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
|
(*
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 =
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
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 =
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
module EvalSources = ScTypes.Expr.Eval (Collect_sources)
let collect_sources = function
| Formula (Expression f) -> EvalSources.eval f Cell.Set.empty
| _ -> Cell.Set.empty
module Shifter = ScTypes.Expr.Eval (Shift_expr)
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
(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 -> ());
UTF8.Buffer.contents buffer
let shift vector = function
| Formula (Expression f) -> Formula (Expression (Shifter.eval f vector))
| other -> other
let ( = ) t1 t2 =
match (t1, t2) with
| Basic b1, Basic b2 -> ScTypes.Type.( = ) b1 b2
| o1, o2 -> Stdlib.( = ) o1 o2
|
