More work on macros

diff --git a/extra/lisp/lisp.factor b/extra/lisp/lisp.factor
index e865a2e3ed2e981c0c9ab139ff93be789175c7cb..425ee27bb75a74223b1f208f4edea39c66fc816c 100644 (file)
--- a/extra/lisp/lisp.factor
+++ b/extra/lisp/lisp.factor
@@ -59,10 +59,23 @@ PRIVATE>
 : convert-unquoted ( cons -- quot )    
     "unquote not valid outside of quasiquote!" throw ;
     
-: convert-quasiquoted ( cons -- newcons )
+: convert-unquoted-splicing ( cons -- quot )    
+    "unquote-splicing not valid outside of quasiquote!" throw ;
+    
+<PRIVATE    
+: quasiquote-unquote ( cons -- newcons )
     [ { [ dup list? ] [ car dup lisp-symbol? ] [ name>> "unquote" equal? dup ] } && nip ]
     [ cadr ] traverse ;
     
+: quasiquote-unquote-splicing ( cons -- newcons )    
+    [ { [ dup list? ] [ dup cdr [ cons? ] [ car cons? ] bi and ]
+        [ dup cadr car lisp-symbol? ] [ cadr car name>> "unquote-splicing" equal? dup ] } && nip ]
+    [ dup cadr cdr >>cdr ] traverse ;
+PRIVATE>
+
+: convert-quasiquoted ( cons -- newcons )
+    quasiquote-unquote quasiquote-unquote-splicing ;
+    
 : convert-defmacro ( cons -- quot )
     cdr [ car ] keep [ convert-lambda ] [ car name>> ] bi define-lisp-macro 1quotation ;
     
@@ -72,6 +85,7 @@ PRIVATE>
       { "defmacro" [ convert-defmacro ] }
       { "quote" [ convert-quoted ] }
       { "unquote" [ convert-unquoted ] }
+      { "unquote-splicing" [ convert-unquoted-splicing ] }
       { "quasiquote" [ convert-quasiquoted ] }
       { "begin" [ convert-begin ] }
       { "cond" [ convert-cond ] }
@@ -99,7 +113,7 @@ PRIVATE>
     call ; inline
     
 : macro-expand ( cons -- quot )
-    uncons [ list>seq [ ] like ] [ lookup-macro macro-call compile-form  ] bi* call ;
+    uncons [ list>seq [ ] like ] [ lookup-macro macro-call compile-form  ] bi* ;
     
 : lisp-string>factor ( str -- quot )
     lisp-expr parse-result-ast compile-form ;