[svn] r6187: nemerle/trunk/macros/Profiling.n

[malekith]

Log:
Allow easy disabling of all profiling. Add expression-level profile macro, but it doesn't work, as the profiler structure is output before :/

Author: malekith
Date: Tue Apr 11 13:07:11 2006
New Revision: 6187

Modified:
   nemerle/trunk/macros/Profiling.n

Modified: nemerle/trunk/macros/Profiling.n
==============================================================================
--- nemerle/trunk/macros/Profiling.n	(original)
+++ nemerle/trunk/macros/Profiling.n	Tue Apr 11 13:07:11 2006
@@ -43,6 +43,7 @@
     public mutable static field_names : list [string * string] = [];
     public mutable static class_name : Name = null;
     public mutable static dumper : PExpr = null;
+    public mutable static profiling_enabled = true;
 
     public FinishUp () : void
     {
@@ -100,9 +101,52 @@
         internal class $(class_name : name)
         { }
       ]>;
+
+      if (profiling_enabled) {
       def tc = GlobalEnv.Core.Define (decl);
       fields.Iter (tc.Define);
       tc.Compile ();
+      } else {
+        dumper = <[ () ]>;
+      }
+    }
+
+    public Wrap (full_name : string, body : PExpr) : PExpr
+    {
+      if (!profiling_enabled) body
+      else {
+        def mangled_name = full_name.Replace ('.', '_').Replace (':', '_');
+
+        assert (field_names != null);
+        assert (class_name != null);
+
+        field_names ::= (full_name, mangled_name);
+        
+        def start = <[ $(class_name : name).$(mangled_name + "_start" : dyn) ]>;
+        def total = <[ $(class_name : name).$(mangled_name + "_total" : dyn) ]>;
+        def count_rec = <[ $(class_name : name).$(mangled_name + "_count_rec" : dyn) ]>;
+        def count_nonrec = <[ $(class_name : name).$(mangled_name + "_count_nonrec" : dyn) ]>;
+      
+        <[
+          def started =
+            if ($start == 0) {
+              $start = $get_time;
+              $count_nonrec++;
+              true
+            } else {
+              $count_rec++;
+              false
+            }
+          try {
+            $body;
+          } finally {
+            when (started) {
+              $total += $get_time - $start;
+              $start = 0;
+            }
+          }
+        ]>;
+      }
     }
   }
   
@@ -115,6 +159,10 @@
       | <[ GetTime = $expr ]> => get_time = expr
       | <[ TimeType = $expr ]> => time_type = expr
       | <[ Divisor = $expr ]> => divisor = expr
+      | <[ Enabled = true ]>
+      | <[ Enabled = 1 ]> => profiling_enabled = true
+      | <[ Enabled = false ]>
+      | <[ Enabled = 0 ]> => profiling_enabled = false
       | _ =>
         Message.Error ($ "invalid option $o");
     }
@@ -142,38 +190,23 @@
                        Inherited = false, AllowMultiple = false)]
   macro Profile (current_type : TypeBuilder, method : ParsedMethod)
   {
-    def full_name = current_type.FullName + "." + method.Name;
-    def mangled_name = full_name.Replace ('.', '_');
-
-    assert (field_names != null);
-    assert (class_name != null);
+    method.Body = Wrap (current_type.FullName + "." + method.Name, method.Body)
+  }
 
-    field_names ::= (full_name, mangled_name);
+  macro @profile (id, body)
+    syntax ("profile", "(", id, ")", body)
+  {
+    def id =
+      match (id) {
+        | <[ $(id : dyn) ]> => id
+        | _ =>
+          Message.Error ("the syntax is 'profile (identifier) body'"); 
+          "foobar"
+      }
     
-    def start = <[ $(class_name : name).$(mangled_name + "_start" : dyn) ]>;
-    def total = <[ $(class_name : name).$(mangled_name + "_total" : dyn) ]>;
-    def count_rec = <[ $(class_name : name).$(mangled_name + "_count_rec" : dyn) ]>;
-    def count_nonrec = <[ $(class_name : name).$(mangled_name + "_count_nonrec" : dyn) ]>;
+    def typer = Macros.ImplicitCTX ();
     
-    method.Body = <[
-      def started =
-        if ($start == 0) {
-          $start = $get_time;
-          $count_nonrec++;
-          true
-        } else {
-          $count_rec++;
-          false
-        }
-      try {
-        $(method.Body);
-      } finally {
-        when (started) {
-          $total += $get_time - $start;
-          $start = 0;
+    Wrap (typer.CurrentTypeBuilder.FullName + "." + 
+          typer.CurrentMethodBuilder.Name + ":::" + id, body)
         }
-      }
-    ]>;
-  }
-  
 }