constructors: Unify C:, CONSTRUCTOR:, NAMED-CONSTRUCTOR:, and DEFAULT-CONSTRUCTOR...

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.

diff --git a/extra/constructors/constructors-tests.factor b/extra/constructors/constructors-tests.factor
index 36419d60eee4d819b72c3148247f298b60153fa8..85a4de50fbb23cd84dd55f2f38eec65749665784 100644 (file)
--- 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 -- 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> 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
 [ 0 ] [ 0 0 <ct2> a>> ] unit-test
 [ 0 ] [ 0 0 0 <ct3> 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
     { 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
 >>
 
 : <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> 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> 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 ae810dc3281ae3463ffa5d3d1dbeb0fabec24c7e..4690fa140a412559f1e5b06437dbe926d8af5945 100644 (file)
--- 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 ;