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

Parent Directory | 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