1 ! Copyright (C) 2009 Slava Pestov, Doug Coleman.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors assocs classes.tuple effects.parser fry
4 generalizations generic.standard kernel lexer locals macros
5 parser sequences slots vocabs words ;
10 : initializer-name ( class -- word )
11 name>> "initialize-" prepend ;
13 : lookup-initializer ( class -- word/f )
14 initializer-name "initializers" lookup ;
16 : initializer-word ( class -- word )
18 "initializers" create-vocab create
19 [ t "initializer" set-word-prop ] [ ] bi ;
21 : define-initializer-generic ( name -- )
22 initializer-word (( object -- object )) define-simple-generic ;
24 : define-initializer ( class def -- )
25 [ drop define-initializer-generic ]
26 [ [ dup lookup-initializer ] dip H{ } clone define-typecheck ] 2bi ;
28 MACRO:: slots>constructor ( class slots -- quot )
29 class all-slots [ [ name>> ] [ initial>> ] bi ] { } map>assoc :> params
33 _ narray slots swap zip
34 params swap assoc-union
35 values _ firstn class boa
38 :: define-constructor ( constructor-word class effect def -- )
40 class def define-initializer
41 class effect in>> '[ _ _ slots>constructor ]
42 class lookup-initializer
43 '[ @ _ execute( obj -- obj ) ] effect define-declared ;
45 : scan-constructor ( -- class word )
46 scan-word [ name>> "<" ">" surround create-in ] keep ;
54 "initializers" create-vocab drop