Support for suppressing messages

src/Common/Flags.sml

@@ -833,10 +833,16 @@ end
   val _ = add_bool_entry0 ("eliminate_polymorphic_equality", eliminate_polymorphic_equality)
 
   val _ = add_bool_entry
-      {long="compile_only", short=SOME "c",
-       menu=["General Control","compile only"],
-       item=ref false, neg=false, desc=
-       "Compile only. Suppresses generation of executable"}
+              {long="compile_only", short=SOME "c",
+               menu=["General Control","compile only"],
+               item=ref false, neg=false,
+               desc="Compile only. Suppresses generation of executable"}
+
+  val _ = add_bool_entry
+              {long="messages", short=NONE, neg=true,
+               menu=["Debug","messages"], item=ref true,
+               desc="Print messages about reading source files and generating\n\
+                    \target files."}
 
 val is_on = Directory.is_on
 val is_on0 = Directory.is_on0

src/Compiler/Backend/Barry/CompileBarry.sml

@@ -36,6 +36,13 @@ structure CompileBarry: COMPILE_BARRY =
     val preHook = CompileToLamb.preHook
     val postHook = CompileToLamb.postHook
 
+    local
+      val messages_p = Flags.is_on0 "messages"
+    in
+      fun message f = if messages_p() then print (f())
+                      else ()
+    end
+
     (*****************************)
     (* This is the main function *)
     (*****************************)
@@ -59,7 +66,7 @@ structure CompileBarry: COMPILE_BARRY =
 	                    (fn s => TextIO.output(os,s), st, colwidth);
 	     TextIO.output(os, "\n\n");
 	     TextIO.closeOut os;
-	     print ("[wrote ML file:\t" ^ filename ^ "]\n");
+	     message (fn () => "[wrote ML file:\t" ^ filename ^ "]\n");
 	     filename) handle X => (TextIO.closeOut os; raise X)
 	end
 

src/Compiler/Backend/JS/CompileJS.sml

@@ -42,6 +42,13 @@ structure CompileJS: COMPILE_JS =
     val preHook = CompileToLamb.preHook
     val postHook = CompileToLamb.postHook
 
+    local
+      val messages_p = Flags.is_on0 "messages"
+    in
+      fun message f = if messages_p() then print (f())
+                      else ()
+    end
+
     (*****************************)
     (* This is the main function *)
     (*****************************)
@@ -67,7 +74,7 @@ structure CompileJS: COMPILE_JS =
                 end
             val filename = repair filename ^ ".js"
         in ExpToJs.toFile (filename, #1 target)
-         ; print ("[wrote JavaScript file:\t" ^ filename ^ "]\n")
+         ; message (fn () => "[wrote JavaScript file:\t" ^ filename ^ "]\n")
          ; filename
 	end
 

src/Compiler/Backend/X64/CodeGenX64.sml

@@ -2332,11 +2332,7 @@ val _ = List.app (fn lab => print ("\n" ^ (I.pr_lab lab))) (List.rev dat_labs)
   end
 
   local
-    val messages_p =
-        Flags.add_bool_entry
-            {long="messages", short=NONE, neg=true,
-             menu=["Debug","messages"], item=ref true,
-             desc="Print messages about generated target files."}
+    val messages_p = Flags.is_on0 "messages"
   in
     fun message f = if messages_p() then print (f())
                     else ()

src/Manager/IntModules.sml

@@ -34,6 +34,13 @@ functor IntModules(structure ManagerObjects : MANAGER_OBJECTS0
     fun log (s:string) : unit = TextIO.output (!Flags.log, s)
     fun chat s = if !Flags.chat then log (s ^ "\n") else ()
 
+    local
+      val messages_p = Flags.is_on0 "messages"
+    in
+      fun message f = if messages_p() then print (f())
+                      else ()
+    end
+
     fun cleanBucket () =
         ( List.app Name.mk_rigid (!Name.bucket)
         ; Name.bucket := [])
@@ -470,8 +477,8 @@ functor IntModules(structure ManagerObjects : MANAGER_OBJECTS0
                |> Substring.dropl (fn c => c = #"-")
                |> Substring.string
 
-	      val _ = print("[compiling body of functor " ^ FunId.pr_FunId funid ^
-			    " (from source " ^ src_name ^ ") begin]\n")
+	      val () = message(fn () => "[compiling body of functor " ^ FunId.pr_FunId funid ^
+			                " (from source " ^ src_name ^ ") begin]\n")
 (* 	      val _ = out_functor_application (FunId.pr_FunId funid)  (* for statistics *) *)
 
 	      val _ = chat "[recreating functor body begin...]"
@@ -508,7 +515,7 @@ functor IntModules(structure ManagerObjects : MANAGER_OBJECTS0
 	      val cb'' = CompileBasis.plus(cb,cb')
 	      val mc'' = ModCode.seq(mc,mc')
 	  in (ce', cb'', ModCode.emit (absprjid, mc''))     (* we also emit code for arg.. see comment above *)
-	      before print("[compiling body of functor " ^ FunId.pr_FunId funid ^ " end]\n")
+	     before message(fn () => "[compiling body of functor " ^ FunId.pr_FunId funid ^ " end]\n")
 	  end
 
 	| LETstrexp(info, strdec, strexp) =>

src/Manager/Manager.sml

@@ -534,6 +534,13 @@ functor Manager(structure ManagerObjects : MANAGER_OBJECTS
 
     val debug = Flags.is_on0 "debug_compiler"
 
+    local
+      val messages_p = Flags.is_on0 "messages"
+    in
+      fun message f = if messages_p() then print(f())
+                      else ()
+    end
+
     fun maybe_print_topdec s topdec =
 	if print_post_elab_ast() orelse debug() then
 	    let val _ = print (s ^ ":\n")
@@ -548,15 +555,15 @@ functor Manager(structure ManagerObjects : MANAGER_OBJECTS
 
     fun build_mlb_one (mlbfile, ebfiles, smlfile) : unit =
         let (* load the bases that smlfile depends on *)
-            val _ = print("[reading source file:\t" ^ smlfile)
+            val () = message (fn () => "[reading source file:\t" ^ smlfile)
             val (unpickleStream, elabBasesInfo) = PB.unpickleBases0 ebfiles
             val initialBasis0 = Basis.initialBasis0()
             val (infB,elabB) =
                 List.foldl (fn ({infixElabBasis,...}, acc) =>
                             Basis.plusBasis0(acc,infixElabBasis))
                 initialBasis0
                 elabBasesInfo
-            val _ = print("]")
+            val () = message (fn () => "]")
             val log_cleanup = log_init smlfile
             val _ = Flags.reset_warnings ()
             val abs_mlbfile = ModuleEnvironments.mk_absprjid mlbfile
@@ -597,7 +604,7 @@ functor Manager(structure ManagerObjects : MANAGER_OBJECTS
                         val B = Basis.mk(infB,elabB,opaq_env,intB)
                     in Basis.restrict(B,freelongids)
                     end
-                val _ = print "\n"
+                val () = message (fn () => "\n")
                 val (_,_,opaq_env_im,intB_im) = Basis.un B_im
 
                 (* Setting up for generation of second export basis (eb1) *)

test/repl/load.out.ok

@@ -1,5 +1,4 @@
-. [reading source file:	hello.sml]
-> structure Hello :
+. > structure Hello :
     sig
       val text : string
     end