(* c-target.sml
 *
 * COPYRIGHT (c) 2011 The Diderot Project (http://diderot-language.cs.uchicago.edu)
 * All rights reserved.
 *
 * Generate C code with SSE 4.2 intrinsics.
 *)

structure CTarget : TARGET =
  struct

    structure CL = CLang

    datatype ty
      = T_Bool
      | T_Int			(* default float type *)
      | T_Real			(* default real type *)
      | T_Vec of int
      | T_IVec of int
      | T_Image of int		(* n-dimensional image data *)
      | T_Data of CL.ty		(* pointer to image data *)

    type strand = unit (* FIXME *)

    type var = (ty * string) (* FIXME *)

    type exp = CLang.exp * ty

    type stm = CL.stm

    type method = unit (* FIXME *)

    datatype program = Prog of {
	globals : CL.decl list ref,
	strands : strand list ref
      }

  (* globals that specify the target characteristics.  These should be initialized
   * when the program object is created.
   *)
    val gVectorWid = ref 4
    val gIntTy = ref CL.int32
    val gRealTy = ref CL.float

  (* initialize globals based on target precision *)
    fun initGlobals () = if !Controls.doublePrecision
	  then (
	    gVectorWid := 2;
	    gIntTy := CL.int64;
	    gRealTy := CL.double)
	  else (
	    gVectorWid := 4;
	    gIntTy := CL.int32;
	    gRealTy := CL.float)

  (* for SSE, we have 128-bit vectors *)
    fun vectorWidth () = !gVectorWid

  (* target types *)
    val boolTy = T_Bool
    val intTy = T_Int
    val realTy = T_Real
    fun vecTy 1 = T_Real
      | vecTy n = if (n < 1) orelse (!gVectorWid < n)
	  then raise Size
	  else T_Vec n
    fun ivecTy 1 = T_Int
      | ivecTy n = if (n < 1) orelse (!gVectorWid < n)
	  then raise Size
	  else T_IVec n
    fun imageTy dim = T_Image dim

  (* convert target types to CLang types *)
    fun cvtTy T_Bool = CLang.T_Named "bool"
      | cvtTy T_Int = !gIntTy
      | cvtTy T_Real = !gRealTy
      | cvtTy (T_Vec n) = CLang.T_Named(concat["Diderot_vec", Int.toString n, "D_t"])
      | cvtTy (T_IVec n) = raise Fail "FIXME: T_IVec"
      | cvtTy (T_Image n) = CLang.T_Named(concat["Diderot_image", Int.toString n, "D_t"])
      | cvtTy (T_Data ty) = ty

  (* helper functions for checking the types of arguments *)
    fun scalarTy T_Int = true
      | scalarTy T_Real = true
      | scalarTy _ = false
    fun numTy T_Bool = false
      | numTy (T_Image _) = false
      | numTy (T_Data _) = false
      | numTy _ = true

    fun newProgram () = (
	  initGlobals();
	  Prog{
	      globals = ref [],
	      strands = ref []
	    })

    fun defineStrand (p, strandId) = raise Fail "FIXME: unimplemented"

    structure Var =
      struct
	fun global (Prog{globals, ...}, ty, name) = (
	      globals := CL.D_Var([], cvtTy ty, name) :: !globals;
	      (ty, name))
	fun state (strand, ty, name) = raise Fail "FIXME: Var.state" 
	fun tmp ty = raise Fail "FIXME: Var.tmp"
      end

  (* expression construction *)
    structure Expr =
      struct
      (* variable references *)
	fun global (ty, x) = (CL.mkVar x, ty)
	fun getState (ty, x) = (CL.mkIndirect(CL.mkVar "self", x), ty)
	fun param (ty, x) = (CL.mkVar x, ty)
	fun var (ty, x) = (CL.mkVar x, ty)

      (* literals *)
	fun intLit n = (CL.mkInt(n, !gIntTy), intTy)
	fun floatLit f = (CL.mkFlt(f, !gRealTy), realTy)
	fun stringLit s = (CL.mkStr s, T_Data CL.charPtr)
	fun boolLit b = (CL.mkBool b, boolTy)

      (* vector construction *)
	fun vector _ = raise Fail "FIXME: Expr.vector"

      (* select from a vector *)
	fun select (i, (e, T_Vec n)) =
	      if (i < 0) orelse (n <= i)
		then raise Subscript
		else (CL.mkSubscript(e, CL.mkInt(IntInf.fromInt i, CL.int32)), T_Real)
	  | select (i, (e, T_IVec n)) =
	      if (i < 0) orelse (n <= i)
		then raise Subscript
		else (CL.mkSubscript(e, CL.mkInt(IntInf.fromInt i, CL.int32)), T_Int)
	  | select _ = raise Fail "invalid argument to select"

      (* vector (and scalar) arithmetic *)
	local
	  fun checkTys (ty1, ty2) = (ty1 = ty2) andalso numTy ty1
	  fun binop rator ((e1, ty1), (e2, ty2)) =
		if checkTys (ty1, ty2)
		  then (CL.mkBinOp(e1, rator, e2), ty1)
		  else raise Fail "invalid arguments to binary operator"
	in
	val add = binop CL.#+
	val sub = binop CL.#-
	val mul = binop CL.#*
	val divide = binop CL.#/
	end (* local *)
	fun neg (e, T_Bool) = raise Fail "invalid argument to neg"
	  | neg (e, ty) = (CL.mkUnOp(CL.%-, e), ty)

	fun abs (e, T_Int) = (CL.mkApply("abs", [e]), T_Int)	(* FIXME: not the right type for 64-bit ints *)
	  | abs (e, T_Real) =
	      if !Controls.doublePrecision
		then (CL.mkApply("fabs", [e]), T_Real)
		else (CL.mkApply("fabsf", [e]), T_Real)
	  | abs (e, T_Vec n) = raise Fail "FIXME: Expr.abs"
	  | abs (e, T_IVec n) = raise Fail "FIXME: Expr.abs"
	  | abs _ = raise Fail "invalid argument to abs"

	fun dot ((e1, T_Vec n1), (e2, T_Vec n2)) = raise Fail "FIXME: Expr.dot"
	  | dot _ = raise Fail "invalid argument to dot"

	fun cross ((e1, T_Vec 3), (e2, T_Vec 3)) = raise Fail "FIXME: Expr.cross"
	  | cross _ = raise Fail "invalid argument to cross"

	fun length (e, T_Vec n) = raise Fail "FIXME: Expr.length"
	  | length _ = raise Fail "invalid argument to length"

	fun normalize (e, T_Vec n) = raise Fail "FIXME: Expr.normalize"
	  | normalize _ = raise Fail "invalid argument to length"

      (* comparisons *)
	local
	  fun checkTys (ty1, ty2) =
		(ty1 = ty2) andalso scalarTy ty1
	  fun cmpop rator ((e1, ty1), (e2, ty2)) =
		if checkTys (ty1, ty2)
		  then (CL.mkBinOp(e1, rator, e2), T_Bool)
		  else raise Fail "invalid arguments to compare operator"
	in
	val lt = cmpop CL.#<
	val lte = cmpop CL.#<=
	val equ = cmpop CL.#==
	val neq = cmpop CL.#!=
	val gte = cmpop CL.#>=
	val gt = cmpop CL.#>
	end (* local *)

      (* logical connectives *)
	fun not (e, T_Bool) = (CL.mkUnOp(CL.%!, e), T_Bool)
	  | not _ = raise Fail "invalid argument to not"
	fun && ((e1, T_Bool), (e2, T_Bool)) = (CL.mkBinOp(e1, CL.#&&, e2), T_Bool)
	  | && _ = raise Fail "invalid arguments to &&"
	fun || ((e1, T_Bool), (e2, T_Bool)) = (CL.mkBinOp(e1, CL.#||, e2), T_Bool)
	  | || _ = raise Fail "invalid arguments to ||"

	local
	  fun checkTys (ty1, ty2) = (ty1 = ty2) andalso scalarTy ty1
	  fun binFn f ((e1, ty1), (e2, ty2)) =
		if checkTys (ty1, ty2)
		  then (CL.mkApply(f, [e1, e2]), ty1)
		  else raise Fail "invalid arguments to binary function"
	in
      (* misc functions *)
	val min = binFn "Diderot_min"
	val max = binFn "Diderot_max"
	end (* local *)

      (* math functions *)
	fun pow ((e1, T_Real), (e2, T_Real)) =
	      if !Controls.doublePrecision
		then (CL.mkApply("pow", [e1, e2]), T_Real)
		else (CL.mkApply("powf", [e1, e2]), T_Real)
	  | pow _ = raise Fail "invalid arguments to pow"

	local
	  fun r2r (ff, fd) (e, T_Real) = if !Controls.doublePrecision
		then (CL.mkApply(fd, [e]), T_Real)
		else (CL.mkApply(ff, [e]), T_Real)
	    | r2r (_, fd) _ = raise Fail("invalid argument for "^fd)
	in
	val sin = r2r ("sinf", "sin")
	val cos = r2r ("cosf", "cos")
	val sqrt = r2r ("sqrtf", "sqrt")
      (* rounding *)
	val trunc = r2r ("truncf", "trunc")
	val round = r2r ("roundf", "round")
	val floor = r2r ("floorf", "floor")
	val ceil  = r2r ("ceilf", "ceil")
	end (* local *)

      (* conversions *)
	fun toReal (e, T_Int) = (CL.mkCast(!gRealTy, e), T_Real)
	  | toReal _ = raise Fail "invalid argument for toReal"

	fun truncToInt (e as (_, T_Real)) = (CL.mkCast(!gIntTy, #1(trunc e)), T_Int)
	  | truncToInt _ = raise Fail "invalid argument for truncToInt"
	fun roundToInt (e as (_, T_Real)) = (CL.mkCast(!gIntTy, #1(round e)), T_Int)
	  | roundToInt _ = raise Fail "invalid argument for roundToInt"
	fun ceilToInt (e as (_, T_Real)) = (CL.mkCast(!gIntTy, #1(floor e)), T_Int)
	  | ceilToInt _ = raise Fail "invalid argument for ceilToInt"
	fun floorToInt (e as (_, T_Real)) = (CL.mkCast(!gIntTy, #1(ceil e)), T_Int)
	  | floorToInt _ = raise Fail "invalid argument for floorToInt"

      (* runtime system hooks *)
	fun imageAddr (e, T_Image d) = let
	      val cTy = CL.T_Ptr(!gRealTy)
	      in
		(CL.mkCast(cTy, CL.mkIndirect(e, "data")), T_Data cTy)
	      end
	  | imageAddr _ = raise Fail "invalid argument to imageAddr"
      end

  (* statement construction *)
    structure Stmt =
      struct
	val comment = CL.S_Comment
	fun assignState (x, (e, _)) = CL.mkAssign(#1(Expr.getState x), e)
	fun assign ((_, x), (e, _)) = CL.mkAssign(CL.mkVar x, e)
	fun decl ((ty, x), SOME(e, _)) = CL.mkDecl(cvtTy ty, x, SOME e)
	  | decl ((ty, x), NONE) = CL.mkDecl(cvtTy ty, x, NONE)
	val block = CL.mkBlock
	fun ifthenelse ((e, T_Bool), s1, s2) = CL.mkIfThenElse(e, s1, s2)
	fun die () = comment ["**** die ****"] (* FIXME *)
	fun stabilize () = comment ["**** stabilize ****"] (* FIXME *)
      end

    fun generate (baseName, Prog{globals, strands}) = let
	  val fileName = OS.Path.joinBaseExt{base=baseName, ext=SOME "c"}
	  val outS = TextIO.openOut fileName
	  val ppStrm = PrintAsC.new outS
	  in
	    List.app (fn dcl => PrintAsC.output(ppStrm, dcl)) (List.rev (!globals));
(* what about the strands, etc? *)
	    PrintAsC.close ppStrm;
	    TextIO.closeOut outS
	  end

  end

structure CBackEnd = CodeGenFn(CTarget)