mlton/ssa/shrink.fun

   1 (* Copyright (C) 2009,2011,2017 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.
   5  *
   6  * MLton is released under a BSD-style license.
   7  * See the file MLton-LICENSE for details.
   8  *)
   9
  10 functor Shrink (S: SHRINK_STRUCTS): SHRINK =
  11 struct
  12
  13 open S
  14
  15 structure Exp =
  16    struct
  17       open Exp
  18
  19       val isProfile =
  20          fn Profile _ => true
  21           | _ => false
  22    end
  23
  24 structure Statement =
  25    struct
  26       open Statement
  27
  28       fun isProfile (T {exp, ...}) = Exp.isProfile exp
  29    end
  30
  31 structure Array =
  32    struct
  33       open Array
  34
  35       fun inc (a: int t, i: int): unit = update (a, i, 1 + sub (a, i))
  36       fun dec (a: int t, i: int): unit = update (a, i, sub (a, i) - 1)
  37    end
  38
  39 datatype z = datatype Exp.t
  40 datatype z = datatype Transfer.t
  41
  42 structure VarInfo =
  43    struct
  44       datatype t = T of {isUsed: bool ref,
  45                          numOccurrences: int ref,
  46                          ty: Type.t option,
  47                          value: value option ref,
  48                          var: Var.t}
  49       and value =
  50          Con of {con: Con.t,
  51                  args: t vector}
  52         | Const of Const.t
  53         | Select of {tuple: t, offset: int}
  54         | Tuple of t vector
  55
  56       fun equals (T {var = x, ...}, T {var = y, ...}) = Var.equals (x, y)
  57
  58       fun layout (T {isUsed, numOccurrences, ty, value, var}) =
  59          let open Layout
  60          in record [("isUsed", Bool.layout (!isUsed)),
  61                     ("numOccurrences", Int.layout (!numOccurrences)),
  62                     ("ty", Option.layout Type.layout ty),
  63                     ("value", Option.layout layoutValue (!value)),
  64                     ("var", Var.layout var)]
  65          end
  66       and layoutValue v =
  67          let open Layout
  68          in case v of
  69             Con {con, args} => seq [Con.layout con,
  70                                     Vector.layout layout args]
  71           | Const c => Const.layout c
  72           | Select {tuple, offset} => seq [str "#", Int.layout (offset + 1),
  73                                            str " ", layout tuple]
  74           | Tuple vis => Vector.layout layout vis
  75          end
  76
  77       fun new (x: Var.t, ty: Type.t option) = T {isUsed = ref false,
  78                                                  numOccurrences = ref 0,
  79                                                  ty = ty,
  80                                                  value = ref NONE,
  81                                                  var = x}
  82
  83       fun setValue (T {value, ...}, v) =
  84          (Assert.assert ("Ssa.Shrink.VarInfo.setValue", fn () => Option.isNone (!value))
  85           ; value := SOME v)
  86
  87
  88       fun numOccurrences (T {numOccurrences = r, ...}) = r
  89       fun ty (T {ty, ...}): Type.t option = ty
  90       fun value (T {value, ...}): value option = !value
  91       fun var (T {var, ...}): Var.t = var
  92    end
  93
  94 structure Value =
  95    struct
  96       datatype t = datatype VarInfo.value
  97    end
  98
  99 structure Position =
 100    struct
 101       datatype t =
 102          Formal of int
 103        | Free of Var.t
 104
 105       fun layout (p: t) =
 106          case p of
 107             Formal i => Int.layout i
 108           | Free x => Var.layout x
 109
 110       val equals =
 111          fn (Formal i, Formal i') => i = i'
 112           | (Free x, Free x') => Var.equals (x, x')
 113           | _ => false
 114    end
 115
 116 structure Positions = MonoVector (Position)
 117
 118 structure LabelMeaning =
 119    struct
 120       datatype t = T of {aux: aux,
 121                          blockIndex: int, (* The index of the block *)
 122                          label: Label.t} (* redundant, the label of the block *)
 123
 124       and aux =
 125          Block
 126        | Bug
 127        | Case of {canMove: Statement.t list,
 128                   cases: Cases.t,
 129                   default: Label.t option}
 130        | Goto of {canMove: Statement.t list,
 131                   dst: t,
 132                   args: Positions.t}
 133        | Raise of {args: Positions.t,
 134                    canMove: Statement.t list}
 135        | Return of {args: Positions.t,
 136                     canMove: Statement.t list}
 137
 138       local
 139          fun make f (T r) = f r
 140       in
 141          val aux = make #aux
 142          val blockIndex = make #blockIndex
 143       end
 144
 145       fun layout (T {aux, label, ...}) =
 146          let
 147             open Layout
 148          in
 149             seq [Label.layout label,
 150                  str " ",
 151                  case aux of
 152                     Block => str "Block "
 153                   | Bug => str "Bug"
 154                   | Case _ => str "Case"
 155                   | Goto {dst, args, ...} =>
 156                        seq [str "Goto ",
 157                             tuple [layout dst, Positions.layout args]]
 158                   | Raise {args, ...} =>
 159                        seq [str "Raise ", Positions.layout args]
 160                   | Return {args, ...} =>
 161                        seq [str "Return ", Positions.layout args]]
 162          end
 163    end
 164
 165 structure State =
 166    struct
 167       datatype state =
 168          Unvisited
 169        | Visited of LabelMeaning.t
 170        | Visiting
 171
 172       val layout =
 173          let
 174             open Layout
 175          in
 176             fn Unvisited => str "Unvisited"
 177              | Visited m => LabelMeaning.layout m
 178              | Visiting => str "Visiting"
 179          end
 180    end
 181
 182 val traceApplyInfo = Trace.info "Ssa.Shrink.Prim.apply"
 183
 184 fun shrinkFunction {globals: Statement.t vector} =
 185    let
 186       fun use (VarInfo.T {isUsed, var, ...}): Var.t =
 187          (isUsed := true
 188           ; var)
 189       fun uses (vis: VarInfo.t vector): Var.t vector = Vector.map (vis, use)
 190       (* varInfo can't be getSetOnce because of setReplacement. *)
 191       val {get = varInfo: Var.t -> VarInfo.t, set = setVarInfo, ...} =
 192          Property.getSet (Var.plist,
 193                           Property.initFun (fn x => VarInfo.new (x, NONE)))
 194 (*       Property.getSet (Var.plist, Property.initFun VarInfo.new) *)
 195       val setVarInfo =
 196          Trace.trace2 ("Ssa.Shrink.setVarInfo",
 197                        Var.layout, VarInfo.layout, Unit.layout)
 198          setVarInfo
 199       fun varInfos xs = Vector.map (xs, varInfo)
 200       fun simplifyVar (x: Var.t) = use (varInfo x)
 201       val simplifyVar =
 202          Trace.trace ("Ssa.Shrink.simplifyVar", Var.layout, Var.layout) simplifyVar
 203       fun simplifyVars xs = Vector.map (xs, simplifyVar)
 204       fun incVarInfo (x: VarInfo.t): unit =
 205          Int.inc (VarInfo.numOccurrences x)
 206       fun incVar (x: Var.t): unit = incVarInfo (varInfo x)
 207       fun incVars xs = Vector.foreach (xs, incVar)
 208       fun numVarOccurrences (x: Var.t): int =
 209          ! (VarInfo.numOccurrences (varInfo x))
 210       val _ =
 211          Vector.foreach
 212          (globals, fn Statement.T {var, exp, ty} =>
 213           let
 214              val _ = Option.app
 215                      (var, fn x =>
 216                       setVarInfo (x, VarInfo.new (x, SOME ty)))
 217              fun construct v =
 218                 Option.app (var, fn x => VarInfo.setValue (varInfo x, v))
 219           in case exp of
 220              ConApp {con, args} =>
 221                 construct (Value.Con {con = con,
 222                                       args = Vector.map (args, varInfo)})
 223            | Const c => construct (Value.Const c)
 224            | Select {tuple, offset} =>
 225                 construct (Value.Select {tuple = varInfo tuple,
 226                                          offset = offset})
 227            | Tuple xs => construct (Value.Tuple (Vector.map (xs, varInfo)))
 228            | Var y => Option.app (var, fn x => setVarInfo (x, varInfo y))
 229            | _ => ()
 230           end)
 231    in
 232       fn f: Function.t =>
 233       let
 234          val _ = Function.clear f
 235          val {args, blocks, mayInline, name, raises, returns, start, ...} =
 236             Function.dest f
 237          val _ = Vector.foreach
 238                  (args, fn (x, ty) =>
 239                   setVarInfo (x, VarInfo.new (x, SOME ty)))
 240          (* Index the labels by their defining block in blocks. *)
 241          val {get = labelIndex, set = setLabelIndex, ...} =
 242             Property.getSetOnce (Label.plist,
 243                                  Property.initRaise ("index", Label.layout))
 244          val _ = Vector.foreachi (blocks, fn (i, Block.T {label, ...}) =>
 245                                   setLabelIndex (label, i))
 246          val numBlocks = Vector.length blocks
 247          (* Do a DFS to compute occurrence counts and set label meanings *)
 248          val states = Array.array (numBlocks, State.Unvisited)
 249          val inDegree = Array.array (numBlocks, 0)
 250          fun addLabelIndex i = Array.inc (inDegree, i)
 251          val isHeader = Array.array (numBlocks, false)
 252          val numHandlerUses = Array.array (numBlocks, 0)
 253          fun layoutLabel (l: Label.t): Layout.t =
 254             let
 255                val i = labelIndex l
 256             in
 257                Layout.record [("label", Label.layout l),
 258                               ("inDegree", Int.layout (Array.sub (inDegree, i)))]
 259             end
 260          fun incAux aux =
 261             case aux of
 262                LabelMeaning.Goto {dst, ...} =>
 263                   addLabelIndex (LabelMeaning.blockIndex dst)
 264              | _ => ()
 265          fun incLabel (l: Label.t): unit =
 266             incLabelMeaning (labelMeaning l)
 267          and incLabelMeaning (LabelMeaning.T {aux, blockIndex, ...}): unit =
 268             let
 269                val i = blockIndex
 270                val n = Array.sub (inDegree, i)
 271                val _ = Array.update (inDegree, i, 1 + n)
 272             in
 273                if n = 0
 274                   then incAux aux
 275                else ()
 276             end
 277          and labelMeaning (l: Label.t): LabelMeaning.t =
 278             let
 279                val i = labelIndex l
 280             in
 281                case Array.sub (states, i) of
 282                   State.Visited m => m
 283                 | State.Visiting =>
 284                      (Array.update (isHeader, i, true)
 285                       ; (LabelMeaning.T
 286                          {aux = LabelMeaning.Block,
 287                           blockIndex = i,
 288                           label = Block.label (Vector.sub (blocks, i))}))
 289                 | State.Unvisited =>
 290                      let
 291                         val _ = Array.update (states, i, State.Visiting)
 292                         val m = computeMeaning i
 293                         val _ = Array.update (states, i, State.Visited m)
 294                      in
 295                         m
 296                      end
 297             end
 298          and computeMeaning (i: int): LabelMeaning.t =
 299             let
 300                val Block.T {args, statements, transfer, ...} =
 301                   Vector.sub (blocks, i)
 302                val _ =
 303                   Vector.foreach (args, fn (x, ty) =>
 304                                   setVarInfo (x, VarInfo.new (x, SOME ty)))
 305                val _ =
 306                   Vector.foreach
 307                   (statements, fn s => Exp.foreachVar (Statement.exp s, incVar))
 308                fun extract (actuals: Var.t vector): Positions.t =
 309                   let
 310                      val {get: Var.t -> Position.t, set, destroy} =
 311                         Property.destGetSetOnce
 312                         (Var.plist, Property.initFun Position.Free)
 313                      val _ = Vector.foreachi (args, fn (i, (x, _)) =>
 314                                               set (x, Position.Formal i))
 315                      val ps = Vector.map (actuals, get)
 316                      val _ = destroy ()
 317                   in ps
 318                   end
 319                fun doit aux =
 320                   LabelMeaning.T {aux = aux,
 321                                   blockIndex = i,
 322                                   label = Block.label (Vector.sub (blocks, i))}
 323                fun normal () = doit LabelMeaning.Block
 324                fun canMove () =
 325                   Vector.toListMap
 326                   (statements, fn Statement.T {exp, ty, ...} =>
 327                    Statement.T {exp = exp, ty = ty, var = NONE})
 328                fun rr (xs: Var.t vector, make) =
 329                   let
 330                      val _ = incVars xs
 331 (*
 332                      val n = Vector.length statements
 333                      fun loop (i, ac) =
 334                         if i = n
 335                            then
 336                               if 0 = Vector.length xs
 337                                  orelse 0 < Vector.length args
 338                                  then doit (make {args = extract xs,
 339                                                   canMove = rev ac})
 340                               else normal ()
 341                         else
 342                            let
 343                               val Statement.T {exp, ty, ...} =
 344                                  Vector.sub (statements, i)
 345                            in
 346                               if Exp.isProfile exp
 347                                  then loop (i + 1,
 348                                             Statement.T {exp = exp,
 349                                                          ty = ty,
 350                                                          var = NONE} :: ac)
 351                               else normal ()
 352                            end
 353                   in
 354                      loop (0, [])
 355                   end
 356 *)
 357                   in
 358                      if Vector.forall (statements, Statement.isProfile)
 359                         andalso (0 = Vector.length xs
 360                                  orelse 0 < Vector.length args)
 361                         then doit (make {args = extract xs,
 362                                          canMove = canMove ()})
 363                      else normal ()
 364                   end
 365             in
 366                case transfer of
 367                   Arith {args, overflow, success, ...} =>
 368                      (incVars args
 369                       ; incLabel overflow
 370                       ; incLabel success
 371                       ; normal ())
 372                 | Bug =>
 373                      if Vector.forall (statements, Statement.isProfile)
 374                         andalso (case returns of
 375                                     NONE => true
 376                                   | SOME ts =>
 377                                        Vector.equals
 378                                        (ts, args, fn (t, (_, t')) =>
 379                                         Type.equals (t, t')))
 380                         then doit LabelMeaning.Bug
 381                      else normal ()
 382                 | Call {args, return, ...} =>
 383                      let
 384                         val _ = incVars args
 385                         val _ =
 386                            Return.foreachHandler
 387                            (return, fn l =>
 388                             Array.inc (numHandlerUses, labelIndex l))
 389                         val _ = Return.foreachLabel (return, incLabel)
 390                      in
 391                         normal ()
 392                      end
 393                 | Case {test, cases, default} =>
 394                      let
 395                         val _ = incVar test
 396                         val _ = Cases.foreach (cases, incLabel)
 397                         val _ = Option.app (default, incLabel)
 398                      in
 399                         if Vector.forall (statements, Statement.isProfile)
 400                            andalso not (Array.sub (isHeader, i))
 401                            andalso 1 = Vector.length args
 402                            andalso 1 = numVarOccurrences test
 403                            andalso Var.equals (test, #1 (Vector.first args))
 404                            then
 405                               doit (LabelMeaning.Case {canMove = canMove (),
 406                                                        cases = cases,
 407                                                        default = default})
 408                         else
 409                            normal ()
 410                      end
 411                 | Goto {dst, args = actuals} =>
 412                      let
 413                         val _ = incVars actuals
 414                         val m = labelMeaning dst
 415                      in
 416                         if Vector.exists (statements, not o Statement.isProfile)
 417                            orelse Array.sub (isHeader, i)
 418                            then (incLabelMeaning m
 419                                  ; normal ())
 420                         else
 421                            if Vector.isEmpty statements
 422                               andalso
 423                               Vector.equals (args, actuals, fn ((x, _), x') =>
 424                                              Var.equals (x, x')
 425                                              andalso 1 = numVarOccurrences x)
 426                               then m (* It's an eta. *)
 427                            else
 428                            let
 429                               val ps = extract actuals
 430                               val n =
 431                                  Vector.fold (args, 0, fn ((x, _), n) =>
 432                                               n + numVarOccurrences x)
 433                               val n' =
 434                                  Vector.fold (ps, 0, fn (p, n) =>
 435                                               case p of
 436                                                  Position.Formal _ => n + 1
 437                                                | _ => n)
 438                               datatype z = datatype LabelMeaning.aux
 439                            in
 440                               if n <> n'
 441                                  then (incLabelMeaning m
 442                                        ; normal ())
 443                               else
 444                                  let
 445                                     fun extract (ps': Positions.t)
 446                                        : Positions.t =
 447                                        Vector.map
 448                                        (ps', fn p =>
 449                                         let
 450                                            datatype z = datatype Position.t
 451                                         in
 452                                            case p of
 453                                               Free x => Free x
 454                                             | Formal i => Vector.sub (ps, i)
 455                                         end)
 456                                     val canMove' = canMove ()
 457                                     val a =
 458                                        case LabelMeaning.aux m of
 459                                           Block =>
 460                                              Goto {canMove = canMove',
 461                                                    dst = m,
 462                                                    args = ps}
 463                                         | Bug =>
 464                                              if (case returns of
 465                                                     NONE => true
 466                                                   | SOME ts =>
 467                                                        Vector.equals
 468                                                        (ts, args, fn (t, (_, t')) =>
 469                                                         Type.equals (t, t')))
 470                                                 then Bug
 471                                              else Goto {canMove = canMove',
 472                                                         dst = m,
 473                                                         args = ps}
 474                                         | Case _ =>
 475                                              Goto {canMove = canMove',
 476                                                    dst = m,
 477                                                    args = ps}
 478                                         | Goto {canMove, dst, args} =>
 479                                              Goto {canMove = canMove' @ canMove,
 480                                                    dst = dst,
 481                                                    args = extract args}
 482                                         | Raise {args, canMove} =>
 483                                              Raise {args = extract args,
 484                                                     canMove = canMove' @ canMove}
 485                                         | Return {args, canMove} =>
 486                                              Return {args = extract args,
 487                                                      canMove = canMove' @ canMove}
 488                                  in
 489                                     doit a
 490                                  end
 491                            end
 492                      end
 493                 | Raise xs => rr (xs, LabelMeaning.Raise)
 494                 | Return xs => rr (xs, LabelMeaning.Return)
 495                 | Runtime {args, return, ...} =>
 496                      (incVars args
 497                       ; incLabel return
 498                       ; normal ())
 499             end
 500          val _ = incLabel start
 501          fun indexMeaning i =
 502             case Array.sub (states, i) of
 503                State.Visited m => m
 504              | _ => Error.bug "Ssa.Shrink.indexMeaning: not computed"
 505          val indexMeaning =
 506             Trace.trace ("Ssa.Shrink.indexMeaning", Int.layout, LabelMeaning.layout)
 507             indexMeaning
 508          val labelMeaning = indexMeaning o labelIndex
 509          val labelMeaning =
 510             Trace.trace ("Ssa.Shrink.labelMeaning",
 511                          Label.layout, LabelMeaning.layout)
 512             labelMeaning
 513          fun meaningLabel m =
 514             Block.label (Vector.sub (blocks, LabelMeaning.blockIndex m))
 515          fun labelArgs l =
 516             Block.args (Vector.sub (blocks, labelIndex l))
 517          fun meaningArgs m =
 518             Block.args (Vector.sub (blocks, LabelMeaning.blockIndex m))
 519          fun save (f, s) =
 520             let
 521                val {destroy, controlFlowGraph, ...} =
 522                   Function.layoutDot (f, Var.layout)
 523             in
 524                File.withOut
 525                (concat ["/tmp/", Func.toString (Function.name f),
 526                         ".", s, ".dot"],
 527                 fn out => Layout.outputl (controlFlowGraph, out))
 528                ; destroy ()
 529             end
 530          val _ = if true then () else save (f, "pre")
 531          (* *)
 532          val _ =
 533             if true
 534                then ()
 535             else
 536                Layout.outputl
 537                (Vector.layout
 538                 (fn i =>
 539                  (Layout.record
 540                   [("label",
 541                     Label.layout (Block.label (Vector.sub (blocks, i)))),
 542                    ("inDegree", Int.layout (Array.sub (inDegree, i))),
 543                    ("state", State.layout (Array.sub (states, i)))]))
 544                 (Vector.tabulate (numBlocks, fn i => i)),
 545                 Out.error)
 546          val _ =
 547             Assert.assert
 548             ("Ssa.Shrink.labelMeanings", fn () =>
 549              let
 550                 val inDegree' = Array.array (numBlocks, 0)
 551                 fun bumpIndex i = Array.inc (inDegree', i)
 552                 fun bumpMeaning m = bumpIndex (LabelMeaning.blockIndex m)
 553                 val bumpLabel = bumpMeaning o labelMeaning
 554                 fun doit (LabelMeaning.T {aux, blockIndex, ...}) =
 555                    let
 556                       datatype z = datatype LabelMeaning.aux
 557                    in
 558                       case aux of
 559                          Block =>
 560                             Transfer.foreachLabel
 561                             (Block.transfer (Vector.sub (blocks, blockIndex)),
 562                              bumpLabel)
 563                        | Bug => ()
 564                        | Case {cases, default, ...} =>
 565                             (Cases.foreach (cases, bumpLabel)
 566                              ; Option.app (default, bumpLabel))
 567                        | Goto {dst, ...} => bumpMeaning dst
 568                        | Raise _ => ()
 569                        | Return _ => ()
 570                    end
 571                 val _ =
 572                    Array.foreachi
 573                    (states, fn (i, s) =>
 574                     if Array.sub (inDegree, i) > 0
 575                        then
 576                           (case s of
 577                               State.Visited m => doit m
 578                             | _ => ())
 579                     else ())
 580                 val _ = bumpMeaning (labelMeaning start)
 581              in
 582                 Array.equals (inDegree, inDegree', Int.equals)
 583                 orelse
 584                 let
 585                    val _ =
 586                       Layout.outputl
 587                       (Vector.layout
 588                        (fn i =>
 589                         (Layout.record
 590                          [("label",
 591                            Label.layout (Block.label (Vector.sub (blocks, i)))),
 592                           ("inDegree", Int.layout (Array.sub (inDegree, i))),
 593                           ("inDegree'", Int.layout (Array.sub (inDegree', i))),
 594                           ("state", State.layout (Array.sub (states, i)))]))
 595                        (Vector.tabulate (numBlocks, fn i => i)),
 596                        Out.error)
 597                 in
 598                    false
 599                 end
 600              end)
 601          val isBlock = Array.array (numBlocks, false)
 602          (* Functions for maintaining inDegree. *)
 603          val addLabelIndex =
 604             fn i =>
 605             (Assert.assert ("Ssa.Shrink.addLabelIndex", fn () =>
 606                             Array.sub (inDegree, i) > 0)
 607              ; addLabelIndex i)
 608          val addLabelMeaning = addLabelIndex o LabelMeaning.blockIndex
 609          fun layoutLabelMeaning m =
 610             Layout.record
 611             [("inDegree", Int.layout (Array.sub
 612                                       (inDegree, LabelMeaning.blockIndex m))),
 613              ("meaning", LabelMeaning.layout m)]
 614          val traceDeleteLabelMeaning =
 615             Trace.trace ("SSa.Shrink.deleteLabelMeaning",
 616                          layoutLabelMeaning, Unit.layout)
 617          fun deleteLabel l = deleteLabelMeaning (labelMeaning l)
 618          and deleteLabelMeaning arg: unit =
 619             traceDeleteLabelMeaning
 620             (fn (m: LabelMeaning.t) =>
 621             let
 622                val i = LabelMeaning.blockIndex m
 623                val n = Array.sub (inDegree, i) - 1
 624                val _ = Array.update (inDegree, i, n)
 625                val _ = Assert.assert ("Ssa.Shrink.deleteLabelMeaning", fn () => n >= 0)
 626             in
 627                if n = 0 (* andalso not (Array.sub (isBlock, i)) *)
 628                   then
 629                      let
 630                         datatype z = datatype LabelMeaning.aux
 631                      in
 632                         case LabelMeaning.aux m of
 633                            Block =>
 634                               let
 635                                  val t = Block.transfer (Vector.sub (blocks, i))
 636                                  val _ = Transfer.foreachLabel (t, deleteLabel)
 637                                  val _ =
 638                                     case t of
 639                                        Transfer.Call {return, ...} =>
 640                                           Return.foreachHandler
 641                                           (return, fn l =>
 642                                            Array.dec (numHandlerUses,
 643                                                       (LabelMeaning.blockIndex
 644                                                        (labelMeaning l))))
 645                                      | _ => ()
 646                               in
 647                                  ()
 648                               end
 649                          | Bug => ()
 650                          | Case {cases, default, ...} =>
 651                               (Cases.foreach (cases, deleteLabel)
 652                                ; Option.app (default, deleteLabel))
 653                          | Goto {dst, ...} => deleteLabelMeaning dst
 654                          | Raise _ => ()
 655                          | Return _ => ()
 656                      end
 657                else ()
 658             end) arg
 659          fun primApp (prim: Type.t Prim.t, args: VarInfo.t vector)
 660             : (Type.t, VarInfo.t) Prim.ApplyResult.t =
 661             let
 662                val args' =
 663                   Vector.map
 664                   (args, fn vi =>
 665                    case vi of
 666                       VarInfo.T {value = ref (SOME v), ...} =>
 667                          (case v of
 668                              Value.Con {con, args} =>
 669                                 if Vector.isEmpty args
 670                                    then Prim.ApplyArg.Con {con = con,
 671                                                            hasArg = false}
 672                                 else Prim.ApplyArg.Var vi
 673                            | Value.Const c => Prim.ApplyArg.Const c
 674                            | _ => Prim.ApplyArg.Var vi)
 675                     | _ => Prim.ApplyArg.Var vi)
 676             in
 677                Trace.traceInfo'
 678                (traceApplyInfo,
 679                 fn (p, args, _) =>
 680                 let
 681                    open Layout
 682                 in
 683                    seq [Prim.layout p, str " ",
 684                         List.layout (Prim.ApplyArg.layout
 685                                      (Var.layout o VarInfo.var)) args]
 686                 end,
 687                 Prim.ApplyResult.layout (Var.layout o VarInfo.var))
 688                Prim.apply
 689                (prim, Vector.toList args', VarInfo.equals)
 690             end
 691          (* Another DFS, this time accumulating the new blocks. *)
 692          val traceForceMeaningBlock =
 693             Trace.trace ("Ssa.Shrink.forceMeaningBlock",
 694                         layoutLabelMeaning, Unit.layout)
 695          val traceSimplifyBlock =
 696             Trace.trace2 ("Ssa.Shrink.simplifyBlock",
 697                           List.layout Statement.layout,
 698                           layoutLabel o Block.label,
 699                           Layout.tuple2 (List.layout Statement.layout,
 700                                          Transfer.layout))
 701          val traceGotoMeaning =
 702             Trace.trace3
 703             ("Ssa.Shrink.gotoMeaning",
 704              List.layout Statement.layout,
 705              layoutLabelMeaning,
 706              Vector.layout VarInfo.layout,
 707              Layout.tuple2 (List.layout Statement.layout, Transfer.layout))
 708          val traceEvalStatement =
 709             Trace.trace
 710             ("Ssa.Shrink.evalStatement",
 711              Statement.layout,
 712              Layout.ignore: (Statement.t list -> Statement.t list) -> Layout.t)
 713          val traceSimplifyTransfer =
 714             Trace.trace ("Ssa.Shrink.simplifyTransfer",
 715                          Transfer.layout,
 716                          Layout.tuple2 (List.layout Statement.layout,
 717                                         Transfer.layout))
 718          val traceSimplifyCase =
 719             Trace.trace
 720             ("Ssa.Shrink2.simplifyCase",
 721              fn {canMove, cases, default, test, ...} =>
 722              Layout.record [("canMove", List.layout Statement.layout canMove),
 723                             ("cantSimplify", Layout.str "fn () => ..."),
 724                             ("gone", Layout.str "fn () => ..."),
 725                             ("test", VarInfo.layout test),
 726                             ("cases/default",
 727                              (Transfer.layout o Transfer.Case)
 728                              {cases = cases,
 729                               default = default,
 730                               test = VarInfo.var test})],
 731              Layout.tuple2 (List.layout Statement.layout, Transfer.layout))
 732          val newBlocks = ref []
 733          fun simplifyLabel l =
 734             let
 735                val m = labelMeaning l
 736                val _ = forceMeaningBlock m
 737             in
 738                meaningLabel m
 739             end
 740          and forceMeaningBlock arg =
 741             traceForceMeaningBlock
 742             (fn (LabelMeaning.T {aux, blockIndex = i, ...}) =>
 743              if Array.sub (isBlock, i)
 744                 then ()
 745              else
 746                 let
 747                    val _ = Array.update (isBlock, i, true)
 748                    val block as Block.T {label, args, ...} =
 749                       Vector.sub (blocks, i)
 750                    fun extract (p: Position.t): VarInfo.t =
 751                       varInfo (case p of
 752                                   Position.Formal n => #1 (Vector.sub (args, n))
 753                                 | Position.Free x => x)
 754                    val (statements, transfer) =
 755                       let
 756                          fun rr ({args, canMove}, make) =
 757                             (canMove,
 758                              make (Vector.map (args, use o extract)))
 759                          datatype z = datatype LabelMeaning.aux
 760                       in
 761                          case aux of
 762                             Block => simplifyBlock ([], block)
 763                           | Bug => ([], Transfer.Bug)
 764                           | Case _ => simplifyBlock ([], block)
 765                           | Goto {canMove, dst, args} =>
 766                                gotoMeaning
 767                                (canMove,
 768                                 dst,
 769                                 Vector.map (args, extract))
 770                           | Raise z => rr (z, Transfer.Raise)
 771                           | Return z => rr (z, Transfer.Return)
 772                       end
 773                    val _ =
 774                       List.push
 775                       (newBlocks,
 776                        Block.T {label = label,
 777                                 args = args,
 778                                 statements = Vector.fromList statements,
 779                                 transfer = transfer})
 780                 in
 781                    ()
 782                 end) arg
 783          and simplifyBlock arg : Statement.t list * Transfer.t =
 784             traceSimplifyBlock
 785             (fn (canMoveIn, Block.T {statements, transfer, ...}) =>
 786             let
 787                val f = evalStatements statements
 788                val (ss, transfer) = simplifyTransfer transfer
 789             in
 790                (canMoveIn @ (f ss), transfer)
 791             end) arg
 792          and evalStatements (ss: Statement.t vector)
 793             : Statement.t list -> Statement.t list =
 794             let
 795                val fs = Vector.map (ss, evalStatement)
 796             in
 797                fn ss => Vector.foldr (fs, ss, fn (f, ss) => f ss)
 798             end
 799          and simplifyTransfer arg : Statement.t list * Transfer.t =
 800             traceSimplifyTransfer
 801             (fn (t: Transfer.t) =>
 802             case t of
 803                 Arith {prim, args, overflow, success, ty} =>
 804                    let
 805                       val args = varInfos args
 806                    in
 807                       case primApp (prim, args) of
 808                          Prim.ApplyResult.Const c =>
 809                             let
 810                                val _ = deleteLabel overflow
 811                                val x = Var.newNoname ()
 812                                val isUsed = ref false
 813                                val vi =
 814                                   VarInfo.T {isUsed = isUsed,
 815                                              numOccurrences = ref 0,
 816                                              ty = SOME ty,
 817                                              value = ref (SOME (Value.Const c)),
 818                                              var = x}
 819                                val (ss, t) = goto (success, Vector.new1 vi)
 820                                val ss =
 821                                   if !isUsed
 822                                      then Statement.T {var = SOME x,
 823                                                        ty = Type.ofConst c,
 824                                                        exp = Exp.Const c}
 825                                         :: ss
 826                                   else ss
 827                             in
 828                                (ss, t)
 829                             end
 830                        | Prim.ApplyResult.Var x =>
 831                             let
 832                                val _ = deleteLabel overflow
 833                             in
 834                                goto (success, Vector.new1 x)
 835                             end
 836                        | Prim.ApplyResult.Overflow =>
 837                             let
 838                                val _ = deleteLabel success
 839                             in
 840                                goto (overflow, Vector.new0 ())
 841                             end
 842                        | Prim.ApplyResult.Apply (prim, args) =>
 843                             let val args = Vector.fromList args
 844                             in
 845                                ([], Arith {prim = prim,
 846                                            args = uses args,
 847                                            overflow = simplifyLabel overflow,
 848                                            success = simplifyLabel success,
 849                                            ty = ty})
 850                             end
 851                        | _ =>
 852                             ([], Arith {prim = prim,
 853                                         args = uses args,
 854                                         overflow = simplifyLabel overflow,
 855                                         success = simplifyLabel success,
 856                                         ty = ty})
 857                    end
 858              | Bug => ([], Bug)
 859              | Call {func, args, return} =>
 860                   let
 861                      val (statements, return) =
 862                         case return of
 863                            Return.NonTail {cont, handler} =>
 864                               let
 865                                  fun isEta (m: LabelMeaning.t,
 866                                             ps: Position.t vector): bool =
 867                                     Vector.length ps = Vector.length (meaningArgs m)
 868                                     andalso
 869                                     Vector.foralli
 870                                     (ps,
 871                                      fn (i, Position.Formal i') => i = i'
 872                                       | _ => false)
 873                                  val m = labelMeaning cont
 874                                  fun nonTail () =
 875                                     let
 876                                        val _ = forceMeaningBlock m
 877                                        val handler =
 878                                           Handler.map
 879                                           (handler, fn l =>
 880                                            let
 881                                               val m = labelMeaning l
 882                                               val _ = forceMeaningBlock m
 883                                            in
 884                                               meaningLabel m
 885                                            end)
 886                                     in
 887                                        ([],
 888                                         Return.NonTail {cont = meaningLabel m,
 889                                                         handler = handler})
 890                                     end
 891                                  fun tail statements =
 892                                     (deleteLabelMeaning m
 893                                      ; (statements, Return.Tail))
 894                                  fun cont handlerEta =
 895                                     case LabelMeaning.aux m of
 896                                        LabelMeaning.Bug =>
 897                                           (case handlerEta of
 898                                               NONE => nonTail ()
 899                                             | SOME canMove => tail canMove)
 900                                      | LabelMeaning.Return {args, canMove} =>
 901                                           if isEta (m, args)
 902                                              then tail canMove
 903                                           else nonTail ()
 904                                      | _ => nonTail ()
 905
 906                               in
 907                                  case handler of
 908                                     Handler.Caller => cont NONE
 909                                   | Handler.Dead => cont NONE
 910                                   | Handler.Handle l =>
 911                                        let
 912                                           val m = labelMeaning l
 913                                        in
 914                                           case LabelMeaning.aux m of
 915                                              LabelMeaning.Bug => cont NONE
 916                                            | LabelMeaning.Raise {args, canMove} =>
 917                                                 if isEta (m, args)
 918                                                    then cont (SOME canMove)
 919                                                 else nonTail ()
 920                                            | _ => nonTail ()
 921                                        end
 922                               end
 923                          | _ => ([], return)
 924                   in
 925                      (statements,
 926                       Call {func = func,
 927                             args = simplifyVars args,
 928                             return = return})
 929                   end
 930               | Case {test, cases, default} =>
 931                    let
 932                       val test = varInfo test
 933                       fun cantSimplify () =
 934                          ([],
 935                           Case {test = use test,
 936                                 cases = Cases.map (cases, simplifyLabel),
 937                                 default = Option.map (default, simplifyLabel)})
 938                    in
 939                       simplifyCase
 940                       {canMove = [],
 941                        cantSimplify = cantSimplify,
 942                        cases = cases,
 943                        default = default,
 944                        gone = fn () => (Cases.foreach (cases, deleteLabel)
 945                                         ; Option.app (default, deleteLabel)),
 946                        test = test}
 947                    end
 948               | Goto {dst, args} => goto (dst, varInfos args)
 949               | Raise xs => ([], Raise (simplifyVars xs))
 950               | Return xs => ([], Return (simplifyVars xs))
 951               | Runtime {prim, args, return} =>
 952                    ([], Runtime {prim = prim,
 953                                  args = simplifyVars args,
 954                                  return = simplifyLabel return})
 955                    ) arg
 956          and simplifyCase arg : Statement.t list * Transfer.t =
 957             traceSimplifyCase
 958             (fn {canMove, cantSimplify,
 959                  cases, default, gone, test: VarInfo.t} =>
 960             let
 961                (* tryToEliminate makes sure that the destination meaning
 962                 * hasn't already been simplified.  If it has, then we can't
 963                 * simplify the case.
 964                 *)
 965                fun tryToEliminate m =
 966                   let
 967                      val i = LabelMeaning.blockIndex m
 968                   in
 969                      if Array.sub (inDegree, i) = 0
 970                         then cantSimplify ()
 971                      else
 972                         let
 973                            val _ = addLabelIndex i
 974                            val _ = gone ()
 975                         in
 976                            gotoMeaning (canMove, m, Vector.new0 ())
 977                         end
 978                   end
 979             in
 980                if Cases.isEmpty cases
 981                   then (case default of
 982                            NONE => (canMove, Bug)
 983                          | SOME l => tryToEliminate (labelMeaning l))
 984                else
 985                   let
 986                      val l = Cases.hd cases
 987                      fun isOk (l': Label.t): bool = Label.equals (l, l')
 988                   in
 989                      if Vector.isEmpty (labelArgs l)
 990                         andalso Cases.forall (cases, isOk)
 991                         andalso (case default of
 992                                     NONE => true
 993                                   | SOME l => isOk l)
 994                         then
 995                            (* All cases the same -- eliminate the case. *)
 996                            tryToEliminate (labelMeaning l)
 997                      else
 998                         let
 999                            fun findCase (cases, isCon, args) =
1000                               let
1001                                  val n = Vector.length cases
1002                                  fun doit (l, args) =
1003                                     let
1004                                        val m = labelMeaning l
1005                                        val _ = addLabelMeaning m
1006                                        val _ = gone ()
1007                                     in
1008                                        gotoMeaning (canMove, m, args)
1009                                     end
1010                                  fun loop k =
1011                                     if k = n
1012                                        then
1013                                           (case default of
1014                                               NONE => (gone (); ([], Bug))
1015                                             | SOME l => doit (l, Vector.new0 ()))
1016                                     else
1017                                        let
1018                                           val (con, l) = Vector.sub (cases, k)
1019                                        in
1020                                           if isCon con
1021                                              then doit (l, args)
1022                                           else loop (k + 1)
1023                                        end
1024                               in
1025                                  loop 0
1026                               end
1027                         in
1028                            case (VarInfo.value test, cases) of
1029                               (SOME (Value.Const c), _) =>
1030                                  (case (cases, c) of
1031                                      (Cases.Word (_, cs), Const.Word w) =>
1032                                         findCase (cs,
1033                                                   fn w' => WordX.equals (w, w'),
1034                                                   Vector.new0 ())
1035                                    | _ =>
1036                                         Error.bug "Ssa.Shrink.simplifyCases: strange constant")
1037                             | (SOME (Value.Con {con, args}), Cases.Con cases) =>
1038                                  findCase (cases,
1039                                            fn c => Con.equals (con, c),
1040                                            args)
1041                             | _ => cantSimplify ()
1042                         end
1043                   end
1044             end) arg
1045          and goto (dst: Label.t, args: VarInfo.t vector)
1046             : Statement.t list * Transfer.t =
1047             gotoMeaning ([], labelMeaning dst, args)
1048          and gotoMeaning arg : Statement.t list * Transfer.t =
1049             traceGotoMeaning
1050             (fn (canMoveIn,
1051                  m as LabelMeaning.T {aux, blockIndex = i, ...},
1052                  args: VarInfo.t vector) =>
1053              let
1054                 val n = Array.sub (inDegree, i)
1055                 val _ = Assert.assert ("Ssa.Shrink.gotoMeaning", fn () => n >= 1)
1056                 fun normal () =
1057                    if n = 1
1058                       then
1059                          let
1060                             val _ = Array.update (inDegree, i, 0)
1061                             val b = Vector.sub (blocks, i)
1062                             val _ =
1063                                Vector.foreach2
1064                                (Block.args b, args, fn ((x, _), vi) =>
1065                                 setVarInfo (x, vi))
1066                          in
1067                             simplifyBlock (canMoveIn, b)
1068                          end
1069                    else
1070                       let
1071                          val _ = forceMeaningBlock m
1072                       in
1073                          (canMoveIn,
1074                           Goto {dst = Block.label (Vector.sub (blocks, i)),
1075                                 args = uses args})
1076                       end
1077                 fun extract p =
1078                    case p of
1079                       Position.Formal n => Vector.sub (args, n)
1080                     | Position.Free x => varInfo x
1081                 fun rr ({args, canMove}, make) =
1082                    (canMoveIn @ canMove,
1083                     make (Vector.map (args, use o extract)))
1084                 datatype z = datatype LabelMeaning.aux
1085              in
1086                 case aux of
1087                    Block => normal ()
1088                  | Bug => ((*canMoveIn*)[], Transfer.Bug)
1089                  | Case {canMove, cases, default} =>
1090                       simplifyCase {canMove = canMoveIn @ canMove,
1091                                     cantSimplify = normal,
1092                                     cases = cases,
1093                                     default = default,
1094                                     gone = fn () => deleteLabelMeaning m,
1095                                     test = Vector.first args}
1096                  | Goto {canMove, dst, args} =>
1097                       if Array.sub (isHeader, i)
1098                          orelse Array.sub (isBlock, i)
1099                          then normal ()
1100                       else
1101                          let
1102                             val n' = n - 1
1103                             val _ = Array.update (inDegree, i, n')
1104                             val _ =
1105                                if n' > 0
1106                                   then addLabelMeaning dst
1107                                else ()
1108                          in
1109                             gotoMeaning (canMoveIn @ canMove,
1110                                          dst,
1111                                          Vector.map (args, extract))
1112                          end
1113                  | Raise z => rr (z, Transfer.Raise)
1114                  | Return z => rr (z, Transfer.Return)
1115              end) arg
1116          and evalStatement arg : Statement.t list -> Statement.t list =
1117             traceEvalStatement
1118             (fn (Statement.T {var, ty, exp}) =>
1119             let
1120                val _ = Option.app
1121                        (var, fn x =>
1122                         setVarInfo (x, VarInfo.new (x, SOME ty)))
1123                fun delete ss = ss
1124                fun doit {makeExp: unit -> Exp.t,
1125                          sideEffect: bool,
1126                          value: Value.t option} =
1127                   let
1128                      fun make var =
1129                         Statement.T {var = var,
1130                                      ty = ty,
1131                                      exp = makeExp ()}
1132                   in
1133                      case var of
1134                         NONE =>
1135                            if sideEffect
1136                               then (fn ss => make NONE :: ss)
1137                            else delete
1138                       | SOME x =>
1139                            let
1140                               val VarInfo.T {isUsed, value = r, ...} = varInfo x
1141                               val _ = r := value
1142                            in
1143                               fn ss =>
1144                               if !isUsed
1145                                  then make (SOME x) :: ss
1146                               else if sideEffect
1147                                       then make NONE :: ss
1148                                    else ss
1149                            end
1150                   end
1151                fun setVar vi =
1152                   (Option.app (var, fn x => setVarInfo (x, vi))
1153                    ; delete)
1154                fun construct (v: Value.t, makeExp) =
1155                   doit {makeExp = makeExp,
1156                         sideEffect = false,
1157                         value = SOME v}
1158             in
1159                case exp of
1160                   ConApp {con, args} =>
1161                      let
1162                         val args = varInfos args
1163                      in
1164                         construct (Value.Con {con = con, args = args},
1165                                    fn () => ConApp {con = con,
1166                                                     args = uses args})
1167                      end
1168                 | Const c => construct (Value.Const c, fn () => exp)
1169                 | PrimApp {prim, targs, args} =>
1170                      let
1171                         val args = varInfos args
1172                         fun apply {prim, targs, args} =
1173                            doit {sideEffect = Prim.maySideEffect prim,
1174                                  makeExp = fn () => PrimApp {prim = prim,
1175                                                              targs = targs,
1176                                                              args = uses args},
1177                                  value = NONE}
1178                         datatype z = datatype Prim.ApplyResult.t
1179                      in
1180                         case primApp (prim, args) of
1181                            Apply (prim, args) =>
1182                               apply {prim = prim, targs = Vector.new0 (),
1183                                      args = Vector.fromList args}
1184                          | Bool b =>
1185                               let
1186                                  val con = Con.fromBool b
1187                               in
1188                                  construct (Value.Con {con = con,
1189                                                        args = Vector.new0 ()},
1190                                             fn () =>
1191                                             ConApp {con = con,
1192                                                     args = Vector.new0 ()})
1193                               end
1194                          | Const c => construct (Value.Const c,
1195                                                  fn () => Exp.Const c)
1196                          | Var vi => setVar vi
1197                          | _ => apply {prim = prim,
1198                                        targs = targs,
1199                                        args = args}
1200                      end
1201                 | Select {tuple, offset} =>
1202                      let
1203                         val tuple as VarInfo.T {value, ...} = varInfo tuple
1204                      in
1205                         case !value of
1206                            SOME (Value.Tuple vs) =>
1207                               setVar (Vector.sub (vs, offset))
1208                          | _ =>
1209                               construct (Value.Select {tuple = tuple,
1210                                                        offset = offset},
1211                                          fn () => Select {tuple = use tuple,
1212                                                           offset = offset})
1213                      end
1214                 | Tuple xs =>
1215                      let
1216                         val xs = varInfos xs
1217                      in
1218                         case Exn.withEscape
1219                              (fn escape =>
1220                               Vector.foldri
1221                               (xs, NONE,
1222                                fn (i, VarInfo.T {value, ...}, tuple') =>
1223                                case !value of
1224                                   SOME (Value.Select {offset, tuple}) =>
1225                                      if offset = i
1226                                         then case tuple' of
1227                                                 NONE =>
1228                                                    (case VarInfo.ty tuple of
1229                                                        SOME ty =>
1230                                                           (case Type.deTupleOpt ty of
1231                                                               SOME ts =>
1232                                                                  if Vector.length xs =
1233                                                                     Vector.length ts
1234                                                                     then SOME tuple
1235                                                                  else escape NONE
1236                                                             | NONE => escape NONE)
1237                                                      | NONE => escape NONE)
1238                                               | SOME tuple'' =>
1239                                                    if VarInfo.equals (tuple'', tuple)
1240                                                       then tuple'
1241                                                    else escape NONE
1242                                      else escape NONE
1243                                 | _ => escape NONE)) of
1244                           SOME tuple => setVar tuple
1245                         | NONE => construct (Value.Tuple xs,
1246                                              fn () => Tuple (uses xs))
1247                      end
1248                 | Var x => setVar (varInfo x)
1249                 | _ => doit {makeExp = fn () => exp,
1250                              sideEffect = true,
1251                              value = NONE}
1252             end) arg
1253          val start = labelMeaning start
1254          val _ = forceMeaningBlock start
1255          val f =
1256             Function.new {args = args,
1257                           blocks = Vector.fromList (!newBlocks),
1258                           mayInline = mayInline,
1259                           name = name,
1260                           raises = raises,
1261                           returns = returns,
1262                           start = meaningLabel start}
1263          val _ = if true then () else save (f, "post")
1264          val _ = Function.clear f
1265       in
1266          f
1267       end
1268    end
1269
1270 fun eliminateUselessProfile (f: Function.t): Function.t =
1271    if !Control.profile = Control.ProfileNone
1272       then f
1273    else
1274       let
1275          fun eliminateInBlock (b as Block.T {args, label, statements, transfer})
1276             : Block.t =
1277             if not (Vector.exists (statements, Statement.isProfile))
1278                then b
1279             else
1280                let
1281                   datatype z = datatype Exp.t
1282                   datatype z = datatype ProfileExp.t
1283                   val stack =
1284                      Vector.fold
1285                      (statements, [], fn (s as Statement.T {exp, ...}, stack) =>
1286                       case exp of
1287                          Profile (Leave si) =>
1288                             (case stack of
1289                                 Statement.T {exp = Profile (Enter si'), ...}
1290                                 :: rest =>
1291                                    if SourceInfo.equals (si, si')
1292                                       then rest
1293                                    else Error.bug "Ssa.Shrink.eliminateUselessProfile: mismatched Leave"
1294                               | _ => s :: stack)
1295                        | _ => s :: stack)
1296                   val statements = Vector.fromListRev stack
1297                in
1298                   Block.T {args = args,
1299                            label = label,
1300                            statements = statements,
1301                            transfer = transfer}
1302                end
1303          val {args, blocks, mayInline, name, raises, returns, start} =
1304             Function.dest f
1305          val blocks = Vector.map (blocks, eliminateInBlock)
1306       in
1307          Function.new {args = args,
1308                        blocks = blocks,
1309                        mayInline = mayInline,
1310                        name = name,
1311                        raises = raises,
1312                        returns = returns,
1313                        start = start}
1314       end
1315
1316 val traceShrinkFunction =
1317    Trace.trace ("Ssa.Shrink.shrinkFunction", Function.layout, Function.layout)
1318
1319 val shrinkFunction =
1320    fn g =>
1321    let
1322       val s = shrinkFunction g
1323    in
1324       fn f => traceShrinkFunction s (eliminateUselessProfile f)
1325    end
1326
1327 fun shrink (Program.T {datatypes, globals, functions, main})
1328   = let
1329       val s = shrinkFunction {globals = globals}
1330     in
1331       Program.T {datatypes = datatypes,
1332                  globals = globals,
1333                  functions = List.revMap (functions, s),
1334                  main = main}
1335     end
1336
1337 end