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 68 - (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 : jhr 68 (* overloaded operators *)
45 :     val overloads = [
46 :     (*
47 : jhr 63 val op_add = Atom.atom "+"
48 :     val op_sub = Atom.atom "-"
49 :     val op_mul = Atom.atom "*"
50 :     val op_div = Atom.atom "/"
51 :     val op_lt = Atom.atom "<"
52 :     val op_lte = Atom.atom "<="
53 :     val op_eql = Atom.atom "=="
54 :     val op_neq = Atom.atom "!="
55 :     val op_gte = Atom.atom ">="
56 :     val op_gt = Atom.atom ">"
57 :     *)
58 : jhr 68 ]
59 :    
60 :     (* non-overloaded operators, etc. *)
61 :     val basis = [
62 :     (* operators *)
63 : jhr 63 (N.op_at, all([NK, NK, SK],
64 :     fn [k, d, dd] => let
65 :     val k = Ty.NatVar k
66 :     val d = Ty.NatVar d
67 :     val dd = Ty.ShapeVar dd
68 :     in
69 : jhr 68 [field(k, d, dd), tensor[d]] --> Ty.T_Tensor dd
70 :     end)),
71 :     (N.op_at, all([NK, NK, SK],
72 :     fn [k, d, dd] => let
73 :     val k = Ty.NatVar k
74 :     val d = Ty.NatVar d
75 :     val dd = Ty.ShapeVar dd
76 :     in
77 : jhr 63 [field(k, d, dd), tensor[d]]
78 :     --> field(Ty.NatExp(k, ~1), d, Ty.ShapeExt(dd, d))
79 :     end)),
80 :     (N.op_norm, all([SK],
81 :     fn [dd] => [Ty.T_Tensor(Ty.ShapeVar dd)] --> Ty.realTy)),
82 :     (* functions *)
83 :     (N.fn_CL, ty([tensor[N3, N3]] --> Ty.vec3Ty)),
84 :     (N.fn_convolve, all([NK, NK, SK],
85 :     fn [k, d, dd] => let
86 :     val k = Ty.NatVar k
87 :     val d = Ty.NatVar d
88 :     val dd = Ty.ShapeVar dd
89 :     in
90 :     [Ty.T_Kernel k, Ty.T_Image{dim=d, shape=dd}]
91 :     --> field(k, d, dd)
92 :     end)),
93 :     (N.fn_cos, ty([Ty.realTy] --> Ty.realTy)),
94 :     (N.fn_dot, allNK(fn tv => [tensor[Ty.NatVar tv]]
95 :     --> tensor[Ty.NatVar tv])),
96 : jhr 68 (N.fn_inside, all([NK, NK, SK],
97 :     fn [k, d, dd] => let
98 :     val k = Ty.NatVar k
99 :     val d = Ty.NatVar d
100 :     val dd = Ty.ShapeVar dd
101 :     in
102 :     [Ty.T_Tensor(Ty.Shape[d]), field(k, d, dd)]
103 :     --> Ty.T_Bool
104 :     end)),
105 : jhr 63 (N.fn_load, all([NK, SK],
106 :     fn [d, dd] => let
107 :     val d = Ty.NatVar d
108 :     val dd = Ty.ShapeVar dd
109 :     in
110 :     [Ty.T_String] --> Ty.T_Image{dim=d, shape=dd}
111 :     end)),
112 :     (N.fn_pow, ty([Ty.realTy, Ty.realTy] --> Ty.realTy)),
113 :     (*
114 :     val fn_principleEvec = Atom.atom "principleEvec"
115 :     *)
116 :     (N.fn_sin, ty([Ty.realTy] --> Ty.realTy)),
117 :     (* kernels *)
118 :     (N.kn_bspln3, ty(Ty.T_Kernel(Ty.NatConst 2))),
119 :     (N.kn_tent, ty(Ty.T_Kernel(Ty.NatConst 0)))
120 :     ]
121 :    
122 :     end (* local *)
123 : jhr 47 end

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