Merge pull request #7 from NJdevPro/extend

Add lisp primitive, remove and/or primitives

README.md

@@ -12,11 +12,10 @@ able to run on low powered devices.
 
 The added primitives:
 * strings and conversion
-* predicates >, >=, <=, or, and, not,
-* functions atom, length, reverse, progn, load.
+* predicates >, >=, <=, not,
+* functions list, atom, length, reverse, progn, load.
 
-This has the side effect of being much faster as well, since all these primitives are 
-compiled instead of being interpreted.
+This has the side effect of being much faster as well, since all these primitives are compiled instead of being interpreted.
 
 Among the bells and whistles, I've added a Read-Eval-Print-Loop (REPL) based on Justine Tunney (jart)'s bestline.
 
@@ -86,9 +85,6 @@ The REPL also saves the history of commands in the file history.txt
 This file is loaded at startup, so one can recall previous commands.
 
 Known bugs:
-* Operators "and" and "or" do not work like their typical Lisp counterpart 
-because they evaluate all their operands at the same time instead of one
-by one. You may use the versions in the library.lisp file to correct this behavior.
 * recall of multiline commands does not work as expected.
 * this doesn't have tail call optimization, so expect crashes with sometimes with surprisingly short lists. 
 
@@ -180,16 +176,15 @@ car.
     (setcar cell 'x)
     cell  ; -> (x . b)
 
-`length` and `reverse` operate on a whole list or a string. They can also operate on their 
-arguments when their number is > 1.
+`length` and `reverse` operate either on their arguments, or a single list or a string.
 
     (length '(1 2 3))   ; -> 3
     (length 1 2 t)      ; -> 3
     (length "1 2 3")    ; -> 5
 
     (reverse '(a b c))  ; -> (c b a)
     (reverse "1234")    ; -> "4321" 
-    (reverse '((a) b "c")  ; -> ("c" b (a))
+    (reverse '((a) b "c"))  ; -> (c b (a))
 
 ### Numeric operators
 
@@ -223,26 +218,6 @@ the second.
 
 The other numerical predicates `>`, `<=`, `>=` work in a similar fashion.
 
-`and` takes two or more arguments, evaluates them, and returns the last argument
-that returns true, if all the arguments return true, or () otherwise.
-
-    (and 1 t 2)         ; -> 2
-    (and 1 t (- 3 4))   ; -> -1
-    (and 1 () 2)        ; -> ()
-    (and)               ; t
-
-`or` takes two or more arguments, evaluates them, and returns the first argument
-that returns true.
-
-    (or 1 () 2)  ; -> 1
-    (or () ())   ; -> ()
-    (or)         ; -> ()
-
-Nota Bene: because all the arguments are evaluated, `and` and `or` do not operate  
-like their counterparts written in Lisp, as those stop evaluation at the first 
-argument that returns. If the arguments have side effects, this may affect the 
-program differently.
-
 ### Conditionals
 
 `(if cond then else)` is the only conditional in the language. It first
@@ -277,7 +252,7 @@ contents but actually different are considered to not be the same by `eq`.
 
 ### String functions
 
-`eq` compares two strings.
+`eq` can also compare two strings.
 
     (eq "Hello" "Hello")    ; -> t
     (eq "Hello" "hello")    ; -> ()

examples/library.lisp

@@ -2,12 +2,6 @@
 ;;  Simple library of useful functions and macros
 ;; 
 
-(defun list (x . y)
-  (cons x y))
-
-(defmacro progn (expr . rest)
-  (list (cons 'lambda (cons () (cons expr rest)))))
-
 ;; (and e1 e2 ...)
 ;; => (if e1 (and e2 ...))
 ;; (and e1)

examples/life.lisp

@@ -4,8 +4,8 @@
 
 (load "examples/library.lisp")
 
-(define width 10)
-(define height 10)
+(define width 15)
+(define height 15)
 
 ;; Returns location (x, y)'s element.
 (defun get (board x y)
@@ -44,24 +44,36 @@
            (or (= c 2) (= c 3))
          (= c 3))))
 
+(define iter 1)
+(define idx_height (iota height))
+(define idx_width (iota width))
+
 (defun run (board)
   (while t
     (print board)
-    (println '*)
-    (let newboard (map (iota height)
+    (if (= iter 100) 
+      (exit 0) 
+      (setq iter (+ 1 iter)))
+    (println iter)
+    (let newboard (map idx_height
                        (lambda (y)
-                         (map (iota width)
+                         (map idx_width
                               (lambda (x)
                                 (if (next board x y) '@ '_)))))
          (setq board newboard))))
 
-(run '((_ _ _ _ _ _ _ _ _ _)
-       (_ _ _ _ _ _ _ _ _ _)
-       (_ _ _ _ _ _ _ _ _ _)
-       (_ _ _ _ _ _ _ _ _ _)
-       (_ _ _ _ _ _ _ _ _ _)
-       (_ _ _ _ _ _ _ _ _ _)
-       (_ _ _ _ _ _ _ _ _ _)
-       (_ @ @ @ _ _ _ _ _ _)
-       (_ _ _ @ _ _ _ _ _ _)
-       (_ _ @ _ _ _ _ _ _ _)))
+(run '((_ _ _ _ _ _ _ _ _ _ _ _ _ _ _)
+       (_ _ _ _ _ _ _ _ _ _ _ _ _ _ _)
+       (_ _ _ _ _ _ _ _ _ _ _ _ _ _ _)
+       (_ _ _ _ _ _ _ _ _ _ _ _ _ _ _)
+       (_ _ _ _ _ _ _ _ @ _ _ _ _ _ _)
+       (_ _ _ _ _ _ _ @ @ @ _ _ _ _ _)
+       (_ _ _ _ @ @ _ @ @ _ _ _ _ _ _)
+       (_ _ _ _ _ _ _ @ @ @ _ _ _ _ _)
+       (_ _ _ _ _ _ _ _ @ _ _ _ _ _ _)
+       (_ _ _ _ _ _ _ _ @ _ _ _ _ _ _)
+       (_ _ _ _ _ _ _ _ _ _ _ _ _ _ _)
+       (_ _ _ _ _ _ _ _ _ _ _ _ _ _ _)
+       (_ @ @ @ _ _ _ _ _ _ _ _ _ _ _)
+       (_ _ _ @ _ _ _ _ _ _ _ _ _ _ _)
+       (_ _ @ _ _ _ _ _ _ _ _ _ _ _ _)))

src/minilisp.c

@@ -498,6 +498,13 @@ static Obj *eval(void *root, Obj **env, Obj **obj) {
 // Primitive functions and special forms
 //======================================================================
 
+// (list expr ...)
+static Obj *prim_list(void *root, Obj **env, Obj **list) {
+    DEFINE1(root, values);
+    *values = eval_list(root, env, list);  // Evaluate all arguments
+    return *values;                         // Return them as a list
+}
+
 // 'expr
 static Obj *prim_quote(void *root, Obj **env, Obj **list) {
     if (length(*list) != 1)
@@ -694,26 +701,6 @@ static Obj *prim_not(void *root, Obj **env, Obj **list) {
     return values->car == Nil ? True : Nil;
 }
 
-// (and ...)
-static Obj *prim_and(void *root, Obj **env, Obj **list) {
-    Obj *car = True;  // by default, return True if no args
-    for (Obj *args = eval_list(root, env, list); args != Nil; args = args->cdr) {
-        car = eval(root, env, &args->car);
-        if (car == Nil) break;
-    }
-    return car;
-}
-
-// (or ...)
-static Obj *prim_or(void *root, Obj **env, Obj **list) {
-    Obj *car = Nil;
-    for (Obj *args = eval_list(root, env, list); args != Nil; args = args->cdr) {
-        car = eval(root, env, &args->car);
-        if (car != Nil) break;
-    }
-    return car;
-}
-
 extern void process_file(char *fname, Obj **env, Obj **expr);
 
 static Obj *prim_load(void *root, Obj **env, Obj **list) {
@@ -1010,6 +997,7 @@ void process_file(char *fname, Obj **env, Obj **expr) {
 }
 
 static void define_primitives(void *root, Obj **env) {
+    add_primitive(root, env, "list", prim_list);
     add_primitive(root, env, "quote", prim_quote);
     add_primitive(root, env, "cons", prim_cons);
     add_primitive(root, env, "car", prim_car);
@@ -1019,8 +1007,6 @@ static void define_primitives(void *root, Obj **env) {
     add_primitive(root, env, "while", prim_while);
     add_primitive(root, env, "gensym", prim_gensym);
     add_primitive(root, env, "not", prim_not);
-    add_primitive(root, env, "and", prim_and);
-    add_primitive(root, env, "or", prim_or);
     add_primitive(root, env, "+", prim_plus);
     add_primitive(root, env, "-", prim_minus);
     add_primitive(root, env, "*", prim_mult);

test.sh

@@ -52,9 +52,18 @@ run '<' t '(< 2 3)'
 run '<' '()' '(< 3 3)'
 run '<' '()' '(< 4 3)'
 
+run list '(1 2 3 a b)' "(list 1 2 3 'a 'b)"
 run 'literal list' '(a b c)' "'(a b c)"
 run 'literal list' '(a b . c)' "'(a b . c)"
 
+run reverse '(3 2 1)' '(reverse 1 2 3)'
+run reverse "(3 2 1)" "(reverse '(1 2 3))"
+run reverse "cba" '(reverse "abc")'
+
+run length 5 '(length 1 2 3 4 5)'
+run length 5 "(length '(1 2 3 4 5))"
+run length 5 '(length "abcde")'
+
 # List manipulation
 run cons "(a . b)" "(cons 'a 'b)"
 run cons "(a b c)" "(cons 'a (cons 'b (cons 'c ())))"