(* codegen-fn.sml
 *
 * COPYRIGHT (c) 2011 The Diderot Project (http://diderot-language.cs.uchicago.edu)
 * All rights reserved.
 *
 * Generic support for translating LowIL code to the target representation.
 *
 * FIXME:
 *      We need to run the TreeIL through a splitting pass to match the target's vector widths.
 *)

functor CodeGenFn (T : TARGET) : sig

    val generate : TargetUtil.target_desc * LowIL.program -> unit

  end = struct

    structure IL = TreeIL

    val targetSupportsPrinting = ref T.supportsPrinting

    local
      structure TargetInfo =
        struct
          fun supportsPrinting () = !targetSupportsPrinting
          val inlineCons = T.inlineCons
          val inlineMatrixExp = T.inlineMatrixExp
        end
    in
    structure LowToTree = LowToTreeFn(TargetInfo)
    end

    fun trMethod (strand, stateVars, env) = let
          fun tr (IL.Method{name, body}) = let
                val env = T.Env.scopeMethod (env, name)
                val body = T.Tr.block (env, body)
                in
                  T.Strand.method (strand, name, body)
                end
          in
            tr
          end

    fun trStrand (prog, env) (IL.Strand{name, params, state, stateInit, methods}) = let
          val strand = T.Strand.define(prog, name, state)
          val env = T.Env.scopeStrand env
        (* define the parameters and add them to the environment *)
          val params' = List.map T.Var.param params
          val env = ListPair.foldlEq (fn (x, y, env) => T.Env.bind(env, x, y)) env (params, params')
          in
            T.Strand.init (strand, params', T.Tr.block (env, stateInit));
            List.app (trMethod (strand, state, env)) methods
          end

    fun trInitially (env, prog, {isArray, iterPrefix, iters, createPrefix, strand, args}) = let
          val env = T.Env.scopeInitially env
          val (env, iterPrefix) = T.Tr.fragment (env, iterPrefix)
          fun trIter ((param, lo, hi), (env, iters)) = let
                val param' = T.Var.param param
                val env = T.Env.bind (env, param, param')
                val iter = (param', T.Tr.exp (env, lo), T.Tr.exp (env, hi))
                in
                  (env, iter::iters)
                end
          val (env, iters) = List.foldr trIter (env, []) iters
          val (env, createPrefix) = T.Tr.fragment (env, createPrefix)
          in
            T.Program.initially {
                prog = prog,
                isArray = isArray,
                iterPrefix = iterPrefix,
                iters = iters,
                createPrefix = createPrefix,
                strand = strand,
                args = List.map (fn e => T.Tr.exp(env, e)) args
              }
          end

    fun generate (tgt : TargetUtil.target_desc, srcProg) = let
          val _ = if #parallel tgt then targetSupportsPrinting := false else ()
          val treeProg as TreeIL.Program{props, globals, inputInit, globalInit, strands, initially} =
                PhaseTimer.withTimer Timers.timeLowToTree LowToTree.translate srcProg
val _ = (
TextIO.output(Log.logFile(), "********** After translation to TreeIL **********\n");
TreeILPP.program (Log.logFile(), treeProg))
          val prog = T.Program.new tgt
          val env = T.Env.new prog
        (* define the globals and initialize the environment *)
          val env = let
              (* produce a list of target variables for the globals, such that each global
               * has a unique name.
               *)
                fun genName (x, (cnt, globs)) = let
                      val name = IL.Var.name x
                      fun uniqueName (name, cnt) =
                            if List.exists (fn (_, y) => (name = T.Var.name y)) globs
                              then uniqueName(name ^ Int.toString cnt, cnt+1)
                              else (name, cnt)
                      val (name, cnt) = uniqueName (IL.Var.name x, cnt)
                      in
                        (cnt, (x, T.Var.global(prog, name, IL.Var.ty x))::globs)
                      end
                val (_, globs) = List.foldl genName (0, []) globals
                fun gvar ((x, x'), env) = T.Env.bind(env, x, x')
                in
                  List.foldl gvar (T.Env.scopeGlobal env) globs
                end
          in
            T.Program.inputs (prog, T.Env.scopeGlobal env, inputInit);
          (* global initialization *)
            T.Program.init (prog, T.Tr.block (T.Env.scopeGlobal env, globalInit));
          (* global destruction *)
            T.Program.free (prog, T.Tr.free (T.Env.scopeGlobal env, globalInit));
          (* translate strands *)
            List.app (trStrand (prog, env)) strands;
          (* generate the initially function *)
            trInitially (env, prog, initially);
          (* output the program *)
            T.Program.generate prog
          end

  end