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 3653 - (download) (annotate)
Tue Feb 2 22:50:44 2016 UTC (3 years, 8 months ago) by jhr
File size: 3487 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

  (* 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
  (* 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 mk (avail, name, ty, rhs) = let
	  val lhs = V.new (name, ty)
	  in
	    AvailRHS.addAssign avail (lhs, rhs)
	  end

    fun intLit (avail, n) = mk (avail, "intLit", Ty.intTy, IR.LIT(Literal.Int n))
    fun realLit (avail, r) = mk (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) = mk (avail, "tensor", Ty.TensorTy shp, IR.CONS(args, Ty.TensorTy shp))

    local
      fun lookupMu (mapp, E.V id) = (case IMap.find (mapp, id)
	     of SOME n => n
	      | NONE => raise Fail(concat["lookupMu(_, V ", Int.toString id, "): out of bounds"])
	    (* end case *))
	| lookupMu (_, E.C i) = i
      fun lookupIdx (mapp, id) = (case IMap.find(mapp, id)
	     of SOME x => x
	      | NONE => raise Fail(concat["lookupIdx(_, V ", Int.toString id, "): out of bounds"])
	    (* end case *))
    in
    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 (* local *)

  end

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