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

macros: handle compile-time stack effect check of macro body more elegantly than previous attempt

db4
Slava Pestov 2010-02-02 06:56:13 +13:00
parent 7e64810a00
commit 0438e4983b
2 changed files with 24 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
basis/macros/macros-tests.factor
View File

@ -1,6 +1,7 @@
IN: macros.tests
USING: tools.test macros math kernel arrays
vectors io.streams.string prettyprint parser eval see ;
vectors io.streams.string prettyprint parser eval see
stack-checker compiler.units definitions vocabs ;
IN: macros.tests
MACRO: see-test ( a b -- quot ) + ;
@ -19,7 +20,21 @@ unit-test
[ f ] [ \ see-test macro? ] unit-test
[ ] [ "USING: macros stack-checker kernel ; IN: hanging-macro MACRO: c ( quot -- ) infer drop [ ] ; : a ( -- ) [ a ] c ;" eval( -- ) ] 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
[ ] [ "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 [ ] ;
! Must fail twice, and not memoize a bad result
[ [ 0 bad-macro ] call ] must-fail
[ [ 0 bad-macro ] call ] must-fail
[ [ 0 bad-macro ] infer ] must-fail
[ ] [ [ \ bad-macro forget ] with-compilation-unit ] unit-test

8
basis/macros/macros.factor
View File

@ -1,7 +1,7 @@
! 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
definitions quotations namespaces memoize accessors fry
compiler.units ;
IN: macros
@ -14,7 +14,11 @@ PRIVATE>
: define-macro ( word definition effect -- )
real-macro-effect {
[ [ memoize-quot [ call ] append ] keep define-declared ]
[
[ '[ _ _ call-effect ] ] keep
[ memoize-quot '[ @ call ] ] keep
define-declared
]
[ drop "macro" set-word-prop ]
[ 2drop changed-effect ]
} 3cleave ;