[MLton-commit] r6316

Matthew Fluet fluet at mlton.org
Thu Jan 10 09:25:33 PST 2008


Make things more similar in deepFlatten and refFlatten
----------------------------------------------------------------------

U   mlton/trunk/mlton/ssa/deep-flatten.fun
U   mlton/trunk/mlton/ssa/ref-flatten.fun

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

Modified: mlton/trunk/mlton/ssa/deep-flatten.fun
===================================================================
--- mlton/trunk/mlton/ssa/deep-flatten.fun	2008-01-10 17:10:22 UTC (rev 6315)
+++ mlton/trunk/mlton/ssa/deep-flatten.fun	2008-01-10 17:25:32 UTC (rev 6316)
@@ -1,4 +1,4 @@
-(* Copyright (C) 2004-2007 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 2004-2008 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
  * MLton is released under a BSD-style license.
@@ -654,8 +654,21 @@
                          ("con", Option.layout Con.layout con)],
           Value.layout)
          object
+      val deWeak : Value.t -> Value.t =
+         fn v =>
+         case v of
+            Value.Ground t =>
+               typeValue (case Type.dest t of
+                             Type.Weak t => t
+                           | _ => Error.bug "DeepFlatten.primApp: deWeak")
+          | Value.Weak {arg, ...} => arg
+          | _ => Error.bug "DeepFlatten.primApp: Value.deWeak"
       fun primApp {args, prim, resultVar = _, resultType} =
          let
+            fun weak v =
+               case makeTypeValue resultType of
+                  Const v => v
+                | Make _ => Value.weak v
             fun arg i = Vector.sub (args, i)
             fun result () = typeValue resultType
             datatype z = datatype Prim.Name.t
@@ -692,19 +705,11 @@
              | MLton_equal => equal ()
              | MLton_size => dontFlatten ()
              | MLton_share => dontFlatten ()
-             | Weak_get =>
-                  (case arg 0 of
-                      Value.Ground t =>
-                         typeValue (case Type.dest t of
-                                       Type.Weak t => t
-                                     | _ => Error.bug "DeepFlatten.primApp: deWeak")
-                    | Value.Weak {arg, ...} => arg
-                    | _ => Error.bug "DeepFlatten.primApp: Value.deWeak")
-             | Weak_new =>
-                  (Value.dontFlatten (arg 0);
-                   case makeTypeValue resultType of
-                      Const v => v
-                    | Make _ => Value.weak (arg 0))
+             | Weak_get => deWeak (arg 0)
+             | Weak_new => 
+                  let val a = arg 0
+                  in (Value.dontFlatten a; weak a)
+                  end
              | _ => result ()
          end
       fun base b =

Modified: mlton/trunk/mlton/ssa/ref-flatten.fun
===================================================================
--- mlton/trunk/mlton/ssa/ref-flatten.fun	2008-01-10 17:10:22 UTC (rev 6315)
+++ mlton/trunk/mlton/ssa/ref-flatten.fun	2008-01-10 17:25:32 UTC (rev 6316)
@@ -1,4 +1,4 @@
-(* Copyright (C) 2004-2007 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 2004-2008 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
  * MLton is released under a BSD-style license.
@@ -462,8 +462,12 @@
              | MLton_eq => equal ()
              | MLton_equal => equal ()
              | MLton_size => dontFlatten ()
+             | MLton_share => dontFlatten ()
              | Weak_get => deWeak (arg 0)
-             | Weak_new => weak (arg 0)
+             | Weak_new => 
+                  let val a = arg 0
+                  in (Value.dontFlatten a; weak a)
+                  end
              | _ => result ()
          end
       fun base b =




More information about the MLton-commit mailing list