1 ;;; -*- mode: common-lisp; package: lml2 -*-
3 ;;; $Id: ifstar.lisp,v 1.1 2003/06/20 04:12:29 kevin Exp $
5 ;;; Public domain code by Franz
9 (eval-when (:compile-toplevel :load-toplevel :execute)
10 (defvar if*-keyword-list '("then" "thenret" "else" "elseif")))
12 (defmacro if* (&rest args)
13 (do ((xx (reverse args) (cdr xx))
20 (cond ((eq state :compl)
22 (t (error "if*: illegal form ~s" args))))
23 (cond ((and (symbolp (car xx))
24 (member (symbol-name (car xx))
26 :test #'string-equal))
27 (setq lookat (symbol-name (car xx)))))
29 (cond ((eq state :init)
30 (cond (lookat (cond ((string-equal lookat "thenret")
34 "if*: bad keyword ~a" lookat))))
37 (push (car xx) col))))
40 (cond ((string-equal lookat "else")
43 "if*: multiples elses")))
46 (push `(t ,@col) totalcol))
47 ((string-equal lookat "then")
49 (t (error "if*: bad keyword ~s"
51 (t (push (car xx) col))))
55 "if*: keyword ~s at the wrong place " (car xx)))
56 (t (setq state :compl)
57 (push `(,(car xx) ,@col) totalcol))))
59 (cond ((not (string-equal lookat "elseif"))
60 (error "if*: missing elseif clause ")))
61 (setq state :init)))))