55 lines
1.6 KiB
Factor
55 lines
1.6 KiB
Factor
! Copyright (C) 2009 Slava Pestov, Doug Coleman.
|
|
! See http://factorcode.org/license.txt for BSD license.
|
|
USING: accessors assocs classes.tuple effects.parser fry
|
|
generalizations generic.standard kernel lexer locals macros
|
|
parser sequences slots vocabs words ;
|
|
IN: constructors
|
|
|
|
! An experiment
|
|
|
|
: initializer-name ( class -- word )
|
|
name>> "initialize-" prepend ;
|
|
|
|
: lookup-initializer ( class -- word/f )
|
|
initializer-name "initializers" lookup ;
|
|
|
|
: initializer-word ( class -- word )
|
|
initializer-name
|
|
"initializers" create-vocab create
|
|
[ t "initializer" set-word-prop ] [ ] bi ;
|
|
|
|
: define-initializer-generic ( name -- )
|
|
initializer-word (( object -- object )) define-simple-generic ;
|
|
|
|
: define-initializer ( class def -- )
|
|
[ drop define-initializer-generic ]
|
|
[ [ dup lookup-initializer ] dip H{ } clone define-typecheck ] 2bi ;
|
|
|
|
MACRO:: slots>constructor ( class slots -- quot )
|
|
class all-slots [ [ name>> ] [ initial>> ] bi ] { } map>assoc :> params
|
|
slots length
|
|
params length
|
|
'[
|
|
_ narray slots swap zip
|
|
params swap assoc-union
|
|
values _ firstn class boa
|
|
] ;
|
|
|
|
:: define-constructor ( constructor-word class effect def -- )
|
|
constructor-word
|
|
class def define-initializer
|
|
class effect in>> '[ _ _ slots>constructor ]
|
|
class lookup-initializer
|
|
'[ @ _ execute( obj -- obj ) ] effect define-declared ;
|
|
|
|
: scan-constructor ( -- class word )
|
|
scan-word [ name>> "<" ">" surround create-in ] keep ;
|
|
|
|
SYNTAX: CONSTRUCTOR:
|
|
scan-constructor
|
|
complete-effect
|
|
parse-definition
|
|
define-constructor ;
|
|
|
|
"initializers" create-vocab drop
|