Home My Page Projects Code Snippets Project Openings diderot
Summary Activity Tracker Tasks SCM

SCM Repository

[diderot] View of /branches/pure-cfg/src/compiler/codegen/codegen-fn.sml
ViewVC logotype

View of /branches/pure-cfg/src/compiler/codegen/codegen-fn.sml

Parent Directory Parent Directory | Revision Log Revision Log

Revision 1278 - (download) (annotate)
Mon Jun 6 16:27:28 2011 UTC (10 years ago) by jhr
File size: 6117 byte(s)
  Added name field to program representation and switched to smart constructors
  in OpenCL backend
(* 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.
 *      We need to run the TreeIL through a splitting pass to match the target's vector widths.

functor CodeGenFn (T : TARGET) : sig

    val generate : {
            basename : string,
            double : bool,
            parallel : bool,
            debug : bool,
            prog : LowIL.program
          } -> unit

  end = struct

    structure IL = TreeIL

    structure LowToTree = LowToTreeFn(T)

    fun trMethod (strand, stateVars, env) = let
          val varyingStateVars = List.mapPartial
                (fn (IL.SV{varying = true, var, ...}) => SOME var | _ => NONE)
          val env = T.Env.scopeMethod (env, varyingStateVars)
          fun tr (IL.Method{name, body}) = let
                val body = T.Tr.block (env, body)
                  T.Strand.method (strand, Atom.toString name, body)

    fun trStrand (prog, env) (IL.Strand{name, params, state, stateInit, methods}) = let
          val strand = T.Strand.define(prog, name)
          val env = T.Env.scopeStrand (env, List.map (fn (IL.SV{var, ...}) => var) state)
        (* the output state variable *)
          val outputVar = ref NONE
        (* map the state variables to target state variables and extend the environment *)
          val env = let
                fun cvtSVar (IL.SV{output, var=x, ...}, env) = let
                      val x' = T.Var.state(strand, x)
                        case (output, !outputVar)
                         of (true, NONE) => outputVar := SOME(IL.Var.ty x, x')
                          | (false, _) => ()
                          | _ => raise Fail("multiple outputs in " ^ Atom.toString name)
                        (* end case *);
                        T.Env.bind(env, x, x')
                (* note that we folr right-to-left to get the order of state variables in the
                 * target strand in the right order.
                  List.foldr cvtSVar env state
        (* 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')
            T.Strand.init (strand, params', T.Tr.block (env, stateInit));
            case !outputVar
             of NONE => raise Fail("no output specified for strand " ^ Atom.toString name)
              | SOME(ty, x) => T.Strand.output (strand, ty, x)
            (* end case *);
            List.app (trMethod (strand, state, env)) methods

    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))
                  (env, iter::iters)
          val (env, iters) = List.foldr trIter (env, []) iters
          val (env, createPrefix) = T.Tr.fragment (env, createPrefix)
            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

    fun generate {basename, double, parallel, debug, prog=srcProg} = let
          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 {
                  name = basename,
                  double = double,
                  parallel = parallel,
                  debug = debug
          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)
                        (cnt, (x, T.Var.global(prog, name, IL.Var.ty x))::globs)
                val (_, globs) = List.foldl genName (0, []) globals
                fun gvar ((x, x'), env) = T.Env.bind(env, x, x')
                  List.foldl gvar (T.Env.scopeGlobal env) globs
            T.Program.inputs (prog, T.Tr.block (T.Env.scopeGlobal env, inputInit));
          (* global initialization *)
            T.Program.init (prog, T.Tr.block (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 (basename, prog)


ViewVC Help
Powered by ViewVC 1.0.0