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

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