Revert "macros: macro body is now defined in its own subword, for compile-time stack...

This reverts commit 24de7c52f0c3f21cfcdb80235cac7296b0401c85.

diff --git a/basis/cocoa/cocoa.factor b/basis/cocoa/cocoa.factor
index f3ea7ce8eaccd3a4953d3e03390b1a350d0b5ace..34bac0a5055229e13b7a738190f577359fd3ab7e 100644 (file)
--- a/basis/cocoa/cocoa.factor
+++ b/basis/cocoa/cocoa.factor
@@ -1,10 +1,9 @@
-! Copyright (C) 2006, 2010 Slava Pestov
+! Copyright (C) 2006, 2009 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
 USING: compiler io kernel cocoa.runtime cocoa.subclassing
 cocoa.messages cocoa.types sequences words vocabs parser
 core-foundation.bundles namespaces assocs hashtables
-compiler.units lexer init macros quotations fry alien.c-types
-arrays combinators ;
+compiler.units lexer init ;
 IN: cocoa
 
 : (remember-send) ( selector variable -- )
@@ -15,7 +14,7 @@ SYMBOL: sent-messages
 : remember-send ( selector -- )
     sent-messages (remember-send) ;
 
-SYNTAX: -> scan [ remember-send ] [ suffix! ] bi \ send suffix! ;
+SYNTAX: -> scan dup remember-send suffix! \ send suffix! ;
 
 SYMBOL: super-sent-messages
 
@@ -34,14 +33,6 @@ SYNTAX: FRAMEWORK: scan [ load-framework ] [ frameworks get push ] bi ;
 
 SYNTAX: IMPORT: scan [ ] import-objc-class ;
 
-MACRO: objc-class-case ( alist -- quot )
-    "isKindOfClass:" remember-send
-    [
-        dup callable?
-        [ first2 [ '[ dup _ execute "isKindOfClass:" send c-bool> ] ] dip 2array ]
-        unless
-    ] map '[ _ cond ] ;
-
 "Importing Cocoa classes..." print
 
 "cocoa.classes" create-vocab drop

diff --git a/basis/cocoa/plists/plists.factor b/basis/cocoa/plists/plists.factor
index 90cc64769a7e7f39cafce01da755b15d7e50d4eb..86b13b2ddc2e83341c83480bad3b81b16e20ea17 100644 (file)
--- a/basis/cocoa/plists/plists.factor
+++ b/basis/cocoa/plists/plists.factor
@@ -40,6 +40,13 @@ DEFER: plist>
     [ -> propertyListFromData:mutabilityOption:format:errorDescription: ] keep
     *void* [ -> release "read-plist failed" throw ] when* ;
 
+MACRO: objc-class-case ( alist -- quot )
+    [
+        dup callable?
+        [ first2 [ '[ dup _ execute -> isKindOfClass: c-bool> ] ] dip 2array ]
+        unless
+    ] map '[ _ cond ] ;
+
 PRIVATE>
 
 ERROR: invalid-plist-object object ;

diff --git a/basis/compiler/tree/debugger/debugger.factor b/basis/compiler/tree/debugger/debugger.factor
index c9b60922bd97531b19974dc6d51e5a8fa0a51ad6..7350a35de9fd4fc20d822e0e427c2a8a1d84256d 100644 (file)
--- a/basis/compiler/tree/debugger/debugger.factor
+++ b/basis/compiler/tree/debugger/debugger.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2006, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel assocs match fry accessors namespaces make effects
-sequences sequences.private quotations generic arrays
+sequences sequences.private quotations generic macros arrays
 prettyprint prettyprint.backend prettyprint.custom
 prettyprint.sections math words combinators
 combinators.short-circuit io sorting hints
@@ -30,31 +30,34 @@ IN: compiler.tree.debugger
 
 GENERIC: node>quot ( node -- )
 
+MACRO: match-choose ( alist -- )
+    [ '[ _ ] ] assoc-map '[ _ match-cond ] ;
+
 MATCH-VARS: ?a ?b ?c ;
 
 : pretty-shuffle ( effect -- word/f )
     [ in>> ] [ out>> ] bi 2array {
-        { { { } { } } [ [ ] ] }
-        { { { ?a } { ?a } } [ [ ] ] }
-        { { { ?a ?b } { ?a ?b } } [ [ ] ] }
-        { { { ?a ?b ?c } { ?a ?b ?c } } [ [ ] ] }
-        { { { ?a } { } } [ [ drop ] ] }
-        { { { ?a ?b } { } } [ [ 2drop ] ] }
-        { { { ?a ?b ?c } { } } [ [ 3drop ] ] }
-        { { { ?a } { ?a ?a } } [ [ dup ] ] }
-        { { { ?a ?b } { ?a ?b ?a ?b } } [ [ 2dup ] ] }
-        { { { ?a ?b ?c } { ?a ?b ?c ?a ?b ?c } } [ [ 3dup ] ] }
-        { { { ?a ?b } { ?a ?b ?a } } [ [ over ] ] }
-        { { { ?b ?a } { ?a ?b } } [ [ swap ] ] }
-        { { { ?b ?a ?c } { ?a ?b ?c } } [ [ swapd ] ] }
-        { { { ?a ?b } { ?a ?a ?b } } [ [ dupd ] ] }
-        { { { ?a ?b ?c } { ?a ?b ?c ?a } } [ [ pick ] ] }
-        { { { ?a ?b ?c } { ?c ?a ?b } } [ [ -rot ] ] }
-        { { { ?a ?b ?c } { ?b ?c ?a } } [ [ rot ] ] }
-        { { { ?a ?b } { ?b } } [ [ nip ] ] }
-        { { { ?a ?b ?c } { ?c } } [ [ 2nip ] ] }
-        { __ [ f ] }
-    } match-cond ;
+        { { { } { } } [ ] }
+        { { { ?a } { ?a } } [ ] }
+        { { { ?a ?b } { ?a ?b } } [ ] }
+        { { { ?a ?b ?c } { ?a ?b ?c } } [ ] }
+        { { { ?a } { } } [ drop ] }
+        { { { ?a ?b } { } } [ 2drop ] }
+        { { { ?a ?b ?c } { } } [ 3drop ] }
+        { { { ?a } { ?a ?a } } [ dup ] }
+        { { { ?a ?b } { ?a ?b ?a ?b } } [ 2dup ] }
+        { { { ?a ?b ?c } { ?a ?b ?c ?a ?b ?c } } [ 3dup ] }
+        { { { ?a ?b } { ?a ?b ?a } } [ over ] }
+        { { { ?b ?a } { ?a ?b } } [ swap ] }
+        { { { ?b ?a ?c } { ?a ?b ?c } } [ swapd ] }
+        { { { ?a ?b } { ?a ?a ?b } } [ dupd ] }
+        { { { ?a ?b ?c } { ?a ?b ?c ?a } } [ pick ] }
+        { { { ?a ?b ?c } { ?c ?a ?b } } [ -rot ] }
+        { { { ?a ?b ?c } { ?b ?c ?a } } [ rot ] }
+        { { { ?a ?b } { ?b } } [ nip ] }
+        { { { ?a ?b ?c } { ?c } } [ 2nip ] }
+        { __ f }
+    } match-choose ;
 
 TUPLE: shuffle-node { effect effect } ;
 

diff --git a/basis/macros/expander/expander.factor b/basis/macros/expander/expander.factor
index 1dfb663695de2d3e29ea7ba1866d4e04ab5c12c6..3dab0c3cdb12a25a299b5aa0714356a178a44ca3 100644 (file)
--- a/basis/macros/expander/expander.factor
+++ b/basis/macros/expander/expander.factor
@@ -1,8 +1,8 @@
-! Copyright (C) 2008, 2010 Slava Pestov.
+! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel sequences sequences.private namespaces make
 quotations accessors words continuations vectors effects math
-generalizations fry arrays combinators ;
+generalizations fry arrays ;
 IN: macros.expander
 
 GENERIC: expand-macros ( quot -- quot' )
@@ -55,7 +55,7 @@ M: wrapper expand-macros* wrapped>> literal ;
 
 : word, ( word -- ) end , ;
 
-: expand-transform ( word quot -- )
+: expand-macro ( word quot -- )
     '[
         drop
         stack [ _ with-datastack >vector ] change
@@ -65,25 +65,18 @@ M: wrapper expand-macros* wrapped>> literal ;
         word,
     ] recover ;
 
-: expand-transform? ( word -- ? )
-    dup "transform-quot" word-prop [
-        "transform-n" word-prop
+: expand-macro? ( word -- quot ? )
+    dup [ "transform-quot" word-prop ] [ "macro" word-prop ] bi or dup [
+        swap [ "transform-n" word-prop ] [ stack-effect in>> length ] bi or
         stack get length <=
-    ] [ drop f ] if ;
-
-: expand-macro? ( word -- ? )
-    dup "macro" word-prop [
-        stack-effect in>> length
-        stack get length <=
-    ] [ drop f ] if ;
+    ] [ 2drop f f ] if ;
 
 M: word expand-macros*
-    {
-        { [ dup expand-dispatch? ] [ drop expand-dispatch ] }
-        { [ dup expand-macro? ] [ dup "macro" word-prop '[ _ execute ] expand-transform ] }
-        { [ dup expand-transform? ] [ dup "transform-quot" word-prop expand-transform ] }
-        [ word, ]
-    } cond ;
+    dup expand-dispatch? [ drop expand-dispatch ] [
+        dup expand-macro? [ expand-macro ] [
+            drop word,
+        ] if
+    ] if ;
 
 M: object expand-macros* literal ;
 

diff --git a/basis/macros/macros-docs.factor b/basis/macros/macros-docs.factor
index 9d9f8f4caf9ec5a51af0555f2798b0ee52ee852a..102bc79c7e7aff1ad32c498ae3f233b589097350 100644 (file)
--- a/basis/macros/macros-docs.factor
+++ b/basis/macros/macros-docs.factor
@@ -47,7 +47,9 @@ $nl
 $nl
 "Defining new macros:"
 { $subsections POSTPONE: MACRO: }
-"As with parsing words, macros cannot be used from the same source file that they are defined in."
+"A slightly lower-level facility, " { $emphasis "compiler transforms" } ", allows an ordinary word definition to co-exist with a version that performs compile-time expansion."
+{ $subsections define-transform }
+"An example is the " { $link member? } " word. If the input sequence is a literal, the compile transform kicks in and converts the " { $link member? } " call into a series of conditionals. Otherwise, if the input sequence is not literal, a call to the definition of " { $link member? } " is generated."
 { $see-also "generalizations" "fry" } ;
 
 ABOUT: "macros"

diff --git a/basis/macros/macros-tests.factor b/basis/macros/macros-tests.factor
index efc3ff5a30f56830280ab4f3356dd84ad77a0a57..c8dc0ec16d849fa81542ffca5e986b79ba89ebb3 100644 (file)
--- a/basis/macros/macros-tests.factor
+++ b/basis/macros/macros-tests.factor
@@ -1,7 +1,6 @@
-USING: tools.test macros math kernel arrays
-vectors io.streams.string prettyprint parser eval see
-stack-checker compiler.units definitions vocabs ;
 IN: macros.tests
+USING: tools.test macros math kernel arrays
+vectors io.streams.string prettyprint parser eval see ;
 
 MACRO: see-test ( a b -- quot ) + ;
 
@@ -20,18 +19,7 @@ unit-test
 
 [ f ] [ \ see-test macro? ] unit-test
 
-[ ] [ "USING: macros stack-checker kernel ; IN: hanging-macro MACRO: c ( quot -- ) infer drop [ ] ;" eval( -- ) ] unit-test
-[ ] [ "USING: macros kernel ; IN: hanging-macro : a ( -- ) [ a ] c ;" eval( -- ) ] unit-test
-
-[ ] [ [ "hanging-macro" forget-vocab ] with-compilation-unit ] unit-test
+[ ] [ "USING: macros stack-checker kernel ; IN: hanging-macro MACRO: c ( quot -- ) infer drop [ ] ; : a ( -- ) [ a ] c ;" eval( -- ) ] unit-test
 
 [ ] [ "IN: macros.tests USE: macros MACRO: foo ( -- x ) [ ] ;" eval( -- ) ] unit-test
     [ "IN: macros.tests USE: macros MACRO: foo ( -- x ) [ ] ; inline" eval( -- ) ] must-fail
-
-! The macro expander code should infer
-MACRO: bad-macro ( a -- b ) 1 2 3 [ ] ;
-
-[ [ 0 bad-macro ] call ] must-fail
-[ [ 0 bad-macro ] infer ] must-fail
-
-[ ] [ [ \ bad-macro forget ] with-compilation-unit ] unit-test

diff --git a/basis/macros/macros.factor b/basis/macros/macros.factor
index f2b610cf12136e70bd00acd8d7396d9ed9780cf5..46fd1ce7481726fdd639a22e7d254a5f9883c497 100644 (file)
--- a/basis/macros/macros.factor
+++ b/basis/macros/macros.factor
@@ -1,47 +1,23 @@
 ! Copyright (C) 2007, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: parser kernel sequences words effects combinators assocs
-definitions quotations namespaces memoize accessors arrays
+definitions quotations namespaces memoize accessors
 compiler.units ;
 IN: macros
 
 <PRIVATE
 
-! The macro expander is split off into its own word. This allows
-! the optimizing compiler to optimize and check the stack effect
-! of the expander, even though the actual macro word does not
-! infer.
-
 : real-macro-effect ( effect -- effect' )
     in>> { "quot" } <effect> ;
 
-PREDICATE: macro-body < memoized "macro-owner" word-prop >boolean ;
-
-: <macro-body> ( word quot effect -- macro-body )
-    real-macro-effect
-    [ name>> "( macro body: " " )" surround <uninterned-word> dup ] 2dip
-    define-memoized ;
-
-M: macro-body crossref? "forgotten" word-prop not ;
-
-M: macro-body reset-word
-    [ call-next-method ] [ "macro-body" remove-word-prop ] bi ;
-
-M: macro-body where "macro-owner" word-prop where ;
-
-: reset-macro ( word -- )
-    [ "macro" word-prop forget ] [ f "macro" set-word-prop ] bi ;
-
 PRIVATE>
 
-: define-macro ( word quot effect -- )
-    [ 2drop ] [ <macro-body> ] 3bi
-    {
-        [ "macro" set-word-prop ]
-        [ swap "macro-owner" set-word-prop ]
-        [ [ \ call [ ] 2sequence ] [ stack-effect ] bi define-declared ]
-        [ drop changed-effect ]
-    } 2cleave ;
+: define-macro ( word definition effect -- )
+    real-macro-effect {
+        [ [ memoize-quot [ call ] append ] keep define-declared ]
+        [ drop "macro" set-word-prop ]
+        [ 2drop changed-effect ]
+    } 3cleave ;
 
 SYNTAX: MACRO: (:) define-macro ;
 
@@ -51,12 +27,9 @@ M: macro make-inline cannot-be-inline ;
 
 M: macro definer drop \ MACRO: \ ; ;
 
-M: macro definition "macro" word-prop definition ;
-
-M: macro subwords "macro" word-prop 1array ;
-
-M: macro reset-word [ call-next-method ] [ reset-macro ] bi ;
+M: macro definition "macro" word-prop ;
 
-M: macro forget* [ call-next-method ] [ reset-macro ] bi ;
+M: macro reset-word
+    [ call-next-method ] [ f "macro" set-word-prop ] bi ;
 
 M: macro always-bump-effect-counter? drop t ;

diff --git a/basis/stack-checker/transforms/transforms.factor b/basis/stack-checker/transforms/transforms.factor
index 372e6219885dd4e9a63e96fe46493731a9c35785..cf32792a2e9a2d869f38346602d2142aa0bb08f4 100644 (file)
--- a/basis/stack-checker/transforms/transforms.factor
+++ b/basis/stack-checker/transforms/transforms.factor
@@ -48,7 +48,7 @@ IN: stack-checker.transforms
 
 : apply-macro ( word -- )
     [ current-word set ]
-    [ "macro" word-prop '[ _ execute ] ]
+    [ "macro" word-prop ]
     [ "declared-effect" word-prop in>> length ] tri
     (apply-transform) ;
 

diff --git a/basis/unix/unix.factor b/basis/unix/unix.factor
index 86a3fc9d6a3998dcd657a04ec29899fd393f2d28..4e77a41713a64a50beb95b9c0dc565ff8a6a5678 100644 (file)
--- a/basis/unix/unix.factor
+++ b/basis/unix/unix.factor
@@ -9,8 +9,6 @@ sequences stack-checker strings system unix.time unix.types
 vocabs vocabs.loader unix.ffi ;
 IN: unix
 
-<<
-
 ERROR: unix-error errno message ;
 
 : (io-error) ( -- * ) errno dup strerror unix-error ;
@@ -48,8 +46,6 @@ MACRO:: unix-system-call ( quot -- )
         ] if
     ] ;
 
->>
-
 HOOK: open-file os ( path flags mode -- fd )
 
 : close-file ( fd -- ) [ close ] unix-system-call drop ;
@@ -76,6 +72,10 @@ M: unix open-file [ open ] unix-system-call ;
 
 : unlink-file ( path -- ) [ unlink ] unix-system-call drop ;
 
+<<
+
 "debugger" vocab [
     "unix.debugger" require
 ] when
+
+>>