Browse Source

Make it friendlier

Justine Tunney 3 years ago
parent
commit
0f6b147099
2 changed files with 35 additions and 27 deletions
  1. 17 13
      lisp.c
  2. 18 14
      lisp.lisp

+ 17 - 13
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);
   }
 }

+ 18 - 14
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))))))