From 1c92b20a9a647880b7a15a957c1002d4b244f3e0 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Sat, 5 Jul 2008 20:37:28 -0500
Subject: [PATCH] Fix two bugs

---
 core/classes/tuple/tuple-tests.factor |  2 ++
 core/classes/tuple/tuple.factor       | 34 ++++++++++++++++-----------
 core/generator/generator.factor       | 11 +++++----
 3 files changed, 28 insertions(+), 19 deletions(-)

diff --git a/core/classes/tuple/tuple-tests.factor b/core/classes/tuple/tuple-tests.factor
index 9deb6b1133..a269fad556 100755
--- a/core/classes/tuple/tuple-tests.factor
+++ b/core/classes/tuple/tuple-tests.factor
@@ -657,6 +657,8 @@ TUPLE: boa-coercer-test { x array-capacity } ;
 
 [ fixnum ] [ 0 >bignum boa-coercer-test boa x>> class ] unit-test
 
+[ T{ boa-coercer-test f 0 } ] [ T{ boa-coercer-test } ] unit-test
+
 ! Test error classes
 ERROR: error-class-test a b c ;
 
diff --git a/core/classes/tuple/tuple.factor b/core/classes/tuple/tuple.factor
index 66a75387f1..8471aa918a 100755
--- a/core/classes/tuple/tuple.factor
+++ b/core/classes/tuple/tuple.factor
@@ -17,6 +17,9 @@ ERROR: not-a-tuple object ;
 : check-tuple ( object -- tuple )
     dup tuple? [ not-a-tuple ] unless ; inline
 
+: all-slots ( class -- slots )
+    superclasses [ "slots" word-prop ] map concat ;
+
 <PRIVATE
 
 : (tuple) ( layout -- tuple )
@@ -46,6 +49,20 @@ ERROR: not-a-tuple object ;
 : copy-tuple-slots ( n tuple -- array )
     [ array-nth ] curry map ;
 
+: check-slots ( seq class -- seq class )
+    [ ] [
+        2dup all-slots [
+            class>> 2dup instance?
+            [ 2drop ] [ bad-slot-value ] if
+        ] 2each
+    ] if-bootstrapping ; inline
+
+: initial-values ( class -- slots )
+    all-slots [ initial>> ] map ;
+
+: pad-slots ( slots class -- slots' class )
+    [ initial-values over length tail append ] keep ; inline
+
 PRIVATE>
 
 : tuple>array ( tuple -- array )
@@ -56,21 +73,10 @@ PRIVATE>
 : tuple-slots ( tuple -- seq )
     prepare-tuple>array drop copy-tuple-slots ;
 
-: all-slots ( class -- slots )
-    superclasses [ "slots" word-prop ] map concat ;
-
-: check-slots ( seq class -- seq class )
-    [ ] [
-        2dup all-slots [
-            class>> 2dup instance?
-            [ 2drop ] [ bad-slot-value ] if
-        ] 2each
-    ] if-bootstrapping ; inline
-
 GENERIC: slots>tuple ( seq class -- tuple )
 
 M: tuple-class slots>tuple
-    check-slots
+    check-slots pad-slots
     tuple-layout <tuple> [
         [ tuple-size ]
         [ [ set-array-nth ] curry ]
@@ -138,8 +144,8 @@ ERROR: bad-superclass class ;
     dup boa-check-quot "boa-check" set-word-prop ;
 
 : tuple-prototype ( class -- prototype )
-    [ all-slots [ initial>> ] map ] keep
-    over [ ] contains? [ slots>tuple ] [ 2drop f ] if ;
+    [ initial-values ] keep
+    over [ ] all? [ 2drop f ] [ slots>tuple ] if ;
 
 : define-tuple-prototype ( class -- )
     dup tuple-prototype "prototype" set-word-prop ;
diff --git a/core/generator/generator.factor b/core/generator/generator.factor
index d369c047d9..07d8d6fdad 100755
--- a/core/generator/generator.factor
+++ b/core/generator/generator.factor
@@ -13,11 +13,12 @@ SYMBOL: compiled
 
 : queue-compile ( word -- )
     {
-        { [ dup compiled get key? ] [ drop ] }
-        { [ dup inlined-block? ] [ drop ] }
-        { [ dup primitive? ] [ drop ] }
-        [ compile-queue get push-front ]
-    } cond ;
+        { [ dup "forgotten" word-prop ] [ ] }
+        { [ dup compiled get key? ] [ ] }
+        { [ dup inlined-block? ] [ ] }
+        { [ dup primitive? ] [ ] }
+        [ dup compile-queue get push-front ]
+    } cond drop ;
 
 : maybe-compile ( word -- )
     dup compiled>> [ drop ] [ queue-compile ] if ;