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 65 - (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 65 structure TV = TypeVar
15 : jhr 47
16 : jhr 63 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 : jhr 47 end

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