source: cl-darcs/trunk/ifstar.lisp

Last change on this file was 1, checked in by Magnus Henoch, 16 years ago

Initial import

File size: 1.8 KB
Line 
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(defpackage :excl (:use :common-lisp)
7            (:export #:if* #:then #:thenret #:else #:elseif))
8(in-package :excl)
9
10(defvar if*-keyword-list '("then" "thenret" "else" "elseif"))
11
12(defmacro if* (&rest args)
13   (do ((xx (reverse args) (cdr xx))
14        (state :init)
15        (elseseen nil)
16        (totalcol nil)
17        (lookat nil nil)
18        (col nil))
19       ((null xx)
20        (cond ((eq state :compl)
21               `(cond ,@totalcol))
22              (t (error "if*: illegal form ~s" args))))
23       (cond ((and (symbolp (car xx))
24                   (member (symbol-name (car xx))
25                           if*-keyword-list
26                           :test #'string-equal))
27              (setq lookat (symbol-name (car xx)))))
28
29       (cond ((eq state :init)
30              (cond (lookat (cond ((string-equal lookat "thenret")
31                                   (setq col nil
32                                         state :then))
33                                  (t (error
34                                      "if*: bad keyword ~a" lookat))))
35                    (t (setq state :col
36                             col nil)
37                       (push (car xx) col))))
38             ((eq state :col)
39              (cond (lookat
40                     (cond ((string-equal lookat "else")
41                            (cond (elseseen
42                                   (error
43                                    "if*: multiples elses")))
44                            (setq elseseen t)
45                            (setq state :init)
46                            (push `(t ,@col) totalcol))
47                           ((string-equal lookat "then")
48                            (setq state :then))
49                           (t (error "if*: bad keyword ~s"
50                                              lookat))))
51                    (t (push (car xx) col))))
52             ((eq state :then)
53              (cond (lookat
54                     (error
55                      "if*: keyword ~s at the wrong place " (car xx)))
56                    (t (setq state :compl)
57                       (push `(,(car xx) ,@col) totalcol))))
58             ((eq state :compl)
59              (cond ((not (string-equal lookat "elseif"))
60                     (error "if*: missing elseif clause ")))
61              (setq state :init)))))
62
Note: See TracBrowser for help on using the repository browser.