begin; !takeon: convert imp grammar 31/1/77
constinteger gra=1, old=2; !in streams
constinteger err=0, new=1, glist=2, dlist=3; !out streams
constinteger first phrase = 200
constinteger ident=90
owninteger charmax=0, nmax=-1, inits=0
owninteger newname=0, outstring=-1
integer sym,count,gmin,gmax,kmax
byteintegerarray char(1:1400)
ownbyteintegerarray tran(0:255)
integerarray index(0:255)
integerarray item,next(-1:800), atomic(130:179), phrase(200:255)
integerarray initial,initnext(0:255)
integerarray keydict(32:1023)
routine hwrite(integer n, m)
n = n!x'FFFF0000' if n&x'8000' # 0
write(n, m)
end
routine read sym
cycle
read symbol(sym) until sym # ' '
return if sym # '&' or nextsymbol # nl
skipsymbol
repeat
end
routine print chars(integer p)
integer flag
flag = outstring
if p # 0 start
while char(p) # 0 and flag # 0 cycle
flag = flag-1
printsymbol(char(p)&127)
p = p+1
repeat
finish
end
routine print name(integer n)
print chars(index(n&255))
while n&x'300' # 0 cycle
print symbol('<'); n = n-256
repeat
if outstring < 0 start
printsymbol('"') if (n&x'800' # 0 or tran(n&255) # 0)
n = n>>16
if n # 0 start
printsymbol('['); hwrite(n, 0); printsymbol(']')
finish
finish
end
routine read name(integername n)
integer i,j,k,m
i = charmax
cycle
i = i+1; char(i) = sym
read symbol(sym)
exit unless 'A'<=sym<='Z' or '0'<=sym<='9'
repeat
i = i+1; char(i) = 0
read sym if sym = ' '
m = nmax
while m >= 0 cycle
j = index(m); k = charmax+1
while j # 0 and char(j)&127 = char(k) cycle
->ok if char(k) = 0
j = j+1; k = k+1
repeat
m = m-1
repeat
ok: if newname # 0 start
if m >= 0 start
printstring("DUPLICATE: ")
print chars(charmax+1)
newline
finish
index(n) = charmax+1; charmax = i
tran(n) = 1 and read sym if sym = '"'
nmax = n if nmax < n
else
if m < 0 start
printstring("UNKNOWN: ")
print chars(charmax+1)
newline
m = 0
finish
n = m
finish
end
routine read grammar
integer i,j,k,l,p,min,max,exp,end
integerarray converted(-200:350), head,tail(-200:-1), token,link(1:350)
integerarray map(0:800)
integerfn cell(integer h,t)
!creates a list cell, if necessary, with head h and tail t
integer i
i = t; i = 0 if i > 0
while i # min cycle
i = i-1
result = i if head(i) = h and tail(i) = t
repeat
min = min-1; head(min) = h; tail(min) = t
converted(min) = 0
result = min
end
integerfn union(integer x,y)
integer hx,hy
result = x if x = y
hx=x and x=y and y=hx if x < y
if x >= 0 start
result = cell(x,y) if y >= 0
hy = head(y)
result = cell(x,y) if x > hy
result = cell(hy,union(x,tail(y))) if x # hy
result = y
finish
hx = head(x); hy = head(y)
result = cell(hx,union(tail(x),y)) if hx > hy
result = cell(hy,union(x,tail(y))) if hx # hy
result = cell(hx,union(tail(x),tail(y)))
end
routine concatenate(integer x,y)
integer i,j
i = x
cycle
j = link(i); link(i) = y; i = j
exit if i = x
repeat; ! %until i = x
end
routine accept exp(integername exp,exp end)
!inputs a regular expression and creates intermediate graph representation
integer i,string,string end,unit,unit end, n
exp = 0
s: string = 0
u: if sym = '(' start
read sym
accept exp(unit,unit end)
->err if unit = 0 or sym # ')'
read sym
else
if 'A' <= sym <= 'Z' or sym = '%' start
read name(i)
char(index(i)) = char(index(i))!128 if i # 0
i = i!tran(i)<<11
i = i+256 and read sym while sym = '<'
if sym = '"' start; ! force transparent
readsym
i = i!1<<11
finish
if sym = '[' start
read(n); ->err if n>>4 # 0
i = i+n<<16
readsym; ->err if sym # ']'
read sym
finish
else
->err if sym # '+'
i = 0
i = i+256 and read sym while sym = '+'
finish
max = max+1; token(max) = i; link(max) = max
unit = max; unit end = max
finish
if sym = '*' or sym = '!' start
max = max+1; token(max) = -1; link(max) = max
min = min-1; head(min) = max; tail(min) = unit
concatenate(unit end,min); unit end = max
unit = min if sym = '*'
read sym
finish
if sym = '?' start
max = max+1; token(max) = -1
link(max) = link(unit end); link(unit end) = max
min = min-1; head(min) = max; tail(min) = unit
unit = min
read sym
finish
if string=0 then string=unit else concatenate(string end,unit)
string end = unit end
->u unless sym = ',' or sym = ')' or sym = nl
if exp = 0 start
exp = string
exp end = string end
else
exp = union(string,exp)
i = link(exp end)
link(exp end) = link(string end)
link(string end) = i
finish
return unless sym = ','
read sym until sym # nl
->s
err:exp = 0
end
routine convert
integer i,j,k,m,n,gmax1,loopstop
routine tcount(integer x)
integer t
cycle
return if x = 0
if x < 0 start
tcount(tail(x))
x = head(x)
finish
t = token(x)
exit if t >= 0
return if t = loopstop
token(x) = loopstop
x = link(x)
repeat
k = k-1
end
routine add components(integer x)
owninteger i,k,t,u
while x # 0 cycle
if x < 0 start
add components(tail(x))
x = head(x)
finish
t = token(x)
exit if t >= 0
return if t = loopstop
token(x) = loopstop
x = link(x)
repeat
if x # 0 then x = link(x) else t = 0
u = t&(x'F0000'+15<<11+255)
i = gmax1
cycle
i = i+1
exit if i > gmax
k = item(i)
next(i)=union(next(i),x) and return if k = t
if k&(x'F0000'+15<<11+255) = u start
print name(p) unless p = 0
printstring("-CLASH: ");
print name(k); space; print name(t)
newline
finish
k = k&255
if u = ident or (u&255<k and k>=180) or k = 0 start
cycle i = gmax,-1,i
item(i+1) = item(i)
next(i+1) = next(i)
repeat
exit
finish
repeat
gmax = gmax+1
item(i) = t; next(i) = x
end
loopstop = -1; gmin = gmax+1
cycle i = min,1,max
converted(i) = 0
repeat
n = next(0)
1: gmax1 = gmax
loopstop = loopstop-1
add components(n)
item(gmax) = item(gmax)+1024
if gmax1 = 0 start
inits = gmax
inits = inits-1 while inits # 0 and item(inits)&255 >= first phrase
finish
converted(n) = gmax1+1
m = 0
cycle i = gmin,1,gmax
j = next(i)
if j # 0 start
k = converted(j)
if k = 0 start
loopstop = loopstop-1
tcount(j)
converted(j) = k
finish
if k < m start
m = k; n = j
finish
finish
repeat
->1 if m # 0
cycle i = gmin,1,gmax
k = next(i)
k = converted(k) if k # 0
next(i) = k
repeat
end; !convert
routine minimize
integer i,j,k,m,n
integerarray stack(1:150)
integerfn ult map(integer i)
integer j
j=i and i=map(i) until i = j or i = 0
result = j
end
integerfn equivalent(integer nn,mm)
integer i,j,k,pos1,pos2
pos1 = 0; pos2 = 0
1: cycle
k = item(mm)
->9 unless item(nn) = k
i = next(nn); j = next(mm)
->9 if (i=0 and j#0) or (i#0 and j=0)
pos1 = pos1+1; stack(pos1) = nn; map(nn) = mm
nn = nn+1; mm = mm+1
exit if k&1024 # 0; !last alternative
repeat
2: result = 1 if pos2 = pos1
pos2 = pos2+1; i = stack(pos2)
nn = ult map(next(i)); mm = ult map(next(map(i)))
->2 if nn = mm
if nn < mm start
i = nn; nn = mm; mm = i
finish
->1 if nn > n
9: while pos1 # 0 cycle
i = stack(pos1); map(i) = i
pos1 = pos1-1
repeat
result = 0
end
cycle i = 0,1,gmax
map(i) = i
repeat
return if gmin > gmax
cycle n = gmin,1,gmax
if map(n) = n start
if n = gmin or item(n-1)&1024 # 0 start
m = 1
while m # n cycle
exit if map(m) = m and equivalent(n,m) # 0
m = m+1
repeat
finish
else
map(n) = ult map(n)
finish
repeat
j = gmin-1
cycle i = gmin,1,gmax
k = map(i)
if k = i start
j = j+1; map(i) = j
item(j) = item(i); next(j) = next(i)
else
map(i) = map(k)
finish
repeat
gmax = j
cycle i = gmin,1,gmax
k = next(i)
next(i) = map(k) if k # 0
repeat
end; !minimize
gmax = 0
1: read sym until sym # nl
->10 if sym = '/'
if sym = 'S' and next symbol = 'S' start
skip symbol; p = 0
else
read name(p); stop if p = 0
finish
min = 0; max = 0
read sym until sym#nl and sym#'-' and sym#'>'
accept exp(exp,end)
->9 if exp = 0 or sym # nl
concatenate(end,0)
item(0) = 2047; next(0) = exp
convert
i = gmin
minimize
i = map(gmin)
if p = 0 start; !ss
!!! j = item(i);! k = next(i)
!!! k = k-inits;! %stop %if k <= 0
!!! %if i <= inits %start
!!! ->99 %if l >= first phrase
!!! %signal 0,25 %if initial(l) # 0
!!! %else
!!! %finish
!!! gmax = gmax-inits
cycle i = 1, 1, inits
l = item(i)&255
continue if l >= 200
l = atomic(l) if 130 <= l < 180
signal 0,25 if initial(l) # 0
initial(l) = i; initnext(l) = item(i)
repeat
select output(glist)
newline
else
phrase(p) = i
select output(glist)
newline
print name(p); printstring(" =>")
hwrite(i,1)
finish
k = 1024
cycle i = gmin,1,gmax
if k&1024 # 0 start
newline; hwrite(i,3); j = 0
finish
j = j+1
if j > 5 start
newline; spaces(4); j = 1
finish
spaces(3)
k = item(i)
if k&255 # 0 start
print name(k)
else
printstring("*E")
print symbol('+') and k=k-256 while k&x'300' # 0
finish
hwrite(next(i),1)
repeat
select output(err)
->1
9: printstring("WRONG FORMAT AT: ")
while sym # nl cycle
print symbol(sym); read sym
repeat
newline
->1
!deal with initial phrase
!assumes exactly one (imp)
10: if inits = 1 start; ! not imp!!!
selectoutput(err)
printstring("NOT AN IMP GRAMMAR"); newline
return
finish
p = phrase(item(inits+1)&255)
signal 0,26 if p = 0
cycle
j = item(p); k = j&255
signal 0,27 if k >= 160
k = atomic(k) if k >= 120
signal 0,28 if initial(k) # 0
initial(k) = p!x'8000'; initnext(k) = j
exit if j&1024 # 0
p = p+1
repeat
initial(0) = initial(182); !%decl
select output(glist)
newlines(2)
cycle i = 0,1,119
k = initial(i)
if k # 0 start
hwrite(i,2); printstring(": ")
print name(initnext(i))
hwrite(k&255, 3)
printsymbol('`') if k < 0
newline
finish
repeat
select output(err)
end; !read grammar
routine read atoms
integer i,j,k,dict,dmax,code,class,sub
integerarray char,cont,alt(0:1000)
routine read code
integer n
code = next symbol; sub = 0
if code # ',' and code # nl start
skip symbol
if code = '$' start
read(code); return
finish
return unless code = '('
read(sub)
while nextsymbol = '+' cycle
skipsymbol; read(n); sub = sub+n
repeat
skip symbol
finish
code = class+128
end
routine insert in(integername x)
cycle
while char(x) < code cycle
cont(x) = sub if cont(x) = 0
x == alt(x)
repeat
if char(x) # code start
dmax = dmax+1; char(dmax) = code
cont(dmax) = 0; alt(dmax) = x; x = dmax
finish
exit if code&128 # 0
read code
x == cont(x)
repeat
sub = cont(alt(x)) if sub = 0 and alt(x) # 0
cont(x) = sub
end
routine store(integer x)
integer m,n,v, mm, q
cycle
kmax = kmax+1; n = kmax
m = alt(x); mm = m
store(m) and m=x'8000' if m # 0
v = char(x); x = cont(x)
exit if v&128 # 0
if m = 0 start; !no alternatives
if alt(x) = 0 and char(x)&128 = 0 start
v = char(x)<<7+v; x = cont(x)
finish
else
q = kmax-n+1
if q>>7 # 0 start
selectoutput(0)
printstring("Keydict overflow!"); newline
signal 15,15
stop
finish
v = q<<7+v!x'8000'
finish
keydict(n) = v
repeat
if mm = 0 start
kmax = kmax+1; keydict(kmax) = 0
else
kmax = kmax-1
finish
keydict(n) = m + x'4000' + (keydict(n+1)&127)<<7 + v&127
keydict(n+1) = x
end
dict = 0; dmax = 0; char(0) = 999
1: cycle
sym = next symbol
exit unless sym = '[' or sym = nl
read symbol(sym) until sym = nl
repeat
->10 if sym = '/'
read(class)
newname = 1
read sym; read name(class)
newname = 0
if class < 130 start
if sym # '[' start
read(sym) if sym = '$'
cycle
code = sym; insert in(dict)
read symbol(sym)
exit if sym # ','
read symbol(sym) until sym # ' ' and sym # nl
repeat
finish
else
if class <= first phrase and sym = '=' start
read sym; read name(atomic(class))
finish
finish
read symbol(sym) while sym # nl
->1
routine display(integer i,s)
integer j
routine show(integer sym)
sym = '$' if sym = nl
printsymbol(sym)
end
1: j = keydict(i)
if j&x'4000' = 0 start
show(j&127)
if j&x'8000' = 0 start
j = j>>7
show(j) and s=s+1 if j # 0
space
i = i+1; s = s+2
->1
finish
space
display(j>>7&127+i,s+2)
else
print symbol(':'); print name(j&127)
space and print name(j>>7&127) unless j>>7&127 = 0
j = keydict(i+1)&x'3FFF'
hwrite(j, 4) unless j = 0
newline
return
finish
return if j>>15 = 0
spaces(s); i = i+1
->1
end
10: select output(dlist); newlines(2)
kmax = 126; keydict(32) = 0
cycle i = 33,1,126
print symbol(i); space
if char(dict) = i start
j = (kmax+1)<<2
store(cont(dict))
dict = alt(dict)
display(j>>2,2)
else
print symbol('?'); newline
j = 32<<2
finish
!let:0 dig:1 term:2 other:3
j = j+3 unless 'A'<=i<='Z'
j = j-2 if '0'<=i<='9'
j = j-1 if i = ';'
keydict(i) = j
repeat
keydict('~') = keydict('^')
newlines(2)
select output(err)
end
integer i,j,k
charmax = 0
item(i) = 0 and next(i) = 0 for i = -1, 1, 800
index(i) = 0 for i = 0, 1, 255
atomic(i) = i for i = 130, 1, 179
phrase(i) = 0 for i = first phrase, 1, 255
initnext(i) = 0 and initial(i) = 0 for i = 0, 1, 255
select output(err)
read symbol(i) until i = '/'
read symbol(i) until i = nl
read atoms
read symbol(i) until i = nl
read grammar
!write required values
select output(new)
printstring(" %endoflist"); newline
printstring("%conststring(8)%array text(0:255) = %c
""Z"",")
k = 5; outstring = 8
cycle j = 1, 1, 255
printsymbol('"'); PRINT NAME(J); PRINTSYMBOL('"')
printsymbol(',') unless j = 255
k = k-1; k = 6 and newline if k <= 0
repeat
newline
outstring = -1
printstring("%constinteger gmax1="); hwrite(gmax,0)
newline
printstring("%owninteger gmax="); hwrite(gmax,0); newline
printstring("%constinteger imp phrase ="); hwrite(inits+1, 0)
newlines(2)
printstring("%ownshortintegerarray phrase(200:255) = %C")
for i = 200, 1, 255 cycle
newline if i&7 = 0
hwrite(phrase(i),3)
print symbol(',') unless i = 255
repeat
newlines(2)
printstring("%constbyteintegerarray atomic(130:179) = %c")
k = 0
cycle i = 130,1,179
newline if k&7 = 0
k = k+1
hwrite(atomic(i),3)
print symbol(',') unless i = 179
repeat
newlines(2)
integerfn packed(integer j,k)
j = (j&1024)<<5 + (j&x'0300')<<4 + (j>>3&x'0100')<<6 + (j>>8&x'F00')
result = j+k&255
end
printstring("! FLAG<1> 0<1> SS<2> 0<3> T<1> LINK<8>"); newline
printstring("%constshortintegerarray initial(0:119) = %c")
cycle i = 0,1,119
newline if i&7 = 0
hwrite(initial(i), 7)
print symbol(',') unless i = 119
repeat
newlines(2)
printstring("! MORE<1> 0<1> ORDER<2> TYPE<4> CLASS<8>"); newline
printstring("%ownshortintegerarray gram(0:max grammar) = %c")
cycle i = 0,1,gmax
newline if i&7 = 0
k = 0
k = packed(item(i)!!1024,item(i)) if i # 0
hwrite(k,7)
print symbol(',')
repeat
newline; printstring("0(max grammar-")
write(gmax, 0); printsymbol(')')
newlines(2)
printstring("%ownshortintegerarray glink(0:max grammar) = %c")
cycle i = 0, 1, gmax
newline if i&7 = 0
hwrite(next(i), 7)
printsymbol(',')
repeat
newline; printstring("0(max grammar-")
write(gmax, 0); printsymbol(')')
newlines(2)
printstring("%constshortintegerarray kdict(32:"); hwrite(kmax,0)
printstring(") = %c")
cycle i = 32,1,kmax
newline if i&7 = 0
hwrite(keydict(i),7)
print symbol(',') unless i = kmax
repeat
newline
printstring(" %list"); newline
printstring("%endoffile"); newline
selectoutput(0)
printstring("Grammar complete"); newline
endofprogram