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

SCM Repository

[diderot] View of /branches/vis15/src/compiler/codegen/collect-info.sml
ViewVC logotype

View of /branches/vis15/src/compiler/codegen/collect-info.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3920 - (download) (annotate)
Wed Jun 1 10:36:32 2016 UTC (3 years ago) by jhr
File size: 6164 byte(s)
working on merge
(* collect-info.sml
 *
 * Collect information about the types and operations used in a program.  We need this
 * information to figure out what utility code to generate.
 *
 * This code is part of the Diderot Project (http://diderot-language.cs.uchicago.edu)
 *
 * COPYRIGHT (c) 2016 The University of Chicago
 * All rights reserved.
 *)

(* operators to record:
	RClamp
	RLerp
	VClamp
	VMapClamp
	VLerp
	VScale
	VSum
 *)
structure CollectInfo : sig

    type t

    datatype operation
      = RClamp | RLerp
      | VClamp of int * int
      | VMapClamp of int * int
      | VLerp of int * int
      | VScale of int * int
      | VSum of int * int
      | VLoad of int * int
      | VCons of int * int

    val collect : TreeIR.program -> t

    val foldOverTypes : (TreeTypes.t * bool * 'a -> 'a) -> 'a -> t -> 'a
    val foldOverOps   : (operation * 'a -> 'a) -> 'a -> t -> 'a

  end = struct

    structure IR = TreeIR
    structure Ty = TreeTypes
    structure Op = TreeOps

    datatype operation
      = RClamp | RLerp
      | VSum of int * int
      | VClamp of int * int
      | VMapClamp of int * int
      | VLerp of int * int
      | VScale of int * int
      | VLoad of int * int
      | VCons of int * int

    structure OpTbl = HashTableFn (
      struct
	type hash_key = operation
	fun hashVal rator = (case rator
	       of RClamp => 0w13
		| RLerp => 0w17
		| VSum(w, _) => 0w23 + 0w7 * Word.fromInt w
		| VClamp(w, _) => 0w27 + 0w7 * Word.fromInt w
		| VMapClamp(w, _) => 0w31 + 0w7 * Word.fromInt w
		| VLerp(w, _) => 0w37 + 0w7 * Word.fromInt w
		| VScale(w, _) => 0w41 + 0w7 * Word.fromInt w
		| VLoad(w, _) => 0w43 + 0w7 * Word.fromInt w
		| VCons(w, _) => 0w47 + 0w7 * Word.fromInt w
	      (* end case *))
	fun sameKey (op1, op2) = (case (op1, op2)
	       of (RClamp, RClamp) => true
		| (RLerp, RLerp) => true
		| (VSum(w1, _), VSum(w2, _)) => (w1 = w2)
		| (VClamp(w1, _), VClamp(w2, _)) => (w1 = w2)
		| (VMapClamp(w1, _), VMapClamp(w2, _)) => (w1 = w2)
		| (VLerp(w1, _), VLerp(w2, _)) => (w1 = w2)
		| (VScale(w1, _), VScale(w2, _)) => (w1 = w2)
		| (VLoad(w1, _), VLoad(w2, _)) => (w1 = w2)
		| (VCons(w1, _), VCons(w2, _)) => (w1 = w2)
		| _ => false
	      (* end case *))
      end)

    datatype t = Info of {
	tys : bool TreeTypes.Tbl.hash_table,	(* mapping for types in program; the bool is true *)
						(* for types that are printed. *)
	ops : unit OpTbl.hash_table		(* mapping for selected operations in the program *)
      }

    fun addType (Info{tys, ...}) = let
	  val find = TreeTypes.Tbl.find tys
	  val ins = TreeTypes.Tbl.insert tys
	  fun addTy (ty, inPrint) =  let
		fun insert ty = (case find ty
		       of NONE => ins (ty, inPrint)
			| SOME b => if inPrint andalso (not b) then ins (ty, true) else ()
		      (* end case *))
		fun add ty = (case ty
		       of TreeTypes.BoolTy => ()
			| TreeTypes.IntTy => ()
			| TreeTypes.StringTy => ()
			| TreeTypes.VecTy(1, 1) => ()
			| TreeTypes.StrandTy _ => ()
			| TreeTypes.TupleTy tys => (insert ty; List.app add tys)
			| TreeTypes.SeqTy(ty', _) => (insert ty; add ty')
			| _ => insert ty
		      (* end case *))
		in
		  add ty
		end
	  in
	    addTy
	  end

    fun addOp (Info{ops, ...}) = let
	  val find = OpTbl.find ops
	  val ins = OpTbl.insert ops
	  fun insert rator = (case find rator
		 of NONE => ins (rator, ())
		  | SOME() => ()
		(* end case *))	  
	  fun add' rator = (case rator
		 of Op.RClamp => insert RClamp
		  | Op.RLerp => insert RLerp
		  | Op.VSum(w, pw) => insert (VSum(w, pw))
		  | Op.VClamp(w, pw) => insert (VClamp(w, pw))
		  | Op.VMapClamp(w, pw) => insert (VMapClamp(w, pw))
		  | Op.VLerp(w, pw) => insert (VLerp(w, pw))
		  | _ => ()
		(* end case *))
	  in
	    add'
	  end

    fun collect prog = let
	  val IR.Program{
		consts, inputs, constInit, globals, globalInit,
		strand, create=IR.Create{code, ...}, update, ...
	      } = prog
	  val IR.Strand{params, state, stateInit, initM, updateM, stabilizeM, ...} = strand
	  val info = Info{
		  tys = TreeTypes.Tbl.mkTable (64, Fail "tys"),
		  ops = OpTbl.mkTable (64, Fail "ops")
		}
	  val addType = addType info
	  val addOp = addOp info
	  fun doGlobalV x = addType(TreeGlobalVar.ty x, false)
	  fun doStateV x = addType(TreeStateVar.ty x, false)
	  fun doV x = addType(TreeVar.ty x, false)
	  fun doExp e = (case e
		 of IR.E_State(SOME e, sv) => doExp e
		  | IR.E_Op(rator, args) => (
		      addOp rator;
		      List.app doExp args)
		  | IR.E_Vec(w, pw, es) => (
		      addType(Ty.VecTy(w, pw), false);
(* FIXME: record VCons *)
		      List.app doExp es)
		  | IR.E_Cons(es, ty) => (addType(ty, false); List.app doExp es)
		  | IR.E_Seq(es, ty) => (addType(ty, false); List.app doExp es)
		  | IR.E_Pack(_, es) => List.app doExp es
		  | IR.E_VLoad(layout, e, i) => (
		      addType(Ty.nthVec(layout, i), false);
(* FIXME: record VCons *)
		      doExp e)
		  | _ => ()
		(* end case *))
	  fun doStm stm = (case stm
		 of IR.S_Assign(isDecl, x, e) => (
		      if isDecl then doV x else ();
		      doExp e)
		  | IR.S_MAssign(_, e) => doExp e
		  | IR.S_GAssign(_, e) => doExp e
		  | IR.S_IfThen(e, b) => (doExp e; doBlk b)
		  | IR.S_IfThenElse(e, b1, b2) => (doExp e; doBlk b1; doBlk b2)
		  | IR.S_Foreach(x, e, b) => (doV x; doExp e; doBlk b)
		  | IR.S_Input(_, _, _, SOME e) => doExp e
		  | IR.S_New(_, es) => List.app doExp es
		  | IR.S_Save(_, e) => doExp e
		  | IR.S_Print(tys, es) => (
		      List.app (fn ty => addType(ty, true)) tys;
		      List.app doExp es)
		  | _ => ()
		(* end case *))
	  and doBlk (IR.Block{locals, body}) = (
		List.app doV (!locals);
		List.app doStm body)
	  in
	    List.app doGlobalV consts;
	    List.app (doGlobalV o Inputs.varOf) inputs;
	    List.app doGlobalV globals;
	    List.app doStateV state;
	    doBlk constInit;
	    doBlk globalInit;
	    doBlk stateInit;
	    Option.app doBlk initM;
	    doBlk updateM;
	    Option.app doBlk stabilizeM;
	    doBlk code;
	    Option.app doBlk update;
	    info
	  end

    fun foldOverTypes f init (Info{tys, ...}) = TreeTypes.Tbl.foldi f init tys
    fun foldOverOps f init (Info{ops, ...}) =
	  OpTbl.foldi (fn (k, _, acc) => f(k, acc)) init ops

  end

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