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

SCM Repository

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

View of /branches/vis12-cl/src/compiler/c-util/output-util.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2694 - (download) (annotate)
Wed Sep 10 22:55:58 2014 UTC (4 years, 11 months ago) by jhr
File size: 3396 byte(s)
  Woeking on OpenCL support
(* output-util.sml
 *
 * COPYRIGHT (c) 2014 The Diderot Project (http://diderot-language.cs.uchicago.edu)
 * All rights reserved.
 *
 * Common code for output.
 *)

structure OutputUtil : sig

    val genOutput : Properties.props * (TreeIL.Ty.ty * string) list -> CLang.decl list

  end = struct

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

    val nrrdPtrTy = CL.T_Ptr(CL.T_Named "Nrrd")
    val filePtrTy = CL.T_Ptr(CL.T_Named "FILE")

  (* variables in the generated code *)
    val wrldV = CL.mkVar "wrld"
    val nDataV = CL.mkVar "nData"
    val nLengthsV = CL.mkVar "nLengths"
    val NRRD = CL.mkVar "NRRD"

    fun wrldPtr tgt = CL.T_Ptr(CL.T_Named(N.worldTy tgt))

  (* generate the nrrd-file output and print functions used by standalone executables *)
    fun genOutput (tgt : Properties.props, outputs) = let
	  fun isDyn ty = (case ty of Ty.DynSeqTy _ => true | _ => false)
(* FIXME: use biffMsgAddF and return error status *)
	  fun error (fmt, msg) = CL.mkBlock[
		  CL.mkCall("fprintf", [CL.mkVar "stderr", CL.mkStr fmt, msg]),
		  CL.mkCall("exit", [CL.mkInt 1])
		]
	  val outDecls = if List.exists (isDyn o #1) outputs
		then [CL.mkDecl(nrrdPtrTy, "nLengths", NONE), CL.mkDecl(nrrdPtrTy, "nData", NONE)]
		else [CL.mkDecl(nrrdPtrTy, "nData", NONE)]
	  val prDecls = outDecls @ [CL.mkDecl(filePtrTy, "outS", NONE)]
	  fun nrrdNew v = CL.mkAssign(v, CL.mkApply("nrrdNew", []))
	  fun nrrdNuke v = CL.mkCall("nrrdNuke", [v])
	  fun writeNrrd (ty, name) =
		if isDyn ty
		  then [
		      nrrdNew (nLengthsV),
		      nrrdNew (nDataV),
		      CL.mkIfThenElse(
			CL.mkApply(N.outputGet(tgt, name), [wrldV, nLengthsV, nDataV]),
		      (* then *)
			  error ("Error getting nrrd data:\n%s\n",
			    CL.mkApply("biffMsgStrGet", [CL.mkIndirect(wrldV, "errors")])),
		      (* else *)
			CL.mkIfThen(
			  CL.mkBinOp(
			    CL.mkApply("nrrdSave", [
				CL.mkStr(OS.Path.joinBaseExt{base=name^"-len", ext=SOME "nrrd"}),
				nLengthsV, CL.mkVar "NULL"
			      ]),
			    CL.#||,
			    CL.mkApply("nrrdSave", [
				CL.mkStr(OS.Path.joinBaseExt{base=name^"-data", ext=SOME "nrrd"}),
				nDataV, CL.mkVar "NULL"
			      ])),
			(* then *)
			  error ("Error saving nrrd:\n%s\n", CL.mkApply("biffGetDone", [NRRD]))
			(* endif *))
		      (* endif *)),
		      nrrdNuke nLengthsV,
		      nrrdNuke nDataV
		    ]
		  else [
		      nrrdNew (nDataV),
		      CL.mkIfThenElse(
			CL.mkApply(N.outputGet(tgt, name), [wrldV, nDataV]),
		      (* then *)
			  error ("Error getting nrrd data:\n%s\n",
			    CL.mkApply("biffMsgStrGet", [CL.mkIndirect(wrldV, "errors")])),
		      (* else *)
			CL.mkIfThen(
			  CL.mkApply("nrrdSave", [
			      CL.mkStr(OS.Path.joinBaseExt{base=name, ext=SOME "nrrd"}),
			      nDataV, CL.mkVar "NULL"
			    ]),
			(* then *)
			  error ("Error saving nrrd:\n%s\n", CL.mkApply("biffGetDone", [NRRD]))
			(* endif *))
		      (* endif *)),
		      nrrdNuke nDataV
		    ]
	  fun printNrrd (ty, name) = [] (* FIXME *)
	  in [
	    CL.D_Func(["static"], CL.voidTy, "WriteOutput", [CL.PARAM([], wrldPtr tgt, "wrld")],
	      CL.mkBlock(outDecls @ List.foldr (fn (output, l) => writeNrrd output @ l) [] outputs)),
	    CL.D_Func(["static"], CL.voidTy, "PrintOutput", [CL.PARAM([], wrldPtr tgt, "wrld")],
	      CL.mkBlock(prDecls @ List.foldr (fn (output, l) => printNrrd output @ l) [] outputs))
	  ] end
		      
  end

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