steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

constructors: Unify C:, CONSTRUCTOR:, NAMED-CONSTRUCTOR:, and DEFAULT-CONSTRUCTOR: by requiring the class name after the constructor word name. 

example: CONSTRUCTOR: <foo> foo ( stack effect -- obj ) ;

The benefit is that we can now search for <foo> by name and it's not auto-generated--less magic. Also, there are fewer kinds of constructors.

Rename CONSTRUCTOR-SYNTAX: to SLOT-CONSTRUCTOR: since it's more descriptive.
db4
Doug Coleman 2014-11-04 15:56:23 -08:00
parent db88ae8d30
commit 73bd47f639
2 changed files with 11 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
extra/constructors/constructors-tests.factor
View File

@ -6,7 +6,7 @@ IN: constructors.tests
TUPLE: stock-spread stock spread timestamp ; TUPLE: stock-spread stock spread timestamp ;
CONSTRUCTOR: stock-spread ( stock spread -- stock-spread ) CONSTRUCTOR: <stock-spread> stock-spread ( stock spread -- stock-spread )
now >>timestamp ; now >>timestamp ;
SYMBOL: AAPL SYMBOL: AAPL
@ -25,31 +25,19 @@ TUPLE: ct2 < ct1 b ;
TUPLE: ct3 < ct2 c ; TUPLE: ct3 < ct2 c ;
TUPLE: ct4 < ct3 d ; TUPLE: ct4 < ct3 d ;
DEFAULT-CONSTRUCTOR: ct1 ( a -- obj ) CONSTRUCTOR: <ct1> ct1 ( a -- obj ) ;
DEFAULT-CONSTRUCTOR: ct2 ( a b -- obj ) CONSTRUCTOR: <ct2> ct2 ( a b -- obj ) ;
DEFAULT-CONSTRUCTOR: ct3 ( a b c -- obj ) CONSTRUCTOR: <ct3> ct3 ( a b c -- obj ) ;
DEFAULT-CONSTRUCTOR: ct4 ( a b c d -- obj ) CONSTRUCTOR: <ct4> ct4 ( a b c d -- obj ) ;
[ 1000 ] [ 1000 <ct1> a>> ] unit-test [ 1000 ] [ 1000 <ct1> a>> ] unit-test
[ 0 ] [ 0 0 <ct2> a>> ] unit-test [ 0 ] [ 0 0 <ct2> a>> ] unit-test
[ 0 ] [ 0 0 0 <ct3> a>> ] unit-test [ 0 ] [ 0 0 0 <ct3> a>> ] unit-test
[ 0 ] [ 0 0 0 0 <ct4> a>> ] unit-test [ 0 ] [ 0 0 0 0 <ct4> a>> ] unit-test
NAMED-CONSTRUCTOR: <ct1!> ct1 ( a -- obj )
NAMED-CONSTRUCTOR: <ct2!> ct2 ( a b -- obj )
NAMED-CONSTRUCTOR: <ct3!> ct3 ( a b c -- obj )
NAMED-CONSTRUCTOR: <ct4!> ct4 ( a b c d -- obj )
[ 1000 ] [ 1000 <ct1!> a>> ] unit-test
[ 0 ] [ 0 0 <ct2!> a>> ] unit-test
[ 0 ] [ 0 0 0 <ct3!> a>> ] unit-test
[ 0 ] [ 0 0 0 0 <ct4!> a>> ] unit-test
TUPLE: monster TUPLE: monster
{ name string read-only } { hp integer } { max-hp integer read-only } { name string read-only } { hp integer } { max-hp integer read-only }
@ -62,7 +50,7 @@ TUPLE: a-monster < monster ;
TUPLE: b-monster < monster ; TUPLE: b-monster < monster ;
<< <<
CONSTRUCTOR-SYNTAX: a-monster SLOT-CONSTRUCTOR: a-monster
>> >>
: <a-monster> ( name hp max-hp -- obj ) : <a-monster> ( name hp max-hp -- obj )
@ -83,7 +71,7 @@ CONSTRUCTOR-SYNTAX: a-monster
"""USE: constructors """USE: constructors
IN: constructors.tests IN: constructors.tests
TUPLE: foo a b ; TUPLE: foo a b ;
DEFAULT-CONSTRUCTOR: foo ( a a -- obj )""" eval( -- ) CONSTRUCTOR: <foo> foo ( a a -- obj )""" eval( -- )
] [ ] [
error>> repeated-constructor-parameters? error>> repeated-constructor-parameters?
] must-fail-with ] must-fail-with
@ -92,7 +80,7 @@ DEFAULT-CONSTRUCTOR: foo ( a a -- obj )""" eval( -- )
"""USE: constructors """USE: constructors
IN: constructors.tests IN: constructors.tests
TUPLE: foo a b ; TUPLE: foo a b ;
DEFAULT-CONSTRUCTOR: foo ( a c -- obj )""" eval( -- ) CONSTRUCTOR: <foo> foo ( a c -- obj )""" eval( -- )
] [ ] [
error>> unknown-constructor-parameters? error>> unknown-constructor-parameters?
] must-fail-with ] must-fail-with

12
extra/constructors/constructors.factor
View File

@ -41,7 +41,7 @@ ERROR: unknown-constructor-parameters class effect unknown ;
create-in dup reset-generic ; create-in dup reset-generic ;
: scan-constructor ( -- word class ) : scan-constructor ( -- word class )
scan-word [ name>> "<" ">" surround create-function ] keep ; scan-new-word scan-class ;
: parse-constructor ( -- word class effect def ) : parse-constructor ( -- word class effect def )
scan-constructor scan-effect ensure-constructor-parameters scan-constructor scan-effect ensure-constructor-parameters
@ -59,13 +59,7 @@ SYNTAX: CONSTRUCTOR:
: scan-full-input-effect ( -- effect ) : scan-full-input-effect ( -- effect )
"(" expect scan-rest-input-effect ; "(" expect scan-rest-input-effect ;
SYNTAX: NAMED-CONSTRUCTOR: SYNTAX: SLOT-CONSTRUCTOR:
scan-new-word scan-word scan-effect define-constructor ; scan-new-word [ name>> "(" append create-reset ] keep
SYNTAX: DEFAULT-CONSTRUCTOR:
scan-constructor scan-effect define-constructor ;
SYNTAX: CONSTRUCTOR-SYNTAX:
scan-word [ name>> "(" append create-reset ] keep
'[ scan-rest-input-effect in>> _ '[ _ _ slots>boa ] append! ] define-syntax ; '[ scan-rest-input-effect in>> _ '[ _ _ slots>boa ] append! ] define-syntax ;