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
|
(** Build a module with the result from another one module *)
open StdLabels
module S = Qsp_syntax.S
module T = Qsp_syntax.T
(** Make a module lazy *)
module Lazier (E : S.Expression) :
S.Expression with type t' = E.t' Lazy.t and type t = E.t Lazy.t = struct
type t = E.t Lazy.t
type t' = E.t' Lazy.t
let v : E.t Lazy.t -> E.t' Lazy.t = Lazy.map E.v
let integer : S.pos -> string -> t = fun pos i -> lazy (E.integer pos i)
let ident : (S.pos, t) S.variable -> t =
fun { pos; name : string; index : t option } ->
lazy (E.ident { pos; name; index = Option.map Lazy.force index })
let literal : S.pos -> t T.literal list -> t =
fun pos litts ->
lazy
(let e_litts = List.map litts ~f:(T.map_litteral ~f:Lazy.force) in
E.literal pos e_litts)
let function_ : S.pos -> T.function_ -> t list -> t =
fun pos f e ->
lazy
(let e' = List.map ~f:Lazy.force e in
E.function_ pos f e')
let uoperator : S.pos -> T.uoperator -> t -> t =
fun pos op t ->
let t' = lazy (E.uoperator pos op (Lazy.force t)) in
t'
let boperator : S.pos -> T.boperator -> t -> t -> t =
fun pos op t1 t2 ->
let t' = lazy (E.boperator pos op (Lazy.force t1) (Lazy.force t2)) in
t'
end
(** Build an expression module with the result from another expression. The
signature of the fuctions is a bit different, as they all receive the
result from the previous evaluated element in argument. *)
module Expression (E : S.Expression) = struct
module type SIG = sig
type t
type t'
(* Override the type [t] in the definition of all the functions. The
signatures differs a bit from the standard signature as they get the
result from E.t in last argument *)
val ident : (S.pos, E.t' Lazy.t * t) S.variable -> E.t' Lazy.t -> t
val integer : S.pos -> string -> E.t' Lazy.t -> t
val literal : S.pos -> (E.t' Lazy.t * t) T.literal list -> E.t' Lazy.t -> t
val function_ :
S.pos -> T.function_ -> (E.t' Lazy.t * t) list -> E.t' Lazy.t -> t
val uoperator : S.pos -> T.uoperator -> E.t' Lazy.t * t -> E.t' Lazy.t -> t
val boperator :
S.pos ->
T.boperator ->
E.t' Lazy.t * t ->
E.t' Lazy.t * t ->
E.t' Lazy.t ->
t
val v : E.t' Lazy.t * t -> t'
(** Convert from the internal representation to the external one. *)
end
(* Create a lazy version of the module *)
module E = Lazier (E)
module Make (M : SIG) : S.Expression with type t' = M.t' = struct
type t = E.t * M.t
type t' = M.t'
let v' : E.t -> E.t' = E.v
let v : t -> t' = fun (type_of, v) -> M.v (v' type_of, v)
let ident : (S.pos, t) S.variable -> t =
fun { pos; name : string; index : t option } ->
let t' = E.ident { pos; name; index = Option.map fst index } in
let index' = Option.map (fun (e, m) -> (v' e, m)) index in
(t', M.ident { pos; name; index = index' } (v' t'))
let integer : S.pos -> string -> t =
fun pos i ->
let t' = E.integer pos i in
(t', M.integer pos i (v' t'))
let literal : S.pos -> t T.literal list -> t =
fun pos litts ->
let litts' =
List.map litts ~f:(T.map_litteral ~f:(fun (e, m) -> (v' e, m)))
in
let t' =
let e_litts = List.map litts ~f:(T.map_litteral ~f:fst) in
E.literal pos e_litts
in
(t', M.literal pos litts' (v' t'))
let function_ : S.pos -> T.function_ -> t list -> t =
fun pos f expressions ->
let e = List.map ~f:fst expressions
and expressions' = List.map ~f:(fun (e, m) -> (v' e, m)) expressions in
let t' = E.function_ pos f e in
(t', M.function_ pos f expressions' (v' t'))
let uoperator : S.pos -> T.uoperator -> t -> t =
fun pos op (t, expr) ->
let t' = E.uoperator pos op t in
(t', M.uoperator pos op (v' t, expr) (v' t'))
let boperator : S.pos -> T.boperator -> t -> t -> t =
fun pos op (t1, expr1) (t2, expr2) ->
let t' = E.boperator pos op t1 t2 in
(t', M.boperator pos op (v' t1, expr1) (v' t2, expr2) (v' t'))
end
end
|
