/usr/share/common-lisp/source/kmrcl/ifstar.lisp is in cl-kmrcl 1.106-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 | ;; 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)))))
|