{1995 Jan 31}

{ (c) Copyright 1992-1995 Itty Bitty Computers.  All rights reserved. }

tag TagGrammar: 

  {tree node names}
  type node(no, ty, gl, fn, tk, nt, st, pl, qu, tr, ac, at, mt, ot, cn, rt,
            xf, bt, er, al, ca, qm, dl, tf, dr, vr, as, eq, ls, gr, ne, 
            an, or, ad, su, mp, dv, md, ng, tv, rn, nn, nc, co, sa);

  funct   {predefined in virtual compiler machine}
    addset !int !set ^set;
    difference !set !set ^set;  {first - second}
    inset !int !set;            {fails if not}
    intersect !set !set ^set;
    newelt !set ^int;           {returns a value not in the set}
    notinset !int !set;
    union !set !set ^set;
    
    addnewset !int !int;  {add value to set in place}
    newinset !int !int;
    newnewset !int ^int;  {creates empty set in set list}
    newsetlist ^int;      {allocates set list, returns empty set}
    newunion !int !int ^int;
    uniquenew !int ^int;  {return first =set, dispose old if dupe}
    
    addtbl !int;
    charfrom !int !int ^int;  {i,s: char(i) from string (s), 0-based}
    charval ^int;
    initbl;
    length !int ^int;    {length of indexed string or ident}
    spell !int;          {output identifier or string}
    strindex !int ^int;  {dataAttribute,index; dataAttribute cannot be zero}
    
    into !int !table !tree ^table;
    from !int !table ^tree;
    nothere !int !table;   {fails if in table}
    
    fixadetran !int !int !int !int !int;
    fixatran !int !int !int !set !int;
    getadetran !int ^int ^int ^int ^int ^int ^int;
    getatran !int ^int ^int ^int ^set ^int ^int;
    notherdetran !int !int !int !int;
    nothertran !int !int !set !int;
    
    booltree !bool ^tree;
    inttree !int ^tree;
    settree !set ^tree;
    treebool !tree ^bool;
    treecopy !tree ^tree; {to get past tag compiler type fault}
    treeint !tree ^int;   {returns exp from <exp>}
    treeset !tree ^set;
    treetab !tree ^table;
    
    number !int;   {output decimal value}
    ascii !int;
    opentext; 
    closetext;
    initScannerStuff;
    packattributes !table !set !set !set !tree !int ^table;
    unpackatts !table ^table ^set ^set ^set ^tree ^int;


                                    scanner
ignore
  -> " "|""
  -> "{" ("".."|"|"~")* "}";
STR ^strg:int ^doubleQuote:bool
  -> [initbl] "'" ((" ".."&"|"(".."~") [charval^thisA][addtbl!thisA])* "'" 
     [strindex !1 ^strg; doubleQuote=false]
  -> [initbl] '"' ((" ".."!"|"#".."~") [charval^thisB][addtbl!thisB])* '"' 
     [strindex !1 ^strg; doubleQuote=true];
ID ^ident:int  
  -> [initbl] ("a".."z"|"A".."Z") [charval^this][addtbl!this]
     (("a".."z"|"A".."Z"|"0".."9") [charval^next][addtbl!next])* 
     [strindex !2 ^ident];
NUM ^valu:int
  -> [valu=0] ("0".."9" [charval^this; valu@=valu*10+this-48])+;

                                     parser

TagGrammar                                                             {p010}
  -> "tag" ID ^tagname ":"
     [treetab !<> ^vacnt]
     [into !1 !vacnt !<ty>%1 ^env1]  {int}
     [into !2 !env1 !<ty>%2 ^env2]   {bool}
     [into !3 !env2 !<ty>%3 ^env3]   {tree}
     [into !4 !env3 !<ty>%4 ^env4]   {set}
     [into !5 !env4 !<ty>%5 ^env]    {table}
     [defd=empty; hist=0]
     startoutput !tagname
     (decln !env !defd ^env@ ^defd@)*
     dolibrary !env
     [addset !0 !empty ^emptytok0; addset !1 !emptytok0 ^emptytok1]
     [trans=<no <>>]

     [packattributes !env  !defd   !empty   !emptytok1 !trans !0 ^data]
    {attributes: symtable, def'd, redef'd, tokens, trans, histate}

     ( "scanner" 
       ( "ignore"
         ( "->" scanre !data !0 !0 ^data@ ^tost
           [unpackatts !data@ ^xenv ^xdefd ^xredefd ^xtoks ^dtran ^xhist]
           dtran:newtran !tost !0 !empty !<> !0 )+ ";")? 
       ( scanrule !data ^data@ )+ )?

     ( "parser" (parsrule !data ^data@)+)?
     ( "transformer" (tagrule !data ^data@)+)?
     buildscanner !data ^nst ^ncs ^goalname
     buildparser !data ^bdata
     [unpackatts !bdata ^benv ^bdef ^bred ^btok ^btran ^bhist]
     [//"There is no goal symbol"//; from !tagname !benv ^xnt:<nt ..>]
     finishoutput !tagname !goalname
     [//"expected identifier or end"//]
     "end" ID ^endname [endname=tagname] ".";

decln !insym:table !indef:set ^outsym:table ^outdef:set                {p020}
  -> [outsym=insym; outdef=indef]
     ( "type"
       ( ID ^tname 
         [//"type name already defined"//; notinset !tname !outdef]
         [addset !tname !outdef ^outdef@]
         [tipe=<ty>%tname; into !tname !outsym !tipe ^outsym@]
         ( "("
           ( ID^idn 
             [//"value already defined"//; notinset !idn !outdef]
             [addset !idn !outdef ^outdef@]
             [into !idn !outsym !<co tipe >%idn ^outsym@] )$","
           ")" )? )$"," ";"
     | "global"
       ( ID ^consname 
         [//"global name already defined"//; notinset !consname !outdef]
         [addset !consname !outdef ^outdef@]
         ( ":" typename !outsym ^ctype  [inttree !consname ^valuet]
         | "=" 
           ( NUM ^value  [idn=1; inttree !value ^valuet] 
           | "<>"  [idn=3; valuet=<>]
           | "false"  [idn=2; booltree !false ^valuet]
           | "true"  [idn=2; booltree !true ^valuet] )
           [from !idn !outsym ^ctype] )
         [into !consname !outsym !<gl ctype valuet> ^outsym@]
         globalname !consname !ctype ";" )+
     | "funct"
       ( ID ^functname  [inh=<>; der=<>]
         [//"function name already defined"//; notinset !functname !outdef]
         [addset !functname !outdef ^outdef@]
         ( "!" typename !outsym ^ity  [inh@=<at inh <> ity >] )* 
         ( "^" typename !outsym ^dty  [der@=<at der <> dty >] )*
         [into !functname !outsym !<fn inh der> ^outsym@] ";")+ );

typename !env:table ^atype:tree                                        {p030}
  -> ID ^idn [//"invalid or undefined type"//; from !idn !env ^atype:<ty>]
  -> "table"[from !5 !env ^atype]
  -> "set"  [from !4 !env ^atype]
  -> "int"  [from !1 !env ^atype]
  -> "bool" [from !2 !env ^atype]
  -> "tree" [from !3 !env ^atype];

scanrule !indata:table ^outdata:table                                  {p040}
  -> ID ^name
     [unpackatts !indata ^inenv ^indefd ^red ^intok ^trans ^hist]
     [entry=<tk>; into !name !inenv !entry ^outenv]
     [//"token name already defined"//; notinset !name !indefd]
     [addset !name !indefd ^outdefd]
     [newelt !intok ^newtok; addset !newtok !intok ^outtok]
     [qhist=hist+1]
     [packattributes !outenv !outdefd !red !outtok !trans !qhist ^ntData]
     [data=ntData; der=<>]
     ( derives !der !data !newtok ^der@ ^data@ )*
     entry:redecorate !newtok !der
     "->" scanre !data !0 !newtok ^data2 ^xst
     [unpackatts !data2 ^xxenv ^defx ^redx ^tokx ^otran ^histx]
     otran:newtran !xst !qhist !empty !<> !newtok
     ( "->" splitalt !data !data2 ^data3
       scanre !data3 !0 !newtok ^data4 ^xstate
       [unpackatts !data4 ^xxxenv ^defxx ^redxx ^tokxx ^otranx ^histxx]
       otranx:newtran !xstate !qhist !empty !<> !newtok
       joinalt !data2 !data4 ^data2@ )* ";"
     [unpackatts !data2 ^qxxxenv ^qdefxx ^qredxx ^qtokxx ^qotranx ^qhistxx]
     qotranx:newtranTkNo !qhist !name !entry
     der:isdefined !qdefxx
     datamerge !ntData !data2 ^outdata;

scanre !indata:table !fromst:int !toknno:int ^outdata:table ^tost:int  {p050}
  -> scanalt !indata !fromst !toknno ^outdata ^tost
     ( "|" splitalt !indata !outdata ^xdata
       scanalt !xdata !fromst !toknno ^tdata ^xst
       [unpackatts !tdata ^xenv ^xdefd ^xredefd ^xtoks ^tran ^xhist]
       tran:newtran !xst !tost !empty !<> !toknno
       joinalt !outdata !tdata ^outdata@ )*;

scanalt !indata:table !fromst:int !toknno:int                          {p060}
  ^outdata:table ^tost:int
  -> [tost=fromst; outdata=indata]
     ( scanterm !outdata !tost !toknno ^outdata@ ^tost@ )* ;

scanterm !indata:table !orgst:int !toknno:int                          {p070}
  ^outdata:table ^tost:int
  -> "(" [unpackatts !indata ^inenv ^indef ^inred ^intok ^intran ^inhist]
     [fromst=inhist+1]
     intran:newtran !orgst !fromst !empty !<> !toknno
     [packattributes !inenv !indef !inred !intok !intran !fromst ^ndata]
     initer !ndata ^xdata
     scanre !xdata !fromst !toknno ^odata ^xst ")" 
     ( ("*" [kind=3] | "+" [kind=2] | "?" [kind=1] )
       [unpackatts !odata ^env ^defd ^redef ^tok ^xtran ^ohist]
       [outhist=ohist+1; tost=outhist]
       xtran:newtran !xst !tost !empty !<> !toknno
       ( [kind=3] xtran:newtran !xst !fromst !empty !<> !toknno
         xtran:newtran !fromst !xst !empty !<> !toknno
       | [kind=2] xtran:newtran !xst !fromst !empty !<> !toknno
       | [kind=1] xtran:newtran !fromst !xst !empty !<> !toknno )
       [packattributes !env !defd !redef !tok !xtran !outhist ^mdata]
       exiter !kind !indata !mdata ^outdata
     | exiter !0 !indata !odata ^outdata
       [tost=xst] )
  -> quotedchar ^loch 
     [unpackatts !indata ^env ^defd ^redef ^tok ^tran ^hist]
     [addset !loch !empty ^onch; tost=hist+1]
     ( ".." quotedchar ^hich 
       ( [loch<hich; nextch=loch+1]
         [addset !nextch !onch ^onch@; loch@=nextch] )* )?
     tran:newtran !orgst !tost !onch !<> !toknno
     [packattributes !env !defd !redef !tok !tran !tost ^outdata]
  -> [tdata=indata; acts=<>]
     "[" (scanact !tdata !toknno ^tdata@ ^anact [acts@=<ca acts anact >])$";" 
     "]" [unpackatts !tdata ^env ^defd ^xred ^xtok ^xtran ^hist; tost=hist+1]
     xtran:newtran !orgst !tost !empty !acts !toknno
     [packattributes !env !defd !xred !xtok !xtran !tost ^outdata];

quotedchar ^char:int                                                   {p080}
  -> STR ^strg  ^xdblQ 
     [length !strg ^strlen]
     ( [strlen=0; char=0] | [strlen=1; charfrom !0 !strg ^char] );

scanact !indata:table !toknno:int ^outdata:table ^anact:tree           {p090}
  {semantic action inside the scanner}
  -> ID^name   [unpackatts !indata ^inenv ^indef ^inredef ^tok ^tran ^hist]
     ( ( "@" [notinset !name !inredef; inset !name !indef; isredef=true]
         [//"invalid iterator reference"//]
         ( [from !name !inenv ^thev:<at ..>]
         | [from !name !inenv ^thev:<sa ..>]
         | [from !name !inenv ^thev:<vr ..>] )
         [tenv=inenv]
       | ( [nothere !name !inenv; inttree !toknno ^toknnot; 
           thev=<sa toknnot>%name; into !name !inenv !thev ^tenv]
         | [from !name !inenv ^thev:<at ..>; tenv=inenv] )
         [//"name already defined"//; notinset !name !indef; isredef=false] )
       [packattributes !tenv !indef !inredef !tok !tran !hist ^odata]
       "=" expn !0 !odata ^edata ^exptr ^expty
       [unpackatts !edata ^eenv ^edef ^eredef ^etok ^etran ^ehist]
       ( [isredef=true; ndef=edef; addset !name !eredef ^nredef]
       | [otherwise; addset !name !edef ^ndef; nredef=eredef] )
       [packattributes !eenv !ndef !nredef !etok !etran !ehist ^outdata]
       [anact=<as exptr expty thev>]
     | [//"invalid action call"//; from !name !inenv ^fun:<fn inh der>]
       sends !inh !indata !<> ^sarg ^sdata
       recvs !der !sdata !<> !toknno ^rarg ^outdata
       [anact=<fn sarg rarg >%name]);

parsrule !indata:table ^outdata:table                                  {p100}
  -> ID^name
     [ttree=<nt <> <> >%name]
     newdefine !name !indata !ttree ^attdata
     [inh=<>; der=<>; ldata=attdata]
     ( inherits !inh !ldata ^inh@ ^ldata@)* 
     ( derives !der !ldata !0-1 ^der@ ^ldata@)*
     ttree:ntfill !<no inh der >%0
     "->" parsre !ldata ^rdata ^ptree
     ( "->" splitalt !ldata !rdata ^xdata
       parsre !xdata ^zdata ^prp
       joinalt !rdata !zdata ^rdata@
       [ptree@=<al ptree prp >])* 
     ";" ttree:ntfill !ptree
     datamerge !attdata !rdata ^outdata;

parsre !indata:table ^outdata:table ^outree:tree                       {p110}
  -> parsalt !indata ^outdata ^outree
     ( "|" splitalt !indata !outdata ^xdata
       parsalt !xdata ^zdata ^nutree
       joinalt !outdata !zdata ^outdata@
       [outree@=<al outree nutree >] )*;

parsalt !indata:table ^outdata:table ^outree:tree                      {p120}
  -> [outdata=indata; outree=<>]
     ( parsterm !outdata ^outdata@ ^nutree  [outree@=<ca outree nutree >] )*;

parsterm !indata:table ^outdata:table ^outree:tree                     {p130}
  -> initer !indata ^ndata
     parsfact !ndata ^odata ^xtree
     ("*" [kind=3; outree=<st xtree >; xdata=odata]
     |"+" [kind=2; outree=<pl xtree >; xdata=odata]
     |"?" [kind=1; outree=<al xtree <>>; xdata=odata]
     |"$" partoken !odata ^xdata ^nutree ^tokn
        [kind=4; outree=<dl xtree nutree >%tokn ]
     |[kind=0; outree=xtree; xdata=odata])
     exiter !kind !indata !xdata ^outdata
  -> ID^tname  {nonterminal call or tree being sent to transformer nt}
     [unpackatts !indata ^env ^xdefd ^xredef ^xtok ^xtrans ^xhistate]
     ( [from !tname !env ^xder:<tk der >%toknt]
       recvs !der !indata !<> !0-1 ^rarg ^outdata
       [outree=<tk rarg >%toknt]
     | semantix !tname !<> !indata ^outdata ^outree ) 
  -> semantix !0 !<> !indata ^outdata ^outree ;

parsfact !indata:table ^outdata:table ^outree:tree                     {p140}
  -> "(" parsre !indata ^outdata ^outree ")" 
  -> partoken !indata ^outdata ^outree ^tokn;

partoken !indata:table ^outdata:table ^outree:tree ^newtok:int         {p150}
  -> STR^strng ^xdblQ
     [//"empty token string"//; length !strng ^len; len>0]
     [newtok=strng; outree=<tk <>>%newtok]
     [unpackatts !indata ^inenv ^indef ^redef ^intok ^otran ^hist]
     ( [notinset !strng !intok; addset !newtok !intok ^outok]
       [charno=0; xst=0]
       ( [charno<len; charfrom !charno !strng ^thisch; charno@=charno+1]
         [addset !thisch !empty ^onch; newHi=hist+1; hist@=newHi]
         otran:newtran !xst !newHi !onch !<> !0 [xst@=newHi])*
       [entry=<tk <>>%newtok; inttree !xst ^xxst]
       otran:newtranTK !xxst !strng !entry
     | [otherwise; outok=intok] )
     [packattributes !inenv !indef !redef !outok !otran !hist ^outdata];
     
tagrule !indata:table ^outdata:table                                   {p160}
  -> ID^name
     [ttree=<nt <> <> >%name]
     newdefine !name !indata !ttree ^attdata
     [inh=<>; der=<>; ldata=attdata]
     ( inherits !inh !ldata ^inh@ ^ldata@)* 
     ( derives !der !ldata !0-1 ^der@ ^ldata@)*
     ttree:ntfill !<no inh der >%1
     "->" tagre !ldata ^rdata ^ptree
     ( "=>" xformto !ptree !rdata ^rdata@ ^ptree@ )?
     ( "->" splitalt !ldata !rdata ^xdata
       tagre !xdata ^zdata ^prp
       ( "=>" xformto !prp !zdata ^zdata@ ^prp@ )?
       joinalt !rdata !zdata ^rdata@
       [ptree@=<al ptree prp >] )*
     ";" ttree:ntfill !ptree
     datamerge !attdata !rdata ^outdata;

tagre !indata:table ^outdata:table ^outree:tree                        {p170}
  -> tagalt !indata ^outdata ^outree
     ( "|" splitalt !indata !outdata ^xdata
       tagalt !xdata ^zdata ^nutree
       joinalt !outdata !zdata ^outdata@
       [outree@=<al outree nutree >] )*;

tagalt !indata:table ^outdata:table ^outree:tree                       {p180}
  -> ( "(" tagre !indata ^outdata ^outree ")"
     | recogtree !0 !1 !<> !indata !0-1 ^outdata ^comp [outree=<mt comp>] )
     ( tagSem !outdata ^outdata@ ^semCode  [outree@=<ca outree semCode>] )*;

tagSem !indata:table ^outdata:table ^outCode:tree                      {p190}
  -> "(" initer !indata ^ndata  tagSemRe !ndata ^odata ^semCode ")"
     ( "*" [kind=3; outCode=<st semCode >]
     | "+" [kind=2; outCode=<pl semCode >]
     | "?" [kind=1; outCode=<al semCode <> >]
     |     [kind=0; outCode=semCode] )
     exiter !kind !indata !odata ^outdata
  -> semantix !0 !<> !indata ^outdata ^outCode;

tagSemRe !indata:table ^outdata:table ^lCode:tree                      {p200}
  -> [outdata=indata; lCode=<>]
     ( tagSem !outdata ^outdata@ ^lNewCode  [lCode@=<ca lCode lNewCode >] )*
     ( "|" splitalt !indata !outdata ^xdata
       [zdata=xdata; rCode=<>]
       ( tagSem !zdata ^zdata@ ^rNewCode  [rCode@=<ca rCode rNewCode >] )*
       joinalt !outdata !zdata ^outdata@
       [lCode@=<al lCode rCode>] )*;

xformto !intree:tree !indata:table ^outdata:table ^outree:tree         {p210}
  -> expn !0 !indata ^outdata ^etree ^exptype
     lookup !3 !indata ^exptype
     [outree=<ca intree <xf etree>>]
     ( semantix !0 !outree !outdata ^outdata@ ^outree@ )*;

semantix !idn:int !intree:tree !indata:table                           {p220}
    ^outdata:table ^outree:tree
  -> [idn#0]  {nonterminal reference or tree being sent to transformer}
     [unpackatts !indata ^inenv ^indef ^inred ^intok ^intran ^inhist]
     ( ":" ID^ntname
       ( [from !idn !inenv ^tren:<vr trty>]
       | [from !idn !inenv ^tren:<at lnk vrv trty>])
       lookup !3 !indata ^trtr  sameType !trtr !trty
     | [ntname=idn; tren=<>] )
     ( {already-defined nt}
       [from !ntname !inenv ^ntdef:<nt <no inh der >%kindt ptree >]
       [treeint !kindt ^kind]
       ([ntname=idn; kind=0] | [ntname#idn; kind=1])
     | {fwd nt reference} [inh=<no >; der=inh] )
     sends !inh !indata !<> ^sarg ^tdata
     recvs !der !tdata !<> !0-1 ^rarg ^outdata
     [ntree=<nt sarg rarg tren >%ntname]
     intran:newnonterminalcall !ntree
     [outree=<ca intree ntree >]
  -> "[" [outree=intree; outdata=indata]
     ( action !outdata !0-1 ^outdata@ ^nutree
       [outree@=<ca outree nutree >] )$";" "]"
  -> ID^tname  [idn=0]
     semantix !tname !intree !indata ^outdata ^outree ;

initer !indata:table ^outdata:table                                    {p230}
  -> [unpackatts !indata ^env ^defd ^redef ^tok ^tran ^hist]
     [packattributes !env !defd !empty !tok !tran !hist ^outdata];

exiter !kind:int !indata:table !exdata:table ^outdata:table            {p240}
  -> [unpackatts !indata ^inenv ^indef ^redef ^tok ^tran ^hist]
     [unpackatts !exdata ^xenv ^xdef ^xred ^xtok ^xtran ^xhist]
     ( [kind=kind/2*2; odef=xdef]
     | [kind>kind/2*2; union !indef !xred ^odef] )
     ( [kind>0] | [kind=0; //"@-identifiers not in iterator"//; xred=empty] )
     [ored=redef]
     [difference !xdef !indef ^nudef; intersect !nudef !xred ^empty]
     [packattributes !xenv !odef !ored !xtok !xtran !xhist ^outdata];

splitalt !preLData:table !postLData:table ^preRData:table              {p250}
  -> [unpackatts !preLData  ^prEnv ^prDef ^prRed ^prTok ^prTran ^prHist]
     [unpackatts !postLData ^ptEnv ^ptDef ^ptRed ^ptTok ^ptTran ^ptHist]
     [packattributes !ptEnv !prDef !prRed !ptTok !ptTran !ptHist ^preRData];

joinalt !indata:table !exdata:table ^outdata:table                     {p260}
  -> [unpackatts !indata ^inenv ^indef ^redef ^tok ^tran ^hist]
     [unpackatts !exdata ^xenv ^xdef ^xred ^xtok ^xtran ^xhist]
        [intersect !xdef !indef ^odef; intersect !xred !redef ^ored]
     [packattributes !xenv !odef !ored !xtok !xtran !xhist ^outdata];

newdefine !name:int !indata:table !value:tree ^outdata:table           {p270}
  -> [unpackatts !indata ^inenv ^indef ^redef ^tok ^tran ^hist]
     [//"name already defined"//]
     [nothere !name !inenv; notinset !name !indef]
     [into !name !inenv !value ^outenv; addset !name !indef ^outdef]
     tran:newtranNT !value !name
     [packattributes !outenv !outdef !redef !tok !tran !hist ^outdata];

derives !inatt:tree !indata:table !toknno:int                          {p280}
    ^outatt:tree ^outdata:table
  -> "^" [unpackatts !indata ^inenv ^def ^redef ^tok ^tran ^hist]
     ID^idn ":" typename !inenv ^tipe
     [//"attribute name already defined"//]
     [nothere !idn !inenv; notinset !idn !def]
     [outatt=<at inatt <tk>%toknno tipe>%idn; 
     into !idn !inenv !outatt ^outenv]
     [packattributes !outenv !def !redef !tok !tran !hist ^outdata];

inherits !inatt:tree !indata:table ^outatt:tree ^outdata:table         {p290}
  -> "!" [unpackatts !indata ^inenv ^indef ^redef ^tok ^tran ^hist]
     [//"invalid type"//]
     ID^idn ":" typename !inenv ^tipe
     [notinset !idn !indef; addset !idn !indef ^outdef]
     [//"attribute name already defined"//; nothere !idn !inenv]
     [outatt=<at inatt <> tipe>%idn; into !idn !inenv !outatt ^outenv]
     [packattributes !outenv !outdef !redef !tok !tran !hist ^outdata];

sends !formal:tree !indata:table !intree:tree                          {p300}
    ^actual:tree ^outdata:table
  -> {inherited atts of fwd nt reference}
     [formal:<no>]
     ( "!" expn !0-1 !indata ^tdata ^exptr ^expty 
       sends !formal !tdata !<at intree exptr expty> ^actual ^outdata
     | [otherwise; outdata=indata; actual=intree] )
  -> [formal:<at nextf vrv tipe >]
     sends !nextf !indata !intree ^xtree ^xdata
     "!" expn !0-1 !xdata ^outdata ^exptr ^expty 
     [//"attribute type mismatch"//]  sameType !tipe !expty
     [actual=<at xtree exptr tipe>]
  -> [formal=<>; outdata=indata; actual=intree];

recvs !formal:tree !indata:table !intree:tree !toknno:int              {p310}
    ^actual:tree ^outdata:table
  {Parses synthesized attributes of nonterminal call or function call}
  -> {synthesized att of fwd-referenced nt}
     [formal:<no>]
     ( "^"  lookup !3 !indata ^trty 
       ( ID ^idn  
         ( ":" 
           newvariable !true !idn !indata !trty !toknno
             ^tdata ^thevar ^wasdef ^vartype
           recogtree !0 !1 !thevar !tdata !toknno ^odata ^comp 
           [exptr=<ca thevar <mt comp >>; wasdef=<>]
         | newvariable !false !idn !indata !<tf > !toknno
             ^tdata ^thevar ^wasdef ^vartype
           ( [wasdef=<>; odata=tdata; exptr=thevar]
           | [otherwise; odata=tdata; 
             exptr=<ca thevar <mt <eq wasdef thevar >>>]))
       | newvariable !true !0-1 !indata !trty !toknno ^tdata ^thevar ^wasdef ^vartype
         recogtree !0 !1 !thevar !tdata !toknno ^odata ^comp
         [exptr=<ca thevar <mt comp >>] )
       recvs !formal !odata !<at intree exptr vartype> !toknno ^actual ^outdata
     | [otherwise; outdata=indata; actual=intree])
  -> {synthesized att of function or defined nonterminal}
     [formal:<at nextf vrv tipe >] 
     recvs !nextf !indata !intree !toknno ^xtree ^tdata  "^"
     ( ID ^idn  
       ( ":" 
         newvariable !true !idn !tdata !tipe !toknno ^odata ^thevar ^wasdef ^vartype
         recogtree !0 !1 !thevar !odata !toknno ^outdata ^comp 
         [exptr=<ca thevar <mt comp >>; wasdef=<>]
       | newvariable !true !idn !tdata !tipe !toknno ^odata ^thevar ^wasdef ^vartype
         ( [wasdef=<>; outdata=odata; exptr=thevar]
         | [otherwise; outdata=odata; 
           exptr=<ca thevar <mt <eq wasdef thevar >>>]))
     | newvariable !false !0-1 !tdata !tipe !toknno
         ^odata ^thevar ^wasdef ^vartype
       ( "empty"  [//"attribute type mismatch"//]  lookup !4 !odata ^tipe
         [exptr=<ca thevar <mt <eq thevar <cn tipe >%0 >>>; outdata=odata]
       | recogtree !0 !1 !thevar !odata !toknno ^outdata ^comp 
         [exptr=<ca thevar <mt comp >>]))
     [actual=<at xtree exptr vartype>]
  -> {bottom of known list of synthesized atts}
     [formal=<>; outdata=indata; actual=intree];

action !indata:table !toknno:int ^outdata:table ^outree:tree           {p320}
  -> ID^name             {assigns or asserts or predeclared function call}
     [unpackatts !indata ^inenv ^indef ^redef ^tok ^tran ^hist]
     ( "@" ([notinset !name !redef; asn=true]|[otherwise; asn=false])
       [inset !name !indef] [//"invalid iterator reference"//]
       ([from !name !inenv ^thev:<at ..>]|[from !name !inenv ^thev:<vr ..>]
       |[from !name !inenv ^thev:<sa ..>])
     | ( [notinset !name !indef; asn=true]
         ( [nothere !name !inenv] | [from !name !inenv ^<at ..>]
         | [from !name !inenv ^<vr ..>] )
       | [otherwise; asn=false]) )
     ( [asn=true]
       "=" expn !0 !indata ^tdata ^exptr ^expty
       newvariable !true !name !tdata !expty !toknno ^outdata ^thev ^ovar ^vartype
       ([ovar=<>; outree=<as exptr expty thev >]
       |[otherwise; outree=<as exptr expty ovar >])
     | [from !name !inenv ^fun:<fn inh der>; //"invalid action call"//]
       sends !inh !indata !<> ^sarg ^sdata
       recvs !der !sdata !<> !toknno ^rarg ^outdata
       [outree=<fn sarg rarg >%name]
     | [otherwise; from !name !inenv ^fun; //"invalid assertion"//]
       ([fun:<at ..>]|[fun:<vr ..>]|[fun:<gl ..>]|[fun:<sa ..>]) 
       ( ":" recogtree !0 !1 !fun !indata !toknno ^outdata ^btree 
       | boolex !name !indata ^outdata ^btree)
       [outree=<mt btree >] )
  -> STR^theStrg ^dblQ                             {output text}
     [outdata=indata]
     ( [dblQ=false; theStrg@=0-theStrg] )?
     [outree=<ot >%theStrg]
  -> boolex !0 !indata ^outdata ^btree          {any assertion}
     [outree=<mt btree >]
  -> "//" [outdata=indata; etree=<>]            {error action for failure}
     ( erract !outdata !toknno ^outdata@ ^btree
       [etree@=<ca etree btree >] )$";"
     "//" [outree=<er etree >];

erract !indata:table !toknno:int ^outdata:table ^outree:tree           {p330}
  -> STR^theStrg ^xdblQ            {output text}
     [outdata=indata; outree=<ot >%theStrg]
  -> ID^name              {predeclared function call or assigns only}
     [unpackatts !indata ^inenv ^indef ^redef ^tok ^tran ^hist]
     ( ( "@" [notinset !name !redef; inset !name !indef; tenv=inenv]
         [//"invalid iterator reference"//]
         ( [from !name !tenv ^thev:<at ..>]|[from !name !tenv ^thev:<vr ..>]
         | [from !name !tenv ^thev:<sa ..>])
         [ndef=indef; addset !name !redef ^nred]
       | ( [nothere !name !inenv] 
           ( [toknno=0-1; thev=<vr <>>%name; into !name !inenv !thev ^tenv]
           | [otherwise; inttree !toknno ^toknnot; thev=<sa toknnot <>>%name; 
             into !name !inenv !thev ^tenv] )
         | [tenv=inenv; from !name !tenv ^thev:<at ..>])
         [//"name already defined"//]
         [notinset !name !indef; addset !name !indef ^ndef; nred=redef])
       [packattributes !tenv !ndef !nred !tok !tran !hist ^edata]
       "=" expn !0 !edata ^outdata ^exptr ^expty
       [outree=<as exptr expty thev >]
       ( [from !name !inenv ^iden] ([iden:<vr <>>]|[iden:<sa xtk <>>])
         iden:redecorate !name !expty )?    {I hope this is the same one!}
     | [//"invalid action call"//; from !name !inenv ^fun:<fn inh der>]
       sends !inh !indata !<> ^sarg ^sdata
       recvs !der !sdata !<> !toknno ^rarg ^outdata
       [outree=<fn sarg rarg >%name]);

recogtree !path:int !depth:int !root:tree !indata:table !toknno:int    {p340}
  ^outdata:table ^exptree:tree  {*** limit depth to 32 bits ***}
  -> ".." lookup !2 !indata ^exptype  {don't care; return true}
     [outdata=indata; exptree=<cn exptype >%1]
  -> {name of a subtree within angle brackets}
     ID ^idn  lookup !3 !indata ^tipe
     newvariable !true !idn !indata !tipe !toknno
       ^tdata ^thevar ^wasdef ^vrtyp
     [inttree !path ^pathtree; inttree !0 ^compare]
     [rtTree=<rt root pathtree compare thevar >]
     ( [wasdef=<>]
       ( ":" recogtree !path !depth !root !tdata !toknno ^outdata ^comp 
         [exptree=<an rtTree comp >]
       | [exptree=rtTree; outdata=tdata] )
     | [otherwise; exptree=<an rtTree <eq wasdef thevar >>; outdata=tdata] )
  -> "<>"  {empty tree}
     [inttree !path+9*depth ^pathtree; inttree !-1 ^compare]  {9 sb 10??}
     [outdata=indata; exptree=<rt root pathtree compare <>>]
  -> "<" ID ^idn           {might could take variable node name?  maybe later}
     [//"invalid node name"//]
     lookup !idn !indata ^<co ..>
     [inttree !path+9*depth ^pathtree; inttree !idn ^compare] {9 sb 10??}
     [subtr=<rt root pathtree compare <>>; edata=indata; index=1]
     ( recogtree !path+index*depth !depth*10 !root !edata !toknno ^edata@ ^etree
       [subtr@=<an subtr etree >; index@=index+1] )* ">" 
     ( "%" ID ^idt   lookup !3 !indata ^ttipe
       newvariable !false !idt !edata !ttipe !toknno ^edata@ ^thevar ^wasdef ^vrtyp
       [inttree !path+8*depth ^decorpath; wasdef=<>]
       [subtr@=<an subtr <rt root decorpath compare thevar >>] )?
     [exptree=subtr; outdata=edata];

boolex !iname:int !indata:table ^outdata:table ^exptree:tree           {p350}
  -> "otherwise"
        [//"syntax error"//; iname=0] lookup !2 !indata ^exptype
        [outdata=indata; exptree=<cn exptype >%1]
  -> expn !iname !indata ^outdata ^exptree ^exptype
     lookup !2 !outdata ^exptype;

expn !iname:int !indata:table                                          {p360}
    ^outdata:table ^exptree:tree ^exptype:tree
  -> boolterm !iname !indata ^outdata ^exptree ^xtype
     ( ( "`" boolterm !0 !outdata ^outdata@ ^btree ^otype        {or}
         checktype !2 !otype !indata  lookup !2 !indata ^exptype
         [exptree@=<or exptree btree >])+
     | [exptype=xtype]);

boolterm !iname:int !indata:table                                      {p370}
    ^outdata:table ^exptree:tree ^exptype:tree
  -> boolfact !iname !indata ^outdata ^exptree ^xtype
     ( ( "&" boolfact !0 !outdata ^outdata@ ^btree ^atype        {and}
         checktype !2 !atype !indata  lookup !2 !indata ^exptype
         [exptree@=<an exptree btree >] )+
     | [exptype=xtype] );

boolfact !iname:int !indata:table                                      {p380}
    ^outdata:table ^exptree:tree ^exptype:tree
  -> {not} "~"  [iname<1]  boolfact !iname !indata ^outdata ^btree ^exptype
     checktype !2 !exptype !outdata  [exptree=<no btree >]
  -> sexpn !iname !indata ^edata ^etree ^etype
     ( ( "=" sexpn !0 !edata ^outdata ^btree ^rExpType
         [exptree=<eq etree btree >]
       | "<" sexpn !0 !edata ^outdata ^btree ^rExpType
         [exptree=<ls etree btree >]
       | ">" sexpn !0 !edata ^outdata ^btree ^rExpType
         [exptree=<gr etree btree >]
       | "#" sexpn !0 !edata ^outdata ^btree ^rExpType
         [exptree=<ne etree btree >] )
       sameType !etype !rExpType  lookup !2 !outdata ^exptype
     |  [exptree=etree; exptype=etype; outdata=edata] );

sexpn !iname:int !indata:table ^outdata:table                          {p390}
    ^exptree:tree ^exptype:tree
  -> ( [iname<1] "+" term !iname !indata ^outdata ^exptree ^extype
       checktype !1 !extype !outdata  lookup !1 !indata ^xtype
     | [iname<1] "-" term !iname !indata ^outdata ^etree ^extype
       checktype !1 !extype !outdata  lookup !1 !indata ^xtype
       [exptree=<ng etree >]
     | term !iname !indata ^outdata ^exptree ^xtype)
     ( ( "+" term !0 !outdata ^outdata@ ^etree ^pltype
         checktype !1 !pltype !outdata@  lookup !1 !indata ^exptype
         [exptree@=<ad exptree etree >]
       | "-" term !0 !outdata ^outdata@ ^etree ^mntype
         checktype !1 !mntype !outdata@  lookup !1 !indata ^exptype
         [exptree@=<su exptree etree >])+
     | [exptype=xtype] );

term !iname:int !indata:table                                          {p400}
    ^outdata:table ^exptree:tree ^exptype:tree
  -> fact !iname !indata ^outdata ^exptree ^extype
     ( ( "*" fact !0 !outdata ^outdata@ ^etree ^xtype
         checktype !1 !xtype !outdata@  lookup !1 !indata ^exptype
         [exptree@=<mp exptree etree >]
       | "/" fact !0 !outdata ^outdata@ ^etree ^xtype
         checktype !1 !xtype !outdata@  lookup !1 !indata ^exptype
         [exptree@=<dv exptree etree >]
       | "\" fact !0 !outdata ^outdata@ ^etree ^xtype   {mod}
         checktype !1 !xtype !outdata@  lookup !1 !indata ^exptype
         [exptree@=<md exptree etree >] )+
     | [exptype=extype] );

fact !iname:int !indata:table                                          {p410}
    ^outdata:table ^exptree:tree ^exptype:tree
  -> ":" [//"syntax error"//; iname>0]      {named tree}
     fact !0 !indata ^data ^etree ^exptype
     [unpackatts !data ^env ^defd ^redef ^tok ^tran ^hist]
     [//"tree name already defined"//]
     [notinset !iname !defd; addset !iname !defd ^outdef]
     ( [nothere !iname !env; thev=<vr exptype >%iname; 
       into !iname !env !thev ^outenv]
     | [otherwise; outenv=env; //"invalid node name"//]
       [from !iname !env ^thev:<at lnk vrv exptype >] )
     [//"invalid named tree expression"//]
     [from !3 !outenv ^exptype; from !iname !outenv ^ref]
     [packattributes !outenv !outdef !redef !tok !tran !hist ^outdata]
     [exptree=<ca <as etree exptype thev > ref >]
  -> [iname>0]  factName !iname !indata ^outdata ^exptree ^exptype
  -> "<>" [//"syntax error"//; iname<1]     {empty tree}
        [outdata=indata] lookup !3 !indata ^exptype [exptree=<bt <> <>>]
  -> "<" [//"syntax error"//; iname<1] lookup !3 !indata ^exptype
     [//"invalid node name"//]
     ID ^idn  lookup !idn !indata ^<co ..>
     [subtrees=<bt <> <>>; edata=indata; index=1; decor=<bt <> <>>]
     ( fact !0 !edata ^edata@ ^etree ^factType            {*** not LL(1) ***}
       sameType !exptype !factType
       [subtrees@=<ca subtrees etree >%index; index@=index+1])* ">"
     ( "%" sexpn !0 !edata ^edata@ ^dtree ^etype
       [decor@=<nn dtree etype exptype >])?
     [exptree=<bt subtrees decor >%idn; outdata=edata]
  -> "false"
     [//"syntax error"//; iname<1] lookup !2 !indata ^exptype
     [outdata=indata; exptree=<cn exptype >%0]
  -> "true"
     [//"syntax error"//; iname<1] lookup !2 !indata ^exptype
     [outdata=indata; exptree=<cn exptype >%1]
  -> "empty"
     [//"syntax error"//; iname<1] lookup !4 !indata ^exptype
     [outdata=indata; exptree=<cn exptype >%0]
  -> "vacant"
     [//"syntax error"//; iname<1] lookup !5 !indata ^exptype
     [outdata=indata; exptree=<cn exptype >%0]
  -> NUM ^value
     [//"syntax error"//; iname<1] lookup !1 !indata ^exptype
     [outdata=indata; exptree=<cn exptype >%value]
  -> ID ^name  [//"syntax error"//; iname<1]
     [unpackatts !indata ^env ^defd ^redef ^tok ^tran ^hist]
     ( "@" [//"invalid use of iterator"//; inset !name !redef]
     | [//"invalid use of iterator"//; notinset !name !redef])
     ( [iname=0]  fact !name !indata ^outdata ^exptree ^exptype
     | [otherwise]  factName !name !indata ^outdata ^exptree ^exptype )
  -> "(" [iname<1] expn !0 !indata ^outdata ^exptree ^exptype ")";
 
factName !iname:int !indata:table                                      {p420}
  ^outdata:table ^exptree:tree ^exptype:tree
  -> [outdata=indata]
     [unpackatts !indata ^env ^defd ^redef ^tok ^tran ^hist]
     [from !iname !env ^exptree]
     [//"undefined identifier"//; inset !iname !defd]
     [//"invalid identifier in expression"//]
     ( [exptree:<at lnk vrv exptype >] | [exptree:<vr exptype>]
     | [exptree:<gl exptype>] | [exptree:<sa xtk exptype>] );

newvariable !chktyp:bool !name:int !indata:table !tipe:tree            {p430}
    !toknno:int ^outdata:table ^thevar:tree ^oldvar:tree ^vartype:tree
  {Processes an undefined attribute receiving a value or a defined attribute}
  {whose value is being asserted.}
  -> [name<0]
     [unpackatts !indata ^inenv ^indef ^redef ^tok ^tran ^hist]
     [idn=hist+1]
     [packattributes !inenv !indef !redef !tok !tran !idn ^outdata]
     [thevar=<tv tipe >%idn; oldvar=<>; vartype=tipe]
  -> {variable being assigned to, att being synthesized by fn or nt call,}
     {or tree being recognized by nt "recogtree" }
     [name>0; unpackatts !indata ^inenv ^indef ^redef ^tok ^tran ^hist]
     ( "@"                           {** what about call from assignment? **}
       [//"invalid iterator reference"//; inset !name !indef]
       ( [from !name !inenv ^avar:<at lnk xvrv exty>]
       | [from !name !inenv ^avar:<vr exty>]
       | [from !name !inenv ^avar:<sa xtk exty>])
       ( [chktyp=true; //"attribute type mismatch"//] sameType !tipe !exty )?
       ( [inset !name !redef; oldvar=avar] 
         newvariable !chktyp !0-1 !indata !exty !toknno
             ^outdata ^thevar ^xvar ^vartype
       | [otherwise; addset !name !redef ^nred]
         [packattributes !inenv !indef !nred !tok !tran !hist ^outdata]
         [thevar=avar; oldvar=<>]
         ( [exty#<>; vartype=exty] | [otherwise; vartype=tipe] ) )
     | {not a redefine}
       ( [inset !name !indef]
         ( [from !name !inenv ^oldvar:<at lnk xvrv exty>]
         | [from !name !inenv ^oldvar:<vr exty>]
         | [from !name !inenv ^oldvar:<sa xtk exty>])
         ( [chktyp=true; //"attribute type mismatch"//]
           sameType !tipe !exty)?
         newvariable !chktyp !0-1 !indata !exty !toknno ^outdata ^thevar ^xvar ^vartype
       | [otherwise; addset !name !indef ^ndef; oldvar=<>]
         ( [nothere !name !inenv; vartype=tipe] 
           ( [toknno=0-1; thevar=<vr tipe>%name; into !name !inenv !thevar ^tenv]
           | [otherwise; inttree !toknno ^toknnot; thevar=<sa toknnot tipe>%name; 
             into !name !inenv !thevar ^tenv])
           [exty=tipe; packattributes !tenv !ndef !redef !tok !tran !hist ^outdata]
         | [otherwise; tenv=inenv]
           ( [from !name !tenv ^thevar:<at lnk vrv vartype >]
           | [from !name !tenv ^thevar:<vr vartype >] )
           [packattributes !tenv !ndef !redef !tok !tran !hist ^outdata]
           ( [chktyp=true; //"attribute type mismatch"//]
             sameType !tipe !vartype )? )))
  -> {doubt this is ever used}
     [otherwise]  {name=0}
     ID^idn 
     newvariable !chktyp !idn !indata !tipe !toknno ^outdata ^thevar ^oldvar ^vartype;

lookup !name:int !data:table ^value:tree                               {p440}
  -> [unpackatts !data ^env ^defd ^redef ^tok ^tran ^hist]
     [from !name !env ^value];

checktype !mustbe:int !typ:tree !data:table                            {p450}
  -> [//"wrong type"//] lookup !mustbe !data ^typ;

sameType !lType:tree !rType:tree                                       {p460}
  -> [lType:<tf >]
     ( [rType:<tf >]
     | [rType:<ty >%typeNumT; treeint !typeNumT ^typeNum]
       lType:redecorate !typeNum !<> )
  -> [rType:<tf >; lType:<ty >%typeNumT; treeint !typeNumT ^typeNum]
       rType:redecorate !typeNum !<>
  -> [lType:<ty >%lTypeNumT; treeint !lTypeNumT ^typeNum]
     [rType:<ty >%rTypeNumT; treeint !rTypeNumT ^typeNum] ;

datamerge !ldata:table !rdata:table ^outdata:table                     {p470}
  -> [unpackatts !ldata ^inenv ^indef ^redef ^tok ^tran ^hist]
     [unpackatts !rdata ^xenv ^xdef ^xred ^xtok ^xtran ^xhist]
     [packattributes !inenv !indef !redef !xtok !xtran !xhist ^outdata];

uniqueset !oldlist:tree !theset:set ^setno:int ^newlist:tree         {p480}
{find or create a set item in the list, =theset, return index}
  -> [currsett=oldlist; newlist=oldlist; setno=0; settree !theset ^asett]
     ( [asett#<>]
       ( [currsett:<no link tset >%ixt; treeset !tset ^currset]
         [currsett@=link; difference !theset !currset ^dif1]
         [difference !currset !theset ^dif2]
         ( [dif1=dif2; treeint !ixt ^ixn; setno@=ixn; currsett@=<>])? )*
       ( [setno=0]  
         ( [oldlist:<no ..>%lxt; treeint !lxt ^lxn] | [otherwise; lxn=0])
         [setno@=lxn+1; newlist@=<no oldlist asett >%lxn+1])? )?;

scannerform !thelist:tree !defalts:set !inchs:tree                     {p490}
    ^chrsets:tree ^outacts:tree ^actno:int ^matchtoks:tree ^goalname:tree
  -> [thelist:<tr link frtree totree ontree acts >; elt=0; nelts=0]
     [treeset !ontree ^onset; unset=onset; treeset !<> ^emty]
     ( [onset#emty] 
       ( [elt<256] 
         ( [inset !elt !onset; nelts@=nelts+1]
           ( [notinset !elt+1 !onset; elt@=260])? )?
         [elt@=elt+1] )* )?
     ( [nelts<64; difference !defalts !onset ^redefs]
     | [otherwise; redefs=defalts] )
     [alist=inchs; nxlist=inchs]
     ( [onset#emty; alist:<no slink tset >%ixt; treeset !tset ^aset]
       [difference !onset !aset ^dif1; difference !aset !onset ^dif2]
       [intersect !onset !aset ^dif0; onset@=dif1; nlist=slink]
       ( [dif2#emty&dif2#aset; nlist@=alist]  alist:deleteitem
         uniqueset !nxlist !dif0 ^setn0 ^xlist
         uniqueset !xlist !dif2 ^setn2 ^nxlist@ )?
       [alist@=nlist] )* 
     uniqueset !nxlist !onset ^setn1 ^inchex
     scannerform !link !redefs !inchex
         ^chrsets ^inacts ^nactn ^matchtoks ^goalname
     [csets=chrsets]
     ( [acts=<>; actno=nactn; outacts=inacts; actor=0]
     | [otherwise; actno=nactn+1; actor=actno]
       [outacts=<no inacts <no <> acts >%actno >%actno] )
     {following line assumes that if you're using 64 or more characters,}
     {you want all the "other" ones, too                                }
     ( [nelts<64; bset=emty]|[otherwise; addset !0 !emty ^bset] )
     ( [csets:<no clink csett >%cnot; treeint !cnot ^cno]
       [treeset !csett ^cset; csets@=clink]
       [intersect !unset !cset ^qset]
       ( [qset#emty; addset !cno !bset ^nset; bset@=nset])? )*
     [treeint !frtree ^frosty; treeint !totree ^tosty]
     [nothertran !frosty !tosty !bset !actor]

  -> [thelist:<tk link frtree nmtree >%acts]
     scannerform !link !defalts !inchs
       ^chrsets ^inacts ^nactn ^machs ^goalname
     ( ( [nmtree:<no ..>; acts:<tk ders >%tokno]
         [matchtoks=<tk machs frtree nmtree >%acts]
       | [nmtree:<st>%tokno; ders=<>; matchtoks=machs] )
       [treeset !<> ^emty; addset !3 !emty ^cset; actno=nactn+1]
       [outacts=<no inacts <no <> <tr ders >%tokno >%actno >%actno]
       [treeint !frtree ^frosty; treeint !tokno ^tokn]
       [nothertran !frosty !0 !cset !actno]
     | [otherwise; matchtoks=machs; actno=nactn; outacts=inacts] )

  -> [thelist:<no link>]            { header node for the transition list}
     scannerform !link !defalts !inchs
       ^chrsets ^outacts ^actno ^matchtoks ^goalname
 
  -> [thelist:<nt link ontree >%name]
     scannerform !link !defalts !inchs
       ^chrsets ^outacts ^actno ^matchtoks ^gname
     [tempname=<>]  ( [tempname@=gname] )?
     ( [tempname=<>; goalname=name] | [otherwise; goalname=gname] )?
       
  -> [thelist:<nc link ontree >]
     scannerform !link !defalts !inchs
       ^chrsets ^outacts ^actno ^matchtoks ^goalname

  -> [thelist=<>; matchtoks=<>; goalname=<>]
     [treeset !<> ^emty; addset !0 !emty ^rets; ones=inchs]
     [addset !32 !emty ^spas; settree !rets ^rett]
     {***26 Mar 1993 - possibly don't need to add 256 to mgss below?}
     [addset !256 !emty ^mgss; settree !mgss ^mgst]
     [settree !spas ^spat; settree !defalts ^deset]
     [csets=<no <no <no <no <> deset >%0 rett >%1 spat >%2 mgst >%3]
     ([ones:<no olink osett >; ones@=olink; treeset !osett ^oset] 
      uniqueset !csets !oset ^nsetx ^csets@ )*
     [chrsets=csets]
     { action 1 sets badChar flag; token 1 is reserved for use in flatten }
     [actno=1; outacts=<no <> <no <> <tr <>>%1 >%actno >%actno]
     [addset !0 !emty ^defsetnum; nothertran !0 !0 !defsetnum !actno];

findcycle !transIndex:int !headst:int !here:int !looky:set             {p500}
{if you find an empty to headst, convert all statenos of trans }
{ in looky to headst; if from=to then delete; err if acts#<>}
  -> [flist=transIndex; addset !here !looky ^looking; treeset !<> ^mtset]
     ( [getatran !flist ^foundtran ^frono ^tono ^chrs ^acts ^flist@]
       ( [frono=here&chrs=mtset]          {flist,frono,tono,looking}
         ( [tono=headst; alist=-1]
           ( [getatran !alist ^fndtran ^afro ^ato ^achrs ^acta ^alink]
             [rev=false]                 {##alist,afro,ato,achrs}
             ( [inset !afro !looking; afro@=headst; rev@=true])?
             ( [inset !ato !looking; ato@=headst; rev@=true])?
             ( [ato=afro&achrs=mtset; fixatran !fndtran !-1 !-1 !mtset !-1]
               [//"Empty cycle action"//; acta=0]
             | [rev=true; fixatran !fndtran !afro !ato !achrs !acta] )
             [alist@=alink])*
         | [notinset !tono !looking]
           findcycle !-1 !headst !tono !looking ))? )* ;

matchlist !atree:tree !btree:tree  {fails if different}                {p510}
  ->  [atree=btree]
  ->  [atree:<no alnk acode >%adec; treeint !adec ^anum]
      [btree:<no blnk bcode >%bdec; treeint !bdec ^bnum]
      [anum=bnum]  matchlist !alnk !blnk;

cataction !oldact:tree !act1:int !act2:int ^act3:int ^newact:tree     {p520}
{find or create action list act1;act2 (no dupes), return id# tree}
  -> [alist=oldact; blist=oldact; newact=oldact; sub1=<>; sub2=<>]
     [got=false; hino=0]
     ( [act1=0; act3=act2]
     | [act2=0; act3=act1]
     | ( [alist:<no alnk aseq >%axt; treeint !axt ^axn]
         ([act1=axn; sub1@=aseq])? ([act2=axn; sub2@=aseq])?
         ([hino<axn; hino@=axn])?  [alist@=alnk])*
       sub1:catlist !sub2 ^sub3 
       ( [blist:<no blnk bseq >%bxt; blist@=blnk; treeint !bxt ^bxtn]
         (matchlist !sub3 !bseq [act3=bxtn; blist@=<>; got@=true])? )*
       ( [got=false; act3=hino+1]
         [newact@=<no oldact sub3 >%act3])? );

buildscanner !indata:table                                             {p530}
  ^highstate:int ^hicharset:int ^goalname:int
  -> [unpackatts !indata ^env ^indef ^inred ^intok ^intran ^inhist]
     ["CONST MuchTooBig=132000;TableHigh=32767;"; ascii!0]
     ["TYPE BigRange=[0..MuchTooBig];TableRange=[0..TableHigh];"]
     ["transType=RECORD action,nextState:TableRange END;"]
     ["StateTableAry=ARRAY BigRange OF transType;"]
     ["StateTable=POINTER TO StateTableAry;"; ascii!0]
     ["VAR badChar:BOOLEAN;ncharsets:CARDINAL;"]
     ["CurrentState:INTEGER;"]
     ["scannextch:CHAR;StateTablePtr:StateTable;"]
     ["charClass:ARRAY CHAR OF INTEGER;"]
     [treeset !<> ^mtset; allset=mtset; tch=1]
     ( [tch<256; nch=tch; tch@=tch+1]
       ( [nch#32&(nch<8`nch>13); addset !nch !allset ^allset@])? )*
     [initScannerStuff]
     scannerform !intran !allset !<>
       ^chrsets ^actsets ^actnx ^matchtoks ^goalnamet
     [treeint !goalnamet ^goalname]
     [initTransIndex=-1]
{@}  [atran=initTransIndex; change=true]   {actsets...}
     actsets:findvars !env !mtset ^xset
     ["errno:INTEGER;"; ascii!0]
     ["PROCEDURE NewStateTable(nitems:BigRange);"; ascii!0] {generic}
     ["VAR ix:BigRange;"; ascii!0]
     ["BEGIN NEW(StateTablePtr);"]
     ["FOR ix:=0 TO MuchTooBig DO StateTablePtr^[ix].action:=0;"]
     ["StateTablePtr^[ix].nextState:=0 END "]
     ["END NewStateTable;"; ascii!0]
     ["PROCEDURE doerr;VAR ok:BOOLEAN;"]
     ["BEGIN ok:=TRUE;CASE errno OF 0:|"]
     actsets:finderrs !env !1 ^lasterr
     ["END;IF errno>0 THEN abortit ELSE errno:=0 END END doerr;"]
     {remove empty cycles}
     ( [getatran !atran ^fdtran ^cyc0 ^cyc1 ^chrs1 ^acts1 ^link1]
       ( [chrs1=mtset]  findcycle !link1 !cyc0 !cyc1 !mtset )?
       [atran@=link1])*

     {remove empty moves, transfer action to successor moves}
{~}  ( [change=true; change@=false; btran=initTransIndex] 
       ( [getatran !btran ^foundit ^from3n ^froto ^chrs3 ^acts3 ^link3]
         ( [chrs3=mtset; ctran=initTransIndex; change@=true; chng=false] 
           ( [getatran !ctran ^fndit ^tofro ^tost4n ^chrs4s ^acts4 ^ctran@]
             ( [froto=tofro]
               cataction !actsets !acts3 !acts4 ^acts34 ^actsets@
               ( [chng=false]
                 [fixatran !foundit !from3n !tost4n !chrs4s !acts34]
               | [otherwise] 
                 [nothertran !from3n !tost4n !chrs4s !acts34] )
               [chng@=true])? )* )?
         [btran@=link3])* )*

     {convert to dfsm (no reduce)}
{ }  [chrsets:<no ..>%hinot; treeint !hinot ^hino; nxchs=chrsets]
     [newsetlist ^stsets; newnewset !stsets ^firstset]
     [addnewset !0 !firstset; doing=firstset; lastset=firstset]
     [more=true; newsetlist ^usacts]
     ( [more=true; more@=false; alln=0]   {:doing,alln}
       ( [alln<hino+1; oldtr=initTransIndex; newnewset !stsets ^alls]
         [newnewset !usacts ^user]
         ( [getatran !oldtr ^realtr ^frstn ^dest ^chrs8s ^actor ^oldtr@]
           ( [inset !alln !chrs8s; newinset !frstn !doing]
             ( [actor#0; addnewset !actor !user])?
             [addnewset !dest !alls])? )*
         [uniquenew !alls ^destn] ([lastset<destn; lastset@=destn])?
         [uniquenew !user ^actno]
         ( [destn>firstset; dests=(destn-firstset)/4]
         | [otherwise; dests=0])
         ( [dests>0`actno>3; "(*"; number!(doing-firstset)/4]
           [","; number!dests; ","; number!alln; ","]
           [number!actno/4; "*)"; ascii!0]
           [notherdetran !(doing-firstset)/4 !(destn-firstset)/4 !alln !actno] )?
         [alln@=alln+1])*
{n}    ( [lastset>doing; more@=true; doing@=doing+4])? )*

     {transmogrify halt/block transitions}
{^}  [etran=-1]
     ( [getadetran !etran ^founddetr ^frost ^tost5 ^ch5 ^acts5 ^link5]
       ( [ch5=3; ftran=-1; gtran=-1; chg=false; nset=mtset]
         ( [getadetran !ftran ^fndx ^from6 ^tosey ^ch6 ^acts6 ^ftran@]
           ( [frost=from6&tosey#tost5; addset !ch6 !nset ^mset; nset@=mset])? )*  
         ( [getadetran !gtran ^fdx ^froy ^tost7n ^ch7 ^acts7 ^gtran@]
           ( [froy=tost5; notinset !ch7 !nset]
             [newunion !acts5 !acts7 ^acts57]
             ( [chg=false; chg@=true]
               [fixadetran !founddetr !frost !tost7n !ch7 !acts57]
             | [notherdetran !frost !tost7n !ch7 !acts57] ))? )*
         ( [chg=false; fixadetran !founddetr !-1 !0 !0 !0] )? )?
       [etran@=link5] )*

     {output dfsm}
{%}  ["PROCEDURE scanstateitem(st:INTEGER;ch:CARDINAL;ac,ns:INTEGER);"; ascii!0]
     ["VAR ix:BigRange;"; ascii !0]
     ["BEGIN ix:=st;ix:=ix*ncharsets+ch;StateTablePtr^[ix].action:=ac;"]
     ["StateTablePtr^[ix].nextState:=ns END scanstateitem;"; ascii!0]
     ["PROCEDURE ScannerFill;VAR ix:CHAR;BEGIN"; ascii!0]
     ["(* fromState, onChar, action, toState *)"; ascii!0]
     [htran=-1]
     ( [getadetran !htran ^fx ^frost8 ^tost8 ^ch8 ^acts8 ^htran@]
       ( [tost8>0`acts8>3; "  scanstateitem(("; number!frost8; "),"]
         [number!ch8; ","; number!acts8/4; ","; number!tost8; ");"]
         [ascii!0])? )*

     {output rest of scanner code}
{"}  ["FOR ix:=CHR(0)TO CHR(255)DO charClass[ix]:=0 END;"]
     ["FOR ix:=CHR(8)TO CHR(12)DO charClass[ix]:=2 END;"]  { :=6; }
     ["charClass[CHR(13)]:=1;"]
     ( [nxchs:<no nxlnk achsett >%setnt; treeint !setnt ^setno]
       [nxchs@=nxlnk; ixc=0; treeset !achsett ^achset]  
       ( [ixc<256]  ( [setno>0; inset !ixc !achset; "charClass[CHR("]
           [number!ixc; ")]:="; number!setno; ";"; ascii!0])?
         [ixc@=ixc+1])* )*
     ["END ScannerFill;"; ascii!0]
     ["PROCEDURE Getoken;VAR ix:INTEGER;ok:BOOLEAN;"]
     ["BEGIN ok:=TRUE;errno:=0;IF Debugging THEN sWriteC('"; ascii!34; "')END;"]
     ["NexToken:=0;REPEAT LastCharacter:=scannextch;"]
     ["IF LastCharacter>CHR(0)THEN sWriteC(LastCharacter) END;"]
     ["IF badChar THEN NexToken:=-1 ELSE "]
     ["ix:=CurrentState*"; number!(hino+1); ";"]
     ["IF EOF()THEN scannextch:=CHR(0);badChar:=TRUE "]
     ["ELSE IF EOLN() THEN READLN;"]
     ["scannextch:=CHR(0) ELSE READ(scannextch)END;"]
     ["ix:=ix+charClass[scannextch];"]
     ["CurrentState:=StateTablePtr^[ix].nextState;END;"]
     ["CASE StateTablePtr^[ix].action OF"; ascii!0]
     [newnewset !usacts ^usual; using=usual]
     ( [using>usacts; number!using/4; ": "; gots=mtset]
{:}    [aclist=actsets; hitok=0; toktr=<>]
       ( [aclist:<no aclnk actup >%listr; treeint !listr ^lino]
         ( [newinset !lino !using]
           ( [actup:<no zlnk coder >%itmt; treeint !itmt ^item]
             ( [coder:<tr ..>%tkno; treeint !tkno ^tknn; tknn>1]
               ( [tknn>hitok; hitok@=tknn; toktr@=coder] )?
             | [notinset !item !gots]  coder:flatten !env  
               [";"; addset !item !gots ^git; gots@=git])?
             [actup@=zlnk])* )?
         [aclist@=aclnk])*
       ( [hitok>0; ";"]  toktr:flatten !env )?
       ["|"; ascii!0; using@=using-4])*
     ["0:END END UNTIL NexToken<>0;"]
     ["IF Debugging THEN IF NexToken<0 "]
     ["THEN sWriteS('"; ascii!34; " ?? ')ELSE sWriteC('"]
     [ascii!34; "')END END END Getoken;"; ascii!0]
     ["PROCEDURE InitializeScanner;BEGIN badChar:=FALSE;"]
     ["ncharsets:="; number!hino+1; ";"]
     ["scannextch:=CHR(0);LastCharacter:=CHR(0);"]
     ["CurrentState:=0;NewStateTable("]
     [number!(doing+1)*(hino+1)*2; ");ScannerFill;"]
     ["NEW(StringTable);StringTable^[0]:=CHR(0);"]
     ["EndStrings:=1;Getoken END InitializeScanner;"; ascii!0]
     ["PROCEDURE MatchToken(tkno:INTEGER):BOOLEAN;"]
     ["BEGIN IF tkno=NexToken THEN Getoken;Taken:=Taken+1;"]
     ["RETURN TRUE ELSE RETURN FALSE END END MatchToken;"; ascii!0]
     ( [matchtoks:<tk klnk ontree <no >%tknam >%entry]  {/ders}
       [entry:<tk ders >%tokno]
       [treeint !tokno ^tokn; treeint !tknam ^toknam]
       ["PROCEDURE MatchTok"; number!tokn; "("]
       ( [ders#<>]  ders:paramlist !true !false ^osemi )?
       ["):BOOLEAN;"]
       ["BEGIN IF NexToken="; number!tokn; " THEN "]
       ( [ders:<at dlnk vrv vty >%namt; ders@=dlnk]
         ["at"; treeint !namt ^name; spell!name; ":=sa"]
         [number!tokn; spell!name; ";"; ascii!0])*
       ["IF Debugging THEN sWriteS('="; spell!toknam; "');"]
       ders:showdeprams   ["sWriteLn END;"; ascii!0]
       ["Getoken;Taken:=Taken+1;RETURN TRUE"; ascii !0]
       ["ELSE RETURN FALSE END END MatchTok"; number!tokn; ";"]
       [ascii!0; matchtoks@=klnk])*
     [hicharset=hino; highstate=doing];

buildparser !indata:table ^outdata:table                               {p540}
  -> [outdata=indata]
     [unpackatts !indata ^inenv ^indef ^inred ^intok ^intran ^inhist]
     intran:checkntcalls !inenv;

startoutput !name:int                                                  {p550}
  -> ["MODULE "; spell !name; ";"; ascii!0]
     ["FROM Storage IMPORT ALLOCATE;"; ascii!0]
     ["FROM TagIO IMPORT EOF, EOLN, READ, READLN, "]
     ["sWriteB, sWriteC, sWriteI, sWriteS, sWriteLn,"]
     ["writeC, writeI, writeS, writeLn;"; ascii!0]
     ["FROM TagLib IMPORT abortit, build, Debugging, EndStrings, "]
     ["fnaddnewset, fnaddset, fnaddtbl, fnascii, "]
     ["fnbooltree, fncharfrom, fncharval, fndifference, "]
     ["fnfixadetran, fnfixatran, fnfrom, fngetadetran, fngetatran, "]
     ["fninitbl, fninitScannerStuff, fninset, fnintersect, fninto, fninttree, "]
     ["fnlength, "]
     ["fnnewelt, fnnewinset, fnnewnewset, fnnewsetlist, fnnewunion, "]
     ["fnnotherdetran, fnnothere, fnnothertran, fnnotinset, fnnumber, "]
     ["fnpackattributes, "]
     ["fnsettree, fnspell, fnstrindex, "]
     ["fntreeint, fntreeset, fntreetab, fnunion, fnuniquenew, fnunpackatts, "]
     ["inttree, LastCharacter, NexToken, replacetree, "]
     ["ShoBOOLEAN, ShoINTEGER, Shotable, Shotree, StringTable, SyntaxError, "]
     ["table, TagBegin, TagEnd, Taken, tree, treepart, treetree;"; ascii!0]
     ["FROM TagStack IMPORT pop, push;"; ascii!0];

finishoutput !tagname:int !goalname:int                                {p560}
  -> ["  BEGIN IF TagBegin() THEN InitializeScanner;"]
     ["IF nt"; spell !goalname; "()"]
     ["THEN sWriteS('Success')ELSE sWriteS('Failed')END; TagEnd"]
     [" END END"; ascii !0; "  "; spell !tagname; "."];

globalname !name:int !itstype:tree                                     {p570}
  -> ["v"; spell !name; ":"] itstype:showtype [";"];

dolibrary !env:table                                                   {p580}
  -> {output the predefined routines};

makeforward !name:int !env:table                                       {p590}
    !inh:tree !der:tree !tgf:int !addForward:bool
  -> ["PROCEDURE nt"; spell !name]
     ( [inh:<>; der:<>; tgf=0; "()"]
     | [inh:<>; der:<>; tgf=1; "(thetree:tree)"]
     | [otherwise; "("]
       inh:paramlist !false !false ^isemi
       der:paramlist !true !isemi ^dsemi
       ( [tgf=1; ";thetree:tree)"]|[tgf=0; ")"] ) )
     [":BOOLEAN;"]
     ( [addForward=true; "FORWARD;"] )?
     [ascii!0];

shovarType !tytoo:bool !vty:tree !needsem:bool                         {p600}
  -> ( [tytoo=true; ":"] vty:showtype ( [needsem=true; ";"] )? )?;


                                  transformer

newtran !fromst:int !tost:int !onch:set !actn:tree !tokn:int           {t002}
  -> <no intran>
     [inttree !fromst ^frtree; inttree !tost ^totree; settree !onch ^ontree]
  => <no <tr intran frtree totree ontree actn>%tokn >;
  
newtranNT !nonterm:tree !name:int                                      {t004}
  -> <no intran>
  => <no <nt intran nonterm >%name >;

newtranTK !fromstate:tree !strng:int !tokendef:tree                    {t006}
  -> <no intran>
  => <no <tk intran fromstate <st>%strng >%tokendef >;

newtranTkNo !fromstate:int !noname:int !tokendef:tree                  {t008}
  -> <no intran> [inttree !fromstate ^fromstatet]
  => <no <tk intran fromstatet <no>%noname >%tokendef >;
  
newnonterminalcall !newnonterm:tree                                    {t009}
  -> <no intran >
  => <no <nc intran newnonterm > >;

redecorate !decor:int !subtree:tree                                    {t010}
  -> <vr ..>
  => <vr subtree >%decor
  -> <tk ..>
  => <tk subtree >%decor
  -> <nt ..>
  => <nt subtree >%decor
  -> <tv ..>
  => <tv subtree >%decor
  -> <sa toknno xtyp>
  => <sa toknno subtree>%decor
  -> <tr link fromst tost chrs acts > 
       [inttree !decor ^atree]
  => <tr link atree subtree chrs acts >
  -> <tf ..>
  => <ty >%decor ;

ntfill !filltree:tree                                                  {t020}
  { fills in information on a nonterminal after it is in the symbol table }
  -> <nt <> codetree >%name
  => <nt filltree codetree >%name
  -> <nt <no inh der >%tipe <> >%name
  => <nt <no inh der >%tipe filltree >%name;

isdefined !defset:set                                                  {t030}
  -> <at nextu vrv tipe >%idnt [treeint !idnt ^idn]
     nextu:isdefined !defset
     [//"undefined attribute "; spell !idn //; inset !idn !defset]
  -> <>;
  
checkntcalls !env:table                                                {t040}
  -> ( <tr link fst tst chs act > | <tk link fst chs > | <no link> )
     link:checkntcalls !env
  -> <nc link <nt snd rcv trn >%namet >
     [treeint !namet ^name]
     [//"not a nonterminal: "; spell !name //]
     [from !name !env ^<nt <no inh der >%tgft rightp >]
     [treeint !tgft ^tgf]
     ( [trn=<>; //spell !name; " is not a parser nonterminal"//]
       [tgf=0]
     | [trn#<>; //spell !name; " is not a transformer nonterminal"//]
       [tgf=1] )
     snd:actualformal !inh !name
     rcv:actualformal !der !name
     link:checkntcalls !env
  -> <nt link rpt >%namet        {do nonterminals as functions}
     [treeint !namet ^name]
     [from !name !env ^ntre:<nt <no inh der >%tgft rightp >]
     [treeint !tgft ^tgf]
     makeforward !name !env !inh !der !tgf !true
     link:checkntcalls !env
     makeforward !name !env !inh !der !tgf !false
     rpt:doflatten !name !env !inh !der !tgf
  -> <>;

actualformal !formal:tree !name:int                                    {t050}
  -> <>
     [//"too few actual attributes, calling "; spell !name//; formal:<>]
  -> ( <at link exptree:<vr expty >%idnt actType:<tf > >
       [formal:<at nextf vrv tipe >]
       sameType !tipe !actType
     | <at link <ca exptree:<tv expty >%idnt mtt > actType:<tf > >
       [formal:<at nextf vrv tipe >]
       sameType !tipe !actType
     | <at link exptree expty >
       [formal:<at nextf vrv tipe >] )
     [//"attribute type mismatch calling "; spell !name//]
     sameType !tipe !expty
     link:actualformal !nextf !name;

paramlist !needsvar:bool !insemi:bool ^outsemi:bool                    {t060}
  -> <> [outsemi=insemi]
  -> ident:<at link vrv tipe >%name
     link:paramlist !needsvar !insemi ^tsemi
     ( [tsemi=true; ";"] )? ( [needsvar=true; "VAR "] )?
     [outsemi=true]
     ident:shovar !false !false !true !true !empty ^xset;

showdeprams                                                            {t070}
  -> ident:<at link vrv tipe >%name
     link:showdeprams
        ["Sho"]  tipe:showtype  ["("]
     ident:shovar !false !false !false !true !empty ^xset  [");"]
  -> <>;

doflatten !name:int !env:table !inh:tree !der:tree !tgf:int            {t080}
  -> <nt <no ..>%kindt body >
     [treeint !kindt ^kind]
     ["  VAR ok:BOOLEAN;t0:tree;"]
     body:findvars !env !empty ^xset
     ["errno:INTEGER;"; ascii !0; "  PROCEDURE doerr;VAR ok:BOOLEAN;"]
     ["BEGIN ok:=TRUE;CASE errno OF 0:|"]
     body:finderrs !env !1 ^lasterr
     ["END;IF errno>0 THEN abortit ELSE errno:=0 END;"]
     ["END doerr;"; ascii !0; "  BEGIN ok:=TRUE;errno:=0;"]
     ( [kind=1; "t0:=thetree;"] | [otherwise; "t0:=NIL;"] )
     ["IF Debugging THEN sWriteS('+"; spell !name; "');"]
     ( [kind=1; "Shotree(t0);"] )?
     inh:showdeprams   ["sWriteLn END;"]
     body:flatten !env
     ["IF NOT ok THEN doerr END;"]
     ["IF Debugging THEN sWriteS('-"; spell !name; "');"]
     ["IF ok THEN "]   der:showdeprams   
     ["ELSE sWriteS('  ----')END;ShoBOOLEAN(ok);sWriteLn END;"]
     ["RETURN ok END"; ascii !0; "  nt"; spell !name; ";"; ascii!0];

findvars !env:table !indone:set ^outdone:set                           {t090}
  -> ( <> | <ot > | <tr .. > )  [outdone=indone]
  -> ( <al left right > | <ca left right > | <no left right > )
     left:findvars !env !indone ^tdone  right:findvars !env !tdone ^outdone
  -> ( <st body > | <pl body > | <dl body tokn > | <er body > )
     body:findvars !env !indone ^outdone
  -> <tk params >
     params:argvars !env !true !indone ^outdone
  -> ( <nt snd rcv tre > | <fn snd rcv > )
     snd:argvars !env !false !indone ^tdone
     rcv:argvars !env !true !tdone ^outdone
  -> ( <mt expt > | <xf expt > )
     expt:expnvars !env !indone ^outdone
  -> <as expt exty thev >
     thev:shovar !true !true !true !false !indone ^tdone
     expt:expnvars !env !tdone ^outdone;

expnvars !env:table !indone:set ^outdone:set                           {t100}
  -> <ca stm exp>
     stm:findvars !env !indone ^tdone
     exp:expnvars !env !tdone ^outdone
  -> <bt exp1 exp2 >
     exp1:bldvars !env !indone ^tdone
     exp2:expnvars !env !tdone ^outdone
  -> ( <or exp1 exp2 > | <an exp1 exp2 > | <eq exp1 exp2 > | <ne exp1 exp2 >
     | <ls exp1 exp2 > | <gr exp1 exp2 > | <ad exp1 exp2 > | <su exp1 exp2 >
     | <mp exp1 exp2 > | <dv exp1 exp2 > | <md exp1 exp2 > )
     exp1:expnvars !env !indone ^tdone
     exp2:expnvars !env !tdone ^outdone
  -> ( <no exp > exp:expnvars !env !indone ^outdone
     | <ng exp > exp:expnvars !env !indone ^outdone
     | <nn exp > exp:expnvars !env !indone ^outdone )
  -> <rt nod pth cmp <> >
     [outdone=indone] 
  -> <rt nod pth cmp var>
     var:shovar !true !true !true !false !indone ^outdone 
  -> ( <> | <cn ..> | <vr ..> | <at ..> | <gl ..> | <tv ..> | <sa ..> )
     [outdone=indone];

bldvars !env:table !indone:set ^outdone:set                            {t110}
  -> <ca stm exp >
     stm:bldvars !env !indone ^tdone
     exp:expnvars !env !tdone ^outdone 
  -> exp:<bt ..> 
     exp:expnvars !env !indone ^outdone 
  -> <> [outdone=indone];

argvars !env:table !uparo:bool !indone:set ^outdone:set                {t120}
  -> ( exp:<vr ..> | exp:<at vlnx <> vty > | exp:<at vlnx <tk> vty >
     | exp:<gl ..> | exp:<sa ..> )
     [uparo=true] exp:shovar !true !true !true !false !indone ^outdone
  -> <at nexta exptr expty >
     nexta:argvars !env !uparo !indone ^xdone
     ( [uparo=true]
       exptr:argvars !env !uparo !xdone ^outdone
     | [otherwise]
       exptr:expnvars !env !xdone ^outdone )
  -> <ca exp stm >
     ( [uparo=true]
       exp:shovar !true !true !true !false !indone ^tdone 
       stm:findvars !env !tdone ^outdone
     | [otherwise]
       exp:findvars !env !indone ^tdone
       stm:expnvars !env !tdone ^outdone )
  -> <> [outdone=indone];

shovar !usesa:bool !needsem:bool                                       {t130}
  !tytoo:bool !allvars:bool !indone:set ^outdone:set
  -> <tv vty >%numbt  [treeint !numbt ^numb; outdone=indone]
     ["tv"; number !numb]
     ( [tytoo=true; ":"] vty:showtype ( [needsem=true; ";"] )? )?
  -> <gl vty >%namet [treeint !namet ^name]
     ( [allvars=true; "gl"; spell !name; addset !name !indone ^outdone] 
       shovarType !tytoo !vty !needsem
     | [otherwise; outdone=indone] )
  -> <at lnk vrv vty>%namet [treeint !namet ^name]
     ( [vrv:<tk>%toknnot; treeint !toknnot ^toknno; toknno#-1;
       usesa=true; notinset !name*20+toknno !indone;
       addset !name*20+toknno !indone ^outdone]
       ( [tytoo=true; "sa"; number !toknno; spell !name]
         shovarType !tytoo !vty !true )?
       ["sv"; number !toknno; spell !name]
       shovarType !tytoo !vty !needsem
     | [allvars=true; "at"; spell !name; addset !name !indone ^outdone]
       shovarType !tytoo !vty !needsem
     | [otherwise; outdone=indone] )
  -> <vr vty >%namet [treeint !namet ^name]
     ( [notinset !name !indone; addset !name !indone ^outdone]
       ["vr"; spell !name]
       shovarType !tytoo !vty !needsem
     | [otherwise; outdone=indone] )
  -> <sa toknnot vty>%namet [treeint !namet ^name; treeint !toknnot ^toknno]
     ( [notinset !name*20+toknno !indone;
       addset !name*20+toknno !indone ^outdone]
       ["sv"; number !toknno; spell !name]
       shovarType !tytoo !vty !needsem
     | [otherwise; outdone=indone] );

showtype                                                               {p140}
  -> <ty >%typenot [treeint !typenot ^typeno]
     ( [typeno=1; "INTEGER"] | [typeno=2; "BOOLEAN"] | [typeno=3; "tree"]
     | [typeno=4; "tree"] | [typeno=5; "table"] | [typeno>5; "INTEGER"] );

finderrs !env:table !inerno:int ^outno:int                             {t150}
  -> ( <> | <tr ..> | <ot > | <tk ..> | <nt ..>
     | <fn ..> | <mt ..> | <xf ..> | <as ..> )
     [outno=inerno]
  -> ( <al left right > | <ca left right > | <no left right > )
     left:finderrs !env !inerno ^midno
     right:finderrs !env !midno ^outno
  -> ( <st body > | <pl body > | <dl body tokn > )
     body:finderrs !env !inerno ^outno
  -> <er body >
     [number !inerno; ": "]
     body:flatten !env
     ["|"; outno=inerno+1]
  => <er >%inerno;

flatten !env:table                                                     {t160}
  -> <>             {no code}
  -> <no left right>
     left:flatten !env
     right:flatten !env
  -> <ca <> right >
     right:flatten !env
  -> <ca left right >
     left:flatten !env
       ["  IF ok THEN "]
     right:flatten !env
       ["ELSE doerr END;"; ascii !0]
  -> <al left right >
       ["push(errno);errno:=0;push(Taken);Taken:=0;"]
     left:flatten !env
       ["IF NOT ok THEN doerr;ok:=TRUE;errno:=0;"]
       ["IF Taken>0 THEN SyntaxError END;"]
       ["IF Debugging THEN sWriteS('|')END;"]
     right:flatten !env
       ["IF NOT ok THEN doerr;IF Taken>0 THEN SyntaxError END;"]
       ["END END;Taken:=Taken+pop();errno:=pop();"]
  -> <st body >
       ["push(errno);push(Taken);WHILE ok DO "]
       ["errno:=0;Taken:=0;IF Debugging THEN sWriteS('(')END;"]
     body:flatten !env
       ["IF Debugging THEN sWriteS(')*')END;"]
       ["IF Taken>0 THEN IF ok THEN push(Taken+pop())"]
       ["ELSE SyntaxError END END END;"]
       ["Taken:=pop();errno:=pop();ok:=TRUE;"]
  -> <pl body >
       ["push(errno);push(Taken);push(0);REPEAT "]
       ["Taken:=0;errno:=0;IF Debugging THEN sWriteS('(')END;"]
     body:flatten !env
       ["IF Debugging THEN sWriteS(')+')END;"]
       ["IF Taken>0 THEN IF ok THEN push(pop()+pop()+Taken);"]
       ["push(1) ELSE SyntaxError END ELSIF ok THEN "]
       ["push(pop()+1)END UNTIL NOT ok;ok:=pop()>0;Taken:=pop();errno:=pop();"]
  -> <dl body tokx>%toknt [treeint !toknt ^tokn]
       ["push(errno);push(Taken);push(0);REPEAT errno:=0;Taken:=0;"]
       ["IF Debugging THEN sWriteS('(')END;"]
     body:flatten !env
       ["IF Debugging THEN sWriteS(')$')END;push(Taken+pop())"]
       ["UNTIL NOT ok OR NOT MatchToken("; number !tokn; ");"]
       ["Taken:=pop();IF NOT ok THEN doerr;"]
       ["IF Taken>0 THEN SyntaxError END END;"]
       ["Taken:=Taken+pop();errno:=pop();"]
  -> <tk <>>%toknt [treeint !toknt ^tokn]
       ["ok:=MatchToken("; number !tokn; ");"]
  -> <tk params:<at ..>>%toknt [treeint !toknt ^tokn]
       ["ok:=MatchTok"; number !tokn; "("]
     params:doargs !env !true !false !<> ^needs ^post
       [");"]
     post:flatten !env 
  -> <nt snd rcv tre>%namet [treeint !namet ^name]
       ["ok:=nt"; spell !name; "("]
     snd:doargs !env !false !false !<> ^sneed ^postx
     rcv:doargs !env !true !sneed !postx ^rneed ^post
     ( [tre#<>] 
       ( [rneed=true; ","] )?
       tre:shovar !true !false !false !true !empty ^xset )?
     [");"]
     ( [post#<>; "  IF ok THEN "]
       post:flatten !env
       ["ELSE doerr END;"; ascii !0] )?
  -> <fn snd rcv >%namet [treeint !namet ^name]
     ["ok:=fn"; spell !name; "("]
     snd:doargs !env !false !false !<> ^sneed ^postx
     rcv:doargs !env !true !sneed !postx ^rneed ^post
     [");"]
     post:flatten !env
  -> <mt expt >
        ["ok:="]
     expt:flattex !2 !env ^extx [";"]
  -> <as expt <> thev >
     thev:getvartype ^<ty>%extyt [treeint !extyt ^exty]
     thev:shovar !true !false !false !true !empty ^xset [":="] 
     expt:flattex !exty !env ^extx [";"]
  -> <as expt <ty>%extyt thev > [treeint !extyt ^exty]
     thev:shovar !true !false !false !true !empty ^xset [":="] 
     expt:flattex !exty !env ^extx [";"]
  -> <ot >%txtnot [treeint !txtnot ^txtno]
     ( [txtno<0; "writeS('"; spell !0-txtno; "');"]
     | [txtno=0; "writeLn;"]
     | [txtno>0; 'writeS("'; spell !txtno; '");'] )
  -> <xf body > 
        ["replacetree(thetree,"]
     body:flattex !3 !env ^extx [");"]
  -> <tr <> >%toknot
     [treeint !toknot ^tokno; tokno=1; "badChar:=TRUE"]
  -> <tr ders >%toknot
     [treeint !toknot ^tokno; "NexToken:="; number!tokno; ";"]
     ders:preserveScanVars
  -> <er ..>%ernot [treeint !ernot ^erno]
        ["IF NOT ok THEN doerr END;errno:="; number !erno; ";"];

preserveScanVars                                                       {t170}
  -> <>
  -> <at next <tk >%toknnot tipe >%namet
     [treeint !toknnot ^toknno; treeint !namet ^name]
     ["sa"; number !toknno; spell !name]
     [":=sv"; number !toknno; spell !name; ";"]
     next:preserveScanVars;

getvartype ^vartype:tree                                               {t180}
  -> <tv vartype>
  -> <gl vartype>
  -> <at lnk vrv vartype>
  -> <vr vartype>
  -> <sa toknno vartype>;

flattex !mustype:int !env:table ^istype:int                            {t190}
  -> <rt root pth comp nvar>  [from !1 !env ^itype]
     ( [nvar:<vr vtyt>] | [nvar:<at vlnx vlv vtyt>]
     | [nvar:<gl vtyt>] | [nvar:<sa toknno vtyt>] | [otherwise;vtyt=<>] )  
     ( [itype=vtyt; "treeparty("] | [otherwise; "treepart("] )
     ( [root=<>; "thetree"]
     | [otherwise] root:shovar !true !false !false !true !empty ^xset )
     [","; treeint !pth ^path; number !path; ","; treeint !comp ^con]
     [number !con; ","]
     ( [nvar=<>; "t0"]
     | [otherwise] nvar:shovar !true !false !false !true !empty ^zset )
     [")"; istype=2; //"boolean type expected"//; mustype=2`mustype=0]
  -> <bt <> <>>
       ["NIL"; istype=3; //"tree type expected"//; mustype=3`mustype=0]
  -> <bt subs decor >%ndnt [treeint !ndnt ^ndn; "build("; number !ndn; ","]
        [istype=3; //"tree type expected"//; mustype=3`mustype=0]
     decor:flattex !3 !env ^exty
     subs:buildtree !env ^nsubs  [nnn=nsubs]
     ( [nsubs<8; ",NIL"; nsubs@=nsubs+1] )*
     [","; number !nnn; ")"]
  -> ( <nn expr:<vr texty> <> <ty>%totyt> | <nn expr texty:<ty> <ty>%totyt> )
     [treeint !totyt ^toty]  texty:castype !toty ^itsty
     ["("; istype=toty; //"type mismatch"//; mustype=toty`mustype=0]
     expr:flattex !itsty !env ^extx  [")"]
  -> <or left right >    ["("; //"boolean type expected"//; mustype=2`mustype=0]
     left:flattex !2 !env ^exty [")OR("]
     right:flattex !2 !env ^extz [")"; istype=2]
  -> <an left right >    ["("; //"boolean type expected"//; mustype=2`mustype=0]
     left:flattex !2 !env ^exty [")AND("]
     right:flattex !2 !env ^extz [")"; istype=2]
  -> <no left >    ["NOT("; //"boolean type expected"//; mustype=2`mustype=0]
     left:flattex !2 !env ^exty [")"; istype=2]
  -> <eq left right >    ["("; //"boolean type expected"//; mustype=2`mustype=0]
     left:flattex !0 !env ^exty ["="]
     right:flattex !0 !env ^exty    [")"; istype=2]
  -> <ne left right >    ["("; //"boolean type expected"//; mustype=2`mustype=0]
     left:flattex !0 !env ^exty [")<>("]
     right:flattex !0 !env ^exty    [")"; istype=2]
  -> <ls left right >
     ["("; //"boolean type expected"//; mustype=2`mustype=0]
     [exty=1; //"invalid magnitude compare not int"//]
     left:flattex !0 !env ^exty  [")<("]
     right:flattex !0 !env ^exty 
     [")"; istype=2]
  -> <gr left right >
     ["("; //"boolean type expected"//; mustype=2`mustype=0]
     [exty=1; //"invalid magnitude compare not int"//]
     left:flattex !0 !env ^exty  [")>("]
     right:flattex !0 !env ^exty 
     [")"; istype=2]
  -> <ad left right >    ["("; //"integer type expected"//; mustype<2]
     left:flattex !1 !env ^exty [")+("]
     right:flattex !1 !env ^extz    [")"; istype=1]
  -> <su left right >    ["("; //"integer type expected"//; mustype<2]
     left:flattex !1 !env ^exty [")-("]
     right:flattex !1 !env ^extz    [")"; istype=1]
  -> <mp left right >    ["("; //"integer type expected"//; mustype<2]
     left:flattex !1 !env ^exty [")*("]
     right:flattex !1 !env ^extz    [")"; istype=1]
  -> <dv left right >    ["("; //"integer type expected"//; mustype<2]
     left:flattex !1 !env ^exty [")DIV("]
     right:flattex !1 !env ^extz    [")"; istype=1]
  -> <md left right >    ["("; //"integer type expected"//; mustype<2]
     left:flattex !1 !env ^exty [")MOD("]
     right:flattex !1 !env ^extz    [")"; istype=1]
  -> <ng left >          ["-("; //"integer type expected"//; mustype<2]
     left:flattex !1 !env ^exty     [")"; istype=1]
  -> ( thev:<vr <ty>%vtyt> | thev:<gl <ty>%vtyt> | thev:<at xx vrv <ty>%vtyt>
     | thev:<tv <ty>%vtyt> | thev:<sa toknno <ty>%vtyt> )
     [treeint !vtyt ^vty]
     [//"identifier type mismatch"//; mustype=vty`mustype=0; istype=vty]
     thev:shovar !true !false !false !true !empty ^xset
  -> <co <ty>%tipet >%idnt [treeint !tipet ^tipe; treeint !idnt ^idn]
     [//"identifier type mismatch"//; mustype=tipe`mustype=0]
     [number !idn; istype=tipe]
  -> <cn <ty>%ctyt >%valt 
     [treeint !ctyt ^cty; cty=2] [treeint !valt ^val; val=0]
     [//"boolean type expected"//; mustype=2`mustype=0]["FALSE"; istype=2]
  -> <cn <ty>%ctyt >%valt 
     [treeint !ctyt ^cty; cty=2] [treeint !valt ^val; val=1]
     [//"boolean type expected"//; mustype=2`mustype=0]["TRUE"; istype=2]
  -> <cn <ty>%ctyt > 
     [treeint !ctyt ^cty; cty=4]
     [//"set type expected"//; mustype=4`mustype=0]["NIL"; istype=4]
  -> <cn <ty>%ctyt > 
     [treeint !ctyt ^cty; cty=5]
     [//"symbol table type expected"//; mustype=5`mustype=0]["NIL"; istype=5]
  -> <cn <ty>%ctyt >%valt 
     [treeint !ctyt ^cty; cty=1; treeint !valt ^val]
     [//"integer type expected"//; mustype<2][number !val; istype=1]
  -> <cn <ty>%ctyt >%valt [treeint !ctyt ^cty; treeint !valt ^val]
     [//"invalid constant type"//; mustype=cty`mustype=0; cty>5]
     [number !val; istype=cty] ;

doargs !env:table !uparo:bool !insemi:bool !repost:tree                {t200}
    ^outsemi:bool ^post:tree
  -> <> [outsemi=insemi; post=repost]
  -> <at nexta exptr expty:<ty >%tynot > [treeint !tynot ^tyno]
     nexta:doargs !env !uparo !insemi !repost ^xsemi ^postx  [outsemi=true]
     ( [xsemi=true; ","] )?
     ( [uparo=true]  exptr:splitarg !postx ^post
     | [otherwise; post=postx]  exptr:flattex !tyno !env ^xty );
 
splitarg !pre:tree ^post:tree                                          {t210}
  -> <ca exptr thep >
     exptr:shovar !true !false !false !true !empty ^xset
     [post=<ca pre thep >]
  -> ( thev:<vr ..> | thev:<gl ..> | thev:<at ..>
     | thev:<tv ..> | thev:<sa ..> )
     thev:shovar !true !false !false !true !empty ^xset  [post=pre];

buildtree !env:table ^nsubs:int                                        {t220}
  -> <bt <> <> >  [nsubs=0]
  -> <ca nextv extr >
     nextv:buildtree !env ^nmos  [","; nsubs=nmos+1]
     extr:flattex !3 !env ^xty;

castype !wanty:int ^typeno:int                                         {t230}
  -> <ty >%typenot [treeint !typenot ^typeno]
     ( [typeno=1; "int"] | [typeno=2; "bool"] | [typeno=3; "tree"]
     | [typeno=4; "tree"] | [typeno=5; "tree"] | [typeno>5; "int"] )
     ( [wanty=1; "int"] | [wanty=2; "bool"] | [wanty=3; "tree"]
     | [wanty=4; "tree"] | [wanty=5; "tree"] | [wanty>5; "int"] );

deleteitem {delete from list, replace with its link}                   {t240}
  -> <no link aset >
  => link
  -> <tr link fromst tost chrs acts >
  => link;

catlist !tail:tree ^result:tree       {cats tree to tail}              {t250}
  -> <>  [result=tail]
  -> <no link code >%deco
     link:catlist !tail ^midlist  [result=<no midlist code >%deco];

end TagGrammar.