From 86c81bedfb3254b7e19ab3859c987d55fd0ca62e Mon Sep 17 00:00:00 2001
From: John Benediktsson <mrjbq7@gmail.com>
Date: Sun, 19 Jul 2015 11:16:19 -0700
Subject: [PATCH] macros: check macro effect is real-macro-effect.

---
 basis/macros/macros-tests.factor | 2 +-
 basis/macros/macros.factor       | 9 +++++++--
 2 files changed, 8 insertions(+), 3 deletions(-)

diff --git a/basis/macros/macros-tests.factor b/basis/macros/macros-tests.factor
index 58c1de3dad..f02ea299f7 100644
--- a/basis/macros/macros-tests.factor
+++ b/basis/macros/macros-tests.factor
@@ -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
diff --git a/basis/macros/macros.factor b/basis/macros/macros.factor
index 31ef0e4037..9b17ba0426 100644
--- a/basis/macros/macros.factor
+++ b/basis/macros/macros.factor
@@ -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 ]