Changeset 12932

Timestamp:

10/01/10 08:24:41 (13 years ago)

Author:

ehuelsmann

Message:

Fix #88: "We need SYS:COMPILED-LISP-FUNCTION-P" to distinguish
Java-defined and Lisp-defined functions (for SLIME).

Location:

trunk/abcl/src/org/armedbear/lisp

Files:

• Primitives.java (modified) (1 diff)
• Symbol.java (modified) (1 diff)
• compiler-pass2.lisp (modified) (3 diffs)
• jvm-class-file.lisp (modified) (1 diff)

trunk/abcl/src/org/armedbear/lisp/Primitives.java

@@ -199 +199 @@
         }
     };
+
+    // ### compiled-lisp-function-p
+    private static final Primitive COMPILED_LISP_FUNCTION_P =
+        new pf_compiled_lisp_function_p();
+    private static final class pf_compiled_lisp_function_p extends Primitive {
+        pf_compiled_lisp_function_p() {
+            super(Symbol.COMPILED_LISP_FUNCTION_P, "object");
+        }
+
+        @Override
+        public LispObject execute(LispObject arg) {
+            return (arg instanceof CompiledClosure
+                    || arg instanceof CompiledPrimitive) ? T : NIL;
+        }
+    }
 
     // ### consp

trunk/abcl/src/org/armedbear/lisp/Symbol.java

@@ -2987 +2987 @@
   public static final Symbol _CLASS_SLOTS =
     PACKAGE_SYS.addExternalSymbol("%CLASS-SLOTS");
+  public static final Symbol COMPILED_LISP_FUNCTION_P =
+    PACKAGE_SYS.addExternalSymbol("COMPILED-LISP-FUNCTION-P");
   public static final Symbol LAYOUT =
     PACKAGE_SYS.addExternalSymbol("LAYOUT");

trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp

@@ -809 +809 @@
          (*current-code-attribute* code))
     (setf (code-max-locals code) 1)
-    (unless (eq super +lisp-primitive+)
+    (unless (eq super +lisp-compiled-primitive+)
       (multiple-value-bind
             (req opt key key-p rest
@@ -877 +877 @@
                                             +lisp-object+ +lisp-object+))))))
     (aload 0) ;; this
-    (cond ((eq super +lisp-primitive+)
+    (cond ((eq super +lisp-compiled-primitive+)
            (emit-constructor-lambda-name lambda-name)
            (emit-constructor-lambda-list args)
@@ -7051 +7051 @@
       (and *child-p* *closure-variables*))
         +lisp-compiled-closure+
-      +lisp-primitive+))
+      +lisp-compiled-primitive+))
 
     (setf (abcl-class-file-lambda-list class-file) args)

trunk/abcl/src/org/armedbear/lisp/jvm-class-file.lisp

@@ -168 +168 @@
 (define-class-name +lisp-go+ "org.armedbear.lisp.Go")
 (define-class-name +lisp-primitive+ "org.armedbear.lisp.Primitive")
+(define-class-name +lisp-compiled-primitive+
+    "org.armedbear.lisp.CompiledPrimitive")
 (define-class-name +lisp-eql-hash-table+ "org.armedbear.lisp.EqlHashTable")
 (define-class-name +lisp-hash-table+ "org.armedbear.lisp.HashTable")