[armedbear-cvs] r11441 - trunk/j/src/org/armedbear/lisp

[Erik Huelsmann]

Author: ehuelsmann
Date: Sun Dec 14 12:07:52 2008
New Revision: 11441

Log:
Fix compiled MACROLET.13 and MACROLET.14: MACROEXPAND should know about symbol macros while expanding.

Modified:
   trunk/j/src/org/armedbear/lisp/Environment.java
   trunk/j/src/org/armedbear/lisp/Primitives.java
   trunk/j/src/org/armedbear/lisp/SymbolMacro.java
   trunk/j/src/org/armedbear/lisp/precompiler.lisp

Modified: trunk/j/src/org/armedbear/lisp/Environment.java
==============================================================================
--- trunk/j/src/org/armedbear/lisp/Environment.java	(original)
+++ trunk/j/src/org/armedbear/lisp/Environment.java	Sun Dec 14 12:07:52 2008
@@ -308,6 +308,21 @@
       }
     };
 
+  // ### environment-add-symbol-binding
+  public static final Primitive ENVIRONMENT_ADD_SYMBOL_BINDING =
+    new Primitive("environment-add-symbol-binding", PACKAGE_SYS, true,
+                  "environment symbol value")
+    {
+      @Override
+      public LispObject execute(LispObject first, LispObject second,
+                                LispObject third)
+        throws ConditionThrowable
+      {
+        checkEnvironment(first).bind(checkSymbol(second), third);
+        return first;
+      }
+    };
+    
   // ### empty-environment-p
   private static final Primitive EMPTY_ENVIRONMENT_P =
     new Primitive("empty-environment-p", PACKAGE_SYS, true, "environment")

Modified: trunk/j/src/org/armedbear/lisp/Primitives.java
==============================================================================
--- trunk/j/src/org/armedbear/lisp/Primitives.java	(original)
+++ trunk/j/src/org/armedbear/lisp/Primitives.java	Sun Dec 14 12:07:52 2008
@@ -1728,6 +1728,17 @@
       }
     };
 
+  // ### make-symbol-macro
+  private static final Primitive MAKE_SYMBOL_MACRO =
+      new Primitive("make-symbol-macro", PACKAGE_SYS, true, "expansion")
+  {
+      public LispObject execute(LispObject arg) throws ConditionThrowable
+      {
+          return new SymbolMacro(arg);
+      }
+  };
+
+
   // ### %defparameter
   private static final Primitive _DEFPARAMETER =
     new Primitive("%defparameter", PACKAGE_SYS, false)

Modified: trunk/j/src/org/armedbear/lisp/SymbolMacro.java
==============================================================================
--- trunk/j/src/org/armedbear/lisp/SymbolMacro.java	(original)
+++ trunk/j/src/org/armedbear/lisp/SymbolMacro.java	Sun Dec 14 12:07:52 2008
@@ -47,13 +47,4 @@
         return expansion;
     }
 
-    // ### make-symbol-macro
-    private static final Primitive MAKE_MACRO =
-        new Primitive("make-symbol-macro", PACKAGE_SYS, false)
-    {
-        public LispObject execute(LispObject arg) throws ConditionThrowable
-        {
-            return new SymbolMacro(arg);
-        }
-    };
 }

Modified: trunk/j/src/org/armedbear/lisp/precompiler.lisp
==============================================================================
--- trunk/j/src/org/armedbear/lisp/precompiler.lisp	(original)
+++ trunk/j/src/org/armedbear/lisp/precompiler.lisp	Sun Dec 14 12:07:52 2008
@@ -719,6 +719,8 @@
 
 (defun precompile-symbol-macrolet (form)
   (let ((*local-variables* *local-variables*)
+        (*compile-file-environment*
+         (make-environment *compile-file-environment*))
         (defs (cadr form)))
     (dolist (def defs)
       (let ((sym (car def))
@@ -727,7 +729,11 @@
           (error 'program-error
                  :format-control "Attempt to bind the special variable ~S with SYMBOL-MACROLET."
                  :format-arguments (list sym)))
-        (push (list sym :symbol-macro expansion) *local-variables*)))
+        (push (list sym :symbol-macro expansion) *local-variables*)
+        (environment-add-symbol-binding *compile-file-environment*
+                                        sym
+                                        (sys::make-symbol-macro expansion))
+        ))
     (multiple-value-bind (body decls)
         (parse-body (cddr form) nil)
       (when decls