Subject: v20i055: Portable compiler of the FP language, Part06/06 Newsgroups: comp.sources.unix Sender: sources Approved: rsalz@uunet.UU.NET Submitted-by: Edoardo Biagioni Posting-number: Volume 20, Issue 55 Archive-name: fpc/part06 # This is a shell archive. # Remove everything above and including the cut line. # Then run the rest of the file through sh. -----cut here-----cut here-----cut here-----cut here----- #!/bin/sh # shar: Shell Archiver # Run the following text with /bin/sh to create: # parse.c # parse.h # prims.fp # y.tab.c # This archive created: Thu May 26 17:08:30 1988 echo shar: extracting parse.c '(11733 characters)' sed 's/^XX//' << \SHAR_EOF > parse.c XX/* parse.c: builds the parse tree for each function, then calls code (tree) XX * to produce the code for it. XX */ XX XX#include XX#include XX#include "fpc.h" XX#include "parse.h" XX XXextern char * malloc (); XXextern char * sprintf (); XX XXvoid code (); XXvoid startcomp (); XXvoid endcomp (); XX XXchar funname [MAXIDLEN] = "no function declaration seen yet"; XXint inerror = 0; XXstatic struct fpexprd basefun = { INVALID }; XXstatic fpexpr stack [STACKDEPTH] = { & basefun }; XXstatic int stackptr = 0; XX XX/* the context holds, for level cntptr, whether a compose was XX * encountered on that level or not. */ XXstatic int context [STACKDEPTH]; XXstatic int cntptr = 0; XX XXstatic fpexpr newexpr (type) XXint type; XX{ XX register fpexpr new; XX XX new = (fpexpr) malloc (sizeof (struct fpexprd)); XX new->exprtype = type; XX return (new); XX} XX XXvoid parsefnstart (fname) XXchar * fname; XX{ XX extern int verbose; /* set in fpc.c */ XX XX#ifdef TRACE XX (void) printf ("function name is %s\n", fname); XX#endif XX (void) strcpy (funname, fname); XX inerror = 0; XX stackptr = 0; XX cntptr = 0; /* root context */ XX if (verbose) XX (void) printf ("%s\n", funname); XX startcomp (); XX} XX XXvoid parsefnend () XX{ XX#ifdef TRACE XX (void) printf ("function body is finished\n"); XX#endif XX endcomp (); XX if (inerror) XX inerror = 0; XX else XX { XX if (stackptr != 1) XX (void) fprintf (stderr, "stackptr is %d at end\n", stackptr); XX if (cntptr != 0) XX (void) fprintf (stderr, "context pointer is %d at end\n", cntptr); XX if (stackptr != 1) XX puterror ("compiler error 1", ""); XX if (cntptr != 0) XX puterror ("compiler error 5", ""); XX code (funname, stack [0]); XX } XX} XX XXvoid parsethen () XX{ /* pop the composition being parsed off the stack and make it XX * the first (if) part of the conditional */ XX fpexpr ifpart, current; XX XX#ifdef TRACE XX (void) printf (" -> "); XX#endif XX endcomp (); XX ifpart = stack [--stackptr]; XX stack [stackptr++] = current = newexpr (COND); XX current->fpexprv.conditional [0] = ifpart; XX startcomp (); XX} XX XXvoid parseelse () XX{ XX/* top of stack is the then part, put it into the structure */ XX fpexpr current; XX XX#ifdef TRACE XX (void) printf (" ; "); XX#endif XX endcomp (); XX current = stack [stackptr - 2]; XX if (current->exprtype != COND) XX yyerror ("compiler error 2"); XX current->fpexprv.conditional [1] = stack [--stackptr]; XX startcomp (); XX} XX XXvoid parseendif () XX{ XX/* top of stack is the else part, put it into the structure */ XX fpexpr current; XX XX#ifdef TRACE XX (void) printf (" endif\n"); XX#endif XX endcomp (); XX if (stackptr < 2) XX yyerror ("compiler error 4"); XX else XX { XX current = stack [stackptr - 2]; XX if (current->exprtype != COND) XX yyerror ("compiler error 3"); XX current->fpexprv.conditional [2] = stack [--stackptr]; XX } XX startcomp (); /* empty, only to keep the stack balanced */ XX} XX XXvoid parsebustart (right) XXint right; XX{ XX#ifdef TRACE XX (void) printf ("starting bu%s\n", (right) ? "r" : ""); XX#endif XX stack [stackptr++] = newexpr (right ? BUR : BU); XX startcomp (); XX} XX XXvoid parsebufun () XX{ XX fpexpr fun; XX XX#ifdef TRACE XX (void) printf ("done with the bu or bur expression\n"); XX#endif XX endcomp (); XX fun = stack [--stackptr]; XX stack [stackptr - 1]->fpexprv.bulr.bufun = fun; XX} XX XXvoid parsebuobj () XX{ XX fpexpr obj; XX XX#ifdef TRACE XX (void) printf ("done with the bu or bur object\n"); XX#endif XX obj = stack [--stackptr]; XX stack [stackptr - 1]->fpexprv.bulr.buobj = obj; XX} XX XXvoid whilestart () XX{ XX#ifdef TRACE XX (void) printf ("starting the while\n"); XX#endif XX stack [stackptr++] = newexpr (WHILE); XX startcomp (); XX} XX XXvoid whilepred () XX{ XX fpexpr pred; XX XX#ifdef TRACE XX (void) printf ("while predicate done\n"); XX#endif XX endcomp (); XX pred = stack [--stackptr]; XX stack [stackptr - 1]->fpexprv.whilestat [0] = pred; XX startcomp (); XX} XX XXvoid whilefun () XX{ XX fpexpr loop; XX XX#ifdef TRACE XX (void) printf ("while function done\n"); XX#endif XX endcomp (); XX loop = stack [--stackptr]; XX stack [stackptr - 1]->fpexprv.whilestat [1] = loop; XX} XX XXvoid parsecomp () XX{ XX fpexpr fun, next; XX XX#ifdef TRACE XX (void) printf ("composing with next function\n"); XX#endif XX fun = stack [--stackptr]; XX next = newexpr (COMP); XX next->fpexprv.compconstr.compexpr = fun; XX if (context [cntptr - 1]) /* node already allocated on this level */ XX { /* join the new one in front of the old list, which is now present */ XX#ifdef TRACE XX (void) printf ("adding to old compose list, stackptr is %d\n", stackptr); XX#endif XX if (stackptr < 1) XX yyerror ("compiler error 9"); XX else XX { XX next->fpexprv.compconstr.compnext = stack [stackptr - 1]; XX stack [stackptr - 1] = next; XX } XX } XX else /* create new list */ XX { XX#ifdef TRACE XX (void) printf ("creating new compose list, stackptr is %d\n", stackptr); XX#endif XX next->fpexprv.compconstr.compnext = 0; XX stack [stackptr++] = next; XX } XX context [cntptr - 1] = 1; /* yes, we have a compose on this level */ XX} XX XXvoid startcomp () XX{ XX#ifdef TRACE XX (void) printf ("setting up possible composition\n"); XX#endif XX context [cntptr++] = 0; XX} XX XXvoid endcomp () XX{ XX#ifdef TRACE XX (void) printf ("closing up %s composition\n", XX context [cntptr - 1] ? "the" : "no"); XX#endif XX if (cntptr <= 0) /* endcomp does not match comp */ XX yyerror ("compiler error 6"); XX else if ((context [cntptr - 1]) == 0) /* composition not done */ XX cntptr--; XX else if (stackptr <= 1) /* composition done, but no composition? */ XX yyerror ("compiler error 7"); XX else if (stack [stackptr - 2]->exprtype != COMP) /* same problem */ XX yyerror ("compiler error 8"); XX else XX { /* we put the stack top as the last expression to be composed with */ XX parsecomp (); XX cntptr--; XX } XX} XX XXvoid parseaa () XX{ XX fpexpr exp, aa; XX XX#ifdef TRACE XX (void) printf ("apply-to-all encountered\n"); XX#endif XX exp = stack [--stackptr]; XX stack [stackptr++] = aa = newexpr (AA); XX aa->fpexprv.aains = exp; XX} XX XXvoid parseconstr () XX{ XX#ifdef TRACE XX (void) printf ("constructor encountered\n"); XX#endif XX stack [stackptr] = newexpr (CONSTR); XX stack [stackptr++]->fpexprv.compconstr.compnext = 0; XX startcomp (); XX} XX XXvoid constrnext () XX{ /* append new item to the end of the list */ XX fpexpr fun, oldc; XX XX#ifdef TRACE XX (void) printf ("finished item of constructor\n"); XX#endif XX endcomp (); XX fun = stack [--stackptr]; XX oldc = stack [stackptr - 1]; XX while (oldc->fpexprv.compconstr.compnext != 0) XX oldc = oldc->fpexprv.compconstr.compnext; XX oldc->fpexprv.compconstr.compexpr = fun; XX oldc->fpexprv.compconstr.compnext = newexpr (CONSTR); XX oldc->fpexprv.compconstr.compnext->fpexprv.compconstr.compnext = 0; XX startcomp (); XX} XX XXvoid endconstr () XX{ /* we delete the last storage box of the list, since it's unused */ XX fpexpr oldc, last; XX XX#ifdef TRACE XX (void) printf ("constructor finished\n"); XX#endif XX endcomp ();/* usually this one just pops the context, should always be 0 */ XX oldc = stack [stackptr - 1]; XX while (oldc->fpexprv.compconstr.compnext != 0) XX { XX last = oldc; XX oldc = oldc->fpexprv.compconstr.compnext; XX } XX last->fpexprv.compconstr.compnext = 0; XX} XX XXvoid parseinsert (type) XXint type; XX/* type is 0 for insert, 1 for right insert, 2 for tree insert */ XX{ XX fpexpr ins; XX XX#ifdef TRACE XX switch (type) XX { XX case 0: (void) printf ("insert encountered\n"); XX break; XX case 1: (void) printf ("right insert encountered\n"); XX break; XX case 2: (void) printf ("tree insert encountered\n"); XX break; XX default: (void) printf ("unknown insert found\n"); XX exit (1); XX } XX#endif XX switch (type) XX { XX case 0: ins = newexpr (INSERT); XX break; XX case 1: ins = newexpr (RINSERT); XX break; XX default: ins = newexpr (TREE); XX } XX stack [stackptr++] = ins; XX} XX XXvoid endinsert () XX{ XX#ifdef TRACE XX (void) printf ("insert done\n"); XX#endif XX stackptr--; XX stack [stackptr - 1]->fpexprv.aains = stack [stackptr]; XX} XX XXvoid parsesel (sel, right) XXchar * sel; XXint right; XX{ XX fpexpr selfn; XX char errbuf [256]; XX XX#ifdef TRACE XX (void) printf ("%s selector is %s\n", (right ? "right" : "left"), sel); XX#endif XX stack [stackptr++] = selfn = newexpr (right ? RSEL : SEL); XX (void) sscanf (sel, "%d", &selfn->fpexprv.lrsel); XX if (selfn->fpexprv.lrsel <= 0) XX { XX (void) sprintf (errbuf, "error: selector %d < 1", selfn->fpexprv.lrsel); XX yyerror (errbuf); XX } XX} XX XXvoid parsefncall (fun) XXchar * fun; XX{ XX fpexpr funblk; XX unsigned int len; XX XX#ifdef TRACE XX (void) printf ("calling function %s\n", fun); XX#endif XX stack [stackptr++] = funblk = newexpr (FNCALL); XX len = strlen (fun) + 1; XX funblk->fpexprv.funcall = malloc (len); XX (void) strcpy (funblk->fpexprv.funcall, fun); XX} XX XXvoid consttrue () XX{ XX#ifdef TRACE XX (void) printf ("constant true\n"); XX#endif XX stack [stackptr++] = newexpr (TRUE); XX} XX XXvoid constfalse () XX{ XX#ifdef TRACE XX (void) printf ("constant false\n"); XX#endif XX stack [stackptr++] = newexpr (FALSE); XX} XX XXvoid constnum (num) XXchar * num; XX{ XX fpexpr objblock; XX XX#ifdef TRACE XX (void) printf ("constant number %s\n", num); XX#endif XX stack [stackptr++] = objblock = newexpr (INT); XX (void) sscanf (num, "%d", &objblock->fpexprv.intobj); XX} XX XXvoid constsym (name) XXchar * name; XX{ XX fpexpr objblock; XX XX#ifdef TRACE XX (void) printf ("constant symbol %s\n", name); XX#endif XX stack [stackptr++] = objblock = newexpr (SYM); XX objblock->fpexprv.symbol = malloc ((unsigned) (strlen (name) + 1)); XX (void) strcpy (objblock->fpexprv.symbol, name); XX} XX XXvoid conststr (str) XXchar * str; XX{ XX fpexpr obj, new, ch; XX char * strp = str; XX XX#ifdef TRACE XX (void) printf ("constant string %s\n", str); XX#endif XX while (*(++strp) != '\0') XX ; XX strp--; /* strp now points to the char before the null */ XX strp--; /* strp now points to the char before the " */ XX if (strp == str) /* empty string, same as NIL */ XX stack [stackptr++] = newexpr (NIL); XX else XX { XX for (obj = 0; strp != str; strp--) XX/* by checking strp != str, we skip the initial " */ XX { XX new = newexpr (LIST); XX new->fpexprv.listobj.listnext = obj; XX ch = newexpr (CHAR); XX ch->fpexprv.character = *strp; XX new->fpexprv.listobj.listel = ch; XX obj = new; XX } XX stack [stackptr++] = obj; XX } XX} XX XXvoid constchr (ch) XXchar * ch; XX{ XX fpexpr objblock; XX XX#ifdef TRACE XX (void) printf ("constant character %s\n", ch); XX#endif XX stack [stackptr++] = objblock = newexpr (CHAR); XX if (*(++ch) == '\\') XX ch++; XX objblock->fpexprv.character = *ch; XX} XX XXvoid constreal (num) XXchar * num; XX{ XX fpexpr objblock; XX XX#ifdef TRACE XX (void) printf ("constant floating-point number %s\n", num); XX#endif XX stack [stackptr++] = objblock = newexpr (FLOAT); XX (void) sscanf (num, "%lf", &objblock->fpexprv.floatobj); XX} XX XXvoid parsenil () XX{ XX#ifdef TRACE XX (void) printf ("constant nil\n"); XX#endif XX stack [stackptr++] = newexpr (NIL); XX} XX XXvoid liststart () XX{ XX fpexpr objblock; XX XX#ifdef TRACE XX (void) printf ("beginning of constant list\n"); XX#endif XX stack [stackptr++] = objblock = newexpr (LIST); XX objblock->fpexprv.listobj.listnext = 0; XX} XX XXvoid listnext () XX{ XX fpexpr obj, oldobj, el; XX XX#ifdef TRACE XX (void) printf ("end of element of constant list\n"); XX#endif XX obj = newexpr (LIST); XX el = stack [--stackptr]; XX obj->fpexprv.listobj.listnext = 0; XX oldobj = stack [stackptr - 1]; XX while (oldobj->fpexprv.listobj.listnext != 0) XX oldobj = oldobj->fpexprv.listobj.listnext; XX oldobj->fpexprv.listobj.listel = el; XX oldobj->fpexprv.listobj.listnext = obj; XX} XX XXvoid listend () XX{ /* invariant: thanks to YACC, there must have been at XX * least one call to listnext since the call to liststart */ XX /* essentially, we take the last element off the list, since XX * that is the one and only unused one */ XX fpexpr obj; XX XX#ifdef TRACE XX (void) printf ("end of constant list\n"); XX#endif XX obj = stack [stackptr - 1]; XX while (obj->fpexprv.listobj.listnext->fpexprv.listobj.listnext != 0) XX obj = obj->fpexprv.listobj.listnext; XX obj->fpexprv.listobj.listnext = 0; XX} SHAR_EOF if test 11733 -ne "`wc -c parse.c`" then echo shar: error transmitting parse.c '(should have been 11733 characters)' fi echo shar: extracting parse.h '(1448 characters)' sed 's/^XX//' << \SHAR_EOF > parse.h XX/* parse.h: defines the possible structures of the parse tree XX * used to represent FP functions. XX */ XX XX#define COND 0 XX#define BU 1 XX#define BUR 2 XX#define WHILE 3 XX#define COMP 4 XX#define AA 5 XX#define CONSTR 6 XX#define INSERT 7 XX#define RINSERT 8 XX#define TREE 9 XX/* unnecessary, since the individual constant types take care of this XX #define CONST 10 */ XX#define SEL 11 XX#define RSEL 12 XX#define MULTI 13 XX/* not a real functional form, used for in-lining /{+, *, and, or} */ XX#define FNCALL 14 XX#define INVALID 15 XX XX#define NIL 20 XX#define TRUE 21 XX#define FALSE 22 XX#define LIST 23 XX#define INT 24 XX#define FLOAT 25 XX#define SYM 26 XX#define CHAR 27 XX XXtypedef struct fpexprd * fpexpr; XX XXunion fpexprc XX{ XX fpexpr conditional [3]; /* if, then, else */ XX struct { XX fpexpr bufun; XX fpexpr buobj; XX } bulr; /* bu, bur */ XX fpexpr whilestat [2]; /* predicate, body */ XX struct { XX fpexpr compexpr; XX fpexpr compnext; XX } compconstr; XX/* compose, construct both have lists of expressions */ XX fpexpr aains; /* aa, all inserts, multi */ XX int lrsel; /* left, right selects */ XX char * funcall; /* function call */ XX struct { XX fpexpr listel; XX fpexpr listnext; XX } listobj; XX long intobj; XX double floatobj; XX char * symbol; XX char * string; XX char character; XX}; XX XXstruct fpexprd XX{ XX int exprtype; XX union fpexprc fpexprv; XX char constvar [6]; /* only used for constants */ XX}; XX XX#ifndef STACKDEPTH XX#define STACKDEPTH 100 XX#endif XX SHAR_EOF if test 1448 -ne "`wc -c parse.h`" then echo shar: error transmitting parse.h '(should have been 1448 characters)' fi echo shar: extracting prims.fp '(8494 characters)' sed 's/^XX//' << \SHAR_EOF > prims.fp XX# prims.fp: test suite for any implementation of FP or FP/FFP XXDef prims [id, \/and] o XX [testtl, testtlr, XX testrotl, testrotr, XX testid, testatom, XX testdistl, testdistr, XX testapndl, testapndr, XX testeq, testnoteq, XX testleq, testgeq, XX testless, testgreater, XX testplus, testminus, XX testtimes, testdiv, XX testneg, testmod, XX testnull, testlength, XX testtrans, testreverse, XX testand, testor, XX testnot, testiota] XX XXDef testand \/and o aa = o XX (bu trans ) o aa and o _<, , , > XX XXDef testapndl \/and o aa = o XX (bu trans <, , , <<>>, <>, <, >>) o XX aa apndl o XX _<>, >, >, <<>, <>>, <, <>>, XX <, <>>> XX XXDef testapndr \/and o aa = o XX (bu trans <, , , <<>>, <>, <, >>) o XX aa apndr o XX _<<<>, a>, <, b>, <, c>, <<>, <>>, <<>, >, XX <<>, >> XX XXDef testatom \/and o aa = o XX (bu trans ) o XX aa atom o XX _, 1, 1.0, a, 'a, "string", , XX <"vector">, > XX XXDef testdistl \/and o aa = o XX (bu trans <<>, <>, <, >, <<<>, 1>, XX <<>, 2>, <<>, 3>>>) o XX aa distl o _<>, >, >, <<>, <1, 2, 3>>> XX XXDef testdistr \/and o aa = o XX (bu trans <<>, <>, <, >, XX <>, >, >>>) o XX aa distr o _<<<>, x>, <, 1>, <, 2>, <, <>>> XX XXDef testdiv \/and o aa = o XX (bu trans XX <1, 1, 0, 2, -12, -3, 6, XX 1.0, 1.0, 0.5, 2.0, -8.75, -17.5, 6.25>) o XX aa div o XX _<<1, 1>, <10, 10>, <1, 2>, <2, 1>, <35, -3>, <-35, 17>, <-27, -4>, XX <1, 1.0>, <10.0, 10>, <1.0, 2.0>, <2.0, 1>, <35, -4.0>, XX <-35.0, 2.0>, <-25.0, -4.0>> XX XXDef testeq \/and o aa = o XX (bu trans XX ) o aa = o XX _<<1, 1>, <1, 0>, <1, a>, <1, 'a>, <1, 1.0>, <1, 0.99>, XX <1, <>>, <1, T>, <1, F>, <1, <1>>, XX , , , , , >, XX , , >, XX <'a, 'a>, <'a, 'b>, <'a, 1>, <'a, a>, <'a, 1.0>, XX <'a, <>>, <'a, T>, <'a, F>, <'a, <'a>>, XX <1.0, 1.0>, <1.0, 2.0>, <1.0, 1>, <1.1, 1>, <1.0, 'a>, XX <1.0, a>, <1.0, <>>, <1.0, T>, <1.0, F>, <1.0, <1.0>>, XX , , , , >, , >, XX , , , , >, , >, XX <<>, <>>, <<>, 1>, <<>, 'F>, <<>, 1.0>, <<>, T>, <<>, F>, XX <<>, <<>>>, XX <, >, <, >, <, 1>, <, 'a>, <, 1.0>, XX <, <>>, <, T>, <, F>, <, <>>, XX <, >, e>, , >, e>>, XX <, >, e>, , >, e>>> XX XX# only test geq on atoms, chars and numbers. Particular implementations XX# may have it defined for other values as well, but that is not portable XXDef testgeq \/and o aa = o XX (bu trans ) o XX aa >= o XX _<<1, 0>, <1, 1>, <1, 2>, XX <1.0, 0.99>, <1.0, 1.0>, <1.0, 1.01>, XX <1, 0.99>, <1, 1.0>, <1, 1.01>, XX <1.01, 1>, <1.0, 1>, <0.99, 1>, XX , , , XX <'m, 'a>, <'m, 'm>, <'m, 'z>> XX XXDef testgreater \/and o aa = o XX (bu trans ) o XX aa > o XX _<<1, 0>, <1, 1>, <1, 2>, XX <1.0, 0.99>, <1.0, 1.0>, <1.0, 1.01>, XX <1, 0.99>, <1, 1.0>, <1, 1.01>, XX <1.01, 1>, <1.0, 1>, <0.99, 1>, XX , , , XX <'m, 'a>, <'m, 'm>, <'m, 'z>> XX XXDef testid \/and o aa = o XX (bu trans <1, a, 'a, 1.0, T, F, <>, "id", >) o XX aa id o _<1, a, 'a, 1.0, T, F, <>, "id", > XX XXDef testiota \/and o aa = o XX (bu trans <<>, <1>, <1, 2>, <1, 2, 3, 4, 5, 6, 7, 8, 9, 10>>) o XX aa iota o _<0, 1, 2, 10> XX XXDef testlength \/and o aa = o XX (bu trans <0, 1, 1, 2, 3, 4, 10>) o XX aa length o XX _<<>, <1>, <<<>>>, <, >, "xyz", "four", "lenght ten"> XX XXDef testleq \/and o aa = o XX (bu trans ) o XX aa <= o XX _<<1, 0>, <1, 1>, <1, 2>, XX <1.0, 0.99>, <1.0, 1.0>, <1.0, 1.01>, XX <1, 0.99>, <1, 1.0>, <1, 1.01>, XX <1.01, 1>, <1.0, 1>, <0.99, 1>, XX , , , XX <'m, 'a>, <'m, 'm>, <'m, 'z>> XX XXDef testless \/and o aa = o XX (bu trans ) o XX aa < o XX _<<1, 0>, <1, 1>, <1, 2>, XX <1.0, 0.99>, <1.0, 1.0>, <1.0, 1.01>, XX <1, 0.99>, <1, 1.0>, <1, 1.01>, XX <1.01, 1>, <1.0, 1>, <0.99, 1>, XX , , , XX <'m, 'a>, <'m, 'm>, <'m, 'z>> XX XXDef testminus \/and o aa = o XX (bu trans <1, -1, 0, 11, -5, 3, -5>) o XX aa - o XX _<<1, 0>, <0, 1>, <1, 1>, <7, -4>, <-3, 2>, <-5, -8>, <-8, -3>> XX XXDef testmod \/and o aa = o XX (bu trans <0, 0, 1, 0, 1, 16, 3>) o XX aa mod o XX _<<1, 1>, <10, 10>, <1, 2>, <2, 1>, <35, -3>, <-35, 17>, <-27, -4>> XX XXDef testneg \/and o aa = o (bu trans <0, 0, 1, -1.0, 15.2, -17>) o XX aa neg o _<0, -0, -1, 1.0, -15.2, 17> XX XXDef testnot \/and o aa = o (bu trans ) o aa not o _ XX XXDef testnoteq \/and o aa = o XX (bu trans XX ) o aa != o XX _<<1, 1>, <1, 0>, <1, a>, <1, 'a>, <1, 1.0>, <1, 0.99>, XX <1, <>>, <1, T>, <1, F>, <1, <1>>, XX , , , , , >, XX , , >, XX <'a, 'a>, <'a, 'b>, <'a, 1>, <'a, a>, <'a, 1.0>, <'a, <>>, XX <'a, T>, <'a, F>, <'a, <'a>>, XX <1.0, 1.0>, <1.0, 2.0>, <1.0, 1>, <1.1, 1>, <1.0, 'a>, <1.0, a>, XX <1.0, <>>, <1.0, T>, <1.0, F>, <1.0, <1.0>>, XX , , , , >, , >, XX , , , , >, , >, XX <<>, <>>, <<>, 1>, <<>, 'F>, <<>, 1.0>, <<>, T>, <<>, F>, XX <<>, <<>>>, XX <, >, <, >, <, 1>, <, 'a>, <, 1.0>, XX <, <>>, <, T>, <, F>, <, <>>, XX <, >, e>, , >, e>>, XX <, >, e>, , >, e>>> XX XXDef testnull \/and o aa = o XX (bu trans ) o XX aa null o _<<>, 0, 1, a, '0, T, F, "", "nil", , XX , <, t, e>, r>> XX XXDef testor \/and o aa = o XX (bu trans ) o aa or o _<, , , > XX XXDef testplus \/and o aa = o XX (bu trans <0, 2, 1, 1, -2, 3, -9>) o XX aa + o _<<0, 0>, <1, 1>, <1, 0>, <0, 1>, <1, -3>, <-5, 8>, <-4, -5>> XX XXDef testreverse \/and o aa = o XX (bu trans XX <<>, , , <4, 3, 2, 1>, <, , >>) o XX aa reverse o XX _<<>, , , <1, 2, 3, 4>, <, , >> XX XXDef testrotl \/and o aa = o XX (bu trans XX <<>, , , <2, 3, 4, 5, 1>, <, , >>) o XX aa rotl o XX _<<>, , , <1, 2, 3, 4, 5>, <, , >> XX XXDef testrotr \/and o aa = o XX (bu trans XX <<>, , , <5, 1, 2, 3, 4>, <, , >>) o XX aa rotr o XX _<<>, , , <1, 2, 3, 4, 5>, <, , >> XX XXDef testtimes \/and o aa = o XX (bu trans <0, 0, 0, 9, -2, -4, 6, 6, 28, -18, -10>) o XX aa * o XX _<<0, 0>, <0, 5>, <1, 0>, <1, 9>, <1, -2>, <-1, 4>, <-1, -6>, XX <-2, -3>, <4, 7>, <-6, 3>, <5, -2>> XX XXDef testtl \/and o aa = o XX (bu trans <<>, , , <<>>, <>, <, >>) o XX aa tl o XX _<, <1, a>, , >, >, <, , >> XX XXDef testtlr \/and o aa = o XX (bu trans <<>, , , <<>>, <>, <, >>) o XX aa tlr o XX _<, , , <<>, a>, <, x>, <, , >> XX XXDef testtrans \/and o aa = o XX (bu trans XX <<>, <>, <>, XX <, , , , , >, <<1, 2, 3, 4, 5>>, XX <, >, <, , >, XX <, , , , >>) o XX aa trans o XX _<<<>>, <<>, <>>, <<>, <>, <>, <>, <>>, XX <>, <<1>, <2>, <3>, <4>, <5>>, XX <, >, <, <1, 2, 3>, >, XX <, <1, 2, 3, 4, 5>, >> SHAR_EOF if test 8494 -ne "`wc -c prims.fp`" then echo shar: error transmitting prims.fp '(should have been 8494 characters)' fi echo shar: extracting y.tab.c '(12220 characters)' sed 's/^XX//' << \SHAR_EOF > y.tab.c XX# define Def 257 XX# define Symbol 258 XX# define Sel 259 XX# define Rsel 260 XX# define Then 261 XX# define Else 262 XX# define Compose 263 XX# define Alpha 264 XX# define Insert 265 XX# define Rinsert 266 XX# define Tree 267 XX# define Bu 268 XX# define Bur 269 XX# define While 270 XX# define _ 95 XX# define Div 271 XX# define Geq 272 XX# define Leq 273 XX# define Noteq 274 XX# define TrueConst 275 XX# define FalseConst 276 XX# define String 277 XX# define CharConst 278 XX# define Float 279 XX#define yyclearin yychar = -1 XX#define yyerrok yyerrflag = 0 XXextern int yychar; XXextern short yyerrflag; XX#ifndef YYMAXDEPTH XX#define YYMAXDEPTH 150 XX#endif XX#ifndef YYSTYPE XX#define YYSTYPE int XX#endif XXYYSTYPE yylval, yyval; XX# define YYERRCODE 256 XX XX# line 157 "fpg.y" XX XX XX#include "lex.yy.c" XX XX#undef YYMAXDEPTH XX#define YYMAXDEPTH 2048 XX XXvoid parsefnstart (); XXvoid parsefnend (); XXvoid parsethen (); XXvoid parseelse (); XXvoid parseendif (); XXvoid parsebustart (); XXvoid parsebufun (); XXvoid parsebuobj (); XXvoid whilestart (); XXvoid whilepred (); XXvoid whilefun (); XXvoid parsecomp (); XXvoid startcomp (); XXvoid endcomp (); XXvoid parseaa (); XXvoid parseconstr (); XXvoid constrnext (); XXvoid endconstr (); XXvoid parseinsert (); XXvoid endinsert (); XXvoid parsesel (); XXvoid parsefncall (); XXvoid parsenil (); XXvoid consttrue (); XXvoid constfalse (); XXvoid constnum (); XXvoid constsym (); XXvoid conststr (); XXvoid constchr (); XXvoid constreal (); XXvoid liststart (); XXvoid listnext (); XXvoid listend (); XX XXshort yyexca[] ={ XX-1, 1, XX 0, -1, XX -2, 0, XX }; XX# define YYNPROD 70 XX# define YYLAST 275 XXshort yyact[]={ XX XX 13, 37, 25, 23, 84, 24, 33, 5, 3, 81, XX 45, 7, 40, 8, 91, 72, 88, 2, 82, 4, XX 28, 27, 29, 73, 12, 89, 44, 43, 42, 67, XX 41, 79, 90, 38, 65, 77, 36, 76, 53, 39, XX 13, 35, 25, 23, 75, 24, 62, 63, 64, 34, XX 66, 15, 92, 68, 61, 19, 6, 1, 80, 0, XX 28, 27, 29, 0, 0, 0, 0, 69, 70, 71, XX 0, 0, 0, 74, 0, 0, 0, 0, 0, 78, XX 0, 0, 0, 0, 83, 0, 85, 86, 0, 87, XX 0, 15, 0, 0, 0, 19, 0, 0, 0, 0, XX 0, 93, 94, 0, 95, 0, 0, 0, 0, 0, XX 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, XX 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, XX 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, XX 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, XX 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, XX 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, XX 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, XX 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, XX 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, XX 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, XX 0, 0, 0, 0, 0, 0, 0, 0, 22, 20, XX 21, 0, 0, 0, 14, 16, 17, 18, 9, 10, XX 11, 26, 30, 31, 32, 54, 49, 48, 0, 0, XX 0, 56, 55, 0, 0, 0, 58, 59, 60, 57, XX 0, 0, 0, 46, 47, 50, 51, 52, 22, 20, XX 21, 0, 0, 0, 14, 16, 17, 18, 0, 0, XX 0, 26, 30, 31, 32 }; XXshort yypact[]={ XX XX-249,-249,-1000,-251,-1000,-1000, -40,-1000,-255,-1000, XX-1000,-1000,-262,-1000, 0, -81,-1000,-1000,-1000, -22, XX-1000,-1000,-1000,-1000,-1000,-1000,-1000,-1000,-1000,-1000, XX-1000,-1000,-1000,-1000, -40, -40, -40,-1000, -40,-1000, XX-1000, -40, 0, 0, 0,-1000,-1000,-1000,-1000,-1000, XX-1000,-1000,-1000, -47,-1000,-1000,-1000,-1000,-1000,-1000, XX-1000, -40,-1000,-1000,-1000, 0,-1000, -35,-1000,-1000, XX-1000,-1000,-1000, -22,-258, -22, -22, -40,-1000, -25, XX-1000,-1000, -30,-1000,-1000,-1000,-1000,-1000,-1000, -40, XX-1000, -22, -40,-1000,-1000,-1000 }; XXshort yypgo[]={ XX XX 0, 57, 17, 56, 11, 13, 54, 52, 49, 44, XX 10, 41, 37, 36, 35, 24, 34, 33, 31, 30, XX 29, 28, 27, 26, 25, 23, 18 }; XXshort yyr1[]={ XX XX 0, 1, 1, 3, 2, 6, 7, 4, 8, 9, XX 4, 11, 12, 4, 13, 14, 4, 4, 5, 16, XX 5, 17, 18, 15, 15, 15, 19, 15, 21, 15, XX 22, 15, 23, 15, 15, 15, 15, 15, 15, 15, XX 15, 15, 15, 15, 15, 15, 15, 15, 20, 24, XX 20, 10, 10, 10, 10, 10, 10, 10, 10, 25, XX 10, 10, 10, 10, 10, 10, 10, 10, 26, 26 }; XXshort yyr2[]={ XX XX 0, 1, 2, 0, 4, 0, 0, 7, 0, 0, XX 5, 0, 0, 5, 0, 0, 5, 1, 1, 0, XX 4, 0, 0, 5, 2, 2, 0, 4, 0, 3, XX 0, 3, 0, 3, 2, 1, 1, 1, 1, 1, XX 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, XX 4, 1, 1, 1, 1, 1, 1, 1, 2, 0, XX 4, 1, 1, 1, 1, 1, 1, 1, 1, 3 }; XXshort yychk[]={ XX XX-1000, -1, -2, 257, -2, 258, -3, -4, -5, 268, XX 269, 270, -15, 40, 264, 91, 265, 266, 267, 95, XX 259, 260, 258, 43, 45, 42, 271, 61, 60, 62, XX 272, 273, 274, 261, -8, -11, -13, 263, -17, -15, XX 93, -19, -21, -22, -23, -10, 275, 276, 259, 258, XX 277, 278, 279, 60, 257, 264, 263, 271, 268, 269, XX 270, -6, -4, -4, -4, -16, -4, -20, -4, -15, XX -15, -15, 62, -25, -4, -9, -12, -14, -5, -18, XX 93, 44, -26, -10, 262, -10, -10, -4, 41, -24, XX 62, 44, -7, -4, -10, -4 }; XXshort yydef[]={ XX XX 0, -2, 1, 0, 2, 3, 0, 4, 17, 8, XX 11, 14, 18, 21, 0, 26, 28, 30, 32, 0, XX 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, XX 45, 46, 47, 5, 0, 0, 0, 19, 0, 24, XX 25, 0, 0, 0, 0, 34, 51, 52, 53, 54, XX 55, 56, 57, 59, 61, 62, 63, 64, 65, 66, XX 67, 0, 9, 12, 15, 0, 22, 0, 48, 29, XX 31, 33, 58, 0, 0, 0, 0, 0, 20, 0, XX 27, 49, 0, 68, 6, 10, 13, 16, 23, 0, XX 60, 0, 0, 50, 69, 7 }; XX#ifndef lint XXstatic char yaccpar_sccsid[] = "@(#)yaccpar 4.1 (Berkeley) 2/11/83"; XX#endif not lint XX XX# XX# define YYFLAG -1000 XX# define YYERROR goto yyerrlab XX# define YYACCEPT return(0) XX# define YYABORT return(1) XX XX/* parser for yacc output */ XX XX#ifdef YYDEBUG XXint yydebug = 0; /* 1 for debugging */ XX#endif XXYYSTYPE yyv[YYMAXDEPTH]; /* where the values are stored */ XXint yychar = -1; /* current input token number */ XXint yynerrs = 0; /* number of errors */ XXshort yyerrflag = 0; /* error recovery flag */ XX XXyyparse() { XX XX short yys[YYMAXDEPTH]; XX short yyj, yym; XX register YYSTYPE *yypvt; XX register short yystate, *yyps, yyn; XX register YYSTYPE *yypv; XX register short *yyxi; XX XX yystate = 0; XX yychar = -1; XX yynerrs = 0; XX yyerrflag = 0; XX yyps= &yys[-1]; XX yypv= &yyv[-1]; XX XX yystack: /* put a state and value onto the stack */ XX XX#ifdef YYDEBUG XX if( yydebug ) printf( "state %d, char 0%o\n", yystate, yychar ); XX#endif XX if( ++yyps> &yys[YYMAXDEPTH] ) { yyerror( "yacc stack overflow" ); return(1); } XX *yyps = yystate; XX ++yypv; XX *yypv = yyval; XX XX yynewstate: XX XX yyn = yypact[yystate]; XX XX if( yyn<= YYFLAG ) goto yydefault; /* simple state */ XX XX if( yychar<0 ) if( (yychar=yylex())<0 ) yychar=0; XX if( (yyn += yychar)<0 || yyn >= YYLAST ) goto yydefault; XX XX if( yychk[ yyn=yyact[ yyn ] ] == yychar ){ /* valid shift */ XX yychar = -1; XX yyval = yylval; XX yystate = yyn; XX if( yyerrflag > 0 ) --yyerrflag; XX goto yystack; XX } XX XX yydefault: XX /* default state action */ XX XX if( (yyn=yydef[yystate]) == -2 ) { XX if( yychar<0 ) if( (yychar=yylex())<0 ) yychar = 0; XX /* look through exception table */ XX XX for( yyxi=yyexca; (*yyxi!= (-1)) || (yyxi[1]!=yystate) ; yyxi += 2 ) ; /* VOID */ XX XX while( *(yyxi+=2) >= 0 ){ XX if( *yyxi == yychar ) break; XX } XX if( (yyn = yyxi[1]) < 0 ) return(0); /* accept */ XX } XX XX if( yyn == 0 ){ /* error */ XX /* error ... attempt to resume parsing */ XX XX switch( yyerrflag ){ XX XX case 0: /* brand new error */ XX XX yyerror( "syntax error" ); XX yyerrlab: XX ++yynerrs; XX XX case 1: XX case 2: /* incompletely recovered error ... try again */ XX XX yyerrflag = 3; XX XX /* find a state where "error" is a legal shift action */ XX XX while ( yyps >= yys ) { XX yyn = yypact[*yyps] + YYERRCODE; XX if( yyn>= 0 && yyn < YYLAST && yychk[yyact[yyn]] == YYERRCODE ){ XX yystate = yyact[yyn]; /* simulate a shift of "error" */ XX goto yystack; XX } XX yyn = yypact[*yyps]; XX XX /* the current yyps has no shift onn "error", pop stack */ XX XX#ifdef YYDEBUG XX if( yydebug ) printf( "error recovery pops state %d, uncovers %d\n", *yyps, yyps[-1] ); XX#endif XX --yyps; XX --yypv; XX } XX XX /* there is no state on the stack with an error shift ... abort */ XX XX yyabort: XX return(1); XX XX XX case 3: /* no shift yet; clobber input char */ XX XX#ifdef YYDEBUG XX if( yydebug ) printf( "error recovery discards char %d\n", yychar ); XX#endif XX XX if( yychar == 0 ) goto yyabort; /* don't discard EOF, quit */ XX yychar = -1; XX goto yynewstate; /* try again in the same state */ XX XX } XX XX } XX XX /* reduction by production yyn */ XX XX#ifdef YYDEBUG XX if( yydebug ) printf("reduce %d\n",yyn); XX#endif XX yyps -= yyr2[yyn]; XX yypvt = yypv; XX yypv -= yyr2[yyn]; XX yyval = yypv[1]; XX yym=yyn; XX /* consult goto table to find next state */ XX yyn = yyr1[yyn]; XX yyj = yypgo[yyn] + *yyps + 1; XX if( yyj>=YYLAST || yychk[ yystate = yyact[yyj] ] != -yyn ) yystate = yyact[yypgo[yyn]]; XX switch(yym){ XX XXcase 3: XX# line 13 "fpg.y" XX{ parsefnstart (yytext); } break; XXcase 4: XX# line 14 "fpg.y" XX{ parsefnend (); } break; XXcase 5: XX# line 19 "fpg.y" XX{ parsethen (); } break; XXcase 6: XX# line 22 "fpg.y" XX{ parseelse (); } break; XXcase 7: XX# line 24 "fpg.y" XX{ parseendif (); } break; XXcase 8: XX# line 26 "fpg.y" XX{ parsebustart (0); } break; XXcase 9: XX# line 28 "fpg.y" XX{ parsebufun (); } break; XXcase 10: XX# line 30 "fpg.y" XX{ parsebuobj (); } break; XXcase 11: XX# line 32 "fpg.y" XX{ parsebustart (1); } break; XXcase 12: XX# line 34 "fpg.y" XX{ parsebufun (); } break; XXcase 13: XX# line 36 "fpg.y" XX{ parsebuobj (); } break; XXcase 14: XX# line 38 "fpg.y" XX{ whilestart (); } break; XXcase 15: XX# line 40 "fpg.y" XX{ whilepred (); } break; XXcase 16: XX# line 42 "fpg.y" XX{ whilefun (); } break; XXcase 19: XX# line 49 "fpg.y" XX{ parsecomp (); } break; XXcase 21: XX# line 54 "fpg.y" XX{ startcomp (); } break; XXcase 22: XX# line 56 "fpg.y" XX{ endcomp (); } break; XXcase 24: XX# line 60 "fpg.y" XX{ parseaa (); } break; XXcase 25: XX# line 62 "fpg.y" XX{ parsenil (); } break; XXcase 26: XX# line 64 "fpg.y" XX{ parseconstr (); } break; XXcase 27: XX# line 67 "fpg.y" XX{ constrnext (); endconstr (); } break; XXcase 28: XX# line 69 "fpg.y" XX{ parseinsert (0); } break; XXcase 29: XX# line 71 "fpg.y" XX{ endinsert (); } break; XXcase 30: XX# line 73 "fpg.y" XX{ parseinsert (1); } break; XXcase 31: XX# line 75 "fpg.y" XX{ endinsert (); } break; XXcase 32: XX# line 77 "fpg.y" XX{ parseinsert (2); } break; XXcase 33: XX# line 79 "fpg.y" XX{ endinsert (); } break; XXcase 35: XX# line 82 "fpg.y" XX{ parsesel (yytext, 0); } break; XXcase 36: XX# line 84 "fpg.y" XX{ parsesel (yytext, 1); } break; XXcase 37: XX# line 86 "fpg.y" XX{ parsefncall (yytext); } break; XXcase 38: XX# line 88 "fpg.y" XX{ parsefncall ("plus"); } break; XXcase 39: XX# line 90 "fpg.y" XX{ parsefncall ("minus"); } break; XXcase 40: XX# line 92 "fpg.y" XX{ parsefncall ("times"); } break; XXcase 41: XX# line 94 "fpg.y" XX{ parsefncall ("div"); } break; XXcase 42: XX# line 96 "fpg.y" XX{ parsefncall ("eq"); } break; XXcase 43: XX# line 98 "fpg.y" XX{ parsefncall ("less"); } break; XXcase 44: XX# line 100 "fpg.y" XX{ parsefncall ("greater"); } break; XXcase 45: XX# line 102 "fpg.y" XX{ parsefncall ("gequal"); } break; XXcase 46: XX# line 104 "fpg.y" XX{ parsefncall ("lequal"); } break; XXcase 47: XX# line 106 "fpg.y" XX{ parsefncall ("notequal"); } break; XXcase 49: XX# line 111 "fpg.y" XX{ constrnext (); } break; XXcase 51: XX# line 115 "fpg.y" XX{ consttrue (); } break; XXcase 52: XX# line 117 "fpg.y" XX{ constfalse (); } break; XXcase 53: XX# line 119 "fpg.y" XX{ constnum (yytext); } break; XXcase 54: XX# line 121 "fpg.y" XX{ constsym (yytext); } break; XXcase 55: XX# line 123 "fpg.y" XX{ conststr (yytext); } break; XXcase 56: XX# line 125 "fpg.y" XX{ constchr (yytext); } break; XXcase 57: XX# line 127 "fpg.y" XX{ constreal (yytext); } break; XXcase 58: XX# line 129 "fpg.y" XX{ parsenil (); } break; XXcase 59: XX# line 131 "fpg.y" XX{ liststart (); } break; XXcase 60: XX# line 134 "fpg.y" XX{ listend (); } break; XXcase 61: XX# line 136 "fpg.y" XX{ constsym ("Def"); } break; XXcase 62: XX# line 138 "fpg.y" XX{ constsym ("aa"); } break; XXcase 63: XX# line 140 "fpg.y" XX{ constsym ("o"); } break; XXcase 64: XX# line 142 "fpg.y" XX{ constsym ("div"); } break; XXcase 65: XX# line 144 "fpg.y" XX{ constsym ("bu"); } break; XXcase 66: XX# line 146 "fpg.y" XX{ constsym ("bur"); } break; XXcase 67: XX# line 148 "fpg.y" XX{ constsym ("while"); } break; XXcase 68: XX# line 152 "fpg.y" XX{ listnext (); } break; XXcase 69: XX# line 155 "fpg.y" XX{ listnext (); } break; XX } XX goto yystack; /* stack new state and value */ XX XX } SHAR_EOF if test 12220 -ne "`wc -c y.tab.c`" then echo shar: error transmitting y.tab.c '(should have been 12220 characters)' fi # End of shell archive exit 0