     [ { [ dup list? ] [ car dup lisp-symbol? ] [ name>> "unquote" equal? dup ] } && nip ]
     [ cadr ] traverse ;
     
-: form-dispatch ( lisp-symbol -- quot )
+: convert-defmacro ( cons -- quot )
+    cdr [ car ] keep [ convert-lambda ] [ car name>> ] bi define-lisp-macro 1quotation ;
+    
+: form-dispatch ( cons lisp-symbol -- quot )
     name>>
     { { "lambda" [ convert-lambda ] }
+      { "defmacro" [ convert-defmacro ] }
       { "quote" [ convert-quoted ] }
       { "unquote" [ convert-unquoted ] }
       { "quasiquote" [ convert-quasiquoted ] }
-      { "if" [ convert-if ] }
       { "begin" [ convert-begin ] }
       { "cond" [ convert-cond ] }
      [ drop convert-general-form ]
     } case ;
     
-: macro-expand ( cons -- quot )
-    uncons lookup-macro macro-call convert-form ;
-    
 : convert-list-form ( cons -- quot )  
     dup car
-    { { [ dup lisp-macro?  ] [ macro-expand ] }
+    { { [ dup lisp-macro?  ] [ drop macro-expand ] }
       { [ dup lisp-symbol? ] [ form-dispatch ] } 
      [ drop convert-general-form ]
     } cond ;

! See http://factorcode.org/license.txt for BSD license.
USING: kernel peg sequences arrays strings combinators.lib
namespaces combinators math locals locals.private accessors
vectors syntax lisp.parser assocs parser sequences.lib words quotations
fry lists inspector ;
IN: lisp

DEFER: convert-form

DEFER: lookup-var
DEFER: lisp-macro?
DEFER: lookup-macro
DEFER: macro-expand
DEFER: define-lisp-macro
    
! Functions to convert s-exps to quotations
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: convert-body ( cons -- quot )
    [ ] [ convert-form compose ] foldl ; inline
    
: convert-begin ( cons -- quot )  
    cdr [ convert-form ] [ ] lmap-as '[ , [ funcall ] each ] ;
