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