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
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
|
(*
This file is part of licht.
licht is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
licht is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with licht. If not, see <http://www.gnu.org/licenses/>.
*)
module Tuple2 = Tools.Tuple2
let u = UTF8.from_utf8string
type t =
| Basic: 'a ScTypes.Type.t -> t (** A direct type *)
| Formula: formula -> t (** A formula *)
| Undefined: t (** The content is not defined *)
and formula =
| Expression of ScTypes.Expr.t (** A valid expression *)
| Error of int * UTF8.t (** When the expression cannot be parsed *)
let is_defined = function
| Undefined -> false
| _ -> true
let load content = begin
let content = UTF8.to_utf8string content in
if String.length content > 0 then (
if content.[0] = '=' then (
(* If the string start with a '=', load it as a formula *)
Formula (
try
Expression (
Lexing.from_string content
|> ExpressionParser.value ExpressionLexer.read)
with _ -> Error (1, UTF8.from_utf8string content)
)
) else (
(* First try to load the data with basic types, and fallback with string *)
let content' =
try String.sub content 0 (String.index content '\000')
with Not_found -> content in
try
let ScTypes.Result.Ok r =
ExpressionParser.content ExpressionLexer.read
@@ Lexing.from_string content' in
Basic r
with _ -> Basic (ScTypes.Type.string (UTF8.from_utf8string content'))
)
) else (
(* If the string in empty, build an undefined value *)
Undefined
)
end
let load_expr expr = expr
module EvalExpr = ScTypes.Expr.Eval(Evaluate)
(** Extract the parameters to give to a function.
return an Error if one of them is an error
*)
let eval expr catalog mapper = begin
begin try match expr with
| Basic value -> ScTypes.Result.Ok value
| Formula (Expression e) -> EvalExpr.eval e (catalog, mapper)
| Formula (Error (i, s)) -> ScTypes.Result.Error ScTypes.Error
| Undefined -> ScTypes.Result.Error Not_found
with ex -> ScTypes.Result.Error ex
end
end
module EvalSources = ScTypes.Expr.Eval(Collect_sources)
let collect_sources = begin function
| Formula (Expression f) -> EvalSources.eval f () Cell.Set.empty
| _ -> Cell.Set.empty
end
module Printer = ScTypes.Expr.Eval(Show_expr.Show_Expr(Show_ref)(Show_type))
(** Inherit the default representation, but print the float with all decimals *)
module LongPrinter = ScTypes.Type.Eval(struct
include Show_type
let num n buffer =
if DataType.Num.is_integer n then
DataType.Num.to_int n
|> string_of_int
|> UTF8.from_utf8string
|> UTF8.Buffer.add_string buffer
else
let f = DataType.Num.to_float n
and to_b = UTF8.Format.formatter_of_buffer buffer in
ignore @@ UTF8.Format.fprintf to_b "%f" f;
Format.pp_print_flush to_b ()
end)
let show e =
let buffer = UTF8.Buffer.create 16 in
begin match e with
| Formula (Expression f) ->
UTF8.Buffer.add_char buffer '=';
Printer.eval f () buffer
| Basic b -> LongPrinter.eval b buffer
| Formula (Error (i,s)) -> UTF8.Buffer.add_string buffer s
| Undefined -> ()
end;
UTF8.Buffer.contents buffer
let shift vector = function
| Formula (Expression f) -> Formula (Expression (ScTypes.Expr.shift_exp vector f))
| other -> other
let (=) t1 t2 = match t1, t2 with
| Basic b1, Basic b2 -> ScTypes.Type.(=) b1 b2
| o1, o2 -> Pervasives.(=) o1 o2
|
