[svn] r6192: nemerle/trunk/ncc: hierarchy/DelegateClassGen.n hierarchy/GlobalEnv.n hierarchy/ScanTypeHiera...

nazgul svnadmin at nemerle.org
Wed Apr 12 20:51:40 CEST 2006


Log:
Extend and embrace - some more class generation capabilities.

Author: nazgul
Date: Wed Apr 12 20:51:35 2006
New Revision: 6192

Modified:
   nemerle/trunk/ncc/hierarchy/DelegateClassGen.n
   nemerle/trunk/ncc/hierarchy/GlobalEnv.n
   nemerle/trunk/ncc/hierarchy/ScanTypeHierarchy.n
   nemerle/trunk/ncc/hierarchy/TypeBuilder.n
   nemerle/trunk/ncc/testsuite/positive/macrolib.n
   nemerle/trunk/ncc/testsuite/positive/macroprog.n
   nemerle/trunk/ncc/typing/Macros.n

Modified: nemerle/trunk/ncc/hierarchy/DelegateClassGen.n
==============================================================================
--- nemerle/trunk/ncc/hierarchy/DelegateClassGen.n	(original)
+++ nemerle/trunk/ncc/hierarchy/DelegateClassGen.n	Wed Apr 12 20:51:35 2006
@@ -40,7 +40,7 @@
      */
     internal GenerateDelegateClass ([NotNull] globenv : GlobalEnv,
                                     parent_type : TypeBuilder,
-                                    attrs : Modifiers, header : Fun_header) : void
+                                    attrs : Modifiers, header : Fun_header) : TypeBuilder
     {
       Util.locate (header.loc, {
         when ((attrs.mods %& ~NemerleAttributes.AccessModifiers) != NemerleAttributes.None)
@@ -82,7 +82,8 @@
           };
 
         td.MarkWithSpecialName ();
-        td.Compile ()
+        td.Compile ();
+        td
       })
     }
   }

Modified: nemerle/trunk/ncc/hierarchy/GlobalEnv.n
==============================================================================
--- nemerle/trunk/ncc/hierarchy/GlobalEnv.n	(original)
+++ nemerle/trunk/ncc/hierarchy/GlobalEnv.n	Wed Apr 12 20:51:35 2006
@@ -148,6 +148,10 @@
     
     public Define (td : PT.ClassMember) : TypeBuilder
     {
+      | PT.ClassMember.TypeDeclaration (Delegate (header)) =>
+        def tb = Delegates.GenerateDelegateClass (this, null, td.modifiers, header);
+        tb
+      
       | PT.ClassMember.TypeDeclaration (td) =>
         def tyinfo = AddType (null, current_namespace, td);
         tyinfo.FixupDefinedClass ();

Modified: nemerle/trunk/ncc/hierarchy/ScanTypeHierarchy.n
==============================================================================
--- nemerle/trunk/ncc/hierarchy/ScanTypeHierarchy.n	(original)
+++ nemerle/trunk/ncc/hierarchy/ScanTypeHierarchy.n	Wed Apr 12 20:51:35 2006
@@ -55,7 +55,7 @@
             MacroClasses.GenerateMacroClass (t, ns_node)
           
           | TopDeclaration.Delegate (header) =>
-            Delegates.GenerateDelegateClass (env, parent, t.modifiers, header)
+            _ = Delegates.GenerateDelegateClass (env, parent, t.modifiers, header)
 
           | _ =>
             def tb = NamespaceTree.AddType (parent, ns_node, t);

Modified: nemerle/trunk/ncc/hierarchy/TypeBuilder.n
==============================================================================
--- nemerle/trunk/ncc/hierarchy/TypeBuilder.n	(original)
+++ nemerle/trunk/ncc/hierarchy/TypeBuilder.n	Wed Apr 12 20:51:35 2006
@@ -472,6 +472,9 @@
    */
   public Define (f : PT.ClassMember) : void
   {
+    | PT.ClassMember.TypeDeclaration (Delegate (header) as td) =>
+      _ = Delegates.GenerateDelegateClass (this.GlobalEnv, this, td.modifiers, header);
+    
     | PT.ClassMember.TypeDeclaration (td) =>
       def tyinfo = NamespaceTree.AddType (this, namespace_nd, td);
       tyinfo.FixupDefinedClass ();
@@ -485,6 +488,8 @@
    */
   public Compile () : void
   { 
+    unless (cannot_finalize) Nemerle.Imperative.Return (); // avoid repeated calls
+    
     cannot_finalize = false;
 
     when (Manager.run_phase >= 5) {

Modified: nemerle/trunk/ncc/testsuite/positive/macrolib.n
==============================================================================
--- nemerle/trunk/ncc/testsuite/positive/macrolib.n	(original)
+++ nemerle/trunk/ncc/testsuite/positive/macrolib.n	Wed Apr 12 20:51:35 2006
@@ -350,13 +350,18 @@
   t.Compile();
 
   def t = ctx.Env.Define(<[ decl:
-    public class GenericGeneratedClass['a]
+    public class GenericGeneratedClass['a] where 'a : System.IComparable ['a]
     {
       public this(_value : 'a) {}
     }
   ]>);
   t.Compile();
   
+  def t = ctx.Env.Define(<[ decl:
+    public delegate GeneratedDelegate(_ : string) : void;
+  ]>);
+  t.Compile();
+    
   <[ () ]>
 }
 

Modified: nemerle/trunk/ncc/testsuite/positive/macroprog.n
==============================================================================
--- nemerle/trunk/ncc/testsuite/positive/macroprog.n	(original)
+++ nemerle/trunk/ncc/testsuite/positive/macroprog.n	Wed Apr 12 20:51:35 2006
@@ -69,6 +69,7 @@
     
     _ = null : IEmpty;
     _ = GenericGeneratedClass(1);
+    _ = null : GeneratedDelegate;
     
     System.Console.WriteLine (ulongLiteral ());
   }

Modified: nemerle/trunk/ncc/typing/Macros.n
==============================================================================
--- nemerle/trunk/ncc/typing/Macros.n	(original)
+++ nemerle/trunk/ncc/typing/Macros.n	Wed Apr 12 20:51:35 2006
@@ -260,8 +260,8 @@
       <[ ( $(name : string), MacroColorizer.Color ) ]>
     }
     def quoted_constr (c : Constraint) {
-      def (name, color) = c.tyvar;
-      <[ Constraint (($(name : string), $(color : int)), $(quoted_expr (c.ty))) ]>
+      def (name, _) = c.tyvar;
+      <[ Constraint (($(name : string), MacroColorizer.Color), $(quoted_expr (c.ty))) ]>
     }
     match (constraints) {
       | [Constraint where (("", _), PExpr.Tuple ([PExpr.Wildcard, PExpr.Ellipsis (PExpr.Spliced (e))]))] =>
@@ -381,31 +381,27 @@
   internal quoted_tydecl (td : TopDeclaration) : PExpr {
     def qn = quoted_sstring (td.name);
     def qattr = quoted_attributes (td.modifiers);
+    def qtparms = if (td.typarms != null) quoted_tparms (td.typarms.tyvars, td.typarms.constraints) else <[ null ]>;
     
     match (td) {
-      | TopDeclaration.Class ( typarms = tprms, t_extends = extend, decls = members) =>
-        def qtparms = quoted_tparms (tprms.tyvars, tprms.constraints);
+      | TopDeclaration.Class ( t_extends = extend, decls = members) =>
         def qexten = Lift (extend, quoted_expr);        
         def qmems = lift_members (members);
                           
         <[ TopDeclaration.Class (name = $qn, modifiers = $qattr, t_extends = $qexten,
                      typarms = $qtparms, decls = $qmems) ]>
 
-      | TopDeclaration.Alias ( typarms = tprms, ty = t) =>
-        def qtparms = quoted_tparms (tprms.tyvars, tprms.constraints);                
-        <[ TopDeclaration.Alias (name = $qn, modifiers = $qattr,
-                     typarms = $qtparms, ty = $(quoted_expr (t))) ]>
+      | TopDeclaration.Alias ( ty = t) =>
+        <[ TopDeclaration.Alias (name = $qn, modifiers = $qattr, typarms = $qtparms, ty = $(quoted_expr (t))) ]>
         
-      | TopDeclaration.Interface (typarms = tprms, t_extends = extend, methods = members) =>
-        def qtparms = quoted_tparms (tprms.tyvars, tprms.constraints);
+      | TopDeclaration.Interface (t_extends = extend, methods = members) =>
         def qexten = Lift (extend, quoted_expr);        
         def qmems = lift_members (members);
                           
         <[ TopDeclaration.Interface (name = $qn, modifiers = $qattr, t_extends = $qexten,
                      typarms = $qtparms, methods = $qmems) ]>
                      
-      | TopDeclaration.Variant (typarms = tprms, t_extends = extend, decls = members) =>
-        def qtparms = quoted_tparms (tprms.tyvars, tprms.constraints);
+      | TopDeclaration.Variant (t_extends = extend, decls = members) =>
         def qexten = Lift (extend, quoted_expr);          
         def qmems = lift_members (members);
                           
@@ -415,10 +411,23 @@
       | TopDeclaration.VariantOption (decls = members) =>
         def qmems = lift_members (members);
                           
-        <[ TopDeclaration.VariantOption (name = $qn, modifiers = $qattr, decls = $qmems) ]>
+        <[ TopDeclaration.VariantOption (name = $qn, modifiers = $qattr, typarms = $qtparms, decls = $qmems) ]>
 
-      | _ =>
-        Util.ice ("this quotation is not supported yet")
+      | TopDeclaration.Enum (t_extends = extend, decls = members) =>
+        def qexten = Lift (extend, quoted_expr);          
+        def qmems = lift_members (members);
+                          
+        <[ TopDeclaration.Enum (name = $qn, modifiers = $qattr, t_extends = $qexten,
+                                typarms = $qtparms, decls = $qmems) ]>
+        
+      | TopDeclaration.Delegate (hea) =>
+        def qhtparms = quoted_tparms (hea.typarms.tyvars, hea.typarms.constraints);
+        def qhd = make_quoted_funheader (hea.parms, qhtparms, hea.ret_type, quoted_sstring (hea.name));
+
+        <[ TopDeclaration.Delegate (name = $qn, modifiers = $qattr, typarms = $qtparms, header = $qhd) ]>
+
+      | TopDeclaration.Macro =>
+        Message.FatalError ("quoting macro is not supported - macros should not create macros, it is Bad(TM)");
     }
   }
 



More information about the svn mailing list