From 74fbe979bbf37090cf0a0f04ffe0f9c1c591602c Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 11 Jun 2009 14:31:04 -0500 Subject: [PATCH] forward/backward constructors instead of auto-constructors --- basis/constructors/constructors-tests.factor | 9 ++++++++- basis/constructors/constructors.factor | 9 +++++---- 2 files changed, 13 insertions(+), 5 deletions(-) diff --git a/basis/constructors/constructors-tests.factor b/basis/constructors/constructors-tests.factor index ae7fd0409c..59ecb8ff77 100644 --- a/basis/constructors/constructors-tests.factor +++ b/basis/constructors/constructors-tests.factor @@ -69,11 +69,18 @@ CONSTRUCTOR: inherit2 ( a -- obj ) ; TUPLE: inherit3 hp max-hp ; TUPLE: inherit4 < inherit3 ; +TUPLE: inherit5 < inherit3 ; CONSTRUCTOR: inherit3 ( -- obj ) dup max-hp>> >>hp ; -AUTO-CONSTRUCTOR: inherit4 ( -- obj ) +BACKWARD-CONSTRUCTOR: inherit4 ( -- obj ) 10 >>max-hp ; [ 10 ] [ hp>> ] unit-test + +FORWARD-CONSTRUCTOR: inherit5 ( -- obj ) + 5 >>hp + 10 >>max-hp ; + +[ 5 ] [ hp>> ] unit-test diff --git a/basis/constructors/constructors.factor b/basis/constructors/constructors.factor index a2c8d7637d..b4091a1234 100644 --- a/basis/constructors/constructors.factor +++ b/basis/constructors/constructors.factor @@ -48,9 +48,10 @@ MACRO:: slots>constructor ( class slots -- quot ) class lookup-initializer '[ @ _ execute( obj -- obj ) ] effect define-declared ; -:: define-auto-constructor ( constructor-word class effect def -- ) +:: define-auto-constructor ( constructor-word class effect def reverse? -- ) constructor-word class effect def (define-constructor) - class superclasses [ lookup-initializer ] map sift reverse + class superclasses [ lookup-initializer ] map sift + reverse? [ reverse ] when '[ @ _ [ execute( obj -- obj ) ] each ] effect define-declared ; : scan-constructor ( -- class word ) @@ -60,7 +61,7 @@ MACRO:: slots>constructor ( class slots -- quot ) scan-constructor complete-effect parse-definition ; SYNTAX: CONSTRUCTOR: parse-constructor define-constructor ; - -SYNTAX: AUTO-CONSTRUCTOR: parse-constructor define-auto-constructor ; +SYNTAX: FORWARD-CONSTRUCTOR: parse-constructor f define-auto-constructor ; +SYNTAX: BACKWARD-CONSTRUCTOR: parse-constructor t define-auto-constructor ; "initializers" create-vocab drop