home *** CD-ROM | disk | FTP | other *** search
/ BURKS 2 / BURKS_AUG97.ISO / BURKS / SOFTWARE / LANGS / PCLISP30.ZIP / IF.L (.txt) < prev    next >
Lisp/Scheme  |  1987-04-05  |  1KB  |  34 lines
  1. ;--- super if macro
  2. ; This macro allow the following forms:
  3. ;       (If a then b)   ==>  (cond (a b))
  4. ;       (If a thenret)  ==>  (cond (a))
  5. ;       (If a then b else c) ==> (cond (a b) (t c))
  6. ;       (If a then b b2              ==> (cond (a b b2) (c d d2) (t e))
  7. ;        elseif c then d d2
  8. ;        else e)
  9. ;
  10. ;
  11. (defun If macro  (lis) 
  12.        (prog (majlis minlis revl)
  13.          (do ((revl (reverse lis) (cdr revl)))
  14.          ((null revl))
  15.          (cond ((eq (car revl) 'else)
  16.             (setq majlis `((t ,@minlis) ,@majlis)
  17.                   minlis nil))
  18.                ((or (eq (car revl) 'then) (eq (car revl) 'thenret))
  19.             (setq revl (cdr revl)
  20.                   majlis `((,(car revl) ,@minlis) ,@majlis)
  21.                   minlis nil))
  22.                ((eq (car revl) 'elseif))
  23.                ((eq (car revl) 'If)
  24.             (setq majlis `(cond ,@majlis)))
  25.                (t (setq minlis `( ,(car revl) ,@minlis)))))
  26.          ; we displace the previous macro, that is we actually replace
  27.          ; the if list structure with the corresponding cond, meaning
  28.          ; that the expansion is done only once
  29.          (rplaca  lis (car majlis))
  30.          (rplacd lis (cdr majlis))
  31.          (return majlis)))
  32.  
  33. ;--- msg : print a message consisting of strings and values
  34.