use initial values in constructors when approriate

basis/constructors/constructors-tests.factor

@@ -20,7 +20,6 @@ SYMBOL: AAPL
     } 1&&
 ] unit-test
 
-
 TUPLE: ct1 a ;
 TUPLE: ct2 < ct1 b ;
 TUPLE: ct3 < ct2 c ;
@@ -41,7 +40,20 @@ CONSTRUCTOR: ct4 ( a b c d -- obj )
     initialize-ct3
     [ 1 + ] change-a ;
 
-[ 1 ] [ 0 <ct1> a>> ] unit-test
+[ 1001 ] [ 1000 <ct1> a>> ] unit-test
 [ 2 ] [ 0 0 <ct2> a>> ] unit-test
 [ 2 ] [ 0 0 0 <ct3> a>> ] unit-test
 [ 3 ] [ 0 0 0 0 <ct4> a>> ] unit-test
+
+
+TUPLE: rofl a b c ;
+CONSTRUCTOR: rofl ( b c a  -- obj ) ;
+
+[ T{ rofl { a 3 } { b 1 } { c 2 } } ] [ 1 2 3 <rofl> ] unit-test
+
+
+TUPLE: default { a integer initial: 0 } ;
+
+CONSTRUCTOR: default ( -- obj ) ;
+
+[ 0 ] [ <default> a>> ] unit-test

basis/constructors/constructors.factor

@@ -1,8 +1,8 @@
 ! Copyright (C) 2009 Slava Pestov, Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: slots kernel sequences fry accessors parser lexer words
+USING: accessors assocs classes.tuple effects.parser fry
-effects.parser macros generalizations locals classes.tuple
+generalizations generic.standard kernel lexer locals macros
-vocabs generic.standard ;
+parser sequences slots vocabs words ;
 IN: constructors
 
 ! An experiment
@@ -26,14 +26,13 @@ IN: constructors
     [ [ dup lookup-initializer ] dip H{ } clone define-typecheck ] 2bi ;
 
 MACRO:: slots>constructor ( class slots -- quot )
-    slots class
+    class all-slots [ [ name>> ] [ initial>> ] bi ] { } map>assoc :> params
-    all-slots [ name>> ] map
+    slots length
-    [ '[ _ = ] find drop ] with map
+    params length
-    [ [ ] count ] [ ] [ length ] tri
     '[
-        _ narray _
+        _ narray slots swap zip 
-        [ swap over [ nth ] [ drop ] if ] with map
+        params swap assoc-union
-        _ firstn class boa
+        values _ firstn class boa
     ] ;
 
 :: define-constructor ( constructor-word class effect def -- )