From be4e6138610704cb08f73e7edd7612f13f7d5fc5 Mon Sep 17 00:00:00 2001
From: James Cash <james.nvc@gmail.com>
Date: Wed, 3 Sep 2008 10:21:27 -0400
Subject: [PATCH] Working on adding a <LISP word

---
 extra/lisp/lisp-tests.factor | 27 -----------------------
 extra/lisp/lisp.factor       | 42 +++++++++++++++++++++++++++++-------
 2 files changed, 34 insertions(+), 35 deletions(-)

diff --git a/extra/lisp/lisp-tests.factor b/extra/lisp/lisp-tests.factor
index e539221eaf..6c6396255a 100644
--- a/extra/lisp/lisp-tests.factor
+++ b/extra/lisp/lisp-tests.factor
@@ -5,29 +5,6 @@ quotations ;
 
 IN: lisp.test
 
-: define-lisp-builtins (  --  )    
-   init-env
-    
-    f "#f" lisp-define
-    t "#t" lisp-define
-    
-    "+" "math" "+" define-primitive
-    "-" "math" "-" define-primitive
-    "<" "math" "<" define-primitive
-    ">" "math" ">" define-primitive
-    
-    "cons" "lists" "cons" define-primitive
-    "car" "lists" "car" define-primitive
-    "cdr" "lists" "cdr" define-primitive
-    "append" "lists" "lappend" define-primitive
-    "nil" "lists" "nil" define-primitive
-    "nil?" "lists" "nil?" define-primitive
-    
-    "define" "lisp" "defun" define-primitive
-    
-    "(lambda (&rest xs) xs)" lisp-string>factor "list" lisp-define
-   ;     
-    
 [
     define-lisp-builtins
     
@@ -75,10 +52,6 @@ IN: lisp.test
         "(begin (+ 5 6) (+ 1 4))" lisp-eval
     ] unit-test
     
-    { T{ lisp-symbol f "if" } } [
-        "(defmacro if (pred tr fl) (list (quote cond) (list pred tr) (list (quote #t) fl)))" lisp-eval
-    ] unit-test
-    
     { t } [
         T{ lisp-symbol f "if" } lisp-macro?
     ] unit-test
diff --git a/extra/lisp/lisp.factor b/extra/lisp/lisp.factor
index 22bcd6905b..995e4004d5 100644
--- a/extra/lisp/lisp.factor
+++ b/extra/lisp/lisp.factor
@@ -59,18 +59,20 @@ PRIVATE>
     cadr 1quotation ;
 
 : convert-defmacro ( cons -- quot )
-    cdr [ car ] keep [ convert-lambda ] [ car name>> ] bi define-lisp-macro 1quotation ;
+    cdr [ convert-lambda ] [ car name>> ] bi define-lisp-macro [ ] ;
 
 : macro-expand ( cons -- quot )
     uncons [ list>seq >quotation ] [ lookup-macro ] bi* call call ;
-    
-: (expand-macros) ( cons -- cons )    
+
+<PRIVATE
+: (expand-macros) ( cons -- cons )
     [ dup list? [ (expand-macros) dup car lisp-macro? [ macro-expand ] when ] when ] lmap ;
-    
-: expand-macros ( cons -- cons )    
+PRIVATE>
+
+: expand-macros ( cons -- cons )
     dup list? [ (expand-macros) dup car lisp-macro? [ macro-expand ] when ] when ;
-    
-: convert-begin ( cons -- quot )    
+
+: convert-begin ( cons -- quot )
     cdr [ convert-form ] [ ] lmap-as [ 1 tail* ] [ but-last ] bi
     [ '[ { } , with-datastack drop ] ] map prepend '[ , [ call ] each ] ;
 
@@ -86,7 +88,7 @@ PRIVATE>
 
 : convert-list-form ( cons -- quot )
     dup car
-    { 
+    {
       { [ dup lisp-symbol? ] [ form-dispatch ] }
      [ drop convert-general-form ]
     } cond ;
@@ -147,3 +149,27 @@ M: no-such-var summary drop "No such variable" ;
 
 : lisp-macro? ( car -- ? )
     dup lisp-symbol? [ name>> macro-env get key? ] [ drop f ] if ;
+
+: define-lisp-builtins (  --  )
+   init-env
+
+   f "#f" lisp-define
+   t "#t" lisp-define
+
+   "+" "math" "+" define-primitive
+   "-" "math" "-" define-primitive
+   "<" "math" "<" define-primitive
+   ">" "math" ">" define-primitive
+
+   "cons" "lists" "cons" define-primitive
+   "car" "lists" "car" define-primitive
+   "cdr" "lists" "cdr" define-primitive
+   "append" "lists" "lappend" define-primitive
+   "nil" "lists" "nil" define-primitive
+   "nil?" "lists" "nil?" define-primitive
+
+   "define" "lisp" "defun" define-primitive
+
+   "(lambda (&rest xs) xs)" lisp-string>factor "list" lisp-define
+   "(defmacro if (pred tr fl) (list (quote cond) (list pred tr) (list (quote #t) fl)))" lisp-eval
+   ;