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

remove experimental constructors features

db4
Doug Coleman 2009-07-23 15:59:55 -05:00
parent 15b609b15c
commit 9e7bfc202b
2 changed files with 4 additions and 55 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -29,58 +29,15 @@ CONSTRUCTOR: ct1 ( a -- obj )
[ 1 + ] change-a ; [ 1 + ] change-a ;
CONSTRUCTOR: ct2 ( a b -- obj ) CONSTRUCTOR: ct2 ( a b -- obj )
initialize-ct1
[ 1 + ] change-a ; [ 1 + ] change-a ;
CONSTRUCTOR: ct3 ( a b c -- obj ) CONSTRUCTOR: ct3 ( a b c -- obj )
initialize-ct1
[ 1 + ] change-a ; [ 1 + ] change-a ;
CONSTRUCTOR: ct4 ( a b c d -- obj ) CONSTRUCTOR: ct4 ( a b c d -- obj )
initialize-ct3
[ 1 + ] change-a ; [ 1 + ] change-a ;
[ 1001 ] [ 1000 <ct1> a>> ] unit-test [ 1001 ] [ 1000 <ct1> a>> ] unit-test
[ 2 ] [ 0 0 <ct2> a>> ] unit-test [ 2 ] [ 0 0 <ct2> a>> ] unit-test
[ 2 ] [ 0 0 0 <ct3> a>> ] unit-test [ 3 ] [ 0 0 0 <ct3> a>> ] unit-test
[ 3 ] [ 0 0 0 0 <ct4> a>> ] unit-test [ 4 ] [ 0 0 0 0 <ct4> 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 <rofl> ] unit-test
TUPLE: default { a integer initial: 0 } ;
CONSTRUCTOR: default ( -- obj ) ;
[ 0 ] [ <default> a>> ] unit-test
TUPLE: inherit1 a ;
TUPLE: inherit2 < inherit1 a ;
CONSTRUCTOR: inherit2 ( a -- obj ) ;
[ T{ inherit2 f f 100 } ] [ 100 <inherit2> ] 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 ] [ <inherit4> hp>> ] unit-test
FORWARD-CONSTRUCTOR: inherit5 ( -- obj )
5 >>hp
10 >>max-hp ;
[ 5 ] [ <inherit5> hp>> ] unit-test

12
extra/constructors/constructors.factor
View File

@ -43,12 +43,7 @@ MACRO:: slots>constructor ( class slots -- quot )
class def define-initializer class def define-initializer
class effect in>> '[ _ _ slots>constructor ] ; class effect in>> '[ _ _ slots>constructor ] ;
:: define-constructor ( constructor-word class effect def -- ) :: define-constructor ( constructor-word class effect def reverse? -- )
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? -- )
constructor-word class effect def (define-constructor) constructor-word class effect def (define-constructor)
class superclasses [ lookup-initializer ] map sift class superclasses [ lookup-initializer ] map sift
reverse? [ reverse ] when reverse? [ reverse ] when
@ -60,9 +55,6 @@ MACRO:: slots>constructor ( class slots -- quot )
: parse-constructor ( -- class word effect def ) : parse-constructor ( -- class word effect def )
scan-constructor complete-effect parse-definition ; scan-constructor complete-effect parse-definition ;
SYNTAX: CONSTRUCTOR: parse-constructor define-constructor ; SYNTAX: CONSTRUCTOR: parse-constructor f 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 ;
"initializers" create-vocab drop "initializers" create-vocab drop