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

SCM Repository

[diderot] Annotation of /branches/vis15/src/compiler/basis/basis-vars.sml
ViewVC logotype

Annotation of /branches/vis15/src/compiler/basis/basis-vars.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3391 - (view) (download)

1 : jhr 3391 (* basis-vars.sml
2 :     *
3 :     * This code is part of the Diderot Project (http://diderot-language.cs.uchicago.edu)
4 :     *
5 :     * COPYRIGHT (c) 2015 The University of Chicago
6 :     * All rights reserved.
7 :     *
8 :     * This module defines the AST variables for the built in operators and functions.
9 :     *)
10 :    
11 :     structure BasisVars =
12 :     struct
13 :     local
14 :     structure N = BasisNames
15 :     structure Ty = Types
16 :     structure MV = MetaVar
17 :    
18 :     fun --> (tys, ty) = Ty.T_Fun(tys, ty)
19 :     infix -->
20 :    
21 :     val N2 = Ty.DimConst 2
22 :     val N3 = Ty.DimConst 3
23 :    
24 :     (* short names for kinds *)
25 :     val TK : unit -> Ty.meta_var = Ty.TYPE o MV.newTyVar
26 :     fun DK () : Ty.meta_var = Ty.DIFF(MV.newDiffVar 0)
27 :     val SK : unit -> Ty.meta_var = Ty.SHAPE o MV.newShapeVar
28 :     val NK : unit -> Ty.meta_var = Ty.DIM o MV.newDimVar
29 :    
30 :     fun ty t = ([], t)
31 :     fun all (kinds, mkTy : Ty.meta_var list -> Ty.ty) = let
32 :     val tvs = List.map (fn mk => mk()) kinds
33 :     in
34 :     (tvs, mkTy tvs)
35 :     end
36 :     fun allNK mkTy = let
37 :     val tv = MV.newDimVar()
38 :     in
39 :     ([Ty.DIM tv], mkTy tv)
40 :     end
41 :    
42 :     fun field (k, d, dd) = Ty.T_Field{diff=k, dim=d, shape=dd}
43 :     fun field' (k, d, dd) = field(k, Ty.DimConst d, Ty.Shape(List.map Ty.DimConst dd))
44 :     fun tensor ds = Ty.T_Tensor(Ty.Shape ds)
45 :     fun matrix d = tensor[d,d]
46 :    
47 :     fun monoVar (name, ty) = Var.new (name, AST.BasisVar, ty)
48 :     fun polyVar (name, scheme) = Var.newPoly (name, AST.BasisVar, scheme)
49 :     in
50 :    
51 :     (* overloaded operators; the naming convention is to use the operator name followed
52 :     * by the argument type signature, where
53 :     * i -- int
54 :     * b -- bool
55 :     * r -- real (tensor[])
56 :     * t -- tensor[shape]
57 :     * I -- image(d)[shape]
58 :     * f -- field#k(d)[shape]
59 :     * s -- field#k(d)[]
60 :     * d -- ty{}
61 :     * T -- ty
62 :     *)
63 :    
64 :     (* concatenation of sequences *)
65 :     val at_dT = polyVar (N.op_at, all([TK],
66 :     fn [Ty.TYPE tv] => let
67 :     val seqTyc = Ty.T_DynSequence(Ty.T_Var tv)
68 :     in
69 :     [seqTyc, Ty.T_Var tv] --> seqTyc
70 :     end))
71 :     val at_Td = polyVar (N.op_at, all([TK],
72 :     fn [Ty.TYPE tv] => let
73 :     val seqTyc = Ty.T_DynSequence(Ty.T_Var tv)
74 :     in
75 :     [Ty.T_Var tv, seqTyc] --> seqTyc
76 :     end))
77 :     val at_dd = polyVar (N.op_at, all([TK],
78 :     fn [Ty.TYPE tv] => let
79 :     val seqTyc = Ty.T_DynSequence(Ty.T_Var tv)
80 :     in
81 :     [seqTyc, seqTyc] --> seqTyc
82 :     end))
83 :    
84 :     val add_ii = monoVar(N.op_add, [Ty.T_Int, Ty.T_Int] --> Ty.T_Int)
85 :     val add_tt = polyVar(N.op_add, all([SK], fn [Ty.SHAPE dd] => let
86 :     val t = Ty.T_Tensor(Ty.ShapeVar dd)
87 :     in
88 :     [t, t] --> t
89 :     end))
90 :     val add_ff = polyVar(N.op_add, all([DK,NK,SK],
91 :     fn [Ty.DIFF k, Ty.DIM d, Ty.SHAPE dd] => let
92 :     val f = Ty.T_Field{diff = Ty.DiffVar(k, 0), dim = Ty.DimVar d, shape = Ty.ShapeVar dd}
93 :     in
94 :     [f, f] --> f
95 :     end))
96 :     val add_ft = polyVar(N.op_add, all([DK,NK,SK], (* field + scalar *)
97 :     fn [Ty.DIFF k, Ty.DIM d, Ty.SHAPE dd] => let
98 :     val f = Ty.T_Field{diff = Ty.DiffVar(k, 0), dim = Ty.DimVar d, shape = Ty.ShapeVar dd}
99 :     val t = Ty.T_Tensor(Ty.ShapeVar dd)
100 :     in
101 :     [f, t] --> f
102 :     end))
103 :     val add_tf = polyVar(N.op_add, all([DK,NK,SK], (* scalar + field *)
104 :     fn [Ty.DIFF k, Ty.DIM d, Ty.SHAPE dd] => let
105 :     val f = Ty.T_Field{diff = Ty.DiffVar(k, 0), dim = Ty.DimVar d, shape = Ty.ShapeVar dd}
106 :     val t = Ty.T_Tensor(Ty.ShapeVar dd)
107 :     in
108 :     [t, f] --> f
109 :     end))
110 :    
111 :     val sub_ii = monoVar(N.op_sub, [Ty.T_Int, Ty.T_Int] --> Ty.T_Int)
112 :     val sub_tt = polyVar(N.op_sub, all([SK], fn [Ty.SHAPE dd] => let
113 :     val t = Ty.T_Tensor(Ty.ShapeVar dd)
114 :     in
115 :     [t, t] --> t
116 :     end))
117 :     val sub_ff = polyVar(N.op_sub, all([DK,NK,SK],
118 :     fn [Ty.DIFF k, Ty.DIM d, Ty.SHAPE dd] => let
119 :     val f = Ty.T_Field{diff = Ty.DiffVar(k, 0), dim = Ty.DimVar d, shape = Ty.ShapeVar dd}
120 :     in
121 :     [f, f] --> f
122 :     end))
123 :     val sub_ft = polyVar(N.op_sub, all([DK,NK,SK], (* field - scalar *)
124 :     fn [Ty.DIFF k, Ty.DIM d,Ty.SHAPE dd] => let
125 :     val f = Ty.T_Field{diff = Ty.DiffVar(k, 0), dim = Ty.DimVar d, shape = Ty.ShapeVar dd}
126 :     val t = Ty.T_Tensor(Ty.ShapeVar dd)
127 :     in
128 :     [f, t] --> f
129 :     end))
130 :     val sub_tf = polyVar(N.op_sub, all([DK,NK,SK], (* scalar - field *)
131 :     fn [Ty.DIFF k, Ty.DIM d,Ty.SHAPE dd] => let
132 :     val f = Ty.T_Field{diff = Ty.DiffVar(k, 0), dim = Ty.DimVar d, shape = Ty.ShapeVar dd}
133 :     val t = Ty.T_Tensor(Ty.ShapeVar dd)
134 :     in
135 :     [t, f] --> f
136 :     end))
137 :    
138 :     (* note that we assume that operators are tested in the order defined here, so that mul_rr
139 :     * takes precedence over mul_rt and mul_tr!
140 :     *)
141 :     val mul_ii = monoVar(N.op_mul, [Ty.T_Int, Ty.T_Int] --> Ty.T_Int)
142 :     val mul_rr = monoVar(N.op_mul, [Ty.realTy, Ty.realTy] --> Ty.realTy)
143 :     val mul_rt = polyVar(N.op_mul, all([SK], fn [Ty.SHAPE dd] => let
144 :     val t = Ty.T_Tensor(Ty.ShapeVar dd)
145 :     in
146 :     [Ty.realTy, t] --> t
147 :     end))
148 :     val mul_tr = polyVar(N.op_mul, all([SK], fn [Ty.SHAPE dd] => let
149 :     val t = Ty.T_Tensor(Ty.ShapeVar dd)
150 :     in
151 :     [t, Ty.realTy] --> t
152 :     end))
153 :     val mul_rf = polyVar(N.op_mul, all([DK,NK,SK], fn [Ty.DIFF k, Ty.DIM d, Ty.SHAPE dd] => let
154 :     val t = Ty.T_Field{diff = Ty.DiffVar(k, 0), dim = Ty.DimVar d, shape = Ty.ShapeVar dd}
155 :     in
156 :     [Ty.realTy, t] --> t
157 :     end))
158 :     val mul_fr = polyVar(N.op_mul, all([DK,NK,SK], fn [Ty.DIFF k, Ty.DIM d, Ty.SHAPE dd] => let
159 :     val t = Ty.T_Field{diff = Ty.DiffVar(k, 0), dim = Ty.DimVar d, shape = Ty.ShapeVar dd}
160 :     in
161 :     [t, Ty.realTy] --> t
162 :     end))
163 :     val mul_st = polyVar(N.op_mul, all([DK,NK,SK], fn [Ty.DIFF k, Ty.DIM d, Ty.SHAPE dd] => let
164 :     val f = Ty.T_Field{diff = Ty.DiffVar(k, 0), dim = Ty.DimVar d, shape = Ty.Shape[]}
165 :     val t = Ty.T_Tensor(Ty.ShapeVar dd)
166 :     val g = Ty.T_Field{diff = Ty.DiffVar(k, 0), dim = Ty.DimVar d, shape = Ty.ShapeVar dd}
167 :     in
168 :     [f, t] --> g
169 :     end))
170 :     val mul_ts = polyVar(N.op_mul, all([DK,NK,SK], fn [Ty.DIFF k, Ty.DIM d, Ty.SHAPE dd] => let
171 :     val f = Ty.T_Field{diff = Ty.DiffVar(k, 0), dim = Ty.DimVar d, shape = Ty.Shape[]}
172 :     val t = Ty.T_Tensor(Ty.ShapeVar dd)
173 :     val g = Ty.T_Field{diff = Ty.DiffVar(k, 0), dim = Ty.DimVar d, shape = Ty.ShapeVar dd}
174 :     in
175 :     [t, f] --> g
176 :     end))
177 :     val mul_ss = polyVar(N.op_mul, all([DK,NK], fn [Ty.DIFF k, Ty.DIM d] => let
178 :     val t = Ty.T_Field{diff = Ty.DiffVar(k, 0), dim = Ty.DimVar d, shape = Ty.Shape []}
179 :     in
180 :     [t, t] --> t
181 :     end))
182 :     val mul_sf = polyVar(N.op_mul, all([DK,NK,SK], fn [Ty.DIFF k, Ty.DIM d, Ty.SHAPE dd] => let
183 :     val a = Ty.T_Field{diff = Ty.DiffVar(k, 0), dim = Ty.DimVar d, shape = Ty.Shape []}
184 :     val b = Ty.T_Field{diff = Ty.DiffVar(k, 0), dim = Ty.DimVar d, shape = Ty.ShapeVar dd}
185 :     in
186 :     [a, b] --> b
187 :     end))
188 :     val mul_fs = polyVar(N.op_mul, all([DK,NK,SK], fn [Ty.DIFF k, Ty.DIM d, Ty.SHAPE dd] => let
189 :     val a = Ty.T_Field{diff = Ty.DiffVar(k, 0), dim = Ty.DimVar d, shape = Ty.Shape []}
190 :     val b = Ty.T_Field{diff = Ty.DiffVar(k, 0), dim = Ty.DimVar d, shape = Ty.ShapeVar dd}
191 :     in
192 :     [b, a] --> b
193 :     end))
194 :    
195 :     val div_ii = monoVar(N.op_div, [Ty.T_Int, Ty.T_Int] --> Ty.T_Int)
196 :     val div_rr = monoVar(N.op_div, [Ty.realTy, Ty.realTy] --> Ty.realTy)
197 :     val div_tr = polyVar(N.op_div, all([SK], fn [Ty.SHAPE dd] => let
198 :     val t = Ty.T_Tensor(Ty.ShapeVar dd)
199 :     in
200 :     [t, Ty.realTy] --> t
201 :     end))
202 :     val div_fr = polyVar(N.op_div, all([DK,NK,SK], fn [Ty.DIFF k, Ty.DIM d, Ty.SHAPE dd] => let
203 :     val t = Ty.T_Field{diff = Ty.DiffVar(k, 0), dim = Ty.DimVar d, shape = Ty.ShapeVar dd}
204 :     in
205 :     [t, Ty.realTy] --> t
206 :     end))
207 :     val div_ss = polyVar(N.op_mul, all([DK,NK], fn [Ty.DIFF k, Ty.DIM d] => let
208 :     val t = Ty.T_Field{diff = Ty.DiffVar(k, 0), dim = Ty.DimVar d, shape = Ty.Shape []}
209 :     in
210 :     [t, t] --> t
211 :     end))
212 :     val div_fs = polyVar(N.op_div, all([DK,DK,NK,SK], fn [Ty.DIFF k, Ty.DIFF k2, Ty.DIM d, Ty.SHAPE dd] => let
213 :     val f = Ty.T_Field{diff = Ty.DiffVar(k, 0), dim = Ty.DimVar d, shape = Ty.ShapeVar dd}
214 :     val s = Ty.T_Field{diff = Ty.DiffVar(k2, 0), dim = Ty.DimVar d, shape = Ty.Shape []}
215 :     in
216 :     [f, s] --> f
217 :     end))
218 :    
219 :     (* exponentiation; we distinguish between integer and real exponents to allow x^2 to be compiled
220 :     * as x*x.
221 :     *)
222 :     val exp_ri = monoVar(N.op_exp, [Ty.realTy, Ty.T_Int] --> Ty.realTy)
223 :     val exp_rr = monoVar(N.op_exp, [Ty.realTy, Ty.realTy] --> Ty.realTy)
224 :    
225 :     val convolve_vk = polyVar (N.op_convolve, all([DK, NK, SK], fn [Ty.DIFF k, Ty.DIM d, Ty.SHAPE dd] => let
226 :     val k = Ty.DiffVar(k, 0)
227 :     val d = Ty.DimVar d
228 :     val dd = Ty.ShapeVar dd
229 :     in
230 :     [Ty.T_Image{dim=d, shape=dd}, Ty.T_Kernel k] --> field(k, d, dd)
231 :     end))
232 :     val convolve_kv = polyVar (N.op_convolve, all([DK, NK, SK], fn [Ty.DIFF k, Ty.DIM d, Ty.SHAPE dd] => let
233 :     val k = Ty.DiffVar(k, 0)
234 :     val d = Ty.DimVar d
235 :     val dd = Ty.ShapeVar dd
236 :     in
237 :     [Ty.T_Kernel k, Ty.T_Image{dim=d, shape=dd}] --> field(k, d, dd)
238 :     end))
239 :    
240 :     (* curl on 2d and 3d vector fields *)
241 :     local
242 :     val diff0 = Ty.DiffConst 0
243 :     fun field' (k, d, dd) = field(k, Ty.DimConst d, Ty.Shape(List.map Ty.DimConst dd))
244 :     in
245 :     val curl2D = polyVar (N.op_curl, all([DK], fn [Ty.DIFF k] => let
246 :     val km1 = Ty.DiffVar(k, ~1)
247 :     in
248 :     [field' (Ty.DiffVar(k, 0), 2, [2])] --> field' (km1, 2, [])
249 :     end))
250 :     val curl3D = polyVar (N.op_curl, all([DK], fn [Ty.DIFF k] =>let
251 :     val km1 = Ty.DiffVar(k, ~1)
252 :     in
253 :     [field' (Ty.DiffVar(k, 0), 3, [3])] --> field' (km1, 3, [3])
254 :     end))
255 :     end (* local *)
256 :    
257 :     val lt_ii = monoVar(N.op_lt, [Ty.T_Int, Ty.T_Int] --> Ty.T_Bool)
258 :     val lt_rr = monoVar(N.op_lt, [Ty.realTy, Ty.realTy] --> Ty.T_Bool)
259 :     val lte_ii = monoVar(N.op_lte, [Ty.T_Int, Ty.T_Int] --> Ty.T_Bool)
260 :     val lte_rr = monoVar(N.op_lte, [Ty.realTy, Ty.realTy] --> Ty.T_Bool)
261 :     val gte_ii = monoVar(N.op_gte, [Ty.T_Int, Ty.T_Int] --> Ty.T_Bool)
262 :     val gte_rr = monoVar(N.op_gte, [Ty.realTy, Ty.realTy] --> Ty.T_Bool)
263 :     val gt_ii = monoVar(N.op_gt, [Ty.T_Int, Ty.T_Int] --> Ty.T_Bool)
264 :     val gt_rr = monoVar(N.op_gt, [Ty.realTy, Ty.realTy] --> Ty.T_Bool)
265 :    
266 :     val equ_bb = monoVar(N.op_equ, [Ty.T_Bool, Ty.T_Bool] --> Ty.T_Bool)
267 :     val equ_ii = monoVar(N.op_equ, [Ty.T_Int, Ty.T_Int] --> Ty.T_Bool)
268 :     val equ_ss = monoVar(N.op_equ, [Ty.T_String, Ty.T_String] --> Ty.T_Bool)
269 :     val equ_rr = monoVar(N.op_equ, [Ty.realTy, Ty.realTy] --> Ty.T_Bool)
270 :     val neq_bb = monoVar(N.op_neq, [Ty.T_Bool, Ty.T_Bool] --> Ty.T_Bool)
271 :     val neq_ii = monoVar(N.op_neq, [Ty.T_Int, Ty.T_Int] --> Ty.T_Bool)
272 :     val neq_ss = monoVar(N.op_neq, [Ty.T_String, Ty.T_String] --> Ty.T_Bool)
273 :     val neq_rr = monoVar(N.op_neq, [Ty.realTy, Ty.realTy] --> Ty.T_Bool)
274 :    
275 :     val neg_i = monoVar(N.op_neg, [Ty.T_Int] --> Ty.T_Int)
276 :     val neg_t = polyVar(N.op_neg, all([SK],
277 :     fn [Ty.SHAPE dd] => let
278 :     val t = Ty.T_Tensor(Ty.ShapeVar dd)
279 :     in
280 :     [t] --> t
281 :     end))
282 :     val neg_f = polyVar(N.op_neg, all([DK, NK, SK],
283 :     fn [Ty.DIFF k, Ty.DIM d, Ty.SHAPE dd] => let
284 :     val k = Ty.DiffVar(k, 0)
285 :     val d = Ty.DimVar d
286 :     val dd = Ty.ShapeVar dd
287 :     in
288 :     [field(k, d, dd)] --> field(k, d, dd)
289 :     end))
290 :    
291 :     (* clamp is overloaded at scalars and vectors *)
292 :     val clamp_rrr = monoVar(N.fn_clamp, [Ty.realTy, Ty.realTy, Ty.realTy] --> Ty.realTy)
293 :     val clamp_vvv = polyVar (N.fn_clamp, allNK(fn tv => let
294 :     val t = tensor[Ty.DimVar tv]
295 :     in
296 :     [t, t, t] --> t
297 :     end))
298 :    
299 :     val lerp3 = polyVar(N.fn_lerp, all([SK],
300 :     fn [Ty.SHAPE dd] => let
301 :     val t = Ty.T_Tensor(Ty.ShapeVar dd)
302 :     in
303 :     [t, t, Ty.realTy] --> t
304 :     end))
305 :     val lerp5 = polyVar(N.fn_lerp, all([SK],
306 :     fn [Ty.SHAPE dd] => let
307 :     val t = Ty.T_Tensor(Ty.ShapeVar dd)
308 :     in
309 :     [t, t, Ty.realTy, Ty.realTy, Ty.realTy] --> t
310 :     end))
311 :    
312 :     (* Eigenvalues/vectors of a matrix; we only support this operation on 2x2 and 3x3 matrices, so
313 :     * we overload the function.
314 :     *)
315 :     local
316 :     fun evals d = monoVar (N.fn_evals, [matrix d] --> Ty.T_Sequence(Ty.realTy, d))
317 :     fun evecs d = monoVar (N.fn_evecs, [matrix d] --> Ty.T_Sequence(tensor[d], d))
318 :     in
319 :     val evals2x2 = evals(Ty.DimConst 2)
320 :     val evecs2x2 = evecs(Ty.DimConst 2)
321 :     val evals3x3 = evals(Ty.DimConst 3)
322 :     val evecs3x3 = evecs(Ty.DimConst 3)
323 :     end
324 :    
325 :     (***** non-overloaded operators, etc. *****)
326 :    
327 :     (* C math functions *)
328 :     val mathFns : (MathFuns.name * Var.var) list = let
329 :     fun ty n = List.tabulate(MathFuns.arity n, fn _ => Ty.realTy) --> Ty.realTy
330 :     in
331 :     List.map (fn n => (n, monoVar(MathFuns.toAtom n, ty n))) MathFuns.allFuns
332 :     end
333 :    
334 :     (* integer modulo *)
335 :     val op_mod = monoVar(N.op_mod, [Ty.T_Int, Ty.T_Int] --> Ty.T_Int)
336 :    
337 :     (* pseudo-operator for probing a field *)
338 :     val op_probe = polyVar (N.op_at, all([DK, NK, SK],
339 :     fn [Ty.DIFF k, Ty.DIM d, Ty.SHAPE dd] => let
340 :     val k = Ty.DiffVar(k, 0)
341 :     val d = Ty.DimVar d
342 :     val dd = Ty.ShapeVar dd
343 :     in
344 :     [field(k, d, dd), tensor[d]] --> Ty.T_Tensor dd
345 :     end))
346 :    
347 :     (* differentiation of scalar fields *)
348 :     val op_D = polyVar (N.op_D, all([DK, NK],
349 :     fn [Ty.DIFF k, Ty.DIM d] => let
350 :     val k0 = Ty.DiffVar(k, 0)
351 :     val km1 = Ty.DiffVar(k, ~1)
352 :     val d = Ty.DimVar d
353 :     in
354 :     [field(k0, d, Ty.Shape[])] --> field(km1, d, Ty.Shape[d])
355 :     end))
356 :    
357 :     (* differentiation of higher-order tensor fields *)
358 :     val op_Dotimes = polyVar (N.op_Dotimes, all([DK, NK, SK, NK],
359 :     fn [Ty.DIFF k, Ty.DIM d, Ty.SHAPE dd, Ty.DIM d'] => let
360 :     val k0 = Ty.DiffVar(k, 0)
361 :     val km1 = Ty.DiffVar(k, ~1)
362 :     val d = Ty.DimVar d
363 :     val d' = Ty.DimVar d'
364 :     val dd = Ty.ShapeVar dd
365 :     in
366 :     [field(k0, d, Ty.ShapeExt(dd, d'))]
367 :     --> field(km1, d, Ty.ShapeExt(Ty.ShapeExt(dd, d'), d))
368 :     end))
369 :    
370 :     (* divergence differentiation of higher-order tensor fields *)
371 :     val op_Ddot = polyVar (N.op_Ddot, all([DK, NK, SK, NK],
372 :     fn [Ty.DIFF k, Ty.DIM d, Ty.SHAPE dd, Ty.DIM d'] => let
373 :     val k0 = Ty.DiffVar(k, 0)
374 :     val km1 = Ty.DiffVar(k, ~1)
375 :     val d = Ty.DimVar d
376 :     val d' = Ty.DimVar d'
377 :     val dd' = Ty.ShapeVar dd
378 :     in
379 :     [field(k0, d, Ty.ShapeExt(dd', d'))] --> field(k0, d, dd')
380 :     end))
381 :    
382 :     val op_norm_t = polyVar (N.op_norm, all([SK],
383 :     fn [Ty.SHAPE dd] => [Ty.T_Tensor(Ty.ShapeVar dd)] --> Ty.realTy))
384 :     val op_norm_f = polyVar (N.op_norm, all([DK, NK, SK], fn [Ty.DIFF k,Ty.DIM d, Ty.SHAPE dd1] => let
385 :     val k = Ty.DiffVar(k, 0)
386 :     val d = Ty.DimVar d
387 :     val f1 = Ty.T_Field{diff = k, dim = d, shape = Ty.ShapeVar dd1}
388 :     val f2 = Ty.T_Field{diff = k, dim = d, shape = Ty.Shape []}
389 :     in
390 :     [f1] --> f2
391 :     end))
392 :    
393 :     val op_not = monoVar (N.op_not, [Ty.T_Bool] --> Ty.T_Bool)
394 :    
395 :     (* cross product *)
396 :     local
397 :     val crossTy = let
398 :     val t = tensor[N3]
399 :     in
400 :     [t, t] --> t
401 :     end
402 :     val crossTy2 = let
403 :     val t = tensor[N2]
404 :     in
405 :     [t, t] --> Ty.realTy
406 :     end
407 :     in
408 :     val op_cross2_tt = monoVar (N.op_cross, crossTy2)
409 :     val op_cross3_tt = monoVar (N.op_cross, crossTy)
410 :     end
411 :    
412 :     val op_cross2_ff = polyVar (N.op_cross, all([DK], fn [Ty.DIFF k] => let
413 :     fun field' (k, d, dd) = field(k, Ty.DimConst d, Ty.Shape(List.map Ty.DimConst dd))
414 :     val k0 = Ty.DiffVar(k, 0)
415 :     val f = field' (k0, 2, [2])
416 :     val t1 = field' (k0, 2, [])
417 :     in
418 :     [f, f] --> t1
419 :     end))
420 :    
421 :     val op_cross3_ff = polyVar (N.op_cross, all([DK], fn [Ty.DIFF k] => let
422 :     fun field' (k, d, dd) = field(k, Ty.DimConst d, Ty.Shape(List.map Ty.DimConst dd))
423 :     val f = field' (Ty.DiffVar(k, 0), 3, [3])
424 :     in
425 :     [f, f] --> f
426 :     end))
427 :    
428 :     (* the inner product operator (including dot product) is treated as a special case in the
429 :     * typechecker. It is not included in the basis environment, but we define its type scheme
430 :     * here. There is an implicit constraint on its type to have the following scheme:
431 :     *
432 :     * ALL[sigma1, d1, sigma2] . tensor[sigma1, d1] * tensor[d1, sigma2] -> tensor[sigma1, sigma2]
433 :     *)
434 :     val op_inner_tt = polyVar (N.op_dot, all([SK,SK,SK],
435 :     fn [Ty.SHAPE s1, Ty.SHAPE s2, Ty.SHAPE s3] =>
436 :     [Ty.T_Tensor(Ty.ShapeVar s1), Ty.T_Tensor(Ty.ShapeVar s2)]
437 :     --> Ty.T_Tensor(Ty.ShapeVar s3)))
438 :     val op_inner_tf = polyVar (N.op_dot, all([DK,NK,SK,SK,SK],
439 :     fn [Ty.DIFF k, Ty.DIM d, Ty.SHAPE dd1, Ty.SHAPE dd2, Ty.SHAPE dd3] => let
440 :     val k = Ty.DiffVar(k, 0)
441 :     val d = Ty.DimVar d
442 :     val t1 = Ty.T_Tensor(Ty.ShapeVar dd1)
443 :     val t2 = Ty.T_Field{diff = k, dim = d, shape = Ty.ShapeVar dd2}
444 :     val t3 = Ty.T_Field{diff = k, dim = d, shape = Ty.ShapeVar dd3}
445 :     in
446 :     [t1, t2] --> t3
447 :     end))
448 :     val op_inner_ft = polyVar (N.op_dot, all([DK,NK,SK,SK,SK],
449 :     fn [Ty.DIFF k, Ty.DIM d, Ty.SHAPE dd1, Ty.SHAPE dd2, Ty.SHAPE dd3] => let
450 :     val k = Ty.DiffVar(k, 0)
451 :     val d = Ty.DimVar d
452 :     val t1 = Ty.T_Field{diff = k, dim = d, shape = Ty.ShapeVar dd1}
453 :     val t2 = Ty.T_Tensor(Ty.ShapeVar dd2)
454 :     val t3 = Ty.T_Field{diff = k, dim = d, shape = Ty.ShapeVar dd3}
455 :     in
456 :     [t1, t2] --> t3
457 :     end))
458 :     val op_inner_ff = polyVar (N.op_dot, all([DK,DK, NK, SK, SK, SK],
459 :     fn [Ty.DIFF k1,Ty.DIFF k2, Ty.DIM d, Ty.SHAPE dd1, Ty.SHAPE dd2, Ty.SHAPE dd3] => let
460 :     val k1 = Ty.DiffVar(k1, 0)
461 :     val k2 = Ty.DiffVar(k2, 0)
462 :     val d = Ty.DimVar d
463 :     val t1 = Ty.T_Field{diff = k1, dim = d, shape = Ty.ShapeVar dd1}
464 :     val t2 = Ty.T_Field{diff = k2, dim = d, shape = Ty.ShapeVar dd2}
465 :     val t3 = Ty.T_Field{diff = k1, dim = d, shape = Ty.ShapeVar dd3}
466 :     in
467 :     [t1, t2] --> t3
468 :     end))
469 :    
470 :     (* the colon (or double-dot) product operator is treated as a special case in the
471 :     * typechecker. It is not included in the basis environment, but we define its type
472 :     * scheme here. There is an implicit constraint on its type to have the following scheme:
473 :     *
474 :     * ALL[sigma1, d1, d2, sigma2] .
475 :     * tensor[sigma1, d1, d2] * tensor[d1, d2, sigma2] -> tensor[sigma1, sigma2]
476 :     *)
477 :     val op_colon_tt = polyVar (N.op_colon, all([SK,SK,SK],
478 :     fn [Ty.SHAPE s1, Ty.SHAPE s2, Ty.SHAPE s3] =>
479 :     [Ty.T_Tensor(Ty.ShapeVar s1), Ty.T_Tensor(Ty.ShapeVar s2)]
480 :     --> Ty.T_Tensor(Ty.ShapeVar s3)))
481 :     val op_colon_ff = polyVar (N.op_colon, all([DK,SK,NK,SK,SK],
482 :     fn [Ty.DIFF k,Ty.SHAPE dd1, Ty.DIM d, Ty.SHAPE dd2,Ty.SHAPE dd3] =>let
483 :     val k0 = Ty.DiffVar(k, 0)
484 :     val d' = Ty.DimVar d
485 :     val t1 = Ty.T_Field{diff = k0, dim = d', shape = Ty.ShapeVar dd1}
486 :     val t2 = Ty.T_Field{diff = k0, dim = d', shape = Ty.ShapeVar dd2}
487 :     val t3 = Ty.T_Field{diff = k0, dim = d', shape = Ty.ShapeVar dd3}
488 :     in
489 :     [t1,t2] --> t3
490 :     end))
491 :     val op_colon_ft = polyVar (N.op_colon, all([DK,SK,NK,SK,SK],
492 :     fn [Ty.DIFF k,Ty.SHAPE dd1, Ty.DIM d, Ty.SHAPE s2,Ty.SHAPE dd3] =>let
493 :     val k0 = Ty.DiffVar(k, 0)
494 :     val d' = Ty.DimVar d
495 :     val t1 = Ty.T_Field{diff = k0, dim = d', shape = Ty.ShapeVar dd1}
496 :     val t2 = Ty.T_Tensor(Ty.ShapeVar s2)
497 :     val t3 = Ty.T_Field{diff = k0, dim = d', shape = Ty.ShapeVar dd3}
498 :     in
499 :     [t1, t2] --> t3
500 :     end))
501 :     val op_colon_tf = polyVar (N.op_colon, all([DK,SK,NK,SK,SK],
502 :     fn [Ty.DIFF k,Ty.SHAPE s1, Ty.DIM d, Ty.SHAPE dd2,Ty.SHAPE dd3] =>let
503 :     val k0 = Ty.DiffVar(k, 0)
504 :     val d' = Ty.DimVar d
505 :     val t1 = Ty.T_Tensor(Ty.ShapeVar s1)
506 :     val t2 = Ty.T_Field{diff = k0, dim = d', shape = Ty.ShapeVar dd2}
507 :     val t3 = Ty.T_Field{diff = k0, dim = d', shape = Ty.ShapeVar dd3}
508 :     in
509 :     [t1,t2] --> t3
510 :     end))
511 :    
512 :     (* image size operation *)
513 :     val fn_size = polyVar (N.fn_size, all([NK, SK],
514 :     fn [Ty.DIM d, Ty.SHAPE dd] => let
515 :     val d = Ty.DimVar d
516 :     val dd = Ty.ShapeVar dd
517 :     in
518 :     [Ty.T_Image{dim=d, shape=dd}] --> Ty.T_Sequence(Ty.T_Int, d)
519 :     end))
520 :    
521 :     (* functions that handle the boundary behavior of an image *)
522 :     local
523 :     fun img2img f = polyVar (f, all([NK, SK],
524 :     fn [Ty.DIM d, Ty.SHAPE dd] => let
525 :     val imgTy = Ty.T_Image{dim=Ty.DimVar d, shape=Ty.ShapeVar dd}
526 :     in
527 :     [imgTy] --> imgTy
528 :     end))
529 :     in
530 :     val image_border = polyVar (N.fn_border, all([NK, SK],
531 :     fn [Ty.DIM d, Ty.SHAPE dd] => let
532 :     val d = Ty.DimVar d
533 :     val dd = Ty.ShapeVar dd
534 :     in
535 :     [Ty.T_Image{dim=d, shape=dd}, Ty.T_Tensor dd]
536 :     --> Ty.T_Image{dim=d, shape=dd}
537 :     end))
538 :     val image_clamp = img2img N.fn_clamp
539 :     val image_mirror = img2img N.fn_mirror
540 :     val image_wrap = img2img N.fn_wrap
541 :     end (* local *)
542 :    
543 :     (* is a point inside the domain of a field? *)
544 :     val fn_inside = polyVar (N.fn_inside, all([DK, NK, SK],
545 :     fn [Ty.DIFF k, Ty.DIM d, Ty.SHAPE dd] => let
546 :     val k = Ty.DiffVar(k, 0)
547 :     val d = Ty.DimVar d
548 :     val dd = Ty.ShapeVar dd
549 :     in
550 :     [Ty.T_Tensor(Ty.Shape[d]), field(k, d, dd)]
551 :     --> Ty.T_Bool
552 :     end))
553 :    
554 :     (* load image from nrrd *)
555 :     val fn_image = polyVar (N.fn_image, all([NK, SK],
556 :     fn [Ty.DIM d, Ty.SHAPE dd] => let
557 :     val d = Ty.DimVar d
558 :     val dd = Ty.ShapeVar dd
559 :     in
560 :     [Ty.T_String] --> Ty.T_Image{dim=d, shape=dd}
561 :     end))
562 :    
563 :     (* load dynamic sequence from nrrd *)
564 :     val fn_load = polyVar (N.fn_load, all([TK],
565 :     fn [Ty.TYPE tv] => [Ty.T_String] --> Ty.T_DynSequence(Ty.T_Var tv)))
566 :    
567 :     val fn_length = polyVar (N.fn_length, all([TK],
568 :     fn [Ty.TYPE tv] => [Ty.T_DynSequence(Ty.T_Var tv)] --> Ty.T_Int))
569 :    
570 :     val fn_max = monoVar (N.fn_max, [Ty.realTy, Ty.realTy] --> Ty.realTy)
571 :     val fn_min = monoVar (N.fn_min, [Ty.realTy, Ty.realTy] --> Ty.realTy)
572 :    
573 :     val fn_modulate = polyVar (N.fn_modulate, all([NK],
574 :     fn [Ty.DIM d] => let
575 :     val t = Ty.T_Tensor(Ty.Shape[Ty.DimVar d])
576 :     in
577 :     [t, t] --> t
578 :     end))
579 :    
580 :     val fn_normalize_t = polyVar (N.fn_normalize, all([NK],
581 :     fn [Ty.DIM d] => let
582 :     val t = Ty.T_Tensor(Ty.Shape[Ty.DimVar d])
583 :     in
584 :     [t] --> t
585 :     end))
586 :     val fn_normalize_f = polyVar (N.fn_normalize, all([DK,NK,SK],
587 :     fn [Ty.DIFF k, Ty.DIM d, Ty.SHAPE dd1] => let
588 :     val k0 = Ty.DiffVar(k, 0)
589 :     val d' = Ty.DimVar d
590 :     val f1 = Ty.T_Field{diff = k0, dim = d', shape = Ty.ShapeVar dd1}
591 :     in
592 :     [f1] --> f1
593 :     end))
594 :    
595 :     (* outer product *)
596 :     local
597 :     fun mkOuter [Ty.DIM d1, Ty.DIM d2] = let
598 :     val vt1 = Ty.T_Tensor(Ty.Shape[Ty.DimVar d1])
599 :     val vt2 = Ty.T_Tensor(Ty.Shape[Ty.DimVar d2])
600 :     val mt = Ty.T_Tensor(Ty.Shape[Ty.DimVar d1, Ty.DimVar d2])
601 :     in
602 :     [vt1, vt2] --> mt
603 :     end
604 :     in
605 :     val op_outer_tt = polyVar (N.op_outer, all([NK, NK], mkOuter))
606 :     end
607 :    
608 :     local
609 :     fun mkOuterField [Ty.DIFF k, Ty.DIM d,Ty.DIM a, Ty.DIM b] = let
610 :     val k0 = Ty.DiffVar(k, 0)
611 :     val d' = Ty.DimVar d
612 :     val a' = Ty.DimVar a
613 :     val b' = Ty.DimVar b
614 :     val f = field(k0, d', Ty.Shape[a'])
615 :     val g = field(k0, d', Ty.Shape[b'])
616 :     val h = field(k0, d', Ty.Shape[a', b'])
617 :     in
618 :     [f, g] --> h
619 :     end
620 :     in
621 :     val op_outer_ff = polyVar (N.op_outer, all([DK,NK,NK,NK], mkOuterField))
622 :     end
623 :    
624 :     val fn_principleEvec = polyVar (N.fn_principleEvec, all([NK],
625 :     fn [Ty.DIM d] => let
626 :     val d = Ty.DimVar d
627 :     in
628 :     [matrix d] --> tensor[d]
629 :     end))
630 :    
631 :     val fn_trace_t = polyVar (N.fn_trace, all([NK],
632 :     fn [Ty.DIM d] => [matrix(Ty.DimVar d)] --> Ty.realTy))
633 :     val fn_trace_f = polyVar (N.fn_trace, all([DK,NK,SK],
634 :     fn [Ty.DIFF k, Ty.DIM d, Ty.SHAPE dd1] => let
635 :     val k' = Ty.DiffVar(k, 0)
636 :     val d' = Ty.DimVar d
637 :     val d1 = Ty.ShapeVar dd1
638 :     val f = field(k', d', Ty.ShapeExt(Ty.ShapeExt(d1, d'), d'))
639 :     val h = field(k', d', d1)
640 :     in
641 :     [f] --> h
642 :     end))
643 :    
644 :     val fn_transpose_t = polyVar (N.fn_transpose, all([NK, NK],
645 :     fn [Ty.DIM d1, Ty.DIM d2] =>
646 :     [tensor[Ty.DimVar d1, Ty.DimVar d2]] --> tensor[Ty.DimVar d2, Ty.DimVar d1]))
647 :     val fn_transpose_f = polyVar (N.fn_transpose, all([DK,NK,NK,NK],
648 :     fn [Ty.DIFF k, Ty.DIM d,Ty.DIM a, Ty.DIM b] => let
649 :     val k0 = Ty.DiffVar(k, 0)
650 :     val d' = Ty.DimVar d
651 :     val a' = Ty.DimVar a
652 :     val b' = Ty.DimVar b
653 :     val f = field(k0, d', Ty.Shape[a',b'])
654 :     val h = field(k0, d', Ty.Shape[b',a'])
655 :     in
656 :     [f] --> h
657 :     end))
658 :    
659 :     (* determinant: restrict to 2x2 and 3x3*)
660 :     val fn_det2_t = monoVar (N.fn_det, [matrix N2] --> Ty.realTy)
661 :     val fn_det3_t = monoVar (N.fn_det, [matrix N3] --> Ty.realTy)
662 :     val fn_det2_f = polyVar (N.fn_det, all([DK], fn [Ty.DIFF k] => let
663 :     fun field' (k, d, dd) = field(k, Ty.DimConst d, Ty.Shape(List.map Ty.DimConst dd))
664 :     val k0 = Ty.DiffVar(k, 0)
665 :     val f = field' (k0, 2, [2,2])
666 :     val s = field' (k0, 2, [])
667 :     in
668 :     [f] --> s
669 :     end))
670 :     val fn_det3_f = polyVar (N.fn_det, all([DK], fn [Ty.DIFF k] => let
671 :     fun field' (k, d, dd) = field(k, Ty.DimConst d, Ty.Shape(List.map Ty.DimConst dd))
672 :     val k0 = Ty.DiffVar(k, 0)
673 :     val f = field' (k0, 3, [3,3])
674 :     val s = field' (k0, 3, [])
675 :     in
676 :     [f] --> s
677 :     end))
678 :    
679 :     (* sqrt *)
680 :     val fn_sqrt_t = monoVar (N.fn_sqrt, [Ty.realTy] --> Ty.realTy)
681 :     val fn_sqrt_f = polyVar (N.fn_sqrt, all([DK,NK], fn [Ty.DIFF k, Ty.DIM d] => let
682 :     val k' = Ty.DiffVar(k, 0)
683 :     val d' = Ty.DimVar d
684 :     val f = field(k', d', Ty.Shape[])
685 :     in
686 :     [f] --> f
687 :     end))
688 :    
689 :     (* cosine *)
690 :     val fn_cos_t = monoVar (N.fn_cos, [Ty.realTy] --> Ty.realTy)
691 :     val fn_cos_f = polyVar (N.fn_cos, all([DK,NK], fn [Ty.DIFF k, Ty.DIM d] => let
692 :     val k' = Ty.DiffVar(k, 0)
693 :     val d' = Ty.DimVar d
694 :     val f = field(k', d', Ty.Shape[])
695 :     in
696 :     [f] --> f
697 :     end))
698 :    
699 :     (* arc cosine *)
700 :     val fn_acos_t = monoVar (N.fn_acos, [Ty.realTy] --> Ty.realTy)
701 :     val fn_acos_f = polyVar (N.fn_acos, all([DK,NK], fn [Ty.DIFF k, Ty.DIM d] => let
702 :     val k' = Ty.DiffVar(k, 0)
703 :     val d' = Ty.DimVar d
704 :     val f = field(k', d', Ty.Shape[])
705 :     in
706 :     [f] --> f
707 :     end))
708 :    
709 :     (* sine *)
710 :     val fn_sin_t = monoVar (N.fn_sin, [Ty.realTy] --> Ty.realTy)
711 :     val fn_sin_f = polyVar (N.fn_sin, all([DK,NK], fn [Ty.DIFF k, Ty.DIM d] => let
712 :     val k' = Ty.DiffVar(k, 0)
713 :     val d' = Ty.DimVar d
714 :     val f = field(k', d', Ty.Shape[])
715 :     in
716 :     [f] --> f
717 :     end))
718 :    
719 :     (* arc sine *)
720 :     val fn_asin_t = monoVar (N.fn_asin, [Ty.realTy] --> Ty.realTy)
721 :     val fn_asin_f = polyVar (N.fn_asin, all([DK,NK], fn [Ty.DIFF k, Ty.DIM d] => let
722 :     val k' = Ty.DiffVar(k, 0)
723 :     val d' = Ty.DimVar d
724 :     val f = field(k', d', Ty.Shape[])
725 :     in
726 :     [f] --> f
727 :     end))
728 :    
729 :     (* kernels *)
730 :     (* FIXME: we should really get the continuity info from the kernels themselves *)
731 :     val kn_bspln3 = monoVar (N.kn_bspln3, Ty.T_Kernel(Ty.DiffConst 2))
732 :     val kn_bspln5 = monoVar (N.kn_bspln5, Ty.T_Kernel(Ty.DiffConst 4))
733 :     val kn_c4hexic = monoVar (N.kn_c4hexic, Ty.T_Kernel(Ty.DiffConst 4))
734 :     val kn_ctmr = monoVar (N.kn_ctmr, Ty.T_Kernel(Ty.DiffConst 1))
735 :     val kn_tent = monoVar (N.kn_tent, Ty.T_Kernel(Ty.DiffConst 0))
736 :    
737 :     (***** internal variables *****)
738 :    
739 :     (* integer to real conversion *)
740 :     val i2r = monoVar (Atom.atom "$i2r", [Ty.T_Int] --> Ty.realTy)
741 :    
742 :     (* identity matrix *)
743 :     val identity = polyVar (Atom.atom "$id", allNK (fn dv => [] --> matrix(Ty.DimVar dv)))
744 :    
745 :     (* zero tensor *)
746 :     val zero = polyVar (Atom.atom "$zero", all ([SK],
747 :     fn [Ty.SHAPE dd] => [] --> Ty.T_Tensor(Ty.ShapeVar dd)))
748 :    
749 :     (* NaN tensor *)
750 :     val nan = polyVar (Atom.atom "$nan", all ([SK],
751 :     fn [Ty.SHAPE dd] => [] --> Ty.T_Tensor(Ty.ShapeVar dd)))
752 :    
753 :     (* sequence subscript *)
754 :     val subscript = polyVar (Atom.atom "$sub", all ([TK, NK],
755 :     fn [Ty.TYPE tv, Ty.DIM d] =>
756 :     [Ty.T_Sequence(Ty.T_Var tv, Ty.DimVar d), Ty.T_Int] --> Ty.T_Var tv))
757 :    
758 :     val dynSubscript = polyVar (Atom.atom "$dynsub", all ([TK],
759 :     fn [Ty.TYPE tv] => [Ty.T_DynSequence(Ty.T_Var tv), Ty.T_Int] --> Ty.T_Var tv))
760 :    
761 :     (* range expressions *)
762 :     val range = monoVar (Atom.atom "$range", [Ty.T_Int, Ty.T_Int] --> Ty.T_DynSequence Ty.T_Int)
763 :    
764 :     end (* local *)
765 :     end

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