Sync-ze m3-tools--m3tk with v5.11.9-ZZYYXX-20231103_07-01

VictorMiasnikov · Feb 19, 2024 · 19942d1 · 19942d1
1 parent abffcf0
commit 19942d1
Show file tree

Hide file tree

Showing 6 changed files with 40 additions and 2 deletions.
diff --git a/m3-tools/m3tk/src/fe/M3CGoList.i3 b/m3-tools/m3tk/src/fe/M3CGoList.i3
@@ -20,7 +20,7 @@ INTERFACE M3CGoList;
 (***************************************************************************)
 
 IMPORT M3AST_AS;
-IMPORT M3CUnit, M3Context, M3Conventions;
+IMPORT M3CUnit, M3Context, M3Conventions, Rd;
 
 PROCEDURE CompileUnitsInContext(
     VAR (*inout*) context: M3Context.T;
@@ -91,4 +91,15 @@ called in the order that they were added. *)
 PROCEDURE RemoveNotification(e: Notification) RAISES {};
 (* Remove notification "e". *)
 
+TYPE
+  Streamer <: Streamer_public;
+  Streamer_public = OBJECT
+  METHODS
+    getStream(
+      cu: M3AST_AS.Compilation_Unit;
+      VAR stream : Rd.T);
+  END;
+
+PROCEDURE SetStreamer(s: Streamer) RAISES {};
+
 END M3CGoList.
diff --git a/m3-tools/m3tk/src/fe/M3CGoList.m3 b/m3-tools/m3tk/src/fe/M3CGoList.m3
@@ -109,6 +109,14 @@ PROCEDURE Notify(
     END;
   END Notify;
 
+REVEAL Streamer = Streamer_public BRANDED OBJECT END;
+VAR streamer_g: Streamer := NIL;
+
+PROCEDURE SetStreamer(s: Streamer) RAISES {}=
+  BEGIN
+    streamer_g := s;
+  END SetStreamer;
+
 (***************************************************************************)
 (*                            Error handling                               *)
 (***************************************************************************)
@@ -396,6 +404,10 @@ PROCEDURE UnpickleOrCompileSource(
 
       IF uf = M3CUnit.Form.Source THEN        (* needs compiling from source *)
         saveErrCuList := InitErrorObserver(cd.en, cu);
+        IF streamer_g # NIL THEN
+          (* overwrite stream *)
+          streamer_g.getStream(cu,stream);
+        END;
         M3CGo.CompileUnit(cu, context, stream, FindUnpickleOrCompileSource,
             cd.phases, compTime, cd.headerOnly);
         <*FATAL Rd.Failure, Thread.Alerted*> BEGIN

diff --git a/m3-tools/m3tk/src/toolframe/M3PathTool.i3 b/m3-tools/m3tk/src/toolframe/M3PathTool.i3
@@ -4,7 +4,7 @@
 
 INTERFACE M3PathTool;
 
-IMPORT M3Extension, M3FindFile;
+IMPORT M3Extension, M3FindFile, M3Args;
 
 (* This tool provides control over the search path used by an "M3TK"
 application. The "Define_Arg" and "TFile_Arg" arguments are "prefix"
@@ -54,4 +54,7 @@ PROCEDURE Check(exts := M3Extension.All): M3FindFile.T;
 (* Check for the tool arguments, set up the search path accordingly,
 and return a finder for the given set of extensions. *)
 
+PROCEDURE GetTool() : M3Args.T;
+(* return the tool handle *)
+
 END M3PathTool.
diff --git a/m3-tools/m3tk/src/toolframe/M3PathTool.m3 b/m3-tools/m3tk/src/toolframe/M3PathTool.m3
@@ -106,6 +106,11 @@ PROCEDURE ErrorProc(<*UNUSED*> t: ErrorHandler; dir: M3PathElem.T;
     RETURN TRUE;
   END ErrorProc;
 
+PROCEDURE GetTool() : M3Args.T =
+  BEGIN
+    RETURN tool_g;
+  END GetTool;
+
 BEGIN
   M3Args.RegisterPrefix(tool_g, Define_Arg,
     "specify an explicit path to be used for file searching");

diff --git a/m3-tools/m3tk/src/toolframe/M3ToolFrame.i3 b/m3-tools/m3tk/src/toolframe/M3ToolFrame.i3
@@ -56,5 +56,7 @@ The "Startup"  procedure is equivalent to the following code:
 
 *)
 
+PROCEDURE ResetPath(c: M3Context.T);
+(* Update the search path after initialisation *)
 
 END M3ToolFrame.
diff --git a/m3-tools/m3tk/src/toolframe/M3ToolFrame.m3 b/m3-tools/m3tk/src/toolframe/M3ToolFrame.m3
@@ -27,5 +27,10 @@ PROCEDURE Startup(worker: Worker; compile := TRUE): INTEGER RAISES ANY=
     RETURN worker.work(context, compileResult);
   END Startup;
 
+PROCEDURE ResetPath(context: M3Context.T) =
+  BEGIN
+    context.put(M3PathTool.Check());
+  END ResetPath;
+
 BEGIN
 END M3ToolFrame.