(FILECREATED "26-Mar-85 16:32:50" {ERIS}<LISPCORE>SOURCES>MSANALYZE.;6 60134Q
changes to: (VARS MSANALYZECOMS MS.VERB.TO.NOTICED) (MACROS MSVBNOTICED) (FNS CALLS NLAMBDAFNP)
previous date: "14-Aug-84 19:32:08" {ERIS}<LISPCORE>SOURCES>MSANALYZE.;3)
(* Copyright (c) 1982, 1983, 1984, 1985 by 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 MSANALYZECOMS)
(RPAQQ MSANALYZECOMS ((COMS (FNS VARS FREEVARS CALLS COLLECTFNDATA CALLS3) (VARS MSMACROPROPS (
NOPACKCALLSFLG)) (BLOCKS (CALLS CALLS COLLECTFNDATA CALLS3 (LOCALFREEVARS CALLSDATA) (NOLINKFNS . T) (
GLOBALVARS INVISIBLEVARS COMPILEUSERFN NOPACKCALLSFLG LAMBDASPLST MSRECORDTRANFLG)) (NIL VARS FREEVARS
(LOCALVARS . T))) (DECLARE: EVAL@COMPILE (VARS MS.VERB.TO.NOTICED) DONTCOPY (MACROS MSVBNOTICED))) (
COMS (FNS ALLCALLS MSINITFNDATA MSPRGE MSPRGMACRO MSPRGCALL MSBINDVAR MSPRGRECORD MSPRGERR
MSPRGTEMPLATE1 MSPRGTEMPLATE MSPRGLAMBDA MSPRGLST ADDTO NLAMBDAFNP MSPRGDWIM MSDWIMTRAN) (E (MAPC
MSFNDATA (FUNCTION RPLACD))) (VARS MSFNDATA MSERRORFN (MSRECORDTRANFLG)) (ADDVARS (INVISIBLEVARS $$1
$$2 $$3 $$4 $$5 $$6 $$7 $$8 $$9 $$10 $$11 $$12 $$13 $$14 $$15 $$16 $$17)) (DECLARE: DONTCOPY (MACROS
INCLISP LTEMPLATE)) (BLOCKS (ALLCALLS ALLCALLS ADDTO MSBINDVAR MSDWIMTRAN MSPRGCALL MSPRGDWIM MSPRGE
MSPRGMACRO MSPRGERR MSPRGLAMBDA MSPRGLST MSPRGRECORD MSPRGTEMPLATE MSPRGTEMPLATE1 NLAMBDAFNP (
NOLINKFNS . T) (LOCALFREEVARS FNNAME ERRORS FNDEF INCLISP ONLYRELS PARENTCONTEXT TOPVARS PARENT
EACHTIME VARS) (GLOBALVARS CLISPARRAY MSERRORFN MSRECORDTRANFLG MSFNDATA INVISIBLEVARS CLISPARRAY
MSTEMPLATES USERTEMPLATES MSRECORDTRANFLG NLAMA NLAML DWIMFLG CLISPTRANFLG NOSPELLFLG DWIMESSGAG
FILEPKGFLG) (NOLINKFNS . T)) (NIL MSINITFNDATA NLAMBDAFNP MSPRGDWIM (LOCALVARS . T) (GLOBALVARS NLAMA
NLAML MSFNDATA DWIMFLG NOSPELLFLG DWIMESSGAG FILEPKGFLG))) (P (PUTDQ? MSWORDNAME (LAMBDA (X) X)))) (
COMS (VARS (MSTEMPLATES (HASHARRAY 240Q)) (USERTEMPLATES (HASHARRAY 12Q))) (FILEVARS INITIALTEMPLATES)
(* * INITIALTEMPLATES is not needed after loading up) (P (MAPC INITIALTEMPLATES (FUNCTION (LAMBDA (X)
(MAPC (CDR X) (FUNCTION (LAMBDA (Y) (PUTHASH Y (CAR X) MSTEMPLATES)))))))) (DECLARE: EVAL@COMPILE
DONTCOPY (PROP MACRO LTEMPLATE))) (COMS (FNS MSFINDP) (BLOCKS (MSFINDP MSFINDP)))))
(DEFINEQ
(VARS
(LAMBDA (FN USEDATABASE) (* lmm: 29-DEC-75 27Q 26Q) (CDR (CALLS FN USEDATABASE T))))
(FREEVARS
(LAMBDA (FN USEDATABASE) (* lmm: 5-DEC-75 13Q 10Q) (CADDR (CALLS FN USEDATABASE (QUOTE FREEVARS)))))
(CALLS
(LAMBDA (EXPR USEDATABASE VARSFLG) (* rmk: " 1-AUG-79 09:55") (PROG (FREES FNDEF FLG) (COND ((AND
USEDATABASE (LITATOM EXPR) (GETD (QUOTE UPDATEFN))) (UPDATEFN EXPR NIL (QUOTE ERROR)) (RETURN (LIST (
AND (NOT VARSFLG) (GETRELATION EXPR (QUOTE (CALL NOTERROR)))) (AND (NEQ VARSFLG (QUOTE FREEVARS)) (
GETRELATION EXPR (QUOTE BIND))) (GETRELATION EXPR (QUOTE (USE FREELY))))))) GETDLP (SETQ FNDEF (COND (
(LITATOM EXPR) (OR (GETD (OR (GETP EXPR (QUOTE BROKEN)) EXPR)) (GETP EXPR (QUOTE EXPR)) (AND (NEQ EXPR
(SETQ EXPR (FNCHECK EXPR NIL NIL T))) (GO GETDLP)))) (T EXPR))) (RETURN (COND ((NULL FNDEF) NIL) ((
SUBRP FNDEF) NIL) ((CCODEP FNDEF) (SETQ FNDEF (CALLSCCODE FNDEF)) (OR NOPACKCALLSFLG (for X on (CAR
FNDEF) do (FRPLACA X (PACK* (QUOTE ;) (CAR X) (QUOTE ;))))) (FRPLACA (CDR FNDEF) (NCONC (CADR FNDEF) (
CAR FNDEF))) (SETQ FLG) (CALLS3 (CDDR FNDEF)) (CALLS3 (CDDDR FNDEF)) (CDR FNDEF)) ((EXPRP FNDEF) (*
Note that EXPR can be a piece of a function definition, and calls will still work.) (RESETVARS ((
MSRECORDTRANFLG T)) (RETURN (PROG (CALLSDATA LAMFLG) (COND ((FMEMB (CAR FNDEF) LAMBDASPLST) (SETQ
LAMFLG T) (COND ((OR (AND (EQ (CAR (CADDR FNDEF)) (QUOTE *)) (EQ (CADR (CADDR FNDEF)) (QUOTE
DECLARATIONS:))) (EQ (CAR (CADDR FNDEF)) (QUOTE CLISP:))) (MSPRGDWIM FNDEF EXPR FNDEF))) (SELECTQ (CAR
FNDEF) ((LAMBDA NLAMBDA) NIL) (SETQ FNDEF (OR (AND COMPILEUSERFN (APPLY* COMPILEUSERFN NIL FNDEF))
FNDEF))))) (SETQ CALLSDATA (ALLCALLS FNDEF LAMFLG (UNION (CONSTANT (MSVBNOTICED (QUOTE USE) (QUOTE
FREELY))) (AND (NEQ VARSFLG (QUOTE FREEVARS)) (UNION (CONSTANT (MSVBNOTICED (QUOTE BIND))) (AND (NULL
VARSFLG) (CONSTANT (MSVBNOTICED (QUOTE CALL) (QUOTE NOTERROR))))))) EXPR T)) (SETQ FREES (NCONC FREES
(COLLECTFNDATA (CONSTANT (MSVBNOTICED (QUOTE USE) (QUOTE FREELY)))))) (RETURN (LIST (COLLECTFNDATA (
CONSTANT (MSVBNOTICED (QUOTE CALL) (QUOTE NOTERROR)))) (COLLECTFNDATA (CONSTANT (MSVBNOTICED (QUOTE
BIND)))) FREES)))))) (T (QUOTE ?)))))))
(COLLECTFNDATA
(LAMBDA (LST) (* lmm "21-DEC-78 22:56") (COND ((NLISTP LST) (CDR (FASSOC LST CALLSDATA))) (T (PROG (
VAL) (for X in LST do (SETQ VAL (UNION (COLLECTFNDATA X) VAL))) (RETURN VAL))))))
(CALLS3
(LAMBDA (LST) (* lmm " 6-JUL-78 00:23") (* lmm: 13-DEC-75 4 63Q) (PROG (FLG) (for X on (CAR LST) do (
OR (NOT (FMEMB (CAR X) INVISIBLEVARS)) (SETQ FLG (FRPLACA X)))) (COND (FLG (FRPLACA LST (DREMOVE NIL (
CAR LST))))))))
)
(RPAQQ MSMACROPROPS (DMACRO ALTOMACRO BYTEMACRO MACRO))
(RPAQQ NOPACKCALLSFLG NIL)
[DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY
(BLOCK: CALLS CALLS COLLECTFNDATA CALLS3 (LOCALFREEVARS CALLSDATA) (NOLINKFNS . T) (GLOBALVARS
INVISIBLEVARS COMPILEUSERFN NOPACKCALLSFLG LAMBDASPLST MSRECORDTRANFLG))
(BLOCK: NIL VARS FREEVARS (LOCALVARS . T))
]
(DECLARE: EVAL@COMPILE
(RPAQQ MS.VERB.TO.NOTICED ((BIND (NIL BIND ARG)) (CALL (DIRECTLY CALL EFFECT PREDICATE NLAMBDA) (
EFFECT EFFECT) (INDIRECTLY APPLY STACK) (NIL CALL ERROR APPLY EFFECT PREDICATE NLAMBDA STACK) (
NOTERROR APPLY CALL EFFECT PREDICATE NLAMBDA STACK) (PREDICATE PREDICATE) (TESTING PREDICATE) (VALUE
CALL) (NLAMBDA NLAMBDA)) (CREATE (NIL CREATE)) (DECLARE (LOCALVARS LOCALVARS) (NIL LOCALVARS SPECVARS)
(SPECVARS SPECVARS)) (FETCH (NIL FETCH)) (REFERENCE (FIELDS FETCH) (FREELY REFFREE) (LOCALLY REF) (
NIL REFFREE REF)) (REPLACE (NIL REPLACE)) (SET (FIELDS FETCH REPLACE) (FREELY SETFREE) (LOCALLY SET) (
NIL SETFREE SET)) (SMASH (FIELDS FETCH REPLACE) (FREELY SMASHFREE) (LOCALLY SMASH) (NIL SMASHFREE
SMASH)) (TEST (FREELY TESTFREE) (LOCALLY TEST) (NIL TESTFREE TEST)) (USE (FIELDS FETCH REPLACE) (
FREELY SETFREE SMASHFREE REFFREE TESTFREE) (I.S.OPRS CLISP) (INDIRECTLY LOCALFREEVARS) (LOCALLY SET
SMASH REF TEST) (NIL SETFREE SET SMASHFREE SMASH REFFREE REF TESTFREE TEST) (PREDICATE TEST TESTFREE)
(PROPNAMES PROP) (RECORDS RECORD CREATE) (TESTING TEST TESTFREE) (VALUE SMASH SMASHFREE REF REFFREE) (
TYPE TYPE))))
DONTCOPY
(DECLARE: EVAL@COMPILE
(PUTPROPS MSVBNOTICED MACRO (OPENLAMBDA (VERB MOD) (CDR (ASSOC MOD (CDR (ASSOC VERB MS.VERB.TO.NOTICED
))))))
)
)
(DEFINEQ
(ALLCALLS
(LAMBDA (FNDEF LAMFLG ONLYRELS FNNAME INTERNALFLG EACHTIME) (* lmm "22-DEC-78 13:02") (PROG (VARS
TOPVARS INCLISP ERRORS (PARENT FNDEF)) (MSINITFNDATA) (COND (LAMFLG (MSPRGLAMBDA FNDEF (QUOTE ARG))) (
T (MSPRGE FNDEF NIL (QUOTE RETURN)))) (RETURN (COND (INTERNALFLG MSFNDATA) (T (for X in MSFNDATA when
(CDR X) collect (CONS (CAR X) (CDR X)))))))))
(MSINITFNDATA
(LAMBDA NIL (* MSFNDATA is an association list of the "noticed" types, e.g. CALL, BIND, etc. -- the
FRPLACD resets the pointer) (for Y in MSFNDATA do (FRPLACD Y NIL))))
(MSPRGE
(LAMBDA (EXPR SUPEXPR EVALCONTEXT) (* lmm "13-DEC-82 23:46") (* analyzes EXPR; SUPEXPR is the parent
expression and is used in the SHOWUSE case where we are printing occurrances of various things rather
than updating data base; EVALCONTEXT is a type of reference for this expression from the template:
SMASH etc) (PROG (TEM CALLED CLISP) (COND ((NLISTP EXPR) (RETURN (COND ((AND (LITATOM EXPR) EXPR (NEQ
EXPR T) (NOT (FMEMB EXPR INVISIBLEVARS))) (* A variable reference) (COND ((OR (FMEMB EXPR VARS) (SOME
TOPVARS (FUNCTION (LAMBDA (Z) (* bound higher up in the function but but used in a functional argument
) (COND ((FMEMB EXPR Z) (ADDTO (QUOTE LOCALFREEVARS) EXPR SUPEXPR) T)))))) (* Things were added to
VARS only if they were "noticeable") (SELECTQ EVALCONTEXT ((SMASH TEST SET) (ADDTO EVALCONTEXT EXPR
SUPEXPR)) (CHANGE (ADDTO (QUOTE SET) EXPR SUPEXPR)) (ADDTO (QUOTE REF) EXPR SUPEXPR))) (T (SELECTQ
EVALCONTEXT (SMASH (ADDTO (QUOTE SMASHFREE) EXPR SUPEXPR)) (TEST (ADDTO (QUOTE TESTFREE) EXPR SUPEXPR)
) ((SET CHANGE) (ADDTO (QUOTE SETFREE) EXPR SUPEXPR)) (ADDTO (QUOTE REFFREE) EXPR SUPEXPR))))))))) (
COND ((EQ EVALCONTEXT (QUOTE SET)) (* in a "SET" context, but not a variable) (MSPRGERR PARENT))) (
COND ((LISTP (SETQ CALLED (CAR EXPR))) (MSPRGLAMBDA CALLED NIL (SELECTQ EVALCONTEXT ((TEST EFFECT
SMASH) EVALCONTEXT) NIL)) (SELECTQ (CAR CALLED) (LAMBDA (MSPRGLST (CDR EXPR) EXPR)) NIL) (RETURN))) (
COND ((SETQ TEM (LTEMPLATE CALLED)) (RETURN (MSPRGTEMPLATE EXPR TEM EVALCONTEXT)))) (COND ((NOT (FGETD
(OR (GETP CALLED (QUOTE BROKEN)) CALLED))) (COND ((AND DWIMFLG (SETQ TEM (GETPROP CALLED (QUOTE
CLISPWORD)))) (* E.G. IF, FOR, etc.) (SETQ CLISP (MSDWIMTRAN EXPR)) (RETURN (COND (CLISP (COND (TEM (
SELECTQ (CAR TEM) (RECORDTRAN (OR (MSPRGRECORD EXPR EVALCONTEXT) MSRECORDTRANFLG (RETURN)) (*
optionally also look at translation)) (IFWORD) (CHANGETRAN (MSPRGE (CADR EXPR) EXPR (QUOTE CHANGE))) (
for X in EXPR when (AND (LITATOM X) (EQ (CAR TEM) (CAR (GETPROP X (QUOTE CLISPWORD))))) do (ADDTO (
QUOTE CLISP) X EXPR))))) (* Analyze the CLISP translation) (PROG ((INCLISP (INCLISP EXPR))) (MSPRGE
CLISP EXPR EVALCONTEXT))) ((OR (NULL (GETPROP (CAR EXPR) (QUOTE CLISPWORD))) (NEQ (CAR EXPR) CALLED))
(RETURN (MSPRGE EXPR SUPEXPR EVALCONTEXT))) (T (SELECTQ (CAR TEM) (RECORDTRAN (MSPRGRECORD EXPR
EVALCONTEXT)) (CHANGETRAN (MSPRGE (CADR EXPR) EXPR (QUOTE CHANGE)) (MSPRGLST (CDDR EXPR) EXPR)) (PROGN
(* CLISP word wouldn't DWIMIFY) (MSPRGCALL CALLED EXPR EVALCONTEXT) (MSPRGERR EXPR) (MSPRGLST (CDR
EXPR) EXPR))))))) ((AND MSMACROPROPS (SETQ TEM (GETMACROPROP CALLED MSMACROPROPS)) (MSPRGMACRO EXPR
TEM EVALCONTEXT)) (RETURN))))) (COND ((NLAMBDAFNP CALLED) (ADDTO (QUOTE NLAMBDA) CALLED EXPR) (COND ((
AND MSMACROPROPS (SETQ TEM (GETMACROPROP CALLED MSMACROPROPS)) (MSPRGMACRO EXPR TEM EVALCONTEXT)) (
RETURN))) (MSPRGCALL CALLED EXPR EVALCONTEXT)) (T (* normal lambda function call) (MSPRGCALL CALLED
EXPR EVALCONTEXT) (MSPRGLST (CDR EXPR) EXPR (QUOTE EVAL)))))))
(MSPRGMACRO
(LAMBDA (FORM MACDEF CONTEXT) (* lmm "13-DEC-82 23:45") (PROG ((ME (MACROEXPANSION FORM MACDEF))) (
COND ((AND (NOT (EQUAL ME FORM)) (NOT (EQUAL ME INCLISP))) (MSPRGCALL (CAR FORM) FORM CONTEXT) (PROG (
(INCLISP (INCLISP FORM)) (EXPR FORM)) (MSPRGE ME FORM (QUOTE EVAL))) (RETURN T))))))
(MSPRGCALL
(LAMBDA (FN PRNT CONTEXT) (* lmm "22-DEC-78 12:57") (ADDTO (COND (TOPVARS (QUOTE APPLY)) (T (SELECTQ
CONTEXT (TEST (QUOTE PREDICATE)) (EFFECT (QUOTE EFFECT)) (QUOTE CALL)))) FN PRNT)))
(MSBINDVAR
(LAMBDA (VAR TYPE EXPR) (* lmm " 6-JUL-78 00:23") (COND ((AND VAR (LITATOM VAR) (NEQ VAR T)) (COND ((
NOT (FMEMB VAR INVISIBLEVARS)) (ADDTO (OR TYPE (QUOTE BIND)) VAR (OR EXPR PARENT)))) (SETQ VARS (CONS
VAR VARS))) (T (MSPRGERR (COND ((LITATOM VAR) (OR EXPR PARENT)) (T VAR)))))))
(MSPRGRECORD
(LAMBDA (PRNT CNTXT) (* lmm "25-FEB-82 11:24") (* ANALYZE RECORD EXPRESSION PRNT - RETURN NIL IF
ANALYZED SUCCESSFULLY) (PROG (Z) (MSPRGTEMPLATE PRNT (SELECTQ (CAR PRNT) ((create CREATE) (ADDTO (
QUOTE CREATE) (CADR PRNT) PRNT) (SETQ Z (CDDR PRNT)) (while Z do (COND ((EQ (QUOTE RECORDTRAN) (CAR (
GETPROP (CAR Z) (QUOTE CLISPWORD)))) (* e.g. USING or COPYING) (MSPRGE (CADR Z) PRNT (SELECTQ (CAR Z)
((smashing SMASHING) (QUOTE SMASH)) NIL)) (SETQ Z (CDDR Z))) ((EQ (CADR Z) (QUOTE ←)) (* If dwimified
correctly, the fields should be separated by ←'s) (ADDTO (QUOTE REPLACE) (CAR Z) PRNT) (MSPRGE (CADDR
Z) PRNT) (SETQ Z (CDDDR Z))) ((EQ (CAAR Z) (QUOTE SETQ)) (* partially dwimified) (ADDTO (QUOTE REPLACE
) (CADAR Z) PRNT) (MSPRGE (CADDAR Z) PRNT) (SETQ Z (CDR Z))) (T (* shouldn't happen, but) (MSPRGE (CAR
Z) PRNT) (SETQ Z (CDR Z))))) (RETURN)) ((fetch FETCH ffetch FFETCH) (COND ((EQ CNTXT (QUOTE CHANGE))
(QUOTE (NIL (IF LISTP (BOTH (NIL .. FETCH (BOTH FETCH REPLACE)) (.. RECORD NIL)) (BOTH FETCH REPLACE))
NIL EVAL))) (T (QUOTE (NIL (IF LISTP (BOTH (NIL .. FETCH) (.. RECORD NIL)) FETCH) NIL EVAL))))) ((
REPLACE /REPLACE replace /replace freplace FREPLACE) (QUOTE (NIL (IF LISTP (BOTH (NIL .. FETCH REPLACE
) (.. RECORD NIL)) REPLACE) NIL SMASH NIL EVAL))) ((type? TYPE?) (QUOTE (CLISP RECORD EVAL . PPE))) ((
initrecord INITRECORD) (QUOTE (CLISP RECORD . PPE))) ((WITH with) (COND ((SETQ Z (RECORDFIELDNAMES (
CADR PRNT))) (ADDTO (QUOTE RECORD) (CADR PRNT) PRNT) (MSPRGE (CADDR PRNT) PRNT) (for X in (PROG1 (for
X on MSFNDATA when (FMEMB (CAAR X) (QUOTE (SETFREE TESTFREE REFFREE))) collect (LIST (CAR X) (RPLACA X
(LIST (CAAR X))))) (PROG (ONLYRELS (EACHTIME (AND EACHTIME (for X inside (PROGN EACHTIME) when (NOT (
FMEMB X (QUOTE (SETFREE TESTFREE REFFREE)))) collect X)))) (MSPRGLST (CDDDR PRNT) PRNT))) do (for Y in
(PROG1 (CDR (CAADR X)) (RPLACA (CADR X) (CAR X))) do (ADDTO (COND ((FMEMB Y Z) (SELECTQ (CAAR X) (
SETFREE (QUOTE REPLACE)) (QUOTE FETCH))) (T (CAAR X))) Y PRNT))) (RETURN)) (T (QUOTE (RECORD .. EVAL))
))) (RETURN T))))))
(MSPRGERR
(LAMBDA (EXPR) (* lmm "21-DEC-78 22:44") (SETQ ERRORS T) (ADDTO (QUOTE ERROR) MSERRORFN EXPR)))
(MSPRGTEMPLATE1
(LAMBDA (X TEMPLATE) (* lmm " 6-APR-82 21:35") (COND ((NLISTP TEMPLATE) (SELECTQ TEMPLATE ((EVAL SMASH
TEST EFFECT SET) (MSPRGE X PARENT TEMPLATE)) ((FUNCTION FUNCTIONAL) (* This is a functional arg to
something - the marker FUNCTIONAL means that it will be a separate function while FUNCTION is reserved
for those things which compile open - e.g. MAPC is marked (EVAL FUNCTION FUNCTION . PPE) while SORT
is marked (EVAL FUNCTIONAL . PPE)) (OR (COND ((AND (LISTP X) (NULL (CDDR X))) (COND ((EQ (CAR X) (
QUOTE F/L)) (MSPRGDWIM X FNNAME FNDEF))) (SELECTQ (CAR X) ((FUNCTION QUOTE) (MSPRGTEMPLATE (CADR X) (
COND ((LISTP (CADR X)) (SELECTQ TEMPLATE (FUNCTIONAL (QUOTE (REMOTE LAMBDA))) (QUOTE LAMBDA))) ((OR (
NEQ (CAR X) (QUOTE FUNCTION)) (EQ TEMPLATE (QUOTE FUNCTIONAL))) (QUOTE (REMOTE CALL))) (T (QUOTE CALL)
)) X) T) NIL))) (EQ X T) (NULL X) (PROGN (* arbitrary expression as functional argument) (ADDTO (QUOTE
ERROR) (QUOTE apply) PARENT) (MSPRGE X PARENT (QUOTE FUNCTIONAL))))) (STACK (* arg to stack fn, e.g.
RETFROM) (OR (AND (LISTP X) (SELECTQ (CAR X) ((FUNCTION QUOTE) (ADDTO (QUOTE STACK) (CADR X) PARENT) T
) NIL)) (PROGN (ADDTO (QUOTE ERROR) (QUOTE stackfn) PARENT) (MSPRGE X PARENT (QUOTE EVAL))))) (PROP (
COND ((AND (LISTP X) (EQ (CAR X) (QUOTE QUOTE))) (for Y inside (CADR X) do (ADDTO (QUOTE PROP) Y
PARENT))) (T (MSPRGE X PARENT TEMPLATE)))) (NIL (* not used) NIL) (RETURN (* this is sometimes the
value of PARENT expression) (MSPRGTEMPLATE1 X (SELECTQ PARENTCONTEXT ((TEST EFFECT) PARENTCONTEXT) (
QUOTE EVAL)))) (TESTRETURN (* if PARENT is tested, then so is this) (MSPRGTEMPLATE1 X (SELECTQ
PARENTCONTEXT (TEST PARENTCONTEXT) (QUOTE EVAL)))) (BIND (MSBINDVAR X)) (LAMBDA (MSPRGLAMBDA X)) (PPE
(* paren error if not NIL) (COND (X (MSPRGERR PARENT) (MSPRGLST X PARENT)))) (CALL (MSPRGCALL X PARENT
PARENTCONTEXT)) (EVALQT (COND ((EQ (CAR X) (QUOTE QUOTE)) (MSPRGTEMPLATE (CADR X) (QUOTE (REMOTE EVAL
)) PARENT)) (T (MSPRGE X PARENT (QUOTE EVAL))))) (ADDTO TEMPLATE X PARENT T))) (T (SELECTQ (CAR
TEMPLATE) (IF (PROG ((EXPR X)) (DECLARE (SPECVARS EXPR)) (MSPRGTEMPLATE1 X (COND ((COND ((LISTP (CADR
TEMPLATE)) (* ASSERT: ((REMOTE EVAL) EXPR)) (EVAL (CADR TEMPLATE))) (T (APPLY* (CADR TEMPLATE) X))) (
CADDR TEMPLATE)) (T (CADDDR TEMPLATE)))))) (.. (COND ((AND (CADR TEMPLATE) (NULL (CDDR TEMPLATE))) (*
Special case to handle most common cases) (MAPC X (FUNCTION (LAMBDA (X) (MSPRGTEMPLATE1 X (CADR
TEMPLATE)))))) (T (FRPTQ (IDIFFERENCE (LENGTH X) (LENGTH (CDDR TEMPLATE))) (MSPRGTEMPLATE1 (CAR X) (
CADR TEMPLATE)) (SETQ X (CDR X))) (MSPRGTEMPLATE1 X (CDDR TEMPLATE))))) (MACRO (ADDTO (QUOTE CALL) (
CAR X) PARENT) (MSPRGMACRO X (CDR TEMPLATE))) (BOTH (MSPRGTEMPLATE1 X (CADR TEMPLATE)) (MSPRGTEMPLATE1
X (CADDR TEMPLATE))) (@ (PROG ((EXPR X)) (DECLARE (SPECVARS EXPR)) (MSPRGTEMPLATE1 (EVAL (CADR
TEMPLATE)) (EVAL (CADDR TEMPLATE))))) (REMOTE (PROG (VARS (TOPVARS (CONS VARS TOPVARS))) (
MSPRGTEMPLATE1 X (CADR TEMPLATE)))) (COND ((LISTP X) (MSPRGTEMPLATE1 (CAR X) (CAR TEMPLATE)) (
MSPRGTEMPLATE1 (CDR X) (CDR TEMPLATE)))))))))
(MSPRGTEMPLATE
(LAMBDA (PARENT TEMPLATE PARENTCONTEXT) (* lmm "21-MAY-82 23:39") (PROG ((VARS VARS) TEM) (COND ((EQ
TEMPLATE (QUOTE MACRO)) (COND ((SETQ TEM (GETMACROPROP (CAR PARENT) MSMACROPROPS)) (MSPRGMACRO PARENT
TEM)) (T (MSPRGTEMPLATE1 PARENT (QUOTE (CALL .. EVAL)))))) (T (MSPRGTEMPLATE1 PARENT TEMPLATE))))))
(MSPRGLAMBDA
(LAMBDA (EXPR FLG TYPE) (* DD: "28-Dec-81 10:41") (SELECTQ (CAR (LISTP EXPR)) ((LAMBDA NLAMBDA) (
MSPRGTEMPLATE EXPR (QUOTE (NIL (IF LISTP (.. BIND) (IF (PROGN EXPR) BIND)) .. EFFECT RETURN)) TYPE)) (
PROG (CLISP) (COND ((AND DWIMFLG (SETQ CLISP (MSDWIMTRAN EXPR))) (* has a CLISP translation (e.g.
DLAMBDA)) (PROG ((INCLISP (INCLISP EXPR))) (* rebind INCLISP, and try again on the translation) (
MSPRGLAMBDA CLISP FLG TYPE))) (T (MSPRGERR EXPR) (MSPRGE EXPR)))))))
(MSPRGLST
(LAMBDA (L PARNT CNTX) (* lmm "27-JUN-78 01:57") (for X in L do (MSPRGE X PARNT CNTX))))
(ADDTO
(LAMBDA (RELATION WHAT PRNT FLG) (* lmm "24-DEC-78 11:51") (PROG ((PTR (FASSOC RELATION MSFNDATA))) (
OR PTR (COND (FLG (RETURN)) (T (SHOULDNT)))) (OR (NULL ONLYRELS) (FMEMB RELATION ONLYRELS) (RETURN)) (
AND EACHTIME (EQMEMB RELATION (CAR EACHTIME)) (APPLY* (CADR EACHTIME) WHAT (CADDR EACHTIME) (CADDDR
EACHTIME) PRNT INCLISP)) LP (COND ((NULL (CDR PTR)) (FRPLACD PTR (LIST WHAT))) ((EQ (CAR (SETQ PTR (
CDR PTR))) WHAT) (RETURN)) (T (GO LP))))))
(NLAMBDAFNP
(LAMBDA (FN) (* lmm "26-Mar-85 12:37") (AND (NOT (EQMEMB (QUOTE EVAL) (GETPROP FN (QUOTE INFO)))) (
COND ((OR (FGETD (SETQ FN (OR (GETPROP FN (QUOTE BROKEN)) FN))) (SETQ FN (GETLIS FN (QUOTE (EXPR CODE)
)))) (* if the function is defined, check its argtype to tell you whether it is NLAMBDA or LAMBDA) (
SELECTQ (ARGTYPE FN) ((1 3) T) NIL)) (T (* otherwise, rely on NLAMA or NLAML) (OR (FMEMB FN NLAMA) (
FMEMB FN NLAML)))))))
(MSPRGDWIM
(LAMBDA (X FN DEF) (* lmm "24-DEC-78 14:36") (AND DWIMFLG (RESETVARS ((NOSPELLFLG T) (DWIMESSGAG T)
FILEPKGFLG) (PROG (LISPXHIST) (* ASSERT: ((REMOTE EVAL) DWIMESSGAG FILEPKGFLG NOSPELLFLG)) (DWIMIFY0 X
(OR (AND (LITATOM FN) FN) (QUOTE ?)) VARS DEF))))))
(MSDWIMTRAN
(LAMBDA (EXPR) (* DD: "28-DEC-81 13:46") (AND DWIMFLG (COND ((AND CLISPARRAY (GETHASH EXPR CLISPARRAY)
)) ((AND CLISPTRANFLG (EQ (CAR (LISTP EXPR)) CLISPTRANFLG)) (CADR EXPR)) (T (MSPRGDWIM EXPR FNNAME
FNDEF) (OR (AND CLISPARRAY (GETHASH EXPR CLISPARRAY)) (AND CLISPTRANFLG (EQ (CAR (LISTP EXPR))
CLISPTRANFLG) (CADR EXPR))))))))
)
(RPAQQ MSFNDATA ((BIND) (CALL) (EFFECT) (PREDICATE) (CLISP) (PROP) (SETFREE) (SET) (SMASHFREE) (SMASH)
(REFFREE) (REF) (FETCH) (REPLACE) (RECORD) (ERROR) (ARG) (CREATE) (LOCALVARS) (SPECVARS) (APPLY) (
TESTFREE) (TEST) (LOCALFREEVARS) (NLAMBDA) (TYPE) (STACK)))
(RPAQQ MSERRORFN ppe)
(RPAQQ MSRECORDTRANFLG NIL)
(ADDTOVAR INVISIBLEVARS $$1 $$2 $$3 $$4 $$5 $$6 $$7 $$8 $$9 $$10 $$11 $$12 $$13 $$14 $$15 $$16 $$17)
(DECLARE: DONTCOPY
(DECLARE: EVAL@COMPILE
(PUTPROPS INCLISP MACRO ((.X.) (COND ((AND INCLISP EACHTIME (NOT (MSFINDP INCLISP .X.))) INCLISP) (T
.X.))))
(PUTPROPS LTEMPLATE MACRO (LAMBDA (Y) (DECLARE (LOCALVARS Y)) (AND (NEQ T (SETQ Y (OR (GETHASH Y
USERTEMPLATES) (GETHASH Y MSTEMPLATES)))) Y)))
)
)
[DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY
(BLOCK: ALLCALLS ALLCALLS ADDTO MSBINDVAR MSDWIMTRAN MSPRGCALL MSPRGDWIM MSPRGE MSPRGMACRO MSPRGERR
MSPRGLAMBDA MSPRGLST MSPRGRECORD MSPRGTEMPLATE MSPRGTEMPLATE1 NLAMBDAFNP (NOLINKFNS . T) (
LOCALFREEVARS FNNAME ERRORS FNDEF INCLISP ONLYRELS PARENTCONTEXT TOPVARS PARENT EACHTIME VARS) (
GLOBALVARS CLISPARRAY MSERRORFN MSRECORDTRANFLG MSFNDATA INVISIBLEVARS CLISPARRAY MSTEMPLATES
USERTEMPLATES MSRECORDTRANFLG NLAMA NLAML DWIMFLG CLISPTRANFLG NOSPELLFLG DWIMESSGAG FILEPKGFLG) (
NOLINKFNS . T))
(BLOCK: NIL MSINITFNDATA NLAMBDAFNP MSPRGDWIM (LOCALVARS . T) (GLOBALVARS NLAMA NLAML MSFNDATA DWIMFLG
NOSPELLFLG DWIMESSGAG FILEPKGFLG))
]
(PUTDQ? MSWORDNAME (LAMBDA (X) X))
(RPAQ MSTEMPLATES (HASHARRAY 240Q))
(RPAQ USERTEMPLATES (HASHARRAY 12Q))
(RPAQQ INITIALTEMPLATES (((CALL (REMOTE (IF LITATOM CALL LAMBDA)) (IF LITATOM EVAL NIL)) FUNCTION) ((
IF (EQ (CADR EXPR) (QUOTE ASSERT:)) (NIL NIL .. (IF LISTP (@ (CDR EXPR) (LIST (QUOTE ..) (MSWORDNAME (
CAR EXPR))))))) *) ((NIL (BOTH (.. (IF LISTP (NIL EVAL .. EFFECT) NIL)) (.. (IF LISTP (BIND) BIND)))
.. (IF LISTP EFFECT)) PROG) (MACRO RESETVARS) ((CALL EVAL) XNLSETQ NLSETQ ERSETQ) ((CALL .. EVAL)
RESETFORM FRPTQ) ((CALL EVAL EVAL FUNCTIONAL FUNCTIONAL . PPE) MAP2C) ((CALL EVAL EVAL SMASH . PPE)
/DSUBST DSUBST) ((CALL EVAL FUNCTION FUNCTION . PPE) MAPCAR MAPCON MAPCONC MAPLIST SUBSET EVERY
NOTEVERY ANY NOTANY SOME MAPC MAP) ((CALL EVAL FUNCTIONAL . PPE) MAPHASH) ((CALL EVAL PROP . PPE) GETP
GETLIS GET GETPROP LISTGET LISTGET1 REMPROP /REMPROP) ((CALL EVAL PROP EVAL . PPE) PUT /PUT PUTPROP
/PUTPROP LISTPUT LISTPUT1) ((CALL EVAL SMASH . PPE) /ATTACH ATTACH) ((CALL FUNCTIONAL . PPE) MAPATOMS)
((CALL FUNCTIONAL .. EVAL) APPLY* BLKAPPLY* APPLY BLKAPPLY) ((CALL NIL .. (@ EXPR (SELECTQ (CAR (
LISTP EXPR)) ((CQ CQ2 CV CV2) (QUOTE (NIL .. EVAL))) (VAR (QUOTE (NIL (.. NIL EVAL)))) (SETQ (QUOTE (
NIL SET))) NIL))) ASSEMBLE) ((CALL EVAL SMASH . PPE) DREMOVE /DREMOVE) ((CALL SET EVAL EVAL . PPE)
RESETVAR) ((CALL SET EVAL . PPE) SETN) ((CALL SMASH . PPE) DREVERSE) ((CALL SMASH EVAL . PPE) RPLACD
/RPLACD RPLACA /RPLACA RPLNODE2 /RPLNODE2 FRPLACD FRPLNODE2 TCONC /TCONC LCONC /LCONC NCONC1 /NCONC1
FRPLACA) ((CALL SMASH EVAL EVAL . PPE) RPLNODE FRPLNODE /RPLNODE) ((CALL SMASH FUNCTIONAL . PPE) SORT)
((CALL (BOTH SET EVAL) . PPE) ADD1VAR SUB1VAR) ((CALL (IF NULL NIL (IF ATOM SET EVAL)) EVAL . PPE)
RESETSAVE) ((CALL (IF (EQ (CAR (LISTP EXPR)) (QUOTE QUOTE)) (NIL SET) EVAL) EVAL . PPE) SET /SET
SETTOPVAL /SETTOPVAL SETATOMVAL /SETATOMVAL) ((CALL (IF (EQ (CAR (LISTP EXPR)) (QUOTE QUOTE)) (NIL SET
) EVAL) EVAL EVAL EVAL . PPE) SAVESET) ((CALL (IF (EQ (CAR (LISTP EXPR)) (QUOTE QUOTE)) (NIL EVAL)
EVAL) .. EVAL) GETATOMVAL EVAL EVALV) ((NIL .. TESTRETURN RETURN) OR) ((NIL .. TEST RETURN) AND) ((NIL
.. EFFECT RETURN) PROGN) ((NIL .. (IF CDR (TEST .. EFFECT RETURN) (TESTRETURN . PPE))) COND) ((CALL
.. (@ EXPR (CONS NIL (SELECTQ (CAR (LISTP EXPR)) (LOCALVARS (QUOTE (IF LISTP (.. LOCALVARS) LOCALVARS)
)) (SPECVARS (QUOTE (IF LISTP (.. SPECVARS) SPECVARS))) NIL)))) DECLARE) ((NIL RETURN) CLISP% ) ((NIL
EVAL . PPE) LISTP NLISTP RETURN) ((NIL TEST . PPE) NOT NULL) ((CALL EVAL .. (NIL .. EFFECT RETURN)
RETURN) SELECTQ SELCHARQ) ((CALL EVAL .. (EVAL .. EFFECT RETURN) RETURN) SELECTC) ((CALL EVAL .. ((IF
LISTP (.. EVAL) EVAL) .. EFFECT RETURN) RETURN) SELECT) ((NIL EVAL EVAL . PPE) EQ NEQ) ((NIL NIL . PPE
) QUOTE GO) ((NIL EVAL . PPE) CAR CDR CAAR CADR CDAR CDDR CAAAR CAADR CADAR CDAAR CADDR CDADR CDDAR
CDDDR CAAAAR CAAADR CAADAR CAADDR CADAAR CADADR CADDAR CADDDR CDAAAR CDAADR CDADAR CDADDR CDDAAR
CDDADR CDDDAR CDDDDR) ((NIL RETURN .. EFFECT) PROG1) ((NIL SET NIL . PPE) SETQQ) ((NIL SET EVAL . PPE)
SETQ ADV-SETQ SAVESETQ) ((CALL EVAL (BOTH (@ (QUOTE RPTN) (QUOTE BIND)) RETURN) . PPE) RPTQ) ((CALL
EVALQT .. EVAL) EVAL ERRORSET) ((BOTH (IF (EQ (CAR (LISTP (CADDR EXPR))) (QUOTE QUOTE)) (NIL NIL (NIL
(.. (BIND))))) (CALL EVALQT EVAL . PPE)) EVALA) ((CALL EVALQT STACK STACK EVAL EVAL . PPE) ENVEVAL) ((
CALL FUNCTIONAL EVALQT STACK STACK EVAL EVAL . PPE) ENVAPPLY) ((CALL STACK EVAL EVAL EVAL . PPE)
STKAPPLY) ((CALL STACK EVALQT EVAL EVAL . PPE) RETEVAL STKEVAL) ((CALL STACK EVAL EVAL . PPE) RETFROM
RETTO)))
(* * INITIALTEMPLATES is not needed after loading up)
(MAPC INITIALTEMPLATES (FUNCTION (LAMBDA (X) (MAPC (CDR X) (FUNCTION (LAMBDA (Y) (PUTHASH Y (CAR X)
MSTEMPLATES)))))))
(DECLARE: EVAL@COMPILE DONTCOPY
(PUTPROPS LTEMPLATE MACRO (LAMBDA (Y) (DECLARE (LOCALVARS Y)) (AND (NEQ T (SETQ Y (OR (GETHASH Y
USERTEMPLATES) (GETHASH Y MSTEMPLATES)))) Y)))
)
(DEFINEQ
(MSFINDP
(LAMBDA (STRUC SUB) (* lmm "14-Aug-84 16:38") (PROG NIL LP (RETURN (OR (EQ SUB STRUC) (AND (LISTP
STRUC) (OR (MSFINDP (CAR STRUC) SUB) (PROGN (SETQ STRUC (CDR STRUC)) (GO LP)))))))))
)
[DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY
(BLOCK: MSFINDP MSFINDP)
]
(PUTPROPS MSANALYZE COPYRIGHT ("Xerox Corporation" T 3676Q 3677Q 3700Q 3701Q))
(DECLARE: DONTCOPY
(FILEMAP (NIL (4725Q 12030Q (VARS 4737Q . 5075Q) (FREEVARS 5077Q . 5261Q) (CALLS 5263Q . 11141Q) (
COLLECTFNDATA 11143Q . 11454Q) (CALLS3 11456Q . 12026Q)) (15223Q 44725Q (ALLCALLS 15235Q . 16011Q) (
MSINITFNDATA 16013Q . 16306Q) (MSPRGE 16310Q . 24205Q) (MSPRGMACRO 24207Q . 24666Q) (MSPRGCALL 24670Q
. 25200Q) (MSBINDVAR 25202Q . 25653Q) (MSPRGRECORD 25655Q . 31713Q) (MSPRGERR 31715Q . 32072Q) (
MSPRGTEMPLATE1 32074Q . 40111Q) (MSPRGTEMPLATE 40113Q . 40616Q) (MSPRGLAMBDA 40620Q . 41563Q) (
MSPRGLST 41565Q . 41733Q) (ADDTO 41735Q . 42651Q) (NLAMBDAFNP 42653Q . 43545Q) (MSPRGDWIM 43547Q .
44166Q) (MSDWIMTRAN 44170Q . 44723Q)) (57334Q 57654Q (MSFINDP 57346Q . 57652Q)))))
STOP