From 0438e4983b297e62d06feb26a38304b22baed5bf Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Tue, 2 Feb 2010 06:56:13 +1300
Subject: [PATCH] macros: handle compile-time stack effect check of macro body
 more elegantly than previous attempt

---
 basis/macros/macros-tests.factor | 21 ++++++++++++++++++---
 basis/macros/macros.factor       |  8 ++++++--
 2 files changed, 24 insertions(+), 5 deletions(-)

diff --git a/basis/macros/macros-tests.factor b/basis/macros/macros-tests.factor
index c8dc0ec16d..57723879dc 100644
--- a/basis/macros/macros-tests.factor
+++ b/basis/macros/macros-tests.factor
@@ -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
diff --git a/basis/macros/macros.factor b/basis/macros/macros.factor
index 46fd1ce748..91ca2f301c 100644
--- a/basis/macros/macros.factor
+++ b/basis/macros/macros.factor
@@ -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 ;