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

SCM Repository

[diderot] Annotation of /trunk/src/compiler/ast/type-util.sml
ViewVC logotype

Annotation of /trunk/src/compiler/ast/type-util.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 241 - (view) (download)

1 : jhr 63 (* type-util.sml
2 :     *
3 :     * COPYRIGHT (c) 2010 The Diderot Project (http://diderot.cs.uchicago.edu)
4 :     * All rights reserved.
5 :     *)
6 :    
7 :     structure TypeUtil : sig
8 :    
9 : jhr 228 (* returns true if the type is a value type (bool, int, string, or tensor) *)
10 :     val isValueType : Types.ty -> bool
11 :    
12 : jhr 96 (* prune out instantiated meta variables *)
13 :     val prune : Types.ty -> Types.ty
14 :     val pruneDiff : Types.diff -> Types.diff
15 :     val pruneShape : Types.shape -> Types.shape
16 :     val pruneDim : Types.dim -> Types.dim
17 :    
18 :     (* prune the head of a type *)
19 :     val pruneHead : Types.ty -> Types.ty
20 :    
21 :     (* resolve meta variables to their instantiations (or else variable) *)
22 :     val resolve : Types.ty_var -> Types.ty
23 :     val resolveDiff : Types.diff_var -> Types.diff
24 :     val resolveShape : Types.shape_var -> Types.shape
25 :     val resolveDim : Types.dim_var -> Types.dim
26 :    
27 : jhr 95 (* string representations of types, etc *)
28 : jhr 63 val toString : Types.ty -> string
29 : jhr 95 val diffToString : Types.diff -> string
30 :     val shapeToString : Types.shape -> string
31 :     val dimToString : Types.dim -> string
32 : jhr 63
33 :     end = struct
34 :    
35 :     structure Ty = Types
36 : jhr 75 structure MV = MetaVar
37 : jhr 63
38 : jhr 96 (* prune out instantiated meta variables from a type *)
39 :     fun prune ty = (case ty
40 :     of (ty as Ty.T_Var(Ty.TV{bind, ...})) => (case !bind
41 :     of NONE => ty
42 :     | SOME ty => prune ty
43 :     (* end case *))
44 :     | (Ty.T_Kernel diff) => Ty.T_Kernel(pruneDiff diff)
45 :     | (Ty.T_Tensor shape) => Ty.T_Tensor(pruneShape shape)
46 :     | (Ty.T_Image{dim, shape}) => Ty.T_Image{
47 :     dim = pruneDim dim,
48 :     shape = pruneShape shape
49 :     }
50 :     | (Ty.T_Field{diff, dim, shape}) => Ty.T_Field{
51 :     diff = pruneDiff diff,
52 :     dim = pruneDim dim,
53 :     shape = pruneShape shape
54 :     }
55 :     | (Ty.T_Fun(tys1, ty2)) => Ty.T_Fun(List.map prune tys1, prune ty2)
56 :     | ty => ty
57 :     (* end case *))
58 : jhr 63
59 : jhr 96 and pruneDiff (Ty.DiffVar(Ty.DfV{bind=ref(SOME diff), ...}, i)) = (
60 :     case pruneDiff diff
61 :     of Ty.DiffVar(dv, i') => Ty.DiffVar(dv, i+i')
62 :     | Ty.DiffConst i' => Ty.DiffConst(i+i')
63 :     (* end case *))
64 :     | pruneDiff diff = diff
65 : jhr 75
66 : jhr 96 and pruneDim dim = (case dim
67 :     of Ty.DimVar(Ty.DV{bind=ref(SOME dim), ...}) => pruneDim dim
68 :     | dim => dim
69 :     (* end case *))
70 :    
71 :     and pruneShape shape = (case shape
72 : jhr 241 of Ty.Shape dd => Ty.Shape(List.map pruneDim dd)
73 :     | Ty.ShapeVar(Ty.SV{bind=ref(SOME shape), ...}) => pruneShape shape
74 : jhr 96 | Ty.ShapeExt(shape, dim) => Ty.shapeExt(pruneShape shape, pruneDim dim)
75 :     | _ => shape
76 :     (* end case *))
77 :    
78 :     (* resolve meta variables to their instantiations (or else variable) *)
79 :     fun resolve (tv as Ty.TV{bind, ...}) = (case !bind
80 :     of NONE => Ty.T_Var tv
81 :     | SOME ty => prune ty
82 :     (* end case *))
83 :    
84 :     fun resolveDiff (dv as Ty.DfV{bind, ...}) = (case !bind
85 :     of NONE => Ty.DiffVar(dv, 0)
86 :     | SOME diff => pruneDiff diff
87 :     (* end case *))
88 :    
89 :     fun resolveShape (sv as Ty.SV{bind, ...}) = (case !bind
90 :     of NONE => Ty.ShapeVar sv
91 :     | SOME shape => pruneShape shape
92 :     (* end case *))
93 :    
94 :     fun resolveDim (dv as Ty.DV{bind, ...}) = (case !bind
95 :     of NONE => Ty.DimVar dv
96 :     | SOME dim => pruneDim dim
97 :     (* end case *))
98 :    
99 :     (* prune the head of a type *)
100 :     fun pruneHead ty = let
101 :     fun prune' (ty as Ty.T_Var(Ty.TV{bind, ...})) = (case !bind
102 :     of NONE => ty
103 :     | SOME ty => prune' ty
104 :     (* end case *))
105 :     | prune' (Ty.T_Kernel diff) = Ty.T_Kernel(pruneDiff diff)
106 :     | prune' (Ty.T_Tensor shape) = Ty.T_Tensor(pruneShape shape)
107 :     | prune' (Ty.T_Image{dim, shape}) = Ty.T_Image{
108 :     dim = pruneDim dim,
109 :     shape = pruneShape shape
110 :     }
111 :     | prune' (Ty.T_Field{diff, dim, shape}) = Ty.T_Field{
112 :     diff = pruneDiff diff,
113 :     dim = pruneDim dim,
114 :     shape = pruneShape shape
115 :     }
116 :     | prune' ty = ty
117 : jhr 63 in
118 : jhr 96 prune' ty
119 : jhr 63 end
120 :    
121 : jhr 96 fun listToString fmt sep items = String.concatWith sep (List.map fmt items)
122 : jhr 63
123 : jhr 96 fun diffToString diff = (case pruneDiff diff
124 :     of Ty.DiffConst n => Int.toString n
125 :     | Ty.DiffVar(dv, 0) => MV.diffVarToString dv
126 :     | Ty.DiffVar(dv, i) => if i < 0
127 :     then String.concat["(", MV.diffVarToString dv, "-", Int.toString(~i), ")"]
128 :     else String.concat["(", MV.diffVarToString dv, "+", Int.toString i, ")"]
129 :     (* end case *))
130 :    
131 :     fun shapeToString shape = (case pruneShape shape
132 :     of Ty.Shape shape => concat["[", listToString dimToString "," shape, "]"]
133 :     | Ty.ShapeVar sv => MV.shapeVarToString sv
134 :     | Ty.ShapeExt(shape, d) => let
135 :     fun toS (Ty.Shape shape) = (listToString dimToString "," shape) ^ ","
136 :     | toS (Ty.ShapeVar sv) = MV.shapeVarToString sv ^ ";"
137 :     | toS (Ty.ShapeExt(shape, d)) = concat[toS shape, dimToString d, ","]
138 :     in
139 :     toS shape ^ dimToString d
140 :     end
141 :     (* end case *))
142 :    
143 :     and dimToString dim = (case pruneDim dim
144 :     of Ty.DimConst n => Int.toString n
145 :     | Ty.DimVar v => MV.dimVarToString v
146 :     (* end case *))
147 :    
148 : jhr 228 (* returns true if the type is a value type (bool, int, string, or tensor) *)
149 :     fun isValueType ty = (case prune ty
150 :     of Ty.T_Bool => true
151 :     | Ty.T_Int => true
152 :     | Ty.T_String => true
153 :     | Ty.T_Tensor _ => true
154 :     | _ => false
155 :     (* end case *))
156 :    
157 : jhr 96 fun toString ty = (case pruneHead ty
158 : jhr 75 of Ty.T_Var tv => MV.tyVarToString tv
159 : jhr 63 | Ty.T_Bool => "bool"
160 :     | Ty.T_Int => "int"
161 :     | Ty.T_String => "string"
162 : jhr 75 | Ty.T_Kernel n => "kernel#" ^ diffToString n
163 :     | Ty.T_Tensor(Ty.Shape[]) => "real"
164 :     | Ty.T_Tensor(Ty.Shape[Ty.DimConst 2]) => "vec2"
165 :     | Ty.T_Tensor(Ty.Shape[Ty.DimConst 3]) => "vec3"
166 :     | Ty.T_Tensor(Ty.Shape[Ty.DimConst 4]) => "vec4"
167 : jhr 63 | Ty.T_Tensor shape => "tensor" ^ shapeToString shape
168 :     | Ty.T_Image{dim, shape} => concat[
169 : jhr 75 "image(", dimToString dim, ")", shapeToString shape
170 : jhr 63 ]
171 :     | Ty.T_Field{diff, dim, shape} => concat[
172 : jhr 75 "field#", diffToString diff, "(", dimToString dim,
173 : jhr 63 ")", shapeToString shape
174 :     ]
175 : jhr 81 | Ty.T_Fun(tys1, ty2) => let
176 : jhr 63 fun tysToString [] = "()"
177 :     | tysToString [ty] = toString ty
178 :     | tysToString tys = String.concat[
179 :     "(", listToString toString " * " tys, ")"
180 :     ]
181 :     in
182 : jhr 81 String.concat[tysToString tys1, " -> ", toString ty2]
183 : jhr 63 end
184 :     (* end case *))
185 :    
186 :     end

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