! TABUTIL: (Table utilities)
!
!  ORDER TAB - routine to order a table
!
!  GET ILAP TABLE  - routine to read a table
!
!  TABMIN : a routine to ensure that MINIMO will accept an ILAP table
!  i.e. appends "mode tabin" to the start of the file, if not already
!  there.
!
!  MINTAB : an ILAP external routine which converts a MINIMO
!  output file ( .RCD ) into an ILAP table file ( .TBL ).
!
!  EQUATE : Produce a file of equations from a table.

%include "nmos.inc"
%include "plautils.inc"

{#########################################################################}
{#                                                                       #}
{#      This program is part of the ILAP library, and was written in     #}
{#   The Department of Computer Science at the University of Edinburgh   #}
{#       (James Clerk Maxwell Building, Kings Buildings, Edinburgh)      #}
{#                                                                       #}
{#   This software is available free to other educational establisments  #}
{#   but the University of Edinburgh, retains all commercial rights.     #}
{#   It is a condition of having this software is that the sources are   #}
{#   not passed on to any other site, and that Edinburgh University is   #}
{#   given credit in any re-implementations of any of the algorithms     #}
{#   used, or articles published which refer to the software.            #}
{#                                                                       #}
{#   There is no formal support for this software, but any bugs should   #}
{#   be reported to Gordon Hughes or David Rees at the above address,    #}
{#   and these are likely to be fixed in a future release.               #}
{#                                                                       #}
{#########################################################################}

%external %routine order table %alias "ILAP_ORDER_TABLE" %c
   ( %byte %array (2) %name table, %string(*)%array %name names,
     %integer %array %name feedback, %integer ins, outs, feeds, prods )
   %integer i,n

   %routine swop ( %byte %name a , b )
     %byte c
     c = a ; a = b ; b = c
   %end

   %routine swop col( %integer col1 , col2 )
     %integer i
     %string(8) t
     swop( table(col1,i) , table(col2,i) ) %for i = 1,1,prods
     t = names(col1) ; names(col1) = names(col2) ; names(col2) = t
     i = feedback(col1) ; feedback(col1) = feedback(col2)
     feedback(col2) = i
   %end

   %integer %function less ( %string(6) a, b )
     %integer i
     %for i = ins+1,1,ins+feeds %cycle
        %if names(i) = a = b %or names(i) = b %start
           %result = false
        %finish %else %if names(i) = a %start
           %result = true
        %finish
     %repeat
     %result = false
   %end

   %if ins + feeds > 1 %start
     %for n = ins+feeds,-1,2 %cycle
       %for i = 1,1,n-1 %cycle
         swop col( i,i+1 ) %if feedback(i+1) = false %and feedback(i) = true
       %repeat 
     %repeat
   %finish
   %if outs + feeds > 1 %start
     %for n = ins+feeds+feeds+outs,-1,ins+feeds+2 %cycle
       %for i = ins+feeds+1,1,n-1 %cycle
         swop col( i,i+1 ) %if feedback(i) = false %and feedback(i+1) = true
         disaster ("feedback order incorrect") %if feedback(i) = true %and %c
                 feedback(i+1) = true %and less( names(i), names(i+1) ) = true
       %repeat
     %repeat
   %finish
%end

%external %routine get ilap table %alias "ILAP_GET_TABLE" %c
   ( %byte %array (2) %name table, %string(*)%array %name names,
     %integer %array %name feedback, %integer %name ins, outs, feeds, prods,
     %string(15) error id )
  %integer np { name pointer }

  %routine get inputs
    %string(255) name
    %integer term
    read to terminator(name,term) %until name = "in" { skip past IN }
    %while term # nl %cycle
      ins = ins + 1
      np = np + 1
      feed back(np) = false
      read to terminator(name,term)
      %if term<=' ' %start { Allows spaces at the end of the line }
           read symbol (term) %while next symbol <=' ' %and term#nl
      %finish
      names(np) <- name
      ins = ins -1 %and np = np - 1 %if names(np) = ""
    %repeat
  %end

  %routine get table
    %integer ch, y, x, length
    y = 0;   length = -1
    %cycle
      y = y + 1
      disaster (error id.": table too long") %if y > max prods
      x = 0
      %cycle
        x = x + 1
        disaster (error id.": table too wide") %if x > max names
        read symbol(ch) %until ch # ' '
        %if ch = '{' %start
            read symbol (ch) %until ch='}'
            x = x - 1
            %continue
        %finish
        %if ch = '0' %start
          table(x,y) = 0
        %finish %else %if ch = 'x' %or ch = 'X' %start
          table(x,y) = 1
        %finish %else %if ch = '1' %start
          table(x,y) = 2
        %finish %else %if ch = nl %start
          y=y-1 %and %exit %if x=1 { Only a comment on the line }
          disaster (error id.": line length inconsistency") %if length # -1 %and x # length
          length = x
          %exit
        %finish %else %if ch = 'O' %or ch = 'o' %start
          read symbol(ch) %until ch = ' '
          prods = y - 1
          %return
        %finish %else %start
          disaster (error id.": illegal symbol < ".to string(ch)." >")
        %finish
      %repeat
    %repeat                    
  %end

  %integer %function found ( %string(6) name )
    %integer i
!    print string(names(i)." ") %for i=1,1,np-1
    %for i = 1,1,np-1 %cycle
       feed back(i) = true %and %result = true %if name = names(i)
    %repeat
    %result = false
  %end

  %routine get outputs
    %integer term
    %string(255) name
    %on 9 %start
        np = np - 1
        %return
    %finish
    %cycle
      np = np + 1
      read to terminator(name,term)
      names(np) = name
      %if names(np) = "" %start
          np = np - 1
      %finish %else %if found(names(np)) = true %start
          ins = ins - 1
          feed back(np) = true
          feeds = feeds + 1
      %finish %else %start
          outs = outs + 1
          feed back(np) = false
      %finish
    %repeat %until term = nl
  %end

  np = 0
!  write (ins, 1); write (outs,1); write (feeds,1); newline
  get inputs
!  write (ins, 1); write (outs,1); write (feeds,1); newline
  get table
!  write (ins, 1); write (outs,1); write (feeds,1); newline
  get outputs
!  write (ins, 1); write (outs,1); write (feeds,1); newline
%end

%external %routine tabmin %alias "ILAP_TABMIN" ( %string(255) filespec )
  %string(255) word, rest
  %string(127) fin, fout
  %integer in, out, oldin, oldout

  %on 9 %start
    close input
    close output
    select input(oldin)
    select output(oldout)
    %return
  %finish

  %routine read string( %string(*)%name s )
    %integer ch
    s = ""
    read symbol(ch) %until ch > ' '
    %while ch # nl %cycle
      ch = ch - 'A'+'a' %if 'A' <= ch <= 'Z'
      s = s.to string (ch)
      read symbol(ch)
    %repeat
  %end

  old in = in stream;   old out = out stream
  parse filespec ( filespec, "tbl", "mtb", fin, fout, in, out )

  %if diags = true %start
    %if fin # "" %start
      print string("reading from < ".fin." >");newline
    %finish
    %if fout # "" %start
      print string("writing to   < ".fout." >");newline
    %finish
  %finish

  select input(in)
  select output(out)
  print string("MODE tabin");newline
  %cycle
    read string(word)
    print string(word) %and newline %unless word -> ("mode").rest %and rest -> ("tabin")
  %repeat
%end

%external %routine mintab %alias "ILAP_MINTAB" ( %string(255) filespec )
! I/O
!
  %integer in, out, old in, old out
  %string(127) fin,fout

! table declarations
!
  %byte %array table (1:max names, 1:max prods)
  %string(7)%array names (1:max names)
  %integer %array feed back (1:max names)

  %integer ins, outs, feeds, prods
  %string(255) dump
  %string(255) name                         { truncated to 6 for names }

  %on 9 %start
    disaster ("MINTAB: unexpected end of input. Empty file ?")
  %finish

  %routine mget table
    %integer x , y
    %integer i
    %integer output
    %integer length
    %integer term
    %integer tok

    %routine min read ( %string(*)%name s , %integer %name term )
       %integer new
       new = false
       read to terminator(s,term)
       new = true %if term = nl
       %while next symbol <= ' ' %cycle
          read symbol(term)
          new = true %if term = nl
       %repeat
       term = nl %if new = true
    %end

    %integer %function found ( %string(6) name )
      %integer i
      %for i = 1,1,output %cycle
        %result = true %if names(i) = name
      %repeat
      %result = false
    %end

    y = 0;   length = -1; feeds = 0
    names(i) = "" %for i = 1,1,max names
    feedback(i) = false %for i = 1,1,max names

    min read(name,term) %until name -> ("reduced").dump
    read symbol(term) %until term = nl

    %cycle
      min read(name,term) %until name # ""
      %exit %unless name -> ("reduced").dump %or name ->("minimised").dump
      read symbol(term) %until term = nl
    %repeat

    %cycle
      %if name = "cells" %start
        prods = y
        %exit
      %finish
      y = y + 1
      disaster ("MINTAB: table too long") %if y > max prods
      x = 0
      %cycle
        x = x + 1
        disaster ("MINTAB: table too wide") %if x > max names
        %if name = "." %start
          table(x,y) = 1
          tok=false
        %finish %else %if name -> ("\").name %start
          table(x,y) = 0
          tok = true
        %finish %else %if name = ":" %start
          x = x - 1
          output = x
          tok=false
        %finish %else %start
          table(x,y) = 2
          tok = true
        %finish
        %if tok = true %start
          %if names(x) # "" %and name#"?" %and names(x) # name %start
            disaster("MINTAB: name inconsistency < ".name." > < ".names(x)." >")
          %finish
          names(x) <- name %if name#"?"
          tok = false
        %finish
        %if term = nl %start
          %if length # -1 %and length # x %start
            disaster("MINTAB: length inconsistency < ".name." >") 
          %finish
          length = x
          min read(name,term)
          %exit
        %finish
        min read(name,term)
      %repeat
    %repeat

    %for i = output + 1,1,length %cycle
      %if found( names(i) ) = true %start
        feedback(i) = true
        feeds = feeds + 1
      %finish
    %repeat

    ins = output - feeds
    outs = length - 2*feeds - ins

  %end

  %routine print table
    %integer i,j,k,l
    %return %if ins + feeds < 1 %or outs + feeds < 1

    l = 1
    print string("IN  ")
    %if ins + feeds >= 1 %start
        I = 1
        I = I + 1 %while names(i)=""
        disaster  ("MINTAB: Table contains no input terms") %if i > ins + feeds
        print string (names(i))
        I = I + 1
        L = length(names(i)) + 1
        %for i = i,1,ins+feeds %cycle
             %if names (i)#"" %start
                 l = l + 1 + length(names(i))
                 print symbol (',')
                 print string (names(i))
             %finish
       %repeat
    %finish
    newline

    %for i = 1,1,prods %cycle
         spaces (3)
         %for j = 1,1,ins+feeds %cycle
              %if names(j)#"" %start
                  space %for k = 1,1,length(names(j))
                  %if table(j,i) = 0 %start
                      print symbol('0')
                  %finish %else %if table(j,i) = 1 %start
                      print symbol('x')
                  %finish %else %start
                      print symbol('1')
                  %finish
              %finish
         %repeat
         space
         %for j = ins+feeds+1,1,ins+feeds*2+outs %cycle
              %if names(j)#"" %start
                  space %for k = 1,1,length(names(j))
                  %if table(j,i) = 2 %start
                      print symbol('1')
                  %finish %else %start
                      print symbol('0')
                  %finish
              %finish
         %repeat
         newline
    %repeat

    print string("OUT ")
    space %for k = 0,1,l
    %if outs + feeds >= 1 %start
        I = ins + feeds + 1
        I = I + 1 %while names(i)=""
        print string (names(i))
        I = I + 1
        %for i = i,1,ins+feeds+feeds+outs %cycle
            print symbol (',') %and print string (names(i)) %if names(i)#""
        %repeat
    %finish
    newline

  %end

  old in = in stream;   old out = out stream

  parse filespec ( filespec, "rcd", "tbl", fin, fout, in, out )

  %if diags = true %start
    %if fin # "" %start
      print string("reading from < ".fin." >");newline
    %finish
    %if fout # "" %start
      print string("writing to   < ".fout." >");newline
    %finish
  %finish

  select input( in )
  select output( out )

  mget table
  order table( table, names, feedback, ins, outs, feeds, prods )
  print table

  close input
  close output
  select input (  oldin )
  select output( oldout )
%end

%external %routine equate %alias "ILAP_EQUATE" ( %string(255) filespec )
  %byte %array table ( 1:max names, 1 : max prods )
  %string(7)%array names (1:max names)  
  %integer %array feed back (1:max prods)
  %integer ins, outs, feeds, prods
  %string(127) in, out
  %integer inn, outn, oldin, oldout
  
  %on 9 %start
    disaster ("EQUATE: unexpected end of input");newline
  %finish
  
  %routine print equations
    %integer i,j,k
    %integer firsts
    %integer firstp
    %return %if ins + feeds < 1 %or outs + feeds < 1
    print string("IN  ")
    %if ins + feeds > 1 %start
      print string(names(i).",") %for i = 1,1,ins+feeds-1
    %finish
    print string(names(ins+feeds));newline
    %for i = ins+feeds+1,1,ins+2*feeds+outs %cycle
      print string(names(i)."=")
      firsts = true
      %for j = 1,1,prods %cycle
        %if table(i,j) = 2 %start
          print string("+") %if firsts = false
          firstp = true
          %for k = 1,1,ins+feeds %cycle
            %if table(k,j) # 1 %start
              print symbol('.') %if firstp = false
              firstp = false
              %if table(k,j) = 0 %start
                print string("\".names(k))
              %finish %else %if table(k,j) = 2 %start
                print string(names(k))
              %finish
            %finish
          %repeat
          firsts = false
        %finish
      %repeat
      newline
    %repeat
    print string("OUT ")
    %if outs + feeds > 1 %start
      print string(names(i).",") %for i = ins+feeds+1,1,ins+feeds+feeds+outs-1
    %finish
    print string(names(ins+2*feeds+outs))
    newline
  %end

  ins = 0;   outs = 0;   feeds = 0
  old in = in stream;   old out = out stream

  select output(0)

  print string("EQUATE:  Version 2.1") %and newline %if diags = true

  parse filespec( filespec, "tbl", "eqn", in , out, inn, outn )

  %if diags = true %start
    %if in # "" %start
      print string("reading from < ".in." >");newline
    %finish
    %if out # "" %start
      print string("writing to   < ".out." >");newline
    %finish
  %finish    
  select input(inn)

  prompt("] ")
  get ilap table( table, names, feedback, ins, outs, feeds, prods, "EQUATE")
  order table( table, names, feedback, ins, outs, feeds, prods )

  select output(outn)
  print equations
  close input
  close output

  select input( oldin )       { common courtesy }
  select output( oldout )
%end

%end %of %file
