![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to parser.l CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSD / ucb / fp|
Return to parser.l CVS log | Up to [CSRG BSD Unix] / 43BSD / ucb / fp |
1.1 root 1: ; FP interpreter/compiler
2: ; Copyright (c) 1982 Scott B. Baden
3: ; Berkeley, California
4: ;
5: ; Copyright (c) 1982 Regents of the University of California.
6: ; All rights reserved. The Berkeley software License Agreement
7: ; specifies the terms and conditions for redistribution.
8: ;
9: (setq SCCS-parser.l "@(#)parser.l 5.1 (Berkeley) 5/31/85")
10:
11: (include specials.l)
12: (declare (special flag)
13: (localf get_condit trap_err Push
14: prs_fn get_def get_constr get_while Pop))
15:
16: (defun parse (a_flag)
17: (let ((flag a_flag))
18: (do
19: ((tkn (get_tkn) (get_tkn))
20: (rslt nil) (action nil) (wslen 0) (stk nil))
21:
22: ((eq tkn 'eof$$) (cond ((eq flag 'top_lev) 'eof$$)
23: (t (*throw 'parse$err '(err$$ eof)))))
24:
25: (cond ((null (plist (prs_fn))) (*throw 'parse$err `(err$$ unknown ,tkn))))
26: (cond ((find 'badtkn$$ tkn) (*throw 'parse$err `(err$$ badtkn ,(cadr tkn)))))
27: (setq action (get (prs_fn) flag))
28: (cond ((null action) (*throw 'parse$err `(err$$ illeg ,tkn))))
29: (setq rslt (funcall action))
30: (cond ((eq rslt 'cmd$$) (return rslt)))
31: (cond ((not (listp rslt)) (*throw 'parse$err `(err$$ fatal1 ,stk ,tkn ,rslt))))
32: (cond ((eq (car rslt) 'return)
33: (return
34: (cond ((eq (cadr rslt) 'done) (cdr rslt))
35: (t (cadr rslt)))))
36:
37: ((eq (car rslt) 'Push)
38: (cond ((eq flag 'while$$)
39: (cond ((or (zerop wslen) (onep wslen))
40: (Push (cadr rslt)))
41: ((twop wslen) (*throw 'parse$err `(err$$ bad_whl ,stk ,tkn)))
42: (t (*throw 'parse$err '(err$$ bad_while parse)))))
43: (t
44: (cond ((null stk) (Push (cadr rslt)))
45: (t (*throw 'parse$err `(err$$ stk_ful ,stk ,tkn)))))))
46:
47: ((eq (car rslt) 'nothing))
48: (t (*throw 'parse$err `(err$$ fatal2 ,stk ,tkn ,rslt)))))))
49:
50:
51: ; These are the parse action functions.
52: ; There is one for each token-context combination.
53: ; The contexts are:
54: ; top_lev,constr$$,compos$$,alpha$$,insert$$.
55: ; The name of each function is formed by appending p$ to the
56: ; name of the token just parsed.
57: ; For each function name there is actually a set of functions
58: ; associated by a plist (keyed on the context).
59:
60: (defun (p$lbrace$$ top_lev) nil
61: (cond (in_def (*throw 'parse$err '(err$$ ill_lbrace)))
62: (t (list 'nothing (get_def)))))
63:
64: (defun (p$rbrace$$ top_lev) nil
65: (cond ((not in_def) (*throw 'parse$err '(err$$ ill_rbrace)))
66: (t (progn
67: (cond ((null stk) (*throw 'parse$err '(err$$ stk_emp)))
68: ((null infile)
69: (do
70: ((c (Tyi) (Tyi)))
71: ((eq c 10)))))
72: `(return ,(Pop))))))
73:
74: (defun (p$rbrace$$ semi$$) nil
75: (cond
76: ((not in_def) (*throw 'parse$err '(err$$ ill_rbrace)))
77: (t (progn
78: (cond ((null stk) (*throw 'parse$err '(err$$ stk_emp)))
79: ((null infile)
80: (do
81: ((c (Tyi) (Tyi)))
82: ((eq c 10)))))
83: `(rbrace$$ ,(Pop))))))
84:
85: (defun trap_err (p)
86: (cond ((find 'err$$ p) (*throw 'parse$err p))
87: (t p)))
88:
89: (defun (p$lparen$$ top_lev) nil
90: (cond ((not (null stk)) (*throw 'parse$err '(err$$ ill_lpar)))
91: (t `(Push ,(trap_err (*catch '(parse$err end_while end_condit) (parse tkn)))))))
92:
93: (defun (p$lparen$$ constr$$) nil
94: (cond ((not (null stk)) (*throw 'parse$err '(err$$ ill_lpar)))
95: (t `(Push ,(trap_err (*catch '(parse$err end_while end_condit) (parse tkn)))))))
96:
97: (defun (p$lparen$$ compos$$) nil
98: (cond ((not (null stk)) (*throw 'parse$err '(err$$ ill_lpar)))
99: (t `(return ,(trap_err (*catch '(parse$err end_while end_condit) (parse tkn)))))))
100:
101: (defun (p$lparen$$ alpha$$) nil
102: (cond ((not (null stk)) (*throw 'parse$err '(err$$ ill_lpar)))
103: (t `(return ,(trap_err (*catch '(parse$err end_while end_condit) (parse tkn)))))))
104:
105: (defun (p$lparen$$ ti$$) nil
106: (cond ((not (null stk)) (*throw 'parse$err '(err$$ ill_lpar)))
107: (t `(return ,(trap_err (*catch '(parse$err end_while end_condit) (parse tkn)))))))
108:
109: (defun (p$lparen$$ insert$$) nil
110: (cond ((not (null stk)) (*throw 'parse$err '(err$$ ill_lpar)))
111: (t `(return ,(trap_err (*catch '(parse$err end_while end_condit) (parse tkn)))))))
112:
113: (defun (p$lparen$$ arrow$$) nil
114: (cond ((not (null stk)) (*throw 'parse$err '(err$$ ill_lpar)))
115: (t `(Push ,(trap_err (*catch '(parse$err end_while end_condit) (parse tkn)))))))
116:
117: (defun (p$lparen$$ semi$$) nil
118: (cond ((not (null stk)) (*throw 'parse$err '(err$$ ill_lpar)))
119: (t `(Push ,(trap_err (*catch '(parse$err end_while end_condit) (parse tkn)))))))
120:
121: (defun (p$lparen$$ lparen$$) nil
122: (cond ((not (null stk)) (*throw 'parse$err '(err$$ ill_lpar)))
123: (t `(Push ,(trap_err (*catch '(parse$err end_while end_condit) (parse tkn)))))))
124:
125: (defun (p$lparen$$ while$$) nil
126: (cond ((twop wslen) (*throw 'parse$err '(err$$ ill_lpar)))
127: (t `(Push ,(trap_err (*catch '(parse$err end_while end_condit) (parse tkn)))))))
128:
129: (defun (p$rparen$$ lparen$$) nil
130: `(return ,(Pop)))
131:
132: (defun (p$rparen$$ top_lev) nil ; process commands
133: (cond ((not (null stk)) (*throw 'parse$err '(err$$ unbalparen)))
134: (t (cond ((null infile) (get_cmd))
135: (t (patom "commands may not be issued from a file")
136: (terpri)
137: 'cmd$$)))))
138:
139: (defun (p$rparen$$ semi$$) nil
140: `(return ,(Pop)))
141:
142: (defun (p$rparen$$ while$$) nil
143: `(return ,(nreverse (list (Pop) (Pop)))))
144:
145: (defun (p$alpha$$ top_lev) nil
146: (cond ((not (null stk)) (*throw 'parse$err '(err$$ ill_alpha)))
147: (t `(Push ,(frm_hnk 'alpha$$ (parse tkn))))))
148:
149: (defun (p$alpha$$ compos$$) nil
150: (cond ((not (null stk)) (*throw 'parse$err '(err$$ ill_alpha)))
151: (t `(return ,(frm_hnk 'alpha$$ (parse tkn))))))
152:
153: (defun (p$alpha$$ constr$$) nil
154: (cond ((not (null stk)) (*throw 'parse$err '(err$$ ill_alpha)))
155: (t `(Push ,(frm_hnk 'alpha$$ (parse tkn))))))
156:
157: (defun (p$alpha$$ insert$$) nil
158: (cond ((not (null stk)) (*throw 'parse$err '(err$$ ill_alpha)))
159: (t `(return ,(frm_hnk 'alpha$$ (parse tkn))))))
160:
161: (defun (p$alpha$$ ti$$) nil
162: (cond ((not (null stk)) (*throw 'parse$err '(err$$ ill_alpha)))
163: (t `(return ,(frm_hnk 'alpha$$ (parse tkn))))))
164:
165: (defun (p$alpha$$ alpha$$) nil
166: (cond ((not (null stk)) (*throw 'parse$err '(err$$ ill_alpha)))
167: (t `(return ,(frm_hnk 'alpha$$ (parse tkn))))))
168:
169: (defun (p$alpha$$ lparen$$) nil
170: (cond ((not (null stk)) (*throw 'parse$err '(err$$ ill_alpha)))
171: (t `(Push ,(frm_hnk 'alpha$$ (parse tkn))))))
172:
173: (defun (p$alpha$$ arrow$$) nil
174: (cond ((not (null stk)) (*throw 'parse$err '(err$$ ill_alpha)))
175: (t `(Push ,(frm_hnk 'alpha$$ (parse tkn))))))
176:
177: (defun (p$alpha$$ semi$$) nil
178: (cond ((not (null stk)) (*throw 'parse$err '(err$$ ill_alpha)))
179: (t `(Push ,(frm_hnk 'alpha$$ (parse tkn))))))
180:
181: (defun (p$alpha$$ while$$) nil
182: (cond ((twop wslen) (*throw 'parse$err '(err$$ ill_alpha)))
183: (t `(Push ,(frm_hnk 'alpha$$ (parse tkn))))))
184:
185:
186: (defun (p$insert$$ top_lev) nil
187: (cond ((not (null stk)) (*throw 'parse$err '(err$$ ill_insert)))
188: (t `(Push ,(frm_hnk 'insert$$ (parse tkn))))))
189:
190: (defun (p$insert$$ compos$$) nil
191: (cond ((not (null stk)) (*throw 'parse$err '(err$$ ill_insert)))
192: (t `(return ,(frm_hnk 'insert$$ (parse tkn))))))
193:
194: (defun (p$insert$$ constr$$) nil
195: (cond ((not (null stk)) (*throw 'parse$err '(err$$ ill_insert)))
196: (t `(Push ,(frm_hnk 'insert$$ (parse tkn))))))
197:
198: (defun (p$insert$$ insert$$) nil
199: (cond ((not (null stk)) (*throw 'parse$err '(err$$ ill_insert)))
200: (t `(return ,(frm_hnk 'insert$$ (parse tkn))))))
201:
202: (defun (p$insert$$ ti$$) nil
203: (cond ((not (null stk)) (*throw 'parse$err '(err$$ ill_insert)))
204: (t `(return ,(frm_hnk 'insert$$ (parse tkn))))))
205:
206: (defun (p$insert$$ alpha$$) nil
207: (cond ((not (null stk)) (*throw 'parse$err '(err$$ ill_insert)))
208: (t `(return ,(frm_hnk 'insert$$ (parse tkn))))))
209:
210: (defun (p$insert$$ lparen$$) nil
211: (cond ((not (null stk)) (*throw 'parse$err '(err$$ ill_insert)))
212: (t `(Push ,(frm_hnk 'insert$$ (parse tkn))))))
213:
214: (defun (p$insert$$ arrow$$) nil
215: (cond ((not (null stk)) (*throw 'parse$err '(err$$ ill_insert)))
216: (t `(Push ,(frm_hnk 'insert$$ (parse tkn))))))
217:
218: (defun (p$insert$$ semi$$) nil
219: (cond ((not (null stk)) (*throw 'parse$err '(err$$ ill_insert)))
220: (t `(Push ,(frm_hnk 'insert$$ (parse tkn))))))
221:
222: (defun (p$insert$$ while$$) nil
223: (cond ((twop wslen) (*throw 'parse$err '(err$$ ill_insert)))
224: (t `(Push ,(frm_hnk 'insert$$ (parse tkn))))))
225:
226:
227: (defun (p$ti$$ top_lev) nil
228: (cond ((not (null stk)) (*throw 'parse$err '(err$$ ill_ai)))
229: (t `(Push ,(frm_hnk 'ti$$ (parse tkn))))))
230:
231: (defun (p$ti$$ compos$$) nil
232: (cond ((not (null stk)) (*throw 'parse$err '(err$$ ill_ai)))
233: (t `(return ,(frm_hnk 'ti$$ (parse tkn))))))
234:
235: (defun (p$ti$$ constr$$) nil
236: (cond ((not (null stk)) (*throw 'parse$err '(err$$ ill_ai)))
237: (t `(Push ,(frm_hnk 'ti$$ (parse tkn))))))
238:
239: (defun (p$ti$$ insert$$) nil
240: (cond ((not (null stk)) (*throw 'parse$err '(err$$ ill_ai)))
241: (t `(return ,(frm_hnk 'ti$$ (parse tkn))))))
242:
243: (defun (p$ti$$ ti$$) nil
244: (cond ((not (null stk)) (*throw 'parse$err '(err$$ ill_ai)))
245: (t `(return ,(frm_hnk 'ti$$ (parse tkn))))))
246:
247: (defun (p$ti$$ alpha$$) nil
248: (cond ((not (null stk)) (*throw 'parse$err '(err$$ ill_ai)))
249: (t `(return ,(frm_hnk 'ti$$ (parse tkn))))))
250:
251: (defun (p$ti$$ lparen$$) nil
252: (cond ((not (null stk)) (*throw 'parse$err '(err$$ ill_ai)))
253: (t `(Push ,(frm_hnk 'ti$$ (parse tkn))))))
254:
255: (defun (p$ti$$ arrow$$) nil
256: (cond ((not (null stk)) (*throw 'parse$err '(err$$ ill_ai)))
257: (t `(Push ,(frm_hnk 'ti$$ (parse tkn))))))
258:
259: (defun (p$ti$$ semi$$) nil
260: (cond ((not (null stk)) (*throw 'parse$err '(err$$ ill_ai)))
261: (t `(Push ,(frm_hnk 'ti$$ (parse tkn))))))
262:
263: (defun (p$ti$$ while$$) nil
264: (cond ((twop wslen) (*throw 'parse$err '(err$$ ill_ai)))
265: (t `(Push ,(frm_hnk 'ti$$ (parse tkn))))))
266:
267:
268: (defun (p$compos$$ top_lev) nil
269: `(Push ,(frm_hnk 'compos$$ (Pop) (parse tkn))))
270:
271: (defun (p$compos$$ compos$$) nil
272: `(Push ,(frm_hnk 'compos$$ (Pop) (parse tkn))))
273:
274: (defun (p$compos$$ constr$$) nil
275: `(Push ,(frm_hnk 'compos$$ (Pop) (parse tkn))))
276:
277: (defun (p$compos$$ lparen$$) nil
278: `(Push ,(frm_hnk 'compos$$ (Pop) (parse tkn))))
279:
280: (defun (p$compos$$ arrow$$) nil
281: `(Push ,(frm_hnk 'compos$$ (Pop) (parse tkn))))
282:
283: (defun (p$compos$$ semi$$) nil
284: `(Push ,(frm_hnk 'compos$$ (Pop) (parse tkn))))
285:
286: (defun (p$compos$$ while$$) nil
287: `(Push ,(frm_hnk 'compos$$ (Pop) (parse tkn))))
288:
289:
290: (defun (p$comma$$ constr$$) nil
291: `(return ,(Pop)))
292:
293: (defun (p$comma$$ semi$$) nil
294: `(comma$$ ,(Pop)))
295:
296:
297: (defun (p$lbrack$$ top_lev) nil
298: `(Push ,(get_constr)))
299:
300: (defun (p$lbrack$$ compos$$) nil
301: `(return ,(get_constr)))
302:
303: (defun (p$lbrack$$ constr$$) nil
304: `(Push ,(get_constr)))
305:
306: (defun (p$lbrack$$ lparen$$) nil
307: `(Push ,(get_constr)))
308:
309: (defun (p$lbrack$$ arrow$$) nil
310: `(Push ,(get_constr)))
311:
312: (defun (p$lbrack$$ semi$$) nil
313: `(Push ,(get_constr)))
314:
315: (defun (p$lbrack$$ alpha$$) nil
316: `(return ,(get_constr)))
317:
318: (defun (p$lbrack$$ insert$$) nil
319: `(return ,(get_constr)))
320:
321: (defun (p$lbrack$$ ti$$) nil
322: `(return ,(get_constr)))
323:
324: (defun (p$lbrack$$ while$$) nil
325: `(Push ,(get_constr)))
326:
327:
328: (defun (p$rbrack$$ constr$$) nil
329: `(return done ,(cond ((null stk) nil)
330: (t (Pop)))))
331:
332: (defun (p$rbrack$$ semi$$) nil
333: `(rbrack$$ ,`(done ,(cond ((null stk) nil)
334: (t (Pop))))))
335:
336:
337: (defun (p$defined$$ top_lev) nil
338: `(Push ,(concat (cadr tkn) '_fp)))
339:
340: (defun (p$defined$$ compos$$) nil
341: `(return ,(concat (cadr tkn) '_fp)))
342:
343: (defun (p$defined$$ constr$$) nil
344: `(Push ,(concat (cadr tkn) '_fp)))
345:
346: (defun (p$defined$$ lparen$$) nil
347: `(Push ,(concat (cadr tkn) '_fp)))
348:
349: (defun (p$defined$$ arrow$$) nil
350: `(Push ,(concat (cadr tkn) '_fp)))
351:
352: (defun (p$defined$$ semi$$) nil
353: `(Push ,(concat (cadr tkn) '_fp)))
354:
355: (defun (p$defined$$ alpha$$) nil
356: `(return ,(concat (cadr tkn) '_fp)))
357:
358: (defun (p$defined$$ insert$$) nil
359: `(return ,(concat (cadr tkn) '_fp)))
360:
361: (defun (p$defined$$ ti$$) nil
362: `(return ,(concat (cadr tkn) '_fp)))
363:
364: (defun (p$defined$$ while$$) nil
365: `(Push ,(concat (cadr tkn) '_fp)))
366:
367:
368: (defun (p$builtin$$ top_lev) nil
369: `(Push ,(concat (cadr tkn) '$fp)))
370:
371: (defun (p$builtin$$ compos$$) nil
372: `(return ,(concat (cadr tkn) '$fp)))
373:
374: (defun (p$builtin$$ constr$$) nil
375: `(Push ,(concat (cadr tkn) '$fp)))
376:
377: (defun (p$builtin$$ lparen$$) nil
378: `(Push ,(concat (cadr tkn) '$fp)))
379:
380: (defun (p$builtin$$ arrow$$) nil
381: `(Push ,(concat (cadr tkn) '$fp)))
382:
383: (defun (p$builtin$$ semi$$) nil
384: `(Push ,(concat (cadr tkn) '$fp)))
385:
386: (defun (p$builtin$$ alpha$$) nil
387: `(return ,(concat (cadr tkn) '$fp)))
388:
389: (defun (p$builtin$$ insert$$) nil
390: `(return ,(concat (cadr tkn) '$fp)))
391:
392: (defun (p$builtin$$ ti$$) nil
393: `(return ,(concat (cadr tkn) '$fp)))
394:
395: (defun (p$builtin$$ while$$) nil
396: `(Push ,(concat (cadr tkn) '$fp)))
397:
398:
399: (defun (p$select$$ top_lev) nil
400: `(Push ,(makhunk tkn)))
401:
402: (defun (p$select$$ compos$$) nil
403: `(return ,(makhunk tkn)))
404:
405: (defun (p$select$$ constr$$) nil
406: `(Push ,(makhunk tkn)))
407:
408: (defun (p$select$$ lparen$$) nil
409: `(Push ,(makhunk tkn)))
410:
411: (defun (p$select$$ arrow$$) nil
412: `(Push ,(makhunk tkn)))
413:
414: (defun (p$select$$ semi$$) nil
415: `(Push ,(makhunk tkn)))
416:
417: (defun (p$select$$ alpha$$) nil
418: `(return ,(makhunk tkn)))
419:
420: (defun (p$select$$ while$$) nil
421: `(Push ,(makhunk tkn)))
422:
423:
424: (defun (p$constant$$ top_lev) nil
425: `(Push ,(makhunk tkn)))
426:
427: (defun (p$constant$$ compos$$) nil
428: `(return ,(makhunk tkn)))
429:
430: (defun (p$constant$$ constr$$) nil
431: `(Push ,(makhunk tkn)))
432:
433: (defun (p$constant$$ lparen$$) nil
434: `(Push ,(makhunk tkn)))
435:
436: (defun (p$constant$$ arrow$$) nil
437: `(Push ,(makhunk tkn)))
438:
439: (defun (p$constant$$ semi$$) nil
440: `(Push ,(makhunk tkn)))
441:
442: (defun (p$constant$$ alpha$$) nil
443: `(return ,(makhunk tkn)))
444:
445: (defun (p$constant$$ while$$) nil
446: `(Push ,(makhunk tkn)))
447:
448:
449: (defun (p$colon$$ top_lev) nil
450: (cond (in_def (*throw 'parse$err '(err$$ ill_appl)))
451: (t `(return ,(Pop)))))
452:
453: (defun (p$colon$$ semi$$) nil
454: (cond (in_def (*throw 'parse$err '(err$$ ill_appl)))
455: (t `(colon$$ ,(Pop)))))
456:
457:
458: (defun (p$arrow$$ lparen$$) nil
459: (get_condit))
460:
461:
462: (defun (p$semi$$ arrow$$) nil
463: `(return ,(Pop)))
464:
465: (defun (p$while$$ lparen$$) nil
466: (cond ((not (null stk)) (*throw 'parse$err '(err$$ bad_while)))
467: (t (get_while))))
468:
469:
470: ; parse action support functions
471:
472: (defun get_condit nil
473: (prog (q r)
474: (setq q (parse 'arrow$$))
475: (cond ((and (listp q) (find 'err$$ q)) (*throw 'parse$err q)))
476: (setq r (parse 'semi$$))
477: (cond ((and (listp r) (find 'err$$ r)) (*throw 'parse$err r)))
478: (*throw 'end_condit (frm_hnk 'condit$$ (Pop) q r))))
479:
480:
481: (defun Push (value)
482: (cond ((eq flag 'while$$)
483: (cond
484: ((zerop wslen) (setq stk value) (setq wslen 1))
485: ((onep wslen) (setq stk (list stk value)) (setq wslen 2))
486: (t (*throw 'parse$err '(err$$ bad_while Push)))))
487: (t (setq stk value))))
488:
489: (defun Pop nil
490: (cond
491: ((null stk) (*throw 'parse$err '(err$$ stk_emp)))
492: (t
493: (prog (tmp)
494: (setq tmp stk)
495: (cond ((eq flag 'while$$)
496: (cond ((onep wslen) (setq stk nil) (setq wslen 0) (return tmp))
497: ((twop wslen)
498: (setq stk (car tmp)) (setq wslen 1) (return (cadr tmp)))
499: (t (*throw 'parse$err '(err$$ bad_while Pop)))))
500: (t (setq stk nil)
501: (return tmp)))))))
502:
503: (defun get_def nil
504: (prog (dummy)
505: (setq in_def t)
506: (setq dummy (get_tkn))
507: (cond ((find 'builtin$$ dummy) (*throw 'parse$err '(err$$ redef)))
508: ((not (find 'defined$$ dummy)) (*throw 'parse$err '(err$$ bad_nam)))
509: (t (setq fn_name (concat (cadr dummy) '_fp))))))
510:
511:
512: (defun get_constr nil
513: (cond ((eq flag 'while$$) (cond
514: ((twop wslen) (*throw 'parse$err `(err$$ bad_whl ,stk ,tkn)))))
515: (t (cond ((not (null stk)) (*throw 'parse$err '(err$$ bad_constr parse))))))
516: (do
517: ((v (parse 'constr$$) (parse 'constr$$))
518: (temp nil)
519: (fn_lst nil))
520:
521: ((eq tkn 'eof$$) (*throw 'parse$err '(err$$ eof$$)))
522:
523: (cond
524: ((listp v)
525: (cond ((eq (car v) 'err$$) (*throw 'parse$err v))
526: ((eq (car v) 'done)
527: (cond ((eq (cadr v) 'err$$) (*throw 'parse$err (cdr v)))
528: (t (return
529: (makhunk (cons 'constr$$ (reverse (cons (cadr v) fn_lst))))))))
530: (t (setq fn_lst (cons v fn_lst)))))
531: (t (setq fn_lst (cons v fn_lst))))))
532:
533: (def frm_hnk (lexpr (z)
534: (prog (l bad_one)
535: (setq l (listify z))
536: (setq bad_one (assq 'err$$ (cdr l)))
537: (cond ((null bad_one) (return (makhunk l)))
538: (t (*throw 'parse$err bad_one))))))
539:
540:
541:
542: (defun prs_fn nil
543: (concat 'p$ (cond ((atom tkn) tkn)
544: (t (car tkn)))))
545:
546: (defun get_while nil
547: (let ((r (parse 'while$$)))
548: (cond ((and (listp r) (find 'err$$ r)) (*throw 'parse$err r))
549: (t (*throw 'end_while (frm_hnk 'while$$ (car r) (cadr r)))))))
550:
551: (defun twop (x)
552: (eq 2 x))
553:
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.