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"