[MLton-commit] r6749

[Matthew Fluet]

Eliminate implicit raise from {X,Sx}mlTree.Dexp.bug.
----------------------------------------------------------------------

U   mlton/trunk/mlton/xml/implement-exceptions.fun
U   mlton/trunk/mlton/xml/implement-suffix.fun
U   mlton/trunk/mlton/xml/xml-tree.fun
U   mlton/trunk/mlton/xml/xml-tree.sig

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

Modified: mlton/trunk/mlton/xml/implement-exceptions.fun
===================================================================
--- mlton/trunk/mlton/xml/implement-exceptions.fun	2008-08-19 22:14:11 UTC (rev 6748)
+++ mlton/trunk/mlton/xml/implement-exceptions.fun	2008-08-19 22:14:21 UTC (rev 6749)
@@ -477,8 +477,9 @@
                  (Dexp.lambda
                   {arg = Var.newNoname (),
                    argType = extraType,
-                   body = Dexp.bug ("extendExtra unimplemented",
-                                    extraType),
+                   body = (Dexp.sequence o Vector.new2)
+                          (Dexp.bug "extendExtra unimplemented",
+                           Dexp.monoVar (dfltExtraVar, extraType)),
                    bodyType = extraType,
                    mayInline = true})),
           var = extendExtraVar}
@@ -508,8 +509,7 @@
           exp = Dexp.reff (Dexp.lambda
                            {arg = Var.newNoname (),
                             argType = Type.exn,
-                            body = Dexp.bug ("toplevel handler not installed",
-                                             Type.unit),
+                            body = Dexp.bug "toplevel handler not installed",
                             bodyType = Type.unit,
                             mayInline = true}),
           body = body}
@@ -518,13 +518,7 @@
          {try = body,
           ty = Type.unit,
           catch = (Var.newNoname (), Type.exn),
-          handler = (Dexp.primApp
-                     {prim = Prim.bug,
-                      targs = Vector.new0 (),
-                      args = Vector.new1
-                             (Dexp.string
-                              "toplevel handler not installed"),
-                      ty = Type.unit})}
+          handler = Dexp.bug "toplevel handler not installed"}
       val body = Dexp.toExp body
       val program =
          Program.T {datatypes = datatypes,

Modified: mlton/trunk/mlton/xml/implement-suffix.fun
===================================================================
--- mlton/trunk/mlton/xml/implement-suffix.fun	2008-08-19 22:14:11 UTC (rev 6748)
+++ mlton/trunk/mlton/xml/implement-suffix.fun	2008-08-19 22:14:21 UTC (rev 6749)
@@ -112,8 +112,7 @@
           exp = Dexp.reff (Dexp.lambda
                            {arg = Var.newNoname (),
                             argType = Type.unit,
-                            body = Dexp.bug ("toplevel suffix not installed",
-                                             Type.unit),
+                            body = Dexp.bug "toplevel suffix not installed",
                             bodyType = Type.unit,
                             mayInline = true}),
           body = body}

Modified: mlton/trunk/mlton/xml/xml-tree.fun
===================================================================
--- mlton/trunk/mlton/xml/xml-tree.fun	2008-08-19 22:14:11 UTC (rev 6748)
+++ mlton/trunk/mlton/xml/xml-tree.fun	2008-08-19 22:14:21 UTC (rev 6749)
@@ -742,19 +742,12 @@
                                 in (Var x, t)
                                 end)
 
-      val bug: string * Type.t -> t =
-         fn (s, ty) =>
-         sequence (Vector.new2
-                   (primApp {prim = Prim.bug,
-                             targs = Vector.new0 (),
-                             args = Vector.new1 (string s),
-                             ty = Type.unit},
-                    raisee {exn = primApp {prim = Prim.bogus,
-                                           targs = Vector.new1 Type.exn,
-                                           args = Vector.new0 (),
-                                           ty = Type.exn},
-                            extend = false,
-                            ty = ty}))
+      val bug: string -> t =
+         fn s =>
+         primApp {prim = Prim.bug,
+                  targs = Vector.new0 (),
+                  args = Vector.new1 (string s),
+                  ty = Type.unit}
 
       fun seq (es, make) =
          fn k => convertsGen (es, fn xts =>

Modified: mlton/trunk/mlton/xml/xml-tree.sig
===================================================================
--- mlton/trunk/mlton/xml/xml-tree.sig	2008-08-19 22:14:11 UTC (rev 6748)
+++ mlton/trunk/mlton/xml/xml-tree.sig	2008-08-19 22:14:21 UTC (rev 6749)
@@ -181,7 +181,7 @@
             type t
 
             val app: {func: t, arg: t, ty: Type.t} -> t
-            val bug: string * Type.t -> t
+            val bug: string -> t
             val casee:
                {cases: t Cases.t,
                 default: (t * Region.t) option,