1 (* Copyright (C) 1999-2005, 2008 Henry Cejtin, Matthew Fluet, Suresh
2 * Jagannathan, and Stephen Weeks.
3 * Copyright (C) 1997-2000 NEC Research Institute.
5 * MLton is released under a BSD-style license.
6 * See the file MLton-LICENSE for details.
9 (* Change any toplevel function that only calls itself in tail position
10 * into one with a local loop and no self calls.
12 functor IntroduceLoops (S: SSA_TRANSFORM_STRUCTS): SSA_TRANSFORM =
16 datatype z = datatype Exp.t
17 datatype z = datatype Transfer.t
23 fun isTail (z: t): bool =
30 fun transform (Program.T {datatypes, globals, functions, main}) =
36 val {args, blocks, mayInline, name, raises, returns, start} =
38 val tailCallsItself = ref false
41 (blocks, fn Block.T {transfer, ...} =>
43 Call {func, return, ...} =>
44 if Func.equals (name, func)
45 andalso Return.isTail return
46 then tailCallsItself := true
49 val (args, start, blocks) =
53 val _ = Control.diagnostics
57 display (Func.layout name)
60 Vector.map (args, fn (x, t) => (Var.new x, t))
61 val loopName = Label.newString "loop"
62 val loopSName = Label.newString "loopS"
66 fn Block.T {label, args, statements, transfer} =>
70 Call {func, args, return} =>
71 if Func.equals (name, func)
72 andalso Return.isTail return
73 then Goto {dst = loopName,
78 Block.T {label = label,
80 statements = statements,
87 args = Vector.new0 (),
88 statements = Vector.new0 (),
89 transfer = Goto {dst = loopName,
90 args = Vector.map (newArgs, #1)}} ::
94 statements = Vector.new0 (),
95 transfer = Goto {dst = start,
96 args = Vector.new0 ()}} ::
103 else (args, start, blocks)
105 Function.new {args = args,
107 mayInline = mayInline,
114 Program.T {datatypes = datatypes,
116 functions = functions,