1: %{
   2: static char apl_y_Sccsid[] = "apl.y @(#)apl.y	1.3	10/5/82 Berkeley ";
   3: %}
   4: %union {
   5:     char    *charptr;
   6:     char    charval;
   7: }
   8: %term   lex0, lex1, lex2, lex3, lex4, lex5, lex6
   9: %term lpar, rpar, lbkt, rbkt, eol, unk
  10: %term <charval> com, com0, Quad, asg
  11: %term null, dot, cln, semi, comnt, tran
  12: %term <charptr> strng nam, numb, nfun, mfun, dfun
  13: %term <charval> comexpr, comnam, comnull, comlist
  14: 
  15: %term <charval> dscal, mdscal
  16: %term <charval> m, d, md, msub, mdsub
  17: 
  18: %type <charptr> func, header, args, autos, labels, label
  19: %type <charptr> fstat0, stat, statement, output, expr
  20: %type <charptr> e1, e2, number, subs, sub, monadic
  21: %type <charptr> dyadic, subr, anyname, hprint
  22: %type <charval> comand, lsub, monad, smonad, sdyad
  23: %type <charval> comp, dyad, mdcom, mondya, scalar
  24: 
  25: %{
  26: #include "apl.h"
  27:     int vcount;
  28:     int scount;
  29:     int litflag;
  30:     int nlexsym;
  31:     int context;
  32:     char    *iline;
  33:     char    *ccharp, *ccharp2;
  34:     data    lnumb;      /* current label number */
  35:     char    *labcpp;    /* label prologue */
  36:     char    *labcpe;    /* label epilogue */
  37:     int immedcmd;   /* immediate command number */
  38: %}
  39: 
  40: %%
  41: 
  42: /*
  43:  * line-at-a-time APL compiler.
  44:  * first lexical character gives context.
  45:  */
  46: line:
  47: 
  48: /*
  49:  * immediate.
  50:  */
  51:     lex0 stat =
  52:     {
  53:         integ = ccharp[-1];
  54:         if(integ != ASGN && integ != PRINT && integ != COMNT)
  55:             *ccharp++ = PRINT;
  56:         *ccharp++ = EOL;
  57:     } |
  58:     lex0 bcomand comand eol =
  59:     {
  60:         *ccharp++ = IMMED;
  61:         *ccharp++ = $3;
  62:     } |
  63: /*
  64:  * immediate mode state indicator stuff
  65:  */
  66:     lex0 tran eol =
  67:     {
  68:         *ccharp++ = SICLR0;
  69:     } |
  70:     lex0 tran expr eol =
  71:     {
  72:         *ccharp++ = SICLR;
  73:     } |
  74: /*
  75:  * quad input
  76:  */
  77:     lex1 stat |
  78: /*
  79:  * function definition
  80:  */
  81:     lex2 func |
  82: /*
  83:  * function prolog
  84:  */
  85:     lex3 func |
  86: /*
  87:  * function epilog
  88:  */
  89:     lex4 func |
  90: /*
  91:  * function body
  92:  */
  93:     lex5 fstat ;
  94: 
  95: 
  96: 
  97: 
  98: 
  99: 
 100: 
 101: 
 102: 
 103: /*
 104:  * function header
 105:  */
 106: func:
 107:     anyname asg header =
 108:     {
 109:         switch(context) {
 110: 
 111:         case lex3:
 112:             name($$, AUTO);
 113:             /*
 114: 			 * see comments in ai.c/funcomp() concerning
 115: 			 * label processing.
 116: 			 */
 117:             *ccharp++ = ELID;
 118:             break;
 119: 
 120:         case lex4:
 121:             ccharp2 = ccharp;
 122:             *ccharp++ = EOL;
 123:             name($$, RVAL);
 124:             name($$, REST);
 125:             invert($3, ccharp2);
 126:         }
 127:     } |
 128:     header =
 129:     {
 130:         if(context == lex3)
 131:             *ccharp++ = ELID;
 132:         if(context == lex4){
 133:             *ccharp++ = EOL;    /* pop previous result */
 134:             *ccharp++ = NILRET; /* return empty result */
 135:         }
 136:     } ;
 137: header:
 138:     args autos =
 139:     {
 140:         if(context == lex4)
 141:             invert($$, $2);
 142:     } ;
 143: 
 144: args:
 145:     anyname anyname anyname =
 146:     {
 147:         $$ = ccharp;
 148:         switch(context) {
 149: 
 150:         case lex2:
 151:             name($2, DF);
 152:             break;
 153: 
 154:         case lex3:
 155:             name($3, ARG2);
 156:             name($1, ARG1);
 157:             break;
 158: 
 159:         case lex4:
 160:             name($1, REST);
 161:             name($3, REST);
 162:         }
 163:     } |
 164:     anyname anyname =
 165:     {
 166:         $$ = ccharp;
 167:         switch(context) {
 168: 
 169:         case lex2:
 170:             name($1, MF);
 171:             break;
 172: 
 173:         case lex3:
 174:             name($2, ARG1);
 175:             break;
 176: 
 177:         case lex4:
 178:             name($2, REST);
 179:         }
 180:     } |
 181:     anyname =
 182:     {
 183:         if(context == lex2)
 184:             name($$, NF);
 185:         $$ = ccharp;
 186:     } ;
 187: autos:
 188:     semi nam autos =
 189:     {
 190:         $$ = $3;
 191:         switch(context) {
 192: 
 193:         case lex3:
 194:             name($2, AUTO);
 195:             break;
 196: 
 197:         case lex4:
 198:             ccharp2 = name($2, REST);
 199:             invert($$, ccharp2);
 200:         }
 201:     } |
 202:     eol =
 203:     {
 204:         $$ = ccharp;
 205:     } ;
 206: 
 207: /*
 208:  * system commands
 209:  */
 210: bcomand:
 211:     rpar =
 212:     {
 213:         litflag = -1;
 214:     } ;
 215: comand:
 216:     comexpr expr |
 217:     comnam anyname =
 218:     {
 219:         name($2, NAME);
 220:     } |
 221:     comlist anylist |
 222:     comnull ;
 223: 
 224: anylist:
 225:     anylist anyname =
 226:     {
 227:         *ccharp++ = IMMED;
 228:         *ccharp++ = immedcmd;
 229:         name($2, NAME);
 230:     } |
 231:     anyname =
 232:     {
 233:         name($1, NAME);
 234:     };
 235: 
 236: 
 237: /*
 238:  * statement:
 239:  *	comments
 240:  *	expressions
 241:  *	heterogeneous output
 242:  *	transfers (in functions)
 243:  */
 244: fstat:
 245:     labels fstat0 | fstat0;
 246: 
 247: labels:
 248:     label | labels label;
 249: 
 250: label:
 251:     anyname cln = {
 252:         if(labgen)
 253:             genlab($1);
 254:     }  ;
 255: 
 256: fstat0:
 257:     stat =
 258:     {
 259:         integ = ccharp[-1];
 260:         if(integ != ASGN && integ != PRINT && integ != COMNT)
 261:             *ccharp++ = PRINT;
 262:     } |
 263:     tran eol =
 264:     {
 265:         $$ = ccharp;
 266:         *ccharp++ = BRAN0;
 267:     } |
 268:     tran expr eol =
 269:     {
 270:         $$ = $2;
 271:         *ccharp++ = BRAN;
 272:     } ;
 273: stat:
 274:     eol =
 275:     {
 276:         $$ = ccharp;
 277:         *ccharp++ = COMNT;
 278:     } |
 279:     statement eol ;
 280: statement:
 281:     comnt =
 282:     {
 283:         litflag = 1;
 284:         $$ = ccharp;
 285:         *ccharp++ = COMNT;
 286:     } |
 287:     expr |
 288:     hprint ;
 289: hprint:
 290:     expr hsemi output ;
 291: output:
 292:     expr =
 293:     {
 294:         *ccharp++ = PRINT;
 295:     } |
 296:     hprint ;
 297: hsemi:
 298:     semi =
 299:     {
 300:         *ccharp++ = HPRINT;
 301:     };
 302: expr:
 303:     e1 |
 304:     monadic expr =
 305:     {
 306:         invert($$, $2);
 307:     } |
 308:     e1 dyadic expr =
 309:     {
 310:         invert($$, $3);
 311:     } ;
 312: e1:
 313:     e2 |
 314:     e2 lsub subs rbkt =
 315:     {
 316:         invert($$, $3);
 317:         *ccharp++ = INDEX;
 318:         *ccharp++ = scount;
 319:         scount = $2;
 320:     } ;
 321: e2:
 322:     nfun =
 323:     {
 324:         $$ = name($$, FUN);
 325:     } |
 326:     nam =
 327:     {
 328:         $$ = name($$, NAME);
 329:     } |
 330:     strng =
 331:     {
 332:         $$ = ccharp;
 333:         ccharp += 2;
 334:         integ = iline[-1];
 335:         vcount = 0;
 336:         for(;;) {
 337:             if(*iline == '\n') {
 338:                 nlexsym = unk;
 339:                 break;
 340:             }
 341:             if(*iline == integ) {
 342:                 iline++;
 343:                 if(*iline != integ)
 344:                     break;
 345:             }
 346:             *ccharp++ = *iline++;
 347:             vcount++;
 348:         }
 349:         ((struct chrstrct *)$$)->c[0] = QUOT;
 350:         ((struct chrstrct *)$$)->c[1] = vcount;
 351:     } |
 352:     vector =
 353:     {
 354:         *ccharp++ = CONST;
 355:         *ccharp++ = vcount;
 356:         invert($$, ccharp-2);
 357:     } |
 358:     lpar expr rpar =
 359:     {
 360:         $$ = $2;
 361:     } |
 362:     Quad =
 363:     {
 364:         $$ = ccharp;
 365:         *ccharp++ = $1;
 366:     } ;
 367: vector:
 368:     number vector =
 369:     {
 370:         vcount++;
 371:     } |
 372:     number =
 373:     {
 374:         vcount = 1;
 375:     } ;
 376: number:
 377:     numb =
 378:     {
 379:         $$ = ccharp;
 380:         ccharp += copy(DA,&datum,ccharp,1);
 381:     } ;
 382: 
 383: /*
 384:  * indexing subscripts
 385:  * optional expressions separated by semi
 386:  */
 387: lsub:
 388:     lbkt =
 389:     {
 390:         $$ = scount;
 391:         scount = 1;
 392:     } ;
 393: subs:
 394:     sub |
 395:     subs semi sub =
 396:     {
 397:         invert($$, $3);
 398:         scount++;
 399:     } ;
 400: sub:
 401:     expr |
 402:     =
 403:     {
 404:         $$ = ccharp;
 405:         *ccharp++ = ELID;
 406:     } ;
 407: 
 408: /*
 409:  * return a string of a monadic operator.
 410:  */
 411: monadic:
 412:     monad =
 413:     {
 414:         $$ = ccharp;
 415:         *ccharp++ = $1;
 416:     } |
 417:     smonad subr =
 418:     {
 419:         $$ = $2;
 420:         *ccharp++ = $1+1;
 421:     } |
 422:     mfun =
 423:     {
 424:         $$ = name($$, FUN);
 425:     } |
 426:     scalar comp =
 427:     {
 428:         $$ = ccharp;
 429:         *ccharp++ = $2+1;
 430:         *ccharp++ = $1;
 431:     } |
 432:     scalar com subr =
 433:     {
 434:         $$ = $3;
 435:         *ccharp++ = $2+3;
 436:         *ccharp++ = $1;
 437:     } ;
 438: monad:
 439:     m |
 440:     msub |
 441:     mondya =
 442:     {
 443:         $$++;
 444:     } ;
 445: smonad:
 446:     msub |
 447:     mdsub =
 448:     {
 449:         $$ += 2;
 450:     } ;
 451: 
 452: /*
 453:  * return a string of a dyadic operator.
 454:  */
 455: dyadic:
 456:     dyad =
 457:     {
 458:         $$ = ccharp;
 459:         *ccharp++ = $1;
 460:     } |
 461:     sdyad subr =
 462:     {
 463:         $$ = $2;
 464:         *ccharp++ = $1;
 465:     } |
 466:     dfun =
 467:     {
 468:         $$ = name($$, FUN);
 469:     } |
 470:     null dot scalar =
 471:     {
 472:         $$ = ccharp;
 473:         *ccharp++ = OPROD;
 474:         *ccharp++ = $3;
 475:     } |
 476:     scalar dot scalar =
 477:     {
 478:         $$ = ccharp;
 479:         *ccharp++ = IPROD;
 480:         *ccharp++ = $1;
 481:         *ccharp++ = $3;
 482:     } ;
 483: sdyad:
 484:     mdcom =
 485:     {
 486:         $$ += 2;
 487:     } ;
 488: 
 489: /*
 490:  * single expression subscript
 491:  * as found on operators to select
 492:  * a dimension.
 493:  */
 494: subr:
 495:     lbkt expr rbkt =
 496:     {
 497:         $$ = $2;
 498:     } ;
 499: 
 500: /*
 501:  * various combinations
 502:  */
 503: comp:
 504:     com | com0 ;
 505: dyad:
 506:     mondya | dscal | d | com0 | asg | com ;
 507: mdcom:
 508:     mdsub | com ;
 509: mondya:
 510:     mdscal | md | mdsub ;
 511: scalar:
 512:     mdscal | dscal ;
 513: anyname:
 514:     nam | nfun | mfun | dfun ;
 515: %%
 516: #include "tab.c"
 517: #include "lex.c"
Last modified: 1983-06-22
Generated: 2016-12-26
Generated by src2html V0.67
page hit count: 3159
Valid CSS Valid XHTML 1.0 Strict