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

SCM Repository

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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3919 - (view) (download)

1 : jhr 3866 (* collect-info.sml
2 :     *
3 :     * Collect information about the types and operations used in a program. We need this
4 :     * information to figure out what utility code to generate.
5 :     *
6 :     * This code is part of the Diderot Project (http://diderot-language.cs.uchicago.edu)
7 :     *
8 :     * COPYRIGHT (c) 2016 The University of Chicago
9 :     * All rights reserved.
10 :     *)
11 :    
12 : jhr 3870 (* operators to record:
13 :     RClamp
14 :     RLerp
15 :     VClamp
16 :     VMapClamp
17 :     VLerp
18 :     VScale
19 :     VSum
20 : jhr 3872 EigenVecs2x2
21 :     EigenVecs3x3
22 :     EigenVals2x2
23 :     EigenVals3x3
24 : jhr 3870 *)
25 : jhr 3866 structure CollectInfo : sig
26 :    
27 :     type t
28 :    
29 :     val collect : TreeIR.program -> t
30 :    
31 : jhr 3868 val foldOverTypes : (TreeTypes.t * bool * 'a -> 'a) -> 'a -> t -> 'a
32 : jhr 3917 val applyToTypes : (TreeTypes.t * bool -> unit) -> t -> unit
33 : jhr 3866
34 :     end = struct
35 :    
36 :     structure IR = TreeIR
37 : jhr 3919 structure Ty = TreeTypes
38 : jhr 3866
39 :     datatype t = Info of {
40 :     tys : bool TreeTypes.Tbl.hash_table (* mapping for types in program; the bool is true *)
41 :     (* for types that are printed. *)
42 :     }
43 :    
44 :     fun addType (Info{tys, ...}) = let
45 :     val find = TreeTypes.Tbl.find tys
46 :     val ins = TreeTypes.Tbl.insert tys
47 : jhr 3868 fun addTy (ty, inPrint) = let
48 :     fun insert ty = (case find ty
49 : jhr 3866 of NONE => ins (ty, inPrint)
50 :     | SOME b => if inPrint andalso (not b) then ins (ty, true) else ()
51 :     (* end case *))
52 : jhr 3868 fun add ty = (case ty
53 :     of TreeTypes.BoolTy => ()
54 :     | TreeTypes.IntTy => ()
55 :     | TreeTypes.StringTy => ()
56 :     | TreeTypes.VecTy(1, 1) => ()
57 :     | TreeTypes.StrandTy _ => ()
58 :     | TreeTypes.TupleTy tys => (insert ty; List.app add tys)
59 :     | TreeTypes.SeqTy(ty', _) => (insert ty; add ty')
60 :     | _ => insert ty
61 :     (* end case *))
62 :     in
63 :     add ty
64 :     end
65 : jhr 3866 in
66 :     addTy
67 :     end
68 :    
69 :     fun collect prog = let
70 :     val IR.Program{
71 :     consts, inputs, constInit, globals, globalInit,
72 :     strand, create=IR.Create{code, ...}, update, ...
73 :     } = prog
74 :     val IR.Strand{params, state, stateInit, initM, updateM, stabilizeM, ...} = strand
75 :     val info = Info{
76 :     tys = TreeTypes.Tbl.mkTable (64, Fail "tys")
77 :     }
78 :     val addType = addType info
79 :     fun doGlobalV x = addType(TreeGlobalVar.ty x, false)
80 :     fun doStateV x = addType(TreeStateVar.ty x, false)
81 :     fun doV x = addType(TreeVar.ty x, false)
82 :     fun doExp e = (case e
83 :     of IR.E_State(SOME e, sv) => doExp e
84 :     | IR.E_Op(rator, args) => (
85 :     (* TODO: check rator *)
86 :     List.app doExp args)
87 : jhr 3919 | IR.E_Vec(w, pw, es) => (addType(Ty.VecTy(w, pw), false); List.app doExp es)
88 : jhr 3866 | IR.E_Cons(es, ty) => (addType(ty, false); List.app doExp es)
89 :     | IR.E_Seq(es, ty) => (addType(ty, false); List.app doExp es)
90 :     | IR.E_Pack(_, es) => List.app doExp es
91 : jhr 3919 | IR.E_VLoad(layout, e, i) => (addType(Ty.nthVec(layout, i), false); doExp e)
92 : jhr 3866 | _ => ()
93 :     (* end case *))
94 :     fun doStm stm = (case stm
95 :     of IR.S_Assign(isDecl, x, e) => (
96 :     if isDecl then doV x else ();
97 :     doExp e)
98 :     | IR.S_MAssign(_, e) => doExp e
99 :     | IR.S_GAssign(_, e) => doExp e
100 :     | IR.S_IfThen(e, b) => (doExp e; doBlk b)
101 :     | IR.S_IfThenElse(e, b1, b2) => (doExp e; doBlk b1; doBlk b2)
102 :     | IR.S_Foreach(x, e, b) => (doV x; doExp e; doBlk b)
103 :     | IR.S_Input(_, _, _, SOME e) => doExp e
104 :     | IR.S_New(_, es) => List.app doExp es
105 :     | IR.S_Save(_, e) => doExp e
106 :     | IR.S_Print(tys, es) => (
107 :     List.app (fn ty => addType(ty, true)) tys;
108 :     List.app doExp es)
109 :     | _ => ()
110 :     (* end case *))
111 :     and doBlk (IR.Block{locals, body}) = (
112 :     List.app doV (!locals);
113 :     List.app doStm body)
114 :     in
115 :     List.app doGlobalV consts;
116 :     List.app (doGlobalV o Inputs.varOf) inputs;
117 :     List.app doGlobalV globals;
118 :     List.app doStateV state;
119 :     doBlk constInit;
120 :     doBlk globalInit;
121 :     doBlk stateInit;
122 :     Option.app doBlk initM;
123 :     doBlk updateM;
124 :     Option.app doBlk stabilizeM;
125 :     doBlk code;
126 :     Option.app doBlk update;
127 :     info
128 :     end
129 :    
130 : jhr 3868 fun foldOverTypes f init (Info{tys}) = TreeTypes.Tbl.foldi f init tys
131 : jhr 3866
132 : jhr 3917 fun applyToTypes f (Info{tys}) = TreeTypes.Tbl.appi f tys
133 :    
134 : jhr 3866 end

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