Return to ucido.l CVS log

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

Annotation of 43BSD/ucb/lisp/lisplib/ucido.l, revision 1.1

1.1     ! root        1: (setq SCCS-ucido "@(#)ucido.l      1.3     6/29/81")
        !             2: ;
        !             3: ; ucilisp do loop,  this is a seperate file due to conflicts with
        !             4: ;      the franz lisp do function.  To use this, one needs
        !             5: ;      to load this file in at run time.  (And have calls to
        !             6: ;      do be close compiled in compiled code).
        !             7: ;
        !             8: ;      NOTE: do is a macro and must be declared before calls to it
        !             9: ;              in code to be compiled!
        !            10: ;
        !            11: ;      to compile this file: liszt ucido.l
        !            12: ;
        !            13: (declare (macros t))
        !            14: 
        !            15: (eval-when (compile)
        !            16:   (load 'ucifnc))
        !            17: 
        !            18: (defun do macro (l)
        !            19:   ((lambda (dotype alist)
        !            20:           (cond ((eq dotype 'while)
        !            21:                  (dowhile (car alist) (cdr alist)))
        !            22:                 ((eq dotype 'until)
        !            23:                  (dowhile (list 'not (car alist))
        !            24:                           (cdr alist)))
        !            25:                 ((eq dotype 'for)
        !            26:                  (dofor (car alist) 
        !            27:                         (cadr alist)
        !            28:                         (caddr alist)
        !            29:                         (cdddr alist)))
        !            30:                 (t `((lambda ()
        !            31:                              ,@alist)))))
        !            32:    (cadr l)
        !            33:    (cddr l)))
        !            34: 
        !            35: (defun dowhile (expr alist)
        !            36:   `(prog (returnvar)
        !            37:         loop
        !            38:         (cond (,expr
        !            39:                (setq returnvar ((lambda ()
        !            40:                                         ,@alist)))
        !            41:                (go loop))
        !            42:               (t (return returnvar)))))
        !            43: 
        !            44: (defun dofor (var fortype varlist stmlist)
        !            45:   (selectq fortype 
        !            46:           (in `(prog (returnvar l1 l2)
        !            47:                      (setq l2 ',varlist)
        !            48:                      loop
        !            49:                      (setq l1 (car l2))
        !            50:                      (setq l2 (cdr l2))
        !            51:                      (cond ((null l1) 
        !            52:                             (return returnvar)))
        !            53:                      (setq returnvar
        !            54:                            ((lambda (,var)
        !            55:                                     ,@stmlist)
        !            56:                             (l1)))
        !            57:                      (go loop)))
        !            58:           (on `(prog (returnvar l1 l2)
        !            59:                      (setq l2 ',varlist)
        !            60:                      loop
        !            61:                      (cond ((null l2) 
        !            62:                             (return returnvar)))
        !            63:                      (setq returnvar
        !            64:                            ((lambda (,var)
        !            65:                                     ,@stmlist)
        !            66:                             (l2)))
        !            67:                      (setq l2 (cdr l2))
        !            68:                      (go loop)))
        !            69:           (rpt `(prog (returnvar ,var)
        !            70:                       (setq ,var 1)
        !            71:                       loop
        !            72:                       (cond ((not (> ,var ,varlist))
        !            73:                              (setq returnvar ((lambda ()
        !            74:                                                       ,@stmlist)))
        !            75:                              (setq ,var (1+ ,var))
        !            76:                              (go loop))
        !            77:                             (t (return returnvar)))))
        !            78:           nil))

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