[MLton-commit] r7460

[Matthew Fluet]

Add control and option to supress deprecation warnings.
----------------------------------------------------------------------

U   mlton/trunk/mlton/control/control-flags.sig
U   mlton/trunk/mlton/control/control-flags.sml
U   mlton/trunk/mlton/elaborate/elaborate-mlbs.fun
U   mlton/trunk/mlton/main/main.fun

----------------------------------------------------------------------

Modified: mlton/trunk/mlton/control/control-flags.sig
===================================================================
--- mlton/trunk/mlton/control/control-flags.sig	2010-05-04 17:28:00 UTC (rev 7459)
+++ mlton/trunk/mlton/control/control-flags.sig	2010-05-09 21:50:42 UTC (rev 7460)
@@ -1,4 +1,4 @@
-(* Copyright (C) 2009 Matthew Fluet.
+(* Copyright (C) 2009-2010 Matthew Fluet.
  * Copyright (C) 1999-2008 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  * Copyright (C) 1997-2000 NEC Research Institute.
@@ -370,6 +370,8 @@
 
       val warnAnn: bool ref
 
+      val warnDeprecated: bool ref
+
       val zoneCutDepth: int ref
 
       (*------------------------------------*)

Modified: mlton/trunk/mlton/control/control-flags.sml
===================================================================
--- mlton/trunk/mlton/control/control-flags.sml	2010-05-04 17:28:00 UTC (rev 7459)
+++ mlton/trunk/mlton/control/control-flags.sml	2010-05-09 21:50:42 UTC (rev 7460)
@@ -1,4 +1,4 @@
-(* Copyright (C) 2009 Matthew Fluet.
+(* Copyright (C) 2009-2010 Matthew Fluet.
  * Copyright (C) 1999-2008 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  * Copyright (C) 1997-2000 NEC Research Institute.
@@ -1094,6 +1094,10 @@
                        default = true,
                        toString = Bool.toString}
 
+val warnDeprecated = control {name = "warn deprecated features",
+                              default = true,
+                              toString = Bool.toString}
+
 val zoneCutDepth: int ref =
    control {name = "zone cut depth",
             default = 100,

Modified: mlton/trunk/mlton/elaborate/elaborate-mlbs.fun
===================================================================
--- mlton/trunk/mlton/elaborate/elaborate-mlbs.fun	2010-05-04 17:28:00 UTC (rev 7459)
+++ mlton/trunk/mlton/elaborate/elaborate-mlbs.fun	2010-05-09 21:50:42 UTC (rev 7460)
@@ -1,4 +1,5 @@
-(* Copyright (C) 1999-2006 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 2010 Matthew Fluet.
+ * Copyright (C) 1999-2006 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  * Copyright (C) 1997-2000 NEC Research Institute.
  *
@@ -220,13 +221,16 @@
                          let
                             val (ids, args) = List.unzip alts
                             val () =
-                               let open Layout
-                               in
-                                  Control.warning
-                                  (reg, seq [str "deprecated annotation: ", str ann, str ", use ",
-                                             List.layout (str o Control.Elaborate.Id.name) ids],
-                                   empty)
-                               end
+                               if !Control.warnDeprecated
+                                  then
+                                     let open Layout
+                                     in
+                                        Control.warning
+                                        (reg, seq [str "deprecated annotation: ", str ann, str ", use ",
+                                                   List.layout (str o Control.Elaborate.Id.name) ids],
+                                         empty)
+                                     end
+                               else ()
                             val restores =
                                List.map (args, Args.processAnn)
                          in

Modified: mlton/trunk/mlton/main/main.fun
===================================================================
--- mlton/trunk/mlton/main/main.fun	2010-05-04 17:28:00 UTC (rev 7459)
+++ mlton/trunk/mlton/main/main.fun	2010-05-09 21:50:42 UTC (rev 7460)
@@ -203,10 +203,13 @@
             Control.Elaborate.Bad =>
                usage (concat ["invalid -", flag, " flag: ", s])
           | Control.Elaborate.Deprecated ids =>
-               Out.output
-               (Out.error,
-                concat ["Warning: ", "deprecated annotation: ", s, ".  Use ",
-                        List.toString Control.Elaborate.Id.name ids, ".\n"])
+               if !Control.warnDeprecated
+                  then
+                     Out.output
+                     (Out.error,
+                      concat ["Warning: ", "deprecated annotation: ", s, ", use ",
+                              List.toString Control.Elaborate.Id.name ids, ".\n"])
+               else ()
           | Control.Elaborate.Good () => ()
           | Control.Elaborate.Other =>
                usage (concat ["invalid -", flag, " flag: ", s])
@@ -804,6 +807,9 @@
        (Expert, "warn-ann", " {true|false}",
         "unrecognized annotation warnings",
         boolRef warnAnn),
+       (Expert, "warn-deprecated", " {true|false}",
+        "deprecated feature warnings",
+        boolRef warnDeprecated),
        (Expert, "xml-passes", " <passes>", "xml optimization passes",
         SpaceString
         (fn s =>
@@ -1026,9 +1032,11 @@
          else ()
       val _ =
          if !codegen = Bytecode
-            then Out.output
-                 (Out.error,
-                  "Warning: bytecode codegen is deprecated.  Use native or C codegen.\n")
+            andalso !Control.warnDeprecated
+            then
+               Out.output
+               (Out.error,
+                "Warning: bytecode codegen is deprecated.  Use native or C codegen.\n")
          else ()
       val () =
          Control.labelsHaveExtra_ := (case targetOS of
@@ -1450,9 +1458,12 @@
                   fun compileCM (file: File.t) =
                      let
                         val _ =
-                           Out.output
-                           (Out.error,
-                            "Warning: .cm input files are deprecated.  Use .mlb input files.\n")
+                           if !Control.warnDeprecated
+                              then
+                                 Out.output
+                                 (Out.error,
+                                  "Warning: .cm input files are deprecated.  Use .mlb input files.\n")
+                           else ()
                         val files = CM.cm {cmfile = file}
                      in
                         compileSML files