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
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
(* SPDX-License-Identifier: AGPL-3.0-or-later *)
(* Copyright © 2021-2024 OCamlPro *)
(* Written by the Owi programmers *)
module type S = sig
type vbool
type int32
type int64
type float32
type float64
type ref_value
type value
type t = value list
val empty : t
val pp : Fmt.formatter -> t -> unit
(** pop operations *)
val drop : t -> t
val drop_n : 'a list -> int -> 'a list
val pop : t -> value * t
val pop_n : t -> int -> t * t
val keep : t -> int -> t
val pop_bool : t -> vbool * t
val pop_i32 : t -> int32 * t
val pop2_i32 : t -> (int32 * int32) * t
val pop_i64 : t -> int64 * t
val pop2_i64 : t -> (int64 * int64) * t
val pop_f32 : t -> float32 * t
val pop2_f32 : t -> (float32 * float32) * t
val pop_f64 : t -> float64 * t
val pop2_f64 : t -> (float64 * float64) * t
val pop_ref : t -> value * t
val pop_as_ref : t -> ref_value * t
(** push operations *)
val push : t -> value -> t
val push_bool : t -> vbool -> t
val push_i32 : t -> int32 -> t
val push_const_i32 : t -> Int32.t -> t
val push_i32_of_int : t -> int -> t
val push_i64 : t -> int64 -> t
val push_const_i64 : t -> Int64.t -> t
val push_f32 : t -> float32 -> t
val push_const_f32 : t -> Float32.t -> t
val push_f64 : t -> float64 -> t
val push_const_f64 : t -> Float64.t -> t
val push_as_externref : t -> 'b Type.Id.t -> 'b -> t
val push_array : t -> unit Array.t -> t
end
module Make (V : Value_intf.T) :
S
with type value := V.t
and type vbool := V.vbool
and type int32 := V.int32
and type int64 := V.int64
and type float32 := V.float32
and type float64 := V.float64
and type ref_value := V.ref_value = struct
open V
type t = V.t list
exception Empty
let empty = []
let push s v = v :: s
let push_bool s b = push s (I32 (V.Bool.int32 b))
let push_const_i32 s i = push s (I32 (V.const_i32 i))
let push_i32 s i = push s (I32 i)
let push_i32_of_int s i = push_const_i32 s (Int32.of_int i)
let push_const_i64 s i = push s (I64 (V.const_i64 i))
let push_i64 s i = push s (I64 i)
let push_const_f32 s f = push s (F32 (V.const_f32 f))
let push_f32 s f = push s (F32 f)
let push_const_f64 s f = push s (F64 (V.const_f64 f))
let push_f64 s f = push s (F64 f)
let push_as_externref s ty v = push s (V.ref_externref ty v)
let push_array _ _ = assert false
let pp fmt (s : t) =
Fmt.list ~sep:(fun fmt () -> Fmt.string fmt " ; ") V.pp fmt s
let pop = function [] -> raise Empty | hd :: tl -> (hd, tl)
let drop = function [] -> raise Empty | _hd :: tl -> tl
let pop_i32 s =
let hd, tl = pop s in
match hd with I32 n -> (n, tl) | _ -> assert false
let pop2_i32 s =
let n2, s = pop s in
let n1, tl = pop s in
match (n1, n2) with I32 n1, I32 n2 -> ((n1, n2), tl) | _ -> assert false
let pop_i64 s =
let hd, tl = pop s in
match hd with I64 n -> (n, tl) | _ -> assert false
let pop2_i64 s =
let n2, s = pop s in
let n1, tl = pop s in
match (n1, n2) with I64 n1, I64 n2 -> ((n1, n2), tl) | _ -> assert false
let pop_f32 s =
let hd, tl = pop s in
match hd with F32 f -> (f, tl) | _ -> assert false
let pop2_f32 s =
let n2, s = pop s in
let n1, tl = pop s in
match (n1, n2) with F32 n1, F32 n2 -> ((n1, n2), tl) | _ -> assert false
let pop_f64 s =
let hd, tl = pop s in
match hd with F64 f -> (f, tl) | _ -> assert false
let pop2_f64 s =
let n2, s = pop s in
let n1, tl = pop s in
match (n1, n2) with F64 n1, F64 n2 -> ((n1, n2), tl) | _ -> assert false
let pop_ref s =
let hd, tl = pop s in
match hd with Ref _ -> (hd, tl) | _ -> assert false
let pop_as_ref s =
let hd, tl = pop s in
match hd with Ref hd -> (hd, tl) | _ -> assert false
let pop_bool s =
let hd, tl = pop s in
match hd with I32 n -> (V.I32.to_bool n, tl) | _ -> assert false
let pop_n s n =
(List.filteri (fun i _hd -> i < n) s, List.filteri (fun i _hd -> i >= n) s)
let keep s n = List.filteri (fun i _hd -> i < n) s
let rec drop_n s n =
if n = 0 then s
else match s with [] -> assert false | _ :: tl -> drop_n tl (n - 1)
end