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

SCM Repository

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

Annotation of /trunk/src/basis/basis.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 63 - (view) (download)

1 : jhr 47 (* basis.sml
2 :     *
3 :     * COPYRIGHT (c) 2010 The Diderot Project (http://diderot.cs.uchicago.edu)
4 :     * All rights reserved.
5 :     *
6 :     * Type definitions for Basis functions.
7 :     *)
8 :    
9 :     structure Basis =
10 :     struct
11 : jhr 63 local
12 :     structure N = BasisNames
13 :     structure Ty = Types
14 : jhr 47
15 : jhr 63 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 : jhr 47 end

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