1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
|
open Catalog
let u = UTF8.from_utf8string
let eq = u"="
let neq = u"<>"
let lt = u"<"
let le = u"<="
let gt = u">"
let ge = u">="
let add = u"+"
let mul = u"*"
let pow = u"^"
let div = u"/"
let sub = u"-"
let sum = u"sum"
let () =
(** Comparaison *)
let compare = function
| ScTypes.Num (n1,_)::ScTypes.Num (n2,_)::[] -> Num.compare_num n1 n2
| ScTypes.Date n1::ScTypes.Date n2::[] -> Num.compare_num n1 n2
| ScTypes.Str s1::ScTypes.Str s2::[] -> UTF8.compare s1 s2
| ScTypes.Bool b1::ScTypes.Bool b2::[] -> Pervasives.compare b1 b2
| ScTypes.List l1::ScTypes.List l2::[] -> Pervasives.compare l1 l2
| t1::t2::[] -> Pervasives.compare t1 t2
| _ -> raise ScTypes.Error
in
register eq (fun args -> ScTypes.Bool ((compare args) = 0));
register neq (fun args -> ScTypes.Bool ((compare args) != 0));
register lt (fun args -> ScTypes.Bool ((compare args) < 0));
register le (fun args -> ScTypes.Bool ((compare args) <= 0));
register gt (fun args -> ScTypes.Bool ((compare args) > 0));
register ge (fun args -> ScTypes.Bool ((compare args) >= 0));
(** Basic *)
register sum (fun args ->
let rec sum value = function
| ScTypes.Undefined -> value
| ScTypes.Num (n,_) -> Num.add_num value n
| ScTypes.Date n -> Num.add_num value n
| ScTypes.List l -> List.fold_left sum value l
| _ -> raise ScTypes.Error in
ScTypes.Num (List.fold_left sum (Num.num_of_int 0) args, None)
);
let rec operation f = begin function
| ScTypes.Undefined , x -> operation f (ScTypes.Num (Num.num_of_int 0, None), x)
| x, ScTypes.Undefined -> operation f (x, ScTypes.Num (Num.num_of_int 0, None))
| ScTypes.Num (n1,_), ScTypes.Num (n2,_) -> ScTypes.Num (f n1 n2, None)
| ScTypes.Date n1, ScTypes.Date n2 -> ScTypes.Date (f n1 n2)
| ScTypes.Date n1, ScTypes.Num (n2,_) -> ScTypes.Date (f n1 n2)
| ScTypes.Num (n1,_), ScTypes.Date n2 -> ScTypes.Date (f n1 n2)
| _ -> raise ScTypes.Error
end
in
register add (function
| t1::t2::[] -> (operation Num.add_num) (t1, t2)
| _ -> raise ScTypes.Error
);
register mul (function
| t1::t2::[] -> (operation Num.mult_num) (t1, t2)
| _ -> raise ScTypes.Error
);
register div (function
| t1::t2::[] -> (operation Num.div_num) (t1, t2)
| _ -> raise ScTypes.Error
);
register sub (function
| t1::t2::[] -> (operation Num.sub_num) (t1, t2)
| _ -> raise ScTypes.Error
);
register pow (function
| t1::t2::[] -> (operation Num.power_num) (t1, t2)
| _ -> raise ScTypes.Error
);
(** Binary *)
register (u"true") (function
| [] -> ScTypes.Bool true
| _ -> raise ScTypes.Error
);
register (u"false") (function
| [] -> ScTypes.Bool false
| _ -> raise ScTypes.Error
);
register (u"not") (function
| (ScTypes.Bool x):: [] -> ScTypes.Bool (not x)
| _ -> raise ScTypes.Error
);
register (u"date") (function
| (ScTypes.Num (x,_)):: [] -> ScTypes.Date x
| _ -> raise ScTypes.Error
);
register (u"num") (function
| (ScTypes.Date x):: [] -> ScTypes.Num (x, None)
| _ -> raise ScTypes.Error
);
|
