[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