diff --git a/extra/constructors/constructors-tests.factor b/extra/constructors/constructors-tests.factor index 59ecb8ff77..1e098645bf 100644 --- a/extra/constructors/constructors-tests.factor +++ b/extra/constructors/constructors-tests.factor @@ -29,58 +29,15 @@ CONSTRUCTOR: ct1 ( a -- obj ) [ 1 + ] change-a ; CONSTRUCTOR: ct2 ( a b -- obj ) - initialize-ct1 [ 1 + ] change-a ; CONSTRUCTOR: ct3 ( a b c -- obj ) - initialize-ct1 [ 1 + ] change-a ; CONSTRUCTOR: ct4 ( a b c d -- obj ) - initialize-ct3 [ 1 + ] change-a ; [ 1001 ] [ 1000 a>> ] unit-test [ 2 ] [ 0 0 a>> ] unit-test -[ 2 ] [ 0 0 0 a>> ] unit-test -[ 3 ] [ 0 0 0 0 a>> ] unit-test - - -TUPLE: rofl a b c ; -CONSTRUCTOR: rofl ( b c a -- obj ) ; - -[ T{ rofl { a 3 } { b 1 } { c 2 } } ] [ 1 2 3 ] unit-test - - -TUPLE: default { a integer initial: 0 } ; - -CONSTRUCTOR: default ( -- obj ) ; - -[ 0 ] [ a>> ] unit-test - - -TUPLE: inherit1 a ; -TUPLE: inherit2 < inherit1 a ; - -CONSTRUCTOR: inherit2 ( a -- obj ) ; - -[ T{ inherit2 f f 100 } ] [ 100 ] unit-test - - -TUPLE: inherit3 hp max-hp ; -TUPLE: inherit4 < inherit3 ; -TUPLE: inherit5 < inherit3 ; - -CONSTRUCTOR: inherit3 ( -- obj ) - dup max-hp>> >>hp ; - -BACKWARD-CONSTRUCTOR: inherit4 ( -- obj ) - 10 >>max-hp ; - -[ 10 ] [ hp>> ] unit-test - -FORWARD-CONSTRUCTOR: inherit5 ( -- obj ) - 5 >>hp - 10 >>max-hp ; - -[ 5 ] [ hp>> ] unit-test +[ 3 ] [ 0 0 0 a>> ] unit-test +[ 4 ] [ 0 0 0 0 a>> ] unit-test diff --git a/extra/constructors/constructors.factor b/extra/constructors/constructors.factor index b8fe598f84..3cee399925 100644 --- a/extra/constructors/constructors.factor +++ b/extra/constructors/constructors.factor @@ -43,12 +43,7 @@ MACRO:: slots>constructor ( class slots -- quot ) class def define-initializer 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 reverse? -- ) +:: define-constructor ( constructor-word class effect def reverse? -- ) constructor-word class effect def (define-constructor) class superclasses [ lookup-initializer ] map sift reverse? [ reverse ] when @@ -60,9 +55,6 @@ MACRO:: slots>constructor ( class slots -- quot ) : parse-constructor ( -- class word effect def ) scan-constructor complete-effect parse-definition ; -SYNTAX: CONSTRUCTOR: parse-constructor define-constructor ; -SYNTAX: FORWARD-CONSTRUCTOR: parse-constructor f define-auto-constructor ; -SYNTAX: BACKWARD-CONSTRUCTOR: parse-constructor t define-auto-constructor ; -SYNTAX: AUTO-CONSTRUCTOR: parse-constructor f define-auto-constructor ; +SYNTAX: CONSTRUCTOR: parse-constructor f define-constructor ; "initializers" create-vocab drop