Changeset 3502


Ignore:
Timestamp:
08/25/03 13:03:00 (19 years ago)
Author:
piso
Message:

CCASE

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/j/src/org/armedbear/lisp/boot.lisp

    r3497 r3502  
    22;;;
    33;;; Copyright (C) 2003 Peter Graves
    4 ;;; $Id: boot.lisp,v 1.95 2003-08-24 19:17:53 piso Exp $
     4;;; $Id: boot.lisp,v 1.96 2003-08-25 13:03:00 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    210210           clauses)))))
    211211
    212 (defmacro case (keyform &body clauses)
     212(defmacro case (keyform &rest clauses)
    213213  (case-expand 'case 'eql keyform clauses))
     214
     215
     216;; CCASE (from CLISP)
     217
     218(defun parenthesize-keys (clauses)
     219  ;; PARENTHESIZE-KEYS is necessary to avoid confusing
     220  ;; the symbols OTHERWISE and T used as keys, with the same
     221  ;; symbols used in the syntax of the non exhaustive CASE.
     222  (mapcar #'(lambda (c)
     223             (cond ((or (eq (car c) 't)
     224                        (eq (car c) 'otherwise))
     225                    (cons (list (car c)) (cdr c)))
     226                   (t c)))
     227          clauses))
     228
     229(defmacro ccase (keyplace &rest clauses)
     230  (let ((g (gensym))
     231        (h (gensym)))
     232    `(block ,g
     233            (tagbody
     234             ,h
     235             (return-from ,g
     236                          (case ,keyplace
     237                            ,@(parenthesize-keys clauses)
     238                            (otherwise
     239                             (error 'type-error "CCASE error") ;; FIXME
     240                             (go ,h))))))))
    214241
    215242
Note: See TracChangeset for help on using the changeset viewer.