Skip to content

Commit

Permalink
Treat length of sequences as a "slot" in Useless optimization
Browse files Browse the repository at this point in the history 
In the `Value.t` representation of the Useless optimization, sequence and tuple
elements are "slots", which combine a `Useful.t` lattice element with an
`Exists.t` lattice element.  When a value flows, vectors and tuples coerce the
`Useful.t` component of slots but unify the `Exists.t` component.  This ensures
that agree on whether or not the element exists even if they disagree that the
element is useful.  If the "from"'s element is useful (and necessarily existing)
but the "to"'s element is not useful, then forcing the "to"'s element to exist
avoids a potentially expensive runtime coercion (e.g., to drop a component of a
tuple or, worse, to drop a component of a tuple that is the contents of a
vector).

Previously, the length of a sequence was represented simply as a `Useful.t`;
this allowed a vector (whose contents were not useful) with a useful length to
flow to a vector (whose contents are necessarily not useful) with a useless
length.  1aad5fe (Optimize representation of sequences in Useless pass;
MLton#569) allowed the Useless optimization to change the representation
of sequence with useless contents.  In particular, a vector with useless
contents but useless length becomes a `word64` and a vector with useless
contents and useless length becomes a `unit`.

However, when such vectors are themselves components of a tuple, then the
program may have a flow of tuples, where the source tuple is changed from
`(..., ?? vector, ...)` to `(..., word64, ...)` but the destination tuple is
changed from `(..., ?? vector, ...)` to `(..., unit, ...)`.  (Note that the
unification of the `Exist.t` components of the corresponding tuple elements is
what makes the destination tuple have a `unit` element.)

This commit treats the length of arrays and vectors as a "slot", so that they
track both usefulness and existence.  Now, a vector with useless contents but a
length that must exist becomes a `word64` (even if the length is useless) and a
vector with useless contents and a length that need not exist (and is
necessarily useless) becomes a `unit`.

Fixes MLton#585.
  • Loading branch information
@MatthewFluet
MatthewFluet committed Dec 20, 2024
1 parent bf18753 commit 8e958ee
Show file tree
Hide file tree
Showing 2 changed files with 65 additions and 49 deletions.
5 changes: 5 additions & 0 deletions CHANGELOG.adoc
View file
Original file line number Diff line number Diff line change
Expand Up @@ -8,6 +8,11 @@ Here are the changes from version 20210117 to YYYYMMDD.

=== Details

* 2024-12-20
** Fix bug in the optimization of representations of sequences in
`Useless` SSA optimization. Thanks to Humza Shahid (hummy123) for
the bug report.

* 2024-12-14
** Update SML/NJ libraries to SML/NJ 110.99.6.1.

Expand Down
109 changes: 60 additions & 49 deletions mlton/ssa/useless.fun
View file
Original file line number Diff line number Diff line change
Expand Up @@ -102,14 +102,14 @@ structure Value =
value: value} Set.t
and value =
Array of {elt: slot,
length: t,
length: slot,
useful: Useful.t}
| Ground of Useful.t
| Ref of {arg: slot,
useful: Useful.t}
| Tuple of slot vector
| Vector of {elt: slot,
length: t}
length: slot}
| Weak of {arg: slot,
useful: Useful.t}
withtype slot = t * Exists.t
Expand All @@ -135,7 +135,7 @@ structure Value =
Array {elt, length, useful} =>
seq [str "array ",
record [("useful", Useful.layout useful),
("length", layout length),
("length", layoutSlot length),
("elt", layoutSlot elt)]]
| Ground g => seq [str "ground ", Useful.layout g]
| Ref {arg, useful, ...} =>
Expand All @@ -145,7 +145,7 @@ structure Value =
| Tuple ss => Vector.layout layoutSlot ss
| Vector {elt, length} =>
seq [str "vector ",
record [("length", layout length),
record [("length", layoutSlot length),
("elt", layoutSlot elt)]]
| Weak {arg, useful} =>
seq [str "weak ",
Expand All @@ -167,7 +167,9 @@ structure Value =
case (v, v') of
(Array {useful = u, length = n, elt = e},
Array {useful = u', length = n', elt = e'}) =>
(Useful.== (u, u'); unify (n, n'); unifySlot (e, e'))
(Useful.== (u, u')
; unifySlot (n, n')
; unifySlot (e, e'))
| (Ground g, Ground g') => Useful.== (g, g')
| (Ref {useful = u, arg = a},
Ref {useful = u', arg = a'}) =>
Expand All @@ -176,7 +178,8 @@ structure Value =
Vector.foreach2 (ss, ss', unifySlot)
| (Vector {length = n, elt = e},
Vector {length = n', elt = e'}) =>
(unify (n, n'); unifySlot (e, e'))
(unifySlot (n, n')
; unifySlot (e, e'))
| (Weak {useful = u, arg = a}, Weak {useful = u', arg = a'}) =>
(Useful.== (u, u'); unifySlot (a, a'))
| _ => Error.bug "Useless.Value.unify: strange"
Expand All @@ -202,7 +205,7 @@ structure Value =
coerceSlot {from = s, to = s'})
| (Vector {length = n, elt = e},
Vector {length = n', elt = e'}) =>
(coerce {from = n, to = n'}
(coerceSlot {from = n, to = n'}
; coerceSlot {from = e, to = e'})
| (Weak _, Weak _) => unify (from, to)
| _ => Error.bug "Useless.Value.coerce: strange"
Expand All @@ -219,6 +222,15 @@ structure Value =
Unit.layout)
coerce

val coerceSlot =
Trace.trace ("Useless.Value.coerceSlot",
fn {from, to} => let open Layout
in record [("from", layoutSlot from),
("to", layoutSlot to)]
end,
Unit.layout)
coerceSlot

fun coerces {from, to} =
Vector.foreach2 (from, to, fn (from, to) =>
coerce {from = from, to = to})
Expand All @@ -228,11 +240,11 @@ structure Value =
fun loop (v: t): unit =
case value v of
Array {length, elt, useful} =>
(f useful; loop length; slot elt)
(f useful; slot length; slot elt)
| Ground u => f u
| Tuple ss => Vector.foreach (ss, slot)
| Ref {arg, useful} => (f useful; slot arg)
| Vector {length, elt} => (loop length; slot elt)
| Vector {length, elt} => (slot length; slot elt)
| Weak {arg, useful} => (f useful; slot arg)
and slot (v, _) = loop v
in
Expand All @@ -258,7 +270,7 @@ structure Value =
| Ground u => SOME u
| Ref {useful = u, ...} => SOME u
| Tuple ss => Vector.peekMap (ss, someUseful o #1)
| Vector {length, ...} => SOME (deground length)
| Vector {length, ...} => SOME (deground (#1 length))
| Weak {useful = u, ...} => SOME u

fun allOrNothing (v: t): Useful.t option =
Expand All @@ -281,18 +293,17 @@ structure Value =
let val e = Exists.new ()
in (loop (t, e :: es), e)
end
val loop = fn t => loop (t, es)
val value =
case Type.dest t of
Type.Array t =>
Array {useful = useful (),
length = loop (Type.word (WordSize.seqIndex ())),
length = slot (Type.word (WordSize.seqIndex ())),
elt = slot t}
| Type.Ref t => Ref {arg = slot t,
useful = useful ()}
| Type.Tuple ts => Tuple (Vector.map (ts, slot))
| Type.Vector t =>
Vector {length = loop (Type.word (WordSize.seqIndex ())),
Vector {length = slot (Type.word (WordSize.seqIndex ())),
elt = slot t}
| Type.Weak t => Weak {arg = slot t,
useful = useful ()}
Expand Down Expand Up @@ -379,7 +390,7 @@ structure Value =
struct
datatype t =
Array of (Type.t * bool)
| Length
| Length of bool
| LengthRef
| UnitRef
| Unit
Expand All @@ -388,7 +399,7 @@ structure Value =
struct
datatype t =
Vector of (Type.t * bool)
| Length
| Length of bool
| Unit
end

Expand All @@ -399,28 +410,28 @@ structure Value =
in (if Exists.doesExist e then SOME t else NONE, b)
end
and arrayRep {elt, length, useful}: ArrayRep.t =
(case (getNewSlot elt, isUseful length, Useful.isUseful useful) of
((SOME ty, eltUseful), lengthUseful, useful) =>
(case (getNewSlot elt, getNewSlot length, Useful.isUseful useful) of
((SOME ty, eltUseful), (_, lengthUseful), useful) =>
ArrayRep.Array (ty, eltUseful orelse lengthUseful orelse useful)
| ((NONE, false), true, false) => ArrayRep.Length
| ((NONE, false), true, true) => ArrayRep.LengthRef
| ((NONE, false), false, true) => ArrayRep.UnitRef
| ((NONE, false), false, false) => ArrayRep.Unit
| ((NONE, false), (SOME _, _), true) => ArrayRep.LengthRef
| ((NONE, false), (SOME _, lengthUseful), false) => ArrayRep.Length lengthUseful
| ((NONE, false), (NONE, false), true) => ArrayRep.UnitRef
| ((NONE, false), (NONE, false), false) => ArrayRep.Unit
| _ => Error.bug (concat
["Value.arrayRep: ",
"elt: ", Layout.toString (layoutSlot elt), "; ",
"length: ", Layout.toString (layout length), "; ",
"length: ", Layout.toString (layoutSlot length), "; ",
"useful: ", Layout.toString (Useful.layout useful)]))
and vectorRep {elt, length}: VectorRep.t =
(case (getNewSlot elt, isUseful length) of
((SOME ty, eltUseful), lengthUseful) =>
(case (getNewSlot elt, getNewSlot length) of
((SOME ty, eltUseful), (_, lengthUseful)) =>
VectorRep.Vector (ty, eltUseful orelse lengthUseful)
| ((NONE, false), true) => VectorRep.Length
| ((NONE, false), false) => VectorRep.Unit
| ((NONE, false), (SOME _, lengthUseful)) => VectorRep.Length lengthUseful
| ((NONE, false), (NONE, false)) => VectorRep.Unit
| _ => Error.bug (concat
["Value.vectorRep: ",
"elt: ", Layout.toString (layoutSlot elt), "; ",
"length: ", Layout.toString (layout length)]))
"length: ", Layout.toString (layoutSlot length)]))
and getNew (T s): Type.t * bool =
let
val {value, ty, new, ...} = Set.! s
Expand All @@ -439,7 +450,7 @@ structure Value =
Array arg =>
(case arrayRep arg of
ArrayRep.Array (ty, u) => (Type.array ty, u)
| ArrayRep.Length => (Type.word (WordSize.seqIndex ()), true)
| ArrayRep.Length u => (Type.word (WordSize.seqIndex ()), u)
| ArrayRep.LengthRef => (Type.reff (Type.word (WordSize.seqIndex ())), true)
| ArrayRep.UnitRef => (Type.reff Type.unit, true)
| ArrayRep.Unit => (Type.unit, false))
Expand All @@ -461,7 +472,7 @@ structure Value =
| Vector arg =>
(case vectorRep arg of
VectorRep.Vector (ty, u) => (Type.vector ty, u)
| VectorRep.Length => (Type.word (WordSize.seqIndex ()), true)
| VectorRep.Length u => (Type.word (WordSize.seqIndex ()), u)
| VectorRep.Unit => (Type.unit, false))
| Weak {arg, useful} =>
orU (wrap (arg, Type.weak), useful)
Expand Down Expand Up @@ -550,7 +561,7 @@ fun transform (program: Program.t): Program.t =
case value v of
Array {useful = u, length = n, elt = e} =>
(Useful.makeUseful u
; deepMakeUseful n
; slot n
; slot e)
| Ground u =>
(Useful.makeUseful u
Expand All @@ -574,7 +585,7 @@ fun transform (program: Program.t): Program.t =
| _ => ()))
| Ref {useful = u, arg = a} => (Useful.makeUseful u; slot a)
| Tuple vs => Vector.foreach (vs, slot)
| Vector {length = n, elt = e} => (deepMakeUseful n; slot e)
| Vector {length = n, elt = e} => (slot n; slot e)
| Weak {useful = u, arg = a} => (Useful.makeUseful u; slot a)
end
val deepMakeUseful =
Expand Down Expand Up @@ -614,7 +625,7 @@ fun transform (program: Program.t): Program.t =
| _ => ()))
| Ref {useful = u, ...} => Useful.makeUseful u
| Tuple vs => Vector.foreach (vs, slot)
| Vector {length = n, elt = e} => (shallowMakeUseful n; slot e)
| Vector {length = n, elt = e} => (slot n; slot e)
| Weak {useful = u, ...} => Useful.makeUseful u
end
val shallowMakeUseful =
Expand All @@ -637,7 +648,7 @@ fun transform (program: Program.t): Program.t =
| Ground u => Useful.makeWanted u
| Ref {useful = u, ...} => Useful.makeWanted u
| Tuple vs => Vector.foreach (vs, slot)
| Vector {length = n, elt = e} => (makeWanted n; slot e)
| Vector {length = n, elt = e} => (slot n; slot e)
| Weak {useful = u, ...} => Useful.makeWanted u
end
val makeWanted =
Expand Down Expand Up @@ -681,7 +692,7 @@ fun transform (program: Program.t): Program.t =
val (l, e) = arrayLengthAndElt (arg 0)
val (l', e') = seqLengthAndElt result
in
coerce {from = l, to = l'}
coerceSlot {from = l, to = l'}
; coerceSlot {from = e, to = e'}
end
fun update () =
Expand All @@ -699,7 +710,7 @@ fun transform (program: Program.t): Program.t =
| Prim.Array_array => seq arrayElt
| Prim.Array_copyArray => copy arrayEltSlot
| Prim.Array_copyVector => copy vectorEltSlot
| Prim.Array_length => length arrayLength
| Prim.Array_length => length (#1 o arrayLength)
| Prim.Array_sub => sub arrayElt
| Prim.Array_toArray => toSeq arrayLengthAndElt
| Prim.Array_toVector => toSeq vectorLengthAndElt
Expand Down Expand Up @@ -740,7 +751,7 @@ fun transform (program: Program.t): Program.t =
| Prim.Ref_assign => coerce {from = arg 1, to = deref (arg 0)}
| Prim.Ref_deref => return (deref (arg 0))
| Prim.Ref_ref => coerce {from = arg 0, to = deref result}
| Prim.Vector_length => length vectorLength
| Prim.Vector_length => length (#1 o vectorLength)
| Prim.Vector_sub => sub vectorElt
| Prim.Vector_vector => seq vectorElt
| Prim.Weak_canGet =>
Expand Down Expand Up @@ -976,7 +987,7 @@ fun transform (program: Program.t): Program.t =
Prim.Array_alloc _ =>
(case Value.arrayRep (Value.arrayArg resultValue) of
Value.ArrayRep.Array _ => doit ()
| Value.ArrayRep.Length => simple (Var (arg 0))
| Value.ArrayRep.Length _ => simple (Var (arg 0))
| Value.ArrayRep.LengthRef =>
simple (PrimApp {prim = Prim.Ref_ref,
targs = Vector.new1 (Type.word (WordSize.seqIndex ())),
Expand All @@ -989,7 +1000,7 @@ fun transform (program: Program.t): Program.t =
| Prim.Array_array =>
(case Value.arrayRep (Value.arrayArg resultValue) of
Value.ArrayRep.Array (eltTy, _) => makeSeq eltTy
| Value.ArrayRep.Length =>
| Value.ArrayRep.Length _ =>
let
val len_var = Var.newNoname ()
val len_ty = Type.word (WordSize.seqIndex ())
Expand Down Expand Up @@ -1029,7 +1040,7 @@ fun transform (program: Program.t): Program.t =
| Prim.Array_length =>
(case Value.arrayRep (Value.arrayArg (value (arg 0))) of
Value.ArrayRep.Array _ => doit ()
| Value.ArrayRep.Length => simple (Var (arg 0))
| Value.ArrayRep.Length _ => simple (Var (arg 0))
| Value.ArrayRep.LengthRef =>
simple (PrimApp {prim = Prim.Ref_deref,
targs = Vector.new1 (Type.word (WordSize.seqIndex ())),
Expand Down Expand Up @@ -1071,19 +1082,19 @@ fun transform (program: Program.t): Program.t =
in
Vector.new2 (len_stmt, len_ref_stmt)
end
| (Value.ArrayRep.Length, Value.ArrayRep.LengthRef) =>
| (Value.ArrayRep.Length _, Value.ArrayRep.LengthRef) =>
simple (PrimApp {prim = Prim.Ref_ref,
targs = Vector.new1 (Type.word (WordSize.seqIndex ())),
args = Vector.new1 (arg 0)})
| (Value.ArrayRep.LengthRef, Value.ArrayRep.LengthRef) =>
simple (Var (arg 0))
| (Value.ArrayRep.Array _, Value.ArrayRep.Length) =>
| (Value.ArrayRep.Array _, Value.ArrayRep.Length _) =>
simple (PrimApp {prim = Prim.Array_length,
targs = targs,
args = args})
| (Value.ArrayRep.Length, Value.ArrayRep.Length) =>
| (Value.ArrayRep.Length _, Value.ArrayRep.Length _) =>
simple (Var (arg 0))
| (Value.ArrayRep.LengthRef, Value.ArrayRep.Length) =>
| (Value.ArrayRep.LengthRef, Value.ArrayRep.Length _) =>
simple (PrimApp {prim = Prim.Ref_deref,
targs = Vector.new1 (Type.word (WordSize.seqIndex ())),
args = args})
Expand All @@ -1093,13 +1104,13 @@ fun transform (program: Program.t): Program.t =
(case (Value.arrayRep (Value.arrayArg (value (arg 0))),
Value.vectorRep (Value.vectorArg resultValue)) of
(_, Value.VectorRep.Unit) => simple (Var unitVar)
| (Value.ArrayRep.Array _, Value.VectorRep.Length) =>
| (Value.ArrayRep.Array _, Value.VectorRep.Length _) =>
simple (PrimApp {prim = Prim.Array_length,
targs = targs,
args = args})
| (Value.ArrayRep.Length, Value.VectorRep.Length) =>
| (Value.ArrayRep.Length _, Value.VectorRep.Length _) =>
simple (Var (arg 0))
| (Value.ArrayRep.LengthRef, Value.VectorRep.Length) =>
| (Value.ArrayRep.LengthRef, Value.VectorRep.Length _) =>
simple (PrimApp {prim = Prim.Ref_deref,
targs = Vector.new1 (Type.word (WordSize.seqIndex ())),
args = args})
Expand Down Expand Up @@ -1135,13 +1146,13 @@ fun transform (program: Program.t): Program.t =
| Prim.Vector_length =>
(case Value.vectorRep (Value.vectorArg (value (arg 0))) of
Value.VectorRep.Vector _ => doit ()
| Value.VectorRep.Length => simple (Var (arg 0))
| Value.VectorRep.Length _ => simple (Var (arg 0))
| Value.VectorRep.Unit =>
Error.bug "Useless.doitPrim: Vector_length/VectorRep.Unit")
| Prim.Vector_vector =>
(case Value.vectorRep (Value.vectorArg resultValue) of
Value.VectorRep.Vector (eltTy, _) => makeSeq eltTy
| Value.VectorRep.Length =>
| Value.VectorRep.Length _ =>
let
val len_var = Var.newNoname ()
val len_ty = Type.word (WordSize.seqIndex ())
Expand Down Expand Up @@ -1193,7 +1204,7 @@ fun transform (program: Program.t): Program.t =
targs = Vector.new1 Type.unit,
args = WordXVector.toVectorMap (ws, fn _ => unitVar)})
else simple e
| Value.VectorRep.Length =>
| Value.VectorRep.Length _ =>
simple (Const (Const.word
(WordX.fromInt
(WordXVector.length ws,
Expand Down

0 comments on commit 8e958ee

Please sign in to comment.