Home My Page Projects Code Snippets Project Openings diderot

# SCM Repository

[diderot] Diff of /branches/charisee/src/compiler/basis/basis-vars.sml
 [diderot] / branches / charisee / src / compiler / basis / basis-vars.sml

# Diff of /branches/charisee/src/compiler/basis/basis-vars.sml

trunk/src/compiler/basis/basis-vars.sml revision 435, Tue Oct 19 13:14:20 2010 UTC branches/charisee/src/compiler/basis/basis-vars.sml revision 2506, Fri Nov 8 00:05:57 2013 UTC
# Line 21  Line 21
21
22      (* short names for kinds *)      (* short names for kinds *)
23        val TK : unit -> Ty.meta_var = Ty.TYPE o MV.newTyVar        val TK : unit -> Ty.meta_var = Ty.TYPE o MV.newTyVar
24        fun DK () = Ty.DIFF(MV.newDiffVar 0)        fun DK () : Ty.meta_var = Ty.DIFF(MV.newDiffVar 0)
25        val SK : unit -> Ty.meta_var = Ty.SHAPE o MV.newShapeVar        val SK : unit -> Ty.meta_var = Ty.SHAPE o MV.newShapeVar
26        val NK : unit -> Ty.meta_var = Ty.DIM o MV.newDimVar        val NK : unit -> Ty.meta_var = Ty.DIM o MV.newDimVar
27
# Line 39  Line 39
39
40        fun field (k, d, dd) = Ty.T_Field{diff=k, dim=d, shape=dd}        fun field (k, d, dd) = Ty.T_Field{diff=k, dim=d, shape=dd}
41        fun tensor ds = Ty.T_Tensor(Ty.Shape ds)        fun tensor ds = Ty.T_Tensor(Ty.Shape ds)
42          fun matrix d = tensor[d,d]
43
44        fun monoVar (name, ty) = Var.new (name, AST.BasisVar, ty)        fun monoVar (name, ty) = Var.new (name, AST.BasisVar, ty)
45        fun polyVar (name, scheme) = Var.newPoly (name, AST.BasisVar, scheme)        fun polyVar (name, scheme) = Var.newPoly (name, AST.BasisVar, scheme)
# Line 54  Line 55
55     *    b  -- bool     *    b  -- bool
56     *    r  -- real (tensor[])     *    r  -- real (tensor[])
57     *    t  -- tensor[shape]     *    t  -- tensor[shape]
58       *    f  -- field#k(d)[shape]
59     *)     *)
60
# Line 62  Line 64
64              in              in
65                [t, t] --> t                [t, t] --> t
66              end))              end))
68              fn [Ty.DIFF k, Ty.DIM d, Ty.SHAPE dd] => let
69                val t = Ty.T_Field{diff = Ty.DiffVar(k, 0), dim = Ty.DimVar d, shape = Ty.ShapeVar dd}
70                in
71                  [t, t] --> t
72                end))
74              fn [Ty.DIFF k, Ty.DIM d] => let
75                val t = Ty.T_Field{diff = Ty.DiffVar(k, 0), dim = Ty.DimVar d, shape = Ty.Shape[]}
76                in
77                  [t, Ty.realTy] --> t
78                end))
80              fn [Ty.DIFF k, Ty.DIM d] => let
81                val t = Ty.T_Field{diff = Ty.DiffVar(k, 0), dim = Ty.DimVar d, shape = Ty.Shape[]}
82                in
83                  [Ty.realTy, t] --> t
84                end))
85
86      val sub_ii = monoVar(N.op_sub, [Ty.T_Int, Ty.T_Int] --> Ty.T_Int)      val sub_ii = monoVar(N.op_sub, [Ty.T_Int, Ty.T_Int] --> Ty.T_Int)
87      val sub_tt = polyVar(N.op_sub, all([SK], fn [Ty.SHAPE dd] => let      val sub_tt = polyVar(N.op_sub, all([SK], fn [Ty.SHAPE dd] => let
# Line 69  Line 89
89              in              in
90                [t, t] --> t                [t, t] --> t
91              end))              end))
92        val sub_ff = polyVar(N.op_sub, all([DK,NK,SK],
93              fn [Ty.DIFF k, Ty.DIM d, Ty.SHAPE dd] => let
94                val t = Ty.T_Field{diff = Ty.DiffVar(k, 0), dim = Ty.DimVar d, shape = Ty.ShapeVar dd}
95                in
96                  [t, t] --> t
97                end))
98        val sub_fr = polyVar(N.op_sub, all([DK,NK], (* field - scalar *)
99              fn [Ty.DIFF k, Ty.DIM d] => let
100                val t = Ty.T_Field{diff = Ty.DiffVar(k, 0), dim = Ty.DimVar d, shape = Ty.Shape[]}
101                in
102                  [t, Ty.realTy] --> t
103                end))
104        val sub_rf = polyVar(N.op_sub, all([DK,NK], (* scalar - field *)
105              fn [Ty.DIFF k, Ty.DIM d] => let
106                val t = Ty.T_Field{diff = Ty.DiffVar(k, 0), dim = Ty.DimVar d, shape = Ty.Shape[]}
107                in
108                  [Ty.realTy, t] --> t
109                end))
110
111    (* note that we assume that operators are tested in the order defined here, so that mul_rr    (* note that we assume that operators are tested in the order defined here, so that mul_rr
112     * takes precedence over mul_rt and mul_tr!     * takes precedence over mul_rt and mul_tr!
# Line 85  Line 123
123              in              in
124                [t, Ty.realTy] --> t                [t, Ty.realTy] --> t
125              end))              end))
126        val mul_rf = polyVar(N.op_mul, all([DK,NK,SK],
127              fn [Ty.DIFF k, Ty.DIM d, Ty.SHAPE dd] => let
128                val t = Ty.T_Field{diff = Ty.DiffVar(k, 0), dim = Ty.DimVar d, shape = Ty.ShapeVar dd}
129                in
130                  [Ty.realTy, t] --> t
131                end))
132        val mul_fr = polyVar(N.op_mul, all([DK,NK,SK],
133              fn [Ty.DIFF k, Ty.DIM d, Ty.SHAPE dd] => let
134                val t = Ty.T_Field{diff = Ty.DiffVar(k, 0), dim = Ty.DimVar d, shape = Ty.ShapeVar dd}
135                in
136                  [t, Ty.realTy] --> t
137                end))
138
139      val div_ii = monoVar(N.op_div, [Ty.T_Int, Ty.T_Int] --> Ty.T_Int)      val div_ii = monoVar(N.op_div, [Ty.T_Int, Ty.T_Int] --> Ty.T_Int)
140      val div_rr = monoVar(N.op_div, [Ty.realTy, Ty.realTy] --> Ty.realTy)      val div_rr = monoVar(N.op_div, [Ty.realTy, Ty.realTy] --> Ty.realTy)
# Line 93  Line 143
143              in              in
144                [t, Ty.realTy] --> t                [t, Ty.realTy] --> t
145              end))              end))
146        val div_fr = polyVar(N.op_div, all([DK,NK,SK],
147              fn [Ty.DIFF k, Ty.DIM d, Ty.SHAPE dd] => let
148                val t = Ty.T_Field{diff = Ty.DiffVar(k, 0), dim = Ty.DimVar d, shape = Ty.ShapeVar dd}
149                in
150                  [t, Ty.realTy] --> t
151                end))
152
153      (* exponentiation; we distinguish between integer and real exponents to allow x^2 to be compiled
154       * as x*x.
155       *)
156        val exp_ri = monoVar(N.op_exp, [Ty.realTy, Ty.T_Int] --> Ty.realTy)
157        val exp_rr = monoVar(N.op_exp, [Ty.realTy, Ty.realTy] --> Ty.realTy)
158
159        val convolve_vk = polyVar (N.op_convolve, all([DK, NK, SK],
160                fn [Ty.DIFF k, Ty.DIM d, Ty.SHAPE dd] => let
161                    val k = Ty.DiffVar(k, 0)
162                    val d = Ty.DimVar d
163                    val dd = Ty.ShapeVar dd
164                    in
165                      [Ty.T_Image{dim=d, shape=dd}, Ty.T_Kernel k]
166                        --> field(k, d, dd)
167                    end))
168        val convolve_kv = polyVar (N.op_convolve, all([DK, NK, SK],
169                fn [Ty.DIFF k, Ty.DIM d, Ty.SHAPE dd] => let
170                    val k = Ty.DiffVar(k, 0)
171                    val d = Ty.DimVar d
172                    val dd = Ty.ShapeVar dd
173                    in
174                      [Ty.T_Kernel k, Ty.T_Image{dim=d, shape=dd}]
175                        --> field(k, d, dd)
176                    end))
177
178      (* curl on 2d and 3d vector fields *)
179        local
180          val diff0 = Ty.DiffConst 0
181          fun field' (k, d, dd) = field(k, Ty.DimConst d, Ty.Shape(List.map Ty.DimConst dd))
182        in
183    (* FIXME: we want to be able to require that k > 0, but we don't have a way to do that! *)
184        val curl2D = polyVar (N.op_curl, all([DK],
185              fn [Ty.DIFF k] =>
186                [field' (Ty.DiffVar(k, 0), 2, [2])] --> field' (diff0, 2, [])))
187        val curl3D = polyVar (N.op_curl, all([DK],
188              fn [Ty.DIFF k] =>
189                [field' (Ty.DiffVar(k, 0), 3, [3])] --> field' (diff0, 2, [3])))
190        end (* local *)
191
192      val lt_ii = monoVar(N.op_lt, [Ty.T_Int, Ty.T_Int] --> Ty.T_Bool)      val lt_ii = monoVar(N.op_lt, [Ty.T_Int, Ty.T_Int] --> Ty.T_Bool)
193      val lt_rr = monoVar(N.op_lt, [Ty.realTy, Ty.realTy] --> Ty.T_Bool)      val lt_rr = monoVar(N.op_lt, [Ty.realTy, Ty.realTy] --> Ty.T_Bool)
# Line 113  Line 208
208      val neq_rr = monoVar(N.op_neq, [Ty.realTy, Ty.realTy] --> Ty.T_Bool)      val neq_rr = monoVar(N.op_neq, [Ty.realTy, Ty.realTy] --> Ty.T_Bool)
209
210
211      val neg_i = monoVar(N.op_neg, [Ty.T_Int, Ty.T_Int] --> Ty.T_Bool)      val neg_i = monoVar(N.op_neg, [Ty.T_Int] --> Ty.T_Int)
212      val neg_t = polyVar(N.op_neg, all([SK],      val neg_t = polyVar(N.op_neg, all([SK],
213            fn [Ty.SHAPE dd] => let            fn [Ty.SHAPE dd] => let
214                val t = Ty.T_Tensor(Ty.ShapeVar dd)                val t = Ty.T_Tensor(Ty.ShapeVar dd)
# Line 129  Line 224
224                  [field(k, d, dd)] --> field(k, d, dd)                  [field(k, d, dd)] --> field(k, d, dd)
225                end))                end))
226
227      (* clamp is overloaded at scalars and vectors *)
228        val clamp_rrr = monoVar(N.fn_clamp, [Ty.realTy, Ty.realTy, Ty.realTy] --> Ty.realTy)
229        val clamp_vvv = polyVar (N.fn_clamp, allNK(fn tv => let
230              val t = tensor[Ty.DimVar tv]
231              in
232                [t, t, t] --> t
233              end))
234
235        val lerp3 = polyVar(N.fn_lerp, all([SK],
236              fn [Ty.SHAPE dd] => let
237                  val t = Ty.T_Tensor(Ty.ShapeVar dd)
238                  in
239                    [t, t, Ty.realTy] --> t
240                  end))
241        val lerp5 = polyVar(N.fn_lerp, all([SK],
242              fn [Ty.SHAPE dd] => let
243                  val t = Ty.T_Tensor(Ty.ShapeVar dd)
244                  in
245                    [t, t, Ty.realTy, Ty.realTy, Ty.realTy] --> t
246                  end))
247
248      (* Eigenvalues/vectors of a matrix; we only support this operation on 2x2 and 3x3 matrices, so
249       * we overload the function.
250       *)
251        local
252          fun evals d = monoVar (N.fn_evals, [matrix d] --> Ty.T_Sequence(Ty.realTy, d))
253          fun evecs d = monoVar (N.fn_evecs, [matrix d] --> Ty.T_Sequence(tensor[d], d))
254        in
255        val evals2x2 = evals(Ty.DimConst 2)
256        val evecs2x2 = evecs(Ty.DimConst 2)
257        val evals3x3 = evals(Ty.DimConst 3)
258        val evecs3x3 = evecs(Ty.DimConst 3)
259        end
260
261
263
264      val op_at = polyVar (N.op_at, all([DK, NK, SK],    (* C math functions *)
265        val mathFns : (MathFuns.name * Var.var) list = let
266              fun ty n = List.tabulate(MathFuns.arity n, fn _ => Ty.realTy) --> Ty.realTy
267              in
268                List.map (fn n => (n, monoVar(MathFuns.toAtom n, ty n))) MathFuns.allFuns
269              end
270
271      (* pseudo-operator for probing a field *)
272        val op_probe = polyVar (N.op_at, all([DK, NK, SK],
273            fn [Ty.DIFF k, Ty.DIM d, Ty.SHAPE dd] => let            fn [Ty.DIFF k, Ty.DIM d, Ty.SHAPE dd] => let
274                val k = Ty.DiffVar(k, 0)                val k = Ty.DiffVar(k, 0)
275                val d = Ty.DimVar d                val d = Ty.DimVar d
# Line 141  Line 278
278                  [field(k, d, dd), tensor[d]] --> Ty.T_Tensor dd                  [field(k, d, dd), tensor[d]] --> Ty.T_Tensor dd
279                end))                end))
280
281  (* NOTE: this should be overloaded to allow both v*h and h*v orders *)    (* differentiation of scalar fields *)
282      val op_convolve = polyVar (N.op_convolve, all([DK, NK, SK],      val op_D = polyVar (N.op_D, all([DK, NK],
283              fn [Ty.DIFF k, Ty.DIM d, Ty.SHAPE dd] => let            fn [Ty.DIFF k, Ty.DIM d] => let
284                  val k = Ty.DiffVar(k, 0)                val k0 = Ty.DiffVar(k, 0)
285                  val km1 = Ty.DiffVar(k, ~1)
286                  val d = Ty.DimVar d
287                  in
288                    [field(k0, d, Ty.Shape[])]
289                      --> field(km1, d, Ty.Shape[d])
290                  end))
291      (* differetiation of higher-order tensor fields *)
292        val op_Dotimes = polyVar (N.op_Dotimes, all([DK, NK, SK, NK],
293              fn [Ty.DIFF k, Ty.DIM d, Ty.SHAPE dd, Ty.DIM d'] => let
294                  val k0 = Ty.DiffVar(k, 0)
295                  val km1 = Ty.DiffVar(k, ~1)
296                  val d = Ty.DimVar d                  val d = Ty.DimVar d
297                  val d' = Ty.DimVar d'
298                  val dd = Ty.ShapeVar dd                  val dd = Ty.ShapeVar dd
299                  in                  in
300                    [Ty.T_Image{dim=d, shape=dd}, Ty.T_Kernel k]                  [field(k0, d, Ty.ShapeExt(dd, d'))]
301                      --> field(k, d, dd)                    --> field(km1, d, Ty.ShapeExt(Ty.ShapeExt(dd, d'), d))
302                  end))                  end))
303
304      val op_D = polyVar (N.op_D, all([DK, NK, SK],  (* differetiation of higher-order tensor fields *)
305            fn [Ty.DIFF k, Ty.DIM d, Ty.SHAPE dd] => let  val op_Ddot = polyVar (N.op_Ddot, all([DK, NK, SK, NK],
306    fn [Ty.DIFF k, Ty.DIM d, Ty.SHAPE dd, Ty.DIM d'] => let
307                val k0 = Ty.DiffVar(k, 0)                val k0 = Ty.DiffVar(k, 0)
308                val km1 = Ty.DiffVar(k, ~1)                val km1 = Ty.DiffVar(k, ~1)
309                val d = Ty.DimVar d                val d = Ty.DimVar d
310    val d' = Ty.DimVar d'
311                val dd = Ty.ShapeVar dd                val dd = Ty.ShapeVar dd
312                in                in
313                  [field(k0, d, dd)]  [field(k0, d, Ty.ShapeExt(dd, d'))]
314                    --> field(km1, d, Ty.ShapeExt(dd, d))  --> field(km1, d, Ty.ShapeExt(Ty.ShapeExt(dd, d'), d))
315                end))                end))
316
317      val op_norm = polyVar (N.op_norm, all([SK],      val op_norm = polyVar (N.op_norm, all([SK],
# Line 169  Line 320
320      val op_not = monoVar (N.op_not, [Ty.T_Bool] --> Ty.T_Bool)      val op_not = monoVar (N.op_not, [Ty.T_Bool] --> Ty.T_Bool)
321
322    (* functions *)    (* functions *)
323      val fn_CL = monoVar (N.fn_CL, [tensor[N3, N3]] --> Ty.realTy)      local
324          val crossTy = let
325  (* the following is depreciated in favor of the infix operator *)              val t = tensor[N3]
val fn_convolve = polyVar (N.fn_convolve, all([DK, NK, SK],
fn [Ty.DIFF k, Ty.DIM d, Ty.SHAPE dd] => let
val k = Ty.DiffVar(k, 0)
val d = Ty.DimVar d
val dd = Ty.ShapeVar dd
326                  in                  in
327                    [Ty.T_Kernel k, Ty.T_Image{dim=d, shape=dd}]                [t, t] --> t
328                      --> field(k, d, dd)              end
329                  end))      in
330        val op_cross = monoVar (N.op_cross, crossTy)
331        end
332
333      val fn_cos = monoVar (N.fn_cos, [Ty.realTy] --> Ty.realTy)    (* the inner product operator (including dot product) is treated as a special case in the
334       * typechecker.  It is not included in the basis environment, but we define its type scheme
335       * here.  There is an implicit constraint on its type to have the following scheme:
336       *
337       *     ALL[sigma1, d1, sigma2] . tensor[sigma1, d1] * tensor[d1, sigma2] -> tensor[sigma1, sigma2]
338       *)
339        val op_inner = polyVar (N.op_dot, all([SK, SK, SK],
340                fn [Ty.SHAPE s1, Ty.SHAPE s2, Ty.SHAPE s3] =>
341                    [Ty.T_Tensor(Ty.ShapeVar s1), Ty.T_Tensor(Ty.ShapeVar s2)]
342                      --> Ty.T_Tensor(Ty.ShapeVar s3)))
343
344      (* the colon (or double-dot) product operator is treated as a special case in the
345       * typechecker.  It is not included in the basis environment, but we define its type
346       * schemehere.  There is an implicit constraint on its type to have the following scheme:
347       *
348       *     ALL[sigma1, d1, d2, sigma2] .
349       *       tensor[sigma1, d1, d2] * tensor[d1, d2, sigma2] -> tensor[sigma1, sigma2]
350       *)
351        val op_colon = polyVar (N.op_colon, all([SK, SK, SK],
352                fn [Ty.SHAPE s1, Ty.SHAPE s2, Ty.SHAPE s3] =>
353                    [Ty.T_Tensor(Ty.ShapeVar s1), Ty.T_Tensor(Ty.ShapeVar s2)]
354                      --> Ty.T_Tensor(Ty.ShapeVar s3)))
355
356      val fn_dot = polyVar (N.fn_dot, allNK(fn tv => let    (* load image from nrrd *)
357            val t = tensor[Ty.DimVar tv]      val fn_image = polyVar (N.fn_image, all([NK, SK],
358                fn [Ty.DIM d, Ty.SHAPE dd] => let
359                    val d = Ty.DimVar d
360                    val dd = Ty.ShapeVar dd
361            in            in
362              [t, t] --> Ty.realTy                    [Ty.T_String] --> Ty.T_Image{dim=d, shape=dd}
363            end))            end))
364
365      val fn_inside = polyVar (N.fn_inside, all([DK, NK, SK],      val fn_inside = polyVar (N.fn_inside, all([DK, NK, SK],
# Line 218  Line 390
390                    [t, t] --> t                    [t, t] --> t
391                  end))                  end))
392
393      val fn_pow = monoVar (N.fn_pow, [Ty.realTy, Ty.realTy] --> Ty.realTy)      val fn_normalize = polyVar (N.fn_normalize, all([NK],
394                fn [Ty.DIM d] => let
395                    val t = Ty.T_Tensor(Ty.Shape[Ty.DimVar d])
396                    in
397                      [t] --> t
398                    end))
399
400      (* outer product *)
401        local
402          fun mkOuter [Ty.DIM d1, Ty.DIM d2] = let
403                val vt1 = Ty.T_Tensor(Ty.Shape[Ty.DimVar d1])
404                val vt2 = Ty.T_Tensor(Ty.Shape[Ty.DimVar d2])
405                val mt = Ty.T_Tensor(Ty.Shape[Ty.DimVar d1, Ty.DimVar d2])
406                in
407                  [vt1, vt2] --> mt
408                end
409        in
410        val op_outer = polyVar (N.op_outer, all([NK, NK], mkOuter))
411        end
412
413      val fn_principleEvec = polyVar (N.fn_principleEvec, all([NK],      val fn_principleEvec = polyVar (N.fn_principleEvec, all([NK],
414              fn [Ty.DIM d] => let              fn [Ty.DIM d] => let
415                  val d = Ty.DimVar d                  val d = Ty.DimVar d
416                  in                  in
417                    [tensor[d,d]] --> tensor[d]                    [matrix d] --> tensor[d]
418                  end))                  end))
419
420      val fn_sin = monoVar (N.fn_sin, [Ty.realTy] --> Ty.realTy)      val fn_trace = polyVar (N.fn_trace, all([NK],
421                fn [Ty.DIM d] => [matrix(Ty.DimVar d)] --> Ty.realTy))
422
423        val fn_transpose = polyVar (N.fn_transpose, all([NK, NK],
424                fn [Ty.DIM d1, Ty.DIM d2] =>
425                  [tensor[Ty.DimVar d1, Ty.DimVar d2]] --> tensor[Ty.DimVar d2, Ty.DimVar d1]))
426
427    (* kernels *)    (* kernels *)
428  (* FIXME: we should really get the continuity info from the kernels themselves *)  (* FIXME: we should really get the continuity info from the kernels themselves *)
429      val kn_bspln3 = monoVar (N.kn_bspln3, Ty.T_Kernel(Ty.DiffConst 2))      val kn_bspln3 = monoVar (N.kn_bspln3, Ty.T_Kernel(Ty.DiffConst 2))
430      val kn_bspln5 = monoVar (N.kn_bspln5, Ty.T_Kernel(Ty.DiffConst 4))      val kn_bspln5 = monoVar (N.kn_bspln5, Ty.T_Kernel(Ty.DiffConst 4))
431      val kn_ctmr = monoVar (N.kn_ctmr, Ty.T_Kernel(Ty.DiffConst 2))      val kn_c4hexic = monoVar (N.kn_c4hexic, Ty.T_Kernel(Ty.DiffConst 4))
432        val kn_ctmr = monoVar (N.kn_ctmr, Ty.T_Kernel(Ty.DiffConst 1))
433      val kn_tent = monoVar (N.kn_tent, Ty.T_Kernel(Ty.DiffConst 0))      val kn_tent = monoVar (N.kn_tent, Ty.T_Kernel(Ty.DiffConst 0))
434      (* kernels with false claims of differentiability, for pedagogy *)
435    (* internal variables *)      val kn_c1tent = monoVar (N.kn_c1tent, Ty.T_Kernel(Ty.DiffConst 1))
436      val i2r = monoVar (Atom.atom "\$i2r", [Ty.T_Int] --> Ty.realTy)      (* integer to real conversion *)      val kn_c2ctmr = monoVar (N.kn_c2ctmr, Ty.T_Kernel(Ty.DiffConst 2))
437
438      (***** internal variables *****)
439
440      (* integer to real conversion *)
441        val i2r = monoVar (Atom.atom "\$i2r", [Ty.T_Int] --> Ty.realTy)
442
443      (* identity matrix *)
444        val identity = polyVar (Atom.atom "\$id", allNK (fn dv => [] --> matrix(Ty.DimVar dv)))
445
446      (* zero tensor *)
447        val zero = polyVar (Atom.atom "\$zero", all ([SK],
448                fn [Ty.SHAPE dd] => [] --> Ty.T_Tensor(Ty.ShapeVar dd)))
449
450      (* sequence subscript *)
451        val subscript = polyVar (Atom.atom "\$sub", all ([TK, NK],
452                fn [Ty.TYPE tv, Ty.DIM d] =>
453                  [Ty.T_Sequence(Ty.T_Var tv, Ty.DimVar d), Ty.T_Int] --> Ty.T_Var tv))
454      end (* local *)      end (* local *)
455    end    end

Legend:
 Removed from v.435 changed lines Added in v.2506