add a constructor that calls all of its superclass initializers

diff --git a/basis/constructors/constructors.factor b/basis/constructors/constructors.factor
index e6982e3d98aaaf7961f2ff54b1c59dcc319451ea..d67d07810d618bd771e20ffb868dbfd9d06b53c4 100644 (file)
--- a/basis/constructors/constructors.factor
+++ b/basis/constructors/constructors.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2009 Slava Pestov, Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors assocs classes.tuple effects.parser fry
-generalizations generic.standard kernel lexer locals macros
+USING: accessors assocs classes classes.tuple effects.parser
+fry generalizations generic.standard kernel lexer locals macros
 parser sequences slots vocabs words ;
 IN: constructors
 
@@ -35,20 +35,29 @@ MACRO:: slots>constructor ( class slots -- quot )
         values _ firstn class boa
     ] ;
 
-:: define-constructor ( constructor-word class effect def -- )
+:: (define-constructor) ( constructor-word class effect def -- word quot )
     constructor-word
     class def define-initializer
-    class effect in>> '[ _ _ slots>constructor ]
+    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 -- )
+    constructor-word class effect def (define-constructor)
+    class superclasses [ lookup-initializer ] map sift
+    '[ @ _ [ execute( obj -- obj ) ] each ] effect define-declared ;
+
 : scan-constructor ( -- class word )
     scan-word [ name>> "<" ">" surround create-in ] keep ;
 
-SYNTAX: CONSTRUCTOR:
-    scan-constructor
-    complete-effect
-    parse-definition
-    define-constructor ;
+: parse-constructor ( -- class word effect def )
+    scan-constructor complete-effect parse-definition ;
+
+SYNTAX: CONSTRUCTOR: parse-constructor define-constructor ;
+
+SYNTAX: AUTO-CONSTRUCTOR: parse-constructor define-auto-constructor ;
 
 "initializers" create-vocab drop