From 9e463a9f75a7f14eac0d9934c3753daa9ef890c0 Mon Sep 17 00:00:00 2001 From: "Eric S. Raymond" Date: Thu, 3 Nov 1994 00:00:54 +0000 Subject: [PATCH] Initial revision --- cupl.y | 283 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++ main.c | 82 +++++++++++++++++ 2 files changed, 365 insertions(+) create mode 100644 cupl.y create mode 100644 main.c diff --git a/cupl.y b/cupl.y new file mode 100644 index 0000000..08d7697 --- /dev/null +++ b/cupl.y @@ -0,0 +1,283 @@ +/***************************************************************************** + +NAME + cupl.y -- grammar for the CUPL language + +SYNOPSIS + int yyparse() -- parse CUPL on stdin + +DESCRIPTION + This YACC grammar parses the CUPL language, as described in Appendix A of +R.J. Walker's manual. All it does is build a parse tree for later code +generation and interpretation. + +AUTHOR + Eric S. Raymond , November 1994. The +author retains copyright on this implementation. Permission for +nonprofit and educational use is granted to all; if you're planning to +make money with this or any code derived from it, check with the +author first. + +****************************************************************************/ +%{ +#include +#include +#include + +#define NULLNODE (node *)NULL +%} + +%start program + +%union +{ + struct edon *node; +} + +/* keywords */ +%token ABS ALL ALLOCATE AND ATAN BLOCK BY COMMENT COS DET DOT ELSE END EXP +%token FLOOR FOR GE GO GT IDN IF INV LE LET LN LOG LT MAX MIN NE OR PERFORM +%token POSMAX POSMIN RAND READ SGM SIN SQRT STOP THEN TIMES TO TRC TRN +%token WATCH WHILE WRITE DATA + +%token POWER +%token STRING +%token NUMBER +%token IDENTIFIER + +%token LPAREN ')' +%token RPAREN '(' +%token PLUS '+' +%token MINUS '-' +%token MULTIPLY '*' +%token DIVIDE '/' +%token EQUAL '=' +%token PERIOD '.' +%token COMMA ',' + +%left '+' '-' +%left '*' '/' +%left UMINUS +%nonassoc POWER + +/* internal node types */ +%token FWRITE +%token OG +%token UMINUS +%token SUBSCRIPT +%token STATEMENT +%token VARLIST +%token FORLIST +%token DATALIST +%token LABEL +%token IFELSE +%token DIMENSION +%token ISLICE JSLICE + +%type prog command cond simple guard perform iter expr rel alloc subscr +%type datal ditem expl readl writel witem allocl varlist minl maxl + +%% /* beginning of rules section */ + +/* a program description consists of a sequence of statements */ +program : prog {interpret($1);} + +prog : command prog {$$ = cons(STATEMENT, $1, $2);} + | IDENTIFIER command prog {$$ = cons(STATEMENT, + cons(LABEL, $1, $2), $3);} + | /* EMPTY */ {$$ = (node *)NULL;} + ; + +/* statement syntax */ + +command : simple {$$ = $1;} + | cond {$$ = $1;} + | perform {$$ = $1;} + | BLOCK {$$ = cons(BLOCK, NULLNODE, NULLNODE);} + | END {$$ = cons(END, NULLNODE, NULLNODE);} + | DATA datal {$$ = cons(DATA, NULLNODE, $2);} + ; + +cond : IF guard THEN simple + {$$ = cons(IF, $2, $4);} + | IF guard ELSE simple + {$$ = cons(IFELSE, $2, cons(THEN, $4, (node *)NULL));} + | IF guard THEN simple ELSE simple + {$$ = cons(IFELSE, $2, cons(THEN, $4, $6));} + ; + +ditem : NUMBER {$$ = $1;} + | IDENTIFIER '=' NUMBER {$$ = cons(LET,$1, $3);} + ; + +datal : ditem ',' datal {$$ = cons(DATALIST, $1, $3);} + | ditem datal {$$ = cons(DATALIST, $1, $2);} + | ditem {$$ = cons(DATALIST, $1, NULLNODE);} + ; + +perform : PERFORM IDENTIFIER + {$$ = cons(PERFORM, NULLNODE, $2);} + | PERFORM IDENTIFIER expr TIMES + {$$ = cons(TIMES, $3, $2);} + | PERFORM IDENTIFIER WHILE guard + {$$ = cons(WHILE, $4, $2);} + | PERFORM IDENTIFIER FOR IDENTIFIER '=' expl + {$$ = cons(FOR, $2, cons('=', $4, $6));} + | PERFORM IDENTIFIER FOR IDENTIFIER '=' expr iter + {$$ = cons(FOR, $2, cons(FOR, $4, cons(FOR, $6, $7)));} + ; + +iter : TO expr BY expr {$$ = cons(TO, $2, $4);} + | BY expr TO expr {$$ = cons(TO, $4, $2);} + | TO expr {$$ = cons(TO, $2, (node *)NULL);} + ; + +expl : expr ',' expl {$$ = cons(FORLIST, $1, $3);} + | expr {$$ = cons(FORLIST, $1, NULLNODE);} + ; + +/* guard syntax */ + +/* + * this relaxes the pure-AND/pure-OR rule on guards, in order to avoid + * a parser ambiguity; we can check the rule at runtime + */ +guard : rel {$$ = $1;} + | rel AND rel {$$ = cons(AND, $1, $3);} + | rel OR rel {$$ = cons(OR, $1, $3);} + ; + +rel : expr '=' expr {$$ = cons('=', $1, $3);} + | expr NE expr {$$ = cons(NE, $1, $3);} + | expr LE expr {$$ = cons(LE, $1, $3);} + | expr GE expr {$$ = cons(GE, $1, $3);} + | expr LT expr {$$ = cons(LT, $1, $3);} + | expr GT expr {$$ = cons(GT, $1, $3);} + ; + +/* simple statement types */ + +simple : LET IDENTIFIER '=' expr {$$ = cons(LET, $2, $4);} + | GO TO IDENTIFIER {$$ = cons(GO, $3, NULLNODE);} + | GO TO IDENTIFIER END {$$ = cons(OG, $3, NULLNODE);} + | READ readl {$$ = $2;} + | WRITE writel {$$ = $2;} + | ALLOCATE allocl {$$ = $2;} + | WATCH varlist {$$ = $2;} + | STOP {$$ = cons(STOP, NULLNODE, NULLNODE);} + ; + +readl : IDENTIFIER ',' readl {$$ = cons(READ, $1, $3);} + | IDENTIFIER {$$ = cons(READ, $1, NULLNODE);} + ; + +writel : witem ',' writel {$$ = cons(WRITE, $1, $3);} + | witem {$$ = cons(WRITE, $1, NULLNODE);} + ; + +witem : IDENTIFIER {$$ = cons(WRITE, $1, NULLNODE);} + | '/' IDENTIFIER {$$ = cons(FWRITE, $2, NULLNODE);} + | STRING {$$ = cons(FWRITE, $1, NULLNODE);} + | /* EMPTY */ {$$ = (node *)NULL;} + ; + +allocl : alloc ',' allocl {$$ = cons(VARLIST, $1, $3);} + | alloc {$$ = cons(VARLIST, $1, NULLNODE);} + ; + +alloc : IDENTIFIER '(' expr ')' + {$$ = cons(ALLOCATE, $1, $3);} + | IDENTIFIER '(' expr ',' expr ')' + {$$ = cons(ALLOCATE, $1, cons(DIMENSION, $3, $5));} + ; + +varlist : IDENTIFIER ',' varlist {$$ = cons(WATCH, $1, $3);} + | IDENTIFIER {$$ = cons(WATCH, $1, NULLNODE);} + ; + +/* expression syntax */ + +expr : NUMBER {$$ = $1;} + | IDENTIFIER {$$ = $1;} + + | '(' expr ')' {$$ = $2;} + | expr '+' expr {$$ = cons(PLUS, $1, $3);} + | expr '-' expr {$$ = cons(MINUS, $1, $3);} + | '-' expr %prec UMINUS {$$ = cons(UMINUS, NULLNODE, $2);} + | expr '*' expr {$$ = cons(MULTIPLY, $1, $3);} + | expr '/' expr {$$ = cons(DIVIDE, $1, $3);} + | expr POWER expr {$$ = cons(POWER, $1, $3);} + + | IDN {$$ = cons(IDN, NULLNODE, NULLNODE);} + | subscr {$$ = $1;} + + | ABS '(' expr ')' {$$ = cons(ABS, NULLNODE, $3);} + | ATAN '(' expr ')' {$$ = cons(ATAN, NULLNODE, $3);} + | COS '(' expr ')' {$$ = cons(COS, NULLNODE, $3);} + | EXP '(' expr ')' {$$ = cons(EXP, NULLNODE, $3);} + | FLOOR '(' expr ')' {$$ = cons(FLOOR, NULLNODE, $3);} + | LOG '(' expr ')' {$$ = cons(LOG, NULLNODE, $3);} + | SQRT '(' expr ')' {$$ = cons(SQRT, NULLNODE, $3);} + | SIN '(' expr ')' {$$ = cons(SIN, NULLNODE, $3);} + | RAND '(' expr ')' {$$ = cons(RAND, NULLNODE, $3);} + | DET '(' expr ')' {$$ = cons(DET, NULLNODE, $3);} + | DOT '(' expr ',' expr ')' {$$ = cons(DOT, $3, $5);} + | INV '(' expr ')' {$$ = cons(INV, NULLNODE, $3);} + | POSMAX '(' expr ')' {$$ = cons(POSMAX, NULLNODE, $3);} + | POSMIN '(' expr ')' {$$ = cons(POSMIN, NULLNODE, $3);} + | SGM '(' expr ')' {$$ = cons(SGM, NULLNODE, $3);} + | TRC '(' expr ')' {$$ = cons(TRC, NULLNODE, $3);} + | TRN '(' expr ')' {$$ = cons(TRN, NULLNODE, $3);} + + | MAX '(' expr ',' maxl ')' {$$ = cons(MAX, $3, $5);} + | MIN '(' expr ',' minl ')' {$$ = cons(MIN, $3, $5);} + ; + +maxl : expr ',' maxl {$$ = cons(MAX, $1, $3);} + | expr {$$ = cons(MAX, $1, NULLNODE);} + ; + +minl : expr ',' minl {$$ = cons(MIN, $1, $3);} + | expr {$$ = cons(MIN, $1, NULLNODE);} + ; + +subscr : IDENTIFIER '(' expr ')' + {$$ = cons(SUBSCRIPT, $1, $3);} + | IDENTIFIER '(' expr ',' expr ')' + {$$ = cons(SUBSCRIPT, $1, cons(DIMENSION, $3, $5));} + | IDENTIFIER '(' expr ',' '*' ')' + {$$ = cons(JSLICE, $1, $3);} + | IDENTIFIER '(' '*' ',' expr ')' + {$$ = cons(ISLICE, $1, $5);} + ; +%% +#include "cupl.h" + +node *cons(op, left, right) +/* make a cons for a binary operation */ +int op; /* opcode */ +node *left, *right; /* child nodes */ +{ + node *new; + + /* get a node */ + if ((new = (node *)malloc(sizeof(node))) == (node *)NULL) + { + (void) puts(NOMEM); + exit(1); + } + + new->type = op; + new->u.n.left = left; + new->u.n.right = right; + +#ifdef PARSEDEBUG + if (verbose >= 2) + (void) printf("cons: %9x -> %9x %9x (%s)\n", + new, left, right, tokdump(op)); +#endif /* PARSEDEBUG */ + + return(new); +} + +/* cupl.y ends here */ diff --git a/main.c b/main.c new file mode 100644 index 0000000..403d0eb --- /dev/null +++ b/main.c @@ -0,0 +1,82 @@ +/***************************************************************************** + +NAME + main.c -- main sequence of the CUPL compiler + +SYNOPSIS + cupl [-v] [file...] + +DESCRIPTION + The main sequence of the Cornell University Programming Language compiler. +All the real work is done by yyparse. May set globals verbose and yydebug. + +*****************************************************************************/ +/*LINTLIBRARY*/ +#include +#include +#include +#include "cupl.h" + +extern FILE *yyin; /* the program text file descriptor */ +extern int yylineno; /* the current source line count */ +extern int yydebug; /* enable YACC instrumentation? */ + +#define CANTOPN "can't open file %s\n" +#define USAGE "usage: cupl [-v nnn]\n" + +int verbose; /* verbosity level of the interpreter */ + +static int execfile(const char *file) +/* translate a CUPL file in the current directory */ +{ + if (file == (char *)NULL) + yyin = stdin; + else + { + if ((yyin = fopen(file, "r")) == (FILE *)NULL) + { + (void) fprintf(stderr, CANTOPN, file); + return(1); + } + } + + yyparse(); /* build and interpret the parse tree */ + + if (file) + (void) fclose(yyin); + + return(0); +} + +main(argc, argv) +int argc; +char *argv[]; +{ + extern int optind; /* getopt() sets this */ + extern char *optarg; /* and this */ + extern char *getenv(); + int c; + + while ((c = getopt(argc, argv, "v:")) != EOF) + switch (c) + { + case 'v': + verbose = atoi(optarg); + if (strchr(optarg, 'y')) + yydebug = 1; + break; + + default: + (void) fprintf(stderr, USAGE); + break; + } + + if (optind == argc) + return(execfile((char *)NULL)); + else + for (; optind < argc; optind++) + if (execfile(argv[optind])) + break; +} + +/* main.c ends here */ -- 2.43.0