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

# SCM Repository

[diderot] Diff of /trunk/src/basis/basis.sml
 [diderot] / trunk / src / basis / basis.sml

# Diff of /trunk/src/basis/basis.sml

revision 47, Tue Apr 13 14:57:27 2010 UTC revision 63, Thu May 13 00:29:39 2010 UTC
# Line 8  Line 8
8
9  structure Basis =  structure Basis =
10    struct    struct
11        local
12          structure N = BasisNames
13          structure Ty = Types
14
15          fun --> (tys1, ty) = Ty.T_Fun(tys1, [ty])
16          infix -->
17
18          val N2 = Ty.NatConst 2
19          val N3 = Ty.NatConst 3
20
21        (* short names for kinds *)
22          val NK = Ty.TK_NAT
23          val SK = Ty.TK_SHAPE
24          val TK = Ty.TK_TYPE
25
26          fun ty t = ([], t)
27          fun all (kinds, mkTy) = let
28                val tvs = List.map (fn k => TV.new k) kinds
29                in
30                  (tvs, mkTy tvs)
31                end
32          fun allNK mkTy = let
33                val tv = TV.new NK
34                in
35                  ([tv], mkTy tv)
36                end
37
38        fun field (k, d, dd) = Ty.T_Field{diff=k, dim=d, shape=dd}
39        fun tensor ds = Ty.T_Tensor(Ty.Shape ds)
40
41        in
42
43        val basis = [
44            (* operators *)
45              (N.op_at, all([NK, NK, SK],
46                fn [k, d, dd] => let
47                    val k = Ty.NatVar k
48                    val d = Ty.NatVar d
49                    val dd = Ty.ShapeVar dd
50                    in
51                      [field(k, d, dd), tensor[d]] --> Ty.T_Tensor dd
52                    end)),
53    (*
54        val op_add = Atom.atom "+"
55        val op_sub = Atom.atom "-"
56        val op_mul = Atom.atom "*"
57        val op_div = Atom.atom "/"
58        val op_lt = Atom.atom "<"
59        val op_lte = Atom.atom "<="
60        val op_eql = Atom.atom "=="
61        val op_neq = Atom.atom "!="
62        val op_gte = Atom.atom ">="
63        val op_gt = Atom.atom ">"
64    *)
65              (N.op_at, all([NK, NK, SK],
66                fn [k, d, dd] => let
67                    val k = Ty.NatVar k
68                    val d = Ty.NatVar d
69                    val dd = Ty.ShapeVar dd
70                    in
71                      [field(k, d, dd), tensor[d]]
72                        --> field(Ty.NatExp(k, ~1), d, Ty.ShapeExt(dd, d))
73                    end)),
74    (*
75        val op_orelse = Atom.atom "||"
76        val op_andalso = Atom.atom "&&"
77    *)
78              (N.op_norm, all([SK],
79                fn [dd] => [Ty.T_Tensor(Ty.ShapeVar dd)] --> Ty.realTy)),
80            (* functions *)
81              (N.fn_CL,     ty([tensor[N3, N3]] --> Ty.vec3Ty)),
82              (N.fn_convolve, all([NK, NK, SK],
83                fn [k, d, dd] => let
84                    val k = Ty.NatVar k
85                    val d = Ty.NatVar d
86                    val dd = Ty.ShapeVar dd
87                    in
88                      [Ty.T_Kernel k, Ty.T_Image{dim=d, shape=dd}]
89                        --> field(k, d, dd)
90                    end)),
91              (N.fn_cos,    ty([Ty.realTy] --> Ty.realTy)),
92              (N.fn_dot,    allNK(fn tv => [tensor[Ty.NatVar tv]]
93                              --> tensor[Ty.NatVar tv])),
94    (*
95        val fn_inside = Atom.atom "inside"
96    *)
97              (N.fn_load,   all([NK, SK],
98                fn [d, dd] => let
99                    val d = Ty.NatVar d
100                    val dd = Ty.ShapeVar dd
101                    in
102                      [Ty.T_String] --> Ty.T_Image{dim=d, shape=dd}
103                    end)),
104              (N.fn_pow,    ty([Ty.realTy, Ty.realTy] --> Ty.realTy)),
105    (*
106        val fn_principleEvec = Atom.atom "principleEvec"
107    *)
108              (N.fn_sin,    ty([Ty.realTy] --> Ty.realTy)),
109            (* kernels *)
110              (N.kn_bspln3, ty(Ty.T_Kernel(Ty.NatConst 2))),
111              (N.kn_tent,   ty(Ty.T_Kernel(Ty.NatConst 0)))
112            ]
113
114        end (* local *)
115    end    end

Legend:
 Removed from v.47 changed lines Added in v.63

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