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

SCM Repository

[diderot] View of /branches/vis12/src/compiler/c-util/gen-inputs.sml
ViewVC logotype

View of /branches/vis12/src/compiler/c-util/gen-inputs.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1812 - (download) (annotate)
Sat Apr 7 21:33:09 2012 UTC (7 years, 4 months ago) by jhr
File size: 8230 byte(s)
  Change convention for naming inputs and outputs
(* gen-inputs.sml
 *
 * COPYRIGHT (c) 2012 The Diderot Project (http://diderot-language.cs.uchicago.edu)
 * All rights reserved.
 *)

structure GenInputs : sig

    type input_desc = (TreeIL.Ty.ty * string * string * bool)

    val gatherInputs : TreeIL.block -> input_desc list

    val genRegisterInputs : TargetUtil.target_desc * input_desc list -> CLang.decl

    val genInputFuns : TargetUtil.target_desc * input_desc list -> CLang.decl list

  end = struct

    structure IL = TreeIL
    structure Ty = TreeIL.Ty
    structure CL = CLang
    structure N = CNames

    type input_desc = (Ty.ty * string * string * bool)

    val nrrdPtrTy = CL.T_Ptr(CL.T_Named "Nrrd")
    val wrldPrefixTy = CL.T_Ptr(CL.T_Named "WorldPrefix_t")

    type target_desc = TargetUtil.target_desc

  (* translate TreeIL types to CLang types *)
    val trType = TreeTyToC.trType

  (* an l-value expression for accessing a global variable *)
    fun global name = CL.mkIndirect(CL.mkIndirect(CL.mkVar "wrld", "globals"), name)

  (* gather the input globals from the input initialization block *)
    fun gatherInputs (IL.Block{body, ...}) = let
          fun gather (IL.S_Input(x, name, desc, NONE)) = SOME(IL.Var.ty x, name, desc, false)
            | gather (IL.S_Input(x, name, desc, SOME _)) = SOME(IL.Var.ty x, name, desc, true)
            | gather _ = NONE
          in
            List.mapPartial gather body
          end

(* old input code from tree-to-c.sml
                  | IL.S_Input(lhs, name, desc, optDflt) => let
                      val lhs = VarToC.lvalueVar (env, lhs)
                      val (initCode, hasDflt) = (case optDflt
                             of SOME e => ([CL.mkAssign(lhs, trExp(env, e))], true)
                              | NONE => ([], false)
                            (* end case *))
                      val code = [CL.mkCall(N.input(V.ty lhs), [
                              CL.mkVar "opts",
                              CL.mkStr name,
                              CL.mkStr desc,
                              addrOf lhs,
                              CL.mkBool hasDflt])]
                      in
                        initCode
                      end
*)

    fun genRegisterInputs (tgt : target_desc, inputs) = let
	  val prefix = #namespace tgt
	(* the world pointer type *)
	  val worldPtrTy = CL.T_Ptr(CL.T_Named(prefix ^ "World_t"))
	  in
	    CL.D_Func(
	      [], CL.voidTy, N.registerOpts,
	      [CL.PARAM([], worldPtrTy, "wrld"), CL.PARAM([], CL.T_Ptr(CL.T_Named N.optionsTy), "opts")],
(* FIXME: fill in the code! *)
	      CL.mkBlock[])
	  end

(* FIXME: we need to translate from the C representation to the Diderot representation *)
    fun copy (ty, dst, src) = let
          fun assign () = CL.mkAssign(dst, src)
          fun addrOf (CL.E_UnOp(CL.%*, x)) = x
            | addrOf x = CL.mkUnOp(CL.%&, x)
          fun memcpy () = CL.mkCall("memcpy", [addrOf dst, addrOf src, CL.mkSizeof(trType ty)])
          in
            case ty
             of Ty.BoolTy => assign()
              | Ty.StringTy => CL.mkCall("strcpy", [addrOf dst, addrOf src])
              | Ty.IntTy => assign()
              | Ty.TensorTy[] => assign()
              | Ty.TensorTy _ => memcpy()
              | Ty.SeqTy _ => memcpy()
              | Ty.DynSeqTy _ => raise Fail "dynamic sequence"
              | Ty.ImageTy _ => raise Fail "unexpected image copy"
              | _ => raise Fail(concat["bogus input type ", Ty.toString ty])
            (* end case *)
          end

  (* for each input variable we generate two or three top-level declaraions *)
    fun genInputFuns (tgt : target_desc, inputs) = let
	  val prefix = #namespace tgt
	(* the world pointer type *)
	  val worldPtrTy = CL.T_Ptr(CL.T_Named(prefix ^ "World_t"))
          val wrldParam = CL.PARAM([], worldPtrTy, "wrld")
	(* create decls for an input variable *)
          fun mkInputDecls (ty, name, desc, hasDflt) = let
              (* create a description declaration for the input variable *)
                val descDcl = if (desc = "")
                        then []
                        else [
                            CL.D_Var([], CL.T_Ptr(CL.T_Named "const char"),
                              concat[prefix, name, "Desc"],
                              SOME(CL.I_Exp(CL.mkStr desc)))
                          ]
                val getDcl = if hasDflt
                        then let
                          val getName = concat[prefix, name, "Get"]
                        (* convert the input type to a by-reference C type *)
                          val outTy = (case ty
                                 of Ty.BoolTy => CL.T_Ptr(trType ty)
                                  | Ty.StringTy => CL.T_Ptr(trType ty)
                                  | Ty.IntTy => CL.T_Ptr(trType ty)
                                  | Ty.TensorTy[] => CL.T_Ptr(trType ty)
                                  | Ty.TensorTy _ => trType ty
                                  | Ty.SeqTy _ => trType ty
                                  | Ty.DynSeqTy _ => CL.T_Ptr(trType ty)
                                  | Ty.ImageTy _ => CL.T_Ptr CL.charPtr
                                  | _ => raise Fail(concat["bogus input type ", Ty.toString ty])
                                (* end case *))
                          in [
                            CL.D_Func([], CL.voidTy, getName, [wrldParam, CL.PARAM([], outTy, "v")],
                              CL.mkBlock[copy(ty, CL.mkUnOp(CL.%*, CL.mkVar "v"), global name)])
                          ] end
                        else []
                val setDcl = (case ty
                       of Ty.ImageTy info => let
                            val dim = ImageInfo.dim info
                            in [
                              CL.D_Func(
                                [], CL.boolTy, concat[prefix, name, "SetByName"],
                                [wrldParam, CL.PARAM(["const"], CL.charPtr, "s")],
                                CL.mkBlock[
(* FIXME: we should also generate code to check that the loaded image has the right type, etc. *)
                                    CL.mkReturn(SOME(
                                      CL.mkBinOp(CL.mkVar "DIDEROT_FAIL", CL.#==,
                                        CL.mkApply(N.loadImage dim, [
                                            CL.mkCast(wrldPrefixTy, CL.mkVar "wrld"),
                                            CL.mkVar "s", CL.mkUnOp(CL.%&, global name)
                                          ]))))
                                  ]),
                              CL.D_Func(
                                [], CL.boolTy, concat[prefix, name, "Set"],
                                [wrldParam, CL.PARAM([], nrrdPtrTy, "nin")],
                                CL.mkBlock[
(* FIXME: we should also generate code to check that the loaded image has the right type, etc. *)
                                    CL.mkReturn(SOME(
                                      CL.mkBinOp(CL.mkVar "DIDEROT_FAIL", CL.#==,
                                        CL.mkApply(N.setImage dim, [
                                            CL.mkCast(wrldPrefixTy, CL.mkVar "wrld"),
                                            CL.mkVar "nin", CL.mkUnOp(CL.%&, global name)
                                          ]))))
                                  ])
                            ] end
                        | Ty.DynSeqTy _ => raise Fail "dynamic input not supported yet"
                        | _ => [
                              CL.D_Func(
                                [], CL.boolTy, concat[prefix, name, "Set"],
                                [wrldParam, CL.PARAM([], trType ty, "v")],
                                CL.mkBlock[
                                    copy(ty, global name, CL.mkVar "v"),
                                    CL.mkReturn(SOME(CL.mkVar "false"))
                                  ])
                            ]
                      (* end case *))
                in
                  descDcl @ getDcl @ setDcl
                end
          in
            List.foldr (fn (input, dcls) => mkInputDecls input @ dcls) [] inputs
          end

  end

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0