Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv3019
Modified Files: basic-macros.lisp Log Message: Slightly improved eql.
Date: Tue Jun 8 15:02:47 2004 Author: ffjeld
Index: movitz/losp/muerte/basic-macros.lisp diff -u movitz/losp/muerte/basic-macros.lisp:1.20 movitz/losp/muerte/basic-macros.lisp:1.21 --- movitz/losp/muerte/basic-macros.lisp:1.20 Tue Jun 8 13:06:26 2004 +++ movitz/losp/muerte/basic-macros.lisp Tue Jun 8 15:02:47 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Wed Nov 8 18:44:57 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: basic-macros.lisp,v 1.20 2004/06/08 20:06:26 ffjeld Exp $ +;;;; $Id: basic-macros.lisp,v 1.21 2004/06/08 22:02:47 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------
@@ -420,8 +420,22 @@ (:compile-two-forms (:eax :ebx) ,x ,y) (:cmpl :eax :ebx)))))
-(define-compiler-macro eql (x y) - `(eq ,x ,y)) +(define-compiler-macro eql (&whole form x y &environment env) + (cond + ((and (movitz:movitz-constantp x env) + (movitz:movitz-constantp y env)) + (eql (movitz:movitz-eval x env) + (movitz:movitz-eval y env))) + ((movitz:movitz-constantp y env) + `(eql ,y ,x)) + ((movitz:movitz-constantp x env) + (let ((x (movitz:movitz-eval x env))) + (typecase x + (number + `(= ,x ,y)) + (t `(eq ,x ,y))))) + (t form))) +
(define-compiler-macro values (&rest sub-forms) `(inline-values ,@sub-forms))