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/ein-to-scalar.sml
ViewVC logotype

View of /branches/vis15/src/compiler/mid-to-low/ein-to-scalar.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3654 - (download) (annotate)
Wed Feb 3 23:00:46 2016 UTC (3 years, 11 months ago) by jhr
File size: 3999 byte(s)
  minor tweaks to merge branch
(* ein-to-scalar.sml
 *
 * Generate LowIR scalar computations that implement Ein expressions.
 *
 * 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 EinToScalar : sig

    val expand :
	  AvailRHS.t * int IntRedBlackMap.map * (Ein.param_kind list * Ein.ein_exp * LowIR.var list)
	    -> LowIR.var

  end = struct

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

    fun indexTensor e = Mk.indexTensor e
    fun mkSubSca e =  Mk.mkSubSca e
    fun mkProdSca e = Mk.mkProdSca e
    fun mkDivSca e =  Mk.mkDivSca e
    fun mkMultiple e = Mk.mkMultiple e
    fun mkOp1 e =  Mk.mkOp1 e

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

    fun expand (avail, mapp, (params, body, args)) = let
	  fun gen (mapp, body) = let
	      (*********sumexpression ********)
		fun tb n =  List.tabulate (n, fn e => e)
		fun sumCheck (mapp, (E.V v, lb, ub) :: sumx, e) = let
		      fun sumloop mapp = gen (mapp, e)
		      fun sumI1 (left, (v, [i], lb1), [], rest) = let
			    val mapp = IMap.insert (mapp, v, lb1+i)
			    val vD = gen (mapp, e)
			    in
			      rest@[vD]
			    end
		        | sumI1 (left, (v, i::es, lb1), [], rest) = let
			    val mapp = IMap.insert (left, v, i+lb1)
			    val vD = gen (mapp, e)
			    in
			      sumI1 (mapp, (v, es, lb1), [], rest@[vD])
			    end
		        | sumI1 (left, (v, [i], lb1), (E.V a, lb2, ub2) ::sx, rest) =
			    sumI1 (IMap.insert (left, v, lb1+i), (a, tb (ub2-lb2+1), lb2), sx, rest)
		        | sumI1 (left, (v, s::es, lb1), (E.V a, lb2, ub2) ::sx, rest) = let
			    val mapp = IMap.insert (left, v, s+lb1)
			    val xx = tb (ub2-lb2+1)
			    val rest' = sumI1 (mapp, (a, xx, lb2), sx, rest)
			    in
			      sumI1 (mapp, (v, es, lb1), (E.V a, lb2, ub2) ::sx, rest')
			    end
		        | sumI1 _ = raise Fail "None Variable-index in summation"
		      in
			sumI1 (mapp, (v, tb (ub-lb+1), lb), sumx, [])
		      end
		in
		  case body
		   of E.Value v => Mk.intToRealLit (avail, mapIndex (mapp, v))
		    | E.Const c => Mk.intToRealLit (avail, c)
		    | E.Delta(i, j) => Mk.delta (avail, mapp, i, j)
		    | E.Epsilon(i, j, k) => Mk.epsilon3 (avail, mapp, i, j, k)
		    | E.Eps2(i, j) => Mk.epsilon2 (avail, mapp, i, j)
		    | E.Tensor(id, ix) =>
			indexTensor (avail, mapp, (params, args, id, ix, Ty.realTy))
		    | E.Op1(E.Neg, e1) =>
(* QUESTION: why not just negate the tensor? *)
			mkProdSca (avail, [Mk.intToRealLit (avail, ~1), gen (mapp, e1)])
		    | E.Op1(op1, e1) => mkOp1 (op1, gen (mapp, e1))
		    | E.Op2(E.Sub, e1, e2) => mkSubSca (avail, [gen (mapp, e1), gen (mapp, e2)])
		    | E.Opn(E.Add, es) => let
			fun iter ([], ids) =
			      mkMultiple (avail, List.rev ids, Op.addSca, Ty.realTy)
			  | iter (e1::es, ids) = iter (es, (gen (mapp, e1))::ids)
			in
			  iter (es, [])
			end
		    | E.Opn(E.Prod, es) => let
			fun iter ([], ids) =
			      mkMultiple (avail, List.rev ids, Op.prodSca, Ty.realTy)
			  | iter (e1::es, ids) = iter (es, (gen (mapp, e1))::ids)
			in
			  iter (es, [])
			end
		    | E.Op2(E.Div, e1 as E.Tensor (_, [_]), e2 as E.Tensor (_, [])) =>
			gen (mapp, E.Opn(E.Prod, [E.Op2 (E.Div, E.Const 1, e2), e1]))
		    | E.Op2(E.Div, e1, e2) => mkDivSca (avail, [gen (mapp, e2)])
		    | E.Sum(x, E.Opn (E.Prod, (E.Img (Vid, _, _) ::E.Krn (Hid, _, _) ::_))) =>
			FieldToLow.expand (avail, mapp, params, body, args)
		    | E.Sum(sumx, e) => let
			val ids = sumCheck (mapp, sumx, e)
			in
			  mkMultiple (avail, ids, Op.addSca, Ty.realTy)
			end
		    | _ => raise Fail("unsupported ein-exp: " ^ EinPP.expToString body)
		  (*end case*)
		end
	  in
	    gen (mapp, body)
	  end

    end

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