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
|
module Tuple2 = Tools.Tuple2
let u = UTF8.from_utf8string
type t =
| Basic of ScTypes.types (** A direct type *)
| Formula of formula (** A formula *)
| Undefined (** The content is not defined *)
and formula =
| Expression of ScTypes.expression (** 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
Basic (
try Lexing.from_string content'
|> ExpressionParser.content ExpressionLexer.read
with _ -> ScTypes.Str (UTF8.from_utf8string content')
)
)
) else (
(* If the string in empty, build an undefined value *)
Undefined
)
end
let load_expr expr = expr
(** Extract the parameters to give to a function.
return an Error if one of them is an error
*)
let eval expr sources = begin
let eval_exp f = Evaluator.repr sources f in
begin try match expr with
| Basic value -> ScTypes.Result value
| Formula (Expression f) -> ScTypes.Result (eval_exp f)
| Formula (Error (i, s)) -> ScTypes.Error ScTypes.Error
| Undefined -> ScTypes.Error Not_found
with ex -> ScTypes.Error ex
end
end
let collect_sources expr = begin
let rec collect refs = function
| ScTypes.Ref r ->
begin match ScTypes.Refs.collect r with
| ScTypes.Refs.Single r -> Cell.Set.add r refs
| ScTypes.Refs.Array1 a1 ->
List.fold_left (fun set elt -> Cell.Set.add elt set) refs a1
| ScTypes.Refs.Array2 a2 ->
List.fold_left (List.fold_left (fun set elt -> Cell.Set.add elt set)) refs a2
end
| ScTypes.Call (ident, params) -> List.fold_left collect refs params
| ScTypes.Expression f -> collect refs f
| _ -> refs
in match expr with
| Formula (Expression f) -> collect Cell.Set.empty f
| _ -> Cell.Set.empty
end
let show e =
let buffer = UTF8.Buffer.create 16 in
begin match e with
| Formula (Expression f) ->
UTF8.Buffer.add_char buffer '=';
ScTypes.show_expr buffer f
| Basic b -> ScTypes.Type.show buffer b
| Formula (Error (i,s)) -> UTF8.Buffer.add_string buffer s
| Undefined -> ()
end;
UTF8.Buffer.contents buffer
let shift vector =
let rec shift_exp: ScTypes.expression -> ScTypes.expression = function
| ScTypes.Value v -> ScTypes.Value v
| ScTypes.Call (ident, params) -> ScTypes.Call (ident, List.map shift_exp params)
| ScTypes.Ref r -> ScTypes.Ref (ScTypes.Refs.shift vector r)
| ScTypes.Expression expr -> ScTypes.Expression (shift_exp expr)
in function
| Formula (Expression f) -> Formula (Expression (shift_exp f))
| other -> other
let (=) t1 t2 = match t1, t2 with
| Basic b1, Basic b2 -> ScTypes.Type.(=) b1 b2
| o1, o2 -> Pervasives.(=) o1 o2
|
