(* gen-library-interface.sml
 *
 * COPYRIGHT (c) 2012 The Diderot Project (http://diderot-language.cs.uchicago.edu)
 * All rights reserved.
 *
 * Generate the C header file for the library produced by the compiler.
 *
 * The format of header file is:
 *
 *	HEAD
 *	decls for input variables
 *	BODY
 *	decls for output variables
 *	FOOT
 *)

structure GenLibraryInterface : sig

    val gen : {
	    tgt : TargetUtil.target_desc,	(* target information *)
	    rt : string option,			(* fragment with extra runtime system hooks *)
	    inputs : (TreeIL.Ty.ty * string * string option * TreeIL.exp option) list,
	    outputs : (TreeIL.Ty.ty * string) list
	  } -> unit

  end = struct

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

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

  (* translate a TreeIL type to the C types used to represent it in the external API *)
    val trType = CTyTranslate.toCType

    fun mkSymbol base = let
	  fun tr c = if Char.isAlpha c then Char.toUpper c
		else if Char.isDigit c then c
		else #"_"
	  in
	    String.concat["_", CharVector.map tr base, "_H_"]
	  end

    fun gen {tgt, rt, inputs, outputs} = let
	  val filename = OS.Path.joinDirFile{
		  dir = #outDir tgt,
		  file = OS.Path.joinBaseExt{base = #outBase tgt, ext = SOME "h"}
		}
	(* the world pointer type *)
	  val worldPtrTy = CL.T_Ptr(CL.T_Named(N.worldTy tgt))
	(* create decls for an input variable *)
          fun mkInputDecls (ty, name, desc, optDflt) = let
                val wrldParam = CL.PARAM([], worldPtrTy, "wrld")
              (* create a description declaration for the input variable *)
                val descDcl = (case desc
		       of NONE => []
			| SOME desc => [
			      CL.D_Var(["extern"], CL.T_Ptr(CL.T_Named "const char"),
				N.inputDesc(tgt, name), NONE)
			    ]
		      (* end case *))
                val getDcl = if Option.isSome optDflt
                        then let
                          val name = N.inputGet(tgt, name)
                        (* 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
(* FIXME: for images and sequences, it is not clear what the get function should return.
 * For now, we just return 0
 *)
                                  | Ty.DynSeqTy _ => CL.T_Ptr CL.voidPtr
                                  | Ty.ImageTy _ => CL.T_Ptr CL.voidPtr
                                  | _ => raise Fail(concat["bogus input type ", Ty.toString ty])
                                (* end case *))
                          in [
                            CL.D_Proto([], CL.voidTy, name, [wrldParam, CL.PARAM([], outTy, "v")])
                          ] end
                        else []
                val setDcl = let
		    (* prototypes for setting an image or dynamic sequence from a nrrd *)
		      fun loadPrototypes () = [
                              CL.D_Proto(
                                [], CL.boolTy, N.inputSetByName(tgt, name),
                                [wrldParam, CL.PARAM(["const"], CL.charPtr, "s")]),
                              CL.D_Proto(
                                [], CL.boolTy, N.inputSet(tgt, name),
                                [wrldParam, CL.PARAM([], nrrdPtrTy, "data")])
			    ]
		      in
			case ty
			 of Ty.ImageTy _ => loadPrototypes()
			  | Ty.DynSeqTy _ => loadPrototypes()
			  | _ => [
				CL.D_Proto(
				  [], CL.boolTy, N.inputSet(tgt, name),
				  [wrldParam, CL.PARAM([], trType ty, "v")])
			      ]
			(* end case *)
		      end
                in
                  descDcl @ getDcl @ setDcl
                end
	(* create a decl for an output variable *)
	  fun mkGetDecl snapshot (Ty.DynSeqTy _, name) = [
		  CL.D_Proto(
		    [], CL.boolTy, (if snapshot then N.snapshotGet else N.outputGet)(tgt, name),
		    [CL.PARAM([], worldPtrTy, "wrld"), CL.PARAM([], nrrdPtrTy, "lengths"), CL.PARAM([], nrrdPtrTy, "data")])
		]
	    | mkGetDecl snapshot (_, name) = [
		  CL.D_Proto(
		    [], CL.boolTy, (if snapshot then N.snapshotGet else N.outputGet)(tgt, name),
		    [CL.PARAM([], worldPtrTy, "wrld"), CL.PARAM([], nrrdPtrTy, "data")])
		]
	  val placeholders = [
		  ("DIDEROT_FLOAT_PRECISION", TargetUtil.floatPrecisionDef tgt),
		  ("DIDEROT_INT_PRECISION", TargetUtil.intPrecisionDef tgt),
		  ("DIDEROT_TARGET", TargetUtil.targetDef tgt),
		  ("HDRFILE", filename),
		  ("HDR_DEFINE", mkSymbol(#outBase tgt)),
		  ("PREFIX", #namespace tgt),
		  ("SRCFILE", #srcFile tgt)
		]
	  val outStrm = TextIO.openOut filename
	  val outS = PrC.new outStrm
	  fun prFrag frag = PrC.output (outS, CL.verbatim [frag] placeholders)
	  val prDecls = List.app (fn dcl => PrC.output(outS, dcl))
	  in
	    prFrag LibInterfaceHeadFrag.text;
	    PrC.output (outS, CL.D_Verbatim ["\n/**** Functions etc. for input variables ****/\n"]);
	    List.app (fn input => prDecls (mkInputDecls input)) inputs;
	    prFrag LibInterfaceRTFrag.text;
	    case rt of SOME rt => prFrag rt | _ => ();
	    prFrag LibInterfaceBodyFrag.text;
	    PrC.output (outS, CL.D_Verbatim ["\n/**** Getters for output values ****/\n"]);
	    if (#snapshot tgt)
	      then List.app (fn output => prDecls (mkGetDecl true output)) outputs
	      else ();
	    List.app (fn output => prDecls (mkGetDecl false output)) outputs;
	    prFrag LibInterfaceFootFrag.text;
	    PrC.close outS;
	    TextIO.closeOut outStrm
	  end

  end