Return to ucifnc.l CVS log

Up to [CSRG BSD Unix] / 42BSD / ucb / lisp / lisplib

Annotation of 42BSD/ucb/lisp/lisplib/ucifnc.l, revision 1.1

1.1     ! root        1: (setq rcs-ucifnc-
        !             2:    "$Header: /usr/lib/lisp/ucifnc.l,v 1.1 83/01/29 18:41:16 jkf Exp $")
        !             3: 
        !             4: ;
        !             5: ; There is problems with the ucilisp do being
        !             6: ;      incompatible with maclisp/franz do,
        !             7: ;      The problems with compiling do are gone, but
        !             8: ;      due to these possible problems, the ucilisp do function
        !             9: ;      is in a seperate file ucido.l and users of it
        !            10: ;      should also load that file in at compile time before
        !            11: ;      any call to do (since do is a macro) (and
        !            12: ;      at runtime if do is to be interpreted).
        !            13: ;
        !            14: ; This file is meant to be fasl'd or used with liszt -u
        !            15: ;      not to be read in interpretively (the syntax changes
        !            16: ;      will not work in that case.
        !            17: ;
        !            18: ;      to compile this file do liszt ucifnc.l
        !            19: ;
        !            20: ;      one who wants to use these functions or compile and run
        !            21: ;      a ucilisp program should do both
        !            22: ;      liszt -u file.l         when compiling.
        !            23: ;      and
        !            24: ;      (fasl '/usr/lib/lisp/ucifnc)
        !            25: ;              before loading in and running them
        !            26: ;              programs in lisp.
        !            27: ;      This is because some functions are macros and others are too
        !            28: ;              complicated and need other functions around.
        !            29: ;      Note this file will not load in directly and when fasl'd in will
        !            30: ;              cause the syntax of lisp to change to ucilisp syntax.
        !            31: ;
        !            32: (declare (macros t))
        !            33: 
        !            34: ;
        !            35: ; ucilisp (de df dm) declare function macros.
        !            36: ;
        !            37: ; (de name args body) -> declare exprs and lexprs.
        !            38: ;
        !            39: (defun de macro (l) 
        !            40:   `(defun ,@(cdr l)))
        !            41:   
        !            42: ;
        !            43: ; (df name args body) -> declare fexprs.
        !            44: ;
        !            45: (defun df macro (l) 
        !            46:   `(defun ,(cadr l)
        !            47:          fexpr
        !            48:          ,@(cddr l)))
        !            49: 
        !            50: ;
        !            51: ; macro's are not compiled except under the same
        !            52: ;      conditions as in franz lisp.
        !            53: ;      (usually just do (declare (macros t))
        !            54: ;              to have macros also compiled).
        !            55: ;
        !            56: ;
        !            57: ; (dm name args body) -> declare macros. same as (defun name 'macro body)
        !            58: ;
        !            59: (defun dm macro (l) 
        !            60:   `(defun ,(cadr l)
        !            61:          macro
        !            62:          ,@(cddr l)))
        !            63:   
        !            64: ;
        !            65: ; ucilisp let macro.
        !            66: ;
        !            67: (eval-when (compile load eval)
        !            68:   (defun let1 (l vars vals body)
        !            69:         (cond ((null l) 
        !            70:                (cons (cons 'lambda (cons vars body)) vals))
        !            71:               (t 
        !            72:                (let1 (cddr l) 
        !            73:                      (cons (car l) vars) 
        !            74:                      (cons (cadr l) vals) body)))))
        !            75:   
        !            76: (defun let macro (l)
        !            77:   (let1 (cadr l) nil nil (cddr l)))
        !            78:   
        !            79: (defun nconc1 macro (l) 
        !            80:   `(nconc ,(cadr l) (list ,(caddr l))))
        !            81:   
        !            82: (putd 'expandmacro (getd 'macroexpand))
        !            83:   
        !            84: ;
        !            85: ; ucilisp selectq function. (written by jkf)
        !            86: ;
        !            87: (def selectq
        !            88:   (macro (form)
        !            89:         ((lambda (x)
        !            90:                  `((lambda (,x)
        !            91:                            (cond 
        !            92:                             ,@(maplist 
        !            93:                                '(lambda (ff)
        !            94:                                         (cond ((null (cdr ff))
        !            95:                                                `(t  ,(car ff)))
        !            96:                                               ((atom (caar ff))
        !            97:                                                `((eq ,x ',(caar ff))
        !            98:                                                  . ,(cdar ff)))
        !            99:                                               (t
        !           100:                                                `((memq ,x ',(caar ff))
        !           101:                                                  . ,(cdar ff)))))
        !           102:                                (cddr form))))
        !           103:                    ,(cadr form)))
        !           104:          (gensym 'Z))))
        !           105: 
        !           106: ;
        !           107: ; ucilisp functions which declare read macros.
        !           108: ;
        !           109: ; dsm - declare splicing read macro.
        !           110: ;
        !           111: (defun dsm macro (l) 
        !           112:   `(eval-when (compile load eval)
        !           113:              (setsyntax ',(cadr l) 'splicing ',(caddr l))))
        !           114: 
        !           115: ;
        !           116: ; drm - declare read macro.
        !           117: ;
        !           118: (defun drm macro (l) 
        !           119:   `(eval-when (compile load eval)
        !           120:              (setsyntax ',(cadr l) 'macro ',(caddr l))))
        !           121: 
        !           122: ;
        !           123: ;(:= a b) -> ucilisp assignment macro.
        !           124: ;
        !           125: (defun := macro (expression)
        !           126:       (let (lft (macroexpand (cadr expression)) rgt (caddr expression))
        !           127:           (cond ((atom lft) 
        !           128:                  `(setq ,lft ,(subst lft '*-* rgt)))
        !           129:                 ((get (car lft) 'set-program)
        !           130:                  (cons (get (car lft) 'set-program)
        !           131:                        (append (cdr lft) (list (subst lft '*-* rgt))))))))
        !           132:   
        !           133: (defprop car rplaca set-program)
        !           134: (defprop cdr rplacd set-program)
        !           135: (defprop cadr rplacad set-program)
        !           136: (defprop cddr rplacdd set-program)
        !           137: (defprop caddr rplacadd set-program)
        !           138: (defprop cadddr rplacaddd set-program)
        !           139: (defprop get get-set-program set-program)
        !           140: 
        !           141: (defun get-set-program (atm prop val) 
        !           142:   (putprop atm val prop))
        !           143: 
        !           144: (defun rplacad (exp1 exp2) 
        !           145:   (rplaca (cdr exp1) exp2))
        !           146: 
        !           147: (defun rplacdd (exp1 exp2) 
        !           148:   (rplacd (cdr exp1) exp2))
        !           149: 
        !           150: (defun rplacadd (exp1 exp2) 
        !           151:   (rplaca (cddr exp1) exp2))
        !           152: 
        !           153: (defun rplacaddd (exp1 exp2) 
        !           154:   (rplaca (cdddr exp1) exp2))
        !           155: 
        !           156: ;
        !           157: ; ucilisp record-type package to declare records and field extraction
        !           158: ;      macros.
        !           159: ;
        !           160: 
        !           161: (declare (special *type*))
        !           162: 
        !           163: (defun record-type macro (l)
        !           164:   (let (*type* (cadr l) *flag* (caddr l) slots (car (last l)))
        !           165:        `(progn 'compile
        !           166:               (defun ,*type*
        !           167:                      ,(slot-funs-extract slots (and *flag* '(d)))
        !           168:                      ,(cond ((null *flag*) (struc-cons-form slots))
        !           169:                             (t (append `(cons ',*flag*)
        !           170:                                        (list (struc-cons-form slots))))))
        !           171:               ,(cond (*flag*
        !           172:                       (cond ((dtpr *flag*) (setq *flag* *type*)))
        !           173:                       `(defun ,(concat 'is- *type*)
        !           174:                               macro
        !           175:                               (l)
        !           176:                               (list 'and (list 'dtpr (cadr l))
        !           177:                                     (list 'eq (list 'car (cadr l))
        !           178:                                           '',*flag*))))))))
        !           179:   
        !           180: (defun slot-funs-extract (slots path)
        !           181:   (cond ((null slots) nil)
        !           182:        ((atom slots)
        !           183:         (eval `(defun ,(concat slots ': *type*)
        !           184:                       macro
        !           185:                       (l)
        !           186:                       (list ',(readlist `(c ,@path r))
        !           187:                             (cadr l))))
        !           188:         (list slots))
        !           189:        ((nconc (slot-funs-extract (car slots) (cons 'a path))
        !           190:                (slot-funs-extract (cdr slots) (cons 'd path))))))
        !           191:   
        !           192: (defun struc-cons-form (struc)
        !           193:   (cond ((null struc) nil)
        !           194:        ((atom struc) struc)
        !           195:        (t `(cons ,(struc-cons-form (car struc))
        !           196:                  ,(struc-cons-form (cdr struc))))))
        !           197: 
        !           198: (defun some macro (l)
        !           199:   `((lambda (f a)
        !           200:            (prog ()
        !           201:                  loop
        !           202:                  (cond ((null a) (return nil))
        !           203:                        ((funcall f (car a))
        !           204:                         (return a))
        !           205:                        (t (setq a (cdr a))
        !           206:                           (go loop)))))
        !           207:     ,(cadr l)
        !           208:     ,(caddr l)))
        !           209: 
        !           210: (declare (special vars))
        !           211:   
        !           212: (defun for macro (*l*)
        !           213:   (let (vars (vars:for *l*)
        !           214:             args (args:for *l*)
        !           215:             test (test:for *l*)
        !           216:             type (type:for *l*)
        !           217:             body (body:for *l*))
        !           218:        (cons (make-mapfn vars test type body)
        !           219:             (cons (list 'quote
        !           220:                         (make-lambda 
        !           221:                          vars (add-test test
        !           222:                                         (make-body vars test type body))))
        !           223:                   args))))
        !           224:   
        !           225: (defun type:for (*l*)
        !           226:   (let (item (item:for '(do save splice filter) *l*))
        !           227:        (cond (item (car item))
        !           228:             ((error '"No body in for loop")))))
        !           229:   
        !           230: (defun error (l &optional x)
        !           231:   (cond (x (terpri) (patom l) (terpri) (drain) (break) l)
        !           232:        (t l)))
        !           233:   
        !           234: (defun vars:for (*m*)
        !           235:   (mapcan '(lambda (x) (cond ((is-var-form x) (list (var:var-form x))))) *m*))
        !           236: 
        !           237: (defun args:for (*n*)
        !           238:   (mapcan '(lambda (x) 
        !           239:                   (cond ((is-var-form x) (list (args:var-form x)))))
        !           240:          *n*))
        !           241: 
        !           242: (defun is-var-form (x) (and (eq (length x) 3) (eq (cadr x) 'in)))
        !           243:   
        !           244: (defun var:var-form (x) (car x))
        !           245: (defun args:var-form (x) (caddr x))
        !           246:   
        !           247: (defun test:for (*o*)
        !           248:   (let (item (item:for '(when) *o*))
        !           249:        (cond (item (cadr item)))))
        !           250:   
        !           251: (defun body:for (*p*)
        !           252:   (let (item (item:for '(do save splice filter) *p*))
        !           253:        (cond ((not item) (error '"NO body in for loop"))
        !           254:             ((eq (length (cdr item)) 1) (cadr item))
        !           255:             ((cons 'progn (cdr item))))))
        !           256: 
        !           257: (declare (special *l* item))
        !           258: 
        !           259: (defun item:for (keywords *l*)
        !           260:   (let (item nil)
        !           261:        (some '(lambda (key) (setq item (assoc key (cdr *l*))))
        !           262:             keywords)
        !           263:        item))
        !           264: 
        !           265: (defun make-mapfn (vars test type body)
        !           266:   (cond ((equal type 'do) 'mapc)
        !           267:        ((not (equal type 'save)) 'mapcan)
        !           268:        ((null test) 'mapcar)
        !           269:        ((subset-test vars body) 'subset)
        !           270:        ('mapcan)))
        !           271:   
        !           272: (defun subset-test (vars body)
        !           273:   (and (equal (length vars) 1) (equal (car vars) body)))
        !           274:   
        !           275: (defun make-body (vars test type body)
        !           276:   (cond ((equal type 'filter)
        !           277:         (list 'let (list 'x body) '(cond (x (list x)))))
        !           278:        ((or (not (equal type 'save)) (null test)) body)
        !           279:        ((subset-test vars body) nil)
        !           280:        ((list 'list body))))
        !           281:   
        !           282: (defun add-test (test body)
        !           283:   (cond ((null test) body)
        !           284:        ((null body) test)
        !           285:        (t (list 'cond (cond ((eq (car body) 'progn) (cons test (cdr body)))
        !           286:                             ((list test body)))))))
        !           287:   
        !           288: (defun make-lambda (var body)
        !           289:   (cond ((equal var (cdr body)) (car body))
        !           290:        ((eq (car body) 'progn) (cons 'lambda (cons vars (cdr body))))
        !           291:        ((list 'lambda vars body))))
        !           292:   
        !           293: (defun pop macro (q)
        !           294:   `(prog (*q*)
        !           295:         (setq *q* (car ,(cadr q)))
        !           296:         (setq ,(cadr q) (cdr ,(cadr q)))
        !           297:         (return *q*)))
        !           298:   
        !           299: (defun length (*u*)
        !           300:   (cond ((null *u*) 0)
        !           301:        ((atom *u*) 0)
        !           302:        ((add1 (length (cdr *u*))))))
        !           303:   
        !           304: (declare (special l))
        !           305:   
        !           306: (defun every macro (l)
        !           307:   `(prog ($$k $v)
        !           308:         (setq $$k ,(caddr l))
        !           309:         loop
        !           310:         (cond ((null $$k)
        !           311:                (return t))
        !           312:               ((apply ,(cadr l) (list (car $$k)))
        !           313:                (setq $$k (cdr $$k))
        !           314:                (go loop)))
        !           315:         (return nil)))
        !           316: 
        !           317: (defun timer fexpr (request)
        !           318:   (prog (timein timeout result cpu garbage)
        !           319:        (setq timein (ptime))
        !           320:        (prog ()
        !           321:              loop (setq result (eval (car request)))
        !           322:              (setq request (cdr request))
        !           323:              (cond ((null request) (return result))
        !           324:                    ((go loop))))
        !           325:        (setq timeout (ptime))
        !           326:        (setq cpu (quotient (times 1000.0
        !           327:                                   (quotient (difference (car timeout) 
        !           328:                                                         (car timein))
        !           329:                                             60.0))
        !           330:                            1000.0))
        !           331:        (setq garbage (quotient (times 1000.0
        !           332:                                       (quotient (difference (cadr timeout) 
        !           333:                                                             (cadr timein)) 
        !           334:                                                 60.0))
        !           335:                                1000.0))
        !           336:        (print (cons cpu garbage))
        !           337:        (terpri)
        !           338:        (return result)))
        !           339:   
        !           340: (defun addprop (id value prop)
        !           341:   (putprop id (enter value (get id prop)) prop))
        !           342:   
        !           343: (defun enter (v l)
        !           344:   (cond ((member v l) l)
        !           345:        (t (cons v l))))
        !           346:   
        !           347: (defmacro subset (fun lis)
        !           348:   `(mapcan '(lambda (ele)
        !           349:                    (cond ((funcall ,fun ele) (ncons ele))))
        !           350:           ,lis))
        !           351:   
        !           352: (defun push macro (varval)
        !           353:   `(setq ,(cadr varval)
        !           354:         (cons ,(caddr varval)
        !           355:               ,(cadr varval))))
        !           356:   
        !           357: (putd 'consp (getd 'dtpr))
        !           358:   
        !           359: (defun prelist (a b)
        !           360:   (cond ((null a) nil)
        !           361:        ((eq b 0) nil)
        !           362:        ((cons (car a) (prelist (cdr a) (sub1 b))))))
        !           363:   
        !           364: (defun suflist (a b)
        !           365:   (cond ((null a) nil)
        !           366:        ((eq b 0) a)
        !           367:        ((suflist (cdr a) (sub1 b)))))
        !           368:   
        !           369: (defun loop macro (l)
        !           370:   `(prog ,(var-list (get-keyword 'initial l))
        !           371:         ,@(subset (function caddr)
        !           372:                   (setq-steps (get-keyword 'initial l)))
        !           373:         loop
        !           374:         ,@(apply (function append) (mapcar (function do-clause) (cdr l)))
        !           375:         (go loop)
        !           376:         exit
        !           377:         (return ,@(get-keyword 'result l))))
        !           378:   
        !           379: (defun do-clause (clause)
        !           380:   (cond ((memq (car clause) '(initial result)) nil)
        !           381:        ((eq (car clause) 'while)
        !           382:         (list (list 'or (cadr clause) '(go exit))))
        !           383:        ((eq (car clause) 'do) (cdr clause))
        !           384:        ((eq (car clause) 'next) (setq-steps (cdr clause)))
        !           385:        ((eq (car clause) 'until)
        !           386:         (list (list 'and (cadr clause) '(go exit))))
        !           387:        (t (terpri) (patom '"unknown keyword clause")
        !           388:           (patom (car clause))
        !           389:           (terpri))))
        !           390:   
        !           391: (defun get-keyword (key l)
        !           392:   (cdr (assoc key (cdr l))))
        !           393:   
        !           394: (defun var-list (r)
        !           395:   (and r (cons (car r) (var-list (cddr r)))))
        !           396:   
        !           397: (defun setq-steps (s)
        !           398:   (and s (cons (list 'setq (car s) (cadr s))
        !           399:               (setq-steps (cddr s)))))
        !           400: 
        !           401: (putd 'readch (getd 'readc))
        !           402: 
        !           403: 
        !           404: ;
        !           405: ; ucilisp msg function. (written by jkf)
        !           406: ;
        !           407: (defmacro msg ( &rest body)
        !           408:   `(progn ,@(mapcar 
        !           409:             '(lambda (form)
        !           410:                      (cond ((eq form t) '(line-feed 1))
        !           411:                            ((numberp form)
        !           412:                             (cond ((greaterp form 0) 
        !           413:                                    `(msg-space ,form))
        !           414:                                   (t `(line-feed ,(minus form)))))
        !           415:                            ((atom form) `(patom ,form))
        !           416:                            ((eq (car form) t) '(patom '/       ))
        !           417:                            ((eq (car form) 'e) 
        !           418:                             `(patom ,(cadr form)))
        !           419:                            (t `(patom ,form))))
        !           420:             body)))
        !           421:   
        !           422: ;
        !           423: ; this must be fixed to not use do.
        !           424: ;
        !           425: (defmacro msg-space (n)
        !           426:   (cond ((eq 1 n) '(patom '" "))
        !           427:        (t `(do i ,n (sub1 i) (lessp i 1) (patom '/ ))))) 
        !           428: 
        !           429: (defmacro line-feed (n)
        !           430:   (cond ((eq 1 n) '(terpr))
        !           431:        (t `(do i ,n (sub1 i) (lessp i 1) (terpr)))))
        !           432: 
        !           433: (defmacro prog1 ( first &rest rest &aux (foo (gensym)))
        !           434:   `((lambda (,foo) ,@rest ,foo) ,first))
        !           435: 
        !           436: (defun append1 (l x) (append l (list x)))
        !           437: 
        !           438: ; compatability functions: functions required by uci lisp but not
        !           439: ;      present in franz
        !           440: ;
        !           441: ; union uses the franz do loop (not the ucilisp one defined in this file).
        !           442: ;
        !           443: 
        !           444: (def union 
        !           445:   (lexpr (n)
        !           446:         (do ((res (arg n))
        !           447:              (i (sub1 n) (sub1 i)))
        !           448:             ((zerop i) res)
        !           449:             (mapc '(lambda (arg)
        !           450:                            (cond ((not (member arg res)) 
        !           451:                                   (setq res (cons arg res)))))
        !           452:                   (arg i)))))
        !           453: 
        !           454: 
        !           455: (putd 'newsym (getd 'gensym))  ; this is not exactly correct.
        !           456:                                ; it only uses the first letter of the arg.
        !           457: (putd 'remove (getd 'delete))
        !           458: 
        !           459: ; ignore column count
        !           460: (def sprint
        !           461:   (lambda (form column)
        !           462:          ($prpr form)))
        !           463: 
        !           464: (def save  (lambda (f) (putprop f (getd f) 'olddef)))
        !           465: 
        !           466: (def unsave 
        !           467:   (lambda (f) 
        !           468:          (putd f (get f 'olddef))))
        !           469: 
        !           470: (putd 'atcat (getd 'concat))
        !           471: (putd 'consp (getd 'dtpr))
        !           472: 
        !           473: (defun neq macro (x)
        !           474:   `(not (eq ,@(cdr x))))
        !           475: 
        !           476: (putd 'gt (getd '>))
        !           477: (putd 'lt (getd '<))
        !           478: 
        !           479: (defun le macro (x)
        !           480:   `(not (> ,@(cdr x))))
        !           481: 
        !           482: (defun ge macro (x)
        !           483:   `(not (< ,@(cdr x))))
        !           484: 
        !           485: (defun litatom macro (x)
        !           486:   `(and (atom ,@(cdr x))
        !           487:        (not (numberp ,@(cdr x)))))
        !           488: 
        !           489: (putd 'apply\# (getd 'apply))
        !           490: 
        !           491: (defun tconc (ptr x)
        !           492:   (cond ((null ptr)
        !           493:         (prog (temp)
        !           494:               (setq temp (list x))
        !           495:               (return (setq ptr (cons temp (last temp))))))
        !           496:        ((null (car ptr))
        !           497:         (rplaca ptr (list x))
        !           498:         (rplacd ptr (last (car ptr)))
        !           499:         ptr)
        !           500:        (t (prog (temp)
        !           501:                 (setq temp (cdr ptr))
        !           502:                 (rplacd (cdr ptr) (list x))
        !           503:                 (rplacd ptr (cdr temp))
        !           504:                 (return ptr)))))
        !           505: 
        !           506: ;
        !           507: ;      unbound - (setq x (unbound)) will unbind x.
        !           508: ; "this [code] is sick" - jkf.
        !           509: ;
        !           510: (defun unbound macro (l)
        !           511:   `(fake -4))
        !           512: 
        !           513: ;
        !           514: ;
        !           515: ;      due to problems with franz do in the compiler, this
        !           516: ;              has been commented out and is left in a seperate
        !           517: ;              file called /usr/lib/lisp/ucido.l
        !           518: ;
        !           519: ;(defun do macro (l)
        !           520: ;  ((lambda (dotype alist)
        !           521: ;         (selectq dotype 
        !           522: ;                  (while (dowhile (car alist) (cdr alist)))
        !           523: ;                  (until (dowhile (list 'not (car alist))
        !           524: ;                                  (cdr alist)))
        !           525: ;                  (for (dofor (car alist) 
        !           526: ;                              (cadr alist)
        !           527: ;                              (caddr alist)
        !           528: ;                              (cdddr alist)))
        !           529: ;                  `((lambda ()
        !           530: ;                            ,@alist))))
        !           531: ;   (cadr l)
        !           532: ;   (cddr l)))
        !           533: ;
        !           534: ;(defun dowhile (expr alist)
        !           535: ;  `(prog (returnvar)
        !           536: ;       loop
        !           537: ;       (cond (,expr
        !           538: ;              (setq returnvar ((lambda ()
        !           539: ;                                       ,@alist)))
        !           540: ;              (go loop))
        !           541: ;             (t (return returnvar)))))
        !           542: ;
        !           543: ;(defun dofor (var fortype varlist stmlist)
        !           544: ;  (selectq fortype 
        !           545: ;         (in `(prog (returnvar l1 l2)
        !           546: ;                    (setq l2 ',varlist)
        !           547: ;                    loop
        !           548: ;                    (setq l1 (car l2))
        !           549: ;                    (setq l2 (cdr l2))
        !           550: ;                    (cond ((null l1) 
        !           551: ;                           (return returnvar)))
        !           552: ;                    (setq returnvar
        !           553: ;                          ((lambda (,var)
        !           554: ;                                   ,@stmlist)
        !           555: ;                           (l1)))
        !           556: ;                    (go loop)))
        !           557: ;         (on `(prog (returnvar l1 l2)
        !           558: ;                    (setq l2 ',varlist)
        !           559: ;                    loop
        !           560: ;                    (cond ((null l2) 
        !           561: ;                           (return returnvar)))
        !           562: ;                    (setq returnvar
        !           563: ;                          ((lambda (,var)
        !           564: ;                                   ,@stmlist)
        !           565: ;                           (l2)))
        !           566: ;                    (setq l2 (cdr l2))
        !           567: ;                    (go loop)))
        !           568: ;         (rpt `(prog (returnvar ,var)
        !           569: ;                     (setq ,var 1)
        !           570: ;                     loop
        !           571: ;                     (cond ((not (> ,var ,varlist))
        !           572: ;                            (setq returnvar ((lambda ()
        !           573: ;                                                     ,@stmlist)))
        !           574: ;                            (setq ,var (1+ ,var))
        !           575: ;                            (go loop))
        !           576: ;                           (t (return returnvar)))))
        !           577: ;         nil))
        !           578: ;
        !           579: (putd 'dddd* (getd 'boundp))
        !           580: (defun boundp (l)
        !           581:   (cond ((arrayp l))
        !           582:        ((dddd* l))))
        !           583: 
        !           584: ;
        !           585: ; now change to ucilisp syntax.
        !           586: ;
        !           587: (sstatus uctolc t)
        !           588: ;
        !           589: ;      Leave backquote macro in for now.
        !           590: ;              These characters should be declared as follows for real
        !           591: ;              ucilisp syntax though.
        !           592: ;(setsyntax '\` 2)
        !           593: ;(setsyntax '\, 2)
        !           594: ;(setsyntax '\@ 201)
        !           595: ;(setsyntax '\@ 'macro '(lambda () (list 'quote (read))))
        !           596: ; 
        !           597: ; ~ as comment character, not ; and / instead of \ for escape
        !           598: (setsyntax '\~ 'splicing 'zapline)
        !           599: (setsyntax '\; 2)
        !           600: (setsyntax '\# 2)
        !           601: (setsyntax '\/ 143)
        !           602: (setsyntax '\\   2)
        !           603: (setsyntax '\! 2)

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