steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Fix a macro.expander bug

db4
Slava Pestov 2008-09-24 20:18:03 -05:00
parent 29f633c7d1
commit 505eedc34b
3 changed files with 15 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
basis/locals/locals-tests.factor
View File

@ -1,7 +1,7 @@
USING: locals math sequences tools.test hashtables words kernel
namespaces arrays strings prettyprint io.streams.string parser
accessors generic eval combinators combinators.short-circuit
combinators.short-circuit.smart ;
combinators.short-circuit.smart math.order ;
IN: locals.tests
:: foo ( a b -- a a ) a a ;
@ -332,3 +332,12 @@ M:: sequence method-with-locals ( a -- y ) a reverse ;
[ 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
:: 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

2
basis/macros/expander/expander-tests.factor
View File

@ -7,3 +7,5 @@ kernel ;
[ f ] [ 15 [ { [ 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

4
basis/macros/expander/expander.factor
View File

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