Merge branch 'master' of git://factorcode.org/git/factor

db4
Doug Coleman 2008-09-24 20:25:05 -05:00
commit be3f57379f
3 changed files with 15 additions and 4 deletions

View File

@ -1,7 +1,7 @@
USING: locals math sequences tools.test hashtables words kernel USING: locals math sequences tools.test hashtables words kernel
namespaces arrays strings prettyprint io.streams.string parser namespaces arrays strings prettyprint io.streams.string parser
accessors generic eval combinators combinators.short-circuit accessors generic eval combinators combinators.short-circuit
combinators.short-circuit.smart ; combinators.short-circuit.smart math.order ;
IN: locals.tests IN: locals.tests
:: foo ( a b -- a a ) a a ; :: foo ( a b -- a a ) a a ;
@ -331,4 +331,13 @@ M:: sequence method-with-locals ( a -- y ) a reverse ;
[ T{ slice f 0 3 "abc" } ] [ T{ slice f 0 3 "abc" } ]
[ 0 3 "abc" [| from to seq | T{ slice f from to seq } ] call ] unit-test [ 0 3 "abc" [| from to seq | T{ slice f from to seq } ] call ] unit-test
{ 3 1 } [| from to seq | T{ slice f from to seq } ] must-infer-as { 3 1 } [| from to seq | T{ slice f from to seq } ] must-infer-as
:: compare-case ( obj1 obj2 lt-quot eq-quot gt-quot -- )
obj1 obj2 <=> {
{ +lt+ [ lt-quot call ] }
{ +eq+ [ eq-quot call ] }
{ +gt+ [ gt-quot call ] }
} case ; inline
[ [ ] [ ] [ ] compare-case ] must-infer

View File

@ -7,3 +7,5 @@ kernel ;
[ f ] [ 15 [ { [ integer? ] [ even? ] [ 10 > ] } 1&& ] expand-macros call ] unit-test [ f ] [ 15 [ { [ integer? ] [ even? ] [ 10 > ] } 1&& ] expand-macros call ] unit-test
[ f ] [ 5.0 [ { [ integer? ] [ even? ] [ 10 > ] } 1&& ] expand-macros call ] unit-test [ f ] [ 5.0 [ { [ integer? ] [ even? ] [ 10 > ] } 1&& ] expand-macros call ] unit-test
[ [ no-case ] ] [ [ { } case ] expand-macros ] unit-test

View File

@ -33,8 +33,8 @@ M: wrapper expand-macros* wrapped>> literal ;
stack get pop >quotation end (expand-macros) ; stack get pop >quotation end (expand-macros) ;
: expand-macro? ( word -- quot ? ) : expand-macro? ( word -- quot ? )
dup [ "macro" word-prop ] [ "transform-quot" word-prop ] bi or dup [ dup [ "transform-quot" word-prop ] [ "macro" word-prop ] bi or dup [
swap [ stack-effect in>> length ] [ "transform-n" word-prop ] bi or swap [ "transform-n" word-prop ] [ stack-effect in>> length ] bi or
stack get length <= stack get length <=
] [ 2drop f f ] if ; ] [ 2drop f f ] if ;