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

SCM Repository

[diderot] View of /branches/vis15/src/compiler/mid-to-low/mk-low-ir.sml
ViewVC logotype

View of /branches/vis15/src/compiler/mid-to-low/mk-low-ir.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3746 - (download) (annotate)
Tue Apr 12 11:49:43 2016 UTC (3 years, 4 months ago) by jhr
File size: 6828 byte(s)
  working on merge
(* mk-low-ir.sml
 *
 * Helper code to build LowIR assigments using the AvailRHS infrastructure.
 *
 * This code is part of the Diderot Project (http://diderot-language.cs.uchicago.edu)
 *
 * COPYRIGHT (c) 2016 The University of Chicago
 * All rights reserved.
 *)

structure MkLowIR : sig

  (* an environment that maps De Bruijn indices to their iteration-index value *)
    type index_env = int IntRedBlackMap.map
 
  (* ??? *)
    val lookupIdx : int IntRedBlackMap.map * int -> int
  (* ??? *)
    val lookupMu : int IntRedBlackMap.map * Ein.mu -> int

  (* make "x := <int-literal>" *)
    val intLit : AvailRHS.t * IntLit.t -> LowIR.var
  (* make "x := <real-literal>" *)
    val realLit : AvailRHS.t * RealLit.t -> LowIR.var
  (* make "x := <real-literal>", where the real literal is specified as an integer *)
    val intToRealLit : AvailRHS.t * int -> LowIR.var

  (* generate a reduction sequence using the given binary operator *)
    val reduce : AvailRHS.t * (AvailRHS.t * LowIR.var * LowIR.var -> LowIR.var) * LowIR.var list
	  -> LowIR.var

  (* scalar arithmetic *)
    val realAdd : AvailRHS.t * LowIR.var * LowIR.var -> LowIR.var
    val realSub : AvailRHS.t * LowIR.var * LowIR.var -> LowIR.var
    val realMul : AvailRHS.t * LowIR.var * LowIR.var -> LowIR.var
    val realDiv : AvailRHS.t * LowIR.var * LowIR.var -> LowIR.var
    val realNeg : AvailRHS.t * LowIR.var -> LowIR.var

  (* scalar math functions *)
    val realSqrt   : AvailRHS.t * LowIR.var -> LowIR.var
    val realCos    : AvailRHS.t * LowIR.var -> LowIR.var
    val realArcCos : AvailRHS.t * LowIR.var -> LowIR.var
    val realSin    : AvailRHS.t * LowIR.var -> LowIR.var
    val realArcSin : AvailRHS.t * LowIR.var -> LowIR.var
    val realTan    : AvailRHS.t * LowIR.var -> LowIR.var
    val realArcTan : AvailRHS.t * LowIR.var -> LowIR.var

  (* vector arithmetic *)
    val vecAdd   : AvailRHS.t * int * LowIR.var * LowIR.var -> LowIR.var
    val vecSub   : AvailRHS.t * int * LowIR.var * LowIR.var -> LowIR.var
    val vecScale : AvailRHS.t * int * LowIR.var * LowIR.var -> LowIR.var
    val vecMul   : AvailRHS.t * int * LowIR.var * LowIR.var -> LowIR.var
    val vecNeg   : AvailRHS.t * int * LowIR.var -> LowIR.var
    val vecSum   : AvailRHS.t * int * LowIR.var -> LowIR.var
    val vecProj  : AvailRHS.t * int * LowIR.var * int -> LowIR.var
    val vecDot   : AvailRHS.t * int * LowIR.var * LowIR.var -> LowIR.var

  (* tensor operations *)
    val tensorIndex : AvailRHS.t * index_env * LowIR.var * Ein.alpha -> LowIR.var

  (* make "x := [args]" *)
    val cons : AvailRHS.t * int list * LowIR.var list -> LowIR.var
  (* code for δ_{i,j} *)
    val delta : AvailRHS.t * index_env * Ein.mu * Ein.mu -> LowIR.var
  (* code for ε_{i,j} *)
    val epsilon2 : AvailRHS.t * index_env * Ein.index_id * Ein.index_id -> LowIR.var
  (* code for ε_{i,j,k} *)
    val epsilon3 : AvailRHS.t * index_env * Ein.index_id * Ein.index_id * Ein.index_id -> LowIR.var

  (* evaluate δ_{i,j} *)
    val evalDelta : index_env * Ein.mu * Ein.mu -> int

  end = struct

    structure IR = LowIR
    structure V = IR.Var
    structure Ty = LowTypes
    structure Op = LowOps
    structure E = Ein
    structure IMap = IntRedBlackMap

  (* an environment that maps De Bruijn indices to their iteration-index value *)
    type index_env = int IMap.map

   fun lookupIdx (mapp, id) = (case IMap.find(mapp, id)
	  of SOME x => x
	   | NONE => raise Fail(concat["lookupIdx(_, ", Int.toString id, "): out of bounds"])
	 (* end case *))

   fun lookupMu (mapp, E.V id) = lookupIdx (mapp, id)
     | lookupMu (_, E.C i) = i

    val add = AvailRHS.addAssign

    fun intLit (avail, n) = add (avail, "intLit", Ty.intTy, IR.LIT(Literal.Int n))
    fun realLit (avail, r) = add (avail, "realLit", Ty.realTy, IR.LIT(Literal.Real r))
    fun intToRealLit (avail, n) = realLit (avail, RealLit.fromInt(IntInf.fromInt n))

    fun cons (avail, shp, args) =
	  add (avail, "tensor", Ty.TensorTy shp, IR.CONS(args, Ty.TensorTy shp))

    fun reduce (avail, rator, []) = raise Fail "reduction with no arguments"
      | reduce (avail, rator, arg::args) = let
	  fun gen (acc, []) = acc
	    | gen (acc, x::xs) = gen (rator (avail, acc, x), xs)
	  in
	    gen (arg, args)
	  end

  (* scalar arithmetic *)
    local
      fun scalarOp1 rator (avail, x) = add (avail, "r", Ty.realTy, IR.OP(rator, [x]))
      fun scalarOp2 rator (avail, x, y) = add (avail, "r", Ty.realTy, IR.OP(rator, [x, y]))
    in
    val realAdd = scalarOp2 Op.RAdd
    val realSub = scalarOp2 Op.RSub
    val realMul = scalarOp2 Op.RMul
    val realDiv = scalarOp2 Op.RDiv
    val realNeg = scalarOp1 Op.RNeg
    val realSqrt = scalarOp1 Op.Sqrt
    val realCos = scalarOp1 Op.Cos
    val realArcCos = scalarOp1 Op.ArcCos
    val realSin = scalarOp1 Op.Sin
    val realArcSin = scalarOp1 Op.ArcSin
    val realTan = scalarOp1 Op.Tan
    val realArcTan = scalarOp1 Op.ArcTan
    end (* local *)

  (* vector arithmetic *)
    local
      fun vecOp1 rator (avail, dim, x) =
	    add (avail, "v", Ty.TensorTy[dim], IR.OP(rator dim, [x]))
      fun vecOp2 rator (avail, dim, x, y) =
	    add (avail, "v", Ty.TensorTy[dim], IR.OP(rator dim, [x, y]))
    in
    val vecAdd = vecOp2 Op.VAdd
    val vecSub = vecOp2 Op.VSub
    val vecScale = vecOp2 Op.VScale
    val vecMul = vecOp2 Op.VMul
    val vecNeg = vecOp1 Op.VNeg
    val vecSum = vecOp1 Op.VSum
    fun vecProj (avail, dim, x, i) =
	  add (avail, "v", Ty.TensorTy[dim], IR.OP(Op.VProj(dim, i), [x]))
    end (* local *)

    fun vecDot (avail, vecIX, a, b) =
          vecSum (avail, vecIX, vecMul (avail, vecIX, a, b))

    fun tensorIndex (avail, mapp, arg, []) = arg
      | tensorIndex (avail, mapp, arg, ix) =
	  add (
	    avail, "r", Ty.realTy,
	    IR.OP(Op.TensorIndex(V.ty arg, List.map (fn id => lookupMu(mapp, id)) ix), [arg]))

    fun evalDelta (mapp, i, j) = let
	  val i' = lookupMu (mapp, i)
	  val j' = lookupMu (mapp, j)
	  in
	    if (i' = j') then 1 else 0
	  end

    fun delta (avail, mapp, i, j) = intToRealLit (avail, evalDelta (mapp, i, j))

    fun epsilon2 (avail, mapp, i, j) = let
	  val i' = lookupIdx (mapp, i)
	  val j' = lookupIdx (mapp, j)
	  in
	    if (i' = j')
	      then intToRealLit (avail, 0)
            else if (j' > i')
	      then intToRealLit (avail, 1)
	      else intToRealLit (avail, ~1)
	  end

    fun epsilon3 (avail, mapp, i, j, k) = let
	  val i' = lookupIdx (mapp, i)
	  val j' = lookupIdx (mapp, j)
	  val k' = lookupIdx (mapp, k)
	  in
            if (i' = j' orelse j' = k' orelse i' = k')
	      then intToRealLit (avail, 0)
            else if (j' > i')
	      then if (j' > k' andalso k' > i')
		then intToRealLit (avail, ~1)
		else intToRealLit (avail, 1)
	    else if (i' > k' andalso k' > j')
	      then intToRealLit (avail, 1)
	      else intToRealLit (avail, ~1)
	  end

  end

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