xref: /original-bsd/old/lisp/fp/fp.vax/parser.l (revision 4e9331e4)
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) 05/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 
554