From 0e18200b16ea8c1bb1aa234cef3aeb8a5018b193 Mon Sep 17 00:00:00 2001
From: James Cash <james.nvc@gmail.com>
Date: Sun, 14 Sep 2008 21:28:36 -0400
Subject: [PATCH] Fixing defun, adding test for it

---
 extra/lisp/lisp-tests.factor |  5 ++---
 extra/lisp/lisp.factor       | 21 ++++++++-------------
 2 files changed, 10 insertions(+), 16 deletions(-)

diff --git a/extra/lisp/lisp-tests.factor b/extra/lisp/lisp-tests.factor
index 6e586bc657..9ddd31cde0 100644
--- a/extra/lisp/lisp-tests.factor
+++ b/extra/lisp/lisp-tests.factor
@@ -85,9 +85,8 @@ IN: lisp.test
     ] unit-test
     
     {  { 3 3 4 } } [
-        <LISP (setq foo (lambda (x y &rest z)
-                            (cons (+ x y) z)))
-
+        <LISP (defun foo (x y &rest z)
+                  (cons (+ x y) z))
               (foo 1 2 3 4)
         LISP> cons>seq
     ] unit-test
diff --git a/extra/lisp/lisp.factor b/extra/lisp/lisp.factor
index e60529caab..4a933501e8 100644
--- a/extra/lisp/lisp.factor
+++ b/extra/lisp/lisp.factor
@@ -64,14 +64,9 @@ PRIVATE>
 : macro-expand ( cons -- quot )
     uncons [ list>seq >quotation ] [ lookup-macro ] bi* call call ;
 
-<PRIVATE
-: (expand-macros) ( cons -- cons )
-    [ dup list? [ (expand-macros) dup car lisp-macro? [ macro-expand ] when ] when ] lmap ;
-PRIVATE>
-
 : expand-macros ( cons -- cons )
-    dup list? [ (expand-macros) dup car lisp-macro? [ macro-expand ] when ] when ;
-
+    dup list? [ [ expand-macros ] lmap dup car lisp-macro? [ macro-expand expand-macros ] when ] when ;
+    
 : convert-begin ( cons -- quot )
     cdr [ convert-form ] [ ] lmap-as [ 1 tail* ] [ but-last ] bi
     [ '[ { } _ with-datastack drop ] ] map prepend '[ _ [ call ] each ] ;
@@ -169,15 +164,15 @@ M: no-such-var summary drop "No such variable" ;
 
    "set" "lisp" "define-lisp-var" define-primitive
     
-   "(lambda (&rest xs) xs)" lisp-string>factor first "list" lisp-define
-   "(defmacro setq (var val) (list (quote set) (list (quote quote) var) val))" lisp-eval
+   "(set 'list (lambda (&rest xs) xs))" lisp-eval
+   "(defmacro setq (var val) (list 'set (list 'quote var) val))" lisp-eval
     
    <" (defmacro defun (name vars &rest body)
-        (list (quote setq) name (list (quote lambda) vars body))) "> lisp-eval
+        (list 'setq name (cons 'lambda (cons vars body)))) "> lisp-eval
     
-   "(defmacro if (pred tr fl) (list (quote cond) (list pred tr) (list (quote #t) fl)))" lisp-eval
+   "(defmacro if (pred tr fl) (list 'cond (list pred tr) (list (quote #t) fl)))" lisp-eval
    ;
 
 : <LISP 
-    "LISP>" parse-multiline-string define-lisp-builtins
-    lisp-string>factor parsed \ call parsed ; parsing
+    "LISP>" parse-multiline-string "(begin " prepend ")" append define-lisp-builtins
+    lisp-string>factor parsed \ call parsed ; parsing
\ No newline at end of file