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
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
(* SPDX-License-Identifier: AGPL-3.0-or-later *)
(* Copyright © 2021-2026 OCamlPro *)
(* Written by the Owi programmers *)

let i32 =
  [| (************************* limit cases and magic *************)
     0l
   ; 1l
   ; 17l
   ; 42l
   ; 666l
   ; 123456l
   ; Int32.min_int
   ; Int32.max_int
   ; (************************* 2^n *******************************)
     2l
   ; 4l
   ; 8l
   ; 16l
   ; 32l
   ; 64l
   ; 128l
   ; 256l
   ; 512l
   ; 1024l
   ; 2048l
   ; 4096l
   ; 8192l
   ; 16384l
   ; 32768l
   ; 65536l
   ; 131072l
   ; 262144l
   ; 524288l
   ; 1048576l
   ; 2097152l
   ; 4194304l
   ; 8388608l
   ; 16777216l
   ; 33554432l
   ; 67108864l
   ; 134217728l
   ; 268435456l
   ; 536870912l
   ; 1073741824l
   ; 2147483648l
  |]

let i64 =
  [| (************************* limit cases and magic *************)
     0L
   ; 1L
   ; 17L
   ; 42L
   ; 666L
   ; 123456L
   ; Int64.min_int
   ; Int64.max_int
   ; (************************* 2^n *******************************)
     2L
   ; 4L
   ; 8L
   ; 16L
   ; 32L
   ; 64L
   ; 128L
   ; 256L
   ; 512L
   ; 1024L
   ; 2048L
   ; 4096L
   ; 8192L
   ; 16384L
   ; 32768L
   ; 65536L
   ; 131072L
   ; 262144L
   ; 524288L
   ; 1048576L
   ; 2097152L
   ; 4194304L
   ; 8388608L
   ; 16777216L
   ; 33554432L
   ; 67108864L
   ; 134217728L
   ; 268435456L
   ; 536870912L
   ; 1073741824L
   ; 2147483648L
   ; 4294967296L
   ; 8589934592L
   ; 17179869184L
   ; 34359738368L
   ; 68719476736L
   ; 137438953472L
   ; 274877906944L
   ; 549755813888L
   ; 1099511627776L
   ; 2199023255552L
   ; 4398046511104L
   ; 8796093022208L
   ; 17592186044416L
   ; 35184372088832L
   ; 70368744177664L
   ; 140737488355328L
   ; 281474976710656L
   ; 562949953421312L
   ; 1125899906842624L
   ; 2251799813685248L
   ; 4503599627370496L
   ; 9007199254740992L
   ; 18014398509481984L
   ; 36028797018963968L
   ; 72057594037927936L
   ; 144115188075855872L
   ; 288230376151711744L
   ; 576460752303423488L
   ; 1152921504606846976L
   ; 2305843009213693952L
   ; 4611686018427387904L
  |]

let f32 =
  (* TODO: avoid going through 64bits floats *)
  Array.map Concrete_f32.of_float
    [| (************************* limit cases and magic ***********)
       0.
     ; -0.
     ; Float.one
     ; Float.infinity
     ; Float.nan
     ; Float.signaling_nan
     ; Float.quiet_nan
     ; Float.pi
     ; Float.max_float
     ; Float.min_float
     ; Float.epsilon
    |]

let f64 =
  Array.map Concrete_f64.of_float
    [| (************************* limit cases and magic ***********)
       0.
     ; -0.
     ; Float.one
     ; Float.infinity
     ; Float.nan
     ; Float.signaling_nan
     ; Float.quiet_nan
     ; Float.pi
     ; Float.max_float
     ; Float.min_float
     ; Float.epsilon
    |]

module Collect = struct
  type t =
    { i32 : Concrete_i32.t list
    ; i64 : Concrete_i64.t list
    ; f32 : Concrete_f32.t list
    ; f64 : Concrete_f64.t list
    }

  let empty = { i32 = []; i64 = []; f32 = []; f64 = [] }

  let from_simple_instruction collect (instr : Binary.simple_instruction) =
    match instr with
    | Binary.I32 (Const n) -> { collect with i32 = n :: collect.i32 }
    | I64 (Const n) -> { collect with i64 = n :: collect.i64 }
    | F32 (Const n) -> { collect with f32 = n :: collect.f32 }
    | F64 (Const n) -> { collect with f64 = n :: collect.f64 }
    | I32 _ | I64 _ | F32 _ | F64 _ | V128 _ | I8x16 _ | I16x8 _ | I32x4 _
    | I64x2 _ | Ref _ | Local _ | Global _ | Table _ | Elem _ | Memory _
    | Data _ | Drop | Select _ | Nop | Unreachable | Any_convert_extern
    | Extern_convert_any | F32x4 _ | F64x2 _ | I31 _ | Struct _ | Array _ ->
      collect

  let rec from_instr collect (instr : Binary.instr Annotated.t) =
    match instr.Annotated.raw with
    | Simple instr -> from_simple_instruction collect instr
    | Block (_, _, e) | Loop (_, _, e) -> from_expr collect e
    | If_else (_, _, e1, e2) ->
      let collect = from_expr collect e1 in
      from_expr collect e2
    | Br _ | Br_if _ | Br_table _ | Br_on_null _ | Br_on_non_null _ | Return
    | Return_call _ | Return_call_ref _ | Return_call_indirect _ | Call _
    | Call_indirect _ | Call_ref _
    | Br_on_cast (_, _, _)
    | Br_on_cast_fail (_, _, _) ->
      collect

  and from_expr collect expr =
    List.fold_left from_instr collect expr.Annotated.raw

  let from_global _globals collect = (* TODO *) collect

  let from_table _tables collect = (* TODO *) collect

  let from_mem _memories collect = (* TODO *) collect

  let from_func funcs collect =
    Array.fold_left
      (fun collect -> function
        | Origin.Imported _ -> (* tODO *) collect
        | Local { Binary.Func.body; type_f = _; locals = _; id = _ } ->
          from_expr collect body )
      collect funcs

  let from_elem _elem collect = (* TODO *) collect

  let from_data _data collect = (* TODO *) collect

  let from_module
    { Binary.Module.id = _
    ; types = _
    ; global
    ; table
    ; mem
    ; func
    ; tag = _
    ; elem
    ; data
    ; exports = _
    ; start = _
    ; custom = _
    ; type_defs = _
    } =
    empty |> from_global global |> from_table table |> from_mem mem
    |> from_func func |> from_elem elem |> from_data data
end