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 3893 - (download) (annotate)
Sat May 21 21:33:08 2016 UTC (3 years ago) by jhr
File size: 3654 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
	EigenVecs2x2
	EigenVecs3x3
	EigenVals2x2
	EigenVals3x3
 *)
structure CollectInfo : sig

    type t

    val collect : TreeIR.program -> t

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

  end = struct

    structure IR = TreeIR

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

    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 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")
		}
	  val addType = addType 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) => (
		      (* TODO: check rator *)
		      List.app doExp args)
		  | IR.E_Vec(_, _, es) => 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(_, e, _) => 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

  end

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