5 files changed, 60 insertions(+), 47 deletions(-)

M fs/comp/lisp.fs
M fs/comp/lisp/builtin.fs
M fs/doc/comp/lisp.txt
M fs/tests/comp/lisp.fs
A fs/tests/comp/lisp.l

@@ 4,3 4,5 @@ unit comp/lisp
 
 : lisp aliases$ env$ raw< cook ;
 : lisp. lisp .cons ;
+: _ begin toword? while raw< cook drop repeat ;
+: lisp<< ?progress> aliases$ ['] _ exec<< ;

@@ 19,5 19,5 @@ unit comp/lisp/builtin
 
 \ Add functions to registry
 2 8 addfuncs< + - * / = equal apply map
-1 3 addfuncs< eval stype noret
+1 4 addfuncs< eval stype noret not
 1 noret< stype

@@ 12,16 12,22 @@ As with [comp/c], the broad idea is that Lisp functions and Forth words are
 pretty much the same, except that Lisp, like C, can only handle "single result
 signatures", that is ( ... -- res ).
 
-You interpret a Lisp expression with "lisp ( -- res )" followed by an opening
-"(" followed by your expression. When the closing parens is encountered, the
-result, which can be either a straight number or a cons [mem/cons], is pretty-
-printed, then yielded. For example:
+## Invocation
+
+You can interpret a Lisp expression with "lisp ( -- res )" followed by an
+opening "(" followed by your expression. When the closing parens is encountered,
+the result, which can be either a straight number or a cons [mem/cons]. For
+example:
 
   needs comp/lisp
   lisp (- 42 (+ 2 3)) .
 
-will print 37 twice. Once by "lisp" and once by ".". "+" and "-" refer to the
-regular Forth words, so this is just syntactic sugar for "42 2 3 + -".
+will print 37. You can also use "lisp. ( -- )" which will pretty-print the
+result instead using .cons [mem/cons].
+
+You can also interpret whole files with "lisp<<". This will repeatedly interpret
+all parens in the file until the end of file is reached, dropping the result at
+ech iteration. Example: lisp<< foo.l
 
 ## Tokenisation logic
 

@@ 23,8 23,6 @@ raw< (foo
 raw< () 0 #eq
 raw< (() ()) decons swap 0 #eq decons 0 #eq 0 #eq
 
-lisp (+ 2 3) 5 #eq
-lisp (- 42 (+ 2 3)) 37 #eq
 42 value answertouniverse
 lisp answertouniverse 42 #eq
 lisp 'answertouniverse ' answertouniverse #eq


@@ 41,25 39,10 @@ lisp '((1 . 2) . (3 . 4))
     decons 2 #eq 1 #eq
 lisp (quote lisp) ' lisp #eq
 
-lisp (apply '+ '(2 3)) 5 #eq
-lisp (eval '(+ 2 3)) 5 #eq
-lisp (equal 42 42) #true
-lisp (equal 41 42) not #true
-lisp (equal '(1 2 3) 42) not #true
-lisp (= '(1 2 3) '(1 2 3)) not #true
-lisp (equal '(1 2 3) '(1 2 3)) #true
-42 value answertouniverse
-lisp (+ answertouniverse 1) 43 #eq
-
-lisp ((lambda (a b) (- b a)) 2 4) 2 #eq
 lisp. (defun foo (a b) (- b a))
 2 3 foo 1 #eq
 lisp. (defun foo (n) n)
 42 foo 42 #eq
-lisp. (defun twice (f x) (f (f x)))
-lisp (twice '1+ 10) 12 #eq
-lisp ((lambda (f x) (f (f x))) (lambda (y) (* y y)) 10) 10000 #eq
-lisp ((lambda (x) ((lambda (x) (+ x 1)) x)) 42) 43 #eq
 
 \ test that we can have more than one list in function bodies
 variable myvar


@@ 70,36 53,14 @@ myvar @ 0 #eq
 bar 5 #eq
 myvar @ 42 #eq
 
-lisp. (noret (defword noop ()))
-lisp (noop) 0 #eq
 exec>str lisp (stype "Hello World!")
 "Hello World!" #s= 0 #eq
 
-lisp ((lambda (x) ((lambda (x f) (f 1)) 10 (lambda (z) (+ z x)))) 20) 11 #eq
-lisp ((lambda (x)
-  (lambda (y) (+ x 1))
-  ((lambda (z) (+ x 2)) 12))
-  42) 44 #eq
-
-lisp (equal (map '1+ '(1 2 3)) '(2 3 4)) #true
-lisp (equal
-  (map (lambda (n) (* n 3)) '(1 2 3))
-  '(3 6 9)) #true
-
 lisp (defun foo (n) (if n 42 54)) drop
 0 foo 54 #eq
 1 foo 42 #eq
 
-\ tail optimized fibonacci
-lisp (defun _fib (n a b)
-  (if n (tailcall (- n 1) b (+ a b)) a)) drop
-lisp (defun fib (n) (_fib n 0 1)) drop
-0 fib 0 #eq
-1 fib 1 #eq
-2 fib 1 #eq
-3 fib 2 #eq
-5 fib 5 #eq
-9 fib 34 #eq
+lisp<< tests/comp/lisp.l
 
 \ test that compiled quotes cons references are properly leaked
 lisp. (defun foo () '(1 2 3))

@@ 0,0 1,44 @@
+(noret (defword #eq (a b)))
+(noret (defword #true (f)))
+(defun #false (f) (#true (not f)))
+(#eq 5 (+ 2 3))
+(#eq 37 (- 42 (+ 2 3)))
+(#eq 5 (apply '+ '(2 3)))
+(#eq 5 (eval '(+ 2 3)))
+(#true (equal 42 42))
+(#false (equal 41 42))
+(#false (equal '(1 2 3) 42))
+(#false (= '(1 2 3) '(1 2 3)))
+(#true (equal '(1 2 3) '(1 2 3)))
+(#eq 43 (+ answertouniverse 1))
+
+(#eq 2 ((lambda (a b) (- b a)) 2 4))
+(defun twice (f x) (f (f x)))
+(#eq 12 (twice '1+ 10))
+(#eq 10000 ((lambda (f x) (f (f x))) (lambda (y) (* y y)) 10))
+(#eq 43 ((lambda (x) ((lambda (x) (+ x 1)) x)) 42))
+
+(noret (defword noop ()))
+(#eq 0 (noop))
+
+(#eq 11 ((lambda (x) ((lambda (x f) (f 1)) 10 (lambda (z) (+ z x)))) 20))
+(#eq 44 ((lambda (x)
+  (lambda (y) (+ x 1))
+  ((lambda (z) (+ x 2)) 12))
+  42))
+
+(#true (equal (map '1+ '(1 2 3)) '(2 3 4)))
+(#true (equal
+  (map (lambda (n) (* n 3)) '(1 2 3))
+  '(3 6 9)))
+
+\ tail optimized fibonacci
+(defun _fib (n a b)
+  (if n (tailcall (- n 1) b (+ a b)) a))
+(defun fib (n) (_fib n 0 1))
+(#eq 0 (fib 0))
+(#eq 1 (fib 1))
+(#eq 1 (fib 2))
+(#eq 2 (fib 3))
+(#eq 5 (fib 5))
+(#eq 34 (fib 9))