Changeset 12310

Timestamp:

12/28/09 13:00:31 (14 years ago)

Author:

ehuelsmann

Message:

Implement note 1 from r12306: function preloading for macros.

Location:

trunk/abcl/src/org/armedbear/lisp

Files:

• AutoloadedFunctionProxy.java (modified) (8 diffs)
• Lisp.java (modified) (1 diff)
• compile-file.lisp (modified) (1 diff)

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

@@ -42 +42 @@
 public class AutoloadedFunctionProxy extends Function {
 
+    public enum FunctionType
+    {
+        NORMAL, SETF, MACRO
+    };
+
     final private Symbol symbol;
     final private String name;
@@ -47 +52 @@
     final private LispObject pack;
     final private LispObject anonymousPackage;
-    final private boolean isSetfFunction;
+    final private FunctionType fType;
     Function fun = null;
 
@@ -53 +58 @@
                                    LispObject cache, LispObject pack,
                                    LispObject anonymousPackage,
-                                   boolean setfFunction) {
+                                   FunctionType ft) {
         super();
         this.symbol = symbol;
@@ -59 +64 @@
         this.cache = cache;
         this.pack = pack;
-        //        Debug.trace("proxying ... " + name.getStringValue());
         Debug.assertTrue(! (cache instanceof Nil));
         this.anonymousPackage = anonymousPackage;
-        this.isSetfFunction = setfFunction;
+        this.fType = ft;
     }
 
@@ -87 +91 @@
         }
 
-        if (symbol != null) {
-            if (isSetfFunction)
-                put(symbol, Symbol.SETF_FUNCTION, fun);
+        if (symbol != null)
+            installFunction(fType, symbol, fun);
+
+        return fun;
+    }
+
+    final static private void installFunction(FunctionType fType,
+                                              Symbol sym, Function fun) {
+
+        if (fType == FunctionType.SETF)
+            put(sym, Symbol.SETF_FUNCTION, fun);
+        else if (fType == FunctionType.MACRO) {
+            if (sym.getSymbolFunction() instanceof SpecialOperator)
+                put(sym, Symbol.MACROEXPAND_MACRO,
+                    new MacroObject(sym, fun));
             else
-                symbol.setSymbolFunction(fun);
-        }
-
-        return fun;
+                sym.setSymbolFunction(new MacroObject(sym, fun));
+        } else
+            sym.setSymbolFunction(fun);
     }
 
@@ -215 +230 @@
         LispThread thread = LispThread.currentThread();
         Symbol sym;
-        LispObject fun;
-        boolean setfFun = false;
+        Function fun;
+        FunctionType fType = FunctionType.NORMAL;
 
         if (symbol instanceof Symbol)
@@ -222 +237 @@
         else if (isValidSetfFunctionName(symbol)) {
             sym = (Symbol)symbol.cadr();
-            setfFun = true;
+            fType = FunctionType.SETF;
+        } else if (isValidMacroFunctionName(symbol)) {
+            sym = (Symbol)symbol.cadr();
+            fType = FunctionType.MACRO;
         } else {
             checkSymbol(symbol); // generate an error
@@ -236 +254 @@
             fun = new AutoloadedFunctionProxy(sym, name, cache, pack,
                                               Load._FASL_ANONYMOUS_PACKAGE_.symbolValue(thread),
-                                              setfFun);
-            if (setfFun)
-                put(sym, Symbol.SETF_FUNCTION, fun);
-            else
-                sym.setSymbolFunction(fun);
+                                              fType);
+
+            installFunction(fType, sym, fun);
         }
 

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

@@ -1478 +1478 @@
     return false;
   }
+
+  public static final boolean isValidMacroFunctionName(LispObject obj)
+  {
+    if (obj instanceof Cons)
+      {
+        Cons cons = (Cons) obj;
+        if (cons.car == Symbol.MACRO_FUNCTION && cons.cdr instanceof Cons)
+          {
+            Cons cdr = (Cons) cons.cdr;
+            return (cdr.car instanceof Symbol && cdr.cdr == NIL);
+          }
+      }
+    return false;
+  }
+
 
   public static final LispObject FUNCTION_NAME =

trunk/abcl/src/org/armedbear/lisp/compile-file.lisp

@@ -225 +225 @@
                              `(put ',name 'macroexpand-macro
                                    (make-macro ',name
-                                               (load-compiled-function
+                                               (proxy-preloaded-function
+                                                '(macro-function ,name)
                                                 ,(file-namestring classfile))))
                              `(fset ',name
                                     (make-macro ',name
-                                                (load-compiled-function
+                                                (proxy-preloaded-function
+                                                 '(macro-function ,name)
                                                  ,(file-namestring classfile)))
                                     ,*source-position*