(FILECREATED "11-APR-83 18:04:57" ("compiled on " {PHYLUM}<3-LISP>3A-LISP>NEW-3-LISP.;34) " 9-APR-83 13:10:59" recompiled exprs: ENVD PATTERN BODY EXPAND-SPECIAL-CONTINUATION LOCATE-EXPRESSION-FROM-PATH REMEMBER-STANDARD-CONTINUATIONS BUILD-INITIAL-ENVIRONMENT in WORK dated " 9-APR-83 13:25:45") (FILECREATED "11-APR-83 17:59:42" {PHYLUM}<3-LISP>3A-LISP>NEW-3-LISP.;34 91103 changes to: (VARS NEW-3-LISPCOMS) (FNS EXPAND-SPECIAL-CONTINUATION REMEMBER-STANDARD-CONTINUATIONS BUILD-INITIAL-ENVIRONMENT PATTERN BODY ENVD LOCATE-EXPRESSION-FROM-PATH) previous date: "11-APR-83 06:29:01" {PHYLUM}<3-LISP>3A-LISP>NEW-3-LISP.;33) DE D1 (L (0 X)) @h (5 DEFINE) NIL NIL CREATE-READ-TABLE D1 NIL Og go` go` go` go` go` `(111Q SETSYNTAX 74Q SETSYNTAX 57Q SETSYNTAX 42Q SETSYNTAX 25Q SETSYNTAX 5 COPYREADTABLE) (114Q 3-LISP-READ-TABLE 106Q 3-LISP-READ-TABLE 77Q %] 71Q 3-LISP-READ-TABLE 62Q %[ 54Q 3-LISP-READ-TABLE 45Q ' 37Q 3-LISP-READ-TABLE 30Q \ 22Q 3-LISP-READ-TABLE 13Q ^ 10Q 3-LISP-READ-TABLE 2 ORIG) (103Q (MACRO ALWAYS CLOSE-BRACKET-READ-MACRO) 66Q (MACRO ALWAYS OPEN-BRACKET-READ-MACRO) 51Q (MACRO FIRST QUOTE-READ-MACRO) 34Q (MACRO FIRST DOWN-READ-MACRO) 17Q (MACRO FIRST UP-READ-MACRO)) UP-READ-MACRO D1 (L (1 READ-TABLE 0 FILE)) g@A h(7 READ) (2 UP) NIL DOWN-READ-MACRO D1 (L (1 READ-TABLE 0 FILE)) g@A h(7 READ) (2 DOWN) NIL QUOTE-READ-MACRO D1 (L (1 READ-TABLE 0 FILE)) g@A h(7 READ) (2 &Q) NIL OPEN-BRACKET-READ-MACRO D1 (L (1 READ-TABLE 0 FILE)) 2@A Xg0HdgI@A J KhZK&(37Q READ 7 READ) (23Q &END-OF-RAIL& 13Q &) NIL CLOSE-BRACKET-READ-MACRO D1 NIL gNIL (2 &END-OF-RAIL&) NIL PRINT-3-LISPA0007A0008 D1 (NAME ERRORSET L (2 ERRORSET.W 1 ERRORSET.V 0 ERRORSET.U) F 0 EXTERNALISED-EXP F 1 MACROY) P ci(3 PRINTDEF) NIL NIL PRINT-3-LISPA0007 D1 (NAME ERRORSET L (2 ERRORSET.W 1 ERRORSET.V 0 ERRORSET.U) P 3 RESETSTATE P 2 MACROY P 0 OLDVALUE F 4 RESETVARSLST F 5 PP-3-LISP F 6 FILE) Fgc V 1gHhhTcog gIcgI Khh(76Q ERROR! 70Q APPLY 44Q PRINT-3-LISPA0007A0008 11Q OUTFILE) (61Q OUTFILE 50Q ERROR 41Q INTERNAL 17Q OUTFILE 2 PRETTY-PLEASE) (36Q (DUMMY.FOR.ERRORSET)) PRINT-3-LISP D1 (P 1 MACROY I 1 FILE I 0 EXTERNALISED-EXP F 2 RESETVARSLST F 3 PP-3-LISP) @gSRcRYog HcIdRHcR RkI H(74Q ERROR! 63Q NLEFT 54Q TAILP 27Q PRINT-3-LISPA0007) (24Q INTERNAL 2 PP-3-LISP) (21Q (DUMMY.FOR.ERRORSET)) PP3-TRAN D1 (L (0 COMS)) @go @(14Q SUBST) (5 ARGH) (11Q (PRINT-3-LISP (THETA-INVERSE ARGH))) PP3E-TRAN D1 (L (0 COMS)) @go @(14Q SUBST) (5 ARGH) (11Q (PRINT-3-LISP ARGH)) 3ATOM D1 (L (0 X)) @l@hh @o h(25Q MEMB) NIL (22Q ($T $F)) NUMERAL D1 (L (0 X)) @ddNIL NIL NIL RAIL D1 (L (0 X)) @i @o h(20Q MEMB) NIL (15Q (&Q &K &C &P)) 1ST D1 (L (0 X)) 6@ gg @Hdo gg Hgg (63Q ERROR 50Q ERROR 35Q MEMB 13Q ERROR) (60Q 1ST 55Q NOT-A-RAIL 45Q 1ST 42Q NOT-A-RAIL 10Q 1ST 5 EMPTY-RAIL) (32Q (&Q &K &C &P)) F1ST D1 (L (0 X)) @NIL NIL NIL 2ND D1 (L (0 X)) E@ gg ,@do gg @bd gg @gg (102Q ERROR 65Q ERROR 44Q ERROR 31Q MEMB 13Q ERROR) (77Q 2ND 74Q NOT-A-RAIL 62Q 2ND 57Q INDEX-TOO-LARGE 41Q 2ND 36Q NOT-A-RAIL 10Q 2ND 5 EMPTY-RAIL) (26Q (&Q &K &C &P)) F2ND D1 (L (0 X)) @NIL NIL NIL REST D1 (L (0 X)) 4@ gg @do gg @gg (61Q ERROR 44Q ERROR 31Q MEMB 13Q ERROR) (56Q REST 53Q NOT-A-RAIL 41Q REST 36Q NOT-A-RAIL 10Q REST 5 EMPTY-RAIL) (26Q (&Q &K &C &P)) FREST D1 (L (0 X)) @NIL NIL NIL PREP D1 (L (1 X 0 E)) -A@hAo gg @Agg (52Q ERROR 34Q ERROR 22Q MEMB) (47Q PREP 44Q NOT-A-RAIL 31Q PREP 26Q NOT-A-RAIL) (17Q (&Q &K &C &P)) FPREP D1 (L (1 X 0 E)) @ANIL NIL NIL EMPTY D1 (L (0 X)) @hNIL NIL NIL RCONS D1 NIL %eHAk]dIJaK Lh[MkذL&NIL NIL NIL HANDLE D1 (L (0 X)) @@gNIL (10Q &Q) NIL DOWN D1 (L (0 X)) @ gg g@(14Q ERROR) (21Q &Q 11Q DOWN 6 NOT-A-HANDLE) NIL FDOWN D1 (L (0 X)) @NIL NIL NIL UP D1 (L (0 X)) g@NIL (2 &Q) NIL CLOSURE D1 (L (0 X)) @ @o (14Q MEMB) NIL (11Q (&C &K)) SPECIAL-CONTINUATION D1 (L (0 X)) @@gNIL (10Q &K) NIL CCONS D1 (L (4 B 3 P 2 E 1 K 0 TAG)) g@ACDB h(12Q INTERNALISE-ENV) (2 &C) NIL FCCONS D1 (L (4 BODY 3 PATTERN 2 INTERNAL-ENV 1 PROCT 0 CODE)) g@ACDBhNIL (2 &C) NIL SCCONS D1 (L (6 PATH 5 MASTER-EXP 4 ESC 3 ENV 2 CONT 1 STACK 0 PC)) g@ABCDEFhNIL (2 &K) NIL PROCT D1 (L (0 X)) '@ gg dg@gg(14Q ERROR) (44Q SIMPLE 36Q &K 22Q &C 11Q PROCT 6 NOT-A-CLOSURE) NIL FPROCT D1 (L (0 X)) @dggNIL (12Q SIMPLE 5 &K) NIL ENVD D1 (L (0 X)) A@ gg @g@ @g@  gg h(75Q ERROR 63Q EXTERNALISE-ENV 52Q EXPAND-SPECIAL-CONTINUATION 36Q EXTERNALISE-ENV 14Q ERROR) (72Q ENVD 67Q NOT-A-CLOSURE 44Q &K 22Q &C 11Q ENVD 6 NOT-A-CLOSURE) NIL FENVD D1 (L (0 X)) @NIL NIL NIL PATTERN D1 (L (0 X)) 7@ gg @g@@g@ gg h(63Q ERROR 45Q EXPAND-SPECIAL-CONTINUATION 14Q ERROR) (60Q PATTERN 55Q NOT-A-CLOSURE 37Q &K 22Q &C 11Q PATTERN 6 NOT-A-CLOSURE) NIL FPATTERN D1 (L (0 X)) @NIL NIL NIL BODY D1 (L (0 X)) 9@ gg @g@@g@ gg h(65Q ERROR 46Q EXPAND-SPECIAL-CONTINUATION 14Q ERROR) (62Q BODY 57Q NOT-A-CLOSURE 40Q &K 22Q &C 11Q BODY 6 NOT-A-CLOSURE) NIL FBODY D1 (L (0 X)) @NIL NIL NIL NON-REFLECTIVE-CLOSURE D1 (L (0 X)) "@h@g@g @ghNIL (34Q REFLECT 22Q &C 12Q &K) NIL FDE-REFLECT D1 (L (0 CLOSURE)) @ g@ @ @ (26Q FCCONS 22Q FBODY 16Q FPATTERN 12Q FENVD 3 COMPILED-CODE-FOR) (6 SIMPLE) NIL EXPAND-SPECIAL-CONTINUATION D1 (L (0 SPECIAL-CLOSURE))  @XHXHXHXHXHX^_dgNNJhIJKLMN N _oM K `LO ` _hgO`` g^NJhI JKLMN N _gI oM K `LO ` _hgO`` OdgNNJhIJKLMN N _oM K `LO ` _hgO`` g^NJhI JKLMN N _gI oM K `LO ` _hgO`` oOl2OO%g_OOh__Ok_O&_ON P(720Q \APPEND2 715Q \APPEND2 617Q FCCONS 574Q FBIND 571Q FBIND 566Q FENVD 560Q RCONS 546Q EXTERNALISE-ENV 542Q UP 532Q UP 527Q TOP 515Q SCCONS 507Q LOCATE-EXPRESSION-FROM-PATH 477Q POP 455Q FCCONS 432Q FBIND 427Q FENVD 421Q RCONS 407Q EXTERNALISE-ENV 403Q UP 370Q SCCONS 362Q LOCATE-EXPRESSION-FROM-PATH 330Q FCCONS 305Q FBIND 302Q FBIND 277Q FENVD 271Q RCONS 257Q EXTERNALISE-ENV 253Q UP 243Q UP 240Q TOP 226Q SCCONS 220Q LOCATE-EXPRESSION-FROM-PATH 210Q POP 166Q FCCONS 143Q FBIND 140Q FENVD 132Q RCONS 120Q EXTERNALISE-ENV 114Q UP 101Q SCCONS 73Q LOCATE-EXPRESSION-FROM-PATH) (645Q REST 613Q C-REST!-BODY 610Q C-REST!-PATTERN 603Q SIMPLE 563Q STANDARD-NORMALISE-CLOSURE 551Q STANDARD-NORMALISE-CLOSURE 523Q FIRST! 461Q REST 451Q C-FIRST!-BODY 446Q C-FIRST!-PATTERN 441Q SIMPLE 424Q STANDARD-NORMALISE-CLOSURE 412Q STANDARD-NORMALISE-CLOSURE 337Q 1ST 324Q C-ARGS!-BODY 321Q C-ARGS!-PATTERN 314Q SIMPLE 274Q STANDARD-NORMALISE-CLOSURE 262Q STANDARD-NORMALISE-CLOSURE 234Q PROC! 172Q CDR 162Q C-PROC!-BODY 157Q C-PROC!-PATTERN 152Q SIMPLE 135Q STANDARD-NORMALISE-CLOSURE 123Q STANDARD-NORMALISE-CLOSURE 50Q CAR) (624Q (1ST) 536Q (EXP ENV NORMALISE ESC CONT) 377Q (EXP ENV NORMALISE ESC CONT) 247Q (EXP ENV NORMALISE ESC CONT) 110Q (EXP ENV NORMALISE ESC CONT)) LOCATE-EXPRESSION-FROM-PATH D1 (L (1 PATH 0 EXP)) VA@dg@A dg@A dg@A g@A @A A (122Q NTH 115Q LOCATE-EXPRESSION-FROM-PATH 106Q FREST 103Q LOCATE-EXPRESSION-FROM-PATH 67Q F1ST 64Q LOCATE-EXPRESSION-FROM-PATH 46Q FPCDR 43Q LOCATE-EXPRESSION-FROM-PATH 25Q FPCAR 22Q LOCATE-EXPRESSION-FROM-PATH) (73Q REST 53Q 1ST 32Q CDR 11Q CAR) NIL REMEMBER-STANDARD-CONTINUATIONS D1 NIL `o h(11Q EDITE) (2 STANDARD-NORMALISE-CLOSURE) (6 ((F PROC! 1) (S C-PROC!-PATTERN) NX (S C-PROC!-BODY) ^ (F ARGS! 1) (S C-ARGS!-PATTERN) NX (S C-ARGS!-BODY) ^ (F FIRST! 1) (S C-FIRST!-PATTERN) NX (S C-FIRST!-BODY) ^ (F REST! 1) (S C-REST!-PATTERN) NX (S C-REST!-BODY))) PAIR D1 (L (0 X)) @@gNIL (10Q &P) NIL PCONS D1 (L (1 Y 0 X)) g@AhNIL (2 &P) NIL PCAR D1 (L (0 X)) @ @gg (21Q ERROR 3 PAIR) (16Q PCAR 13Q NOT-A-PAIR) NIL FPCAR D1 (L (0 X)) @NIL NIL NIL PCDR D1 (L (0 X)) @ @gg (22Q ERROR 3 PAIR) (17Q PCDR 14Q NOT-A-PAIR) NIL FPCDR D1 (L (0 X)) @NIL NIL NIL TYPE D1 (L (0 X)) a@gddg@dlo gg(@dggdggdggggg (136Q ERROR 43Q MEMB) (133Q TYPE 130Q UNRECOGNISED-OBJECT 124Q CLOSURE 116Q &K 111Q &C 104Q PAIR 77Q &P 72Q HANDLE 65Q &Q 53Q ATOM 47Q BOOLEAN 24Q NUMERAL 5 RAIL) (40Q ($T $F)) NORMAL D1 (L (0 EXP)) @d @  h@ i(25Q 3ATOM 16Q PAIR 12Q NORMAL-RAIL 4 RAIL) NIL NIL NORMAL-RAIL D1 (L (0 X)) @dHH i(13Q NORMAL) NIL NIL THETA D1 (L (0 E)) @dl'dg 0@d IHhZH&Jdgg@ g@ @h@dgg@ @ hgg@ @ hg@ g@ h(234Q THETA 223Q THETA 206Q THETA 177Q THETA 152Q THETA 145Q THETA 113Q THETA 76Q THETA 33Q THETA) (226Q & 216Q &P 172Q &P 164Q &. 140Q &P 131Q &Q 106Q &P 70Q &Q 62Q &Q 14Q &) NIL THETA-INVERSE D1 (L (0 E)) @ghl@@dgg@ hgI@d +@ 0@d IHhZH&J g@ h@dg!g@ @ @ hg"g@g@ h@ggghg0@d IHhZH&J(340Q THETA-INVERSE 273Q THETA-INVERSE 224Q THETA-INVERSE 221Q FBODY 215Q THETA-INVERSE 212Q FPATTERN 206Q THETA-INVERSE 203Q FPROCT 155Q THETA-INVERSE 143Q THETA-INVERSE 112Q THETA-INVERSE 74Q THETA-INVERSE 63Q RAIL 40Q THETA-INVERSE) (325Q & 316Q ... 313Q &CONTOUR 306Q &CONTOUR 260Q OF 244Q &SPECIAL-LAMBDA 236Q &K 177Q &LAMBDA 170Q &C 146Q &. 50Q &P 33Q &Q 25Q &Q 5 &) NIL SANITIZE-CODE D1 (L (0 INSTRUCTION-LIST)) @@d[dgdgKK KjdgdgdgKTdggKK  42Q 37Q & 34Q LAMBDA 30Q DEFINE 25Q 3-LISP-FNS 12Q NOERROR 6 3-LISP-FNS) NIL REBIAS-ANSWER D1 (L (2 TO-LEVEL 1 FROM-LEVEL 0 EXP)) ;AdB @B @ @ Akbbgg @ Akbb(56Q UP 51Q ERROR 25Q FDOWN 20Q HANDLE 5 EQUAL) (46Q REBIAS-ANSWER 43Q CANT-REBIAS-ANSWER) NIL RUN-COMPILED-CODE D1 (L (1 INITIAL-ENV 0 INITIAL-PC)) z$jddddddddddd` h_$k_&@_A_h__O& _ O& _"j_Ok_O HkظD_(O_O(dgJkغO(O _dgKkػqdg,Mkؽ_,O(k_@_>O@O>O,O _dg0IkعO(O O _`gd`o VdgOk_O(_O(_7dgLkؼO _0d go O0 gO( O `O"O O0 O _Ok_O&k_&` !o` O&` o` O$?O& _ O& _"?dgNk^>g.Ok_O(gOO( O( O _KO(o OOO OO"OO( _ h_O(_ RO _*O _,_O,_,_O,_,_ O,_,_O,_,_"O,_,_O,_,O*O _O O O _Ok_O&k_&` !o` O&` o` O$O& _ O& _"_ O$_"O$_$O _.O _ _0O _O0d O. O. k O. Ok_O O"hO$_$O&k_&` !o` O&` o` O0_ O. _O dggOhgHhgIhgJhgKhgLhgMhgNhgOhgOhgOhgOhhO go O0 _8_6O8_4O6dddO.d O. _:[ IO. ?j_:0#O. (d_ " . ".. ") 217Q "Execution statistics:" 170Q "A= " 145Q "Error detected by processor." 133Q (DUMMY.FOR.ERRORSET) 61Q "Execution statistics:" 30Q "A= ") PUSH D1 (L (1 STACK 0 ELEMENT)) @ANIL NIL NIL POP D1 (L (0 STACK)) @NIL NIL NIL TOP D1 (L (0 STACK)) @NIL NIL NIL TEST-CODE-1 D1 NIL oNIL NIL (3 ((CODE-BLOCK (&P TYPE (144Q)) (VARIABLE TYPE) (RCHECK (144Q)) (CONSTANT (144Q)) (CALL)))) TEST-CODE-2 D1 NIL oNIL NIL (3 ((CONSTANT 1) (CONSTANT 2) (CONSTANT 3) (RCONS 2) (CONSTANT 4) (RCONS 3))) TEST-CODE-3 D1 NIL oNIL NIL (3 ((CODE-BLOCK (&P TYPE ((&P TYPE (144Q)))) (VARIABLE TYPE) (NEST (1 CDR) (VARIABLE TYPE) (RCHECK (144Q)) (CONSTANT (144Q)) (CALL)) (RCONS 1) (CALL)))) TEST-CODE-4 D1 NIL oNIL NIL (3 ((CODE-BLOCK (PREP (1+ 12Q) (& ((1ST (& 1+ 1-)) 67Q))) (VARIABLE PREP) (NEST (1 CDR) (VARIABLE 1+) (CONSTANT 12Q) (RCONS 1) (CALL)) (NEST (2 1 CDR) (VARIABLE 1ST) (VARIABLE 1+) (VARIABLE 1-) (RCONS 2) (RCONS 1) (CALL) (CONSTANT (67Q)) (CALL)) (RCONS 1) (RCONS 2) (CALL)))) ADD.3-LISP-FN D1 (L (2 TYPE 1 NAME 0 COM)) @A i(4 /NCONC1) NIL NIL DELDEF.3-LISP-FN D1 (L (1 TYPE 0 NAME)) @g (6 REMPROP) (3 3-LISP-FNS) NIL DUMP.3-LISP-FN D1 (L (0 NAME)) 'g@h h h @ h h h (44Q TERPRI 40Q TERPRI 34Q PRINTDEF 31Q POSITION 25Q GETDEF.3-LISP-FN 21Q TERPRI 15Q TERPRI 11Q PRIN1) (2 READ.3-LISP-FN) NIL GETDEF.3-LISP-FN D1 (L (1 TYPE 0 NAME)) @gNIL (3 3-LISP-FNS) NIL PUTDEF.3-LISP-FN D1 (L (2 DEF 1 TYPE 0 NAME)) @gB (7 PUTPROP) (3 3-LISP-FNS) NIL READ.3-LISP-FN D1 (L (0 NAME)) @g (11Q PUTDEF.3-LISP-FN 6 READ) (3 3-LISP-FNS) NIL (PRETTYCOMPRINT NEW-3-LISPCOMS) (RPAQQ NEW-3-LISPCOMS ((P (* These characters are used in variable names.) (CLDISABLE (QUOTE *)) ( CLDISABLE (QUOTE -)) (CLDISABLE (QUOTE &)) (CLDISABLE (QUOTE $)) (CLDISABLE (QUOTE +)) (CLDISABLE ( QUOTE =)) (CLDISABLE (QUOTE @)) (CLDISABLE (QUOTE :)) (CLDISABLE (QUOTE BIND)) (CLDISABLE (QUOTE IF)) (CLDISABLE (QUOTE POP)) (CLDISABLE (QUOTE PUSH))) (LOCALVARS . T) (FNS DE) (VARS FONTCHANGEFLG HELPDEPTH PROMPT#FLG SYSPRETTYFLG #RPARS AUTOBACKTRACEFLG) (GLOBALVARS 3-LISP-READ-TABLE) (P (SETQ PP-3-LISP NIL)) (SPECVARS PP-3-LISP) (ALISTS (PRETTYPRINTMACROS &LAMBDA & &Q DOWN UP UNINTERRUPTABLY) (PRINTOUTMACROS .PP3 .PP3E)) (FNS CREATE-READ-TABLE UP-READ-MACRO DOWN-READ-MACRO QUOTE-READ-MACRO OPEN-BRACKET-READ-MACRO CLOSE-BRACKET-READ-MACRO PRINT-3-LISP PP3-TRAN PP3E-TRAN) (GLOBALVARS GLOBAL-ENV 3-LISP-PRIMITIVES ENV-HARRAY BASIC-ENVIRONMENT LAMBDA-CLOSURE LAMBDA-REFLECT-CLOSURE KERNEL-NON-PRIMITIVES KERNEL-ENV CURRENT-ENV STANDARD-NORMALISE-CLOSURE ID-CLOSURE MACRO-GENERATED-CLOSURE Y-GENERATED-CLOSURE) (GLOBALVARS 3-LISP-USER-PROCEDURES) (VARS 3-LISP-USER-PROCEDURES) (FNS 3ATOM NUMERAL) (FNS RAIL 1ST F1ST 2ND F2ND REST FREST PREP FPREP EMPTY RCONS) (FNS HANDLE DOWN FDOWN UP) (GLOBALVARS C-PROC!-PATTERN C-PROC!-BODY C-ARGS!-PATTERN C-ARGS!-BODY C-FIRST!-PATTERN C-FIRST!-BODY C-REST!-PATTERN C-REST!-BODY) (FNS CLOSURE SPECIAL-CONTINUATION CCONS FCCONS SCCONS PROCT FPROCT ENVD FENVD PATTERN FPATTERN BODY FBODY NON-REFLECTIVE-CLOSURE FDE-REFLECT EXPAND-SPECIAL-CONTINUATION LOCATE-EXPRESSION-FROM-PATH REMEMBER-STANDARD-CONTINUATIONS) (FNS PAIR PCONS PCAR FPCAR PCDR FPCDR) (FNS TYPE NORMAL NORMAL-RAIL) (FNS THETA THETA-INVERSE SANITIZE-CODE) (GLOBALVARS LAST-NAME) (FNS PROCESSOR RUN REDO-ALL) ( GLOBALVARS *BIND-STATUS* *BINDING-STATUS*) (FNS FBIND FMATCH BINDING EXTERNALISE-ENV INTERNALISE-ENV BOUND-VARIABLES CREATE-ENV-HARRAY GET-3-GLOBAL SET-3-GLOBAL) (FNS :1+ :1- :1ST := :BODY :CAR :CCONS :CDR :DOWN :EF :EMPTY :ENVIRONMENT-DESIGNATOR :PATTERN :PCONS :PREP :PROCEDURE-TYPE :RCONS :REST :TYPE :UP :ZERO :BOGUS-PRIMITIVE) (GLOBALVARS *APPLY-PRIMITIVE-STATUS*) (FNS APPLY-PRIMITIVE IDENTIFY-PRIMITIVE) (FNS COMPILED-CODE-FOR COMPILE-CLOSURE COMPILE-ISOLATED-EXPRESSION COMPILE-EXP COMPILE-CONSTANT COMPILE-VARIABLE COMPILE-RAIL COMPILE-PAIR COMPILE-LAMBDA COMPILE-MACRO TIDY UNTIDY IS-TIDY CODE-PART WARNING C C1 ANALYSE-PATTERN) (ADVISE COMPILE-ISOLATED-EXPRESSION COMPILE-CLOSURE) ( FNS TOP-LEVEL-CONTINUATION TOP-LEVEL-ESCAPE OVERHEAD-CONT OVERHEAD-ESC) (GLOBALVARS TRACE-WINDOW **STATS**) (FNS SETUP BUILD-INITIAL-ENVIRONMENT D3 REBIAS-ANSWER) (FNS RUN-COMPILED-CODE D) (FNS PUSH POP TOP) (FNS TEST-CODE-1 TEST-CODE-2 TEST-CODE-3 TEST-CODE-4) (FNS ADD.3-LISP-FN DELDEF.3-LISP-FN DUMP.3-LISP-FN GETDEF.3-LISP-FN PUTDEF.3-LISP-FN READ.3-LISP-FN) (FILEPKGCOMS 3-LISP-FNS) (3-LISP-FNS STANDARD-NORMALISE ENVIRONMENT DE-REFLECT REFLECTIVE NOT MAP DOUBLE 2ND UNIT PRIMITIVE ID RAIL PAIR HANDLE ATOM CLOSURE BINDING BIND Y-OPERATOR 3RD IF LAMBDA-MACRO LET LETSEQ Y*-OPERATOR LETREC LENGTH FOO OR AND NTH) (BITMAPS TILE1 TILE2) (DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS ( ADDVARS (NLAMA DE) (NLAML READ.3-LISP-FN D3) (LAMA :RCONS RCONS))))) (CLDISABLE (QUOTE *)) (CLDISABLE (QUOTE -)) (CLDISABLE (QUOTE &)) (CLDISABLE (QUOTE $)) (CLDISABLE (QUOTE +)) (CLDISABLE (QUOTE =)) (CLDISABLE (QUOTE @)) (CLDISABLE (QUOTE :)) (CLDISABLE (QUOTE BIND)) (CLDISABLE (QUOTE IF)) (CLDISABLE (QUOTE POP)) (CLDISABLE (QUOTE PUSH)) (RPAQQ FONTCHANGEFLG NIL) (RPAQQ HELPDEPTH 30) (RPAQQ PROMPT#FLG T) (RPAQQ SYSPRETTYFLG T) (RPAQQ #RPARS NIL) (RPAQQ AUTOBACKTRACEFLG NIL) (SETQ PP-3-LISP NIL) (ADDTOVAR PRETTYPRINTMACROS (&LAMBDA LAMBDA (FORM) (PROG ((POS (IPLUS (POSITION) 3))) (COND ((NOT ( EQUAL PP-3-LISP (QUOTE PRETTY-PLEASE))) (RETURN FORM))) (PRIN1 "{LAMBDA ") (PRINTDEF (CADR FORM) ( POSITION)) (PRINTDEF (CADDR FORM) (ADD1 (POSITION))) (TERPRI) (PRINTDEF (CADDDR FORM) POS) (PRIN1 "}") )) (& LAMBDA (FORM) (PROG NIL (COND ((NOT (EQUAL PP-3-LISP (QUOTE PRETTY-PLEASE))) (RETURN FORM))) ( PRIN1 "[") (PRINTDEF (CDR FORM) (POSITION) NIL T) (PRIN1 "]"))) (&Q LAMBDA (FORM) (PROG NIL (COND (( NOT (EQUAL PP-3-LISP (QUOTE PRETTY-PLEASE))) (RETURN FORM))) (PRIN1 "'") (PRINTDEF (CADR FORM) ( POSITION)))) (DOWN LAMBDA (FORM) (PROG NIL (COND ((OR (NOT (EQUAL PP-3-LISP (QUOTE PRETTY-PLEASE))) ( NOT (EQUAL (LENGTH FORM) 2))) (RETURN FORM))) (PRIN1 "\") (PRINTDEF (CADR FORM) (POSITION)))) (UP LAMBDA (FORM) (PROG NIL (COND ((OR (NOT (EQUAL PP-3-LISP (QUOTE PRETTY-PLEASE))) (NOT (EQUAL (LENGTH FORM) 2))) (RETURN FORM))) (PRIN1 "^") (PRINTDEF (CADR FORM) (POSITION)))) (UNINTERRUPTABLY LAMBDA ( FORM) (PROG ((POS (IPLUS 4 (POSITION)))) (PRIN1 "(") (PRIN2 (CAR FORM)) (OR (EQ COMMENTFLG (CAAR (SETQ FORM (CDR FORM)))) (TAB POS 0)) (PRINTDEF FORM POS T T FNSLST) (PRIN1 ")")))) (ADDTOVAR PRINTOUTMACROS (.PP3 PP3-TRAN) (.PP3E PP3E-TRAN)) (RPAQQ 3-LISP-USER-PROCEDURES (LETSEQ Y*-OPERATOR LETREC LENGTH OR AND FOO NTH INTRIM-Y BT)) (PUTPROPS COMPILE-ISOLATED-EXPRESSION READVICE (NIL (BEFORE NIL (printout T "Compiling the expression " .PP3 EXP T)))) (PUTPROPS COMPILE-CLOSURE READVICE (NIL (BEFORE NIL (printout T "Compiling the closure with body " .PP3 (FBODY REGULAR-CLOSURE) T)))) (READVISE COMPILE-ISOLATED-EXPRESSION COMPILE-CLOSURE) (PUTDEF (QUOTE 3-LISP-FNS) (QUOTE FILEPKGCOMS) (QUOTE ((COM MACRO (X (E (MAPC (QUOTE X) (FUNCTION DUMP.3-LISP-FN)))) CONTENTS NILL ADD ADD.3-LISP-FN) (TYPE DESCRIPTION "3-LISP definitions" GETDEF GETDEF.3-LISP-FN PUTDEF PUTDEF.3-LISP-FN DELDEF DELDEF.3-LISP-FN)))) (READ.3-LISP-FN STANDARD-NORMALISE) (DEFINE STANDARD-NORMALISE (LAMBDA (& EXP ENV NORMALISE ESC CONT) ((EF (ATOM EXP) (LAMBDA (&) ((LAMBDA (& RESULT) ((EF (EMPTY RESULT) (LAMBDA (&) (ESC (&Q UNBOUND-VARIABLE) (& EXP ENV NORMALISE ESC CONT)) ) (LAMBDA (&) (CONT (1ST RESULT)))))) (BINDING EXP ENV))) (LAMBDA (&) ((EF (RAIL EXP) (LAMBDA (&) ((EF (EMPTY EXP) (LAMBDA (&) (CONT EXP)) (LAMBDA (&) (NORMALISE (1ST EXP) ENV NORMALISE ESC (LAMBDA (& FIRST!) (NORMALISE (REST EXP) ENV NORMALISE ESC (LAMBDA (& REST!) (CONT (PREP FIRST! REST!)))))))))) ( LAMBDA (&) ((EF (PAIR EXP) (LAMBDA (&) (NORMALISE (CAR EXP) ENV NORMALISE ESC (LAMBDA (& PROC!) ((EF ( NOT (CLOSURE PROC!)) (LAMBDA (&) (ESC (&Q NOT-A-CLOSURE) (& PROC! EXP ENV NORMALISE ESC CONT))) ( LAMBDA (&) ((EF (REFLECTIVE PROC!) (LAMBDA (&) (DOWN (DE-REFLECT PROC!) (CDR EXP) ENV NORMALISE ESC CONT)) (LAMBDA (&) (NORMALISE (CDR EXP) ENV NORMALISE ESC (LAMBDA (& ARGS!) ((LAMBDA (& NEW-ENV) ((EF (EMPTY NEW-ENV) (LAMBDA (&) (ESC (&Q PATTERN-MATCH-FAILED) (& PROC! ARGS! EXP ENV NORMALISE ESC CONT)) ) (LAMBDA (&) ((EF (PRIMITIVE PROC!) (LAMBDA (&) (CONT (UP ((DOWN PROC!) &. (DOWN ARGS!))))) (LAMBDA ( &) (NORMALISE (BODY PROC!) (1ST NEW-ENV) NORMALISE ESC CONT)))))))) (BIND (PATTERN PROC!) ARGS! ( ENVIRONMENT PROC!)))))))))))))) (LAMBDA (&) (CONT EXP)))))))))))) (READ.3-LISP-FN ENVIRONMENT) (DEFINE ENVIRONMENT (LAMBDA (& CLOSURE) (DOWN (ENVIRONMENT-DESIGNATOR CLOSURE)))) (READ.3-LISP-FN DE-REFLECT) (DEFINE DE-REFLECT (LAMBDA (& CLOSURE) (CCONS (&Q SIMPLE) (ENVIRONMENT-DESIGNATOR CLOSURE) (PATTERN CLOSURE) (BODY CLOSURE)))) (READ.3-LISP-FN REFLECTIVE) (DEFINE REFLECTIVE (LAMBDA (& CLOSURE) (= (PROCEDURE-TYPE CLOSURE) (&Q REFLECT)))) (READ.3-LISP-FN NOT) (DEFINE NOT (LAMBDA (& X) (EF X $F $T))) (READ.3-LISP-FN MAP) (DEFINE MAP (LAMBDA ARGS ((EF (EMPTY (2ND ARGS)) (LAMBDA (&) (2ND ARGS)) (LAMBDA (&) ((EF (DOUBLE ARGS ) (LAMBDA (&) (PREP ((1ST ARGS) (1ST (2ND ARGS))) (MAP (1ST ARGS) (REST (2ND ARGS))))) (LAMBDA (&) ( PREP ((1ST ARGS) &. (MAP 1ST (REST ARGS))) (MAP &. (PREP (1ST ARGS) (MAP REST (REST ARGS))))))))))))) (READ.3-LISP-FN DOUBLE) (DEFINE DOUBLE (LAMBDA (& VECTOR) ((EF (EMPTY VECTOR) (LAMBDA (&) $F) (LAMBDA (&) (UNIT (REST VECTOR)) ))))) (READ.3-LISP-FN 2ND) (DEFINE 2ND (LAMBDA (& VECTOR) (1ST (REST VECTOR)))) (READ.3-LISP-FN UNIT) (DEFINE UNIT (LAMBDA (& VECTOR) ((EF (EMPTY VECTOR) (LAMBDA (&) $F) (LAMBDA (&) (EMPTY (REST VECTOR))) )))) (READ.3-LISP-FN PRIMITIVE) (DEFINE PRIMITIVE (LAMBDA (& CLOSURE) (= (PROCEDURE-TYPE CLOSURE) (&Q PRIMITIVE)))) (READ.3-LISP-FN ID) (DEFINE ID (LAMBDA (& X) X)) (READ.3-LISP-FN RAIL) (DEFINE RAIL (LAMBDA (& X) (= (TYPE X) (&Q RAIL)))) (READ.3-LISP-FN PAIR) (DEFINE PAIR (LAMBDA (& X) (= (TYPE X) (&Q PAIR)))) (READ.3-LISP-FN HANDLE) (DEFINE HANDLE (LAMBDA (& X) (= (TYPE X) (&Q HANDLE)))) (READ.3-LISP-FN ATOM) (DEFINE ATOM (LAMBDA (& X) (= (TYPE X) (&Q ATOM)))) (READ.3-LISP-FN CLOSURE) (DEFINE CLOSURE (LAMBDA (& X) (= (TYPE X) (&Q CLOSURE)))) (READ.3-LISP-FN BINDING) (DEFINE BINDING (LAMBDA (& VAR ENV) ((EF (EMPTY ENV) (LAMBDA (&) ENV) (LAMBDA (&) ((EF (= VAR (1ST ( 1ST ENV))) (LAMBDA (&) (REST (1ST ENV))) (LAMBDA (&) (BINDING VAR (REST ENV)))))))))) (READ.3-LISP-FN BIND) (DEFINE BIND (LAMBDA (& PATTERN ARGS BINDINGS) ((EF (ATOM PATTERN) (LAMBDA (&) (& (PREP (& PATTERN ARGS) BINDINGS))) (LAMBDA (&) ((EF (HANDLE ARGS) (LAMBDA (&) (BIND PATTERN (MAP UP (DOWN ARGS)) BINDINGS)) (LAMBDA (&) ((EF (EMPTY PATTERN) (LAMBDA (&) ((EF (EMPTY ARGS) (LAMBDA (&) (& BINDINGS)) ( LAMBDA (&) (&))))) (LAMBDA (&) ((EF (EMPTY ARGS) (LAMBDA (&) (&)) (LAMBDA (&) ((LAMBDA (& RESULT) ((EF (EMPTY RESULT) (LAMBDA (&) (&)) (LAMBDA (&) (BIND (1ST PATTERN) (1ST ARGS) (1ST RESULT)))))) (BIND ( REST PATTERN) (REST ARGS) BINDINGS)))))))))))))))) (READ.3-LISP-FN Y-OPERATOR) (DEFINE Y-OPERATOR (LAMBDA (& H) ((LAMBDA (& G) (H (G G))) (LAMBDA (& G) (LAMBDA-REFLECT (& A E N T C) (N (PCONS (UP (H (G G))) A) E N T C)))))) (READ.3-LISP-FN 3RD) (DEFINE 3RD (LAMBDA (& VECTOR) (2ND (REST VECTOR)))) (READ.3-LISP-FN IF) (DEFINE IF (LAMBDA-MACRO ARGS ((EF (RAIL ARGS) (LAMBDA (&) (PCONS (PCONS (&Q EF) (RCONS (1ST ARGS) ( PCONS (&Q LAMBDA) (RCONS (RCONS) (2ND ARGS))) (PCONS (&Q LAMBDA) (RCONS (RCONS) (3RD ARGS))))) (RCONS) )) (LAMBDA (&) (PCONS (&Q EF) ARGS)))))) (READ.3-LISP-FN LAMBDA-MACRO) (DEFINE LAMBDA-MACRO (LAMBDA-REFLECT (& (& PATTERN BODY) ENV NORMALISE ESC CONT) ((LAMBDA (& EXPANDER) (CONT (UP (LAMBDA-REFLECT (& ARGS ENV2 NORMALISE2 ESC2 CONT2) (NORMALISE2 (EXPANDER &. ARGS) ENV2 NORMALISE2 ESC2 CONT2))))) (DOWN (CCONS (&Q SIMPLE) (UP ENV) PATTERN BODY))))) (READ.3-LISP-FN LET) (DEFINE LET (LAMBDA-MACRO (& LIST BODY) (PCONS (PCONS (&Q LAMBDA) (RCONS (MAP 1ST LIST) BODY)) (MAP 2ND LIST)))) (READ.3-LISP-FN LETSEQ) (DEFINE LETSEQ (LAMBDA-MACRO (& LIST BODY) (IF (EMPTY LIST) BODY (PCONS (&Q LET) (RCONS (RCONS (1ST LIST)) (PCONS (&Q LETSEQ) (RCONS (REST LIST) BODY))))))) (READ.3-LISP-FN Y*-OPERATOR) (DEFINE Y*-OPERATOR (LAMBDA HS (LET (& (& GS (MAP (LAMBDA (& HI) (LAMBDA GS (LAMBDA-REFLECT (& A E N T C) (N (PCONS (UP (HI &. (MAP (LAMBDA (& GI) (GI &. GS)) GS))) ARGS) E N T C)))) HS))) (MAP (LAMBDA (& HI) (HI &. (MAP (LAMBDA (& GI) (GI &. GS)) GS))) HS)))) (READ.3-LISP-FN LETREC) (DEFINE LETREC (LAMBDA-MACRO (& LIST BODY) (LETSEQ (& (& NAMES (MAP 1ST LIST)) (& FORMS (MAP 2ND LIST) ) (& HELPERS (MAP (LAMBDA (& FORMI) (PCONS (&Q LAMBDA) (RCONS NAMES FORMI))) FORMS))) (PCONS (&Q LET) (RCONS (RCONS (RCONS NAMES (PCONS (&Q Y*-OPERATOR) HELPERS))) BODY))))) (READ.3-LISP-FN LENGTH) (DEFINE LENGTH (LAMBDA (& VECTOR) ((EF (EMPTY VECTOR) (LAMBDA (&) 0) (LAMBDA (&) (1+ (LENGTH (REST VECTOR)))))))) (READ.3-LISP-FN FOO) (DEFINE FOO (LAMBDA (& X) (IF (EMPTY X) $F (OR (FOO (REST X)) (FOO (REST X)))))) (READ.3-LISP-FN OR) (DEFINE OR (LAMBDA-MACRO ARGS (IF (EMPTY ARGS) (&Q $F) (PCONS (&Q IF) (RCONS (1ST ARGS) (&Q $T) (PCONS (&Q OR) (REST ARGS))))))) (READ.3-LISP-FN AND) (DEFINE AND (LAMBDA-MACRO ARGS (IF (EMPTY ARGS) (&Q $T) (PCONS (&Q IF) (RCONS (1ST ARGS) (PCONS (&Q AND) (REST ARGS)) (&Q $F)))))) (READ.3-LISP-FN NTH) (DEFINE NTH (LAMBDA (& N VECTOR) (IF (= N 1) (1ST VECTOR) (NTH (1- N) (REST VECTOR))))) (RPAQ TILE1 (READBITMAP)) (12 16 "OOO@" "ONA@" "MNM@" "LNM@" "NFA@" "OCC@" "OIO@" "OHO@" "GBF@" "FGB@" "FOJ@" "COL@" "COL@" "AOH@" "@O@@" "@F@@") (RPAQ TILE2 (READBITMAP)) (16 16 "@@@H" "OOOO" "@@@H" "N@@H" "O@@H" "CH@H" "AH@H" "@L@H" "AL@H" "CF@H" "CF@H" "FC@H" "FC@H" "FAHH" "D@LH" "@@@H") NIL