From 0c62577e9266e8cec94b623ff32259c9c398ebaf Mon Sep 17 00:00:00 2001 From: Larry Masinter Date: Tue, 16 Apr 2024 10:51:23 -0700 Subject: [PATCH] ANSI CL says all non-symbol non-list is self-evaluating; fix CL:EVAL (#1664) --- sources/CMLEVAL | 1087 +++++++++++++++++++++--------------------- sources/CMLEVAL.LCOM | Bin 48241 -> 47939 bytes 2 files changed, 537 insertions(+), 550 deletions(-) diff --git a/sources/CMLEVAL b/sources/CMLEVAL index 8a80aab7..b7163714 100644 --- a/sources/CMLEVAL +++ b/sources/CMLEVAL @@ -1,154 +1,154 @@ -(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE "INTERLISP") -(FILECREATED "30-Dec-93 14:27:43" |{DSK}export>lispcore>clos>2.0>CMLEVAL.;1| 102797 +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10) - |changes| |to:| (OPTIMIZERS CL-EVAL-FN3-CALL) +(FILECREATED "15-Apr-2024 21:22:06" |{DSK}larry>il>medley>sources>CMLEVAL.;7| 99203 - |previous| |date:| " 1-Apr-92 12:43:15" |{DSK}export>lispcore>sources>CMLEVAL.;1|) + :EDIT-BY "lmm" + :CHANGES-TO (VARS CMLEVALCOMS) + + :PREVIOUS-DATE "15-Apr-2024 20:14:11" |{DSK}larry>il>medley>sources>CMLEVAL.;5|) -; Copyright (c) 1986, 1987, 1988, 1990, 1991, 1992, 1993 by Venue & Xerox Corporation. All rights reserved. (PRETTYCOMPRINT CMLEVALCOMS) -(RPAQQ CMLEVALCOMS ( +(RPAQQ CMLEVALCOMS + ( (* |;;;| "Common Lisp interpreter") - (COMS - (* |;;| "These really don't belong here") + (COMS + (* |;;| "These really don't belong here") - (FUNCTIONS CL:EQUAL CL:EQUALP) - - (* |;;| - "For the byte compiler: Optimize by constant fold and coerce to EQ where possible") + (FUNCTIONS CL:EQUAL CL:EQUALP) + + (* |;;| + "For the byte compiler: Optimize by constant fold and coerce to EQ where possible") - (PROP BYTEMACRO CL:EQUAL CL:EQUALP) - (PROP DOPVAL CL:EQUAL)) - (COMS (FUNCTIONS \\REMOVE-DECLS) - (FUNCTIONS CL:SPECIAL-FORM-P)) - (COMS (SPECIAL-FORMS INTERLISP) - (PROP DMACRO INTERLISP COMMON-LISP) - (FNS COMMON-LISP)) - (COMS (ADDVARS (LAMBDASPLST CL:LAMBDA)) - (FNS \\TRANSLATE-CL\:LAMBDA) - (VARIABLES *CHECK-ARGUMENT-COUNTS* *SPECIAL-BINDING-MARK*)) - (VARIABLES CL:LAMBDA-LIST-KEYWORDS CL:CALL-ARGUMENTS-LIMIT - CL:LAMBDA-PARAMETERS-LIMIT) - (STRUCTURES CLOSURE ENVIRONMENT) - (FUNCTIONS \\MAKE-CHILD-ENVIRONMENT) - (COMS (FNS CL:EVAL \\EVAL-INVOKE-LAMBDA \\INTERPRET-ARGUMENTS - \\INTERPRETER-LAMBDA CHECK-BINDABLE CHECK-KEYWORDS) - (FUNCTIONS ARG-REF) - (PROP DMACRO .COMPILER-SPREAD-ARGUMENTS.)) - (FNS DECLARED-SPECIAL) - (COMS (* \; - "FUNCALL and APPLY, not quite same as Interlisp") - (FNS CL:FUNCALL CL:APPLY) - (PROP DMACRO CL:APPLY CL:FUNCALL)) - (COMS (* \; - "COMPILER-LET needs to work differently compiled and interpreted") - (FNS CL:COMPILER-LET COMP.COMPILER-LET) - (PROP DMACRO CL:COMPILER-LET) - (SPECIAL-FORMS CL:COMPILER-LET)) - (COMS (* \; - "Lexical function- and macro-binding forms: FLET, LABELS, and MACROLET.") - (SPECIAL-FORMS CL:MACROLET CL:FLET CL:LABELS)) - (SPECIAL-FORMS QUOTE) - (COMS (SPECIAL-FORMS THE) - (PROP DMACRO THE)) - (COMS (PROP DMACRO CL:EVAL-WHEN) - (FNS CL:EVAL-WHEN) - (SPECIAL-FORMS CL:EVAL-WHEN)) - (COMS (SPECIAL-FORMS DECLARE) - (FUNCTIONS CL:LOCALLY)) - (COMS (* \; "Interlisp version on LLINTERP") - (SPECIAL-FORMS PROGN) - (FNS \\EVAL-PROGN)) - (COMS (* \; - "Confused because currently Interlisp special form, fixing MACRO-FUNCTION is complex") + (PROP BYTEMACRO CL:EQUAL CL:EQUALP) + (PROP DOPVAL CL:EQUAL)) + (COMS (FUNCTIONS \\REMOVE-DECLS) + (FUNCTIONS CL:SPECIAL-FORM-P)) + (COMS (SPECIAL-FORMS INTERLISP) + (PROP DMACRO INTERLISP COMMON-LISP) + (FNS COMMON-LISP)) + (COMS (ADDVARS (LAMBDASPLST CL:LAMBDA)) + (FNS \\TRANSLATE-CL\:LAMBDA) + (VARIABLES *CHECK-ARGUMENT-COUNTS* *SPECIAL-BINDING-MARK*)) + (VARIABLES CL:LAMBDA-LIST-KEYWORDS CL:CALL-ARGUMENTS-LIMIT CL:LAMBDA-PARAMETERS-LIMIT) + (STRUCTURES CLOSURE ENVIRONMENT) + (FUNCTIONS \\MAKE-CHILD-ENVIRONMENT) + (COMS (FNS CL:EVAL \\EVAL-INVOKE-LAMBDA \\INTERPRET-ARGUMENTS \\INTERPRETER-LAMBDA + CHECK-BINDABLE CHECK-KEYWORDS) + (FUNCTIONS ARG-REF) + (PROP DMACRO .COMPILER-SPREAD-ARGUMENTS.)) + (FNS DECLARED-SPECIAL) + (COMS (* \; + "FUNCALL and APPLY, not quite same as Interlisp") + (FNS CL:FUNCALL CL:APPLY) + (PROP DMACRO CL:APPLY CL:FUNCALL)) + (COMS (* \; + "COMPILER-LET needs to work differently compiled and interpreted") + (FNS CL:COMPILER-LET COMP.COMPILER-LET) + (PROP DMACRO CL:COMPILER-LET) + (SPECIAL-FORMS CL:COMPILER-LET)) + (COMS (* \; + "Lexical function- and macro-binding forms: FLET, LABELS, and MACROLET.") + (SPECIAL-FORMS CL:MACROLET CL:FLET CL:LABELS)) + (SPECIAL-FORMS QUOTE) + (COMS (SPECIAL-FORMS THE) + (PROP DMACRO THE)) + (COMS (PROP DMACRO CL:EVAL-WHEN) + (FNS CL:EVAL-WHEN) + (SPECIAL-FORMS CL:EVAL-WHEN)) + (COMS (SPECIAL-FORMS DECLARE) + (FUNCTIONS CL:LOCALLY)) + (COMS (* \; "Interlisp version on LLINTERP") + (SPECIAL-FORMS PROGN) + (FNS \\EVAL-PROGN)) + (COMS (* \; + "Confused because currently Interlisp special form, fixing MACRO-FUNCTION is complex") (* \; - "The Interlisp function is on LLINTERP") - (SPECIAL-FORMS PROG1) - (FUNCTIONS PROG1)) - (COMS (SPECIAL-FORMS LET* LET) - (PROP MACRO LET LET*) - (FNS \\LET*-RECURSION |\\LETtran|)) - (COMS (SPECIAL-FORMS COND) - (FUNCTIONS COND)) - (COMS (FNS CL:IF) - (SPECIAL-FORMS CL:IF) - (PROP DMACRO CL:IF)) - (COMS (* \; - "Interlisp NLAMBDA definitions on LLINTERP") + "The Interlisp function is on LLINTERP") + (SPECIAL-FORMS PROG1) + (FUNCTIONS PROG1)) + (COMS (SPECIAL-FORMS LET* LET) + (PROP MACRO LET LET*) + (FNS \\LET*-RECURSION |\\LETtran|)) + (COMS (SPECIAL-FORMS COND) + (FUNCTIONS COND)) + (COMS (FNS CL:IF) + (SPECIAL-FORMS CL:IF) + (PROP DMACRO CL:IF)) + (COMS (* \; + "Interlisp NLAMBDA definitions on LLINTERP") (* \; "both special form and macro") - (FUNCTIONS AND OR) - (SPECIAL-FORMS AND OR)) - (COMS (* \; "BLOCK and RETURN go together") - (FNS CL:BLOCK) - (PROP DMACRO CL:BLOCK) - (SPECIAL-FORMS CL:BLOCK) - (FUNCTIONS RETURN) - (FNS CL:RETURN-FROM) - (SPECIAL-FORMS CL:RETURN-FROM)) - (COMS (* \; - "IL and CL versions of FUNCTION.") - (FNS CL:FUNCTION) - (PROP DMACRO CL:FUNCTION) - (SPECIAL-FORMS CL:FUNCTION FUNCTION) - (FUNCTIONS CL:FUNCTIONP CL:COMPILED-FUNCTION-P)) - (SPECIAL-FORMS CL:MULTIPLE-VALUE-CALL CL:MULTIPLE-VALUE-PROG1) - (FNS COMP.CL-EVAL) - (FUNCTIONS CL:EVALHOOK CL:APPLYHOOK) - (VARIABLES *EVALHOOK* *APPLYHOOK* CL::*SKIP-EVALHOOK* CL::*SKIP-APPLYHOOK*) - (COMS (* \; "CONSTANTS mechanism") - (FNS CL:CONSTANTP) - (SETFS CL:CONSTANTP) - (FUNCTIONS XCL::SET-CONSTANTP)) - (COMS (* \; - "Interlisp SETQ for Common Lisp and vice versa") - (SPECIAL-FORMS CL:SETQ SETQ) - (PROP DMACRO CL:SETQ) - - (* |;;| + (FUNCTIONS AND OR) + (SPECIAL-FORMS AND OR)) + (COMS (* \; "BLOCK and RETURN go together") + (FNS CL:BLOCK) + (PROP DMACRO CL:BLOCK) + (SPECIAL-FORMS CL:BLOCK) + (FUNCTIONS RETURN) + (FNS CL:RETURN-FROM) + (SPECIAL-FORMS CL:RETURN-FROM)) + (COMS (* \; "IL and CL versions of FUNCTION.") + (FNS CL:FUNCTION) + (PROP DMACRO CL:FUNCTION) + (SPECIAL-FORMS CL:FUNCTION FUNCTION) + (FUNCTIONS CL:FUNCTIONP CL:COMPILED-FUNCTION-P)) + (SPECIAL-FORMS CL:MULTIPLE-VALUE-CALL CL:MULTIPLE-VALUE-PROG1) + (FNS COMP.CL-EVAL) + (FUNCTIONS CL:EVALHOOK CL:APPLYHOOK) + (VARIABLES *EVALHOOK* *APPLYHOOK* CL::*SKIP-EVALHOOK* CL::*SKIP-APPLYHOOK*) + (COMS (* \; "CONSTANTS mechanism") + (FNS CL:CONSTANTP) + (SETFS CL:CONSTANTP) + (FUNCTIONS XCL::SET-CONSTANTP)) + (COMS (* \; + "Interlisp SETQ for Common Lisp and vice versa") + (SPECIAL-FORMS CL:SETQ SETQ) + (PROP DMACRO CL:SETQ) + + (* |;;|  "An nlambda definition for cl:setq so cmldeffer may use cl:setq will run in the init") - (FNS CL:SETQ) - (FUNCTIONS SETQ) - (FNS SET-SYMBOL) - (FUNCTIONS CL:PSETQ) - (FUNCTIONS SETQQ)) - (COMS (SPECIAL-FORMS CL:CATCH CL:THROW CL:UNWIND-PROTECT) - (FNS CL:THROW CL:CATCH CL:UNWIND-PROTECT)) - (COMS (FUNCTIONS PROG PROG*) - (SPECIAL-FORMS GO CL:TAGBODY) - (FNS CL:TAGBODY)) - (COMS (* \; "for macro caching") - (FNS CACHEMACRO) - (VARIABLES *MACROEXPAND-HOOK*) - (VARS (*IN-COMPILER-LET* NIL))) - (COMS - (* |;;| "PROCLAIM and friends.") + (FNS CL:SETQ) + (FUNCTIONS SETQ) + (FNS SET-SYMBOL) + (FUNCTIONS CL:PSETQ) + (FUNCTIONS SETQQ)) + (COMS (SPECIAL-FORMS CL:CATCH CL:THROW CL:UNWIND-PROTECT) + (FNS CL:THROW CL:CATCH CL:UNWIND-PROTECT)) + (COMS (FUNCTIONS PROG PROG*) + (SPECIAL-FORMS GO CL:TAGBODY) + (FNS CL:TAGBODY)) + (COMS (* \; "for macro caching") + (FNS CACHEMACRO) + (VARIABLES *MACROEXPAND-HOOK*) + (VARS (*IN-COMPILER-LET* NIL))) + (COMS + (* |;;| "PROCLAIM and friends.") - - (* |;;| "Needs to come first because DEFVARs put it out. With package code in the init, also need this here rather than CMLEVAL") + + (* |;;| "Needs to come first because DEFVARs put it out. With package code in the init, also need this here rather than CMLEVAL") - (FUNCTIONS CL:PROCLAIM) + (FUNCTIONS CL:PROCLAIM) (* \; "used by the codewalker, too") - (MACROS VARIABLE-GLOBALLY-SPECIAL-P VARIABLE-GLOBAL-P) - (FUNCTIONS XCL::DECL-SPECIFIER-P XCL::SET-DECL-SPECIFIER-P) - (FUNCTIONS XCL::GLOBALLY-NOTINLINE-P XCL::SET-GLOBALLY-NOTINLINE-P) - (SETFS XCL::DECL-SPECIFIER-P XCL::GLOBALLY-NOTINLINE-P) - (PROP PROPTYPE GLOBALLY-SPECIAL GLOBALVAR SI::DECLARATION-SPECIFIER - SI::GLOBALLY-NOTINLINE SPECIAL-FORM)) - (PROP (FILETYPE MAKEFILE-ENVIRONMENT) - CMLEVAL) - (DECLARE\: EVAL@COMPILE DONTCOPY (OPTIMIZERS CL-EVAL-FN3-CALL)) - (DECLARE\: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY (LOCALVARS . T)) - (DECLARE\: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS - (ADDVARS (NLAMA CL:TAGBODY CL:UNWIND-PROTECT CL:CATCH CL:SETQ CL:BLOCK - CL:EVAL-WHEN CL:COMPILER-LET COMMON-LISP) - (NLAML CL:THROW CL:FUNCTION CL:RETURN-FROM CL:IF) - (LAMA CL:APPLY CL:FUNCALL))))) + (MACROS VARIABLE-GLOBALLY-SPECIAL-P VARIABLE-GLOBAL-P) + (FUNCTIONS XCL::DECL-SPECIFIER-P XCL::SET-DECL-SPECIFIER-P) + (FUNCTIONS XCL::GLOBALLY-NOTINLINE-P XCL::SET-GLOBALLY-NOTINLINE-P) + (SETFS XCL::DECL-SPECIFIER-P XCL::GLOBALLY-NOTINLINE-P) + (PROP PROPTYPE GLOBALLY-SPECIAL GLOBALVAR SI::DECLARATION-SPECIFIER + SI::GLOBALLY-NOTINLINE SPECIAL-FORM)) + (PROP (FILETYPE MAKEFILE-ENVIRONMENT) + CMLEVAL) + (DECLARE\: EVAL@COMPILE DONTCOPY (OPTIMIZERS CL-EVAL-FN3-CALL)) + (DECLARE\: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY (LOCALVARS . T)) + (DECLARE\: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS + (ADDVARS (NLAMA CL:TAGBODY CL:UNWIND-PROTECT CL:CATCH CL:SETQ CL:BLOCK CL:EVAL-WHEN + CL:COMPILER-LET COMMON-LISP) + (NLAML CL:THROW CL:FUNCTION CL:RETURN-FROM CL:IF) + (LAMA CL:APPLY CL:FUNCALL))))) @@ -165,144 +165,146 @@ (CL:SYMBOL (EQ CL::X CL::Y)) (CL:NUMBER (EQL CL::X CL::Y)) (CONS (AND (CL:CONSP CL::Y) - (CL:EQUAL (CAR CL::X) - (CAR CL::Y)) - (CL:EQUAL (CDR CL::X) - (CDR CL::Y)))) + (CL:EQUAL (CAR CL::X) + (CAR CL::Y)) + (CL:EQUAL (CDR CL::X) + (CDR CL::Y)))) (STRING (AND (CL:STRINGP CL::Y) - (CL:STRING= CL::X CL::Y))) + (CL:STRING= CL::X CL::Y))) (CL:BIT-VECTOR (AND (CL:BIT-VECTOR-P CL::Y) - (LET ((CL::SX (CL:LENGTH CL::X))) - (AND (EQL CL::SX (CL:LENGTH CL::Y)) - (CL:DOTIMES (CL::I CL::SX T) - (CL:IF (NOT (EQ (BIT CL::X CL::I) - (BIT CL::Y CL::I))) - (RETURN NIL))))))) + (LET ((CL::SX (CL:LENGTH CL::X))) + (AND (EQL CL::SX (CL:LENGTH CL::Y)) + (CL:DOTIMES (CL::I CL::SX T) + (CL:IF (NOT (EQ (BIT CL::X CL::I) + (BIT CL::Y CL::I))) + (RETURN NIL))))))) (PATHNAME (AND (CL:PATHNAMEP CL::Y) - (%PATHNAME-EQUAL CL::X CL::Y))) + (%PATHNAME-EQUAL CL::X CL::Y))) (T (EQ CL::X CL::Y)))) (CL:DEFUN CL:EQUALP (CL::X CL::Y) (CL:TYPECASE CL::X (CL:SYMBOL (EQ CL::X CL::Y)) (CL:NUMBER (AND (CL:NUMBERP CL::Y) - (= CL::X CL::Y))) + (= CL::X CL::Y))) (CONS (AND (CL:CONSP CL::Y) - (CL:EQUALP (CAR CL::X) - (CAR CL::Y)) - (CL:EQUALP (CDR CL::X) - (CDR CL::Y)))) + (CL:EQUALP (CAR CL::X) + (CAR CL::Y)) + (CL:EQUALP (CDR CL::X) + (CDR CL::Y)))) (CL:CHARACTER (AND (CL:CHARACTERP CL::Y) - (CL:CHAR-EQUAL CL::X CL::Y))) + (CL:CHAR-EQUAL CL::X CL::Y))) (STRING (AND (CL:STRINGP CL::Y) - (STRING-EQUAL CL::X CL::Y))) + (STRING-EQUAL CL::X CL::Y))) (PATHNAME (AND (CL:PATHNAMEP CL::Y) - (%PATHNAME-EQUAL CL::X CL::Y))) + (%PATHNAME-EQUAL CL::X CL::Y))) (CL:VECTOR (AND (CL:VECTORP CL::Y) - (LET ((CL::SX (CL:LENGTH CL::X))) - (AND (EQL CL::SX (CL:LENGTH CL::Y)) - (CL:DOTIMES (CL::I CL::SX T) - (CL:IF (NOT (CL:EQUALP (CL:AREF CL::X CL::I) - (CL:AREF CL::Y CL::I))) - (RETURN NIL))))))) + (LET ((CL::SX (CL:LENGTH CL::X))) + (AND (EQL CL::SX (CL:LENGTH CL::Y)) + (CL:DOTIMES (CL::I CL::SX T) + (CL:IF (NOT (CL:EQUALP (CL:AREF CL::X CL::I) + (CL:AREF CL::Y CL::I))) + (RETURN NIL))))))) (CL:ARRAY (AND (CL:ARRAYP CL::Y) - (CL:EQUAL (CL:ARRAY-DIMENSIONS CL::X) - (CL:ARRAY-DIMENSIONS CL::Y)) - (LET ((CL::FX (%FLATTEN-ARRAY CL::X)) - (CL::FY (%FLATTEN-ARRAY CL::Y))) - (CL:DOTIMES (CL::I (CL:ARRAY-TOTAL-SIZE CL::X) - T) - (CL:IF (NOT (CL:EQUALP (CL:AREF CL::FX CL::I) - (CL:AREF CL::FY CL::I))) - (RETURN NIL)))))) + (CL:EQUAL (CL:ARRAY-DIMENSIONS CL::X) + (CL:ARRAY-DIMENSIONS CL::Y)) + (LET ((CL::FX (%FLATTEN-ARRAY CL::X)) + (CL::FY (%FLATTEN-ARRAY CL::Y))) + (CL:DOTIMES (CL::I (CL:ARRAY-TOTAL-SIZE CL::X) + T) + (CL:IF (NOT (CL:EQUALP (CL:AREF CL::FX CL::I) + (CL:AREF CL::FY CL::I))) + (RETURN NIL)))))) (T (* |;;| "so that datatypes will be properly compared") (OR (EQ CL::X CL::Y) - (LET ((CL::TYPENAME (TYPENAME CL::X))) - (AND (EQ CL::TYPENAME (TYPENAME CL::Y)) - (LET ((CL::DESCRIPTORS (GETDESCRIPTORS CL::TYPENAME))) - (CL:IF CL::DESCRIPTORS - (FOR CL::FIELD IN CL::DESCRIPTORS - ALWAYS (CL:EQUALP (FETCHFIELD CL::FIELD CL::X) - (FETCHFIELD CL::FIELD CL::Y))))))))))) + (LET ((CL::TYPENAME (TYPENAME CL::X))) + (AND (EQ CL::TYPENAME (TYPENAME CL::Y)) + (LET ((CL::DESCRIPTORS (GETDESCRIPTORS CL::TYPENAME))) + (CL:IF CL::DESCRIPTORS + (FOR CL::FIELD IN CL::DESCRIPTORS + ALWAYS (CL:EQUALP (FETCHFIELD CL::FIELD CL::X) + (FETCHFIELD CL::FIELD CL::Y))))))))))) (* |;;| "For the byte compiler: Optimize by constant fold and coerce to EQ where possible") -(PUTPROPS CL:EQUAL BYTEMACRO COMP.EQ) +(PUTPROPS CL:EQUAL BYTEMACRO COMP.EQ) -(PUTPROPS CL:EQUALP BYTEMACRO COMP.EQ) +(PUTPROPS CL:EQUALP BYTEMACRO COMP.EQ) -(PUTPROPS CL:EQUAL DOPVAL (2 CMLEQUAL)) +(PUTPROPS CL:EQUAL DOPVAL (2 CMLEQUAL)) (CL:DEFUN \\REMOVE-DECLS (CL::BODY CL::ENVIRONMENT) (* |;;;| "This is like parse-body, except that it returns the body and a list of specials declared in this frame. It side-effects the environment to mark the specials.") (PROG ((CL::SPECIALS NIL) - CL::FORM) - CL::NEXT-FORM - (CL:IF (NULL CL::BODY) - (GO CL::DONE)) - (CL:SETQ CL::FORM (CAR CL::BODY)) - CL::RETRY-FORM - (COND - ((OR (CL:ATOM CL::FORM) - (NOT (CL:SYMBOLP (CAR CL::FORM)))) - (GO CL::DONE)) - ((EQ (CAR CL::FORM) - 'DECLARE) - (CL:MAPC #'(CL:LAMBDA (CL:DECLARATION) - (CL:WHEN (CL:CONSP CL:DECLARATION) - (CL:WHEN (OR (EQ (CAR CL:DECLARATION) - 'CL:SPECIAL) - (EQ (CAR CL:DECLARATION) - 'SPECVARS)) - (CL:IF (EQ (CDR CL:DECLARATION) - T) + CL::FORM) + CL::NEXT-FORM + (CL:IF (NULL CL::BODY) + (GO CL::DONE)) + (CL:SETQ CL::FORM (CAR CL::BODY)) + CL::RETRY-FORM + (COND + ((OR (CL:ATOM CL::FORM) + (NOT (CL:SYMBOLP (CAR CL::FORM)))) + (GO CL::DONE)) + ((EQ (CAR CL::FORM) + 'DECLARE) + (CL:MAPC #'(CL:LAMBDA (CL:DECLARATION) + (CL:WHEN (CL:CONSP CL:DECLARATION) + (CL:WHEN (OR (EQ (CAR CL:DECLARATION) + 'CL:SPECIAL) + (EQ (CAR CL:DECLARATION) + 'SPECVARS)) + (CL:IF (EQ (CDR CL:DECLARATION) + T) (* |;;| "(specvars . t) refers to all variables inside this scope, not just those bound in this frame. So handling (specvars . t) by declaring the variables in this frame special would not be correct. Hence print a warning and continue.") - (CL:WARN + (CL:WARN "(IL:SPECVARS . T) has no effect in the CL evaluator." - ) - (CL:MAPC #'(CL:LAMBDA (CL::NAME) - (CL:PUSH CL::NAME CL::SPECIALS)) - (CDR CL:DECLARATION)))))) - (CDR CL::FORM)) - (CL:POP CL::BODY) - (GO CL::NEXT-FORM)) - ((CL:SPECIAL-FORM-P (CAR CL::FORM)) - (GO CL::DONE)) - (T (LET ((CL::NEW-FORM (CL:MACROEXPAND-1 CL::FORM CL::ENVIRONMENT))) - (COND - ((AND (NOT (EQ CL::NEW-FORM CL::FORM)) - (CL:CONSP CL::NEW-FORM)) - (CL:SETQ CL::FORM CL::NEW-FORM) - (GO CL::RETRY-FORM)) - (T (GO CL::DONE)))))) - CL::DONE - (RETURN (CL:IF CL::SPECIALS - (PROGN (FOR CL::VAR IN CL::SPECIALS - DO (CL:SETF (ENVIRONMENT-VARS CL::ENVIRONMENT) - (LIST* CL::VAR *SPECIAL-BINDING-MARK* - (ENVIRONMENT-VARS CL::ENVIRONMENT)))) - (CL:VALUES CL::BODY CL::SPECIALS)) - CL::BODY)))) + ) + (CL:MAPC #'(CL:LAMBDA (CL::NAME) + (CL:PUSH CL::NAME CL::SPECIALS)) + (CDR CL:DECLARATION)))))) + (CDR CL::FORM)) + (CL:POP CL::BODY) + (GO CL::NEXT-FORM)) + ((CL:SPECIAL-FORM-P (CAR CL::FORM)) + (GO CL::DONE)) + (T (LET ((CL::NEW-FORM (CL:MACROEXPAND-1 CL::FORM CL::ENVIRONMENT))) + (COND + ((AND (NOT (EQ CL::NEW-FORM CL::FORM)) + (CL:CONSP CL::NEW-FORM)) + (CL:SETQ CL::FORM CL::NEW-FORM) + (GO CL::RETRY-FORM)) + (T (GO CL::DONE)))))) + CL::DONE + (RETURN (CL:IF CL::SPECIALS + (PROGN (FOR CL::VAR IN CL::SPECIALS DO (CL:SETF (ENVIRONMENT-VARS + CL::ENVIRONMENT) + (LIST* CL::VAR + *SPECIAL-BINDING-MARK* + (ENVIRONMENT-VARS + CL::ENVIRONMENT)))) + (CL:VALUES CL::BODY CL::SPECIALS)) + CL::BODY)))) (CL:DEFUN CL:SPECIAL-FORM-P (CL::X) (GET CL::X 'SPECIAL-FORM)) (DEFINE-SPECIAL-FORM INTERLISP PROGN) -(PUTPROPS INTERLISP DMACRO ((X . Y) - (PROGN X . Y))) +(PUTPROPS INTERLISP DMACRO ((X . Y) + (PROGN X . Y))) -(PUTPROPS COMMON-LISP DMACRO ((X) - X)) +(PUTPROPS COMMON-LISP DMACRO ((X) + X)) (DEFINEQ (common-lisp @@ -422,21 +424,20 @@ (CL:DEFPARAMETER *CHECK-ARGUMENT-COUNTS* NIL) -(DEFGLOBALVAR *SPECIAL-BINDING-MARK* - "Variable specially bound. This string should never be visible") +(DEFGLOBALVAR *SPECIAL-BINDING-MARK* "Variable specially bound. This string should never be visible") -(CL:DEFCONSTANT CL:LAMBDA-LIST-KEYWORDS '(&OPTIONAL &REST &KEY &AUX &BODY &WHOLE - &ALLOW-OTHER-KEYS &ENVIRONMENT &CONTEXT)) +(CL:DEFCONSTANT CL:LAMBDA-LIST-KEYWORDS '(&OPTIONAL &REST &KEY &AUX &BODY &WHOLE &ALLOW-OTHER-KEYS + &ENVIRONMENT &CONTEXT)) (CL:DEFCONSTANT CL:CALL-ARGUMENTS-LIMIT 512) (CL:DEFCONSTANT CL:LAMBDA-PARAMETERS-LIMIT 512) (CL:DEFSTRUCT (CLOSURE (:PRINT-FUNCTION (LAMBDA (CLOSURE STREAM) - (LET ((*PRINT-RADIX* NIL)) - (CL:FORMAT STREAM "#" - (\\HILOC CLOSURE) - (\\LOLOC CLOSURE)))))) + (LET ((*PRINT-RADIX* NIL)) + (CL:FORMAT STREAM "#" + (\\HILOC CLOSURE) + (\\LOLOC CLOSURE)))))) (* |;;;| "An interpreted lexical closure. Contains the function and an environment object.") @@ -444,14 +445,13 @@ ENVIRONMENT) (CL:DEFSTRUCT (ENVIRONMENT (:CONSTRUCTOR \\MAKE-ENVIRONMENT NIL) - (:COPIER \\COPY-ENVIRONMENT) - (:PRINT-FUNCTION (LAMBDA (ENV STREAM DEPTH) - (DECLARE (IGNORE DEPTH)) - (LET ((*PRINT-RADIX* NIL)) - (CL:FORMAT STREAM - "#" - (\\HILOC ENV) - (\\LOLOC ENV)))))) + (:COPIER \\COPY-ENVIRONMENT) + (:PRINT-FUNCTION (LAMBDA (ENV STREAM DEPTH) + (DECLARE (IGNORE DEPTH)) + (LET ((*PRINT-RADIX* NIL)) + (CL:FORMAT STREAM "#" + (\\HILOC ENV) + (\\LOLOC ENV)))))) (* |;;;| "An environment used by the Common Lisp interpreter. Every environment contains all of the information of its parents. That is, new child environments are made by copying the parent and then pushing new data onto one of the fields. This makes certain tests very fast.") @@ -472,31 +472,30 @@ TAGBODIES) (DEFMACRO \\MAKE-CHILD-ENVIRONMENT (PARENT &KEY ((:BLOCK (BLOCK-NAME BLOCK-BLIP)) - NIL BLOCK-P) - ((:TAGBODY (TAGBODY-TAIL TAGBODY-BLIP)) - NIL TAGBODY-P)) + NIL BLOCK-P) + ((:TAGBODY (TAGBODY-TAIL TAGBODY-BLIP)) + NIL TAGBODY-P)) `(LET* (($$PARENT ,PARENT) ($$NEW-ENV (CL:IF $$PARENT (\\COPY-ENVIRONMENT $$PARENT) (\\MAKE-ENVIRONMENT)))) ,@(AND BLOCK-P `((CL:SETF (ENVIRONMENT-BLOCKS $$NEW-ENV) - (LIST* ,BLOCK-NAME ,BLOCK-BLIP (ENVIRONMENT-BLOCKS $$NEW-ENV))) - )) + (LIST* ,BLOCK-NAME ,BLOCK-BLIP (ENVIRONMENT-BLOCKS $$NEW-ENV))))) ,@(AND TAGBODY-P `((CL:SETF (ENVIRONMENT-TAGBODIES $$NEW-ENV) - (LIST* ,TAGBODY-TAIL ,TAGBODY-BLIP (ENVIRONMENT-TAGBODIES - $$NEW-ENV))))) + (LIST* ,TAGBODY-TAIL ,TAGBODY-BLIP (ENVIRONMENT-TAGBODIES + $$NEW-ENV))))) $$NEW-ENV)) (DEFINEQ (CL:EVAL - (LAMBDA (CL::EXPRESSION CL::ENVIRONMENT) (* \; "Edited 1-Apr-92 12:39 by jds") + (LAMBDA (CL::EXPRESSION CL::ENVIRONMENT) (* \; "Edited 15-Apr-2024 20:00 by lmm") + (* \; "Edited 1-Apr-92 12:39 by jds") (* |;;| "This is in Interlisp and not a DEFUN to help avoid bootstrap death, although bootstrap death is quite possible anyway if, for example, any of the macros here are in Common Lisp and the macro definitions are interpreted.") (DECLARE (LOCALVARS . T)) (COND - ((AND *EVALHOOK* (NOT (PROG1 CL::*SKIP-EVALHOOK* (CL:SETQ CL::*SKIP-EVALHOOK* NIL) - ))) + ((AND *EVALHOOK* (NOT (PROG1 CL::*SKIP-EVALHOOK* (CL:SETQ CL::*SKIP-EVALHOOK* NIL)))) (LET ((CL::HOOKFN *EVALHOOK*) (*EVALHOOK* NIL)) (CL:FUNCALL CL::HOOKFN CL::EXPRESSION CL::ENVIRONMENT))) @@ -510,29 +509,27 @@ (T (LET (CL::LOC CL::VAL) (CL:BLOCK CL::EVAL-VARIABLE (CL:WHEN CL::ENVIRONMENT - (|for| CL::TAIL |on| (ENVIRONMENT-VARS - CL::ENVIRONMENT) - |by| (CDDR CL::TAIL) - |when| (EQ CL::EXPRESSION (CAR CL::TAIL)) + (|for| CL::TAIL |on| (ENVIRONMENT-VARS CL::ENVIRONMENT) + |by| (CDDR CL::TAIL) |when| (EQ CL::EXPRESSION + (CAR CL::TAIL)) |do| (CL:SETQ CL::VAL (CADR CL::TAIL)) - (COND - ((EQ CL::VAL *SPECIAL-BINDING-MARK*) + (COND + ((EQ CL::VAL *SPECIAL-BINDING-MARK*) - (* |;;| - "return from FOR loop, skipping to SPECIALS code below.") + (* |;;| + "return from FOR loop, skipping to SPECIALS code below.") - (RETURN NIL)) - (T (CL:RETURN-FROM CL::EVAL-VARIABLE - CL::VAL))))) + (RETURN NIL)) + (T (CL:RETURN-FROM CL::EVAL-VARIABLE CL::VAL))))) (* |;;| - "following copied from \\EVALVAR in the Interlisp interpreter") + "following copied from \\EVALVAR in the Interlisp interpreter") (SETQ CL::LOC (\\STKSCAN CL::EXPRESSION)) (COND ((EQ (CL:SETQ CL::VAL (\\GETBASEPTR CL::LOC 0)) 'NOBIND) (* \; - "Value is NOBIND even if it was not found as the top-level value.") + "Value is NOBIND even if it was not found as the top-level value.") (CL:ERROR 'UNBOUND-VARIABLE :NAME CL::EXPRESSION)) (T CL::VAL))))))) (CONS @@ -549,21 +546,21 @@ (CL-EVAL-FN3-CALL (CAR CL::EXPRESSION) CL::ENVIRONMENT) ((CL:EVAL CL::ENVIRONMENT))))) - (T (LET ((CL::FN-DEFN (AND CL::ENVIRONMENT (CL:GETF (ENVIRONMENT-FUNCTIONS - CL::ENVIRONMENT) - (CAR CL::EXPRESSION))))) + (T (LET ((CL::FN-DEFN (AND CL::ENVIRONMENT (CL:GETF (ENVIRONMENT-FUNCTIONS + CL::ENVIRONMENT) + (CAR CL::EXPRESSION))))) (COND ((NULL CL::FN-DEFN) (* \; - "The normal case: the function is not lexically-defined.") + "The normal case: the function is not lexically-defined.") (CASE (ARGTYPE (CAR CL::EXPRESSION)) ((0 2) (* |;;| "has a Interlisp/CommonLisp lambda-spread definition") (CL:IF (AND *APPLYHOOK* (NOT (PROG1 CL::*SKIP-APPLYHOOK* - (CL:SETQ - CL::*SKIP-APPLYHOOK* - NIL)))) + (CL:SETQ + CL::*SKIP-APPLYHOOK* + NIL)))) (LET* ((CL::ARGS (CL:MAPCAR #'(CL:LAMBDA (CL::ARG) (CL:EVAL CL::ARG CL::ENVIRONMENT) @@ -580,31 +577,31 @@ ((CL:EVAL CL::ENVIRONMENT)))))) (T (* |;;| - "in Common Lisp, special form overrides nlambda definition") + "in Common Lisp, special form overrides nlambda definition") (* |;;| "note that the GET will error if not a symbol. ") (LET ((CL::TEMP (AND (CL:SYMBOLP (CAR CL::EXPRESSION)) - (GET (CAR CL::EXPRESSION) - 'SPECIAL-FORM)))) + (GET (CAR CL::EXPRESSION) + 'SPECIAL-FORM)))) (COND (CL::TEMP (* \; - "CAR is the name of a special form.") + "CAR is the name of a special form.") (CL:FUNCALL CL::TEMP (CDR CL::EXPRESSION) CL::ENVIRONMENT)) ((CL:SETQ CL::TEMP (CL:MACRO-FUNCTION (CAR CL::EXPRESSION - ))) + ))) (* \; "CAR is the name of a macro") (CL:EVAL (CL:FUNCALL CL::TEMP CL::EXPRESSION - CL::ENVIRONMENT) + CL::ENVIRONMENT) CL::ENVIRONMENT)) (T (ERROR "Undefined car of form" (CAR CL::EXPRESSION))) ))))) ((EQ (CAR CL::FN-DEFN) :MACRO) (* \; "A use of a lexical macro.") (CL:EVAL (CL:FUNCALL (CDR CL::FN-DEFN) - CL::EXPRESSION CL::ENVIRONMENT) + CL::EXPRESSION CL::ENVIRONMENT) CL::ENVIRONMENT)) (T (* \; "A call to a lexical function") (LET ((CL::ARGCOUNT 0)) @@ -612,13 +609,13 @@ CL::ARGCOUNT (CDR CL::FN-DEFN) ((CL:EVAL CL::ENVIRONMENT)))))))))) - ((OR CL:NUMBER STRING CL:CHARACTER CL:BIT-VECTOR) + (T + (* |;;| "3.1.2.1.3 Self-Evaluating Objects") - (* |;;| "all of these are defined to be self-evaluating") + (* |;;| "A form that is neither a symbol nor a cons is defined to be a self-evaluating object. Evaluating such an object yields the same object as a result.") + + (* |;;| "See https://interlisp.org/clhs/Issues/iss145_w") - CL::EXPRESSION) - (T (CL:CERROR "Return the invalid expression as its own value" - "~S is an invalid expression for EVAL." CL::EXPRESSION) CL::EXPRESSION)))))) (\\eval-invoke-lambda @@ -898,7 +895,7 @@ (DEFMACRO ARG-REF (BLOCK N) `(\\GETBASEPTR ,BLOCK (LLSH ,N 1))) -(PUTPROPS .COMPILER-SPREAD-ARGUMENTS. DMACRO (APPLY COMP.SPREAD)) +(PUTPROPS .COMPILER-SPREAD-ARGUMENTS. DMACRO (APPLY COMP.SPREAD)) (DEFINEQ (declared-special @@ -937,35 +934,33 @@ cl::av))))) ) -(PUTPROPS CL:APPLY DMACRO (DEFMACRO (FN &REST ARGS) (CASE COMPILE.CONTEXT - ((EFFECT RETURN) - `(LET - ((FN ,FN) +(PUTPROPS CL:APPLY DMACRO (DEFMACRO (FN &REST ARGS) (CASE COMPILE.CONTEXT + ((EFFECT RETURN) + `(LET ((FN ,FN) (CNT ,(LENGTH (CDR ARGS)))) (.SPREAD. ((OPCODES) \,@ ARGS) CNT FN))) - (T - (* |;;| - "otherwise might not return multiple values") + (T + (* |;;| + "otherwise might not return multiple values") - 'IGNOREMACRO)))) + 'IGNOREMACRO)))) -(PUTPROPS CL:FUNCALL DMACRO (DEFMACRO (FN &REST ARGS) (COND - ((AND (NLISTP FN) - (EVERY ARGS (FUNCTION NLISTP))) - `((OPCODES APPLYFN) - ,@ARGS - ,(LENGTH ARGS) - ,FN)) - (T - (LET ((TEM (GENSYM))) - `((LAMBDA (,TEM) - ((OPCODES APPLYFN) - ,@ARGS - ,(LENGTH ARGS) - ,TEM)) - ,FN)))))) +(PUTPROPS CL:FUNCALL DMACRO (DEFMACRO (FN &REST ARGS) (COND + ((AND (NLISTP FN) + (EVERY ARGS (FUNCTION NLISTP))) + `((OPCODES APPLYFN) + ,@ARGS + ,(LENGTH ARGS) + ,FN)) + (T (LET ((TEM (GENSYM))) + `((LAMBDA (,TEM) + ((OPCODES APPLYFN) + ,@ARGS + ,(LENGTH ARGS) + ,TEM)) + ,FN)))))) @@ -998,19 +993,19 @@ (comp.progn (cdr \\a))))) ) -(PUTPROPS CL:COMPILER-LET DMACRO COMP.COMPILER-LET) +(PUTPROPS CL:COMPILER-LET DMACRO COMP.COMPILER-LET) (DEFINE-SPECIAL-FORM CL:COMPILER-LET (CL::ARGS &REST CL::BODY &ENVIRONMENT CL::ENV) (LET ((*IN-COMPILER-LET* T)) - (DECLARE (CL:SPECIAL *IN-COMPILER-LET*)) (* \; - "the *IN-COMPILER-LET* is for macro-caching. It says: don't cache macros under compiler lets") + (DECLARE (CL:SPECIAL *IN-COMPILER-LET*)) (* \; + "the *IN-COMPILER-LET* is for macro-caching. It says: don't cache macros under compiler lets") (CL:PROGV (FOR CL::X IN CL::ARGS COLLECT (IF (CL:CONSP CL::X) - THEN (CAR CL::X) - ELSE CL::X)) + THEN (CAR CL::X) + ELSE CL::X)) (FOR CL::X IN CL::ARGS COLLECT (IF (CL:CONSP CL::X) - THEN (CL:EVAL (CADR CL::X) - CL::ENV) - ELSE NIL)) + THEN (CL:EVAL (CADR CL::X) + CL::ENV) + ELSE NIL)) (\\EVAL-PROGN CL::BODY CL::ENV)))) @@ -1022,17 +1017,18 @@ (LET* ((CL::NEW-ENV (\\MAKE-CHILD-ENVIRONMENT CL::ENV)) (CL::FUNCTIONS (ENVIRONMENT-FUNCTIONS CL::NEW-ENV))) (FOR CL::MACRO-DEFN IN CL::MACRO-DEFNS - DO (CL:SETQ CL::FUNCTIONS - (LIST* (CAR CL::MACRO-DEFN) - (CONS :MACRO `(CL:LAMBDA (SI::$$MACRO-FORM SI::$$MACRO-ENVIRONMENT) - (CL:BLOCK ,(CAR CL::MACRO-DEFN) - ,(PARSE-DEFMACRO (CADR CL::MACRO-DEFN) - 'SI::$$MACRO-FORM - (CDDR CL::MACRO-DEFN) - (CAR CL::MACRO-DEFN) - NIL :ENVIRONMENT - 'SI::$$MACRO-ENVIRONMENT)))) - CL::FUNCTIONS))) + DO (CL:SETQ CL::FUNCTIONS (LIST* (CAR CL::MACRO-DEFN) + (CONS :MACRO + `(CL:LAMBDA (SI::$$MACRO-FORM + SI::$$MACRO-ENVIRONMENT) + (CL:BLOCK ,(CAR CL::MACRO-DEFN) + ,(PARSE-DEFMACRO (CADR CL::MACRO-DEFN) + 'SI::$$MACRO-FORM + (CDDR CL::MACRO-DEFN) + (CAR CL::MACRO-DEFN) + NIL :ENVIRONMENT + 'SI::$$MACRO-ENVIRONMENT)))) + CL::FUNCTIONS))) (CL:SETF (ENVIRONMENT-FUNCTIONS CL::NEW-ENV) CL::FUNCTIONS) (\\EVAL-PROGN CL::BODY CL::NEW-ENV))) @@ -1042,9 +1038,9 @@ (CL::FUNCTIONS (ENVIRONMENT-FUNCTIONS CL::NEW-ENV))) (FOR CL::FN-DEFN IN CL::FN-DEFNS DO (CL:SETQ CL::FUNCTIONS - (LIST* (CL:FIRST CL::FN-DEFN) - (CONS :FUNCTION - (MAKE-CLOSURE :FUNCTION + (LIST* (CL:FIRST CL::FN-DEFN) + (CONS :FUNCTION (MAKE-CLOSURE + :FUNCTION (CL:MULTIPLE-VALUE-BIND (CL::BODY CL::DECLS) (PARSE-BODY (CDDR CL::FN-DEFN) @@ -1054,7 +1050,7 @@ (CL:BLOCK ,(CL:FIRST CL::FN-DEFN) ,@CL::BODY))) :ENVIRONMENT CL::ENV)) - CL::FUNCTIONS))) + CL::FUNCTIONS))) (CL:SETF (ENVIRONMENT-FUNCTIONS CL::NEW-ENV) CL::FUNCTIONS) (\\EVAL-PROGN CL::BODY CL::NEW-ENV))) @@ -1064,22 +1060,22 @@ (CL::FUNCTIONS (ENVIRONMENT-FUNCTIONS CL::NEW-ENV))) (FOR CL::FN-DEFN IN CL::FN-DEFNS DO (CL:SETQ CL::FUNCTIONS - (LIST* (CL:FIRST CL::FN-DEFN) - (CONS :FUNCTION + (LIST* (CL:FIRST CL::FN-DEFN) + (CONS :FUNCTION - (* |;;| "Must share the environment object so that all of the new lexical function bindings appear in each new functions environment.") + (* |;;| "Must share the environment object so that all of the new lexical function bindings appear in each new functions environment.") - (MAKE-CLOSURE :FUNCTION - (CL:MULTIPLE-VALUE-BIND - (CL::BODY CL::DECLS) - (PARSE-BODY (CDDR CL::FN-DEFN) - CL::NEW-ENV T) - `(CL:LAMBDA ,(CL:SECOND CL::FN-DEFN) - ,@CL::DECLS - (CL:BLOCK ,(CL:FIRST CL::FN-DEFN) - ,@CL::BODY))) - :ENVIRONMENT CL::NEW-ENV)) - CL::FUNCTIONS))) + (MAKE-CLOSURE :FUNCTION + (CL:MULTIPLE-VALUE-BIND + (CL::BODY CL::DECLS) + (PARSE-BODY (CDDR CL::FN-DEFN) + CL::NEW-ENV T) + `(CL:LAMBDA ,(CL:SECOND CL::FN-DEFN) + ,@CL::DECLS + (CL:BLOCK ,(CL:FIRST CL::FN-DEFN) + ,@CL::BODY))) + :ENVIRONMENT CL::NEW-ENV)) + CL::FUNCTIONS))) (CL:SETF (ENVIRONMENT-FUNCTIONS CL::NEW-ENV) CL::FUNCTIONS) (\\EVAL-PROGN CL::BODY CL::NEW-ENV))) @@ -1088,8 +1084,8 @@ (DEFINE-SPECIAL-FORM THE (CL::TYPE-SPEC CL::FORM &ENVIRONMENT CL::ENV) (CL:IF (AND (CL:CONSP CL::TYPE-SPEC) - (EQ (CAR CL::TYPE-SPEC) - 'CL:VALUES)) + (EQ (CAR CL::TYPE-SPEC) + 'CL:VALUES)) (LET ((CL:VALUES (CL:MULTIPLE-VALUE-LIST (CL:EVAL CL::FORM CL::ENV)))) (CL:IF (CL:NOTEVERY #'(CL:LAMBDA (CL::VALUE CL::SPEC) (TYPEP CL::VALUE CL::SPEC)) @@ -1102,17 +1098,15 @@ CL::VALUE (CHECK-TYPE-FAIL T CL::FORM CL::VALUE CL::TYPE-SPEC NIL))))) -(PUTPROPS THE DMACRO ((SPEC FORM) - FORM)) +(PUTPROPS THE DMACRO ((SPEC FORM) + FORM)) -(PUTPROPS CL:EVAL-WHEN DMACRO (DEFMACRO (OPTIONS &BODY BODY) (AND (OR (FMEMB 'COMPILE OPTIONS) - (FMEMB 'CL:COMPILE OPTIONS) - ) - (MAPC BODY - (FUNCTION CL:EVAL))) - (AND (OR (FMEMB 'LOAD OPTIONS) - (FMEMB 'CL:LOAD OPTIONS)) - `(PROGN ,@BODY)))) +(PUTPROPS CL:EVAL-WHEN DMACRO (DEFMACRO (OPTIONS &BODY BODY) (AND (OR (FMEMB 'COMPILE OPTIONS) + (FMEMB 'CL:COMPILE OPTIONS)) + (MAPC BODY (FUNCTION CL:EVAL))) + (AND (OR (FMEMB 'LOAD OPTIONS) + (FMEMB 'CL:LOAD OPTIONS)) + `(PROGN ,@BODY)))) (DEFINEQ (cl:eval-when @@ -1125,8 +1119,8 @@ (DEFINE-SPECIAL-FORM CL:EVAL-WHEN (CL::TAGS &REST CL::BODY &ENVIRONMENT CL::ENV) (AND (OR (CL:MEMBER 'CL:EVAL CL::TAGS) - (CL:MEMBER 'EVAL CL::TAGS)) - (\\EVAL-PROGN CL::BODY CL::ENV))) + (CL:MEMBER 'EVAL CL::TAGS)) + (\\EVAL-PROGN CL::BODY CL::ENV))) (DEFINE-SPECIAL-FORM DECLARE FALSE) @@ -1166,10 +1160,10 @@ (DEFINE-SPECIAL-FORM PROG1 (CL:FIRST &REST CL:REST &ENVIRONMENT CL::ENV) (LET ((CL::VAL (CL:EVAL CL:FIRST CL::ENV))) (CL:TAGBODY PROG1 (CL:IF CL:REST - (PROGN (CL:EVAL (CAR CL:REST) - CL::ENV) - (CL:SETQ CL:REST (CDR CL:REST))) - (CL:RETURN-FROM PROG1 CL::VAL)) + (PROGN (CL:EVAL (CAR CL:REST) + CL::ENV) + (CL:SETQ CL:REST (CDR CL:REST))) + (CL:RETURN-FROM PROG1 CL::VAL)) (GO PROG1)))) (DEFMACRO PROG1 (CL:FIRST &REST CL:REST) @@ -1187,30 +1181,28 @@ (* |;;| "Initializes the variables, binding them to new values all at once, then executes the remaining forms as in a PROGN.") (CL:MULTIPLE-VALUE-BIND (CL::\\BODY CL::SPECIALS) - (\\REMOVE-DECLS CL::BODY (CL:SETQ CL::\\NEW-ENV (\\MAKE-CHILD-ENVIRONMENT - CL::ENV))) + (\\REMOVE-DECLS CL::BODY (CL:SETQ CL::\\NEW-ENV (\\MAKE-CHILD-ENVIRONMENT CL::ENV))) (* |;;| "Note that since remove decls side-effects the environment, variables which are declared special inside this scope will cause references inside the variable value forms to do special reference.") (LET ((CL::ENV-VARS (ENVIRONMENT-VARS CL::\\NEW-ENV)) CL::SPECVARS CL::SPECVALS CL::VALUE) - (FOR CL::VAR IN CL::VARS - DO (COND - ((CL:CONSP CL::VAR) + (FOR CL::VAR IN CL::VARS DO (COND + ((CL:CONSP CL::VAR) - (* |;;| "NEW-ENV current has all of the new specials, but none of the new lexicals. This is the right environment to eval in.") + (* |;;| "NEW-ENV current has all of the new specials, but none of the new lexicals. This is the right environment to eval in.") - (CL:SETQ CL::VALUE (CL:EVAL (CADR CL::VAR) - CL::\\NEW-ENV)) - (CL:SETQ CL::VAR (CAR CL::VAR))) - (T (CL:SETQ CL::VALUE NIL))) - (CHECK-BINDABLE CL::VAR) - (IF (OR (FMEMB CL::VAR CL::SPECIALS) - (VARIABLE-GLOBALLY-SPECIAL-P CL::VAR)) - THEN (CL:PUSH CL::VAR CL::SPECVARS) - (CL:PUSH CL::VALUE CL::SPECVALS) - ELSE (CL:SETQ CL::ENV-VARS (LIST* CL::VAR CL::VALUE CL::ENV-VARS))) - ) + (CL:SETQ CL::VALUE (CL:EVAL (CADR CL::VAR) + CL::\\NEW-ENV)) + (CL:SETQ CL::VAR (CAR CL::VAR))) + (T (CL:SETQ CL::VALUE NIL))) + (CHECK-BINDABLE CL::VAR) + (IF (OR (FMEMB CL::VAR CL::SPECIALS) + (VARIABLE-GLOBALLY-SPECIAL-P CL::VAR)) + THEN (CL:PUSH CL::VAR CL::SPECVARS) + (CL:PUSH CL::VALUE CL::SPECVALS) + ELSE (CL:SETQ CL::ENV-VARS (LIST* CL::VAR CL::VALUE + CL::ENV-VARS)))) (CL:SETF (ENVIRONMENT-VARS CL::\\NEW-ENV) CL::ENV-VARS) (CL:IF CL::SPECVARS @@ -1218,9 +1210,9 @@ (\\EVAL-PROGN CL::\\BODY CL::\\NEW-ENV)) (\\EVAL-PROGN CL::\\BODY CL::\\NEW-ENV))))) -(PUTPROPS LET MACRO (X (|\\LETtran| X))) +(PUTPROPS LET MACRO (X (|\\LETtran| X))) -(PUTPROPS LET* MACRO (X (|\\LETtran| X T))) +(PUTPROPS LET* MACRO (X (|\\LETtran| X T))) (DEFINEQ (\\let*-recursion @@ -1292,21 +1284,21 @@ (DEFINE-SPECIAL-FORM COND (&REST CL::COND-CLAUSES &ENVIRONMENT CL::ENVIRONMENT) (PROG NIL - CL::CONDLOOP - (COND - ((NULL CL::COND-CLAUSES) - (RETURN NIL)) - ((NULL (CDAR CL::COND-CLAUSES)) - (RETURN (OR (CL:EVAL (CAAR CL::COND-CLAUSES) - CL::ENVIRONMENT) - (PROGN (CL:SETQ CL::COND-CLAUSES (CDR CL::COND-CLAUSES)) - (GO CL::CONDLOOP))))) - ((CL:EVAL (CAAR CL::COND-CLAUSES) - CL::ENVIRONMENT) - (RETURN (\\EVAL-PROGN (CDAR CL::COND-CLAUSES) - CL::ENVIRONMENT))) - (T (CL:SETQ CL::COND-CLAUSES (CDR CL::COND-CLAUSES)) - (GO CL::CONDLOOP))))) + CL::CONDLOOP + (COND + ((NULL CL::COND-CLAUSES) + (RETURN NIL)) + ((NULL (CDAR CL::COND-CLAUSES)) + (RETURN (OR (CL:EVAL (CAAR CL::COND-CLAUSES) + CL::ENVIRONMENT) + (PROGN (CL:SETQ CL::COND-CLAUSES (CDR CL::COND-CLAUSES)) + (GO CL::CONDLOOP))))) + ((CL:EVAL (CAAR CL::COND-CLAUSES) + CL::ENVIRONMENT) + (RETURN (\\EVAL-PROGN (CDAR CL::COND-CLAUSES) + CL::ENVIRONMENT))) + (T (CL:SETQ CL::COND-CLAUSES (CDR CL::COND-CLAUSES)) + (GO CL::CONDLOOP))))) (DEFMACRO COND (&REST CL::TAIL) (CL:IF CL::TAIL @@ -1345,7 +1337,7 @@ (CL:EVAL CL::THEN CL::ENVIRONMENT) (CL:EVAL CL::ELSE CL::ENVIRONMENT))) -(PUTPROPS CL:IF DMACRO COMP.IF) +(PUTPROPS CL:IF DMACRO COMP.IF) @@ -1380,7 +1372,7 @@ (RETURN T)) ((NULL (CDR CL::AND-CLAUSES)) (RETURN (CL:EVAL (CAR CL::AND-CLAUSES) - CL::ENV))) + CL::ENV))) (T (CL:IF (CL:EVAL (CAR CL::AND-CLAUSES) CL::ENV) (CL:POP CL::AND-CLAUSES) @@ -1388,14 +1380,12 @@ (DEFINE-SPECIAL-FORM OR (&REST CL::TAIL &ENVIRONMENT CL::ENV) (BIND CL::VAL FOR OLD CL::TAIL ON CL::TAIL (COND - ((NULL (CDR CL::TAIL)) - (RETURN (CL:EVAL - (CAR CL::TAIL) - CL::ENV))) - ((CL:SETQ CL::VAL - (CL:EVAL (CAR CL::TAIL) - CL::ENV)) - (RETURN CL::VAL))))) + ((NULL (CDR CL::TAIL)) + (RETURN (CL:EVAL (CAR CL::TAIL) + CL::ENV))) + ((CL:SETQ CL::VAL (CL:EVAL (CAR CL::TAIL) + CL::ENV)) + (RETURN CL::VAL))))) @@ -1409,7 +1399,7 @@ (\\evprogn (cdr cl::tail)))) ) -(PUTPROPS CL:BLOCK DMACRO COMP.BLOCK) +(PUTPROPS CL:BLOCK DMACRO COMP.BLOCK) (DEFINE-SPECIAL-FORM CL:BLOCK (CL::NAME &REST CL::\\BODY &ENVIRONMENT CL::ENVIRONMENT) @@ -1444,21 +1434,21 @@ (DEFINE-SPECIAL-FORM CL:RETURN-FROM (CL::BLOCK-NAME CL::EXPR &ENVIRONMENT CL::ENV) (LET ((CL::BLIP (AND CL::ENV (CL:GETF (ENVIRONMENT-BLOCKS CL::ENV) - CL::BLOCK-NAME)))) + CL::BLOCK-NAME)))) (CL:IF (AND CL::BLOCK-NAME (NULL CL::BLIP)) (CL:ERROR 'ILLEGAL-RETURN :TAG CL::BLOCK-NAME) (LET ((CL::\\BLK CL::BLOCK-NAME) (CL::VALS (CL:MULTIPLE-VALUE-LIST (CL:EVAL CL::EXPR CL::ENV)))) (COND (CL::BLIP (* \; - "This is a CL RETURN-FROM, so do the throw.") + "This is a CL RETURN-FROM, so do the throw.") (HANDLER-BIND ((ILLEGAL-THROW #'(CL:LAMBDA (CL::C) (DECLARE (IGNORE CL::C)) (CL:ERROR 'ILLEGAL-RETURN :TAG CL::\\BLK)))) (CL:THROW CL::BLIP (CL:VALUES-LIST CL::VALS)))) (T (* \; - "This is an IL RETURN, so return from the closest enclosing \\PROG0.") + "This is an IL RETURN, so return from the closest enclosing \\PROG0.") (RETVALUES (STKPOS '\\PROG0) CL::VALS T))))))) @@ -1478,10 +1468,10 @@ cl::fn))) ) -(PUTPROPS CL:FUNCTION DMACRO (DEFMACRO (X) (COND - ((CL:SYMBOLP X) - `(CL:SYMBOL-FUNCTION ',X)) - (T `(FUNCTION ,X))))) +(PUTPROPS CL:FUNCTION DMACRO (DEFMACRO (X) (COND + ((CL:SYMBOLP X) + `(CL:SYMBOL-FUNCTION ',X)) + (T `(FUNCTION ,X))))) (DEFINE-SPECIAL-FORM CL:FUNCTION (CL::FN &ENVIRONMENT CL::ENVIRONMENT) (COND @@ -1489,9 +1479,8 @@ (LET (CL::FN-DEFN) (COND ((OR (NULL CL::ENVIRONMENT) - (NULL (CL:SETQ CL::FN-DEFN (CL:GETF (ENVIRONMENT-FUNCTIONS CL::ENVIRONMENT - ) - CL::FN)))) + (NULL (CL:SETQ CL::FN-DEFN (CL:GETF (ENVIRONMENT-FUNCTIONS CL::ENVIRONMENT) + CL::FN)))) (CL:SYMBOL-FUNCTION CL::FN)) ((EQ (CAR CL::FN-DEFN) :FUNCTION) @@ -1499,11 +1488,11 @@ (T (CL:ERROR "The lexical macro ~S is not a legal argument to ~S." CL::FN 'CL:FUNCTION))))) ((OR (NULL CL::ENVIRONMENT) - (AND (FOR CL::VALUE IN (CDR (ENVIRONMENT-VARS CL::ENVIRONMENT)) - BY CDDR ALWAYS (EQ CL::VALUE *SPECIAL-BINDING-MARK*)) - (NULL (ENVIRONMENT-FUNCTIONS CL::ENVIRONMENT)) - (NULL (ENVIRONMENT-BLOCKS CL::ENVIRONMENT)) - (NULL (ENVIRONMENT-TAGBODIES CL::ENVIRONMENT)))) + (AND (FOR CL::VALUE IN (CDR (ENVIRONMENT-VARS CL::ENVIRONMENT)) BY CDDR + ALWAYS (EQ CL::VALUE *SPECIAL-BINDING-MARK*)) + (NULL (ENVIRONMENT-FUNCTIONS CL::ENVIRONMENT)) + (NULL (ENVIRONMENT-BLOCKS CL::ENVIRONMENT)) + (NULL (ENVIRONMENT-TAGBODIES CL::ENVIRONMENT)))) (* |;;| "Environment is empty: don't have to make a closure.") @@ -1517,7 +1506,7 @@ (T CL::FN)) :ENVIRONMENT (\\COPY-ENVIRONMENT CL::ENVIRONMENT) (* \; - "environment is copied so that forms that side-effect it (such as LET*) will work correctly.") + "environment is copied so that forms that side-effect it (such as LET*) will work correctly.") )))) (DEFINE-SPECIAL-FORM FUNCTION (FN &OPTIONAL FUNARGP &ENVIRONMENT ENVIRONMENT) @@ -1532,19 +1521,19 @@ (LET (FN-DEFN) (COND ((OR (NULL ENVIRONMENT) - (NULL (SETQ FN-DEFN (CL:GETF (ENVIRONMENT-FUNCTIONS ENVIRONMENT) - FN)))) + (NULL (SETQ FN-DEFN (CL:GETF (ENVIRONMENT-FUNCTIONS ENVIRONMENT) + FN)))) FN) ((EQ (CAR FN-DEFN) :FUNCTION) (CDR FN-DEFN)) (T (CL:ERROR "The lexical macro ~S is not a legal argument to ~S." FN 'FUNCTION))))) ((OR (NULL ENVIRONMENT) - (AND (FOR VALUE IN (CDR (ENVIRONMENT-VARS ENVIRONMENT)) BY CDDR - ALWAYS (EQ VALUE *SPECIAL-BINDING-MARK*)) - (NULL (ENVIRONMENT-FUNCTIONS ENVIRONMENT)) - (NULL (ENVIRONMENT-BLOCKS ENVIRONMENT)) - (NULL (ENVIRONMENT-TAGBODIES ENVIRONMENT)))) + (AND (FOR VALUE IN (CDR (ENVIRONMENT-VARS ENVIRONMENT)) BY CDDR + ALWAYS (EQ VALUE *SPECIAL-BINDING-MARK*)) + (NULL (ENVIRONMENT-FUNCTIONS ENVIRONMENT)) + (NULL (ENVIRONMENT-BLOCKS ENVIRONMENT)) + (NULL (ENVIRONMENT-TAGBODIES ENVIRONMENT)))) FN) (T (MAKE-CLOSURE :FUNCTION (COND ((EQ (CAR FN) @@ -1557,29 +1546,28 @@ (CL:DEFUN CL:FUNCTIONP (CL::FN) (AND (OR (CL:SYMBOLP CL::FN) - (CL:COMPILED-FUNCTION-P CL::FN) - (AND (CL:CONSP CL::FN) - (EQ (CAR CL::FN) - 'CL:LAMBDA)) - (CLOSURE-P CL::FN)) - T)) + (CL:COMPILED-FUNCTION-P CL::FN) + (AND (CL:CONSP CL::FN) + (EQ (CAR CL::FN) + 'CL:LAMBDA)) + (CLOSURE-P CL::FN)) + T)) (CL:DEFUN CL:COMPILED-FUNCTION-P (CL::FN) (OR (TYPEP CL::FN 'COMPILED-CLOSURE) - (AND (ARRAYP CL::FN) - (EQ (|fetch| (ARRAYP TYP) |of| CL::FN) - \\ST.CODE)))) + (AND (ARRAYP CL::FN) + (EQ (|fetch| (ARRAYP TYP) |of| CL::FN) + \\ST.CODE)))) (DEFINE-SPECIAL-FORM CL:MULTIPLE-VALUE-CALL (CL::FN &REST CL::ARGS &ENVIRONMENT CL::ENV) (* |;;| - "for interpreted calls only. The macro inserts a \\MVLIST call after the computation of TAIL") + "for interpreted calls only. The macro inserts a \\MVLIST call after the computation of TAIL") (CL:APPLY (CL:EVAL CL::FN CL::ENV) (FOR CL::X IN CL::ARGS JOIN (\\MVLIST (CL:EVAL CL::X CL::ENV))))) -(DEFINE-SPECIAL-FORM CL:MULTIPLE-VALUE-PROG1 (CL::FORM &REST CL::OTHER-FORMS &ENVIRONMENT CL::ENV - ) +(DEFINE-SPECIAL-FORM CL:MULTIPLE-VALUE-PROG1 (CL::FORM &REST CL::OTHER-FORMS &ENVIRONMENT CL::ENV) (CL:VALUES-LIST (PROG1 (CL:MULTIPLE-VALUE-LIST (CL:EVAL CL::FORM CL::ENV)) (FOR CL::X IN CL::OTHER-FORMS DO (CL:EVAL CL::X CL::ENV))))) (DEFINEQ @@ -1597,8 +1585,7 @@ (CL::*SKIP-APPLYHOOK* NIL)) (CL:EVAL CL::FORM CL::ENV))) -(CL:DEFUN CL:APPLYHOOK (CL:FUNCTION CL::ARGS CL::EVALHOOKFN CL::APPLYHOOKFN &OPTIONAL CL::ENV - ) +(CL:DEFUN CL:APPLYHOOK (CL:FUNCTION CL::ARGS CL::EVALHOOKFN CL::APPLYHOOKFN &OPTIONAL CL::ENV) "Evaluates Form with *Evalhook* bound to Evalhookfn and *Applyhook* bound to applyhookfn. Ignores these hooks once, for the top-level evaluation of Form." (DECLARE (IGNORE CL::ENV)) @@ -1669,19 +1656,18 @@ (DEFINE-SPECIAL-FORM CL:SETQ (&REST CL::TAIL &ENVIRONMENT CL::ENV) (LET (CL::VALUE) (WHILE CL::TAIL DO (CL:SETQ CL::VALUE (SET-SYMBOL (CL:POP CL::TAIL) - (CL:EVAL (CL:POP CL::TAIL) - CL::ENV) - CL::ENV))) + (CL:EVAL (CL:POP CL::TAIL) + CL::ENV) + CL::ENV))) CL::VALUE)) (DEFINE-SPECIAL-FORM SETQ (VAR VALUE &ENVIRONMENT ENV) (SET-SYMBOL VAR (CL:EVAL VALUE ENV) ENV)) -(PUTPROPS CL:SETQ DMACRO (DEFMACRO (X Y &REST CL:REST) `(PROGN - (SETQ ,X ,Y) - ,@(AND CL:REST - `((CL:SETQ ,@CL:REST)))))) +(PUTPROPS CL:SETQ DMACRO (DEFMACRO (X Y &REST CL:REST) `(PROGN + (SETQ ,X ,Y) + ,@(AND CL:REST `((CL:SETQ ,@CL:REST)))))) @@ -1755,18 +1741,17 @@ (DEFMACRO CL:PSETQ (&REST TAIL) (AND TAIL `(PROGN (SETQ ,(|pop| TAIL) - ,(CL:IF (CDR TAIL) - `(PROG1 ,(POP TAIL) - (CL:PSETQ ,@TAIL)) - (CAR TAIL))) - NIL))) + ,(CL:IF (CDR TAIL) + `(PROG1 ,(POP TAIL) + (CL:PSETQ ,@TAIL)) + (CAR TAIL))) + NIL))) -(DEFMACRO SETQQ (SYMBOL VALUE) (* \; - "so common lisp interpreter will know about it") +(DEFMACRO SETQQ (SYMBOL VALUE) (* \; + "so common lisp interpreter will know about it") `(SETQ ,SYMBOL ',VALUE)) -(DEFINE-SPECIAL-FORM CL:CATCH (CL::CATCH-TAG &REST CL::\\CATCH-FORMS &ENVIRONMENT CL::\\CATCH-ENV - ) +(DEFINE-SPECIAL-FORM CL:CATCH (CL::CATCH-TAG &REST CL::\\CATCH-FORMS &ENVIRONMENT CL::\\CATCH-ENV) (CL:CATCH (CL:EVAL CL::CATCH-TAG CL::\\CATCH-ENV) (\\EVAL-PROGN CL::\\CATCH-FORMS CL::\\CATCH-ENV))) @@ -1806,24 +1791,22 @@ (LET* ,VARS ,@DECLS (CL:TAGBODY ,@BODY)))) (DEFINE-SPECIAL-FORM GO (CL::\\TAG &ENVIRONMENT CL::ENV) - (BIND CL::TAIL FOR CL::TAGBODIES ON (AND CL::ENV (ENVIRONMENT-TAGBODIES CL::ENV)) - BY CDDR WHEN (CL:SETQ CL::TAIL (CL:MEMBER CL::\\TAG (CAR CL::TAGBODIES))) + (BIND CL::TAIL FOR CL::TAGBODIES ON (AND CL::ENV (ENVIRONMENT-TAGBODIES CL::ENV)) BY CDDR + WHEN (CL:SETQ CL::TAIL (CL:MEMBER CL::\\TAG (CAR CL::TAGBODIES))) - (* |;;| "MUST use EQL, as tags may be integers.") + (* |;;| "MUST use EQL, as tags may be integers.") DO (HANDLER-BIND ((ILLEGAL-THROW #'(CL:LAMBDA (CL::C) - (CL:ERROR 'ILLEGAL-GO :TAG CL::\\TAG)))) - (CL:THROW (CADR CL::TAGBODIES) - CL::TAIL)) FINALLY (CL:ERROR 'ILLEGAL-GO :TAG CL::\\TAG))) + (CL:ERROR 'ILLEGAL-GO :TAG CL::\\TAG)))) + (CL:THROW (CADR CL::TAGBODIES) + CL::TAIL)) FINALLY (CL:ERROR 'ILLEGAL-GO :TAG CL::\\TAG))) (DEFINE-SPECIAL-FORM CL:TAGBODY (&REST CL::\\TAGBODY-TAIL &ENVIRONMENT CL::ENV) (LET* ((CL::BLIP (CONS NIL NIL)) - (CL::\\NEW-ENV (\\MAKE-CHILD-ENVIRONMENT CL::ENV :TAGBODY (CL::\\TAGBODY-TAIL CL::BLIP) - ))) + (CL::\\NEW-ENV (\\MAKE-CHILD-ENVIRONMENT CL::ENV :TAGBODY (CL::\\TAGBODY-TAIL CL::BLIP)))) (WHILE (CL:SETQ CL::\\TAGBODY-TAIL (CL:CATCH CL::BLIP - (FOR CL::X IN CL::\\TAGBODY-TAIL - UNLESS (CL:SYMBOLP CL::X) - DO (CL:EVAL CL::X CL::\\NEW-ENV))) - )))) + (FOR CL::X IN CL::\\TAGBODY-TAIL + UNLESS (CL:SYMBOLP CL::X) + DO (CL:EVAL CL::X CL::\\NEW-ENV))))))) (DEFINEQ (cl:tagbody @@ -1884,43 +1867,37 @@ (CL:WHEN (CL:CONSP CL::PROCLAMATION) (CASE (CAR CL::PROCLAMATION) - (CL:SPECIAL (FOR CL::X IN (CDR CL::PROCLAMATION) DO (CL:SETF ( + (CL:SPECIAL (FOR CL::X IN (CDR CL::PROCLAMATION) DO (CL:SETF (VARIABLE-GLOBALLY-SPECIAL-P + CL::X) + T) + (CL:SETF (VARIABLE-GLOBAL-P CL::X) + NIL) + (CL:SETF (CL:CONSTANTP CL::X) + NIL))) + (GLOBAL (FOR CL::X IN (CDR CL::PROCLAMATION) DO (CL:SETF (VARIABLE-GLOBAL-P CL::X) + T) + (CL:SETF (VARIABLE-GLOBALLY-SPECIAL-P + CL::X) + NIL) + (CL:SETF (CL:CONSTANTP CL::X) + NIL))) + (SI::CONSTANT (FOR CL::X IN (CDR CL::PROCLAMATION) DO (CL:SETF (CL:CONSTANTP CL::X) + T) + (CL:SETF (VARIABLE-GLOBAL-P CL::X) + NIL) + (CL:SETF ( VARIABLE-GLOBALLY-SPECIAL-P - CL::X) - T) - (CL:SETF (VARIABLE-GLOBAL-P - CL::X) - NIL) - (CL:SETF (CL:CONSTANTP - CL::X) - NIL))) - (GLOBAL (FOR CL::X IN (CDR CL::PROCLAMATION) DO (CL:SETF (VARIABLE-GLOBAL-P - CL::X) - T) - (CL:SETF ( - VARIABLE-GLOBALLY-SPECIAL-P - CL::X) - NIL) - (CL:SETF (CL:CONSTANTP - CL::X) - NIL))) - (SI::CONSTANT (FOR CL::X IN (CDR CL::PROCLAMATION) - DO (CL:SETF (CL:CONSTANTP CL::X) - T) - (CL:SETF (VARIABLE-GLOBAL-P CL::X) - NIL) - (CL:SETF (VARIABLE-GLOBALLY-SPECIAL-P CL::X) - NIL))) - (CL:DECLARATION (FOR CL::X IN (CDR CL::PROCLAMATION) - DO (CL:SETF (XCL::DECL-SPECIFIER-P CL::X) - T))) - (CL:NOTINLINE (FOR CL::X IN (CDR CL::PROCLAMATION) - DO (CL:SETF (XCL::GLOBALLY-NOTINLINE-P CL::X) - T))) - (CL:INLINE (FOR CL::X IN (CDR CL::PROCLAMATION) DO (CL:SETF ( - XCL::GLOBALLY-NOTINLINE-P - CL::X) - NIL)))))) + CL::X) + NIL))) + (CL:DECLARATION (FOR CL::X IN (CDR CL::PROCLAMATION) DO (CL:SETF (XCL::DECL-SPECIFIER-P + CL::X) + T))) + (CL:NOTINLINE (FOR CL::X IN (CDR CL::PROCLAMATION) DO (CL:SETF (XCL::GLOBALLY-NOTINLINE-P + CL::X) + T))) + (CL:INLINE (FOR CL::X IN (CDR CL::PROCLAMATION) DO (CL:SETF (XCL::GLOBALLY-NOTINLINE-P + CL::X) + NIL)))))) @@ -1928,10 +1905,10 @@ (DECLARE\: EVAL@COMPILE -(PUTPROPS VARIABLE-GLOBALLY-SPECIAL-P MACRO ((VARIABLE) +(PUTPROPS VARIABLE-GLOBALLY-SPECIAL-P MACRO ((VARIABLE) (GET VARIABLE 'GLOBALLY-SPECIAL))) -(PUTPROPS VARIABLE-GLOBAL-P MACRO ((VARIABLE) +(PUTPROPS VARIABLE-GLOBAL-P MACRO ((VARIABLE) (GET VARIABLE 'GLOBALVAR))) ) @@ -1953,40 +1930,40 @@ (CL:DEFSETF XCL::GLOBALLY-NOTINLINE-P XCL::SET-GLOBALLY-NOTINLINE-P) -(PUTPROPS GLOBALLY-SPECIAL PROPTYPE IGNORE) +(PUTPROPS GLOBALLY-SPECIAL PROPTYPE IGNORE) -(PUTPROPS GLOBALVAR PROPTYPE IGNORE) +(PUTPROPS GLOBALVAR PROPTYPE IGNORE) -(PUTPROPS SI::DECLARATION-SPECIFIER PROPTYPE IGNORE) +(PUTPROPS SI::DECLARATION-SPECIFIER PROPTYPE IGNORE) -(PUTPROPS SI::GLOBALLY-NOTINLINE PROPTYPE IGNORE) +(PUTPROPS SI::GLOBALLY-NOTINLINE PROPTYPE IGNORE) -(PUTPROPS SPECIAL-FORM PROPTYPE IGNORE) +(PUTPROPS SPECIAL-FORM PROPTYPE IGNORE) -(PUTPROPS CMLEVAL FILETYPE CL:COMPILE-FILE) +(PUTPROPS CMLEVAL FILETYPE BCOMPL) -(PUTPROPS CMLEVAL MAKEFILE-ENVIRONMENT (:READTABLE "XCL" :PACKAGE "INTERLISP")) +(PUTPROPS CMLEVAL MAKEFILE-ENVIRONMENT (:READTABLE "XCL" :PACKAGE "INTERLISP")) (DECLARE\: EVAL@COMPILE DONTCOPY (DEFOPTIMIZER CL-EVAL-FN3-CALL (ARG1 ARG2 &ENVIRONMENT ENV) - (* |;;| "Emit a call to FN3 after pushing only 2 arguments (the other having been pushed by IL:.COMPILER-SPREAD-ARGUMENTS. earlier in the game). Used in CL:EVAL.") + (* |;;| "Emit a call to FN3 after pushing only 2 arguments (the other having been pushed by IL:.COMPILER-SPREAD-ARGUMENTS. earlier in the game). Used in CL:EVAL.") - (COND - ((FMEMB :4-BYTE (COMPILER::ENV-TARGET-ARCHITECTURE ENV)) - `((OPCODES FN3 0 0 0 (FN . \\EVAL-INVOKE-LAMBDA) - RETURN) - ,ARG1 - ,ARG2)) - ((FMEMB :3-BYTE (COMPILER::ENV-TARGET-ARCHITECTURE ENV)) - `((OPCODES FN3 0 0 (FN . \\EVAL-INVOKE-LAMBDA) - RETURN) - ,ARG1 - ,ARG2)) - (T `((OPCODES FN3 0 (FN . \\EVAL-INVOKE-LAMBDA) - RETURN) - ,ARG1 - ,ARG2)))) + (COND + ((FMEMB :4-BYTE (COMPILER::ENV-TARGET-ARCHITECTURE ENV)) + `((OPCODES FN3 0 0 0 (FN . \\EVAL-INVOKE-LAMBDA) + RETURN) + ,ARG1 + ,ARG2)) + ((FMEMB :3-BYTE (COMPILER::ENV-TARGET-ARCHITECTURE ENV)) + `((OPCODES FN3 0 0 (FN . \\EVAL-INVOKE-LAMBDA) + RETURN) + ,ARG1 + ,ARG2)) + (T `((OPCODES FN3 0 (FN . \\EVAL-INVOKE-LAMBDA) + RETURN) + ,ARG1 + ,ARG2)))) ) (DECLARE\: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY (DECLARE\: DOEVAL@COMPILE DONTCOPY @@ -1996,26 +1973,36 @@ ) (DECLARE\: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS -(ADDTOVAR NLAMA CL:TAGBODY CL:UNWIND-PROTECT CL:CATCH CL:SETQ CL:BLOCK CL:EVAL-WHEN - CL:COMPILER-LET COMMON-LISP) +(ADDTOVAR NLAMA CL:TAGBODY CL:UNWIND-PROTECT CL:CATCH CL:SETQ CL:BLOCK CL:EVAL-WHEN CL:COMPILER-LET + COMMON-LISP) (ADDTOVAR NLAML CL:THROW CL:FUNCTION CL:RETURN-FROM CL:IF) (ADDTOVAR LAMA CL:APPLY CL:FUNCALL) ) -(PUTPROPS CMLEVAL COPYRIGHT ("Venue & Xerox Corporation" 1986 1987 1988 1990 1991 1992 1993)) (DECLARE\: DONTCOPY - (FILEMAP (NIL (16590 16771 (COMMON-LISP 16600 . 16769)) (16810 22264 (\\TRANSLATE-CL\:LAMBDA 16820 . -22262)) (25766 50966 (CL:EVAL 25776 . 34711) (\\EVAL-INVOKE-LAMBDA 34713 . 35913) ( -\\INTERPRET-ARGUMENTS 35915 . 47331) (\\INTERPRETER-LAMBDA 47333 . 48020) (CHECK-BINDABLE 48022 . -48678) (CHECK-KEYWORDS 48680 . 50964)) (51110 51755 (DECLARED-SPECIAL 51120 . 51753)) (51820 52506 ( -CL:FUNCALL 51830 . 51993) (CL:APPLY 51995 . 52504)) (54754 56393 (CL:COMPILER-LET 54764 . 55558) ( -COMP.COMPILER-LET 55560 . 56391)) (63209 63498 (CL:EVAL-WHEN 63219 . 63496)) (63925 64325 ( -\\EVAL-PROGN 63935 . 64323)) (67720 71340 (\\LET*-RECURSION 67730 . 69073) (|\\LETtran| 69075 . 71338) -) (73162 73424 (CL:IF 73172 . 73422)) (75753 75917 (CL:BLOCK 75763 . 75915)) (76563 77808 ( -CL:RETURN-FROM 76573 . 77806)) (79253 79554 (CL:FUNCTION 79263 . 79552)) (84577 84797 (COMP.CL-EVAL -84587 . 84795)) (86277 87489 (CL:CONSTANTP 86287 . 87487)) (88889 89579 (CL:SETQ 88899 . 89577)) ( -89832 91441 (SET-SYMBOL 89842 . 91439)) (92634 93303 (CL:THROW 92644 . 92857) (CL:CATCH 92859 . 93069) - (CL:UNWIND-PROTECT 93071 . 93301)) (94809 95158 (CL:TAGBODY 94819 . 95156)) (95194 96093 (CACHEMACRO -95204 . 96091))))) + (FILEMAP (NIL (7500 8538 (CL:EQUAL 7500 . 8538)) (8540 10948 (CL:EQUALP 8540 . 10948)) (11194 14364 ( +\\REMOVE-DECLS 11194 . 14364)) (14366 14435 (CL:SPECIAL-FORM-P 14366 . 14435)) (14645 14826 ( +COMMON-LISP 14655 . 14824)) (14865 20319 (\\TRANSLATE-CL\:LAMBDA 14875 . 20317)) (22737 23656 ( +\\MAKE-CHILD-ENVIRONMENT 22737 . 23656)) (23657 48810 (CL:EVAL 23667 . 32555) (\\EVAL-INVOKE-LAMBDA +32557 . 33757) (\\INTERPRET-ARGUMENTS 33759 . 45175) (\\INTERPRETER-LAMBDA 45177 . 45864) ( +CHECK-BINDABLE 45866 . 46522) (CHECK-KEYWORDS 46524 . 48808)) (48812 48882 (ARG-REF 48812 . 48882)) ( +48958 49603 (DECLARED-SPECIAL 48968 . 49601)) (49668 50354 (CL:FUNCALL 49678 . 49841) (CL:APPLY 49843 + . 50352)) (52425 54064 (CL:COMPILER-LET 52435 . 53229) (COMP.COMPILER-LET 53231 . 54062)) (60751 +61040 (CL:EVAL-WHEN 60761 . 61038)) (61305 61364 (CL:LOCALLY 61305 . 61364)) (61458 61858 ( +\\EVAL-PROGN 61468 . 61856)) (62476 62686 (PROG1 62476 . 62686)) (65421 69041 (\\LET*-RECURSION 65431 + . 66774) (|\\LETtran| 66776 . 69039)) (69860 70776 (COND 69860 . 70776)) (70777 71039 (CL:IF 70787 . +71037)) (71429 71622 (AND 71429 . 71622)) (71624 71940 (OR 71624 . 71940)) (73132 73296 (CL:BLOCK +73142 . 73294)) (73872 73945 (RETURN 73872 . 73945)) (73946 75191 (CL:RETURN-FROM 73956 . 75189)) ( +76636 76937 (CL:FUNCTION 76646 . 76935)) (80578 80852 (CL:FUNCTIONP 80578 . 80852)) (80854 81064 ( +CL:COMPILED-FUNCTION-P 80854 . 81064)) (81704 81924 (COMP.CL-EVAL 81714 . 81922)) (81926 82357 ( +CL:EVALHOOK 81926 . 82357)) (82359 82980 (CL:APPLYHOOK 82359 . 82980)) (83369 84581 (CL:CONSTANTP +83379 . 84579)) (84633 84921 (XCL::SET-CONSTANTP 84633 . 84921)) (85873 86563 (CL:SETQ 85883 . 86561)) + (86565 86815 (SETQ 86565 . 86815)) (86816 88425 (SET-SYMBOL 86826 . 88423)) (88427 88730 (CL:PSETQ +88427 . 88730)) (88732 88946 (SETQQ 88732 . 88946)) (89562 90231 (CL:THROW 89572 . 89785) (CL:CATCH +89787 . 89997) (CL:UNWIND-PROTECT 89999 . 90229)) (90233 90349 (PROG 90233 . 90349)) (90351 90469 ( +PROG* 90351 . 90469)) (91627 91976 (CL:TAGBODY 91637 . 91974)) (92012 92911 (CACHEMACRO 92022 . 92909) +) (93184 96222 (CL:PROCLAIM 93184 . 96222)) (96559 96653 (XCL::DECL-SPECIFIER-P 96559 . 96653)) (96655 + 96791 (XCL::SET-DECL-SPECIFIER-P 96655 . 96791)) (96793 96884 (XCL::GLOBALLY-NOTINLINE-P 96793 . +96884)) (96886 97019 (XCL::SET-GLOBALLY-NOTINLINE-P 96886 . 97019))))) STOP diff --git a/sources/CMLEVAL.LCOM b/sources/CMLEVAL.LCOM index d6a5efb73476270474f53bb84e1e16a63855b543..db137ab1ccfba361db6b474f9ad13e099c5ec0e0 100644 GIT binary patch delta 6896 zcmb6;X>?QPm6p80!#1*!ZCPIQEWAj@GTOWe&6vSmwpLW>tL7~=(uSIkl%24j|l zKncr7QdHR|?(zQOL^&JKE@ zpH|buPuqO;+bY%!^mSJDwhaw!sqF5p?Cb34?c7qieqiHJd*}K}tINqYFwUYyWy4yU zQX9-6!G_`yi>cI7Y*f=~E9df{wP-~LNbc?*rq%X<(@BSO6crT#uA^;3X9u9eF@|DZ zRIyt71&wm@Y3j>P@tTwK@E{>Sj1dZ(pC9wpeQ!cMa>) z`8itCz<7Oh@VIaspO&_GyljJm3;1+4a4Q%bZj0VxFqc{k1~pCnzx-G{tfk1mNbC}d zD5Z4(JEa`}-$&q_^^08er9Mvqa5TRVb`v7CV6G}Zi=4|tIn#N9oLmx{p9;TK`HKK9 z%SX43=064ShxvFb8V%mvE)Cwwe`rvuU5jvmJ_n#juOV9sWF)en2!0t0N&t2jc;|v6 zIbXobiVl3cAV)@Nis|6C;JZf!+LReWd%$h=J2(IXWc_B|3&Ce>KFXJjTS=E6fCW7 z>_Vcb8BczTNMcG062<&|qB{!~fV1MH5L*XLDD;9!3-A{vMLIgWrGlBC0`^)MMxXf z6UmJ^Yuay|}Mq*m2S9!$vVrIL=7BEk0QdE-;{Qt9}IygXp(tCB=cn0pc> z5mnOhtPTl7A?-tHzciw@=hsbtcx6qmnctee`B80^gqeeAS%Qq|I39z`yV5F2e&R3Z z*4>QUc|GF2D#`2-+-_B_eQ<$O_DUa2Y;DY&sBP4&Y1d3oR#i!Vux9z|?weVz)`aQC zyjIzCqD;ogT9c-$BwPa18_6Xl$bv@PaUFHm=e@qWevPu_4Yzc~_&aM`<H(1$w|CLIidt}cxx0B>F7yLk+3Ra-t|WtTT?&|Zlom029N@p9R4Sh z2)>+<*GXG5rg@$WfrnY!n)Nr7XMyspkaEl6#BjIAb{t2Kqg;!JsFf9#o8gjPPVBg(1ex zxL9ZmbiiHB1>80r6aoiR?PTfVQrgW`JKQ#!7vpFAoC~zjW`mhl2l_iYySn>f_G@n& zq6fO@u7ROG7`MVKggWVDT-7#)&mN7F))*%xi}}2ZtHgfdu51LjB#=g?E2Cl6UwsvN zZ!w+cg}&_YvNoYyeHc)ZQ%}tfC*V9-%NeIgkRHYN@V!+&%<6m0fROV`0s2 z9aAjiHt3$m>z@ILnNTanW4&p|W9_Z7 zO;R-q6lW35FaCI>tjJdp+kh-TrDj7CK@WYpN znpx2LGks$)0g$_m27sSOB@33yn|_x^X-dkUaI>|RwbtwKy7|jTf1Xt}qtW!ztpHCh z9f1MDU^I}^OXbA0%p|7-mU_0ik@MPwnTKp$HUY%CmMnnI78}6BEpmWRbjiQA=yEBI z(MUU;zFOLV=~Kh{@zLS&WBk$(zZwJ15mwLR+VIgDGEMaygDcA7xXo)+Ll9U zO8E@8grga~UT@%U6?cosgSKRlH@7`MYepXKhqDM0{q5MQe%_ug1kp!uCbO4j)U%jN(H4cm}sGRi{)4F(7M62&@stJ1C}&ChIvw` zguzlR(3TG3Q|iEAg;F?r=jOq-{tlg!!?(LXp*W;}1 zx?@~>sZtB9T-2NS} za09>k4%`4q-;9cFn->5a+>A!=+uV~W-X^q9P^$B?)_~VHGn^-F`3uk`Y<0pEs-=c` zq76fB@Ckq~^8H&kp`zbCT_Y&c592FD1-|GRZVy@Z-Y}Z1+J-5Gj_BSt39HQQWdaxa zd*gO`4&IZ)F67AR?G}}2+7l_^u!p%OeZ(8mvvH&bFc>CucdK~(5wL$;uo?(dANycyLklfF_baR`HvxVZ62t+Z+UqX-Q&{9s(u zp~*xm`i8Xbv@4!eGGnr!BP>R=yKMYpyBgARn>`_42s6l7ruaY(!HIVI(u;z?%dSYTLi;!kS&?KdLo`@&4g7PsW?uN zPfwu#-#?y13Qyv97S)Mlvg)Ks_rHk)k61ak&(FAFqUUSjTPIua`c*FmtJ=emFwyQ!j4Kq%xdZ$t>9b$PzY*>meJ%fRB`pg0tcKM)y zFCSt>8$1_9zB;3jQFt6*v#Xj5PI&ao8z5}WCHSx*<1f$UzX;&DMJ1lcv|u5{Qr&nq zAGH*h)0!|X7tiL(DUlKR!p)PP)28y}dr5$UFSjtcB1Ncv51zwu_aG02>J>viKW7g` z;NtT_zgCg`ugoE%=et9wKc061Z`B2{p$}hJ8$y0|0g)9KF)cI3O3BHK<`A;tVs@-C z=)`X>hTT=g#mrEOqRN+nz37rgNb;qZTKRJ9uk~_`!VUfGQfs<+L+C&&qs{F**5q496(XtHJqp;8mfCpMlN%D{A2wt}7M69u%zmI4g+*%$X}lYrQ&Oq@~He zt9VD3uA+@UxymSU`m*?$8rn=doKCg|p4By+aHaG$oSv}PG+cWJR_gKKOtX0$oV;}-P725$|HE4X z=O?$)h({Jr#&2O|`{b4f;NsgDe~q_sTHA3uQy@HZI}?6R-^S77p|}a3*@NS7#Z+D- zc#(WKr3jidg#~i@b_$uA!j^u2N+}>7PGRqPIHe|=UaNrB1mN%HR`0;2p5K3IG1J)|0Y3w!|}(|0)GJ@-HF%6lIG delta 7544 zcmZ`eYgCk1l63R%`C$VMHt%Z-*dUGc3%XlHKKcPIO@Hl2BcQ|4xC3iLQWCM#yL*^RS%@|fA#lbqw3Ofs1tJ15!b&Y79)W@mP*?$a@W_x_*c_r8~_HFk&7<#A}8F1JJL@;C)jAUb%vkFRq(h`P<@R*$D; zj+Js6M6kh<&tWHOy-B;ab3kh`6J4dXveK&8tBFS4HMnD_r$5k51_y|m1fQ}uH|}25 z-!n4QH8>oo85!I;+!Yw9u{F6J>v?y@N?ov&aB4%PwyASiYcUahrPW}tRvOhrZ4;Wj zs1OS6R+I5hQpTDB-Ti@GL}%3UJGUWvMMVV&>Fyj2bO(t#Hm@^T_0?9RSv^~6kYo>Z zX)Oj|!cYuRCHr~?w$%il7#bWNt%)k!)jv2=qpzrB8W)CDh7IehE!8C0wY_s-TVNze zxZvoZHFzYwU?T|*4F?|U8Qcl8Off4cMs!+!2==EZI=$6subrcf0Vch;KxNOnx3=@MnckNfRjmxF)z6Vpg)-hIFY;s zU{Xpaz^y4=0Dqo>yjILXcy!KIfIrL$0PLJw2ypLQ?fKM!10`SD5 zT>zB|)a?nyh9nL`kWO4v(%&oA#D4H;4X}RdS{6N>h8EeAo<(KpUKok#$ZI+s_nDa? zq;fX5)v>OHcN44K%!P(C>SVBTMY$rK)09RRz0&HRl)Z_t+NtVJ!c}@(RSZABQ9Ed|xb zk7v@!WsB)cB??ATKyQ{HjedzSL6N{h@E67%RPR!8#9T!*Rv%wqC)nGGmFV%lTA7f}_a_Qjsfw^B{~)9u z^)!{-e70$O&L)5AjGzDxlOOc@RWqP4xldt1)%TfS6;^pJC^B>9D?vr`tvO@45!Ldh z^U$(FUh0;FjEt$j_WE;x5zgeKDh5&eS{d7~LMB;tI!jQ?{bYtwkua69*I)Dy`9&bV zDBfgW2}MAisu)}AFX=WY=uFS#VrHVtLJ70~IiZC890RJ) z0F@)Yq8nE&!qj44jfMHy)vW+0)?}yXq?GYx%_Zn;Or%7FuE!-h>{8~MSd%lKudJ*z z%)%19Sn+sw1gijggFU3n2Iu=O_oi^>cR*aOu7r&0udu4!Z@4y zZGaI9*lfuBg1srqd_gs8W{zm4qTkd{#5x?@TeY-yYmGfr=Tss6#`^V9`V??J7U3^z z9w1fC(Sf6-#Y-I1jBja+=me`_tG(z7#!JkUGI^+ct!6Ih+#+6t9*W9Zb?6tiHLvJ^ z4aWP0x?6u&!fC23vrKPmaM&8P7)>m;P?^_T+i(wU?N37ULv*Gps@tHX-?VQ{=HQZ` zW54<~7?hku+vsR-6-0Zu08Ve1CLpGgl)z5l6cH=$b_=aq!Pfu^0d6yNP|s|%XK_J@ z%+7&sEicw4>0 zUKWQ9FAw3Q4Y#Zkv;XPnsDP3wWd*6_CAumSMrL+~LyKh}l$1!Gd1PN^q@^ zp3*2IoO+Pe3tM)9W2&L>&R)mx)=5EE+=Y$(dtJE;*ksrzV_nu*_`TPK-S^(73aPAn zI+@d$EhLUWVk6s@LGN|r9mpEM-fr(xYPu`%OBgk6-3RcKt(5>}+nRHjHG(|@qk&;a zQ=?iZY&|R$h(d?A&B0JSzP(j405VSL!DfF=5BBbe6YNPsoV~qqIN$Z+HM6|WTrgVz zgkk*F_Vt-!Tbt=yEb*lO-FF)Vnk;n5jtu&FzfzKZuipvl<{cVJytjc7B`M>(^XcIs)c5)jpB~BDEMBAlTllCi zwtq4l&MZu?Hy-6Sukg0Ul1_Gqn^xqycO8#2- zIQpykanvdJ`0`xXKMIFzV`~wcv9Ms|ONRK_<9+!NX|vHJjI~ev0DPRg+|b~cazTbP zI@~!R?IrZ)uE#J8^Pj4hgx3a@;f8zfQwL%@Obs?HzR!?wMYYG-aUvK3E-kyw5|{Da zs}>--%PA@G*=}oLL`_U2aYk`PQmAgvXiOf)&#gU1;Q7Zrg?O0+nn>ckPw=L(iYyj} zJTw+MmNH$=NEGGKn_~r;_fZRCRO=vcA9#8Vz)Me;14PgN`RTlD2|sqYfpgUHYFDv5 zAwgaX-93N3VWLOT&@DeFbA{VY>Hm+vZ;-c5{w_fSH2@T6=R+TD!=ed~9^Z?8{$g(y zKs-^Ny$fm4zN(lJw(PUBmlk%Pkqr6cecIUif9xv;(nb5By`UBQ_o)Adg&BEt2Zi+8 z{nJ2j`k6w>S7_>gf5r+^X$LToU@3d#KrZG0rZm*#7SW@1imYA3hXkpP3-+ULp&@T}u)4U&t??RL~dM<(%+{5E+o zHyVP4p--PPV1Onc?2D=U+(9Qi;YcMg_O|frgR5e;Q9mC5s=s@F1;A_1hqHO;&(9NN zrh4J$0Dt>}2Ow_Wai|tX?>?^rh`IT_Lpg|c=fz(EoPLR+9d@&18M$nSpN;&7*TZ(8 zDUZBD=vg9^I!kFgA1}xXZ|6S`8zp{p1iWn2$L!>N7Qc zaXhYhlWkMd#v{#1P^dY2h!#byrKaB=5o0z$yp2=`dpJZ(Kzmj}-C7oqtbO}{@~}AP z=rVvSj^;C);ws*EC3ik@^m2?JeGAor?iFk~+Fq##c={Er zp5w>MQlnzapgTd5e5yEs)tNtG2l(s>Ovr%FdWQbUnif0pF3Vv!P5oXW_-rNhqXA@{Nt;2u`OdXEqTohZDK5c%)%dk zEv_y3J(Pxu~XITr2_FKYrcPKUryvuN77#$H$18Iv;#;#KfN6KaD1@Pz=IK5 zByGa1-~d0tguBG{iBUlQXre4Px~)iEypQb~DxO&ln1|0SL$)SMlr2`~FVDc) zk5?yR4b-RU_0q*GAFpc>d=6||k+XCX(k2Lf=XG>p=UFAa^ZI-kRqW@f<_%}ef}Lk$ z)x3~ieq&Zqs5xuRot>b44WiH*=aDOCdt?02Bi1)Dy(!KunG>n~ufEwALs6W=17JQE z=SRi4e0u5}T&*Af4C4=0){Rwrrx)bK#y17tfnu#RS?s9=weoiULyJE zEnR%i(c)=^i;)(39Ur_gFcgi8e)5)*8ZNdZ!p(vXUR<09Z^Dt-jsyWTM`1JG8#B>G z@8Glc=C{>S;>EOo=56v|KNV?<;%PF|%LqOuz*7f4GfMtP4m0oICB%PO6)6drfod;h z#v(FyaO#DqQw!-!m;MDXH(nMcZKf{c!I_%Oq6;T6j$U+GsCTkGW}d0ZT$o1hy>uy= z-kZD%zb;J0)x0mJY7`hr(Pu-v&}ye4e8ZmsY&_f)rS}h(Eq6>`03M4&_OLx5d5wiI zIUNg?&*e0tmtVJzQ17BFmPf(*aJO?cG4qG+h8D^J^DkF^CK12?lTP?qeASzapJJ?5 zyxU2aK&J~XoZ;$n_^JlnWuXIUImwa?6Yrjk@SbX`r`u4Aip==vsr-&|h~P<5jS;OZO3`LT;D zeeK%fbOIam;`1$W)q4cd0lDUl8+d;H^+s+QY$be!V;>n|?YkR7SBwJ*f2M@O=WQ2V z^$kAwz_~s!urokPNLyfd@CjlY9EJ~uoulyb17G