move files from sources that are not used
This commit is contained in:
Larry Masinter
committed by
Larry Masinter
Larry Masinter
parent
d4b8656803
commit
510516e62d
@@ -1,36 +0,0 @@
|
||||
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
|
||||
(FILECREATED "16-May-90 14:26:04" {DSK}<usr>local>lde>lispcore>sources>CMLSEQ.;2 1265
|
||||
|
||||
changes to%: (VARS CMLSEQCOMS)
|
||||
|
||||
previous date%: "15-Oct-86 17:56:17" {DSK}<usr>local>lde>lispcore>sources>CMLSEQ.;1)
|
||||
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1985, 1986, 1990 by Venue & Xerox Corporation. All rights reserved.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT CMLSEQCOMS)
|
||||
|
||||
(RPAQQ CMLSEQCOMS [(FILES CMLSEQCOMMON CMLSEQBASICS CMLSEQMAPPERS CMLSEQMODIFY CMLSEQFINDER
|
||||
CMLSORT)
|
||||
(PROP FILETYPE CMLSEQ)
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
|
||||
(NLAML)
|
||||
(LAMA])
|
||||
|
||||
(FILESLOAD CMLSEQCOMMON CMLSEQBASICS CMLSEQMAPPERS CMLSEQMODIFY CMLSEQFINDER CMLSORT)
|
||||
|
||||
(PUTPROPS CMLSEQ FILETYPE CL:COMPILE-FILE)
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
|
||||
|
||||
(ADDTOVAR NLAMA )
|
||||
|
||||
(ADDTOVAR NLAML )
|
||||
|
||||
(ADDTOVAR LAMA )
|
||||
)
|
||||
(PUTPROPS CMLSEQ COPYRIGHT ("Venue & Xerox Corporation" 1985 1986 1990))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL)))
|
||||
STOP
|
||||
@@ -1 +0,0 @@
|
||||
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
(FILECREATED "25-Jan-98 10:34:21" ("compiled on " {DSK}<lispcore>sources>CMLSEQ.;1)
"30-Mar-95 20:33:04" bcompl'd in "Medley 14-Aug-95 ..." dated "14-Aug-95 15:27:48")
(FILECREATED "16-May-90 14:26:04" {DSK}<usr>local>lde>lispcore>sources>CMLSEQ.;2 1265 changes to%: (
VARS CMLSEQCOMS) previous date%: "15-Oct-86 17:56:17" {DSK}<usr>local>lde>lispcore>sources>CMLSEQ.;1)
(PRETTYCOMPRINT CMLSEQCOMS)
(RPAQQ CMLSEQCOMS ((FILES CMLSEQCOMMON CMLSEQBASICS CMLSEQMAPPERS CMLSEQMODIFY CMLSEQFINDER CMLSORT) (
PROP FILETYPE CMLSEQ) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA) (
NLAML) (LAMA)))))
(FILESLOAD CMLSEQCOMMON CMLSEQBASICS CMLSEQMAPPERS CMLSEQMODIFY CMLSEQFINDER CMLSORT)
(PUTPROPS CMLSEQ FILETYPE CL:COMPILE-FILE)
(PUTPROPS CMLSEQ COPYRIGHT ("Venue & Xerox Corporation" 1985 1986 1990))
NIL
|
||||
601
sources/CMLWALK
601
sources/CMLWALK
@@ -1,601 +0,0 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED "16-May-90 14:56:15" {DSK}<usr>local>lde>lispcore>sources>CMLWALK.;2 29711
|
||||
|
||||
changes to%: (VARS CMLWALKCOMS)
|
||||
|
||||
previous date%: "17-Jun-87 17:43:58" {DSK}<usr>local>lde>lispcore>sources>CMLWALK.;1)
|
||||
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1986, 1987, 1990 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 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 `(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))]
|
||||
`(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 (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])
|
||||
|
||||
|
||||
|
||||
(* ; "not a wonderful place for it, but CMLMACROS comes too eraly in the loadup.")
|
||||
|
||||
|
||||
(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. *")
|
||||
|
||||
`(LET ((*DECLARATIONS* NIL)
|
||||
(*LEXICAL-VARIABLES* *LEXICAL-VARIABLES*)
|
||||
(*ENVIRONMENT* *ENVIRONMENT*))
|
||||
,@BODY))
|
||||
|
||||
(DEFMACRO NOTE-LEXICAL-BINDING (THING)
|
||||
`(CL:PUSH ,THING *LEXICAL-VARIABLES*))
|
||||
|
||||
(DEFMACRO NOTE-DECLARATION (CL:DECLARATION)
|
||||
`(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)
|
||||
'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))
|
||||
'(CL:LAMBDA :REPEAT (:EVAL))
|
||||
(GET X '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 ':EVAL))
|
||||
(DEFINEQ
|
||||
|
||||
(WALK-FORM-INTERNAL
|
||||
(CL: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.")
|
||||
(CL:MULTIPLE-VALUE-SETQ (NEWFORM WALK-NO-MORE-P)
|
||||
(CL:FUNCALL *WALK-FUNCTION* FORM CONTEXT))
|
||||
(COND
|
||||
(WALK-NO-MORE-P NEWFORM)
|
||||
((NOT (EQ FORM NEWFORM))
|
||||
(WALK-FORM-INTERNAL NEWFORM CONTEXT))
|
||||
((NOT (CL:CONSP FORM))
|
||||
FORM)
|
||||
((NOT (CL:SYMBOLP (CAR FORM)))
|
||||
(WALK-TEMPLATE FORM '(:CALL :REPEAT (:EVAL)) CONTEXT))
|
||||
((SETQ TEMPLATE (GET-WALKER-TEMPLATE (CAR FORM)))
|
||||
(CL:IF (CL:SYMBOLP TEMPLATE)
|
||||
(CL:FUNCALL TEMPLATE FORM CONTEXT)
|
||||
(WALK-TEMPLATE FORM TEMPLATE CONTEXT)))
|
||||
((NEQ FORM (SETQ FORM (CL: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
|
||||
(CL:LAMBDA (FORM TEMPLATE CONTEXT) (* lmm "24-May-86 16:43")
|
||||
(CL:IF (CL:ATOM TEMPLATE)
|
||||
(CL:ECASE TEMPLATE ((CALL :CALL)
|
||||
(if (CL: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))
|
||||
(CL:LAMBDA (WALK-LAMBDA FORM CONTEXT)))
|
||||
(CASE (CAR TEMPLATE)
|
||||
(CL:IF (LET ((*WALK-FORM* FORM))
|
||||
(WALK-TEMPLATE FORM (COND
|
||||
((CL:IF (LISTP (CL:SECOND TEMPLATE))
|
||||
(CL:EVAL (CL:SECOND TEMPLATE))
|
||||
(CL:FUNCALL (CL:SECOND TEMPLATE)
|
||||
FORM))
|
||||
(CL:THIRD TEMPLATE))
|
||||
(T (CL:FOURTH TEMPLATE)))
|
||||
CONTEXT)))
|
||||
((REPEAT :REPEAT)
|
||||
(WALK-TEMPLATE-HANDLE-REPEAT FORM (CDR TEMPLATE)
|
||||
(CL:NTHCDR (- (CL:LENGTH FORM)
|
||||
(CL:LENGTH (CDDR TEMPLATE)))
|
||||
FORM)
|
||||
CONTEXT))
|
||||
(T (COND
|
||||
((CL: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
|
||||
(CL:LAMBDA (FORM TEMPLATE STOP-FORM CONTEXT) (* lmm "11-Apr-86 12:05")
|
||||
(CL: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
|
||||
(CL:LAMBDA (FORM TEMPLATE REPEAT-TEMPLATE STOP-FORM CONTEXT)
|
||||
(* lmm "24-May-86 16:43")
|
||||
(COND
|
||||
((NULL FORM)
|
||||
NIL)
|
||||
((EQ FORM STOP-FORM)
|
||||
(CL:IF (NULL REPEAT-TEMPLATE)
|
||||
(WALK-TEMPLATE STOP-FORM (CDR TEMPLATE)
|
||||
CONTEXT)
|
||||
(CL: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)
|
||||
(CL:IF LIST (WALK-RECONS LIST (CL:FUNCALL FN (CAR LIST))
|
||||
(WALK-LIST (CDR LIST)
|
||||
FN)))))
|
||||
|
||||
(WALK-RECONS
|
||||
(CL:LAMBDA (X CAR CDR) (* lmm "24-May-86 16:43")
|
||||
(CL:IF *WALK-COPY* (CL:IF (OR (NOT (EQ (CAR X)
|
||||
CAR))
|
||||
(NOT (EQ (CDR X)
|
||||
CDR)))
|
||||
(CONS CAR CDR)
|
||||
X)
|
||||
NIL)))
|
||||
)
|
||||
|
||||
(DEFMACRO WALK-RELIST* (X FIRST &REST CL:REST)
|
||||
(CL:IF CL:REST
|
||||
`(WALK-RECONS ,X ,FIRST (WALK-RELIST* (CDR ,X)
|
||||
,@CL:REST))
|
||||
FIRST))
|
||||
(DEFINEQ
|
||||
|
||||
(WALK-DECLARATIONS
|
||||
(CL: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.
|
||||
*)
|
||||
|
||||
(CL:DOLIST (CL:DECLARATION (CDR FORM))
|
||||
(NOTE-DECLARATION CL:DECLARATION)
|
||||
(CL:PUSH CL:DECLARATION DECLARATIONS))
|
||||
(WALK-RECONS BODY FORM (WALK-DECLARATIONS (CDR BODY)
|
||||
FN DOC-STRING-P DECLARATIONS)))
|
||||
((AND (CL:CONSP FORM)
|
||||
(NULL (GET-WALKER-TEMPLATE (CAR FORM)))
|
||||
(NOT (EQ FORM (SETQ FORM (CL: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.)
|
||||
|
||||
(CL:FUNCALL FN BODY)))))
|
||||
|
||||
(WALK-ARGLIST
|
||||
(CL:LAMBDA (ARGLIST CONTEXT &OPTIONAL DESTRUCTURINGP &AUX ARG)
|
||||
(* lmm "24-May-86 16:44")
|
||||
(COND
|
||||
((NULL ARGLIST)
|
||||
NIL)
|
||||
((CL:SYMBOLP (CL:SETQ ARG (CAR ARGLIST)))
|
||||
(OR (CL:MEMBER ARG CL:LAMBDA-LIST-KEYWORDS :TEST (FUNCTION EQ))
|
||||
(NOTE-LEXICAL-BINDING ARG))
|
||||
(WALK-RECONS ARGLIST ARG (WALK-ARGLIST (CDR ARGLIST)
|
||||
CONTEXT
|
||||
(AND DESTRUCTURINGP (NOT (CL:MEMBER
|
||||
ARG CL:LAMBDA-LIST-KEYWORDS
|
||||
:TEST (FUNCTION EQ)))))))
|
||||
((CL:CONSP ARG)
|
||||
(PROG1 (CL: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)))
|
||||
(CL:IF (CL:SYMBOLP (CAR ARG))
|
||||
(NOTE-LEXICAL-BINDING (CAR ARG))
|
||||
(NOTE-LEXICAL-BINDING (CADAR ARG)))
|
||||
(OR (NULL (CDDR ARG))
|
||||
(NOT (CL:SYMBOLP (CADDR ARG)))
|
||||
(NOTE-LEXICAL-BINDING ARG))))
|
||||
(T (CL:ERROR "Can't understand something in the arglist ~S" ARGLIST)))))
|
||||
|
||||
(WALK-LAMBDA
|
||||
(CL: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 (CL:LAMBDA (REAL-BODY)
|
||||
(CL:SETQ WALKED-ARGLIST
|
||||
(WALK-ARGLIST ARGLIST CONTEXT
|
||||
))
|
||||
(WALK-TEMPLATE REAL-BODY
|
||||
'(:REPEAT (:EVAL)) CONTEXT)))
|
||||
)))
|
||||
(WALK-RELIST* FORM (CAR FORM)
|
||||
WALKED-ARGLIST WALKED-BODY)))))
|
||||
)
|
||||
|
||||
(PUTPROPS CL:COMPILER-LET WALKER-TEMPLATE WALK-COMPILER-LET)
|
||||
(DEFINEQ
|
||||
|
||||
(WALK-COMPILER-LET
|
||||
(CL:LAMBDA (FORM CONTEXT) (* gbn " 7-Aug-86 18:21")
|
||||
(* ;
|
||||
"bind the variables, but then return the COMPILER-LET")
|
||||
(LET ((VARS (CL:MAPCAR (FUNCTION (LAMBDA (X)
|
||||
(CL:IF (CL:CONSP X)
|
||||
(CAR X)
|
||||
X)))
|
||||
(CADR FORM)))
|
||||
(VALS (CL:MAPCAR (FUNCTION (CL:LAMBDA (X)
|
||||
(CL:IF (CL:CONSP X)
|
||||
(CL:EVAL (CADR X))
|
||||
NIL)))
|
||||
(CADR FORM))))
|
||||
(CL:PROGV VARS VALS (WALK-TEMPLATE FORM '(NIL NIL :REPEAT (:EVAL)
|
||||
:RETURN) CONTEXT)))))
|
||||
)
|
||||
|
||||
(PUTPROPS DECLARE WALKER-TEMPLATE WALK-UNEXPECTED-DECLARE)
|
||||
(DEFINEQ
|
||||
|
||||
(WALK-UNEXPECTED-DECLARE
|
||||
(CL:LAMBDA (FORM CONTEXT) (* lmm "24-May-86 22:27")
|
||||
(DECLARE (IGNORE CONTEXT))
|
||||
(CL: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
|
||||
(CL:LAMBDA (FORM CONTEXT)
|
||||
(WALK-LET/LET* FORM CONTEXT NIL)))
|
||||
|
||||
(WALK-LET*
|
||||
(CL:LAMBDA (FORM CONTEXT)
|
||||
(WALK-LET/LET* FORM CONTEXT T)))
|
||||
|
||||
(WALK-LET/LET*
|
||||
(CL: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 (CL:LAMBDA (REAL-BODY)
|
||||
(CL:SETQ WALKED-BINDINGS
|
||||
(WALK-LIST BINDINGS
|
||||
(FUNCTION (LAMBDA (BINDING)
|
||||
(CL:IF
|
||||
(CL:SYMBOLP BINDING)
|
||||
(PROG1 BINDING (NOTE-LEXICAL-BINDING
|
||||
BINDING))
|
||||
(PROG1 (LET ((*DECLARATIONS*
|
||||
OLD-DECLARATIONS)
|
||||
(*LEXICAL-VARIABLES*
|
||||
(CL: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 CL:TAGBODY WALKER-TEMPLATE WALK-TAGBODY)
|
||||
(DEFINEQ
|
||||
|
||||
(WALK-TAGBODY
|
||||
(CL: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 (CL:IF (CL:SYMBOLP X)
|
||||
'QUOTE CONTEXT))))))))
|
||||
)
|
||||
|
||||
(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)))
|
||||
|
||||
|
||||
|
||||
(* ;; "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)
|
||||
)
|
||||
(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])
|
||||
(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)
|
||||
)
|
||||
(PUTPROPS CMLWALK COPYRIGHT ("Venue & Xerox Corporation" 1986 1987 1990))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (8262 14412 (WALK-FORM-INTERNAL 8272 . 9743) (WALK-TEMPLATE 9745 . 12120) (
|
||||
WALK-TEMPLATE-HANDLE-REPEAT 12122 . 12497) (WALK-TEMPLATE-HANDLE-REPEAT-1 12499 . 13602) (WALK-LIST
|
||||
13604 . 13965) (WALK-RECONS 13967 . 14410)) (14610 19654 (WALK-DECLARATIONS 14620 . 16728) (
|
||||
WALK-ARGLIST 16730 . 18511) (WALK-LAMBDA 18513 . 19652)) (19725 20773 (WALK-COMPILER-LET 19735 . 20771
|
||||
)) (20842 21127 (WALK-UNEXPECTED-DECLARE 20852 . 21125)) (21330 24127 (WALK-LET 21340 . 21429) (
|
||||
WALK-LET* 21431 . 21519) (WALK-LET/LET* 21521 . 24125)) (24188 24611 (WALK-TAGBODY 24198 . 24609)))))
|
||||
STOP
|
||||
Binary file not shown.
@@ -1,25 +0,0 @@
|
||||
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
|
||||
(FILECREATED "16-May-90 14:57:24" {DSK}<usr>local>lde>lispcore>sources>COMMENT.;2 850
|
||||
|
||||
changes to%: (VARS COMMENTCOMS)
|
||||
|
||||
previous date%: "14-Oct-86 12:24:10" {DSK}<usr>local>lde>lispcore>sources>COMMENT.;1)
|
||||
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1983, 1984, 1986, 1990 by Venue & Xerox Corporation. All rights reserved.
|
||||
The following program was created in 1983 but has not been published
|
||||
within the meaning of the copyright law, is furnished under license,
|
||||
and may not be used, copied and/or disclosed except in accordance
|
||||
with the terms of said license.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT COMMENTCOMS)
|
||||
|
||||
(RPAQQ COMMENTCOMS ((FILES FONTPROFILE PRINTFN)))
|
||||
|
||||
(FILESLOAD FONTPROFILE PRINTFN)
|
||||
(PUTPROPS COMMENT COPYRIGHT ("Venue & Xerox Corporation" T 1983 1984 1986 1990))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL)))
|
||||
STOP
|
||||
@@ -1 +0,0 @@
|
||||
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
(FILECREATED "25-Jan-98 11:40:26" ("compiled on " {DSK}<lispcore>sources>COMMENT.;1)
"30-Mar-95 20:33:04" bcompl'd in "Medley 14-Aug-95 ..." dated "14-Aug-95 15:27:48")
(FILECREATED "16-May-90 14:57:24" {DSK}<usr>local>lde>lispcore>sources>COMMENT.;2 850 changes to%: (
VARS COMMENTCOMS) previous date%: "14-Oct-86 12:24:10" {DSK}<usr>local>lde>lispcore>sources>COMMENT.;1
)
(PRETTYCOMPRINT COMMENTCOMS)
(RPAQQ COMMENTCOMS ((FILES FONTPROFILE PRINTFN)))
(FILESLOAD FONTPROFILE PRINTFN)
(PUTPROPS COMMENT COPYRIGHT ("Venue & Xerox Corporation" T 1983 1984 1986 1990))
NIL
|
||||
@@ -1,35 +0,0 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 5-Sep-2024 22:33:36" {DSK}<home>matt>Interlisp>medley>sources>DEFPACKAGE-IMPORT.;2 1161
|
||||
|
||||
:EDIT-BY "mth"
|
||||
|
||||
:CHANGES-TO (VARS DEFPACKAGE-IMPORTCOMS)
|
||||
|
||||
:PREVIOUS-DATE "16-May-90 15:31:19"
|
||||
{DSK}<home>matt>Interlisp>medley>sources>DEFPACKAGE-IMPORT.;1)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT DEFPACKAGE-IMPORTCOMS)
|
||||
|
||||
(RPAQQ DEFPACKAGE-IMPORTCOMS ((P (IMPORT (CL:INTERN "DEFPACKAGE" "XCL")
|
||||
"INTERLISP")
|
||||
(IMPORT (CL:INTERN "DEFPACKAGE" "XCL")
|
||||
"LISP")
|
||||
(EXPORT (CL:FIND-SYMBOL "DEFPACKAGE" "LISP")
|
||||
"LISP"))
|
||||
(PROP MAKEFILE-ENVIRONMENT DEFPACKAGE-IMPORT)))
|
||||
|
||||
(IMPORT (CL:INTERN "DEFPACKAGE" "XCL")
|
||||
"INTERLISP")
|
||||
|
||||
(IMPORT (CL:INTERN "DEFPACKAGE" "XCL")
|
||||
"LISP")
|
||||
|
||||
(EXPORT (CL:FIND-SYMBOL "DEFPACKAGE" "LISP")
|
||||
"LISP")
|
||||
|
||||
(PUTPROPS DEFPACKAGE-IMPORT MAKEFILE-ENVIRONMENT (:READTABLE "INTERLISP" :PACKAGE "INTERLISP"))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL)))
|
||||
STOP
|
||||
@@ -1,17 +0,0 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 5-Sep-2024 22:35:06" ("compiled on "
|
||||
{DSK}<home>matt>Interlisp>medley>sources>DEFPACKAGE-IMPORT.;2) "31-Jul-2024 02:24:35" tcompl'd in
|
||||
"FULL 31-Jul-2024 ..." dated "31-Jul-2024 02:24:38")
|
||||
(FILECREATED " 5-Sep-2024 22:33:36" {DSK}<home>matt>Interlisp>medley>sources>DEFPACKAGE-IMPORT.;2 1161
|
||||
:EDIT-BY "mth" :CHANGES-TO (VARS DEFPACKAGE-IMPORTCOMS) :PREVIOUS-DATE "16-May-90 15:31:19"
|
||||
{DSK}<home>matt>Interlisp>medley>sources>DEFPACKAGE-IMPORT.;1)
|
||||
(PRETTYCOMPRINT DEFPACKAGE-IMPORTCOMS)
|
||||
(RPAQQ DEFPACKAGE-IMPORTCOMS ((P (IMPORT (CL:INTERN "DEFPACKAGE" "XCL") "INTERLISP") (IMPORT (CL:INTERN
|
||||
"DEFPACKAGE" "XCL") "LISP") (EXPORT (CL:FIND-SYMBOL "DEFPACKAGE" "LISP") "LISP")) (PROP
|
||||
MAKEFILE-ENVIRONMENT DEFPACKAGE-IMPORT)))
|
||||
(IMPORT (CL:INTERN "DEFPACKAGE" "XCL") "INTERLISP")
|
||||
(IMPORT (CL:INTERN "DEFPACKAGE" "XCL") "LISP")
|
||||
(EXPORT (CL:FIND-SYMBOL "DEFPACKAGE" "LISP") "LISP")
|
||||
(PUTPROPS DEFPACKAGE-IMPORT MAKEFILE-ENVIRONMENT (:READTABLE "INTERLISP" :PACKAGE "INTERLISP"))
|
||||
NIL
|
||||
@@ -1,25 +0,0 @@
|
||||
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
|
||||
(FILECREATED "16-May-90 15:42:03" {DSK}<usr>local>lde>lispcore>sources>DFILE.;2 860
|
||||
|
||||
changes to%: (VARS DFILECOMS)
|
||||
|
||||
previous date%: "15-Oct-86 07:46:09" {DSK}<usr>local>lde>lispcore>sources>DFILE.;1)
|
||||
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1982, 1983, 1984, 1985, 1986, 1990 by Venue & Xerox Corporation. All rights reserved.
|
||||
The following program was created in 1982 but has not been published
|
||||
within the meaning of the copyright law, is furnished under license,
|
||||
and may not be used, copied and/or disclosed except in accordance
|
||||
with the terms of said license.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT DFILECOMS)
|
||||
|
||||
(RPAQQ DFILECOMS ((FILES DIRECTORY SPELLFILE)))
|
||||
|
||||
(FILESLOAD DIRECTORY SPELLFILE)
|
||||
(PUTPROPS DFILE COPYRIGHT ("Venue & Xerox Corporation" T 1982 1983 1984 1985 1986 1990))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL)))
|
||||
STOP
|
||||
@@ -1 +0,0 @@
|
||||
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
(FILECREATED "25-Jan-98 12:34:23" ("compiled on " {DSK}<lispcore>sources>DFILE.;1)
"30-Mar-95 20:33:04" bcompl'd in "Medley 14-Aug-95 ..." dated "14-Aug-95 15:27:48")
(FILECREATED "16-May-90 15:42:03" {DSK}<usr>local>lde>lispcore>sources>DFILE.;2 860 changes to%: (VARS
DFILECOMS) previous date%: "15-Oct-86 07:46:09" {DSK}<usr>local>lde>lispcore>sources>DFILE.;1)
(PRETTYCOMPRINT DFILECOMS)
(RPAQQ DFILECOMS ((FILES DIRECTORY SPELLFILE)))
(FILESLOAD DIRECTORY SPELLFILE)
(PUTPROPS DFILE COPYRIGHT ("Venue & Xerox Corporation" T 1982 1983 1984 1985 1986 1990))
NIL
|
||||
1271
sources/DISKDLION
1271
sources/DISKDLION
File diff suppressed because it is too large
Load Diff
Binary file not shown.
@@ -1,103 +0,0 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
|
||||
(FILECREATED "16-May-90 18:23:44" |{DSK}<usr>local>lde>lispcore>sources>INSPECT-CLOSURE.;2| 5126
|
||||
|
||||
|changes| |to:| (VARS INSPECT-CLOSURECOMS)
|
||||
|
||||
|previous| |date:| " 3-Feb-88 15:15:04"
|
||||
|{DSK}<usr>local>lde>lispcore>sources>INSPECT-CLOSURE.;1|)
|
||||
|
||||
|
||||
; Copyright (c) 1988, 1990 by Venue & Xerox Corporation. All rights reserved.
|
||||
|
||||
(PRETTYCOMPRINT INSPECT-CLOSURECOMS)
|
||||
|
||||
(RPAQQ INSPECT-CLOSURECOMS (
|
||||
|
||||
(* |;;;| "A nicer inspector for lexical closures.")
|
||||
|
||||
(FUNCTIONS INSPECT-CLOSURE CLOSURE-PROPERTIES CLOSURE-FETCHFN
|
||||
CLOSURE-STOREFN)
|
||||
(ADDVARS (INSPECTMACROS ((FUNCTION CLOSURE-P) . INSPECT-CLOSURE)))))
|
||||
|
||||
|
||||
|
||||
(* |;;;| "A nicer inspector for lexical closures.")
|
||||
|
||||
|
||||
(CL:DEFUN INSPECT-CLOSURE (CLOSURE TYPE WHERE)
|
||||
(INSPECTW.CREATE CLOSURE (CLOSURE-PROPERTIES CLOSURE)
|
||||
'CLOSURE-FETCHFN
|
||||
'CLOSURE-STOREFN NIL NIL NIL NIL NIL NIL #'(CL:LAMBDA (PROP DATUM)
|
||||
(CL:IF (NULL (CDR PROP))
|
||||
NIL
|
||||
(CAR PROP)))))
|
||||
|
||||
(CL:DEFUN CLOSURE-PROPERTIES (CLOSURE)
|
||||
"Make up a property description for a closure."
|
||||
|
||||
(* |;;| "Does not list fields that aren't present in the closure. Tags the fields present with a dummy field, which the inspect module is kind enough to provide.")
|
||||
|
||||
(LIST* '("function" FUNCTION) (* \; "The function in the closure.")
|
||||
(CL:MAPCAN (* \;
|
||||
"Here we compute the properties from the environment.")
|
||||
#'(CL:LAMBDA (SUB-ENV-NAME SUB-ENV-GET &OPTIONAL (SUB-ENV (CL:FUNCALL SUB-ENV-GET
|
||||
(
|
||||
CLOSURE-ENVIRONMENT
|
||||
CLOSURE))))
|
||||
(CL:WHEN SUB-ENV (* \;
|
||||
"Only display if there's something in this part of the environment.")
|
||||
(LIST* `(,(CL:STRING-DOWNCASE (CL:SYMBOL-NAME SUB-ENV-NAME)))
|
||||
(* \; "Dummy field printed in middle.")
|
||||
(CL:DO ((PLIST SUB-ENV (CDDR PLIST))
|
||||
(PROP-SPECS NIL))
|
||||
((NULL PLIST)
|
||||
PROP-SPECS)
|
||||
(CL:PUSH `(,(CL:FIRST PLIST)
|
||||
,SUB-ENV-NAME)
|
||||
PROP-SPECS)))))
|
||||
'(VARS FUNCTIONS BLOCKS TAGBODIES)
|
||||
'(ENVIRONMENT-VARS ENVIRONMENT-FUNCTIONS ENVIRONMENT-BLOCKS ENVIRONMENT-TAGBODIES))))
|
||||
|
||||
(CL:DEFUN CLOSURE-FETCHFN (CLOSURE PROP)
|
||||
(COND
|
||||
((NULL (CDR PROP))
|
||||
(CAR PROP))
|
||||
((EQ (CADR PROP)
|
||||
'FUNCTION)
|
||||
(CLOSURE-FUNCTION CLOSURE))
|
||||
(T (LET (ACCESSOR)
|
||||
(CL:IF (SETQ ACCESSOR (CDR (CL:ASSOC (CADR PROP)
|
||||
'((VARS . ENVIRONMENT-VARS)
|
||||
(FUNCTIONS . ENVIRONMENT-FUNCTIONS)
|
||||
(BLOCKS . ENVIRONMENT-BLOCKS)
|
||||
(TAGBODIES . ENVIRONMENT-TAGBODIES))
|
||||
:TEST
|
||||
'EQ)))
|
||||
(CL:GETF (CL:FUNCALL ACCESSOR (CLOSURE-ENVIRONMENT CLOSURE))
|
||||
(CAR PROP)))))))
|
||||
|
||||
(CL:DEFUN CLOSURE-STOREFN (CLOSURE PROP VALUE)
|
||||
(COND
|
||||
((NULL (CDR PROP))
|
||||
NIL)
|
||||
((EQ (CADR PROP)
|
||||
'FUNCTION)
|
||||
(CL:SETF (CLOSURE-FUNCTION CLOSURE)
|
||||
VALUE))
|
||||
(T (LET (ACCESSOR)
|
||||
(CL:IF (SETQ ACCESSOR (CDR (CL:ASSOC (CADR PROP)
|
||||
'((VARS . ENVIRONMENT-VARS)
|
||||
(FUNCTIONS . ENVIRONMENT-FUNCTIONS)
|
||||
(BLOCKS . ENVIRONMENT-BLOCKS)
|
||||
(TAGBODIES . ENVIRONMENT-TAGBODIES))
|
||||
:TEST
|
||||
'EQ)))
|
||||
(LET ((PLIST (CL:FUNCALL ACCESSOR (CLOSURE-ENVIRONMENT CLOSURE))))
|
||||
(CL:SETF (CL:GETF PLIST (CAR PROP))
|
||||
VALUE)))))))
|
||||
|
||||
(ADDTOVAR INSPECTMACROS ((FUNCTION CLOSURE-P) . INSPECT-CLOSURE))
|
||||
(PUTPROPS INSPECT-CLOSURE COPYRIGHT ("Venue & Xerox Corporation" 1988 1990))
|
||||
(DECLARE\: DONTCOPY
|
||||
(FILEMAP (NIL)))
|
||||
STOP
|
||||
@@ -1 +0,0 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
(FILECREATED "25-Jan-98 14:36:09" ("compiled on " |{DSK}<lispcore>sources>INSPECT-CLOSURE.;1|)
"30-Mar-95 20:33:04" |bcompl'd| |in| "Medley 14-Aug-95 ..." |dated| "14-Aug-95 15:27:48")
(FILECREATED "16-May-90 18:23:44" |{DSK}<usr>local>lde>lispcore>sources>INSPECT-CLOSURE.;2| 5126
|changes| |to:| (VARS INSPECT-CLOSURECOMS) |previous| |date:| " 3-Feb-88 15:15:04"
|{DSK}<usr>local>lde>lispcore>sources>INSPECT-CLOSURE.;1|)
(PRETTYCOMPRINT INSPECT-CLOSURECOMS)
(RPAQQ INSPECT-CLOSURECOMS ((* |;;;| "A nicer inspector for lexical closures.") (FUNCTIONS
INSPECT-CLOSURE CLOSURE-PROPERTIES CLOSURE-FETCHFN CLOSURE-STOREFN) (ADDVARS (INSPECTMACROS ((FUNCTION
CLOSURE-P) . INSPECT-CLOSURE)))))
(CL:DEFUN INSPECT-CLOSURE (CLOSURE TYPE WHERE) (INSPECTW.CREATE CLOSURE (CLOSURE-PROPERTIES CLOSURE) (
QUOTE CLOSURE-FETCHFN) (QUOTE CLOSURE-STOREFN) NIL NIL NIL NIL NIL NIL (CL:FUNCTION (CL:LAMBDA (PROP
DATUM) (CL:IF (NULL (CDR PROP)) NIL (CAR PROP))))))
(CL:DEFUN CLOSURE-PROPERTIES (CLOSURE) "Make up a property description for a closure." (* |;;|
"Does not list fields that aren't present in the closure. Tags the fields present with a dummy field, which the inspect module is kind enough to provide."
) (LIST* (QUOTE ("function" FUNCTION)) (* \; "The function in the closure.") (CL:MAPCAN (* \;
"Here we compute the properties from the environment.") (CL:FUNCTION (CL:LAMBDA (SUB-ENV-NAME
SUB-ENV-GET &OPTIONAL (SUB-ENV (CL:FUNCALL SUB-ENV-GET (CLOSURE-ENVIRONMENT CLOSURE)))) (CL:WHEN
SUB-ENV (* \; "Only display if there's something in this part of the environment.") (LIST* (BQUOTE ((
\\\, (CL:STRING-DOWNCASE (CL:SYMBOL-NAME SUB-ENV-NAME))))) (* \; "Dummy field printed in middle.") (
CL:DO ((PLIST SUB-ENV (CDDR PLIST)) (PROP-SPECS NIL)) ((NULL PLIST) PROP-SPECS) (CL:PUSH (BQUOTE ((
\\\, (CL:FIRST PLIST)) (\\\, SUB-ENV-NAME))) PROP-SPECS)))))) (QUOTE (VARS FUNCTIONS BLOCKS TAGBODIES)
) (QUOTE (ENVIRONMENT-VARS ENVIRONMENT-FUNCTIONS ENVIRONMENT-BLOCKS ENVIRONMENT-TAGBODIES)))))
(CL:DEFUN CLOSURE-FETCHFN (CLOSURE PROP) (COND ((NULL (CDR PROP)) (CAR PROP)) ((EQ (CADR PROP) (QUOTE
FUNCTION)) (CLOSURE-FUNCTION CLOSURE)) (T (LET (ACCESSOR) (CL:IF (SETQ ACCESSOR (CDR (CL:ASSOC (CADR
PROP) (QUOTE ((VARS . ENVIRONMENT-VARS) (FUNCTIONS . ENVIRONMENT-FUNCTIONS) (BLOCKS .
ENVIRONMENT-BLOCKS) (TAGBODIES . ENVIRONMENT-TAGBODIES))) :TEST (QUOTE EQ)))) (CL:GETF (CL:FUNCALL
ACCESSOR (CLOSURE-ENVIRONMENT CLOSURE)) (CAR PROP)))))))
(CL:DEFUN CLOSURE-STOREFN (CLOSURE PROP VALUE) (COND ((NULL (CDR PROP)) NIL) ((EQ (CADR PROP) (QUOTE
FUNCTION)) (CL:SETF (CLOSURE-FUNCTION CLOSURE) VALUE)) (T (LET (ACCESSOR) (CL:IF (SETQ ACCESSOR (CDR (
CL:ASSOC (CADR PROP) (QUOTE ((VARS . ENVIRONMENT-VARS) (FUNCTIONS . ENVIRONMENT-FUNCTIONS) (BLOCKS .
ENVIRONMENT-BLOCKS) (TAGBODIES . ENVIRONMENT-TAGBODIES))) :TEST (QUOTE EQ)))) (LET ((PLIST (CL:FUNCALL
ACCESSOR (CLOSURE-ENVIRONMENT CLOSURE)))) (CL:SETF (CL:GETF PLIST (CAR PROP)) VALUE)))))))
(ADDTOVAR INSPECTMACROS ((FUNCTION CLOSURE-P) . INSPECT-CLOSURE))
(PUTPROPS INSPECT-CLOSURE COPYRIGHT ("Venue & Xerox Corporation" 1988 1990))
NIL
|
||||
1317
sources/JAPANESE
1317
sources/JAPANESE
File diff suppressed because it is too large
Load Diff
Binary file not shown.
@@ -1,23 +0,0 @@
|
||||
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
|
||||
(FILECREATED "16-May-90 20:24:51" {DSK}<usr>local>lde>lispcore>sources>MACROAUX-OPTIMIZERS.;2 766
|
||||
|
||||
changes to%: (VARS MACROAUX-OPTIMIZERSCOMS)
|
||||
|
||||
previous date%: "23-Sep-86 20:01:04" {DSK}<usr>local>lde>lispcore>sources>MACROAUX-OPTIMIZERS.;1
|
||||
)
|
||||
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1986, 1990 by Venue & Xerox Corporation. All rights reserved.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT MACROAUX-OPTIMIZERSCOMS)
|
||||
|
||||
(RPAQQ MACROAUX-OPTIMIZERSCOMS ((OPTIMIZERS EVALUABLE.CONSTANT.FIXP)))
|
||||
|
||||
(DEFOPTIMIZER EVALUABLE.CONSTANT.FIXP (X)
|
||||
`[FIXP (CAR (EVALUABLE.CONSTANTP ,X])
|
||||
(PUTPROPS MACROAUX-OPTIMIZERS COPYRIGHT ("Venue & Xerox Corporation" 1986 1990))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL)))
|
||||
STOP
|
||||
@@ -1 +0,0 @@
|
||||
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
(FILECREATED "25-Jan-98 17:37:41" ("compiled on " {DSK}<lispcore>sources>MACROAUX-OPTIMIZERS.;1)
"30-Mar-95 20:33:04" bcompl'd in "Medley 14-Aug-95 ..." dated "14-Aug-95 15:27:48")
(FILECREATED "16-May-90 20:24:51" {DSK}<usr>local>lde>lispcore>sources>MACROAUX-OPTIMIZERS.;2 766
changes to%: (VARS MACROAUX-OPTIMIZERSCOMS) previous date%: "23-Sep-86 20:01:04"
{DSK}<usr>local>lde>lispcore>sources>MACROAUX-OPTIMIZERS.;1)
(PRETTYCOMPRINT MACROAUX-OPTIMIZERSCOMS)
(RPAQQ MACROAUX-OPTIMIZERSCOMS ((OPTIMIZERS EVALUABLE.CONSTANT.FIXP)))
(DEFOPTIMIZER EVALUABLE.CONSTANT.FIXP (X) (BQUOTE (FIXP (CAR (EVALUABLE.CONSTANTP (\, X))))))
(PUTPROPS MACROAUX-OPTIMIZERS COPYRIGHT ("Venue & Xerox Corporation" 1986 1990))
NIL
|
||||
2212
sources/MOD44IO
2212
sources/MOD44IO
File diff suppressed because it is too large
Load Diff
Binary file not shown.
@@ -1,58 +0,0 @@
|
||||
(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE (DEFPACKAGE SEDIT ( USE LISP XCL)))
|
||||
(IL:FILECREATED "16-May-90 21:48:59" IL:|{DSK}<usr>local>lde>lispcore>sources>SEDIT-CONVERT.;2| 2271
|
||||
|
||||
IL:|changes| IL:|to:| (IL:VARS IL:SEDIT-CONVERTCOMS)
|
||||
|
||||
IL:|previous| IL:|date:| "17-Nov-87 16:02:51"
|
||||
IL:|{DSK}<usr>local>lde>lispcore>sources>SEDIT-CONVERT.;1|)
|
||||
|
||||
|
||||
; Copyright (c) 1987, 1990 by Venue & Xerox Corporation. All rights reserved.
|
||||
|
||||
(IL:PRETTYCOMPRINT IL:SEDIT-CONVERTCOMS)
|
||||
|
||||
(IL:RPAQQ IL:SEDIT-CONVERTCOMS ((IL:PROP IL:FILETYPE IL:SEDIT-CONVERT)
|
||||
(IL:PROP IL:MAKEFILE-ENVIRONMENT IL:SEDIT-CONVERT)
|
||||
(IL:FUNCTIONS INCOMS LOOKOLDCOM MAPINCOMS)))
|
||||
|
||||
(IL:PUTPROPS IL:SEDIT-CONVERT IL:FILETYPE :COMPILE-FILE)
|
||||
|
||||
(IL:PUTPROPS IL:SEDIT-CONVERT IL:MAKEFILE-ENVIRONMENT (:READTABLE "XCL" :PACKAGE
|
||||
(DEFPACKAGE IL:SEDIT
|
||||
(:USE IL:LISP IL:XCL))))
|
||||
|
||||
(DEFUN INCOMS (COMS PREDICATE &OPTIONAL (EDIT? T))
|
||||
(DOLIST (COM COMS)
|
||||
(WHEN (FUNCALL PREDICATE COM)
|
||||
(PRINT COM))
|
||||
(CASE (FIRST COM)
|
||||
((IL:FNS IL:FUNCTIONS IL:VARS IL:MACROS)
|
||||
(DOLIST (F (REST COM))
|
||||
(LET ((DEF (AND (ATOM F)
|
||||
(IL:NLSETQ (IL:GETDEF F (FIRST COM))))))
|
||||
(WHEN (AND DEF (FUNCALL PREDICATE (FIRST DEF)))
|
||||
(PRINT (LIST F (FIRST COM)))
|
||||
(WHEN EDIT?
|
||||
(ED F (LIST (FIRST COM)))))))))))
|
||||
|
||||
(DEFUN LOOKOLDCOM (DEF)
|
||||
(COND
|
||||
((ATOM DEF)
|
||||
NIL)
|
||||
((AND (EQ (FIRST DEF)
|
||||
'IL:*)
|
||||
(NOT (MEMBER (SECOND DEF)
|
||||
'(IL:\; IL:|;;| IL:|;;;|))))
|
||||
T)
|
||||
(T (SOME #'LOOKOLDCOM DEF))))
|
||||
|
||||
(DEFUN MAPINCOMS (PREDICATE &OPTIONAL (FILES IL:FILELST)
|
||||
(EDIT? T))
|
||||
(DOLIST (F FILES)
|
||||
(PRINT F)
|
||||
(INCOMS (FIRST (IL:GETDEF F 'IL:FILES))
|
||||
PREDICATE EDIT?)))
|
||||
(IL:PUTPROPS IL:SEDIT-CONVERT IL:COPYRIGHT ("Venue & Xerox Corporation" 1987 1990))
|
||||
(IL:DECLARE\: IL:DONTCOPY
|
||||
(IL:FILEMAP (NIL)))
|
||||
IL:STOP
|
||||
Binary file not shown.
@@ -1,132 +0,0 @@
|
||||
(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE (DEFPACKAGE SEDIT ( USE LISP XCL)))
|
||||
(IL:FILECREATED "16-May-90 21:51:00" IL:|{DSK}<usr>local>lde>lispcore>sources>SEDIT-DEBUG.;2| 6465
|
||||
|
||||
IL:|changes| IL:|to:| (IL:VARS IL:SEDIT-DEBUGCOMS)
|
||||
|
||||
IL:|previous| IL:|date:| "13-Apr-88 13:02:09"
|
||||
IL:|{DSK}<usr>local>lde>lispcore>sources>SEDIT-DEBUG.;1|)
|
||||
|
||||
|
||||
; Copyright (c) 1987, 1988, 1990 by Venue & Xerox Corporation. All rights reserved.
|
||||
|
||||
(IL:PRETTYCOMPRINT IL:SEDIT-DEBUGCOMS)
|
||||
|
||||
(IL:RPAQQ IL:SEDIT-DEBUGCOMS ((IL:PROP (IL:FILETYPE IL:MAKEFILE-ENVIRONMENT)
|
||||
IL:SEDIT-DEBUG)
|
||||
(IL:DECLARE\: IL:DONTCOPY IL:DOEVAL@COMPILE (IL:FILES
|
||||
IL:SEDIT-DECLS))
|
||||
(IL:VARS FILES)
|
||||
(IL:FUNCTIONS FNS-TO-FUNCTIONS LOADPROP-SOURCES
|
||||
DISTRIBUTE-CALL-INFO WHO-DOES)
|
||||
(IL:COMMANDS "icontext" "ienv" "ipoint" "isel" "inode")))
|
||||
|
||||
(IL:PUTPROPS IL:SEDIT-DEBUG IL:FILETYPE :COMPILE-FILE)
|
||||
|
||||
(IL:PUTPROPS IL:SEDIT-DEBUG IL:MAKEFILE-ENVIRONMENT (:READTABLE "XCL" :PACKAGE
|
||||
(DEFPACKAGE IL:SEDIT
|
||||
(:USE IL:LISP IL:XCL))))
|
||||
(IL:DECLARE\: IL:DONTCOPY IL:DOEVAL@COMPILE
|
||||
|
||||
(IL:FILESLOAD IL:SEDIT-DECLS)
|
||||
)
|
||||
|
||||
(IL:RPAQQ FILES (IL:SEDIT-DECLS IL:SEDIT IL:SEDIT-ACCESS IL:SEDIT-ATOMIC IL:SEDIT-BASE
|
||||
IL:SEDIT-COMMANDS IL:SEDIT-COMMENTS IL:SEDIT-DEBUG IL:SEDIT-EXPORTS
|
||||
IL:SEDIT-INDENT IL:SEDIT-LINEAR IL:SEDIT-LIST-FORMATS IL:SEDIT-LISTS
|
||||
IL:SEDIT-TERMINAL IL:SEDIT-TOPLEVEL IL:SEDIT-WINDOW))
|
||||
|
||||
(DEFUN FNS-TO-FUNCTIONS (SYM &OPTIONAL (EDIT? T)
|
||||
(EDITCOMS? NIL))
|
||||
|
||||
(IL:* IL:|;;;| "Sym is assumed to have a FNS definition. Give it a FUNCTIONS definition instead.")
|
||||
|
||||
(LET ((OLDDEF (IL:GETDEF SYM 'IL:FNS)))
|
||||
(UNLESS (AND OLDDEF (LISTP OLDDEF)
|
||||
(EQ (FIRST OLDDEF)
|
||||
'IL:LAMBDA))
|
||||
(ERROR "Invalid or missing FNS definition for ~S." SYM))
|
||||
(LET ((NEWDEF (COPY-TREE (LIST* 'DEFUN SYM (REST OLDDEF))))
|
||||
(FILE (IL:WHEREIS SYM 'IL:FNS)))
|
||||
(IL:PUTDEF SYM 'IL:FUNCTIONS NEWDEF 'IL:DEFINED)
|
||||
(IL:DELDEF SYM 'IL:FNS)
|
||||
(UNLESS (IL:GETDEF SYM 'IL:FUNCTIONS)
|
||||
(ERROR "The functions definition went away!"))
|
||||
(WHEN EDIT?
|
||||
(ED SYM '(IL:FUNCTIONS)))
|
||||
(WHEN (AND FILE (LISTP FILE)
|
||||
(NULL (REST FILE)))
|
||||
(IL:ADDTOFILE SYM 'IL:FUNCTIONS (FIRST FILE))
|
||||
(WHEN EDITCOMS?
|
||||
(ED (FIRST FILE)
|
||||
'(IL:FILES)))))))
|
||||
|
||||
(DEFUN LOADPROP-SOURCES ()
|
||||
(DECLARE (SPECIAL FILES))
|
||||
(DOLIST (F FILES)
|
||||
(IL:LOAD F 'IL:ALLPROP)))
|
||||
|
||||
(DEFUN DISTRIBUTE-CALL-INFO (&OPTIONAL FILE-LIST)
|
||||
(DECLARE (SPECIAL FILES))
|
||||
(IL:FOR FILE IL:INSIDE (IL:U-CASE (OR FILE-LIST FILES))
|
||||
IL:DO (IL:FOR FN IL:IN (APPEND (IL:FILECOMSLST FILE 'IL:FUNCTIONS)
|
||||
(IL:FILEFNSLST FILE)) IL:WHEN (IL:CCODEP FN)
|
||||
IL:DO (IL:BLOCK)
|
||||
(LET ((Y (IL:CALLSCCODE FN)))
|
||||
(IL:FOR Z IL:IN (CADR Y)
|
||||
IL:DO (IL:PUSHNEW (IL:GETPROP Z 'IL:CALLEDBY)
|
||||
FN))
|
||||
(IL:FOR Z IL:IN (CADDR Y)
|
||||
IL:DO (IL:PUSHNEW (IL:GETPROP Z 'IL:BOUNDBY)
|
||||
FN))
|
||||
(IL:FOR Z IL:IN (CADDDR Y)
|
||||
IL:DO (IL:PUSHNEW (IL:GETPROP Z 'IL:USEDFREEBY)
|
||||
FN))
|
||||
(IL:FOR Z IL:IN (CAR (CDDDDR Y))
|
||||
IL:DO (IL:PUSHNEW (IL:GETPROP Z 'IL:USEDGLOBALBY)
|
||||
FN))))))
|
||||
|
||||
(DEFUN WHO-DOES (METHOD-NAME)
|
||||
(LET (L FN)
|
||||
(DOLIST (TY TYPES)
|
||||
(WHEN (SETQ FN (IL:RECORDACCESS METHOD-NAME TY NIL 'IL:FETCH))
|
||||
(IL:PUSHNEW L FN)))
|
||||
L))
|
||||
|
||||
(DEFCOMMAND "icontext" (&OPTIONAL (INSPECT? T)
|
||||
(WINDOWSPEC (IL:GETPOSITION)))
|
||||
(LET ((CONTEXT (IL:WINDOWPROP (IL:WHICHW WINDOWSPEC)
|
||||
'EDIT-CONTEXT)))
|
||||
(WHEN INSPECT? (INSPECT CONTEXT))
|
||||
NIL))
|
||||
|
||||
(DEFCOMMAND "ienv" (&OPTIONAL (INSPECT? T)
|
||||
(WINDOWSPEC (IL:GETPOSITION)))
|
||||
(LET ((ENV (IL:FETCH ENVIRONMENT IL:OF (IL:WINDOWPROP (IL:WHICHW WINDOWSPEC)
|
||||
'EDIT-CONTEXT))))
|
||||
(WHEN INSPECT? (INSPECT ENV))
|
||||
ENV NIL))
|
||||
|
||||
(DEFCOMMAND "ipoint" (&OPTIONAL (INSPECT? T)
|
||||
(WINDOWSPEC (IL:GETPOSITION)))
|
||||
(LET ((POINT (IL:FETCH CARET-POINT IL:OF (IL:WINDOWPROP (IL:WHICHW WINDOWSPEC)
|
||||
'EDIT-CONTEXT))))
|
||||
(WHEN INSPECT? (INSPECT POINT))
|
||||
POINT NIL))
|
||||
|
||||
(DEFCOMMAND "isel" (&OPTIONAL (INSPECT? T)
|
||||
(WINDOWSPEC (IL:GETPOSITION)))
|
||||
(LET ((SELECTION (IL:FETCH SELECTION IL:OF (IL:WINDOWPROP (IL:WHICHW WINDOWSPEC)
|
||||
'EDIT-CONTEXT))))
|
||||
(WHEN INSPECT? (INSPECT SELECTION))
|
||||
NIL))
|
||||
|
||||
(DEFCOMMAND "inode" (&OPTIONAL (WINDOWSPEC (IL:GETPOSITION)))
|
||||
(INSPECT (IL:FETCH SELECT-NODE IL:OF (IL:FETCH SELECTION IL:OF (IL:WINDOWPROP
|
||||
(IL:WHICHW
|
||||
WINDOWSPEC)
|
||||
'EDIT-CONTEXT))))
|
||||
NIL)
|
||||
(IL:PUTPROPS IL:SEDIT-DEBUG IL:COPYRIGHT ("Venue & Xerox Corporation" 1987 1988 1990))
|
||||
(IL:DECLARE\: IL:DONTCOPY
|
||||
(IL:FILEMAP (NIL)))
|
||||
IL:STOP
|
||||
@@ -1 +0,0 @@
|
||||
(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE (DEFPACKAGE SEDIT ( USE LISP XCL)))
(IL:FILECREATED "26-Jan-98 13:33:27" ("compiled on "
IL:|{DSK}<disk>disk2>jdstools>lc3>lispcore3.0>sources>SEDIT-DEBUG.;1|) "30-Mar-95 20:33:04"
IL:|bcompl'd| IL:|in| "Medley 14-Aug-95 ..." IL:|dated| "14-Aug-95 15:27:48")
(IL:FILECREATED "16-May-90 21:51:00" IL:|{DSK}<usr>local>lde>lispcore>sources>SEDIT-DEBUG.;2| 6465
IL:|changes| IL:|to:| (IL:VARS IL:SEDIT-DEBUGCOMS) IL:|previous| IL:|date:| "13-Apr-88 13:02:09"
IL:|{DSK}<usr>local>lde>lispcore>sources>SEDIT-DEBUG.;1|)
(IL:PRETTYCOMPRINT IL:SEDIT-DEBUGCOMS)
(IL:RPAQQ IL:SEDIT-DEBUGCOMS ((IL:PROP (IL:FILETYPE IL:MAKEFILE-ENVIRONMENT) IL:SEDIT-DEBUG) (
IL:DECLARE\: IL:DONTCOPY IL:DOEVAL@COMPILE (IL:FILES IL:SEDIT-DECLS)) (IL:VARS FILES) (IL:FUNCTIONS
FNS-TO-FUNCTIONS LOADPROP-SOURCES DISTRIBUTE-CALL-INFO WHO-DOES) (IL:COMMANDS "icontext" "ienv"
"ipoint" "isel" "inode")))
(IL:PUTPROPS IL:SEDIT-DEBUG IL:FILETYPE :COMPILE-FILE)
(IL:PUTPROPS IL:SEDIT-DEBUG IL:MAKEFILE-ENVIRONMENT (:READTABLE "XCL" :PACKAGE (DEFPACKAGE IL:SEDIT (
:USE IL:LISP IL:XCL))))
(IL:RPAQQ FILES (IL:SEDIT-DECLS IL:SEDIT IL:SEDIT-ACCESS IL:SEDIT-ATOMIC IL:SEDIT-BASE IL:SEDIT-COMMANDS
IL:SEDIT-COMMENTS IL:SEDIT-DEBUG IL:SEDIT-EXPORTS IL:SEDIT-INDENT IL:SEDIT-LINEAR IL:SEDIT-LIST-FORMATS
IL:SEDIT-LISTS IL:SEDIT-TERMINAL IL:SEDIT-TOPLEVEL IL:SEDIT-WINDOW))
(DEFUN FNS-TO-FUNCTIONS (SYM &OPTIONAL (EDIT? T) (EDITCOMS? NIL)) (IL:* IL:|;;;|
"Sym is assumed to have a FNS definition. Give it a FUNCTIONS definition instead.") (LET ((OLDDEF (
IL:GETDEF SYM (QUOTE IL:FNS)))) (UNLESS (AND OLDDEF (LISTP OLDDEF) (EQ (FIRST OLDDEF) (QUOTE IL:LAMBDA
))) (ERROR "Invalid or missing FNS definition for ~S." SYM)) (LET ((NEWDEF (COPY-TREE (LIST* (QUOTE
DEFUN) SYM (REST OLDDEF)))) (FILE (IL:WHEREIS SYM (QUOTE IL:FNS)))) (IL:PUTDEF SYM (QUOTE IL:FUNCTIONS
) NEWDEF (QUOTE IL:DEFINED)) (IL:DELDEF SYM (QUOTE IL:FNS)) (UNLESS (IL:GETDEF SYM (QUOTE IL:FUNCTIONS
)) (ERROR "The functions definition went away!")) (WHEN EDIT? (ED SYM (QUOTE (IL:FUNCTIONS)))) (WHEN (
AND FILE (LISTP FILE) (NULL (REST FILE))) (IL:ADDTOFILE SYM (QUOTE IL:FUNCTIONS) (FIRST FILE)) (WHEN
EDITCOMS? (ED (FIRST FILE) (QUOTE (IL:FILES))))))))
(DEFUN LOADPROP-SOURCES NIL (DECLARE (SPECIAL FILES)) (DOLIST (F FILES) (IL:LOAD F (QUOTE IL:ALLPROP))
))
(DEFUN DISTRIBUTE-CALL-INFO (&OPTIONAL FILE-LIST) (DECLARE (SPECIAL FILES)) (IL:FOR FILE IL:INSIDE (
IL:U-CASE (OR FILE-LIST FILES)) IL:DO (IL:FOR FN IL:IN (APPEND (IL:FILECOMSLST FILE (QUOTE IL:FUNCTIONS
)) (IL:FILEFNSLST FILE)) IL:WHEN (IL:CCODEP FN) IL:DO (IL:BLOCK) (LET ((Y (IL:CALLSCCODE FN))) (IL:FOR
Z IL:IN (CADR Y) IL:DO (IL:PUSHNEW (IL:GETPROP Z (QUOTE IL:CALLEDBY)) FN)) (IL:FOR Z IL:IN (CADDR Y)
IL:DO (IL:PUSHNEW (IL:GETPROP Z (QUOTE IL:BOUNDBY)) FN)) (IL:FOR Z IL:IN (CADDDR Y) IL:DO (IL:PUSHNEW
(IL:GETPROP Z (QUOTE IL:USEDFREEBY)) FN)) (IL:FOR Z IL:IN (CAR (CDDDDR Y)) IL:DO (IL:PUSHNEW (IL:GETPROP
Z (QUOTE IL:USEDGLOBALBY)) FN))))))
(DEFUN WHO-DOES (METHOD-NAME) (LET (L FN) (DOLIST (TY TYPES) (WHEN (SETQ FN (IL:RECORDACCESS
METHOD-NAME TY NIL (QUOTE IL:FETCH))) (IL:PUSHNEW L FN))) L))
(DEFCOMMAND "icontext" (&OPTIONAL (INSPECT? T) (WINDOWSPEC (IL:GETPOSITION))) (LET ((CONTEXT (
IL:WINDOWPROP (IL:WHICHW WINDOWSPEC) (QUOTE EDIT-CONTEXT)))) (WHEN INSPECT? (INSPECT CONTEXT)) NIL))
(DEFCOMMAND "ienv" (&OPTIONAL (INSPECT? T) (WINDOWSPEC (IL:GETPOSITION))) (LET ((ENV (IL:FETCH
ENVIRONMENT IL:OF (IL:WINDOWPROP (IL:WHICHW WINDOWSPEC) (QUOTE EDIT-CONTEXT))))) (WHEN INSPECT? (
INSPECT ENV)) ENV NIL))
(DEFCOMMAND "ipoint" (&OPTIONAL (INSPECT? T) (WINDOWSPEC (IL:GETPOSITION))) (LET ((POINT (IL:FETCH
CARET-POINT IL:OF (IL:WINDOWPROP (IL:WHICHW WINDOWSPEC) (QUOTE EDIT-CONTEXT))))) (WHEN INSPECT? (
INSPECT POINT)) POINT NIL))
(DEFCOMMAND "isel" (&OPTIONAL (INSPECT? T) (WINDOWSPEC (IL:GETPOSITION))) (LET ((SELECTION (IL:FETCH
SELECTION IL:OF (IL:WINDOWPROP (IL:WHICHW WINDOWSPEC) (QUOTE EDIT-CONTEXT))))) (WHEN INSPECT? (INSPECT
SELECTION)) NIL))
(DEFCOMMAND "inode" (&OPTIONAL (WINDOWSPEC (IL:GETPOSITION))) (INSPECT (IL:FETCH SELECT-NODE IL:OF (
IL:FETCH SELECTION IL:OF (IL:WINDOWPROP (IL:WHICHW WINDOWSPEC) (QUOTE EDIT-CONTEXT))))) NIL)
(IL:PUTPROPS IL:SEDIT-DEBUG IL:COPYRIGHT ("Venue & Xerox Corporation" 1987 1988 1990))
NIL
|
||||
Reference in New Issue
Block a user