add merge in Ron's 11/21/2020 lispcore
This commit is contained in:
Larry Masinter
560
CLTL2/CMLWALK
Normal file
560
CLTL2/CMLWALK
Normal file
@@ -0,0 +1,560 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED "18-Oct-93 15:25:46" "{Pele:mv:envos}<LispCore>Sources>CLTL2>CMLWALK.;2" 27482
|
||||
|
||||
previous date%: " 3-Sep-91 17:53:09" "{Pele:mv:envos}<LispCore>Sources>CLTL2>CMLWALK.;1")
|
||||
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1986, 1987, 1990, 1991, 1993 by Venue & Xerox Corporation. All rights reserved.
|
||||
")
|
||||
|
||||
(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 LISP: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 LISP:TAGBODY)
|
||||
(FNS WALK-TAGBODY)
|
||||
(PROP WALKER-TEMPLATE FUNCTION LISP:FUNCTION GO LISP:IF LISP:MULTIPLE-VALUE-CALL
|
||||
LISP:MULTIPLE-VALUE-PROG1 PROGN LISP:PROGV QUOTE LISP:RETURN-FROM RETURN
|
||||
LISP:SETQ LISP:BLOCK LISP:CATCH LISP:EVAL-WHEN THE LISP:THROW LISP:UNWIND-PROTECT
|
||||
LOAD-TIME-EVAL COND LISP: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 (LISP:GENSYM))
|
||||
(XCL::RUN-TIME-VARS (LISP:GENSYM))
|
||||
(XCL::RUN-TIME-VALS (LISP:GENSYM))
|
||||
(XCL::EXPAND-TIME-VAL-FORMS (FOR XCL::VAR IN XCL::VARS
|
||||
COLLECT `(LISP:IF (OR (LISP:SYMBOLP ,XCL::VAR)
|
||||
(LISP:CONSTANTP ,XCL::VAR))
|
||||
,XCL::VAR
|
||||
(LET ((,XCL::GENSYM-VAR (LISP:GENSYM)))
|
||||
(LISP:PUSH ,XCL::GENSYM-VAR
|
||||
,XCL::RUN-TIME-VARS)
|
||||
(LISP:PUSH ,XCL::VAR
|
||||
,XCL::RUN-TIME-VALS)
|
||||
,XCL::GENSYM-VAR))]
|
||||
`(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]
|
||||
`(LET ,(FOR XCL::RUN-TIME-VAR IN (LISP:REVERSE XCL::RUN-TIME-VARS)
|
||||
AS XCL::RUN-TIME-VAL IN (LISP:REVERSE XCL::RUN-TIME-VALS)
|
||||
COLLECT (LIST XCL::RUN-TIME-VAR XCL::RUN-TIME-VAL))
|
||||
,XCL::WRAPPED-BODY])
|
||||
|
||||
|
||||
|
||||
(* ; "not a wonderful place for it, but CMLMACROS comes too eraly in the loadup.")
|
||||
|
||||
|
||||
(LISP:DEFVAR *WALK-FUNCTION* NIL
|
||||
"the function being called on each sub-form in the code-walker")
|
||||
|
||||
(LISP: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."
|
||||
)
|
||||
|
||||
(LISP:DEFVAR *DECLARATIONS* "a list of the declarations currently in effect while codewalking")
|
||||
|
||||
(LISP:DEFVAR *LEXICAL-VARIABLES* NIL (* ;
|
||||
"used in walker to hold list of lexical variables available")
|
||||
)
|
||||
|
||||
(LISP:DEFVAR *ENVIRONMENT*
|
||||
"while codewalking, this is the lexical environment as far as macros are concerned")
|
||||
|
||||
(LISP: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. *")
|
||||
|
||||
`(LET ((*DECLARATIONS* NIL)
|
||||
(*LEXICAL-VARIABLES* *LEXICAL-VARIABLES*)
|
||||
(*ENVIRONMENT* *ENVIRONMENT*))
|
||||
,@BODY))
|
||||
|
||||
(DEFMACRO NOTE-LEXICAL-BINDING (THING)
|
||||
`(LISP:PUSH ,THING *LEXICAL-VARIABLES*))
|
||||
|
||||
(DEFMACRO NOTE-DECLARATION (LISP:DECLARATION)
|
||||
`(LISP:PUSH ,LISP:DECLARATION *DECLARATIONS*))
|
||||
|
||||
(LISP:DEFUN VARIABLE-SPECIAL-P (VAR)
|
||||
(* lmm "27-May-86 15:42")
|
||||
(OR (for DECL in *DECLARATIONS* do (AND (EQ (CAR DECL)
|
||||
'LISP:SPECIAL)
|
||||
(FMEMB VAR (CDR DECL))
|
||||
(RETURN T)))
|
||||
(VARIABLE-GLOBALLY-SPECIAL-P VAR)))
|
||||
|
||||
(LISP:DEFUN VARIABLE-LEXICAL-P (VAR)
|
||||
(* lmm "11-Apr-86 10:59")
|
||||
(AND (NOT (VARIABLE-SPECIAL-P VAR))
|
||||
(LISP:MEMBER VAR *LEXICAL-VARIABLES* :TEST (FUNCTION EQ))))
|
||||
|
||||
(LISP:DEFUN GET-WALKER-TEMPLATE (X)
|
||||
(* lmm "24-May-86 14:48")
|
||||
(LISP:IF (NOT (LISP:SYMBOLP X))
|
||||
'(LISP:LAMBDA :REPEAT (:EVAL))
|
||||
(GET X 'WALKER-TEMPLATE)))
|
||||
|
||||
(LISP:DEFUN WALK-FORM (FORM &KEY ((:DECLARATIONS *DECLARATIONS*)
|
||||
NIL)
|
||||
((:LEXICAL-VARIABLES *LEXICAL-VARIABLES*)
|
||||
NIL)
|
||||
((:ENVIRONMENT *ENVIRONMENT*)
|
||||
NIL)
|
||||
((:WALK-FUNCTION *WALK-FUNCTION*)
|
||||
(FUNCTION (LISP: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 ':EVAL))
|
||||
(DEFINEQ
|
||||
|
||||
(WALK-FORM-INTERNAL
|
||||
[LISP:LAMBDA (FORM CONTEXT &AUX FN TEMPLATE WALK-NO-MORE-P NEWFORM)
|
||||
(* lmm "24-May-86 20:28")
|
||||
|
||||
(* ;; "WALK-FORM-INTERNAL is the main driving function for the code walker. It takes a form and the current context and walks the form calling itself or the appropriate template recursively.")
|
||||
|
||||
(LISP:MULTIPLE-VALUE-SETQ (NEWFORM WALK-NO-MORE-P)
|
||||
(LISP:FUNCALL *WALK-FUNCTION* FORM CONTEXT))
|
||||
(COND
|
||||
(WALK-NO-MORE-P NEWFORM)
|
||||
((NOT (EQ FORM NEWFORM))
|
||||
(WALK-FORM-INTERNAL NEWFORM CONTEXT))
|
||||
((NOT (LISP:CONSP FORM))
|
||||
FORM)
|
||||
((NOT (LISP:SYMBOLP (CAR FORM)))
|
||||
(WALK-TEMPLATE FORM '(:CALL :REPEAT (:EVAL))
|
||||
CONTEXT))
|
||||
((SETQ TEMPLATE (GET-WALKER-TEMPLATE (CAR FORM)))
|
||||
(LISP:IF (LISP:SYMBOLP TEMPLATE)
|
||||
(LISP:FUNCALL TEMPLATE FORM CONTEXT)
|
||||
(WALK-TEMPLATE FORM TEMPLATE CONTEXT)))
|
||||
((NEQ FORM (SETQ FORM (LISP:MACROEXPAND-1 FORM *ENVIRONMENT*)))
|
||||
(WALK-FORM-INTERNAL FORM CONTEXT))
|
||||
(T
|
||||
(* ;; "Otherwise, walk the form as if its just a standard function call using a template for standard function call.")
|
||||
|
||||
(WALK-TEMPLATE FORM '(:CALL :REPEAT (:EVAL))
|
||||
CONTEXT])
|
||||
|
||||
(WALK-TEMPLATE
|
||||
[LISP:LAMBDA (FORM TEMPLATE CONTEXT) (* lmm "24-May-86 16:43")
|
||||
(LISP:IF (LISP:ATOM TEMPLATE)
|
||||
(LISP:ECASE TEMPLATE
|
||||
((CALL :CALL) (if (LISP:CONSP FORM)
|
||||
then (WALK-LAMBDA FORM NIL)
|
||||
else FORM))
|
||||
((QUOTE NIL PPE :ERROR) FORM)
|
||||
((:EVAL EVAL :FUNCTION FUNCTION :TEST TEST :EFFECT EFFECT :RETURN RETURN)
|
||||
(WALK-FORM-INTERNAL FORM ':EVAL))
|
||||
((SET :SET) (WALK-FORM-INTERNAL FORM ':SET))
|
||||
(LISP:LAMBDA (WALK-LAMBDA FORM CONTEXT)))
|
||||
(CASE (CAR TEMPLATE)
|
||||
(LISP:IF (LET ((*WALK-FORM* FORM))
|
||||
(WALK-TEMPLATE FORM (COND
|
||||
((LISP:IF (LISTP (LISP:SECOND TEMPLATE))
|
||||
(LISP:EVAL (LISP:SECOND TEMPLATE))
|
||||
(LISP:FUNCALL (LISP:SECOND TEMPLATE)
|
||||
FORM))
|
||||
(LISP:THIRD TEMPLATE))
|
||||
(T (LISP:FOURTH TEMPLATE)))
|
||||
CONTEXT)))
|
||||
((REPEAT :REPEAT) (WALK-TEMPLATE-HANDLE-REPEAT FORM (CDR TEMPLATE)
|
||||
(LISP:NTHCDR (- (LISP:LENGTH FORM)
|
||||
(LISP:LENGTH (CDDR TEMPLATE)))
|
||||
FORM)
|
||||
CONTEXT))
|
||||
(T [COND
|
||||
((LISP:ATOM FORM)
|
||||
FORM)
|
||||
(T (WALK-RECONS FORM (WALK-TEMPLATE (CAR FORM)
|
||||
(CAR TEMPLATE)
|
||||
CONTEXT)
|
||||
(WALK-TEMPLATE (CDR FORM)
|
||||
(CDR TEMPLATE)
|
||||
CONTEXT])))])
|
||||
|
||||
(WALK-TEMPLATE-HANDLE-REPEAT
|
||||
(LISP:LAMBDA (FORM TEMPLATE STOP-FORM CONTEXT) (* lmm "11-Apr-86 12:05")
|
||||
(LISP:IF (EQ FORM STOP-FORM)
|
||||
(WALK-TEMPLATE FORM (CDR TEMPLATE)
|
||||
CONTEXT)
|
||||
(WALK-TEMPLATE-HANDLE-REPEAT-1 FORM TEMPLATE (CAR TEMPLATE)
|
||||
STOP-FORM CONTEXT))))
|
||||
|
||||
(WALK-TEMPLATE-HANDLE-REPEAT-1
|
||||
[LISP:LAMBDA (FORM TEMPLATE REPEAT-TEMPLATE STOP-FORM CONTEXT)
|
||||
(* lmm "24-May-86 16:43")
|
||||
(COND
|
||||
((NULL FORM)
|
||||
NIL)
|
||||
((EQ FORM STOP-FORM)
|
||||
(LISP:IF (NULL REPEAT-TEMPLATE)
|
||||
(WALK-TEMPLATE STOP-FORM (CDR TEMPLATE)
|
||||
CONTEXT)
|
||||
(LISP:ERROR
|
||||
"While handling repeat:
|
||||
~%%~Ran into stop while still in repeat template.")))
|
||||
((NULL REPEAT-TEMPLATE)
|
||||
(WALK-TEMPLATE-HANDLE-REPEAT-1 FORM TEMPLATE (CAR TEMPLATE)
|
||||
STOP-FORM CONTEXT))
|
||||
(T (WALK-RECONS FORM (WALK-TEMPLATE (CAR FORM)
|
||||
(CAR REPEAT-TEMPLATE)
|
||||
CONTEXT)
|
||||
(WALK-TEMPLATE-HANDLE-REPEAT-1 (CDR FORM)
|
||||
TEMPLATE
|
||||
(CDR REPEAT-TEMPLATE)
|
||||
STOP-FORM CONTEXT])
|
||||
|
||||
(WALK-LIST
|
||||
[LAMBDA (LIST FN) (* lmm "24-May-86 16:43")
|
||||
(* copy list walking each element)
|
||||
(LISP:IF LIST
|
||||
(WALK-RECONS LIST (LISP:FUNCALL FN (CAR LIST))
|
||||
(WALK-LIST (CDR LIST)
|
||||
FN)))])
|
||||
|
||||
(WALK-RECONS
|
||||
(LISP:LAMBDA (X CAR CDR) (* lmm "24-May-86 16:43")
|
||||
(LISP:IF *WALK-COPY*
|
||||
(LISP:IF (OR (NOT (EQ (CAR X)
|
||||
CAR))
|
||||
(NOT (EQ (CDR X)
|
||||
CDR)))
|
||||
(CONS CAR CDR)
|
||||
X)
|
||||
NIL)))
|
||||
)
|
||||
|
||||
(DEFMACRO WALK-RELIST* (X FIRST &REST LISP:REST)
|
||||
(LISP:IF LISP:REST
|
||||
`(WALK-RECONS ,X ,FIRST (WALK-RELIST* (CDR ,X)
|
||||
,@LISP:REST))
|
||||
FIRST))
|
||||
(DEFINEQ
|
||||
|
||||
(WALK-DECLARATIONS
|
||||
[LISP:LAMBDA (BODY FN &OPTIONAL DOC-STRING-P DECLARATIONS &AUX (FORM (CAR BODY)))
|
||||
(* lmm "18-Jun-86 14:35")
|
||||
(* skips over declarations)
|
||||
(COND
|
||||
((AND (STRINGP FORM) (* might be a doc string *)
|
||||
(CDR BODY) (* isn't the returned value *)
|
||||
(NULL DOC-STRING-P) (* no doc string yet *)
|
||||
(NULL DECLARATIONS)) (* no declarations yet *)
|
||||
(WALK-RECONS BODY FORM (WALK-DECLARATIONS (CDR BODY)
|
||||
FN T)))
|
||||
((AND (LISTP FORM)
|
||||
(EQ (CAR FORM)
|
||||
'DECLARE)) (* Got a real declaration.
|
||||
Record it, look for more.
|
||||
*)
|
||||
(LISP:DOLIST (LISP:DECLARATION (CDR FORM))
|
||||
(NOTE-DECLARATION LISP:DECLARATION)
|
||||
(LISP:PUSH LISP:DECLARATION DECLARATIONS))
|
||||
(WALK-RECONS BODY FORM (WALK-DECLARATIONS (CDR BODY)
|
||||
FN DOC-STRING-P DECLARATIONS)))
|
||||
([AND (LISP:CONSP FORM)
|
||||
(NULL (GET-WALKER-TEMPLATE (CAR FORM)))
|
||||
(NOT (EQ FORM (SETQ FORM (LISP:MACROEXPAND-1 FORM *ENVIRONMENT*]
|
||||
|
||||
(* * When we macroexpanded this form we got something else back.
|
||||
Maybe this is a macro which expanded into a declare? Recurse to find out.)
|
||||
|
||||
(WALK-DECLARATIONS (CONS FORM (CDR BODY))
|
||||
FN DOC-STRING-P DECLARATIONS))
|
||||
(T
|
||||
|
||||
(* Now that we have walked and recorded the declarations, call the function our
|
||||
caller provided to expand the body. We call that function rather than passing
|
||||
the real-body back, because we are RECONSING up the new body.)
|
||||
|
||||
(LISP:FUNCALL FN BODY])
|
||||
|
||||
(WALK-ARGLIST
|
||||
[LISP:LAMBDA (ARGLIST CONTEXT &OPTIONAL DESTRUCTURINGP &AUX ARG)
|
||||
(* lmm "24-May-86 16:44")
|
||||
(COND
|
||||
((NULL ARGLIST)
|
||||
NIL)
|
||||
[(LISP:SYMBOLP (LISP:SETQ ARG (CAR ARGLIST)))
|
||||
(OR (LISP:MEMBER ARG LISP:LAMBDA-LIST-KEYWORDS :TEST (FUNCTION EQ))
|
||||
(NOTE-LEXICAL-BINDING ARG))
|
||||
(WALK-RECONS ARGLIST ARG (WALK-ARGLIST
|
||||
(CDR ARGLIST)
|
||||
CONTEXT
|
||||
(AND DESTRUCTURINGP (NOT (LISP:MEMBER
|
||||
ARG LISP:LAMBDA-LIST-KEYWORDS
|
||||
:TEST (FUNCTION EQ]
|
||||
[(LISP:CONSP ARG)
|
||||
(PROG1 (LISP:IF DESTRUCTURINGP
|
||||
(WALK-ARGLIST ARG CONTEXT DESTRUCTURINGP)
|
||||
(WALK-RECONS ARGLIST (WALK-RELIST* ARG (CAR ARG)
|
||||
(WALK-FORM-INTERNAL (CADR ARG)
|
||||
':EVAL)
|
||||
(CDDR ARG))
|
||||
(WALK-ARGLIST (CDR ARGLIST)
|
||||
CONTEXT NIL)))
|
||||
(LISP:IF (LISP:SYMBOLP (CAR ARG))
|
||||
(NOTE-LEXICAL-BINDING (CAR ARG))
|
||||
(NOTE-LEXICAL-BINDING (CADAR ARG)))
|
||||
(OR (NULL (CDDR ARG))
|
||||
(NOT (LISP:SYMBOLP (CADDR ARG)))
|
||||
(NOTE-LEXICAL-BINDING ARG)))]
|
||||
(T (LISP:ERROR "Can't understand something in the arglist ~S" ARGLIST])
|
||||
|
||||
(WALK-LAMBDA
|
||||
[LISP:LAMBDA (FORM CONTEXT) (* lmm "24-May-86 16:44")
|
||||
(WITH-NEW-CONTOUR (LET* [(ARGLIST (CADR FORM))
|
||||
(BODY (CDDR FORM))
|
||||
(WALKED-ARGLIST NIL)
|
||||
(WALKED-BODY (WALK-DECLARATIONS
|
||||
BODY
|
||||
(FUNCTION (LISP:LAMBDA
|
||||
(REAL-BODY)
|
||||
(LISP:SETQ WALKED-ARGLIST
|
||||
(WALK-ARGLIST ARGLIST
|
||||
CONTEXT))
|
||||
(WALK-TEMPLATE
|
||||
REAL-BODY
|
||||
'(:REPEAT (:EVAL))
|
||||
CONTEXT]
|
||||
(WALK-RELIST* FORM (CAR FORM)
|
||||
WALKED-ARGLIST WALKED-BODY])
|
||||
)
|
||||
|
||||
(PUTPROPS LISP:COMPILER-LET WALKER-TEMPLATE WALK-COMPILER-LET)
|
||||
(DEFINEQ
|
||||
|
||||
(WALK-COMPILER-LET
|
||||
[LISP:LAMBDA (FORM CONTEXT) (* gbn " 7-Aug-86 18:21")
|
||||
(* ;
|
||||
"bind the variables, but then return the COMPILER-LET")
|
||||
(LET [(VARS (LISP:MAPCAR [FUNCTION (LAMBDA (X)
|
||||
(LISP:IF (LISP:CONSP X)
|
||||
(CAR X)
|
||||
X)]
|
||||
(CADR FORM)))
|
||||
(VALS (LISP:MAPCAR (FUNCTION (LISP:LAMBDA (X)
|
||||
(LISP:IF (LISP:CONSP X)
|
||||
(LISP:EVAL (CADR X))
|
||||
NIL)))
|
||||
(CADR FORM]
|
||||
(LISP:PROGV VARS VALS
|
||||
(WALK-TEMPLATE FORM '(NIL NIL :REPEAT (:EVAL)
|
||||
:RETURN)
|
||||
CONTEXT))])
|
||||
)
|
||||
|
||||
(PUTPROPS DECLARE WALKER-TEMPLATE WALK-UNEXPECTED-DECLARE)
|
||||
(DEFINEQ
|
||||
|
||||
(WALK-UNEXPECTED-DECLARE
|
||||
(LISP:LAMBDA (FORM CONTEXT) (* lmm "24-May-86 22:27")
|
||||
(DECLARE (IGNORE CONTEXT))
|
||||
(LISP:WARN "Encountered declare ~S in a place where a declare was not expected." FORM)
|
||||
FORM))
|
||||
)
|
||||
|
||||
(PUTPROPS LET WALKER-TEMPLATE WALK-LET)
|
||||
|
||||
(PUTPROPS PROG WALKER-TEMPLATE WALK-LET)
|
||||
|
||||
(PUTPROPS LET* WALKER-TEMPLATE WALK-LET*)
|
||||
|
||||
(PUTPROPS PROG* WALKER-TEMPLATE WALK-LET*)
|
||||
(DEFINEQ
|
||||
|
||||
(WALK-LET
|
||||
(LISP:LAMBDA (FORM CONTEXT)
|
||||
(WALK-LET/LET* FORM CONTEXT NIL)))
|
||||
|
||||
(WALK-LET*
|
||||
(LISP:LAMBDA (FORM CONTEXT)
|
||||
(WALK-LET/LET* FORM CONTEXT T)))
|
||||
|
||||
(WALK-LET/LET*
|
||||
[LISP:LAMBDA
|
||||
(FORM CONTEXT SEQUENTIALP) (* lmm "24-May-86 16:44")
|
||||
(LET
|
||||
((OLD-DECLARATIONS *DECLARATIONS*)
|
||||
(OLD-LEXICAL-VARIABLES *LEXICAL-VARIABLES*))
|
||||
(WITH-NEW-CONTOUR
|
||||
(LET* [(LET/LET* (CAR FORM))
|
||||
(BINDINGS (CADR FORM))
|
||||
(BODY (CDDR FORM))
|
||||
WALKED-BINDINGS
|
||||
(WALKED-BODY
|
||||
(WALK-DECLARATIONS
|
||||
BODY
|
||||
(FUNCTION (LISP:LAMBDA
|
||||
(REAL-BODY)
|
||||
[LISP:SETQ WALKED-BINDINGS
|
||||
(WALK-LIST BINDINGS
|
||||
(FUNCTION (LAMBDA (BINDING)
|
||||
(LISP:IF (LISP:SYMBOLP BINDING)
|
||||
(PROG1 BINDING (NOTE-LEXICAL-BINDING
|
||||
BINDING))
|
||||
(PROG1 (LET ((*DECLARATIONS* OLD-DECLARATIONS)
|
||||
(*LEXICAL-VARIABLES* (LISP:IF
|
||||
SEQUENTIALP
|
||||
|
||||
*LEXICAL-VARIABLES*
|
||||
|
||||
OLD-LEXICAL-VARIABLES)
|
||||
))
|
||||
(WALK-RELIST*
|
||||
BINDING
|
||||
(CAR BINDING)
|
||||
(WALK-FORM-INTERNAL
|
||||
(CADR BINDING)
|
||||
CONTEXT)
|
||||
(CDDR BINDING)))
|
||||
(NOTE-LEXICAL-BINDING (CAR BINDING))))
|
||||
]
|
||||
(WALK-TEMPLATE REAL-BODY '(:REPEAT (:EVAL))
|
||||
CONTEXT]
|
||||
(WALK-RELIST* FORM LET/LET* WALKED-BINDINGS WALKED-BODY])
|
||||
)
|
||||
|
||||
(PUTPROPS LISP:TAGBODY WALKER-TEMPLATE WALK-TAGBODY)
|
||||
(DEFINEQ
|
||||
|
||||
(WALK-TAGBODY
|
||||
[LISP:LAMBDA (FORM CONTEXT) (* lmm "24-May-86 16:44")
|
||||
(WALK-RECONS FORM (CAR FORM)
|
||||
(WALK-LIST (CDR FORM)
|
||||
(FUNCTION (LAMBDA (X)
|
||||
(WALK-FORM-INTERNAL X (LISP:IF (LISP:SYMBOLP X)
|
||||
'QUOTE
|
||||
CONTEXT)])
|
||||
)
|
||||
|
||||
(PUTPROPS FUNCTION WALKER-TEMPLATE (NIL :CALL))
|
||||
|
||||
(PUTPROPS LISP:FUNCTION WALKER-TEMPLATE (NIL :CALL))
|
||||
|
||||
(PUTPROPS GO WALKER-TEMPLATE (NIL NIL))
|
||||
|
||||
(PUTPROPS LISP:IF WALKER-TEMPLATE (NIL :TEST :RETURN :RETURN))
|
||||
|
||||
(PUTPROPS LISP:MULTIPLE-VALUE-CALL WALKER-TEMPLATE (NIL :EVAL :REPEAT (:EVAL)))
|
||||
|
||||
(PUTPROPS LISP:MULTIPLE-VALUE-PROG1 WALKER-TEMPLATE (NIL :RETURN :REPEAT (:EVAL)))
|
||||
|
||||
(PUTPROPS PROGN WALKER-TEMPLATE (NIL :REPEAT (:EVAL)))
|
||||
|
||||
(PUTPROPS LISP:PROGV WALKER-TEMPLATE (NIL :EVAL :EVAL :REPEAT (:EVAL)))
|
||||
|
||||
(PUTPROPS QUOTE WALKER-TEMPLATE (NIL QUOTE))
|
||||
|
||||
(PUTPROPS LISP:RETURN-FROM WALKER-TEMPLATE (NIL NIL :EVAL))
|
||||
|
||||
(PUTPROPS RETURN WALKER-TEMPLATE (NIL :EVAL))
|
||||
|
||||
(PUTPROPS LISP:SETQ WALKER-TEMPLATE (NIL :REPEAT (:SET :EVAL)))
|
||||
|
||||
(PUTPROPS LISP:BLOCK WALKER-TEMPLATE (NIL NIL :REPEAT (:EVAL)))
|
||||
|
||||
(PUTPROPS LISP:CATCH WALKER-TEMPLATE (NIL :EVAL :REPEAT (:EVAL)))
|
||||
|
||||
(PUTPROPS LISP:EVAL-WHEN WALKER-TEMPLATE (NIL NIL :REPEAT (:EVAL)))
|
||||
|
||||
(PUTPROPS THE WALKER-TEMPLATE (NIL NIL :EVAL))
|
||||
|
||||
(PUTPROPS LISP:THROW WALKER-TEMPLATE (NIL :EVAL :EVAL))
|
||||
|
||||
(PUTPROPS LISP: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 LISP: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)))
|
||||
|
||||
|
||||
|
||||
(* ;; "for Interlisp")
|
||||
|
||||
|
||||
(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)
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
|
||||
|
||||
(ADDTOVAR NLAMA )
|
||||
|
||||
(ADDTOVAR NLAML )
|
||||
|
||||
(ADDTOVAR 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)
|
||||
)
|
||||
(PUTPROPS CMLWALK COPYRIGHT ("Venue & Xerox Corporation" 1986 1987 1990 1991 1993))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (8105 14049 (WALK-FORM-INTERNAL 8115 . 9572) (WALK-TEMPLATE 9574 . 11843) (
|
||||
WALK-TEMPLATE-HANDLE-REPEAT 11845 . 12206) (WALK-TEMPLATE-HANDLE-REPEAT-1 12208 . 13310) (WALK-LIST
|
||||
13312 . 13665) (WALK-RECONS 13667 . 14047)) (14259 19629 (WALK-DECLARATIONS 14269 . 16481) (
|
||||
WALK-ARGLIST 16483 . 18330) (WALK-LAMBDA 18332 . 19627)) (19702 20803 (WALK-COMPILER-LET 19712 . 20801
|
||||
)) (20872 21155 (WALK-UNEXPECTED-DECLARE 20882 . 21153)) (21358 24219 (WALK-LET 21368 . 21461) (
|
||||
WALK-LET* 21463 . 21553) (WALK-LET/LET* 21555 . 24217)) (24282 24766 (WALK-TAGBODY 24292 . 24764)))))
|
||||
STOP
|
||||
Reference in New Issue
Block a user