Return to parser.l CVS log

Up to [CSRG BSD Unix] / 43BSD / ucb / fp

Annotation of 43BSD/ucb/fp/parser.l, revision 1.1

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.