1 (* Copyright (C) 2009 Matthew Fluet.
2 * Copyright (C) 1999-2008 Henry Cejtin, Matthew Fluet, Suresh
3 * Jagannathan, and Stephen Weeks.
4 * Copyright (C) 1997-2000 NEC Research Institute.
6 * MLton is released under a BSD-style license.
7 * See the file MLton-LICENSE for details.
10 functor RemoveUnused (S: SSA_TRANSFORM_STRUCTS): SSA_TRANSFORM =
18 structure L = TwoPointLattice (val bottom = "unused"
23 val whenUsed = addHandler
28 structure L = TwoPointLattice (val bottom = "not coned"
33 val whenConed = addHandler
38 structure L = TwoPointLattice (val bottom = "not deconed"
47 structure L = TwoPointLattice (val bottom = "does not return"
48 val top = "may return")
52 val whenReturns = addHandler
57 structure L = TwoPointLattice (val bottom = "does not raise"
58 val top = "may raise")
62 val whenRaises = addHandler
68 datatype t = T of {ty: Type.t,
71 fun layout (T {used, ...}) = Used.layout used
74 fun make f (T r) = f r
80 fun new (ty : Type.t): t = T {ty = ty,
83 val use = Used.use o used
84 val isUsed = Used.isUsed o used
85 fun whenUsed (vi, th) = Used.whenUsed (used vi, th)
90 datatype t = T of {args: (VarInfo.t * Type.t) vector,
93 dummy: {con: Con.t, args: Type.t vector,
96 fun layout (T {args, coned, deconed, ...}) =
97 Layout.record [("args", Vector.layout (VarInfo.layout o #1) args),
98 ("coned", Coned.layout coned),
99 ("deconed", Deconed.layout deconed)]
102 fun make f (T r) = f r
104 val args = make #args
105 val coned = make #coned
106 val deconed = make #deconed
107 val dummy = make #dummy
110 val con = Coned.con o coned
111 val isConed = Coned.isConed o coned
112 fun whenConed (ci, th) = Coned.whenConed (coned ci, th)
114 val decon = Deconed.decon o deconed
115 val isDeconed = Deconed.isDeconed o deconed
117 fun new {args: Type.t vector,
118 dummy: {con: Con.t, args: Type.t vector
120 T {args = Vector.map (args, fn ty => (VarInfo.new ty, ty)),
121 coned = Coned.new (),
122 deconed = Deconed.new (),
126 structure TyconInfo =
128 datatype t = T of {cons: Con.t vector,
129 dummy: {con: Con.t, args: Type.t vector},
133 fun layout (T {used, ...}) =
134 Layout.record [("used", Used.layout used)]
137 fun make f (T r) = f r
138 fun make' f = (make f, ! o (make f))
140 val cons = make #cons
141 val dummy = make #dummy
142 val (numCons', numCons) = make' #numCons
143 val used = make #used
146 fun new {cons: Con.t vector,
147 dummy: {con: Con.t, args: Type.t vector}}: t =
156 datatype t = T of {deconed: bool ref,
157 simplify: Type.t option ref,
161 fun make f (T r) = f r
162 fun make' f = (make f, ! o (make f))
164 val (deconed', _) = make' #deconed
165 val (simplify', _) = make' #simplify
166 val (used', _) = make' #used
169 fun new (): t = T {deconed = ref false,
176 datatype t = T of {args: (VarInfo.t * Type.t) vector,
177 bugLabel: Label.t option ref,
178 mayRaise: MayRaise.t,
179 mayReturn: MayReturn.t,
180 raiseLabel: Label.t option ref,
181 raises: (VarInfo.t * Type.t) vector option,
182 returnLabel: Label.t option ref,
183 returns: (VarInfo.t * Type.t) vector option,
185 wrappers: Block.t list ref}
192 Layout.record [("args", Vector.layout
193 (Layout.tuple2 (VarInfo.layout, Type.layout))
195 ("mayRaise", MayRaise.layout mayRaise),
196 ("mayReturn", MayReturn.layout mayReturn),
197 ("raises", Option.layout
199 (Layout.tuple2 (VarInfo.layout, Type.layout)))
201 ("returns", Option.layout
203 (Layout.tuple2 (VarInfo.layout, Type.layout)))
205 ("used", Used.layout used)]
208 fun make f (T r) = f r
209 fun make' f = (make f, ! o (make f))
211 val args = make #args
212 val mayRaise' = make #mayRaise
213 val mayReturn' = make #mayReturn
214 val raiseLabel = make #raiseLabel
215 val raises = make #raises
216 val returnLabel = make #returnLabel
217 val returns = make #returns
218 val used = make #used
219 val (wrappers', wrappers) = make' #wrappers
222 val raisee = MayRaise.raisee o mayRaise'
223 val mayRaise = MayRaise.mayRaise o mayRaise'
224 fun whenRaises (fi, th) = MayRaise.whenRaises (mayRaise' fi, th)
225 fun flowRaises (fi, fi') = MayRaise.<= (mayRaise' fi, mayRaise' fi')
227 val return = MayReturn.return o mayReturn'
228 fun whenReturns (fi, th) = MayReturn.whenReturns (mayReturn' fi, th)
229 val mayReturn = MayReturn.mayReturn o mayReturn'
230 fun flowReturns (fi, fi') = MayReturn.<= (mayReturn' fi, mayReturn' fi')
232 val use = Used.use o used
233 val isUsed = Used.isUsed o used
234 fun whenUsed (fi, th) = Used.whenUsed (used fi, th)
236 fun new {args: (VarInfo.t * Type.t) vector,
237 raises: (VarInfo.t * Type.t) vector option,
238 returns: (VarInfo.t * Type.t) vector option}: t =
241 mayRaise = MayRaise.new (),
242 mayReturn = MayReturn.new (),
243 raiseLabel = ref NONE,
245 returnLabel = ref NONE,
251 structure LabelInfo =
253 datatype t = T of {args: (VarInfo.t * Type.t) vector,
256 wrappers: (Type.t vector * Label.t) list ref}
258 fun layout (T {args, used, ...}) =
259 Layout.record [("args", Vector.layout (VarInfo.layout o #1) args),
260 ("used", Used.layout used)]
262 fun new {args: (VarInfo.t * Type.t) vector, func: FuncInfo.t}: t =
269 fun make f (T r) = f r
270 fun make' f = (make f, ! o (make f))
272 val args = make #args
273 val func = make #func
274 val used = make #used
275 val (wrappers', wrappers) = make' #wrappers
278 val use = Used.use o used
279 val isUsed = Used.isUsed o used
280 fun whenUsed (li, th) = Used.whenUsed (used li, th)
284 fun transform (Program.T {datatypes, globals, functions, main}) =
286 val {get = conInfo: Con.t -> ConInfo.t,
287 set = setConInfo, ...} =
290 Property.initRaise ("RemoveUnused.conInfo", Con.layout))
291 fun newConInfo (con, args, dummy) =
292 setConInfo (con, ConInfo.new {args = args, dummy = dummy})
294 val {get = tyconInfo: Tycon.t -> TyconInfo.t,
295 set = setTyconInfo, ...} =
298 Property.initRaise ("RemoveUnused.tyconInfo", Tycon.layout))
299 fun newTyconInfo (tycon, cons, dummy) =
300 setTyconInfo (tycon, TyconInfo.new {cons = cons, dummy = dummy})
302 val {get = typeInfo: Type.t -> TypeInfo.t,
306 Property.initFun (fn _ => TypeInfo.new ()))
308 val {get = varInfo: Var.t -> VarInfo.t,
309 set = setVarInfo, ...} =
312 Property.initRaise ("RemoveUnused.varInfo", Var.layout))
313 fun newVarInfo (var, ty) =
314 setVarInfo (var, VarInfo.new ty)
316 val {get = labelInfo: Label.t -> LabelInfo.t,
317 set = setLabelInfo, ...} =
320 Property.initRaise ("RemoveUnused.labelInfo", Label.layout))
322 val {get = funcInfo: Func.t -> FuncInfo.t,
323 set = setFuncInfo, ...} =
326 Property.initRaise ("RemoveUnused.funcInfo", Func.layout))
328 val usedTycon = TyconInfo.used o tyconInfo
329 val useTycon = Used.use o usedTycon
330 fun visitTycon (tycon: Tycon.t) = useTycon tycon
331 val isUsedTycon = Used.isUsed o usedTycon
333 fun visitType (ty: Type.t) =
336 val used = TypeInfo.used' ti
341 val () = used := true
342 datatype z = datatype Type.dest
345 Array ty => visitType ty
346 | Datatype tycon => visitTycon tycon
347 | Ref ty => visitType ty
348 | Tuple tys => Vector.foreach (tys, visitType)
349 | Vector ty => visitType ty
350 | Weak ty => visitType ty
356 val visitTypeTh = fn ty => fn () => visitType ty
358 val tyVar = VarInfo.ty o varInfo
359 val usedVar = VarInfo.used o varInfo
360 val useVar = Used.use o usedVar
361 val isUsedVar = Used.isUsed o usedVar
362 val whenUsedVar = fn (var, th) => VarInfo.whenUsed (varInfo var, th)
363 fun flowVarInfoTyVarInfoTy ((vi, _), (vi', _)) =
364 Used.<= (VarInfo.used vi, VarInfo.used vi')
365 fun flowVarInfoTysVarInfoTys (xs, ys) =
366 Vector.foreach2 (xs, ys, flowVarInfoTyVarInfoTy)
367 fun flowVarInfoTyVar ((vi, _), x) =
368 Used.<= (VarInfo.used vi, usedVar x)
369 fun flowVarInfoTysVars (xs, ys) =
370 Vector.foreach2 (xs, ys, flowVarInfoTyVar)
372 val newVarInfo = fn (var, ty) =>
373 (newVarInfo (var, ty)
374 ; whenUsedVar (var, visitTypeTh ty))
376 val visitLabelInfo = LabelInfo.use
377 val visitLabelInfoTh = fn li => fn () => visitLabelInfo li
378 val visitLabel = visitLabelInfo o labelInfo
379 val visitLabelTh = fn l => fn () => visitLabel l
380 val visitFuncInfo = FuncInfo.use
381 val visitFunc = visitFuncInfo o funcInfo
383 fun visitVar (x: Var.t) = useVar x
384 fun visitVars (xs: Var.t Vector.t) = Vector.foreach (xs, visitVar)
385 fun visitExp (e: Exp.t) =
387 ConApp {con, args} =>
390 val () = ConInfo.con ci
391 val () = flowVarInfoTysVars (ConInfo.args ci, args)
396 | PrimApp {prim, args, ...} =>
398 val () = visitVars args
399 datatype z = datatype Type.dest
400 fun deconType (ty: Type.t) =
403 val deconed = TypeInfo.deconed' ti
408 val () = deconed := true
413 (TyconInfo.cons (tyconInfo t),
414 fn con => deconCon con)
415 | Tuple ts => Vector.foreach (ts, deconType)
416 | Vector t => deconType t
425 val () = ConInfo.decon ci
428 (ConInfo.args ci, fn (x, t) =>
435 case Prim.name prim of
436 Prim.Name.MLton_eq =>
437 (* MLton_eq may be used on datatypes used as enums. *)
438 deconType (tyVar (Vector.first args))
439 | Prim.Name.MLton_equal =>
440 (* MLton_equal will be expanded by poly-equal into uses
441 * of constructors as patterns.
443 deconType (tyVar (Vector.first args))
444 | Prim.Name.MLton_hash =>
445 (* MLton_hash will be expanded by poly-hash into uses
446 * of constructors as patterns.
448 deconType (tyVar (Vector.first args))
450 | Prim.Name.MLton_size =>
451 deconType (tyVar (Vector.first args))
458 | Select {tuple, ...} => visitVar tuple
459 | Tuple xs => visitVars xs
460 | Var x => visitVar x
461 val visitExpTh = fn e => fn () => visitExp e
462 fun maybeVisitVarExp (var, exp) =
463 Option.app (var, fn var =>
464 VarInfo.whenUsed (varInfo var, visitExpTh exp))
465 fun visitStatement (Statement.T {exp, var, ty, ...}) =
466 (Option.app (var, fn var => newVarInfo (var, ty))
467 ; if Exp.maySideEffect exp
470 else maybeVisitVarExp (var, exp))
471 fun visitTransfer (t: Transfer.t, fi: FuncInfo.t) =
473 Arith {args, overflow, success, ty, ...} =>
475 ; visitLabel overflow
479 | Call {args, func, return} =>
484 val (cont, handler) =
486 Return.Dead => (None, None)
487 | Return.NonTail {cont, handler} =>
490 Handler.Caller => Caller
491 | Handler.Dead => None
492 | Handler.Handle h => Some h)
493 | Return.Tail => (Caller, Caller)
494 val fi' = funcInfo func
495 val () = flowVarInfoTysVars (FuncInfo.args fi', args)
502 case (FuncInfo.returns fi,
503 FuncInfo.returns fi') of
504 (SOME xts, SOME xts') =>
505 flowVarInfoTysVarInfoTys (xts, xts')
507 val () = FuncInfo.flowReturns (fi', fi)
516 (FuncInfo.returns fi', fn xts =>
517 flowVarInfoTysVarInfoTys
518 (LabelInfo.args li, xts))
521 (fi', visitLabelInfoTh li)
531 case (FuncInfo.raises fi,
532 FuncInfo.raises fi') of
533 (SOME xts, SOME xts') =>
534 flowVarInfoTysVarInfoTys (xts, xts')
536 val () = FuncInfo.flowRaises (fi', fi)
545 (FuncInfo.raises fi', fn xts =>
546 flowVarInfoTysVarInfoTys
547 (LabelInfo.args li, xts))
549 FuncInfo.whenRaises (fi', visitLabelInfoTh li)
553 val () = visitFuncInfo fi'
557 | Case {test, cases, default} =>
559 val () = visitVar test
562 Cases.Word (_, cs) =>
563 (Vector.foreach (cs, visitLabel o #2)
564 ; Option.app (default, visitLabel))
566 if Vector.isEmpty cases
567 then Option.app (default, visitLabel)
571 (cases, fn (con, l) =>
574 val () = ConInfo.decon ci
577 flowVarInfoTysVarInfoTys
578 (LabelInfo.args li, ConInfo.args ci)
586 case Type.dest (tyVar test) of
587 Type.Datatype tycon => tycon
588 | _ => Error.bug "RemoveUnused.visitTransfer: Case:non-Datatype"
589 val cons = TyconInfo.cons (tyconInfo tycon)
602 (conInfo con, visitLabelTh l))
605 | Goto {dst, args} =>
607 val li = labelInfo dst
608 val () = flowVarInfoTysVars (LabelInfo.args li, args)
609 val () = visitLabelInfo li
615 ; flowVarInfoTysVars (valOf (FuncInfo.raises fi), xs))
618 ; flowVarInfoTysVars (valOf (FuncInfo.returns fi), xs))
619 | Runtime {args, return, ...} =>
622 fun visitBlock (Block.T {statements, transfer, ...}, fi: FuncInfo.t) =
623 (Vector.foreach (statements, visitStatement)
624 ; visitTransfer (transfer, fi))
625 val visitBlockTh = fn (b, fi) => fn () => visitBlock (b, fi)
626 (* Visit all reachable expressions. *)
629 (datatypes, fn Datatype.T {tycon, cons} =>
631 val dummyCon = Con.newString "dummy"
632 val dummyArgs = Vector.new0 ()
633 val dummy = {con = dummyCon, args = dummyArgs}
636 (tycon, Vector.map (cons, fn {con, ...} => con), dummy)
637 val dummyExp = ConApp {args = Vector.new0 (),
639 val dummy = {con = dummyCon, args = dummyArgs, exp = dummyExp}
642 (cons, fn {con, args} =>
643 newConInfo (con, args, dummy))
662 Vector.foreach (globals, visitStatement)
665 (functions, fn function =>
667 val {name, args, raises, returns, start, blocks, ...} =
668 Function.dest function
669 val () = Vector.foreach (args, newVarInfo)
672 Vector.map (vts, fn (x, t) => (varInfo x, t))
674 Vector.map (ts, fn t => (VarInfo.new t, t))
676 Option.map (ts, doitTys)
680 {args = doitVarTys args,
681 raises = doitTys' raises,
682 returns = doitTys' returns}
684 val () = setFuncInfo (name, fi)
685 val () = FuncInfo.whenUsed (fi, visitLabelTh start)
688 (blocks, fn block as Block.T {label, args, ...} =>
690 val () = Vector.foreach (args, newVarInfo)
693 Vector.map (vts, fn (x, t) => (varInfo x, t))
697 {args = doitVarTys args,
700 val () = setLabelInfo (label, li)
701 val () = LabelInfo.whenUsed (li, visitBlockTh (block, fi))
708 val () = visitFunc main
717 (datatypes, fn Datatype.T {tycon, cons} =>
718 display (seq [Tycon.layout tycon,
720 TyconInfo.layout (tyconInfo tycon),
726 ConInfo.layout (conInfo con)])
732 val {name, blocks, ...} = Function.dest f
734 display (seq [Func.layout name,
736 FuncInfo.layout (funcInfo name)]);
738 (blocks, fn Block.T {label, ...} =>
739 display (seq [Label.layout label,
741 LabelInfo.layout (labelInfo label)]));
746 (* Analysis is done, Now build the resulting program. *)
747 fun getWrapperLabel (l: Label.t,
748 args: (VarInfo.t * Type.t) vector) =
752 if Vector.forall2 (args, LabelInfo.args li, fn ((x, _), (y, _)) =>
753 VarInfo.isUsed x = VarInfo.isUsed y)
757 Vector.keepAllMap (args, fn (x, ty) =>
763 (LabelInfo.wrappers li, fn (args', _) =>
764 Vector.length args' = Vector.length tys
766 Vector.forall2 (args', tys, fn (ty', ty) =>
767 Type.equals (ty', ty))) of
770 val liArgs = LabelInfo.args li
771 val l' = Label.newNoname ()
772 val (args', args'') =
775 (args, liArgs, fn ((x, ty), (y, _)) =>
777 val z = Var.newNoname ()
780 then SOME (z, ty) else NONE,
782 then SOME z else NONE)
785 Vector.keepAllMap (args', fn x => x)
786 val (_, tys') = Vector.unzip args'
788 Vector.keepAllMap (args'', fn x => x)
792 statements = Vector.new0 (),
793 transfer = Goto {dst = l,
796 List.push (LabelInfo.wrappers' li,
799 List.push (FuncInfo.wrappers' (LabelInfo.func li),
807 val getConWrapperLabel = getWrapperLabel
808 val getContWrapperLabel = getWrapperLabel
809 val getHandlerWrapperLabel = getWrapperLabel
810 fun getOriginalWrapperLabel l =
812 (l, Vector.map (LabelInfo.args (labelInfo l), fn (_, t) =>
814 val x = VarInfo.new t
815 val () = VarInfo.use x
819 val getArithOverflowWrapperLabel = getOriginalWrapperLabel
820 val getArithSuccessWrapperLabel = getOriginalWrapperLabel
821 val getRuntimeWrapperLabel = getOriginalWrapperLabel
822 fun getBugFunc (fi: FuncInfo.t): Label.t =
823 (* Can't share the Bug block across different places because the
824 * profile sourceInfo stack might be different.
827 val l = Label.newNoname ()
828 val block = Block.T {label = l,
829 args = Vector.new0 (),
830 statements = Vector.new0 (),
832 val () = List.push (FuncInfo.wrappers' fi, block)
836 fun getReturnFunc (fi: FuncInfo.t): Label.t =
838 val r = FuncInfo.returnLabel fi
843 val l = Label.newNoname ()
844 val returns = valOf (FuncInfo.returns fi)
847 (returns, fn (vi, ty) =>
849 then SOME (Var.newNoname (), ty)
851 val xs = Vector.map (args, #1)
852 val block = Block.T {label = l,
854 statements = Vector.new0 (),
855 transfer = Return xs}
857 val () = List.push (FuncInfo.wrappers' fi, block)
858 val () = setLabelInfo (l, LabelInfo.new {func = fi,
865 fun getReturnContFunc (fi, args) =
866 getWrapperLabel (getReturnFunc fi, args)
867 fun getRaiseFunc (fi: FuncInfo.t): Label.t =
869 val r = FuncInfo.raiseLabel fi
874 val l = Label.newNoname ()
875 val raises = valOf (FuncInfo.raises fi)
878 (raises, fn (vi, ty) =>
880 then SOME (Var.newNoname (), ty)
882 val xs = Vector.map (args, #1)
883 val block = Block.T {label = l,
885 statements = Vector.new0 (),
888 val () = List.push (FuncInfo.wrappers' fi, block)
889 val () = setLabelInfo (l, LabelInfo.new {func = fi,
896 fun getRaiseHandlerFunc (fi, args) =
897 getWrapperLabel (getRaiseFunc fi, args)
899 fun simplifyType (ty: Type.t): Type.t =
902 val simplify = TypeInfo.simplify' ti
906 datatype z = datatype Type.dest
909 Array ty => Type.array (simplifyType ty)
910 | Ref ty => Type.reff (simplifyType ty)
911 | Tuple tys => Type.tuple (Vector.map (tys, simplifyType))
912 | Vector ty => Type.vector (simplifyType ty)
913 | Weak ty => Type.weak (simplifyType ty)
924 (datatypes, fn Datatype.T {tycon, cons} =>
927 val needsDummy : bool ref = ref false
930 (cons, fn {con, ...} =>
937 val () = needsDummy := true
939 SOME (TyconInfo.dummy (tyconInfo tycon))
942 case (ConInfo.isConed ci,
943 ConInfo.isDeconed ci) of
946 SOME {args = Vector.keepAllMap
947 (ConInfo.args ci, fn (x, ty) =>
949 then SOME (simplifyType ty)
955 val num = Vector.length cons
956 val () = TyconInfo.numCons' (tyconInfo tycon) := num
958 SOME (Datatype.T {tycon = tycon, cons = cons})
962 fun simplifyExp (e: Exp.t): Exp.t =
964 ConApp {con, args} =>
968 if ConInfo.isDeconed ci
973 ConApp {args = (Vector.keepAllMap2
981 else #exp (ConInfo.dummy ci)
983 | PrimApp {prim, targs, args} =>
984 PrimApp {prim = prim,
985 targs = Vector.map (targs, simplifyType),
988 fun simplifyStatement (s as Statement.T {var, ty, exp}) : Statement.t option =
995 ty = simplifyType ty,
996 exp = simplifyExp exp})
998 if Exp.maySideEffect exp
1005 SOME var => if isUsedVar var
1006 then doit (SOME var)
1010 fun simplifyStatements (ss: Statement.t Vector.t) : Statement.t Vector.t =
1011 Vector.keepAllMap (ss, simplifyStatement)
1012 fun simplifyTransfer (t: Transfer.t, fi: FuncInfo.t): Transfer.t =
1014 Arith {prim, args, overflow, success, ty} =>
1017 overflow = getArithOverflowWrapperLabel overflow,
1018 success = getArithSuccessWrapperLabel success,
1019 ty = simplifyType ty}
1021 | Call {func, args, return} =>
1023 val fi' = funcInfo func
1027 val (cont, handler) =
1029 Return.Dead => (None, None)
1030 | Return.NonTail {cont, handler} =>
1033 Handler.Caller => Caller
1034 | Handler.Dead => None
1035 | Handler.Handle h => Some h)
1036 | Return.Tail => (Caller, Caller)
1038 if FuncInfo.mayReturn fi'
1041 Error.bug "RemoveUnused.simplifyTransfer: cont:None"
1043 (if (case (FuncInfo.returns fi,
1044 FuncInfo.returns fi') of
1045 (SOME xts, SOME yts) =>
1047 (xts, yts, fn ((x, _), (y, _)) =>
1048 VarInfo.isUsed x = VarInfo.isUsed y)
1049 | _ => Error.bug "RemoveUnused.simplifyTransfer: cont:Caller")
1051 else Some (getReturnContFunc
1052 (fi, valOf (FuncInfo.returns fi'))))
1054 Some (getContWrapperLabel
1055 (l, valOf (FuncInfo.returns fi')))
1058 if FuncInfo.mayRaise fi'
1059 then (case handler of
1061 Error.bug "RemoveUnused.simplifyTransfer: handler:None"
1063 (if (case (FuncInfo.raises fi,
1064 FuncInfo.raises fi') of
1065 (SOME xts, SOME yts) =>
1067 (xts, yts, fn ((x, _), (y, _)) =>
1068 VarInfo.isUsed x = VarInfo.isUsed y)
1069 | _ => Error.bug "RemoveUnused.simplifyTransfer: handler:Caller")
1071 else Some (getRaiseHandlerFunc
1072 (fi, valOf (FuncInfo.raises fi'))))
1074 Some (getHandlerWrapperLabel
1075 (l, valOf (FuncInfo.raises fi'))))
1078 case (cont, handler) of
1079 (None, None) => Return.Dead
1080 | (None, Caller) => Return.Tail
1083 {cont = getBugFunc fi,
1084 handler = Handler.Handle h}
1085 | (Caller, None) => Return.Tail
1086 | (Caller, Caller) => Return.Tail
1087 | (Caller, Some h) =>
1089 {cont = getReturnContFunc
1090 (fi, valOf (FuncInfo.returns fi')),
1091 handler = Handler.Handle h}
1095 handler = Handler.Dead}
1096 | (Some c, Caller) =>
1099 handler = Handler.Caller}
1100 | (Some c, Some h) =>
1103 handler = Handler.Handle h}
1107 (args, FuncInfo.args fi', fn (x, (y, _)) =>
1116 | Case {test, cases = Cases.Con cases, default} =>
1120 (cases, fn (con, l) =>
1122 val ci = conInfo con
1124 if ConInfo.isConed ci
1125 then SOME (con, getConWrapperLabel (l, ConInfo.args ci))
1128 fun keep default = Case {test = test,
1129 cases = Cases.Con cases,
1131 fun none () = keep NONE
1135 | SOME l => if Vector.isEmpty cases
1136 then if LabelInfo.isUsed (labelInfo l)
1137 then Goto {dst = l, args = Vector.new0 ()}
1141 case Type.dest (tyVar test) of
1142 Type.Datatype tycon => tycon
1143 | _ => Error.bug "RemoveUnused.simplifyTransfer: Case:non-Datatype"
1144 val numCons = TyconInfo.numCons (tyconInfo tycon)
1146 if Vector.length cases = numCons
1151 | Case {test, cases, default} =>
1155 | Goto {dst, args} =>
1157 args = (Vector.keepAllMap2
1158 (args, LabelInfo.args (labelInfo dst),
1159 fn (x, (y, _)) => if VarInfo.isUsed y
1163 Raise (Vector.keepAllMap2
1164 (xs, valOf (FuncInfo.raises fi),
1165 fn (x, (y, _)) => if VarInfo.isUsed y
1169 Return (Vector.keepAllMap2
1170 (xs, valOf (FuncInfo.returns fi),
1171 fn (x, (y, _)) => if VarInfo.isUsed y
1174 | Runtime {prim, args, return} =>
1175 Runtime {prim = prim,
1177 return = getRuntimeWrapperLabel return}
1178 val simplifyTransfer =
1180 ("RemoveUnused.simplifyTransfer",
1181 Layout.tuple2 (Transfer.layout, FuncInfo.layout), Transfer.layout)
1183 fun simplifyBlock (Block.T {label, args, statements, transfer}): Block.t option =
1185 val li = labelInfo label
1187 if LabelInfo.isUsed li
1191 (LabelInfo.args li, args, fn ((vi, _), (x, ty)) =>
1192 if VarInfo.isUsed vi
1193 then SOME (x, simplifyType ty)
1195 val statements = simplifyStatements statements
1197 simplifyTransfer (transfer, LabelInfo.func li)
1199 SOME (Block.T {label = label,
1201 statements = statements,
1202 transfer = transfer})
1206 fun simplifyBlocks (bs: Block.t Vector.t): Block.t Vector.t =
1207 Vector.keepAllMap (bs, simplifyBlock)
1208 val globals = simplifyStatements globals
1209 val shrink = shrinkFunction {globals = globals}
1210 fun simplifyFunction (f: Function.t): Function.t option =
1212 val {args, blocks, mayInline, name, start, ...} = Function.dest f
1213 val fi = funcInfo name
1215 if FuncInfo.isUsed fi
1219 (FuncInfo.args fi, args, fn ((vi, _), (x, ty)) =>
1220 if VarInfo.isUsed vi
1221 then SOME (x, simplifyType ty)
1223 val blocks = simplifyBlocks blocks
1224 val wrappers = Vector.fromList (FuncInfo.wrappers fi)
1225 val blocks = Vector.concat [wrappers, blocks]
1227 case FuncInfo.returns fi of
1230 if FuncInfo.mayReturn fi
1231 then SOME (Vector.keepAllMap
1234 then SOME (simplifyType ty)
1238 case FuncInfo.raises fi of
1241 if FuncInfo.mayRaise fi
1242 then SOME (Vector.keepAllMap
1245 then SOME (simplifyType ty)
1249 SOME (shrink (Function.new {args = args,
1251 mayInline = mayInline,
1259 fun simplifyFunctions (fs: Function.t List.t): Function.t List.t =
1260 List.keepAllMap (fs, simplifyFunction)
1261 val functions = simplifyFunctions functions
1262 val program = Program.T {datatypes = datatypes,
1264 functions = functions,
1267 val () = Program.clearTop program