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

ehuelsmann at common-lisp.net ehuelsmann at common-lisp.net
Wed Aug 22 21:37:01 UTC 2012


Author: ehuelsmann
Date: Wed Aug 22 14:36:59 2012
New Revision: 14133

Log:
Remove code duplication. Rename MAKE-EXPANDER-FOR-MACROLET because it
is no longer used solely for MACROLET.

Modified:
   trunk/abcl/src/org/armedbear/lisp/Primitives.java
   trunk/abcl/src/org/armedbear/lisp/autoloads-gen.lisp
   trunk/abcl/src/org/armedbear/lisp/compile-file.lisp
   trunk/abcl/src/org/armedbear/lisp/destructuring-bind.lisp
   trunk/abcl/src/org/armedbear/lisp/precompiler.lisp

Modified: trunk/abcl/src/org/armedbear/lisp/Primitives.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Primitives.java	Wed Aug 22 13:44:30 2012	(r14132)
+++ trunk/abcl/src/org/armedbear/lisp/Primitives.java	Wed Aug 22 14:36:59 2012	(r14133)
@@ -1879,25 +1879,8 @@
         public LispObject execute(LispObject args, Environment env)
 
         {
-            /* Create an expansion function
-             * `(lambda (,formArg ,envArg)
-             *     (apply (function (macro-function ,lambdaList
-             *                         (block ,symbol , at body)))
-             *            (cdr ,formArg)))
-             */
             Symbol symbol = checkSymbol(args.car());
-            LispObject lambdaList = checkList(args.cadr());
-            LispObject body = args.cddr();
-            LispObject block = new Cons(Symbol.BLOCK, new Cons(symbol, body));
-            LispObject toBeApplied =
-                list(Symbol.FUNCTION, list(Symbol.MACRO_FUNCTION, lambdaList, block));
-            final LispThread thread = LispThread.currentThread();
-            LispObject formArg = gensym("FORM-", thread);
-            LispObject envArg = gensym("ENV-", thread); // Ignored.
-            LispObject expander =
-                list(Symbol.LAMBDA, list(formArg, envArg),
-                     list(Symbol.APPLY, toBeApplied,
-                          list(Symbol.CDR, formArg)));
+            LispObject expander = MAKE_MACRO_EXPANDER.execute(args);
             Closure expansionFunction = new Closure(expander, env);
             MacroObject macroObject =
                 new MacroObject(symbol, expansionFunction);
@@ -3634,7 +3617,7 @@
                     LispObject def = checkList(defs.car());
                     Symbol symbol = checkSymbol(def.car());
                     Symbol make_expander_for_macrolet =
-                        PACKAGE_SYS.intern("MAKE-EXPANDER-FOR-MACROLET");
+                        PACKAGE_SYS.intern("MAKE-MACRO-EXPANDER");
                     LispObject expander =
                         make_expander_for_macrolet.execute(def);
                     Closure expansionFunction = new Closure(expander, env);
@@ -3651,11 +3634,10 @@
         }
     };
 
-    private static final Primitive MAKE_EXPANDER_FOR_MACROLET = new pf_make_expander_for_macrolet();
-    private static final class pf_make_expander_for_macrolet extends Primitive {
-        pf_make_expander_for_macrolet() {
-            super("make-expander-for-macrolet", PACKAGE_SYS, true,
-                  "definition");
+    private static final Primitive MAKE_MACRO_EXPANDER = new pf_make_macro_expander();
+    private static final class pf_make_macro_expander extends Primitive {
+        pf_make_macro_expander() {
+            super("make-macro-expander", PACKAGE_SYS, true, "definition");
         }
 
         @Override

Modified: trunk/abcl/src/org/armedbear/lisp/autoloads-gen.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/autoloads-gen.lisp	Wed Aug 22 13:44:30 2012	(r14132)
+++ trunk/abcl/src/org/armedbear/lisp/autoloads-gen.lisp	Wed Aug 22 14:36:59 2012	(r14133)
@@ -150,7 +150,7 @@
 ;; FUNCTIONS
 
 (IN-PACKAGE :SYSTEM)
-(DOLIST (FS (QUOTE ((("abcl-contrib") FIND-SYSTEM-JAR FIND-CONTRIB) (("assert") ASSERT-ERROR ASSERT-PROMPT) (("aver") %FAILED-AVER) (("backquote") BACKQUOTE-MACRO COMMA-MACRO EXPANDABLE-BACKQ-EXPRESSION-P BACKQUOTIFY COMMA BACKQUOTIFY-1 BACKQ-LIST BACKQ-LIST* BACKQ-APPEND BACKQ-NCONC BACKQ-CONS BACKQ-VECTOR %READER-ERROR) (("bit-array-ops") BIT-ARRAY-SAME-DIMENSIONS-P REQUIRE-SAME-DIMENSIONS PICK-RESULT-ARRAY) (("case") LIST-OF-LENGTH-AT-LEAST-P CASE-BODY-ERROR CASE-BODY-AUX CASE-BODY) (("check-type") CHECK-TYPE-ERROR) (("clos") COERCE-TO-CONDITION) (("coerce") COERCE-LIST-TO-VECTOR COPY-STRING COERCE-ERROR COERCE-OBJECT-TO-AND-TYPE) (("compile-file-pathname") CFP-OUTPUT-FILE-DEFAULT) (("compile-file") BASE-CLASSNAME FASL-LOADER-CLASSNAME COMPUTE-CLASSFILE-NAME SANITIZE-CLASS-NAME NEXT-CLASSFILE-NAME DUMMY VERIFY-LOAD NOTE-TOPLEVEL-FORM OUTPUT-FORM FINALIZE-FASL-OUTPUT SIMPLE-TOPLEVEL-FORM-P CONVERT-TOPLEVEL-FORM PROCESS-PROGN PRECOMPILE-TOPLEVEL-FORM PROCESS-TOPLEVEL-MACROLET PROCESS-TOPLEVEL-DEFCONSTANT PROCESS-TOPLEVEL-QUOTE PROCESS-TOPLEVEL-IMPORT PROCESS-TOPLEVEL-EXPORT PROCESS-TOPLEVEL-MOP.ENSURE-METHOD PROCESS-TOPLEVEL-DEFVAR/DEFPARAMETER PROCESS-TOPLEVEL-DEFPACKAGE/IN-PACKAGE PROCESS-TOPLEVEL-DECLARE PROCESS-TOPLEVEL-PROGN PROCESS-TOPLEVEL-DEFTYPE PROCESS-TOPLEVEL-EVAL-WHEN PROCESS-TOPLEVEL-DEFMETHOD/DEFGENERIC PROCESS-TOPLEVEL-LOCALLY PROCESS-TOPLEVEL-DEFMACRO PROCESS-TOPLEVEL-DEFUN INSTALL-TOPLEVEL-HANDLER PROCESS-TOPLEVEL-FORM POPULATE-ZIP-FASL WRITE-FASL-PROLOGUE COMPILE-FROM-STREAM COMPILE-FILE-IF-NEEDED) (("compile-system") CHECK-LISP-HOME GROVEL-JAVA-DEFINITIONS-IN-FILE GROVEL-JAVA-DEFINITIONS PACKAGES-FROM-COMBOS REMOVE-MULTI-COMBO-SYMBOLS SET-EQUAL COMBOS-TO-SYMBOL-FILESETS COMBOS-TO-FILESET-SYMBOLS WRITE-AUTOLOADER WRITE-PACKAGE-FILESETS LOAD-COMBOS GENERATE-AUTOLOADS %COMPILE-SYSTEM CREATE-SYSTEM-LOGICAL-TRANSLATIONS) (("compiler-error") COMPILER-STYLE-WARN COMPILER-WARN COMPILER-ERROR INTERNAL-COMPILER-ERROR COMPILER-UNSUPPORTED) (("compiler-macro") COMPILER-MACROEXPAND-1 COMPILER-MACROEXPAND) (("compiler-pass2") AUTOCOMPILE) (("compiler-types") MAKE-CONSTANT-TYPE CONSTANT-TYPE-P %MAKE-INTEGER-TYPE INTEGER-TYPE-P MAKE-INTEGER-TYPE FIXNUM-TYPE-P FIXNUM-CONSTANT-VALUE INTEGER-CONSTANT-VALUE JAVA-LONG-TYPE-P MAKE-UNION-TYPE MAKE-COMPILER-TYPE INTEGER-TYPE-SUBTYPEP COMPILER-SUBTYPEP FUNCTION-RESULT-TYPE SET-FUNCTION-RESULT-TYPE %DEFKNOWN) (("concatenate") CONCATENATE-TO-STRING) (("debug") INTERNAL-DEBUG DEBUG-LOOP INVOKE-DEBUGGER-REPORT-CONDITION RUN-HOOK BACKTRACE-AS-LIST) (("define-symbol-macro") %DEFINE-SYMBOL-MACRO) (("defpackage") DESIGNATED-PACKAGE-NAME STRINGIFY-NAMES CHECK-DISJOINT) (("defsetf") %DEFSETF) (("defstruct") MAKE-DEFSTRUCT-DESCRIPTION MAKE-DEFSTRUCT-SLOT-DESCRIPTION KEYWORDIFY DEFINE-KEYWORD-CONSTRUCTOR FIND-DSD GET-SLOT DEFINE-BOA-CONSTRUCTOR DEFAULT-CONSTRUCTOR-NAME DEFINE-CONSTRUCTORS NAME-INDEX DEFINE-PREDICATE MAKE-LIST-READER MAKE-VECTOR-READER MAKE-STRUCTURE-READER DEFINE-READER MAKE-LIST-WRITER MAKE-VECTOR-WRITER MAKE-STRUCTURE-WRITER DEFINE-WRITER DEFINE-ACCESS-FUNCTIONS DEFINE-COPIER DEFINE-PRINT-FUNCTION PARSE-1-OPTION PARSE-NAME-AND-OPTIONS COMPILER-DEFSTRUCT DEFSTRUCT-DEFAULT-CONSTRUCTOR) (("deftype") EXPAND-DEFTYPE) (("delete-duplicates") LIST-DELETE-DUPLICATES* VECTOR-DELETE-DUPLICATES*) (("describe-compiler-policy") DESCRIBE-COMPILER-POLICY) (("describe") DESCRIBE-ARGLIST %DESCRIBE-OBJECT) (("destructuring-bind") PARSE-BODY ARG-COUNT-ERROR PARSE-DEFMACRO DEFMACRO-ERROR VERIFY-KEYWORDS LOOKUP-KEYWORD KEYWORD-SUPPLIED-P PARSE-DEFMACRO-LAMBDA-LIST PUSH-SUB-LIST-BINDING PUSH-LET-BINDING PUSH-OPTIONAL-BINDING MAKE-EXPANDER-FOR-MACROLET) (("directory") PATHNAME-AS-FILE WILD-INFERIORS-P LIST-DIRECTORIES-WITH-WILDCARDS) (("do") DO-DO-BODY) (("dump-form") GET-INSTANCE-FORM DF-REGISTER-CIRCULARITY DF-CHECK-CONS DF-CHECK-VECTOR DF-CHECK-INSTANCE DF-CHECK-OBJECT DF-HANDLE-CIRCULARITY DUMP-CONS DUMP-VECTOR DUMP-INSTANCE DUMP-UNINTERNED-SYMBOL-INDEX DUMP-OBJECT DUMP-FORM) (("ed") DEFAULT-ED-FUNCTION) (("enough-namestring") EQUAL-COMPONENTS-P) (("fill") LIST-FILL VECTOR-FILL) (("find") LIST-POSITION* VECTOR-POSITION* LIST-FIND* VECTOR-FIND*) (("format") SYMBOLICATE PROPER-LIST-OF-LENGTH-P FLONUM-TO-STRING ROUND-UP SCALE-EXPONENT FLOAT-DENORMALIZED-P) (("inline") INLINE-EXPANSION SET-INLINE-EXPANSION) (("inspect") LEADER SAFE-LENGTH DISPLAY-OBJECT DISPLAY-CURRENT ISTEP) (("late-setf") MAKE-GENSYM-LIST) (("lcm") TWO-ARG-LCM) (("ldb") %LDB) (("load") LOAD-RETURNING-LAST-RESULT) (("make-sequence") SIZE-MISMATCH-ERROR) (("map1") MAP1) (("nsubstitute") NLIST-SUBSTITUTE* NVECTOR-SUBSTITUTE* NLIST-SUBSTITUTE-IF* NVECTOR-SUBSTITUTE-IF* NLIST-SUBSTITUTE-IF-NOT* NVECTOR-SUBSTITUTE-IF-NOT*) (("open") UPGRADED-ELEMENT-TYPE-BITS UPGRADED-ELEMENT-TYPE) (("parse-integer") PARSE-INTEGER-ERROR) (("parse-lambda-list") PARSE-LAMBDA-LIST-LIKE-THING PARSE-LAMBDA-LIST) (("pathnames") COMPONENT-MATCH-WILD-P COMPONENT-MATCH-P DIRECTORY-MATCH-COMPONENTS DIRECTORY-MATCH-P WILD-P CASIFY TRANSLATE-COMPONENT TRANSLATE-JAR-DEVICE TRANSLATE-DIRECTORY-COMPONENTS-AUX TRANSLATE-DIRECTORY-COMPONENTS TRANSLATE-DIRECTORY LOGICAL-HOST-P CANONICALIZE-LOGICAL-PATHNAME-TRANSLATIONS %SET-LOGICAL-PATHNAME-TRANSLATIONS) (("print-unreadable-object") %PRINT-UNREADABLE-OBJECT) (("print") COMPOUND-OBJECT-P OUTPUT-INTEGER OUTPUT-LIST OUTPUT-TERSE-ARRAY ARRAY-READABLY-PRINTABLE-P OUTPUT-VECTOR OUTPUT-UGLY-OBJECT CHECK-FOR-CIRCULARITY HANDLE-CIRCULARITY PRINT-LABEL PRINT-REFERENCE UNIQUELY-IDENTIFIED-BY-PRINT-P %PRINT-OBJECT %CHECK-OBJECT OUTPUT-OBJECT) (("proclaim") DECLARATION-ERROR CHECK-DECLARATION-TYPE PROCLAIM-TYPE PROCLAIMED-TYPE PROCLAIM-FTYPE-1 PROCLAIM-FTYPE PROCLAIMED-FTYPE FTYPE-RESULT-TYPE) (("query") QUERY-READLINE) (("read-circle") CIRCLE-SUBST SHARP-EQUAL SHARP-SHARP) (("read-conditional") READ-FEATURE READ-CONDITIONAL) (("remove-duplicates") LIST-REMOVE-DUPLICATES VECTOR-REMOVE-DUPLICATES) (("replace") LIST-REPLACE-FROM-LIST* LIST-REPLACE-FROM-VECTOR* VECTOR-REPLACE-FROM-LIST* VECTOR-REPLACE-FROM-VECTOR*) (("run-program") RUN-PROGRAM %MAKE-PROCESS PROCESS-P MAKE-PROCESS PROCESS-ALIVE-P PROCESS-WAIT PROCESS-EXIT-CODE PROCESS-KILL %MAKE-PROCESS-BUILDER %PROCESS-BUILDER-ENVIRONMENT %PROCESS-BUILDER-ENV-PUT %PROCESS-BUILDER-ENV-CLEAR %PROCESS-BUILDER-START %MAKE-PROCESS-INPUT-STREAM %MAKE-PROCESS-OUTPUT-STREAM %MAKE-PROCESS-ERROR-STREAM %PROCESS-ALIVE-P %PROCESS-WAIT %PROCESS-EXIT-CODE %PROCESS-KILL) (("search") SIMPLE-SEARCH) (("sequences") MAKE-SEQUENCE-OF-TYPE) (("setf") GET-SETF-METHOD-INVERSE EXPAND-OR-GET-SETF-INVERSE %SET-SUBSEQ %DEFINE-SETF-MACRO %SET-CAAR %SET-CADR %SET-CDAR %SET-CDDR %SET-CAAAR %SET-CADAR %SET-CDAAR %SET-CDDAR %SET-CAADR %SET-CADDR %SET-CDADR %SET-CDDDR %SET-CAAAAR %SET-CADAAR %SET-CDAAAR %SET-CDDAAR %SET-CAADAR %SET-CADDAR %SET-CDADAR %SET-CDDDAR %SET-CAAADR %SET-CADADR %SET-CDAADR %SET-CDDADR %SET-CAADDR %SET-CADDDR %SET-CDADDR %SET-CDDDDR %SET-FIFTH %SET-SIXTH %SET-SEVENTH %SET-EIGHTH %SET-NINTH %SET-TENTH) (("sort") MERGE-SORT-VECTORS LAST-CONS-OF MERGE-LISTS MERGE-LISTS-NO-KEY SORT-LIST QUICKSORT QUICK-SORT) (("source-transform") SOURCE-TRANSFORM SET-SOURCE-TRANSFORM EXPAND-SOURCE-TRANSFORM-1 EXPAND-SOURCE-TRANSFORM) (("subst") %SUBST %SUBST-IF %SUBST-IF-NOT) (("subtypep") INITIALIZE-KNOWN-TYPES KNOWN-TYPE-P SUB-INTERVAL-P DIMENSION-SUBTYPEP SIMPLE-SUBTYPEP MAKE-CTYPE CTYPE-SUPER CTYPE-TYPE CTYPE CSUBTYPEP-ARRAY CSUBTYPEP-FUNCTION CSUBTYPEP-COMPLEX CSUBTYPEP %SUBTYPEP) (("time") PICK-OBVIOUS-YEAR LEAP-YEARS-BEFORE) (("trace") MAKE-TRACE-INFO TRACE-INFO-P LIST-TRACED-FUNCTIONS EXPAND-TRACE TRACE-1 TRACED-FUNCTION UNTRACED-FUNCTION TRACE-REDEFINED-UPDATE INDENT UNTRACE-ALL UNTRACE-1) (("tree-equal") TREE-EQUAL-TEST-NOT TREE-EQUAL-TEST) (("typep") SIMPLE-ARRAY-P IN-INTERVAL-P MATCH-DIMENSIONS %TYPEP) (("with-hash-table-iterator") HASH-TABLE-ITERATOR-FUNCTION) (("with-package-iterator") PACKAGE-ITERATOR-FUNCTION) (("with-standard-io-syntax") %WITH-STANDARD-IO-SYNTAX)))) (FUNCALL (FUNCTION AUTOLOAD) (CDR FS) (CAR (CAR FS))))
+(DOLIST (FS (QUOTE ((("abcl-contrib") FIND-SYSTEM-JAR FIND-CONTRIB) (("assert") ASSERT-ERROR ASSERT-PROMPT) (("aver") %FAILED-AVER) (("backquote") BACKQUOTE-MACRO COMMA-MACRO EXPANDABLE-BACKQ-EXPRESSION-P BACKQUOTIFY COMMA BACKQUOTIFY-1 BACKQ-LIST BACKQ-LIST* BACKQ-APPEND BACKQ-NCONC BACKQ-CONS BACKQ-VECTOR %READER-ERROR) (("bit-array-ops") BIT-ARRAY-SAME-DIMENSIONS-P REQUIRE-SAME-DIMENSIONS PICK-RESULT-ARRAY) (("case") LIST-OF-LENGTH-AT-LEAST-P CASE-BODY-ERROR CASE-BODY-AUX CASE-BODY) (("check-type") CHECK-TYPE-ERROR) (("clos") COERCE-TO-CONDITION) (("coerce") COERCE-LIST-TO-VECTOR COPY-STRING COERCE-ERROR COERCE-OBJECT-TO-AND-TYPE) (("compile-file-pathname") CFP-OUTPUT-FILE-DEFAULT) (("compile-file") BASE-CLASSNAME FASL-LOADER-CLASSNAME COMPUTE-CLASSFILE-NAME SANITIZE-CLASS-NAME NEXT-CLASSFILE-NAME DUMMY VERIFY-LOAD NOTE-TOPLEVEL-FORM OUTPUT-FORM FINALIZE-FASL-OUTPUT SIMPLE-TOPLEVEL-FORM-P CONVERT-TOPLEVEL-FORM PROCESS-PROGN PRECOMPILE-TOPLEVEL-FORM PROCESS-TOPLEVEL-MACROLET PROCESS-TOPLEVEL-DEFCONSTANT PROCESS-TOPLEVEL-QUOTE PROCESS-TOPLEVEL-IMPORT PROCESS-TOPLEVEL-EXPORT PROCESS-TOPLEVEL-MOP.ENSURE-METHOD PROCESS-TOPLEVEL-DEFVAR/DEFPARAMETER PROCESS-TOPLEVEL-DEFPACKAGE/IN-PACKAGE PROCESS-TOPLEVEL-DECLARE PROCESS-TOPLEVEL-PROGN PROCESS-TOPLEVEL-DEFTYPE PROCESS-TOPLEVEL-EVAL-WHEN PROCESS-TOPLEVEL-DEFMETHOD/DEFGENERIC PROCESS-TOPLEVEL-LOCALLY PROCESS-TOPLEVEL-DEFMACRO PROCESS-TOPLEVEL-DEFUN INSTALL-TOPLEVEL-HANDLER PROCESS-TOPLEVEL-FORM POPULATE-ZIP-FASL WRITE-FASL-PROLOGUE COMPILE-FROM-STREAM COMPILE-FILE-IF-NEEDED) (("compile-system") CHECK-LISP-HOME GROVEL-JAVA-DEFINITIONS-IN-FILE GROVEL-JAVA-DEFINITIONS PACKAGES-FROM-COMBOS REMOVE-MULTI-COMBO-SYMBOLS SET-EQUAL COMBOS-TO-SYMBOL-FILESETS COMBOS-TO-FILESET-SYMBOLS WRITE-AUTOLOADER WRITE-PACKAGE-FILESETS LOAD-COMBOS GENERATE-AUTOLOADS %COMPILE-SYSTEM CREATE-SYSTEM-LOGICAL-TRANSLATIONS) (("compiler-error") COMPILER-STYLE-WARN COMPILER-WARN COMPILER-ERROR INTERNAL-COMPILER-ERROR COMPILER-UNSUPPORTED) (("compiler-macro") COMPILER-MACROEXPAND-1 COMPILER-MACROEXPAND) (("compiler-pass2") AUTOCOMPILE) (("compiler-types") MAKE-CONSTANT-TYPE CONSTANT-TYPE-P %MAKE-INTEGER-TYPE INTEGER-TYPE-P MAKE-INTEGER-TYPE FIXNUM-TYPE-P FIXNUM-CONSTANT-VALUE INTEGER-CONSTANT-VALUE JAVA-LONG-TYPE-P MAKE-UNION-TYPE MAKE-COMPILER-TYPE INTEGER-TYPE-SUBTYPEP COMPILER-SUBTYPEP FUNCTION-RESULT-TYPE SET-FUNCTION-RESULT-TYPE %DEFKNOWN) (("concatenate") CONCATENATE-TO-STRING) (("debug") INTERNAL-DEBUG DEBUG-LOOP INVOKE-DEBUGGER-REPORT-CONDITION RUN-HOOK BACKTRACE-AS-LIST) (("define-symbol-macro") %DEFINE-SYMBOL-MACRO) (("defpackage") DESIGNATED-PACKAGE-NAME STRINGIFY-NAMES CHECK-DISJOINT) (("defsetf") %DEFSETF) (("defstruct") MAKE-DEFSTRUCT-DESCRIPTION MAKE-DEFSTRUCT-SLOT-DESCRIPTION KEYWORDIFY DEFINE-KEYWORD-CONSTRUCTOR FIND-DSD GET-SLOT DEFINE-BOA-CONSTRUCTOR DEFAULT-CONSTRUCTOR-NAME DEFINE-CONSTRUCTORS NAME-INDEX DEFINE-PREDICATE MAKE-LIST-READER MAKE-VECTOR-READER MAKE-STRUCTURE-READER DEFINE-READER MAKE-LIST-WRITER MAKE-VECTOR-WRITER MAKE-STRUCTURE-WRITER DEFINE-WRITER DEFINE-ACCESS-FUNCTIONS DEFINE-COPIER DEFINE-PRINT-FUNCTION PARSE-1-OPTION PARSE-NAME-AND-OPTIONS COMPILER-DEFSTRUCT DEFSTRUCT-DEFAULT-CONSTRUCTOR) (("deftype") EXPAND-DEFTYPE) (("delete-duplicates") LIST-DELETE-DUPLICATES* VECTOR-DELETE-DUPLICATES*) (("describe-compiler-policy") DESCRIBE-COMPILER-POLICY) (("describe") DESCRIBE-ARGLIST %DESCRIBE-OBJECT) (("destructuring-bind") PARSE-BODY ARG-COUNT-ERROR PARSE-DEFMACRO DEFMACRO-ERROR VERIFY-KEYWORDS LOOKUP-KEYWORD KEYWORD-SUPPLIED-P PARSE-DEFMACRO-LAMBDA-LIST PUSH-SUB-LIST-BINDING PUSH-LET-BINDING PUSH-OPTIONAL-BINDING MAKE-MACRO-EXPANDER) (("directory") PATHNAME-AS-FILE WILD-INFERIORS-P LIST-DIRECTORIES-WITH-WILDCARDS) (("do") DO-DO-BODY) (("dump-form") GET-INSTANCE-FORM DF-REGISTER-CIRCULARITY DF-CHECK-CONS DF-CHECK-VECTOR DF-CHECK-INSTANCE DF-CHECK-OBJECT DF-HANDLE-CIRCULARITY DUMP-CONS DUMP-VECTOR DUMP-INSTANCE DUMP-UNINTERNED-SYMBOL-INDEX DUMP-OBJECT DUMP-FORM) (("ed") DEFAULT-ED-FUNCTION) (("enough-namestring") EQUAL-COMPONENTS-P) (("fill") LIST-FILL VECTOR-FILL) (("find") LIST-POSITION* VECTOR-POSITION* LIST-FIND* VECTOR-FIND*) (("format") SYMBOLICATE PROPER-LIST-OF-LENGTH-P FLONUM-TO-STRING ROUND-UP SCALE-EXPONENT FLOAT-DENORMALIZED-P) (("inline") INLINE-EXPANSION SET-INLINE-EXPANSION) (("inspect") LEADER SAFE-LENGTH DISPLAY-OBJECT DISPLAY-CURRENT ISTEP) (("late-setf") MAKE-GENSYM-LIST) (("lcm") TWO-ARG-LCM) (("ldb") %LDB) (("load") LOAD-RETURNING-LAST-RESULT) (("make-sequence") SIZE-MISMATCH-ERROR) (("map1") MAP1) (("nsubstitute") NLIST-SUBSTITUTE* NVECTOR-SUBSTITUTE* NLIST-SUBSTITUTE-IF* NVECTOR-SUBSTITUTE-IF* NLIST-SUBSTITUTE-IF-NOT* NVECTOR-SUBSTITUTE-IF-NOT*) (("open") UPGRADED-ELEMENT-TYPE-BITS UPGRADED-ELEMENT-TYPE) (("parse-integer") PARSE-INTEGER-ERROR) (("parse-lambda-list") PARSE-LAMBDA-LIST-LIKE-THING PARSE-LAMBDA-LIST) (("pathnames") COMPONENT-MATCH-WILD-P COMPONENT-MATCH-P DIRECTORY-MATCH-COMPONENTS DIRECTORY-MATCH-P WILD-P CASIFY TRANSLATE-COMPONENT TRANSLATE-JAR-DEVICE TRANSLATE-DIRECTORY-COMPONENTS-AUX TRANSLATE-DIRECTORY-COMPONENTS TRANSLATE-DIRECTORY LOGICAL-HOST-P CANONICALIZE-LOGICAL-PATHNAME-TRANSLATIONS %SET-LOGICAL-PATHNAME-TRANSLATIONS) (("print-unreadable-object") %PRINT-UNREADABLE-OBJECT) (("print") COMPOUND-OBJECT-P OUTPUT-INTEGER OUTPUT-LIST OUTPUT-TERSE-ARRAY ARRAY-READABLY-PRINTABLE-P OUTPUT-VECTOR OUTPUT-UGLY-OBJECT CHECK-FOR-CIRCULARITY HANDLE-CIRCULARITY PRINT-LABEL PRINT-REFERENCE UNIQUELY-IDENTIFIED-BY-PRINT-P %PRINT-OBJECT %CHECK-OBJECT OUTPUT-OBJECT) (("proclaim") DECLARATION-ERROR CHECK-DECLARATION-TYPE PROCLAIM-TYPE PROCLAIMED-TYPE PROCLAIM-FTYPE-1 PROCLAIM-FTYPE PROCLAIMED-FTYPE FTYPE-RESULT-TYPE) (("query") QUERY-READLINE) (("read-circle") CIRCLE-SUBST SHARP-EQUAL SHARP-SHARP) (("read-conditional") READ-FEATURE READ-CONDITIONAL) (("remove-duplicates") LIST-REMOVE-DUPLICATES VECTOR-REMOVE-DUPLICATES) (("replace") LIST-REPLACE-FROM-LIST* LIST-REPLACE-FROM-VECTOR* VECTOR-REPLACE-FROM-LIST* VECTOR-REPLACE-FROM-VECTOR*) (("run-program") RUN-PROGRAM %MAKE-PROCESS PROCESS-P MAKE-PROCESS PROCESS-ALIVE-P PROCESS-WAIT PROCESS-EXIT-CODE PROCESS-KILL %MAKE-PROCESS-BUILDER %PROCESS-BUILDER-ENVIRONMENT %PROCESS-BUILDER-ENV-PUT %PROCESS-BUILDER-ENV-CLEAR %PROCESS-BUILDER-START %MAKE-PROCESS-INPUT-STREAM %MAKE-PROCESS-OUTPUT-STREAM %MAKE-PROCESS-ERROR-STREAM %PROCESS-ALIVE-P %PROCESS-WAIT %PROCESS-EXIT-CODE %PROCESS-KILL) (("search") SIMPLE-SEARCH) (("sequences") MAKE-SEQUENCE-OF-TYPE) (("setf") GET-SETF-METHOD-INVERSE EXPAND-OR-GET-SETF-INVERSE %SET-SUBSEQ %DEFINE-SETF-MACRO %SET-CAAR %SET-CADR %SET-CDAR %SET-CDDR %SET-CAAAR %SET-CADAR %SET-CDAAR %SET-CDDAR %SET-CAADR %SET-CADDR %SET-CDADR %SET-CDDDR %SET-CAAAAR %SET-CADAAR %SET-CDAAAR %SET-CDDAAR %SET-CAADAR %SET-CADDAR %SET-CDADAR %SET-CDDDAR %SET-CAAADR %SET-CADADR %SET-CDAADR %SET-CDDADR %SET-CAADDR %SET-CADDDR %SET-CDADDR %SET-CDDDDR %SET-FIFTH %SET-SIXTH %SET-SEVENTH %SET-EIGHTH %SET-NINTH %SET-TENTH) (("sort") MERGE-SORT-VECTORS LAST-CONS-OF MERGE-LISTS MERGE-LISTS-NO-KEY SORT-LIST QUICKSORT QUICK-SORT) (("source-transform") SOURCE-TRANSFORM SET-SOURCE-TRANSFORM EXPAND-SOURCE-TRANSFORM-1 EXPAND-SOURCE-TRANSFORM) (("subst") %SUBST %SUBST-IF %SUBST-IF-NOT) (("subtypep") INITIALIZE-KNOWN-TYPES KNOWN-TYPE-P SUB-INTERVAL-P DIMENSION-SUBTYPEP SIMPLE-SUBTYPEP MAKE-CTYPE CTYPE-SUPER CTYPE-TYPE CTYPE CSUBTYPEP-ARRAY CSUBTYPEP-FUNCTION CSUBTYPEP-COMPLEX CSUBTYPEP %SUBTYPEP) (("time") PICK-OBVIOUS-YEAR LEAP-YEARS-BEFORE) (("trace") MAKE-TRACE-INFO TRACE-INFO-P LIST-TRACED-FUNCTIONS EXPAND-TRACE TRACE-1 TRACED-FUNCTION UNTRACED-FUNCTION TRACE-REDEFINED-UPDATE INDENT UNTRACE-ALL UNTRACE-1) (("tree-equal") TREE-EQUAL-TEST-NOT TREE-EQUAL-TEST) (("typep") SIMPLE-ARRAY-P IN-INTERVAL-P MATCH-DIMENSIONS %TYPEP) (("with-hash-table-iterator") HASH-TABLE-ITERATOR-FUNCTION) (("with-package-iterator") PACKAGE-ITERATOR-FUNCTION) (("with-standard-io-syntax") %WITH-STANDARD-IO-SYNTAX)))) (FUNCALL (FUNCTION AUTOLOAD) (CDR FS) (CAR (CAR FS))))
 
 ;; MACROS
 

Modified: trunk/abcl/src/org/armedbear/lisp/compile-file.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/compile-file.lisp	Wed Aug 22 13:44:30 2012	(r14132)
+++ trunk/abcl/src/org/armedbear/lisp/compile-file.lisp	Wed Aug 22 14:36:59 2012	(r14133)
@@ -247,7 +247,7 @@
       (environment-add-macro-definition *compile-file-environment*
                                         (car definition)
                                         (make-macro (car definition)
-                                                    (make-expander-for-macrolet definition))))
+                                                    (make-macro-expander definition))))
     (dolist (body-form (cddr form))
       (process-toplevel-form body-form stream compile-time-too)))
   nil)

Modified: trunk/abcl/src/org/armedbear/lisp/destructuring-bind.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/destructuring-bind.lisp	Wed Aug 22 13:44:30 2012	(r14132)
+++ trunk/abcl/src/org/armedbear/lisp/destructuring-bind.lisp	Wed Aug 22 14:36:59 2012	(r14133)
@@ -368,8 +368,8 @@
 	 , at local-decls
 	 ,body))))
 
-;; Redefine SYS:MAKE-EXPANDER-FOR-MACROLET to use PARSE-DEFMACRO.
-(defun make-expander-for-macrolet (definition)
+;; Redefine SYS:MAKE-MACRO-EXPANDER to use PARSE-DEFMACRO.
+(defun make-macro-expander (definition)
   (let* ((name (car definition))
          (lambda-list (cadr definition))
          (form (gensym "WHOLE-"))

Modified: trunk/abcl/src/org/armedbear/lisp/precompiler.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/precompiler.lisp	Wed Aug 22 13:44:30 2012	(r14132)
+++ trunk/abcl/src/org/armedbear/lisp/precompiler.lisp	Wed Aug 22 14:36:59 2012	(r14133)
@@ -647,7 +647,7 @@
        (car definition)
        (make-macro (car definition)
                    (make-closure
-                    (make-expander-for-macrolet definition)
+                    (make-macro-expander definition)
                     NIL))))
     (multiple-value-bind (body decls)
         (parse-body (cddr form) nil)




More information about the armedbear-cvs mailing list