Greetings!
cvs -z9 -q diff -u -r Version_2_6_8pre:2012-03-20 -r Version_2_6_8pre:2012-03-24
Index: cmpnew/gcl_cmpif.lsp
===================================================================
RCS file: /sources/gcl/gcl/cmpnew/gcl_cmpif.lsp,v
retrieving revision 1.1.2.1.14.1
retrieving revision 1.1.2.1.14.2
diff -u -u -r1.1.2.1.14.1 -r1.1.2.1.14.2
--- cmpnew/gcl_cmpif.lsp 21 Jun 2006 20:03:05 -0000 1.1.2.1.14.1
+++ cmpnew/gcl_cmpif.lsp 23 Mar 2012 14:13:07 -0000 1.1.2.1.14.2
@@ -330,32 +330,55 @@
(when (endp args) (too-few-args 'case 1 0))
(let* ((info (make-info))
(key-form (c1expr* (car args) info))
- (clauses nil))
+ clauses)
(cond ((subtypep (info-type (second key-form)) 'fixnum)
- (return-from c1case (c1expr (convert-case-to-switch
- args default )))))
- (dolist (clause (cdr args))
- (cmpck (endp clause) "The CASE clause ~S is illegal." clause)
- (case (car clause)
- ((nil))
- ((t otherwise)
- (when default
- (cmperr (if (eq default 't)
- "ECASE had an OTHERWISE clause."
- "CASE had more than one OTHERWISE clauses.")))
- (setq default (c1progn (cdr clause)))
- (add-info info (cadr default)))
- (t (let* ((keylist
- (cond ((consp (car clause))
- (mapcar #'(lambda (key) (if (symbolp key) key
- (add-object key)))
- (car clause)))
- ((symbolp (car clause)) (list (car clause)))
- (t (list (add-object (car clause))))))
- (body (c1progn (cdr clause))))
- (add-info info (cadr body))
- (push (cons keylist body) clauses)))))
- (list 'case info key-form (reverse clauses) (or default (c1nil)))))
+ (return-from c1case (c1expr (convert-case-to-switch args default
)))))
+ (do ((c (cdr args) (cdr c))) ((not c))
+ (let* ((clause (car c)))
+ (cmpck (endp clause) "The CASE clause ~S is illegal." clause)
+ (let* ((k (pop clause))(dfp (unless default (member k '(t
otherwise))))
+ (keylist
+ (cond ((listp k)
+ (mapcar (lambda (key) (if (symbolp key) key
(add-object key))) k))
+ ((symbolp k)
+ (when dfp (when (cdr c) (cmperr "default case found in
bad place")))
+ (list k))
+ ((list (add-object k)))))
+ (body (c1progn clause)))
+ (add-info info (cadr body))
+ (if dfp (setq default body) (push (cons keylist body) clauses)))))
+ (list 'case info key-form (nreverse clauses) (or default (c1nil)))))
+
+;; (defun c1case (args &optional (default nil))
+;; (when (endp args) (too-few-args 'case 1 0))
+;; (let* ((info (make-info))
+;; (key-form (c1expr* (car args) info))
+;; (clauses nil))
+;; (cond ((subtypep (info-type (second key-form)) 'fixnum)
+;; (return-from c1case (c1expr (convert-case-to-switch
+;; args default )))))
+;; (dolist (clause (cdr args))
+;; (cmpck (endp clause) "The CASE clause ~S is illegal." clause)
+;; (case (car clause)
+;; ((nil))
+;; ((t otherwise)
+;; (when default
+;; (cmperr (if (eq default 't)
+;; "ECASE had an OTHERWISE clause."
+;; "CASE had more than one OTHERWISE
clauses.")))
+;; (setq default (c1progn (cdr clause)))
+;; (add-info info (cadr default)))
+;; (t (let* ((keylist
+;; (cond ((consp (car clause))
+;; (mapcar #'(lambda (key) (if (symbolp key) key
+;; (add-object key)))
+;; (car clause)))
+;; ((symbolp (car clause)) (list (car clause)))
+;; (t (list (add-object (car clause))))))
+;; (body (c1progn (cdr clause))))
+;; (add-info info (cadr body))
+;; (push (cons keylist body) clauses)))))
+;; (list 'case info key-form (reverse clauses) (or default (c1nil)))))
(defun c2case (key-form clauses default
&aux (cvar (next-cvar)) (*vs* *vs*) (*inline-blocks* 0))
Index: debian/changelog
===================================================================
RCS file: /sources/gcl/gcl/debian/changelog,v
retrieving revision
1.220.2.1.4.1.2.1.2.1.2.2.2.1.2.19.2.207.2.23.2.11.2.14.2.13.4.7.2.22.2.154
retrieving revision
1.220.2.1.4.1.2.1.2.1.2.2.2.1.2.19.2.207.2.23.2.11.2.14.2.13.4.7.2.22.2.155
diff -u -u
-r1.220.2.1.4.1.2.1.2.1.2.2.2.1.2.19.2.207.2.23.2.11.2.14.2.13.4.7.2.22.2.154
-r1.220.2.1.4.1.2.1.2.1.2.2.2.1.2.19.2.207.2.23.2.11.2.14.2.13.4.7.2.22.2.155
--- debian/changelog 20 Jan 2012 19:53:52 -0000
1.220.2.1.4.1.2.1.2.1.2.2.2.1.2.19.2.207.2.23.2.11.2.14.2.13.4.7.2.22.2.154
+++ debian/changelog 23 Mar 2012 14:15:55 -0000
1.220.2.1.4.1.2.1.2.1.2.2.2.1.2.19.2.207.2.23.2.11.2.14.2.13.4.7.2.22.2.155
@@ -242,8 +242,9 @@
* make-array;make-sequence;replace;coerce
* restore traditional make-sequence,make-array, and coerce, and
optimize replace, as 2.6.8 compiler is still too weak re: inlines
+ * case default error checking
- -- Camm Maguire <c...@debian.org> Fri, 20 Jan 2012 19:53:29 +0000
+ -- Camm Maguire <c...@debian.org> Fri, 23 Mar 2012 14:15:50 +0000
gcl (2.6.7-7) unstable; urgency=high
Index: lsp/gcl_evalmacros.lsp
===================================================================
RCS file: /sources/gcl/gcl/lsp/gcl_evalmacros.lsp,v
retrieving revision 1.1.2.2.4.1.10.3
retrieving revision 1.1.2.2.4.1.10.4
diff -u -u -r1.1.2.2.4.1.10.3 -r1.1.2.2.4.1.10.4
--- lsp/gcl_evalmacros.lsp 24 Sep 2010 19:30:57 -0000 1.1.2.2.4.1.10.3
+++ lsp/gcl_evalmacros.lsp 23 Mar 2012 14:13:07 -0000 1.1.2.2.4.1.10.4
@@ -254,20 +254,33 @@
(go ,label))))
)
-(defmacro case (keyform &rest clauses &aux (form nil) (key (gensym)))
- (dolist (clause (reverse clauses) `(let ((,key ,keyform)) ,form))
- (declare (object clause))
- (cond ((or (eq (car clause) 't) (eq (car clause) 'otherwise))
- (setq form `(progn ,@(cdr clause))))
- ((consp (car clause))
- (setq form `(if (member ,key ',(car clause))
- (progn ,@(cdr clause))
- ,form)))
- ((car clause)
- (setq form `(if (eql ,key ',(car clause))
- (progn ,@(cdr clause))
- ,form)))))
- )
+(defmacro case (keyform &rest clauses &aux (key (load-time-value (gensym
"CASE"))) (c (reverse clauses)))
+ (declare (optimize (safety 2)))
+ (labels ((sw (x) `(eql ,key ',x))(dfp (x) (or (eq x t) (eq x 'otherwise)))
+ (v (x) (if (when (listp x) (not (cdr x))) (car x) x))
+ (m (x c &aux (v (v x))) (if (eq v x) (cons c v) v)))
+ `(let ((,key ,keyform))
+ (declare (ignorable ,key))
+ ,(let ((df (when (dfp (caar c)) (m (cdr (pop c)) 'progn))))
+ (reduce (lambda (y c &aux (a (pop c))(v (v a)))
+ (when (dfp a) (error "default case must be last"))
+ `(if ,(if (when (eq a v) (listp v)) (m (mapcar #'sw
v) 'or) (sw v)) ,(m c 'progn) ,y))
+ c :initial-value df)))))
+
+;; (defmacro case (keyform &rest clauses &aux (form nil) (key (gensym)))
+;; (dolist (clause (reverse clauses) `(let ((,key ,keyform)) ,form))
+;; (declare (object clause))
+;; (cond ((or (eq (car clause) 't) (eq (car clause) 'otherwise))
+;; (setq form `(progn ,@(cdr clause))))
+;; ((consp (car clause))
+;; (setq form `(if (member ,key ',(car clause))
+;; (progn ,@(cdr clause))
+;; ,form)))
+;; ((car clause)
+;; (setq form `(if (eql ,key ',(car clause))
+;; (progn ,@(cdr clause))
+;; ,form)))))
+;; )
(defmacro return (&optional (val nil)) `(return-from nil ,val))
Take care,
Faheem Mitha <fah...@faheem.info> writes:
> On Sat, 24 Mar 2012, Camm Maguire wrote:
>
>> Greetings!
>>
>> export CVSROOT=:pserver:anonym...@cvs.sv.gnu.org:/sources/gcl
>> cvs -z9 -q co -d gcl-2.6.8pre -r Version_2_6_8pre gcl
>>
>> Take care,
>
> Thanks for the information. I think this commit must be the one.
>
> revision 1.1.2.1.14.2
> date: 2012-03-23 19:43:07 +0530; author: camm; state: Exp; lines:
> +48 -25; commitid: OhlbKUngXCha01Yv;
> case default error checking
>
> How do I get the diff? Sorry, I've never used cvs.
>
> Regards, Faheem
>
>
>
>
--
Camm Maguire c...@maguirefamily.org
==========================================================================
"The earth is but one country, and mankind its citizens." -- Baha'u'llah
_______________________________________________
Gcl-devel mailing list
Gcl-devel@gnu.org
https://lists.gnu.org/mailman/listinfo/gcl-devel
