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
(* SPDX-License-Identifier: AGPL-3.0-or-later *)
(* Copyright © 2021-2024 OCamlPro *)
(* Written by the Owi programmers *)
open Types
module type Value_types = sig
type int32
type int64
type float32
type float64
type bool
end
module type Monad_type = sig
type 'a t
end
module type Memory_type = sig
type t
end
module type T_Extern_func = sig
type int32
type int64
type float32
type float64
type 'a m
type memory
type _ telt =
| I32 : int32 telt
| I64 : int64 telt
| F32 : float32 telt
| F64 : float64 telt
| Externref : 'a Type.Id.t -> 'a telt
type _ rtype =
| R0 : unit rtype
| R1 : 'a telt -> 'a rtype
| R2 : 'a telt * 'b telt -> ('a * 'b) rtype
| R3 : 'a telt * 'b telt * 'c telt -> ('a * 'b * 'c) rtype
| R4 : 'a telt * 'b telt * 'c telt * 'd telt -> ('a * 'b * 'c * 'd) rtype
type (_, _) atype =
| Mem : ('b, 'r) atype -> (memory -> 'b, 'r) atype
| UArg : ('b, 'r) atype -> (unit -> 'b, 'r) atype
| Arg : 'a telt * ('b, 'r) atype -> ('a -> 'b, 'r) atype
| NArg : string * 'a telt * ('b, 'r) atype -> ('a -> 'b, 'r) atype
| Res : ('r, 'r) atype
type _ func_type = Func : ('f, 'r m) atype * 'r rtype -> 'f func_type
type extern_func = Extern_func : 'a func_type * 'a -> extern_func
(* val extern_type : _ func_type -> Simplified.func_type *)
val extern_type : extern_func -> binary Types.func_type
end
type t =
| WASM of int * binary func * Env_id.t
| Extern of Func_id.t
module type T = sig
include T_Extern_func
type nonrec t = t
(* val typ : ('env, extern_func) t -> Simplified.func_type *)
val wasm : binary func -> Env_id.t -> t
end
module Make_extern_func
(V : Value_types)
(M : Monad_type)
(Memory : Memory_type) : sig
type nonrec t = t
val fresh : unit -> int
val wasm : Types.binary Types.func -> Env_id.t -> t
include
T_Extern_func
with type int32 := V.int32
and type int64 := V.int64
and type float32 := V.float32
and type float64 := V.float64
and type 'a m := 'a M.t
and type memory := Memory.t
end = struct
type 'a m = 'a M.t
type memory = Memory.t
type _ telt =
| I32 : V.int32 telt
| I64 : V.int64 telt
| F32 : V.float32 telt
| F64 : V.float64 telt
| Externref : 'a Type.Id.t -> 'a telt
type _ rtype =
| R0 : unit rtype
| R1 : 'a telt -> 'a rtype
| R2 : 'a telt * 'b telt -> ('a * 'b) rtype
| R3 : 'a telt * 'b telt * 'c telt -> ('a * 'b * 'c) rtype
| R4 : 'a telt * 'b telt * 'c telt * 'd telt -> ('a * 'b * 'c * 'd) rtype
type (_, _) atype =
| Mem : ('b, 'r) atype -> (memory -> 'b, 'r) atype
| UArg : ('b, 'r) atype -> (unit -> 'b, 'r) atype
| Arg : 'a telt * ('b, 'r) atype -> ('a -> 'b, 'r) atype
| NArg : string * 'a telt * ('b, 'r) atype -> ('a -> 'b, 'r) atype
| Res : ('r, 'r) atype
type _ func_type = Func : ('f, 'r m) atype * 'r rtype -> 'f func_type
type extern_func = Extern_func : 'a func_type * 'a -> extern_func
let elt_type (type t) (e : t telt) : binary val_type =
match e with
| I32 -> Num_type I32
| I64 -> Num_type I64
| F32 -> Num_type F32
| F64 -> Num_type F64
| Externref _ -> Ref_type (Null, Extern_ht)
let res_type (type t) (r : t rtype) : binary result_type =
match r with
| R0 -> []
| R1 a -> [ elt_type a ]
| R2 (a, b) -> [ elt_type a; elt_type b ]
| R3 (a, b, c) -> [ elt_type a; elt_type b; elt_type c ]
| R4 (a, b, c, d) -> [ elt_type a; elt_type b; elt_type c; elt_type d ]
let rec arg_type : type t r. (t, r) atype -> binary param_type = function
| Mem tl -> arg_type tl
| UArg tl -> arg_type tl
| Arg (hd, tl) -> (None, elt_type hd) :: arg_type tl
| NArg (name, hd, tl) -> (Some name, elt_type hd) :: arg_type tl
| Res -> []
let extern_type (Extern_func (Func (arg, res), _)) : binary Types.func_type =
(arg_type arg, res_type res)
type nonrec t = t
let fresh =
let r = ref ~-1 in
fun () ->
incr r;
!r
let wasm func env : t = WASM (fresh (), func, env)
end