Commit f0f44f9f authored by ehuelsmann@1c010e3e-69d0-11dd-93a8-456734b0d56f's avatar ehuelsmann@1c010e3e-69d0-11dd-93a8-456734b0d56f
Browse files

Remove code duplication. Rename MAKE-EXPANDER-FOR-MACROLET because it

is no longer used solely for MACROLET.
parent 1937110a
...@@ -1879,25 +1879,8 @@ public final class Primitives { ...@@ -1879,25 +1879,8 @@ public final class Primitives {
public LispObject execute(LispObject args, Environment env) public LispObject execute(LispObject args, Environment env)
{ {
/* Create an expansion function
* `(lambda (,formArg ,envArg)
* (apply (function (macro-function ,lambdaList
* (block ,symbol ,@body)))
* (cdr ,formArg)))
*/
Symbol symbol = checkSymbol(args.car()); Symbol symbol = checkSymbol(args.car());
LispObject lambdaList = checkList(args.cadr()); LispObject expander = MAKE_MACRO_EXPANDER.execute(args);
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)));
Closure expansionFunction = new Closure(expander, env); Closure expansionFunction = new Closure(expander, env);
MacroObject macroObject = MacroObject macroObject =
new MacroObject(symbol, expansionFunction); new MacroObject(symbol, expansionFunction);
...@@ -3634,7 +3617,7 @@ public final class Primitives { ...@@ -3634,7 +3617,7 @@ public final class Primitives {
LispObject def = checkList(defs.car()); LispObject def = checkList(defs.car());
Symbol symbol = checkSymbol(def.car()); Symbol symbol = checkSymbol(def.car());
Symbol make_expander_for_macrolet = Symbol make_expander_for_macrolet =
PACKAGE_SYS.intern("MAKE-EXPANDER-FOR-MACROLET"); PACKAGE_SYS.intern("MAKE-MACRO-EXPANDER");
LispObject expander = LispObject expander =
make_expander_for_macrolet.execute(def); make_expander_for_macrolet.execute(def);
Closure expansionFunction = new Closure(expander, env); Closure expansionFunction = new Closure(expander, env);
...@@ -3651,11 +3634,10 @@ public final class Primitives { ...@@ -3651,11 +3634,10 @@ public final class Primitives {
} }
}; };
private static final Primitive MAKE_EXPANDER_FOR_MACROLET = new pf_make_expander_for_macrolet(); private static final Primitive MAKE_MACRO_EXPANDER = new pf_make_macro_expander();
private static final class pf_make_expander_for_macrolet extends Primitive { private static final class pf_make_macro_expander extends Primitive {
pf_make_expander_for_macrolet() { pf_make_macro_expander() {
super("make-expander-for-macrolet", PACKAGE_SYS, true, super("make-macro-expander", PACKAGE_SYS, true, "definition");
"definition");
} }
@Override @Override
......
...@@ -150,7 +150,7 @@ ...@@ -150,7 +150,7 @@
;; FUNCTIONS ;; FUNCTIONS
(IN-PACKAGE :SYSTEM) (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 ;; MACROS
......
...@@ -247,7 +247,7 @@ interpreted toplevel form, non-NIL if it is 'simple enough'." ...@@ -247,7 +247,7 @@ interpreted toplevel form, non-NIL if it is 'simple enough'."
(environment-add-macro-definition *compile-file-environment* (environment-add-macro-definition *compile-file-environment*
(car definition) (car definition)
(make-macro (car definition) (make-macro (car definition)
(make-expander-for-macrolet definition)))) (make-macro-expander definition))))
(dolist (body-form (cddr form)) (dolist (body-form (cddr form))
(process-toplevel-form body-form stream compile-time-too))) (process-toplevel-form body-form stream compile-time-too)))
nil) nil)
......
...@@ -368,8 +368,8 @@ ...@@ -368,8 +368,8 @@
,@local-decls ,@local-decls
,body)))) ,body))))
;; Redefine SYS:MAKE-EXPANDER-FOR-MACROLET to use PARSE-DEFMACRO. ;; Redefine SYS:MAKE-MACRO-EXPANDER to use PARSE-DEFMACRO.
(defun make-expander-for-macrolet (definition) (defun make-macro-expander (definition)
(let* ((name (car definition)) (let* ((name (car definition))
(lambda-list (cadr definition)) (lambda-list (cadr definition))
(form (gensym "WHOLE-")) (form (gensym "WHOLE-"))
......
...@@ -647,7 +647,7 @@ ...@@ -647,7 +647,7 @@
(car definition) (car definition)
(make-macro (car definition) (make-macro (car definition)
(make-closure (make-closure
(make-expander-for-macrolet definition) (make-macro-expander definition)
NIL)))) NIL))))
(multiple-value-bind (body decls) (multiple-value-bind (body decls)
(parse-body (cddr form) nil) (parse-body (cddr form) nil)
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment