diff --git a/basis/constructors/constructors-tests.factor b/basis/constructors/constructors-tests.factor index af1a879ee3..271e173718 100644 --- a/basis/constructors/constructors-tests.factor +++ b/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 a>> ] unit-test +[ 1001 ] [ 1000 a>> ] unit-test [ 2 ] [ 0 0 a>> ] unit-test [ 2 ] [ 0 0 0 a>> ] unit-test [ 3 ] [ 0 0 0 0 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 ] unit-test + + +TUPLE: default { a integer initial: 0 } ; + +CONSTRUCTOR: default ( -- obj ) ; + +[ 0 ] [ a>> ] unit-test diff --git a/basis/constructors/constructors.factor b/basis/constructors/constructors.factor index b08ac0cda3..c2a7d828c9 100644 --- a/basis/constructors/constructors.factor +++ b/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 -effects.parser macros generalizations locals classes.tuple -vocabs generic.standard ; +USING: accessors assocs classes.tuple effects.parser fry +generalizations generic.standard kernel lexer locals macros +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 - all-slots [ name>> ] map - [ '[ _ = ] find drop ] with map - [ [ ] count ] [ ] [ length ] tri + class all-slots [ [ name>> ] [ initial>> ] bi ] { } map>assoc :> params + slots length + params length '[ - _ narray _ - [ swap over [ nth ] [ drop ] if ] with map - _ firstn class boa + _ narray slots swap zip + params swap assoc-union + values _ firstn class boa ] ; :: define-constructor ( constructor-word class effect def -- )