macros: check macro effect is real-macro-effect.
parent
4cda3fe7c4
commit
86c81bedfb
|
@ -20,7 +20,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 stack-checker kernel ; IN: hanging-macro MACRO: c ( quot -- 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
|
||||
|
|
|
@ -9,13 +9,18 @@ IN: macros
|
|||
: real-macro-effect ( effect -- effect' )
|
||||
in>> { "quot" } <effect> ;
|
||||
|
||||
: check-macro-effect ( word effect -- )
|
||||
[ real-macro-effect ] keep 2dup effect=
|
||||
[ 3drop ] [ bad-stack-effect ] if ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: define-macro ( word definition effect -- )
|
||||
real-macro-effect {
|
||||
{
|
||||
[ nip check-macro-effect ]
|
||||
[
|
||||
[ '[ _ _ call-effect ] ] keep
|
||||
[ memoize-quot '[ @ call ] ] keep
|
||||
[ memoize-quot ] keep
|
||||
define-declared
|
||||
]
|
||||
[ drop "macro" set-word-prop ]
|
||||
|
|
Loading…
Reference in New Issue