(FILECREATED " 7-Aug-86 14:14:11" {ERIS}<LISPCORE>LIBRARY>CMLCOMPILE.;59 32280
changes to: (FUNCTIONS DEFOPTIMIZER)
previous date: " 3-Aug-86 15:09:17" {ERIS}<LISPCORE>LIBRARY>CMLCOMPILE.;56)
(* Copyright (c) 1985, 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT CMLCOMPILECOMS)
(RPAQQ CMLCOMPILECOMS
((COMS (FUNCTIONS CL:COMPILE DISASSEMBLE)
(FNS COMPILE-FILE INTERLISP-FORMAT-P INTERLISP-NLAMBDA-FUNCTION-P
COMPILE-FILE-EXPRESSION COMPILE-FILE-WALK-FUNCTION ARGTYPE.STATE
COMPILE.CHECK.ARGTYPE COMPILE.FILE.DEFINEQ COMPILE-FILE-SETF-SYMBOL-FUNCTION
COMPILE-FILE-EX/IMPORT COMPILE.FILE.APPLY COMPILE.FILE.RESET COMPILE-IN-CORE)
(VARS ARGTYPE.VARS)
(PROP COMPILE-FILE-EXPRESSION DEFINEQ * SETF-SYMBOL-FUNCTION))
(COMS (FNS NEWDEFC)
(DECLARE: DONTEVAL@LOAD DOCOPY (P (MOVD (QUOTE NEWDEFC)
(QUOTE DEFC)))))
(COMS (* "Optimizer definitions and environment hacking")
(DEFINE-TYPES OPTIMIZERS)
(FUNCTIONS COMPILER:OPTIMIZER-LIST)
(FUNCTIONS DEFOPTIMIZER)
(STRUCTURES COMPILER::ENV COMPILER:CONTEXT)
(FNS COMPILER:COPY-ENV-WITH-FUNCTION COMPILER:COPY-ENV-WITH-VARIABLE
COMPILER:ENV-BOUNDP COMPILER:ENV-FBOUNDP COMPILER:MAKE-EMPTY-ENV))
(PROP COMPILE-FILE-EXPRESSION PRETTYCOMPRINT)
(PROP FILETYPE CMLCOMPILE)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDVARS (NLAMA)
(NLAML)
(LAMA COMPILER:MAKE-EMPTY-ENV COMPILER:ENV-FBOUNDP COMPILER:ENV-BOUNDP
COMPILER:COPY-ENV-WITH-VARIABLE COMPILER:COPY-ENV-WITH-FUNCTION
COMPILE-FILE)))))
(DEFUN CL:COMPILE (NAME &OPTIONAL LAMBDA-EXPR) (LET ((NEW-NAME (OR NAME (QUOTE \CLCOMPILETEMP))))
(COMPILE-IN-CORE NEW-NAME (OR LAMBDA-EXPR
(GETD NAME)))
(AND LAMBDA-EXPR NAME (/PUTPROP NAME (QUOTE
EXPR)
LAMBDA-EXPR))
(OR NAME (GETD NEW-NAME))))
(DEFUN DISASSEMBLE (NAME-OR-COMPILED-FUNCTION &KEY LEVEL-P (RADIX 8)
(OUTPUT *STANDARD-OUTPUT*)
FIRST-BYTE MARKED-PC) (PRINTCODE
(if (CCODEP NAME-OR-COMPILED-FUNCTION)
then NAME-OR-COMPILED-FUNCTION
else (CL:COMPILE NIL (if (SYMBOLP
NAME-OR-COMPILED-FUNCTION
)
then (SYMBOL-FUNCTION
NAME-OR-COMPILED-FUNCTION
)
else
NAME-OR-COMPILED-FUNCTION
)))
LEVEL-P RADIX OUTPUT FIRST-BYTE MARKED-PC))
(DEFINEQ
(COMPILE-FILE
(CL:LAMBDA (FILENAME &KEY LAP REDEFINE OUTPUT-FILE (SAVE-EXPRS T)
(COMPILER-OUTPUT T)
(PROCESS-ENTIRE-FILE NIL PEFP)) (* bvm: " 3-Aug-86 15:08")
(LET (COMPILE.FILE.AFTER VALUE COMPILE.FILE.VALUE)
(DECLARE (SPECIAL COMPILE.FILE.AFTER COMPILE.FILE.VALUE))
[RESETLST (RESETSAVE NIL (LIST (QUOTE RESETUNDO))
(RESETUNDO))
(RESETSAVE NLAML NLAML)
(RESETSAVE NLAMA NLAMA)
(RESETSAVE LAMS LAMS)
(RESETSAVE LAMA LAMA)
(RESETSAVE DFNFLG NIL)
(RESETSAVE COUTFILE COMPILER-OUTPUT)
(RESETSAVE STRF REDEFINE)
(RESETSAVE SVFLG (AND SAVE-EXPRS (QUOTE DEFER)))
(RESETSAVE LAPFLG LAP)
(LET ((*PACKAGE* *INTERLISP-PACKAGE*)
(*READ-BASE* 10)
(LOCALVARS SYSLOCALVARS)
(SPECVARS T)
STREAM LSTFIL ROOTNAME INTERLISP-FORMAT)
(DECLARE (SPECIAL *PACKAGE* *READ-BASE* LOCALVARS SPECVARS LSTFIL))
[RESETSAVE NIL (LIST [FUNCTION (LAMBDA (X)
(CLOSEF? X)
(AND RESETSTATE (DELFILE X]
(SETQ STREAM (OPENSTREAM FILENAME (QUOTE INPUT]
(SETQ INTERLISP-FORMAT (INTERLISP-FORMAT-P STREAM))
(CL:UNLESS PEFP (SETQ PROCESS-ENTIRE-FILE INTERLISP-FORMAT))
(if LAP
then (SETQ LSTFIL COUTFILE))
(SETQ FILENAME (FINDFILE FILENAME))
(RESETSAVE NIL (LIST (FUNCTION COMPILE.FILE.RESET)
[SETQ OUTPUT-FILE (OPENSTREAM
(OR OUTPUT-FILE (
PACKFILENAME.STRING
(QUOTE VERSION)
NIL
(QUOTE EXTENSION)
COMPILE.EXT
(QUOTE BODY)
FILENAME))
(QUOTE OUTPUT)
(QUOTE NEW)
(QUOTE ((TYPE BINARY]
STREAM
(ROOTFILENAME FILENAME)))
(COND
(OUTPUT-FILE (PRINT (LIST (QUOTE FILECREATED)
(DATE)
(LIST COMPILEHEADER FILENAME)
COMPVERSION "COMPILE-FILEd" (QUOTE in)
HERALDSTRING
(QUOTE dated)
MAKESYSDATE)
OUTPUT-FILE FILERDTBL)
(RESETSAVE LCFIL OUTPUT-FILE)))
(PROG ((READ-TABLE (COND
(INTERLISP-FORMAT FILERDTBL)
(T (PRINT (QUOTE (IN-PACKAGE "USER"))
OUTPUT-FILE FILERDTBL)
(*
"Force the output file to read in the appropriate package")
(SETQ *PACKAGE* (FIND-PACKAGE "USER"))
CMLRDTBL)))
DEFERRED.EXPRESSIONS FORM)
(DECLARE (SPECIAL DEFERRED.EXPRESSIONS))
LP (SKIPSEPRS STREAM READ-TABLE)
(COND
((EOFP STREAM)
[AND PROCESS-ENTIRE-FILE (MAPC (REVERSE DEFERRED.EXPRESSIONS)
(FUNCTION (LAMBDA (EXP)
(APPLY* (CAR EXP)
(CDR EXP)
OUTPUT-FILE
FILERDTBL]
(CLOSEF STREAM)
(RETURN)))
(COMPILE-FILE-EXPRESSION [LET ((EXPRESSION (READ STREAM READ-TABLE)))
(COND
(INTERLISP-FORMAT EXPRESSION)
(T (CMLTRANSLATE EXPRESSION]
OUTPUT-FILE NIL NIL PROCESS-ENTIRE-FILE)
(GO LP))
(PRINT (QUOTE STOP)
OUTPUT-FILE FILERDTBL)
(SETQ COMPILE.FILE.VALUE (CLOSEF OUTPUT-FILE]
(* "Do these after UNDONLSETQ entered")
(MAPC (REVERSE COMPILE.FILE.AFTER)
(FUNCTION EVAL))
COMPILE.FILE.VALUE)))
(INTERLISP-FORMAT-P
[LAMBDA (STREAM) (* bvm: " 3-Aug-86 14:01")
(SELCHARQ (PEEKCCODE STREAM)
(; NIL)
((↑F "(")
T)
NIL])
(INTERLISP-NLAMBDA-FUNCTION-P
[LAMBDA (X) (* lmm " 7-May-86 20:12")
(AND (LITATOM X)
(FMEMB (ARGTYPE X)
(QUOTE (1 3)))
(NOT (SPECIAL-FORM-P X])
(COMPILE-FILE-EXPRESSION
[LAMBDA (FORM COMPILED.FILE COMPILE.TIME.TOO DONT.COPY DEFER)
(DECLARE (SPECIAL COMPILED.FILE)) (* bvm: " 3-Aug-86 14:58")
(AND (LISTP FORM)
(SELECTQ (CAR FORM)
(DECLARE: (PROG ((ORIG.COMPILE.TIME.TOO COMPILE.TIME.TOO)
(ORIG.DONT.COPY DONT.COPY)
(FORM (CDR FORM)))
LP (COND
((NLISTP FORM)
(RETURN))
((NLISTP (CAR FORM))
(SELECTQ (CAR FORM)
(DONTCOPY (SETQ DONT.COPY T))
((DOCOPY COPY)
(SETQ DONT.COPY NIL))
(COPYWHEN [SETQ DONT.COPY (NOT (EVAL (CAR (SETQ FORM
(CDR FORM])
(FIRST (PRINTOUT COUTFILE
"Warning: (DECLARE: -- FIRST -- --) not implemented in COMPILE-FILE: "
(CADR FORM)
T))
((NOTFIRST COMPILERVARS))
(DONTEVAL@COMPILE
(SETQ COMPILE.TIME.TOO NIL))
((DOEVAL@COMPILE EVAL@COMPILE)
(SETQ COMPILE.TIME.TOO T))
(EVAL@COMPILEWHEN
[SETQ COMPILE.TIME.TOO (EVAL (CAR (SETQ FORM (CDR FORM])
(EVAL@LOADWHEN (SETQ FORM (CDR FORM)))
((DONTEVAL@LOAD DOEVAL@LOAD EVAL@LOAD)
NIL)
(PRINT (CONS (CAR FORM)
(QUOTE (UNRECOGNIZED DECLARE TAG)))
COUTFILE)))
(T (COMPILE-FILE-EXPRESSION (CAR FORM)
COMPILED.FILE COMPILE.TIME.TOO DONT.COPY DEFER)))
(SETQ FORM (CDR FORM))
(GO LP)))
(PROGN (for X in (CDR FORM) do (COMPILE-FILE-EXPRESSION X COMPILED.FILE COMPILE.TIME.TOO
DONT.COPY DEFER)))
(QUOTE NIL)
(EVAL-WHEN (for X in (CDDR FORM)
do (COMPILE-FILE-EXPRESSION X COMPILED.FILE
[OR (FMEMB (QUOTE COMPILE)
(CADR FORM))
(FMEMB (QUOTE CL:COMPILE)
(CADR FORM))
(AND COMPILE.TIME.TOO (OR (FMEMB (QUOTE EVAL)
(CADR FORM))
(FMEMB (QUOTE CL:EVAL)
(CADR FORM]
[NOT (OR (FMEMB (QUOTE CL:LOAD)
(CADR FORM))
(FMEMB (QUOTE LOAD)
(CADR FORM]
DEFER)))
(IN-PACKAGE (*
"This is special because it has to be dumped to the output BEFORE the package changes")
(PRINT FORM COMPILED.FILE FILERDTBL)
(EVAL FORM))
(LET [(PROP (OR (GETPROP (CAR FORM)
(QUOTE COMPILE-FILE-EXPRESSION))
(GETPROP (CAR FORM)
(QUOTE COMPILE.FILE.EXPRESSION]
(COND
([AND (NOT PROP)
(NOT (SPECIAL-FORM-P (CAR FORM)))
(NOT (INTERLISP-NLAMBDA-FUNCTION-P (CAR FORM)))
(NEQ FORM (SETQ FORM (MACROEXPAND-1 FORM]
(COMPILE-FILE-EXPRESSION FORM COMPILED.FILE COMPILE.TIME.TOO DONT.COPY DEFER))
(T (PROGN (AND COMPILE.TIME.TOO (EVAL FORM))
(OR DONT.COPY (COND
(PROP (COMPILE.FILE.APPLY PROP FORM COMPILE.TIME.TOO
DONT.COPY DEFER))
([NOT (EQUAL FORM (SETQ FORM
(WALK-FORM FORM :WALK-FUNCTION
(FUNCTION
COMPILE-FILE-WALK-FUNCTION
]
(COMPILE-FILE-EXPRESSION FORM COMPILED.FILE
COMPILE.TIME.TOO DONT.COPY DEFER))
(T (COMPILE.FILE.APPLY (FUNCTION PRINT)
FORM COMPILE.TIME.TOO DONT.COPY DEFER])
(COMPILE-FILE-WALK-FUNCTION
[LAMBDA (FORM) (* lmm "26-Jun-86 17:25")
(if (NLISTP FORM)
then FORM
else (VALUES FORM (INTERLISP-NLAMBDA-FUNCTION-P (CAR FORM])
(ARGTYPE.STATE
[LAMBDA NIL
(for X in ARGTYPE.VARS do (PRINTOUT T X %, (EVAL (CADR X))
T])
(COMPILE.CHECK.ARGTYPE
[LAMBDA (X AT) (* lmm "15-Jun-85 16:58")
(if (NEQ AT (LET (BLKFLG)
(COMP.ARGTYPE X)))
then (*
"Incorrectly on one of the defining lists")
(for ATYPEPAIR in ARGTYPE.VARS
do (LET [(VAL (FMEMB X (EVALV (CADR ATYPEPAIR]
(if (EQ AT (CAR ATYPEPAIR))
then (if VAL
then (PRINTOUT COUTFILE "Compiler confused: " X " on "
(CADR ATYPEPAIR)
" but compiler doesn't think its a "
(CADDR ATYPEPAIR)))
[/SETTOPVAL (CADR ATYPEPAIR)
(CONS X (PROGN (GETTOPVAL (CADR ATYPEPAIR]
else (if VAL
then (PRINTOUT COUTFILE "Warning: compiler thought " X " "
(LIST (QUOTE a)
(OR (CADDR (ASSOC AT ARGTYPE.VARS))
"LAMBDA spread")
(QUOTE function))
" was a "
(CADDR ATYPEPAIR)
" because it was incorrectly on "
(CADR ATYPEPAIR)
T)
(/SETTOPVAL (CADR ATYPEPAIR)
(REMOVE X (PROGN (GETTOPVAL (CADR ATYPEPAIR])
(COMPILE.FILE.DEFINEQ
[LAMBDA (FORM LCFIL RDTBL) (* lmm " 5-Jul-85 15:42")
(for DEF in (CDR FORM) do (COMPILE.CHECK.ARGTYPE (CAR DEF)
(ARGTYPE (CADR DEF)))
(BYTECOMPILE2 (CAR DEF)
(COMPILE1A (CAR DEF)
(CADR DEF)
NIL])
(COMPILE-FILE-SETF-SYMBOL-FUNCTION
[LAMBDA (FORM LCFIL RDTBL) (* lmm "26-Jun-86 17:25")
(if [AND (FMEMB (CAR (LISTP (THIRD FORM)))
(QUOTE (FUNCTION CL:FUNCTION)))
(EQ (CAR (LISTP (SECOND FORM)))
(QUOTE QUOTE))
(CONSP (SECOND (THIRD FORM]
then (BYTECOMPILE2 (CADR (SECOND FORM))
(CADR (THIRD FORM)))
else (PRINT (WALK-FORM FORM :WALK-FUNCTION (FUNCTION COMPILE-FILE-WALK-FUNCTION))
LCFIL RDTBL])
(COMPILE-FILE-EX/IMPORT
[LAMBDA (FORM LCFIL RDTBL) (* bvm: " 3-Aug-86 15:05")
(* * "EXPORT, IMPORT, SHADOW, USE-PACKAGE are all implicitly EVAL@COMPILE, since they have to affect the package being used to read what follows")
(PRINT FORM LCFIL RDTBL)
(EVAL FORM])
(COMPILE.FILE.APPLY
[LAMBDA (PROP FORM COMPILE.TIME.TOO DONT.COPY DEFER) (* lmm "27-Jun-85 17:36")
(PROGN (AND COMPILE.TIME.TOO (EVAL FORM))
(OR DONT.COPY (if DEFER
then (push DEFERRED.EXPRESSIONS (CONS PROP FORM))
else (APPLY* PROP FORM COMPILED.FILE FILERDTBL])
(COMPILE.FILE.RESET
[LAMBDA (COMPILED.FILE SOURCEFILE ROOTNAME) (* lmm "15-Jun-85 16:52")
(* Cleans up after brecompile and
bcompl have finished operating,)
[COND
(COMPILED.FILE (CLOSEF? COMPILED.FILE)
(AND RESETSTATE (DELFILE COMPILED.FILE]
(COND
(SOURCEFILE (CLOSEF? SOURCEFILE)))
(COND
((NULL RESETSTATE) (* Finished successfully.)
(/SETATOMVAL (QUOTE NOTCOMPILEDFILES)
(REMOVE ROOTNAME NOTCOMPILEDFILES)) (* Removes FILES from
NOTCOMPILEDFILES.)
])
(COMPILE-IN-CORE
[LAMBDA (fn-name fn-expr fn-type NOSAVE)
(DECLARE (SPECVARS LCFIL LAPFLG STRF SVFLG LSTFIL SPECVARS LOCALVARS DONT-TRANSFER-PUTD))
(* lmm " 2-Jun-86 22:04")
(* in-core compiling for functions and forms, without the interview.
if X is a list, we assume that we are being called merely to display the lap
and machine code. the form is compiled as the definition of FOO but the
compiled :CODE is thrown away. -
if X is a litatom, then saving, redefining, and printing is controlled by the
flags.)
(LET ((NOREDEFINE NIL)
(PRINTLAP NIL)
(DONT-TRANSFER-PUTD T))
(RESETVARS [(NLAMA NLAMA)
(NLAML NLAML)
(LAMS LAMS)
(LAMA LAMA)
(NOFIXFNSLST NOFIXFNSLST)
(NOFIXVARSLST NOFIXVARSLST)
(COUTFILE (COND
((AND (BOUNDP (QUOTE NULLFILE))
(STREAMP NULLFILE)
(OPENP NULLFILE))
NULLFILE)
(T (SETQ NULLFILE (OPENFILE (QUOTE {NULL})
(QUOTE OUTPUT]
(RETURN (RESETLST (* RESETLST to provide reset context
for macros under COMPILE1 as generated
e.g. by DECL.)
(PROG ((LCFIL)
[LAPFLG (AND PRINTLAP (COND
(BYTECOMPFLG T)
(T 2]
(STRF (NOT NOREDEFINE))
(SVFLG (if (EQ fn-type (QUOTE SELECTOR))
then (QUOTE SELECTOR)
else (NOT NOSAVE)))
(LSTFIL T)
(SPECVARS SYSSPECVARS)
(LOCALVARS T))
(RETURN (PROGN (SETQ fn-expr (COMPILE1A fn-name fn-expr T))
(PROG ((FREEVARS FREEVARS))
(RETURN (BYTECOMPILE2 fn-name fn-expr])
)
(RPAQQ ARGTYPE.VARS ((1 NLAML "NLAMBDA spread")
(2 LAMA "LAMBDA nospread")
(0 LAMS "LAMBDA spread")
(3 NLAMA "NLAMBDA no-spread")))
(PUTPROPS DEFINEQ COMPILE-FILE-EXPRESSION COMPILE.FILE.DEFINEQ)
(PUTPROPS * COMPILE-FILE-EXPRESSION NILL)
(PUTPROPS SETF-SYMBOL-FUNCTION COMPILE-FILE-EXPRESSION COMPILE-FILE-SETF-SYMBOL-FUNCTION)
(DEFINEQ
(NEWDEFC
[LAMBDA (NM DF) (* lmm "15-Aug-85 16:06")
(COND
((EQ SVFLG (QUOTE DEFER))
(push COMPILE.FILE.AFTER (LIST (FUNCTION NEWDEFC)
(KWOTE NM)
(KWOTE DF)
T)))
((EQ SVFLG (QUOTE SELECTOR)) (* hack to allow compiling selectors)
(SELECTOR.PUTD NM DF T))
((OR (NULL DFNFLG)
(EQ DFNFLG T))
[COND
((GETD NM)
(VIRGINFN NM T)
(COND
((NULL DFNFLG)
(PRINT (CONS NM (QUOTE (redefined)))
T T) (* NOTE: this call to PRINT is changed
to LISPXPRINT later in the loadup.)
(SAVEDEF NM]
(/PUTD NM DF T) (* NOTE: this call to \PUTD is changed
to /PUTD later in the loadup.)
)
(T (/PUTPROP NM (QUOTE CODE)
DF) (* NOTE: this call to /PUTPROP is
changed to /PUTPROP later in the
loadup.)
))
DF])
)
(DECLARE: DONTEVAL@LOAD DOCOPY
(MOVD (QUOTE NEWDEFC)
(QUOTE DEFC))
)
(* "Optimizer definitions and environment hacking")
(DEF-DEFINE-TYPE OPTIMIZERS "COMPILER OPTIMIZERS" )
(DEFMACRO COMPILER:OPTIMIZER-LIST (FN) (BQUOTE (GET (\, FN)
(QUOTE COMPILER:OPTIMIZER-LIST))))
(DEFDEFINER DEFOPTIMIZER OPTIMIZERS
(NAME OPT-NAME &REST ARGLIST-BODY &ENVIRONMENT ENV)
"define an optimizer for NAME"
(COND
((NOT ARGLIST-BODY) (* ; "(defoptimizer name optfn)")
(PROG1 (BQUOTE (CL:PUSHNEW (QUOTE (\, OPT-NAME))
(COMPILER:OPTIMIZER-LIST (QUOTE (\, NAME)))))
(SETQ NAME (INTERN (CONCATENATE NAME "-OPTIMIZED-BY-" OPT-NAME)
(SYMBOL-PACKAGE OPT-NAME)))
(* ; " optimizer name is generated")
))
(T (LET* ((FORM-NAME NAME)
(ARG-LIST OPT-NAME)
(OPT-FN-NAME (if (AND OPT-NAME (SYMBOLP OPT-NAME)
(CDR ARGLIST-BODY))
then
(* ;
"(defoptimizer form-name opt-name arglist . body)")
(SETQ NAME OPT-NAME)
(* ; "optimizer name is opt-name")
(PROG1 OPT-NAME (SETQ ARG-LIST
(POP ARGLIST-BODY)))
else
(* ;
"(defoptimizer form-name arglist . body) optimizer name is form name")
(PACK* "optimize-" FORM-NAME))))
(MULTIPLE-VALUE-BIND
(BODY DECLS DOC)
(PARSE-DEFMACRO ARG-LIST (QUOTE $$WHOLE)
ARGLIST-BODY NAME ENV :ENVIRONMENT (QUOTE $$ENV)
:CONTEXT
(QUOTE $$CTX))
(BQUOTE (PROGN (DEFUN (\, OPT-FN-NAME) ($$WHOLE $$ENV $$CTX)
(\,@ DECLS)
(\, BODY))
(CL:PUSHNEW (QUOTE (\, OPT-FN-NAME))
(COMPILER:OPTIMIZER-LIST
(QUOTE (\, FORM-NAME)))))))))))
(DEFSTRUCT (COMPILER::ENV (:CONSTRUCTOR COMPILER::MAKE-ENV)
(:COPIER COMPILER::COPY-ENV)
(:PREDICATE COMPILER::ENV-P)) (VENV NIL) (FENV NIL))
(DEFSTRUCT (COMPILER:CONTEXT (:CONSTRUCTOR COMPILER:MAKE-CONTEXT)
(:COPIER COMPILER::COPY-CONTEXT)
(:PREDICATE COMPILER::CONTEXT-P)) (TOP-LEVEL-P NIL) (VALUES-USED
:UNKNOWN)
(PREDICATE-P NIL))
(DEFINEQ
(COMPILER:COPY-ENV-WITH-FUNCTION
(CL:LAMBDA (ENV FN &OPTIONAL (KIND :FUNCTION)
EXP-FN) (* "Pavel" "26-Apr-86 15:13")
(* "Pavel" "25-Apr-86 18:53")
(LET [(NEW-ENV (CL:IF ENV (COMPILER::COPY-ENV ENV)
(COMPILER:MAKE-EMPTY-ENV]
(CL:PUSH (LIST FN KIND EXP-FN)
(COMPILER::ENV-FENV NEW-ENV))
NEW-ENV)))
(COMPILER:COPY-ENV-WITH-VARIABLE
(CL:LAMBDA (ENV VAR &OPTIONAL (KIND :LEXICAL)) (* "Pavel" "26-Apr-86 15:12")
(* "Pavel" "25-Apr-86 18:54")
(LET [(NEW-ENV (CL:IF ENV (COMPILER::COPY-ENV ENV)
(COMPILER:MAKE-EMPTY-ENV]
(CL:PUSH (CONS VAR KIND)
(COMPILER::ENV-VENV NEW-ENV))
NEW-ENV)))
(COMPILER:ENV-BOUNDP
[CL:LAMBDA (ENV VAR) (* "Pavel" "25-Apr-86 18:41")
(LET [(BINDING (CL:ASSOC VAR (COMPILER::ENV-VENV ENV]
(AND BINDING (CDR BINDING])
(COMPILER:ENV-FBOUNDP
[CL:LAMBDA (ENV FN) (* "Pavel" "25-Apr-86 18:42")
(LET [(BINDING (CL:ASSOC FN (COMPILER::ENV-FENV ENV]
(AND BINDING (LET ((KIND (SECOND BINDING)))
(CL:IF (EQ KIND :MACRO)
(VALUES :MACRO (THIRD BINDING))
KIND])
(COMPILER:MAKE-EMPTY-ENV
(CL:LAMBDA NIL (COMPILER::MAKE-ENV)))
)
(PUTPROPS PRETTYCOMPRINT COMPILE-FILE-EXPRESSION NILL)
(PUTPROPS CMLCOMPILE FILETYPE COMPILE-FILE)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA )
(ADDTOVAR NLAML )
(ADDTOVAR LAMA COMPILER:MAKE-EMPTY-ENV COMPILER:ENV-FBOUNDP COMPILER:ENV-BOUNDP
COMPILER:COPY-ENV-WITH-VARIABLE COMPILER:COPY-ENV-WITH-FUNCTION COMPILE-FILE)
)
(PUTPROPS CMLCOMPILE COPYRIGHT ("Xerox Corporation" 1985 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (3952 24240 (COMPILE-FILE 3962 . 10333) (INTERLISP-FORMAT-P 10335 . 10556) (
INTERLISP-NLAMBDA-FUNCTION-P 10558 . 10800) (COMPILE-FILE-EXPRESSION 10802 . 16516) (
COMPILE-FILE-WALK-FUNCTION 16518 . 16766) (ARGTYPE.STATE 16768 . 16916) (COMPILE.CHECK.ARGTYPE 16918
. 18900) (COMPILE.FILE.DEFINEQ 18902 . 19377) (COMPILE-FILE-SETF-SYMBOL-FUNCTION 19379 . 19950) (
COMPILE-FILE-EX/IMPORT 19952 . 20294) (COMPILE.FILE.APPLY 20296 . 20666) (COMPILE.FILE.RESET 20668 .
21477) (COMPILE-IN-CORE 21479 . 24238)) (24652 26151 (NEWDEFC 24662 . 26149)) (30063 31790 (
COMPILER:COPY-ENV-WITH-FUNCTION 30073 . 30597) (COMPILER:COPY-ENV-WITH-VARIABLE 30599 . 31069) (
COMPILER:ENV-BOUNDP 31071 . 31299) (COMPILER:ENV-FBOUNDP 31301 . 31718) (COMPILER:MAKE-EMPTY-ENV 31720
. 31788)))))
STOP