fix constructors for shadowed slots

db4
Doug Coleman 2009-06-09 12:31:00 -04:00
parent e64acee023
commit 0d308e6a4b
2 changed files with 17 additions and 6 deletions

View File

@ -57,3 +57,11 @@ TUPLE: default { a integer initial: 0 } ;
CONSTRUCTOR: default ( -- obj ) ; CONSTRUCTOR: default ( -- obj ) ;
[ 0 ] [ <default> a>> ] unit-test [ 0 ] [ <default> a>> ] unit-test
TUPLE: inherit1 a ;
TUPLE: inherit2 < inherit1 a ;
CONSTRUCTOR: inherit2 ( a -- obj ) ;
[ T{ inherit2 f f 100 } ] [ 100 <inherit2> ] unit-test

View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors assocs classes classes.tuple effects.parser USING: accessors assocs classes classes.tuple effects.parser
fry generalizations generic.standard kernel lexer locals macros fry generalizations generic.standard kernel lexer locals macros
parser sequences slots vocabs words ; parser sequences slots vocabs words arrays ;
IN: constructors IN: constructors
! An experiment ! An experiment
@ -25,14 +25,17 @@ IN: constructors
[ drop define-initializer-generic ] [ drop define-initializer-generic ]
[ [ dup lookup-initializer ] dip H{ } clone define-typecheck ] 2bi ; [ [ dup lookup-initializer ] dip H{ } clone define-typecheck ] 2bi ;
: all-slots-assoc ( class -- slots )
superclasses [ [ "slots" word-prop ] keep '[ _ ] { } map>assoc ] map concat ;
MACRO:: slots>constructor ( class slots -- quot ) MACRO:: slots>constructor ( class slots -- quot )
class all-slots [ [ name>> ] [ initial>> ] bi ] { } map>assoc :> params class all-slots-assoc slots [ '[ first name>> _ = ] find-last nip ] with map :> slot-assoc
class all-slots-assoc [ [ ] [ first initial>> ] bi ] { } map>assoc :> default-params
slots length slots length
params length default-params length
'[ '[
_ narray slots swap zip _ narray slot-assoc swap zip
params swap assoc-union default-params swap assoc-union values _ firstn class boa
values _ firstn class boa
] ; ] ;
:: (define-constructor) ( constructor-word class effect def -- word quot ) :: (define-constructor) ( constructor-word class effect def -- word quot )