add a constructor that calls all of its superclass initializers
parent
989cb7d5df
commit
2ff32e838e
|
@ -1,7 +1,7 @@
|
|||
! 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
|
||||
USING: accessors assocs classes classes.tuple effects.parser
|
||||
fry generalizations generic.standard kernel lexer locals macros
|
||||
parser sequences slots vocabs words ;
|
||||
IN: constructors
|
||||
|
||||
|
@ -35,20 +35,29 @@ MACRO:: slots>constructor ( class slots -- quot )
|
|||
values _ firstn class boa
|
||||
] ;
|
||||
|
||||
:: define-constructor ( constructor-word class effect def -- )
|
||||
:: (define-constructor) ( constructor-word class effect def -- word quot )
|
||||
constructor-word
|
||||
class def define-initializer
|
||||
class effect in>> '[ _ _ slots>constructor ]
|
||||
class effect in>> '[ _ _ slots>constructor ] ;
|
||||
|
||||
:: define-constructor ( constructor-word class effect def -- )
|
||||
constructor-word class effect def (define-constructor)
|
||||
class lookup-initializer
|
||||
'[ @ _ execute( obj -- obj ) ] effect define-declared ;
|
||||
|
||||
:: define-auto-constructor ( constructor-word class effect def -- )
|
||||
constructor-word class effect def (define-constructor)
|
||||
class superclasses [ lookup-initializer ] map sift
|
||||
'[ @ _ [ execute( obj -- obj ) ] each ] effect define-declared ;
|
||||
|
||||
: scan-constructor ( -- class word )
|
||||
scan-word [ name>> "<" ">" surround create-in ] keep ;
|
||||
|
||||
SYNTAX: CONSTRUCTOR:
|
||||
scan-constructor
|
||||
complete-effect
|
||||
parse-definition
|
||||
define-constructor ;
|
||||
: parse-constructor ( -- class word effect def )
|
||||
scan-constructor complete-effect parse-definition ;
|
||||
|
||||
SYNTAX: CONSTRUCTOR: parse-constructor define-constructor ;
|
||||
|
||||
SYNTAX: AUTO-CONSTRUCTOR: parse-constructor define-auto-constructor ;
|
||||
|
||||
"initializers" create-vocab drop
|
||||
|
|
Loading…
Reference in New Issue