diff --git a/lisp.c b/lisp.c index bc85972..3fbdd95 100644 --- a/lisp.c +++ b/lisp.c @@ -56,10 +56,10 @@ function Intern(x, y, i) { function ReadAtom(h) { var c = ReadChar(); - if (c <= 32) return ReadAtom(h); - return Intern(c, c > 41 && dx > 41 ? + if (c <= Ord(' ')) return ReadAtom(h); + return Intern(c, c > Ord(')') && dx > Ord(')') ? ReadAtom(Hash(h, c)) : 0, - Hash(h, c) - Hash(0, 78)); + Hash(h, c) - Hash(0, Ord('N'))); } function PrintAtom(x) { @@ -73,31 +73,31 @@ function AddList(x) { function ReadList() { var t = ReadAtom(0); - if (Get(t) == 41) return 0; + if (Get(t) == Ord(')')) return -0; return AddList(ReadObject(t)); } function ReadObject(t) { - if (Get(t) != 40) return t; + if (Get(t) != Ord('(')) return t; return ReadList(); } function PrintList(x) { - PrintChar(40); + PrintChar(Ord('(')); if (x < 0) { PrintObject(Car(x)); while ((x = Cdr(x))) { if (x < 0) { - PrintChar(32); + PrintChar(Ord(' ')); PrintObject(Car(x)); } else { - PrintChar(8729); + PrintChar(0x2219); PrintObject(x); break; } } } - PrintChar(41); + PrintChar(Ord(')')); } function PrintObject(x) { @@ -110,7 +110,7 @@ function PrintObject(x) { function Print(e) { PrintObject(e); - PrintChar(10); + PrintChar(Ord('\n')); } function Read() { @@ -154,7 +154,7 @@ function Copy(x, m, k) { function Evlis(m, a) { return m ? Cons(Eval(Car(m), a), - Evlis(Cdr(m), a)) : 0; + Evlis(Cdr(m), a)) : m; } function Pairlis(x, y, a) { @@ -226,6 +226,10 @@ function Lisp() { } } +Ord(c) { + return c; +} + Throw(x) { longjmp(undefined, x); } @@ -252,13 +256,13 @@ ReadChar() { free(freeme); freeme = 0; line = 0; - c = 10; + c = Ord('\n'); } t = dx; dx = c; return t; } else { - PrintChar(10); + PrintChar(Ord('\n')); exit(0); } } diff --git a/lisp.lisp b/lisp.lisp index c7fc750..2554631 100644 --- a/lisp.lisp +++ b/lisp.lisp @@ -61,7 +61,8 @@ NIL ;; FIND FIRST ATOM IN TREE ;; CORRECT RESULT OF EXPRESSION IS `A` ;; RECURSIVE CONDITIONAL FUNCTION BINDING -((LAMBDA (FF X) (FF X)) +((LAMBDA (FF X) + (FF X)) (QUOTE (LAMBDA (X) (COND ((ATOM X) X) ((QUOTE T) (FF (CAR X)))))) @@ -76,28 +77,27 @@ NIL ;; 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)))))) + (EVAL (QUOTE ((LAMBDA (FF X) + (FF X)) + (LAMBDA (X) + (COND ((ATOM X) X) + (T (FF (CAR X))))) (QUOTE ((A) B C)))) - ())) + NIL)) (QUOTE (LAMBDA (X Y) - (COND ((EQ Y ()) ()) - ((EQ X (CAR (CAR Y))) - (CDR (CAR Y))) - ((QUOTE T) - (ASSOC X (CDR Y)))))) + (COND ((EQ Y NIL) (QUOTE *UNDEFINED)) + ((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) + (COND ((EQ X NIL) A) ((QUOTE T) (CONS (CONS (CAR X) (CAR Y)) (PAIRLIS (CDR X) (CDR Y) A)))))) (QUOTE (LAMBDA (M A) - (COND ((EQ M ()) ()) + (COND ((EQ M NIL) M) ((QUOTE T) (CONS (EVAL (CAR M) A) (EVLIS (CDR M) A)))))) (QUOTE (LAMBDA (FN X A) @@ -114,10 +114,14 @@ NIL (PAIRLIS (CAR (CDR FN)) X A)))))) (QUOTE (LAMBDA (E A) (COND - ((ATOM E) (ASSOC E A)) + ((ATOM E) + (COND ((EQ E NIL) E) + ((EQ E (QUOTE T)) (QUOTE T)) + ((QUOTE T) (ASSOC E A)))) ((ATOM (CAR E)) (COND ((EQ (CAR E) (QUOTE QUOTE)) (CAR (CDR E))) ((EQ (CAR E) (QUOTE COND)) (EVCON (CDR E) A)) + ((EQ (CAR E) (QUOTE LAMBDA)) E) ((QUOTE T) (APPLY (CAR E) (EVLIS (CDR E) A) A)))) ((QUOTE T) (APPLY (CAR E) (EVLIS (CDR E) A) A))))))