(FILECREATED "18-Sep-86 14:43:52" {ERIS}<LISPCORE>LIBRARY>CMLCOMPILE.;65 33835
changes to: (FNS COMPILE.FILE.DEFINEQ)
previous date: "15-Sep-86 18:08:10" {ERIS}<LISPCORE>LIBRARY>CMLCOMPILE.;64)
(* 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: "15-Sep-86 18:04")
(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 ENV FORM)
(DECLARE (SPECIAL *PACKAGE* *READ-BASE* LOCALVARS SPECVARS LSTFIL))
[RESETSAVE NIL (LIST (FUNCTION CLOSEF?)
(SETQ STREAM (OPENSTREAM FILENAME (QUOTE INPUT]
(MULTIPLE-VALUE-SETQ (ENV FORM)
(\PARSE-FILE-HEADER STREAM (QUOTE RETURN)
T))
(SETQ INTERLISP-FORMAT (AND ENV (NEQ ENV *COMMON-LISP-READ-ENVIRONMENT*)))
(if (NOT PEFP)
then (SETQ PROCESS-ENTIRE-FILE INTERLISP-FORMAT))
(if LAP
then (SETQ LSTFIL COUTFILE))
(SETQ FILENAME (FULLNAME STREAM))
(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)))
(if OUTPUT-FILE
then (RESETSAVE LCFIL OUTPUT-FILE)
(PRINT-COMPILE-HEADER (LIST STREAM)
"COMPILE-FILEd" ENV))
(WITH-READER-ENVIRONMENT
ENV
(if NIL
then (PRINT (QUOTE (IN-PACKAGE "USER"))
OUTPUT-FILE FILERDTBL)
(* ;
"Force the output file to read in the appropriate package")
(SETQ *PACKAGE* (FIND-PACKAGE "USER")))
(PROG (DEFERRED.EXPRESSIONS)
(DECLARE (SPECIAL DEFERRED.EXPRESSIONS))
LP (COMPILE-FILE-EXPRESSION FORM OUTPUT-FILE NIL PROCESS-ENTIRE-FILE)
(SKIPSEPRS STREAM)
(if (EOFP STREAM)
then (AND PROCESS-ENTIRE-FILE (for EXP in (REVERSE
DEFERRED.EXPRESSIONS
)
do (APPLY* (CAR EXP)
(CDR EXP)
OUTPUT-FILE)))
(CLOSEF STREAM)
(RETURN))
[SETQ FORM (LET ((EXPRESSION (READ STREAM)))
(if INTERLISP-FORMAT
then EXPRESSION
else (CMLTRANSLATE EXPRESSION]
(GO LP))
(PRINT NIL OUTPUT-FILE))
(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 DEFER)
(DECLARE (SPECIAL COMPILED.FILE)) (* bvm: " 8-Sep-86 16:42")
(AND (LISTP FORM)
(SELECTQ (CAR FORM)
(DECLARE: (PROG ((COMPILE.SPECIFIED NIL)
(LOAD.SPECIFIED T)
(EVAL.SPECIFIED T)
(FORM (CDR FORM)))
LP (if (NLISTP FORM)
then (RETURN)
elseif (NLISTP (CAR FORM))
then (SELECTQ (CAR FORM)
(DONTCOPY (SETQ LOAD.SPECIFIED NIL))
((DOCOPY COPY)
(SETQ LOAD.SPECIFIED T))
(COPYWHEN [SETQ LOAD.SPECIFIED (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.SPECIFIED NIL))
((DOEVAL@COMPILE EVAL@COMPILE)
(SETQ COMPILE.SPECIFIED T))
(EVAL@COMPILEWHEN
[SETQ COMPILE.SPECIFIED (EVAL (CAR (SETQ FORM
(CDR FORM])
((DOEVAL@LOAD EVAL@LOAD)
(SETQ EVAL.SPECIFIED T))
(DONTEVAL@LOAD (SETQ EVAL.SPECIFIED NIL))
(EVAL@LOADWHEN [SETQ EVAL.SPECIFIED
(EVAL (CAR (SETQ FORM (CDR FORM])
(PRINT (CONS (CAR FORM)
(QUOTE (UNRECOGNIZED DECLARE TAG)))
COUTFILE))
else (if (NOT LOAD.SPECIFIED)
then (if (OR COMPILE.SPECIFIED (AND COMPILE.TIME.TOO
EVAL.SPECIFIED))
then (EVAL (CAR FORM)))
else (COMPILE-FILE-EXPRESSION (CAR FORM)
COMPILED.FILE
(OR COMPILE.SPECIFIED (AND COMPILE.TIME.TOO
EVAL.SPECIFIED))
DEFER)))
(SETQ FORM (CDR FORM))
(GO LP)))
(PROGN (for X in (CDR FORM) do (COMPILE-FILE-EXPRESSION X COMPILED.FILE COMPILE.TIME.TOO
DEFER)))
((QUOTE) (* ; " ignore top level quoted expression -i")
NIL)
(COMPILER-LET (* ; " top level compiler-let. bind variables and recursively compile sub-expressions. This is here mainly for b PCL has top level compiler-lets")
[LET [(VARS (CL:MAPCAR (CL:FUNCTION (CL:LAMBDA (X)
(if (CONSP X)
then (CAR X)
else X)))
(CADR FORM)))
(VALS (CL:MAPCAR [CL:FUNCTION
(CL:LAMBDA (X)
(if (CONSP X)
then (CL:EVAL (CADR X]
(CADR FORM]
(PROGV VARS VALS (CL:MAPC (CL:FUNCTION (CL:LAMBDA (X)
(
COMPILE-FILE-EXPRESSION
X COMPILED.FILE
COMPILE.TIME.TOO DEFER
)))
(CDDR FORM])
(EVAL-WHEN [LET [[EVAL.SPECIFIED (OR (FMEMB (QUOTE EVAL)
(CADR FORM))
(FMEMB (QUOTE CL:EVAL)
(CADR FORM]
[LOAD.SPECIFIED (OR (FMEMB (QUOTE LOAD)
(CADR FORM))
(FMEMB (QUOTE CL:LOAD)
(CADR FORM]
(COMPILE.SPECIFIED (OR (FMEMB (QUOTE COMPILE)
(CADR FORM))
(FMEMB (QUOTE CL:COMPILE)
(CADR FORM]
(COND
[(NOT LOAD.SPECIFIED)
(COND
((OR COMPILE.SPECIFIED (AND COMPILE.TIME.TOO EVAL.SPECIFIED))
(for INNER-FORM in (CDDR FORM) do (EVAL INNER-FORM]
(T (for INNER-FORM in (CDDR FORM)
do (COMPILE-FILE-EXPRESSION INNER-FORM COMPILED.FILE
(OR COMPILE.SPECIFIED (AND COMPILE.TIME.TOO
EVAL.SPECIFIED))
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]
(if [AND (NOT PROP)
(NOT (SPECIAL-FORM-P (CAR FORM)))
(NOT (INTERLISP-NLAMBDA-FUNCTION-P (CAR FORM)))
(NEQ FORM (SETQ FORM (MACROEXPAND-1 FORM]
then (COMPILE-FILE-EXPRESSION FORM COMPILED.FILE COMPILE.TIME.TOO DEFER)
else (if COMPILE.TIME.TOO
then (EVAL FORM))
(if PROP
then (COMPILE.FILE.APPLY PROP FORM DEFER)
elseif [NOT (EQUAL FORM (SETQ FORM (WALK-FORM FORM :WALK-FUNCTION
(FUNCTION
COMPILE-FILE-WALK-FUNCTION]
then (COMPILE-FILE-EXPRESSION FORM COMPILED.FILE COMPILE.TIME.TOO DEFER)
else (COMPILE.FILE.APPLY (FUNCTION PRINT)
FORM 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) (* bvm: "18-Sep-86 14:35")
(for DEF in (CDR FORM) unless (FMEMB (CAR DEF)
DONTCOMPILEFNS) 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) (* bvm: " 8-Sep-86 16:55")
(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])
(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 DEFER) (* bvm: " 8-Sep-86 16:55")
(if DEFER
then (push DEFERRED.EXPRESSIONS (CONS PROP FORM))
else (APPLY* PROP FORM COMPILED.FILE])
(COMPILE.FILE.RESET
[LAMBDA (COMPILED.FILE SOURCEFILE ROOTNAME) (* bvm: " 9-Sep-86 15:16")
(* Cleans up after brecompile and
bcompl have finished operating,)
(if (AND COMPILED.FILE (OPENP COMPILED.FILE))
then (CLOSE-AND-MAYBE-DELETE COMPILED.FILE))
(if SOURCEFILE
then (CLOSEF? SOURCEFILE))
(if (NULL RESETSTATE)
then (* 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) (* gbn " 7-Aug-86 18:54")
(COND
((EQ SVFLG (QUOTE DEFER))
(push COMPILE.FILE.AFTER (LIST (FUNCTION NEWDEFC)
(KWOTE NM)
(KWOTE DF)
T)))
((OR (NULL DFNFLG)
(EQ DFNFLG T))
[COND
((GETD NM)
(VIRGINFN NM T)
(COND
((NULL DFNFLG)
(FORMAT *ERROR-OUTPUT* "~&~A redefined ~&" NM)
(SAVEDEF NM]
(/PUTD NM DF T))
(T (/PUTPROP NM (QUOTE CODE)
DF)))
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 (STRING-APPEND 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 (3949 26572 (COMPILE-FILE 3959 . 9742) (INTERLISP-FORMAT-P 9744 . 9965) (
INTERLISP-NLAMBDA-FUNCTION-P 9967 . 10209) (COMPILE-FILE-EXPRESSION 10211 . 18716) (
COMPILE-FILE-WALK-FUNCTION 18718 . 18966) (ARGTYPE.STATE 18968 . 19115) (COMPILE.CHECK.ARGTYPE 19117
. 21032) (COMPILE.FILE.DEFINEQ 21034 . 21800) (COMPILE-FILE-SETF-SYMBOL-FUNCTION 21802 . 22368) (
COMPILE-FILE-EX/IMPORT 22370 . 22712) (COMPILE.FILE.APPLY 22714 . 22966) (COMPILE.FILE.RESET 22968 .
23809) (COMPILE-IN-CORE 23811 . 26570)) (26984 27702 (NEWDEFC 26994 . 27700)) (31618 33345 (
COMPILER:COPY-ENV-WITH-FUNCTION 31628 . 32152) (COMPILER:COPY-ENV-WITH-VARIABLE 32154 . 32624) (
COMPILER:ENV-BOUNDP 32626 . 32854) (COMPILER:ENV-FBOUNDP 32856 . 33273) (COMPILER:MAKE-EMPTY-ENV 33275
. 33343)))))
STOP