diff --git a/extra/constructors/constructors-tests.factor b/extra/constructors/constructors-tests.factor index 36419d60ee..85a4de50fb 100644 --- a/extra/constructors/constructors-tests.factor +++ b/extra/constructors/constructors-tests.factor @@ -6,7 +6,7 @@ IN: constructors.tests TUPLE: stock-spread stock spread timestamp ; -CONSTRUCTOR: stock-spread ( stock spread -- stock-spread ) +CONSTRUCTOR: stock-spread ( stock spread -- stock-spread ) now >>timestamp ; SYMBOL: AAPL @@ -25,31 +25,19 @@ TUPLE: ct2 < ct1 b ; TUPLE: ct3 < ct2 c ; TUPLE: ct4 < ct3 d ; -DEFAULT-CONSTRUCTOR: ct1 ( a -- obj ) +CONSTRUCTOR: ct1 ( a -- obj ) ; -DEFAULT-CONSTRUCTOR: ct2 ( a b -- obj ) +CONSTRUCTOR: ct2 ( a b -- obj ) ; -DEFAULT-CONSTRUCTOR: ct3 ( a b c -- obj ) +CONSTRUCTOR: ct3 ( a b c -- obj ) ; -DEFAULT-CONSTRUCTOR: ct4 ( a b c d -- obj ) +CONSTRUCTOR: ct4 ( a b c d -- obj ) ; [ 1000 ] [ 1000 a>> ] unit-test [ 0 ] [ 0 0 a>> ] unit-test [ 0 ] [ 0 0 0 a>> ] unit-test [ 0 ] [ 0 0 0 0 a>> ] unit-test -NAMED-CONSTRUCTOR: ct1 ( a -- obj ) - -NAMED-CONSTRUCTOR: ct2 ( a b -- obj ) - -NAMED-CONSTRUCTOR: ct3 ( a b c -- obj ) - -NAMED-CONSTRUCTOR: ct4 ( a b c d -- obj ) - -[ 1000 ] [ 1000 a>> ] unit-test -[ 0 ] [ 0 0 a>> ] unit-test -[ 0 ] [ 0 0 0 a>> ] unit-test -[ 0 ] [ 0 0 0 0 a>> ] unit-test TUPLE: monster { name string read-only } { hp integer } { max-hp integer read-only } @@ -62,7 +50,7 @@ TUPLE: a-monster < monster ; TUPLE: b-monster < monster ; << -CONSTRUCTOR-SYNTAX: a-monster +SLOT-CONSTRUCTOR: a-monster >> : ( name hp max-hp -- obj ) @@ -83,7 +71,7 @@ CONSTRUCTOR-SYNTAX: a-monster """USE: constructors IN: constructors.tests TUPLE: foo a b ; -DEFAULT-CONSTRUCTOR: foo ( a a -- obj )""" eval( -- ) +CONSTRUCTOR: foo ( a a -- obj )""" eval( -- ) ] [ error>> repeated-constructor-parameters? ] must-fail-with @@ -92,7 +80,7 @@ DEFAULT-CONSTRUCTOR: foo ( a a -- obj )""" eval( -- ) """USE: constructors IN: constructors.tests TUPLE: foo a b ; -DEFAULT-CONSTRUCTOR: foo ( a c -- obj )""" eval( -- ) +CONSTRUCTOR: foo ( a c -- obj )""" eval( -- ) ] [ error>> unknown-constructor-parameters? ] must-fail-with diff --git a/extra/constructors/constructors.factor b/extra/constructors/constructors.factor index ae810dc328..4690fa140a 100644 --- a/extra/constructors/constructors.factor +++ b/extra/constructors/constructors.factor @@ -41,7 +41,7 @@ ERROR: unknown-constructor-parameters class effect unknown ; create-in dup reset-generic ; : scan-constructor ( -- word class ) - scan-word [ name>> "<" ">" surround create-function ] keep ; + scan-new-word scan-class ; : parse-constructor ( -- word class effect def ) scan-constructor scan-effect ensure-constructor-parameters @@ -59,13 +59,7 @@ SYNTAX: CONSTRUCTOR: : scan-full-input-effect ( -- effect ) "(" expect scan-rest-input-effect ; -SYNTAX: NAMED-CONSTRUCTOR: - scan-new-word scan-word scan-effect define-constructor ; - -SYNTAX: DEFAULT-CONSTRUCTOR: - scan-constructor scan-effect define-constructor ; - -SYNTAX: CONSTRUCTOR-SYNTAX: - scan-word [ name>> "(" append create-reset ] keep +SYNTAX: SLOT-CONSTRUCTOR: + scan-new-word [ name>> "(" append create-reset ] keep '[ scan-rest-input-effect in>> _ '[ _ _ slots>boa ] append! ] define-syntax ;