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

SCM Repository

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

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

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

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

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

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