From 106c07c25abc99cce6a1c369fb32f0fdbbb8882a Mon Sep 17 00:00:00 2001 From: Justine Tunney Date: Fri, 26 Nov 2021 09:50:37 -0800 Subject: [PATCH] Create reform branch (429 bytes) --- lisp.c | 58 +++++++++++++---------------- lisp.lisp | 103 +++++++++++++++++++++++---------------------------- sectorlisp.S | 11 ++---- 3 files changed, 75 insertions(+), 97 deletions(-) diff --git a/lisp.c b/lisp.c index 0f9ab1e..62df434 100644 --- a/lisp.c +++ b/lisp.c @@ -33,15 +33,14 @@ #define kT 4 #define kQuote 6 -#define kCond 12 -#define kAtom 17 -#define kCar 22 -#define kCdr 26 -#define kCons 30 -#define kEq 35 +#define kAtom 12 +#define kCar 17 +#define kCdr 21 +#define kCons 25 +#define kEq 30 #define M (RAM + sizeof(RAM) / sizeof(RAM[0]) / 2) -#define S "NIL\0T\0QUOTE\0COND\0ATOM\0CAR\0CDR\0CONS\0EQ" +#define S "NIL\0T\0QUOTE\0ATOM\0CAR\0CDR\0CONS\0EQ" int cx; /* stores negative memory use */ int dx; /* stores lookahead character */ @@ -125,22 +124,24 @@ PrintAtom(x) { PrintList(x) { PrintChar('('); - PrintObject(Car(x)); - while ((x = Cdr(x))) { - if (x < 0) { - PrintChar(' '); - PrintObject(Car(x)); - } else { - PrintChar(L'∙'); - PrintObject(x); - break; + if (x) { + PrintObject(Car(x)); + while ((x = Cdr(x))) { + if (x < 0) { + PrintChar(' '); + PrintObject(Car(x)); + } else { + PrintChar(L'∙'); + PrintObject(x); + break; + } } } PrintChar(')'); } PrintObject(x) { - if (x < 0) { + if (1./x < 0) { PrintList(x); } else { PrintAtom(x); @@ -186,7 +187,6 @@ Pairlis(x, y, a) { } Assoc(x, y) { - if (!y) return 0; if (x == Car(Car(y))) return Cdr(Car(y)); return Assoc(x, Cdr(y)); } @@ -200,7 +200,7 @@ Evcon(c, a) { } Apply(f, x, a) { - if (f < 0) return Eval(Car(Cdr(Cdr(f))), Pairlis(Car(Cdr(f)), x, a)); + if (f < 0) return Evcon(Cdr(f), Pairlis(Car(f), x, a)); if (f > kEq) return Apply(Eval(f, a), x, a); if (f == kEq) return Car(x) == Car(Cdr(x)) ? kT : 0; if (f == kCons) return Cons(Car(x), Car(Cdr(x))); @@ -211,21 +211,13 @@ Apply(f, x, a) { Eval(e, a) { int A, B, C; - if (e >= 0) - return Assoc(e, a); - if (Car(e) == kQuote) - return Car(Cdr(e)); - A = cx; - if (Car(e) == kCond) { - e = Evcon(Cdr(e), a); - } else { - e = Apply(Car(e), Evlis(Cdr(e), a), a); - } - B = cx; - e = Gc(e, A, A - B); + if (!e) return 0; + if (e > 0) return Assoc(e, a); + if (Car(e) == kQuote) return Car(Cdr(e)); + A = cx, e = Apply(Car(e), Evlis(Cdr(e), a), a); + B = cx, e = Gc(e, A, A - B); C = cx; - while (C < B) - M[--A] = M[--B]; + while (C < B) M[--A] = M[--B]; cx = A; return e; } diff --git a/lisp.lisp b/lisp.lisp index 25a57ab..5d58c1e 100644 --- a/lisp.lisp +++ b/lisp.lisp @@ -61,62 +61,53 @@ NIL ;; FIND FIRST ATOM IN TREE ;; CORRECT RESULT OF EXPRESSION IS `A` ;; RECURSIVE CONDITIONAL FUNCTION BINDING -((LAMBDA (FF X) (FF X)) - (QUOTE (LAMBDA (X) - (COND ((ATOM X) X) - ((QUOTE T) (FF (CAR X)))))) +(((FF X) + ((QUOTE T) (FF X))) + (QUOTE ((X) + ((ATOM X) X) + ((QUOTE T) (FF (CAR X))))) (QUOTE ((A) B C))) -;; LISP IMPLEMENTED IN LISP -;; WITHOUT ANY SUBJECTIVE SYNTACTIC SUGAR -;; RUNS "FIND FIRST ATOM IN TREE" PROGRAM -;; CORRECT RESULT OF EXPRESSION IS STILL `A` -;; REQUIRES CONS CAR CDR QUOTE ATOM EQ LAMBDA COND -;; SIMPLIFIED BUG FIXED VERSION OF JOHN MCCARTHY PAPER -;; NOTE: ((EQ (CAR E) ()) (QUOTE *UNDEFINED)) CAN HELP -;; NOTE: ((EQ (CAR E) (QUOTE LAMBDA)) E) IS NICE -((LAMBDA (ASSOC EVCON PAIRLIS EVLIS APPLY EVAL) - (EVAL (QUOTE ((LAMBDA (FF X) (FF X)) - (QUOTE (LAMBDA (X) - (COND ((ATOM X) X) - ((QUOTE T) (FF (CAR X)))))) +;; LISP IN LISP +;; WITH LANGUAGE REFORMS +(((ASSOC EVCON PAIRLIS EVLIS APPLY EVAL) + ((QUOTE T) + (EVAL (QUOTE (((FF X) + ((QUOTE T) (FF X))) + (QUOTE ((X) + ((ATOM X) X) + ((QUOTE T) (FF (CAR X))))) (QUOTE ((A) B C)))) - ())) - (QUOTE (LAMBDA (X Y) - (COND ((EQ Y ()) ()) - ((EQ X (CAR (CAR Y))) - (CDR (CAR Y))) - ((QUOTE T) - (ASSOC X (CDR Y)))))) - (QUOTE (LAMBDA (C A) - (COND ((EVAL (CAR (CAR C)) A) - (EVAL (CAR (CDR (CAR C))) A)) - ((QUOTE T) (EVCON (CDR C) A))))) - (QUOTE (LAMBDA (X Y A) - (COND ((EQ X ()) A) - ((QUOTE T) (CONS (CONS (CAR X) (CAR Y)) - (PAIRLIS (CDR X) (CDR Y) A)))))) - (QUOTE (LAMBDA (M A) - (COND ((EQ M ()) ()) - ((QUOTE T) (CONS (EVAL (CAR M) A) - (EVLIS (CDR M) A)))))) - (QUOTE (LAMBDA (FN X A) - (COND - ((ATOM FN) - (COND ((EQ FN (QUOTE CAR)) (CAR (CAR X))) - ((EQ FN (QUOTE CDR)) (CDR (CAR X))) - ((EQ FN (QUOTE ATOM)) (ATOM (CAR X))) - ((EQ FN (QUOTE CONS)) (CONS (CAR X) (CAR (CDR X)))) - ((EQ FN (QUOTE EQ)) (EQ (CAR X) (CAR (CDR X)))) - ((QUOTE T) (APPLY (EVAL FN A) X A)))) - ((EQ (CAR FN) (QUOTE LAMBDA)) - (EVAL (CAR (CDR (CDR FN))) - (PAIRLIS (CAR (CDR FN)) X A)))))) - (QUOTE (LAMBDA (E A) - (COND - ((ATOM E) (ASSOC E A)) - ((ATOM (CAR E)) - (COND ((EQ (CAR E) (QUOTE QUOTE)) (CAR (CDR E))) - ((EQ (CAR E) (QUOTE COND)) (EVCON (CDR E) A)) - ((QUOTE T) (APPLY (CAR E) (EVLIS (CDR E) A) A)))) - ((QUOTE T) (APPLY (CAR E) (EVLIS (CDR E) A) A)))))) + ()))) + (QUOTE ((X Y) + ((EQ X (CAR (CAR Y))) (CDR (CAR Y))) + ((QUOTE T) (ASSOC X (CDR Y))))) + (QUOTE ((C A) + ((EVAL (CAR (CAR C)) A) + (EVAL (CAR (CDR (CAR C))) A)) + ((QUOTE T) (EVCON (CDR C) A)))) + (QUOTE ((X Y A) + ((EQ X ()) A) + ((QUOTE T) (CONS (CONS (CAR X) (CAR Y)) + (PAIRLIS (CDR X) (CDR Y) A))))) + (QUOTE ((M A) + ((EQ M ()) ()) + ((QUOTE T) (CONS (EVAL (CAR M) A) + (EVLIS (CDR M) A))))) + (QUOTE ((FN X A) + ((ATOM FN) + ((() ((EQ FN (QUOTE CAR)) (CAR (CAR X))) + ((EQ FN (QUOTE CDR)) (CDR (CAR X))) + ((EQ FN (QUOTE ATOM)) (ATOM (CAR X))) + ((EQ FN (QUOTE CONS)) (CONS (CAR X) (CAR (CDR X)))) + ((EQ FN (QUOTE EQ)) (EQ (CAR X) (CAR (CDR X)))) + ((QUOTE T) (APPLY (EVAL FN A) X A))))) + ((QUOTE T) + (EVCON (CDR FN) (PAIRLIS (CAR FN) X A))))) + (QUOTE ((E A) + ((EQ E ()) ()) + ((ATOM E) (ASSOC E A)) + ((ATOM (CAR E)) + ((() ((EQ (CAR E) (QUOTE QUOTE)) (CAR (CDR E))) + ((QUOTE T) (APPLY (CAR E) (EVLIS (CDR E) A) A))))) + ((QUOTE T) (APPLY (CAR E) (EVLIS (CDR E) A) A))))) diff --git a/sectorlisp.S b/sectorlisp.S index 1ff881d..4aadd8f 100644 --- a/sectorlisp.S +++ b/sectorlisp.S @@ -29,7 +29,6 @@ kT: .asciz "T" # add %dl,(%si) boot A:\ DL=0 start: ljmp $0x7c00>>4,$begin # cs = 0x7c00 is boot address .asciz "" kQuote: .asciz "QUOTE" -kCond: .asciz "COND" kAtom: .asciz "ATOM" # ordering matters kCar: .asciz "CAR" # ordering matters kCdr: .asciz "CDR" # ordering matters @@ -205,13 +204,12 @@ GetList:call GetToken Apply: test %ax,%ax # Apply(fn:ax,x:si:a:dx):ax jns .switch # jump if atom xchg %ax,%di # di = fn -.lambda:mov (%bx,%di),%di # di = Cdr(fn) - push %di # save 1 +.lambda:push (%bx,%di) # save 1 mov (%di),%di # di = Cadr(fn) call Pairlis xchg %ax,%dx pop %di # restore 1 - jmp .EvCadr + jmp Evcon .switch:cmp $kEq,%ax # eq is last builtin atom ja .dflt1 # ah is zero if not above mov (%si),%di # di = Car(x) @@ -255,7 +253,7 @@ Evcon: push %di # save c test %ax,%ax # nil test jz 1b mov (%di),%di # di = Car(c) -.EvCadr:call Cadr # ax = Cadar(c) + call Cadr # ax = Cadar(c) # jmp Eval Eval: test %ax,%ax # Eval(e:ax,a:dx):ax @@ -266,8 +264,6 @@ Eval: test %ax,%ax # Eval(e:ax,a:dx):ax cmp $kQuote,%ax # maybe CONS mov (%si),%di # di = Cdr(e) je Car - cmp $kCond,%ax - je Evcon # ABC Garbage Collector push %dx # save a push %cx # save A push %ax @@ -291,7 +287,6 @@ Eval: test %ax,%ax # Eval(e:ax,a:dx):ax .word 0xAA55 2: .type .sig,@object .type kQuote,@object - .type kCond,@object .type kAtom,@object .type kCar,@object .type kCdr,@object