(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) (FILECREATED " 4-Nov-93 10:57:37" ("compiled on " {DSK}export>lispcore>sources>CLTL2>CMLWALK.;1) "19-Feb-93 17:03:08" bcompl'd in "Medley 19-Feb-93 ..." dated "19-Feb-93 18:20:42") (FILECREATED "18-Oct-93 15:25:46" "{Pele:mv:envos}Sources>CLTL2>CMLWALK.;2" 27482 previous date%: " 3-Sep-91 17:53:09" "{Pele:mv:envos}Sources>CLTL2>CMLWALK.;1") WALK-FORM-INTERNAL :D8 (L (1 CONTEXT 0 FORM) F 3 *WALK-FUNCTION* F 4 *ENVIRONMENT*) y0@AlS YIJ@dJJb@@dd3@@oA  X@dT bd3@@AlH@HA @oA (118 WALK-TEMPLATE 105 WALK-TEMPLATE 77 CL:MACROEXPAND-1 66 GET-WALKER-TEMPLATE 59 WALK-TEMPLATE 13 \MVLIST) NIL ( 112 (:CALL :REPEAT (:EVAL)) 53 (:CALL :REPEAT (:EVAL))) WALK-TEMPLATE :D8 (L (2 CONTEXT 1 TEMPLATE 0 FORM)) pAdHgHdg@dh gHHgHdg@gSHgJHgAHg8Hg/Hg&HgHgHgHdg@g gHdg@g g @B gHo Hdg*@Ad @kIAAbbgHg!@A@ A @ B @ddAB @AB (365 WALK-RECONS 360 WALK-TEMPLATE 350 WALK-TEMPLATE 334 WALK-TEMPLATE-HANDLE-REPEAT 328 CL:NTHCDR 321 CL:LENGTH 313 CL:LENGTH 263 CL:EVAL 233 ECASE-FAIL 216 WALK-LAMBDA 200 WALK-FORM-INTERNAL 171 WALK-FORM-INTERNAL 40 XCL::WALK-LAMBDA) (301 :REPEAT 293 REPEAT 245 CL:IF 222 TEMPLATE 206 CL:LAMBDA 195 :SET 186 :SET 177 SET 166 :EVAL 157 RETURN 148 :RETURN 139 EFFECT 130 :EFFECT 121 TEST 112 :TEST 103 FUNCTION 94 :FUNCTION 85 EVAL 76 :EVAL 67 :ERROR 58 PPE 46 QUOTE 24 :CALL 15 CALL) ( 228 (CALL :CALL QUOTE NIL PPE :ERROR :EVAL EVAL :FUNCTION FUNCTION :TEST TEST :EFFECT EFFECT :RETURN RETURN SET :SET CL:LAMBDA)) WALK-TEMPLATE-HANDLE-REPEAT :D8 (L (3 CONTEXT 2 STOP-FORM 1 TEMPLATE 0 FORM)) @dBAC AdBC (24 WALK-TEMPLATE-HANDLE-REPEAT-1 12 WALK-TEMPLATE) NIL () WALK-TEMPLATE-HANDLE-REPEAT-1 :D8 (L (4 CONTEXT 3 STOP-FORM 2 REPEAT-TEMPLATE 1 TEMPLATE 0 FORM)) G@dCBCAD o BAb@dBD @ABCD  (68 WALK-RECONS 63 WALK-TEMPLATE-HANDLE-REPEAT-1 50 WALK-TEMPLATE 29 CL:ERROR 18 WALK-TEMPLATE) NIL ( 24 "While handling repeat: ~%%~Ran into stop while still in repeat template.") WALK-LIST :D8 (P 0 A4285 I 1 FN I 0 LIST) @dA@kH@A (26 WALK-RECONS 21 WALK-LIST) NIL () WALK-RECONS :D8 (L (2 CDR 1 CAR 0 X) F 0 *WALK-COPY*) P@A@dBABNIL NIL () WALK-DECLARATIONS :D8 (L (3 DECLARATIONS 2 DOC-STRING-P 1 FN 0 BODY) F 3 *ENVIRONMENT*) @!Hd @BC@H@Ai Hd3dg)Y@H@ABC Z JCbIH HdS XH@b@kA(115 CL:MACROEXPAND-1 105 GET-WALKER-TEMPLATE 85 NOTE-DECLARATION 77 WALK-RECONS 72 WALK-DECLARATIONS 40 WALK-RECONS 35 WALK-DECLARATIONS 11 STRINGP) (53 DECLARE) () WALK-ARGLIST :D8 (L (2 DESTRUCTURINGP 1 CONTEXT 0 ARGLIST)) @dXdd3@uHgOHgFHg=Hg4Hg+Hg"HgHgHdg @H@AB Hoh ^BHAB )@HdHg H @Ah Hdd3@H HHd3@H o@ (238 CL:ERROR 225 NOTE-LEXICAL-BINDING 205 NOTE-LEXICAL-BINDING 186 WALK-RECONS 181 WALK-ARGLIST 172 WALK-RELIST* 164 WALK-FORM-INTERNAL 145 WALK-ARGLIST 131 WALK-RECONS 126 WALK-ARGLIST 103 NOTE-LEXICAL-BINDING) (159 :EVAL 96 &CONTEXT 87 &ENVIRONMENT 78 &ALLOW-OTHER-KEYS 69 &WHOLE 60 &BODY 51 &AUX 42 &KEY 33 &REST 24 &OPTIONAL) ( 232 "Can't understand something in the arglist ~S" 118 (&OPTIONAL &REST &KEY &AUX &BODY &WHOLE &ALLOW-OTHER-KEYS &ENVIRONMENT &CONTEXT)) WALK-LAMBDAA0001 :D8 (L (0 REAL-BODY) F 0 CONTEXT F 1 ARGLIST F 2 WALKED-ARGLIST) QP c@oP (20 WALK-TEMPLATE 6 WALK-ARGLIST) NIL ( 14 (:REPEAT (:EVAL))) WALK-LAMBDA :D8 (L (0 FORM) P 2 WALKED-ARGLIST P 0 ARGLIST I 1 CONTEXT) &@!@g @dJI  (35 WITH-NEW-CONTOUR 29 WALK-RELIST* 18 WALK-DECLARATIONS) (13 WALK-LAMBDAA0001) () WALK-COMPILER-LETA0001 :D8 (F 0 FORM F 1 CONTEXT) PoQ (11 WALK-TEMPLATE) NIL ( 5 (NIL NIL :REPEAT (:EVAL) :RETURN)) WALK-COMPILER-LET :D8 (I 1 CONTEXT I 0 FORM) Y@1HK@AH'Kg HdKJI&IhZHX\ L KJI&IhZHX(69 CL:EVAL 31 \DO.PROGV) (26 WALK-COMPILER-LETA0001) () WALK-UNEXPECTED-DECLARE :D8 (L (1 CONTEXT 0 FORM)) o@ @(10 CL:WARN) NIL ( 4 "Encountered declare ~S in a place where a declare was not expected.") WALK-LET :D8 (L (1 CONTEXT 0 FORM)) @Ah (7 WALK-LET/LET*) NIL () WALK-LET* :D8 (L (1 CONTEXT 0 FORM)) @Ai (7 WALK-LET/LET*) NIL () WALK-LET/LET*A0001A0002 :D8 (L (0 BINDING) F 0 CONTEXT) .@dd3@@d d@P @ @ (42 NOTE-LEXICAL-BINDING 35 WALK-RELIST* 27 WALK-FORM-INTERNAL 14 NOTE-LEXICAL-BINDING) NIL () WALK-LET/LET*A0001 :D8 (L (0 REAL-BODY) F 0 BINDINGS F 1 WALKED-BINDINGS F 2 CONTEXT) Pg c@oR (24 WALK-TEMPLATE 10 WALK-LIST) (5 WALK-LET/LET*A0001A0002) ( 18 (:REPEAT (:EVAL))) WALK-LET/LET* :D8 (L (0 FORM) P 5 BINDINGS P 4 WALKED-BINDINGS P 1 OLD-LEXICAL-VARIABLES P 0 OLD-DECLARATIONS I 2 SEQUENTIALP I 1 CONTEXT F 6 *DECLARATIONS* F 7 *LEXICAL-VARIABLES*) .VW@!@@g @KLJ  (43 WITH-NEW-CONTOUR 37 WALK-RELIST* 27 WALK-DECLARATIONS) (22 WALK-LET/LET*A0001) () WALK-TAGBODYA0001 :D8 (L (0 X) F 0 CONTEXT) @dd3@gP (18 WALK-FORM-INTERNAL) (11 QUOTE) () WALK-TAGBODY :D8 (L (0 FORM) I 1 CONTEXT) @d@g (19 WALK-RECONS 14 WALK-LIST) (9 WALK-TAGBODYA0001) () (PRETTYCOMPRINT CMLWALKCOMS) (RPAQQ CMLWALKCOMS ((FUNCTIONS XCL:ONCE-ONLY) (* ; "not a wonderful place for it, but CMLMACROS comes too eraly in the loadup.") (VARIABLES *WALK-FUNCTION* *WALK-FORM* *DECLARATIONS* *LEXICAL-VARIABLES* *ENVIRONMENT* *WALK-COPY*) (FUNCTIONS WITH-NEW-CONTOUR NOTE-LEXICAL-BINDING NOTE-DECLARATION) (FUNCTIONS VARIABLE-SPECIAL-P VARIABLE-LEXICAL-P GET-WALKER-TEMPLATE) (FUNCTIONS WALK-FORM) (FNS WALK-FORM-INTERNAL WALK-TEMPLATE WALK-TEMPLATE-HANDLE-REPEAT WALK-TEMPLATE-HANDLE-REPEAT-1 WALK-LIST WALK-RECONS) (FUNCTIONS WALK-RELIST*) (FNS WALK-DECLARATIONS WALK-ARGLIST WALK-LAMBDA) (COMS (PROP WALKER-TEMPLATE CL:COMPILER-LET) (FNS WALK-COMPILER-LET) (PROP WALKER-TEMPLATE DECLARE) (FNS WALK-UNEXPECTED-DECLARE) (PROP WALKER-TEMPLATE LET PROG LET* PROG*) (FNS WALK-LET WALK-LET* WALK-LET/LET*) (PROP WALKER-TEMPLATE CL:TAGBODY) (FNS WALK-TAGBODY) (PROP WALKER-TEMPLATE FUNCTION CL:FUNCTION GO CL:IF CL:MULTIPLE-VALUE-CALL CL:MULTIPLE-VALUE-PROG1 PROGN CL:PROGV QUOTE CL:RETURN-FROM RETURN CL:SETQ CL:BLOCK CL:CATCH CL:EVAL-WHEN THE CL:THROW CL:UNWIND-PROTECT LOAD-TIME-EVAL COND CL:UNWIND-PROTECT SETQ AND OR)) (COMS (* ;; "for Interlisp") (PROP WALKER-TEMPLATE RPAQ? RPAQ XNLSETQ ERSETQ NLSETQ RESETVARS)) (PROP FILETYPE CMLWALK) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS ( ADDVARS (NLAMA) (NLAML) (LAMA WALK-TAGBODY WALK-LET/LET* WALK-LET* WALK-LET WALK-UNEXPECTED-DECLARE WALK-COMPILER-LET WALK-LAMBDA WALK-ARGLIST WALK-DECLARATIONS WALK-RECONS WALK-TEMPLATE-HANDLE-REPEAT-1 WALK-TEMPLATE-HANDLE-REPEAT WALK-TEMPLATE WALK-FORM-INTERNAL))))) (DEFMACRO XCL:ONCE-ONLY (XCL::VARS &BODY XCL::BODY) (* ;;; "ONCE-ONLY assures that the forms given as vars are evaluated in the proper order, once only. Used in the body of macro definitions. Taken from Zeta Lisp." ) (LET* ((XCL::GENSYM-VAR (CL:GENSYM)) (XCL::RUN-TIME-VARS (CL:GENSYM)) (XCL::RUN-TIME-VALS (CL:GENSYM )) (XCL::EXPAND-TIME-VAL-FORMS (FOR XCL::VAR IN XCL::VARS COLLECT (BQUOTE (CL:IF (OR (CL:SYMBOLP (\, XCL::VAR)) (CL:CONSTANTP (\, XCL::VAR))) (\, XCL::VAR) (LET (((\, XCL::GENSYM-VAR) (CL:GENSYM))) ( CL:PUSH (\, XCL::GENSYM-VAR) (\, XCL::RUN-TIME-VARS)) (CL:PUSH (\, XCL::VAR) (\, XCL::RUN-TIME-VALS)) (\, XCL::GENSYM-VAR))))))) (BQUOTE (LET* ((\, XCL::RUN-TIME-VARS) (\, XCL::RUN-TIME-VALS) ( XCL::WRAPPED-BODY (LET (\, (FOR XCL::VAR IN XCL::VARS AS XCL::EXPAND-TIME-VAL-FORM IN XCL::EXPAND-TIME-VAL-FORMS COLLECT (LIST XCL::VAR XCL::EXPAND-TIME-VAL-FORM))) (\,@ XCL::BODY)))) ( BQUOTE (LET (\, (FOR XCL::RUN-TIME-VAR IN (CL:REVERSE XCL::RUN-TIME-VARS) AS XCL::RUN-TIME-VAL IN ( CL:REVERSE XCL::RUN-TIME-VALS) COLLECT (LIST XCL::RUN-TIME-VAR XCL::RUN-TIME-VAL))) (\, XCL::WRAPPED-BODY ))))))) (CL:DEFVAR *WALK-FUNCTION* NIL "the function being called on each sub-form in the code-walker") (CL:DEFVAR *WALK-FORM* "When the first argument to the IF template in the code-walker is a list, it will be evaluated with *walk-form* bound to the form currently being walked." ) (CL:DEFVAR *DECLARATIONS* "a list of the declarations currently in effect while codewalking") (CL:DEFVAR *LEXICAL-VARIABLES* NIL (* ; "used in walker to hold list of lexical variables available")) (CL:DEFVAR *ENVIRONMENT* "while codewalking, this is the lexical environment as far as macros are concerned") (CL:DEFVAR *WALK-COPY* "while walking, this is true if we are making a copy of the expresion being walked") (DEFMACRO WITH-NEW-CONTOUR (&BODY BODY) (* ;; "WITH-NEW-CONTOUR is used to enter a new lexical binding contour which inherits from the exisiting one. Using WITH-NEW-CONTOUR is often overkill: It would suffice for the the walker to rebind *LEXICAL-VARIABLES* and *DECLARATIONS* when walking LET and rebind *ENVIRONMENT* and *DECLARATIONS* when walking MACROLET etc. WITH-NEW-CONTOUR is much more convenient and just as correct. *" ) (BQUOTE (LET ((*DECLARATIONS* NIL) (*LEXICAL-VARIABLES* *LEXICAL-VARIABLES*) (*ENVIRONMENT* *ENVIRONMENT*)) (\,@ BODY)))) (DEFMACRO NOTE-LEXICAL-BINDING (THING) (BQUOTE (CL:PUSH (\, THING) *LEXICAL-VARIABLES*))) (DEFMACRO NOTE-DECLARATION (CL:DECLARATION) (BQUOTE (CL:PUSH (\, CL:DECLARATION) *DECLARATIONS*))) (CL:DEFUN VARIABLE-SPECIAL-P (VAR) (* lmm "27-May-86 15:42") (OR (for DECL in *DECLARATIONS* do (AND ( EQ (CAR DECL) (QUOTE CL:SPECIAL)) (FMEMB VAR (CDR DECL)) (RETURN T))) (VARIABLE-GLOBALLY-SPECIAL-P VAR ))) (CL:DEFUN VARIABLE-LEXICAL-P (VAR) (* lmm "11-Apr-86 10:59") (AND (NOT (VARIABLE-SPECIAL-P VAR)) ( CL:MEMBER VAR *LEXICAL-VARIABLES* :TEST (FUNCTION EQ)))) (CL:DEFUN GET-WALKER-TEMPLATE (X) (* lmm "24-May-86 14:48") (CL:IF (NOT (CL:SYMBOLP X)) (QUOTE ( CL:LAMBDA :REPEAT (:EVAL))) (GET X (QUOTE WALKER-TEMPLATE)))) (CL:DEFUN WALK-FORM (FORM &KEY ((:DECLARATIONS *DECLARATIONS*) NIL) ((:LEXICAL-VARIABLES *LEXICAL-VARIABLES*) NIL) ((:ENVIRONMENT *ENVIRONMENT*) NIL) ((:WALK-FUNCTION *WALK-FUNCTION*) ( FUNCTION (CL:LAMBDA (X IGNORE) IGNORE X))) ((:COPY *WALK-COPY*) T)) "Walk FORM, expanding all macros, calling :WALK-FUNCTION on each subfof :COPY is true (default), will return the expansion" (WALK-FORM-INTERNAL FORM (QUOTE :EVAL))) (DEFMACRO WALK-RELIST* (X FIRST &REST CL:REST) (CL:IF CL:REST (BQUOTE (WALK-RECONS (\, X) (\, FIRST) ( WALK-RELIST* (CDR (\, X)) (\,@ CL:REST)))) FIRST)) (PUTPROPS CL:COMPILER-LET WALKER-TEMPLATE WALK-COMPILER-LET) (PUTPROPS DECLARE WALKER-TEMPLATE WALK-UNEXPECTED-DECLARE) (PUTPROPS LET WALKER-TEMPLATE WALK-LET) (PUTPROPS PROG WALKER-TEMPLATE WALK-LET) (PUTPROPS LET* WALKER-TEMPLATE WALK-LET*) (PUTPROPS PROG* WALKER-TEMPLATE WALK-LET*) (PUTPROPS CL:TAGBODY WALKER-TEMPLATE WALK-TAGBODY) (PUTPROPS FUNCTION WALKER-TEMPLATE (NIL :CALL)) (PUTPROPS CL:FUNCTION WALKER-TEMPLATE (NIL :CALL)) (PUTPROPS GO WALKER-TEMPLATE (NIL NIL)) (PUTPROPS CL:IF WALKER-TEMPLATE (NIL :TEST :RETURN :RETURN)) (PUTPROPS CL:MULTIPLE-VALUE-CALL WALKER-TEMPLATE (NIL :EVAL :REPEAT (:EVAL))) (PUTPROPS CL:MULTIPLE-VALUE-PROG1 WALKER-TEMPLATE (NIL :RETURN :REPEAT (:EVAL))) (PUTPROPS PROGN WALKER-TEMPLATE (NIL :REPEAT (:EVAL))) (PUTPROPS CL:PROGV WALKER-TEMPLATE (NIL :EVAL :EVAL :REPEAT (:EVAL))) (PUTPROPS QUOTE WALKER-TEMPLATE (NIL QUOTE)) (PUTPROPS CL:RETURN-FROM WALKER-TEMPLATE (NIL NIL :EVAL)) (PUTPROPS RETURN WALKER-TEMPLATE (NIL :EVAL)) (PUTPROPS CL:SETQ WALKER-TEMPLATE (NIL :REPEAT (:SET :EVAL))) (PUTPROPS CL:BLOCK WALKER-TEMPLATE (NIL NIL :REPEAT (:EVAL))) (PUTPROPS CL:CATCH WALKER-TEMPLATE (NIL :EVAL :REPEAT (:EVAL))) (PUTPROPS CL:EVAL-WHEN WALKER-TEMPLATE (NIL NIL :REPEAT (:EVAL))) (PUTPROPS THE WALKER-TEMPLATE (NIL NIL :EVAL)) (PUTPROPS CL:THROW WALKER-TEMPLATE (NIL :EVAL :EVAL)) (PUTPROPS CL:UNWIND-PROTECT WALKER-TEMPLATE (NIL :EVAL :REPEAT (:EVAL))) (PUTPROPS LOAD-TIME-EVAL WALKER-TEMPLATE (NIL :EVAL)) (PUTPROPS COND WALKER-TEMPLATE (NIL :REPEAT ((:REPEAT (:EVAL))))) (PUTPROPS CL:UNWIND-PROTECT WALKER-TEMPLATE (NIL :EVAL :REPEAT (:EVAL))) (PUTPROPS SETQ WALKER-TEMPLATE (NIL :SET :EVAL)) (PUTPROPS AND WALKER-TEMPLATE (NIL :REPEAT (:EVAL))) (PUTPROPS OR WALKER-TEMPLATE (NIL :REPEAT (:EVAL))) (PUTPROPS RPAQ? WALKER-TEMPLATE (NIL :SET :EVAL)) (PUTPROPS RPAQ WALKER-TEMPLATE (NIL :SET :EVAL)) (PUTPROPS XNLSETQ WALKER-TEMPLATE (NIL :REPEAT (:EVAL))) (PUTPROPS ERSETQ WALKER-TEMPLATE (NIL :REPEAT (:EVAL))) (PUTPROPS NLSETQ WALKER-TEMPLATE (NIL :REPEAT (:EVAL))) (PUTPROPS RESETVARS WALKER-TEMPLATE WALK-LET) (PUTPROPS CMLWALK FILETYPE :COMPILE-FILE) (PUTPROPS CMLWALK COPYRIGHT ("Venue & Xerox Corporation" 1986 1987 1990 1991 1993)) NIL