[svn] r6808: nemerle/trunk/ncc: hierarchy/TypeBuilder.n hierarchy/TypesManager.n misc/PrettyPrint.n parsin...

nazgul svnadmin at nemerle.org
Sun Oct 29 21:45:50 CET 2006


Log:
Add functionality of generating faked source of programatically defined members

Author: nazgul
Date: Sun Oct 29 21:45:34 2006
New Revision: 6808

Modified:
   nemerle/trunk/ncc/hierarchy/TypeBuilder.n
   nemerle/trunk/ncc/hierarchy/TypesManager.n
   nemerle/trunk/ncc/misc/PrettyPrint.n
   nemerle/trunk/ncc/parsing/ParseTree.n

Modified: nemerle/trunk/ncc/hierarchy/TypeBuilder.n
==============================================================================
--- nemerle/trunk/ncc/hierarchy/TypeBuilder.n	(original)
+++ nemerle/trunk/ncc/hierarchy/TypeBuilder.n	Sun Oct 29 21:45:34 2006
@@ -452,30 +452,38 @@
     }
   }
 
-
-  public Define (f : PT.ClassMember) : void
-  {
-    Define (f, true)
-  }
-
-  /**
-   * Adds a definition to this type
-   */
-  public Define (f : PT.ClassMember, do_fixup : bool) : void
+  public DefineAndReturn (f : PT.ClassMember, do_fixup : bool) : MemberBuilder
   {
     match (f) {
       | PT.ClassMember.TypeDeclaration (Delegate (header) as td) =>
         _ = Delegates.GenerateDelegateClass (this.GlobalEnv, this, td.modifiers, header);
+        null
     
       | PT.ClassMember.TypeDeclaration (td) =>
         def tyinfo = Manager.NameTree.AddType (this, namespace_nd, td);
         when (do_fixup)
           tyinfo.FixupDefinedClass ();
+        null
 
-      | _ => ignore (DefineAndReturn (f))
+      | _ => DefineAndReturn (f)
     }
   }
 
+  public DefineWithSource (f : PT.ClassMember, do_fixup = true) : MemberBuilder
+  {
+    TyManager.GenerateFakeSourceCode (f);
+    DefineAndReturn (f, do_fixup)
+  }
+
+  public Define (f : PT.ClassMember) : void
+  { Define (f, true) }
+
+  /**
+   * Adds a definition to this type
+   */
+  public Define (f : PT.ClassMember, do_fixup : bool) : void
+  { _ = DefineAndReturn (f, do_fixup) }
+
 
   /**
    * Builds this type

Modified: nemerle/trunk/ncc/hierarchy/TypesManager.n
==============================================================================
--- nemerle/trunk/ncc/hierarchy/TypesManager.n	(original)
+++ nemerle/trunk/ncc/hierarchy/TypesManager.n	Sun Oct 29 21:45:34 2006
@@ -39,6 +39,10 @@
     mutable assembly_attributes : SCG.List [GlobalEnv * Parsetree.PExpr] = SCG.List();
     internal mutable run_phase : int;
 
+    // used to create fake source code for macro generated expressions
+    mutable generatedSourceCode : LocatingTextWriter;
+    mutable generatedSourceLocation : Location;
+    
     attribute_macros_queue : Nemerle.Collections.Heap [AttributeMacroExpansion] = Nemerle.Collections.Heap (100);
 
     [Record (Exclude = [AddedNr])]
@@ -333,6 +337,20 @@
       Iter (check_method_implements);
 
       Iter (fun (x : TypeBuilder) { x.check_ctor_constraints () });
+      
+      when (generatedSourceCode != null) 
+        try {
+          using (genSrcFile = System.IO.StreamWriter (nameOfGeneratedSourceFile ()))
+            genSrcFile.Write (generatedSourceCode.ToString ());
+        }
+        catch {
+          | e => Message.Warning ("could not save generated source code file: " + e.Message)
+        }
+    }
+
+    private nameOfGeneratedSourceFile () : string {
+      System.IO.Path.Combine (System.IO.Path.GetDirectoryName(System.IO.Path.GetFullPath (Manager.Options.OutputFileName)),
+        "_N_GeneratedSource_" + System.IO.Path.GetFileNameWithoutExtension (Manager.Options.OutputFileName) + ".n")
     }
 
     /** Called at the end of the finialization. */
@@ -357,5 +375,19 @@
         when (Manager.Options.Warnings.IsEnabled (10003) || Manager.Options.Warnings.IsEnabled (649))
         Iter (_.check_for_unused_global_symbols ())
     }
+    
+    public GenerateFakeSourceCode (mem : Parsetree.ClassMember) : void
+    {
+      when (generatedSourceCode == null)
+        generatedSourceCode = LocatingTextWriter (System.Text.StringBuilder (), 
+          Location (nameOfGeneratedSourceFile (), 1, 1, 1, 1));
+          
+      def begin_loc = generatedSourceCode.Loc;
+      generatedSourceCode.Write (mem.ToString ());
+      generatedSourceCode.FetchUpdatedLocation (mem, begin_loc);
+      generatedSourceCode.Write ("\n");
+      mem.PrintBody (generatedSourceCode);
+      generatedSourceCode.Write ("\n\n");
+    }
   }
 }

Modified: nemerle/trunk/ncc/misc/PrettyPrint.n
==============================================================================
--- nemerle/trunk/ncc/misc/PrettyPrint.n	(original)
+++ nemerle/trunk/ncc/misc/PrettyPrint.n	Sun Oct 29 21:45:34 2006
@@ -50,11 +50,9 @@
     /* -- PARSE TREE ---------------------------------------------------------- */
     /* ------------------------------------------------------------------------ */
     
-    SprintExpr (ctx : option[Typer], expr : PExpr, indentation : string,
-                acc : StringBuilder) : void 
+    internal SprintExpr (ctx : option[Typer], expr : PExpr, indentation : string,
+                acc : LocatableTextWriter) : void 
     {
-      def add (x : string) { ignore (acc.Append (x)) };
-    
       def expr = 
         match (ctx) {
           | Some (c) => MacroRegistry.expand_macro (c, expr) [0]
@@ -64,69 +62,71 @@
       def print_tconstraints (cts : list [Constraint]) {
         | [] => ()
         | x :: xs =>
-          add ($"where $(x.tyvar) : ");
+          acc.Write ($"where $(x.tyvar) : ");
           SprintExpr (ctx, x.ty, indentation, acc);
           print_tconstraints (xs)
       };
 
       def print_funparm (p : Fun_parm) {
         | <[ parameter: $(n : name) : $ty ]> =>
-          add (n.Id + " : ");
+          acc.Write (n.Id + " : ");
           SprintExpr (ctx, ty, indentation, acc)
 
         | <[ parameter: params $(n : name) : $ty ]> =>
-          add (sprintf ("params %s : ", n.Id));
+          acc.Write (sprintf ("params %s : ", n.Id));
           SprintExpr (ctx, ty, indentation, acc)
 
         | <[ parameter: $(n : name) : $ty = $expr ]> =>
-          add (sprintf ("params %s : ", n.Id));
+          acc.Write (sprintf ("params %s : ", n.Id));
           SprintExpr (ctx, ty, indentation, acc);
-          add (" = ");
+          acc.Write (" = ");
           SprintExpr (ctx, expr, indentation, acc)
 
-        | _ => add ("spliced funparm name")
+        | _ => acc.Write ("spliced funparm name")
       };
      
       def print_funparms (fps) {
-        NString.SeparatedCalls (", ", fps, print_funparm, acc)
+        SeparatedCalls (", ", fps, print_funparm, acc)
       };
 
       def sprint_ss (x) {
-        if (x == null) add ("(NULL-MEM)") else
+        if (x == null) acc.Write ("(NULL-MEM)") else
         match (x) {
-          | Splicable.Name (n) => add (n.Id);
+          | Splicable.Name (n) => acc.Write (n.Id);
           #if PRINT_COLOR
-          add ("."); add (n.color.ToString ());
+          acc.Write ("."); acc.Write (n.color.ToString ());
           #endif
           | Splicable.Expression (e) =>
-            add ("$(");
+            acc.Write ("$(");
             SprintExpr (ctx, e, indentation, acc);
-            add (")");
+            acc.Write (")");
           | Splicable.HalfId (n) =>
-            add (n.Id + "<COMPL>");
+            acc.Write (n.Id + "<COMPL>");
         }
       }
 
-      if (expr == null) add ("(NULL)") else
+      def begin_loc = acc.Loc;
+      
+      if (expr == null) acc.Write ("(NULL)") else
       match (expr) {
         | <[ $(n : name) ]> =>
-          add (n.Id);
+          acc.Write (n.Id);
           #if PRINT_COLOR
-          add ("."); add (n.color.ToString ());
+          acc.Write ("."); acc.Write (n.color.ToString ());
           #endif
 
         | <[ $obj . $mem ]> => 
-          SprintExpr (ctx, obj, indentation, acc); add ("."); sprint_ss (mem)
+          SprintExpr (ctx, obj, indentation, acc); acc.Write ("."); sprint_ss (mem)
 
         | <[ $x :: $xs ]> =>
           SprintExpr (ctx, x, indentation, acc);  
-          add (" :: "); SprintExpr (ctx, xs, indentation, acc)
+          acc.Write (" :: "); SprintExpr (ctx, xs, indentation, acc)
 
         | <[ $func (.. $parms) ]> =>
           def print_parm (p : PExpr) {
             match (p) {
               | <[ $(n : name) = $expr ]> =>
-                add (n.Id + " = ");
+                acc.Write (n.Id + " = ");
                 SprintExpr (ctx, expr, indentation + "  ", acc)
               | _ =>
                 SprintExpr (ctx, p, indentation + "  ", acc)
@@ -134,222 +134,222 @@
           };
           match ((func, parms)) {
             | (<[ $(x : name) ]>, [e]) when LexerBase.IsOperator (x.Id) =>
-              add (x.Id);
+              acc.Write (x.Id);
               print_parm (e)
 
             | (<[ $(x : name) ]>, [e1, e2]) when LexerBase.IsOperator (x.Id) =>
               print_parm (e1);
-              add (" " + x.Id + " ");
+              acc.Write (" " + x.Id + " ");
               print_parm (e2);            
 
             | _ =>
-              SprintExpr (ctx, func, indentation, acc); add (" (");
-              NString.SeparatedCalls (", ", parms, print_parm, acc);             
-              add (")");
+              SprintExpr (ctx, func, indentation, acc); acc.Write (" (");
+              SeparatedCalls (", ", parms, print_parm, acc);             
+              acc.Write (")");
           }
 
         | <[ $target = $source ]> =>
-          SprintExpr (ctx, target, indentation, acc); add (" = ");
+          SprintExpr (ctx, target, indentation, acc); acc.Write (" = ");
           SprintExpr (ctx, source, indentation, acc);
 
         | <[ def $n = $val ]> =>
-          add ("def "); SprintExpr (ctx, n, indentation, acc);
-          add (" = "); SprintExpr (ctx, val, indentation, acc)
+          acc.Write ("def "); SprintExpr (ctx, n, indentation, acc);
+          acc.Write (" = "); SprintExpr (ctx, val, indentation, acc)
 
         | <[ mutable $n = $val ]> =>
-          add ("mutable "); SprintExpr (ctx, n, indentation, acc);
-          add (" = "); SprintExpr (ctx, val, indentation, acc)
+          acc.Write ("mutable "); SprintExpr (ctx, n, indentation, acc);
+          acc.Write (" = "); SprintExpr (ctx, val, indentation, acc)
 
         | <[ $expr :> $ty ]> =>
-          add ("("); SprintExpr (ctx, expr, indentation, acc); add (" :> ");
-          SprintExpr (ctx, ty, indentation, acc); add (")");
+          acc.Write ("("); SprintExpr (ctx, expr, indentation, acc); acc.Write (" :> ");
+          SprintExpr (ctx, ty, indentation, acc); acc.Write (")");
 
         | <[ $expr is $ty ]> =>
-          add ("("); SprintExpr (ctx, expr, indentation, acc);
-          add (" is "); SprintExpr (ctx, ty, indentation, acc); add (")")
+          acc.Write ("("); SprintExpr (ctx, expr, indentation, acc);
+          acc.Write (" is "); SprintExpr (ctx, ty, indentation, acc); acc.Write (")")
 
         | <[ $e1 where $e2 ]> =>
           SprintExpr (ctx, e1, indentation, acc);
-          add (" where "); SprintExpr (ctx, e2, indentation, acc)
+          acc.Write (" where "); SprintExpr (ctx, e2, indentation, acc)
         
         | <[ ( $expr : $ty ) ]> =>
-          add ("("); SprintExpr (ctx, expr, indentation, acc);
-          add (" : "); SprintExpr (ctx, ty, indentation, acc); add (")")
+          acc.Write ("("); SprintExpr (ctx, expr, indentation, acc);
+          acc.Write (" : "); SprintExpr (ctx, ty, indentation, acc); acc.Write (")")
         
         | PExpr.TypedPattern => ()
         | PExpr.TypedType => ()
         | PExpr.As  => ()
 
         | <[ [..$elems] ]> =>
-          add ("[");
-          NString.SeparatedCalls (", ", elems, fun (x) { 
+          acc.Write ("[");
+          SeparatedCalls (", ", elems, fun (x) { 
             SprintExpr (ctx, x, indentation + " ", acc); 
           }, acc);
-          add ("]");
+          acc.Write ("]");
           
         | <[ match ($expr) {.. $cases } ]> =>
           def print_case (c : MatchCase) {
             def <[ case: | ..$guards => $expr ]> = c;
             foreach (g in guards) {
-              add (sprintf ("\n%s| ", indentation + "  "));
+              acc.Write (sprintf ("\n%s| ", indentation + "  "));
               SprintExpr (ctx, g, indentation, acc);
             }
-            add (sprintf (" => \n%s", indentation + "    "));
+            acc.Write (sprintf (" => \n%s", indentation + "    "));
             SprintExpr (ctx, expr, indentation + "    ", acc)
           };
 
-          add ("match ("); 
-          SprintExpr (ctx, expr, indentation, acc); add (") {");
+          acc.Write ("match ("); 
+          SprintExpr (ctx, expr, indentation, acc); acc.Write (") {");
           List.Iter (cases, print_case);
-          add (sprintf ("\n%s}", indentation))
+          acc.Write (sprintf ("\n%s}", indentation))
 
         | <[ throw $exc ]> =>
-          add ("throw "); SprintExpr (ctx, exc, indentation, acc);
+          acc.Write ("throw "); SprintExpr (ctx, exc, indentation, acc);
 
         | PExpr.TryFinally (body, handler) =>
-          add (sprintf ("try {\n%s  ", indentation));
+          acc.Write (sprintf ("try {\n%s  ", indentation));
           SprintExpr (ctx, body, indentation + "  ", acc);
-          add (sprintf ("\n%s}\n%sfinally {\n%s  ", indentation, indentation, indentation));
+          acc.Write (sprintf ("\n%s}\n%sfinally {\n%s  ", indentation, indentation, indentation));
           SprintExpr (ctx, handler, indentation + "  ", acc);
-          add (sprintf ("\n%s}", indentation));
+          acc.Write (sprintf ("\n%s}", indentation));
 
         | PExpr.Try (body, cases) =>
-          add (sprintf ("try {\n%s  ", indentation));
+          acc.Write (sprintf ("try {\n%s  ", indentation));
           SprintExpr (ctx, body, indentation + "  ", acc);
-          add (sprintf ("\n%s}\n%scatch {", indentation, indentation));
+          acc.Write (sprintf ("\n%s}\n%scatch {", indentation, indentation));
           def print_case (case) {
             | TryCase.Catch (exn, exn_ty, handler) =>
-              add (sprintf ("\n%s", indentation + "  "));
-              sprint_ss (exn); add (" is ");
+              acc.Write (sprintf ("\n%s", indentation + "  "));
+              sprint_ss (exn); acc.Write (" is ");
               SprintExpr (ctx, exn_ty, indentation, acc);
-              add (sprintf ("=>\n%s", indentation + "    "));
+              acc.Write (sprintf ("=>\n%s", indentation + "    "));
               SprintExpr (ctx, handler, indentation + "    ", acc);
             | TryCase.Filter (exn, exn_ty, filter, handler) =>
-              add (sprintf ("\n%s", indentation + "  "));
-              sprint_ss (exn); add (" is ");
+              acc.Write (sprintf ("\n%s", indentation + "  "));
+              sprint_ss (exn); acc.Write (" is ");
               SprintExpr (ctx, exn_ty, indentation, acc);
-              add (" when (");
+              acc.Write (" when (");
               SprintExpr (ctx, filter, indentation, acc);
-              add (") ");
-              add (sprintf ("=>\n%s", indentation + "    "));
+              acc.Write (") ");
+              acc.Write (sprintf ("=>\n%s", indentation + "    "));
               SprintExpr (ctx, handler, indentation + "    ", acc);
             | TryCase.Ellipsis (e) =>
-              add (sprintf ("\n%s", indentation + "  "));
+              acc.Write (sprintf ("\n%s", indentation + "  "));
               SprintExpr (ctx, e, indentation + "  ", acc);
           }
           foreach (case in cases)
             print_case (case);
-          add (sprintf ("\n%s}", indentation));
+          acc.Write (sprintf ("\n%s}", indentation));
 
-        | PExpr.Literal (lit) => add (lit.ToString ())
+        | PExpr.Literal (lit) => acc.Write (lit.ToString ())
 
-        | <[ this ]> => add ("this")
+        | <[ this ]> => acc.Write ("this")
 
-        | <[ base ]> => add ("base")
+        | <[ base ]> => acc.Write ("base")
 
         | <[ typeof ($t) ]> =>
-          add ("typeof ("); SprintExpr (ctx, t, indentation, acc); add (")")
+          acc.Write ("typeof ("); SprintExpr (ctx, t, indentation, acc); acc.Write (")")
 
         | <[ {.. $seq } ]> =>
           match (seq) {
             | [e] =>
               SprintExpr (ctx, e, indentation, acc)
             | _ =>
-              add ("{");
-              NString.SeparatedCalls (";", seq, fun (x) { 
-                add (sprintf ("\n%s", indentation + "  ")); 
+              acc.Write ("{");
+              SeparatedCalls (";", seq, fun (x) { 
+                acc.Write (sprintf ("\n%s", indentation + "  ")); 
                 SprintExpr (ctx, x, indentation + "  ", acc); 
               }, acc);
-              add (sprintf ("\n%s}", indentation))
+              acc.Write (sprintf ("\n%s}", indentation))
           }
 
         | <[ (.. $args) ]> =>
-          add ("(");
-          NString.SeparatedCalls (", ", args, fun (x) { 
+          acc.Write ("(");
+          SeparatedCalls (", ", args, fun (x) { 
             SprintExpr (ctx, x, indentation, acc) 
           }, acc);
-          add (")")
+          acc.Write (")")
 
         | <[ array (..$args) ]> =>
-          add ("array (");
-          NString.SeparatedCalls (", ", args, fun (x) { 
+          acc.Write ("array (");
+          SeparatedCalls (", ", args, fun (x) { 
             SprintExpr (ctx, x, indentation, acc) 
           }, acc);
 
-        | <[ ref $e ]> => add ("ref "); SprintExpr (ctx, e, indentation, acc)
+        | <[ ref $e ]> => acc.Write ("ref "); SprintExpr (ctx, e, indentation, acc)
 
-        | <[ out $e ]> => add ("ref "); SprintExpr (ctx, e, indentation, acc)
+        | <[ out $e ]> => acc.Write ("out "); SprintExpr (ctx, e, indentation, acc)
 
         | <[ array $args ]> =>
-          add ("array ");
+          acc.Write ("array ");
           SprintExpr (ctx, args, indentation, acc);
 
         | <[ array .[ $rank ] $args ]> =>
-          add ("array .[");
+          acc.Write ("array .[");
           SprintExpr (ctx, rank, indentation, acc);
-          add ("] ");
+          acc.Write ("] ");
           SprintExpr (ctx, args, indentation, acc);
 
         | <[ $obj .[..$args] ]> =>
           SprintExpr (ctx, obj, indentation, acc);
-          add (".[");
-          NString.SeparatedCalls (", ", args, fun (x) { 
+          acc.Write (".[");
+          SeparatedCalls (", ", args, fun (x) { 
             SprintExpr (ctx, x, indentation, acc) 
           }, acc);
-          add ("]")
+          acc.Write ("]")
           
         | <[ $obj [.. $args] ]> =>
           SprintExpr (ctx, obj, indentation, acc);
-          add ("[");
-          NString.SeparatedCalls (", ", args, fun (x) { 
+          acc.Write ("[");
+          SeparatedCalls (", ", args, fun (x) { 
             SprintExpr (ctx, x, indentation, acc) 
           }, acc);
-          add ("]")
+          acc.Write ("]")
 
         | PExpr.Lambda (fd) =>
-          add ("fun "); add (fd.header.typarms.tyvars.ToString ());
-          add (" ("); print_funparms (fd.header.parms); add (") ");
-          add (": "); SprintExpr (ctx, fd.header.ret_type, indentation, acc); add (" ");
-          print_tconstraints (fd.header.typarms.constraints); add (" ");
+          acc.Write ("fun "); acc.Write (fd.header.typarms.tyvars.ToString ());
+          acc.Write (" ("); print_funparms (fd.header.parms); acc.Write (") ");
+          acc.Write (": "); SprintExpr (ctx, fd.header.ret_type, indentation, acc); acc.Write (" ");
+          print_tconstraints (fd.header.typarms.constraints); acc.Write (" ");
           SprintExpr (ctx, fd.body, indentation, acc)
 
         | <[ def ..$funs ]> =>
           def print_fun (f : Function_decl) {
             | <[ fundecl: $(n : name) [ ..$tparms] (..$args)
                  where .. $tconstrs $body ]> =>
-              add (n.Id); add (" "); add (tparms.ToString ());
-              add (" ("); print_funparms (args); add (") ");
-              print_tconstraints (tconstrs); add (" ");
+              acc.Write (n.Id); acc.Write (" "); acc.Write (tparms.ToString ());
+              acc.Write (" ("); print_funparms (args); acc.Write (") ");
+              print_tconstraints (tconstrs); acc.Write (" ");
               SprintExpr (ctx, body, indentation, acc)
-            | _ => add ("spliced fun name")
+            | _ => acc.Write ("spliced fun name")
           };
         
-          add ("def ");
-          NString.SeparatedCalls ("\nand ", funs, print_fun, acc)
+          acc.Write ("def ");
+          SeparatedCalls ("\nand ", funs, print_fun, acc)
 
-        | PExpr.Wildcard => add ("_ ");
+        | PExpr.Wildcard => acc.Write ("_ ");
 
-        | PExpr.Void => add ("void ");
+        | PExpr.Void => acc.Write ("void ");
 
         | PExpr.MacroCall (_, namespc, parms) =>
           match (namespc.Value) {
             | NamespaceTree.TypeInfoCache.MacroCall (m) =>
               def (rules, _) = m.SyntaxExtension ();
               mutable parms_left = parms;
-              add (rules.ToString () + " ");
+              acc.Write (rules.ToString () + " ");
               def rules = rules.Next;
 
               def print_gel (x) {
                 match (x) {
-                  | GrammarElement.Keyword (k) => add (" "); add (k); add (" ")
-                  | GrammarElement.Operator (")") => add (") ")
-                  | GrammarElement.Operator ("}") => add ("} ")                
-                  | GrammarElement.Operator (o) => add (o)
+                  | GrammarElement.Keyword (k) => acc.Write (" "); acc.Write (k); acc.Write (" ")
+                  | GrammarElement.Operator (")") => acc.Write (") ")
+                  | GrammarElement.Operator ("}") => acc.Write ("} ")                
+                  | GrammarElement.Operator (o) => acc.Write (o)
                   | GrammarElement.Optional (g) => print_gel (g)
                   | GrammarElement.RawToken => 
                     match (parms_left) {
                       | SyntaxElement.RawToken (t) :: xs =>
-                        add (t.ToString ());
+                        acc.Write (t.ToString ());
                         parms_left = xs;
                       | _ =>
                         Message.Error ("expected raw token as parameter of macro "
@@ -377,7 +377,7 @@
                     };
 
                   | GrammarElement.ExpressionList =>
-                    NString.SeparatedCalls (", ", parms_left, fun (_) {
+                    SeparatedCalls (", ", parms_left, fun (_) {
                       | SyntaxElement.Expression (e) => SprintExpr (ctx, e, indentation, acc)
                       | _ =>
                         Message.Error ("expected expression in macro parameters: "
@@ -390,33 +390,38 @@
                   print_gel (x.Next)
               };
               print_gel (rules);
-            | _ => add ("macro_call")
+            | _ => acc.Write ("macro_call")
           }
 
         | PExpr.ToComplete (n) =>
-          add (n.Id + "<COMPL>");
+          acc.Write (n.Id + "<COMPL>");
 
         | PExpr.Spliced (e) =>
-          add ("$("); SprintExpr (ctx, e, indentation, acc); add (")");
+          acc.Write ("$("); SprintExpr (ctx, e, indentation, acc); acc.Write (")");
 
         | PExpr.Ellipsis (e) =>
-          add (".."); SprintExpr (ctx, e, indentation, acc); 
+          acc.Write (".."); SprintExpr (ctx, e, indentation, acc); 
 
         | PExpr.Quoted (quot) =>
-          add ("<[ ");
-          add (quot.ToString ());
-          add (" ]>");
-
-        | PExpr.Typed (e) => SprintTyExpr (ctx, e, None (), false, indentation, acc)
+          acc.Write ("<[ ");
+          acc.Write (quot.ToString ());
+          acc.Write (" ]>");
+
+        | PExpr.Typed (e) => 
+          def pos = acc.Sbuilder.Length;
+          SprintTyExpr (ctx, e, None (), false, indentation, acc.Sbuilder);
+          acc.MoveLocation (pos);
 
         | PExpr.Error => ()
       }
+      
+      acc.FetchUpdatedLocation (expr, begin_loc);
     }
 
     [Nemerle.Assertions.Ensures (value != null)]
     public SprintExpr (ctx : option[Typer], expr : PExpr) : string
     {
-      def result = StringBuilder ();
+      def result = LocatableTextWriter (StringBuilder());
       SprintExpr (ctx, expr, "", result);
       result.ToString ()    
     }
@@ -427,6 +432,18 @@
     }
 
 
+    SeparatedCalls ['a] (sep : string, l : list ['a], f : 'a -> void,
+                         acc : LocatableTextWriter) : void
+    {
+      def loop (l)
+      {
+        | [x] => f (x)
+        | x :: xs => f (x); acc.Write (sep); loop (xs)
+        | [] => ()
+      }
+      loop (l)
+    }    
+    
     /* ------------------------------------------------------------------------ */
     /* -- TYPED TREE ---------------------------------------------------------- */
     /* ------------------------------------------------------------------------ */
@@ -1316,6 +1333,64 @@
       result.ToString ()
     }
   }
+  
+  [Record]
+  class LocatableTextWriter {
+    [Nemerle.Utility.Accessor]
+    protected sbuilder : StringBuilder;  
+    
+    public virtual Loc : Location {
+      get { Location.Default }   
+    }
+    
+    public virtual Write (txt : string) : void {
+      _ = sbuilder.Append (txt);
+    }
+    
+    public virtual FetchUpdatedLocation (_entity : Located, _begin_loc : Location) : void
+    {}
+    public virtual MoveLocation (_from_position : int) : void
+    {}
+    
+    public override ToString () : string {
+      sbuilder.ToString ();   
+    }
+  }
+  
+  [Record]
+  class LocatingTextWriter : LocatableTextWriter {
+    [Nemerle.Utility.Accessor (flags = Override)]      
+    mutable loc : Location;
+    
+    public override Write (txt : string) : void {
+      moveLoc (txt);
+      base.Write (txt);
+    }
+
+    private moveLoc (txt : string) : void {
+      mutable line = loc.Line;
+      mutable col = loc.Column;
+      for (mutable i = 0; i < txt.Length; i++)
+        match (txt[i]) {
+          | '\n' => line++; col = 1;
+          | '\r' when i+1<txt.Length && txt[i+1] != '\n' => line++; col = 1;
+          | _ => col++;
+        }
+      loc = Location (loc.FileIndex, line, col);
+    }
+    
+    public override MoveLocation (from_position : int) : void
+    {
+      when (from_position != sbuilder.Length)
+        moveLoc (sbuilder.ToString (from_position, sbuilder.Length - from_position));
+    }
+        
+    public override FetchUpdatedLocation (entity : Located, begin_loc : Location) : void
+    {
+      when (entity != null)
+        entity.loc = begin_loc + loc;   
+    }
+  }
 }
 
 /*** END OF FILE ***/

Modified: nemerle/trunk/ncc/parsing/ParseTree.n
==============================================================================
--- nemerle/trunk/ncc/parsing/ParseTree.n	(original)
+++ nemerle/trunk/ncc/parsing/ParseTree.n	Sun Oct 29 21:45:34 2006
@@ -131,6 +131,19 @@
 
     public IsMutable () : bool { modifiers.mods %&& NemerleAttributes.Mutable }
 
+    internal PrintBody (writer : LocatableTextWriter) : void
+    {
+      match (this) {
+        | Function (body = bd) =>
+          match (bd) {
+              | FunBody.Parsed (expr) => 
+                PrettyPrint.SprintExpr (None(), expr, "", writer);
+              | _ => ()
+          }
+        | _ => ()
+      }
+    }
+    
     public override ToString() : string
     {
       def attrs1 = Attributes.ToString().ToLower().Replace(",", "");



More information about the svn mailing list