blob: fb056d6820373383cfa0a8ebd00e076ea463e380 (
plain)
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
|
open StdLabels
module Expression : S.Expression with type t' = Report.t list = struct
type t = Report.t list
type t' = t
let v : t -> t' = Fun.id
(** Identify the expressions reprented as string. That’s here that the report
are added.
All the rest of the module only push thoses warning to the top level. *)
let literal : S.pos -> t T.literal list -> t =
fun pos content ->
match content with
| [ T.Expression expr; T.Text "" ] ->
ignore expr;
let msg = Report.debug pos "This expression can be simplified" in
[ msg ]
| _ -> []
let ident : (S.pos, t) S.variable -> t =
fun { pos; name : string; index : t option } ->
ignore pos;
ignore name;
match index with None -> [] | Some v -> v
let integer : S.pos -> string -> t = fun _ _ -> []
let function_ : S.pos -> T.function_ -> t list -> t =
fun _ _ expressions -> List.concat expressions
let uoperator : S.pos -> T.uoperator -> t -> t = fun _ _ expr1 -> expr1
let boperator : S.pos -> T.boperator -> t -> t -> t =
fun _ _ expr1 expr2 -> expr1 @ expr2
end
module Instruction :
S.Instruction with type t' = Report.t list and type expression = Expression.t' =
struct
type t = Report.t list
(** Internal type used in the evaluation *)
type t' = t
let v : t -> t' = Fun.id
type expression = Expression.t'
let call : S.pos -> T.keywords -> expression list -> t =
fun pos k exprs ->
ignore pos;
ignore k;
List.concat exprs
let location : S.pos -> string -> t = fun _ _ -> []
let comment : S.pos -> t = fun _ -> []
let expression : expression -> t = Fun.id
let act : S.pos -> label:expression -> t list -> t =
fun pos ~label instructions ->
ignore pos;
List.concat (label :: instructions)
let fold_clause : (expression, t) S.clause -> t =
fun (_pos1, expression, ts) -> List.concat (expression :: ts)
let if_ :
S.pos ->
(expression, t) S.clause ->
elifs:(expression, t) S.clause list ->
else_:(S.pos * t list) option ->
t =
fun pos clause ~elifs ~else_ ->
ignore pos;
let init =
match else_ with
| None -> fold_clause clause
| Some (_, ts) -> List.rev_append (fold_clause clause) (List.concat ts)
in
List.fold_left elifs ~init ~f:(fun t clause ->
List.rev_append (fold_clause clause) t)
let assign :
S.pos ->
(S.pos, expression) S.variable ->
T.assignation_operator ->
expression ->
t =
fun pos variable op expression ->
ignore pos;
ignore op;
match variable.index with
| None -> expression
| Some v -> List.rev_append v expression
end
module Location = struct
type t = unit
type instruction = Instruction.t'
let location : S.pos -> instruction list -> t * Report.t list =
fun pos intructions ->
ignore pos;
((), List.concat intructions)
end
|
