macros: some cleanup.

basis/macros/expander/expander.factor

@@ -1,45 +1,38 @@
 ! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel sequences sequences.private namespaces make
+USING: accessors arrays combinators combinators.short-circuit
-quotations accessors words continuations vectors effects math
+continuations effects fry generalizations kernel make math
-generalizations fry arrays ;
+namespaces quotations sequences sequences.private vectors words
+;
 IN: macros.expander
 
 GENERIC: expand-macros ( quot -- quot' )
 
 SYMBOL: stack
 
-: begin ( -- ) V{ } clone stack set ;
+: begin ( -- )
+    V{ } clone stack set ;
 
 : end ( -- )
-    stack get
+    stack get [ [ literalize , ] each ] [ delete-all ] bi ;
-    [ [ literalize , ] each ]
-    [ delete-all ]
-    bi ;
 
 GENERIC: condomize? ( obj -- ? )
 
 M: array condomize? [ condomize? ] any? ;
-
 M: callable condomize? [ condomize? ] any? ;
-
 M: object condomize? drop f ;
 
 GENERIC: condomize ( obj -- obj' )
 
 M: array condomize [ condomize ] map ;
-
 M: callable condomize [ condomize ] map ;
-
 M: object condomize ;
 
-: literal ( obj -- ) dup condomize? [ condomize ] when stack get push ;
+: literal ( obj -- )
+    dup condomize? [ condomize ] when stack get push ;
 
 GENERIC: expand-macros* ( obj -- )
 
-: (expand-macros) ( quot -- )
-    [ expand-macros* ] each ;
-
 M: wrapper expand-macros* wrapped>> literal ;
 
 : expand-dispatch? ( word -- ? )
@@ -59,24 +52,38 @@ M: wrapper expand-macros* wrapped>> literal ;
     '[
         drop
         stack [ _ with-datastack >vector ] change
-        stack get pop >quotation end (expand-macros)
+        stack get pop >quotation end
+        [ expand-macros* ] each
     ] [
         drop
         word,
     ] recover ;
 
+: macro-quot ( word -- quot/f )
+    {
+        [ "transform-quot" word-prop ]
+        [ "macro" word-prop ]
+    } 1|| ;
+
+: macro-effect ( word -- n )
+    {
+        [ "transform-n" word-prop ]
+        [ stack-effect in>> length ]
+    } 1|| ;
+
 : expand-macro? ( word -- quot ? )
-    dup [ "transform-quot" word-prop ] [ "macro" word-prop ] bi or dup [
+    dup macro-quot [
-        swap [ "transform-n" word-prop ] [ stack-effect in>> length ] bi or
+        swap macro-effect stack get length <=
-        stack get length <=
+    ] [
-    ] [ 2drop f f ] if ;
+        drop f f
+    ] if* ;
 
 M: word expand-macros*
-    dup expand-dispatch? [ drop expand-dispatch ] [
+    {
-        dup expand-macro? [ expand-macro ] [
+        { [ dup expand-dispatch? ] [ drop expand-dispatch ] }
-            drop word,
+        { [ dup expand-macro? ] [ expand-macro ] }
-        ] if
+        [ drop word, ]
-    ] if ;
+    } cond ;
 
 M: object expand-macros* literal ;
 
@@ -84,4 +91,4 @@ M: callable expand-macros*
     expand-macros literal ;
 
 M: callable expand-macros ( quot -- quot' )
-    [ begin (expand-macros) end ] [ ] make ;
+    [ begin [ expand-macros* ] each end ] [ ] make ;

basis/macros/macros.factor

@@ -1,8 +1,7 @@
 ! Copyright (C) 2007, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: parser effects.parser kernel sequences words effects
+USING: accessors combinators compiler.units definitions effects
-combinators assocs definitions quotations namespaces memoize
+effects.parser fry kernel memoize words ;
-accessors fry compiler.units ;
 IN: macros
 
 <PRIVATE