[svn] r7675: nemerle/trunk: macros/Nemerle.n macros/core.n ncc/testsuite/positive/ctor-default-param.n

[nazgul]

Log:
Inherit constructors macro

Author: nazgul
Date: Sun May 13 11:50:00 2007
New Revision: 7675

Modified:
   nemerle/trunk/macros/Nemerle.n
   nemerle/trunk/macros/core.n
   nemerle/trunk/ncc/testsuite/positive/ctor-default-param.n

Modified: nemerle/trunk/macros/Nemerle.n
==============================================================================
--- nemerle/trunk/macros/Nemerle.n	(original)
+++ nemerle/trunk/macros/Nemerle.n	Sun May 13 11:50:00 2007
@@ -55,4 +55,21 @@
       | _ => <[ Nemerle.LazyValue (fun () { $val }) ]>
     }
   }
+  
+  [Nemerle.MacroUsage (Nemerle.MacroPhase.BeforeInheritance,
+                       Nemerle.MacroTargets.Class,
+                       Inherited = false, AllowMultiple = false)]
+  macro InheritConstructors (par : TypeBuilder)
+  {
+      par.DisableImplicitConstructor ();
+  }
+
+
+  [Nemerle.MacroUsage (Nemerle.MacroPhase.WithTypedMembers,
+                       Nemerle.MacroTargets.Class,
+                       Inherited = false, AllowMultiple = false)]
+  macro InheritConstructors (par : TypeBuilder)
+  {
+    MacrosHelper.InheritConstructorsAddingFields (par, []);
+  }
 }

Modified: nemerle/trunk/macros/core.n
==============================================================================
--- nemerle/trunk/macros/core.n	(original)
+++ nemerle/trunk/macros/core.n	Sun May 13 11:50:00 2007
@@ -1,5 +1,5 @@
 /*
- * Copyright (c) 2003-2005 The University of Wroclaw.
+ * Copyright (c) 2003-2007 The University of Wroclaw.
  * All rights reserved.
  *
  * Redistribution and use in source and binary forms, with or without
@@ -570,40 +570,36 @@
                        Inherited = false, AllowMultiple = false)]
   macro Record (par : TypeBuilder, params options : list [PExpr])
   {
-    def instance_flags = BindingFlags.Instance %| BindingFlags.Public %| 
-      BindingFlags.NonPublic %| BindingFlags.DeclaredOnly;
-
     def inclusion_regexs = MacrosHelper.AnalyseNameInclusionPatterns (options);
+    def flds = par.GetFields (MacrosHelper.InstanceFlags).Filter (f =>
+      MacrosHelper.NameMatchesPatterns (f.Name, inclusion_regexs));
+    MacrosHelper.InheritConstructorsAddingFields (par, flds);
+  }
+  
+  module MacrosHelper {
+    public InstanceFlags = BindingFlags.Instance %| BindingFlags.Public %| 
+      BindingFlags.NonPublic %| BindingFlags.DeclaredOnly;
       
+    public InheritConstructorsAddingFields (par : TypeBuilder, flds : list [IField]) : void
+    {
     def make_ctor (is_value_type, base_ctor : IMethod) {
       def (ctor_parms, base_call) =
         if (base_ctor == null)
           ([], if (is_value_type) <[ () ]> else <[ base () ]>)
         else {
-          def pp = base_ctor.GetParameters ();
-          def callparms = List.Map (pp, fun (fp : Fun_parm) {
-            <[ $(fp.name : usesite) ]>
-          });
-          (List.Map (pp, fun (fp : Fun_parm) {
-             <[ parameter: $(fp.name : usesite) : $(fp.ty : typed) ]>
-           }),
+            def callparms = base_ctor.GetHeader ().ParametersReferences;
+            (base_ctor.GetHeader ().ParametersDeclarations, 
            <[ base (..$callparms) ]>)
         };
 
-      def flds = par.GetFields (instance_flags);
-
       def collect (mem : IField, acc) {
-        if (MacrosHelper.NameMatchesPatterns (mem.Name, inclusion_regexs)) {
           def n = Macros.UseSiteSymbol (mem.Name);
           def fp = <[ parameter: $(n : name) : $(mem.GetMemType () : typed) ]>;
           def ex = <[ this.$(n : name) = $(n : name) ]>;
           def (es, ps) = acc;
           (ex :: es, fp :: ps)
-        }
-        else 
-          acc
       };
-      def (assigns, parms) = List.FoldLeft (flds, ([], []), collect);
+        def (assigns, parms) = flds.FoldLeft (([], []), collect);
       
       def body = <[ { ..$(base_call :: assigns) } ]>;
       
@@ -613,35 +609,30 @@
           | _ => NemerleAttributes.Public
         }, custom_attrs = []);
         
-      def parms = List.Append (ctor_parms, List.Rev (parms));
+        def parms = ctor_parms.Append (parms.Reverse ());
       def meth = <[ decl: ..$attrs this (..$parms) $body ]>;
       
       /// we do not try to add empty constructor if it exists
-      if (parms is []) {
-        def existing = par.GetConstructors (instance_flags);
-        unless (List.Exists (existing, fun (x : IMethod) { 
-            x.GetParameters ().IsEmpty
-          }))
+        if (parms.IsEmpty) {
+          def existing = par.GetConstructors (MacrosHelper.InstanceFlags);
+          unless (existing.Exists (c => c.GetParameters ().IsEmpty))
           par.DefineAndReturn (meth).HasBeenUsed = true;          
       }
       else
         par.DefineAndReturn (meth).HasBeenUsed = true;
     };
       
-    match (par.SuperClass ()) {
-      | Some (baseti) when baseti.FullName != "System.ValueType" =>
-        def ctors = baseti.GetConstructors (instance_flags);
-        foreach (x in ctors) make_ctor (false, x)
-
-      // our parent is System.ValueType, so we will not generate any base ctor calls
-      | Some => make_ctor (true, null)
-        
-      | _ => make_ctor (false, null)
+      if (par.IsValueType)
+        make_ctor (true, null)
+      else if (par.BaseType != null) {
+        def ctors = par.BaseType.GetConstructors (MacrosHelper.InstanceFlags);
+        foreach (x in ctors) 
+          make_ctor (false, x)
     }
+      else 
+        make_ctor (false, null)
   }
 
-  
-  module MacrosHelper {
     public AnalyseNameInclusionPatterns (options : list [PT.PExpr]) : Regex * Regex
     {
       mutable inclusion = null;

Modified: nemerle/trunk/ncc/testsuite/positive/ctor-default-param.n
==============================================================================
--- nemerle/trunk/ncc/testsuite/positive/ctor-default-param.n	(original)
+++ nemerle/trunk/ncc/testsuite/positive/ctor-default-param.n	Sun May 13 11:50:00 2007
@@ -5,11 +5,19 @@
   public static Main () : void {
     _ = A();
     _ = A(1);
+    _ = B(5);
   }
 }
+
+[Nemerle.InheritConstructors]
+class B : A {
+  mutable x : string;
+}
+
 /*
 BEGIN-OUTPUT
 3
 1
+5
 END-OUTPUT
 */