From 4a06e6e5d8d3672c7e6d830c67d4704fc83176ee Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Wed, 15 May 2024 09:27:15 -0400 Subject: [PATCH 1/4] Refactor `Useless.Value.layout` --- mlton/ssa/useless.fun | 34 ++++++++++++++++++---------------- 1 file changed, 18 insertions(+), 16 deletions(-) diff --git a/mlton/ssa/useless.fun b/mlton/ssa/useless.fun index 2cf67a44c..a76195d29 100644 --- a/mlton/ssa/useless.fun +++ b/mlton/ssa/useless.fun @@ -1,4 +1,4 @@ -(* Copyright (C) 2009,2017-2021 Matthew Fluet. +(* Copyright (C) 2009,2017-2021,2024 Matthew Fluet. * Copyright (C) 1999-2008 Henry Cejtin, Matthew Fluet, Suresh * Jagannathan, and Stephen Weeks. * Copyright (C) 1997-2000 NEC Research Institute. @@ -128,22 +128,24 @@ structure Value = let val {value, ...} = Set.! s in - case value of - Array {elt, length, ...} => - seq [str "array", tuple [layout length, layoutSlot elt]] - | Ground g => seq [str "ground ", Useful.layout g] - | Ref {arg, useful, ...} => - seq [str "ref ", - record [("useful", Useful.layout useful), - ("slot", layoutSlot arg)]] - | Tuple vs => Vector.layout layoutSlot vs - | Vector {elt, length} => - seq [str "vector", tuple [layout length, layoutSlot elt]] - | Weak {arg, useful} => - seq [str "weak ", - record [("useful", Useful.layout useful), - ("slot", layoutSlot arg)]] + layoutValue value end + and layoutValue value = + case value of + Array {elt, length, ...} => + seq [str "array", tuple [layout length, layoutSlot elt]] + | Ground g => seq [str "ground ", Useful.layout g] + | Ref {arg, useful, ...} => + seq [str "ref ", + record [("useful", Useful.layout useful), + ("slot", layoutSlot arg)]] + | Tuple vs => Vector.layout layoutSlot vs + | Vector {elt, length} => + seq [str "vector", tuple [layout length, layoutSlot elt]] + | Weak {arg, useful} => + seq [str "weak ", + record [("useful", Useful.layout useful), + ("slot", layoutSlot arg)]] and layoutSlot (v, e) = tuple [Exists.layout e, layout v] end From 5e84a24352f8a7004bb6094114527b3bf3a5555e Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Wed, 15 May 2024 09:28:38 -0400 Subject: [PATCH 2/4] Simplify `Useless.doit{Exp,Statement}` Ensure that `Useless.doitExp` is called with a (non-`NONE`) `Value.t`. --- mlton/ssa/useless.fun | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/mlton/ssa/useless.fun b/mlton/ssa/useless.fun index a76195d29..35e7bebc1 100644 --- a/mlton/ssa/useless.fun +++ b/mlton/ssa/useless.fun @@ -906,7 +906,7 @@ fun transform (program: Program.t): Program.t = in loop (0, n, 0) end - fun doitExp (e: Exp.t, resultType: Type.t, resultValue: Value.t option) = + fun doitExp (e: Exp.t, resultType: Type.t, resultValue: Value.t) = case e of ConApp {con, args} => ConApp {con = con, @@ -997,7 +997,7 @@ fun transform (program: Program.t): Program.t = end | Tuple xs => let - val slots = Value.detupleSlots (valOf resultValue) + val slots = Value.detupleSlots resultValue val xs = Vector.keepAllMap2 (xs, slots, fn (x, (v, e)) => @@ -1014,24 +1014,24 @@ fun transform (program: Program.t): Program.t = | _ => e val doitExp = Trace.trace3 ("Useless.doitExp", - Exp.layout, Layout.ignore, Layout.ignore, + Exp.layout, Type.layout, Value.layout, Exp.layout) doitExp fun doitStatement (Statement.T {var, exp, ty}) = let val v = Option.map (var, value) - val (ty, b) = + val (v, (ty, b)) = case v of - NONE => (ty, false) - | SOME v => Value.getNew v - fun yes ty = + NONE => (Value.fromType ty, (ty, false)) + | SOME v => (v, Value.getNew v) + fun yes () = SOME (Statement.T {var = var, ty = ty, exp = doitExp (exp, ty, v)}) in if b - then yes ty + then yes () else case exp of PrimApp {prim, args, ...} => @@ -1053,9 +1053,9 @@ fun transform (program: Program.t): Program.t = | Prim.WordArray_updateWord _ => array () | _ => true end - then yes ty + then yes () else NONE - | Profile _ => yes ty + | Profile _ => yes () | _ => NONE end val doitStatement = From 322205fc8b55854356dc4cb32774275d16aa2b5b Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Wed, 15 May 2024 09:54:08 -0400 Subject: [PATCH 3/4] Improve/fix handling of `WordXVector` constants in `Useless` pass Allow a `Exp.Const (Const.WordXVector ws)` to "optimize" to a `Vector_vector[unit](unitVar, ..., unitVar)` when the elements are useless. Closes MLton/mlton#559 --- mlton/ssa/useless.fun | 23 +++++++++++------------ 1 file changed, 11 insertions(+), 12 deletions(-) diff --git a/mlton/ssa/useless.fun b/mlton/ssa/useless.fun index 35e7bebc1..b9ba3455f 100644 --- a/mlton/ssa/useless.fun +++ b/mlton/ssa/useless.fun @@ -308,17 +308,7 @@ structure Value = loop (t, []) end - fun const (c: Const.t): t = - let - val v = fromType (Type.ofConst c) - (* allOrNothing v because constants are not transformed and their - * type cannot change. So they must either be completely eliminated - * or completely kept. - *) - val _ = allOrNothing v - in - v - end + fun const (c: Const.t): t = fromType (Type.ofConst c) fun detupleSlots (v: t): slot vector = case value v of @@ -911,7 +901,16 @@ fun transform (program: Program.t): Program.t = ConApp {con, args} => ConApp {con = con, args = keepUseful (args, conArgs con)} - | Const _ => e + | Const c => + (case c of + Const.WordVector ws => + if Type.isUnit (Type.deVector resultType) + then PrimApp + {prim = Prim.Vector_vector, + targs = Vector.new1 Type.unit, + args = WordXVector.toVectorMap (ws, fn _ => unitVar)} + else e + | _ => e) | PrimApp {prim, args, ...} => let fun arg i = Vector.sub (args, i) From 741732b424ccf5a9052baa55b7381cb0b9a25f98 Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Wed, 15 May 2024 10:02:02 -0400 Subject: [PATCH 4/4] Improve `Useless.Value.layout` --- mlton/ssa/useless.fun | 15 ++++++++++----- 1 file changed, 10 insertions(+), 5 deletions(-) diff --git a/mlton/ssa/useless.fun b/mlton/ssa/useless.fun index b9ba3455f..9d29c2779 100644 --- a/mlton/ssa/useless.fun +++ b/mlton/ssa/useless.fun @@ -132,20 +132,25 @@ structure Value = end and layoutValue value = case value of - Array {elt, length, ...} => - seq [str "array", tuple [layout length, layoutSlot elt]] + Array {elt, length, useful} => + seq [str "array ", + record [("useful", Useful.layout useful), + ("length", layout length), + ("elt", layoutSlot elt)]] | Ground g => seq [str "ground ", Useful.layout g] | Ref {arg, useful, ...} => seq [str "ref ", record [("useful", Useful.layout useful), - ("slot", layoutSlot arg)]] + ("arg", layoutSlot arg)]] | Tuple vs => Vector.layout layoutSlot vs | Vector {elt, length} => - seq [str "vector", tuple [layout length, layoutSlot elt]] + seq [str "vector ", + record [("length", layout length), + ("elt", layoutSlot elt)]] | Weak {arg, useful} => seq [str "weak ", record [("useful", Useful.layout useful), - ("slot", layoutSlot arg)]] + ("arg", layoutSlot arg)]] and layoutSlot (v, e) = tuple [Exists.layout e, layout v] end