[armedbear-cvs] r12119 - trunk/abcl/src/org/armedbear/lisp

[Mark Evenson]

Author: mevenson
Date: Thu Aug 27 05:33:21 2009
New Revision: 12119

Log:
Fix ticket#61 for THE evaluated with DEFTYPEd forms.

Shouldn't the call to the Lisp-side TYPEP be added at the "top-level"
typep() defined on LispObject?



Modified:
   trunk/abcl/src/org/armedbear/lisp/SpecialOperators.java
   trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp

Modified: trunk/abcl/src/org/armedbear/lisp/SpecialOperators.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/SpecialOperators.java	(original)
+++ trunk/abcl/src/org/armedbear/lisp/SpecialOperators.java	Thu Aug 27 05:33:21 2009
@@ -376,9 +376,17 @@
         LispObject type = args.car();
         if (type instanceof Symbol
             || type instanceof BuiltInClass)
-            if (rv.typep(type) == NIL)
-                type_error(rv, type);
-
+	  if (rv.typep(type) == NIL) {
+	    // Try to call the Lisp-side TYPEP, as we will miss
+	    // DEFTYPEd types.
+	    Symbol typep
+	      = PACKAGE_SYS.findAccessibleSymbol("TYPEP");
+	    LispObject result
+	      = typep.getSymbolFunction().execute(rv, type);
+	    if (result == NIL) {
+	      type_error(rv, type);
+	    }
+	  }
         return rv;
       }
     };

Modified: trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp	(original)
+++ trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp	Thu Aug 27 05:33:21 2009
@@ -7915,9 +7915,11 @@
                  (cond
                    ((eq name 'LET)
                     (p2-let/let*-node form target representation))
-                   ((eq name 'SETF) ;; SETF functions create
+;;                   ((eq name 'LABELS)
+;;                    (p2-labels-node form target representation))
+;;                   ((eq name 'SETF) ;; SETF functions create
                     ;; consp block names, if we're unlucky
-                    (p2-block-node form target representation))
+;;                    (p2-block-node form target representation))
                    (t
                     (print name)
                     (aver (not "Can't happen.")))