%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) = 0(*)
%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
         ->Lok %if char(k) = 0
         j = j+1;  k = k+1
       %repeat
       m = m-1
    %repeat
Lok: %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
Ls:  string = 0
Lu:  %if sym = '(' %start
       read sym
       accept exp(unit,unit end)
       ->Lerr %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);  ->Lerr %if n>>4 # 0
             i = i+n<<16
             readsym;  ->Lerr %if sym # ']'
             read sym
          %finish
       %else
          ->Lerr %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
    ->Lu %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
    ->Ls
Lerr: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=0,k=0,t=0,u=0
    %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)
L1:  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
    ->L1 %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
L1:  %cycle
       k = item(mm)
       ->L9 %unless item(nn) = k
       i = next(nn);  j = next(mm)
       ->L9 %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
L2:  %result = 1 %if pos2 = pos1
    pos2 = pos2+1;  i = stack(pos2)
    nn = ult map(next(i));  mm = ult map(next(map(i)))
    ->L2 %if nn = mm
    %if nn < mm %start
       i = nn;  nn = mm;  mm = i
    %finish
    ->L1 %if nn > n
L9:  %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
L1:  read sym %until sym # nl
    ->L10 %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)
    ->L9 %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
!!!             ->L99 %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)
    ->L1
L9:  printstring("WRONG FORMAT AT: ")
    %while sym # nl %cycle
       print symbol(sym);  read sym
    %repeat
    newline
    ->L1
    !deal with initial phrase
    !assumes exactly one (imp)
L10: %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
L1:  %cycle
       sym = next symbol
       %exit %unless sym = '[' %or sym = nl
       read symbol(sym) %until sym = nl
    %repeat
    ->L10 %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
    ->L1

%routine display(%integer i,s)
%integer j
   %routine show(%integer sym)
      sym = '$' %if sym = nl
      printsymbol(sym)
   %end
L1:  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
          ->L1
       %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
    ->L1
%end

L10: 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