| Current Path : /proc/thread-self/root/usr/share/common-lisp/source/kmrcl/ |
Linux ift1.ift-informatik.de 5.4.0-216-generic #236-Ubuntu SMP Fri Apr 11 19:53:21 UTC 2025 x86_64 |
| Current File : //proc/thread-self/root/usr/share/common-lisp/source/kmrcl/ifstar.lisp |
;; the if* macro used in Allegro:
;;
;; This is in the public domain... please feel free to put this definition
;; in your code or distribute it with your version of lisp.
(in-package #:kmrcl)
(eval-when (:compile-toplevel :load-toplevel :execute)
(defvar if*-keyword-list '("then" "thenret" "else" "elseif")))
(defmacro if* (&rest args)
(do ((xx (reverse args) (cdr xx))
(state :init)
(elseseen nil)
(totalcol nil)
(lookat nil nil)
(col nil))
((null xx)
(cond ((eq state :compl)
`(cond ,@totalcol))
(t (error "if*: illegal form ~s" args))))
(cond ((and (symbolp (car xx))
(member (symbol-name (car xx))
if*-keyword-list
:test #'string-equal))
(setq lookat (symbol-name (car xx)))))
(cond ((eq state :init)
(cond (lookat (cond ((string-equal lookat "thenret")
(setq col nil
state :then))
(t (error
"if*: bad keyword ~a" lookat))))
(t (setq state :col
col nil)
(push (car xx) col))))
((eq state :col)
(cond (lookat
(cond ((string-equal lookat "else")
(cond (elseseen
(error
"if*: multiples elses")))
(setq elseseen t)
(setq state :init)
(push `(t ,@col) totalcol))
((string-equal lookat "then")
(setq state :then))
(t (error "if*: bad keyword ~s"
lookat))))
(t (push (car xx) col))))
((eq state :then)
(cond (lookat
(error
"if*: keyword ~s at the wrong place " (car xx)))
(t (setq state :compl)
(push `(,(car xx) ,@col) totalcol))))
((eq state :compl)
(cond ((not (string-equal lookat "elseif"))
(error "if*: missing elseif clause ")))
(setq state :init)))))