/[gcl]/gcl/clcs/gcl_clcs_macros.lisp
ViewVC logotype

Diff of /gcl/clcs/gcl_clcs_macros.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.2 by camm, Sat May 7 02:52:28 2005 UTC revision 1.3 by camm, Mon Aug 8 22:48:55 2005 UTC
# Line 42  Line 42 
42                 (RPLACA (CAR C) (LIST KEYS))))))                 (RPLACA (CAR C) (LIST KEYS))))))
43    
44  (DEFMACRO ECASE (KEYFORM &REST CASES)  (DEFMACRO ECASE (KEYFORM &REST CASES)
45      (declare (optimize (safety 1)))
46    (LET ((KEYS (ACCUMULATE-CASES 'ECASE CASES NIL))    (LET ((KEYS (ACCUMULATE-CASES 'ECASE CASES NIL))
47          (NCASES (ESCAPE-SPECIAL-CASES-REPLACE CASES))          (NCASES (ESCAPE-SPECIAL-CASES-REPLACE CASES))
48          (VAR (GENSYM)))          (VAR (GENSYM)))
# Line 55  Line 56 
56                                  :POSSIBILITIES ',KEYS))))))                                  :POSSIBILITIES ',KEYS))))))
57    
58  (DEFMACRO CCASE (KEYPLACE &REST CASES)  (DEFMACRO CCASE (KEYPLACE &REST CASES)
59      (declare (optimize (safety 1)))
60    (LET ((KEYS (ACCUMULATE-CASES 'CCASE CASES NIL))    (LET ((KEYS (ACCUMULATE-CASES 'CCASE CASES NIL))
61          (NCASES (ESCAPE-SPECIAL-CASES-REPLACE CASES))          (NCASES (ESCAPE-SPECIAL-CASES-REPLACE CASES))
62          (TAG1 (GENSYM))          (TAG1 (GENSYM))
# Line 79  Line 81 
81                     (GO ,TAG2))))))))))                     (GO ,TAG2))))))))))
82    
83  (DEFMACRO ETYPECASE (KEYFORM &REST CASES)  (DEFMACRO ETYPECASE (KEYFORM &REST CASES)
84      (declare (optimize (safety 1)))
85    (LET ((TYPES (ACCUMULATE-CASES 'ETYPECASE CASES T))    (LET ((TYPES (ACCUMULATE-CASES 'ETYPECASE CASES T))
86          (VAR (GENSYM)))          (VAR (GENSYM)))
87      `(LET ((,VAR ,KEYFORM))      `(LET ((,VAR ,KEYFORM))
# Line 91  Line 94 
94                                  :POSSIBILITIES ',TYPES))))))                                  :POSSIBILITIES ',TYPES))))))
95    
96  (DEFMACRO CTYPECASE (KEYPLACE &REST CASES)  (DEFMACRO CTYPECASE (KEYPLACE &REST CASES)
97      (declare (optimize (safety 1)))
98    (LET ((TYPES (ACCUMULATE-CASES 'CTYPECASE CASES T))    (LET ((TYPES (ACCUMULATE-CASES 'CTYPECASE CASES T))
99          (TAG1 (GENSYM))          (TAG1 (GENSYM))
100          (TAG2 (GENSYM)))          (TAG2 (GENSYM)))
# Line 139  Line 143 
143           :FORMAT-ARGUMENTS (LIST ASSERTION)))           :FORMAT-ARGUMENTS (LIST ASSERTION)))
144    
145  (DEFMACRO ASSERT (TEST-FORM &OPTIONAL PLACES DATUM &REST ARGUMENTS)  (DEFMACRO ASSERT (TEST-FORM &OPTIONAL PLACES DATUM &REST ARGUMENTS)
146      (declare (optimize (safety 1)))
147    (LET ((TAG (GENSYM)))    (LET ((TAG (GENSYM)))
148      `(TAGBODY ,TAG      `(TAGBODY ,TAG
149         (UNLESS ,TEST-FORM         (UNLESS ,TEST-FORM

Legend:
Removed from v.1.2  
changed lines
  Added in v.1.3

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26