Annotation of 42BSD/ucb/fp/parser.l, revision 1.1.1.1

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

unix.superglobalmegacorp.com

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.