xref: /csrg-svn/old/lisp/fp/fp.vax/parser.l (revision 21730)
112069Sbaden ;  FP interpreter/compiler
212069Sbaden ;  Copyright (c) 1982  Scott B. Baden
312069Sbaden ;  Berkeley, California
4*21730Sdist ;
5*21730Sdist ;  Copyright (c) 1982 Regents of the University of California.
6*21730Sdist ;  All rights reserved.  The Berkeley software License Agreement
7*21730Sdist ;  specifies the terms and conditions for redistribution.
8*21730Sdist ;
9*21730Sdist (setq SCCS-parser.l "@(#)parser.l	5.1 (Berkeley) 05/31/85")
1012069Sbaden 
1112069Sbaden (include specials.l)
1212069Sbaden (declare (special flag)
1312069Sbaden   (localf get_condit trap_err Push
1412069Sbaden 	  prs_fn get_def get_constr get_while Pop))
1512069Sbaden 
1612069Sbaden (defun parse (a_flag)
1712069Sbaden   (let ((flag a_flag))
1812069Sbaden        (do
1912069Sbaden 	((tkn (get_tkn) (get_tkn))
2012069Sbaden 	 (rslt nil) (action nil) (wslen 0) (stk nil))
2112069Sbaden 
2212069Sbaden 	((eq tkn 'eof$$) (cond ((eq flag 'top_lev) 'eof$$)
2312069Sbaden 			       (t (*throw 'parse$err  '(err$$ eof)))))
2412069Sbaden 
2512069Sbaden 	(cond ((null (plist (prs_fn))) (*throw 'parse$err `(err$$ unknown ,tkn))))
2612069Sbaden 	(cond ((find 'badtkn$$ tkn) (*throw 'parse$err `(err$$ badtkn ,(cadr tkn)))))
2712069Sbaden 	(setq action (get (prs_fn) flag))
2812069Sbaden 	(cond ((null action) (*throw 'parse$err `(err$$ illeg ,tkn))))
2912069Sbaden 	(setq rslt (funcall action))
3012069Sbaden 	(cond ((eq rslt 'cmd$$) (return rslt)))
3112069Sbaden 	(cond ((not (listp rslt)) (*throw 'parse$err  `(err$$ fatal1 ,stk ,tkn ,rslt))))
3212069Sbaden 	(cond ((eq (car rslt) 'return)
3312069Sbaden 	       (return
3412069Sbaden 		(cond ((eq (cadr rslt) 'done) (cdr rslt))
3512069Sbaden 		      (t (cadr rslt)))))
3612069Sbaden 
3712069Sbaden 	      ((eq (car rslt) 'Push)
3812069Sbaden 	       (cond ((eq flag 'while$$)
3912069Sbaden 		      (cond ((or (zerop wslen) (onep wslen))
4012069Sbaden 			     (Push (cadr rslt)))
4112069Sbaden 			    ((twop wslen) (*throw 'parse$err  `(err$$ bad_whl ,stk ,tkn)))
4212069Sbaden 			    (t (*throw  'parse$err '(err$$ bad_while parse)))))
4312069Sbaden 		     (t
4412069Sbaden 		      (cond ((null stk) (Push (cadr rslt)))
4512069Sbaden 			    (t (*throw  'parse$err `(err$$ stk_ful ,stk ,tkn)))))))
4612069Sbaden 
4712069Sbaden 	      ((eq (car rslt) 'nothing))
4812069Sbaden 	      (t (*throw  'parse$err `(err$$ fatal2 ,stk ,tkn ,rslt)))))))
4912069Sbaden 
5012069Sbaden 
5112069Sbaden ; These are the parse action functions.
5212069Sbaden ; There is one for each token-context combination.
5312069Sbaden ; The contexts  are:
5412069Sbaden ;     top_lev,constr$$,compos$$,alpha$$,insert$$.
5512069Sbaden ; The name of each function is formed by appending p$ to the
5612069Sbaden ; name of the token just parsed.
5712069Sbaden ; For each function name there is actually a set of functions
5812069Sbaden ; associated by a plist (keyed on the context).
5912069Sbaden 
6012069Sbaden (defun (p$lbrace$$ top_lev) nil
6112069Sbaden   (cond (in_def  (*throw  'parse$err '(err$$ ill_lbrace)))
6212069Sbaden 	(t (list 'nothing (get_def)))))
6312069Sbaden 
6412069Sbaden (defun (p$rbrace$$ top_lev) nil
6512069Sbaden   (cond ((not in_def)  (*throw 'parse$err  '(err$$ ill_rbrace)))
6612069Sbaden 	(t (progn
6712069Sbaden 	    (cond ((null stk) (*throw  'parse$err '(err$$ stk_emp)))
6812069Sbaden 		  ((null infile)
6912069Sbaden 		   (do
7012069Sbaden 		    ((c (Tyi) (Tyi)))
7112069Sbaden 		    ((eq c 10)))))
7212069Sbaden 	    `(return ,(Pop))))))
7312069Sbaden 
7412069Sbaden (defun (p$rbrace$$ semi$$) nil
7512069Sbaden   (cond
7612069Sbaden    ((not in_def)  (*throw  'parse$err '(err$$ ill_rbrace)))
7712069Sbaden    (t (progn
7812069Sbaden        (cond ((null stk) (*throw  'parse$err '(err$$ stk_emp)))
7912069Sbaden 	     ((null infile)
8012069Sbaden 	      (do
8112069Sbaden 	       ((c (Tyi) (Tyi)))
8212069Sbaden 	       ((eq c 10)))))
8312069Sbaden        `(rbrace$$ ,(Pop))))))
8412069Sbaden 
8512069Sbaden (defun trap_err (p)
8612069Sbaden   (cond ((find 'err$$ p) (*throw  'parse$err p))
8712069Sbaden 	(t p)))
8812069Sbaden 
8912069Sbaden (defun (p$lparen$$ top_lev) nil
9012069Sbaden   (cond ((not (null stk)) (*throw  'parse$err '(err$$ ill_lpar)))
9112069Sbaden 	(t `(Push ,(trap_err (*catch '(parse$err end_while end_condit)  (parse tkn)))))))
9212069Sbaden 
9312069Sbaden (defun (p$lparen$$ constr$$) nil
9412069Sbaden   (cond ((not (null stk)) (*throw  'parse$err '(err$$ ill_lpar)))
9512069Sbaden 	(t `(Push ,(trap_err (*catch '(parse$err end_while end_condit) (parse tkn)))))))
9612069Sbaden 
9712069Sbaden (defun (p$lparen$$ compos$$) nil
9812069Sbaden   (cond ((not (null stk)) (*throw  'parse$err '(err$$ ill_lpar)))
9912069Sbaden 	(t `(return ,(trap_err (*catch '(parse$err end_while end_condit) (parse tkn)))))))
10012069Sbaden 
10112069Sbaden (defun (p$lparen$$ alpha$$) nil
10212069Sbaden   (cond ((not (null stk)) (*throw  'parse$err '(err$$ ill_lpar)))
10312069Sbaden 	(t `(return ,(trap_err (*catch '(parse$err end_while end_condit) (parse tkn)))))))
10412069Sbaden 
10512069Sbaden (defun (p$lparen$$ ti$$) nil
10612069Sbaden   (cond ((not (null stk)) (*throw  'parse$err '(err$$ ill_lpar)))
10712069Sbaden 	(t `(return ,(trap_err (*catch '(parse$err end_while end_condit) (parse tkn)))))))
10812069Sbaden 
10912069Sbaden (defun (p$lparen$$ insert$$) nil
11012069Sbaden   (cond ((not (null stk)) (*throw  'parse$err '(err$$ ill_lpar)))
11112069Sbaden 	(t `(return ,(trap_err (*catch '(parse$err end_while end_condit) (parse tkn)))))))
11212069Sbaden 
11312069Sbaden (defun (p$lparen$$ arrow$$) nil
11412069Sbaden   (cond ((not (null stk)) (*throw  'parse$err '(err$$ ill_lpar)))
11512069Sbaden 	(t `(Push ,(trap_err (*catch '(parse$err end_while end_condit) (parse tkn)))))))
11612069Sbaden 
11712069Sbaden (defun (p$lparen$$ semi$$) nil
11812069Sbaden   (cond ((not (null stk)) (*throw  'parse$err '(err$$ ill_lpar)))
11912069Sbaden 	(t `(Push ,(trap_err (*catch '(parse$err end_while end_condit) (parse tkn)))))))
12012069Sbaden 
12112069Sbaden (defun (p$lparen$$ lparen$$) nil
12212069Sbaden   (cond ((not (null stk)) (*throw 'parse$err '(err$$ ill_lpar)))
12312069Sbaden 	(t `(Push ,(trap_err (*catch '(parse$err end_while end_condit) (parse tkn)))))))
12412069Sbaden 
12512069Sbaden (defun (p$lparen$$ while$$) nil
12612069Sbaden   (cond ((twop wslen) (*throw 'parse$err '(err$$ ill_lpar)))
12712069Sbaden 	(t `(Push ,(trap_err (*catch '(parse$err end_while end_condit) (parse tkn)))))))
12812069Sbaden 
12912069Sbaden (defun (p$rparen$$ lparen$$) nil
13012069Sbaden   `(return ,(Pop)))
13112069Sbaden 
13212069Sbaden (defun (p$rparen$$ top_lev) nil			; process commands
13312069Sbaden   (cond ((not (null stk)) (*throw 'parse$err '(err$$ unbalparen)))
13412069Sbaden 	(t (cond ((null infile) (get_cmd))
13512069Sbaden 		 (t (patom "commands may not be issued from a file")
13612069Sbaden 		    (terpri)
13712069Sbaden 		    'cmd$$)))))
13812069Sbaden 
13912069Sbaden (defun (p$rparen$$ semi$$) nil
14012069Sbaden   `(return ,(Pop)))
14112069Sbaden 
14212069Sbaden (defun (p$rparen$$ while$$) nil
14312069Sbaden   `(return ,(nreverse (list (Pop) (Pop)))))
14412069Sbaden 
14512069Sbaden (defun (p$alpha$$ top_lev) nil
14612069Sbaden   (cond ((not (null stk)) (*throw 'parse$err '(err$$ ill_alpha)))
14712069Sbaden 	(t `(Push ,(frm_hnk 'alpha$$ (parse tkn))))))
14812069Sbaden 
14912069Sbaden (defun (p$alpha$$ compos$$) nil
15012069Sbaden   (cond ((not (null stk)) (*throw 'parse$err '(err$$ ill_alpha)))
15112069Sbaden 	(t `(return ,(frm_hnk 'alpha$$ (parse tkn))))))
15212069Sbaden 
15312069Sbaden (defun (p$alpha$$ constr$$) nil
15412069Sbaden   (cond ((not (null stk)) (*throw 'parse$err '(err$$ ill_alpha)))
15512069Sbaden 	(t `(Push ,(frm_hnk 'alpha$$ (parse tkn))))))
15612069Sbaden 
15712069Sbaden (defun (p$alpha$$ insert$$) nil
15812069Sbaden   (cond ((not (null stk)) (*throw 'parse$err '(err$$ ill_alpha)))
15912069Sbaden 	(t `(return ,(frm_hnk 'alpha$$ (parse tkn))))))
16012069Sbaden 
16112069Sbaden (defun (p$alpha$$ ti$$) nil
16212069Sbaden   (cond ((not (null stk)) (*throw 'parse$err '(err$$ ill_alpha)))
16312069Sbaden 	(t `(return ,(frm_hnk 'alpha$$ (parse tkn))))))
16412069Sbaden 
16512069Sbaden (defun (p$alpha$$ alpha$$) nil
16612069Sbaden   (cond ((not (null stk)) (*throw 'parse$err '(err$$ ill_alpha)))
16712069Sbaden 	(t `(return ,(frm_hnk 'alpha$$ (parse tkn))))))
16812069Sbaden 
16912069Sbaden (defun (p$alpha$$ lparen$$) nil
17012069Sbaden   (cond ((not (null stk)) (*throw 'parse$err '(err$$ ill_alpha)))
17112069Sbaden 	(t `(Push ,(frm_hnk 'alpha$$ (parse tkn))))))
17212069Sbaden 
17312069Sbaden (defun (p$alpha$$ arrow$$) nil
17412069Sbaden   (cond ((not (null stk)) (*throw 'parse$err '(err$$ ill_alpha)))
17512069Sbaden 	(t `(Push ,(frm_hnk 'alpha$$ (parse tkn))))))
17612069Sbaden 
17712069Sbaden (defun (p$alpha$$ semi$$) nil
17812069Sbaden   (cond ((not (null stk)) (*throw 'parse$err '(err$$ ill_alpha)))
17912069Sbaden 	(t `(Push ,(frm_hnk 'alpha$$ (parse tkn))))))
18012069Sbaden 
18112069Sbaden (defun (p$alpha$$ while$$) nil
18212069Sbaden   (cond ((twop wslen) (*throw 'parse$err '(err$$ ill_alpha)))
18312069Sbaden 	(t `(Push ,(frm_hnk 'alpha$$ (parse tkn))))))
18412069Sbaden 
18512069Sbaden 
18612069Sbaden (defun (p$insert$$ top_lev) nil
18712069Sbaden   (cond ((not (null stk)) (*throw 'parse$err '(err$$ ill_insert)))
18812069Sbaden 	(t `(Push ,(frm_hnk 'insert$$ (parse tkn))))))
18912069Sbaden 
19012069Sbaden (defun (p$insert$$ compos$$) nil
19112069Sbaden   (cond ((not (null stk)) (*throw 'parse$err '(err$$ ill_insert)))
19212069Sbaden 	(t `(return ,(frm_hnk 'insert$$ (parse tkn))))))
19312069Sbaden 
19412069Sbaden (defun (p$insert$$ constr$$) nil
19512069Sbaden   (cond ((not (null stk)) (*throw 'parse$err '(err$$ ill_insert)))
19612069Sbaden 	(t `(Push ,(frm_hnk 'insert$$ (parse tkn))))))
19712069Sbaden 
19812069Sbaden (defun (p$insert$$ insert$$) nil
19912069Sbaden   (cond ((not (null stk)) (*throw 'parse$err '(err$$ ill_insert)))
20012069Sbaden 	(t `(return ,(frm_hnk 'insert$$ (parse tkn))))))
20112069Sbaden 
20212069Sbaden (defun (p$insert$$ ti$$) nil
20312069Sbaden   (cond ((not (null stk)) (*throw 'parse$err '(err$$ ill_insert)))
20412069Sbaden 	(t `(return ,(frm_hnk 'insert$$ (parse tkn))))))
20512069Sbaden 
20612069Sbaden (defun (p$insert$$ alpha$$) nil
20712069Sbaden   (cond ((not (null stk)) (*throw 'parse$err '(err$$ ill_insert)))
20812069Sbaden 	(t `(return ,(frm_hnk 'insert$$ (parse tkn))))))
20912069Sbaden 
21012069Sbaden (defun (p$insert$$ lparen$$) nil
21112069Sbaden   (cond ((not (null stk)) (*throw 'parse$err '(err$$ ill_insert)))
21212069Sbaden 	(t `(Push ,(frm_hnk 'insert$$ (parse tkn))))))
21312069Sbaden 
21412069Sbaden (defun (p$insert$$ arrow$$) nil
21512069Sbaden   (cond ((not (null stk)) (*throw 'parse$err '(err$$ ill_insert)))
21612069Sbaden 	(t `(Push ,(frm_hnk 'insert$$ (parse tkn))))))
21712069Sbaden 
21812069Sbaden (defun (p$insert$$ semi$$) nil
21912069Sbaden   (cond ((not (null stk)) (*throw 'parse$err '(err$$ ill_insert)))
22012069Sbaden 	(t `(Push ,(frm_hnk 'insert$$ (parse tkn))))))
22112069Sbaden 
22212069Sbaden (defun (p$insert$$ while$$) nil
22312069Sbaden   (cond ((twop wslen) (*throw 'parse$err '(err$$ ill_insert)))
22412069Sbaden 	(t `(Push ,(frm_hnk 'insert$$ (parse tkn))))))
22512069Sbaden 
22612069Sbaden 
22712069Sbaden (defun (p$ti$$ top_lev) nil
22812069Sbaden   (cond ((not (null stk)) (*throw 'parse$err '(err$$ ill_ai)))
22912069Sbaden 	(t `(Push ,(frm_hnk 'ti$$ (parse tkn))))))
23012069Sbaden 
23112069Sbaden (defun (p$ti$$ compos$$) nil
23212069Sbaden   (cond ((not (null stk)) (*throw 'parse$err '(err$$ ill_ai)))
23312069Sbaden 	(t `(return ,(frm_hnk 'ti$$ (parse tkn))))))
23412069Sbaden 
23512069Sbaden (defun (p$ti$$ constr$$) nil
23612069Sbaden   (cond ((not (null stk)) (*throw 'parse$err '(err$$ ill_ai)))
23712069Sbaden 	(t `(Push ,(frm_hnk 'ti$$ (parse tkn))))))
23812069Sbaden 
23912069Sbaden (defun (p$ti$$ insert$$) nil
24012069Sbaden   (cond ((not (null stk)) (*throw 'parse$err '(err$$ ill_ai)))
24112069Sbaden 	(t `(return ,(frm_hnk 'ti$$ (parse tkn))))))
24212069Sbaden 
24312069Sbaden (defun (p$ti$$ ti$$) nil
24412069Sbaden   (cond ((not (null stk)) (*throw 'parse$err '(err$$ ill_ai)))
24512069Sbaden 	(t `(return ,(frm_hnk 'ti$$ (parse tkn))))))
24612069Sbaden 
24712069Sbaden (defun (p$ti$$ alpha$$) nil
24812069Sbaden   (cond ((not (null stk)) (*throw 'parse$err '(err$$ ill_ai)))
24912069Sbaden 	(t `(return ,(frm_hnk 'ti$$ (parse tkn))))))
25012069Sbaden 
25112069Sbaden (defun (p$ti$$ lparen$$) nil
25212069Sbaden   (cond ((not (null stk)) (*throw 'parse$err '(err$$ ill_ai)))
25312069Sbaden 	(t `(Push ,(frm_hnk 'ti$$ (parse tkn))))))
25412069Sbaden 
25512069Sbaden (defun (p$ti$$ arrow$$) nil
25612069Sbaden   (cond ((not (null stk)) (*throw 'parse$err '(err$$ ill_ai)))
25712069Sbaden 	(t `(Push ,(frm_hnk 'ti$$ (parse tkn))))))
25812069Sbaden 
25912069Sbaden (defun (p$ti$$ semi$$) nil
26012069Sbaden   (cond ((not (null stk)) (*throw 'parse$err '(err$$ ill_ai)))
26112069Sbaden 	(t `(Push ,(frm_hnk 'ti$$ (parse tkn))))))
26212069Sbaden 
26312069Sbaden (defun (p$ti$$ while$$) nil
26412069Sbaden   (cond ((twop wslen) (*throw 'parse$err '(err$$ ill_ai)))
26512069Sbaden 	(t `(Push ,(frm_hnk 'ti$$ (parse tkn))))))
26612069Sbaden 
26712069Sbaden 
26812069Sbaden (defun (p$compos$$ top_lev) nil
26912069Sbaden   `(Push ,(frm_hnk 'compos$$ (Pop) (parse tkn))))
27012069Sbaden 
27112069Sbaden (defun (p$compos$$ compos$$) nil
27212069Sbaden   `(Push ,(frm_hnk 'compos$$ (Pop) (parse tkn))))
27312069Sbaden 
27412069Sbaden (defun (p$compos$$ constr$$) nil
27512069Sbaden   `(Push ,(frm_hnk 'compos$$ (Pop) (parse tkn))))
27612069Sbaden 
27712069Sbaden (defun (p$compos$$ lparen$$) nil
27812069Sbaden   `(Push ,(frm_hnk 'compos$$ (Pop) (parse tkn))))
27912069Sbaden 
28012069Sbaden (defun (p$compos$$ arrow$$) nil
28112069Sbaden   `(Push ,(frm_hnk 'compos$$ (Pop) (parse tkn))))
28212069Sbaden 
28312069Sbaden (defun (p$compos$$ semi$$) nil
28412069Sbaden   `(Push ,(frm_hnk 'compos$$ (Pop) (parse tkn))))
28512069Sbaden 
28612069Sbaden (defun (p$compos$$ while$$) nil
28712069Sbaden   `(Push ,(frm_hnk 'compos$$ (Pop) (parse tkn))))
28812069Sbaden 
28912069Sbaden 
29012069Sbaden (defun (p$comma$$ constr$$) nil
29112069Sbaden   `(return ,(Pop)))
29212069Sbaden 
29312069Sbaden (defun (p$comma$$ semi$$) nil
29412069Sbaden   `(comma$$ ,(Pop)))
29512069Sbaden 
29612069Sbaden 
29712069Sbaden (defun (p$lbrack$$ top_lev) nil
29812069Sbaden   `(Push ,(get_constr)))
29912069Sbaden 
30012069Sbaden (defun (p$lbrack$$ compos$$) nil
30112069Sbaden   `(return ,(get_constr)))
30212069Sbaden 
30312069Sbaden (defun (p$lbrack$$ constr$$) nil
30412069Sbaden   `(Push ,(get_constr)))
30512069Sbaden 
30612069Sbaden (defun (p$lbrack$$ lparen$$) nil
30712069Sbaden   `(Push ,(get_constr)))
30812069Sbaden 
30912069Sbaden (defun (p$lbrack$$ arrow$$) nil
31012069Sbaden   `(Push ,(get_constr)))
31112069Sbaden 
31212069Sbaden (defun (p$lbrack$$ semi$$) nil
31312069Sbaden   `(Push ,(get_constr)))
31412069Sbaden 
31512069Sbaden (defun (p$lbrack$$ alpha$$) nil
31612069Sbaden   `(return ,(get_constr)))
31712069Sbaden 
31812069Sbaden (defun (p$lbrack$$ insert$$) nil
31912069Sbaden   `(return ,(get_constr)))
32012069Sbaden 
32112069Sbaden (defun (p$lbrack$$ ti$$) nil
32212069Sbaden   `(return ,(get_constr)))
32312069Sbaden 
32412069Sbaden (defun (p$lbrack$$ while$$) nil
32512069Sbaden   `(Push ,(get_constr)))
32612069Sbaden 
32712069Sbaden 
32812069Sbaden (defun (p$rbrack$$ constr$$) nil
32912069Sbaden   `(return done ,(cond ((null stk) nil)
33012069Sbaden 		       (t (Pop)))))
33112069Sbaden 
33212069Sbaden (defun (p$rbrack$$ semi$$) nil
33312069Sbaden   `(rbrack$$ ,`(done ,(cond ((null stk) nil)
33412069Sbaden 			    (t (Pop))))))
33512069Sbaden 
33612069Sbaden 
33712069Sbaden (defun (p$defined$$ top_lev) nil
33812069Sbaden   `(Push ,(concat (cadr tkn) '_fp)))
33912069Sbaden 
34012069Sbaden (defun (p$defined$$ compos$$) nil
34112069Sbaden   `(return ,(concat (cadr tkn) '_fp)))
34212069Sbaden 
34312069Sbaden (defun (p$defined$$ constr$$) nil
34412069Sbaden   `(Push ,(concat (cadr tkn) '_fp)))
34512069Sbaden 
34612069Sbaden (defun (p$defined$$ lparen$$) nil
34712069Sbaden   `(Push ,(concat (cadr tkn) '_fp)))
34812069Sbaden 
34912069Sbaden (defun (p$defined$$ arrow$$) nil
35012069Sbaden   `(Push ,(concat (cadr tkn) '_fp)))
35112069Sbaden 
35212069Sbaden (defun (p$defined$$ semi$$) nil
35312069Sbaden   `(Push ,(concat (cadr tkn) '_fp)))
35412069Sbaden 
35512069Sbaden (defun (p$defined$$ alpha$$) nil
35612069Sbaden   `(return ,(concat (cadr tkn) '_fp)))
35712069Sbaden 
35812069Sbaden (defun (p$defined$$ insert$$) nil
35912069Sbaden   `(return ,(concat (cadr tkn) '_fp)))
36012069Sbaden 
36112069Sbaden (defun (p$defined$$ ti$$) nil
36212069Sbaden   `(return ,(concat (cadr tkn) '_fp)))
36312069Sbaden 
36412069Sbaden (defun (p$defined$$ while$$) nil
36512069Sbaden   `(Push ,(concat (cadr tkn) '_fp)))
36612069Sbaden 
36712069Sbaden 
36812069Sbaden (defun (p$builtin$$ top_lev) nil
36912069Sbaden   `(Push ,(concat (cadr tkn) '$fp)))
37012069Sbaden 
37112069Sbaden (defun (p$builtin$$ compos$$) nil
37212069Sbaden   `(return ,(concat (cadr tkn) '$fp)))
37312069Sbaden 
37412069Sbaden (defun (p$builtin$$ constr$$) nil
37512069Sbaden   `(Push ,(concat (cadr tkn) '$fp)))
37612069Sbaden 
37712069Sbaden (defun (p$builtin$$ lparen$$) nil
37812069Sbaden   `(Push ,(concat (cadr tkn) '$fp)))
37912069Sbaden 
38012069Sbaden (defun (p$builtin$$ arrow$$) nil
38112069Sbaden   `(Push ,(concat (cadr tkn) '$fp)))
38212069Sbaden 
38312069Sbaden (defun (p$builtin$$ semi$$) nil
38412069Sbaden   `(Push ,(concat (cadr tkn) '$fp)))
38512069Sbaden 
38612069Sbaden (defun (p$builtin$$ alpha$$) nil
38712069Sbaden   `(return ,(concat (cadr tkn) '$fp)))
38812069Sbaden 
38912069Sbaden (defun (p$builtin$$ insert$$) nil
39012069Sbaden   `(return ,(concat (cadr tkn) '$fp)))
39112069Sbaden 
39212069Sbaden (defun (p$builtin$$ ti$$) nil
39312069Sbaden   `(return ,(concat (cadr tkn) '$fp)))
39412069Sbaden 
39512069Sbaden (defun (p$builtin$$ while$$) nil
39612069Sbaden   `(Push ,(concat (cadr tkn) '$fp)))
39712069Sbaden 
39812069Sbaden 
39912069Sbaden (defun (p$select$$ top_lev) nil
40012069Sbaden   `(Push ,(makhunk tkn)))
40112069Sbaden 
40212069Sbaden (defun (p$select$$ compos$$) nil
40312069Sbaden   `(return ,(makhunk tkn)))
40412069Sbaden 
40512069Sbaden (defun (p$select$$ constr$$) nil
40612069Sbaden   `(Push ,(makhunk tkn)))
40712069Sbaden 
40812069Sbaden (defun (p$select$$ lparen$$) nil
40912069Sbaden   `(Push ,(makhunk tkn)))
41012069Sbaden 
41112069Sbaden (defun (p$select$$ arrow$$) nil
41212069Sbaden   `(Push ,(makhunk tkn)))
41312069Sbaden 
41412069Sbaden (defun (p$select$$ semi$$) nil
41512069Sbaden   `(Push ,(makhunk tkn)))
41612069Sbaden 
41712069Sbaden (defun (p$select$$ alpha$$) nil
41812069Sbaden   `(return ,(makhunk tkn)))
41912069Sbaden 
42012069Sbaden (defun (p$select$$ while$$) nil
42112069Sbaden   `(Push ,(makhunk tkn)))
42212069Sbaden 
42312069Sbaden 
42412069Sbaden (defun (p$constant$$ top_lev) nil
42512069Sbaden   `(Push ,(makhunk tkn)))
42612069Sbaden 
42712069Sbaden (defun (p$constant$$ compos$$) nil
42812069Sbaden   `(return ,(makhunk tkn)))
42912069Sbaden 
43012069Sbaden (defun (p$constant$$ constr$$) nil
43112069Sbaden   `(Push ,(makhunk tkn)))
43212069Sbaden 
43312069Sbaden (defun (p$constant$$ lparen$$) nil
43412069Sbaden   `(Push ,(makhunk tkn)))
43512069Sbaden 
43612069Sbaden (defun (p$constant$$ arrow$$) nil
43712069Sbaden   `(Push ,(makhunk tkn)))
43812069Sbaden 
43912069Sbaden (defun (p$constant$$ semi$$) nil
44012069Sbaden   `(Push ,(makhunk tkn)))
44112069Sbaden 
44212069Sbaden (defun (p$constant$$ alpha$$) nil
44312069Sbaden   `(return ,(makhunk tkn)))
44412069Sbaden 
44512069Sbaden (defun (p$constant$$ while$$) nil
44612069Sbaden   `(Push ,(makhunk tkn)))
44712069Sbaden 
44812069Sbaden 
44912069Sbaden (defun (p$colon$$ top_lev) nil
45012069Sbaden   (cond (in_def  (*throw 'parse$err '(err$$ ill_appl)))
45112069Sbaden 	(t `(return ,(Pop)))))
45212069Sbaden 
45312069Sbaden (defun (p$colon$$ semi$$) nil
45412069Sbaden   (cond (in_def  (*throw 'parse$err '(err$$ ill_appl)))
45512069Sbaden 	(t `(colon$$ ,(Pop)))))
45612069Sbaden 
45712069Sbaden 
45812069Sbaden (defun (p$arrow$$ lparen$$) nil
45912069Sbaden   (get_condit))
46012069Sbaden 
46112069Sbaden 
46212069Sbaden (defun (p$semi$$ arrow$$) nil
46312069Sbaden   `(return ,(Pop)))
46412069Sbaden 
46512069Sbaden (defun (p$while$$ lparen$$) nil
46612069Sbaden   (cond ((not (null stk)) (*throw 'parse$err '(err$$ bad_while)))
46712069Sbaden 	(t (get_while))))
46812069Sbaden 
46912069Sbaden 
47012069Sbaden ; parse action support functions
47112069Sbaden 
47212069Sbaden (defun get_condit nil
47312069Sbaden   (prog (q r)
47412069Sbaden 	(setq q (parse 'arrow$$))
47512069Sbaden 	(cond ((and (listp q) (find 'err$$ q)) (*throw 'parse$err q)))
47612069Sbaden 	(setq r (parse 'semi$$))
47712069Sbaden 	(cond ((and (listp r) (find 'err$$ r)) (*throw 'parse$err r)))
47812069Sbaden 	(*throw 'end_condit (frm_hnk 'condit$$ (Pop) q r))))
47912069Sbaden 
48012069Sbaden 
48112069Sbaden (defun Push (value)
48212069Sbaden   (cond ((eq flag 'while$$)
48312069Sbaden 	 (cond
48412069Sbaden 	  ((zerop wslen) (setq stk value) (setq wslen 1))
48512069Sbaden 	  ((onep wslen) (setq stk (list stk value)) (setq wslen 2))
48612069Sbaden 	  (t (*throw 'parse$err '(err$$ bad_while Push)))))
48712069Sbaden 	(t (setq stk value))))
48812069Sbaden 
48912069Sbaden (defun Pop nil
49012069Sbaden   (cond
49112069Sbaden    ((null stk) (*throw 'parse$err '(err$$ stk_emp)))
49212069Sbaden    (t
49312069Sbaden     (prog (tmp)
49412069Sbaden 	  (setq tmp stk)
49512069Sbaden 	  (cond ((eq flag 'while$$)
49612069Sbaden 		 (cond ((onep wslen) (setq stk nil) (setq wslen 0) (return tmp))
49712069Sbaden 		       ((twop wslen)
49812069Sbaden 			(setq stk (car tmp)) (setq wslen 1) (return (cadr tmp)))
49912069Sbaden 		       (t  (*throw 'parse$err '(err$$ bad_while Pop)))))
50012069Sbaden 		(t (setq stk nil)
50112069Sbaden 		   (return tmp)))))))
50212069Sbaden 
50312069Sbaden (defun get_def nil
50412069Sbaden   (prog (dummy)
50512069Sbaden 	(setq in_def t)
50612069Sbaden 	(setq dummy (get_tkn))
50712069Sbaden 	(cond ((find 'builtin$$ dummy) (*throw 'parse$err '(err$$ redef)))
50812069Sbaden 	      ((not (find 'defined$$ dummy)) (*throw 'parse$err  '(err$$ bad_nam)))
50912069Sbaden 	      (t (setq fn_name (concat (cadr dummy) '_fp))))))
51012069Sbaden 
51112069Sbaden 
51212069Sbaden (defun get_constr  nil
51312069Sbaden   (cond ((eq flag 'while$$) (cond
51412069Sbaden 			     ((twop wslen) (*throw 'parse$err `(err$$ bad_whl ,stk ,tkn)))))
51512069Sbaden 	(t (cond ((not (null stk)) (*throw 'parse$err '(err$$ bad_constr parse))))))
51612069Sbaden   (do
51712069Sbaden    ((v (parse 'constr$$) (parse 'constr$$))
51812069Sbaden     (temp nil)
51912069Sbaden     (fn_lst nil))
52012069Sbaden 
52112069Sbaden    ((eq tkn 'eof$$) (*throw 'parse$err '(err$$ eof$$)))
52212069Sbaden 
52312069Sbaden    (cond
52412069Sbaden     ((listp v)
52512069Sbaden      (cond ((eq (car v) 'err$$) (*throw 'parse$err v))
52612069Sbaden 	   ((eq (car v) 'done)
52712069Sbaden 	    (cond ((eq (cadr v) 'err$$) (*throw 'parse$err  (cdr v)))
52812069Sbaden 		  (t (return
52912069Sbaden 		      (makhunk (cons 'constr$$ (reverse (cons (cadr v) fn_lst))))))))
53012069Sbaden 	   (t (setq fn_lst (cons v fn_lst)))))
53112069Sbaden     (t (setq fn_lst (cons v fn_lst))))))
53212069Sbaden 
53312069Sbaden (def frm_hnk (lexpr (z)
53412069Sbaden 		    (prog (l bad_one)
53512069Sbaden 			  (setq l (listify z))
53612069Sbaden 			  (setq bad_one (assq 'err$$ (cdr l)))
53712069Sbaden 			  (cond ((null bad_one) (return (makhunk l)))
53812069Sbaden 				(t (*throw 'parse$err bad_one))))))
53912069Sbaden 
54012069Sbaden 
54112069Sbaden 
54212069Sbaden (defun prs_fn nil
54312069Sbaden   (concat 'p$ (cond ((atom tkn) tkn)
54412069Sbaden 		    (t (car tkn)))))
54512069Sbaden 
54612069Sbaden (defun get_while nil
54712069Sbaden   (let ((r (parse 'while$$)))
54812069Sbaden        (cond ((and (listp r) (find 'err$$ r)) (*throw 'parse$err  r))
54912069Sbaden 	     (t (*throw 'end_while (frm_hnk 'while$$ (car r) (cadr r)))))))
55012069Sbaden 
55112069Sbaden (defun twop (x)
55212069Sbaden   (eq 2 x))
55312069Sbaden 
554