ares@alessia.dei.unipd.it (Nicola Catacchio 259126) (05/20/91)
This is an inplementation of Mc Carthy's LISP 1.5 , interpreter and compiler.For any explanation, refer to: Mc Carty J. et alii.:LISP 1.5 Programmer's Manual.The MIT press,1965. The only modification is that the Lisp function eval has been renamed EVL , for obvious reasons ;-} |------------------------------------------------------------------------------| |Nicola Catacchio |E-mail: ares@alessia.unipd.it | |Universita' di Padova |mail : Cannaregio 4389, Venezia, Italy | | )/A |tel.# : 041/5222516 | | A A | | | A A RR E EE SSSS | |AAAAAAA--R--R-E-E--E-S--------------------------------------------------------| A A RRR E E SSSS R E S R E SS -----------------------------CUT---------------------------------------- %%HP: T(3)A(R)F(.); DIR LISP \<< { "` " 31 EVL 33 " \183 " 25.2 } STOKEYS -63 SF -62 SF \>> XAMP DIR FATT \<< \-> X \<< CASE X 0 > SO THEN X X 1 - FATT * END 1 END \>> \>> P { DEFUN FATT { X } { COND { { > X 0 } { * X { FATT { - X 1 } } } } { T 1 } } } SORTN \<< \-> N \<< CASE N 0 < SO THEN NIL END N 2 MOD SO THEN N 1 - SORTN N 1 \->LIST APPEND END N N 1 - SORTN CONS END \>> \>> DINSPOT "{DEFUN INSPOT {L}{COND {L{{\Gl{K}{ APPEND{ADDTO{ CAR L}K}K}}{INSPOT {CDR L}}}}{T{ LIST NIL }}" DADDTO "{DEFUN ADDTO {O L}{COND {L{CONS {CONS O{CAR L}} {ADDTO O{CDR L}}" DREV "{DEFUN REV{X} {COND {{CDR X}{APPEND {REV{CDR X}} {LIST{CAR X}}}} {T X}}}" DFLAT "{DEFUN FLAT{X} {COND {{AND{ATOM X}X} {LIST X}} {X{APPEND {FLAT{CAR X}} {FLAT{CDR X}}}}}}" DDEPTHF "{DEFUN DEPTHF {L X}{{\Gl{C} {COND {{SAME{CAR C}X}C} {T{DEPTHF{APPEND {CDR C}{CDR L}}X}}}} {CAR L}}" DSORTN "{DEFUN SORTN {N}{COND {{< N 0}NIL} {{MOD N 2} {APPEND{SORTN{- N 1}} {LIST N}}} {T{CONS N {SORTN{- N 1" END EVL \<< IF DUP TYPE 5 - THEN EVAL ELSE OBJ\-> IF DUP THEN 1 - \->LIST IF { \Gl COND DEFINE LIST ` PROGRAM DEFUN LABEL } 3 PICK POS THEN SWAP EVAL ELSE EVLIS APPLY END ELSE DROP { } END END \>> APPLY \<< OBJ\-> 1 + ROLL IFERR RCL THEN END EVL \>> ` \<< IF DUP TYPE THEN OBJ\-> DROP ELSE GETI END \>> \183 \<< "Dot Notation Error: Bad form" DOERR \>> DEFUN \<< DUP CAR SWAP 1 '\Gl' PUT 1 \->LIST PROGRAM SWAP STO NIL \>> \Gl \<< OBJ\-> DROP \->STR "EVL " + " \-> " ROT \->STR 2 OVER SIZE 2 - SUB + SWAP BRCK + OBJ\-> \>> CONS \<< IF DUP TYPE 5 \=/ THEN '\183' SWAP 3 ELSE LIST\-> 1 + END \->LIST \>> CAR \<< 1 GET \>> CDR \<< IF DUP '\183' POS 2 - THEN 2 9999 SUB ELSE 3 GET END \>> EQ \<< \=/ NULL \>> ATOM \<< DUP TYPE 5 - 1 ROT NULL 1 \->LIST IFTE \>> LABEL \<< OBJ\-> DROP SWAP "{} \-> " OVER + "\<< \->STR OBJ\-> DUP " + SWAP \->STR + " STO EVL " + OBJ\-> \>> DEFINE \<< OBJ\-> 1 - \->LIST \<< \>> 3 PICK STO PROGRAM SWAP STO NIL \>> COND \<< { { T NIL } } + 1 0 DO DROP GETI UNTIL OBJ\-> DROP SWAP EVL SO END ROT ROT DROP2 EVL \>> NULL \<< SO 'NIL' 1 IFTE \>> EVLIS \<< IF DUP SIZE THEN { } SWAP 1 DO GETI EVL 4 ROLL SWAP 1 \->LIST + ROT ROT UNTIL DUP 1 == END DROP2 END \>> NIL { } NOT \<< SO 'NIL' 'T' IFTE \>> OR \<< SO 'T' ROT 1 \->LIST IFTE \>> AND \<< SO SWAP 1 \->LIST 'NIL' IFTE \>> SO \<< { NIL { } 0 } SWAP POS NOT \>> OS \<< { NIL { } 0 } OVER POS 'NIL' ROT 1 \->LIST IFTE \>> PROGRAM \<< IF DUP TYPE THEN CAR CMP BRCK OBJ\-> ELSE GETI END \>> LIST \<< EVLIS \>> CMP \<< IF DUP ATOM SO THEN DUP TYPE CASE 18 \>= THEN BRCK END END IF DUP { } SAME THEN \->STR ELSE " " + END ELSE OBJ\-> 1 - \->LIST SWAP CASE DUP 'COND' SAME THEN DROP { { T NIL } } + "CASE " SWAP 1 WHILE GETI OBJ\-> DROP OVER 'T' SAME NOT SO REPEAT SWAP CMP "SO THEN " + SWAP CMP + "END " + 4 ROLL SWAP + ROT ROT END 4 ROLLD 3 DROPN CMP "END " + + END DUP '\Gl' SAME THEN DROP OBJ\-> DROP " \-> " ROT \->STR 2 OVER SIZE 1 - SUB + SWAP CMP BRCK + END DUP 'LABEL' SAME THEN DROP OBJ\-> DROP SWAP "\<<\>>\-> " OVER + ROT CMP BRCK "DUP " + ROT \->STR + " STO EVAL " + BRCK + END { DEFINE DEFUN } OVER POS THEN SWAP \->STR SWAP + END DUP 'LIST' SAME THEN DROP DUP CMLIS SWAP SIZE \->STR + " \->LIST " + END DUP '`' SAME THEN DROP CAR CMP "'" SWAP + "'" + END DUP 'PROGRAM' SAME THEN DROP CAR CMP BRCK END DUP TYPE CASE DUP 6 == THEN DROP DUP IF VTYPE 5 == THEN \->STR " RCL EVL " + ELSE CMP END END 5 == THEN CMP END \->STR END " " + SWAP CMLIS SWAP + END END \>> CMLIS \<< " " SWAP IF DUP SIZE THEN 1 DO GETI IF { ` PROGRAM } OVER POS THEN EVAL \->STR ELSE CMP END 4 ROLL SWAP + ROT ROT DUP UNTIL 1 == END DROP END DROP \>> MEMBER \<< SWAP POS NOT NULL \>> APPEND \<< \-> X Y \<< CASE X ATOM SO NOT THEN X CAR X CDR Y APPEND CONS END Y END \>> \>> SET \<< DUP ROT STO \>> F { } BRCK \<< "\<<" SWAP \->STR + "\>>" + \>> \GaENTER \<< "{" SWAP + OBJ\-> IF 1 FS? THEN CMP OBJ\-> ELSE EVL END \>> T 1 CST { EVL CMP ` " \183 " \Gl NIL CAR CDR CONS APPLY ATOM PROGRAM LIST DEFUN DEFINE MEMBER COND APPEND NULL SET AND OR NOT } NAME \<< \->STR # 23317d SYSEVAL \>> END