BSD 4 development

[unix-history] / usr / src / cmd / apl / apl.y

%term   lex0, lex1, lex2, lex3, lex4, lex5, lex6
%term   lpar, rpar, lbkt, rbkt, eol, unk
%term   com, com0, strng, null, dot, cln
%term   quad, semi, comnt, tran, asg
%term   nam, numb, nfun, mfun, dfun
%term   comexpr, comnam, comnull

%term           dscal,  mdscal
%term   m,      d,      md
%term   msub,   mdsub,

%{
#include "apl.h"
       int     vcount;
       int     scount;
       int     litflag;
       int     nlexsym;
       int     context;
       unsigned        char    *iline;
       char    *ccharp;
%}

%%

/*
* line-at-a-time APL compiler.
* first lexical character gives context.
*/
line:

/*
* immediate.
*/
   lex0 stat =
       {
               integ = ccharp[-1];
               if(integ != ASGN && integ != PRINT)
                       *ccharp++ = PRINT;
               *ccharp++ = EOL;
       } |
   lex0 bcomand comand eol =
       {
               *ccharp++ = IMMED;
               *ccharp++ = $3;
       } |
/*
* quad
*/
   lex1 stat |
/*
* function definition
*/
   lex2 func |
/*
* function prolog
*/
   lex3 func |
/*
* function epilog
*/
   lex4 func |
/*
* function body
*/
   lex5 fstat ;









/*
* function header
*/
func:
   anyname asg header =
       {
               switch(context) {

               case lex3:
                       name($$, AUTO);
                       *ccharp++ = ELID;
                       break;

               case lex4:
                       integ = ccharp;
                       *ccharp++ = EOL;
                       name($$, NAME);
                       name($$, REST);
                       invert($3, integ);
               }
       } |
   header =
       {
               if(context == lex3)
                       *ccharp++ = ELID;
       } ;
header:
   args autos =
       {
               if(context == lex4)
                       invert($$, $2);
       } ;

args:
   anyname anyname anyname =
       {
               $$ = ccharp;
               switch(context) {

               case lex2:
                       name($2, DF);
                       break;

               case lex3:
                       name($1, ARG1);
                       name($3, ARG2);
                       break;

               case lex4:
                       name($1, REST);
                       name($3, REST);
               }
       } |
   anyname anyname =
       {
               $$ = ccharp;
               switch(context) {

               case lex2:
                       name($1, MF);
                       break;

               case lex3:
                       name($2, ARG1);
                       break;

               case lex4:
                       name($2, REST);
               }
       } |
   anyname =
       {
               if(context == lex2)
                       name($$, NF);
               $$ = ccharp;
       } ;
autos:
   semi nam autos =
       {
               $$ = $3;
               switch(context) {

               case lex3:
                       name($2, AUTO);
                       break;

               case lex4:
                       integ = name($2, REST);
                       invert($$, integ);
               }
       } |
   eol =
       {
               $$ = ccharp;
       } ;

/*
* system commands
*/
bcomand:
   rpar =
       {
               litflag = -1;
       } ;
comand:
   comexpr expr |
   comnam anyname =
       {
               name($2, NAME);
       } |
   comnull ;

/*
* statement:
*      comments
*      expressions
*      heterogeneous output
*      transfers (in functions)
*/
fstat:
   numb cln realfstat = {
       $$ = $3;
   } |
   realfstat = $$ = $1;

realfstat:
   stat |
   tran eol =
       {
               $$ = ccharp;
               *ccharp++ = BRAN0;
       } |
   tran expr eol =
       {
               $$ = $2;
               *ccharp++ = BRAN;
       } ;
stat:
   statement eol ;
statement:
   comnt =
       {
               litflag = 1;
               $$ = ccharp;
               *ccharp++ = COMNT;
       } |
   expr |
   hprint ;
hprint:
   expr hsemi output ;
output:
   expr =
       {
               *ccharp++ = PRINT;
       } |
   hprint ;
hsemi:
   semi =
       {
               *ccharp++ = HPRINT;
       };
expr:
   e1 |
   monadic expr =
       {
               invert($$, $2);
       } |
   e1 dyadic expr =
       {
               invert($$, $3);
       } ;
e1:
   e2 |
   e2 lsub subs rbkt =
       {
               invert($$, $3);
               *ccharp++ = INDEX;
               *ccharp++ = scount;
               scount = $2;
       } ;
e2:
   nfun =
       {
               $$ = name($$, FUN);
       } |
   nam =
       {
               $$ = name($$, NAME);
       } |
   strng =
       {
               $$ = ccharp;
               ccharp += 2;
               integ = iline[-1];
               vcount = 0;
               for(;;) {
                       if(*iline == '\n') {
                               nlexsym = unk;
                               break;
                       }
                       if(*iline == integ) {
                               iline++;
                               break;
                       }
                       *ccharp++ = *iline++;
                       vcount++;
               }
               $$->c[0] = QUOT;
               $$->c[1] = vcount;
       } |
   vector =
       {
               *ccharp++ = CONST;
               *ccharp++ = vcount;
               invert($$, ccharp-2);
       } |
   lpar expr rpar =
       {
               $$ = $2;
       } |
   quad =
       {
               $$ = ccharp;
               *ccharp++ = $1;
       } ;
vector:
   number vector =
       {
               vcount++;
       } |
   number =
       {
               vcount = 1;
       } ;
number:
   numb =
       {
               $$ = ccharp;
               for(integ=0; integ<SDAT; integ++)
                       *ccharp++ = datum.c[integ];
       } ;

/*
* indexing subscripts
* optional expressions separated by semi
*/
lsub:
   lbkt =
       {
               $$ = scount;
               scount = 1;
       } ;
subs:
   sub |
   subs semi sub =
       {
               invert($$, $3);
               scount++;
       } ;
sub:
   expr |
       =
       {
               $$ = ccharp;
               *ccharp++ = ELID;
       } ;

/*
* return a string of a monadic operator.
*/
monadic:
   monad =
       {
               $$ = ccharp;
               *ccharp++ = $1;
       } |
   smonad subr =
       {
               $$ = $2;
               *ccharp++ = $1+1;
       } |
   mfun =
       {
               $$ = name($$, FUN);
       } |
   scalar comp =
       {
               $$ = ccharp;
               *ccharp++ = $2+1;
               *ccharp++ = $1;
       } |
   scalar com subr =
       {
               $$ = $3;
               *ccharp++ = $2+3;
               *ccharp++ = $1;
       } ;
monad:
   m |
   msub |
   mondya =
       {
               $$++;
       } ;
smonad:
   msub |
   mdsub =
       {
               $$ += 2;
       } ;

/*
* return a string of a dyadic operator.
*/
dyadic:
   dyad =
       {
               $$ = ccharp;
               *ccharp++ = $1;
       } |
   sdyad subr =
       {
               $$ = $2;
               *ccharp++ = $1;
       } |
   dfun =
       {
               $$ = name($$, FUN);
       } |
   null dot scalar =
       {
               $$ = ccharp;
               *ccharp++ = OPROD;
               *ccharp++ = $3;
       } |
   scalar dot scalar =
       {
               $$ = ccharp;
               *ccharp++ = IPROD;
               *ccharp++ = $1;
               *ccharp++ = $3;
       } ;
sdyad:
   mdcom =
       {
               $$ += 2;
       } ;

/*
* single expression subscript
* as found on operators to select
* a dimension.
*/
subr:
   lbkt expr rbkt =
       {
               $$ = $2;
       } ;

/*
* various combinations
*/
comp:
   com | com0 ;
dyad:
   mondya | dscal | d | com0 | asg | com ;
mdcom:
   mdsub | com ;
mondya:
   mdscal | md | mdsub ;
scalar:
   mdscal | dscal ;
anyname:
   nam | nfun | mfun | dfun ;
%%
#include "tab.c"
#include "lex.c"