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) {
 function ReadAtom(h) {
   var c = ReadChar();
   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,
                 ReadAtom(Hash(h, c)) : 0,
-                Hash(h, c) - Hash(0, 78));
+                Hash(h, c) - Hash(0, Ord('N')));
 }
 }
 
 
 function PrintAtom(x) {
 function PrintAtom(x) {
@@ -73,31 +73,31 @@ function AddList(x) {
 
 
 function ReadList() {
 function ReadList() {
   var t = ReadAtom(0);
   var t = ReadAtom(0);
-  if (Get(t) == 41) return 0;
+  if (Get(t) == Ord(')')) return -0;
   return AddList(ReadObject(t));
   return AddList(ReadObject(t));
 }
 }
 
 
 function ReadObject(t) {
 function ReadObject(t) {
-  if (Get(t) != 40) return t;
+  if (Get(t) != Ord('(')) return t;
   return ReadList();
   return ReadList();
 }
 }
 
 
 function PrintList(x) {
 function PrintList(x) {
-  PrintChar(40);
+  PrintChar(Ord('('));
   if (x < 0) {
   if (x < 0) {
     PrintObject(Car(x));
     PrintObject(Car(x));
     while ((x = Cdr(x))) {
     while ((x = Cdr(x))) {
       if (x < 0) {
       if (x < 0) {
-        PrintChar(32);
+        PrintChar(Ord(' '));
         PrintObject(Car(x));
         PrintObject(Car(x));
       } else {
       } else {
-        PrintChar(8729);
+        PrintChar(0x2219);
         PrintObject(x);
         PrintObject(x);
         break;
         break;
       }
       }
     }
     }
   }
   }
-  PrintChar(41);
+  PrintChar(Ord(')'));
 }
 }
 
 
 function PrintObject(x) {
 function PrintObject(x) {
@@ -110,7 +110,7 @@ function PrintObject(x) {
 
 
 function Print(e) {
 function Print(e) {
   PrintObject(e);
   PrintObject(e);
-  PrintChar(10);
+  PrintChar(Ord('\n'));
 }
 }
 
 
 function Read() {
 function Read() {
@@ -154,7 +154,7 @@ function Copy(x, m, k) {
 
 
 function Evlis(m, a) {
 function Evlis(m, a) {
   return m ? Cons(Eval(Car(m), a),
   return m ? Cons(Eval(Car(m), a),
-                  Evlis(Cdr(m), a)) : 0;
+                  Evlis(Cdr(m), a)) : m;
 }
 }
 
 
 function Pairlis(x, y, a) {
 function Pairlis(x, y, a) {
@@ -226,6 +226,10 @@ function Lisp() {
   }
   }
 }
 }
 
 
+Ord(c) {
+  return c;
+}
+
 Throw(x) {
 Throw(x) {
   longjmp(undefined, x);
   longjmp(undefined, x);
 }
 }
@@ -252,13 +256,13 @@ ReadChar() {
       free(freeme);
       free(freeme);
       freeme = 0;
       freeme = 0;
       line = 0;
       line = 0;
-      c = 10;
+      c = Ord('\n');
     }
     }
     t = dx;
     t = dx;
     dx = c;
     dx = c;
     return t;
     return t;
   } else {
   } else {
-    PrintChar(10);
+    PrintChar(Ord('\n'));
     exit(0);
     exit(0);
   }
   }
 }
 }

+ 18 - 14
lisp.lisp

@@ -61,7 +61,8 @@ NIL
 ;; FIND FIRST ATOM IN TREE
 ;; FIND FIRST ATOM IN TREE
 ;; CORRECT RESULT OF EXPRESSION IS `A`
 ;; CORRECT RESULT OF EXPRESSION IS `A`
 ;; RECURSIVE CONDITIONAL FUNCTION BINDING
 ;; RECURSIVE CONDITIONAL FUNCTION BINDING
-((LAMBDA (FF X) (FF X))
+((LAMBDA (FF X)
+   (FF X))
  (QUOTE (LAMBDA (X)
  (QUOTE (LAMBDA (X)
           (COND ((ATOM X) X)
           (COND ((ATOM X) X)
                 ((QUOTE T) (FF (CAR X))))))
                 ((QUOTE T) (FF (CAR X))))))
@@ -76,28 +77,27 @@ NIL
 ;; NOTE: ((EQ (CAR E) ()) (QUOTE *UNDEFINED)) CAN HELP
 ;; NOTE: ((EQ (CAR E) ()) (QUOTE *UNDEFINED)) CAN HELP
 ;; NOTE: ((EQ (CAR E) (QUOTE LAMBDA)) E) IS NICE
 ;; NOTE: ((EQ (CAR E) (QUOTE LAMBDA)) E) IS NICE
 ((LAMBDA (ASSOC EVCON PAIRLIS EVLIS APPLY EVAL)
 ((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))))
                  (QUOTE ((A) B C))))
-         ()))
+         NIL))
  (QUOTE (LAMBDA (X Y)
  (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)
  (QUOTE (LAMBDA (C A)
           (COND ((EVAL (CAR (CAR C)) A)
           (COND ((EVAL (CAR (CAR C)) A)
                  (EVAL (CAR (CDR (CAR C))) A))
                  (EVAL (CAR (CDR (CAR C))) A))
                 ((QUOTE T) (EVCON (CDR C) A)))))
                 ((QUOTE T) (EVCON (CDR C) A)))))
  (QUOTE (LAMBDA (X Y A)
  (QUOTE (LAMBDA (X Y A)
-          (COND ((EQ X ()) A)
+          (COND ((EQ X NIL) A)
                 ((QUOTE T) (CONS (CONS (CAR X) (CAR Y))
                 ((QUOTE T) (CONS (CONS (CAR X) (CAR Y))
                                  (PAIRLIS (CDR X) (CDR Y) A))))))
                                  (PAIRLIS (CDR X) (CDR Y) A))))))
  (QUOTE (LAMBDA (M A)
  (QUOTE (LAMBDA (M A)
-          (COND ((EQ M ()) ())
+          (COND ((EQ M NIL) M)
                 ((QUOTE T) (CONS (EVAL (CAR M) A)
                 ((QUOTE T) (CONS (EVAL (CAR M) A)
                                  (EVLIS (CDR M) A))))))
                                  (EVLIS (CDR M) A))))))
  (QUOTE (LAMBDA (FN X A)
  (QUOTE (LAMBDA (FN X A)
@@ -114,10 +114,14 @@ NIL
                    (PAIRLIS (CAR (CDR FN)) X A))))))
                    (PAIRLIS (CAR (CDR FN)) X A))))))
  (QUOTE (LAMBDA (E A)
  (QUOTE (LAMBDA (E A)
           (COND
           (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))
             ((ATOM (CAR E))
              (COND ((EQ (CAR E) (QUOTE QUOTE)) (CAR (CDR E)))
              (COND ((EQ (CAR E) (QUOTE QUOTE)) (CAR (CDR E)))
                    ((EQ (CAR E) (QUOTE COND)) (EVCON (CDR E) A))
                    ((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))))
             ((QUOTE T) (APPLY (CAR E) (EVLIS (CDR E) A) A))))))
             ((QUOTE T) (APPLY (CAR E) (EVLIS (CDR E) A) A))))))