ifstar.lisp

   1 ;; the if* macro used in Allegro:
   2 ;;
   3 ;; This is in the public domain... please feel free to put this definition
   4 ;; in your code or distribute it with your version of lisp.
   5
   6 (in-package #:kmrcl)
   7
   8 (eval-when (:compile-toplevel :load-toplevel :execute)
   9   (defvar if*-keyword-list '("then" "thenret" "else" "elseif")))
  10
  11 (defmacro if* (&rest args)
  12    (do ((xx (reverse args) (cdr xx))
  13         (state :init)
  14         (elseseen nil)
  15         (totalcol nil)
  16         (lookat nil nil)
  17         (col nil))
  18        ((null xx)
  19         (cond ((eq state :compl)
  20                `(cond ,@totalcol))
  21               (t (error "if*: illegal form ~s" args))))
  22        (cond ((and (symbolp (car xx))
  23                    (member (symbol-name (car xx))
  24                            if*-keyword-list
  25                            :test #'string-equal))
  26               (setq lookat (symbol-name (car xx)))))
  27
  28        (cond ((eq state :init)
  29               (cond (lookat (cond ((string-equal lookat "thenret")
  30                                    (setq col nil
  31                                          state :then))
  32                                   (t (error
  33                                       "if*: bad keyword ~a" lookat))))
  34                     (t (setq state :col
  35                              col nil)
  36                        (push (car xx) col))))
  37              ((eq state :col)
  38               (cond (lookat
  39                      (cond ((string-equal lookat "else")
  40                             (cond (elseseen
  41                                    (error
  42                                     "if*: multiples elses")))
  43                             (setq elseseen t)
  44                             (setq state :init)
  45                             (push `(t ,@col) totalcol))
  46                            ((string-equal lookat "then")
  47                             (setq state :then))
  48                            (t (error "if*: bad keyword ~s"
  49                                               lookat))))
  50                     (t (push (car xx) col))))
  51              ((eq state :then)
  52               (cond (lookat
  53                      (error
  54                       "if*: keyword ~s at the wrong place " (car xx)))
  55                     (t (setq state :compl)
  56                        (push `(,(car xx) ,@col) totalcol))))
  57              ((eq state :compl)
  58               (cond ((not (string-equal lookat "elseif"))
  59                      (error "if*: missing elseif clause ")))
  60               (setq state :init)))))
  61