From a7b19de3a8a38ffbae4a6183100f948cc0ac2b49 Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Wed, 12 Feb 2020 20:47:54 -0500 Subject: [PATCH 01/19] Cleanup formatting and whitespace --- mlton/ssa/simplify-types.fun | 177 +++++++++++++++++++---------------- 1 file changed, 95 insertions(+), 82 deletions(-) diff --git a/mlton/ssa/simplify-types.fun b/mlton/ssa/simplify-types.fun index 6df08df3a2..8baae159fd 100644 --- a/mlton/ssa/simplify-types.fun +++ b/mlton/ssa/simplify-types.fun @@ -1,4 +1,4 @@ -(* Copyright (C) 2009,2018 Matthew Fluet. +(* Copyright (C) 2009,2018,2020 Matthew Fluet. * Copyright (C) 1999-2005, 2008 Henry Cejtin, Matthew Fluet, Suresh * Jagannathan, and Stephen Weeks. * Copyright (C) 1997-2000 NEC Research Institute. @@ -39,7 +39,7 @@ * the datatype and replace the lhs by the rhs, i.e. we must keep the * circularity around. * Must do similar things for vectors. - * + * * Also, to eliminate as many Transparent constructors as possible, for * something like the following, * datatype t = T of u array @@ -50,7 +50,7 @@ * where all uses of t are replaced by u array. *) -functor SimplifyTypes (S: SSA_TRANSFORM_STRUCTS): SSA_TRANSFORM = +functor SimplifyTypes (S: SSA_TRANSFORM_STRUCTS): SSA_TRANSFORM = struct open S @@ -158,10 +158,12 @@ structure Result = | Keep of 'a fun layout layoutX = - let open Layout - in fn Bugg => str "Bug" - | Delete => str "Delete" - | Keep x => seq [str "Keep ", layoutX x] + let + open Layout + in + fn Bugg => str "Bug" + | Delete => str "Delete" + | Keep x => seq [str "Keep ", layoutX x] end end @@ -197,8 +199,8 @@ fun transform (Program.T {datatypes, globals, functions, main}) = setConRep val conIsUseful = ConRep.isUseful o conRep val conIsUseful = - Trace.trace - ("SimplifyTypes.conIsUseful", Con.layout, Bool.layout) + Trace.trace + ("SimplifyTypes.conIsUseful", Con.layout, Bool.layout) conIsUseful val {get = tyconInfo: Tycon.t -> {cardinality: Cardinality.t, numCons: int ref, @@ -251,7 +253,7 @@ fun transform (Program.T {datatypes, globals, functions, main}) = val _ = setConRepUseful Con.truee val _ = setConRepUseful Con.falsee val _ = Vector.foreach (globals, handleStatement) - val _ = List.foreach + val _ = List.foreach (functions, fn f => Vector.foreach (Function.blocks f, fn Block.T {statements, ...} => @@ -326,8 +328,10 @@ fun transform (Program.T {datatypes, globals, functions, main}) = val _ = Control.diagnostics (fn display => - let open Layout - in Vector.foreach + let + open Layout + in + Vector.foreach (origDatatypes, fn Datatype.T {tycon, cons} => (display (seq [str "cardinality of ", Tycon.layout tycon, @@ -347,7 +351,7 @@ fun transform (Program.T {datatypes, globals, functions, main}) = (* "unary" is datatypes with one constructor whose rhs contains an * array (or vector) type. * For datatypes with one variant not containing an array type, eliminate - * the datatype. + * the datatype. *) fun containsArrayOrVector (ty: Type.t): bool = let @@ -374,22 +378,23 @@ fun transform (Program.T {datatypes, globals, functions, main}) = then (setConRep (con, ConRep.Useless) ; NONE) else SOME c) - in case Vector.length cons of - 0 => (setTyconNumCons (tycon, 0) - ; setTyconReplacement (tycon, SOME Type.unit) - ; (datatypes, unary)) - | 1 => - let - val {con, args} = Vector.first cons - in - if Vector.exists (args, containsArrayOrVector) - then (datatypes, - {tycon = tycon, con = con, args = args} :: unary) - else (transparent (tycon, con, args) - ; (datatypes, unary)) - end - | _ => (Datatype.T {tycon = tycon, cons = cons} :: datatypes, - unary) + in + case Vector.length cons of + 0 => (setTyconNumCons (tycon, 0) + ; setTyconReplacement (tycon, SOME Type.unit) + ; (datatypes, unary)) + | 1 => + let + val {con, args} = Vector.first cons + in + if Vector.exists (args, containsArrayOrVector) + then (datatypes, + {tycon = tycon, con = con, args = args} :: unary) + else (transparent (tycon, con, args) + ; (datatypes, unary)) + end + | _ => (Datatype.T {tycon = tycon, cons = cons} :: datatypes, + unary) end) fun containsTycon (ty: Type.t, tyc: Tycon.t): bool = let @@ -420,7 +425,7 @@ fun transform (Program.T {datatypes, globals, functions, main}) = (unary, datatypes, fn ({tycon, con, args}, accum) => if Vector.exists (args, fn arg => containsTycon (arg, tycon)) then Datatype.T {tycon = tycon, - cons = Vector.new1 {con = con, args = args}} + cons = Vector.new1 {con = con, args = args}} :: accum else (transparent (tycon, con, args) ; accum)) @@ -431,7 +436,7 @@ fun transform (Program.T {datatypes, globals, functions, main}) = in if Type.isUnit t then NONE - else SOME t + else SOME t end) val {get = simplifyType, destroy = destroySimplifyType} = Property.destGet @@ -441,23 +446,24 @@ fun transform (Program.T {datatypes, globals, functions, main}) = let val keepSimplifyTypes = makeKeepSimplifyTypes simplifyType open Type - in case dest t of - Array t => array (simplifyType t) - | Datatype tycon => - (case tyconReplacement tycon of - SOME t => - let - val t = simplifyType t - val _ = setTyconReplacement (tycon, SOME t) - in - t - end - | NONE => t) - | Ref t => reff (simplifyType t) - | Tuple ts => Type.tuple (keepSimplifyTypes ts) - | Vector t => vector (simplifyType t) - | Weak t => weak (simplifyType t) - | _ => t + in + case dest t of + Array t => array (simplifyType t) + | Datatype tycon => + (case tyconReplacement tycon of + SOME t => + let + val t = simplifyType t + val _ = setTyconReplacement (tycon, SOME t) + in + t + end + | NONE => t) + | Ref t => reff (simplifyType t) + | Tuple ts => Type.tuple (keepSimplifyTypes ts) + | Vector t => vector (simplifyType t) + | Weak t => weak (simplifyType t) + | _ => t end)) val simplifyType = Trace.trace ("SimplifyTypes.simplifyType", Type.layout, Type.layout) @@ -475,7 +481,7 @@ fun transform (Program.T {datatypes, globals, functions, main}) = args = keepSimplifyTypes args})})) val unitVar = Var.newNoname () val {get = varInfo: Var.t -> Type.t, set = setVarInfo, ...} = - Property.getSetOnce + Property.getSetOnce (Var.plist, Property.initRaise ("varInfo", Var.layout)) fun simplifyVarType (x: Var.t, t: Type.t): Type.t = (setVarInfo (x, t) @@ -489,23 +495,26 @@ fun transform (Program.T {datatypes, globals, functions, main}) = fun simplifyVar (x: Var.t): Var.t = if Type.isUnit (newVarType x) then unitVar - else x + else x val varIsUseless = Type.isUnit o newVarType fun removeUselessVars xs = Vector.keepAll (xs, not o varIsUseless) fun tuple xs = let val xs = removeUselessVars xs - in if 1 = Vector.length xs + in + if 1 = Vector.length xs then Var (Vector.first xs) - else Tuple xs + else Tuple xs end fun simplifyFormals xts = Vector.keepAllMap (xts, fn (x, t) => - let val t = simplifyVarType (x, t) - in if Type.isUnit t + let + val t = simplifyVarType (x, t) + in + if Type.isUnit t then NONE - else SOME (x, t) + else SOME (x, t) end) val typeIsUseful = not o Type.isUnit o simplifyType datatype result = datatype Result.t @@ -520,29 +529,30 @@ fun transform (Program.T {datatypes, globals, functions, main}) = | ConRep.Useless => Bugg) | PrimApp {prim, targs, args} => Keep - (let + (let fun normal () = PrimApp {prim = prim, targs = simplifyTypes targs, args = Vector.map (args, simplifyVar)} fun equal () = if 2 = Vector.length args - then - if varIsUseless (Vector.first args) - then ConApp {con = Con.truee, - args = Vector.new0 ()} - else normal () - else Error.bug "SimplifyTypes.simplifyExp: strange eq/equal PrimApp" + then if varIsUseless (Vector.first args) + then ConApp {con = Con.truee, + args = Vector.new0 ()} + else normal () + else Error.bug "SimplifyTypes.simplifyExp: strange eq/equal PrimApp" open Prim.Name - in case Prim.name prim of - MLton_eq => equal () - | MLton_equal => equal () - | _ => normal () + in + case Prim.name prim of + MLton_eq => equal () + | MLton_equal => equal () + | _ => normal () end) | Select {tuple, offset} => let val ts = Type.deTuple (oldVarType tuple) - in Vector.fold' + in + Vector.fold' (ts, 0, (offset, 0), fn (pos, t, (n, offset)) => if n = 0 then (Vector.Done @@ -552,13 +562,13 @@ fun transform (Program.T {datatypes, globals, functions, main}) = (ts, pos + 1, Vector.length ts, typeIsUseful)) then Var tuple - else Select {tuple = tuple, - offset = offset}))) - else Vector.Continue (n - 1, - if typeIsUseful t - then offset + 1 - else offset), - fn _ => Error.bug "SimplifyTypes.simplifyExp: Select:newOffset") + else Select {tuple = tuple, + offset = offset}))) + else Vector.Continue (n - 1, + if typeIsUseful t + then offset + 1 + else offset), + fn _ => Error.bug "SimplifyTypes.simplifyExp: Select:newOffset") end | Tuple xs => Keep (tuple xs) | _ => Keep e @@ -585,7 +595,7 @@ fun transform (Program.T {datatypes, globals, functions, main}) = | (n, SOME l) => if n = tyconNumCons (Type.deDatatype (oldVarType test)) then NONE - else SOME l + else SOME l fun normal () = (Vector.new0 (), Case {test = test, @@ -604,7 +614,7 @@ fun transform (Program.T {datatypes, globals, functions, main}) = (* This case can occur because an array or vector * tycon was kept around. *) - normal () + normal () else (* The type has become a tuple. Do the selects. *) let val ts = keepSimplifyTypes (conArgs con) @@ -615,15 +625,18 @@ fun transform (Program.T {datatypes, globals, functions, main}) = Vector.unzip (Vector.mapi (ts, fn (i, ty) => - let val x = Var.newNoname () - in (x, - Statement.T - {var = SOME x, + let + val x = Var.newNoname () + in + (x, + Statement.T + {var = SOME x, ty = ty, exp = Select {tuple = test, offset = i}}) end)) - in (stmts, Goto {dst = l, args = args}) + in + (stmts, Goto {dst = l, args = args}) end end | _ => normal () @@ -645,7 +658,7 @@ fun transform (Program.T {datatypes, globals, functions, main}) = simplifyTransfer fun simplifyStatement (Statement.T {var, ty, exp}) = let - val ty = simplifyMaybeVarType (var, ty) + val ty = simplifyMaybeVarType (var, ty) in (* It is wrong to omit calling simplifyExp when var = NONE because * targs in a PrimApp may still need to be simplified. From 87d2f179aadd7a5c93e82d8eaac810e47f3a6f62 Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Thu, 13 Feb 2020 08:40:05 -0500 Subject: [PATCH 02/19] Refactor `simplifyType` property of `SimplifyTypes` to `simplifyTypeOpt` Previously, the `simplifyType` property had the type `Type.t -> Type.t`, where `Type.unit` was used to signal an uninhabited type. However, this is ambiguous, as `Type.unit` is an inhabited type. The refactored `simplifyTypeOpt` property has the type `Type.t -> Type.t option`, where `NONE` is used to signal an uninhabited type. --- mlton/ssa/simplify-types.fun | 108 +++++++++++++++++++++-------------- 1 file changed, 64 insertions(+), 44 deletions(-) diff --git a/mlton/ssa/simplify-types.fun b/mlton/ssa/simplify-types.fun index 8baae159fd..8944b26cfb 100644 --- a/mlton/ssa/simplify-types.fun +++ b/mlton/ssa/simplify-types.fun @@ -429,47 +429,69 @@ fun transform (Program.T {datatypes, globals, functions, main}) = :: accum else (transparent (tycon, con, args) ; accum)) - fun makeKeepSimplifyTypes simplifyType ts = - Vector.keepAllMap (ts, fn t => - let - val t = simplifyType t - in - if Type.isUnit t - then NONE - else SOME t - end) - val {get = simplifyType, destroy = destroySimplifyType} = + + fun makeSimplifyTypeFns simplifyTypeOpt = + let + fun simplifyType t = + case simplifyTypeOpt t of + NONE => Error.bug (concat ["SimplifyTypes.simplifyType: ", + Layout.toString (Type.layout t)]) + | SOME t => t + fun simplifyTypeAsUnit t = + case simplifyTypeOpt t of + NONE => Type.unit + | SOME t => t + fun simplifyTypesOpt ts = + Exn.withEscape + (fn escape => + SOME (Vector.map (ts, fn t => + case simplifyTypeOpt t of + NONE => escape NONE + | SOME t => t))) + fun simplifyTypes ts = Vector.map (ts, simplifyType) + fun keepSimplifyTypes ts = Vector.keepAllMap (ts, simplifyTypeOpt) + in + {simplifyType = simplifyType, + simplifyTypeAsUnit = simplifyTypeAsUnit, + simplifyTypes = simplifyTypes, + simplifyTypesOpt = simplifyTypesOpt, + keepSimplifyTypes = keepSimplifyTypes} + end + val {get = simplifyTypeOpt, destroy = destroySimplifyTypeOpt} = Property.destGet (Type.plist, Property.initRec - (fn (t, simplifyType) => - let - val keepSimplifyTypes = makeKeepSimplifyTypes simplifyType - open Type - in - case dest t of - Array t => array (simplifyType t) - | Datatype tycon => - (case tyconReplacement tycon of - SOME t => - let - val t = simplifyType t - val _ = setTyconReplacement (tycon, SOME t) - in - t - end - | NONE => t) - | Ref t => reff (simplifyType t) - | Tuple ts => Type.tuple (keepSimplifyTypes ts) - | Vector t => vector (simplifyType t) - | Weak t => weak (simplifyType t) - | _ => t - end)) - val simplifyType = - Trace.trace ("SimplifyTypes.simplifyType", Type.layout, Type.layout) - simplifyType - fun simplifyTypes ts = Vector.map (ts, simplifyType) - val keepSimplifyTypes = makeKeepSimplifyTypes simplifyType + (fn (t, simplifyTypeOpt) => + if Cardinality.isZero (typeCardinality t) + then NONE + else SOME (let + val {simplifyType, simplifyTypeAsUnit, simplifyTypes, ...} = + makeSimplifyTypeFns simplifyTypeOpt + open Type + in + case dest t of + Array t => array (simplifyTypeAsUnit t) + | Datatype tycon => + (case tyconReplacement tycon of + SOME t => + let + val t = simplifyType t + val _ = setTyconReplacement (tycon, SOME t) + in + t + end + | NONE => t) + | Ref t => reff (simplifyType t) + | Tuple ts => Type.tuple (simplifyTypes ts) + | Vector t => vector (simplifyTypeAsUnit t) + | Weak t => weak (simplifyType t) + | _ => t + end))) + val simplifyTypeOpt = + Trace.trace ("SimplifyTypes.simplifyTypeOpt", Type.layout, Option.layout Type.layout) + simplifyTypeOpt + val {simplifyType, simplifyTypes, keepSimplifyTypes, ...} = + makeSimplifyTypeFns simplifyTypeOpt (* Simplify constructor argument types. *) val datatypes = Vector.fromListMap @@ -491,12 +513,10 @@ fun transform (Program.T {datatypes, globals, functions, main}) = SOME x => simplifyVarType (x, t) | NONE => simplifyType t val oldVarType = varInfo - val newVarType = simplifyType o oldVarType + val newVarType = simplifyTypeOpt o oldVarType + val varIsUseless = Option.isNone o newVarType fun simplifyVar (x: Var.t): Var.t = - if Type.isUnit (newVarType x) - then unitVar - else x - val varIsUseless = Type.isUnit o newVarType + if varIsUseless x then unitVar else x fun removeUselessVars xs = Vector.keepAll (xs, not o varIsUseless) fun tuple xs = let @@ -749,7 +769,7 @@ fun transform (Program.T {datatypes, globals, functions, main}) = functions = functions, main = main} val _ = destroyTypeCardinality () - val _ = destroySimplifyType () + val _ = destroySimplifyTypeOpt () val _ = Program.clearTop program in program From 216d5050d8c25b479d2438cd78d991badf66dcef Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Thu, 13 Feb 2020 09:00:30 -0500 Subject: [PATCH 03/19] Refactor handling of uninhabited types in `SimplifyTypes` Following the previous commit, further use a `Type.t option` and `NONE` to signal an uninhabited type, rather than a `Type.t` and `Type.unit`. In particular, a `Statement.t` that purports to produce a value of an uninhabited type must be unreachable. This optimization isn't expressible when an uninhabited type is signaled by `Type.unit`, because many statements may produce a value of `Type.unit`. --- mlton/ssa/simplify-types.fun | 59 +++++++++++++++++------------------- 1 file changed, 27 insertions(+), 32 deletions(-) diff --git a/mlton/ssa/simplify-types.fun b/mlton/ssa/simplify-types.fun index 8944b26cfb..eacc9116ec 100644 --- a/mlton/ssa/simplify-types.fun +++ b/mlton/ssa/simplify-types.fun @@ -490,7 +490,7 @@ fun transform (Program.T {datatypes, globals, functions, main}) = val simplifyTypeOpt = Trace.trace ("SimplifyTypes.simplifyTypeOpt", Type.layout, Option.layout Type.layout) simplifyTypeOpt - val {simplifyType, simplifyTypes, keepSimplifyTypes, ...} = + val {simplifyTypes, keepSimplifyTypes, ...} = makeSimplifyTypeFns simplifyTypeOpt (* Simplify constructor argument types. *) val datatypes = @@ -505,13 +505,13 @@ fun transform (Program.T {datatypes, globals, functions, main}) = val {get = varInfo: Var.t -> Type.t, set = setVarInfo, ...} = Property.getSetOnce (Var.plist, Property.initRaise ("varInfo", Var.layout)) - fun simplifyVarType (x: Var.t, t: Type.t): Type.t = + fun simplifyVarType (x: Var.t, t: Type.t): Type.t option = (setVarInfo (x, t) - ; simplifyType t) - fun simplifyMaybeVarType (x: Var.t option, t: Type.t): Type.t = + ; simplifyTypeOpt t) + fun simplifyMaybeVarType (x: Var.t option, t: Type.t): Type.t option = case x of SOME x => simplifyVarType (x, t) - | NONE => simplifyType t + | NONE => simplifyTypeOpt t val oldVarType = varInfo val newVarType = simplifyTypeOpt o oldVarType val varIsUseless = Option.isNone o newVarType @@ -529,14 +529,10 @@ fun transform (Program.T {datatypes, globals, functions, main}) = fun simplifyFormals xts = Vector.keepAllMap (xts, fn (x, t) => - let - val t = simplifyVarType (x, t) - in - if Type.isUnit t - then NONE - else SOME (x, t) - end) - val typeIsUseful = not o Type.isUnit o simplifyType + case simplifyVarType (x, t) of + NONE => NONE + | SOME t => SOME (x, t)) + val typeIsUseful = Option.isSome o simplifyTypeOpt datatype result = datatype Result.t fun simplifyExp (e: Exp.t): Exp.t result = case e of @@ -677,25 +673,24 @@ fun transform (Program.T {datatypes, globals, functions, main}) = Layout.tuple2 (Vector.layout Statement.layout, Transfer.layout)) simplifyTransfer fun simplifyStatement (Statement.T {var, ty, exp}) = - let - val ty = simplifyMaybeVarType (var, ty) - in - (* It is wrong to omit calling simplifyExp when var = NONE because - * targs in a PrimApp may still need to be simplified. - *) - if not (Type.isUnit ty) - orelse Exp.maySideEffect exp - orelse (case exp of - Profile _ => true - | _ => false) - then - (case simplifyExp exp of - Bugg => Bugg - | Delete => Delete - | Keep exp => - Keep (Statement.T {var = var, ty = ty, exp = exp})) - else Delete - end + case simplifyMaybeVarType (var, ty) of + NONE => + (* It is impossible for a statement to produce a value of an + * uninhabited type; block must be unreachable. + * Example: `Vector_sub` from a `(ty) vector`, where `ty` is + * uninhabited. The `(ty) vector` type is inhabited, but only by + * the vector of length 0; this `Vector_sub` is unreachable due + * to a dominating bounds check that must necessarily fail. + *) + Bugg + | SOME ty => + (* It is wrong to omit calling simplifyExp when var = NONE because + * targs in a PrimApp may still need to be simplified. + *) + (case simplifyExp exp of + Bugg => Bugg + | Delete => Delete + | Keep exp => Keep (Statement.T {var = var, ty = ty, exp = exp})) val simplifyStatement = Trace.trace ("SimplifyTypes.simplifyStatement", From 51ae3cdfeef3c47e514ad216d7105e4bd809ae2b Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Thu, 13 Feb 2020 09:33:48 -0500 Subject: [PATCH 04/19] Fix bug in `SimplifyTypes` After identifying an unreachable statement (e.g., the `ConApp` of a `Useless` constructor), `SimplifyTypes` stops visiting subsequent statements in the block. However, visiting statements is necessary to `setVarInfo` on the variables defined in the block. Because `SimplifyTypes` visits the blocks of a function via a DFS, it may visit (necessarily unreachable) blocks that use variables that were defined (but not visited) by a previously unreachable block. This triggers a `no varInfo property` compiler error. This was previously noted (see the comment at the end of MLton/mlton@19b07c0) and has now been observed in the wild (see MPLLang/mpl#107). To fix the bug, switch from a DFS to a dominator tree traversal, where the dominator tree traversal does not visit any children of an unreachable block. This addresses the `no varInfo property` compiler error, because any block that uses a variable must be dominated by the block that defines the variable. --- mlton/ssa/simplify-types.fun | 34 ++++++++++++++++++++++------------ 1 file changed, 22 insertions(+), 12 deletions(-) diff --git a/mlton/ssa/simplify-types.fun b/mlton/ssa/simplify-types.fun index eacc9116ec..eb880d66de 100644 --- a/mlton/ssa/simplify-types.fun +++ b/mlton/ssa/simplify-types.fun @@ -710,19 +710,21 @@ fun transform (Program.T {datatypes, globals, functions, main}) = SOME o Vector.fromListRev) in case statements of - NONE => Block.T {label = label, - args = args, - statements = Vector.new0 (), - transfer = Bug} + NONE => ({dead = true}, + Block.T {label = label, + args = args, + statements = Vector.new0 (), + transfer = Bug}) | SOME statements => let val (stmts, transfer) = simplifyTransfer transfer val statements = Vector.concat [statements, stmts] in - Block.T {label = label, - args = args, - statements = statements, - transfer = transfer} + ({dead = false}, + Block.T {label = label, + args = args, + statements = statements, + transfer = transfer}) end end fun simplifyFunction f = @@ -731,10 +733,18 @@ fun transform (Program.T {datatypes, globals, functions, main}) = Function.dest f val args = simplifyFormals args val blocks = ref [] - val _ = - Function.dfs (f, fn block => - (List.push (blocks, simplifyBlock block) - ; fn () => ())) + + fun loop (Tree.T (b, children)) = + let + val ({dead}, b) = simplifyBlock b + val _ = List.push (blocks, b) + in + if dead + then () + else Tree.Seq.foreach (children, loop) + end + val _ = loop (Function.dominatorTree f) + val returns = Option.map (returns, keepSimplifyTypes) val raises = Option.map (raises, keepSimplifyTypes) in From f27a6bfaacdf04572c3252a20f11f047d2952581 Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Thu, 13 Feb 2020 09:54:46 -0500 Subject: [PATCH 05/19] Further optimize `SimplifyTypes` It is impossible for a block to be called with a value of an uninhabited type. In practice, such a block is usually the target of a `Case` transfer for a `Useless` constructor. The corresponding branch of the `Case` transfer will be eliminated. --- mlton/ssa/simplify-types.fun | 90 +++++++++++++++++++++--------------- 1 file changed, 53 insertions(+), 37 deletions(-) diff --git a/mlton/ssa/simplify-types.fun b/mlton/ssa/simplify-types.fun index eb880d66de..39a3aac0a7 100644 --- a/mlton/ssa/simplify-types.fun +++ b/mlton/ssa/simplify-types.fun @@ -526,6 +526,14 @@ fun transform (Program.T {datatypes, globals, functions, main}) = then Var (Vector.first xs) else Tuple xs end + fun simplifyFormalsOpt xts = + Exn.withEscape + (fn escape => + SOME (Vector.map + (xts, fn (x, t) => + case simplifyVarType (x, t) of + NONE => escape NONE + | SOME t => (x, t)))) fun simplifyFormals xts = Vector.keepAllMap (xts, fn (x, t) => @@ -698,35 +706,41 @@ fun transform (Program.T {datatypes, globals, functions, main}) = Result.layout Statement.layout) simplifyStatement fun simplifyBlock (Block.T {label, args, statements, transfer}) = - let - val args = simplifyFormals args - val statements = - Vector.fold' - (statements, 0, [], fn (_, statement, statements) => - case simplifyStatement statement of - Bugg => Vector.Done NONE - | Delete => Vector.Continue statements - | Keep s => Vector.Continue (s :: statements), - SOME o Vector.fromListRev) - in - case statements of - NONE => ({dead = true}, - Block.T {label = label, - args = args, - statements = Vector.new0 (), - transfer = Bug}) - | SOME statements => - let - val (stmts, transfer) = simplifyTransfer transfer - val statements = Vector.concat [statements, stmts] - in - ({dead = false}, - Block.T {label = label, - args = args, - statements = statements, - transfer = transfer}) - end - end + case simplifyFormalsOpt args of + NONE => + (* It is impossible for a block to be called with a value of an + * uninhabited type; block must be unreachable. + *) + NONE + | SOME args => + let + val statements = + Vector.fold' + (statements, 0, [], fn (_, statement, statements) => + case simplifyStatement statement of + Bugg => Vector.Done NONE + | Delete => Vector.Continue statements + | Keep s => Vector.Continue (s :: statements), + SOME o Vector.fromListRev) + in + case statements of + NONE => SOME ({dead = true}, + Block.T {label = label, + args = args, + statements = Vector.new0 (), + transfer = Bug}) + | SOME statements => + let + val (stmts, transfer) = simplifyTransfer transfer + val statements = Vector.concat [statements, stmts] + in + SOME ({dead = false}, + Block.T {label = label, + args = args, + statements = statements, + transfer = transfer}) + end + end fun simplifyFunction f = let val {args, mayInline, name, raises, returns, start, ...} = @@ -735,14 +749,16 @@ fun transform (Program.T {datatypes, globals, functions, main}) = val blocks = ref [] fun loop (Tree.T (b, children)) = - let - val ({dead}, b) = simplifyBlock b - val _ = List.push (blocks, b) - in - if dead - then () - else Tree.Seq.foreach (children, loop) - end + case simplifyBlock b of + NONE => () + | SOME ({dead}, b) => + let + val _ = List.push (blocks, b) + in + if dead + then () + else Tree.Seq.foreach (children, loop) + end val _ = loop (Function.dominatorTree f) val returns = Option.map (returns, keepSimplifyTypes) From efeb4ccee30ea7e814be497793f56c0bd667cefc Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Thu, 13 Feb 2020 10:18:53 -0500 Subject: [PATCH 06/19] Rename `SimplifyTypes.Result.Bugg` to `Dead` --- mlton/ssa/simplify-types.fun | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/mlton/ssa/simplify-types.fun b/mlton/ssa/simplify-types.fun index 39a3aac0a7..c16ddd78ec 100644 --- a/mlton/ssa/simplify-types.fun +++ b/mlton/ssa/simplify-types.fun @@ -153,7 +153,7 @@ structure ConRep = structure Result = struct datatype 'a t = - Bugg + Dead | Delete | Keep of 'a @@ -161,7 +161,7 @@ structure Result = let open Layout in - fn Bugg => str "Bug" + fn Dead => str "Dead" | Delete => str "Delete" | Keep x => seq [str "Keep ", layoutX x] end @@ -550,7 +550,7 @@ fun transform (Program.T {datatypes, globals, functions, main}) = | ConRep.Useful => Keep (ConApp {con = con, args = removeUselessVars args}) - | ConRep.Useless => Bugg) + | ConRep.Useless => Dead) | PrimApp {prim, targs, args} => Keep (let @@ -690,13 +690,13 @@ fun transform (Program.T {datatypes, globals, functions, main}) = * the vector of length 0; this `Vector_sub` is unreachable due * to a dominating bounds check that must necessarily fail. *) - Bugg + Dead | SOME ty => (* It is wrong to omit calling simplifyExp when var = NONE because * targs in a PrimApp may still need to be simplified. *) (case simplifyExp exp of - Bugg => Bugg + Dead => Dead | Delete => Delete | Keep exp => Keep (Statement.T {var = var, ty = ty, exp = exp})) val simplifyStatement = @@ -718,7 +718,7 @@ fun transform (Program.T {datatypes, globals, functions, main}) = Vector.fold' (statements, 0, [], fn (_, statement, statements) => case simplifyStatement statement of - Bugg => Vector.Done NONE + Dead => Vector.Done NONE | Delete => Vector.Continue statements | Keep s => Vector.Continue (s :: statements), SOME o Vector.fromListRev) @@ -779,7 +779,7 @@ fun transform (Program.T {datatypes, globals, functions, main}) = exp = Exp.unit}), Vector.keepAllMap (globals, fn s => case simplifyStatement s of - Bugg => Error.bug "SimplifyTypes.globals: bind can't fail" + Dead => Error.bug "SimplifyTypes.globals: Dead" | Delete => NONE | Keep b => SOME b)] val shrink = shrinkFunction {globals = globals} From 674c8205f54a29c81c1ce83455dd588774172868 Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Thu, 13 Feb 2020 10:41:40 -0500 Subject: [PATCH 07/19] Use an explicit `void` type for sequences of uninhabited types Rather than using `unit` --- mlton/ssa/simplify-types.fun | 18 ++++++++++++------ 1 file changed, 12 insertions(+), 6 deletions(-) diff --git a/mlton/ssa/simplify-types.fun b/mlton/ssa/simplify-types.fun index c16ddd78ec..8cb2651ee4 100644 --- a/mlton/ssa/simplify-types.fun +++ b/mlton/ssa/simplify-types.fun @@ -430,6 +430,8 @@ fun transform (Program.T {datatypes, globals, functions, main}) = else (transparent (tycon, con, args) ; accum)) + val void = Tycon.newString "void" + fun makeSimplifyTypeFns simplifyTypeOpt = let fun simplifyType t = @@ -437,9 +439,9 @@ fun transform (Program.T {datatypes, globals, functions, main}) = NONE => Error.bug (concat ["SimplifyTypes.simplifyType: ", Layout.toString (Type.layout t)]) | SOME t => t - fun simplifyTypeAsUnit t = + fun simplifyTypeAsVoid t = case simplifyTypeOpt t of - NONE => Type.unit + NONE => Type.datatypee void | SOME t => t fun simplifyTypesOpt ts = Exn.withEscape @@ -452,7 +454,7 @@ fun transform (Program.T {datatypes, globals, functions, main}) = fun keepSimplifyTypes ts = Vector.keepAllMap (ts, simplifyTypeOpt) in {simplifyType = simplifyType, - simplifyTypeAsUnit = simplifyTypeAsUnit, + simplifyTypeAsVoid = simplifyTypeAsVoid, simplifyTypes = simplifyTypes, simplifyTypesOpt = simplifyTypesOpt, keepSimplifyTypes = keepSimplifyTypes} @@ -465,12 +467,12 @@ fun transform (Program.T {datatypes, globals, functions, main}) = if Cardinality.isZero (typeCardinality t) then NONE else SOME (let - val {simplifyType, simplifyTypeAsUnit, simplifyTypes, ...} = + val {simplifyType, simplifyTypeAsVoid, simplifyTypes, ...} = makeSimplifyTypeFns simplifyTypeOpt open Type in case dest t of - Array t => array (simplifyTypeAsUnit t) + Array t => array (simplifyTypeAsVoid t) | Datatype tycon => (case tyconReplacement tycon of SOME t => @@ -483,7 +485,7 @@ fun transform (Program.T {datatypes, globals, functions, main}) = | NONE => t) | Ref t => reff (simplifyType t) | Tuple ts => Type.tuple (simplifyTypes ts) - | Vector t => vector (simplifyTypeAsUnit t) + | Vector t => vector (simplifyTypeAsVoid t) | Weak t => weak (simplifyType t) | _ => t end))) @@ -501,6 +503,10 @@ fun transform (Program.T {datatypes, globals, functions, main}) = cons = Vector.map (cons, fn {con, args} => {con = con, args = keepSimplifyTypes args})})) + val datatypes = + Vector.concat + [Vector.new1 (Datatype.T {tycon = void, cons = Vector.new0 ()}), + datatypes] val unitVar = Var.newNoname () val {get = varInfo: Var.t -> Type.t, set = setVarInfo, ...} = Property.getSetOnce From 08d219704356648fcd9319ee78dd2ce50c76b104 Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Thu, 13 Feb 2020 10:43:47 -0500 Subject: [PATCH 08/19] Don't need to record information about uninhabited datatypes --- mlton/ssa/simplify-types.fun | 9 +++------ 1 file changed, 3 insertions(+), 6 deletions(-) diff --git a/mlton/ssa/simplify-types.fun b/mlton/ssa/simplify-types.fun index 8cb2651ee4..c69c4f459d 100644 --- a/mlton/ssa/simplify-types.fun +++ b/mlton/ssa/simplify-types.fun @@ -320,9 +320,8 @@ fun transform (Program.T {datatypes, globals, functions, main}) = conCardinality con)) in if Vector.isEmpty cons - then (setTyconReplacement (tycon, SOME Type.unit) - ; NONE) - else SOME (Datatype.T {tycon = tycon, cons = cons}) + then NONE + else SOME (Datatype.T {tycon = tycon, cons = cons}) end) (* diagnostic *) val _ = @@ -380,9 +379,7 @@ fun transform (Program.T {datatypes, globals, functions, main}) = else SOME c) in case Vector.length cons of - 0 => (setTyconNumCons (tycon, 0) - ; setTyconReplacement (tycon, SOME Type.unit) - ; (datatypes, unary)) + 0 => (datatypes, unary) | 1 => let val {con, args} = Vector.first cons From ed7d109115ae8c8dddb445ee0ee2f98b4dea138c Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Thu, 13 Feb 2020 11:03:13 -0500 Subject: [PATCH 09/19] Further optimize `SimplifyTypes` It is impossible for a function to be called with a value of an uninhabited type. --- mlton/ssa/simplify-types.fun | 67 +++++++++++++++++++----------------- 1 file changed, 35 insertions(+), 32 deletions(-) diff --git a/mlton/ssa/simplify-types.fun b/mlton/ssa/simplify-types.fun index c69c4f459d..2484495fd6 100644 --- a/mlton/ssa/simplify-types.fun +++ b/mlton/ssa/simplify-types.fun @@ -537,12 +537,6 @@ fun transform (Program.T {datatypes, globals, functions, main}) = case simplifyVarType (x, t) of NONE => escape NONE | SOME t => (x, t)))) - fun simplifyFormals xts = - Vector.keepAllMap - (xts, fn (x, t) => - case simplifyVarType (x, t) of - NONE => NONE - | SOME t => SOME (x, t)) val typeIsUseful = Option.isSome o simplifyTypeOpt datatype result = datatype Result.t fun simplifyExp (e: Exp.t): Exp.t result = @@ -748,32 +742,40 @@ fun transform (Program.T {datatypes, globals, functions, main}) = let val {args, mayInline, name, raises, returns, start, ...} = Function.dest f - val args = simplifyFormals args - val blocks = ref [] - - fun loop (Tree.T (b, children)) = - case simplifyBlock b of - NONE => () - | SOME ({dead}, b) => - let - val _ = List.push (blocks, b) - in - if dead - then () - else Tree.Seq.foreach (children, loop) - end - val _ = loop (Function.dominatorTree f) - - val returns = Option.map (returns, keepSimplifyTypes) - val raises = Option.map (raises, keepSimplifyTypes) in - Function.new {args = args, - blocks = Vector.fromList (!blocks), - mayInline = mayInline, - name = name, - raises = raises, - returns = returns, - start = start} + case simplifyFormalsOpt args of + NONE => + (* It is impossible for a function to be called with a value of an + * uninhabited type; function must be unreachable. + *) + NONE + | SOME args => + let + val blocks = ref [] + fun loop (Tree.T (b, children)) = + case simplifyBlock b of + NONE => () + | SOME ({dead}, b) => + let + val _ = List.push (blocks, b) + in + if dead + then () + else Tree.Seq.foreach (children, loop) + end + val _ = loop (Function.dominatorTree f) + + val returns = Option.map (returns, keepSimplifyTypes) + val raises = Option.map (raises, keepSimplifyTypes) + in + SOME (Function.new {args = args, + blocks = Vector.fromList (!blocks), + mayInline = mayInline, + name = name, + raises = raises, + returns = returns, + start = start}) + end end val globals = Vector.concat @@ -786,7 +788,8 @@ fun transform (Program.T {datatypes, globals, functions, main}) = | Delete => NONE | Keep b => SOME b)] val shrink = shrinkFunction {globals = globals} - val functions = List.revMap (functions, shrink o simplifyFunction) + val simplifyFunction = fn f => Option.map (simplifyFunction f, shrink) + val functions = List.revKeepAllMap (functions, simplifyFunction) val program = Program.T {datatypes = datatypes, globals = globals, From fab36d3a79b8878e93c4edcc5802e7cec6ac6a40 Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Thu, 13 Feb 2020 11:12:41 -0500 Subject: [PATCH 10/19] Further optimize `SimplifyTypes` It is impossible for a primitive to be called with a value of an uninhabited type. Hence, a reachable primitive must have all inhabited (and therefore useful) arguments. As a further consequence, a reachable `MLton_eq` and `MLton_equal` must have all inhabited (and therefore useful) arguments and there will be no opportunity to simplify the equality to `true`. --- mlton/ssa/simplify-types.fun | 22 +++++----------------- 1 file changed, 5 insertions(+), 17 deletions(-) diff --git a/mlton/ssa/simplify-types.fun b/mlton/ssa/simplify-types.fun index 2484495fd6..97035920a6 100644 --- a/mlton/ssa/simplify-types.fun +++ b/mlton/ssa/simplify-types.fun @@ -8,8 +8,7 @@ *) (* This pass must happen before polymorphic equality is implemented because - * 1. it will make polymorphic equality faster because some types are simpler - * 2. it removes uses of polymorphic equality that must return true + * it will make polymorphic equality faster because some types are simpler * * This pass computes a "cardinality" of each datatype, which is an * abstraction of the number of values of the datatype. @@ -518,8 +517,6 @@ fun transform (Program.T {datatypes, globals, functions, main}) = val oldVarType = varInfo val newVarType = simplifyTypeOpt o oldVarType val varIsUseless = Option.isNone o newVarType - fun simplifyVar (x: Var.t): Var.t = - if varIsUseless x then unitVar else x fun removeUselessVars xs = Vector.keepAll (xs, not o varIsUseless) fun tuple xs = let @@ -554,20 +551,11 @@ fun transform (Program.T {datatypes, globals, functions, main}) = fun normal () = PrimApp {prim = prim, targs = simplifyTypes targs, - args = Vector.map (args, simplifyVar)} - fun equal () = - if 2 = Vector.length args - then if varIsUseless (Vector.first args) - then ConApp {con = Con.truee, - args = Vector.new0 ()} - else normal () - else Error.bug "SimplifyTypes.simplifyExp: strange eq/equal PrimApp" - open Prim.Name + args = args} + datatype z = datatype Prim.Name.t in case Prim.name prim of - MLton_eq => equal () - | MLton_equal => equal () - | _ => normal () + _ => normal () end) | Select {tuple, offset} => let @@ -669,7 +657,7 @@ fun transform (Program.T {datatypes, globals, functions, main}) = | Return xs => (Vector.new0 (), Return (removeUselessVars xs)) | Runtime {prim, args, return} => (Vector.new0 (), Runtime {prim = prim, - args = Vector.map (args, simplifyVar), + args = args, return = return}) val simplifyTransfer = Trace.trace From 3b8f3f782715f86716066e7ac34b306f1e796163 Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Thu, 13 Feb 2020 11:26:06 -0500 Subject: [PATCH 11/19] Further optimize `SimplifyTypes` An array or vector of an uninhabited type is necessarily empty. This is important, because while an `Array_sub` or `Vector_sub` of a sequence of an uninhabited type will be recognized as unreachable, the "origin" of the unreachability is the dominating bounds check that must necessarily fail. Replacing `Array_length` and `Vector_length` of a sequence of an uninhabited type allows the dominating bounds check to be simplified. --- mlton/ssa/simplify-types.fun | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/mlton/ssa/simplify-types.fun b/mlton/ssa/simplify-types.fun index 97035920a6..dd70e3365c 100644 --- a/mlton/ssa/simplify-types.fun +++ b/mlton/ssa/simplify-types.fun @@ -552,10 +552,16 @@ fun transform (Program.T {datatypes, globals, functions, main}) = PrimApp {prim = prim, targs = simplifyTypes targs, args = args} + fun length () = + case simplifyTypeOpt (Vector.first targs) of + NONE => Exp.Const (Const.word (WordX.zero (WordSize.seqIndex ()))) + | SOME _ => normal () datatype z = datatype Prim.Name.t in case Prim.name prim of - _ => normal () + Array_length => length () + | Vector_length => length () + | _ => normal () end) | Select {tuple, offset} => let From d6f732ba5270409a3027ec94a26328c02ce58fa8 Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Thu, 13 Feb 2020 11:32:07 -0500 Subject: [PATCH 12/19] Eliminate (now) unused `unitVar` from `SimplifyTypes` --- mlton/ssa/simplify-types.fun | 15 +++++---------- 1 file changed, 5 insertions(+), 10 deletions(-) diff --git a/mlton/ssa/simplify-types.fun b/mlton/ssa/simplify-types.fun index dd70e3365c..3391f97aab 100644 --- a/mlton/ssa/simplify-types.fun +++ b/mlton/ssa/simplify-types.fun @@ -503,7 +503,6 @@ fun transform (Program.T {datatypes, globals, functions, main}) = Vector.concat [Vector.new1 (Datatype.T {tycon = void, cons = Vector.new0 ()}), datatypes] - val unitVar = Var.newNoname () val {get = varInfo: Var.t -> Type.t, set = setVarInfo, ...} = Property.getSetOnce (Var.plist, Property.initRaise ("varInfo", Var.layout)) @@ -772,15 +771,11 @@ fun transform (Program.T {datatypes, globals, functions, main}) = end end val globals = - Vector.concat - [Vector.new1 (Statement.T {var = SOME unitVar, - ty = Type.unit, - exp = Exp.unit}), - Vector.keepAllMap (globals, fn s => - case simplifyStatement s of - Dead => Error.bug "SimplifyTypes.globals: Dead" - | Delete => NONE - | Keep b => SOME b)] + Vector.keepAllMap (globals, fn s => + case simplifyStatement s of + Dead => Error.bug "SimplifyTypes.globals: Dead" + | Delete => NONE + | Keep b => SOME b) val shrink = shrinkFunction {globals = globals} val simplifyFunction = fn f => Option.map (simplifyFunction f, shrink) val functions = List.revKeepAllMap (functions, simplifyFunction) From 33614ae2a6aabed478c0eea67a150fe44f907245 Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Thu, 13 Feb 2020 11:34:26 -0500 Subject: [PATCH 13/19] Further optimize `SimplifyTypes` It is impossible to `ConApp`, `Call`, `Raise`, or `Return` with a value of an uninhabited type. Hence, a reachable `ConApp`, `Call`, `Raise`, or `Return` must have all inhabited (and therefore useful) arguments. --- mlton/ssa/simplify-types.fun | 60 +++++++++++------------------------- 1 file changed, 18 insertions(+), 42 deletions(-) diff --git a/mlton/ssa/simplify-types.fun b/mlton/ssa/simplify-types.fun index 3391f97aab..30e28afe68 100644 --- a/mlton/ssa/simplify-types.fun +++ b/mlton/ssa/simplify-types.fun @@ -498,7 +498,7 @@ fun transform (Program.T {datatypes, globals, functions, main}) = ; Datatype.T {tycon = tycon, cons = Vector.map (cons, fn {con, args} => {con = con, - args = keepSimplifyTypes args})})) + args = simplifyTypes args})})) val datatypes = Vector.concat [Vector.new1 (Datatype.T {tycon = void, cons = Vector.new0 ()}), @@ -514,17 +514,10 @@ fun transform (Program.T {datatypes, globals, functions, main}) = SOME x => simplifyVarType (x, t) | NONE => simplifyTypeOpt t val oldVarType = varInfo - val newVarType = simplifyTypeOpt o oldVarType - val varIsUseless = Option.isNone o newVarType - fun removeUselessVars xs = Vector.keepAll (xs, not o varIsUseless) fun tuple xs = - let - val xs = removeUselessVars xs - in - if 1 = Vector.length xs - then Var (Vector.first xs) - else Tuple xs - end + if 1 = Vector.length xs + then Var (Vector.first xs) + else Tuple xs fun simplifyFormalsOpt xts = Exn.withEscape (fn escape => @@ -533,16 +526,13 @@ fun transform (Program.T {datatypes, globals, functions, main}) = case simplifyVarType (x, t) of NONE => escape NONE | SOME t => (x, t)))) - val typeIsUseful = Option.isSome o simplifyTypeOpt datatype result = datatype Result.t fun simplifyExp (e: Exp.t): Exp.t result = case e of ConApp {con, args} => (case conRep con of ConRep.Transparent => Keep (tuple args) - | ConRep.Useful => - Keep (ConApp {con = con, - args = removeUselessVars args}) + | ConRep.Useful => Keep (ConApp {con = con, args = args}) | ConRep.Useless => Dead) | PrimApp {prim, targs, args} => Keep @@ -563,27 +553,14 @@ fun transform (Program.T {datatypes, globals, functions, main}) = | _ => normal () end) | Select {tuple, offset} => - let - val ts = Type.deTuple (oldVarType tuple) - in - Vector.fold' - (ts, 0, (offset, 0), fn (pos, t, (n, offset)) => - if n = 0 - then (Vector.Done - (Keep - (if offset = 0 - andalso not (Vector.existsR - (ts, pos + 1, Vector.length ts, - typeIsUseful)) - then Var tuple - else Select {tuple = tuple, - offset = offset}))) - else Vector.Continue (n - 1, - if typeIsUseful t - then offset + 1 - else offset), - fn _ => Error.bug "SimplifyTypes.simplifyExp: Select:newOffset") - end + Keep + (let + val ts = Type.deTuple (oldVarType tuple) + in + if Vector.length ts = 1 + then Var tuple + else Select {tuple = tuple, offset = offset} + end) | Tuple xs => Keep (tuple xs) | _ => Keep e val simplifyExp = @@ -595,8 +572,7 @@ fun transform (Program.T {datatypes, globals, functions, main}) = Bug => (Vector.new0 (), t) | Call {func, args, return} => (Vector.new0 (), - Call {func = func, return = return, - args = removeUselessVars args}) + Call {func = func, return = return, args = args}) | Case {test, cases = Cases.Con cases, default} => let val cases = @@ -631,7 +607,7 @@ fun transform (Program.T {datatypes, globals, functions, main}) = normal () else (* The type has become a tuple. Do the selects. *) let - val ts = keepSimplifyTypes (conArgs con) + val ts = simplifyTypes (conArgs con) val (args, stmts) = if 1 = Vector.length ts then (Vector.new1 test, Vector.new0 ()) @@ -657,9 +633,9 @@ fun transform (Program.T {datatypes, globals, functions, main}) = end | Case _ => (Vector.new0 (), t) | Goto {dst, args} => - (Vector.new0 (), Goto {dst = dst, args = removeUselessVars args}) - | Raise xs => (Vector.new0 (), Raise (removeUselessVars xs)) - | Return xs => (Vector.new0 (), Return (removeUselessVars xs)) + (Vector.new0 (), Goto {dst = dst, args = args}) + | Raise xs => (Vector.new0 (), Raise xs) + | Return xs => (Vector.new0 (), Return xs) | Runtime {prim, args, return} => (Vector.new0 (), Runtime {prim = prim, args = args, From cdc536d584a1a6d2632cc7829a49a9a7ca070169 Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Thu, 13 Feb 2020 13:07:37 -0500 Subject: [PATCH 14/19] Fix latent bug in previous optimization of `SimplifyTypes` In a previous commit, it was noted that it is impossible for a block to be called with a value of an uninhabited type. This was used to justify not including such a block in the transformed function. One example is a block that is the target of a `Case` transfer for a `Useless` constructor. The corresponding branch of the `Case` transfer will be eliminated and the block will not have a use in the transformed function. However, it is possible for such a block to be the `cont` or `handle` of a non-tail call. While it will be impossible for the called function to `Return` or `Raise` with a value of an uninhabited type, the type of the function must be (mostly) preserved. In particular, the `returns` and `raises` are transformed via: val returns = Option.map (returns, keepSimplifyTypes) val raises = Option.map (raises, keepSimplifyTypes) where `keepSimplifyTypes` drops uninhabited components. Because the `returns` and `raises` of the function are not eliminated, the `cont` and `handle` blocks cannot be eliminated. On the other hand, when the block is the target of a `Case` transfer for a `Useless` constructor, then there will be no use of the block in the transformed program and the block will be eliminated by `Shrink`. While it would be possible to adjust the `cont` and `handle` at a `Call`, it is non-trivial. For example, a function that purports to return a value of an uninhabited type cannot actually `Return`, but could continue to `Raise`. However, the SSA IR cannot express a non-tail call with a `handle` but no `cont`, so some dummy `cont` block would nonetheless be required. Moreover, it would require inspecting the `returns` and `raises` types of the called function, which are not currently recorded in a property for `SimplifyTypes`. Finally, this kind of calling-convention adjustment is suitably handled by `RemoveUnused`. --- mlton/ssa/simplify-types.fun | 73 +++++++++++++++++++++--------------- 1 file changed, 42 insertions(+), 31 deletions(-) diff --git a/mlton/ssa/simplify-types.fun b/mlton/ssa/simplify-types.fun index 30e28afe68..5e6582dce8 100644 --- a/mlton/ssa/simplify-types.fun +++ b/mlton/ssa/simplify-types.fun @@ -518,14 +518,24 @@ fun transform (Program.T {datatypes, globals, functions, main}) = if 1 = Vector.length xs then Var (Vector.first xs) else Tuple xs + fun simplifyFormals xts = + let + val dead = ref false + val xts = + Vector.keepAllMap + (xts, fn (x, t) => + case simplifyVarType (x, t) of + NONE => (dead := true; NONE) + | SOME t => SOME (x, t)) + in + ({dead = !dead}, xts) + end fun simplifyFormalsOpt xts = - Exn.withEscape - (fn escape => - SOME (Vector.map - (xts, fn (x, t) => - case simplifyVarType (x, t) of - NONE => escape NONE - | SOME t => (x, t)))) + let + val ({dead}, xts) = simplifyFormals xts + in + if dead then NONE else SOME xts + end datatype result = datatype Result.t fun simplifyExp (e: Exp.t): Exp.t result = case e of @@ -672,13 +682,16 @@ fun transform (Program.T {datatypes, globals, functions, main}) = Result.layout Statement.layout) simplifyStatement fun simplifyBlock (Block.T {label, args, statements, transfer}) = - case simplifyFormalsOpt args of - NONE => + case simplifyFormals args of + ({dead = true}, args) => (* It is impossible for a block to be called with a value of an * uninhabited type; block must be unreachable. *) - NONE - | SOME args => + ({dead = true}, Block.T {label = label, + args = args, + statements = Vector.new0 (), + transfer = Bug}) + | ({dead = false}, args) => let val statements = Vector.fold' @@ -690,21 +703,21 @@ fun transform (Program.T {datatypes, globals, functions, main}) = SOME o Vector.fromListRev) in case statements of - NONE => SOME ({dead = true}, - Block.T {label = label, - args = args, - statements = Vector.new0 (), - transfer = Bug}) + NONE => ({dead = true}, + Block.T {label = label, + args = args, + statements = Vector.new0 (), + transfer = Bug}) | SOME statements => let val (stmts, transfer) = simplifyTransfer transfer val statements = Vector.concat [statements, stmts] in - SOME ({dead = false}, - Block.T {label = label, - args = args, - statements = statements, - transfer = transfer}) + ({dead = false}, + Block.T {label = label, + args = args, + statements = statements, + transfer = transfer}) end end fun simplifyFunction f = @@ -722,16 +735,14 @@ fun transform (Program.T {datatypes, globals, functions, main}) = let val blocks = ref [] fun loop (Tree.T (b, children)) = - case simplifyBlock b of - NONE => () - | SOME ({dead}, b) => - let - val _ = List.push (blocks, b) - in - if dead - then () - else Tree.Seq.foreach (children, loop) - end + let + val ({dead}, b) = simplifyBlock b + val _ = List.push (blocks, b) + in + if dead + then () + else Tree.Seq.foreach (children, loop) + end val _ = loop (Function.dominatorTree f) val returns = Option.map (returns, keepSimplifyTypes) From 92cc669d9c73f174498bb98fc0a3e224f15a11a3 Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Thu, 13 Feb 2020 13:21:37 -0500 Subject: [PATCH 15/19] Further optimize `SimplifyTypes` It is impossible to encounter a `ConRep.FFI` `ConApp`, because all `ConRep.FFI` constructors were converted to `ConRep.Useful`. It is impossible to encounter a `ConRep.Useless` `ConApp`, because it such constructors were deemed useless. --- mlton/ssa/simplify-types.fun | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/mlton/ssa/simplify-types.fun b/mlton/ssa/simplify-types.fun index 5e6582dce8..fb3a3be8d7 100644 --- a/mlton/ssa/simplify-types.fun +++ b/mlton/ssa/simplify-types.fun @@ -543,7 +543,7 @@ fun transform (Program.T {datatypes, globals, functions, main}) = (case conRep con of ConRep.Transparent => Keep (tuple args) | ConRep.Useful => Keep (ConApp {con = con, args = args}) - | ConRep.Useless => Dead) + | ConRep.Useless => Error.bug "SimplifyTypes.simplfyExp: ConApp, ConRep.Useless") | PrimApp {prim, targs, args} => Keep (let From 7f93cea64ad3d1946a775bb2f22419a432cfbc2f Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Thu, 13 Feb 2020 13:27:47 -0500 Subject: [PATCH 16/19] Further optimize `SimplifyTypes`; `simplifyExp` always succeeds --- mlton/ssa/simplify-types.fun | 65 +++++++++++++++++------------------- 1 file changed, 30 insertions(+), 35 deletions(-) diff --git a/mlton/ssa/simplify-types.fun b/mlton/ssa/simplify-types.fun index fb3a3be8d7..0318f8a0dd 100644 --- a/mlton/ssa/simplify-types.fun +++ b/mlton/ssa/simplify-types.fun @@ -537,45 +537,43 @@ fun transform (Program.T {datatypes, globals, functions, main}) = if dead then NONE else SOME xts end datatype result = datatype Result.t - fun simplifyExp (e: Exp.t): Exp.t result = + fun simplifyExp (e: Exp.t): Exp.t = case e of ConApp {con, args} => (case conRep con of - ConRep.Transparent => Keep (tuple args) - | ConRep.Useful => Keep (ConApp {con = con, args = args}) + ConRep.Transparent => tuple args + | ConRep.Useful => ConApp {con = con, args = args} | ConRep.Useless => Error.bug "SimplifyTypes.simplfyExp: ConApp, ConRep.Useless") | PrimApp {prim, targs, args} => - Keep - (let - fun normal () = - PrimApp {prim = prim, - targs = simplifyTypes targs, - args = args} - fun length () = - case simplifyTypeOpt (Vector.first targs) of - NONE => Exp.Const (Const.word (WordX.zero (WordSize.seqIndex ()))) - | SOME _ => normal () - datatype z = datatype Prim.Name.t - in - case Prim.name prim of - Array_length => length () - | Vector_length => length () - | _ => normal () - end) + let + fun normal () = + PrimApp {prim = prim, + targs = simplifyTypes targs, + args = args} + fun length () = + case simplifyTypeOpt (Vector.first targs) of + NONE => Exp.Const (Const.word (WordX.zero (WordSize.seqIndex ()))) + | SOME _ => normal () + datatype z = datatype Prim.Name.t + in + case Prim.name prim of + Array_length => length () + | Vector_length => length () + | _ => normal () + end | Select {tuple, offset} => - Keep - (let - val ts = Type.deTuple (oldVarType tuple) - in - if Vector.length ts = 1 - then Var tuple - else Select {tuple = tuple, offset = offset} - end) - | Tuple xs => Keep (tuple xs) - | _ => Keep e + let + val ts = Type.deTuple (oldVarType tuple) + in + if Vector.length ts = 1 + then Var tuple + else Select {tuple = tuple, offset = offset} + end + | Tuple xs => tuple xs + | _ => e val simplifyExp = Trace.trace ("SimplifyTypes.simplifyExp", - Exp.layout, Result.layout Exp.layout) + Exp.layout, Exp.layout) simplifyExp fun simplifyTransfer (t : Transfer.t): Statement.t vector * Transfer.t = case t of @@ -671,10 +669,7 @@ fun transform (Program.T {datatypes, globals, functions, main}) = (* It is wrong to omit calling simplifyExp when var = NONE because * targs in a PrimApp may still need to be simplified. *) - (case simplifyExp exp of - Dead => Dead - | Delete => Delete - | Keep exp => Keep (Statement.T {var = var, ty = ty, exp = exp})) + Keep (Statement.T {var = var, ty = ty, exp = simplifyExp exp}) val simplifyStatement = Trace.trace ("SimplifyTypes.simplifyStatement", From 297677aececbfb062a07b3c603d85a89d6b8b0e2 Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Thu, 13 Feb 2020 13:36:39 -0500 Subject: [PATCH 17/19] Eliminate unnecessary `structure Result` in `SimplifyTypes` All statements are either dead or kept (and none are deleted), so a simple option suffices. --- mlton/ssa/simplify-types.fun | 41 ++++++++++-------------------------- 1 file changed, 11 insertions(+), 30 deletions(-) diff --git a/mlton/ssa/simplify-types.fun b/mlton/ssa/simplify-types.fun index 0318f8a0dd..6cad302317 100644 --- a/mlton/ssa/simplify-types.fun +++ b/mlton/ssa/simplify-types.fun @@ -149,23 +149,6 @@ structure ConRep = val layout = Layout.str o toString end -structure Result = - struct - datatype 'a t = - Dead - | Delete - | Keep of 'a - - fun layout layoutX = - let - open Layout - in - fn Dead => str "Dead" - | Delete => str "Delete" - | Keep x => seq [str "Keep ", layoutX x] - end - end - fun transform (Program.T {datatypes, globals, functions, main}) = let val {get = conInfo: Con.t -> {args: Type.t vector, @@ -664,17 +647,17 @@ fun transform (Program.T {datatypes, globals, functions, main}) = * the vector of length 0; this `Vector_sub` is unreachable due * to a dominating bounds check that must necessarily fail. *) - Dead + NONE | SOME ty => (* It is wrong to omit calling simplifyExp when var = NONE because * targs in a PrimApp may still need to be simplified. *) - Keep (Statement.T {var = var, ty = ty, exp = simplifyExp exp}) + SOME (Statement.T {var = var, ty = ty, exp = simplifyExp exp}) val simplifyStatement = Trace.trace ("SimplifyTypes.simplifyStatement", Statement.layout, - Result.layout Statement.layout) + Option.layout Statement.layout) simplifyStatement fun simplifyBlock (Block.T {label, args, statements, transfer}) = case simplifyFormals args of @@ -689,13 +672,12 @@ fun transform (Program.T {datatypes, globals, functions, main}) = | ({dead = false}, args) => let val statements = - Vector.fold' - (statements, 0, [], fn (_, statement, statements) => - case simplifyStatement statement of - Dead => Vector.Done NONE - | Delete => Vector.Continue statements - | Keep s => Vector.Continue (s :: statements), - SOME o Vector.fromListRev) + Exn.withEscape + (fn escape => + SOME (Vector.map (statements, fn s => + case simplifyStatement s of + NONE => escape NONE + | SOME s => s))) in case statements of NONE => ({dead = true}, @@ -755,9 +737,8 @@ fun transform (Program.T {datatypes, globals, functions, main}) = val globals = Vector.keepAllMap (globals, fn s => case simplifyStatement s of - Dead => Error.bug "SimplifyTypes.globals: Dead" - | Delete => NONE - | Keep b => SOME b) + NONE => Error.bug "SimplifyTypes.globals: NONE" + | SOME s => SOME s) val shrink = shrinkFunction {globals = globals} val simplifyFunction = fn f => Option.map (simplifyFunction f, shrink) val functions = List.revKeepAllMap (functions, simplifyFunction) From 0ace0ffee3c4de144871a76b83ec6ab1d81a93b0 Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Fri, 14 Feb 2020 11:48:12 -0500 Subject: [PATCH 18/19] Further optimize `SimplifyTypes` `MLton_eq` and `MLton_equal` at a type of cardinality 1 must return `true`. --- mlton/ssa/simplify-types.fun | 15 +++++++++++---- 1 file changed, 11 insertions(+), 4 deletions(-) diff --git a/mlton/ssa/simplify-types.fun b/mlton/ssa/simplify-types.fun index 6cad302317..d9092ccd33 100644 --- a/mlton/ssa/simplify-types.fun +++ b/mlton/ssa/simplify-types.fun @@ -8,7 +8,8 @@ *) (* This pass must happen before polymorphic equality is implemented because - * it will make polymorphic equality faster because some types are simpler + * 1. it will make polymorphic equality faster because some types are simpler + * 2. it removes uses of polymorphic equality that must return true * * This pass computes a "cardinality" of each datatype, which is an * abstraction of the number of values of the datatype. @@ -533,14 +534,20 @@ fun transform (Program.T {datatypes, globals, functions, main}) = PrimApp {prim = prim, targs = simplifyTypes targs, args = args} + fun equal () = + if Cardinality.isOne (typeCardinality (Vector.first targs)) + then ConApp {con = Con.truee, args = Vector.new0 ()} + else normal () fun length () = - case simplifyTypeOpt (Vector.first targs) of - NONE => Exp.Const (Const.word (WordX.zero (WordSize.seqIndex ()))) - | SOME _ => normal () + if Cardinality.isZero (typeCardinality (Vector.first targs)) + then Exp.Const (Const.word (WordX.zero (WordSize.seqIndex ()))) + else normal () datatype z = datatype Prim.Name.t in case Prim.name prim of Array_length => length () + | MLton_eq => equal () + | MLton_equal => equal () | Vector_length => length () | _ => normal () end From 9b95df4df19773c30d49a1d2ab71b181a5150cfc Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Fri, 14 Feb 2020 11:54:18 -0500 Subject: [PATCH 19/19] Note `SimplifyTypes` bug fix in `CHANGELOG.adoc` --- CHANGELOG.adoc | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/CHANGELOG.adoc b/CHANGELOG.adoc index 89e86cc19b..88659f0a96 100644 --- a/CHANGELOG.adoc +++ b/CHANGELOG.adoc @@ -8,6 +8,9 @@ Here are the changes from version 20180206 to version YYYYMMDD. === Details +* 2020-02-14 + ** Fixed bug in `SimplifyTypes` SSA optimization pass. + * 2020-01-22 ** Added expert `-pi-style {default|npi|pic|pie}` and `-native-pic {false|true}` options, which can be used to override a @@ -16,7 +19,7 @@ Here are the changes from version 20180206 to version YYYYMMDD. * 2020-01-21 ** Support parallel build (i.e., `make -j`). This mainly supports - platforms/packagers tht use a parallel `make` by default; it does + platforms/packagers that use a parallel `make` by default; it does not obtain significant build speedups. * 2020-01-11