(original) (raw)

Page Numbers: Yes X: 306 Y: 1.0" First Page: 36 Margins: Top: 1.0" Bottom: 1.3" Heading: z18344l3000x3e4qk40(0,65535) STANDARD PROCEDURES 3-LISP REFERENCE MANUAL March 10, 1984l3000d2469y756x3e4qk40(0,2999)(1,8678)(2,16381)(13,0)\f7 1f1 l3008e2(0,6068)(1,9376)(2,10103)(3,12256)(13,65535)\f3 l3008e2\f3 ;;; First a version without error checking: ;;; l3008e2\f3 (DEFINE READ-NORMALISE-PRINT (LAMBDA [LEVEL ENV STREAM] (NORMALISE (BEGIN (PRINTOUT STREAM LEVEL "> ") (READ STREAM)) ENV (LAMBDA [RESULT-NF] (BEGIN (PRINTOUT STREAM LEVEL "= " RESULT-NF CR) (REBIND 'IT RESULT-NF GLOBAL) (READ-NORMALISE-PRINT LEVEL ENV STREAM))))))l3008e2\f3 l3008e2\f3 (DEFINE NORMALISE (LAMBDA [STRUCTURE ENV CONT] (COND [(NORMAL STRUCTURE) (CONT STRUCTURE)] [(ATOM STRUCTURE) (CONT (BINDING STRUCTURE ENV))] [(RAIL STRUCTURE) (IF (NULL STRUCTURE) (CONT STRUCTURE) (NORMALISE (FIRST STRUCTURE) ENV ESC (LAMBDA [FIRST-NF] (NORMALISE (REST STRUCTURE) ENV ESC (LAMBDA [REST-NF] (CONT (CONS FIRST-NF REST-NF)))))))] [(PAIR STRUCTURE) (NORMALISE (PPROC STRUCTURE) ENV ESC (LAMBDA [PROC-NF] (COND [(MACRO-CLOSURE PROC-NF) (NORMALISE ((EXPANDER PROC-NF) STRUCTURE) ENV ESC CONT)] [(REFLECTIVE-CLOSURE PROC-NF) ((DE-REFLECT PROC-NF) STRUCTURE ENV ESC CONT)] [(SIMPLE-CLOSURE PROC-NF) (NORMALISE (PARGS STRUCTURE) ENV ESC (LAMBDA [ARGS-NF] (IF (PRIMITIVE-CLOSURE PROC-NF) (CONT ^(^PROC-NF . ^ARGS-NF)) (NORMALISE (BODY PROC-NF) (BIND (PATTERN PROC-NF) ARGS-NF (CLOSURE-ENVIRONMENT PROC-NF)) CONT))))])))])))l3008e2\f3 1166f4 1f3 10f4 1f3 ;;; ;;; Then one with full error detection: ;;; l3008e2\f3 (DEFINE READ-NORMALISE-PRINT (LAMBDA [LEVEL ENV STREAM] (NORMALISE (BEGIN (PRINTOUT STREAM LEVEL "> ") (READ STREAM)) ENV (LAMBDA [ERR-MESSAGE ERR-STRUCTURE ERR-ENV ERR-ESC ERR-CONT ERR-CULPRIT ERR-TIDBIT] (BEGIN (PRINTOUT STREAM "Error at level " LEVEL " of type " ERR-MESSAGE "." CR) (PRINTOUT STREAM "Error expression is " err-exp "." CR) (IF (NOT (NULL ERR-CULPRIT)) (PRINTOUT STREAM "Culprit is " ERR-CULPRIT "." CR) T)(IF(NOT(NULLERR−TIDBIT))(PRINTOUTSTREAM"Tidbitis"ERR−CULPRIT"."CR)T) (IF (NOT (NULL ERR-TIDBIT)) (PRINTOUT STREAM "Tidbit is " ERR-CULPRIT "." CR) T)(IF(NOT(NULLERR−TIDBIT))(PRINTOUTSTREAM"Tidbitis"ERR−CULPRIT"."CR)T) (READ-NORMALISE-PRINT LEVEL ENV STREAM))) (LAMBDA [RESULT-NF] (BEGIN (PRINTOUT STREAM LEVEL "= " RESULT-NF CR) (REBIND 'IT RESULT-NF GLOBAL) (READ-NORMALISE-PRINT LEVEL ENV STREAM))))))l3008e2\f3 (DEFINE NORMALISE (LAMBDA [STRUCTURE ENV ESC CONT] (COND [(NORMAL STRUCTURE) (CONT STRUCTURE)] [(ATOM STRUCTURE) (LET [[RESULT (BINDING STRUCTURE ENV)]] (IF (= RESULT "Unbound variable") (ESC RESULT STRUCTURE ENV ESC CONT "" "") (CONT RESULT)))] [(RAIL STRUCTURE) (IF (NULL STRUCTURE) (CONT STRUCTURE) (NORMALISE (FIRST STRUCTURE) ENV ESC (LAMBDA [FIRST-NF] (NORMALISE (REST STRUCTURE) ENV ESC (LAMBDA [REST-NF] (CONT (CONS FIRST-NF REST-NF)))))))] [(PAIR STRUCTURE) (NORMALISE (PPROC STRUCTURE) ENV ESC (LAMBDA [PROC-NF] (COND [(MACRO-CLOSURE PROC-NF) (NORMALISE ((EXPANDER PROC-NF) STRUCTURE) ENV ESC CONT)] [(REFLECTIVE-CLOSURE PROC-NF) ((DE-REFLECT PROC-NF) STRUCTURE ENV ESC CONT)] [(SIMPLE-CLOSURE PROC-NF) (NORMALISE (PARGS STRUCTURE) ENV ESC (LAMBDA [ARGS-NF] (IF (PRIMITIVE-CLOSURE PROC-NF) (CPS-ERROR-PROTECT ^(^PROC-NF . ^ARGS-NF) CONT (LAMBDA [MESSAGE] (ESC MESSAGE STRUCTURE ENV ESC CONT PROC-NF ARGS-NF))) (LET [[NEW-ENV (BIND (PATTERN PROC-NF) ARGS-NF (CLOSURE-ENVIRONMENT PROC-NF))]] (IF (= NEW-ENV "Wrong number of arguments") (ESC NEW-ENV STRUCTURE ENV ESC CONT PROC-NF ARGS-NF) (NORMALISE (BODY PROC-NF) NEW-ENV ESC CONT))))))] [$TRUE (ESC "Not reducible" STRUCTURE ENV ESC CONT PROC-NF "")] )))])l3008e2\f3 1353f4 1f3 10f4 1f3