(EDIT E EF H L S C X PASTE EQUAL GETCMD *COMMANDS* PSET SETP R A D B LI RE CONZ PRE I DEL G PP P PPRINT PPAUX MULTARGS PPARGS TABRET *FORMATS* LPAR BLANK RPAR LINE-WIDTH PU LOCK UNLOCK GETLST)›(SETQ EDIT '(PP)›)›(DEFINEQ EDIT '(LAMBDA (S-EXP) (PROG (CURR PREV X) (COND ((EQ S-EXP) (SETQ S-EXP %LASTEXP))) T (SETQ %LASTEXP S-EXP) (PSET S-EXP) (SETQ PREV (LIST S-EXP)) LOOP (POKE 128 0) (COND ((EQ (SETQ X (GETCMD (QUOTE "ลไ้๔> "))) (QUOTE EX)) (RETURN (QUOTE EXIT)))) (POKE 128 63) (COND ((EQ X (QUOTE T)) (GO T)) ((MEMBER X *COMMANDS*) (APPLY* X)) ((PRIN2 (LIST (QUOTE ILL) (QUOTE COMMAND-->) X)) (TERPRI))) (GO LOOP)))›)›(DEFINEQ E '(LAMBDA NIL ((LAMBDA (X) (PROGN (SETQ S-EXP (COND ((EVAL X)) (T (POKE 128 0) (PRIN1 (QUOTE ร๒ๅแ๔้๎็-->)) (PRINT X) (SET X (GETLST (GETCMD (QUOTE "ษ๎๐๕๔> "))))))) (GO T))) (READ)))›)›(DEFINEQ EF '(LAMBDA NIL ((LAMBDA (X) (PROGN (SETQ S-EXP (COND ((GETD X)) (T (POKE 128 0) (PRIN1 (QUOTE ร๒ๅแ๔้๎็-->)) (PRINT X) (DEFINE X (GETLST (GETCMD (QUOTE "ษ๎๐๕๔> "))))))) (GO T))) (READ)))›)›(DEFINEQ H '(LAMBDA NIL (PRIN1 (LIST (QUOTE COMMANDS:) COMMANDS)))›)›(DEFINEQ L '(LAMBDA NIL ((LAMBDA (FILE) (PROGN (LOAD FILE) (PRIN1 (QUOTE "ฬ๏แไๅไ--> ")) (PRINT (EVAL FILE)))) (GETCMD (QUOTE "ฦ้์ๅ> "))))›)›(DEFINEQ S '(LAMBDA NIL (PROGN (SAVE (EVAL (GETCMD (QUOTE "ะ๒๏๐ๅ๒๔้ๅ๓> "))) (GETCMD (QUOTE "ฦ้์ๅ> "))) (PRINT (QUOTE ำแ๖ๅไ))))›)›(DEFINEQ C '(LAMBDA NIL (DIR (READ)))›)›(SETQ X 'S›)›(DEFINEQ X '(LAMBDA NIL (PROGN (PASTE CURR (READ) (READ)) (PSET CURR)))›)›(DEFINEQ PASTE '(LAMBDA (X Y Z) (COND ((EQUAL X)) ((ATOM X)) ((EQUAL (CAR X) Y) (RPLACA X Z) (PASTE (CDR X) Y Z)) (T (PASTE (CAR X) Y Z) (PASTE (CDR X) Y Z))))›)›(DEFINEQ EQUAL '(LAMBDA (X Y) (COND ((ATOM X) (EQ X Y)) ((ATOM Y) (EQ X Y)) ((AND (EQUAL (CAR X) (CAR Y)) (EQUAL (CDR X) (CDR Y))))))›)›(DEFINEQ GETCMD '(LAMBDA (X) (PROGN (POKE 128 0) (TERPRI) (PRIN1 X) (READ)))›)›(SETQ *COMMANDS* '(A D B P R DEL I G LI RE PP PRE C E EF X S L H PU LOCK UNLOCK)›)›(DEFINEQ *COMMANDS* '(NIL)›)›(DEFINEQ PSET '(LAMBDA (L) (PRINT (CAR (SETQ CURR L))))›)›(DEFINEQ SETP '(LAMBDA (FUNCTION) (COND ((ATOM (APPLY* FUNCTION CURR)) (PRINT (QUOTE ล๎ไ฿๏ๆ฿์้๓๔))) (T (SETQ PREV (CONS CURR PREV)) (PSET (APPLY* FUNCTION CURR)))))›)›(DEFINEQ R '(LAMBDA NIL (PRINT (CAR (RPLACA CURR (READ)))))›)›(SETQ A '(A)›)›(DEFINEQ A '(LAMBDA NIL (SETP (QUOTE CDR)))›)›(DEFINEQ D '(LAMBDA NIL (SETP (QUOTE CAR)))›)›(DEFINEQ B '(LAMBDA NIL (COND ((EQ (CDR PREV)) (PRINT (QUOTE ิ๏๐฿๏ๆ฿์้๓๔)) (PSET CURR)) (T (PSET (CAR PREV)) (SETQ PREV (CDR PREV)))))›)›(DEFINEQ LI '(LAMBDA NIL (PSET (RPLACA CURR (LIST (CAR CURR)))))›)›(DEFINEQ RE '(LAMBDA NIL (COND ((ATOM (CAR CURR)) (PRIN1 (QUOTE ฮ๏๔฿แ฿์้๓๔)) (TERPRI)) (T (PROG NIL (NCONC (CAR CURR) (CDR CURR)) (PSET (CONZ CURR (CAR (CAR CURR)) (CDR (CAR CURR))))))))›)›(DEFINEQ CONZ '(LAMBDA (X Y Z) (RPLACA (RPLACD X Z) Y))›)›(DEFINEQ PRE '(LAMBDA NIL (PSET (RPLACA CURR (CONS (READ) (LIST (CAR CURR))))))›)›(DEFINEQ I '(LAMBDA NIL (PROG NIL (RPLACD CURR (CONS (READ) (CDR CURR))) (A)))›)›(DEFINEQ DEL '(LAMBDA NIL (PROG NIL ((LAMBDA (X) (COND ((EQ CURR X) (CONZ CURR (CAR (CDR CURR)) (CDR (CDR CURR)))) ((EQ CURR (CDR X)) (RPLACD X (CDR CURR))) (T (RPLACA X (CDR CURR))))) (CAR PREV)) (B)))›)›(DEFINEQ G '(LAMBDA NIL (PROG (X Y) (SETQ Y CURR) L (SETQ X (GETCMD (QUOTE "ว๒๏๕๐> "))) (COND ((EQ X (QUOTE A)) (COND ((EQ (CDR Y)) (PRINT (QUOTE ล๎ไ฿๏ๆ฿์้๓๔))) (T (PRINT (CAR (SETQ Y (CDR Y))))))) ((EQ X (QUOTE G)) (RETURN (COND ((EQ CURR Y) (LI)) (T (CONZ CURR (CONS (CAR CURR) (CDR CURR)) (CDR Y)) (RPLACD Y NIL) (PRINT (CAR CURR)))))) (T (RETURN (PRINT (QUOTE มโ๏๒๔ๅไ))))) (GO L)))›)›(DEFINEQ PP '(LAMBDA NIL (PPRINT S-EXP 2))›)›(DEFINEQ P '(LAMBDA NIL (PPRINT (CAR CURR) 2))›)›(DEFINEQ PPRINT '(LAMBDA (X IND) (PROG (TFLG) (PPAUX X IND) (TERPRI)))›)›(DEFINEQ PPAUX '(LAMBDA (X INDTN) (COND ((ATOM X) (PRIN2 X) (SETQ TFLG)) ((ATOM (CAR X)) ((LAMBDA (Y) (COND (Y (MULTARGS X INDTN (CDR Y))) ((PROGN (PRIN1 LPAR) (PRIN2 (CAR X)) (PPARGS (CDR X) INDTN) (PRIN1 RPAR) (SETQ TFLG))))) (ASSOC (CAR X) *FORMATS*))) (((LAMBDA (IND1) (PROGN (PRIN1 LPAR) (SETQ TFLG T) (PPAUX (CAR X) IND1) (TABRET INDTN) (PPARGS (CDR X) IND1) (PRIN1 RPAR) (SETQ TFLG))) (+ INDTN 1)))))›)›(DEFINEQ MULTARGS '(LAMBDA (X INDTN L) ((LAMBDA (INDTN2) (PROGN (TABRET INDTN) (PRIN1 LPAR) (PRIN2 (CAR X)) (PRIN1 BLANK) (PPAUX (CAR (CDR X)) INDTN2) (COND ((CDR (CDR X)) (MAPCAR (CDR (CDR X)) (QUOTE (LAMBDA (Y) (PROG NIL (TABRET INDTN2) (PPAUX Y INDTN2))))))) (PRIN1 RPAR) (SETQ TFLG))) (+ INDTN (CAR L))))›)›(DEFINEQ PPARGS '(LAMBDA (X INDTN) (PROG NIL LOOP (COND ((EQ X) (RETURN)) ((ATOM X) (PRIN1 (QUOTE " . ")) (PRIN1 X) (RETURN))) (PRIN1 BLANK) (PPAUX (CAR X) INDTN) (SETQ X (CDR X)) (GO LOOP)))›)›(DEFINEQ TABRET '(LAMBDA (N) (PROG NIL (COND (TFLG (RETURN)) ((TERPRI))) (SETQ TFLG T) (COND ((> N LINE-WIDTH) (TERPRI) (TAB (SUB N LINE-WIDTH))) ((TAB N)))))›)›(SETQ *FORMATS* '((COND 6) (LAMBDA 2) (PROG 6) (PROGN 7) (AND 5) (OR 4) (MAPCAR 8) (NLAMBDA 2) (MACRO 2))›)›(DEFINEQ *FORMATS* '(NIL)›)›(SETQ LPAR '"("›)›(DEFINEQ LPAR '(NIL)›)›(SETQ BLANK '" "›)›(DEFINEQ BLANK '(NIL)›)›(SETQ RPAR ')›)›(DEFINEQ RPAR '(NIL)›)›(SETQ LINE-WIDTH '39›)›(DEFINEQ LINE-WIDTH '(NIL)›)›(DEFINEQ PU '(LAMBDA NIL ((LAMBDA (X) (PROGN (COND ((EQ (GETCMD (QUOTE "ล๎๔ๅ๒ งูง ๔๏ ไๅ์ๅ๔ๅ> ")) (QUOTE Y)) (XIO 33 7 0 0 X) (CLOSE 7))) (DIR))) (READ)))›)›(DEFINEQ LOCK '(LAMBDA NIL ((LAMBDA (X) (PROGN (XIO 35 7 0 0 X) (CLOSE 7))) (READ)))›)›(DEFINEQ UNLOCK '(LAMBDA NIL ((LAMBDA (X) (PROGN (XIO 36 7 0 0 X) (CLOSE 7))) (READ)))›)›(DEFINEQ GETLST '(LAMBDA (X) (COND ((ATOM X) (LIST X)) (X)))›)›NIL›