![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to apl.y CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 40BSD / cmd / apl|
Return to apl.y CVS log | Up to [CSRG BSD Unix] / 40BSD / cmd / apl |
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.