(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) (FILECREATED "18-Oct-93 14:19:04" "{Pele:mv:envos}Sources>CLTL2>CMLMACROS.;2" 12700 previous date%: "12-Jan-92 12:41:41" "{Pele:mv:envos}Sources>CLTL2>CMLMACROS.;1") (* ; " Copyright (c) 1986, 1987, 1990, 1991, 1992, 1993 by Venue & Xerox Corporation. All rights reserved. ") (PRETTYCOMPRINT CMLMACROSCOMS) (RPAQQ CMLMACROSCOMS [(FNS CLISPEXPANSION GLOBAL-MACRO-FUNCTION LOCAL-MACRO-FUNCTION LOCAL-SYMBOL-FUNCTION \INTERLISP-NLAMBDA-MACRO LISP:MACRO-FUNCTION LISP:MACROEXPAND LISP:MACROEXPAND-1 SETF-MACRO-FUNCTION) (APPENDVARS (COMPILERMACROPROPS DMACRO BYTEMACRO MACRO)) (ADDVARS (GLOBALVARS COMPILERMACROPROPS)) (PROP MACRO *) (FUNCTIONS LISP:MACROLET) (SETFS LISP:MACRO-FUNCTION) (PROP FILETYPE CMLMACROS) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA) (NLAML) (LAMA LISP:MACROEXPAND-1 LISP:MACROEXPAND LISP:MACRO-FUNCTION ]) (DEFINEQ (CLISPEXPANSION [LAMBDA (X ENV) (* ; "Edited 4-Dec-86 01:19 by lmm") (* ;; "the macro function for all CLISP words. Expand X as a clisp macro.") (LISP:VALUES (do (LET ((NOSPELLFLG T) (LISPXHIST NIL) (VARS NIL) (COP (COPY X))) (DECLARE (LISP:SPECIAL NOSPELLFLG VARS LISPXHIST)) (* ;  "make a copy so dwim doesn't muck with it!") [COND ((GETPROP (CAR X) 'CLISPWORD) (DWIMIFY0? COP COP COP NIL NIL NIL 'VARSBOUND) (COND ((NOT (LISP:EQUAL COP X)) (* ; "made a change") (RETURN COP)) ((SETQ COP (GETHASH COP CLISPARRAY)) (RETURN COP] (LISP:CERROR "Try expanding again." "Can't CLISP expand expression ~S." X))) T]) (GLOBAL-MACRO-FUNCTION [LAMBDA (X ENV) (* ; "Edited 22-Apr-87 19:07 by Pavel") (LET (MD) (COND [(AND (TYPEP ENV 'COMPILER:ENV) (LISP:MULTIPLE-VALUE-BIND (KIND EXPN-FN) (COMPILER:ENV-FBOUNDP ENV X) (AND (EQ KIND :MACRO) EXPN-FN] ((GET X 'MACRO-FN)) ((LISP:SPECIAL-FORM-P X) NIL) [[AND [NOT (FMEMB (ARGTYPE X) '(0 2] (FIND PROP IN COMPILERMACROPROPS SUCHTHAT (AND (SETQ MD (GETPROP X PROP)) (NOT (OR (LITATOM MD) (FMEMB (CAR MD) '(APPLY APPLY*] `(LAMBDA (FORM ENV) (MACROEXPANSION FORM ',MD] ((AND (NOT (GETD X)) (GETPROP X 'CLISPWORD)) (FUNCTION CLISPEXPANSION)) ((FMEMB (ARGTYPE X) '(1 3)) (FUNCTION \INTERLISP-NLAMBDA-MACRO]) (LOCAL-MACRO-FUNCTION [LAMBDA (X ENV) (* ; "Edited 13-Apr-87 11:16 by Pavel") (AND ENV (LISP:TYPECASE ENV (ENVIRONMENT (* ; "Interpreter's environments") (LET ((FN-DEFN (LISP:GETF (ENVIRONMENT-FUNCTIONS ENV) X))) (AND FN-DEFN (EQ (CAR FN-DEFN) :MACRO) (CDR FN-DEFN)))) (COMPILER:ENV (* ; "Compiler's environments.") (LISP:MULTIPLE-VALUE-BIND (KIND EXPN-FN) (COMPILER:ENV-FBOUNDP ENV X :LEXICAL-ONLY T) (AND (EQ KIND :MACRO) EXPN-FN))))]) (LOCAL-SYMBOL-FUNCTION [LAMBDA (X ENV) (* ; "Edited 31-Jul-87 18:06 by amd") (AND ENV (LISP:TYPECASE ENV (ENVIRONMENT (* ; "Interpreter's environments") (LET ((FN-DEFN (LISP:GETF (ENVIRONMENT-FUNCTIONS ENV) X))) (AND FN-DEFN (EQ (CAR FN-DEFN) :FUNCTION) (CDR FN-DEFN)))) (COMPILER:ENV (* ; "Compiler's environments.") (LISP:MULTIPLE-VALUE-BIND (KIND FN) (COMPILER:ENV-FBOUNDP ENV X :LEXICAL-ONLY T) (AND (EQ KIND :FUNCTION) FN))))]) (\INTERLISP-NLAMBDA-MACRO [LAMBDA (X ENV) (* lmm " 7-May-86 17:24") `(LISP:FUNCALL (FUNCTION ,(CAR X)) ,@(SELECTQ (ARGTYPE (CAR X)) (1 (MAPCAR (CDR X) (FUNCTION KWOTE))) (3 (LIST (KWOTE (CDR X)))) (SHOULDNT]) (LISP:MACRO-FUNCTION [LISP:LAMBDA (LISP::X LISP::ENV) (* ; "Edited 12-Jan-92 11:45 by bane") (AND (LISP:SYMBOLP LISP::X) (NOT (LOCAL-SYMBOL-FUNCTION LISP::X LISP::ENV)) (OR (LOCAL-MACRO-FUNCTION LISP::X LISP::ENV) (GLOBAL-MACRO-FUNCTION LISP::X LISP::ENV]) (LISP:MACROEXPAND [LISP:LAMBDA (LISP::FORM &OPTIONAL LISP::ENV) (* ; "Edited 13-Feb-87 23:47 by Pavel") (* ;;; "If FORM is a macro call, then the form is expanded until the result is not a macro. Returns as multiple values, the form after any expansion has been done and T if expansion was done, or NIL otherwise. Env is the lexical environment to expand in, which defaults to the null environment.") (PROG (LISP::FLAG) (LISP:MULTIPLE-VALUE-SETQ (LISP::FORM LISP::FLAG) (LISP:MACROEXPAND-1 LISP::FORM LISP::ENV)) (LISP:UNLESS LISP::FLAG (RETURN (LISP:VALUES LISP::FORM NIL))) LISP:LOOP (LISP:MULTIPLE-VALUE-SETQ (LISP::FORM LISP::FLAG) (LISP:MACROEXPAND-1 LISP::FORM LISP::ENV)) (LISP:IF LISP::FLAG (GO LISP:LOOP) (RETURN (LISP:VALUES LISP::FORM T)))]) (LISP:MACROEXPAND-1 [LISP:LAMBDA (LISP::FORM &OPTIONAL LISP::ENV) (* ; "Edited 13-Feb-87 23:49 by Pavel") (* ;;; "If form is a macro, expands it once. Returns two values, the expanded form and a T-or-NIL flag indicating whether the form was, in fact, a macro. Env is the lexical environment to expand in, which defaults to the null environment.") (COND [(AND (LISP:CONSP LISP::FORM) (LISP:SYMBOLP (CAR LISP::FORM))) (LET ((LISP::DEF (LISP:MACRO-FUNCTION (CAR LISP::FORM) LISP::ENV))) (COND (LISP::DEF (LISP:IF [NOT (EQ LISP::FORM (LISP:SETQ LISP::FORM (LISP:FUNCALL *MACROEXPAND-HOOK* LISP::DEF LISP::FORM LISP::ENV] (LISP:VALUES LISP::FORM T) (LISP:VALUES LISP::FORM NIL))) (T (LISP:VALUES LISP::FORM NIL] (T (LISP:VALUES LISP::FORM NIL]) (SETF-MACRO-FUNCTION [LAMBDA (X BODY) (* ; "Edited 13-Feb-87 13:26 by Pavel") (* ;; "the SETF function for MACRO-FUNCTION ") (* ;; "NOTE: If you change this, be sure to change the undoable version on CMLUNDO!") (PROG1 (LISP:SETF (GET X 'MACRO-FN) BODY) (AND (GETD X) (SELECTQ (ARGTYPE X) ((1 3) (* ;  "Leave Interlisp nlambda definition alone") ) (PUTD X NIL))))]) ) (APPENDTOVAR COMPILERMACROPROPS DMACRO BYTEMACRO MACRO) (ADDTOVAR GLOBALVARS COMPILERMACROPROPS) (PUTPROPS * MACRO ((X . Y) 'X)) (DEFMACRO LISP:MACROLET (LISP::MACRODEFS &BODY LISP::BODY &ENVIRONMENT LISP::ENV) (DECLARE (SPECVARS *BYTECOMPILER-IS-EXPANDING*)) (* ;; "This macro for the old interpreter and compiler only. The new interpreter has a special-form definition. When the new compiler is expanding, we simply return a disguised version of the form.") [IF (AND *BYTECOMPILER-IS-EXPANDING* *BYTECOMPILER-OPTIMIZE-MACROLET*) THEN (LET ((LISP::NEW-ENV (COMPILER::MAKE-CHILD-ENV LISP::ENV))) (DECLARE (LISP:SPECIAL *BC-MACRO-ENVIRONMENT*)) [FOR LISP::FN IN LISP::MACRODEFS DO (COMPILER::ENV-BIND-FUNCTION LISP::NEW-ENV (CAR LISP::FN) :MACRO (COMPILER::CRACK-DEFMACRO (CONS 'DEFMACRO LISP::FN] (LISP:SETQ *BC-MACRO-ENVIRONMENT* LISP::NEW-ENV) (CONS 'LISP:LOCALLY LISP::BODY)) ELSEIF (TYPEP LISP::ENV 'COMPILER:ENV) THEN `(SI::%%MACROLET ,LISP::MACRODEFS ,@LISP::BODY) ELSE (LET (LISP::NEW-ENV LISP::FUNCTIONS) (* ;;  "We parse and handle the declarations here, so they'll take effect in the new child environment") (LISP:MULTIPLE-VALUE-BIND (LISP::BODY LISP::SPECIALS) (\REMOVE-DECLS LISP::BODY (LISP:SETQ LISP::NEW-ENV (\MAKE-CHILD-ENVIRONMENT LISP::ENV))) (LISP:SETQ LISP::FUNCTIONS (ENVIRONMENT-FUNCTIONS LISP::NEW-ENV)) (FOR LISP::FN IN LISP::MACRODEFS DO (LISP:SETQ LISP::FUNCTIONS (LIST* (CAR LISP::FN) [CONS :MACRO `(LISP:LAMBDA (SI::$$MACRO-FORM SI::$$MACRO-ENVIRONMENT) (LISP:BLOCK ,(CAR LISP::FN) ,(PARSE-DEFMACRO (CADR LISP::FN) 'SI::$$MACRO-FORM (CDDR LISP::FN) (CAR LISP::FN) NIL :ENVIRONMENT 'SI::$$MACRO-ENVIRONMENT))] LISP::FUNCTIONS))) (LISP:SETF (ENVIRONMENT-FUNCTIONS LISP::NEW-ENV) LISP::FUNCTIONS) (WALK-FORM (CONS 'LISP:LOCALLY LISP::BODY) :ENVIRONMENT LISP::NEW-ENV]) (LISP:DEFSETF LISP:MACRO-FUNCTION SETF-MACRO-FUNCTION) (PUTPROPS CMLMACROS FILETYPE LISP:COMPILE-FILE) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDTOVAR NLAMA ) (ADDTOVAR NLAML ) (ADDTOVAR LAMA LISP:MACROEXPAND-1 LISP:MACROEXPAND LISP:MACRO-FUNCTION) ) (PUTPROPS CMLMACROS COPYRIGHT ("Venue & Xerox Corporation" 1986 1987 1990 1991 1992 1993)) (DECLARE%: DONTCOPY (FILEMAP (NIL (1472 9378 (CLISPEXPANSION 1482 . 2890) (GLOBAL-MACRO-FUNCTION 2892 . 4085) ( LOCAL-MACRO-FUNCTION 4087 . 4949) (LOCAL-SYMBOL-FUNCTION 4951 . 5808) (\INTERLISP-NLAMBDA-MACRO 5810 . 6169) (LISP:MACRO-FUNCTION 6171 . 6530) (LISP:MACROEXPAND 6532 . 7504) (LISP:MACROEXPAND-1 7506 . 8736) (SETF-MACRO-FUNCTION 8738 . 9376))))) STOP