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