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 3866 - (download) (annotate)
Mon May 16 16:48:13 2016 UTC (3 years ago) by jhr
File size: 3361 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.
 *)

structure CollectInfo : sig

    type t

    val collect : TreeIR.program -> t

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

  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) = (case ty
		 of TreeTypes.BoolTy => ()
		  | TreeTypes.IntTy => ()
		  | TreeTypes.StringTy => ()
		  | TreeTypes.VecTy(1, 1) => ()
		  | TreeTypes.StrandTy _ => ()
		  | _ => (case find ty
		       of NONE => ins (ty, inPrint)
			| SOME b => if inPrint andalso (not b) then ins (ty, true) else ()
		      (* end case *))
		(* end case *))
	  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 mapOverTypes f (Info{tys}) =
	  TreeTypes.Tbl.foldi (fn (ty, isPrinted, acc) => f(ty, isPrinted) :: acc) [] tys

  end

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