[MLton-commit] r5791

Matthew Fluet fluet at mlton.org
Wed Jul 25 20:46:32 PDT 2007


Additional leaf inlining functionality
----------------------------------------------------------------------

U   mlton/trunk/mlton/control/control-flags.sig
U   mlton/trunk/mlton/control/control-flags.sml
U   mlton/trunk/mlton/main/main.fun
U   mlton/trunk/mlton/ssa/inline.fun
U   mlton/trunk/mlton/ssa/inline.sig
U   mlton/trunk/mlton/ssa/simplify.fun

----------------------------------------------------------------------

Modified: mlton/trunk/mlton/control/control-flags.sig
===================================================================
--- mlton/trunk/mlton/control/control-flags.sig	2007-07-25 23:04:09 UTC (rev 5790)
+++ mlton/trunk/mlton/control/control-flags.sig	2007-07-26 03:46:30 UTC (rev 5791)
@@ -151,14 +151,12 @@
       (* Indentation used in laying out ILs. *)
       val indentation: int ref
 
-      datatype inline =
-         NonRecursive of {product: int,
-                          small: int}
-       | Leaf of {size: int option}
-       | LeafNoLoop of {size: int option}
-      val inline: inline ref
-      val setInlineSize: int -> unit
+      val inline: int ref
 
+      val inlineLeafSize: int option ref
+      val inlineLeafLoops: bool ref
+      val inlineLeafRepeat: bool ref
+
       val inlineIntoMain: bool ref
 
       (* The input file on the command line, minus path and extension. *)

Modified: mlton/trunk/mlton/control/control-flags.sml
===================================================================
--- mlton/trunk/mlton/control/control-flags.sml	2007-07-25 23:04:09 UTC (rev 5790)
+++ mlton/trunk/mlton/control/control-flags.sml	2007-07-26 03:46:30 UTC (rev 5791)
@@ -653,42 +653,22 @@
                            default = 3,
                            toString = Int.toString}
 
-structure Inline =
-   struct
-      datatype t =
-         NonRecursive of {product: int,
-                          small: int}
-       | Leaf of {size: int option}
-       | LeafNoLoop of {size: int option}
+val inline = control {name = "inline",
+                      default = 60, 
+                      toString = Int.toString}
 
-      local open Layout
-         val iol = Option.layout Int.layout
-      in
-         val layout = 
-            fn NonRecursive {product, small} =>
-            seq [str "NonRecursive ",
-                record [("product", Int.layout product),
-                       ("small", Int.layout small)]]
-             | Leaf {size} => seq [str "Leaf ", iol size]
-             | LeafNoLoop {size} => seq [str "LeafNoLoop ", iol size]
-      end
-      val toString = Layout.toString o layout
-   end
+val inlineLeafLoops = control {name = "inlineLeafLoops",
+                               default = true,
+                               toString = Bool.toString}
 
-datatype inline = datatype Inline.t
+val inlineLeafRepeat = control {name = "inlineLeafRepeat",
+                                default = false,
+                                toString = Bool.toString}
 
-val inline = control {name = "inline",
-                      default = NonRecursive {product = 320,
-                                              small = 60},
-                      toString = Inline.toString}
+val inlineLeafSize = control {name = "inlineLeafSize",
+                              default = SOME 20,
+                              toString = Option.toString Int.toString}
 
-fun setInlineSize (size: int): unit =
-   inline := (case !inline of
-                 NonRecursive {small, ...} =>
-                    NonRecursive {product = size, small = small}
-               | Leaf _ => Leaf {size = SOME size}
-               | LeafNoLoop _ => LeafNoLoop {size = SOME size})
-
 val inlineIntoMain = control {name = "inlineIntoMain",
                               default = true,
                               toString = Bool.toString}

Modified: mlton/trunk/mlton/main/main.fun
===================================================================
--- mlton/trunk/mlton/main/main.fun	2007-07-25 23:04:09 UTC (rev 5790)
+++ mlton/trunk/mlton/main/main.fun	2007-07-26 03:46:30 UTC (rev 5791)
@@ -340,10 +340,23 @@
         boolRef Native.IEEEFP),
        (Expert, "indentation", " <n>", "indentation level in ILs",
         intRef indentation),
-       (Normal, "inline", " <n>", "set inlining threshold", Int setInlineSize),
+       (Normal, "inline", " <n>", "set inlining threshold", intRef inline),
        (Expert, "inline-into-main", " {true|false}",
         "inline functions into main",
         boolRef inlineIntoMain),
+       (Expert, "inline-leaf-size", " 20", "set leaf inlining threshold",
+        SpaceString (fn s => 
+                     inlineLeafSize := 
+                     (if s = "inf"
+                         then NONE
+                      else if String.forall (s, Char.isDigit)
+                         then Int.fromString s
+                      else (usage o concat)
+                           ["invalid -inline-leaf-size flag: ", s]))),
+       (Expert, "inline-leaf-loops", " {true|false}", " leaf inline loops",
+        boolRef inlineLeafLoops),
+       (Expert, "inline-leaf-repeat", " {false|true}", " repeat leaf inline",
+        boolRef inlineLeafRepeat),
        (Normal, "keep", " {g|o|sml}", "save intermediate files",
         SpaceString (fn s =>
                      case s of

Modified: mlton/trunk/mlton/ssa/inline.fun
===================================================================
--- mlton/trunk/mlton/ssa/inline.fun	2007-07-25 23:04:09 UTC (rev 5790)
+++ mlton/trunk/mlton/ssa/inline.fun	2007-07-26 03:46:30 UTC (rev 5791)
@@ -14,6 +14,42 @@
 
 type int = Int.t
 
+structure Function =
+   struct
+      open Function
+
+      fun containsCall (f: Function.t): bool =
+         Exn.withEscape
+         (fn escape =>
+          (Vector.foreach
+           (Function.blocks f, fn Block.T {transfer, ...} =>
+            case transfer of
+               Call _ => escape true
+             | _ => ())
+           ; false))
+      fun containsLoop (f: Function.t): bool =
+         let
+            val {get, set, destroy} =
+               Property.destGetSet (Label.plist, Property.initConst false)
+         in
+            Exn.withEscape
+            (fn escape =>
+             let
+                val _ =
+                   Function.dfs
+                   (f, fn (Block.T {label, transfer, ...}) =>
+                    (set (label, true)
+                     ; (case transfer of
+                           Goto {dst, ...} => if get dst then escape true else ()
+                         | _ => ())
+                     ; fn () => set (label, false)))
+             in
+                false
+             end)
+            before (destroy ())
+         end
+   end
+
 structure Size =
    struct
       val check : (int * int option) -> bool =
@@ -110,50 +146,138 @@
             end)
          ; shouldInline
       end
-   fun containsCall (f: Function.t): bool =
-      Exn.withEscape
-      (fn escape =>
-       (Vector.foreach
-        (Function.blocks f, fn Block.T {transfer, ...} =>
-         case transfer of
-            Call _ => escape true
-          | _ => ())
-        ; false))
-   fun containsLoop (f: Function.t): bool =
+in
+   val leafOnce = make (fn (f, {size}) =>
+                        Size.functionGT size f
+                        orelse Function.containsCall f)
+   val leafOnceNoLoop = make (fn (f, {size}) =>
+                              Size.functionGT size f
+                              orelse Function.containsCall f
+                              orelse Function.containsLoop f)
+end
+
+structure Graph = DirectedGraph
+structure Node = Graph.Node
+
+local
+   fun make (dontInline: Function.t -> bool)
+      (Program.T {functions, ...}, {size: int option}) =
       let
-         val {get, set, destroy} =
-            Property.destGetSet (Label.plist, Property.initConst false)
+         val max = size
+         type info = {function: Function.t,
+                      node: unit Node.t,
+                      shouldInline: bool ref,
+                      size: int ref}
+         val {get = funcInfo: Func.t -> info,
+              set = setFuncInfo, ...} =
+            Property.getSetOnce
+            (Func.plist, Property.initRaise ("funcInfo", Func.layout))
+         val {get = nodeFunc: unit Node.t -> Func.t,
+              set = setNodeFunc, ...} = 
+            Property.getSetOnce 
+            (Node.plist, Property.initRaise ("nodeFunc", Node.layout))
+         val graph = Graph.new ()
+         (* initialize the info for each func *)
+         val _ = 
+            List.foreach
+            (functions, fn f =>
+             let 
+                val name = Function.name f
+                val n = Graph.newNode graph
+             in
+                setNodeFunc (n, name)
+                ; setFuncInfo (name, {function = f,
+                                      node = n,
+                                      shouldInline = ref false,
+                                      size = ref 0})
+             end)
+         (* Build the call graph. *)
+         val _ =
+            List.foreach
+            (functions, fn f => 
+             let 
+                val {name, blocks, ...} = Function.dest f
+                val {node, ...} = funcInfo name
+             in
+                Vector.foreach
+                (blocks, fn Block.T {transfer, ...} =>
+                 case transfer of
+                    Call {func, ...} =>
+                       (ignore o Graph.addEdge)
+                       (graph, {from = node, to = #node (funcInfo func)})
+                  | _ => ())
+             end)
+         (* Compute strongly-connected components.
+          * Then start at the leaves of the call graph and work up.
+          *)
+         val _ = 
+            List.foreach
+            (rev (Graph.stronglyConnectedComponents graph),
+             fn scc =>
+             case scc of 
+                [n] =>
+                   let 
+                      val {function, shouldInline, size, ...} = 
+                         funcInfo (nodeFunc n)
+                   in 
+                      if Function.mayInline function
+                         andalso not (dontInline function)
+                         then Exn.withEscape
+                              (fn escape =>
+                               let
+                                  val (n, check) =
+                                     Size.functionSize
+                                     (0, max)
+                                     (Size.defaultExpSize,
+                                      fn t =>
+                                      case t of
+                                         Call {func, ...} =>
+                                            let
+                                               val {shouldInline, size, ...} = 
+                                                  funcInfo func
+                                            in
+                                               if !shouldInline
+                                                  then !size
+                                               else escape ()
+                                            end
+                                       | _ => Size.defaultTransferSize t)
+                                     function
+                               in
+                                  if check
+                                     then ()
+                                  else (shouldInline := true
+                                        ; size := n)
+                               end)
+                      else ()
+                   end
+              | _ => ())
+         val _ =
+            Control.diagnostics
+            (fn display =>
+             let open Layout
+             in List.foreach
+                (functions, fn f => 
+                 let 
+                    val name = Function.name f
+                    val {shouldInline, size, ...} = funcInfo name
+                    val shouldInline = !shouldInline
+                    val size = !size
+                 in 
+                    display
+                    (seq [Func.layout name, str ": ",
+                          record [("shouldInline", Bool.layout shouldInline),
+                                  ("size", Int.layout size)]])
+                 end)
+             end)
       in
-         Exn.withEscape
-         (fn escape =>
-          let
-             val _ =
-                Function.dfs
-                (f, fn (Block.T {label, transfer, ...}) =>
-                 (set (label, true)
-                  ; (case transfer of
-                        Goto {dst, ...} => if get dst then escape true else ()
-                      | _ => ())
-                  ; fn () => set (label, false)))
-          in
-             false
-          end)
-         before (destroy ())
+         ! o #shouldInline o funcInfo
       end
 in
-   val leaf = make (fn (f, {size}) =>
-                    Size.functionGT size f
-                    orelse containsCall f)
-   val leafNoLoop = make (fn (f, {size}) =>
-                          Size.functionGT size f
-                          orelse containsCall f
-                          orelse containsLoop f)
+   val leafRepeat = make (fn _ => false)
+   val leafRepeatNoLoop = make (fn f => Function.containsLoop f)
 end
 
-structure Graph = DirectedGraph
-structure Node = Graph.Node
-
-fun product (Program.T {functions, ...}, {small: int, product: int}) =
+fun nonRecursive (Program.T {functions, ...}, {small: int, product: int}) =
    let
       type info = {doesCallSelf: bool ref,
                    function: Function.t,
@@ -280,39 +404,37 @@
                  display
                  (seq [Func.layout name, str ": ",
                        record [("numCalls", Int.layout numCalls),
-                               ("size", Int.layout size),
-                               ("shouldInline", Bool.layout shouldInline)]])
+                               ("shouldInline", Bool.layout shouldInline),
+                               ("size", Int.layout size)]])
               end)
           end)
    in
       ! o #shouldInline o funcInfo
    end
 
-fun inline (program as Program.T {datatypes, globals, functions, main}) =
+fun transform {program as Program.T {datatypes, globals, functions, main},
+               shouldInline: Func.t -> bool,
+               inlineIntoMain: bool} =
    let
-      val shouldInline: Func.t -> bool =
-         let open Control
-         in case !inline of
-            NonRecursive r => product (program, r)
-          | Leaf r => leaf (program, r)
-          | LeafNoLoop r => leafNoLoop (program, r)
-         end
       val {get = funcInfo: Func.t -> {function: Function.t,
                                       isCalledByMain: bool ref},
            set = setFuncInfo, ...} =
          Property.getSetOnce
          (Func.plist, Property.initRaise ("Inline.funcInfo", Func.layout))
+      val isCalledByMain: Func.t -> bool =
+         ! o #isCalledByMain o funcInfo
       val () = List.foreach (functions, fn f =>
                              setFuncInfo (Function.name f,
                                           {function = f,
                                            isCalledByMain = ref false}))
       val () =
-         Vector.foreach (#blocks (Function.dest (Program.mainFunction program)),
-                         fn Block.T {transfer, ...} =>
-                         case transfer of
-                            Transfer.Call {func, ...} =>
-                               #isCalledByMain (funcInfo func) := true
-                          | _ => ())
+         Vector.foreach 
+         (#blocks (Function.dest (Program.mainFunction program)),
+          fn Block.T {transfer, ...} =>
+          case transfer of
+             Transfer.Call {func, ...} =>
+                #isCalledByMain (funcInfo func) := true
+           | _ => ())
       fun doit (blocks: Block.t vector,
                 return: Return.t) : Block.t vector =
          let
@@ -383,7 +505,6 @@
             Vector.concat (blocks::(!newBlocks))
          end
       val shrink = shrinkFunction {globals = globals}
-      val inlineIntoMain = !Control.inlineIntoMain
       val functions =
          List.fold
          (functions, [], fn (f, ac) =>
@@ -412,7 +533,7 @@
                 if shouldInline name
                    then
                       if inlineIntoMain
-                         orelse not (! (#isCalledByMain (funcInfo name)))
+                         orelse not (isCalledByMain name)
                          then ac
                       else keep ()
                 else keep ()
@@ -427,4 +548,39 @@
       program
    end
 
+fun inlineLeafOnce (p, {size}) =
+   if size = SOME 0
+      then p
+   else transform {program = p,
+                   shouldInline = leafOnce (p, {size = size}),
+                   inlineIntoMain = true}
+fun inlineLeafOnceNoLoop (p, {size}) =
+   if size = SOME 0
+      then p
+   else transform {program = p,
+                   shouldInline = leafOnceNoLoop (p, {size = size}),
+                   inlineIntoMain = true}
+fun inlineLeafRepeat (p, {size}) =
+   if size = SOME 0
+      then p
+   else transform {program = p,
+                   shouldInline = leafRepeat (p, {size = size}),
+                   inlineIntoMain = true}
+fun inlineLeafRepeatNoLoop (p, {size}) =
+   if size = SOME 0
+      then p
+   else transform {program = p,
+                   shouldInline = leafRepeatNoLoop (p, {size = size}),
+                   inlineIntoMain = true}
+fun inlineLeaf (p, {loops, repeat, size}) =
+   case (loops, repeat) of
+      (false, false) => inlineLeafOnce (p, {size = size})
+    | (false, true) => inlineLeafRepeat (p, {size = size})
+    | (true, false) => inlineLeafOnceNoLoop (p, {size = size})
+    | (true, true) => inlineLeafRepeatNoLoop (p, {size = size})
+fun inlineNonRecursive (p, arg) =
+   transform {program = p,
+              shouldInline = nonRecursive (p, arg),
+              inlineIntoMain = !Control.inlineIntoMain}
+
 end

Modified: mlton/trunk/mlton/ssa/inline.sig
===================================================================
--- mlton/trunk/mlton/ssa/inline.sig	2007-07-25 23:04:09 UTC (rev 5790)
+++ mlton/trunk/mlton/ssa/inline.sig	2007-07-26 03:46:30 UTC (rev 5791)
@@ -6,6 +6,8 @@
  * See the file MLton-LICENSE for details.
  *)
 
+type int = Int.t
+
 signature INLINE_STRUCTS = 
    sig
       include SHRINK
@@ -15,5 +17,12 @@
    sig
       include INLINE_STRUCTS
 
-      val inline: Program.t -> Program.t
+      val inlineLeaf: 
+         Program.t * {loops: bool, repeat: bool, size: int option} -> Program.t
+      val inlineLeafOnce: Program.t * {size:int option} -> Program.t
+      val inlineLeafOnceNoLoop: Program.t * {size:int option} -> Program.t
+      val inlineLeafRepeat: Program.t * {size:int option} -> Program.t
+      val inlineLeafRepeatNoLoop: Program.t * {size:int option} -> Program.t
+         
+      val inlineNonRecursive: Program.t * {small:int,product:int} -> Program.t
    end

Modified: mlton/trunk/mlton/ssa/simplify.fun
===================================================================
--- mlton/trunk/mlton/ssa/simplify.fun	2007-07-25 23:04:09 UTC (rev 5790)
+++ mlton/trunk/mlton/ssa/simplify.fun	2007-07-26 03:46:30 UTC (rev 5791)
@@ -31,30 +31,16 @@
 structure SimplifyTypes = SimplifyTypes (S)
 structure Useless = Useless (S)
 
-fun inlineNonRecursive (product, small) p =
-   Ref.fluidLet
-   (Control.inline, 
-    Control.NonRecursive {product = product, small = small}, 
-    fn () => Inline.inline p)
-fun inlineLeaf size p =
-   Ref.fluidLet
-   (Control.inlineIntoMain, true, fn () =>
-    Ref.fluidLet
-    (Control.inline, Control.Leaf {size = SOME size}, 
-     fn () => Inline.inline p))
-fun inlineLeafNoLoop size p =
-   Ref.fluidLet
-   (Control.inlineIntoMain, true, fn () =>
-    Ref.fluidLet
-    (Control.inline, Control.LeafNoLoop {size = SOME size}, 
-     fn () => Inline.inline p))
-
 type pass = {name: string,
              doit: Program.t -> Program.t}
 
 val ssaPassesDefault =
    {name = "removeUnused1", doit = RemoveUnused.remove} ::
-   {name = "leafInline", doit = inlineLeaf 20} ::
+   {name = "introduceLoops1", doit = IntroduceLoops.introduceLoops} ::
+   {name = "inlineLeaf", doit = fn p => 
+    Inline.inlineLeaf (p, {loops = !Control.inlineLeafLoops,
+                           repeat = !Control.inlineLeafRepeat,
+                           size = !Control.inlineLeafSize})} ::
    {name = "contify1", doit = Contify.contify} ::
    {name = "localFlatten1", doit = LocalFlatten.flatten} ::
    {name = "constantPropagation", doit = ConstantPropagation.simplify} ::
@@ -71,11 +57,12 @@
     *)
    {name = "polyEqual", doit = PolyEqual.polyEqual} ::
    {name = "contify2", doit = Contify.contify} ::
-   {name = "inline", doit = Inline.inline} ::
+   {name = "inlineNonRecursive", doit = fn p =>
+    Inline.inlineNonRecursive (p, {small = !Control.inline, product = 320})} ::
    {name = "localFlatten2", doit = LocalFlatten.flatten} ::
    {name = "removeUnused3", doit = RemoveUnused.remove} ::
    {name = "contify3", doit = Contify.contify} ::
-   {name = "introduceLoops", doit = IntroduceLoops.introduceLoops} ::
+   {name = "introduceLoops2", doit = IntroduceLoops.introduceLoops} ::
    {name = "loopInvariant", doit = LoopInvariant.loopInvariant} ::
    {name = "localRef", doit = LocalRef.eliminate} ::
    {name = "flatten", doit = Flatten.flatten} ::
@@ -114,22 +101,30 @@
       let
          val count = Counter.new 1
          fun nums s =
-            if s = ""
-               then SOME []
-            else if String.sub (s, 0) = #"(" 
-                  andalso String.sub (s, String.size s - 1)= #")"
-               then let
-                       val s = String.dropFirst (String.dropLast s)
-                    in
-                       case List.fold (String.split (s, #","), SOME [],
-                                       fn (s,SOME nums) => (case Int.fromString s of
-                                                               SOME i => SOME (i::nums)
-                                                             | NONE => NONE)
-                                        | (_, NONE) => NONE) of
-                          SOME (l as _::_) => SOME (List.rev l)
-                        | _ => NONE
-                    end
-            else NONE
+            Exn.withEscape
+            (fn escape =>
+             if s = ""
+                then SOME []
+             else let
+                     val l = String.length s
+                  in
+                     if String.sub (s, 0) = #"(" 
+                        andalso String.sub (s, l - 1)= #")"
+                        then let
+                                val s = String.substring2 (s, {start = 1, finish = l - 1})
+                                fun doit s =
+                                   if s = "inf"
+                                      then NONE
+                                   else if String.forall (s, Char.isDigit)
+                                           then Int.fromString s
+                                        else escape NONE
+                             in
+                                case List.map (String.split (s, #","), doit) of
+                                   l as _::_ => SOME l
+                                 | _ => NONE
+                             end
+                    else NONE
+                 end)
       in
          fn s =>
          if String.hasPrefix (s, {prefix = "inlineNonRecursive"})
@@ -139,42 +134,80 @@
                                             Int.toString product, ",",
                                             Int.toString small, ")#",
                                             Int.toString (Counter.next count)],
-                             doit = inlineNonRecursive (product, small)}
+                             doit = (fn p => 
+                                     Inline.inlineNonRecursive 
+                                     (p, {small = small, product = product}))}
                     val s = String.dropPrefix (s, String.size "inlineNonRecursive")
                  in
                     case nums s of
                        SOME [] => mk (320, 60)
-                     | SOME [product, small] => mk (product, small)
+                     | SOME [SOME product, SOME small] => mk (product, small)
                      | _ => NONE
                  end
-         else if String.hasPrefix (s, {prefix = "inlineLeafNoLoop"})
+         else if String.hasPrefix (s, {prefix = "inlineLeafRepeat"})
             then let
                     fun mk size =
-                       SOME {name = concat ["inlineLeafNoLoop(", 
-                                            Int.toString size, ")#",
+                       SOME {name = concat ["inlineLeafRepeat(", 
+                                            Option.toString Int.toString size, ")#",
                                             Int.toString (Counter.next count)],
-                             doit = inlineLeafNoLoop size}
-                    val s = String.dropPrefix (s, String.size "inlineLeafNoLoop")
+                             doit = (fn p => 
+                                     Inline.inlineLeafRepeat
+                                     (p, {size = size}))}
+                    val s = String.dropPrefix (s, String.size "inlineLeafRepeat")
                  in
                     case nums s of
-                       SOME [] => mk 20
+                       SOME [] => mk (SOME 20)
                      | SOME [size] => mk size
                      | _ => NONE
                  end
-         else if String.hasPrefix (s, {prefix = "inlineLeaf"})
+         else if String.hasPrefix (s, {prefix = "inlineLeafRepeatNoLoop"})
             then let
                     fun mk size =
-                       SOME {name = concat ["inlineLeaf(", 
-                                            Int.toString size, ")#",
+                       SOME {name = concat ["inlineLeafRepeatNoLoop(", 
+                                            Option.toString Int.toString size, ")#",
                                             Int.toString (Counter.next count)],
-                             doit = inlineLeaf size}
-                    val s = String.dropPrefix (s, String.size "inlineLeaf")
+                             doit = (fn p => 
+                                     Inline.inlineLeafRepeatNoLoop
+                                     (p, {size = size}))}
+                    val s = String.dropPrefix (s, String.size "inlineLeafRepeatNoLoop")
                  in
                     case nums s of
-                       SOME [] => mk 20
+                       SOME [] => mk (SOME 20)
                      | SOME [size] => mk size
                      | _ => NONE
                  end
+         else if String.hasPrefix (s, {prefix = "inlineLeafOnceNoLoop"})
+            then let
+                    fun mk size =
+                       SOME {name = concat ["inlineLeafOnceNoLoop(", 
+                                            Option.toString Int.toString size, ")#",
+                                            Int.toString (Counter.next count)],
+                             doit = (fn p => 
+                                     Inline.inlineLeafOnceNoLoop 
+                                     (p, {size = size}))}
+                    val s = String.dropPrefix (s, String.size "inlineLeafOnceNoLoop")
+                 in
+                    case nums s of
+                       SOME [] => mk (SOME 20)
+                     | SOME [size] => mk size
+                     | _ => NONE
+                 end
+         else if String.hasPrefix (s, {prefix = "inlineLeafOnce"})
+            then let
+                    fun mk size =
+                       SOME {name = concat ["inlineLeafOnce(", 
+                                            Option.toString Int.toString size, ")#",
+                                            Int.toString (Counter.next count)],
+                             doit = (fn p => 
+                                     Inline.inlineLeafOnce
+                                     (p, {size = size}))}
+                    val s = String.dropPrefix (s, String.size "inlineLeafOnce")
+                 in
+                    case nums s of
+                       SOME [] => mk (SOME 20)
+                     | SOME [size] => mk size
+                     | _ => NONE
+                 end
          else NONE
       end
 




More information about the MLton-commit mailing list