diff --git a/api/owi/Owi/Binary/index.html b/api/owi/Owi/Binary/index.html index 569f2af16..82b86ca7c 100644 --- a/api/owi/Owi/Binary/index.html +++ b/api/owi/Owi/Binary/index.html @@ -1,4 +1,4 @@ -Binary (owi.Owi.Binary)

Module Owi.Binary

type export = {
  1. name : string;
  2. id : int;
}

named export

type exports = {
  1. global : export list;
  2. mem : export list;
  3. table : export list;
  4. func : export list;
}

named exports of a module

type global = {
  1. typ : Types.binary Types.global_type;
  2. init : Types.binary Types.expr;
  3. id : string option;
}
type data_mode =
  1. | Data_passive
  2. | Data_active of int option * Types.binary Types.expr
type data = {
  1. id : string option;
  2. init : string;
  3. mode : data_mode;
}
type elem_mode =
  1. | Elem_passive
  2. | Elem_active of int option * Types.binary Types.expr
  3. | Elem_declarative
type elem = {
  1. id : string option;
  2. typ : Types.binary Types.ref_type;
  3. init : Types.binary Types.expr list;
  4. mode : elem_mode;
}
type modul = {
  1. id : string option;
  2. global : (global, Types.binary Types.global_type) Runtime.t Named.t;
  3. table : (Types.binary Types.table, Types.binary Types.table_type) Runtime.t +Binary (owi.Owi.Binary)

    Module Owi.Binary

    type export = {
    1. name : string;
    2. id : int;
    }

    named export

    type exports = {
    1. global : export list;
    2. mem : export list;
    3. table : export list;
    4. func : export list;
    }

    named exports of a module

    type global = {
    1. typ : Types.binary Types.global_type;
    2. init : Types.binary Types.expr;
    3. id : string option;
    }
    type data_mode =
    1. | Data_passive
    2. | Data_active of int * Types.binary Types.expr
    type data = {
    1. id : string option;
    2. init : string;
    3. mode : data_mode;
    }
    type elem_mode =
    1. | Elem_passive
    2. | Elem_active of int option * Types.binary Types.expr
    3. | Elem_declarative
    type elem = {
    1. id : string option;
    2. typ : Types.binary Types.ref_type;
    3. init : Types.binary Types.expr list;
    4. mode : elem_mode;
    }
    val empty_modul : modul
    diff --git a/api/owi/Owi/Binary_encoder/index.html b/api/owi/Owi/Binary_encoder/index.html new file mode 100644 index 000000000..6c327d0d8 --- /dev/null +++ b/api/owi/Owi/Binary_encoder/index.html @@ -0,0 +1,7 @@ + +Binary_encoder (owi.Owi.Binary_encoder)

    Module Owi.Binary_encoder

    val convert : + Fpath.t -> + unsafe:bool -> + optimize:bool -> + Text.modul -> + (unit, Result.err) Prelude.result
    diff --git a/api/owi/Owi/Binary_parser/index.html b/api/owi/Owi/Binary_parser/index.html index 74f816e25..795cc46fc 100644 --- a/api/owi/Owi/Binary_parser/index.html +++ b/api/owi/Owi/Binary_parser/index.html @@ -1,2 +1,2 @@ -Binary_parser (owi.Owi.Binary_parser)

    Module Owi.Binary_parser

    val from_string : string -> Binary.modul Result.t
    val from_channel : Stdlib.in_channel -> Binary.modul Result.t
    val from_file : Fpath.t -> Binary.modul Result.t
    +Binary_parser (owi.Owi.Binary_parser)

    Module Owi.Binary_parser

    val from_string : string -> Binary.modul Result.t
    val from_channel : Prelude.in_channel -> Binary.modul Result.t
    val from_file : Fpath.t -> Binary.modul Result.t
    diff --git a/api/owi/Owi/Binary_types/index.html b/api/owi/Owi/Binary_types/index.html index ab47a1da1..2a3ea0404 100644 --- a/api/owi/Owi/Binary_types/index.html +++ b/api/owi/Owi/Binary_types/index.html @@ -1,8 +1,5 @@ -Binary_types (owi.Owi.Binary_types)

    Module Owi.Binary_types

    type tbl = (string, int) Stdlib.Hashtbl.t Stdlib.Option.t
    val equal_func_types : - Types.binary Types.func_type -> - Types.binary Types.func_type -> - bool
    val convert_val_type : +Binary_types (owi.Owi.Binary_types)

    Module Owi.Binary_types

    type tbl = (string, int) Prelude.Hashtbl.t Prelude.Option.t
    val convert_heap_type : diff --git a/api/owi/Owi/C_instrumentor/index.html b/api/owi/Owi/C_instrumentor/index.html deleted file mode 100644 index 9dce5938c..000000000 --- a/api/owi/Owi/C_instrumentor/index.html +++ /dev/null @@ -1,2 +0,0 @@ - -C_instrumentor (owi.Owi.C_instrumentor)

    Module Owi.C_instrumentor

    val instrument : Fpath.t -> Fpath.t list -> unit
    diff --git a/api/owi/Owi/C_share/index.html b/api/owi/Owi/C_share/index.html deleted file mode 100644 index 4b904361b..000000000 --- a/api/owi/Owi/C_share/index.html +++ /dev/null @@ -1,2 +0,0 @@ - -C_share (owi.Owi.C_share)

    Module Owi.C_share

    val py_location : Fpath.t list
    val bin_location : Fpath.t list
    val lib_location : Fpath.t list
    val libc : Fpath.t
    diff --git a/api/owi/Owi/C_share_site/Sites/index.html b/api/owi/Owi/C_share_site/Sites/index.html index c33206060..7efac848d 100644 --- a/api/owi/Owi/C_share_site/Sites/index.html +++ b/api/owi/Owi/C_share_site/Sites/index.html @@ -1,2 +1,2 @@ -Sites (owi.Owi.C_share_site.Sites)

    Module C_share_site.Sites

    val binc : Dune_site.Private_.Helpers.Location.t list
    val libc : Dune_site.Private_.Helpers.Location.t list
    val pyc : Dune_site.Private_.Helpers.Location.t list
    +Sites (owi.Owi.C_share_site.Sites)

    Module C_share_site.Sites

    val binc : Dune_site.Private_.Helpers.Location.t list
    val libc : Dune_site.Private_.Helpers.Location.t list
    diff --git a/api/owi/Owi/Choice_intf/module-type-Complete/index.html b/api/owi/Owi/Choice_intf/module-type-Complete/index.html index 8d07bdc91..5763e507f 100644 --- a/api/owi/Owi/Choice_intf/module-type-Complete/index.html +++ b/api/owi/Owi/Choice_intf/module-type-Complete/index.html @@ -1,2 +1,2 @@ -Complete (owi.Owi.Choice_intf.Complete)

    Module type Choice_intf.Complete

    include Base
    type 'a t
    val return : 'a -> 'a t
    val bind : 'a t -> ('a -> 'b t) -> 'b t
    val map : 'a t -> ('a -> 'b) -> 'b t
    val select : V.vbool -> bool t
    val select_i32 : V.int32 -> Int32.t t
    val trap : Trap.t -> 'a t
    val let* : 'a t -> ('a -> 'b t) -> 'b t
    val let+ : 'a t -> ('a -> 'b) -> 'b t
    type thread
    type 'a run_result
    val assertion : V.vbool -> unit t
    val with_thread : (thread -> 'b) -> 'b t
    val solver : Solver.solver t
    val thread : thread t
    val add_pc : V.vbool -> unit t
    val run : workers:int -> 'a t -> thread -> 'a run_result
    +Complete (owi.Owi.Choice_intf.Complete)

    Module type Choice_intf.Complete

    include Base
    type 'a t
    val return : 'a -> 'a t
    val bind : 'a t -> ('a -> 'b t) -> 'b t
    val map : 'a t -> ('a -> 'b) -> 'b t
    val select : V.vbool -> bool t
    val select_i32 : V.int32 -> Int32.t t
    val trap : Trap.t -> 'a t
    val let* : 'a t -> ('a -> 'b t) -> 'b t
    val let+ : 'a t -> ('a -> 'b) -> 'b t
    type thread
    type 'a run_result
    val assertion : V.vbool -> unit t
    val with_thread : (thread -> 'b) -> 'b t
    val solver : Solver.t t
    val thread : thread t
    val add_pc : V.vbool -> unit t
    val lift_mem : 'a Symbolic_choice_without_memory.t -> 'a t
    diff --git a/api/owi/Owi/Cmd_c/index.html b/api/owi/Owi/Cmd_c/index.html index 7bf28badb..c0ff52609 100644 --- a/api/owi/Owi/Cmd_c/index.html +++ b/api/owi/Owi/Cmd_c/index.html @@ -15,5 +15,7 @@ bool -> bool -> bool -> + Cmd_sym.fail_mode -> bool -> + Smtml.Solver_dispatcher.solver_type -> unit Result.t
    diff --git a/api/owi/Owi/Cmd_conc/index.html b/api/owi/Owi/Cmd_conc/index.html index 32f88f8d3..b6a510835 100644 --- a/api/owi/Owi/Cmd_conc/index.html +++ b/api/owi/Owi/Cmd_conc/index.html @@ -8,6 +8,8 @@ bool -> bool -> bool -> + Cmd_sym.fail_mode -> Fpath.t -> + Smtml.Solver_dispatcher.solver_type -> Fpath.t list -> unit Result.t
    diff --git a/api/owi/Owi/Cmd_sym/index.html b/api/owi/Owi/Cmd_sym/index.html index bfb8be04f..e11523fc1 100644 --- a/api/owi/Owi/Cmd_sym/index.html +++ b/api/owi/Owi/Cmd_sym/index.html @@ -1,5 +1,5 @@ -Cmd_sym (owi.Owi.Cmd_sym)

    Module Owi.Cmd_sym

    val cmd : +Cmd_sym (owi.Owi.Cmd_sym)

    Module Owi.Cmd_sym

    type fail_mode = [
    1. | `Trap_only
    2. | `Assertion_only
    3. | `Both
    ]
    val cmd : bool -> bool -> bool -> @@ -8,6 +8,8 @@ bool -> bool -> bool -> + fail_mode -> Fpath.t -> + Smtml.Solver_dispatcher.solver_type -> Fpath.t list -> unit Result.t
    diff --git a/api/owi/Owi/Cmd_utils/index.html b/api/owi/Owi/Cmd_utils/index.html new file mode 100644 index 000000000..fac808b48 --- /dev/null +++ b/api/owi/Owi/Cmd_utils/index.html @@ -0,0 +1,4 @@ + +Cmd_utils (owi.Owi.Cmd_utils)

    Module Owi.Cmd_utils

    val write_testcase : dir:Fpath.t -> Smtml.Value.t list -> unit Result.t
    val add_main_as_start : + Binary.modul -> + (Binary.modul, [> `Msg of string ]) Prelude.result
    diff --git a/api/owi/Owi/Cmd_wat2wasm/index.html b/api/owi/Owi/Cmd_wat2wasm/index.html new file mode 100644 index 000000000..b9c463ca5 --- /dev/null +++ b/api/owi/Owi/Cmd_wat2wasm/index.html @@ -0,0 +1,2 @@ + +Cmd_wat2wasm (owi.Owi.Cmd_wat2wasm)

    Module Owi.Cmd_wat2wasm

    val cmd : bool -> bool -> bool -> bool -> Fpath.t list -> unit Result.t
    diff --git a/api/owi/Owi/Compile/Any/index.html b/api/owi/Owi/Compile/Any/index.html new file mode 100644 index 000000000..8bcaecaca --- /dev/null +++ b/api/owi/Owi/Compile/Any/index.html @@ -0,0 +1,21 @@ + +Any (owi.Owi.Compile.Any)

    Module Compile.Any

    val until_typecheck : + unsafe:bool -> + 'extern_func Kind.t -> + Binary.modul Result.t
    val until_optimize : + unsafe:bool -> + optimize:bool -> + 'extern_func Kind.t -> + Binary.modul Result.t

    compile a module with a given link state and produce a new link state and a runnable module

    val until_interpret : + unsafe:bool -> + optimize:bool -> + name:string option -> + Concrete_value.Func.extern_func Link.state -> + Concrete_value.Func.extern_func Kind.t -> + Concrete_value.Func.extern_func Link.state Result.t

    compile and interpret a module with a given link state and produce a new link state

    diff --git a/api/owi/Owi/Compile/Binary/index.html b/api/owi/Owi/Compile/Binary/index.html index 7f215b06f..dd379ba52 100644 --- a/api/owi/Owi/Compile/Binary/index.html +++ b/api/owi/Owi/Compile/Binary/index.html @@ -5,14 +5,14 @@ Binary.modul -> Binary.modul Result.t

    compile a module with a given link state and produce a new link state and a runnable module

    val until_interpret : - Concrete_value.Func.extern_func Link.state -> unsafe:bool -> optimize:bool -> name:string option -> + Concrete_value.Func.extern_func Link.state -> Binary.modul -> Concrete_value.Func.extern_func Link.state Result.t

    compile and interpret a module with a given link state and produce a new link state

    diff --git a/api/owi/Owi/Compile/File/index.html b/api/owi/Owi/Compile/File/index.html new file mode 100644 index 000000000..81374697c --- /dev/null +++ b/api/owi/Owi/Compile/File/index.html @@ -0,0 +1,18 @@ + +File (owi.Owi.Compile.File)

    Module Compile.File

    val until_typecheck : unsafe:bool -> Fpath.t -> Binary.modul Result.t
    val until_optimize : + unsafe:bool -> + optimize:bool -> + Fpath.t -> + Binary.modul Result.t

    compile a file with a given link state and produce a new link state and a runnable module

    val until_interpret : + unsafe:bool -> + optimize:bool -> + name:string option -> + Concrete_value.Func.extern_func Link.state -> + Fpath.t -> + Concrete_value.Func.extern_func Link.state Result.t

    compile and interpret a file with a given link state and produce a new link state

    diff --git a/api/owi/Owi/Compile/Text/index.html b/api/owi/Owi/Compile/Text/index.html index b9e8f4efa..d1fe33329 100644 --- a/api/owi/Owi/Compile/Text/index.html +++ b/api/owi/Owi/Compile/Text/index.html @@ -5,14 +5,14 @@ Text.modul -> Binary.modul Result.t

compile a module with a given link state and produce a new link state and a runnable module

val until_interpret : - Concrete_value.Func.extern_func Link.state -> unsafe:bool -> optimize:bool -> name:string option -> + Concrete_value.Func.extern_func Link.state -> Text.modul -> Concrete_value.Func.extern_func Link.state Result.t

compile and interpret a module with a given link state and produce a new link state

diff --git a/api/owi/Owi/Compile/index.html b/api/owi/Owi/Compile/index.html index d793ef791..b26900b4c 100644 --- a/api/owi/Owi/Compile/index.html +++ b/api/owi/Owi/Compile/index.html @@ -1,2 +1,2 @@ -Compile (owi.Owi.Compile)

Module Owi.Compile

Utility functions to compile a module until a given step.

module Text : sig ... end
module Binary : sig ... end
+Compile (owi.Owi.Compile)

Module Owi.Compile

Utility functions to compile a module until a given step.

module Any : sig ... end
module File : sig ... end
module Text : sig ... end
module Binary : sig ... end
diff --git a/api/owi/Owi/Concolic/P'/Extern_func/index.html b/api/owi/Owi/Concolic/P'/Extern_func/index.html index cc3c51458..1dd8a1448 100644 --- a/api/owi/Owi/Concolic/P'/Extern_func/index.html +++ b/api/owi/Owi/Concolic/P'/Extern_func/index.html @@ -1,2 +1,2 @@ -Extern_func (owi.Owi.Concolic.P'.Extern_func)

Module P'.Extern_func

type _ telt =
  1. | I32 : Value.int32 telt
  2. | I64 : Value.int64 telt
  3. | F32 : Value.float32 telt
  4. | F64 : Value.float64 telt
  5. | Externref : 'a Stdlib.Type.Id.t -> 'a telt
type _ rtype =
  1. | R0 : unit rtype
  2. | R1 : 'a telt -> 'a rtype
  3. | R2 : 'a telt * 'b telt -> ('a * 'b) rtype
  4. | R3 : 'a telt * 'b telt * 'c telt -> ('a * 'b * 'c) rtype
  5. | R4 : 'a telt * 'b telt * 'c telt * 'd telt -> ('a * 'b * 'c * 'd) rtype
type (_, _) atype =
  1. | UArg : ('b, 'r) atype -> (unit -> 'b, 'r) atype
  2. | Arg : 'a telt * ('b, 'r) atype -> ('a -> 'b, 'r) atype
  3. | NArg : string * 'a telt * ('b, 'r) atype -> ('a -> 'b, 'r) atype
  4. | Res : ('r, 'r) atype
type _ func_type =
  1. | Func : ('f, 'r Choice.t) atype * 'r rtype -> 'f func_type
type extern_func =
  1. | Extern_func : 'a func_type * 'a -> extern_func
+Extern_func (owi.Owi.Concolic.P'.Extern_func)

Module P'.Extern_func

type _ telt =
  1. | I32 : Value.int32 telt
  2. | I64 : Value.int64 telt
  3. | F32 : Value.float32 telt
  4. | F64 : Value.float64 telt
  5. | Externref : 'a Prelude.Type.Id.t -> 'a telt
type _ rtype =
  1. | R0 : unit rtype
  2. | R1 : 'a telt -> 'a rtype
  3. | R2 : 'a telt * 'b telt -> ('a * 'b) rtype
  4. | R3 : 'a telt * 'b telt * 'c telt -> ('a * 'b * 'c) rtype
  5. | R4 : 'a telt * 'b telt * 'c telt * 'd telt -> ('a * 'b * 'c * 'd) rtype
type (_, _) atype =
  1. | Mem : ('b, 'r) atype -> (Memory.t -> 'b, 'r) atype
  2. | UArg : ('b, 'r) atype -> (unit -> 'b, 'r) atype
  3. | Arg : 'a telt * ('b, 'r) atype -> ('a -> 'b, 'r) atype
  4. | NArg : string * 'a telt * ('b, 'r) atype -> ('a -> 'b, 'r) atype
  5. | Res : ('r, 'r) atype
type _ func_type =
  1. | Func : ('f, 'r Choice.t) atype * 'r rtype -> 'f func_type
type extern_func =
  1. | Extern_func : 'a func_type * 'a -> extern_func
diff --git a/api/owi/Owi/Concolic/P'/Value/Bool/index.html b/api/owi/Owi/Concolic/P'/Value/Bool/index.html index e9143ce73..fdcd5ef49 100644 --- a/api/owi/Owi/Concolic/P'/Value/Bool/index.html +++ b/api/owi/Owi/Concolic/P'/Value/Bool/index.html @@ -1,2 +1,2 @@ -Bool (owi.Owi.Concolic.P'.Value.Bool)

Module Value.Bool

val const : bool -> vbool
val not : vbool -> vbool
val or_ : vbool -> vbool -> vbool
val and_ : vbool -> vbool -> vbool
val int32 : vbool -> int32
val pp : Format.formatter -> vbool -> unit
+Bool (owi.Owi.Concolic.P'.Value.Bool)

Module Value.Bool

val const : bool -> vbool
val not : vbool -> vbool
val or_ : vbool -> vbool -> vbool
val and_ : vbool -> vbool -> vbool
val int32 : vbool -> int32
val pp : Prelude.Fmt.formatter -> vbool -> unit
diff --git a/api/owi/Owi/Concolic/P'/Value/Ref/index.html b/api/owi/Owi/Concolic/P'/Value/Ref/index.html index a17af3ee1..69d579d82 100644 --- a/api/owi/Owi/Concolic/P'/Value/Ref/index.html +++ b/api/owi/Owi/Concolic/P'/Value/Ref/index.html @@ -1,2 +1,2 @@ -Ref (owi.Owi.Concolic.P'.Value.Ref)

Module Value.Ref

val get_externref : ref_value -> 'a Stdlib.Type.Id.t -> 'a Value_intf.get_ref
+Ref (owi.Owi.Concolic.P'.Value.Ref)

Module Value.Ref

val get_externref : ref_value -> 'a Prelude.Type.Id.t -> 'a Value_intf.get_ref
diff --git a/api/owi/Owi/Concolic/P'/Value/index.html b/api/owi/Owi/Concolic/P'/Value/index.html index 970f46834..73d1ccd18 100644 --- a/api/owi/Owi/Concolic/P'/Value/index.html +++ b/api/owi/Owi/Concolic/P'/Value/index.html @@ -1,2 +1,2 @@ -Value (owi.Owi.Concolic.P'.Value)

Module P'.Value

type vbool
type int32
type int64
type float32
type float64
type ref_value
type t =
  1. | I32 of int32
  2. | I64 of int64
  3. | F32 of float32
  4. | F64 of float64
  5. | Ref of ref_value
val const_i32 : Int32.t -> int32
val const_i64 : Int64.t -> int64
val const_f32 : Float32.t -> float32
val const_f64 : Float64.t -> float64
val ref_null : Types.binary Types.heap_type -> t
val ref_func : Func_intf.t -> t
val ref_externref : 'a Stdlib.Type.Id.t -> 'a -> t
val ref_is_null : ref_value -> vbool
val pp : Format.formatter -> t -> unit
module Ref : sig ... end
module Bool : sig ... end
module F32 : sig ... end
module F64 : sig ... end
module I32 : sig ... end
module I64 : sig ... end
+Value (owi.Owi.Concolic.P'.Value)

Module P'.Value

type vbool
type int32
val pp_int32 : Prelude.Fmt.formatter -> int32 -> unit
type int64
val pp_int64 : Prelude.Fmt.formatter -> int64 -> unit
type float32
val pp_float32 : Prelude.Fmt.formatter -> float32 -> unit
type float64
val pp_float64 : Prelude.Fmt.formatter -> float64 -> unit
type ref_value
val pp_ref_value : Prelude.Fmt.formatter -> ref_value -> unit
type t =
  1. | I32 of int32
  2. | I64 of int64
  3. | F32 of float32
  4. | F64 of float64
  5. | Ref of ref_value
val pp : Prelude.Fmt.formatter -> t -> unit
val const_i32 : Int32.t -> int32
val const_i64 : Int64.t -> int64
val const_f32 : Float32.t -> float32
val const_f64 : Float64.t -> float64
val ref_null : Types.binary Types.heap_type -> t
val ref_func : Func_intf.t -> t
val ref_externref : 'a Prelude.Type.Id.t -> 'a -> t
val ref_is_null : ref_value -> vbool
module Ref : sig ... end
module Bool : sig ... end
module F32 : sig ... end
module F64 : sig ... end
module I32 : sig ... end
module I64 : sig ... end
diff --git a/api/owi/Owi/Concolic/P'/index.html b/api/owi/Owi/Concolic/P'/index.html index 697428dfd..1dd0c498e 100644 --- a/api/owi/Owi/Concolic/P'/index.html +++ b/api/owi/Owi/Concolic/P'/index.html @@ -3,10 +3,11 @@ Value.vbool -> if_true:Value.t -> if_false:Value.t -> - Value.t Choice.t
module Extern_func : + Value.t Choice.t
module Global : sig ... end
module Table : sig ... end
module Memory : sig ... end
module Extern_func : Func_intf.T_Extern_func with type int32 := Value.int32 and type int64 := Value.int64 and type float32 := Value.float32 and type float64 := Value.float64 - and type 'a m := 'a Choice.t
module Global : sig ... end
module Table : sig ... end
module Memory : sig ... end
module Data : sig ... end
module Elem : sig ... end
module Env : sig ... end
module Module_to_run : sig ... end
+ and type 'a m := 'a Choice.t + and type memory := Memory.t
module Data : sig ... end
module Elem : sig ... end
module Env : sig ... end
module Module_to_run : sig ... end
diff --git a/api/owi/Owi/Concolic/P/Extern_func/index.html b/api/owi/Owi/Concolic/P/Extern_func/index.html index 6dcb2b969..026208248 100644 --- a/api/owi/Owi/Concolic/P/Extern_func/index.html +++ b/api/owi/Owi/Concolic/P/Extern_func/index.html @@ -1,2 +1,2 @@ -Extern_func (owi.Owi.Concolic.P.Extern_func)

Module P.Extern_func

type !'b telt =
  1. | I32 : Value.int32 telt
  2. | I64 : Value.int64 telt
  3. | F32 : Value.float32 telt
  4. | F64 : Value.float64 telt
  5. | Externref : 'a Stdlib.Type.Id.t -> 'a telt
type !'e rtype =
  1. | R0 : unit rtype
  2. | R1 : 'a telt -> 'a rtype
  3. | R2 : 'a0 telt * 'b telt -> ('a0 * 'b) rtype
  4. | R3 : 'a1 telt * 'b0 telt * 'c telt -> ('a1 * 'b0 * 'c) rtype
  5. | R4 : 'a2 telt * 'b1 telt * 'c0 telt * 'd telt -> ('a2 * 'b1 * 'c0 * 'd) rtype
type (!'c, !'d) atype =
  1. | UArg : ('b, 'r) atype -> (unit -> 'b, 'r) atype
  2. | Arg : 'a telt * ('b0, 'r0) atype -> ('a -> 'b0, 'r0) atype
  3. | NArg : string * 'a0 telt * ('b1, 'r1) atype -> ('a0 -> 'b1, 'r1) atype
  4. | Res : ('r2, 'r2) atype
type !'a func_type =
  1. | Func : ('f, 'r Choice.t) atype * 'r rtype -> 'f func_type
type extern_func =
  1. | Extern_func : 'a func_type * 'a -> extern_func
+Extern_func (owi.Owi.Concolic.P.Extern_func)

Module P.Extern_func

type !'b telt =
  1. | I32 : Value.int32 telt
  2. | I64 : Value.int64 telt
  3. | F32 : Value.float32 telt
  4. | F64 : Value.float64 telt
  5. | Externref : 'a Prelude.Type.Id.t -> 'a telt
type !'e rtype =
  1. | R0 : unit rtype
  2. | R1 : 'a telt -> 'a rtype
  3. | R2 : 'a0 telt * 'b telt -> ('a0 * 'b) rtype
  4. | R3 : 'a1 telt * 'b0 telt * 'c telt -> ('a1 * 'b0 * 'c) rtype
  5. | R4 : 'a2 telt * 'b1 telt * 'c0 telt * 'd telt -> ('a2 * 'b1 * 'c0 * 'd) rtype
type (!'c, !'d) atype =
  1. | Mem : ('b, 'r) atype -> (Memory.t -> 'b, 'r) atype
  2. | UArg : ('b0, 'r0) atype -> (unit -> 'b0, 'r0) atype
  3. | Arg : 'a telt * ('b1, 'r1) atype -> ('a -> 'b1, 'r1) atype
  4. | NArg : string * 'a0 telt * ('b2, 'r2) atype -> ('a0 -> 'b2, 'r2) atype
  5. | Res : ('r3, 'r3) atype
type !'a func_type =
  1. | Func : ('f, 'r Choice.t) atype * 'r rtype -> 'f func_type
type extern_func =
  1. | Extern_func : 'a func_type * 'a -> extern_func
diff --git a/api/owi/Owi/Concolic/P/Table/index.html b/api/owi/Owi/Concolic/P/Table/index.html index 59196753d..21807a96e 100644 --- a/api/owi/Owi/Concolic/P/Table/index.html +++ b/api/owi/Owi/Concolic/P/Table/index.html @@ -1,4 +1,26 @@ -Table (owi.Owi.Concolic.P.Table)

Module P.Table

val get : 'a -> 'b -> 'c
val set : 'a -> 'b -> 'c -> 'd
val size : (Concrete_table.t, 'a) Concolic_value.cs -> int
val typ : +Table (owi.Owi.Concolic.P.Table)

Module P.Table

val size : (Concrete_table.t, 'a) Concolic_value.cs -> int
val max_size : (Concrete_table.t, 'a) Concolic_value.cs -> int option
val grow : 'a -> 'b -> 'c -> 'd
val fill : 'a -> 'b -> 'c -> 'd -> 'e
val copy : t_src:'a -> t_dst:'b -> src:'c -> dst:'d -> len:'e -> 'f
+ Types.binary Types.ref_type
val max_size : (Concrete_table.t, 'a) Concolic_value.cs -> int option
val copy : + t_src:(Concrete_table.t, Symbolic_table.t) Concolic_value.cs -> + t_dst:(Concrete_table.t, Symbolic_table.t) Concolic_value.cs -> + src:Int32.t -> + dst:Int32.t -> + len:Int32.t -> + unit
diff --git a/api/owi/Owi/Concolic/P/index.html b/api/owi/Owi/Concolic/P/index.html index c479f7f7c..9723b7a8b 100644 --- a/api/owi/Owi/Concolic/P/index.html +++ b/api/owi/Owi/Concolic/P/index.html @@ -3,4 +3,4 @@ Value.vbool -> if_true:Value.t -> if_false:Value.t -> - Value.t Choice.t
module Extern_func : sig ... end
module Global : sig ... end
module Table : sig ... end
module Memory : sig ... end
module Data : sig ... end
module Elem : sig ... end
module Env : sig ... end
module Module_to_run : sig ... end
+ Value.t Choice.t
module Global : sig ... end
module Table : sig ... end
module Memory : sig ... end
module Extern_func : sig ... end
module Data : sig ... end
module Elem : sig ... end
module Env : sig ... end
module Module_to_run : sig ... end
diff --git a/api/owi/Owi/Concolic/index.html b/api/owi/Owi/Concolic/index.html index d741a7d1e..9fd2372d9 100644 --- a/api/owi/Owi/Concolic/index.html +++ b/api/owi/Owi/Concolic/index.html @@ -1,4 +1,7 @@ Concolic (owi.Owi.Concolic)

Module Owi.Concolic

module P : sig ... end
+ P.Module_to_run.t
val backup : P.Module_to_run.t -> P.Extern_func.extern_func Link_env.backup
val recover : + P.Extern_func.extern_func Link_env.backup -> + P.Module_to_run.t -> + unit
diff --git a/api/owi/Owi/Concolic_choice/index.html b/api/owi/Owi/Concolic_choice/index.html index 090686ff6..72d3203bc 100644 --- a/api/owi/Owi/Concolic_choice/index.html +++ b/api/owi/Owi/Concolic_choice/index.html @@ -1,14 +1,14 @@ -Concolic_choice (owi.Owi.Concolic_choice)

Module Owi.Concolic_choice

type err =
  1. | Assert_fail
  2. | Trap of Trap.t
  3. | Assume_fail of Symbolic_value.vbool
type pc_elt =
  1. | Select of Symbolic_value.vbool * bool
  2. | Select_i32 of Symbolic_value.int32 * int32
  3. | Assume of Symbolic_value.vbool
  4. | Assert of Symbolic_value.vbool
val pp_pc_elt : Format.formatter -> pc_elt -> unit
val pp_pc : Format.formatter -> pc_elt list -> unit
val pp_assignments : - Format.formatter -> +Concolic_choice (owi.Owi.Concolic_choice)

Module Owi.Concolic_choice

type err =
  1. | Assert_fail
  2. | Trap of Trap.t
  3. | Assume_fail of Symbolic_value.vbool
type pc_elt =
  1. | Select of Symbolic_value.vbool * bool
  2. | Select_i32 of Symbolic_value.int32 * int32
  3. | Assume of Symbolic_value.vbool
  4. | Assert of Symbolic_value.vbool
val pp_pc_elt : Stdlib.Format.formatter -> pc_elt -> unit
val pp_pc : Stdlib.Format.formatter -> pc_elt list -> unit
val pp_assignments : + Stdlib.Format.formatter -> (Smtml.Symbol.t * Concrete_value.t) list -> - unit
val pc_elt_to_expr : pc_elt -> Symbolic_value.vbool option
val pc_to_exprs : pc_elt list -> Symbolic_value.vbool list
type pc = pc_elt list
type shared_thread_info = {
  1. memories : Symbolic_memory.collection;
  2. tables : Symbolic_table.collection;
  3. globals : Symbolic_global.collection;
}
type thread = {
  1. pc : pc;
  2. symbols : int;
  3. symbols_value : (Smtml.Symbol.t * Concrete_value.t) list;
  4. preallocated_values : (Smtml.Symbol.t, Smtml.Value.t) Stdlib.Hashtbl.t;
  5. shared : shared_thread_info;
}
val init_thread : - (Smtml.Symbol.t, Smtml.Value.t) Stdlib.Hashtbl.t -> + unit
val pc_elt_to_expr : pc_elt -> Symbolic_value.vbool option
val pc_to_exprs : pc_elt list -> Symbolic_value.vbool list
type pc = pc_elt list
type shared_thread_info = {
  1. memories : Symbolic_memory.collection;
  2. tables : Symbolic_table.collection;
  3. globals : Symbolic_global.collection;
}
type thread = {
  1. pc : pc;
  2. symbols : int;
  3. symbols_value : (Smtml.Symbol.t * Concrete_value.t) list;
  4. preallocated_values : (Smtml.Symbol.t, Smtml.Value.t) Prelude.Hashtbl.t;
  5. shared : shared_thread_info;
}
val init_thread : + (Smtml.Symbol.t, Smtml.Value.t) Prelude.Hashtbl.t -> shared_thread_info -> - thread
type 'a run_result = ('a, err) Stdlib.Result.t * thread
type 'a t =
  1. | M of thread -> 'a run_result
val return : 'a -> 'b t
val bind : 'a t -> ('b -> 'c t) -> 'd t
val let* : 'a t -> ('a -> 'b t) -> 'b t
val map : 'a t -> ('b -> 'c) -> 'd t
val let+ : 'a t -> ('a -> 'b) -> 'b t
val abort : unit t
val add_pc : Concolic_value.V.vbool -> unit t
val add_pc_to_thread : thread -> pc_elt -> thread
val no_choice : Smtml.Expr.t -> bool
val assume : Concolic_value.V.vbool -> unit t
val assertion : Concolic_value.V.vbool -> unit t
val trap : Trap.t -> 'a t
val with_thread : (thread -> 'a) -> 'b t
val with_new_symbol : + thread
type 'a run_result = ('a, err) Prelude.Result.t * thread
type 'a t =
  1. | M of thread -> 'a run_result
val return : 'a -> 'b t
val bind : 'a t -> ('b -> 'c t) -> 'd t
val let* : 'a t -> ('a -> 'b t) -> 'b t
val map : 'a t -> ('b -> 'c) -> 'd t
val let+ : 'a t -> ('a -> 'b) -> 'b t
val abort : unit t
val add_pc : Concolic_value.V.vbool -> unit t
val add_pc_to_thread : thread -> pc_elt -> thread
val no_choice : Smtml.Expr.t -> bool
val assume : Concolic_value.V.vbool -> unit t
val assertion : Concolic_value.V.vbool -> unit t
val trap : Trap.t -> 'a t
val with_thread : (thread -> 'a) -> 'b t
val with_new_symbol : Smtml.Ty.t -> (Smtml.Symbol.t -> Smtml.Value.t option -> Concrete_value.t * 'a) -> 'b t
val run : - (Smtml.Symbol.t, Smtml.Value.t) Stdlib.Hashtbl.t -> + (Smtml.Symbol.t, Smtml.Value.t) Prelude.Hashtbl.t -> 'a t -> 'b run_result
val run' : 'a t -> 'b run_result
diff --git a/api/owi/Owi/Concolic_value/T_pair/I32/index.html b/api/owi/Owi/Concolic_value/T_pair/I32/index.html index 333024ed8..15c68f515 100644 --- a/api/owi/Owi/Concolic_value/T_pair/I32/index.html +++ b/api/owi/Owi/Concolic_value/T_pair/I32/index.html @@ -44,4 +44,4 @@ (C.int32, S.int32) cs
val rotr : (C.int32, S.int32) cs -> (C.int32, S.int32) cs -> - (C.int32, S.int32) cs
val eq_const : (C.int32, S.int32) cs -> Stdlib.Int32.t -> vbool
val eq : (C.int32, S.int32) cs -> (C.int32, S.int32) cs -> vbool
val ne : (C.int32, S.int32) cs -> (C.int32, S.int32) cs -> vbool
val lt : (C.int32, S.int32) cs -> (C.int32, S.int32) cs -> vbool
val gt : (C.int32, S.int32) cs -> (C.int32, S.int32) cs -> vbool
val lt_u : (C.int32, S.int32) cs -> (C.int32, S.int32) cs -> vbool
val gt_u : (C.int32, S.int32) cs -> (C.int32, S.int32) cs -> vbool
val le : (C.int32, S.int32) cs -> (C.int32, S.int32) cs -> vbool
val ge : (C.int32, S.int32) cs -> (C.int32, S.int32) cs -> vbool
val le_u : (C.int32, S.int32) cs -> (C.int32, S.int32) cs -> vbool
val ge_u : (C.int32, S.int32) cs -> (C.int32, S.int32) cs -> vbool
val trunc_f32_s : float32 -> (C.int32, S.int32) cs
val trunc_f32_u : float32 -> (C.int32, S.int32) cs
val trunc_f64_s : float64 -> (C.int32, S.int32) cs
val trunc_f64_u : float64 -> (C.int32, S.int32) cs
val trunc_sat_f32_s : float32 -> (C.int32, S.int32) cs
val trunc_sat_f32_u : float32 -> (C.int32, S.int32) cs
val trunc_sat_f64_s : float64 -> (C.int32, S.int32) cs
val trunc_sat_f64_u : float64 -> (C.int32, S.int32) cs
val extend_s : int -> (C.int32, S.int32) cs -> (C.int32, S.int32) cs
val to_bool : (C.int32, S.int32) cs -> (C.vbool, S.vbool) cs
val reinterpret_f32 : (C.float32, S.float32) cs -> (C.int32, S.int32) cs
val wrap_i64 : (C.int64, S.int64) cs -> (C.int32, S.int32) cs
+ (C.int32, S.int32) cs
val eq_const : (C.int32, S.int32) cs -> Int32.t -> vbool
val eq : (C.int32, S.int32) cs -> (C.int32, S.int32) cs -> vbool
val ne : (C.int32, S.int32) cs -> (C.int32, S.int32) cs -> vbool
val lt : (C.int32, S.int32) cs -> (C.int32, S.int32) cs -> vbool
val gt : (C.int32, S.int32) cs -> (C.int32, S.int32) cs -> vbool
val lt_u : (C.int32, S.int32) cs -> (C.int32, S.int32) cs -> vbool
val gt_u : (C.int32, S.int32) cs -> (C.int32, S.int32) cs -> vbool
val le : (C.int32, S.int32) cs -> (C.int32, S.int32) cs -> vbool
val ge : (C.int32, S.int32) cs -> (C.int32, S.int32) cs -> vbool
val le_u : (C.int32, S.int32) cs -> (C.int32, S.int32) cs -> vbool
val ge_u : (C.int32, S.int32) cs -> (C.int32, S.int32) cs -> vbool
val trunc_f32_s : float32 -> (C.int32, S.int32) cs
val trunc_f32_u : float32 -> (C.int32, S.int32) cs
val trunc_f64_s : float64 -> (C.int32, S.int32) cs
val trunc_f64_u : float64 -> (C.int32, S.int32) cs
val trunc_sat_f32_s : float32 -> (C.int32, S.int32) cs
val trunc_sat_f32_u : float32 -> (C.int32, S.int32) cs
val trunc_sat_f64_s : float64 -> (C.int32, S.int32) cs
val trunc_sat_f64_u : float64 -> (C.int32, S.int32) cs
val extend_s : int -> (C.int32, S.int32) cs -> (C.int32, S.int32) cs
val to_bool : (C.int32, S.int32) cs -> (C.vbool, S.vbool) cs
val reinterpret_f32 : (C.float32, S.float32) cs -> (C.int32, S.int32) cs
val wrap_i64 : (C.int64, S.int64) cs -> (C.int32, S.int32) cs
diff --git a/api/owi/Owi/Concolic_value/T_pair/I64/index.html b/api/owi/Owi/Concolic_value/T_pair/I64/index.html index 6e67008e8..d36a72b92 100644 --- a/api/owi/Owi/Concolic_value/T_pair/I64/index.html +++ b/api/owi/Owi/Concolic_value/T_pair/I64/index.html @@ -44,4 +44,4 @@ (C.int64, S.int64) cs
val rotr : (C.int64, S.int64) cs -> (C.int64, S.int64) cs -> - (C.int64, S.int64) cs
val eq_const : (C.int64, S.int64) cs -> Stdlib.Int64.t -> vbool
val eq : (C.int64, S.int64) cs -> (C.int64, S.int64) cs -> vbool
val ne : (C.int64, S.int64) cs -> (C.int64, S.int64) cs -> vbool
val lt : (C.int64, S.int64) cs -> (C.int64, S.int64) cs -> vbool
val gt : (C.int64, S.int64) cs -> (C.int64, S.int64) cs -> vbool
val lt_u : (C.int64, S.int64) cs -> (C.int64, S.int64) cs -> vbool
val gt_u : (C.int64, S.int64) cs -> (C.int64, S.int64) cs -> vbool
val le : (C.int64, S.int64) cs -> (C.int64, S.int64) cs -> vbool
val ge : (C.int64, S.int64) cs -> (C.int64, S.int64) cs -> vbool
val le_u : (C.int64, S.int64) cs -> (C.int64, S.int64) cs -> vbool
val ge_u : (C.int64, S.int64) cs -> (C.int64, S.int64) cs -> vbool
val trunc_f32_s : float32 -> (C.int64, S.int64) cs
val trunc_f32_u : float32 -> (C.int64, S.int64) cs
val trunc_f64_s : float64 -> (C.int64, S.int64) cs
val trunc_f64_u : float64 -> (C.int64, S.int64) cs
val trunc_sat_f32_s : float32 -> (C.int64, S.int64) cs
val trunc_sat_f32_u : float32 -> (C.int64, S.int64) cs
val trunc_sat_f64_s : float64 -> (C.int64, S.int64) cs
val trunc_sat_f64_u : float64 -> (C.int64, S.int64) cs
val extend_s : int -> (C.int64, S.int64) cs -> (C.int64, S.int64) cs
val of_int32 : (C.int32, S.int32) cs -> (C.int64, S.int64) cs
val to_int32 : (C.int64, S.int64) cs -> (C.int32, S.int32) cs
val reinterpret_f64 : (C.float64, S.float64) cs -> (C.int64, S.int64) cs
val extend_i32_s : (C.int32, S.int32) cs -> (C.int64, S.int64) cs
val extend_i32_u : (C.int32, S.int32) cs -> (C.int64, S.int64) cs
+ (C.int64, S.int64) cs
val eq_const : (C.int64, S.int64) cs -> Int64.t -> vbool
val eq : (C.int64, S.int64) cs -> (C.int64, S.int64) cs -> vbool
val ne : (C.int64, S.int64) cs -> (C.int64, S.int64) cs -> vbool
val lt : (C.int64, S.int64) cs -> (C.int64, S.int64) cs -> vbool
val gt : (C.int64, S.int64) cs -> (C.int64, S.int64) cs -> vbool
val lt_u : (C.int64, S.int64) cs -> (C.int64, S.int64) cs -> vbool
val gt_u : (C.int64, S.int64) cs -> (C.int64, S.int64) cs -> vbool
val le : (C.int64, S.int64) cs -> (C.int64, S.int64) cs -> vbool
val ge : (C.int64, S.int64) cs -> (C.int64, S.int64) cs -> vbool
val le_u : (C.int64, S.int64) cs -> (C.int64, S.int64) cs -> vbool
val ge_u : (C.int64, S.int64) cs -> (C.int64, S.int64) cs -> vbool
val trunc_f32_s : float32 -> (C.int64, S.int64) cs
val trunc_f32_u : float32 -> (C.int64, S.int64) cs
val trunc_f64_s : float64 -> (C.int64, S.int64) cs
val trunc_f64_u : float64 -> (C.int64, S.int64) cs
val trunc_sat_f32_s : float32 -> (C.int64, S.int64) cs
val trunc_sat_f32_u : float32 -> (C.int64, S.int64) cs
val trunc_sat_f64_s : float64 -> (C.int64, S.int64) cs
val trunc_sat_f64_u : float64 -> (C.int64, S.int64) cs
val extend_s : int -> (C.int64, S.int64) cs -> (C.int64, S.int64) cs
val of_int32 : (C.int32, S.int32) cs -> (C.int64, S.int64) cs
val to_int32 : (C.int64, S.int64) cs -> (C.int32, S.int32) cs
val reinterpret_f64 : (C.float64, S.float64) cs -> (C.int64, S.int64) cs
val extend_i32_s : (C.int32, S.int32) cs -> (C.int64, S.int64) cs
val extend_i32_u : (C.int32, S.int32) cs -> (C.int64, S.int64) cs
diff --git a/api/owi/Owi/Concolic_value/T_pair/Ref/index.html b/api/owi/Owi/Concolic_value/T_pair/Ref/index.html index 54ffa3f88..f0eeeb090 100644 --- a/api/owi/Owi/Concolic_value/T_pair/Ref/index.html +++ b/api/owi/Owi/Concolic_value/T_pair/Ref/index.html @@ -1,5 +1,5 @@ Ref (owi.Owi.Concolic_value.T_pair.Ref)

Module T_pair.Ref

val equal_func_intf : Func_intf.t -> Func_intf.t -> bool
val get_externref : (C.ref_value, S.ref_value) cs -> - 'a Stdlib.Type.Id.t -> + 'a Prelude.Type.Id.t -> 'b Value_intf.get_ref
diff --git a/api/owi/Owi/Concolic_value/T_pair/argument-1-C/Bool/index.html b/api/owi/Owi/Concolic_value/T_pair/argument-1-C/Bool/index.html index d7e6c5f69..97d3e6db4 100644 --- a/api/owi/Owi/Concolic_value/T_pair/argument-1-C/Bool/index.html +++ b/api/owi/Owi/Concolic_value/T_pair/argument-1-C/Bool/index.html @@ -1,2 +1,2 @@ -Bool (owi.Owi.Concolic_value.T_pair.C.Bool)

Module C.Bool

val const : bool -> vbool
val not : vbool -> vbool
val or_ : vbool -> vbool -> vbool
val and_ : vbool -> vbool -> vbool
val int32 : vbool -> int32
val pp : Format.formatter -> vbool -> unit
+Bool (owi.Owi.Concolic_value.T_pair.C.Bool)

Module C.Bool

val const : bool -> vbool
val not : vbool -> vbool
val or_ : vbool -> vbool -> vbool
val and_ : vbool -> vbool -> vbool
val int32 : vbool -> int32
val pp : Prelude.Fmt.formatter -> vbool -> unit
diff --git a/api/owi/Owi/Concolic_value/T_pair/argument-1-C/Ref/index.html b/api/owi/Owi/Concolic_value/T_pair/argument-1-C/Ref/index.html index 69e25251d..3efdbdcb8 100644 --- a/api/owi/Owi/Concolic_value/T_pair/argument-1-C/Ref/index.html +++ b/api/owi/Owi/Concolic_value/T_pair/argument-1-C/Ref/index.html @@ -1,2 +1,2 @@ -Ref (owi.Owi.Concolic_value.T_pair.C.Ref)

Module C.Ref

val get_externref : ref_value -> 'a Stdlib.Type.Id.t -> 'a Value_intf.get_ref
+Ref (owi.Owi.Concolic_value.T_pair.C.Ref)

Module C.Ref

val get_externref : ref_value -> 'a Prelude.Type.Id.t -> 'a Value_intf.get_ref
diff --git a/api/owi/Owi/Concolic_value/T_pair/argument-1-C/index.html b/api/owi/Owi/Concolic_value/T_pair/argument-1-C/index.html index 2593ed727..3a27a7f5b 100644 --- a/api/owi/Owi/Concolic_value/T_pair/argument-1-C/index.html +++ b/api/owi/Owi/Concolic_value/T_pair/argument-1-C/index.html @@ -1,2 +1,2 @@ -C (owi.Owi.Concolic_value.T_pair.C)

Parameter T_pair.C

type vbool
type int32
type int64
type float32
type float64
type ref_value
type t =
  1. | I32 of int32
  2. | I64 of int64
  3. | F32 of float32
  4. | F64 of float64
  5. | Ref of ref_value
val const_i32 : Int32.t -> int32
val const_i64 : Int64.t -> int64
val const_f32 : Float32.t -> float32
val const_f64 : Float64.t -> float64
val ref_null : Types.binary Types.heap_type -> t
val ref_func : Func_intf.t -> t
val ref_externref : 'a Stdlib.Type.Id.t -> 'a -> t
val ref_is_null : ref_value -> vbool
val pp : Format.formatter -> t -> unit
module Ref : sig ... end
module Bool : sig ... end
module F32 : sig ... end
module F64 : sig ... end
module I32 : sig ... end
module I64 : sig ... end
+C (owi.Owi.Concolic_value.T_pair.C)

Parameter T_pair.C

type vbool
type int32
val pp_int32 : Prelude.Fmt.formatter -> int32 -> unit
type int64
val pp_int64 : Prelude.Fmt.formatter -> int64 -> unit
type float32
val pp_float32 : Prelude.Fmt.formatter -> float32 -> unit
type float64
val pp_float64 : Prelude.Fmt.formatter -> float64 -> unit
type ref_value
val pp_ref_value : Prelude.Fmt.formatter -> ref_value -> unit
type t =
  1. | I32 of int32
  2. | I64 of int64
  3. | F32 of float32
  4. | F64 of float64
  5. | Ref of ref_value
val pp : Prelude.Fmt.formatter -> t -> unit
val const_i32 : Int32.t -> int32
val const_i64 : Int64.t -> int64
val const_f32 : Float32.t -> float32
val const_f64 : Float64.t -> float64
val ref_null : Types.binary Types.heap_type -> t
val ref_func : Func_intf.t -> t
val ref_externref : 'a Prelude.Type.Id.t -> 'a -> t
val ref_is_null : ref_value -> vbool
module Ref : sig ... end
module Bool : sig ... end
module F32 : sig ... end
module F64 : sig ... end
module I32 : sig ... end
module I64 : sig ... end
diff --git a/api/owi/Owi/Concolic_value/T_pair/argument-2-S/Bool/index.html b/api/owi/Owi/Concolic_value/T_pair/argument-2-S/Bool/index.html index f6bc2ce2c..f124fe6d0 100644 --- a/api/owi/Owi/Concolic_value/T_pair/argument-2-S/Bool/index.html +++ b/api/owi/Owi/Concolic_value/T_pair/argument-2-S/Bool/index.html @@ -1,2 +1,2 @@ -Bool (owi.Owi.Concolic_value.T_pair.S.Bool)

Module S.Bool

val const : bool -> vbool
val not : vbool -> vbool
val or_ : vbool -> vbool -> vbool
val and_ : vbool -> vbool -> vbool
val int32 : vbool -> int32
val pp : Format.formatter -> vbool -> unit
+Bool (owi.Owi.Concolic_value.T_pair.S.Bool)

Module S.Bool

val const : bool -> vbool
val not : vbool -> vbool
val or_ : vbool -> vbool -> vbool
val and_ : vbool -> vbool -> vbool
val int32 : vbool -> int32
val pp : Prelude.Fmt.formatter -> vbool -> unit
diff --git a/api/owi/Owi/Concolic_value/T_pair/argument-2-S/Ref/index.html b/api/owi/Owi/Concolic_value/T_pair/argument-2-S/Ref/index.html index 0b289b4a6..e41ee686d 100644 --- a/api/owi/Owi/Concolic_value/T_pair/argument-2-S/Ref/index.html +++ b/api/owi/Owi/Concolic_value/T_pair/argument-2-S/Ref/index.html @@ -1,2 +1,2 @@ -Ref (owi.Owi.Concolic_value.T_pair.S.Ref)

Module S.Ref

val get_externref : ref_value -> 'a Stdlib.Type.Id.t -> 'a Value_intf.get_ref
+Ref (owi.Owi.Concolic_value.T_pair.S.Ref)

Module S.Ref

val get_externref : ref_value -> 'a Prelude.Type.Id.t -> 'a Value_intf.get_ref
diff --git a/api/owi/Owi/Concolic_value/T_pair/argument-2-S/index.html b/api/owi/Owi/Concolic_value/T_pair/argument-2-S/index.html index bdccb0f76..ae983ed66 100644 --- a/api/owi/Owi/Concolic_value/T_pair/argument-2-S/index.html +++ b/api/owi/Owi/Concolic_value/T_pair/argument-2-S/index.html @@ -1,2 +1,2 @@ -S (owi.Owi.Concolic_value.T_pair.S)

Parameter T_pair.S

type vbool
type int32
type int64
type float32
type float64
type ref_value
type t =
  1. | I32 of int32
  2. | I64 of int64
  3. | F32 of float32
  4. | F64 of float64
  5. | Ref of ref_value
val const_i32 : Int32.t -> int32
val const_i64 : Int64.t -> int64
val const_f32 : Float32.t -> float32
val const_f64 : Float64.t -> float64
val ref_null : Types.binary Types.heap_type -> t
val ref_func : Func_intf.t -> t
val ref_externref : 'a Stdlib.Type.Id.t -> 'a -> t
val ref_is_null : ref_value -> vbool
val pp : Format.formatter -> t -> unit
module Ref : sig ... end
module Bool : sig ... end
module F32 : sig ... end
module F64 : sig ... end
module I32 : sig ... end
module I64 : sig ... end
+S (owi.Owi.Concolic_value.T_pair.S)

Parameter T_pair.S

type vbool
type int32
val pp_int32 : Prelude.Fmt.formatter -> int32 -> unit
type int64
val pp_int64 : Prelude.Fmt.formatter -> int64 -> unit
type float32
val pp_float32 : Prelude.Fmt.formatter -> float32 -> unit
type float64
val pp_float64 : Prelude.Fmt.formatter -> float64 -> unit
type ref_value
val pp_ref_value : Prelude.Fmt.formatter -> ref_value -> unit
type t =
  1. | I32 of int32
  2. | I64 of int64
  3. | F32 of float32
  4. | F64 of float64
  5. | Ref of ref_value
val pp : Prelude.Fmt.formatter -> t -> unit
val const_i32 : Int32.t -> int32
val const_i64 : Int64.t -> int64
val const_f32 : Float32.t -> float32
val const_f64 : Float64.t -> float64
val ref_null : Types.binary Types.heap_type -> t
val ref_func : Func_intf.t -> t
val ref_externref : 'a Prelude.Type.Id.t -> 'a -> t
val ref_is_null : ref_value -> vbool
module Ref : sig ... end
module Bool : sig ... end
module F32 : sig ... end
module F64 : sig ... end
module I32 : sig ... end
module I64 : sig ... end
diff --git a/api/owi/Owi/Concolic_value/T_pair/index.html b/api/owi/Owi/Concolic_value/T_pair/index.html index 281beb59b..0e8c75c25 100644 --- a/api/owi/Owi/Concolic_value/T_pair/index.html +++ b/api/owi/Owi/Concolic_value/T_pair/index.html @@ -1,5 +1,8 @@ -T_pair (owi.Owi.Concolic_value.T_pair)

Module Concolic_value.T_pair

Parameters

module C : Value_intf.T
module S : Value_intf.T

Signature

type vbool = (C.vbool, S.vbool) cs
type int32 = (C.int32, S.int32) cs
type int64 = (C.int64, S.int64) cs
type float32 = (C.float32, S.float32) cs
type float64 = (C.float64, S.float64) cs
type ref_value = (C.ref_value, S.ref_value) cs
type t =
  1. | I32 of int32
  2. | I64 of int64
  3. | F32 of float32
  4. | F64 of float64
  5. | Ref of ref_value
val pair : 'a -> 'b -> ('c, 'd) cs
val value_pair : C.t -> S.t -> t
val concrete_value : t -> C.t
val symbolic_value : t -> S.t
val f_pair_1 : ('a -> 'b) -> ('c -> 'd) -> ('e, 'f) cs -> ('g, 'h) cs
val f_pair_2 : +T_pair (owi.Owi.Concolic_value.T_pair)

Module Concolic_value.T_pair

Parameters

module C : Value_intf.T
module S : Value_intf.T

Signature

type vbool = (C.vbool, S.vbool) cs
type int32 = (C.int32, S.int32) cs
val pp_int32 : Stdlib.Format.formatter -> (C.int32, S.int32) cs -> unit
type int64 = (C.int64, S.int64) cs
val pp_int64 : Stdlib.Format.formatter -> (C.int64, S.int64) cs -> unit
type float32 = (C.float32, S.float32) cs
val pp_float32 : Stdlib.Format.formatter -> (C.float32, S.float32) cs -> unit
type float64 = (C.float64, S.float64) cs
val pp_float64 : Stdlib.Format.formatter -> (C.float64, S.float64) cs -> unit
type ref_value = (C.ref_value, S.ref_value) cs
val pp_ref_value : + Stdlib.Format.formatter -> + (C.ref_value, S.ref_value) cs -> + unit
type t =
  1. | I32 of int32
  2. | I64 of int64
  3. | F32 of float32
  4. | F64 of float64
  5. | Ref of ref_value
val pair : 'a -> 'b -> ('c, 'd) cs
val value_pair : C.t -> S.t -> t
val concrete_value : t -> C.t
val symbolic_value : t -> S.t
val f_pair_1 : ('a -> 'b) -> ('c -> 'd) -> ('e, 'f) cs -> ('g, 'h) cs
val f_pair_2 : ('a -> 'b -> 'c) -> ('d -> 'e -> 'f) -> ('g, 'h) cs -> @@ -14,12 +17,12 @@ ('d -> 'e -> 'f) -> ('g, 'h) cs -> 'i -> - ('j, 'k) cs
val const_i32 : Int32.t -> (C.int32, S.int32) cs
val const_i64 : Int64.t -> (C.int64, S.int64) cs
val const_f32 : Float32.t -> (C.float32, S.float32) cs
val const_f64 : Float64.t -> (C.float64, S.float64) cs
val assert_ref_c : C.t -> C.ref_value
val assert_ref_s : S.t -> S.ref_value
val ref_pair : C.t -> S.t -> t
val ref_null : Types.binary Types.heap_type -> t
val ref_func : Func_intf.t -> t
val ref_externref : 'a Stdlib.Type.Id.t -> 'b -> t
val ref_is_null : (C.ref_value, S.ref_value) cs -> (C.vbool, S.vbool) cs
val mk_pp : + ('j, 'k) cs
val const_i32 : Int32.t -> (C.int32, S.int32) cs
val const_i64 : Int64.t -> (C.int64, S.int64) cs
val const_f32 : Float32.t -> (C.float32, S.float32) cs
val const_f64 : Float64.t -> (C.float64, S.float64) cs
val assert_ref_c : C.t -> C.ref_value
val assert_ref_s : S.t -> S.ref_value
val ref_pair : C.t -> S.t -> t
val ref_null : Types.binary Types.heap_type -> t
val ref_func : Func_intf.t -> t
val ref_externref : 'a Prelude.Type.Id.t -> 'b -> t
val ref_is_null : (C.ref_value, S.ref_value) cs -> (C.vbool, S.vbool) cs
val mk_pp : (Stdlib.Format.formatter -> 'a -> unit) -> (Stdlib.Format.formatter -> 'b -> unit) -> Stdlib.Format.formatter -> ('c, 'd) cs -> - unit
val pp : 'a -> 'b -> 'c
module Ref : sig ... end
module Bool : sig ... end
module type CFop = sig ... end
module type SFop = sig ... end
module MK_Fop + unit
val pp : Stdlib.Format.formatter -> t -> unit
module Ref : sig ... end
module Bool : sig ... end
module type CFop = sig ... end
module type SFop = sig ... end
module MK_Fop (CT : T) (CIT : T) (ST : T) diff --git a/api/owi/Owi/Concolic_value/V'/Bool/index.html b/api/owi/Owi/Concolic_value/V'/Bool/index.html index 5705a4dfc..e413d2e0c 100644 --- a/api/owi/Owi/Concolic_value/V'/Bool/index.html +++ b/api/owi/Owi/Concolic_value/V'/Bool/index.html @@ -1,2 +1,2 @@ -Bool (owi.Owi.Concolic_value.V'.Bool)

Module V'.Bool

val const : bool -> vbool
val not : vbool -> vbool
val or_ : vbool -> vbool -> vbool
val and_ : vbool -> vbool -> vbool
val int32 : vbool -> int32
val pp : Format.formatter -> vbool -> unit
+Bool (owi.Owi.Concolic_value.V'.Bool)

Module V'.Bool

val const : bool -> vbool
val not : vbool -> vbool
val or_ : vbool -> vbool -> vbool
val and_ : vbool -> vbool -> vbool
val int32 : vbool -> int32
val pp : Prelude.Fmt.formatter -> vbool -> unit
diff --git a/api/owi/Owi/Concolic_value/V'/Ref/index.html b/api/owi/Owi/Concolic_value/V'/Ref/index.html index c2c64f3f2..c83955ae4 100644 --- a/api/owi/Owi/Concolic_value/V'/Ref/index.html +++ b/api/owi/Owi/Concolic_value/V'/Ref/index.html @@ -1,2 +1,2 @@ -Ref (owi.Owi.Concolic_value.V'.Ref)

Module V'.Ref

val get_externref : ref_value -> 'a Stdlib.Type.Id.t -> 'a Value_intf.get_ref
+Ref (owi.Owi.Concolic_value.V'.Ref)

Module V'.Ref

val get_externref : ref_value -> 'a Prelude.Type.Id.t -> 'a Value_intf.get_ref
diff --git a/api/owi/Owi/Concolic_value/V'/index.html b/api/owi/Owi/Concolic_value/V'/index.html index da12cbee0..3140c7fb7 100644 --- a/api/owi/Owi/Concolic_value/V'/index.html +++ b/api/owi/Owi/Concolic_value/V'/index.html @@ -1,2 +1,2 @@ -V' (owi.Owi.Concolic_value.V')

Module Concolic_value.V'

type t =
  1. | I32 of int32
  2. | I64 of int64
  3. | F32 of float32
  4. | F64 of float64
  5. | Ref of ref_value
val const_i32 : Int32.t -> int32
val const_i64 : Int64.t -> int64
val const_f32 : Float32.t -> float32
val const_f64 : Float64.t -> float64
val ref_null : Types.binary Types.heap_type -> t
val ref_func : Func_intf.t -> t
val ref_externref : 'a Stdlib.Type.Id.t -> 'a -> t
val ref_is_null : ref_value -> vbool
val pp : Format.formatter -> t -> unit
module Ref : sig ... end
module Bool : sig ... end
module F32 : sig ... end
module F64 : sig ... end
module I32 : sig ... end
module I64 : sig ... end
+V' (owi.Owi.Concolic_value.V')

Module Concolic_value.V'

val pp_int32 : Prelude.Fmt.formatter -> int32 -> unit
val pp_int64 : Prelude.Fmt.formatter -> int64 -> unit
val pp_float32 : Prelude.Fmt.formatter -> float32 -> unit
val pp_float64 : Prelude.Fmt.formatter -> float64 -> unit
val pp_ref_value : Prelude.Fmt.formatter -> ref_value -> unit
type t =
  1. | I32 of int32
  2. | I64 of int64
  3. | F32 of float32
  4. | F64 of float64
  5. | Ref of ref_value
val pp : Prelude.Fmt.formatter -> t -> unit
val const_i32 : Int32.t -> int32
val const_i64 : Int64.t -> int64
val const_f32 : Float32.t -> float32
val const_f64 : Float64.t -> float64
val ref_null : Types.binary Types.heap_type -> t
val ref_func : Func_intf.t -> t
val ref_externref : 'a Prelude.Type.Id.t -> 'a -> t
val ref_is_null : ref_value -> vbool
module Ref : sig ... end
module Bool : sig ... end
module F32 : sig ... end
module F64 : sig ... end
module I32 : sig ... end
module I64 : sig ... end
diff --git a/api/owi/Owi/Concolic_value/V/I32/index.html b/api/owi/Owi/Concolic_value/V/I32/index.html index 21df6e6f5..31fe61fe8 100644 --- a/api/owi/Owi/Concolic_value/V/I32/index.html +++ b/api/owi/Owi/Concolic_value/V/I32/index.html @@ -52,7 +52,7 @@ (Owi.Concrete.Value.int32, Symbolic_value.int32) cs -> (Owi.Concrete.Value.int32, Symbolic_value.int32) cs
val eq_const : (Owi.Concrete.Value.int32, Symbolic_value.int32) cs -> - Stdlib.Int32.t -> + Int32.t -> vbool
val eq : (Owi.Concrete.Value.int32, Symbolic_value.int32) cs -> (Owi.Concrete.Value.int32, Symbolic_value.int32) cs -> diff --git a/api/owi/Owi/Concolic_value/V/I64/index.html b/api/owi/Owi/Concolic_value/V/I64/index.html index 0efb10ae5..9c11dca6e 100644 --- a/api/owi/Owi/Concolic_value/V/I64/index.html +++ b/api/owi/Owi/Concolic_value/V/I64/index.html @@ -52,7 +52,7 @@ (Owi.Concrete.Value.int64, Symbolic_value.int64) cs -> (Owi.Concrete.Value.int64, Symbolic_value.int64) cs
val eq_const : (Owi.Concrete.Value.int64, Symbolic_value.int64) cs -> - Stdlib.Int64.t -> + Int64.t -> vbool
val eq : (Owi.Concrete.Value.int64, Symbolic_value.int64) cs -> (Owi.Concrete.Value.int64, Symbolic_value.int64) cs -> diff --git a/api/owi/Owi/Concolic_value/V/Ref/index.html b/api/owi/Owi/Concolic_value/V/Ref/index.html index 3a1ca4787..f226e52d3 100644 --- a/api/owi/Owi/Concolic_value/V/Ref/index.html +++ b/api/owi/Owi/Concolic_value/V/Ref/index.html @@ -3,5 +3,5 @@ (Owi.Concrete.Value.ref_value, Symbolic_value.ref_value) cs -> Func_intf.t Value_intf.get_ref
val get_externref : (Owi.Concrete.Value.ref_value, Symbolic_value.ref_value) cs -> - 'a Stdlib.Type.Id.t -> + 'a Prelude.Type.Id.t -> 'b Value_intf.get_ref
diff --git a/api/owi/Owi/Concolic_value/V/index.html b/api/owi/Owi/Concolic_value/V/index.html index 76d0b3464..e470195d3 100644 --- a/api/owi/Owi/Concolic_value/V/index.html +++ b/api/owi/Owi/Concolic_value/V/index.html @@ -1,5 +1,20 @@ -V (owi.Owi.Concolic_value.V)

Module Concolic_value.V

type t = T_pair(Owi.Concrete.Value)(Symbolic_value).t =
  1. | I32 of int32
  2. | I64 of int64
  3. | F32 of float32
  4. | F64 of float64
  5. | Ref of ref_value
val pair : 'a -> 'b -> ('c, 'd) cs
val value_pair : Owi.Concrete.Value.t -> Symbolic_value.t -> t
val concrete_value : t -> Owi.Concrete.Value.t
val symbolic_value : t -> Symbolic_value.t
val f_pair_1 : ('a -> 'b) -> ('c -> 'd) -> ('e, 'f) cs -> ('g, 'h) cs
val f_pair_2 : +V (owi.Owi.Concolic_value.V)

Module Concolic_value.V

val pp_int32 : + Stdlib.Format.formatter -> + (Owi.Concrete.Value.int32, Symbolic_value.int32) cs -> + unit
val pp_int64 : + Stdlib.Format.formatter -> + (Owi.Concrete.Value.int64, Symbolic_value.int64) cs -> + unit
val pp_float32 : + Stdlib.Format.formatter -> + (Owi.Concrete.Value.float32, Symbolic_value.float32) cs -> + unit
val pp_float64 : + Stdlib.Format.formatter -> + (Owi.Concrete.Value.float64, Symbolic_value.float64) cs -> + unit
val pp_ref_value : + Stdlib.Format.formatter -> + (Owi.Concrete.Value.ref_value, Symbolic_value.ref_value) cs -> + unit
type t = T_pair(Owi.Concrete.Value)(Symbolic_value).t =
  1. | I32 of int32
  2. | I64 of int64
  3. | F32 of float32
  4. | F64 of float64
  5. | Ref of ref_value
val pair : 'a -> 'b -> ('c, 'd) cs
val value_pair : Owi.Concrete.Value.t -> Symbolic_value.t -> t
val concrete_value : t -> Owi.Concrete.Value.t
val symbolic_value : t -> Symbolic_value.t
val f_pair_1 : ('a -> 'b) -> ('c -> 'd) -> ('e, 'f) cs -> ('g, 'h) cs
val f_pair_2 : ('a -> 'b -> 'c) -> ('d -> 'e -> 'f) -> ('g, 'h) cs -> @@ -18,14 +33,14 @@ Float32.t -> (Owi.Concrete.Value.float32, Symbolic_value.float32) cs
val ref_null : Types.binary Types.heap_type -> t
val ref_func : Func_intf.t -> t
val ref_externref : 'a Stdlib.Type.Id.t -> 'b -> t
val ref_null : Types.binary Types.heap_type -> t
val ref_func : Func_intf.t -> t
val ref_externref : 'a Prelude.Type.Id.t -> 'b -> t
val mk_pp : (Stdlib.Format.formatter -> 'a -> unit) -> (Stdlib.Format.formatter -> 'b -> unit) -> Stdlib.Format.formatter -> ('c, 'd) cs -> - unit
val pp : 'a -> 'b -> 'c
module Ref : sig ... end
module Bool : sig ... end
module type CFop = sig ... end
module type SFop = sig ... end
module MK_Fop + unit
val pp : Stdlib.Format.formatter -> t -> unit
module Ref : sig ... end
module Bool : sig ... end
module type CFop = sig ... end
module type SFop = sig ... end
module MK_Fop (CT : T) (CIT : T) (ST : T) diff --git a/api/owi/Owi/Concolic_wasm_ffi/index.html b/api/owi/Owi/Concolic_wasm_ffi/index.html new file mode 100644 index 000000000..dea93e8d0 --- /dev/null +++ b/api/owi/Owi/Concolic_wasm_ffi/index.html @@ -0,0 +1,3 @@ + +Concolic_wasm_ffi (owi.Owi.Concolic_wasm_ffi)

Module Owi.Concolic_wasm_ffi

include Wasm_ffi_intf.S + with type extern_func = Concolic.P.Extern_func.extern_func
val symbolic_extern_module : extern_func Link.extern_module
val summaries_extern_module : extern_func Link.extern_module
diff --git a/api/owi/Owi/Concrete/Extern_func/index.html b/api/owi/Owi/Concrete/Extern_func/index.html index daaf7daa2..fa65146cd 100644 --- a/api/owi/Owi/Concrete/Extern_func/index.html +++ b/api/owi/Owi/Concrete/Extern_func/index.html @@ -1,2 +1,2 @@ -Extern_func (owi.Owi.Concrete.Extern_func)

Module Concrete.Extern_func

type _ telt =
  1. | I32 : Value.int32 telt
  2. | I64 : Value.int64 telt
  3. | F32 : Value.float32 telt
  4. | F64 : Value.float64 telt
  5. | Externref : 'a Stdlib.Type.Id.t -> 'a telt
type _ rtype =
  1. | R0 : unit rtype
  2. | R1 : 'a telt -> 'a rtype
  3. | R2 : 'a telt * 'b telt -> ('a * 'b) rtype
  4. | R3 : 'a telt * 'b telt * 'c telt -> ('a * 'b * 'c) rtype
  5. | R4 : 'a telt * 'b telt * 'c telt * 'd telt -> ('a * 'b * 'c * 'd) rtype
type (_, _) atype =
  1. | UArg : ('b, 'r) atype -> (unit -> 'b, 'r) atype
  2. | Arg : 'a telt * ('b, 'r) atype -> ('a -> 'b, 'r) atype
  3. | NArg : string * 'a telt * ('b, 'r) atype -> ('a -> 'b, 'r) atype
  4. | Res : ('r, 'r) atype
type _ func_type =
  1. | Func : ('f, 'r Choice.t) atype * 'r rtype -> 'f func_type
type extern_func =
  1. | Extern_func : 'a func_type * 'a -> extern_func
+Extern_func (owi.Owi.Concrete.Extern_func)

Module Concrete.Extern_func

type _ telt =
  1. | I32 : Value.int32 telt
  2. | I64 : Value.int64 telt
  3. | F32 : Value.float32 telt
  4. | F64 : Value.float64 telt
  5. | Externref : 'a Prelude.Type.Id.t -> 'a telt
type _ rtype =
  1. | R0 : unit rtype
  2. | R1 : 'a telt -> 'a rtype
  3. | R2 : 'a telt * 'b telt -> ('a * 'b) rtype
  4. | R3 : 'a telt * 'b telt * 'c telt -> ('a * 'b * 'c) rtype
  5. | R4 : 'a telt * 'b telt * 'c telt * 'd telt -> ('a * 'b * 'c * 'd) rtype
type (_, _) atype =
  1. | Mem : ('b, 'r) atype -> (Memory.t -> 'b, 'r) atype
  2. | UArg : ('b, 'r) atype -> (unit -> 'b, 'r) atype
  3. | Arg : 'a telt * ('b, 'r) atype -> ('a -> 'b, 'r) atype
  4. | NArg : string * 'a telt * ('b, 'r) atype -> ('a -> 'b, 'r) atype
  5. | Res : ('r, 'r) atype
type _ func_type =
  1. | Func : ('f, 'r Choice.t) atype * 'r rtype -> 'f func_type
type extern_func =
  1. | Extern_func : 'a func_type * 'a -> extern_func
diff --git a/api/owi/Owi/Concrete/index.html b/api/owi/Owi/Concrete/index.html index 27a1dcdb2..a172b022c 100644 --- a/api/owi/Owi/Concrete/index.html +++ b/api/owi/Owi/Concrete/index.html @@ -8,10 +8,11 @@ Value.vbool -> if_true:Value.t -> if_false:Value.t -> - Value.t Choice.t
module Global : sig ... end
module Table : sig ... end
module Memory : sig ... end
module Extern_func : Func_intf.T_Extern_func with type int32 := Value.int32 and type int64 := Value.int64 and type float32 := Value.float32 and type float64 := Value.float64 - and type 'a m := 'a Choice.t
module Global : sig ... end
module Table : sig ... end
module Memory : sig ... end
module Data : sig ... end
module Elem : sig ... end
module Env : sig ... end
module Module_to_run : sig ... end
+ and type 'a m := 'a Choice.t + and type memory := Memory.t
module Data : sig ... end
module Elem : sig ... end
module Env : sig ... end
module Module_to_run : sig ... end
diff --git a/api/owi/Owi/Concrete_global/index.html b/api/owi/Owi/Concrete_global/index.html index 68bca91f4..030117816 100644 --- a/api/owi/Owi/Concrete_global/index.html +++ b/api/owi/Owi/Concrete_global/index.html @@ -1,2 +1,2 @@ -Concrete_global (owi.Owi.Concrete_global)

Module Owi.Concrete_global

runtime global

type t = {
  1. mutable value : Concrete_value.t;
  2. label : string option;
  3. mut : Types.mut;
  4. typ : Types.binary Types.val_type;
}
val value : t -> Concrete_value.t
val set_value : t -> Concrete_value.t -> unit
val mut : t -> Types.mut
+Concrete_global (owi.Owi.Concrete_global)

Module Owi.Concrete_global

runtime global

type t = {
  1. mutable value : Concrete_value.t;
  2. label : string option;
  3. mut : Types.mut;
  4. typ : Types.binary Types.val_type;
}
val value : t -> Concrete_value.t
val set_value : t -> Concrete_value.t -> unit
val mut : t -> Types.mut
val backup : t -> t
val recover : from_:t -> to_:t -> unit
diff --git a/api/owi/Owi/Concrete_memory/index.html b/api/owi/Owi/Concrete_memory/index.html index 14d18b773..7592aefa1 100644 --- a/api/owi/Owi/Concrete_memory/index.html +++ b/api/owi/Owi/Concrete_memory/index.html @@ -1,2 +1,2 @@ -Concrete_memory (owi.Owi.Concrete_memory)

Module Owi.Concrete_memory

type t

runtime memory

val get_limit_max : t -> int64 option
val get_limits : t -> Types.limits
val init : Types.limits -> t
val update_memory : t -> bytes -> unit
val load_8_s : t -> int32 -> int32
val load_8_u : t -> int32 -> int32
val load_16_s : t -> int32 -> int32
val load_16_u : t -> int32 -> int32
val load_32 : t -> int32 -> int32
val load_64 : t -> int32 -> int64
val store_8 : t -> addr:int32 -> int32 -> unit
val store_16 : t -> addr:int32 -> int32 -> unit
val store_32 : t -> addr:int32 -> int32 -> unit
val store_64 : t -> addr:int32 -> int64 -> unit
val grow : t -> int32 -> unit
val fill : t -> pos:int32 -> len:int32 -> char -> bool
val blit : t -> src:int32 -> dst:int32 -> len:int32 -> bool
val blit_string : t -> string -> src:int32 -> dst:int32 -> len:int32 -> bool
val size_in_pages : t -> int32
val size : t -> int32
+Concrete_memory (owi.Owi.Concrete_memory)

Module Owi.Concrete_memory

type t

runtime memory

val backup : t -> t
val recover : from_:t -> to_:t -> unit
val get_limit_max : t -> int64 option
val get_limits : t -> Types.limits
val init : Types.limits -> t
val update_memory : t -> bytes -> unit
val load_8_s : t -> int32 -> int32
val load_8_u : t -> int32 -> int32
val load_16_s : t -> int32 -> int32
val load_16_u : t -> int32 -> int32
val load_32 : t -> int32 -> int32
val load_64 : t -> int32 -> int64
val store_8 : t -> addr:int32 -> int32 -> unit
val store_16 : t -> addr:int32 -> int32 -> unit
val store_32 : t -> addr:int32 -> int32 -> unit
val store_64 : t -> addr:int32 -> int64 -> unit
val grow : t -> int32 -> unit
val fill : t -> pos:int32 -> len:int32 -> char -> bool
val blit : t -> src:int32 -> dst:int32 -> len:int32 -> bool
val blit_string : t -> string -> src:int32 -> dst:int32 -> len:int32 -> bool
val size_in_pages : t -> int32
val size : t -> int32
diff --git a/api/owi/Owi/Concrete_table/index.html b/api/owi/Owi/Concrete_table/index.html index f34fb5d82..f91112c80 100644 --- a/api/owi/Owi/Concrete_table/index.html +++ b/api/owi/Owi/Concrete_table/index.html @@ -1,2 +1,2 @@ -Concrete_table (owi.Owi.Concrete_table)

Module Owi.Concrete_table

runtime table

type table = Concrete_value.ref_value array
type t = {
  1. id : int;
  2. label : string option;
  3. limits : Types.limits;
  4. typ : Types.binary Types.ref_type;
  5. mutable data : table;
}
val get : t -> int -> Concrete_value.ref_value
val set : t -> int -> Concrete_value.ref_value -> unit
val size : t -> int
val update : t -> table -> unit
val init : ?label:string -> Types.binary Types.table_type -> t
val max_size : t -> int option
val grow : t -> int32 -> Concrete_value.ref_value -> unit
val fill : t -> int32 -> int32 -> Concrete_value.ref_value -> unit
val copy : t_src:t -> t_dst:t -> src:int32 -> dst:int32 -> len:int32 -> unit
+Concrete_table (owi.Owi.Concrete_table)

Module Owi.Concrete_table

runtime table

type table = Concrete_value.ref_value array
type t = {
  1. id : int;
  2. label : string option;
  3. limits : Types.limits;
  4. typ : Types.binary Types.ref_type;
  5. mutable data : table;
}
val backup : t -> t
val recover : from_:t -> to_:t -> unit
val get : t -> int -> Concrete_value.ref_value
val set : t -> int -> Concrete_value.ref_value -> unit
val size : t -> int
val update : t -> table -> unit
val init : ?label:string -> Types.binary Types.table_type -> t
val max_size : t -> int option
val grow : t -> int32 -> Concrete_value.ref_value -> unit
val fill : t -> int32 -> int32 -> Concrete_value.ref_value -> unit
val copy : t_src:t -> t_dst:t -> src:int32 -> dst:int32 -> len:int32 -> unit
diff --git a/api/owi/Owi/Concrete_value/Func/index.html b/api/owi/Owi/Concrete_value/Func/index.html index f3d113efe..822762df2 100644 --- a/api/owi/Owi/Concrete_value/Func/index.html +++ b/api/owi/Owi/Concrete_value/Func/index.html @@ -4,4 +4,5 @@ with type int64 := Int64.t with type float32 := Float32.t with type float64 := Float64.t - with type 'a m := 'a
type _ telt =
  1. | I32 : Int32.t telt
  2. | I64 : Int64.t telt
  3. | F32 : Float32.t telt
  4. | F64 : Float64.t telt
  5. | Externref : 'a Stdlib.Type.Id.t -> 'a telt
type _ rtype =
  1. | R0 : unit rtype
  2. | R1 : 'a telt -> 'a rtype
  3. | R2 : 'a telt * 'b telt -> ('a * 'b) rtype
  4. | R3 : 'a telt * 'b telt * 'c telt -> ('a * 'b * 'c) rtype
  5. | R4 : 'a telt * 'b telt * 'c telt * 'd telt -> ('a * 'b * 'c * 'd) rtype
type (_, _) atype =
  1. | UArg : ('b, 'r) atype -> (unit -> 'b, 'r) atype
  2. | Arg : 'a telt * ('b, 'r) atype -> ('a -> 'b, 'r) atype
  3. | NArg : string * 'a telt * ('b, 'r) atype -> ('a -> 'b, 'r) atype
  4. | Res : ('r, 'r) atype
type _ func_type =
  1. | Func : ('f, 'r) atype * 'r rtype -> 'f func_type
type extern_func =
  1. | Extern_func : 'a func_type * 'a -> extern_func
type nonrec t = Func_intf.t
val wasm : Types.binary Types.func -> Env_id.t -> t
+ with type 'a m := 'a + with type memory := Concrete_memory.t
type _ telt =
  1. | I32 : Int32.t telt
  2. | I64 : Int64.t telt
  3. | F32 : Float32.t telt
  4. | F64 : Float64.t telt
  5. | Externref : 'a Prelude.Type.Id.t -> 'a telt
type _ rtype =
  1. | R0 : unit rtype
  2. | R1 : 'a telt -> 'a rtype
  3. | R2 : 'a telt * 'b telt -> ('a * 'b) rtype
  4. | R3 : 'a telt * 'b telt * 'c telt -> ('a * 'b * 'c) rtype
  5. | R4 : 'a telt * 'b telt * 'c telt * 'd telt -> ('a * 'b * 'c * 'd) rtype
type (_, _) atype =
  1. | Mem : ('b, 'r) atype -> (Concrete_memory.t -> 'b, 'r) atype
  2. | UArg : ('b, 'r) atype -> (unit -> 'b, 'r) atype
  3. | Arg : 'a telt * ('b, 'r) atype -> ('a -> 'b, 'r) atype
  4. | NArg : string * 'a telt * ('b, 'r) atype -> ('a -> 'b, 'r) atype
  5. | Res : ('r, 'r) atype
type _ func_type =
  1. | Func : ('f, 'r) atype * 'r rtype -> 'f func_type
type extern_func =
  1. | Extern_func : 'a func_type * 'a -> extern_func
val extern_type : extern_func -> Types.binary Types.func_type
type nonrec t = Func_intf.t
val wasm : Types.binary Types.func -> Env_id.t -> t
diff --git a/api/owi/Owi/Concrete_value/Make_extern_func/argument-3-Memory/index.html b/api/owi/Owi/Concrete_value/Make_extern_func/argument-3-Memory/index.html new file mode 100644 index 000000000..6990c747a --- /dev/null +++ b/api/owi/Owi/Concrete_value/Make_extern_func/argument-3-Memory/index.html @@ -0,0 +1,2 @@ + +Memory (owi.Owi.Concrete_value.Make_extern_func.Memory)

Parameter Make_extern_func.Memory

type t
diff --git a/api/owi/Owi/Concrete_value/Make_extern_func/index.html b/api/owi/Owi/Concrete_value/Make_extern_func/index.html index 9e39f8319..7cce999cc 100644 --- a/api/owi/Owi/Concrete_value/Make_extern_func/index.html +++ b/api/owi/Owi/Concrete_value/Make_extern_func/index.html @@ -1,2 +1,2 @@ -Make_extern_func (owi.Owi.Concrete_value.Make_extern_func)

Module Concrete_value.Make_extern_func

Parameters

Signature

type _ telt =
  1. | I32 : V.int32 telt
  2. | I64 : V.int64 telt
  3. | F32 : V.float32 telt
  4. | F64 : V.float64 telt
  5. | Externref : 'a Stdlib.Type.Id.t -> 'a telt
type _ rtype =
  1. | R0 : unit rtype
  2. | R1 : 'a telt -> 'a rtype
  3. | R2 : 'a telt * 'b telt -> ('a * 'b) rtype
  4. | R3 : 'a telt * 'b telt * 'c telt -> ('a * 'b * 'c) rtype
  5. | R4 : 'a telt * 'b telt * 'c telt * 'd telt -> ('a * 'b * 'c * 'd) rtype
type (_, _) atype =
  1. | UArg : ('b, 'r) atype -> (unit -> 'b, 'r) atype
  2. | Arg : 'a telt * ('b, 'r) atype -> ('a -> 'b, 'r) atype
  3. | NArg : string * 'a telt * ('b, 'r) atype -> ('a -> 'b, 'r) atype
  4. | Res : ('r, 'r) atype
type _ func_type =
  1. | Func : ('f, 'r M.t) atype * 'r rtype -> 'f func_type
type extern_func =
  1. | Extern_func : 'a func_type * 'a -> extern_func
+Make_extern_func (owi.Owi.Concrete_value.Make_extern_func)

Module Concrete_value.Make_extern_func

Parameters

Signature

type _ telt =
  1. | I32 : V.int32 telt
  2. | I64 : V.int64 telt
  3. | F32 : V.float32 telt
  4. | F64 : V.float64 telt
  5. | Externref : 'a Prelude.Type.Id.t -> 'a telt
type _ rtype =
  1. | R0 : unit rtype
  2. | R1 : 'a telt -> 'a rtype
  3. | R2 : 'a telt * 'b telt -> ('a * 'b) rtype
  4. | R3 : 'a telt * 'b telt * 'c telt -> ('a * 'b * 'c) rtype
  5. | R4 : 'a telt * 'b telt * 'c telt * 'd telt -> ('a * 'b * 'c * 'd) rtype
type (_, _) atype =
  1. | Mem : ('b, 'r) atype -> (Memory.t -> 'b, 'r) atype
  2. | UArg : ('b, 'r) atype -> (unit -> 'b, 'r) atype
  3. | Arg : 'a telt * ('b, 'r) atype -> ('a -> 'b, 'r) atype
  4. | NArg : string * 'a telt * ('b, 'r) atype -> ('a -> 'b, 'r) atype
  5. | Res : ('r, 'r) atype
type _ func_type =
  1. | Func : ('f, 'r M.t) atype * 'r rtype -> 'f func_type
type extern_func =
  1. | Extern_func : 'a func_type * 'a -> extern_func
diff --git a/api/owi/Owi/Concrete_value/index.html b/api/owi/Owi/Concrete_value/index.html index 132057a5c..cbbb9c76a 100644 --- a/api/owi/Owi/Concrete_value/index.html +++ b/api/owi/Owi/Concrete_value/index.html @@ -1,16 +1,19 @@ -Concrete_value (owi.Owi.Concrete_value)

Module Owi.Concrete_value

Module to define externref values in OCaml. You should look in the `example` directory to understand how to use this before reading the code...

type externref =
  1. | E : 'a Stdlib.Type.Id.t * 'a -> externref
module Make_extern_func +Concrete_value (owi.Owi.Concrete_value)

Module Owi.Concrete_value

Module to define externref values in OCaml. You should look in the `example` directory to understand how to use this before reading the code...

type externref =
  1. | E : 'a Prelude.Type.Id.t * 'a -> externref
module Func : + and type 'a m := 'a M.t + and type memory := Memory.t
module Func : Func_intf.T with type int32 := Int32.t and type int64 := Int64.t and type float32 := Float32.t and type float64 := Float64.t - and type 'a m := 'a
type ref_value =
  1. | Externref of externref option
  2. | Funcref of Func_intf.t option
  3. | Arrayref of unit array option
type t =
  1. | I32 of Int32.t
  2. | I64 of Int64.t
  3. | F32 of Float32.t
  4. | F64 of Float64.t
  5. | Ref of ref_value
val cast_ref : externref -> 'a Stdlib.Type.Id.t -> 'a option
val of_instr : Types.binary Types.instr -> t
val to_instr : t -> Types.binary Types.instr
val ref_null : Types.binary Types.heap_type -> t
val ref_func : Func.t -> t
val ref_externref : 'a Stdlib.Type.Id.t -> 'a -> t
val ref_is_null : ref_value -> bool
val pp : Format.formatter -> t -> unit
+ and type 'a m := 'a + and type memory := Concrete_memory.t
type ref_value =
  1. | Externref of externref option
  2. | Funcref of Func_intf.t option
  3. | Arrayref of unit array option
val pp_ref_value : Prelude.Fmt.formatter -> ref_value -> unit
type t =
  1. | I32 of Int32.t
  2. | I64 of Int64.t
  3. | F32 of Float32.t
  4. | F64 of Float64.t
  5. | Ref of ref_value
val cast_ref : externref -> 'a Prelude.Type.Id.t -> 'a option
val of_instr : Types.binary Types.instr -> t
val to_instr : t -> Types.binary Types.instr
val ref_null : Types.binary Types.heap_type -> t
val ref_func : Func.t -> t
val ref_externref : 'a Prelude.Type.Id.t -> 'a -> t
val ref_is_null : ref_value -> bool
val pp : Prelude.Fmt.formatter -> t -> unit
diff --git a/api/owi/Owi/Env_id/index.html b/api/owi/Owi/Env_id/index.html index 86779a166..2d7fdee5a 100644 --- a/api/owi/Owi/Env_id/index.html +++ b/api/owi/Owi/Env_id/index.html @@ -2,4 +2,4 @@ Env_id (owi.Owi.Env_id)

Module Owi.Env_id

type t
type 'a collection
val empty : 'a collection
val with_fresh_id : (t -> ('a * 'b) Result.t) -> 'a collection -> - ('a collection * 'b) Result.t
val get : t -> 'a collection -> 'a
val map : ('a -> 'b) -> 'a collection -> 'b collection
module Map : Stdlib.Map.S with type key = t
module Tbl : Stdlib.Hashtbl.S with type key = t
+ ('a collection * 'b) Result.t
val get : t -> 'a collection -> 'a
val map : ('a -> 'b) -> 'a collection -> 'b collection
module Map : Prelude.Map.S with type key = t
module Tbl : Prelude.Hashtbl.S with type key = t
diff --git a/api/owi/Owi/Float32/index.html b/api/owi/Owi/Float32/index.html index d5e910ca4..28cdf12dd 100644 --- a/api/owi/Owi/Float32/index.html +++ b/api/owi/Owi/Float32/index.html @@ -1,2 +1,2 @@ -Float32 (owi.Owi.Float32)

Module Owi.Float32

Custom Float32 module for Wasm.

type t
val neg_nan : t
val pos_nan : t
val of_bits : Int32.t -> t
val to_bits : t -> Int32.t
val zero : t
val add : t -> t -> t
val sub : t -> t -> t
val mul : t -> t -> t
val div : t -> t -> t
val neg : t -> t
val abs : t -> t
val sqrt : t -> t
val ceil : t -> t
val floor : t -> t
val trunc : t -> t
val nearest : t -> t
val min : t -> t -> t
val max : t -> t -> t
val copy_sign : t -> t -> t
val eq : t -> t -> bool
val ne : t -> t -> bool
val lt : t -> t -> bool
val gt : t -> t -> bool
val le : t -> t -> bool
val ge : t -> t -> bool
val of_string : string -> t
val to_hex_string : t -> string
val to_string : t -> string
val to_float : t -> Stdlib.Float.t
val of_float : Stdlib.Float.t -> t
val pp : Format.formatter -> t -> unit
+Float32 (owi.Owi.Float32)

Module Owi.Float32

Custom Float32 module for Wasm.

type t
val neg_nan : t
val pos_nan : t
val is_neg_nan : t -> bool
val is_pos_nan : t -> bool
val of_bits : Int32.t -> t
val to_bits : t -> Int32.t
val zero : t
val add : t -> t -> t
val sub : t -> t -> t
val mul : t -> t -> t
val div : t -> t -> t
val neg : t -> t
val abs : t -> t
val sqrt : t -> t
val ceil : t -> t
val floor : t -> t
val trunc : t -> t
val nearest : t -> t
val min : t -> t -> t
val max : t -> t -> t
val copy_sign : t -> t -> t
val eq : t -> t -> bool
val ne : t -> t -> bool
val lt : t -> t -> bool
val gt : t -> t -> bool
val le : t -> t -> bool
val ge : t -> t -> bool
val of_string : string -> t
val to_hex_string : t -> string
val to_string : t -> string
val to_float : t -> Prelude.Float.t
val of_float : Prelude.Float.t -> t
val pp : Prelude.Fmt.formatter -> t -> unit
diff --git a/api/owi/Owi/Float64/index.html b/api/owi/Owi/Float64/index.html index 37dfd295f..ba2a383f1 100644 --- a/api/owi/Owi/Float64/index.html +++ b/api/owi/Owi/Float64/index.html @@ -1,2 +1,2 @@ -Float64 (owi.Owi.Float64)

Module Owi.Float64

Custom Float64 module for Wasm.

type t
val neg_nan : t
val pos_nan : t
val of_bits : Int64.t -> t
val to_bits : t -> Int64.t
val zero : t
val add : t -> t -> t
val sub : t -> t -> t
val mul : t -> t -> t
val div : t -> t -> t
val neg : t -> t
val abs : t -> t
val sqrt : t -> t
val ceil : t -> t
val floor : t -> t
val trunc : t -> t
val nearest : t -> t
val min : t -> t -> t
val max : t -> t -> t
val copy_sign : t -> t -> t
val eq : t -> t -> bool
val ne : t -> t -> bool
val lt : t -> t -> bool
val gt : t -> t -> bool
val le : t -> t -> bool
val ge : t -> t -> bool
val of_string : string -> t
val to_hex_string : t -> string
val to_string : t -> string
val to_float : t -> Stdlib.Float.t
val of_float : Stdlib.Float.t -> t
val pp : Format.formatter -> t -> unit
+Float64 (owi.Owi.Float64)

Module Owi.Float64

Custom Float64 module for Wasm.

type t
val neg_nan : t
val pos_nan : t
val is_neg_nan : t -> bool
val is_pos_nan : t -> bool
val of_bits : Int64.t -> t
val to_bits : t -> Int64.t
val zero : t
val add : t -> t -> t
val sub : t -> t -> t
val mul : t -> t -> t
val div : t -> t -> t
val neg : t -> t
val abs : t -> t
val sqrt : t -> t
val ceil : t -> t
val floor : t -> t
val trunc : t -> t
val nearest : t -> t
val min : t -> t -> t
val max : t -> t -> t
val copy_sign : t -> t -> t
val eq : t -> t -> bool
val ne : t -> t -> bool
val lt : t -> t -> bool
val gt : t -> t -> bool
val le : t -> t -> bool
val ge : t -> t -> bool
val of_string : string -> t
val to_hex_string : t -> string
val to_string : t -> string
val to_float : t -> Prelude.Float.t
val of_float : Prelude.Float.t -> t
val pp : Prelude.Fmt.formatter -> t -> unit
diff --git a/api/owi/Owi/Format/index.html b/api/owi/Owi/Format/index.html deleted file mode 100644 index 4b33dfe06..000000000 --- a/api/owi/Owi/Format/index.html +++ /dev/null @@ -1,26 +0,0 @@ - -Format (owi.Owi.Format)

Module Owi.Format

type formatter = Stdlib.Format.formatter
val pp : formatter -> ('a, formatter, unit) Stdlib.format -> 'a
val pp_err : ('a, formatter, unit) Stdlib.format -> 'a
val pp_std : ('a, formatter, unit) Stdlib.format -> 'a
val pp_nothing : formatter -> unit -> unit
val pp_space : formatter -> unit -> unit
val pp_bool : formatter -> bool -> unit
val pp_char : formatter -> char -> unit
val pp_int : formatter -> int -> unit
val pp_flush : formatter -> unit -> unit
val pp_list : - ?pp_sep:(formatter -> unit -> unit) -> - (formatter -> 'a -> unit) -> - formatter -> - 'a list -> - unit
val pp_array : - ?pp_sep:(formatter -> unit -> unit) -> - (formatter -> 'a -> unit) -> - formatter -> - 'a array -> - unit
val pp_iter : - ?pp_sep:(formatter -> unit -> unit) -> - (('a -> unit) -> 'b -> unit) -> - (formatter -> 'a -> unit) -> - formatter -> - 'b -> - unit
val pp_string : formatter -> string -> unit
val pp_option : - ?none:(formatter -> unit -> unit) -> - (formatter -> 'a -> unit) -> - formatter -> - 'a option -> - unit
val pp_newline : formatter -> unit -> unit
val sprintf : ('a, unit, string) Stdlib.format -> 'a
val ksprintf : (string -> 'a) -> ('b, unit, string, 'a) Stdlib.format4 -> 'b
val asprintf : ('a, formatter, unit, string) Stdlib.format4 -> 'a
val kasprintf : - (string -> 'a) -> - ('b, formatter, unit, 'a) Stdlib.format4 -> - 'b
diff --git a/api/owi/Owi/Func_intf/index.html b/api/owi/Owi/Func_intf/index.html index 7088396c0..c6c647b8b 100644 --- a/api/owi/Owi/Func_intf/index.html +++ b/api/owi/Owi/Func_intf/index.html @@ -1,2 +1,2 @@ -Func_intf (owi.Owi.Func_intf)

Module Owi.Func_intf

module type Value_types = sig ... end
module type Monad_type = sig ... end
module type T_Extern_func = sig ... end
type t =
  1. | WASM of int * Types.binary Types.func * Env_id.t
  2. | Extern of Func_id.t
module type T = sig ... end
+Func_intf (owi.Owi.Func_intf)

Module Owi.Func_intf

module type Value_types = sig ... end
module type Monad_type = sig ... end
module type Memory_type = sig ... end
module type T_Extern_func = sig ... end
type t =
  1. | WASM of int * Types.binary Types.func * Env_id.t
  2. | Extern of Func_id.t
module type T = sig ... end
diff --git a/api/owi/Owi/Func_intf/module-type-Memory_type/index.html b/api/owi/Owi/Func_intf/module-type-Memory_type/index.html new file mode 100644 index 000000000..c8a2ad053 --- /dev/null +++ b/api/owi/Owi/Func_intf/module-type-Memory_type/index.html @@ -0,0 +1,2 @@ + +Memory_type (owi.Owi.Func_intf.Memory_type)

Module type Func_intf.Memory_type

type t
diff --git a/api/owi/Owi/Func_intf/module-type-T/index.html b/api/owi/Owi/Func_intf/module-type-T/index.html index 7ff7f8b7e..5d5d42e7c 100644 --- a/api/owi/Owi/Func_intf/module-type-T/index.html +++ b/api/owi/Owi/Func_intf/module-type-T/index.html @@ -1,2 +1,2 @@ -T (owi.Owi.Func_intf.T)

Module type Func_intf.T

include T_Extern_func
type int32
type int64
type float32
type float64
type 'a m
type _ telt =
  1. | I32 : int32 telt
  2. | I64 : int64 telt
  3. | F32 : float32 telt
  4. | F64 : float64 telt
  5. | Externref : 'a Stdlib.Type.Id.t -> 'a telt
type _ rtype =
  1. | R0 : unit rtype
  2. | R1 : 'a telt -> 'a rtype
  3. | R2 : 'a telt * 'b telt -> ('a * 'b) rtype
  4. | R3 : 'a telt * 'b telt * 'c telt -> ('a * 'b * 'c) rtype
  5. | R4 : 'a telt * 'b telt * 'c telt * 'd telt -> ('a * 'b * 'c * 'd) rtype
type (_, _) atype =
  1. | UArg : ('b, 'r) atype -> (unit -> 'b, 'r) atype
  2. | Arg : 'a telt * ('b, 'r) atype -> ('a -> 'b, 'r) atype
  3. | NArg : string * 'a telt * ('b, 'r) atype -> ('a -> 'b, 'r) atype
  4. | Res : ('r, 'r) atype
type _ func_type =
  1. | Func : ('f, 'r m) atype * 'r rtype -> 'f func_type
type extern_func =
  1. | Extern_func : 'a func_type * 'a -> extern_func
type nonrec t = t
+T (owi.Owi.Func_intf.T)

Module type Func_intf.T

include T_Extern_func
type int32
type int64
type float32
type float64
type 'a m
type memory
type _ telt =
  1. | I32 : int32 telt
  2. | I64 : int64 telt
  3. | F32 : float32 telt
  4. | F64 : float64 telt
  5. | Externref : 'a Prelude.Type.Id.t -> 'a telt
type _ rtype =
  1. | R0 : unit rtype
  2. | R1 : 'a telt -> 'a rtype
  3. | R2 : 'a telt * 'b telt -> ('a * 'b) rtype
  4. | R3 : 'a telt * 'b telt * 'c telt -> ('a * 'b * 'c) rtype
  5. | R4 : 'a telt * 'b telt * 'c telt * 'd telt -> ('a * 'b * 'c * 'd) rtype
type (_, _) atype =
  1. | Mem : ('b, 'r) atype -> (memory -> 'b, 'r) atype
  2. | UArg : ('b, 'r) atype -> (unit -> 'b, 'r) atype
  3. | Arg : 'a telt * ('b, 'r) atype -> ('a -> 'b, 'r) atype
  4. | NArg : string * 'a telt * ('b, 'r) atype -> ('a -> 'b, 'r) atype
  5. | Res : ('r, 'r) atype
type _ func_type =
  1. | Func : ('f, 'r m) atype * 'r rtype -> 'f func_type
type extern_func =
  1. | Extern_func : 'a func_type * 'a -> extern_func
type nonrec t = t
diff --git a/api/owi/Owi/Func_intf/module-type-T_Extern_func/index.html b/api/owi/Owi/Func_intf/module-type-T_Extern_func/index.html index de60c7fc8..70fb2313c 100644 --- a/api/owi/Owi/Func_intf/module-type-T_Extern_func/index.html +++ b/api/owi/Owi/Func_intf/module-type-T_Extern_func/index.html @@ -1,2 +1,2 @@ -T_Extern_func (owi.Owi.Func_intf.T_Extern_func)

Module type Func_intf.T_Extern_func

type int32
type int64
type float32
type float64
type 'a m
type _ telt =
  1. | I32 : int32 telt
  2. | I64 : int64 telt
  3. | F32 : float32 telt
  4. | F64 : float64 telt
  5. | Externref : 'a Stdlib.Type.Id.t -> 'a telt
type _ rtype =
  1. | R0 : unit rtype
  2. | R1 : 'a telt -> 'a rtype
  3. | R2 : 'a telt * 'b telt -> ('a * 'b) rtype
  4. | R3 : 'a telt * 'b telt * 'c telt -> ('a * 'b * 'c) rtype
  5. | R4 : 'a telt * 'b telt * 'c telt * 'd telt -> ('a * 'b * 'c * 'd) rtype
type (_, _) atype =
  1. | UArg : ('b, 'r) atype -> (unit -> 'b, 'r) atype
  2. | Arg : 'a telt * ('b, 'r) atype -> ('a -> 'b, 'r) atype
  3. | NArg : string * 'a telt * ('b, 'r) atype -> ('a -> 'b, 'r) atype
  4. | Res : ('r, 'r) atype
type _ func_type =
  1. | Func : ('f, 'r m) atype * 'r rtype -> 'f func_type
type extern_func =
  1. | Extern_func : 'a func_type * 'a -> extern_func
+T_Extern_func (owi.Owi.Func_intf.T_Extern_func)

Module type Func_intf.T_Extern_func

type int32
type int64
type float32
type float64
type 'a m
type memory
type _ telt =
  1. | I32 : int32 telt
  2. | I64 : int64 telt
  3. | F32 : float32 telt
  4. | F64 : float64 telt
  5. | Externref : 'a Prelude.Type.Id.t -> 'a telt
type _ rtype =
  1. | R0 : unit rtype
  2. | R1 : 'a telt -> 'a rtype
  3. | R2 : 'a telt * 'b telt -> ('a * 'b) rtype
  4. | R3 : 'a telt * 'b telt * 'c telt -> ('a * 'b * 'c) rtype
  5. | R4 : 'a telt * 'b telt * 'c telt * 'd telt -> ('a * 'b * 'c * 'd) rtype
type (_, _) atype =
  1. | Mem : ('b, 'r) atype -> (memory -> 'b, 'r) atype
  2. | UArg : ('b, 'r) atype -> (unit -> 'b, 'r) atype
  3. | Arg : 'a telt * ('b, 'r) atype -> ('a -> 'b, 'r) atype
  4. | NArg : string * 'a telt * ('b, 'r) atype -> ('a -> 'b, 'r) atype
  5. | Res : ('r, 'r) atype
type _ func_type =
  1. | Func : ('f, 'r m) atype * 'r rtype -> 'f func_type
type extern_func =
  1. | Extern_func : 'a func_type * 'a -> extern_func
diff --git a/api/owi/Owi/Indexed/index.html b/api/owi/Owi/Indexed/index.html index f4bb13296..46b104f10 100644 --- a/api/owi/Owi/Indexed/index.html +++ b/api/owi/Owi/Indexed/index.html @@ -1,2 +1,6 @@ -Indexed (owi.Owi.Indexed)

Module Owi.Indexed

type 'a t
val get : 'a t -> 'a
val get_index : 'a t -> int
val map : ('a -> 'b) -> 'a t -> 'b t
val return : int -> 'a -> 'a t
val get_at : int -> 'a t list -> 'a option
val get_at_exn : int -> 'a t list -> 'a
val has_index : int -> 'a t -> bool
val pp : (Format.formatter -> 'a -> unit) -> Format.formatter -> 'a t -> unit
+Indexed (owi.Owi.Indexed)

Module Owi.Indexed

type 'a t
val get : 'a t -> 'a
val get_index : 'a t -> int
val map : ('a -> 'b) -> 'a t -> 'b t
val return : int -> 'a -> 'a t
val get_at : int -> 'a t list -> 'a option
val get_at_exn : int -> 'a t list -> 'a
val has_index : int -> 'a t -> bool
val pp : + (Prelude.Fmt.formatter -> 'a -> unit) -> + Prelude.Fmt.formatter -> + 'a t -> + unit
diff --git a/api/owi/Owi/Int32/index.html b/api/owi/Owi/Int32/index.html index a044d7e8d..761babda4 100644 --- a/api/owi/Owi/Int32/index.html +++ b/api/owi/Owi/Int32/index.html @@ -1,2 +1,2 @@ -Int32 (owi.Owi.Int32)

Module Owi.Int32

Custom Int32 module for Wasm.

type t = int32
val min_int : t
val max_int : t
val zero : t

conversion

val bits_of_float : float -> t
val float_of_bits : t -> float
val of_float : float -> t
val to_float : t -> float
val of_string : string -> t
val of_int : int -> t
val to_int : t -> int
val of_int64 : int64 -> t
val to_int64 : t -> int64
val extend_s : int -> t -> t
val unsigned_to_int : t -> int option

unary operators

val clz : t -> t
val ctz : t -> t
val popcnt : t -> t
val lognot : t -> t

comparison operators

val eq : t -> t -> bool
val ne : t -> t -> bool
val lt : t -> t -> bool
val gt : t -> t -> bool
val lt_u : t -> t -> bool
val gt_u : t -> t -> bool
val le : t -> t -> bool
val ge : t -> t -> bool
val le_u : t -> t -> bool
val ge_u : t -> t -> bool

binary operators

val logor : t -> t -> t
val logand : t -> t -> t
val logxor : t -> t -> t
val rotl : t -> t -> t
val rotr : t -> t -> t
val shl : t -> t -> t
val shr_s : t -> t -> t
val shr_u : t -> t -> t
val shift_right_logical : t -> int -> t
val add : t -> t -> t
val sub : t -> t -> t
val mul : t -> t -> t
val div : t -> t -> t
val unsigned_div : t -> t -> t
val rem : t -> t -> t
val unsigned_rem : t -> t -> t
val eq_const : t -> int32 -> bool
+Int32 (owi.Owi.Int32)

Module Owi.Int32

Custom Int32 module for Wasm.

type t = int32
val min_int : t
val max_int : t
val zero : t

conversion

val bits_of_float : float -> t
val float_of_bits : t -> float
val of_float : float -> t
val to_float : t -> float
val of_string : string -> t
val of_int : int -> t
val to_int : t -> int
val of_int64 : int64 -> t
val to_int64 : t -> int64
val extend_s : int -> t -> t
val unsigned_to_int : t -> int option

unary operators

val clz : t -> t
val ctz : t -> t
val popcnt : t -> t
val lognot : t -> t

comparison operators

val eq : t -> t -> bool
val ne : t -> t -> bool
val lt : t -> t -> bool
val gt : t -> t -> bool
val lt_u : t -> t -> bool
val gt_u : t -> t -> bool
val le : t -> t -> bool
val ge : t -> t -> bool
val le_u : t -> t -> bool
val ge_u : t -> t -> bool

binary operators

val logor : t -> t -> t
val logand : t -> t -> t
val logxor : t -> t -> t
val rotl : t -> t -> t
val rotr : t -> t -> t
val shl : t -> t -> t
val shr_s : t -> t -> t
val shr_u : t -> t -> t
val shift_right_logical : t -> int -> t
val add : t -> t -> t
val sub : t -> t -> t
val mul : t -> t -> t
val div : t -> t -> t
val unsigned_div : t -> t -> t
val rem : t -> t -> t
val unsigned_rem : t -> t -> t
diff --git a/api/owi/Owi/Int64/index.html b/api/owi/Owi/Int64/index.html index 7e3bd4ce8..53c749137 100644 --- a/api/owi/Owi/Int64/index.html +++ b/api/owi/Owi/Int64/index.html @@ -1,2 +1,2 @@ -Int64 (owi.Owi.Int64)

Module Owi.Int64

Custom Int64 module for Wasm.

type t = int64
val min_int : t
val max_int : t
val zero : t

conversion

val bits_of_float : float -> t
val float_of_bits : t -> float
val of_float : float -> t
val to_float : t -> float
val of_string : string -> t
val of_int : int -> t
val to_int : t -> int
val of_int32 : int32 -> t
val to_int32 : t -> int32
val extend_s : int -> t -> t

unary operators

val abs : t -> t
val clz : t -> t
val ctz : t -> t
val popcnt : t -> t
val lognot : t -> t

comparison operators

val eq : t -> t -> bool
val ne : t -> t -> bool
val lt : t -> t -> bool
val gt : t -> t -> bool
val lt_u : t -> t -> bool
val gt_u : t -> t -> bool
val le : t -> t -> bool
val ge : t -> t -> bool
val le_u : t -> t -> bool
val ge_u : t -> t -> bool

binary operators

val logor : t -> t -> t
val logand : t -> t -> t
val logxor : t -> t -> t
val rotl : t -> t -> t
val rotr : t -> t -> t
val shift_left : t -> int -> t
val shl : t -> t -> t
val shift_right : t -> int -> t
val shr_s : t -> t -> t
val shr_u : t -> t -> t
val shift_right_logical : t -> int -> t
val add : t -> t -> t
val sub : t -> t -> t
val mul : t -> t -> t
val div : t -> t -> t
val unsigned_div : t -> t -> t
val rem : t -> t -> t
val unsigned_rem : t -> t -> t
val eq_const : t -> int64 -> bool
+Int64 (owi.Owi.Int64)

Module Owi.Int64

Custom Int64 module for Wasm.

type t = int64
val min_int : t
val max_int : t
val zero : t

conversion

val bits_of_float : float -> t
val float_of_bits : t -> float
val of_float : float -> t
val to_float : t -> float
val of_string : string -> t
val of_int : int -> t
val to_int : t -> int
val of_int32 : int32 -> t
val to_int32 : t -> int32
val extend_s : int -> t -> t

unary operators

val abs : t -> t
val clz : t -> t
val ctz : t -> t
val popcnt : t -> t
val lognot : t -> t

comparison operators

val eq : t -> t -> bool
val ne : t -> t -> bool
val lt : t -> t -> bool
val gt : t -> t -> bool
val lt_u : t -> t -> bool
val gt_u : t -> t -> bool
val le : t -> t -> bool
val ge : t -> t -> bool
val le_u : t -> t -> bool
val ge_u : t -> t -> bool

binary operators

val logor : t -> t -> t
val logand : t -> t -> t
val logxor : t -> t -> t
val rotl : t -> t -> t
val rotr : t -> t -> t
val shift_left : t -> int -> t
val shl : t -> t -> t
val shift_right : t -> int -> t
val shr_s : t -> t -> t
val shr_u : t -> t -> t
val shift_right_logical : t -> int -> t
val add : t -> t -> t
val sub : t -> t -> t
val mul : t -> t -> t
val div : t -> t -> t
val unsigned_div : t -> t -> t
val rem : t -> t -> t
val unsigned_rem : t -> t -> t
diff --git a/api/owi/Owi/Interpret/SymbolicM/index.html b/api/owi/Owi/Interpret/SymbolicM/index.html index 81eb61f22..568397a85 100644 --- a/api/owi/Owi/Interpret/SymbolicM/index.html +++ b/api/owi/Owi/Interpret/SymbolicM/index.html @@ -2,4 +2,4 @@ SymbolicM (owi.Owi.Interpret.SymbolicM)

Module Interpret.SymbolicM

+ unit Result.t Symbolic.M.Choice.t diff --git a/api/owi/Owi/Interpret/SymbolicP/index.html b/api/owi/Owi/Interpret/SymbolicP/index.html index 055b26a31..7d388c351 100644 --- a/api/owi/Owi/Interpret/SymbolicP/index.html +++ b/api/owi/Owi/Interpret/SymbolicP/index.html @@ -2,4 +2,4 @@ SymbolicP (owi.Owi.Interpret.SymbolicP)

Module Interpret.SymbolicP

+ unit Result.t Symbolic.P.Choice.t diff --git a/api/owi/Owi/Interpret_intf/index.html b/api/owi/Owi/Interpret_intf/index.html index c8704257b..4b1cf88bf 100644 --- a/api/owi/Owi/Interpret_intf/index.html +++ b/api/owi/Owi/Interpret_intf/index.html @@ -1,2 +1,2 @@ -Interpret_intf (owi.Owi.Interpret_intf)

Module Owi.Interpret_intf

module type Memory_data = sig ... end
module type P = sig ... end
module type S = sig ... end
+Interpret_intf (owi.Owi.Interpret_intf)

Module Owi.Interpret_intf

module type P = sig ... end
module type S = sig ... end
diff --git a/api/owi/Owi/Interpret_intf/module-type-Memory_data/index.html b/api/owi/Owi/Interpret_intf/module-type-Memory_data/index.html deleted file mode 100644 index 754579c17..000000000 --- a/api/owi/Owi/Interpret_intf/module-type-Memory_data/index.html +++ /dev/null @@ -1,2 +0,0 @@ - -Memory_data (owi.Owi.Interpret_intf.Memory_data)

Module type Interpret_intf.Memory_data

type int32
type int64
type t
val load_8_s : t -> int32 -> int32
val load_8_u : t -> int32 -> int32
val load_16_s : t -> int32 -> int32
val load_16_u : t -> int32 -> int32
val load_32 : t -> int32 -> int32
val load_64 : t -> int32 -> int64
val store_8 : t -> addr:int32 -> int32 -> unit
val store_16 : t -> addr:int32 -> int32 -> unit
val store_32 : t -> addr:int32 -> int32 -> unit
val store_64 : t -> addr:int32 -> int64 -> unit
val create : Int32.t -> t
val grow : t -> int32 -> unit
val size : t -> int32
val size_in_pages : t -> int32
diff --git a/api/owi/Owi/Interpret_intf/module-type-P/Extern_func/index.html b/api/owi/Owi/Interpret_intf/module-type-P/Extern_func/index.html index d8e8c503a..e9df3d903 100644 --- a/api/owi/Owi/Interpret_intf/module-type-P/Extern_func/index.html +++ b/api/owi/Owi/Interpret_intf/module-type-P/Extern_func/index.html @@ -1,2 +1,2 @@ -Extern_func (owi.Owi.Interpret_intf.P.Extern_func)

Module P.Extern_func

type _ telt =
  1. | I32 : Value.int32 telt
  2. | I64 : Value.int64 telt
  3. | F32 : Value.float32 telt
  4. | F64 : Value.float64 telt
  5. | Externref : 'a Stdlib.Type.Id.t -> 'a telt
type _ rtype =
  1. | R0 : unit rtype
  2. | R1 : 'a telt -> 'a rtype
  3. | R2 : 'a telt * 'b telt -> ('a * 'b) rtype
  4. | R3 : 'a telt * 'b telt * 'c telt -> ('a * 'b * 'c) rtype
  5. | R4 : 'a telt * 'b telt * 'c telt * 'd telt -> ('a * 'b * 'c * 'd) rtype
type (_, _) atype =
  1. | UArg : ('b, 'r) atype -> (unit -> 'b, 'r) atype
  2. | Arg : 'a telt * ('b, 'r) atype -> ('a -> 'b, 'r) atype
  3. | NArg : string * 'a telt * ('b, 'r) atype -> ('a -> 'b, 'r) atype
  4. | Res : ('r, 'r) atype
type _ func_type =
  1. | Func : ('f, 'r Choice.t) atype * 'r rtype -> 'f func_type
type extern_func =
  1. | Extern_func : 'a func_type * 'a -> extern_func
+Extern_func (owi.Owi.Interpret_intf.P.Extern_func)

Module P.Extern_func

type _ telt =
  1. | I32 : Value.int32 telt
  2. | I64 : Value.int64 telt
  3. | F32 : Value.float32 telt
  4. | F64 : Value.float64 telt
  5. | Externref : 'a Prelude.Type.Id.t -> 'a telt
type _ rtype =
  1. | R0 : unit rtype
  2. | R1 : 'a telt -> 'a rtype
  3. | R2 : 'a telt * 'b telt -> ('a * 'b) rtype
  4. | R3 : 'a telt * 'b telt * 'c telt -> ('a * 'b * 'c) rtype
  5. | R4 : 'a telt * 'b telt * 'c telt * 'd telt -> ('a * 'b * 'c * 'd) rtype
type (_, _) atype =
  1. | Mem : ('b, 'r) atype -> (Memory.t -> 'b, 'r) atype
  2. | UArg : ('b, 'r) atype -> (unit -> 'b, 'r) atype
  3. | Arg : 'a telt * ('b, 'r) atype -> ('a -> 'b, 'r) atype
  4. | NArg : string * 'a telt * ('b, 'r) atype -> ('a -> 'b, 'r) atype
  5. | Res : ('r, 'r) atype
type _ func_type =
  1. | Func : ('f, 'r Choice.t) atype * 'r rtype -> 'f func_type
type extern_func =
  1. | Extern_func : 'a func_type * 'a -> extern_func
diff --git a/api/owi/Owi/Interpret_intf/module-type-P/Value/Bool/index.html b/api/owi/Owi/Interpret_intf/module-type-P/Value/Bool/index.html index cf9efedef..2c7e9c0ee 100644 --- a/api/owi/Owi/Interpret_intf/module-type-P/Value/Bool/index.html +++ b/api/owi/Owi/Interpret_intf/module-type-P/Value/Bool/index.html @@ -1,2 +1,2 @@ -Bool (owi.Owi.Interpret_intf.P.Value.Bool)

Module Value.Bool

val const : bool -> vbool
val not : vbool -> vbool
val or_ : vbool -> vbool -> vbool
val and_ : vbool -> vbool -> vbool
val int32 : vbool -> int32
val pp : Format.formatter -> vbool -> unit
+Bool (owi.Owi.Interpret_intf.P.Value.Bool)

Module Value.Bool

val const : bool -> vbool
val not : vbool -> vbool
val or_ : vbool -> vbool -> vbool
val and_ : vbool -> vbool -> vbool
val int32 : vbool -> int32
val pp : Prelude.Fmt.formatter -> vbool -> unit
diff --git a/api/owi/Owi/Interpret_intf/module-type-P/Value/Ref/index.html b/api/owi/Owi/Interpret_intf/module-type-P/Value/Ref/index.html index fe45b47db..ad9448784 100644 --- a/api/owi/Owi/Interpret_intf/module-type-P/Value/Ref/index.html +++ b/api/owi/Owi/Interpret_intf/module-type-P/Value/Ref/index.html @@ -1,2 +1,2 @@ -Ref (owi.Owi.Interpret_intf.P.Value.Ref)

Module Value.Ref

val get_externref : ref_value -> 'a Stdlib.Type.Id.t -> 'a Value_intf.get_ref
+Ref (owi.Owi.Interpret_intf.P.Value.Ref)

Module Value.Ref

val get_externref : ref_value -> 'a Prelude.Type.Id.t -> 'a Value_intf.get_ref
diff --git a/api/owi/Owi/Interpret_intf/module-type-P/Value/index.html b/api/owi/Owi/Interpret_intf/module-type-P/Value/index.html index c324e99be..f47cb4ab8 100644 --- a/api/owi/Owi/Interpret_intf/module-type-P/Value/index.html +++ b/api/owi/Owi/Interpret_intf/module-type-P/Value/index.html @@ -1,2 +1,2 @@ -Value (owi.Owi.Interpret_intf.P.Value)

Module P.Value

type vbool
type int32
type int64
type float32
type float64
type ref_value
type t =
  1. | I32 of int32
  2. | I64 of int64
  3. | F32 of float32
  4. | F64 of float64
  5. | Ref of ref_value
val const_i32 : Int32.t -> int32
val const_i64 : Int64.t -> int64
val const_f32 : Float32.t -> float32
val const_f64 : Float64.t -> float64
val ref_null : Types.binary Types.heap_type -> t
val ref_func : Func_intf.t -> t
val ref_externref : 'a Stdlib.Type.Id.t -> 'a -> t
val ref_is_null : ref_value -> vbool
val pp : Format.formatter -> t -> unit
module Ref : sig ... end
module Bool : sig ... end
module F32 : sig ... end
module F64 : sig ... end
module I32 : sig ... end
module I64 : sig ... end
+Value (owi.Owi.Interpret_intf.P.Value)

Module P.Value

type vbool
type int32
val pp_int32 : Prelude.Fmt.formatter -> int32 -> unit
type int64
val pp_int64 : Prelude.Fmt.formatter -> int64 -> unit
type float32
val pp_float32 : Prelude.Fmt.formatter -> float32 -> unit
type float64
val pp_float64 : Prelude.Fmt.formatter -> float64 -> unit
type ref_value
val pp_ref_value : Prelude.Fmt.formatter -> ref_value -> unit
type t =
  1. | I32 of int32
  2. | I64 of int64
  3. | F32 of float32
  4. | F64 of float64
  5. | Ref of ref_value
val pp : Prelude.Fmt.formatter -> t -> unit
val const_i32 : Int32.t -> int32
val const_i64 : Int64.t -> int64
val const_f32 : Float32.t -> float32
val const_f64 : Float64.t -> float64
val ref_null : Types.binary Types.heap_type -> t
val ref_func : Func_intf.t -> t
val ref_externref : 'a Prelude.Type.Id.t -> 'a -> t
val ref_is_null : ref_value -> vbool
module Ref : sig ... end
module Bool : sig ... end
module F32 : sig ... end
module F64 : sig ... end
module I32 : sig ... end
module I64 : sig ... end
diff --git a/api/owi/Owi/Interpret_intf/module-type-P/index.html b/api/owi/Owi/Interpret_intf/module-type-P/index.html index 6349cae8e..da17026dd 100644 --- a/api/owi/Owi/Interpret_intf/module-type-P/index.html +++ b/api/owi/Owi/Interpret_intf/module-type-P/index.html @@ -3,10 +3,11 @@ Value.vbool -> if_true:Value.t -> if_false:Value.t -> - Value.t Choice.t
module Extern_func : + Value.t Choice.t
module Global : sig ... end
module Table : sig ... end
module Memory : sig ... end
module Extern_func : Func_intf.T_Extern_func with type int32 := Value.int32 and type int64 := Value.int64 and type float32 := Value.float32 and type float64 := Value.float64 - and type 'a m := 'a Choice.t
module Global : sig ... end
module Table : sig ... end
module Memory : sig ... end
module Data : sig ... end
module Elem : sig ... end
module Env : sig ... end
module Module_to_run : sig ... end
+ and type 'a m := 'a Choice.t + and type memory := Memory.t
module Data : sig ... end
module Elem : sig ... end
module Env : sig ... end
module Module_to_run : sig ... end
diff --git a/api/owi/Owi/Kind/index.html b/api/owi/Owi/Kind/index.html new file mode 100644 index 000000000..a8c6b2861 --- /dev/null +++ b/api/owi/Owi/Kind/index.html @@ -0,0 +1,2 @@ + +Kind (owi.Owi.Kind)

Module Owi.Kind

type 'extern_func t =
  1. | Wat of Text.modul
  2. | Wast of Text.script
  3. | Wasm of Binary.modul
  4. | Ocaml of 'extern_func Link.extern_module
diff --git a/api/owi/Owi/Link/index.html b/api/owi/Owi/Link/index.html index 2c60c15db..6160610e8 100644 --- a/api/owi/Owi/Link/index.html +++ b/api/owi/Owi/Link/index.html @@ -1,5 +1,5 @@ -Link (owi.Owi.Link)

Module Owi.Link

Module to link a binary/extern module and producing a runnable module along with a link state.

runtime env

type 'f module_to_run = {
  1. modul : Binary.modul;
  2. env : 'f Link_env.t;
  3. to_run : Types.binary Types.expr list;
}

runnable module

module StringMap : Stdlib.Map.S with type key = string
module StringSet : Stdlib.Set.S
type func := Func_intf.t
type exports = {
  1. globals : Concrete_global.t StringMap.t;
  2. memories : Concrete_memory.t StringMap.t;
  3. tables : Concrete_table.t StringMap.t;
  4. functions : func StringMap.t;
  5. defined_names : StringSet.t;
}

runtime exported items

type 'ext envs = 'ext Link_env.t Env_id.collection
type 'f state = {
  1. by_name : exports StringMap.t;
  2. by_id : (exports * Env_id.t) StringMap.t;
  3. last : (exports * Env_id.t) option;
  4. collection : 'f Func_id.collection;
  5. envs : 'f envs;
}

link state

val empty_state : 'f state

the empty link state

val modul : +Link (owi.Owi.Link)

Module Owi.Link

Module to link a binary/extern module and producing a runnable module along with a link state.

runtime env

type 'f module_to_run = {
  1. modul : Binary.modul;
  2. env : 'f Link_env.t;
  3. to_run : Types.binary Types.expr list;
}

runnable module

module StringMap : Prelude.Map.S with type key = string
module StringSet : Prelude.Set.S
type func := Func_intf.t
type exports = {
  1. globals : Concrete_global.t StringMap.t;
  2. memories : Concrete_memory.t StringMap.t;
  3. tables : Concrete_table.t StringMap.t;
  4. functions : func StringMap.t;
  5. defined_names : StringSet.t;
}

runtime exported items

type 'ext envs = 'ext Link_env.t Env_id.collection
type 'f state = {
  1. by_name : exports StringMap.t;
  2. by_id : (exports * Env_id.t) StringMap.t;
  3. last : (exports * Env_id.t) option;
  4. collection : 'f Func_id.collection;
  5. envs : 'f envs;
}

link state

val empty_state : 'f state

the empty link state

val modul : 'f state -> name:string option -> Binary.modul -> diff --git a/api/owi/Owi/Link_env/index.html b/api/owi/Owi/Link_env/index.html index 92142cdc0..93b9c4cf3 100644 --- a/api/owi/Owi/Link_env/index.html +++ b/api/owi/Owi/Link_env/index.html @@ -1,2 +1,2 @@ -Link_env (owi.Owi.Link_env)

Module Owi.Link_env

type 'ext t
type t' = Env_id.t
type elem = {
  1. mutable value : Concrete_value.ref_value array;
}
type data = {
  1. mutable value : string;
}
type func := Func_intf.t
val get_memory : _ t -> int -> Concrete_memory.t
val get_func : _ t -> int -> func
val get_table : _ t -> int -> Concrete_table.t
val get_elem : _ t -> int -> elem
val get_data : _ t -> int -> data
val get_global : _ t -> int -> Concrete_global.t
val drop_elem : elem -> unit
val drop_data : data -> unit
val get_extern_func : 'ext t -> Func_id.t -> 'ext
val id : _ t -> Env_id.t
module Build : sig ... end
val freeze : t' -> Build.t -> 'ext Func_id.collection -> 'ext t
module type T = sig ... end
module type P = sig ... end
+Link_env (owi.Owi.Link_env)

Module Owi.Link_env

type 'ext t
type 'ext backup
type t' = Env_id.t
type elem = {
  1. mutable value : Concrete_value.ref_value array;
}
type data = {
  1. mutable value : string;
}
type func := Func_intf.t
val backup : 'ext t -> 'ext backup
val recover : 'ext backup -> 'ext t -> unit
val get_memory : _ t -> int -> Concrete_memory.t
val get_func : _ t -> int -> func
val get_table : _ t -> int -> Concrete_table.t
val get_elem : _ t -> int -> elem
val get_data : _ t -> int -> data
val get_global : _ t -> int -> Concrete_global.t
val drop_elem : elem -> unit
val drop_data : data -> unit
val get_extern_func : 'ext t -> Func_id.t -> 'ext
val id : _ t -> Env_id.t
module Build : sig ... end
val freeze : t' -> Build.t -> 'ext Func_id.collection -> 'ext t
module type T = sig ... end
module type P = sig ... end
diff --git a/api/owi/Owi/Link_env/module-type-T/index.html b/api/owi/Owi/Link_env/module-type-T/index.html index 04cccdc67..72a314937 100644 --- a/api/owi/Owi/Link_env/module-type-T/index.html +++ b/api/owi/Owi/Link_env/module-type-T/index.html @@ -1,2 +1,2 @@ -T (owi.Owi.Link_env.T)

Module type Link_env.T

type extern_func
type t
type elem = {
  1. mutable value : Concrete_value.ref_value array;
}
type data = {
  1. mutable value : string;
}
val get_memory : t -> int -> Concrete_memory.t Result.t
val get_func : t -> int -> func Result.t
val get_table : t -> int -> Concrete_table.t Result.t
val get_elem : t -> int -> elem Result.t
val get_data : t -> int -> data Result.t
val get_global : t -> int -> Concrete_global.t Result.t
val drop_elem : elem -> unit
val drop_data : data -> unit
val get_extern_func : t -> Func_id.t -> Concrete_value.Func.extern_func
val get_func_typ : t -> func -> Types.binary Types.func_type
val pp : Format.formatter -> t -> unit
+T (owi.Owi.Link_env.T)

Module type Link_env.T

type extern_func
type t
type elem = {
  1. mutable value : Concrete_value.ref_value array;
}
type data = {
  1. mutable value : string;
}
val get_memory : t -> int -> Concrete_memory.t Result.t
val get_func : t -> int -> func Result.t
val get_table : t -> int -> Concrete_table.t Result.t
val get_elem : t -> int -> elem Result.t
val get_data : t -> int -> data Result.t
val get_global : t -> int -> Concrete_global.t Result.t
val drop_elem : elem -> unit
val drop_data : data -> unit
val get_extern_func : t -> Func_id.t -> Concrete_value.Func.extern_func
val get_func_typ : t -> func -> Types.binary Types.func_type
val pp : Prelude.Fmt.formatter -> t -> unit
diff --git a/api/owi/Owi/Log/index.html b/api/owi/Owi/Log/index.html index a70304c0b..50ac723ba 100644 --- a/api/owi/Owi/Log/index.html +++ b/api/owi/Owi/Log/index.html @@ -1,18 +1,22 @@ -Log (owi.Owi.Log)

Module Owi.Log

Module to enable or disable the printing of debug logs.

val debug_on : bool Stdlib.ref

wether debug printing is enabled or not

val profiling_on : bool Stdlib.ref

wether profiling printing is enabled or not

val debug0 : (unit, Format.formatter, unit) Stdlib.format -> unit

print some debug info

val debug1 : ('a -> unit, Format.formatter, unit) Stdlib.format -> 'a -> unit
val debug2 : - ('a -> 'b -> unit, Format.formatter, unit) Stdlib.format -> +Log (owi.Owi.Log)

Module Owi.Log

Module to enable or disable the printing of debug logs.

val debug_on : bool Prelude.ref

wether debug printing is enabled or not

val profiling_on : bool Prelude.ref

wether profiling printing is enabled or not

val debug0 : (unit, Prelude.Fmt.formatter, unit) Prelude.format -> unit

print some debug info

val debug1 : + ('a -> unit, Prelude.Fmt.formatter, unit) Prelude.format -> + 'a -> + unit
val debug2 : + ('a -> 'b -> unit, Prelude.Fmt.formatter, unit) Prelude.format -> 'a -> 'b -> unit
val debug5 : - ('a -> 'b -> 'c -> 'd -> 'e -> unit, Format.formatter, unit) Stdlib.format -> + ('a -> 'b -> 'c -> 'd -> 'e -> unit, Prelude.Fmt.formatter, unit) + Prelude.format -> 'a -> 'b -> 'c -> 'd -> 'e -> unit
val profile3 : - ('a -> 'b -> 'c -> unit, Format.formatter, unit) Stdlib.format -> + ('a -> 'b -> 'c -> unit, Prelude.Fmt.formatter, unit) Prelude.format -> 'a -> 'b -> 'c -> - unit

print some profiling info

val err : ('a, Format.formatter, unit, 'b) Stdlib.format4 -> 'a

print some error and exit

+ unit

print some profiling info

val err : ('a, Prelude.Fmt.formatter, unit, 'b) Prelude.format4 -> 'a

print some error and exit

diff --git a/api/owi/Owi/Parse/Binary/Module/index.html b/api/owi/Owi/Parse/Binary/Module/index.html index e2dd3ad2b..ea825c780 100644 --- a/api/owi/Owi/Parse/Binary/Module/index.html +++ b/api/owi/Owi/Parse/Binary/Module/index.html @@ -1,2 +1,2 @@ -Module (owi.Owi.Parse.Binary.Module)

Module Binary.Module

val from_string : string -> Binary.modul Result.t

Parse a module from a string.

val from_channel : Stdlib.in_channel -> Binary.modul Result.t

Parse a module from a channel.

val from_file : Fpath.t -> Binary.modul Result.t

Parse a module from a file.

+Module (owi.Owi.Parse.Binary.Module)

Module Binary.Module

val from_string : string -> Binary.modul Result.t

Parse a module from a string.

val from_channel : Prelude.in_channel -> Binary.modul Result.t

Parse a module from a channel.

val from_file : Fpath.t -> Binary.modul Result.t

Parse a module from a file.

diff --git a/api/owi/Owi/Parse/Text/Inline_module/index.html b/api/owi/Owi/Parse/Text/Inline_module/index.html index 001e244d0..a9367190b 100644 --- a/api/owi/Owi/Parse/Text/Inline_module/index.html +++ b/api/owi/Owi/Parse/Text/Inline_module/index.html @@ -1,2 +1,2 @@ -Inline_module (owi.Owi.Parse.Text.Inline_module)

Module Text.Inline_module

val from_string : string -> Text.modul Result.t

Parse an inline module from a string.

val from_channel : Stdlib.in_channel -> Text.modul Result.t

Parse an inline module from a channel.

val from_file : Fpath.t -> Text.modul Result.t

Parse an inline module from a file.

+Inline_module (owi.Owi.Parse.Text.Inline_module)

Module Text.Inline_module

val from_string : string -> Text.modul Result.t

Parse an inline module from a string.

val from_channel : Prelude.in_channel -> Text.modul Result.t

Parse an inline module from a channel.

val from_file : Fpath.t -> Text.modul Result.t

Parse an inline module from a file.

diff --git a/api/owi/Owi/Parse/Text/Module/index.html b/api/owi/Owi/Parse/Text/Module/index.html index 1f10f6aca..e56db3e08 100644 --- a/api/owi/Owi/Parse/Text/Module/index.html +++ b/api/owi/Owi/Parse/Text/Module/index.html @@ -1,2 +1,2 @@ -Module (owi.Owi.Parse.Text.Module)

Module Text.Module

val from_string : string -> Text.modul Result.t

Parse a module from a string.

val from_channel : Stdlib.in_channel -> Text.modul Result.t

Parse a module from a channel.

val from_file : Fpath.t -> Text.modul Result.t

Parse a module from a file.

+Module (owi.Owi.Parse.Text.Module)

Module Text.Module

val from_string : string -> Text.modul Result.t

Parse a module from a string.

val from_channel : Prelude.in_channel -> Text.modul Result.t

Parse a module from a channel.

val from_file : Fpath.t -> Text.modul Result.t

Parse a module from a file.

diff --git a/api/owi/Owi/Parse/Text/Script/index.html b/api/owi/Owi/Parse/Text/Script/index.html index a4ec09ac5..8466764ee 100644 --- a/api/owi/Owi/Parse/Text/Script/index.html +++ b/api/owi/Owi/Parse/Text/Script/index.html @@ -1,2 +1,2 @@ -Script (owi.Owi.Parse.Text.Script)

Module Text.Script

val from_string : string -> Text.script Result.t

Parse a script from a string.

val from_channel : Stdlib.in_channel -> Text.script Result.t

Parse a script from a channel.

val from_file : Fpath.t -> Text.script Result.t

Parse a script from a file.

+Script (owi.Owi.Parse.Text.Script)

Module Text.Script

val from_string : string -> Text.script Result.t

Parse a script from a string.

val from_channel : Prelude.in_channel -> Text.script Result.t

Parse a script from a channel.

val from_file : Fpath.t -> Text.script Result.t

Parse a script from a file.

diff --git a/api/owi/Owi/Parse/index.html b/api/owi/Owi/Parse/index.html index 891f8a95a..a1e8633e2 100644 --- a/api/owi/Owi/Parse/index.html +++ b/api/owi/Owi/Parse/index.html @@ -1,5 +1,2 @@ -Parse (owi.Owi.Parse)

Module Owi.Parse

Module providing functions to parse a wasm script from various kind of inputs.

val guess_from_file : - Fpath.t -> - ((Text.modul, Text.script) Stdlib.Either.t, Binary.modul) Stdlib.Either.t - Result.t
module Text : sig ... end
module Binary : sig ... end
+Parse (owi.Owi.Parse)

Module Owi.Parse

Module providing functions to parse a wasm script from various kind of inputs.

val guess_from_file : Fpath.t -> 'extern_func Kind.t Result.t
module Text : sig ... end
module Binary : sig ... end
diff --git a/api/owi/Owi/Result/index.html b/api/owi/Owi/Result/index.html index 014518dd5..67b25f438 100644 --- a/api/owi/Owi/Result/index.html +++ b/api/owi/Owi/Result/index.html @@ -1,5 +1,5 @@ -Result (owi.Owi.Result)

Module Owi.Result

include module type of Stdlib.Result
val ok : 'a -> ('a, 'e) Stdlib.result
val error : 'e -> ('a, 'e) Stdlib.result
val value : ('a, 'e) Stdlib.result -> default:'a -> 'a
val get_ok : ('a, 'e) Stdlib.result -> 'a
val get_error : ('a, 'e) Stdlib.result -> 'e
val bind : +Result (owi.Owi.Result)

Module Owi.Result

include module type of Prelude.Result
val ok : 'a -> ('a, 'e) Stdlib.result
val error : 'e -> ('a, 'e) Stdlib.result
val value : ('a, 'e) Stdlib.result -> default:'a -> 'a
val get_ok : ('a, 'e) Stdlib.result -> 'a
val get_error : ('a, 'e) Stdlib.result -> 'e
val bind : ('a, 'e) Stdlib.result -> ('a -> ('b, 'e) Stdlib.result) -> ('b, 'e) Stdlib.result
val join : (('a, 'e) Stdlib.result, 'e) Stdlib.result -> ('a, 'e) Stdlib.result
val map : ('a -> 'b) -> ('a, 'e) Stdlib.result -> ('b, 'e) Stdlib.result
val map_error : ('e -> 'f) -> ('a, 'e) Stdlib.result -> ('a, 'f) Stdlib.result
val fold : ok:('a -> 'c) -> error:('e -> 'c) -> ('a, 'e) Stdlib.result -> 'c
val iter : ('a -> unit) -> ('a, 'e) Stdlib.result -> unit
val iter_error : ('e -> unit) -> ('a, 'e) Stdlib.result -> unit
val is_ok : ('a, 'e) Stdlib.result -> bool
val is_error : ('a, 'e) Stdlib.result -> bool
val equal : @@ -12,4 +12,4 @@ error:('e -> 'e -> int) -> ('a, 'e) Stdlib.result -> ('a, 'e) Stdlib.result -> - int
val to_option : ('a, 'e) Stdlib.result -> 'a option
val to_list : ('a, 'e) Stdlib.result -> 'a list
val to_seq : ('a, 'e) Stdlib.result -> 'a Stdlib.Seq.t
type err = [
  1. | `Alignment_too_large
  2. | `Assert_failure
  3. | `Bad_result
  4. | `Call_stack_exhausted
  5. | `Constant_expression_required
  6. | `Constant_out_of_range
  7. | `Did_not_fail_but_expected of string
  8. | `Duplicate_export_name
  9. | `Duplicate_global of string
  10. | `Duplicate_local of string
  11. | `Duplicate_memory of string
  12. | `Duplicate_table of string
  13. | `Failed_with_but_expected of err * string
  14. | `Found_bug of int
  15. | `Global_is_immutable
  16. | `Illegal_escape of string
  17. | `Import_after_function
  18. | `Import_after_global
  19. | `Import_after_memory
  20. | `Import_after_table
  21. | `Incompatible_import_type
  22. | `Inline_function_type
  23. | `Invalid_result_arity
  24. | `Lexer_unknown_operator of string
  25. | `Malformed_utf8_encoding of string
  26. | `Memory_size_too_large
  27. | `Msg of string
  28. | `Multiple_memories
  29. | `Multiple_start_sections
  30. | `No_error
  31. | `Parse_fail of string
  32. | `Size_minimum_greater_than_maximum
  33. | `Start_function
  34. | `Timeout
  35. | `Trap of Trap.t
  36. | `Type_mismatch of string
  37. | `Unbound_last_module
  38. | `Unbound_module of string
  39. | `Unbound_name of string
  40. | `Undeclared_function_reference
  41. | `Unexpected_token
  42. | `Unknown_function of int
  43. | `Unknown_global
  44. | `Unknown_import of string * string
  45. | `Unknown_label
  46. | `Unknown_local of string
  47. | `Unknown_memory of int
  48. | `Unknown_module of string
  49. | `Unknown_operator
  50. | `Unknown_type
  51. | `Unsupported_file_extension of string
]
type 'a t = ('a, err) Stdlib.Result.t
val err_to_string : err -> string
val failwith : err -> 'a
+ int
val to_option : ('a, 'e) Stdlib.result -> 'a option
val to_list : ('a, 'e) Stdlib.result -> 'a list
val to_seq : ('a, 'e) Stdlib.result -> 'a Stdlib.Seq.t
type err = [
  1. | `Alignment_too_large
  2. | `Assert_failure
  3. | `Bad_result
  4. | `Call_stack_exhausted
  5. | `Constant_expression_required
  6. | `Constant_out_of_range
  7. | `Did_not_fail_but_expected of string
  8. | `Duplicate_export_name
  9. | `Duplicate_global of string
  10. | `Duplicate_local of string
  11. | `Duplicate_memory of string
  12. | `Duplicate_table of string
  13. | `Failed_with_but_expected of err * string
  14. | `Found_bug of int
  15. | `Global_is_immutable
  16. | `Illegal_escape of string
  17. | `Import_after_function
  18. | `Import_after_global
  19. | `Import_after_memory
  20. | `Import_after_table
  21. | `Incompatible_import_type
  22. | `Inline_function_type
  23. | `Invalid_result_arity
  24. | `Lexer_unknown_operator of string
  25. | `Malformed_utf8_encoding of string
  26. | `Memory_size_too_large
  27. | `Msg of string
  28. | `Multiple_memories
  29. | `Multiple_start_sections
  30. | `No_error
  31. | `Parse_fail of string
  32. | `Size_minimum_greater_than_maximum
  33. | `Start_function
  34. | `Timeout
  35. | `Trap of Trap.t
  36. | `Type_mismatch of string
  37. | `Unbound_last_module
  38. | `Unbound_module of string
  39. | `Unbound_name of string
  40. | `Undeclared_function_reference
  41. | `Unexpected_token of string
  42. | `Unknown_data of Types.text Types.indice
  43. | `Unknown_elem of Types.text Types.indice
  44. | `Unknown_func of Types.text Types.indice
  45. | `Unknown_global of Types.text Types.indice
  46. | `Unknown_import of string * string
  47. | `Unknown_label of Types.text Types.indice
  48. | `Unknown_local of Types.text Types.indice
  49. | `Unknown_memory of Types.text Types.indice
  50. | `Unknown_module of string
  51. | `Unknown_operator
  52. | `Unknown_table of Types.text Types.indice
  53. | `Unknown_type of Types.text Types.indice
  54. | `Unsupported_file_extension of string
]
type 'a t = ('a, err) Prelude.Result.t
val err_to_string : err -> string
val failwith : err -> 'a
diff --git a/api/owi/Owi/Solver/Z3Batch/index.html b/api/owi/Owi/Solver/Z3Batch/index.html deleted file mode 100644 index 76bba396e..000000000 --- a/api/owi/Owi/Solver/Z3Batch/index.html +++ /dev/null @@ -1,2 +0,0 @@ - -Z3Batch (owi.Owi.Solver.Z3Batch)

Module Solver.Z3Batch

type t = Smtml__Solver.Batch(Smtml.Z3_mappings).t
type solver = Smtml__Solver.Batch(Smtml.Z3_mappings).solver
val solver_time : float Stdlib.ref
val solver_count : int Stdlib.ref
val pp_statistics : Stdlib.Format.formatter -> t -> unit
val create : ?params:Smtml.Params.t -> ?logic:Smtml.Ty.logic -> unit -> t
val interrupt : t -> unit
val clone : t -> t
val push : t -> unit
val pop : t -> int -> unit
val reset : t -> unit
val add : t -> Smtml.Expr.t list -> unit
val get_assertions : t -> Smtml.Expr.t list
val check : t -> Smtml.Expr.t list -> Smtml__Solver_intf.satisfiability
val get_value : t -> Smtml.Expr.t -> Smtml.Expr.t
val model : ?symbols:Smtml.Symbol.t list -> t -> Smtml.Model.t option
diff --git a/api/owi/Owi/Solver/index.html b/api/owi/Owi/Solver/index.html index 7026f72fc..6bbefb5dc 100644 --- a/api/owi/Owi/Solver/index.html +++ b/api/owi/Owi/Solver/index.html @@ -1,2 +1,6 @@ -Solver (owi.Owi.Solver)

Module Owi.Solver

type 'a solver_module = (module Smtml.Solver_intf.S with type t = 'a)
type solver =
  1. | S : ('a solver_module * 'a) -> solver
module Z3Batch : sig ... end
val solver_mod : Z3Batch.t solver_module
val fresh_solver : unit -> solver
+Solver (owi.Owi.Solver)

Module Owi.Solver

type t
val fresh : Smtml.Solver_dispatcher.solver_type -> unit -> t
val check : t -> Smtml.Expr.t list -> Smtml.Solver_intf.satisfiability
val model : + t -> + symbols:Smtml.Symbol.t list option -> + pc:Smtml.Expr.t list -> + Smtml.Model.t
diff --git a/api/owi/Owi/Stack/Make/argument-1-V/Bool/index.html b/api/owi/Owi/Stack/Make/argument-1-V/Bool/index.html index 4bf3874b4..7da84acd2 100644 --- a/api/owi/Owi/Stack/Make/argument-1-V/Bool/index.html +++ b/api/owi/Owi/Stack/Make/argument-1-V/Bool/index.html @@ -1,2 +1,2 @@ -Bool (owi.Owi.Stack.Make.V.Bool)

Module V.Bool

val const : bool -> vbool
val not : vbool -> vbool
val or_ : vbool -> vbool -> vbool
val and_ : vbool -> vbool -> vbool
val int32 : vbool -> int32
val pp : Format.formatter -> vbool -> unit
+Bool (owi.Owi.Stack.Make.V.Bool)

Module V.Bool

val const : bool -> vbool
val not : vbool -> vbool
val or_ : vbool -> vbool -> vbool
val and_ : vbool -> vbool -> vbool
val int32 : vbool -> int32
val pp : Prelude.Fmt.formatter -> vbool -> unit
diff --git a/api/owi/Owi/Stack/Make/argument-1-V/Ref/index.html b/api/owi/Owi/Stack/Make/argument-1-V/Ref/index.html index 397283296..5408df2d5 100644 --- a/api/owi/Owi/Stack/Make/argument-1-V/Ref/index.html +++ b/api/owi/Owi/Stack/Make/argument-1-V/Ref/index.html @@ -1,2 +1,2 @@ -Ref (owi.Owi.Stack.Make.V.Ref)

Module V.Ref

val get_externref : ref_value -> 'a Stdlib.Type.Id.t -> 'a Value_intf.get_ref
+Ref (owi.Owi.Stack.Make.V.Ref)

Module V.Ref

val get_externref : ref_value -> 'a Prelude.Type.Id.t -> 'a Value_intf.get_ref
diff --git a/api/owi/Owi/Stack/Make/argument-1-V/index.html b/api/owi/Owi/Stack/Make/argument-1-V/index.html index 45e7beef1..1b3b4a919 100644 --- a/api/owi/Owi/Stack/Make/argument-1-V/index.html +++ b/api/owi/Owi/Stack/Make/argument-1-V/index.html @@ -1,2 +1,2 @@ -V (owi.Owi.Stack.Make.V)

Parameter Make.V

type vbool
type int32
type int64
type float32
type float64
type ref_value
type t =
  1. | I32 of int32
  2. | I64 of int64
  3. | F32 of float32
  4. | F64 of float64
  5. | Ref of ref_value
val const_i32 : Int32.t -> int32
val const_i64 : Int64.t -> int64
val const_f32 : Float32.t -> float32
val const_f64 : Float64.t -> float64
val ref_null : Types.binary Types.heap_type -> t
val ref_func : Func_intf.t -> t
val ref_externref : 'a Stdlib.Type.Id.t -> 'a -> t
val ref_is_null : ref_value -> vbool
val pp : Format.formatter -> t -> unit
module Ref : sig ... end
module Bool : sig ... end
module F32 : sig ... end
module F64 : sig ... end
module I32 : sig ... end
module I64 : sig ... end
+V (owi.Owi.Stack.Make.V)

Parameter Make.V

type vbool
type int32
val pp_int32 : Prelude.Fmt.formatter -> int32 -> unit
type int64
val pp_int64 : Prelude.Fmt.formatter -> int64 -> unit
type float32
val pp_float32 : Prelude.Fmt.formatter -> float32 -> unit
type float64
val pp_float64 : Prelude.Fmt.formatter -> float64 -> unit
type ref_value
val pp_ref_value : Prelude.Fmt.formatter -> ref_value -> unit
type t =
  1. | I32 of int32
  2. | I64 of int64
  3. | F32 of float32
  4. | F64 of float64
  5. | Ref of ref_value
val pp : Prelude.Fmt.formatter -> t -> unit
val const_i32 : Int32.t -> int32
val const_i64 : Int64.t -> int64
val const_f32 : Float32.t -> float32
val const_f64 : Float64.t -> float64
val ref_null : Types.binary Types.heap_type -> t
val ref_func : Func_intf.t -> t
val ref_externref : 'a Prelude.Type.Id.t -> 'a -> t
val ref_is_null : ref_value -> vbool
module Ref : sig ... end
module Bool : sig ... end
module F32 : sig ... end
module F64 : sig ... end
module I32 : sig ... end
module I64 : sig ... end
diff --git a/api/owi/Owi/Stack/Make/index.html b/api/owi/Owi/Stack/Make/index.html index eb3ff21e2..0988a6d64 100644 --- a/api/owi/Owi/Stack/Make/index.html +++ b/api/owi/Owi/Stack/Make/index.html @@ -1,2 +1,2 @@ -Make (owi.Owi.Stack.Make)

Module Stack.Make

Parameters

module V : Value_intf.T

Signature

type t = V.t list
val empty : t
val pp : Format.formatter -> t -> unit

pop operations

val drop : t -> t
val drop_n : 'a list -> int -> 'a list
val pop : t -> V.t * t
val pop_n : t -> int -> t * t
val keep : t -> int -> t
val pop_bool : t -> V.vbool * t
val pop_i32 : t -> V.int32 * t
val pop2_i32 : t -> (V.int32 * V.int32) * t
val pop_i64 : t -> V.int64 * t
val pop2_i64 : t -> (V.int64 * V.int64) * t
val pop_f32 : t -> V.float32 * t
val pop2_f32 : t -> (V.float32 * V.float32) * t
val pop_f64 : t -> V.float64 * t
val pop2_f64 : t -> (V.float64 * V.float64) * t
val pop_ref : t -> V.t * t
val pop_as_ref : t -> V.ref_value * t

push operations

val push : t -> V.t -> t
val push_bool : t -> V.vbool -> t
val push_i32 : t -> V.int32 -> t
val push_const_i32 : t -> Int32.t -> t
val push_i32_of_int : t -> int -> t
val push_i64 : t -> V.int64 -> t
val push_const_i64 : t -> Int64.t -> t
val push_f32 : t -> V.float32 -> t
val push_const_f32 : t -> Float32.t -> t
val push_f64 : t -> V.float64 -> t
val push_const_f64 : t -> Float64.t -> t
val push_as_externref : t -> 'b Stdlib.Type.Id.t -> 'b -> t
val push_array : t -> unit Stdlib.Array.t -> t
+Make (owi.Owi.Stack.Make)

Module Stack.Make

Parameters

module V : Value_intf.T

Signature

type t = V.t list
val empty : t
val pp : Prelude.Fmt.formatter -> t -> unit

pop operations

val drop : t -> t
val drop_n : 'a list -> int -> 'a list
val pop : t -> V.t * t
val pop_n : t -> int -> t * t
val keep : t -> int -> t
val pop_bool : t -> V.vbool * t
val pop_i32 : t -> V.int32 * t
val pop2_i32 : t -> (V.int32 * V.int32) * t
val pop_i64 : t -> V.int64 * t
val pop2_i64 : t -> (V.int64 * V.int64) * t
val pop_f32 : t -> V.float32 * t
val pop2_f32 : t -> (V.float32 * V.float32) * t
val pop_f64 : t -> V.float64 * t
val pop2_f64 : t -> (V.float64 * V.float64) * t
val pop_ref : t -> V.t * t
val pop_as_ref : t -> V.ref_value * t

push operations

val push : t -> V.t -> t
val push_bool : t -> V.vbool -> t
val push_i32 : t -> V.int32 -> t
val push_const_i32 : t -> Int32.t -> t
val push_i32_of_int : t -> int -> t
val push_i64 : t -> V.int64 -> t
val push_const_i64 : t -> Int64.t -> t
val push_f32 : t -> V.float32 -> t
val push_const_f32 : t -> Float32.t -> t
val push_f64 : t -> V.float64 -> t
val push_const_f64 : t -> Float64.t -> t
val push_as_externref : t -> 'b Prelude.Type.Id.t -> 'b -> t
val push_array : t -> unit Prelude.Array.t -> t
diff --git a/api/owi/Owi/Stack/module-type-S/index.html b/api/owi/Owi/Stack/module-type-S/index.html index d1a0c6852..1f89ac280 100644 --- a/api/owi/Owi/Stack/module-type-S/index.html +++ b/api/owi/Owi/Stack/module-type-S/index.html @@ -1,2 +1,2 @@ -S (owi.Owi.Stack.S)

Module type Stack.S

type vbool
type int32
type int64
type float32
type float64
type ref_value
type value
type t = value list
val empty : t
val pp : Format.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 Stdlib.Type.Id.t -> 'b -> t
val push_array : t -> unit Stdlib.Array.t -> t
+S (owi.Owi.Stack.S)

Module type Stack.S

type vbool
type int32
type int64
type float32
type float64
type ref_value
type value
type t = value list
val empty : t
val pp : Prelude.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 Prelude.Type.Id.t -> 'b -> t
val push_array : t -> unit Prelude.Array.t -> t
diff --git a/api/owi/Owi/String_map/index.html b/api/owi/Owi/String_map/index.html index 34668617d..02bc02eee 100644 --- a/api/owi/Owi/String_map/index.html +++ b/api/owi/Owi/String_map/index.html @@ -1,5 +1,5 @@ -String_map (owi.Owi.String_map)

Module Owi.String_map

include sig ... end
type key = Stdlib.String.t
type !'a t = 'a Stdlib__Map.Make(Stdlib.String).t
val empty : 'a t
val add : key -> 'a -> 'a t -> 'a t
val add_to_list : key -> 'a -> 'a list t -> 'a list t
val update : key -> ('a option -> 'a option) -> 'a t -> 'a t
val singleton : key -> 'a -> 'a t
val remove : key -> 'a t -> 'a t
val merge : +String_map (owi.Owi.String_map)

Module Owi.String_map

include sig ... end
type key = Prelude.String.t
type !'a t = 'a Stdlib__Map.Make(Prelude.String).t
val empty : 'a t
val add : key -> 'a -> 'a t -> 'a t
val add_to_list : key -> 'a -> 'a list t -> 'a list t
val update : key -> ('a option -> 'a option) -> 'a t -> 'a t
val singleton : key -> 'a -> 'a t
val remove : key -> 'a t -> 'a t
val merge : (key -> 'a option -> 'b option -> 'c option) -> 'a t -> 'b t -> diff --git a/api/owi/Owi/Symbolic/M/Choice/index.html b/api/owi/Owi/Symbolic/M/Choice/index.html new file mode 100644 index 000000000..58fa9e545 --- /dev/null +++ b/api/owi/Owi/Symbolic/M/Choice/index.html @@ -0,0 +1,2 @@ + +Choice (owi.Owi.Symbolic.M.Choice)

Module M.Choice

val return : 'a -> 'a t
val bind : 'a t -> ('a -> 'b t) -> 'b t
val map : 'a t -> ('a -> 'b) -> 'b t
val select : Symbolic_value.vbool -> bool t
val select_i32 : Symbolic_value.int32 -> Int32.t t
val trap : Trap.t -> 'a t
val let* : 'a t -> ('a -> 'b t) -> 'b t
val let+ : 'a t -> ('a -> 'b) -> 'b t
val assertion : Symbolic_value.vbool -> unit t
val with_thread : (Thread_with_memory.t -> 'b) -> 'b t
val solver : Solver.t t
val thread : Thread_with_memory.t t
val add_pc : Symbolic_value.vbool -> unit t
val lift_mem : 'a Symbolic_choice_without_memory.t -> 'a t
diff --git a/api/owi/Owi/Symbolic/M/Env/index.html b/api/owi/Owi/Symbolic/M/Env/index.html index c0dba8233..a977c4d70 100644 --- a/api/owi/Owi/Symbolic/M/Env/index.html +++ b/api/owi/Owi/Symbolic/M/Env/index.html @@ -1,11 +1,2 @@ -Env (owi.Owi.Symbolic.M.Env)

Module M.Env

type t' = Env_id.t
val get_memory : - 'a Link_env.t -> - int -> - Symbolic_memory.t Symbolic_choice.Minimalist.t
val get_func : 'a Link_env.t -> int -> Func_intf.t
val get_extern_func : 'a Link_env.t -> Func_id.t -> 'a
val get_elem : 'a Link_env.t -> int -> Link_env.elem
val get_data : - 'a Link_env.t -> - int -> - Link_env.data Symbolic_choice.Minimalist.t
val get_global : t -> int -> Global.t Symbolic_choice.Minimalist.t
val drop_elem : 'a -> unit
val drop_data : Link_env.data -> unit
+Env (owi.Owi.Symbolic.M.Env)

Module M.Env

type t' = Env_id.t
val get_memory : 'a Link_env.t -> int -> Memory.t Choice.t
val get_func : 'a Link_env.t -> int -> Func_intf.t
val get_extern_func : 'a Link_env.t -> Func_id.t -> 'a
val get_elem : 'a Link_env.t -> int -> Link_env.elem
val get_data : 'a Link_env.t -> int -> Link_env.data Choice.t
val get_global : t -> int -> Global.t Choice.t
val drop_elem : 'a -> unit
val drop_data : Link_env.data -> unit
diff --git a/api/owi/Owi/Symbolic/M/Extern_func/index.html b/api/owi/Owi/Symbolic/M/Extern_func/index.html index 23b5bfb80..25e7dd353 100644 --- a/api/owi/Owi/Symbolic/M/Extern_func/index.html +++ b/api/owi/Owi/Symbolic/M/Extern_func/index.html @@ -1,2 +1,2 @@ -Extern_func (owi.Owi.Symbolic.M.Extern_func)

Module M.Extern_func

type !'b telt =
  1. | I32 : Value.int32 telt
  2. | I64 : Value.int64 telt
  3. | F32 : Value.float32 telt
  4. | F64 : Value.float64 telt
  5. | Externref : 'a Stdlib.Type.Id.t -> 'a telt
type !'e rtype =
  1. | R0 : unit rtype
  2. | R1 : 'a telt -> 'a rtype
  3. | R2 : 'a0 telt * 'b telt -> ('a0 * 'b) rtype
  4. | R3 : 'a1 telt * 'b0 telt * 'c telt -> ('a1 * 'b0 * 'c) rtype
  5. | R4 : 'a2 telt * 'b1 telt * 'c0 telt * 'd telt -> ('a2 * 'b1 * 'c0 * 'd) rtype
type (!'c, !'d) atype =
  1. | UArg : ('b, 'r) atype -> (unit -> 'b, 'r) atype
  2. | Arg : 'a telt * ('b0, 'r0) atype -> ('a -> 'b0, 'r0) atype
  3. | NArg : string * 'a0 telt * ('b1, 'r1) atype -> ('a0 -> 'b1, 'r1) atype
  4. | Res : ('r2, 'r2) atype
type !'a func_type =
  1. | Func : ('f, 'r Symbolic_choice.Minimalist.t) atype * 'r rtype -> 'f func_type
type extern_func =
  1. | Extern_func : 'a func_type * 'a -> extern_func
+Extern_func (owi.Owi.Symbolic.M.Extern_func)

Module M.Extern_func

type !'b telt =
  1. | I32 : Value.int32 telt
  2. | I64 : Value.int64 telt
  3. | F32 : Value.float32 telt
  4. | F64 : Value.float64 telt
  5. | Externref : 'a Prelude.Type.Id.t -> 'a telt
type !'e rtype =
  1. | R0 : unit rtype
  2. | R1 : 'a telt -> 'a rtype
  3. | R2 : 'a0 telt * 'b telt -> ('a0 * 'b) rtype
  4. | R3 : 'a1 telt * 'b0 telt * 'c telt -> ('a1 * 'b0 * 'c) rtype
  5. | R4 : 'a2 telt * 'b1 telt * 'c0 telt * 'd telt -> ('a2 * 'b1 * 'c0 * 'd) rtype
type (!'c, !'d) atype =
  1. | Mem : ('b, 'r) atype -> (Symbolic_memory_concretizing.t -> 'b, 'r) atype
  2. | UArg : ('b0, 'r0) atype -> (unit -> 'b0, 'r0) atype
  3. | Arg : 'a telt * ('b1, 'r1) atype -> ('a -> 'b1, 'r1) atype
  4. | NArg : string * 'a0 telt * ('b2, 'r2) atype -> ('a0 -> 'b2, 'r2) atype
  5. | Res : ('r3, 'r3) atype
type !'a func_type =
  1. | Func : ('f, 'r Choice.t) atype * 'r rtype -> 'f func_type
type extern_func =
  1. | Extern_func : 'a func_type * 'a -> extern_func
diff --git a/api/owi/Owi/Symbolic/M/Memory/ITbl/index.html b/api/owi/Owi/Symbolic/M/Memory/ITbl/index.html index 0a503c3fe..de4240505 100644 --- a/api/owi/Owi/Symbolic/M/Memory/ITbl/index.html +++ b/api/owi/Owi/Symbolic/M/Memory/ITbl/index.html @@ -1,2 +1,2 @@ -ITbl (owi.Owi.Symbolic.M.Memory.ITbl)

Module Memory.ITbl

type 'a t
type key
val iter : (key -> 'a -> unit) -> 'a t -> unit
+ITbl (owi.Owi.Symbolic.M.Memory.ITbl)

Module Memory.ITbl

val iter : (key -> 'a -> unit) -> 'a t -> unit
diff --git a/api/owi/Owi/Symbolic/M/Memory/index.html b/api/owi/Owi/Symbolic/M/Memory/index.html index a9c45f41a..8b06574af 100644 --- a/api/owi/Owi/Symbolic/M/Memory/index.html +++ b/api/owi/Owi/Symbolic/M/Memory/index.html @@ -1,5 +1,9 @@ -Memory (owi.Owi.Symbolic.M.Memory)

Module M.Memory

type t
type collection
val init : unit -> collection
val clone : collection -> collection
val get_memory : Env_id.t -> Concrete_memory.t -> collection -> int -> t
val replace_size : t -> Int32.t -> Smtml.Expr.t -> unit
val free : t -> Int32.t -> unit
val grow : t -> Smtml.Expr.t -> unit
val fill : t -> pos:Smtml.Expr.t -> len:Smtml.Expr.t -> char -> Smtml.Expr.t
val blit : +Memory (owi.Owi.Symbolic.M.Memory)

Module M.Memory

val init : unit -> collection
val clone : collection -> collection
val get_memory : Env_id.t -> Concrete_memory.t -> collection -> int -> t
val realloc : + t -> + ptr:Smtml.Expr.t -> + size:Smtml.Expr.t -> + Smtml.Expr.t Symbolic_choice_without_memory.t
val free : t -> Smtml.Expr.t -> unit Symbolic_choice_without_memory.t
val grow : t -> Smtml.Expr.t -> unit
val fill : t -> pos:Smtml.Expr.t -> len:Smtml.Expr.t -> char -> Smtml.Expr.t
val blit : t -> src:Smtml.Expr.t -> dst:Smtml.Expr.t -> @@ -10,45 +14,4 @@ src:Smtml.Expr.t -> dst:Smtml.Expr.t -> len:Smtml.Expr.t -> - Smtml.Expr.t
val size : t -> Smtml.Expr.t
val size_in_pages : t -> Smtml.Expr.t
val get_limit_max : t -> Smtml.Expr.t option
module ITbl : sig ... end
val iter : (t ITbl.t -> unit) -> collection -> unit
val concretise : Smtml.Expr.t -> Smtml.Expr.t Symbolic_choice.Minimalist.t
val check_within_bounds : - t -> - Smtml.Expr.t -> - Symbolic_value.int32 Symbolic_choice.Minimalist.t
val with_concrete : - t -> - Smtml.Expr.t -> - (t -> Symbolic_value.int32 -> 'a) -> - 'a0 Symbolic_choice.Minimalist.t
val load_8_s : - t -> - Smtml.Expr.t -> - Symbolic_value.int32 Symbolic_choice.Minimalist.t
val load_8_u : - t -> - Smtml.Expr.t -> - Symbolic_value.int32 Symbolic_choice.Minimalist.t
val load_16_s : - t -> - Smtml.Expr.t -> - Symbolic_value.int32 Symbolic_choice.Minimalist.t
val load_16_u : - t -> - Smtml.Expr.t -> - Symbolic_value.int32 Symbolic_choice.Minimalist.t
val load_32 : - t -> - Smtml.Expr.t -> - Symbolic_value.int32 Symbolic_choice.Minimalist.t
val load_64 : - t -> - Smtml.Expr.t -> - Symbolic_value.int32 Symbolic_choice.Minimalist.t
val store_8 : - t -> - addr:Smtml.Expr.t -> - Smtml.Expr.t -> - unit Symbolic_choice.Minimalist.t
val store_16 : - t -> - addr:Smtml.Expr.t -> - Smtml.Expr.t -> - unit Symbolic_choice.Minimalist.t
val store_32 : - t -> - addr:Smtml.Expr.t -> - Smtml.Expr.t -> - unit Symbolic_choice.Minimalist.t
val store_64 : - t -> - addr:Smtml.Expr.t -> - Smtml.Expr.t -> - unit Symbolic_choice.Minimalist.t
+ Smtml.Expr.t
val size : t -> Smtml.Expr.t
val size_in_pages : t -> Smtml.Expr.t
val get_limit_max : t -> Smtml.Expr.t option
module ITbl : sig ... end
val iter : (t ITbl.t -> unit) -> collection -> unit
val load_8_s : t -> Smtml.Expr.t -> Symbolic_value.int32 Choice.t
val load_8_u : t -> Smtml.Expr.t -> Symbolic_value.int32 Choice.t
val load_16_s : t -> Smtml.Expr.t -> Symbolic_value.int32 Choice.t
val load_16_u : t -> Smtml.Expr.t -> Symbolic_value.int32 Choice.t
val load_32 : t -> Smtml.Expr.t -> Symbolic_value.int32 Choice.t
val load_64 : t -> Smtml.Expr.t -> Symbolic_value.int32 Choice.t
val store_8 : t -> addr:Smtml.Expr.t -> Smtml.Expr.t -> unit Choice.t
val store_16 : t -> addr:Smtml.Expr.t -> Smtml.Expr.t -> unit Choice.t
val store_32 : t -> addr:Smtml.Expr.t -> Smtml.Expr.t -> unit Choice.t
val store_64 : t -> addr:Smtml.Expr.t -> Smtml.Expr.t -> unit Choice.t
diff --git a/api/owi/Owi/Symbolic/M/Module_to_run/index.html b/api/owi/Owi/Symbolic/M/Module_to_run/index.html index 03834f6e1..548446c99 100644 --- a/api/owi/Owi/Symbolic/M/Module_to_run/index.html +++ b/api/owi/Owi/Symbolic/M/Module_to_run/index.html @@ -1,2 +1,4 @@ -Module_to_run (owi.Owi.Symbolic.M.Module_to_run)

Module M.Module_to_run

runnable module

val env : t -> Env.t
val modul : t -> Binary.modul
val to_run : t -> Types.binary Types.expr list
+Module_to_run (owi.Owi.Symbolic.M.Module_to_run)

Module M.Module_to_run

runnable module

val env : t -> Env.t
val modul : t -> Binary.modul
val to_run : t -> Types.binary Types.expr list
diff --git a/api/owi/Owi/Symbolic/M/index.html b/api/owi/Owi/Symbolic/M/index.html index 2fff5cb16..2aa9be1f8 100644 --- a/api/owi/Owi/Symbolic/M/index.html +++ b/api/owi/Owi/Symbolic/M/index.html @@ -1,6 +1,6 @@ -M (owi.Owi.Symbolic.M)

Module Symbolic.M

include sig ... end
module Value = Symbolic_value
type thread = Thread.t
module Extern_func : sig ... end
val select : +M (owi.Owi.Symbolic.M)

Module Symbolic.M

module Value = Symbolic_value
module Choice : sig ... end
module Extern_func : sig ... end
module Global = Symbolic_global
module Table = Symbolic_table
type thread = Thread_with_memory.t
val select : Value.vbool -> if_true:Value.t -> if_false:Value.t -> - Value.t Symbolic_choice.Minimalist.t
module Global = Symbolic_global
module Table = Symbolic_table
module Elem : sig ... end
module Memory : sig ... end
module Data : sig ... end
module Env : sig ... end
module Module_to_run : sig ... end
+ Value.t Choice.t
module Elem : sig ... end
module Memory : sig ... end
module Data : sig ... end
module Env : sig ... end
module Module_to_run : sig ... end
diff --git a/api/owi/Owi/Symbolic/MakeP/Env/index.html b/api/owi/Owi/Symbolic/MakeP/Env/index.html index fa087567e..730d47c4f 100644 --- a/api/owi/Owi/Symbolic/MakeP/Env/index.html +++ b/api/owi/Owi/Symbolic/MakeP/Env/index.html @@ -1,2 +1,2 @@ -Env (owi.Owi.Symbolic.MakeP.Env)

Module MakeP.Env

type t' = Env_id.t
val get_memory : 'a Link_env.t -> int -> Symbolic_memory.t Choice.t
val get_func : 'a Link_env.t -> int -> Func_intf.t
val get_extern_func : 'a Link_env.t -> Func_id.t -> 'a
val get_elem : 'a Link_env.t -> int -> Link_env.elem
val get_data : 'a Link_env.t -> int -> Link_env.data Choice.t
val get_global : t -> int -> Global.t Choice.t
val drop_elem : 'a -> unit
val drop_data : Link_env.data -> unit
+Env (owi.Owi.Symbolic.MakeP.Env)

Module MakeP.Env

type t' = Env_id.t
val get_memory : 'a Link_env.t -> int -> Memory.t Choice.t
val get_func : 'a Link_env.t -> int -> Func_intf.t
val get_extern_func : 'a Link_env.t -> Func_id.t -> 'a
val get_elem : 'a Link_env.t -> int -> Link_env.elem
val get_data : 'a Link_env.t -> int -> Link_env.data Choice.t
val get_global : t -> int -> Global.t Choice.t
val drop_elem : 'a -> unit
val drop_data : Link_env.data -> unit
diff --git a/api/owi/Owi/Symbolic/MakeP/Extern_func/index.html b/api/owi/Owi/Symbolic/MakeP/Extern_func/index.html index e5c2a9cd8..80f55c099 100644 --- a/api/owi/Owi/Symbolic/MakeP/Extern_func/index.html +++ b/api/owi/Owi/Symbolic/MakeP/Extern_func/index.html @@ -1,2 +1,2 @@ -Extern_func (owi.Owi.Symbolic.MakeP.Extern_func)

Module MakeP.Extern_func

type !'b telt =
  1. | I32 : Value.int32 telt
  2. | I64 : Value.int64 telt
  3. | F32 : Value.float32 telt
  4. | F64 : Value.float64 telt
  5. | Externref : 'a Stdlib.Type.Id.t -> 'a telt
type !'e rtype =
  1. | R0 : unit rtype
  2. | R1 : 'a telt -> 'a rtype
  3. | R2 : 'a0 telt * 'b telt -> ('a0 * 'b) rtype
  4. | R3 : 'a1 telt * 'b0 telt * 'c telt -> ('a1 * 'b0 * 'c) rtype
  5. | R4 : 'a2 telt * 'b1 telt * 'c0 telt * 'd telt -> ('a2 * 'b1 * 'c0 * 'd) rtype
type (!'c, !'d) atype =
  1. | UArg : ('b, 'r) atype -> (unit -> 'b, 'r) atype
  2. | Arg : 'a telt * ('b0, 'r0) atype -> ('a -> 'b0, 'r0) atype
  3. | NArg : string * 'a0 telt * ('b1, 'r1) atype -> ('a0 -> 'b1, 'r1) atype
  4. | Res : ('r2, 'r2) atype
type !'a func_type =
  1. | Func : ('f, 'r Choice.t) atype * 'r rtype -> 'f func_type
type extern_func =
  1. | Extern_func : 'a func_type * 'a -> extern_func
+Extern_func (owi.Owi.Symbolic.MakeP.Extern_func)

Module MakeP.Extern_func

type !'b telt =
  1. | I32 : Value.int32 telt
  2. | I64 : Value.int64 telt
  3. | F32 : Value.float32 telt
  4. | F64 : Value.float64 telt
  5. | Externref : 'a Prelude.Type.Id.t -> 'a telt
type !'e rtype =
  1. | R0 : unit rtype
  2. | R1 : 'a telt -> 'a rtype
  3. | R2 : 'a0 telt * 'b telt -> ('a0 * 'b) rtype
  4. | R3 : 'a1 telt * 'b0 telt * 'c telt -> ('a1 * 'b0 * 'c) rtype
  5. | R4 : 'a2 telt * 'b1 telt * 'c0 telt * 'd telt -> ('a2 * 'b1 * 'c0 * 'd) rtype
type (!'c, !'d) atype =
  1. | Mem : ('b, 'r) atype -> (Memory.t -> 'b, 'r) atype
  2. | UArg : ('b0, 'r0) atype -> (unit -> 'b0, 'r0) atype
  3. | Arg : 'a telt * ('b1, 'r1) atype -> ('a -> 'b1, 'r1) atype
  4. | NArg : string * 'a0 telt * ('b2, 'r2) atype -> ('a0 -> 'b2, 'r2) atype
  5. | Res : ('r3, 'r3) atype
type !'a func_type =
  1. | Func : ('f, 'r Choice.t) atype * 'r rtype -> 'f func_type
type extern_func =
  1. | Extern_func : 'a func_type * 'a -> extern_func
diff --git a/api/owi/Owi/Symbolic/MakeP/Memory/index.html b/api/owi/Owi/Symbolic/MakeP/Memory/index.html index 923894dee..6cda032c0 100644 --- a/api/owi/Owi/Symbolic/MakeP/Memory/index.html +++ b/api/owi/Owi/Symbolic/MakeP/Memory/index.html @@ -1,5 +1,9 @@ -Memory (owi.Owi.Symbolic.MakeP.Memory)

Module MakeP.Memory

include module type of struct include Symbolic_memory end
type collection = Symbolic_memory.collection
val init : unit -> collection
val clone : collection -> collection
val get_memory : Env_id.t -> Concrete_memory.t -> collection -> int -> t
val replace_size : t -> Int32.t -> Smtml.Expr.t -> unit
val free : t -> Int32.t -> unit
val grow : t -> Smtml.Expr.t -> unit
val fill : t -> pos:Smtml.Expr.t -> len:Smtml.Expr.t -> char -> Smtml.Expr.t
val blit : +Memory (owi.Owi.Symbolic.MakeP.Memory)

Module MakeP.Memory

include module type of struct include Memory end
type t = Memory.t
type collection = Memory.collection
val init : unit -> collection
val clone : collection -> collection
val get_memory : Env_id.t -> Concrete_memory.t -> collection -> int -> t
val realloc : + t -> + ptr:Smtml.Expr.t -> + size:Smtml.Expr.t -> + Smtml.Expr.t Symbolic_choice_without_memory.t
val free : t -> Smtml.Expr.t -> unit Symbolic_choice_without_memory.t
val grow : t -> Smtml.Expr.t -> unit
val fill : t -> pos:Smtml.Expr.t -> len:Smtml.Expr.t -> char -> Smtml.Expr.t
val blit : t -> src:Smtml.Expr.t -> dst:Smtml.Expr.t -> @@ -10,8 +14,4 @@ src:Smtml.Expr.t -> dst:Smtml.Expr.t -> len:Smtml.Expr.t -> - Smtml.Expr.t
val size : t -> Smtml.Expr.t
val size_in_pages : t -> Smtml.Expr.t
val get_limit_max : t -> Smtml.Expr.t option
module ITbl = Symbolic_memory.ITbl
val iter : (t ITbl.t -> unit) -> collection -> unit
val concretise : Smtml.Expr.t -> Smtml.Expr.t Choice.t
val check_within_bounds : t -> Smtml.Expr.t -> Symbolic_value.int32 Choice.t
val with_concrete : - t -> - Smtml.Expr.t -> - (t -> Symbolic_value.int32 -> 'a) -> - 'a0 Choice.t
val load_8_s : t -> Smtml.Expr.t -> Symbolic_value.int32 Choice.t
val load_8_u : t -> Smtml.Expr.t -> Symbolic_value.int32 Choice.t
val load_16_s : t -> Smtml.Expr.t -> Symbolic_value.int32 Choice.t
val load_16_u : t -> Smtml.Expr.t -> Symbolic_value.int32 Choice.t
val load_32 : t -> Smtml.Expr.t -> Symbolic_value.int32 Choice.t
val load_64 : t -> Smtml.Expr.t -> Symbolic_value.int32 Choice.t
val store_8 : t -> addr:Smtml.Expr.t -> Smtml.Expr.t -> unit Choice.t
val store_16 : t -> addr:Smtml.Expr.t -> Smtml.Expr.t -> unit Choice.t
val store_32 : t -> addr:Smtml.Expr.t -> Smtml.Expr.t -> unit Choice.t
val store_64 : t -> addr:Smtml.Expr.t -> Smtml.Expr.t -> unit Choice.t
+ Smtml.Expr.t
val size : t -> Smtml.Expr.t
val size_in_pages : t -> Smtml.Expr.t
val get_limit_max : t -> Smtml.Expr.t option
module ITbl = Memory.ITbl
val iter : (t ITbl.t -> unit) -> collection -> unit
val load_8_s : t -> Smtml.Expr.t -> Symbolic_value.int32 Choice.t
val load_8_u : t -> Smtml.Expr.t -> Symbolic_value.int32 Choice.t
val load_16_s : t -> Smtml.Expr.t -> Symbolic_value.int32 Choice.t
val load_16_u : t -> Smtml.Expr.t -> Symbolic_value.int32 Choice.t
val load_32 : t -> Smtml.Expr.t -> Symbolic_value.int32 Choice.t
val load_64 : t -> Smtml.Expr.t -> Symbolic_value.int32 Choice.t
val store_8 : t -> addr:Smtml.Expr.t -> Smtml.Expr.t -> unit Choice.t
val store_16 : t -> addr:Smtml.Expr.t -> Smtml.Expr.t -> unit Choice.t
val store_32 : t -> addr:Smtml.Expr.t -> Smtml.Expr.t -> unit Choice.t
val store_64 : t -> addr:Smtml.Expr.t -> Smtml.Expr.t -> unit Choice.t
diff --git a/api/owi/Owi/Symbolic/MakeP/argument-1-Memory/ITbl/index.html b/api/owi/Owi/Symbolic/MakeP/argument-1-Memory/ITbl/index.html new file mode 100644 index 000000000..17b5b3bdb --- /dev/null +++ b/api/owi/Owi/Symbolic/MakeP/argument-1-Memory/ITbl/index.html @@ -0,0 +1,2 @@ + +ITbl (owi.Owi.Symbolic.MakeP.Memory.ITbl)

Module Memory.ITbl

type 'a t
type key
val iter : (key -> 'a -> unit) -> 'a t -> unit
diff --git a/api/owi/Owi/Symbolic/MakeP/argument-1-Memory/index.html b/api/owi/Owi/Symbolic/MakeP/argument-1-Memory/index.html new file mode 100644 index 000000000..3b565ffe2 --- /dev/null +++ b/api/owi/Owi/Symbolic/MakeP/argument-1-Memory/index.html @@ -0,0 +1,51 @@ + +Memory (owi.Owi.Symbolic.MakeP.Memory)

Parameter MakeP.Memory

type t
type collection
val init : unit -> collection
val clone : collection -> collection
val get_memory : Env_id.t -> Concrete_memory.t -> collection -> int -> t
val realloc : + t -> + ptr:Smtml.Expr.t -> + size:Smtml.Expr.t -> + Smtml.Expr.t Symbolic_choice_without_memory.t
val free : t -> Smtml.Expr.t -> unit Symbolic_choice_without_memory.t
val load_8_s : + t -> + Smtml.Expr.t -> + Symbolic_value.int32 Symbolic_choice_without_memory.t
val load_8_u : + t -> + Smtml.Expr.t -> + Symbolic_value.int32 Symbolic_choice_without_memory.t
val load_16_s : + t -> + Smtml.Expr.t -> + Symbolic_value.int32 Symbolic_choice_without_memory.t
val load_16_u : + t -> + Smtml.Expr.t -> + Symbolic_value.int32 Symbolic_choice_without_memory.t
val load_32 : + t -> + Smtml.Expr.t -> + Symbolic_value.int32 Symbolic_choice_without_memory.t
val load_64 : + t -> + Smtml.Expr.t -> + Symbolic_value.int32 Symbolic_choice_without_memory.t
val store_8 : + t -> + addr:Smtml.Expr.t -> + Smtml.Expr.t -> + unit Symbolic_choice_without_memory.t
val store_16 : + t -> + addr:Smtml.Expr.t -> + Smtml.Expr.t -> + unit Symbolic_choice_without_memory.t
val store_32 : + t -> + addr:Smtml.Expr.t -> + Smtml.Expr.t -> + unit Symbolic_choice_without_memory.t
val store_64 : + t -> + addr:Smtml.Expr.t -> + Smtml.Expr.t -> + unit Symbolic_choice_without_memory.t
val grow : t -> Smtml.Expr.t -> unit
val fill : t -> pos:Smtml.Expr.t -> len:Smtml.Expr.t -> char -> Smtml.Expr.t
val blit : + t -> + src:Smtml.Expr.t -> + dst:Smtml.Expr.t -> + len:Smtml.Expr.t -> + Smtml.Expr.t
val blit_string : + t -> + string -> + src:Smtml.Expr.t -> + dst:Smtml.Expr.t -> + len:Smtml.Expr.t -> + Smtml.Expr.t
val size : t -> Smtml.Expr.t
val size_in_pages : t -> Smtml.Expr.t
val get_limit_max : t -> Smtml.Expr.t option
module ITbl : sig ... end
val iter : (t ITbl.t -> unit) -> collection -> unit
diff --git a/api/owi/Owi/Symbolic/MakeP/argument-1-Thread/index.html b/api/owi/Owi/Symbolic/MakeP/argument-1-Thread/index.html deleted file mode 100644 index 4a28b2eea..000000000 --- a/api/owi/Owi/Symbolic/MakeP/argument-1-Thread/index.html +++ /dev/null @@ -1,2 +0,0 @@ - -Thread (owi.Owi.Symbolic.MakeP.Thread)

Parameter MakeP.Thread

type t
val memories : t -> Symbolic_memory.collection
val globals : t -> Symbolic_global.collection
val pc : t -> Symbolic_value.vbool list
diff --git a/api/owi/Owi/Symbolic/MakeP/argument-2-Thread/Memory/index.html b/api/owi/Owi/Symbolic/MakeP/argument-2-Thread/Memory/index.html new file mode 100644 index 000000000..99ee28a22 --- /dev/null +++ b/api/owi/Owi/Symbolic/MakeP/argument-2-Thread/Memory/index.html @@ -0,0 +1,2 @@ + +Memory (owi.Owi.Symbolic.MakeP.Thread.Memory)

Module Thread.Memory

type collection = Memory.collection
val init : unit -> collection
val clone : collection -> collection
diff --git a/api/owi/Owi/Symbolic/MakeP/argument-2-Thread/index.html b/api/owi/Owi/Symbolic/MakeP/argument-2-Thread/index.html new file mode 100644 index 000000000..2aa4351d7 --- /dev/null +++ b/api/owi/Owi/Symbolic/MakeP/argument-2-Thread/index.html @@ -0,0 +1,10 @@ + +Thread (owi.Owi.Symbolic.MakeP.Thread)

Parameter MakeP.Thread

type t
val init : unit -> t
val create : + int -> + Smtml.Symbol.t list -> + Symbolic_value.vbool list -> + Memory.collection -> + Symbolic_table.collection -> + Symbolic_global.collection -> + int32 list -> + t
val pc : t -> Symbolic_value.vbool list
val memories : t -> Memory.collection
val globals : t -> Symbolic_global.collection
val breadcrumbs : t -> int32 list
val symbols_set : t -> Smtml.Symbol.t list
val symbols : t -> int
val clone : t -> t
val add_pc : t -> Symbolic_value.vbool -> t
val add_breadcrumb : t -> int32 -> t
val add_symbol : t -> Smtml.Symbol.t -> t
val incr_symbols : t -> t
diff --git a/api/owi/Owi/Symbolic/MakeP/argument-2-Choice/index.html b/api/owi/Owi/Symbolic/MakeP/argument-3-Choice/index.html similarity index 81% rename from api/owi/Owi/Symbolic/MakeP/argument-2-Choice/index.html rename to api/owi/Owi/Symbolic/MakeP/argument-3-Choice/index.html index a5776076b..47f75aa2e 100644 --- a/api/owi/Owi/Symbolic/MakeP/argument-2-Choice/index.html +++ b/api/owi/Owi/Symbolic/MakeP/argument-3-Choice/index.html @@ -1,2 +1,2 @@ -Choice (owi.Owi.Symbolic.MakeP.Choice)

Parameter MakeP.Choice

include Choice_intf.Base with module V := Symbolic_value
type 'a t
val return : 'a -> 'a t
val bind : 'a t -> ('a -> 'b t) -> 'b t
val map : 'a t -> ('a -> 'b) -> 'b t
val select : Owi.Symbolic_value.vbool -> bool t
val select_i32 : Owi.Symbolic_value.int32 -> Int32.t t
val trap : Trap.t -> 'a t
val let* : 'a t -> ('a -> 'b t) -> 'b t
val let+ : 'a t -> ('a -> 'b) -> 'b t
type 'a run_result
val assertion : Owi.Symbolic_value.vbool -> unit t
val with_thread : (Thread.t -> 'b) -> 'b t
val solver : Solver.solver t
val thread : Thread.t t
val add_pc : Owi.Symbolic_value.vbool -> unit t
val run : workers:int -> 'a t -> Thread.t -> 'a run_result
+Choice (owi.Owi.Symbolic.MakeP.Choice)

Parameter MakeP.Choice

include Choice_intf.Base with module V := Symbolic_value
type 'a t
val return : 'a -> 'a t
val bind : 'a t -> ('a -> 'b t) -> 'b t
val map : 'a t -> ('a -> 'b) -> 'b t
val select : Owi.Symbolic_value.vbool -> bool t
val select_i32 : Owi.Symbolic_value.int32 -> Int32.t t
val trap : Trap.t -> 'a t
val let* : 'a t -> ('a -> 'b t) -> 'b t
val let+ : 'a t -> ('a -> 'b) -> 'b t
type 'a run_result
val assertion : Owi.Symbolic_value.vbool -> unit t
val with_thread : (Thread.t -> 'b) -> 'b t
val solver : Solver.t t
val thread : Thread.t t
val add_pc : Owi.Symbolic_value.vbool -> unit t
val lift_mem : 'a Symbolic_choice_without_memory.t -> 'a t
diff --git a/api/owi/Owi/Symbolic/MakeP/index.html b/api/owi/Owi/Symbolic/MakeP/index.html index d36df9827..c45275cad 100644 --- a/api/owi/Owi/Symbolic/MakeP/index.html +++ b/api/owi/Owi/Symbolic/MakeP/index.html @@ -1,9 +1,9 @@ -MakeP (owi.Owi.Symbolic.MakeP)

Module Symbolic.MakeP

Parameters

module Thread : Thread
module Choice : +MakeP (owi.Owi.Symbolic.MakeP)

Module Symbolic.MakeP

Parameters

module Choice : Choice_intf.Complete with module V := Symbolic_value - and type thread := Thread.t

Signature

module Value = Symbolic_value
type thread = Thread.t
module Choice = Choice
module Extern_func : sig ... end
val select : + and type thread := Thread.t

Signature

module Value = Symbolic_value
module Choice = Choice
module Extern_func : sig ... end
module Global = Symbolic_global
module Table = Symbolic_table
type thread = Thread.t
val select : Value.vbool -> if_true:Value.t -> if_false:Value.t -> - Value.t Choice.t
module Global = Symbolic_global
module Table = Symbolic_table
module Elem : sig ... end
module Memory : sig ... end
module Data : sig ... end
module Env : sig ... end
module Module_to_run : sig ... end
+ Value.t Choice.t
module Elem : sig ... end
module Memory : sig ... end
module Data : sig ... end
module Env : sig ... end
module Module_to_run : sig ... end
diff --git a/api/owi/Owi/Symbolic/P/Choice/index.html b/api/owi/Owi/Symbolic/P/Choice/index.html new file mode 100644 index 000000000..9a45349a8 --- /dev/null +++ b/api/owi/Owi/Symbolic/P/Choice/index.html @@ -0,0 +1,2 @@ + +Choice (owi.Owi.Symbolic.P.Choice)

Module P.Choice

val return : 'a -> 'a t
val bind : 'a t -> ('a -> 'b t) -> 'b t
val map : 'a t -> ('a -> 'b) -> 'b t
val select : Symbolic_value.vbool -> bool t
val select_i32 : Symbolic_value.int32 -> Int32.t t
val trap : Trap.t -> 'a t
val let* : 'a t -> ('a -> 'b t) -> 'b t
val let+ : 'a t -> ('a -> 'b) -> 'b t
val assertion : Symbolic_value.vbool -> unit t
val with_thread : (Thread_with_memory.t -> 'b) -> 'b t
val solver : Solver.t t
val thread : Thread_with_memory.t t
val add_pc : Symbolic_value.vbool -> unit t
val lift_mem : 'a Symbolic_choice_without_memory.t -> 'a t
diff --git a/api/owi/Owi/Symbolic/P/Env/index.html b/api/owi/Owi/Symbolic/P/Env/index.html index d9ef43a4e..5fce84595 100644 --- a/api/owi/Owi/Symbolic/P/Env/index.html +++ b/api/owi/Owi/Symbolic/P/Env/index.html @@ -1,11 +1,2 @@ -Env (owi.Owi.Symbolic.P.Env)

Module P.Env

type t' = Env_id.t
val get_memory : - 'a Link_env.t -> - int -> - Symbolic_memory.t Symbolic_choice.Multicore.t
val get_func : 'a Link_env.t -> int -> Func_intf.t
val get_extern_func : 'a Link_env.t -> Func_id.t -> 'a
val get_elem : 'a Link_env.t -> int -> Link_env.elem
val get_data : - 'a Link_env.t -> - int -> - Link_env.data Symbolic_choice.Multicore.t
val get_global : t -> int -> Global.t Symbolic_choice.Multicore.t
val drop_elem : 'a -> unit
val drop_data : Link_env.data -> unit
+Env (owi.Owi.Symbolic.P.Env)

Module P.Env

type t' = Env_id.t
val get_memory : 'a Link_env.t -> int -> Memory.t Choice.t
val get_func : 'a Link_env.t -> int -> Func_intf.t
val get_extern_func : 'a Link_env.t -> Func_id.t -> 'a
val get_elem : 'a Link_env.t -> int -> Link_env.elem
val get_data : 'a Link_env.t -> int -> Link_env.data Choice.t
val get_global : t -> int -> Global.t Choice.t
val drop_elem : 'a -> unit
val drop_data : Link_env.data -> unit
diff --git a/api/owi/Owi/Symbolic/P/Extern_func/index.html b/api/owi/Owi/Symbolic/P/Extern_func/index.html index 0cbf7b6dc..7bb9bd703 100644 --- a/api/owi/Owi/Symbolic/P/Extern_func/index.html +++ b/api/owi/Owi/Symbolic/P/Extern_func/index.html @@ -1,2 +1,2 @@ -Extern_func (owi.Owi.Symbolic.P.Extern_func)

Module P.Extern_func

type !'b telt =
  1. | I32 : Value.int32 telt
  2. | I64 : Value.int64 telt
  3. | F32 : Value.float32 telt
  4. | F64 : Value.float64 telt
  5. | Externref : 'a Stdlib.Type.Id.t -> 'a telt
type !'e rtype =
  1. | R0 : unit rtype
  2. | R1 : 'a telt -> 'a rtype
  3. | R2 : 'a0 telt * 'b telt -> ('a0 * 'b) rtype
  4. | R3 : 'a1 telt * 'b0 telt * 'c telt -> ('a1 * 'b0 * 'c) rtype
  5. | R4 : 'a2 telt * 'b1 telt * 'c0 telt * 'd telt -> ('a2 * 'b1 * 'c0 * 'd) rtype
type (!'c, !'d) atype =
  1. | UArg : ('b, 'r) atype -> (unit -> 'b, 'r) atype
  2. | Arg : 'a telt * ('b0, 'r0) atype -> ('a -> 'b0, 'r0) atype
  3. | NArg : string * 'a0 telt * ('b1, 'r1) atype -> ('a0 -> 'b1, 'r1) atype
  4. | Res : ('r2, 'r2) atype
type !'a func_type =
  1. | Func : ('f, 'r Symbolic_choice.Multicore.t) atype * 'r rtype -> 'f func_type
type extern_func =
  1. | Extern_func : 'a func_type * 'a -> extern_func
+Extern_func (owi.Owi.Symbolic.P.Extern_func)

Module P.Extern_func

type !'b telt =
  1. | I32 : Value.int32 telt
  2. | I64 : Value.int64 telt
  3. | F32 : Value.float32 telt
  4. | F64 : Value.float64 telt
  5. | Externref : 'a Prelude.Type.Id.t -> 'a telt
type !'e rtype =
  1. | R0 : unit rtype
  2. | R1 : 'a telt -> 'a rtype
  3. | R2 : 'a0 telt * 'b telt -> ('a0 * 'b) rtype
  4. | R3 : 'a1 telt * 'b0 telt * 'c telt -> ('a1 * 'b0 * 'c) rtype
  5. | R4 : 'a2 telt * 'b1 telt * 'c0 telt * 'd telt -> ('a2 * 'b1 * 'c0 * 'd) rtype
type (!'c, !'d) atype =
  1. | Mem : ('b, 'r) atype -> (Symbolic_memory_concretizing.t -> 'b, 'r) atype
  2. | UArg : ('b0, 'r0) atype -> (unit -> 'b0, 'r0) atype
  3. | Arg : 'a telt * ('b1, 'r1) atype -> ('a -> 'b1, 'r1) atype
  4. | NArg : string * 'a0 telt * ('b2, 'r2) atype -> ('a0 -> 'b2, 'r2) atype
  5. | Res : ('r3, 'r3) atype
type !'a func_type =
  1. | Func : ('f, 'r Choice.t) atype * 'r rtype -> 'f func_type
type extern_func =
  1. | Extern_func : 'a func_type * 'a -> extern_func
diff --git a/api/owi/Owi/Symbolic/P/Memory/ITbl/index.html b/api/owi/Owi/Symbolic/P/Memory/ITbl/index.html index d3f63f22e..5cae3ca6a 100644 --- a/api/owi/Owi/Symbolic/P/Memory/ITbl/index.html +++ b/api/owi/Owi/Symbolic/P/Memory/ITbl/index.html @@ -1,2 +1,2 @@ -ITbl (owi.Owi.Symbolic.P.Memory.ITbl)

Module Memory.ITbl

type 'a t
type key
val iter : (key -> 'a -> unit) -> 'a t -> unit
+ITbl (owi.Owi.Symbolic.P.Memory.ITbl)

Module Memory.ITbl

val iter : (key -> 'a -> unit) -> 'a t -> unit
diff --git a/api/owi/Owi/Symbolic/P/Memory/index.html b/api/owi/Owi/Symbolic/P/Memory/index.html index b16362b4a..b886505aa 100644 --- a/api/owi/Owi/Symbolic/P/Memory/index.html +++ b/api/owi/Owi/Symbolic/P/Memory/index.html @@ -1,5 +1,9 @@ -Memory (owi.Owi.Symbolic.P.Memory)

Module P.Memory

type t
type collection
val init : unit -> collection
val clone : collection -> collection
val get_memory : Env_id.t -> Concrete_memory.t -> collection -> int -> t
val replace_size : t -> Int32.t -> Smtml.Expr.t -> unit
val free : t -> Int32.t -> unit
val grow : t -> Smtml.Expr.t -> unit
val fill : t -> pos:Smtml.Expr.t -> len:Smtml.Expr.t -> char -> Smtml.Expr.t
val blit : +Memory (owi.Owi.Symbolic.P.Memory)

Module P.Memory

val init : unit -> collection
val clone : collection -> collection
val get_memory : Env_id.t -> Concrete_memory.t -> collection -> int -> t
val realloc : + t -> + ptr:Smtml.Expr.t -> + size:Smtml.Expr.t -> + Smtml.Expr.t Symbolic_choice_without_memory.t
val free : t -> Smtml.Expr.t -> unit Symbolic_choice_without_memory.t
val grow : t -> Smtml.Expr.t -> unit
val fill : t -> pos:Smtml.Expr.t -> len:Smtml.Expr.t -> char -> Smtml.Expr.t
val blit : t -> src:Smtml.Expr.t -> dst:Smtml.Expr.t -> @@ -10,45 +14,4 @@ src:Smtml.Expr.t -> dst:Smtml.Expr.t -> len:Smtml.Expr.t -> - Smtml.Expr.t
val size : t -> Smtml.Expr.t
val size_in_pages : t -> Smtml.Expr.t
val get_limit_max : t -> Smtml.Expr.t option
module ITbl : sig ... end
val iter : (t ITbl.t -> unit) -> collection -> unit
val concretise : Smtml.Expr.t -> Smtml.Expr.t Symbolic_choice.Multicore.t
val check_within_bounds : - t -> - Smtml.Expr.t -> - Symbolic_value.int32 Symbolic_choice.Multicore.t
val with_concrete : - t -> - Smtml.Expr.t -> - (t -> Symbolic_value.int32 -> 'a) -> - 'a0 Symbolic_choice.Multicore.t
val load_8_s : - t -> - Smtml.Expr.t -> - Symbolic_value.int32 Symbolic_choice.Multicore.t
val load_8_u : - t -> - Smtml.Expr.t -> - Symbolic_value.int32 Symbolic_choice.Multicore.t
val load_16_s : - t -> - Smtml.Expr.t -> - Symbolic_value.int32 Symbolic_choice.Multicore.t
val load_16_u : - t -> - Smtml.Expr.t -> - Symbolic_value.int32 Symbolic_choice.Multicore.t
val load_32 : - t -> - Smtml.Expr.t -> - Symbolic_value.int32 Symbolic_choice.Multicore.t
val load_64 : - t -> - Smtml.Expr.t -> - Symbolic_value.int32 Symbolic_choice.Multicore.t
val store_8 : - t -> - addr:Smtml.Expr.t -> - Smtml.Expr.t -> - unit Symbolic_choice.Multicore.t
val store_16 : - t -> - addr:Smtml.Expr.t -> - Smtml.Expr.t -> - unit Symbolic_choice.Multicore.t
val store_32 : - t -> - addr:Smtml.Expr.t -> - Smtml.Expr.t -> - unit Symbolic_choice.Multicore.t
val store_64 : - t -> - addr:Smtml.Expr.t -> - Smtml.Expr.t -> - unit Symbolic_choice.Multicore.t
+ Smtml.Expr.t
val size : t -> Smtml.Expr.t
val size_in_pages : t -> Smtml.Expr.t
val get_limit_max : t -> Smtml.Expr.t option
module ITbl : sig ... end
val iter : (t ITbl.t -> unit) -> collection -> unit
val load_8_s : t -> Smtml.Expr.t -> Symbolic_value.int32 Choice.t
val load_8_u : t -> Smtml.Expr.t -> Symbolic_value.int32 Choice.t
val load_16_s : t -> Smtml.Expr.t -> Symbolic_value.int32 Choice.t
val load_16_u : t -> Smtml.Expr.t -> Symbolic_value.int32 Choice.t
val load_32 : t -> Smtml.Expr.t -> Symbolic_value.int32 Choice.t
val load_64 : t -> Smtml.Expr.t -> Symbolic_value.int32 Choice.t
val store_8 : t -> addr:Smtml.Expr.t -> Smtml.Expr.t -> unit Choice.t
val store_16 : t -> addr:Smtml.Expr.t -> Smtml.Expr.t -> unit Choice.t
val store_32 : t -> addr:Smtml.Expr.t -> Smtml.Expr.t -> unit Choice.t
val store_64 : t -> addr:Smtml.Expr.t -> Smtml.Expr.t -> unit Choice.t
diff --git a/api/owi/Owi/Symbolic/P/Module_to_run/index.html b/api/owi/Owi/Symbolic/P/Module_to_run/index.html index 7e05c275b..e6404c8c1 100644 --- a/api/owi/Owi/Symbolic/P/Module_to_run/index.html +++ b/api/owi/Owi/Symbolic/P/Module_to_run/index.html @@ -1,2 +1,4 @@ -Module_to_run (owi.Owi.Symbolic.P.Module_to_run)

Module P.Module_to_run

runnable module

val env : t -> Env.t
val modul : t -> Binary.modul
val to_run : t -> Types.binary Types.expr list
+Module_to_run (owi.Owi.Symbolic.P.Module_to_run)

Module P.Module_to_run

runnable module

val env : t -> Env.t
val modul : t -> Binary.modul
val to_run : t -> Types.binary Types.expr list
diff --git a/api/owi/Owi/Symbolic/P/index.html b/api/owi/Owi/Symbolic/P/index.html index 58e4f3135..487a1311d 100644 --- a/api/owi/Owi/Symbolic/P/index.html +++ b/api/owi/Owi/Symbolic/P/index.html @@ -1,6 +1,6 @@ -P (owi.Owi.Symbolic.P)

Module Symbolic.P

include sig ... end
module Value = Symbolic_value
type thread = Thread.t
module Extern_func : sig ... end
val select : +P (owi.Owi.Symbolic.P)

Module Symbolic.P

module Value = Symbolic_value
module Choice : sig ... end
module Extern_func : sig ... end
module Global = Symbolic_global
module Table = Symbolic_table
type thread = Thread_with_memory.t
val select : Value.vbool -> if_true:Value.t -> if_false:Value.t -> - Value.t Symbolic_choice.Multicore.t
module Global = Symbolic_global
module Table = Symbolic_table
module Elem : sig ... end
module Memory : sig ... end
module Data : sig ... end
module Env : sig ... end
module Module_to_run : sig ... end
+ Value.t Choice.t
module Elem : sig ... end
module Memory : sig ... end
module Data : sig ... end
module Env : sig ... end
module Module_to_run : sig ... end
diff --git a/api/owi/Owi/Symbolic/index.html b/api/owi/Owi/Symbolic/index.html index 3ddcd457f..89f6256c6 100644 --- a/api/owi/Owi/Symbolic/index.html +++ b/api/owi/Owi/Symbolic/index.html @@ -1,10 +1,11 @@ -Symbolic (owi.Owi.Symbolic)

Module Owi.Symbolic

module type Thread = sig ... end
module MakeP - (Thread : Thread) - (Choice : +Symbolic (owi.Owi.Symbolic)

Module Owi.Symbolic

module MakeP + (Memory : Symbolic_memory_intf.S) + (Thread : Thread.S with type Memory.collection = Memory.collection) + (Choice : Choice_intf.Complete with module V := Symbolic_value - and type thread := Thread.t) : + and type thread := Thread.t) : sig ... end
module P : sig ... end
module M : sig ... end
val convert_module_to_run_minimalist : diff --git a/api/owi/Owi/Symbolic/module-type-Thread/index.html b/api/owi/Owi/Symbolic/module-type-Thread/index.html deleted file mode 100644 index 60081c96d..000000000 --- a/api/owi/Owi/Symbolic/module-type-Thread/index.html +++ /dev/null @@ -1,2 +0,0 @@ - -Thread (owi.Owi.Symbolic.Thread)

Module type Symbolic.Thread

type t
val memories : t -> Symbolic_memory.collection
val globals : t -> Symbolic_global.collection
val pc : t -> Symbolic_value.vbool list
diff --git a/api/owi/Owi/Symbolic_choice/CoreImpl/State/index.html b/api/owi/Owi/Symbolic_choice/CoreImpl/State/index.html new file mode 100644 index 000000000..d51bca1f0 --- /dev/null +++ b/api/owi/Owi/Symbolic_choice/CoreImpl/State/index.html @@ -0,0 +1,6 @@ + +State (owi.Owi.Symbolic_choice.CoreImpl.State)

Module CoreImpl.State

type ('a, 's) t
val project_state : + ('st1 -> 'st2 * 'backup) -> + ('backup -> 'st2 -> 'st1) -> + ('a, 'st2) t -> + ('a, 'st1) t
diff --git a/api/owi/Owi/Symbolic_choice/CoreImpl/index.html b/api/owi/Owi/Symbolic_choice/CoreImpl/index.html new file mode 100644 index 000000000..8e00d3277 --- /dev/null +++ b/api/owi/Owi/Symbolic_choice/CoreImpl/index.html @@ -0,0 +1,2 @@ + +CoreImpl (owi.Owi.Symbolic_choice.CoreImpl)

Module Symbolic_choice.CoreImpl

module State : sig ... end
diff --git a/api/owi/Owi/Symbolic_choice/Make/argument-1-Thread/Memory/index.html b/api/owi/Owi/Symbolic_choice/Make/argument-1-Thread/Memory/index.html new file mode 100644 index 000000000..b1807f1db --- /dev/null +++ b/api/owi/Owi/Symbolic_choice/Make/argument-1-Thread/Memory/index.html @@ -0,0 +1,2 @@ + +Memory (owi.Owi.Symbolic_choice.Make.Thread.Memory)

Module Thread.Memory

type collection
val init : unit -> collection
val clone : collection -> collection
diff --git a/api/owi/Owi/Symbolic_choice/Make/argument-1-Thread/index.html b/api/owi/Owi/Symbolic_choice/Make/argument-1-Thread/index.html new file mode 100644 index 000000000..8784e7db0 --- /dev/null +++ b/api/owi/Owi/Symbolic_choice/Make/argument-1-Thread/index.html @@ -0,0 +1,10 @@ + +Thread (owi.Owi.Symbolic_choice.Make.Thread)

Parameter Make.Thread

type t
val init : unit -> t
val create : + int -> + Smtml.Symbol.t list -> + Symbolic_value.vbool list -> + Memory.collection -> + Symbolic_table.collection -> + Symbolic_global.collection -> + int32 list -> + t
val pc : t -> Symbolic_value.vbool list
val memories : t -> Memory.collection
val globals : t -> Symbolic_global.collection
val breadcrumbs : t -> int32 list
val symbols_set : t -> Smtml.Symbol.t list
val symbols : t -> int
val clone : t -> t
val add_pc : t -> Symbolic_value.vbool -> t
val add_breadcrumb : t -> int32 -> t
val add_symbol : t -> Smtml.Symbol.t -> t
val incr_symbols : t -> t
diff --git a/api/owi/Owi/Symbolic_choice/Make/index.html b/api/owi/Owi/Symbolic_choice/Make/index.html new file mode 100644 index 000000000..a2efc2bc2 --- /dev/null +++ b/api/owi/Owi/Symbolic_choice/Make/index.html @@ -0,0 +1,10 @@ + +Make (owi.Owi.Symbolic_choice.Make)

Module Symbolic_choice.Make

Parameters

module Thread : Thread.S

Signature

val return : 'a -> 'a t
val bind : 'a t -> ('a -> 'b t) -> 'b t
val let* : 'a t -> ('a -> 'b t) -> 'b t
val map : 'a t -> ('a -> 'b) -> 'b t
val let+ : 'a t -> ('a -> 'b) -> 'b t
val trap : Trap.t -> 'a t
val select : Owi.Symbolic_value.vbool -> bool t
val select_i32 : Owi.Symbolic_value.int32 -> Int32.t t
val assertion : Owi.Symbolic_value.vbool -> unit t
val with_thread : (Thread.t -> 'a) -> 'a t
val with_new_symbol : Smtml.Ty.t -> (Smtml.Symbol.t -> 'b) -> 'b t
val solver : Solver.t t
val thread : Thread.t t
val add_pc : Owi.Symbolic_value.vbool -> unit t
type 'a run_result = ('a Symbolic_choice_intf.eval * Thread.t) Prelude.Seq.t
val run : + workers:int -> + Smtml.Solver_dispatcher.solver_type -> + 'a t -> + Thread.t -> + callback:(('a Symbolic_choice_intf.eval * Thread.t) -> unit) -> + callback_init:(unit -> unit) -> + callback_end:(unit -> unit) -> + unit Prelude.Domain.t array
diff --git a/api/owi/Owi/Symbolic_choice/Minimalist/index.html b/api/owi/Owi/Symbolic_choice/Minimalist/index.html deleted file mode 100644 index c8dd2536b..000000000 --- a/api/owi/Owi/Symbolic_choice/Minimalist/index.html +++ /dev/null @@ -1,5 +0,0 @@ - -Minimalist (owi.Owi.Symbolic_choice.Minimalist)

Module Symbolic_choice.Minimalist

type err = private
  1. | Assert_fail
  2. | Trap of Trap.t
include Choice_intf.Complete - with type thread := Thread.t - and type 'a run_result = ('a, err) Stdlib.Result.t * Thread.t - and module V := Symbolic_value
include Choice_intf.Base with module V := Symbolic_value
type 'a t
val return : 'a -> 'a t
val bind : 'a t -> ('a -> 'b t) -> 'b t
val map : 'a t -> ('a -> 'b) -> 'b t
val select : Owi.Symbolic_value.vbool -> bool t
val select_i32 : Owi.Symbolic_value.int32 -> Int32.t t
val trap : Trap.t -> 'a t
val let* : 'a t -> ('a -> 'b t) -> 'b t
val let+ : 'a t -> ('a -> 'b) -> 'b t
type 'a run_result = ('a, err) Stdlib.Result.t * Thread.t
val assertion : Owi.Symbolic_value.vbool -> unit t
val with_thread : (Thread.t -> 'b) -> 'b t
val solver : Solver.solver t
val thread : Thread.t t
val add_pc : Owi.Symbolic_value.vbool -> unit t
val run : workers:int -> 'a t -> Thread.t -> 'a run_result
diff --git a/api/owi/Owi/Symbolic_choice/Multicore/index.html b/api/owi/Owi/Symbolic_choice/Multicore/index.html deleted file mode 100644 index 319f43e6a..000000000 --- a/api/owi/Owi/Symbolic_choice/Multicore/index.html +++ /dev/null @@ -1,5 +0,0 @@ - -Multicore (owi.Owi.Symbolic_choice.Multicore)

Module Symbolic_choice.Multicore

type 'a eval =
  1. | EVal of 'a
  2. | ETrap of Trap.t
  3. | EAssert of Smtml.Expr.t
include Choice_intf.Complete - with type thread := Thread.t - and type 'a run_result = ('a eval * Thread.t) Stdlib.Seq.t - and module V := Symbolic_value
include Choice_intf.Base with module V := Symbolic_value
type 'a t
val return : 'a -> 'a t
val bind : 'a t -> ('a -> 'b t) -> 'b t
val map : 'a t -> ('a -> 'b) -> 'b t
val select : Owi.Symbolic_value.vbool -> bool t
val select_i32 : Owi.Symbolic_value.int32 -> Int32.t t
val trap : Trap.t -> 'a t
val let* : 'a t -> ('a -> 'b t) -> 'b t
val let+ : 'a t -> ('a -> 'b) -> 'b t
type 'a run_result = ('a eval * Thread.t) Stdlib.Seq.t
val assertion : Owi.Symbolic_value.vbool -> unit t
val with_thread : (Thread.t -> 'b) -> 'b t
val solver : Solver.solver t
val thread : Thread.t t
val add_pc : Owi.Symbolic_value.vbool -> unit t
val run : workers:int -> 'a t -> Thread.t -> 'a run_result
diff --git a/api/owi/Owi/Symbolic_choice/index.html b/api/owi/Owi/Symbolic_choice/index.html index a1ea726b3..9f18798ff 100644 --- a/api/owi/Owi/Symbolic_choice/index.html +++ b/api/owi/Owi/Symbolic_choice/index.html @@ -1,2 +1,7 @@ -Symbolic_choice (owi.Owi.Symbolic_choice)

Module Owi.Symbolic_choice

exception Assertion of Smtml.Expr.t * Thread.t
module Minimalist : sig ... end
module Multicore : sig ... end
+Symbolic_choice (owi.Owi.Symbolic_choice)

Module Owi.Symbolic_choice

module type S = Symbolic_choice_intf.S
module CoreImpl : sig ... end
module Make + (Thread : Thread.S) : + S + with type 'a t = ('a Symbolic_choice_intf.eval, Thread.t) CoreImpl.State.t + and type thread := Thread.t + and module V := Symbolic_value
diff --git a/api/owi/Owi/Symbolic_choice_intf/index.html b/api/owi/Owi/Symbolic_choice_intf/index.html new file mode 100644 index 000000000..e49d69b65 --- /dev/null +++ b/api/owi/Owi/Symbolic_choice_intf/index.html @@ -0,0 +1,2 @@ + +Symbolic_choice_intf (owi.Owi.Symbolic_choice_intf)

Module Owi.Symbolic_choice_intf

type 'a eval =
  1. | EVal of 'a
  2. | ETrap of Trap.t * Smtml.Model.t
  3. | EAssert of Smtml.Expr.t * Smtml.Model.t
module type S = sig ... end
module type Intf = sig ... end
diff --git a/api/owi/Owi/Symbolic_choice_intf/module-type-Intf/CoreImpl/State/index.html b/api/owi/Owi/Symbolic_choice_intf/module-type-Intf/CoreImpl/State/index.html new file mode 100644 index 000000000..b7fe0546a --- /dev/null +++ b/api/owi/Owi/Symbolic_choice_intf/module-type-Intf/CoreImpl/State/index.html @@ -0,0 +1,6 @@ + +State (owi.Owi.Symbolic_choice_intf.Intf.CoreImpl.State)

Module CoreImpl.State

type ('a, 's) t
val project_state : + ('st1 -> 'st2 * 'backup) -> + ('backup -> 'st2 -> 'st1) -> + ('a, 'st2) t -> + ('a, 'st1) t
diff --git a/api/owi/Owi/Symbolic_choice_intf/module-type-Intf/CoreImpl/index.html b/api/owi/Owi/Symbolic_choice_intf/module-type-Intf/CoreImpl/index.html new file mode 100644 index 000000000..c4342b672 --- /dev/null +++ b/api/owi/Owi/Symbolic_choice_intf/module-type-Intf/CoreImpl/index.html @@ -0,0 +1,2 @@ + +CoreImpl (owi.Owi.Symbolic_choice_intf.Intf.CoreImpl)

Module Intf.CoreImpl

module State : sig ... end
diff --git a/api/owi/Owi/Symbolic_choice_intf/module-type-Intf/Make/argument-1-Thread/Memory/index.html b/api/owi/Owi/Symbolic_choice_intf/module-type-Intf/Make/argument-1-Thread/Memory/index.html new file mode 100644 index 000000000..e29dbdb59 --- /dev/null +++ b/api/owi/Owi/Symbolic_choice_intf/module-type-Intf/Make/argument-1-Thread/Memory/index.html @@ -0,0 +1,2 @@ + +Memory (owi.Owi.Symbolic_choice_intf.Intf.Make.Thread.Memory)

Module Thread.Memory

type collection
val init : unit -> collection
val clone : collection -> collection
diff --git a/api/owi/Owi/Symbolic_choice_intf/module-type-Intf/Make/argument-1-Thread/index.html b/api/owi/Owi/Symbolic_choice_intf/module-type-Intf/Make/argument-1-Thread/index.html new file mode 100644 index 000000000..afdeeebeb --- /dev/null +++ b/api/owi/Owi/Symbolic_choice_intf/module-type-Intf/Make/argument-1-Thread/index.html @@ -0,0 +1,10 @@ + +Thread (owi.Owi.Symbolic_choice_intf.Intf.Make.Thread)

Parameter Make.Thread

type t
val init : unit -> t
val create : + int -> + Smtml.Symbol.t list -> + Symbolic_value.vbool list -> + Memory.collection -> + Symbolic_table.collection -> + Symbolic_global.collection -> + int32 list -> + t
val pc : t -> Symbolic_value.vbool list
val memories : t -> Memory.collection
val globals : t -> Symbolic_global.collection
val breadcrumbs : t -> int32 list
val symbols_set : t -> Smtml.Symbol.t list
val symbols : t -> int
val clone : t -> t
val add_pc : t -> Symbolic_value.vbool -> t
val add_breadcrumb : t -> int32 -> t
val add_symbol : t -> Smtml.Symbol.t -> t
val incr_symbols : t -> t
diff --git a/api/owi/Owi/Symbolic_choice_intf/module-type-Intf/Make/index.html b/api/owi/Owi/Symbolic_choice_intf/module-type-Intf/Make/index.html new file mode 100644 index 000000000..d2cb0fa9c --- /dev/null +++ b/api/owi/Owi/Symbolic_choice_intf/module-type-Intf/Make/index.html @@ -0,0 +1,10 @@ + +Make (owi.Owi.Symbolic_choice_intf.Intf.Make)

Module Intf.Make

Parameters

module Thread : Thread.S

Signature

type 'a t = ('a eval, Thread.t) CoreImpl.State.t
val return : 'a -> 'a t
val bind : 'a t -> ('a -> 'b t) -> 'b t
val let* : 'a t -> ('a -> 'b t) -> 'b t
val map : 'a t -> ('a -> 'b) -> 'b t
val let+ : 'a t -> ('a -> 'b) -> 'b t
val trap : Trap.t -> 'a t
val select : Owi.Symbolic_value.vbool -> bool t
val select_i32 : Owi.Symbolic_value.int32 -> Int32.t t
val assertion : Owi.Symbolic_value.vbool -> unit t
val with_thread : (Thread.t -> 'a) -> 'a t
val with_new_symbol : Smtml.Ty.t -> (Smtml.Symbol.t -> 'b) -> 'b t
val solver : Solver.t t
val thread : Thread.t t
val add_pc : Owi.Symbolic_value.vbool -> unit t
type 'a run_result = ('a eval * Thread.t) Prelude.Seq.t
val run : + workers:int -> + Smtml.Solver_dispatcher.solver_type -> + 'a t -> + Thread.t -> + callback:(('a eval * Thread.t) -> unit) -> + callback_init:(unit -> unit) -> + callback_end:(unit -> unit) -> + unit Prelude.Domain.t array
diff --git a/api/owi/Owi/Symbolic_choice_intf/module-type-Intf/index.html b/api/owi/Owi/Symbolic_choice_intf/module-type-Intf/index.html new file mode 100644 index 000000000..71560ac81 --- /dev/null +++ b/api/owi/Owi/Symbolic_choice_intf/module-type-Intf/index.html @@ -0,0 +1,7 @@ + +Intf (owi.Owi.Symbolic_choice_intf.Intf)

Module type Symbolic_choice_intf.Intf

module type S = S
module CoreImpl : sig ... end
module Make + (Thread : Thread.S) : + S + with type 'a t = ('a eval, Thread.t) CoreImpl.State.t + and type thread := Thread.t + and module V := Symbolic_value
diff --git a/api/owi/Owi/Symbolic_choice_intf/module-type-S/V/index.html b/api/owi/Owi/Symbolic_choice_intf/module-type-S/V/index.html new file mode 100644 index 000000000..4cec82e55 --- /dev/null +++ b/api/owi/Owi/Symbolic_choice_intf/module-type-S/V/index.html @@ -0,0 +1,2 @@ + +V (owi.Owi.Symbolic_choice_intf.S.V)

Module S.V

type int32
type int64
type float32
type float64
type vbool
diff --git a/api/owi/Owi/Symbolic_choice_intf/module-type-S/index.html b/api/owi/Owi/Symbolic_choice_intf/module-type-S/index.html new file mode 100644 index 000000000..6ab98e64e --- /dev/null +++ b/api/owi/Owi/Symbolic_choice_intf/module-type-S/index.html @@ -0,0 +1,10 @@ + +S (owi.Owi.Symbolic_choice_intf.S)

Module type Symbolic_choice_intf.S

type thread
type 'a t
val return : 'a -> 'a t
val bind : 'a t -> ('a -> 'b t) -> 'b t
val let* : 'a t -> ('a -> 'b t) -> 'b t
val map : 'a t -> ('a -> 'b) -> 'b t
val let+ : 'a t -> ('a -> 'b) -> 'b t
val trap : Trap.t -> 'a t
val select : V.vbool -> bool t
val select_i32 : V.int32 -> Int32.t t
val assertion : V.vbool -> unit t
val with_thread : (thread -> 'a) -> 'a t
val with_new_symbol : Smtml.Ty.t -> (Smtml.Symbol.t -> 'b) -> 'b t
val solver : Solver.t t
val thread : thread t
val add_pc : V.vbool -> unit t
type 'a run_result = ('a eval * thread) Prelude.Seq.t
val run : + workers:int -> + Smtml.Solver_dispatcher.solver_type -> + 'a t -> + thread -> + callback:(('a eval * thread) -> unit) -> + callback_init:(unit -> unit) -> + callback_end:(unit -> unit) -> + unit Prelude.Domain.t array
diff --git a/api/owi/Owi/Symbolic_choice_minimalist/index.html b/api/owi/Owi/Symbolic_choice_minimalist/index.html new file mode 100644 index 000000000..273fbecb2 --- /dev/null +++ b/api/owi/Owi/Symbolic_choice_minimalist/index.html @@ -0,0 +1,10 @@ + +Symbolic_choice_minimalist (owi.Owi.Symbolic_choice_minimalist)

Module Owi.Symbolic_choice_minimalist

type err = private
  1. | Assert_fail
  2. | Trap of Trap.t
include Choice_intf.Complete + with type thread := Thread_with_memory.t + and type 'a run_result = ('a, err) Prelude.Result.t * Thread_with_memory.t + and module V := Symbolic_value
include Choice_intf.Base with module V := Symbolic_value
type 'a t
val return : 'a -> 'a t
val bind : 'a t -> ('a -> 'b t) -> 'b t
val map : 'a t -> ('a -> 'b) -> 'b t
val select : Owi.Symbolic_value.vbool -> bool t
val select_i32 : Owi.Symbolic_value.int32 -> Int32.t t
val trap : Trap.t -> 'a t
val let* : 'a t -> ('a -> 'b t) -> 'b t
val let+ : 'a t -> ('a -> 'b) -> 'b t
type 'a run_result = ('a, err) Prelude.Result.t * Thread_with_memory.t
val assertion : Owi.Symbolic_value.vbool -> unit t
val with_thread : (Thread_with_memory.t -> 'b) -> 'b t
val solver : Solver.t t
val thread : Thread_with_memory.t t
val add_pc : Owi.Symbolic_value.vbool -> unit t
val lift_mem : 'a Symbolic_choice_without_memory.t -> 'a t
val run : + workers:int -> + Smtml.Solver_dispatcher.solver_type -> + 'a t -> + Thread_with_memory.t -> + 'a run_result
diff --git a/api/owi/Owi/Symbolic_choice_with_memory/index.html b/api/owi/Owi/Symbolic_choice_with_memory/index.html new file mode 100644 index 000000000..e5d7d016d --- /dev/null +++ b/api/owi/Owi/Symbolic_choice_with_memory/index.html @@ -0,0 +1,18 @@ + +Symbolic_choice_with_memory (owi.Owi.Symbolic_choice_with_memory)

Module Owi.Symbolic_choice_with_memory

include Symbolic_choice_intf.S + with type 'a t = + ('a Symbolic_choice_intf.eval, Thread_with_memory.t) + Symbolic_choice.CoreImpl.State.t + and type thread := Thread_with_memory.t + and module V := Symbolic_value
val return : 'a -> 'a t
val bind : 'a t -> ('a -> 'b t) -> 'b t
val let* : 'a t -> ('a -> 'b t) -> 'b t
val map : 'a t -> ('a -> 'b) -> 'b t
val let+ : 'a t -> ('a -> 'b) -> 'b t
val trap : Trap.t -> 'a t
val select : Owi.Symbolic_value.vbool -> bool t
val select_i32 : Owi.Symbolic_value.int32 -> Int32.t t
val assertion : Owi.Symbolic_value.vbool -> unit t
val with_thread : (Thread_with_memory.t -> 'a) -> 'a t
val with_new_symbol : Smtml.Ty.t -> (Smtml.Symbol.t -> 'b) -> 'b t
val solver : Solver.t t
val thread : Thread_with_memory.t t
val add_pc : Owi.Symbolic_value.vbool -> unit t
type 'a run_result = + ('a Symbolic_choice_intf.eval * Thread_with_memory.t) Prelude.Seq.t
val run : + workers:int -> + Smtml.Solver_dispatcher.solver_type -> + 'a t -> + Thread_with_memory.t -> + callback:(('a Symbolic_choice_intf.eval * Thread_with_memory.t) -> unit) -> + callback_init:(unit -> unit) -> + callback_end:(unit -> unit) -> + unit Prelude.Domain.t array
val lift_mem : 'a Symbolic_choice_without_memory.t -> 'a t
diff --git a/api/owi/Owi/Symbolic_choice_without_memory/index.html b/api/owi/Owi/Symbolic_choice_without_memory/index.html new file mode 100644 index 000000000..f3934c280 --- /dev/null +++ b/api/owi/Owi/Symbolic_choice_without_memory/index.html @@ -0,0 +1,18 @@ + +Symbolic_choice_without_memory (owi.Owi.Symbolic_choice_without_memory)

Module Owi.Symbolic_choice_without_memory

include Symbolic_choice_intf.S + with type 'a t = + ('a Symbolic_choice_intf.eval, Thread_without_memory.t) + Symbolic_choice.CoreImpl.State.t + and type thread := Thread_without_memory.t + and module V := Symbolic_value
val return : 'a -> 'a t
val bind : 'a t -> ('a -> 'b t) -> 'b t
val let* : 'a t -> ('a -> 'b t) -> 'b t
val map : 'a t -> ('a -> 'b) -> 'b t
val let+ : 'a t -> ('a -> 'b) -> 'b t
val trap : Trap.t -> 'a t
val select : Owi.Symbolic_value.vbool -> bool t
val select_i32 : Owi.Symbolic_value.int32 -> Int32.t t
val assertion : Owi.Symbolic_value.vbool -> unit t
val with_thread : (Thread_without_memory.t -> 'a) -> 'a t
val with_new_symbol : Smtml.Ty.t -> (Smtml.Symbol.t -> 'b) -> 'b t
val solver : Solver.t t
val add_pc : Owi.Symbolic_value.vbool -> unit t
type 'a run_result = + ('a Symbolic_choice_intf.eval * Thread_without_memory.t) Prelude.Seq.t
val run : + workers:int -> + Smtml.Solver_dispatcher.solver_type -> + 'a t -> + Thread_without_memory.t -> + callback:(('a Symbolic_choice_intf.eval * Thread_without_memory.t) -> unit) -> + callback_init:(unit -> unit) -> + callback_end:(unit -> unit) -> + unit Prelude.Domain.t array
diff --git a/api/owi/Owi/Symbolic_memory/index.html b/api/owi/Owi/Symbolic_memory/index.html index 1ce586817..4c7827630 100644 --- a/api/owi/Owi/Symbolic_memory/index.html +++ b/api/owi/Owi/Symbolic_memory/index.html @@ -2,7 +2,7 @@ Symbolic_memory (owi.Owi.Symbolic_memory)

Module Owi.Symbolic_memory

type t
type collection
val init : unit -> collection
val clone : collection -> collection
val get_memory : Env_id.t -> Concrete_memory.t -> collection -> int -> t
val check_within_bounds : t -> Smtml.Expr.t -> - (Smtml.Expr.t * Symbolic_value.int32, Trap.t) Stdlib.result
val replace_size : t -> Int32.t -> Smtml.Expr.t -> unit
val free : t -> Int32.t -> unit
val load_8_s : t -> Smtml.Expr.t -> Symbolic_value.int32
val load_8_u : t -> Smtml.Expr.t -> Symbolic_value.int32
val load_16_s : t -> Smtml.Expr.t -> Symbolic_value.int32
val load_16_u : t -> Smtml.Expr.t -> Symbolic_value.int32
val load_32 : t -> Smtml.Expr.t -> Symbolic_value.int32
val load_64 : t -> Smtml.Expr.t -> Symbolic_value.int32
val store_8 : t -> addr:Smtml.Expr.t -> Smtml.Expr.t -> unit
val store_16 : t -> addr:Smtml.Expr.t -> Smtml.Expr.t -> unit
val store_32 : t -> addr:Smtml.Expr.t -> Smtml.Expr.t -> unit
val store_64 : t -> addr:Smtml.Expr.t -> Smtml.Expr.t -> unit
val grow : t -> Smtml.Expr.t -> unit
val fill : t -> pos:Smtml.Expr.t -> len:Smtml.Expr.t -> char -> Smtml.Expr.t
val blit : + (Smtml.Expr.t * Symbolic_value.int32, Trap.t) Prelude.result
val realloc : t -> Int32.t -> Smtml.Expr.t -> unit
val free : t -> Int32.t -> unit
val load_8_s : t -> Smtml.Expr.t -> Symbolic_value.int32
val load_8_u : t -> Smtml.Expr.t -> Symbolic_value.int32
val load_16_s : t -> Smtml.Expr.t -> Symbolic_value.int32
val load_16_u : t -> Smtml.Expr.t -> Symbolic_value.int32
val load_32 : t -> Smtml.Expr.t -> Symbolic_value.int32
val load_64 : t -> Smtml.Expr.t -> Symbolic_value.int32
val store_8 : t -> addr:Smtml.Expr.t -> Smtml.Expr.t -> unit
val store_16 : t -> addr:Smtml.Expr.t -> Smtml.Expr.t -> unit
val store_32 : t -> addr:Smtml.Expr.t -> Smtml.Expr.t -> unit
val store_64 : t -> addr:Smtml.Expr.t -> Smtml.Expr.t -> unit
val grow : t -> Smtml.Expr.t -> unit
val fill : t -> pos:Smtml.Expr.t -> len:Smtml.Expr.t -> char -> Smtml.Expr.t
val blit : t -> src:Smtml.Expr.t -> dst:Smtml.Expr.t -> diff --git a/api/owi/Owi/Symbolic_memory_concretizing/ITbl/index.html b/api/owi/Owi/Symbolic_memory_concretizing/ITbl/index.html new file mode 100644 index 000000000..25fadff23 --- /dev/null +++ b/api/owi/Owi/Symbolic_memory_concretizing/ITbl/index.html @@ -0,0 +1,2 @@ + +ITbl (owi.Owi.Symbolic_memory_concretizing.ITbl)

Module Symbolic_memory_concretizing.ITbl

type 'a t
type key
val iter : (key -> 'a -> unit) -> 'a t -> unit
diff --git a/api/owi/Owi/Symbolic_memory_concretizing/index.html b/api/owi/Owi/Symbolic_memory_concretizing/index.html new file mode 100644 index 000000000..f7799dbc8 --- /dev/null +++ b/api/owi/Owi/Symbolic_memory_concretizing/index.html @@ -0,0 +1,51 @@ + +Symbolic_memory_concretizing (owi.Owi.Symbolic_memory_concretizing)

Module Owi.Symbolic_memory_concretizing

type t
type collection
val init : unit -> collection
val clone : collection -> collection
val get_memory : Env_id.t -> Concrete_memory.t -> collection -> int -> t
val realloc : + t -> + ptr:Smtml.Expr.t -> + size:Smtml.Expr.t -> + Smtml.Expr.t Symbolic_choice_without_memory.t
val free : t -> Smtml.Expr.t -> unit Symbolic_choice_without_memory.t
val load_8_s : + t -> + Smtml.Expr.t -> + Symbolic_value.int32 Symbolic_choice_without_memory.t
val load_8_u : + t -> + Smtml.Expr.t -> + Symbolic_value.int32 Symbolic_choice_without_memory.t
val load_16_s : + t -> + Smtml.Expr.t -> + Symbolic_value.int32 Symbolic_choice_without_memory.t
val load_16_u : + t -> + Smtml.Expr.t -> + Symbolic_value.int32 Symbolic_choice_without_memory.t
val load_32 : + t -> + Smtml.Expr.t -> + Symbolic_value.int32 Symbolic_choice_without_memory.t
val load_64 : + t -> + Smtml.Expr.t -> + Symbolic_value.int32 Symbolic_choice_without_memory.t
val store_8 : + t -> + addr:Smtml.Expr.t -> + Smtml.Expr.t -> + unit Symbolic_choice_without_memory.t
val store_16 : + t -> + addr:Smtml.Expr.t -> + Smtml.Expr.t -> + unit Symbolic_choice_without_memory.t
val store_32 : + t -> + addr:Smtml.Expr.t -> + Smtml.Expr.t -> + unit Symbolic_choice_without_memory.t
val store_64 : + t -> + addr:Smtml.Expr.t -> + Smtml.Expr.t -> + unit Symbolic_choice_without_memory.t
val grow : t -> Smtml.Expr.t -> unit
val fill : t -> pos:Smtml.Expr.t -> len:Smtml.Expr.t -> char -> Smtml.Expr.t
val blit : + t -> + src:Smtml.Expr.t -> + dst:Smtml.Expr.t -> + len:Smtml.Expr.t -> + Smtml.Expr.t
val blit_string : + t -> + string -> + src:Smtml.Expr.t -> + dst:Smtml.Expr.t -> + len:Smtml.Expr.t -> + Smtml.Expr.t
val size : t -> Smtml.Expr.t
val size_in_pages : t -> Smtml.Expr.t
val get_limit_max : t -> Smtml.Expr.t option
module ITbl : sig ... end
val iter : (t ITbl.t -> unit) -> collection -> unit
diff --git a/api/owi/Owi/Symbolic_memory_intf/index.html b/api/owi/Owi/Symbolic_memory_intf/index.html new file mode 100644 index 000000000..59eb732fd --- /dev/null +++ b/api/owi/Owi/Symbolic_memory_intf/index.html @@ -0,0 +1,2 @@ + +Symbolic_memory_intf (owi.Owi.Symbolic_memory_intf)

Module Owi.Symbolic_memory_intf

module type M = sig ... end
module type S = sig ... end
module type Intf = sig ... end
diff --git a/api/owi/Owi/Symbolic_memory_intf/module-type-Intf/Make/ITbl/index.html b/api/owi/Owi/Symbolic_memory_intf/module-type-Intf/Make/ITbl/index.html new file mode 100644 index 000000000..8f438230a --- /dev/null +++ b/api/owi/Owi/Symbolic_memory_intf/module-type-Intf/Make/ITbl/index.html @@ -0,0 +1,2 @@ + +ITbl (owi.Owi.Symbolic_memory_intf.Intf.Make.ITbl)

Module Make.ITbl

type 'a t
type key
val iter : (key -> 'a -> unit) -> 'a t -> unit
diff --git a/api/owi/Owi/Symbolic_memory_intf/module-type-Intf/Make/argument-1-_/index.html b/api/owi/Owi/Symbolic_memory_intf/module-type-Intf/Make/argument-1-_/index.html new file mode 100644 index 000000000..a1dc3b07f --- /dev/null +++ b/api/owi/Owi/Symbolic_memory_intf/module-type-Intf/Make/argument-1-_/index.html @@ -0,0 +1,9 @@ + +_ (owi.Owi.Symbolic_memory_intf.Intf.Make._)

Parameter Make._

type t
type address
val address : Smtml.Expr.t -> address Symbolic_choice_without_memory.t
val address_i32 : Int32.t -> address
val make : unit -> t
val clone : t -> t
val loadn : t -> address -> int -> Smtml.Expr.t
val storen : t -> address -> Smtml.Expr.t -> int -> unit
val validate_address : + t -> + Smtml.Expr.t -> + (Smtml.Expr.t, Trap.t) Prelude.result Symbolic_choice_without_memory.t
val realloc : + t -> + ptr:Smtml.Expr.t -> + size:Smtml.Expr.t -> + Smtml.Expr.t Symbolic_choice_without_memory.t
val free : t -> Smtml.Expr.t -> unit Symbolic_choice_without_memory.t
diff --git a/api/owi/Owi/Symbolic_memory_intf/module-type-Intf/Make/index.html b/api/owi/Owi/Symbolic_memory_intf/module-type-Intf/Make/index.html new file mode 100644 index 000000000..6e6147b49 --- /dev/null +++ b/api/owi/Owi/Symbolic_memory_intf/module-type-Intf/Make/index.html @@ -0,0 +1,51 @@ + +Make (owi.Owi.Symbolic_memory_intf.Intf.Make)

Module Intf.Make

Parameters

module _ : M

Signature

type t
type collection
val init : unit -> collection
val clone : collection -> collection
val get_memory : Env_id.t -> Concrete_memory.t -> collection -> int -> t
val realloc : + t -> + ptr:Smtml.Expr.t -> + size:Smtml.Expr.t -> + Smtml.Expr.t Symbolic_choice_without_memory.t
val free : t -> Smtml.Expr.t -> unit Symbolic_choice_without_memory.t
val load_8_s : + t -> + Smtml.Expr.t -> + Symbolic_value.int32 Symbolic_choice_without_memory.t
val load_8_u : + t -> + Smtml.Expr.t -> + Symbolic_value.int32 Symbolic_choice_without_memory.t
val load_16_s : + t -> + Smtml.Expr.t -> + Symbolic_value.int32 Symbolic_choice_without_memory.t
val load_16_u : + t -> + Smtml.Expr.t -> + Symbolic_value.int32 Symbolic_choice_without_memory.t
val load_32 : + t -> + Smtml.Expr.t -> + Symbolic_value.int32 Symbolic_choice_without_memory.t
val load_64 : + t -> + Smtml.Expr.t -> + Symbolic_value.int32 Symbolic_choice_without_memory.t
val store_8 : + t -> + addr:Smtml.Expr.t -> + Smtml.Expr.t -> + unit Symbolic_choice_without_memory.t
val store_16 : + t -> + addr:Smtml.Expr.t -> + Smtml.Expr.t -> + unit Symbolic_choice_without_memory.t
val store_32 : + t -> + addr:Smtml.Expr.t -> + Smtml.Expr.t -> + unit Symbolic_choice_without_memory.t
val store_64 : + t -> + addr:Smtml.Expr.t -> + Smtml.Expr.t -> + unit Symbolic_choice_without_memory.t
val grow : t -> Smtml.Expr.t -> unit
val fill : t -> pos:Smtml.Expr.t -> len:Smtml.Expr.t -> char -> Smtml.Expr.t
val blit : + t -> + src:Smtml.Expr.t -> + dst:Smtml.Expr.t -> + len:Smtml.Expr.t -> + Smtml.Expr.t
val blit_string : + t -> + string -> + src:Smtml.Expr.t -> + dst:Smtml.Expr.t -> + len:Smtml.Expr.t -> + Smtml.Expr.t
val size : t -> Smtml.Expr.t
val size_in_pages : t -> Smtml.Expr.t
val get_limit_max : t -> Smtml.Expr.t option
module ITbl : sig ... end
val iter : (t ITbl.t -> unit) -> collection -> unit
diff --git a/api/owi/Owi/Symbolic_memory_intf/module-type-Intf/index.html b/api/owi/Owi/Symbolic_memory_intf/module-type-Intf/index.html new file mode 100644 index 000000000..97d75c8bb --- /dev/null +++ b/api/owi/Owi/Symbolic_memory_intf/module-type-Intf/index.html @@ -0,0 +1,2 @@ + +Intf (owi.Owi.Symbolic_memory_intf.Intf)

Module type Symbolic_memory_intf.Intf

module type M = M
module type S = S
module Make (_ : M) : S
diff --git a/api/owi/Owi/Symbolic_memory_intf/module-type-M/index.html b/api/owi/Owi/Symbolic_memory_intf/module-type-M/index.html new file mode 100644 index 000000000..e9457d4dc --- /dev/null +++ b/api/owi/Owi/Symbolic_memory_intf/module-type-M/index.html @@ -0,0 +1,9 @@ + +M (owi.Owi.Symbolic_memory_intf.M)

Module type Symbolic_memory_intf.M

type t
type address
val address : Smtml.Expr.t -> address Symbolic_choice_without_memory.t
val address_i32 : Int32.t -> address
val make : unit -> t
val clone : t -> t
val loadn : t -> address -> int -> Smtml.Expr.t
val storen : t -> address -> Smtml.Expr.t -> int -> unit
val validate_address : + t -> + Smtml.Expr.t -> + (Smtml.Expr.t, Trap.t) Prelude.result Symbolic_choice_without_memory.t
val realloc : + t -> + ptr:Smtml.Expr.t -> + size:Smtml.Expr.t -> + Smtml.Expr.t Symbolic_choice_without_memory.t
val free : t -> Smtml.Expr.t -> unit Symbolic_choice_without_memory.t
diff --git a/api/owi/Owi/Symbolic_memory_intf/module-type-S/ITbl/index.html b/api/owi/Owi/Symbolic_memory_intf/module-type-S/ITbl/index.html new file mode 100644 index 000000000..7195219dd --- /dev/null +++ b/api/owi/Owi/Symbolic_memory_intf/module-type-S/ITbl/index.html @@ -0,0 +1,2 @@ + +ITbl (owi.Owi.Symbolic_memory_intf.S.ITbl)

Module S.ITbl

type 'a t
type key
val iter : (key -> 'a -> unit) -> 'a t -> unit
diff --git a/api/owi/Owi/Symbolic_memory_intf/module-type-S/index.html b/api/owi/Owi/Symbolic_memory_intf/module-type-S/index.html new file mode 100644 index 000000000..aa1bd082e --- /dev/null +++ b/api/owi/Owi/Symbolic_memory_intf/module-type-S/index.html @@ -0,0 +1,51 @@ + +S (owi.Owi.Symbolic_memory_intf.S)

Module type Symbolic_memory_intf.S

type t
type collection
val init : unit -> collection
val clone : collection -> collection
val get_memory : Env_id.t -> Concrete_memory.t -> collection -> int -> t
val realloc : + t -> + ptr:Smtml.Expr.t -> + size:Smtml.Expr.t -> + Smtml.Expr.t Symbolic_choice_without_memory.t
val free : t -> Smtml.Expr.t -> unit Symbolic_choice_without_memory.t
val load_8_s : + t -> + Smtml.Expr.t -> + Symbolic_value.int32 Symbolic_choice_without_memory.t
val load_8_u : + t -> + Smtml.Expr.t -> + Symbolic_value.int32 Symbolic_choice_without_memory.t
val load_16_s : + t -> + Smtml.Expr.t -> + Symbolic_value.int32 Symbolic_choice_without_memory.t
val load_16_u : + t -> + Smtml.Expr.t -> + Symbolic_value.int32 Symbolic_choice_without_memory.t
val load_32 : + t -> + Smtml.Expr.t -> + Symbolic_value.int32 Symbolic_choice_without_memory.t
val load_64 : + t -> + Smtml.Expr.t -> + Symbolic_value.int32 Symbolic_choice_without_memory.t
val store_8 : + t -> + addr:Smtml.Expr.t -> + Smtml.Expr.t -> + unit Symbolic_choice_without_memory.t
val store_16 : + t -> + addr:Smtml.Expr.t -> + Smtml.Expr.t -> + unit Symbolic_choice_without_memory.t
val store_32 : + t -> + addr:Smtml.Expr.t -> + Smtml.Expr.t -> + unit Symbolic_choice_without_memory.t
val store_64 : + t -> + addr:Smtml.Expr.t -> + Smtml.Expr.t -> + unit Symbolic_choice_without_memory.t
val grow : t -> Smtml.Expr.t -> unit
val fill : t -> pos:Smtml.Expr.t -> len:Smtml.Expr.t -> char -> Smtml.Expr.t
val blit : + t -> + src:Smtml.Expr.t -> + dst:Smtml.Expr.t -> + len:Smtml.Expr.t -> + Smtml.Expr.t
val blit_string : + t -> + string -> + src:Smtml.Expr.t -> + dst:Smtml.Expr.t -> + len:Smtml.Expr.t -> + Smtml.Expr.t
val size : t -> Smtml.Expr.t
val size_in_pages : t -> Smtml.Expr.t
val get_limit_max : t -> Smtml.Expr.t option
module ITbl : sig ... end
val iter : (t ITbl.t -> unit) -> collection -> unit
diff --git a/api/owi/Owi/Symbolic_memory_make/Make/ITbl/index.html b/api/owi/Owi/Symbolic_memory_make/Make/ITbl/index.html new file mode 100644 index 000000000..78884760e --- /dev/null +++ b/api/owi/Owi/Symbolic_memory_make/Make/ITbl/index.html @@ -0,0 +1,2 @@ + +ITbl (owi.Owi.Symbolic_memory_make.Make.ITbl)

Module Make.ITbl

type 'a t
type key
val iter : (key -> 'a -> unit) -> 'a t -> unit
diff --git a/api/owi/Owi/Symbolic_memory_make/Make/argument-1-_/index.html b/api/owi/Owi/Symbolic_memory_make/Make/argument-1-_/index.html new file mode 100644 index 000000000..cbcbe12fb --- /dev/null +++ b/api/owi/Owi/Symbolic_memory_make/Make/argument-1-_/index.html @@ -0,0 +1,9 @@ + +_ (owi.Owi.Symbolic_memory_make.Make._)

Parameter Make._

type t
type address
val address : Smtml.Expr.t -> address Symbolic_choice_without_memory.t
val address_i32 : Int32.t -> address
val make : unit -> t
val clone : t -> t
val loadn : t -> address -> int -> Smtml.Expr.t
val storen : t -> address -> Smtml.Expr.t -> int -> unit
val validate_address : + t -> + Smtml.Expr.t -> + (Smtml.Expr.t, Trap.t) Prelude.result Symbolic_choice_without_memory.t
val realloc : + t -> + ptr:Smtml.Expr.t -> + size:Smtml.Expr.t -> + Smtml.Expr.t Symbolic_choice_without_memory.t
val free : t -> Smtml.Expr.t -> unit Symbolic_choice_without_memory.t
diff --git a/api/owi/Owi/Symbolic_memory_make/Make/index.html b/api/owi/Owi/Symbolic_memory_make/Make/index.html new file mode 100644 index 000000000..ade09b41b --- /dev/null +++ b/api/owi/Owi/Symbolic_memory_make/Make/index.html @@ -0,0 +1,51 @@ + +Make (owi.Owi.Symbolic_memory_make.Make)

Module Symbolic_memory_make.Make

Parameters

module _ : M

Signature

type t
type collection
val init : unit -> collection
val clone : collection -> collection
val get_memory : Env_id.t -> Concrete_memory.t -> collection -> int -> t
val realloc : + t -> + ptr:Smtml.Expr.t -> + size:Smtml.Expr.t -> + Smtml.Expr.t Symbolic_choice_without_memory.t
val free : t -> Smtml.Expr.t -> unit Symbolic_choice_without_memory.t
val load_8_s : + t -> + Smtml.Expr.t -> + Symbolic_value.int32 Symbolic_choice_without_memory.t
val load_8_u : + t -> + Smtml.Expr.t -> + Symbolic_value.int32 Symbolic_choice_without_memory.t
val load_16_s : + t -> + Smtml.Expr.t -> + Symbolic_value.int32 Symbolic_choice_without_memory.t
val load_16_u : + t -> + Smtml.Expr.t -> + Symbolic_value.int32 Symbolic_choice_without_memory.t
val load_32 : + t -> + Smtml.Expr.t -> + Symbolic_value.int32 Symbolic_choice_without_memory.t
val load_64 : + t -> + Smtml.Expr.t -> + Symbolic_value.int32 Symbolic_choice_without_memory.t
val store_8 : + t -> + addr:Smtml.Expr.t -> + Smtml.Expr.t -> + unit Symbolic_choice_without_memory.t
val store_16 : + t -> + addr:Smtml.Expr.t -> + Smtml.Expr.t -> + unit Symbolic_choice_without_memory.t
val store_32 : + t -> + addr:Smtml.Expr.t -> + Smtml.Expr.t -> + unit Symbolic_choice_without_memory.t
val store_64 : + t -> + addr:Smtml.Expr.t -> + Smtml.Expr.t -> + unit Symbolic_choice_without_memory.t
val grow : t -> Smtml.Expr.t -> unit
val fill : t -> pos:Smtml.Expr.t -> len:Smtml.Expr.t -> char -> Smtml.Expr.t
val blit : + t -> + src:Smtml.Expr.t -> + dst:Smtml.Expr.t -> + len:Smtml.Expr.t -> + Smtml.Expr.t
val blit_string : + t -> + string -> + src:Smtml.Expr.t -> + dst:Smtml.Expr.t -> + len:Smtml.Expr.t -> + Smtml.Expr.t
val size : t -> Smtml.Expr.t
val size_in_pages : t -> Smtml.Expr.t
val get_limit_max : t -> Smtml.Expr.t option
module ITbl : sig ... end
val iter : (t ITbl.t -> unit) -> collection -> unit
diff --git a/api/owi/Owi/Symbolic_memory_make/index.html b/api/owi/Owi/Symbolic_memory_make/index.html new file mode 100644 index 000000000..04e946a7a --- /dev/null +++ b/api/owi/Owi/Symbolic_memory_make/index.html @@ -0,0 +1,2 @@ + +Symbolic_memory_make (owi.Owi.Symbolic_memory_make)

Module Owi.Symbolic_memory_make

module type M = Symbolic_memory_intf.M
module type S = Symbolic_memory_intf.S
module Make (_ : M) : S
diff --git a/api/owi/Owi/Symbolic_value/Bool/index.html b/api/owi/Owi/Symbolic_value/Bool/index.html index f69160d49..1070bc0ee 100644 --- a/api/owi/Owi/Symbolic_value/Bool/index.html +++ b/api/owi/Owi/Symbolic_value/Bool/index.html @@ -1,5 +1,5 @@ -Bool (owi.Owi.Symbolic_value.Bool)

Module Symbolic_value.Bool

val const : bool -> vbool
val not : vbool -> vbool
val or_ : vbool -> vbool -> vbool
val and_ : vbool -> vbool -> vbool
val int32 : vbool -> int32
val pp : Format.formatter -> vbool -> unit
val select_expr : +Bool (owi.Owi.Symbolic_value.Bool)

Module Symbolic_value.Bool

val const : bool -> vbool
val not : vbool -> vbool
val or_ : vbool -> vbool -> vbool
val and_ : vbool -> vbool -> vbool
val int32 : vbool -> int32
val pp : Prelude.Fmt.formatter -> vbool -> unit
val select_expr : Smtml.Expr.t -> if_true:Smtml.Expr.t -> if_false:Smtml.Expr.t -> diff --git a/api/owi/Owi/Symbolic_value/Ref/index.html b/api/owi/Owi/Symbolic_value/Ref/index.html index 4ca7b59b4..a07fa9d0f 100644 --- a/api/owi/Owi/Symbolic_value/Ref/index.html +++ b/api/owi/Owi/Symbolic_value/Ref/index.html @@ -1,2 +1,2 @@ -Ref (owi.Owi.Symbolic_value.Ref)

Module Symbolic_value.Ref

val get_externref : ref_value -> 'a Stdlib.Type.Id.t -> 'a Value_intf.get_ref
+Ref (owi.Owi.Symbolic_value.Ref)

Module Symbolic_value.Ref

val get_externref : ref_value -> 'a Prelude.Type.Id.t -> 'a Value_intf.get_ref
diff --git a/api/owi/Owi/Symbolic_value/index.html b/api/owi/Owi/Symbolic_value/index.html index 4509a2559..ba62a0e8d 100644 --- a/api/owi/Owi/Symbolic_value/index.html +++ b/api/owi/Owi/Symbolic_value/index.html @@ -5,4 +5,4 @@ and type int32 = Smtml.Expr.t and type int64 = Smtml.Expr.t and type float32 = Smtml.Expr.t - and type float64 = Smtml.Expr.t
type vbool = Smtml.Expr.t
type int32 = Smtml.Expr.t
type int64 = Smtml.Expr.t
type float32 = Smtml.Expr.t
type float64 = Smtml.Expr.t
type t =
  1. | I32 of int32
  2. | I64 of int64
  3. | F32 of float32
  4. | F64 of float64
  5. | Ref of ref_value
val const_i32 : Int32.t -> int32
val const_i64 : Int64.t -> int64
val const_f32 : Float32.t -> float32
val const_f64 : Float64.t -> float64
val ref_null : Types.binary Types.heap_type -> t
val ref_func : Func_intf.t -> t
val ref_externref : 'a Stdlib.Type.Id.t -> 'a -> t
val ref_is_null : ref_value -> vbool
val pp : Format.formatter -> t -> unit
module Ref : sig ... end
module F32 : sig ... end
module F64 : sig ... end
module I32 : sig ... end
module I64 : sig ... end
module Bool : sig ... end
+ and type float64 = Smtml.Expr.t
type vbool = Smtml.Expr.t
type int32 = Smtml.Expr.t
val pp_int32 : Prelude.Fmt.formatter -> int32 -> unit
type int64 = Smtml.Expr.t
val pp_int64 : Prelude.Fmt.formatter -> int64 -> unit
type float32 = Smtml.Expr.t
val pp_float32 : Prelude.Fmt.formatter -> float32 -> unit
type float64 = Smtml.Expr.t
val pp_float64 : Prelude.Fmt.formatter -> float64 -> unit
val pp_ref_value : Prelude.Fmt.formatter -> ref_value -> unit
type t =
  1. | I32 of int32
  2. | I64 of int64
  3. | F32 of float32
  4. | F64 of float64
  5. | Ref of ref_value
val pp : Prelude.Fmt.formatter -> t -> unit
val const_i32 : Int32.t -> int32
val const_i64 : Int64.t -> int64
val const_f32 : Float32.t -> float32
val const_f64 : Float64.t -> float64
val ref_null : Types.binary Types.heap_type -> t
val ref_func : Func_intf.t -> t
val ref_externref : 'a Prelude.Type.Id.t -> 'a -> t
val ref_is_null : ref_value -> vbool
module Ref : sig ... end
module F32 : sig ... end
module F64 : sig ... end
module I32 : sig ... end
module I64 : sig ... end
module Bool : sig ... end
diff --git a/api/owi/Owi/Symbolic_wasm_ffi/index.html b/api/owi/Owi/Symbolic_wasm_ffi/index.html new file mode 100644 index 000000000..0cddb19e4 --- /dev/null +++ b/api/owi/Owi/Symbolic_wasm_ffi/index.html @@ -0,0 +1,3 @@ + +Symbolic_wasm_ffi (owi.Owi.Symbolic_wasm_ffi)

Module Owi.Symbolic_wasm_ffi

include Wasm_ffi_intf.S + with type extern_func = Symbolic.P.Extern_func.extern_func
val symbolic_extern_module : extern_func Link.extern_module
val summaries_extern_module : extern_func Link.extern_module
diff --git a/api/owi/Owi/Syntax/index.html b/api/owi/Owi/Syntax/index.html index dbe5b49bc..627b476e7 100644 --- a/api/owi/Owi/Syntax/index.html +++ b/api/owi/Owi/Syntax/index.html @@ -1,30 +1,28 @@ Syntax (owi.Owi.Syntax)

Module Owi.Syntax

val let* : - ('a, 'err) Stdlib.Result.t -> - ('a -> ('b, 'err) Stdlib.Result.t) -> - ('b, 'err) Stdlib.Result.t
val let+ : - ('a, 'err) Stdlib.Result.t -> + ('a, 'err) Prelude.Result.t -> + ('a -> ('b, 'err) Prelude.Result.t) -> + ('b, 'err) Prelude.Result.t
val let+ : + ('a, 'err) Prelude.Result.t -> ('a -> 'b) -> - ('b, 'err) Stdlib.Result.t
val error : string -> ('a, string) Stdlib.Result.t
val error_s : - ('a, Format.formatter, unit, ('b, string) Stdlib.Result.t) Stdlib.format4 -> - 'a
val ok : 'a -> ('a, 'err) Stdlib.Result.t
val list_iter : - ('a -> (unit, 'err) Stdlib.Result.t) -> + ('b, 'err) Prelude.Result.t
val error : string -> ('a, string) Prelude.Result.t
val ok : 'a -> ('a, 'err) Prelude.Result.t
val list_iter : + ('a -> (unit, 'err) Prelude.Result.t) -> 'a list -> - (unit, 'err) Stdlib.Result.t
val list_map : - ('a -> ('b, 'err) Stdlib.Result.t) -> + (unit, 'err) Prelude.Result.t
val list_map : + ('a -> ('b, 'err) Prelude.Result.t) -> 'a list -> - ('b list, 'err) Stdlib.Result.t
val list_fold_left : - ('a -> 'b -> ('a, 'err) Stdlib.Result.t) -> + ('b list, 'err) Prelude.Result.t
val list_fold_left : + ('a -> 'b -> ('a, 'err) Prelude.Result.t) -> 'a -> 'b list -> - ('a, 'err) Stdlib.Result.t
val array_iter : - ('a -> (unit, 'err) Stdlib.Result.t) -> + ('a, 'err) Prelude.Result.t
val array_iter : + ('a -> (unit, 'err) Prelude.Result.t) -> 'a array -> - (unit, 'err) Stdlib.Result.t
val array_map : - ('a -> ('b, 'err) Stdlib.Result.t) -> + (unit, 'err) Prelude.Result.t
val array_map : + ('a -> ('b, 'err) Prelude.Result.t) -> 'a array -> - ('b array, 'err) Stdlib.Result.t
val array_fold_left : - ('a -> 'b -> ('a, 'err) Stdlib.Result.t) -> + ('b array, 'err) Prelude.Result.t
val array_fold_left : + ('a -> 'b -> ('a, 'err) Prelude.Result.t) -> 'a -> 'b array -> - ('a, 'err) Stdlib.Result.t
+ ('a, 'err) Prelude.Result.t
diff --git a/api/owi/Owi/Testcase/index.html b/api/owi/Owi/Testcase/index.html deleted file mode 100644 index 94e07a183..000000000 --- a/api/owi/Owi/Testcase/index.html +++ /dev/null @@ -1,6 +0,0 @@ - -Testcase (owi.Owi.Testcase)

Module Owi.Testcase

val write_testcase : - dir:Fpath.t -> - err:bool -> - Smtml.Value.t list -> - unit Result.t
diff --git a/api/owi/Owi/Text/index.html b/api/owi/Owi/Text/index.html index 4ab052f99..1e27bd4f8 100644 --- a/api/owi/Owi/Text/index.html +++ b/api/owi/Owi/Text/index.html @@ -2,4 +2,4 @@ Text (owi.Owi.Text)

Module Owi.Text

val symbolic : string -> < string_indices : Types.yes.. > Types.indice
val raw : int -> < .. > Types.indice
val bt_ind : < raw_bt : Types.yes.. > as 'a Types.indice -> 'a Types.block_type
val bt_raw : 'b as 'a Types.indice option -> ('a Types.param_type * 'a Types.result_type) -> - 'a Types.block_type
type global = {
  1. typ : Types.text Types.global_type;
  2. init : Types.text Types.expr;
  3. id : string option;
}
val pp_global : Format.formatter -> global -> Stdlib.Unit.t
type data_mode =
  1. | Data_passive
  2. | Data_active of Types.text Types.indice option * Types.text Types.expr
val pp_data_mode : Format.formatter -> data_mode -> Stdlib.Unit.t
type data = {
  1. id : string option;
  2. init : string;
  3. mode : data_mode;
}
val pp_data : Format.formatter -> data -> Stdlib.Unit.t
type elem_mode =
  1. | Elem_passive
  2. | Elem_active of Types.text Types.indice option * Types.text Types.expr
  3. | Elem_declarative
val pp_elem_mode : Format.formatter -> elem_mode -> Stdlib.Unit.t
type elem = {
  1. id : string option;
  2. typ : Types.text Types.ref_type;
  3. init : Types.text Types.expr list;
  4. mode : elem_mode;
}
val pp_elem_expr : Format.formatter -> 'a Types.expr -> Stdlib.Unit.t
val pp_elem : Format.formatter -> elem -> Stdlib.Unit.t
type module_field =
  1. | MType of Types.text Types.rec_type
  2. | MGlobal of global
  3. | MTable of Types.text Types.table
  4. | MMem of Types.mem
  5. | MFunc of Types.text Types.func
  6. | MElem of elem
  7. | MData of data
  8. | MStart of Types.text Types.indice
  9. | MImport of Types.text Types.import
  10. | MExport of Types.text Types.export
val pp_module_field : Format.formatter -> module_field -> Stdlib.Unit.t
type modul = {
  1. id : string option;
  2. fields : module_field list;
}
val pp_modul : Format.formatter -> modul -> unit
type action =
  1. | Invoke of string option * string * Types.text Types.const list
  2. | Get of string option * string
val pp_action : Format.formatter -> action -> unit
type result_const =
  1. | Literal of Types.text Types.const
  2. | Nan_canon of Types.nn
  3. | Nan_arith of Types.nn
val pp_result_const : Format.formatter -> result_const -> unit
type result =
  1. | Result_const of result_const
  2. | Result_extern_ref
  3. | Result_func_ref
val pp_result : Format.formatter -> result -> unit
val pp_result_bis : Format.formatter -> result -> unit
val pp_results : Format.formatter -> result list -> unit
type assertion =
  1. | Assert_return of action * result list
  2. | Assert_trap of action * string
  3. | Assert_trap_module of modul * string
  4. | Assert_malformed of modul * string
  5. | Assert_malformed_quote of string * string
  6. | Assert_malformed_binary of string * string
  7. | Assert_invalid of modul * string
  8. | Assert_invalid_quote of string * string
  9. | Assert_invalid_binary of string * string
  10. | Assert_exhaustion of action * string
  11. | Assert_unlinkable of modul * string
val pp_assertion : Format.formatter -> assertion -> unit
type register = string * string option
val pp_register : Format.formatter -> (string * 'a) -> unit
type cmd =
  1. | Module of modul
  2. | Assert of assertion
  3. | Register of string * string option
  4. | Action of action
val pp_cmd : Format.formatter -> cmd -> unit
type script = cmd list
val pp_script : Format.formatter -> cmd list -> unit
+ 'a Types.block_type
type global = {
  1. typ : Types.text Types.global_type;
  2. init : Types.text Types.expr;
  3. id : string option;
}
val pp_global : Stdlib.Format.formatter -> global -> Prelude.Unit.t
type data_mode =
  1. | Data_passive
  2. | Data_active of Types.text Types.indice option * Types.text Types.expr
val pp_data_mode : Stdlib.Format.formatter -> data_mode -> Prelude.Unit.t
type data = {
  1. id : string option;
  2. init : string;
  3. mode : data_mode;
}
val pp_data : Stdlib.Format.formatter -> data -> Prelude.Unit.t
type elem_mode =
  1. | Elem_passive
  2. | Elem_active of Types.text Types.indice option * Types.text Types.expr
  3. | Elem_declarative
val pp_elem_mode : Stdlib.Format.formatter -> elem_mode -> Prelude.Unit.t
type elem = {
  1. id : string option;
  2. typ : Types.text Types.ref_type;
  3. init : Types.text Types.expr list;
  4. mode : elem_mode;
}
val pp_elem_expr : Stdlib.Format.formatter -> 'a Types.expr -> Prelude.Unit.t
val pp_elem : Stdlib.Format.formatter -> elem -> Prelude.Unit.t
type module_field =
  1. | MType of Types.text Types.rec_type
  2. | MGlobal of global
  3. | MTable of Types.text Types.table
  4. | MMem of Types.mem
  5. | MFunc of Types.text Types.func
  6. | MElem of elem
  7. | MData of data
  8. | MStart of Types.text Types.indice
  9. | MImport of Types.text Types.import
  10. | MExport of Types.text Types.export
val pp_module_field : Stdlib.Format.formatter -> module_field -> Prelude.Unit.t
type modul = {
  1. id : string option;
  2. fields : module_field list;
}
val pp_modul : Stdlib.Format.formatter -> modul -> unit
type action =
  1. | Invoke of string option * string * Types.text Types.const list
  2. | Get of string option * string
val pp_action : Stdlib.Format.formatter -> action -> unit
type result_const =
  1. | Literal of Types.text Types.const
  2. | Nan_canon of Types.nn
  3. | Nan_arith of Types.nn
val pp_result_const : Stdlib.Format.formatter -> result_const -> unit
type result =
  1. | Result_const of result_const
  2. | Result_extern_ref
  3. | Result_func_ref
val pp_result : Stdlib.Format.formatter -> result -> unit
val pp_result_bis : Stdlib.Format.formatter -> result -> unit
val pp_results : Stdlib.Format.formatter -> result list -> unit
type assertion =
  1. | Assert_return of action * result list
  2. | Assert_trap of action * string
  3. | Assert_trap_module of modul * string
  4. | Assert_malformed of modul * string
  5. | Assert_malformed_quote of string * string
  6. | Assert_malformed_binary of string * string
  7. | Assert_invalid of modul * string
  8. | Assert_invalid_quote of string * string
  9. | Assert_invalid_binary of string * string
  10. | Assert_exhaustion of action * string
  11. | Assert_unlinkable of modul * string
val pp_assertion : Stdlib.Format.formatter -> assertion -> unit
type register = string * string option
val pp_register : Stdlib.Format.formatter -> (string * 'a) -> unit
type cmd =
  1. | Quoted_module of string
  2. | Binary_module of string option * string
  3. | Text_module of modul
  4. | Assert of assertion
  5. | Register of string * string option
  6. | Action of action
val pp_cmd : Stdlib.Format.formatter -> cmd -> unit
type script = cmd list
val pp_script : Stdlib.Format.formatter -> cmd list -> unit
diff --git a/api/owi/Owi/Text_lexer/index.html b/api/owi/Owi/Text_lexer/index.html index 61ed3fa61..e77f5a251 100644 --- a/api/owi/Owi/Text_lexer/index.html +++ b/api/owi/Owi/Text_lexer/index.html @@ -2,4 +2,4 @@ Text_lexer (owi.Owi.Text_lexer)

Module Owi.Text_lexer

Module for Wasm lexing.

exception Illegal_escape of string

lexing error exception

exception Unknown_operator of string
exception Unexpected_character of string
val token : Sedlexing.lexbuf -> Text_parser.token

tokenizer

val lexer : Sedlexing.lexbuf -> unit -> - Text_parser.token * Stdlib.Lexing.position * Stdlib.Lexing.position

lexer

+ Text_parser.token * Prelude.Lexing.position * Prelude.Lexing.position

lexer

diff --git a/api/owi/Owi/Text_parser/Incremental/index.html b/api/owi/Owi/Text_parser/Incremental/index.html index 1c323a6f7..d1065d269 100644 --- a/api/owi/Owi/Text_parser/Incremental/index.html +++ b/api/owi/Owi/Text_parser/Incremental/index.html @@ -1,4 +1,6 @@ -Incremental (owi.Owi.Text_parser.Incremental)

Module Text_parser.Incremental

val script : Stdlib.Lexing.position -> Text.script MenhirInterpreter.checkpoint
val modul : Stdlib.Lexing.position -> Text.modul MenhirInterpreter.checkpoint
val inline_module : - Stdlib.Lexing.position -> +Incremental (owi.Owi.Text_parser.Incremental)

Module Text_parser.Incremental

val script : + Prelude.Lexing.position -> + Text.script MenhirInterpreter.checkpoint
val modul : Prelude.Lexing.position -> Text.modul MenhirInterpreter.checkpoint
val inline_module : + Prelude.Lexing.position -> Text.modul MenhirInterpreter.checkpoint
diff --git a/api/owi/Owi/Text_parser/index.html b/api/owi/Owi/Text_parser/index.html index f7024e0e7..608af067c 100644 --- a/api/owi/Owi/Text_parser/index.html +++ b/api/owi/Owi/Text_parser/index.html @@ -1,11 +1,11 @@ -Text_parser (owi.Owi.Text_parser)

Module Owi.Text_parser

type token =
  1. | UNREACHABLE
  2. | TYPE
  3. | THEN
  4. | TABLE_SIZE
  5. | TABLE_SET
  6. | TABLE_INIT
  7. | TABLE_GROW
  8. | TABLE_GET
  9. | TABLE_FILL
  10. | TABLE_COPY
  11. | TABLE
  12. | SUB
  13. | STRUCT_SET
  14. | STRUCT_NEW_CANON_DEFAULT
  15. | STRUCT_NEW_CANON
  16. | STRUCT_GET_S
  17. | STRUCT_GET
  18. | STRUCTREF
  19. | STRUCT
  20. | START
  21. | SELECT
  22. | RPAR
  23. | RETURN_CALL_REF
  24. | RETURN_CALL_INDIRECT
  25. | RETURN_CALL
  26. | RETURN
  27. | RESULT
  28. | REGISTER
  29. | REF_TEST
  30. | REF_STRUCT
  31. | REF_NULL
  32. | REF_IS_NULL
  33. | REF_I31
  34. | REF_HOST
  35. | REF_FUNC
  36. | REF_EXTERN
  37. | REF_EQ
  38. | REF_CAST
  39. | REF_AS_NON_NULL
  40. | REF_ARRAY
  41. | REF
  42. | REC
  43. | QUOTE
  44. | PARAM
  45. | OFFSET
  46. | NUM of Stdlib.String.t
  47. | NULL_REF
  48. | NULL_FUNC_REF
  49. | NULL_EXTERN_REF
  50. | NULL
  51. | NOP
  52. | NONE
  53. | NOFUNC
  54. | NOEXTERN
  55. | NAN_CANON
  56. | NAN_ARITH
  57. | NAME of Stdlib.String.t
  58. | MUTABLE
  59. | MODULE
  60. | MEMORY_SIZE
  61. | MEMORY_INIT
  62. | MEMORY_GROW
  63. | MEMORY_FILL
  64. | MEMORY_COPY
  65. | MEMORY
  66. | LPAR
  67. | LOOP
  68. | LOCAL_TEE
  69. | LOCAL_SET
  70. | LOCAL_GET
  71. | LOCAL
  72. | ITEM
  73. | INVOKE
  74. | IMPORT
  75. | IF
  76. | ID of Stdlib.String.t
  77. | I8
  78. | I64_XOR
  79. | I64_TRUNC_SAT_F64_U
  80. | I64_TRUNC_SAT_F64_S
  81. | I64_TRUNC_SAT_F32_U
  82. | I64_TRUNC_SAT_F32_S
  83. | I64_TRUNC_F64_U
  84. | I64_TRUNC_F64_S
  85. | I64_TRUNC_F32_U
  86. | I64_TRUNC_F32_S
  87. | I64_SUB
  88. | I64_STORE8
  89. | I64_STORE32
  90. | I64_STORE16
  91. | I64_STORE
  92. | I64_SHR_U
  93. | I64_SHR_S
  94. | I64_SHL
  95. | I64_ROTR
  96. | I64_ROTL
  97. | I64_REM_U
  98. | I64_REM_S
  99. | I64_REINTERPRET_F64
  100. | I64_REINTERPRET_F32
  101. | I64_POPCNT
  102. | I64_OR
  103. | I64_NE
  104. | I64_MUL
  105. | I64_LT_U
  106. | I64_LT_S
  107. | I64_LOAD8_U
  108. | I64_LOAD8_S
  109. | I64_LOAD32_U
  110. | I64_LOAD32_S
  111. | I64_LOAD16_U
  112. | I64_LOAD16_S
  113. | I64_LOAD
  114. | I64_LE_U
  115. | I64_LE_S
  116. | I64_GT_U
  117. | I64_GT_S
  118. | I64_GE_U
  119. | I64_GE_S
  120. | I64_EXTEND_I32_U
  121. | I64_EXTEND_I32_S
  122. | I64_EXTEND8_S
  123. | I64_EXTEND32_S
  124. | I64_EXTEND16_S
  125. | I64_EQZ
  126. | I64_EQ
  127. | I64_DIV_U
  128. | I64_DIV_S
  129. | I64_CTZ
  130. | I64_CONST
  131. | I64_CLZ
  132. | I64_AND
  133. | I64_ADD
  134. | I64
  135. | I32_XOR
  136. | I32_WRAP_I64
  137. | I32_TRUNC_SAT_F64_U
  138. | I32_TRUNC_SAT_F64_S
  139. | I32_TRUNC_SAT_F32_U
  140. | I32_TRUNC_SAT_F32_S
  141. | I32_TRUNC_F64_U
  142. | I32_TRUNC_F64_S
  143. | I32_TRUNC_F32_U
  144. | I32_TRUNC_F32_S
  145. | I32_SUB
  146. | I32_STORE8
  147. | I32_STORE16
  148. | I32_STORE
  149. | I32_SHR_U
  150. | I32_SHR_S
  151. | I32_SHL
  152. | I32_ROTR
  153. | I32_ROTL
  154. | I32_REM_U
  155. | I32_REM_S
  156. | I32_REINTERPRET_F64
  157. | I32_REINTERPRET_F32
  158. | I32_POPCNT
  159. | I32_OR
  160. | I32_NE
  161. | I32_MUL
  162. | I32_LT_U
  163. | I32_LT_S
  164. | I32_LOAD8_U
  165. | I32_LOAD8_S
  166. | I32_LOAD16_U
  167. | I32_LOAD16_S
  168. | I32_LOAD
  169. | I32_LE_U
  170. | I32_LE_S
  171. | I32_GT_U
  172. | I32_GT_S
  173. | I32_GE_U
  174. | I32_GE_S
  175. | I32_EXTEND8_S
  176. | I32_EXTEND16_S
  177. | I32_EQZ
  178. | I32_EQ
  179. | I32_DIV_U
  180. | I32_DIV_S
  181. | I32_CTZ
  182. | I32_CONST
  183. | I32_CLZ
  184. | I32_AND
  185. | I32_ADD
  186. | I32
  187. | I31_REF
  188. | I31_GET_U
  189. | I31_GET_S
  190. | I31
  191. | I16
  192. | GLOBAL_SET
  193. | GLOBAL_GET
  194. | GLOBAL
  195. | GET
  196. | FUNC_REF
  197. | FUNC
  198. | FINAL
  199. | FIELD
  200. | F64_TRUNC
  201. | F64_SUB
  202. | F64_STORE
  203. | F64_SQRT
  204. | F64_REINTERPRET_I64
  205. | F64_REINTERPRET_I32
  206. | F64_PROMOTE_F32
  207. | F64_NEG
  208. | F64_NEAREST
  209. | F64_NE
  210. | F64_MUL
  211. | F64_MIN
  212. | F64_MAX
  213. | F64_LT
  214. | F64_LOAD
  215. | F64_LE
  216. | F64_GT
  217. | F64_GE
  218. | F64_FLOOR
  219. | F64_EQ
  220. | F64_DIV
  221. | F64_COPYSIGN
  222. | F64_CONVERT_I64_U
  223. | F64_CONVERT_I64_S
  224. | F64_CONVERT_I32_U
  225. | F64_CONVERT_I32_S
  226. | F64_CONST
  227. | F64_CEIL
  228. | F64_ADD
  229. | F64_ABS
  230. | F64
  231. | F32_TRUNC
  232. | F32_SUB
  233. | F32_STORE
  234. | F32_SQRT
  235. | F32_REINTERPRET_I64
  236. | F32_REINTERPRET_I32
  237. | F32_NEG
  238. | F32_NEAREST
  239. | F32_NE
  240. | F32_MUL
  241. | F32_MIN
  242. | F32_MAX
  243. | F32_LT
  244. | F32_LOAD
  245. | F32_LE
  246. | F32_GT
  247. | F32_GE
  248. | F32_FLOOR
  249. | F32_EQ
  250. | F32_DIV
  251. | F32_DEMOTE_F64
  252. | F32_COPYSIGN
  253. | F32_CONVERT_I64_U
  254. | F32_CONVERT_I64_S
  255. | F32_CONVERT_I32_U
  256. | F32_CONVERT_I32_S
  257. | F32_CONST
  258. | F32_CEIL
  259. | F32_ADD
  260. | F32_ABS
  261. | F32
  262. | EXTERN_REF
  263. | EXTERN_INTERNALIZE
  264. | EXTERN_EXTERNALIZE
  265. | EXTERN
  266. | EXPORT
  267. | EQ_REF
  268. | EQUAL
  269. | EQ
  270. | EOF
  271. | END
  272. | ELSE
  273. | ELEM_DROP
  274. | ELEM
  275. | DROP
  276. | DECLARE
  277. | DATA_DROP
  278. | DATA
  279. | CALL_REF
  280. | CALL_INDIRECT
  281. | CALL
  282. | BR_TABLE
  283. | BR_ON_NULL
  284. | BR_ON_NON_NULL
  285. | BR_ON_CAST_FAIL
  286. | BR_ON_CAST
  287. | BR_IF
  288. | BR
  289. | BLOCK
  290. | BINARY
  291. | ASSERT_UNLINKABLE
  292. | ASSERT_TRAP
  293. | ASSERT_RETURN
  294. | ASSERT_MALFORMED
  295. | ASSERT_INVALID
  296. | ASSERT_EXHAUSTION
  297. | ARRAY_SET
  298. | ARRAY_REF
  299. | ARRAY_NEW_CANON_FIXED
  300. | ARRAY_NEW_CANON_ELEM
  301. | ARRAY_NEW_CANON_DEFAULT
  302. | ARRAY_NEW_CANON_DATA
  303. | ARRAY_NEW_CANON
  304. | ARRAY_LEN
  305. | ARRAY_GET_U
  306. | ARRAY_GET
  307. | ARRAY
  308. | ANY_REF
  309. | ANY
  310. | ALIGN
exception Error
val script : - (Stdlib.Lexing.lexbuf -> token) -> - Stdlib.Lexing.lexbuf -> +Text_parser (owi.Owi.Text_parser)

Module Owi.Text_parser

type token =
  1. | UNREACHABLE
  2. | TYPE
  3. | THEN
  4. | TABLE_SIZE
  5. | TABLE_SET
  6. | TABLE_INIT
  7. | TABLE_GROW
  8. | TABLE_GET
  9. | TABLE_FILL
  10. | TABLE_COPY
  11. | TABLE
  12. | SUB
  13. | STRUCT_SET
  14. | STRUCT_NEW_CANON_DEFAULT
  15. | STRUCT_NEW_CANON
  16. | STRUCT_GET_S
  17. | STRUCT_GET
  18. | STRUCTREF
  19. | STRUCT
  20. | START
  21. | SELECT
  22. | RPAR
  23. | RETURN_CALL_REF
  24. | RETURN_CALL_INDIRECT
  25. | RETURN_CALL
  26. | RETURN
  27. | RESULT
  28. | REGISTER
  29. | REF_TEST
  30. | REF_STRUCT
  31. | REF_NULL
  32. | REF_IS_NULL
  33. | REF_I31
  34. | REF_HOST
  35. | REF_FUNC
  36. | REF_EXTERN
  37. | REF_EQ
  38. | REF_CAST
  39. | REF_AS_NON_NULL
  40. | REF_ARRAY
  41. | REF
  42. | REC
  43. | QUOTE
  44. | PARAM
  45. | OFFSET
  46. | NUM of Prelude.String.t
  47. | NULL_REF
  48. | NULL_FUNC_REF
  49. | NULL_EXTERN_REF
  50. | NULL
  51. | NOP
  52. | NONE
  53. | NOFUNC
  54. | NOEXTERN
  55. | NAN_CANON
  56. | NAN_ARITH
  57. | NAME of Prelude.String.t
  58. | MUTABLE
  59. | MODULE
  60. | MEMORY_SIZE
  61. | MEMORY_INIT
  62. | MEMORY_GROW
  63. | MEMORY_FILL
  64. | MEMORY_COPY
  65. | MEMORY
  66. | LPAR
  67. | LOOP
  68. | LOCAL_TEE
  69. | LOCAL_SET
  70. | LOCAL_GET
  71. | LOCAL
  72. | ITEM
  73. | INVOKE
  74. | IMPORT
  75. | IF
  76. | ID of Prelude.String.t
  77. | I8
  78. | I64_XOR
  79. | I64_TRUNC_SAT_F64_U
  80. | I64_TRUNC_SAT_F64_S
  81. | I64_TRUNC_SAT_F32_U
  82. | I64_TRUNC_SAT_F32_S
  83. | I64_TRUNC_F64_U
  84. | I64_TRUNC_F64_S
  85. | I64_TRUNC_F32_U
  86. | I64_TRUNC_F32_S
  87. | I64_SUB
  88. | I64_STORE8
  89. | I64_STORE32
  90. | I64_STORE16
  91. | I64_STORE
  92. | I64_SHR_U
  93. | I64_SHR_S
  94. | I64_SHL
  95. | I64_ROTR
  96. | I64_ROTL
  97. | I64_REM_U
  98. | I64_REM_S
  99. | I64_REINTERPRET_F64
  100. | I64_REINTERPRET_F32
  101. | I64_POPCNT
  102. | I64_OR
  103. | I64_NE
  104. | I64_MUL
  105. | I64_LT_U
  106. | I64_LT_S
  107. | I64_LOAD8_U
  108. | I64_LOAD8_S
  109. | I64_LOAD32_U
  110. | I64_LOAD32_S
  111. | I64_LOAD16_U
  112. | I64_LOAD16_S
  113. | I64_LOAD
  114. | I64_LE_U
  115. | I64_LE_S
  116. | I64_GT_U
  117. | I64_GT_S
  118. | I64_GE_U
  119. | I64_GE_S
  120. | I64_EXTEND_I32_U
  121. | I64_EXTEND_I32_S
  122. | I64_EXTEND8_S
  123. | I64_EXTEND32_S
  124. | I64_EXTEND16_S
  125. | I64_EQZ
  126. | I64_EQ
  127. | I64_DIV_U
  128. | I64_DIV_S
  129. | I64_CTZ
  130. | I64_CONST
  131. | I64_CLZ
  132. | I64_AND
  133. | I64_ADD
  134. | I64
  135. | I32_XOR
  136. | I32_WRAP_I64
  137. | I32_TRUNC_SAT_F64_U
  138. | I32_TRUNC_SAT_F64_S
  139. | I32_TRUNC_SAT_F32_U
  140. | I32_TRUNC_SAT_F32_S
  141. | I32_TRUNC_F64_U
  142. | I32_TRUNC_F64_S
  143. | I32_TRUNC_F32_U
  144. | I32_TRUNC_F32_S
  145. | I32_SUB
  146. | I32_STORE8
  147. | I32_STORE16
  148. | I32_STORE
  149. | I32_SHR_U
  150. | I32_SHR_S
  151. | I32_SHL
  152. | I32_ROTR
  153. | I32_ROTL
  154. | I32_REM_U
  155. | I32_REM_S
  156. | I32_REINTERPRET_F64
  157. | I32_REINTERPRET_F32
  158. | I32_POPCNT
  159. | I32_OR
  160. | I32_NE
  161. | I32_MUL
  162. | I32_LT_U
  163. | I32_LT_S
  164. | I32_LOAD8_U
  165. | I32_LOAD8_S
  166. | I32_LOAD16_U
  167. | I32_LOAD16_S
  168. | I32_LOAD
  169. | I32_LE_U
  170. | I32_LE_S
  171. | I32_GT_U
  172. | I32_GT_S
  173. | I32_GE_U
  174. | I32_GE_S
  175. | I32_EXTEND8_S
  176. | I32_EXTEND16_S
  177. | I32_EQZ
  178. | I32_EQ
  179. | I32_DIV_U
  180. | I32_DIV_S
  181. | I32_CTZ
  182. | I32_CONST
  183. | I32_CLZ
  184. | I32_AND
  185. | I32_ADD
  186. | I32
  187. | I31_REF
  188. | I31_GET_U
  189. | I31_GET_S
  190. | I31
  191. | I16
  192. | GLOBAL_SET
  193. | GLOBAL_GET
  194. | GLOBAL
  195. | GET
  196. | FUNC_REF
  197. | FUNC
  198. | FINAL
  199. | FIELD
  200. | F64_TRUNC
  201. | F64_SUB
  202. | F64_STORE
  203. | F64_SQRT
  204. | F64_REINTERPRET_I64
  205. | F64_REINTERPRET_I32
  206. | F64_PROMOTE_F32
  207. | F64_NEG
  208. | F64_NEAREST
  209. | F64_NE
  210. | F64_MUL
  211. | F64_MIN
  212. | F64_MAX
  213. | F64_LT
  214. | F64_LOAD
  215. | F64_LE
  216. | F64_GT
  217. | F64_GE
  218. | F64_FLOOR
  219. | F64_EQ
  220. | F64_DIV
  221. | F64_COPYSIGN
  222. | F64_CONVERT_I64_U
  223. | F64_CONVERT_I64_S
  224. | F64_CONVERT_I32_U
  225. | F64_CONVERT_I32_S
  226. | F64_CONST
  227. | F64_CEIL
  228. | F64_ADD
  229. | F64_ABS
  230. | F64
  231. | F32_TRUNC
  232. | F32_SUB
  233. | F32_STORE
  234. | F32_SQRT
  235. | F32_REINTERPRET_I64
  236. | F32_REINTERPRET_I32
  237. | F32_NEG
  238. | F32_NEAREST
  239. | F32_NE
  240. | F32_MUL
  241. | F32_MIN
  242. | F32_MAX
  243. | F32_LT
  244. | F32_LOAD
  245. | F32_LE
  246. | F32_GT
  247. | F32_GE
  248. | F32_FLOOR
  249. | F32_EQ
  250. | F32_DIV
  251. | F32_DEMOTE_F64
  252. | F32_COPYSIGN
  253. | F32_CONVERT_I64_U
  254. | F32_CONVERT_I64_S
  255. | F32_CONVERT_I32_U
  256. | F32_CONVERT_I32_S
  257. | F32_CONST
  258. | F32_CEIL
  259. | F32_ADD
  260. | F32_ABS
  261. | F32
  262. | EXTERN_REF
  263. | EXTERN_INTERNALIZE
  264. | EXTERN_EXTERNALIZE
  265. | EXTERN
  266. | EXPORT
  267. | EQ_REF
  268. | EQUAL
  269. | EQ
  270. | EOF
  271. | END
  272. | ELSE
  273. | ELEM_DROP
  274. | ELEM
  275. | DROP
  276. | DECLARE
  277. | DATA_DROP
  278. | DATA
  279. | CALL_REF
  280. | CALL_INDIRECT
  281. | CALL
  282. | BR_TABLE
  283. | BR_ON_NULL
  284. | BR_ON_NON_NULL
  285. | BR_ON_CAST_FAIL
  286. | BR_ON_CAST
  287. | BR_IF
  288. | BR
  289. | BLOCK
  290. | BINARY
  291. | ASSERT_UNLINKABLE
  292. | ASSERT_TRAP
  293. | ASSERT_RETURN
  294. | ASSERT_MALFORMED
  295. | ASSERT_INVALID
  296. | ASSERT_EXHAUSTION
  297. | ARRAY_SET
  298. | ARRAY_REF
  299. | ARRAY_NEW_CANON_FIXED
  300. | ARRAY_NEW_CANON_ELEM
  301. | ARRAY_NEW_CANON_DEFAULT
  302. | ARRAY_NEW_CANON_DATA
  303. | ARRAY_NEW_CANON
  304. | ARRAY_LEN
  305. | ARRAY_GET_U
  306. | ARRAY_GET
  307. | ARRAY
  308. | ANY_REF
  309. | ANY
  310. | ALIGN
exception Error
val script : + (Prelude.Lexing.lexbuf -> token) -> + Prelude.Lexing.lexbuf -> Text.script
val modul : - (Stdlib.Lexing.lexbuf -> token) -> - Stdlib.Lexing.lexbuf -> + (Prelude.Lexing.lexbuf -> token) -> + Prelude.Lexing.lexbuf -> Text.modul
val inline_module : - (Stdlib.Lexing.lexbuf -> token) -> - Stdlib.Lexing.lexbuf -> + (Prelude.Lexing.lexbuf -> token) -> + Prelude.Lexing.lexbuf -> Text.modul
module MenhirInterpreter : sig ... end
module Incremental : sig ... end
diff --git a/api/owi/Owi/Thread/Make/Memory/index.html b/api/owi/Owi/Thread/Make/Memory/index.html new file mode 100644 index 000000000..7075fabc9 --- /dev/null +++ b/api/owi/Owi/Thread/Make/Memory/index.html @@ -0,0 +1,2 @@ + +Memory (owi.Owi.Thread.Make.Memory)

Module Make.Memory

type collection = Symbolic_memory.collection
val init : unit -> collection
val clone : collection -> collection
diff --git a/api/owi/Owi/Thread/Make/argument-1-Symbolic_memory/index.html b/api/owi/Owi/Thread/Make/argument-1-Symbolic_memory/index.html new file mode 100644 index 000000000..6fd8b89ab --- /dev/null +++ b/api/owi/Owi/Thread/Make/argument-1-Symbolic_memory/index.html @@ -0,0 +1,2 @@ + +Symbolic_memory (owi.Owi.Thread.Make.Symbolic_memory)

Parameter Make.Symbolic_memory

type collection
val init : unit -> collection
val clone : collection -> collection
diff --git a/api/owi/Owi/Thread/Make/index.html b/api/owi/Owi/Thread/Make/index.html new file mode 100644 index 000000000..bb10746bd --- /dev/null +++ b/api/owi/Owi/Thread/Make/index.html @@ -0,0 +1,10 @@ + +Make (owi.Owi.Thread.Make)

Module Thread.Make

Parameters

Signature

type t
val init : unit -> t
val create : + int -> + Smtml.Symbol.t list -> + Symbolic_value.vbool list -> + Memory.collection -> + Symbolic_table.collection -> + Symbolic_global.collection -> + int32 list -> + t
val pc : t -> Symbolic_value.vbool list
val memories : t -> Memory.collection
val globals : t -> Symbolic_global.collection
val breadcrumbs : t -> int32 list
val symbols_set : t -> Smtml.Symbol.t list
val symbols : t -> int
val clone : t -> t
val add_pc : t -> Symbolic_value.vbool -> t
val add_breadcrumb : t -> int32 -> t
val add_symbol : t -> Smtml.Symbol.t -> t
val incr_symbols : t -> t
diff --git a/api/owi/Owi/Thread/index.html b/api/owi/Owi/Thread/index.html index 247c81845..05d3c32a7 100644 --- a/api/owi/Owi/Thread/index.html +++ b/api/owi/Owi/Thread/index.html @@ -1,2 +1,4 @@ -Thread (owi.Owi.Thread)

Module Owi.Thread

type t = {
  1. choices : int;
  2. mutable symbol_set : Smtml.Symbol.t list;
  3. pc : Symbolic_value.vbool list;
  4. memories : Symbolic_memory.collection;
  5. tables : Symbolic_table.collection;
  6. globals : Symbolic_global.collection;
    (*

    Breadcrumbs represent the list of choices that were made so far. They identify one given symbolic execution trace.

    *)
  7. breadcrumbs : int32 list;
}
val pc : t -> Symbolic_value.vbool list
val memories : t -> Symbolic_memory.collection
val globals : t -> Symbolic_global.collection
val breadcrumbs : t -> int32 list
val create : unit -> t
val clone : t -> t
+Thread (owi.Owi.Thread)

Module Owi.Thread

module type M = Thread_intf.M
module type S = Thread_intf.S
diff --git a/api/owi/Owi/Thread_intf/index.html b/api/owi/Owi/Thread_intf/index.html new file mode 100644 index 000000000..7a4be058c --- /dev/null +++ b/api/owi/Owi/Thread_intf/index.html @@ -0,0 +1,2 @@ + +Thread_intf (owi.Owi.Thread_intf)

Module Owi.Thread_intf

module type M = sig ... end
module type S = sig ... end
module type Intf = sig ... end
diff --git a/api/owi/Owi/Thread_intf/module-type-Intf/Make/Memory/index.html b/api/owi/Owi/Thread_intf/module-type-Intf/Make/Memory/index.html new file mode 100644 index 000000000..bc70fa51c --- /dev/null +++ b/api/owi/Owi/Thread_intf/module-type-Intf/Make/Memory/index.html @@ -0,0 +1,2 @@ + +Memory (owi.Owi.Thread_intf.Intf.Make.Memory)

Module Make.Memory

type collection = Symbolic_memory.collection
val init : unit -> collection
val clone : collection -> collection
diff --git a/api/owi/Owi/Thread_intf/module-type-Intf/Make/argument-1-Symbolic_memory/index.html b/api/owi/Owi/Thread_intf/module-type-Intf/Make/argument-1-Symbolic_memory/index.html new file mode 100644 index 000000000..249feacfd --- /dev/null +++ b/api/owi/Owi/Thread_intf/module-type-Intf/Make/argument-1-Symbolic_memory/index.html @@ -0,0 +1,2 @@ + +Symbolic_memory (owi.Owi.Thread_intf.Intf.Make.Symbolic_memory)

Parameter Make.Symbolic_memory

type collection
val init : unit -> collection
val clone : collection -> collection
diff --git a/api/owi/Owi/Thread_intf/module-type-Intf/Make/index.html b/api/owi/Owi/Thread_intf/module-type-Intf/Make/index.html new file mode 100644 index 000000000..125f63b38 --- /dev/null +++ b/api/owi/Owi/Thread_intf/module-type-Intf/Make/index.html @@ -0,0 +1,10 @@ + +Make (owi.Owi.Thread_intf.Intf.Make)

Module Intf.Make

Parameters

Signature

type t
val init : unit -> t
val create : + int -> + Smtml.Symbol.t list -> + Symbolic_value.vbool list -> + Memory.collection -> + Symbolic_table.collection -> + Symbolic_global.collection -> + int32 list -> + t
val pc : t -> Symbolic_value.vbool list
val memories : t -> Memory.collection
val globals : t -> Symbolic_global.collection
val breadcrumbs : t -> int32 list
val symbols_set : t -> Smtml.Symbol.t list
val symbols : t -> int
val clone : t -> t
val add_pc : t -> Symbolic_value.vbool -> t
val add_breadcrumb : t -> int32 -> t
val add_symbol : t -> Smtml.Symbol.t -> t
val incr_symbols : t -> t
diff --git a/api/owi/Owi/Thread_intf/module-type-Intf/index.html b/api/owi/Owi/Thread_intf/module-type-Intf/index.html new file mode 100644 index 000000000..5f85e24d7 --- /dev/null +++ b/api/owi/Owi/Thread_intf/module-type-Intf/index.html @@ -0,0 +1,4 @@ + +Intf (owi.Owi.Thread_intf.Intf)

Module type Thread_intf.Intf

module type M = M
module type S = S
diff --git a/api/owi/Owi/Thread_intf/module-type-M/index.html b/api/owi/Owi/Thread_intf/module-type-M/index.html new file mode 100644 index 000000000..cde461611 --- /dev/null +++ b/api/owi/Owi/Thread_intf/module-type-M/index.html @@ -0,0 +1,2 @@ + +M (owi.Owi.Thread_intf.M)

Module type Thread_intf.M

type collection
val init : unit -> collection
val clone : collection -> collection
diff --git a/api/owi/Owi/Thread_intf/module-type-S/Memory/index.html b/api/owi/Owi/Thread_intf/module-type-S/Memory/index.html new file mode 100644 index 000000000..c7d652766 --- /dev/null +++ b/api/owi/Owi/Thread_intf/module-type-S/Memory/index.html @@ -0,0 +1,2 @@ + +Memory (owi.Owi.Thread_intf.S.Memory)

Module S.Memory

type collection
val init : unit -> collection
val clone : collection -> collection
diff --git a/api/owi/Owi/Thread_intf/module-type-S/index.html b/api/owi/Owi/Thread_intf/module-type-S/index.html new file mode 100644 index 000000000..85eae43d5 --- /dev/null +++ b/api/owi/Owi/Thread_intf/module-type-S/index.html @@ -0,0 +1,10 @@ + +S (owi.Owi.Thread_intf.S)

Module type Thread_intf.S

type t
module Memory : M
val init : unit -> t
val create : + int -> + Smtml.Symbol.t list -> + Symbolic_value.vbool list -> + Memory.collection -> + Symbolic_table.collection -> + Symbolic_global.collection -> + int32 list -> + t
val pc : t -> Symbolic_value.vbool list
val memories : t -> Memory.collection
val globals : t -> Symbolic_global.collection
val breadcrumbs : t -> int32 list
val symbols_set : t -> Smtml.Symbol.t list
val symbols : t -> int
val clone : t -> t
val add_pc : t -> Symbolic_value.vbool -> t
val add_breadcrumb : t -> int32 -> t
val add_symbol : t -> Smtml.Symbol.t -> t
val incr_symbols : t -> t
diff --git a/api/owi/Owi/Thread_with_memory/Memory/index.html b/api/owi/Owi/Thread_with_memory/Memory/index.html new file mode 100644 index 000000000..13564e98e --- /dev/null +++ b/api/owi/Owi/Thread_with_memory/Memory/index.html @@ -0,0 +1,2 @@ + +Memory (owi.Owi.Thread_with_memory.Memory)

Module Thread_with_memory.Memory

val init : unit -> collection
val clone : collection -> collection
diff --git a/api/owi/Owi/Thread_with_memory/index.html b/api/owi/Owi/Thread_with_memory/index.html new file mode 100644 index 000000000..51602bacf --- /dev/null +++ b/api/owi/Owi/Thread_with_memory/index.html @@ -0,0 +1,11 @@ + +Thread_with_memory (owi.Owi.Thread_with_memory)

Module Owi.Thread_with_memory

type t
val init : unit -> t
val create : + int -> + Smtml.Symbol.t list -> + Symbolic_value.vbool list -> + Memory.collection -> + Symbolic_table.collection -> + Symbolic_global.collection -> + int32 list -> + t
val pc : t -> Symbolic_value.vbool list
val memories : t -> Memory.collection
val globals : t -> Symbolic_global.collection
val breadcrumbs : t -> int32 list
val symbols_set : t -> Smtml.Symbol.t list
val symbols : t -> int
val clone : t -> t
val add_pc : t -> Symbolic_value.vbool -> t
val add_breadcrumb : t -> int32 -> t
val add_symbol : t -> Smtml.Symbol.t -> t
val incr_symbols : t -> t
diff --git a/api/owi/Owi/Thread_without_memory/Memory/index.html b/api/owi/Owi/Thread_without_memory/Memory/index.html new file mode 100644 index 000000000..608060736 --- /dev/null +++ b/api/owi/Owi/Thread_without_memory/Memory/index.html @@ -0,0 +1,2 @@ + +Memory (owi.Owi.Thread_without_memory.Memory)

Module Thread_without_memory.Memory

type collection = bool
val init : unit -> collection
val clone : collection -> collection
diff --git a/api/owi/Owi/Thread_without_memory/index.html b/api/owi/Owi/Thread_without_memory/index.html new file mode 100644 index 000000000..d8626f905 --- /dev/null +++ b/api/owi/Owi/Thread_without_memory/index.html @@ -0,0 +1,10 @@ + +Thread_without_memory (owi.Owi.Thread_without_memory)

Module Owi.Thread_without_memory

type t
module Memory : Thread_intf.M with type collection = bool
val init : unit -> t
val create : + int -> + Smtml.Symbol.t list -> + Symbolic_value.vbool list -> + Memory.collection -> + Symbolic_table.collection -> + Symbolic_global.collection -> + int32 list -> + t
val pc : t -> Symbolic_value.vbool list
val memories : t -> Memory.collection
val globals : t -> Symbolic_global.collection
val breadcrumbs : t -> int32 list
val symbols_set : t -> Smtml.Symbol.t list
val symbols : t -> int
val clone : t -> t
val add_pc : t -> Symbolic_value.vbool -> t
val add_breadcrumb : t -> int32 -> t
val add_symbol : t -> Smtml.Symbol.t -> t
val incr_symbols : t -> t
diff --git a/api/owi/Owi/Types/index.html b/api/owi/Owi/Types/index.html index ba185b1f6..7b67eaffe 100644 --- a/api/owi/Owi/Types/index.html +++ b/api/owi/Owi/Types/index.html @@ -1,34 +1,64 @@ -Types (owi.Owi.Types)

Module Owi.Types

exception Trap of string
exception Parse_fail of string
type yes =
  1. | Yes
type no =
  1. | No
type with_string_indices = < string_indices : yes >
type without_string_indices = < string_indices : no >
type with_ind_bt = < raw_bt : yes >
type without_ind_bt = < raw_bt : no >
type text = < with_string_indices ; with_ind_bt >
type _ indice =
  1. | Text : string -> < with_string_indices.. > indice
  2. | Raw : int -> < .. > indice
val pp_id : Format.formatter -> string -> unit
val pp_id_opt : Format.formatter -> string option -> unit
val pp_indice : Format.formatter -> 'kind indice -> unit
val pp_indice_opt : Format.formatter -> 'a indice option -> unit
val pp_indices : Format.formatter -> 'a indice list -> unit
type nonrec num_type =
  1. | I32
  2. | I64
  3. | F32
  4. | F64
val pp_num_type : Format.formatter -> num_type -> unit
type nullable =
  1. | No_null
  2. | Null
val pp_nullable : Format.formatter -> nullable -> unit
type nonrec packed_type =
  1. | I8
  2. | I16
val pp_packed_type : Format.formatter -> packed_type -> unit
type nonrec mut =
  1. | Const
  2. | Var
val pp_mut : Format.formatter -> mut -> unit
type nonrec nn =
  1. | S32
  2. | S64
val pp_nn : Format.formatter -> nn -> unit
type nonrec sx =
  1. | U
  2. | S
val pp_sx : Format.formatter -> sx -> unit
type nonrec iunop =
  1. | Clz
  2. | Ctz
  3. | Popcnt
val pp_iunop : Format.formatter -> iunop -> unit
type nonrec funop =
  1. | Abs
  2. | Neg
  3. | Sqrt
  4. | Ceil
  5. | Floor
  6. | Trunc
  7. | Nearest
val pp_funop : Format.formatter -> funop -> unit
type nonrec ibinop =
  1. | Add
  2. | Sub
  3. | Mul
  4. | Div of sx
  5. | Rem of sx
  6. | And
  7. | Or
  8. | Xor
  9. | Shl
  10. | Shr of sx
  11. | Rotl
  12. | Rotr
val pp_ibinop : Format.formatter -> ibinop -> unit
type nonrec fbinop =
  1. | Add
  2. | Sub
  3. | Mul
  4. | Div
  5. | Min
  6. | Max
  7. | Copysign
val pp_fbinop : Format.formatter -> fbinop -> unit
type nonrec itestop =
  1. | Eqz
val pp_itestop : Format.formatter -> itestop -> unit
type nonrec irelop =
  1. | Eq
  2. | Ne
  3. | Lt of sx
  4. | Gt of sx
  5. | Le of sx
  6. | Ge of sx
val pp_irelop : Format.formatter -> irelop -> Stdlib.Unit.t
type nonrec frelop =
  1. | Eq
  2. | Ne
  3. | Lt
  4. | Gt
  5. | Le
  6. | Ge
val frelop : Format.formatter -> frelop -> Stdlib.Unit.t
type nonrec memarg = {
  1. offset : Int32.t;
  2. align : Int32.t;
}
val pp_memarg : Format.formatter -> memarg -> unit
type nonrec limits = {
  1. min : int;
  2. max : int option;
}
val pp_limits : Format.formatter -> limits -> unit
type nonrec mem = string option * limits
val pp_mem : Format.formatter -> (string option * limits) -> unit
type nonrec final =
  1. | Final
  2. | No_final
val pp_final : Format.formatter -> final -> unit

Structure

Types

type 'a heap_type =
  1. | Any_ht
  2. | None_ht
  3. | Eq_ht
  4. | I31_ht
  5. | Struct_ht
  6. | Array_ht
  7. | Func_ht
  8. | No_func_ht
  9. | Extern_ht
  10. | No_extern_ht
  11. | Def_ht of 'a indice
val pp_heap_type : Format.formatter -> 'a heap_type -> unit
val pp_heap_type_short : Format.formatter -> 'a heap_type -> unit
type nonrec 'a ref_type = nullable * 'a heap_type
val pp_ref_type : Format.formatter -> (nullable * 'a heap_type) -> unit
type nonrec 'a val_type =
  1. | Num_type of num_type
  2. | Ref_type of 'a ref_type
val pp_val_type : Format.formatter -> 'a val_type -> unit
type nonrec 'a param = string option * 'a val_type
val pp_param : Format.formatter -> (string option * 'a val_type) -> unit
type nonrec 'a param_type = 'a param list
val pp_param_type : - Format.formatter -> +Types (owi.Owi.Types)

Module Owi.Types

exception Trap of string
exception Parse_fail of string
type yes =
  1. | Yes
type no =
  1. | No
type with_string_indices = < string_indices : yes >
type without_string_indices = < string_indices : no >
type with_ind_bt = < raw_bt : yes >
type without_ind_bt = < raw_bt : no >
type text = < with_string_indices ; with_ind_bt >
val sp : Stdlib.Format.formatter -> unit -> unit
type _ indice =
  1. | Text : string -> < with_string_indices.. > indice
  2. | Raw : int -> < .. > indice
val pp_id : Stdlib.Format.formatter -> string -> unit
val pp_id_opt : Stdlib.Format.formatter -> string option -> unit
val pp_indice : Stdlib.Format.formatter -> 'kind indice -> unit
val compare_indice : + < string_indices : yes.. > indice -> + < string_indices : yes.. > indice -> + int
val pp_indice_opt : Stdlib.Format.formatter -> 'a indice option -> unit
val pp_indices : Stdlib.Format.formatter -> 'a indice list -> unit
type nonrec num_type =
  1. | I32
  2. | I64
  3. | F32
  4. | F64
val pp_num_type : Stdlib.Format.formatter -> num_type -> unit
val num_type_eq : num_type -> num_type -> bool
val compare_num_type : num_type -> num_type -> int
type nullable =
  1. | No_null
  2. | Null
val pp_nullable : Stdlib.Format.formatter -> nullable -> unit
type nonrec packed_type =
  1. | I8
  2. | I16
val pp_packed_type : Stdlib.Format.formatter -> packed_type -> unit
val packed_type_eq : packed_type -> packed_type -> bool
type nonrec mut =
  1. | Const
  2. | Var
val pp_mut : Stdlib.Format.formatter -> mut -> unit
type nonrec nn =
  1. | S32
  2. | S64
val pp_nn : Stdlib.Format.formatter -> nn -> unit
type nonrec sx =
  1. | U
  2. | S
val pp_sx : Stdlib.Format.formatter -> sx -> unit
type nonrec iunop =
  1. | Clz
  2. | Ctz
  3. | Popcnt
val pp_iunop : Stdlib.Format.formatter -> iunop -> unit
type nonrec funop =
  1. | Abs
  2. | Neg
  3. | Sqrt
  4. | Ceil
  5. | Floor
  6. | Trunc
  7. | Nearest
val pp_funop : Stdlib.Format.formatter -> funop -> unit
type nonrec ibinop =
  1. | Add
  2. | Sub
  3. | Mul
  4. | Div of sx
  5. | Rem of sx
  6. | And
  7. | Or
  8. | Xor
  9. | Shl
  10. | Shr of sx
  11. | Rotl
  12. | Rotr
val pp_ibinop : Stdlib.Format.formatter -> ibinop -> unit
type nonrec fbinop =
  1. | Add
  2. | Sub
  3. | Mul
  4. | Div
  5. | Min
  6. | Max
  7. | Copysign
val pp_fbinop : Stdlib.Format.formatter -> fbinop -> unit
type nonrec itestop =
  1. | Eqz
val pp_itestop : Stdlib.Format.formatter -> itestop -> unit
type nonrec irelop =
  1. | Eq
  2. | Ne
  3. | Lt of sx
  4. | Gt of sx
  5. | Le of sx
  6. | Ge of sx
val pp_irelop : Stdlib.Format.formatter -> irelop -> Prelude.Unit.t
type nonrec frelop =
  1. | Eq
  2. | Ne
  3. | Lt
  4. | Gt
  5. | Le
  6. | Ge
val frelop : Stdlib.Format.formatter -> frelop -> Prelude.Unit.t
type nonrec memarg = {
  1. offset : Int32.t;
  2. align : Int32.t;
}
val pp_memarg : Stdlib.Format.formatter -> memarg -> unit
type nonrec limits = {
  1. min : int;
  2. max : int option;
}
val pp_limits : Stdlib.Format.formatter -> limits -> unit
type nonrec mem = string option * limits
val pp_mem : Stdlib.Format.formatter -> (string option * limits) -> unit
type nonrec final =
  1. | Final
  2. | No_final
val pp_final : Stdlib.Format.formatter -> final -> unit

Structure

Types

type 'a heap_type =
  1. | Any_ht
  2. | None_ht
  3. | Eq_ht
  4. | I31_ht
  5. | Struct_ht
  6. | Array_ht
  7. | Func_ht
  8. | No_func_ht
  9. | Extern_ht
  10. | No_extern_ht
  11. | Def_ht of 'a indice
val pp_heap_type : Stdlib.Format.formatter -> 'a heap_type -> unit
val pp_heap_type_short : Stdlib.Format.formatter -> 'a heap_type -> unit
val heap_type_eq : 'a heap_type -> 'b heap_type -> bool
val compare_heap_type : 'a heap_type -> 'b heap_type -> int
type nonrec 'a ref_type = nullable * 'a heap_type
val pp_ref_type : Stdlib.Format.formatter -> (nullable * 'a heap_type) -> unit
val ref_type_eq : + (nullable * 'a heap_type) -> + (nullable * 'b heap_type) -> + bool
val compare_ref_type : + (nullable * 'a heap_type) -> + (nullable * 'b heap_type) -> + int
type nonrec 'a val_type =
  1. | Num_type of num_type
  2. | Ref_type of 'a ref_type
val pp_val_type : Stdlib.Format.formatter -> 'a val_type -> unit
val val_type_eq : 'a val_type -> 'b val_type -> bool
val compare_val_type : 'a val_type -> 'b val_type -> int
type nonrec 'a param = string option * 'a val_type
val pp_param : Stdlib.Format.formatter -> (string option * 'a val_type) -> unit
val param_eq : ('a * 'b val_type) -> ('c * 'd val_type) -> bool
val compare_param : ('a * 'b val_type) -> ('c * 'd val_type) -> int
type nonrec 'a param_type = 'a param list
val pp_param_type : + Stdlib.Format.formatter -> (string option * 'a val_type) list -> - unit
type nonrec 'a result_type = 'a val_type list
val pp_result_ : Format.formatter -> 'a val_type -> unit
val pp_result_type : Format.formatter -> 'a val_type list -> unit
val with_space_list : - (Format.formatter -> 'a list -> unit) -> - Format.formatter -> + unit
val param_type_eq : ('a * 'b val_type) list -> ('a * 'b val_type) list -> bool
val compare_param_type : + ('a * 'b val_type) list -> + ('a * 'b val_type) list -> + int
type nonrec 'a result_type = 'a val_type list
val pp_result_ : Stdlib.Format.formatter -> 'a val_type -> unit
val pp_result_type : Stdlib.Format.formatter -> 'a val_type list -> unit
val result_type_eq : 'a val_type list -> 'a val_type list -> bool
val compare_result_type : 'a val_type list -> 'a val_type list -> int
val with_space_list : + (Stdlib.Format.formatter -> 'a list -> unit) -> + Stdlib.Format.formatter -> 'a list -> unit
type 'a block_type =
  1. | Bt_ind : 'a indice -> < with_ind_bt.. > as 'a block_type
  2. | Bt_raw : ('a indice option * ('a param_type * 'a result_type)) -> < .. > as 'a - block_type
val pp_block_type : Format.formatter -> 'kind block_type -> unit
val pp_block_type_opt : Format.formatter -> 'a block_type option -> unit
type nonrec 'a func_type = 'a param_type * 'a result_type
val pp_func_type : - Format.formatter -> + block_type
val pp_block_type : Stdlib.Format.formatter -> 'kind block_type -> unit
val pp_block_type_opt : Stdlib.Format.formatter -> 'a block_type option -> unit
type nonrec 'a func_type = 'a param_type * 'a result_type
val pp_func_type : + Stdlib.Format.formatter -> ((string option * 'a val_type) list * 'b val_type list) -> - unit
type nonrec 'a table_type = limits * 'a ref_type
val pp_table_type : - Format.formatter -> + unit
val func_type_eq : + (('a * 'b val_type) list * 'c val_type list) -> + (('a * 'b val_type) list * 'c val_type list) -> + bool
val compare_func_type : + (('a * 'b val_type) list * 'c val_type list) -> + (('a * 'b val_type) list * 'c val_type list) -> + int
type nonrec 'a table_type = limits * 'a ref_type
val pp_table_type : + Stdlib.Format.formatter -> (limits * (nullable * 'a heap_type)) -> - unit
type nonrec 'a global_type = mut * 'a val_type
val pp_global_type : Format.formatter -> (mut * 'a val_type) -> unit
type nonrec 'a extern_type =
  1. | Func of string option * 'a func_type
  2. | Table of string option * 'a table_type
  3. | Mem of string option * limits
  4. | Global of string option * 'a global_type

Instructions

type 'a instr =
  1. | I32_const of Int32.t
  2. | I64_const of Int64.t
  3. | F32_const of Float32.t
  4. | F64_const of Float64.t
  5. | I_unop of nn * iunop
  6. | F_unop of nn * funop
  7. | I_binop of nn * ibinop
  8. | F_binop of nn * fbinop
  9. | I_testop of nn * itestop
  10. | I_relop of nn * irelop
  11. | F_relop of nn * frelop
  12. | I_extend8_s of nn
  13. | I_extend16_s of nn
  14. | I64_extend32_s
  15. | I32_wrap_i64
  16. | I64_extend_i32 of sx
  17. | I_trunc_f of nn * nn * sx
  18. | I_trunc_sat_f of nn * nn * sx
  19. | F32_demote_f64
  20. | F64_promote_f32
  21. | F_convert_i of nn * nn * sx
  22. | I_reinterpret_f of nn * nn
  23. | F_reinterpret_i of nn * nn
  24. | Ref_null of 'a heap_type
  25. | Ref_is_null
  26. | Ref_i31
  27. | Ref_func of 'a indice
  28. | Ref_as_non_null
  29. | Ref_cast of nullable * 'a heap_type
  30. | Ref_test of nullable * 'a heap_type
  31. | Ref_eq
  32. | Drop
  33. | Select of 'a val_type list option
  34. | Local_get of 'a indice
  35. | Local_set of 'a indice
  36. | Local_tee of 'a indice
  37. | Global_get of 'a indice
  38. | Global_set of 'a indice
  39. | Table_get of 'a indice
  40. | Table_set of 'a indice
  41. | Table_size of 'a indice
  42. | Table_grow of 'a indice
  43. | Table_fill of 'a indice
  44. | Table_copy of 'a indice * 'a indice
  45. | Table_init of 'a indice * 'a indice
  46. | Elem_drop of 'a indice
  47. | I_load of nn * memarg
  48. | F_load of nn * memarg
  49. | I_store of nn * memarg
  50. | F_store of nn * memarg
  51. | I_load8 of nn * sx * memarg
  52. | I_load16 of nn * sx * memarg
  53. | I64_load32 of sx * memarg
  54. | I_store8 of nn * memarg
  55. | I_store16 of nn * memarg
  56. | I64_store32 of memarg
  57. | Memory_size
  58. | Memory_grow
  59. | Memory_fill
  60. | Memory_copy
  61. | Memory_init of 'a indice
  62. | Data_drop of 'a indice
  63. | Nop
  64. | Unreachable
  65. | Block of string option * 'a block_type option * 'a expr
  66. | Loop of string option * 'a block_type option * 'a expr
  67. | If_else of string option * 'a block_type option * 'a expr * 'a expr
  68. | Br of 'a indice
  69. | Br_if of 'a indice
  70. | Br_table of 'a indice array * 'a indice
  71. | Br_on_cast of 'a indice * 'a ref_type * 'a ref_type
  72. | Br_on_cast_fail of 'a indice * nullable * 'a heap_type
  73. | Br_on_non_null of 'a indice
  74. | Br_on_null of 'a indice
  75. | Return
  76. | Return_call of 'a indice
  77. | Return_call_indirect of 'a indice * 'a block_type
  78. | Return_call_ref of 'a block_type
  79. | Call of 'a indice
  80. | Call_indirect of 'a indice * 'a block_type
  81. | Call_ref of 'a indice
  82. | Array_get of 'a indice
  83. | Array_get_u of 'a indice
  84. | Array_len
  85. | Array_new of 'a indice
  86. | Array_new_data of 'a indice * 'a indice
  87. | Array_new_default of 'a indice
  88. | Array_new_elem of 'a indice * 'a indice
  89. | Array_new_fixed of 'a indice * int
  90. | Array_set of 'a indice
  91. | I31_get_u
  92. | I31_get_s
  93. | Struct_get of 'a indice * 'a indice
  94. | Struct_get_s of 'a indice * 'a indice
  95. | Struct_new of 'a indice
  96. | Struct_new_default of 'a indice
  97. | Struct_set of 'a indice * 'a indice
  98. | Extern_externalize
  99. | Extern_internalize
and 'a expr = 'a instr list
val pp_instr : Format.formatter -> 'a instr -> Stdlib.Unit.t
val pp_expr : Format.formatter -> 'a expr -> Stdlib.Unit.t
type 'a func = {
  1. type_f : 'a block_type;
  2. locals : 'a param list;
  3. body : 'a expr;
  4. id : string option;
}
val pp_local : Format.formatter -> (string option * 'a val_type) -> unit
val pp_locals : Format.formatter -> (string option * 'a val_type) list -> unit
val pp_func : 'kind. Format.formatter -> 'kind func -> unit
val pp_funcs : Format.formatter -> 'a func list -> unit
type 'a table = string option * 'a table_type
val pp_table : - Format.formatter -> + unit
type nonrec 'a global_type = mut * 'a val_type
val pp_global_type : Stdlib.Format.formatter -> (mut * 'a val_type) -> unit
type nonrec 'a extern_type =
  1. | Func of string option * 'a func_type
  2. | Table of string option * 'a table_type
  3. | Mem of string option * limits
  4. | Global of string option * 'a global_type

Instructions

type 'a instr =
  1. | I32_const of Int32.t
  2. | I64_const of Int64.t
  3. | F32_const of Float32.t
  4. | F64_const of Float64.t
  5. | I_unop of nn * iunop
  6. | F_unop of nn * funop
  7. | I_binop of nn * ibinop
  8. | F_binop of nn * fbinop
  9. | I_testop of nn * itestop
  10. | I_relop of nn * irelop
  11. | F_relop of nn * frelop
  12. | I_extend8_s of nn
  13. | I_extend16_s of nn
  14. | I64_extend32_s
  15. | I32_wrap_i64
  16. | I64_extend_i32 of sx
  17. | I_trunc_f of nn * nn * sx
  18. | I_trunc_sat_f of nn * nn * sx
  19. | F32_demote_f64
  20. | F64_promote_f32
  21. | F_convert_i of nn * nn * sx
  22. | I_reinterpret_f of nn * nn
  23. | F_reinterpret_i of nn * nn
  24. | Ref_null of 'a heap_type
  25. | Ref_is_null
  26. | Ref_i31
  27. | Ref_func of 'a indice
  28. | Ref_as_non_null
  29. | Ref_cast of nullable * 'a heap_type
  30. | Ref_test of nullable * 'a heap_type
  31. | Ref_eq
  32. | Drop
  33. | Select of 'a val_type list option
  34. | Local_get of 'a indice
  35. | Local_set of 'a indice
  36. | Local_tee of 'a indice
  37. | Global_get of 'a indice
  38. | Global_set of 'a indice
  39. | Table_get of 'a indice
  40. | Table_set of 'a indice
  41. | Table_size of 'a indice
  42. | Table_grow of 'a indice
  43. | Table_fill of 'a indice
  44. | Table_copy of 'a indice * 'a indice
  45. | Table_init of 'a indice * 'a indice
  46. | Elem_drop of 'a indice
  47. | I_load of nn * memarg
  48. | F_load of nn * memarg
  49. | I_store of nn * memarg
  50. | F_store of nn * memarg
  51. | I_load8 of nn * sx * memarg
  52. | I_load16 of nn * sx * memarg
  53. | I64_load32 of sx * memarg
  54. | I_store8 of nn * memarg
  55. | I_store16 of nn * memarg
  56. | I64_store32 of memarg
  57. | Memory_size
  58. | Memory_grow
  59. | Memory_fill
  60. | Memory_copy
  61. | Memory_init of 'a indice
  62. | Data_drop of 'a indice
  63. | Nop
  64. | Unreachable
  65. | Block of string option * 'a block_type option * 'a expr
  66. | Loop of string option * 'a block_type option * 'a expr
  67. | If_else of string option * 'a block_type option * 'a expr * 'a expr
  68. | Br of 'a indice
  69. | Br_if of 'a indice
  70. | Br_table of 'a indice array * 'a indice
  71. | Br_on_cast of 'a indice * 'a ref_type * 'a ref_type
  72. | Br_on_cast_fail of 'a indice * nullable * 'a heap_type
  73. | Br_on_non_null of 'a indice
  74. | Br_on_null of 'a indice
  75. | Return
  76. | Return_call of 'a indice
  77. | Return_call_indirect of 'a indice * 'a block_type
  78. | Return_call_ref of 'a block_type
  79. | Call of 'a indice
  80. | Call_indirect of 'a indice * 'a block_type
  81. | Call_ref of 'a indice
  82. | Array_get of 'a indice
  83. | Array_get_u of 'a indice
  84. | Array_len
  85. | Array_new of 'a indice
  86. | Array_new_data of 'a indice * 'a indice
  87. | Array_new_default of 'a indice
  88. | Array_new_elem of 'a indice * 'a indice
  89. | Array_new_fixed of 'a indice * int
  90. | Array_set of 'a indice
  91. | I31_get_u
  92. | I31_get_s
  93. | Struct_get of 'a indice * 'a indice
  94. | Struct_get_s of 'a indice * 'a indice
  95. | Struct_new of 'a indice
  96. | Struct_new_default of 'a indice
  97. | Struct_set of 'a indice * 'a indice
  98. | Extern_externalize
  99. | Extern_internalize
and 'a expr = 'a instr list
val pp_newline : Stdlib.Format.formatter -> unit -> unit
val pp_instr : 'a instr Prelude.Fmt.t
val pp_expr : Stdlib.Format.formatter -> 'a expr -> Prelude.Unit.t
val iter_expr : ('a instr -> 'b) -> 'c expr -> unit
val iter_instr : ('a instr -> 'b) -> 'c instr -> unit
type 'a func = {
  1. type_f : 'a block_type;
  2. locals : 'a param list;
  3. body : 'a expr;
  4. id : string option;
}
val pp_local : Stdlib.Format.formatter -> (string option * 'a val_type) -> unit
val pp_locals : + Stdlib.Format.formatter -> + (string option * 'a val_type) list -> + unit
val pp_func : 'kind. Prelude.Fmt.formatter -> 'kind func -> unit
val pp_funcs : Stdlib.Format.formatter -> 'a func list -> unit
type 'a table = string option * 'a table_type
val pp_table : + Stdlib.Format.formatter -> (string option * (limits * (nullable * 'a heap_type))) -> - unit
type 'a import_desc =
  1. | Import_func of string option * 'a block_type
  2. | Import_table of string option * 'a table_type
  3. | Import_mem of string option * limits
  4. | Import_global of string option * 'a global_type
val import_desc : Format.formatter -> 'a import_desc -> Stdlib.Unit.t
type 'a import = {
  1. modul : string;
  2. name : string;
  3. desc : 'a import_desc;
}
val pp_import : Format.formatter -> 'a import -> Stdlib.Unit.t
type 'a export_desc =
  1. | Export_func of 'a indice option
  2. | Export_table of 'a indice option
  3. | Export_mem of 'a indice option
  4. | Export_global of 'a indice option
val pp_export_desc : Format.formatter -> 'a export_desc -> unit
type 'a export = {
  1. name : string;
  2. desc : 'a export_desc;
}
val pp_export : Format.formatter -> text export -> unit
type 'a storage_type =
  1. | Val_storage_t of 'a val_type
  2. | Val_packed_t of packed_type
val pp_storage_type : Format.formatter -> 'a storage_type -> unit
type 'a field_type = mut * 'a storage_type
val pp_field_type : Format.formatter -> (mut * 'a storage_type) -> unit
type 'a struct_field = string option * 'a field_type list
val pp_fields : Format.formatter -> (mut * 'a storage_type) list -> unit
val pp_struct_field : - Format.formatter -> + unit
type 'a import_desc =
  1. | Import_func of string option * 'a block_type
  2. | Import_table of string option * 'a table_type
  3. | Import_mem of string option * limits
  4. | Import_global of string option * 'a global_type
val import_desc : Stdlib.Format.formatter -> 'a import_desc -> Prelude.Unit.t
type 'a import = {
  1. modul : string;
    (*

    The name of the module from which the import is done

    *)
  2. name : string;
    (*

    The name of the importee in its module of origin

    *)
  3. desc : 'a import_desc;
    (*

    If this import_desc first field is Some s, the importee is made available under name s, else it can only be used via its numerical index.

    *)
}
val pp_import : Stdlib.Format.formatter -> 'a import -> Prelude.Unit.t
type 'a export_desc =
  1. | Export_func of 'a indice option
  2. | Export_table of 'a indice option
  3. | Export_mem of 'a indice option
  4. | Export_global of 'a indice option
val pp_export_desc : Stdlib.Format.formatter -> 'a export_desc -> unit
type 'a export = {
  1. name : string;
  2. desc : 'a export_desc;
}
val pp_export : Stdlib.Format.formatter -> text export -> unit
type 'a storage_type =
  1. | Val_storage_t of 'a val_type
  2. | Val_packed_t of packed_type
val pp_storage_type : Stdlib.Format.formatter -> 'a storage_type -> unit
val storage_type_eq : 'a storage_type -> 'b storage_type -> bool
type 'a field_type = mut * 'a storage_type
val pp_field_type : Stdlib.Format.formatter -> (mut * 'a storage_type) -> unit
val field_type_eq : (mut * 'a storage_type) -> (mut * 'b storage_type) -> bool
type 'a struct_field = string option * 'a field_type list
val pp_fields : Stdlib.Format.formatter -> (mut * 'a storage_type) list -> unit
val pp_struct_field : + Stdlib.Format.formatter -> (string option * (mut * 'a storage_type) list) -> - unit
type 'a struct_type = 'a struct_field list
val pp_struct_type : - Format.formatter -> + unit
val struct_field_eq : + ('a * (mut * 'b storage_type) list) -> + ('c * (mut * 'b storage_type) list) -> + bool
type 'a struct_type = 'a struct_field list
val pp_struct_type : + Stdlib.Format.formatter -> (string option * (mut * 'a storage_type) list) list -> - unit
val pp_array_type : Format.formatter -> (mut * 'a storage_type) -> unit
type 'a str_type =
  1. | Def_struct_t of 'a struct_type
  2. | Def_array_t of 'a field_type
  3. | Def_func_t of 'a func_type
val str_type : Format.formatter -> 'a str_type -> unit
type 'a sub_type = final * 'a indice list * 'a str_type
val pp_sub_type : - Format.formatter -> + unit
val struct_type_eq : + ('a * (mut * 'b storage_type) list) list -> + ('a * (mut * 'b storage_type) list) list -> + bool
val pp_array_type : Stdlib.Format.formatter -> (mut * 'a storage_type) -> unit
type 'a str_type =
  1. | Def_struct_t of 'a struct_type
  2. | Def_array_t of 'a field_type
  3. | Def_func_t of 'a func_type
val str_type : Stdlib.Format.formatter -> 'a str_type -> unit
val str_type_eq : 'a str_type -> 'b str_type -> bool
val compare_str_type : 'a str_type -> 'b str_type -> int
type 'a sub_type = final * 'a indice list * 'a str_type
val pp_sub_type : + Stdlib.Format.formatter -> (final * 'a indice list * 'b str_type) -> - unit
type 'a type_def = string option * 'a sub_type
val pp_type_def : - Format.formatter -> + unit
type 'a type_def = string option * 'a sub_type
val pp_type_def_no_indent : + Stdlib.Format.formatter -> + (string option * (final * 'a indice list * 'b str_type)) -> + unit
val pp_type_def : + Stdlib.Format.formatter -> (string option * (final * 'a indice list * 'b str_type)) -> unit
type 'a rec_type = 'a type_def list
val pp_rec_type : - Format.formatter -> + Stdlib.Format.formatter -> (string option * (final * 'a indice list * 'b str_type)) list -> - unit
val pp_start : Format.formatter -> 'a indice -> unit
type 'a const =
  1. | Const_I32 of Int32.t
  2. | Const_I64 of Int64.t
  3. | Const_F32 of Float32.t
  4. | Const_F64 of Float64.t
  5. | Const_null of 'a heap_type
  6. | Const_host of int
  7. | Const_extern of int
  8. | Const_array
  9. | Const_eq
  10. | Const_i31
  11. | Const_struct
val pp_const : Format.formatter -> 'a const -> unit
val pp_consts : Format.formatter -> 'a const list -> unit
+ unit
val pp_start : Stdlib.Format.formatter -> 'a indice -> unit
type 'a const =
  1. | Const_I32 of Int32.t
  2. | Const_I64 of Int64.t
  3. | Const_F32 of Float32.t
  4. | Const_F64 of Float64.t
  5. | Const_null of 'a heap_type
  6. | Const_host of int
  7. | Const_extern of int
  8. | Const_array
  9. | Const_eq
  10. | Const_i31
  11. | Const_struct
val pp_const : Stdlib.Format.formatter -> 'a const -> unit
val pp_consts : Stdlib.Format.formatter -> 'a const list -> unit
diff --git a/api/owi/Owi/V/Bool/index.html b/api/owi/Owi/V/Bool/index.html index cdd6238d3..efc41fdd1 100644 --- a/api/owi/Owi/V/Bool/index.html +++ b/api/owi/Owi/V/Bool/index.html @@ -1,2 +1,2 @@ -Bool (owi.Owi.V.Bool)

Module V.Bool

val const : bool -> vbool
val not : vbool -> vbool
val or_ : vbool -> vbool -> vbool
val and_ : vbool -> vbool -> vbool
val int32 : vbool -> int32
val pp : Format.formatter -> vbool -> unit
+Bool (owi.Owi.V.Bool)

Module V.Bool

val const : bool -> vbool
val not : vbool -> vbool
val or_ : vbool -> vbool -> vbool
val and_ : vbool -> vbool -> vbool
val int32 : vbool -> int32
val pp : Prelude.Fmt.formatter -> vbool -> unit
diff --git a/api/owi/Owi/V/Ref/index.html b/api/owi/Owi/V/Ref/index.html index 9d329c4ee..849509a23 100644 --- a/api/owi/Owi/V/Ref/index.html +++ b/api/owi/Owi/V/Ref/index.html @@ -1,2 +1,2 @@ -Ref (owi.Owi.V.Ref)

Module V.Ref

val get_externref : ref_value -> 'a Stdlib.Type.Id.t -> 'a Value_intf.get_ref
+Ref (owi.Owi.V.Ref)

Module V.Ref

val get_externref : ref_value -> 'a Prelude.Type.Id.t -> 'a Value_intf.get_ref
diff --git a/api/owi/Owi/V/index.html b/api/owi/Owi/V/index.html index fa8b56dad..3ff539da6 100644 --- a/api/owi/Owi/V/index.html +++ b/api/owi/Owi/V/index.html @@ -1,9 +1,9 @@ V (owi.Owi.V)

Module Owi.V

include Value_intf.T - with type vbool = Stdlib.Bool.t + with type vbool = Prelude.Bool.t and type int32 = Int32.t and type int64 = Int64.t and type float32 = Float32.t and type float64 = Float64.t and type ref_value = Concrete_value.ref_value - and type t = Concrete_value.t
type vbool = Stdlib.Bool.t
type int32 = Int32.t
type int64 = Int64.t
type float32 = Float32.t
type float64 = Float64.t
type ref_value = Concrete_value.ref_value
type t = Concrete_value.t =
  1. | I32 of int32
  2. | I64 of int64
  3. | F32 of float32
  4. | F64 of float64
  5. | Ref of ref_value
val const_i32 : Int32.t -> int32
val const_i64 : Int64.t -> int64
val const_f32 : Float32.t -> float32
val const_f64 : Float64.t -> float64
val ref_null : Types.binary Types.heap_type -> t
val ref_func : Func_intf.t -> t
val ref_externref : 'a Stdlib.Type.Id.t -> 'a -> t
val ref_is_null : ref_value -> vbool
val pp : Format.formatter -> t -> unit
module Ref : sig ... end
module Bool : sig ... end
module F32 : sig ... end
module F64 : sig ... end
module I32 : sig ... end
module I64 : sig ... end
+ and type t = Concrete_value.t
type vbool = Prelude.Bool.t
type int32 = Int32.t
val pp_int32 : Prelude.Fmt.formatter -> int32 -> unit
type int64 = Int64.t
val pp_int64 : Prelude.Fmt.formatter -> int64 -> unit
type float32 = Float32.t
val pp_float32 : Prelude.Fmt.formatter -> float32 -> unit
type float64 = Float64.t
val pp_float64 : Prelude.Fmt.formatter -> float64 -> unit
type ref_value = Concrete_value.ref_value
val pp_ref_value : Prelude.Fmt.formatter -> ref_value -> unit
type t = Concrete_value.t =
  1. | I32 of int32
  2. | I64 of int64
  3. | F32 of float32
  4. | F64 of float64
  5. | Ref of ref_value
val pp : Prelude.Fmt.formatter -> t -> unit
val const_i32 : Int32.t -> int32
val const_i64 : Int64.t -> int64
val const_f32 : Float32.t -> float32
val const_f64 : Float64.t -> float64
val ref_null : Types.binary Types.heap_type -> t
val ref_func : Func_intf.t -> t
val ref_externref : 'a Prelude.Type.Id.t -> 'a -> t
val ref_is_null : ref_value -> vbool
module Ref : sig ... end
module Bool : sig ... end
module F32 : sig ... end
module F64 : sig ... end
module I32 : sig ... end
module I64 : sig ... end
diff --git a/api/owi/Owi/Value_intf/module-type-T/Bool/index.html b/api/owi/Owi/Value_intf/module-type-T/Bool/index.html index 32fb7a830..6a1d61fb6 100644 --- a/api/owi/Owi/Value_intf/module-type-T/Bool/index.html +++ b/api/owi/Owi/Value_intf/module-type-T/Bool/index.html @@ -1,2 +1,2 @@ -Bool (owi.Owi.Value_intf.T.Bool)

Module T.Bool

val const : bool -> vbool
val not : vbool -> vbool
val or_ : vbool -> vbool -> vbool
val and_ : vbool -> vbool -> vbool
val int32 : vbool -> int32
val pp : Format.formatter -> vbool -> unit
+Bool (owi.Owi.Value_intf.T.Bool)

Module T.Bool

val const : bool -> vbool
val not : vbool -> vbool
val or_ : vbool -> vbool -> vbool
val and_ : vbool -> vbool -> vbool
val int32 : vbool -> int32
val pp : Prelude.Fmt.formatter -> vbool -> unit
diff --git a/api/owi/Owi/Value_intf/module-type-T/Ref/index.html b/api/owi/Owi/Value_intf/module-type-T/Ref/index.html index a5317c6d4..4a1189cf8 100644 --- a/api/owi/Owi/Value_intf/module-type-T/Ref/index.html +++ b/api/owi/Owi/Value_intf/module-type-T/Ref/index.html @@ -1,2 +1,2 @@ -Ref (owi.Owi.Value_intf.T.Ref)

Module T.Ref

val get_func : ref_value -> Func_intf.t get_ref
val get_externref : ref_value -> 'a Stdlib.Type.Id.t -> 'a get_ref
+Ref (owi.Owi.Value_intf.T.Ref)

Module T.Ref

val get_func : ref_value -> Func_intf.t get_ref
val get_externref : ref_value -> 'a Prelude.Type.Id.t -> 'a get_ref
diff --git a/api/owi/Owi/Value_intf/module-type-T/index.html b/api/owi/Owi/Value_intf/module-type-T/index.html index 303e355bf..3ac52e139 100644 --- a/api/owi/Owi/Value_intf/module-type-T/index.html +++ b/api/owi/Owi/Value_intf/module-type-T/index.html @@ -1,2 +1,2 @@ -T (owi.Owi.Value_intf.T)

Module type Value_intf.T

type vbool
type int32
type int64
type float32
type float64
type ref_value
type t =
  1. | I32 of int32
  2. | I64 of int64
  3. | F32 of float32
  4. | F64 of float64
  5. | Ref of ref_value
val const_i32 : Int32.t -> int32
val const_i64 : Int64.t -> int64
val const_f32 : Float32.t -> float32
val const_f64 : Float64.t -> float64
val ref_null : Types.binary Types.heap_type -> t
val ref_func : Func_intf.t -> t
val ref_externref : 'a Stdlib.Type.Id.t -> 'a -> t
val ref_is_null : ref_value -> vbool
val pp : Format.formatter -> t -> unit
module Ref : sig ... end
module Bool : sig ... end
module F32 : sig ... end
module F64 : sig ... end
module I32 : sig ... end
module I64 : sig ... end
+T (owi.Owi.Value_intf.T)

Module type Value_intf.T

type vbool
type int32
val pp_int32 : Prelude.Fmt.formatter -> int32 -> unit
type int64
val pp_int64 : Prelude.Fmt.formatter -> int64 -> unit
type float32
val pp_float32 : Prelude.Fmt.formatter -> float32 -> unit
type float64
val pp_float64 : Prelude.Fmt.formatter -> float64 -> unit
type ref_value
val pp_ref_value : Prelude.Fmt.formatter -> ref_value -> unit
type t =
  1. | I32 of int32
  2. | I64 of int64
  3. | F32 of float32
  4. | F64 of float64
  5. | Ref of ref_value
val pp : Prelude.Fmt.formatter -> t -> unit
val const_i32 : Int32.t -> int32
val const_i64 : Int64.t -> int64
val const_f32 : Float32.t -> float32
val const_f64 : Float64.t -> float64
val ref_null : Types.binary Types.heap_type -> t
val ref_func : Func_intf.t -> t
val ref_externref : 'a Prelude.Type.Id.t -> 'a -> t
val ref_is_null : ref_value -> vbool
module Ref : sig ... end
module Bool : sig ... end
module F32 : sig ... end
module F64 : sig ... end
module I32 : sig ... end
module I64 : sig ... end
diff --git a/api/owi/Owi/Wasm_ffi_intf/index.html b/api/owi/Owi/Wasm_ffi_intf/index.html new file mode 100644 index 000000000..b227de2f2 --- /dev/null +++ b/api/owi/Owi/Wasm_ffi_intf/index.html @@ -0,0 +1,2 @@ + +Wasm_ffi_intf (owi.Owi.Wasm_ffi_intf)

Module Owi.Wasm_ffi_intf

module type S0 = sig ... end
module type S = sig ... end
diff --git a/api/owi/Owi/Wasm_ffi_intf/module-type-S/index.html b/api/owi/Owi/Wasm_ffi_intf/module-type-S/index.html new file mode 100644 index 000000000..4aaa8a7d6 --- /dev/null +++ b/api/owi/Owi/Wasm_ffi_intf/module-type-S/index.html @@ -0,0 +1,2 @@ + +S (owi.Owi.Wasm_ffi_intf.S)

Module type Wasm_ffi_intf.S

type extern_func
val symbolic_extern_module : extern_func Link.extern_module
val summaries_extern_module : extern_func Link.extern_module
diff --git a/api/owi/Owi/Wasm_ffi_intf/module-type-S0/Value/index.html b/api/owi/Owi/Wasm_ffi_intf/module-type-S0/Value/index.html new file mode 100644 index 000000000..0dc65278c --- /dev/null +++ b/api/owi/Owi/Wasm_ffi_intf/module-type-S0/Value/index.html @@ -0,0 +1,2 @@ + +Value (owi.Owi.Wasm_ffi_intf.S0.Value)

Module S0.Value

type int32
type int64
type float32
type float64
diff --git a/api/owi/Owi/Wasm_ffi_intf/module-type-S0/index.html b/api/owi/Owi/Wasm_ffi_intf/module-type-S0/index.html new file mode 100644 index 000000000..e60f05920 --- /dev/null +++ b/api/owi/Owi/Wasm_ffi_intf/module-type-S0/index.html @@ -0,0 +1,2 @@ + +S0 (owi.Owi.Wasm_ffi_intf.S0)

Module type Wasm_ffi_intf.S0

type 'a t
type memory
module Value : sig ... end
val symbol_i8 : unit -> Value.int32 t
val symbol_char : unit -> Value.int32 t
val symbol_i32 : unit -> Value.int32 t
val symbol_i64 : unit -> Value.int64 t
val symbol_f32 : unit -> Value.float32 t
val symbol_f64 : unit -> Value.float64 t
val assume_i32 : Value.int32 -> unit t
val assume_positive_i32 : Value.int32 -> unit t
val assert_i32 : Value.int32 -> unit t
val abort : unit -> unit t
val free : memory -> Value.int32 -> unit t
val exit : Value.int32 -> unit t
diff --git a/api/owi/Owi/Wq/index.html b/api/owi/Owi/Wq/index.html new file mode 100644 index 000000000..45cf3debc --- /dev/null +++ b/api/owi/Owi/Wq/index.html @@ -0,0 +1,2 @@ + +Wq (owi.Owi.Wq)

Module Owi.Wq

type !'a t
val init : unit -> 'a t
val push : 'a -> 'a t -> unit
val pop : 'a t -> bool -> 'a option
val make_pledge : 'a t -> unit
val end_pledge : 'a t -> unit
val fail : 'a t -> unit
val read_as_seq : 'a t -> finalizer:(unit -> unit) -> 'a Prelude.Seq.t
diff --git a/api/owi/Owi/index.html b/api/owi/Owi/index.html index 7561b0041..027910b62 100644 --- a/api/owi/Owi/index.html +++ b/api/owi/Owi/index.html @@ -1,2 +1,2 @@ -Owi (owi.Owi)

Module Owi

module Assigned : sig ... end
module Binary : sig ... end
module Binary_parser : sig ... end
module Binary_to_text : sig ... end
module Binary_types : sig ... end
module C_instrumentor : sig ... end
module C_share : sig ... end
module C_share_site : sig ... end
module Check : sig ... end

Initial check done on a module.

module Choice_intf : sig ... end
module Cmd_c : sig ... end
module Cmd_conc : sig ... end
module Cmd_fmt : sig ... end
module Cmd_opt : sig ... end
module Cmd_run : sig ... end
module Cmd_script : sig ... end
module Cmd_sym : sig ... end
module Cmd_validate : sig ... end
module Cmd_wasm2wat : sig ... end
module Compile : sig ... end

Utility functions to compile a module until a given step.

module Concolic : sig ... end
module Concolic_choice : sig ... end
module Concolic_value : sig ... end
module Concrete : sig ... end
module Concrete_choice : sig ... end
module Concrete_global : sig ... end

runtime global

module Concrete_memory : sig ... end
module Concrete_table : sig ... end

runtime table

module Concrete_value : sig ... end

Module to define externref values in OCaml. You should look in the `example` directory to understand how to use this before reading the code...

module Convert : sig ... end

Various conversion functions between i32, i64, f32 and f64.

module Env_id : sig ... end
module Float32 : sig ... end

Custom Float32 module for Wasm.

module Float64 : sig ... end

Custom Float64 module for Wasm.

module Format : sig ... end
module Func_id : sig ... end
module Func_intf : sig ... end
module Grouped : sig ... end
module Imported : sig ... end
module Indexed : sig ... end
module Int32 : sig ... end

Custom Int32 module for Wasm.

module Int64 : sig ... end

Custom Int64 module for Wasm.

module Interpret : sig ... end
module Interpret_intf : sig ... end

Module to link a binary/extern module and producing a runnable module along with a link state.

module Log : sig ... end

Module to enable or disable the printing of debug logs.

module Named : sig ... end
module Optimize : sig ... end

Optimize module

module Parse : sig ... end

Module providing functions to parse a wasm script from various kind of inputs.

module Result : sig ... end
module Rewrite : sig ... end
module Runtime : sig ... end
module Script : sig ... end

Module to execute a full Wasm script.

module Solver : sig ... end
module Spectest : sig ... end

The `spectest` module, to run script from the official test suite.

module Stack : sig ... end
module String_map : sig ... end
module Symbolic : sig ... end
module Symbolic_choice : sig ... end
module Symbolic_global : sig ... end
module Symbolic_memory : sig ... end
module Symbolic_table : sig ... end
module Symbolic_value : sig ... end
module Syntax : sig ... end
module Testcase : sig ... end
module Text : sig ... end
module Text_lexer : sig ... end

Module for Wasm lexing.

module Text_parser : sig ... end
module Thread : sig ... end
module Tracing : sig ... end
module Trap : sig ... end
module Typecheck : sig ... end

Module to typecheck a simplified module.

module Types : sig ... end
module V : sig ... end
module Value_intf : sig ... end
module Wutf8 : sig ... end

Utility functions to work with utf8.

+Owi (owi.Owi)

Module Owi

module Assigned : sig ... end
module Binary : sig ... end
module Binary_encoder : sig ... end
module Binary_parser : sig ... end
module Binary_to_text : sig ... end
module Binary_types : sig ... end
module C_share_site : sig ... end
module Check : sig ... end

Initial check done on a module.

module Choice_intf : sig ... end
module Cmd_c : sig ... end
module Cmd_conc : sig ... end
module Cmd_fmt : sig ... end
module Cmd_opt : sig ... end
module Cmd_run : sig ... end
module Cmd_script : sig ... end
module Cmd_sym : sig ... end
module Cmd_utils : sig ... end
module Cmd_validate : sig ... end
module Cmd_wasm2wat : sig ... end
module Cmd_wat2wasm : sig ... end
module Compile : sig ... end

Utility functions to compile a module until a given step.

module Concolic : sig ... end
module Concolic_choice : sig ... end
module Concolic_value : sig ... end
module Concolic_wasm_ffi : sig ... end
module Concrete : sig ... end
module Concrete_choice : sig ... end
module Concrete_global : sig ... end

runtime global

module Concrete_memory : sig ... end
module Concrete_table : sig ... end

runtime table

module Concrete_value : sig ... end

Module to define externref values in OCaml. You should look in the `example` directory to understand how to use this before reading the code...

module Convert : sig ... end

Various conversion functions between i32, i64, f32 and f64.

module Env_id : sig ... end
module Float32 : sig ... end

Custom Float32 module for Wasm.

module Float64 : sig ... end

Custom Float64 module for Wasm.

module Func_id : sig ... end
module Func_intf : sig ... end
module Grouped : sig ... end
module Imported : sig ... end
module Indexed : sig ... end
module Int32 : sig ... end

Custom Int32 module for Wasm.

module Int64 : sig ... end

Custom Int64 module for Wasm.

module Interpret : sig ... end
module Interpret_intf : sig ... end
module Kind : sig ... end

Module to link a binary/extern module and producing a runnable module along with a link state.

module Log : sig ... end

Module to enable or disable the printing of debug logs.

module Named : sig ... end
module Optimize : sig ... end

Optimize module

module Parse : sig ... end

Module providing functions to parse a wasm script from various kind of inputs.

module Result : sig ... end
module Rewrite : sig ... end
module Runtime : sig ... end
module Script : sig ... end

Module to execute a full Wasm script.

module Solver : sig ... end
module Spectest : sig ... end

The `spectest` module, to run script from the official test suite.

module Stack : sig ... end
module String_map : sig ... end
module Symbolic : sig ... end
module Symbolic_choice : sig ... end
module Symbolic_choice_intf : sig ... end
module Symbolic_choice_minimalist : sig ... end
module Symbolic_choice_with_memory : sig ... end
module Symbolic_choice_without_memory : sig ... end
module Symbolic_global : sig ... end
module Symbolic_memory : sig ... end
module Symbolic_memory_concretizing : sig ... end
module Symbolic_memory_intf : sig ... end
module Symbolic_memory_make : sig ... end
module Symbolic_table : sig ... end
module Symbolic_value : sig ... end
module Symbolic_wasm_ffi : sig ... end
module Syntax : sig ... end
module Text : sig ... end
module Text_lexer : sig ... end

Module for Wasm lexing.

module Text_parser : sig ... end
module Thread : sig ... end
module Thread_intf : sig ... end
module Thread_with_memory : sig ... end
module Thread_without_memory : sig ... end
module Tracing : sig ... end
module Trap : sig ... end
module Typecheck : sig ... end

Module to typecheck a simplified module.

module Types : sig ... end
module V : sig ... end
module Value_intf : sig ... end
module Wasm_ffi_intf : sig ... end
module Wq : sig ... end
module Wutf8 : sig ... end

Utility functions to work with utf8.

diff --git a/api/owi/index.html b/api/owi/index.html index bfd311b19..63640731e 100644 --- a/api/owi/index.html +++ b/api/owi/index.html @@ -1,2 +1,2 @@ -index (owi.index)

owi

owi is a toolchain to work with WebAssembly. It is written in OCaml.

Owi provides many tools: a formatter, an optimizer, a concrete interpreter, a script interpreter and a symbolic interpreter. It also allows to do bug finding on C code by compiling it to Wasm and running the symbolic interpreter.

To get started, have a look at the README which contains pointers to general documentation and examples.

Here you will only find the API documentation which is written towards people using the OCaml library directly or people trying to understand the code of Owi such as its developpers. :-)

API

  • Owi.Parse Module providing functions to parse a wasm script from various kind of inputs.
  • Owi.Types
  • Owi.Compile Utility functions to compile a module until a given step.
  • Owi.Check Initial check done on a module.
  • Owi.Typecheck Module to typecheck a simplified module.
  • Owi.Optimize Optimize module
  • Owi.Link Module to link a binary/extern module and producing a runnable module along with a link state.
  • Owi.Log Module to enable or disable the printing of debug logs.
  • Owi.Interpret
  • Owi.Script Module to execute a full Wasm script.

Private API

You shouldn't have to use any of these modules, they're used internally only. Nonetheless, some modules should maybe move to the public API, open an issue on the repository if you believe a mistake has been done.

+index (owi.index)

owi

owi is a toolchain to work with WebAssembly. It is written in OCaml.

Owi provides many tools: a formatter, an optimizer, a concrete interpreter, a script interpreter and a symbolic interpreter. It also allows to do bug finding on C code by compiling it to Wasm and running the symbolic interpreter.

To get started, have a look at the README which contains pointers to general documentation and examples.

Here you will only find the API documentation which is written towards people using the OCaml library directly or people trying to understand the code of Owi such as its developpers. :-)

API

Private API

You shouldn't have to use any of these modules, they're used internally only. Nonetheless, some modules should maybe move to the public API, open an issue on the repository if you believe a mistake has been done.

diff --git a/coverage/badge.svg b/coverage/badge.svg index aebaea8ac..9f77b5675 100644 --- a/coverage/badge.svg +++ b/coverage/badge.svg @@ -1,5 +1,5 @@ - - coverage: 79% + + coverage: 76% @@ -7,13 +7,13 @@ - + diff --git a/coverage/index.html b/coverage/index.html index ed92cde69..63e8dc9ea 100644 --- a/coverage/index.html +++ b/coverage/index.html @@ -3,13 +3,13 @@ Coverage report - +
@@ -23,117 +23,117 @@

79.93%

- 87% (102 / 116) + 87% (82 / 94) src/cmd/cmd_c.ml
- + - 43% (126 / 290) + 56% (139 / 247) src/cmd/cmd_conc.ml
- + - 81% (22 / 27) + 77% (17 / 22) src/cmd/cmd_fmt.ml
- + - 71% (10 / 14) + 87% (7 / 8) src/cmd/cmd_opt.ml
- + - 92% (13 / 14) + 87% (7 / 8) src/cmd/cmd_run.ml @@ -149,67 +149,85 @@

79.93%

- + - 85% (145 / 170) + 90% (77 / 85) src/cmd/cmd_sym.ml
- + - 87% (7 / 8) + 76% (39 / 51) + + src/cmd/cmd_utils.ml + +
+
+ + + + 83% (5 / 6) src/cmd/cmd_validate.ml
- + - 80% (8 / 10) + 100% (9 / 9) src/cmd/cmd_wasm2wat.ml
- + - 6% (6 / 98) + 20% (21 / 105) src/concolic/concolic.ml
- + - 45% (38 / 84) + 60% (51 / 84) src/concolic/concolic_choice.ml
- + - 60% (95 / 156) + 61% (101 / 165) src/concolic/concolic_value.ml
+
@@ -230,47 +248,47 @@

79.93%

- + - 100% (4 / 4) + 83% (5 / 6) src/concrete/concrete_global.ml
- + - 94% (73 / 77) + 95% (76 / 80) src/concrete/concrete_memory.ml
- + - 100% (24 / 24) + 88% (24 / 27) src/concrete/concrete_table.ml
- + - 63% (45 / 71) + 66% (48 / 72) src/concrete/concrete_value.ml
@@ -302,9 +320,9 @@

79.93%

- + - 92% (13 / 14) + 71% (10 / 14) src/data_structures/indexed.ml @@ -347,54 +365,117 @@

79.93%

- 91% (1263 / 1379) + 91% (1281 / 1394) src/interpret/interpret.ml
+
+ + + + 69% (9 / 13) + + src/interpret/trap.ml + +
+
+ + + + 100% (0 / 0) + + src/intf/interpret_intf.ml + +
+ + +
+ + + + 100% (0 / 0) + + src/intf/thread_intf.ml + +
+
+ + + + 100% (0 / 0) + + src/intf/value_intf.ml
- + - 85% (232 / 272) + 100% (0 / 0) + + src/intf/wasm_ffi_intf.ml + +
+
+ + + + 91% (244 / 267) src/link/link.ml
- + - 91% (31 / 34) + 87% (50 / 57) src/link/link_env.ml @@ -410,18 +491,18 @@

79.93%

- + - 60% (613 / 1010) + 71% (746 / 1046) src/parser/binary_parser.ml
- + - 82% (28 / 34) + 10% (36 / 346) src/parser/parse.ml @@ -430,25 +511,25 @@

79.93%

- 99% (266 / 267) + 99% (345 / 346) src/primitives/convert.ml
- + - 91% (270 / 294) + 96% (347 / 358) src/primitives/float32.ml
- + - 91% (272 / 298) + 96% (350 / 362) src/primitives/float64.ml @@ -457,7 +538,7 @@

79.93%

- 98% (119 / 121) + 98% (129 / 131) src/primitives/int32.ml @@ -466,7 +547,7 @@

79.93%

- 96% (116 / 120) + 96% (126 / 130) src/primitives/int64.ml @@ -475,16 +556,16 @@

79.93%

- 80% (156 / 193) + 80% (177 / 221) src/script/script.ml
- + - 80% (8 / 10) + 83% (10 / 12) src/script/spectest.ml @@ -493,47 +574,92 @@

79.93%

- 100% (2 / 2) + 100% (7 / 7) src/symbolic/solver.ml
- + - 78% (61 / 78) + 83% (52 / 62) src/symbolic/symbolic.ml
- + - 82% (240 / 292) + 95% (228 / 238) src/symbolic/symbolic_choice.ml
+ + +
+ + - 97% (38 / 39) + 94% (37 / 39) src/symbolic/symbolic_global.ml
- + - 83% (172 / 205) + 0% (2 / 208) src/symbolic/symbolic_memory.ml
+ +
+ + + + 88% (110 / 125) + + src/symbolic/symbolic_memory_make.ml + +
@@ -545,137 +671,137 @@

79.93%

- + - 85% (206 / 242) + 84% (206 / 243) src/symbolic/symbolic_value.ml
@@ -683,8 +809,8 @@

79.93%

100% (0 / 0) - - src/value_intf.ml + + src/C_share_site.ml
diff --git a/coverage/src/C_share_site.ml.html b/coverage/src/C_share_site.ml.html index 535de2635..c028a0fae 100644 --- a/coverage/src/C_share_site.ml.html +++ b/coverage/src/C_share_site.ml.html @@ -34,11 +34,6 @@

100.00%

- - - - -
@@ -55,11 +50,6 @@

100.00%

10 11 12 -13 -14 -15 -16 -17 
module Sites = struct
     let binc = Dune_site.Private_.Helpers.site
@@ -72,11 +62,6 @@ 
100.00%

       ~section:Dune_section.Share
       ~suffix:"libc"
       ~encoded:(Sys.opaque_identity "%%DUNE_PLACEHOLDER:4096:location:share:3:owi%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%")
-    let pyc = Dune_site.Private_.Helpers.site
-      ~package:"owi"
-      ~section:Dune_section.Share
-      ~suffix:"pyc"
-      ~encoded:(Sys.opaque_identity "%%DUNE_PLACEHOLDER:4096:location:share:3:owi%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%")
 end
diff --git a/coverage/src/ast/binary.ml.html b/coverage/src/ast/binary.ml.html index 41df4a61f..e6ae5b8c2 100644 --- a/coverage/src/ast/binary.ml.html +++ b/coverage/src/ast/binary.ml.html @@ -96,6 +96,8 @@

100.00%

+ +
@@ -174,6 +176,8 @@

100.00%

72 73 74 +75 +76 
(* SPDX-License-Identifier: AGPL-3.0-or-later *)
 (* Copyright © 2021-2024 OCamlPro *)
@@ -204,7 +208,7 @@ 
100.00%

 type data_mode =
   | Data_passive
   (* TODO: Data_active binary+const expr*)
-  | Data_active of int option * binary expr
+  | Data_active of int * binary expr
 
 type data =
   { id : string option
@@ -227,6 +231,7 @@ 
100.00%

 
 type modul =
   { id : string option
+  ; types : binary rec_type Named.t
   ; global : (global, binary global_type) Runtime.t Named.t
   ; table : (binary table, binary table_type) Runtime.t Named.t
   ; mem : (mem, limits) Runtime.t Named.t
@@ -240,6 +245,7 @@ 
100.00%

 
 let empty_modul =
   { id = None
+  ; types = Named.empty
   ; global = Named.empty
   ; table = Named.empty
   ; mem = Named.empty
diff --git a/coverage/src/ast/binary_encoder.ml.html b/coverage/src/ast/binary_encoder.ml.html
new file mode 100644
index 000000000..0cd7028c0
--- /dev/null
+++ b/coverage/src/ast/binary_encoder.ml.html
@@ -0,0 +1,2657 @@
+
+
+  
+    
+    binary_encoder.ml — Coverage report
+    
+    
+    
+    
+  
+  
+    
+    
+    

+      

+        
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+

+      

+      

+        
+  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
+232
+233
+234
+235
+236
+237
+238
+239
+240
+241
+242
+243
+244
+245
+246
+247
+248
+249
+250
+251
+252
+253
+254
+255
+256
+257
+258
+259
+260
+261
+262
+263
+264
+265
+266
+267
+268
+269
+270
+271
+272
+273
+274
+275
+276
+277
+278
+279
+280
+281
+282
+283
+284
+285
+286
+287
+288
+289
+290
+291
+292
+293
+294
+295
+296
+297
+298
+299
+300
+301
+302
+303
+304
+305
+306
+307
+308
+309
+310
+311
+312
+313
+314
+315
+316
+317
+318
+319
+320
+321
+322
+323
+324
+325
+326
+327
+328
+329
+330
+331
+332
+333
+334
+335
+336
+337
+338
+339
+340
+341
+342
+343
+344
+345
+346
+347
+348
+349
+350
+351
+352
+353
+354
+355
+356
+357
+358
+359
+360
+361
+362
+363
+364
+365
+366
+367
+368
+369
+370
+371
+372
+373
+374
+375
+376
+377
+378
+379
+380
+381
+382
+383
+384
+385
+386
+387
+388
+389
+390
+391
+392
+393
+394
+395
+396
+397
+398
+399
+400
+401
+402
+403
+404
+405
+406
+407
+408
+409
+410
+411
+412
+413
+414
+415
+416
+417
+418
+419
+420
+421
+422
+423
+424
+425
+426
+427
+428
+429
+430
+431
+432
+433
+434
+435
+436
+437
+438
+439
+440
+441
+442
+443
+444
+445
+446
+447
+448
+449
+450
+451
+452
+453
+454
+455
+456
+457
+458
+459
+460
+461
+462
+463
+464
+465
+466
+467
+468
+469
+470
+471
+472
+473
+474
+475
+476
+477
+478
+479
+480
+481
+482
+483
+484
+485
+486
+487
+488
+489
+490
+491
+492
+493
+494
+495
+496
+497
+498
+499
+500
+501
+502
+503
+504
+505
+506
+507
+508
+509
+510
+511
+512
+513
+514
+515
+516
+517
+518
+519
+520
+521
+522
+523
+524
+525
+526
+527
+528
+529
+530
+531
+532
+533
+534
+535
+536
+537
+538
+539
+540
+541
+542
+543
+544
+545
+546
+547
+548
+549
+550
+551
+552
+553
+554
+555
+556
+557
+558
+559
+560
+561
+562
+563
+564
+565
+566
+567
+568
+569
+570
+571
+572
+573
+574
+575
+576
+577
+578
+579
+580
+581
+582
+583
+584
+585
+586
+587
+588
+589
+590
+591
+592
+593
+594
+595
+596
+597
+598
+599
+600
+601
+602
+603
+604
+605
+606
+607
+608
+609
+610
+611
+612
+613
+614
+615
+616
+617
+618
+619
+620
+621
+622
+623
+624
+625
+626
+627
+628
+629
+630
+631
+632
+633
+634
+635
+636
+637
+638
+639
+640
+641
+642
+643
+644
+645
+646
+647
+648
+649
+650
+651
+652
+653
+654
+655
+656
+657
+658
+659
+660
+661
+662
+663
+664
+665
+666
+667
+668
+669
+670
+671
+672
+673
+674
+675
+676
+677
+678
+679
+680
+681
+682
+683
+684
+685
+686
+687
+688
+689
+690
+691
+692
+693
+694
+695
+696
+697
+698
+699
+700
+701
+702
+703
+704
+705
+706
+707
+708
+709
+710
+711
+712
+713
+714
+715
+716
+717
+718
+719
+720
+721
+722
+723
+724
+725
+726
+727
+728
+729
+730
+731
+732
+733
+734
+735
+736
+737
+738
+739
+740
+741
+742
+743
+744
+745
+746
+747
+748
+749
+750
+751
+752
+753
+754
+755
+756
+757
+758
+759
+760
+761
+762
+763
+764
+765
+766
+767
+768
+769
+770
+771
+772
+773
+774
+775
+776
+777
+778
+779
+780
+781
+782
+783
+784
+785
+

+
(* SPDX-License-Identifier: AGPL-3.0-or-later *)
+(* Copyright © 2021-2024 OCamlPro *)
+(* Written by the Owi programmers *)
+
+open Binary
+open Syntax
+open Types
+
+(* add byte from int (ascii code) *)
+let write_byte buf i =
+  let c = Char.chr (i land 0xff) in
+  Buffer.add_char buf c
+
+(* add 2 bytes (16 bits) from int *)
+let write_bytes_2 buf i =
+  write_byte buf (i land 0xff);
+  write_byte buf (i lsr 8)
+
+(* add 4 bytes (32 bits) from int32 *)
+let write_bytes_4 buf i =
+  write_bytes_2 buf (Int32.to_int (Int32.logand i 0xffffl));
+  write_bytes_2 buf (Int32.to_int (Int32.shift_right_logical i 16))
+
+(* add 8 bytes (64 bits) from int64 *)
+let write_bytes_8 buf i =
+  write_bytes_4 buf (Int64.to_int32 (Int64.logand i 0xffffffffL));
+  write_bytes_4 buf (Int64.to_int32 (Int64.shift_right i 32))
+
+let rec write_u64 buf i =
+  let b = Int64.to_int (Int64.logand i 0x7fL) in
+  if Int64.le 0L i && Int64.lt i 128L then write_byte buf b
+  else begin
+    write_byte buf (b lor 0x80);
+    write_u64 buf (Int64.shift_right_logical i 7)
+  end
+
+let write_u32 buf i =
+  write_u64 buf (Int64.logand (Int64.of_int32 i) 0xffffffffL)
+
+let write_u32_of_int buf i =
+  let i = Int32.of_int i in
+  write_u32 buf i
+
+let write_string buf str =
+  let len = String.length str in
+  write_u32_of_int buf len;
+  Buffer.add_string buf str
+
+let rec write_s64 buf i =
+  let b = Int64.to_int (Int64.logand i 0x7fL) in
+  if Int64.le (-64L) i && Int64.lt i 64L then write_byte buf b
+  else begin
+    write_byte buf (b lor 0x80);
+    write_s64 buf (Int64.shift_right i 7)
+  end
+
+let write_s32 buf i = write_s64 buf (Int64.of_int32 i)
+
+let write_f32 buf f =
+  let i32 = Float32.to_bits f in
+  write_bytes_4 buf i32
+
+let write_f64 buf f =
+  let i64 = Float64.to_bits f in
+  write_bytes_8 buf i64
+
+let write_indice buf (Raw idx : binary indice) = write_u32_of_int buf idx
+
+let write_char_indice buf c idx =
+  Buffer.add_char buf c;
+  write_indice buf idx
+
+let write_reftype buf ht =
+  match ht with
+  | Func_ht -> Buffer.add_char buf '\x70'
+  | Extern_ht -> Buffer.add_char buf '\x6F'
+  | _ -> assert false
+
+let get_char_valtype = function
+  | Num_type I32 -> '\x7F'
+  | Num_type I64 -> '\x7E'
+  | Num_type F32 -> '\x7D'
+  | Num_type F64 -> '\x7C'
+  | Ref_type (Null, Func_ht) -> '\x70'
+  | Ref_type (Null, Extern_ht) -> '\x6F'
+  | _ -> assert false (* vecttype v128 '\x7B' *)
+
+let write_valtype buf vt =
+  let c = get_char_valtype vt in
+  Buffer.add_char buf c
+
+let encode_vector buf datas encode_func =
+  let vector_buf = Buffer.create 16 in
+  let len = List.length datas in
+  List.iter (encode_func vector_buf) datas;
+  write_u32_of_int buf len;
+  Buffer.add_buffer buf vector_buf
+
+let write_resulttype buf (rt : _ result_type) =
+  encode_vector buf rt write_valtype
+
+let write_paramtype buf (pt : _ param_type) =
+  let vt = List.map snd pt in
+  write_resulttype buf vt
+
+let write_mut buf (mut : mut) =
+  let c = match mut with Const -> '\x00' | Var -> '\x01' in
+  Buffer.add_char buf c
+
+let write_block_type buf (typ : binary block_type option) =
+  match typ with
+  | None | Some (Bt_raw (None, ([], []))) -> Buffer.add_char buf '\x40'
+  | Some (Bt_raw (None, ([], [ vt ]))) -> write_valtype buf vt
+  | Some (Bt_raw (None, (pt, _))) ->
+    write_paramtype buf pt
+    (* TODO: memo
+       will this pattern matching be enough with the use of the new modul.types field?
+    *)
+  | _ -> assert false (* TODO: same, new pattern matching cases ? *)
+
+let write_block_type_idx buf (typ : binary block_type) =
+  match typ with
+  | Bt_raw (None, _) -> assert false
+  | Bt_raw (Some idx, _) -> write_indice buf idx
+
+let write_global_type buf ((mut, vt) : _ global_type) =
+  write_valtype buf vt;
+  write_mut buf mut
+
+let write_limits buf (limits : limits) =
+  match limits with
+  | { min; max = None } ->
+    Buffer.add_char buf '\x00';
+    write_u32_of_int buf min
+  | { min; max = Some max } ->
+    Buffer.add_char buf '\x01';
+    write_u32_of_int buf min;
+    write_u32_of_int buf max
+
+let write_memarg buf ({ offset; align } : memarg) =
+  write_u32 buf offset;
+  write_u32 buf align
+
+let write_memory buf ((_so, limits) : mem) = write_limits buf limits
+
+let write_memory_import buf
+  ({ Imported.modul; name; desc = limits; _ } : limits Imported.t) =
+  write_string buf modul;
+  write_string buf name;
+  Buffer.add_char buf '\x02';
+  write_limits buf limits
+
+let write_table buf ((_so, (limits, (_nullable, heaptype))) : _ table) =
+  write_reftype buf heaptype;
+  write_limits buf limits
+
+let write_table_import buf
+  ({ Imported.modul; name; desc = limits, (_nullable, heaptype); _ } :
+    _ table_type Imported.t ) =
+  write_string buf modul;
+  write_string buf name;
+  Buffer.add_char buf '\x01';
+  write_reftype buf heaptype;
+  write_limits buf limits
+
+let write_func_import buf
+  ({ Imported.modul; name; desc; _ } : binary block_type Imported.t) =
+  write_string buf modul;
+  write_string buf name;
+  Buffer.add_char buf '\x00';
+  write_block_type_idx buf desc
+
+let write_fc buf i =
+  Buffer.add_char buf '\xFC';
+  write_u32_of_int buf i
+
+let rec write_instr buf instr =
+  let add_char c = Buffer.add_char buf c in
+  match instr with
+  | Unreachable -> add_char '\x00'
+  | Nop -> add_char '\x01'
+  | Block (_str, bt, expr) ->
+    add_char '\x02';
+    write_block_type buf bt;
+    write_expr buf expr ~end_op_code:None
+  | Loop (_str, bt, expr) ->
+    add_char '\x03';
+    write_block_type buf bt;
+    write_expr buf expr ~end_op_code:None
+  | If_else (_str, bt, expr1, expr2) ->
+    add_char '\x04';
+    write_block_type buf bt;
+    begin
+      match expr2 with
+      | [] -> write_expr buf expr1 ~end_op_code:None
+      | expr2 ->
+        write_expr buf expr1 ~end_op_code:(Some '\x05');
+        write_expr buf expr2 ~end_op_code:None
+    end
+  | Br idx -> write_char_indice buf '\x0C' idx
+  | Br_if idx -> write_char_indice buf '\x0D' idx
+  | Br_table (idxs, idx) ->
+    let idxs = Array.to_list idxs in
+    add_char '\x0E';
+    encode_vector buf idxs write_indice;
+    write_indice buf idx
+  | Return -> add_char '\x0F'
+  | Call idx -> write_char_indice buf '\x10' idx
+  | Call_indirect (idx, bt) ->
+    add_char '\x11';
+    write_block_type_idx buf bt;
+    write_indice buf idx
+  | Drop -> add_char '\x1A'
+  | Select None -> add_char '\x1B'
+  | Select (Some vts) ->
+    add_char '\x1C';
+    List.iter (write_valtype buf) vts
+  | Local_get idx -> write_char_indice buf '\x20' idx
+  | Local_set idx -> write_char_indice buf '\x21' idx
+  | Local_tee idx -> write_char_indice buf '\x22' idx
+  | Global_get idx -> write_char_indice buf '\x23' idx
+  | Global_set idx -> write_char_indice buf '\x24' idx
+  | Table_get idx -> write_char_indice buf '\x25' idx
+  | Table_set idx -> write_char_indice buf '\x26' idx
+  | I_load (S32, memarg) ->
+    add_char '\x28';
+    write_memarg buf memarg
+  | I_load (S64, memarg) ->
+    add_char '\x29';
+    write_memarg buf memarg
+  | F_load (S32, memarg) ->
+    add_char '\x2A';
+    write_memarg buf memarg
+  | F_load (S64, memarg) ->
+    add_char '\x2B';
+    write_memarg buf memarg
+  | I_load8 (S32, S, memarg) ->
+    add_char '\x2C';
+    write_memarg buf memarg
+  | I_load8 (S32, U, memarg) ->
+    add_char '\x2D';
+    write_memarg buf memarg
+  | I_load16 (S32, S, memarg) ->
+    add_char '\x2E';
+    write_memarg buf memarg
+  | I_load16 (S32, U, memarg) ->
+    add_char '\x2F';
+    write_memarg buf memarg
+  | I_load8 (S64, S, memarg) ->
+    add_char '\x30';
+    write_memarg buf memarg
+  | I_load8 (S64, U, memarg) ->
+    add_char '\x31';
+    write_memarg buf memarg
+  | I_load16 (S64, S, memarg) ->
+    add_char '\x32';
+    write_memarg buf memarg
+  | I_load16 (S64, U, memarg) ->
+    add_char '\x33';
+    write_memarg buf memarg
+  | I64_load32 (S, memarg) ->
+    add_char '\x34';
+    write_memarg buf memarg
+  | I64_load32 (U, memarg) ->
+    add_char '\x35';
+    write_memarg buf memarg
+  | I_store (S32, memarg) ->
+    add_char '\x36';
+    write_memarg buf memarg
+  | I_store (S64, memarg) ->
+    add_char '\x37';
+    write_memarg buf memarg
+  | F_store (S32, memarg) ->
+    add_char '\x38';
+    write_memarg buf memarg
+  | F_store (S64, memarg) ->
+    add_char '\x39';
+    write_memarg buf memarg
+  | I_store8 (S32, memarg) ->
+    add_char '\x3A';
+    write_memarg buf memarg
+  | I_store16 (S32, memarg) ->
+    add_char '\x3B';
+    write_memarg buf memarg
+  | I_store8 (S64, memarg) ->
+    add_char '\x3C';
+    write_memarg buf memarg
+  | I_store16 (S64, memarg) ->
+    add_char '\x3D';
+    write_memarg buf memarg
+  | I64_store32 memarg ->
+    add_char '\x3E';
+    write_memarg buf memarg
+  | Memory_size ->
+    add_char '\x3F';
+    add_char '\x00'
+  | Memory_grow ->
+    add_char '\x40';
+    add_char '\x00'
+  | I32_const i ->
+    add_char '\x41';
+    write_s32 buf i
+  | I64_const i ->
+    add_char '\x42';
+    write_s64 buf i
+  | F32_const f ->
+    add_char '\x43';
+    write_f32 buf f
+  | F64_const f ->
+    add_char '\x44';
+    write_f64 buf f
+  | I_testop (S32, Eqz) -> add_char '\x45'
+  | I_relop (S32, Eq) -> add_char '\x46'
+  | I_relop (S32, Ne) -> add_char '\x47'
+  | I_relop (S32, Lt S) -> add_char '\x48'
+  | I_relop (S32, Lt U) -> add_char '\x49'
+  | I_relop (S32, Gt S) -> add_char '\x4A'
+  | I_relop (S32, Gt U) -> add_char '\x4B'
+  | I_relop (S32, Le S) -> add_char '\x4C'
+  | I_relop (S32, Le U) -> add_char '\x4D'
+  | I_relop (S32, Ge S) -> add_char '\x4E'
+  | I_relop (S32, Ge U) -> add_char '\x4F'
+  | I_testop (S64, Eqz) -> add_char '\x50'
+  | I_relop (S64, Eq) -> add_char '\x51'
+  | I_relop (S64, Ne) -> add_char '\x52'
+  | I_relop (S64, Lt S) -> add_char '\x53'
+  | I_relop (S64, Lt U) -> add_char '\x54'
+  | I_relop (S64, Gt S) -> add_char '\x55'
+  | I_relop (S64, Gt U) -> add_char '\x56'
+  | I_relop (S64, Le S) -> add_char '\x57'
+  | I_relop (S64, Le U) -> add_char '\x58'
+  | I_relop (S64, Ge S) -> add_char '\x59'
+  | I_relop (S64, Ge U) -> add_char '\x5A'
+  | F_relop (S32, Eq) -> add_char '\x5B'
+  | F_relop (S32, Ne) -> add_char '\x5C'
+  | F_relop (S32, Lt) -> add_char '\x5D'
+  | F_relop (S32, Gt) -> add_char '\x5E'
+  | F_relop (S32, Le) -> add_char '\x5F'
+  | F_relop (S32, Ge) -> add_char '\x60'
+  | F_relop (S64, Eq) -> add_char '\x61'
+  | F_relop (S64, Ne) -> add_char '\x62'
+  | F_relop (S64, Lt) -> add_char '\x63'
+  | F_relop (S64, Gt) -> add_char '\x64'
+  | F_relop (S64, Le) -> add_char '\x65'
+  | F_relop (S64, Ge) -> add_char '\x66'
+  | I_unop (S32, Clz) -> add_char '\x67'
+  | I_unop (S32, Ctz) -> add_char '\x68'
+  | I_unop (S32, Popcnt) -> add_char '\x69'
+  | I_binop (S32, Add) -> add_char '\x6A'
+  | I_binop (S32, Sub) -> add_char '\x6B'
+  | I_binop (S32, Mul) -> add_char '\x6C'
+  | I_binop (S32, Div S) -> add_char '\x6D'
+  | I_binop (S32, Div U) -> add_char '\x6E'
+  | I_binop (S32, Rem S) -> add_char '\x6F'
+  | I_binop (S32, Rem U) -> add_char '\x70'
+  | I_binop (S32, And) -> add_char '\x71'
+  | I_binop (S32, Or) -> add_char '\x72'
+  | I_binop (S32, Xor) -> add_char '\x73'
+  | I_binop (S32, Shl) -> add_char '\x74'
+  | I_binop (S32, Shr S) -> add_char '\x75'
+  | I_binop (S32, Shr U) -> add_char '\x76'
+  | I_binop (S32, Rotl) -> add_char '\x77'
+  | I_binop (S32, Rotr) -> add_char '\x78'
+  | I_unop (S64, Clz) -> add_char '\x79'
+  | I_unop (S64, Ctz) -> add_char '\x7A'
+  | I_unop (S64, Popcnt) -> add_char '\x7B'
+  | I_binop (S64, Add) -> add_char '\x7C'
+  | I_binop (S64, Sub) -> add_char '\x7D'
+  | I_binop (S64, Mul) -> add_char '\x7E'
+  | I_binop (S64, Div S) -> add_char '\x7F'
+  | I_binop (S64, Div U) -> add_char '\x80'
+  | I_binop (S64, Rem S) -> add_char '\x81'
+  | I_binop (S64, Rem U) -> add_char '\x82'
+  | I_binop (S64, And) -> add_char '\x83'
+  | I_binop (S64, Or) -> add_char '\x84'
+  | I_binop (S64, Xor) -> add_char '\x85'
+  | I_binop (S64, Shl) -> add_char '\x86'
+  | I_binop (S64, Shr S) -> add_char '\x87'
+  | I_binop (S64, Shr U) -> add_char '\x88'
+  | I_binop (S64, Rotl) -> add_char '\x89'
+  | I_binop (S64, Rotr) -> add_char '\x8A'
+  | F_unop (S32, Abs) -> add_char '\x8B'
+  | F_unop (S32, Neg) -> add_char '\x8C'
+  | F_unop (S32, Ceil) -> add_char '\x8D'
+  | F_unop (S32, Floor) -> add_char '\x8E'
+  | F_unop (S32, Trunc) -> add_char '\x8F'
+  | F_unop (S32, Nearest) -> add_char '\x90'
+  | F_unop (S32, Sqrt) -> add_char '\x91'
+  | F_binop (S32, Add) -> add_char '\x92'
+  | F_binop (S32, Sub) -> add_char '\x93'
+  | F_binop (S32, Mul) -> add_char '\x94'
+  | F_binop (S32, Div) -> add_char '\x95'
+  | F_binop (S32, Min) -> add_char '\x96'
+  | F_binop (S32, Max) -> add_char '\x97'
+  | F_binop (S32, Copysign) -> add_char '\x98'
+  | F_unop (S64, Abs) -> add_char '\x99'
+  | F_unop (S64, Neg) -> add_char '\x9A'
+  | F_unop (S64, Ceil) -> add_char '\x9B'
+  | F_unop (S64, Floor) -> add_char '\x9C'
+  | F_unop (S64, Trunc) -> add_char '\x9D'
+  | F_unop (S64, Nearest) -> add_char '\x9E'
+  | F_unop (S64, Sqrt) -> add_char '\x9F'
+  | F_binop (S64, Add) -> add_char '\xA0'
+  | F_binop (S64, Sub) -> add_char '\xA1'
+  | F_binop (S64, Mul) -> add_char '\xA2'
+  | F_binop (S64, Div) -> add_char '\xA3'
+  | F_binop (S64, Min) -> add_char '\xA4'
+  | F_binop (S64, Max) -> add_char '\xA5'
+  | F_binop (S64, Copysign) -> add_char '\xA6'
+  | I32_wrap_i64 -> add_char '\xA7'
+  | I_trunc_f (S32, S32, S) -> add_char '\xA8'
+  | I_trunc_f (S32, S32, U) -> add_char '\xA9'
+  | I_trunc_f (S32, S64, S) -> add_char '\xAA'
+  | I_trunc_f (S32, S64, U) -> add_char '\xAB'
+  | I64_extend_i32 S -> add_char '\xAC'
+  | I64_extend_i32 U -> add_char '\xAD'
+  | I_trunc_f (S64, S32, S) -> add_char '\xAE'
+  | I_trunc_f (S64, S32, U) -> add_char '\xAF'
+  | I_trunc_f (S64, S64, S) -> add_char '\xB0'
+  | I_trunc_f (S64, S64, U) -> add_char '\xB1'
+  | F_convert_i (S32, S32, S) -> add_char '\xB2'
+  | F_convert_i (S32, S32, U) -> add_char '\xB3'
+  | F_convert_i (S32, S64, S) -> add_char '\xB4'
+  | F_convert_i (S32, S64, U) -> add_char '\xB5'
+  | F32_demote_f64 -> add_char '\xB6'
+  | F_convert_i (S64, S32, S) -> add_char '\xB7'
+  | F_convert_i (S64, S32, U) -> add_char '\xB8'
+  | F_convert_i (S64, S64, S) -> add_char '\xB9'
+  | F_convert_i (S64, S64, U) -> add_char '\xBA'
+  | F64_promote_f32 -> add_char '\xBB'
+  | I_reinterpret_f (S32, S32) -> add_char '\xBC'
+  | I_reinterpret_f (S64, S64) -> add_char '\xBD'
+  | F_reinterpret_i (S32, S32) -> add_char '\xBE'
+  | F_reinterpret_i (S64, S64) -> add_char '\xBF'
+  | I_extend8_s S32 -> add_char '\xC0'
+  | I_extend16_s S32 -> add_char '\xC1'
+  | I_extend8_s S64 -> add_char '\xC2'
+  | I_extend16_s S64 -> add_char '\xC3'
+  | I64_extend32_s -> add_char '\xC4'
+  | Ref_null rt ->
+    add_char '\xD0';
+    write_reftype buf rt
+  | Ref_is_null -> add_char '\xD1'
+  | Ref_func idx -> write_char_indice buf '\xD2' idx
+  | I_trunc_sat_f (S32, S32, S) -> write_fc buf 0
+  | I_trunc_sat_f (S32, S32, U) -> write_fc buf 1
+  | I_trunc_sat_f (S32, S64, S) -> write_fc buf 2
+  | I_trunc_sat_f (S32, S64, U) -> write_fc buf 3
+  | I_trunc_sat_f (S64, S32, S) -> write_fc buf 4
+  | I_trunc_sat_f (S64, S32, U) -> write_fc buf 5
+  | I_trunc_sat_f (S64, S64, S) -> write_fc buf 6
+  | I_trunc_sat_f (S64, S64, U) -> write_fc buf 7
+  | Memory_init idx ->
+    write_fc buf 8;
+    write_indice buf idx;
+    add_char '\x00'
+  | Data_drop idx ->
+    write_fc buf 9;
+    write_indice buf idx
+  | Memory_copy ->
+    write_fc buf 10;
+    add_char '\x00';
+    add_char '\x00'
+  | Memory_fill ->
+    write_fc buf 11;
+    add_char '\x00'
+  | Table_init (tableidx, elemidx) ->
+    write_fc buf 12;
+    write_indice buf elemidx;
+    write_indice buf tableidx
+  | Elem_drop idx ->
+    write_fc buf 13;
+    write_indice buf idx
+  | Table_copy (idx1, idx2) ->
+    write_fc buf 14;
+    write_indice buf idx1;
+    write_indice buf idx2
+  | Table_grow idx ->
+    write_fc buf 15;
+    write_indice buf idx
+  | Table_size idx ->
+    write_fc buf 16;
+    write_indice buf idx
+  | Table_fill idx ->
+    write_fc buf 17;
+    write_indice buf idx
+  | I_reinterpret_f _ | F_reinterpret_i _ | Ref_i31 | Ref_as_non_null
+  | Ref_cast _ | Ref_test _ | Ref_eq | Br_on_cast _ | Br_on_cast_fail _
+  | Br_on_non_null _ | Br_on_null _ | Return_call _ | Return_call_indirect _
+  | Return_call_ref _ | Call_ref _ | Array_get _ | Array_get_u _ | Array_len
+  | Array_new _ | Array_new_data _ | Array_new_default _ | Array_new_elem _
+  | Array_new_fixed _ | Array_set _ | I31_get_u | I31_get_s | Struct_get _
+  | Struct_get_s _ | Struct_new _ | Struct_new_default _ | Struct_set _
+  | Extern_externalize | Extern_internalize ->
+    assert false
+
+and write_expr buf expr ~end_op_code =
+  List.iter (write_instr buf) expr;
+  let end_op_code = Option.value end_op_code ~default:'\x0B' in
+  Buffer.add_char buf end_op_code
+
+let write_export buf cid ({ name; id } : Binary.export) =
+  write_string buf name;
+  Buffer.add_char buf cid;
+  write_u32_of_int buf id
+
+let write_global buf ({ typ; init; _ } : global) =
+  write_global_type buf typ;
+  write_expr buf init ~end_op_code:None
+
+let write_global_import buf
+  ({ Imported.modul; name; desc = mut, valtype; _ } : _ global_type Imported.t)
+    =
+  write_string buf modul;
+  write_string buf name;
+  Buffer.add_char buf '\x03';
+  write_valtype buf valtype;
+  write_mut buf mut
+
+let write_locals buf locals =
+  let compressed =
+    List.rev
+    @@ List.fold_left
+         (fun compressed (_so, local_type) ->
+           let c = get_char_valtype local_type in
+           match compressed with
+           | (ch, cnt) :: compressed when Char.equal ch c ->
+             (c, cnt + 1) :: compressed
+           | compressed -> (c, 1) :: compressed )
+         [] locals
+  in
+  let len = List.length compressed in
+  write_u32_of_int buf len;
+  List.iter
+    (fun (char, count) ->
+      write_u32_of_int buf count;
+      Buffer.add_char buf char )
+    compressed
+
+let write_element buf ({ typ = _, ht; init; mode; _ } : elem) =
+  let write_init buf init =
+    let is_ref_func = ref true in
+    encode_vector buf init (fun buf expr ->
+        match expr with
+        | [ Ref_func idx ] -> write_indice buf idx
+        | expr ->
+          write_expr buf expr ~end_op_code:None;
+          is_ref_func := false );
+    !is_ref_func
+  in
+  match mode with
+  | Elem_passive ->
+    let elem_buf = Buffer.create 16 in
+    let is_ref_func = write_init elem_buf init in
+    if is_ref_func then begin
+      write_u32_of_int buf 1;
+      Buffer.add_char buf '\x00';
+      Buffer.add_buffer buf elem_buf
+    end
+    else begin
+      write_u32_of_int buf 5;
+      write_reftype buf ht;
+      Buffer.add_buffer buf elem_buf
+    end
+  | Elem_declarative ->
+    let elem_buf = Buffer.create 16 in
+    let is_ref_func = write_init elem_buf init in
+    if is_ref_func then begin
+      write_u32_of_int buf 3;
+      Buffer.add_char buf '\x00';
+      Buffer.add_buffer buf elem_buf
+    end
+    else begin
+      write_u32_of_int buf 7;
+      write_reftype buf ht;
+      Buffer.add_buffer buf elem_buf
+    end
+  | Elem_active (Some 0, expr) ->
+    let elem_buf = Buffer.create 16 in
+    let is_ref_func = write_init elem_buf init in
+    if is_ref_func then write_u32_of_int buf 0 else write_u32_of_int buf 4;
+    write_expr buf expr ~end_op_code:None;
+    Buffer.add_buffer buf elem_buf
+  | Elem_active (Some i, expr) ->
+    let elem_buf = Buffer.create 16 in
+    let is_ref_func = write_init elem_buf init in
+    if is_ref_func then begin
+      write_u32_of_int buf 2;
+      write_indice buf (Raw i);
+      write_expr buf expr ~end_op_code:None;
+      Buffer.add_char buf '\x00';
+      Buffer.add_buffer buf elem_buf
+    end
+    else begin
+      write_u32_of_int buf 6;
+      write_indice buf (Raw i);
+      write_expr buf expr ~end_op_code:None;
+      write_reftype buf ht;
+      Buffer.add_buffer buf elem_buf
+    end
+  | _ -> assert false
+
+let write_data buf ({ init; mode; _ } : data) =
+  match mode with
+  | Data_passive ->
+    write_u32_of_int buf 1;
+    write_string buf init
+  | Data_active (0, expr) ->
+    write_u32_of_int buf 0;
+    write_expr buf expr ~end_op_code:None;
+    write_string buf init
+  | Data_active (i, expr) ->
+    write_u32_of_int buf 2;
+    write_u32_of_int buf i;
+    write_expr buf expr ~end_op_code:None;
+    write_string buf init
+
+let encode_section buf id encode_func data =
+  let section_buf = Buffer.create 16 in
+  encode_func section_buf data;
+  let section_len = Buffer.length section_buf in
+  if section_len <> 0 then begin
+    Buffer.add_char buf id;
+    write_u32_of_int buf section_len;
+    Buffer.add_buffer buf section_buf
+  end
+
+(* type: section 1 *)
+let encode_types buf (rec_types : binary rec_type Named.t) =
+  encode_vector buf rec_types.values
+    (fun buf (typ : binary rec_type Indexed.t) ->
+      let typ = Indexed.get typ in
+      match typ with
+      | [] -> assert false
+      | _ :: _ :: _ ->
+        (* TODO rec types *)
+        assert false
+      | [ typ ] -> (
+        match typ with
+        | _name, (Final, _idx, Def_func_t (pt, rt)) ->
+          Buffer.add_char buf '\x60';
+          write_paramtype buf pt;
+          write_resulttype buf rt
+        | _ ->
+          (* TODO non final types and other type declarations *)
+          assert false ) )
+
+(* import: section 2 *)
+let encode_imports buf (funcs, tables, memories, globals) =
+  let imp_buf = Buffer.create 16 in
+  let len =
+    List.length funcs + List.length tables + List.length memories
+    + List.length globals
+  in
+  List.iter (write_func_import imp_buf) funcs;
+  List.iter (write_table_import imp_buf) tables;
+  List.iter (write_memory_import imp_buf) memories;
+  List.iter (write_global_import imp_buf) globals;
+  write_u32_of_int buf len;
+  Buffer.add_buffer buf imp_buf
+
+(* function: section 3 *)
+let encode_functions buf (funcs : binary func list) =
+  let idx = ref 0 in
+  encode_vector buf funcs (fun buf func ->
+      write_block_type_idx buf func.type_f;
+      incr idx )
+
+(* table: section 4 *)
+let encode_tables buf tables = encode_vector buf tables write_table
+
+(* memory: section 5 *)
+let encode_memories buf memories = encode_vector buf memories write_memory
+
+(* global: section 6 *)
+let encode_globals buf globals =
+  let globals = List.rev globals in
+  encode_vector buf globals write_global
+
+(* export: section 7 *)
+let encode_exports buf ({ global; mem; table; func } : exports) =
+  let exp_buf = Buffer.create 16 in
+  let len =
+    List.length global + List.length mem + List.length table + List.length func
+  in
+  let global = List.rev global in
+  let mem = List.rev mem in
+  let table = List.rev table in
+  let func = List.rev func in
+  List.iter (write_export exp_buf '\x03') global;
+  List.iter (write_export exp_buf '\x02') mem;
+  List.iter (write_export exp_buf '\x01') table;
+  List.iter (write_export exp_buf '\x00') func;
+  write_u32_of_int buf len;
+  Buffer.add_buffer buf exp_buf
+
+(* start: section 8 *)
+let encode_start buf int_opt =
+  match int_opt with None -> () | Some funcidx -> write_u32_of_int buf funcidx
+
+(* element: section 9 *)
+let encode_elements buf { Named.values = elems; _ } =
+  encode_vector buf elems (fun buf elem ->
+      let elem = Indexed.get elem in
+      write_element buf elem )
+
+(* datacount: section 12 *)
+let encode_datacount buf { Named.values = datas; _ } =
+  let len = List.length datas in
+  write_u32_of_int buf len
+
+(* code: section 10 *)
+let encode_codes buf funcs =
+  encode_vector buf funcs (fun buf { locals; body; _ } ->
+      let code_buf = Buffer.create 16 in
+      write_locals code_buf locals;
+      write_expr code_buf body ~end_op_code:None;
+      write_u32_of_int buf (Buffer.length code_buf);
+      Buffer.add_buffer buf code_buf )
+
+(* data: section 11 *)
+let encode_datas buf { Named.values = datas; _ } =
+  encode_vector buf datas (fun buf data ->
+      let data = Indexed.get data in
+      write_data buf data )
+
+let keep_local { Named.values; _ } =
+  List.filter_map
+    (fun data ->
+      match Indexed.get data with
+      | Runtime.Local data -> Some data
+      | Runtime.Imported _data -> None )
+    (List.rev values)
+
+let keep_imported { Named.values; _ } =
+  List.filter_map
+    (fun data ->
+      match Indexed.get data with
+      | Runtime.Local _data -> None
+      | Runtime.Imported data -> Some data )
+    (List.rev values)
+
+let encode (modul : Binary.modul) =
+  let buf = Buffer.create 256 in
+  let local_funcs = keep_local modul.func in
+  let local_tables = keep_local modul.table in
+  let local_memories = keep_local modul.mem in
+  let local_globales = keep_local modul.global in
+  let imported_funcs = keep_imported modul.func in
+  let imported_tables = keep_imported modul.table in
+  let imported_memories = keep_imported modul.mem in
+  let imported_globals = keep_imported modul.global in
+  Buffer.add_string buf "\x00\x61\x73\x6d";
+  (* magic *)
+  Buffer.add_string buf "\x01\x00\x00\x00";
+  (* version *)
+  encode_section buf '\x01' encode_types modul.types;
+  encode_section buf '\x02' encode_imports
+    (imported_funcs, imported_tables, imported_memories, imported_globals);
+  encode_section buf '\x03' encode_functions local_funcs;
+  encode_section buf '\x04' encode_tables local_tables;
+  encode_section buf '\x05' encode_memories local_memories;
+  encode_section buf '\x06' encode_globals local_globales;
+  encode_section buf '\x07' encode_exports modul.exports;
+  encode_section buf '\x08' encode_start modul.start;
+  encode_section buf '\x09' encode_elements modul.elem;
+  encode_section buf '\x0C' encode_datacount modul.data;
+  encode_section buf '\x0A' encode_codes local_funcs;
+  encode_section buf '\x0B' encode_datas modul.data;
+  Buffer.contents buf
+
+let write_file filename content =
+  let _dir, filename = Fpath.split_base filename in
+  let filename, _ext = Fpath.split_ext filename in
+  let filename = Fpath.add_ext ".wasm" filename in
+  let filename = Fpath.to_string filename in
+  let oc = Out_channel.open_bin filename in
+  Out_channel.output_string oc content;
+  Out_channel.close oc
+
+let convert (filename : Fpath.t) ~unsafe ~optimize m =
+  Log.debug0 "bin encoding ...@\n";
+  let+ m = Compile.Text.until_optimize ~unsafe ~optimize m in
+  let content = encode m in
+  write_file filename content
+

+      

+    

+    
+  
+
diff --git a/coverage/src/ast/binary_to_text.ml.html b/coverage/src/ast/binary_to_text.ml.html
new file mode 100644
index 000000000..56a0a8e33
--- /dev/null
+++ b/coverage/src/ast/binary_to_text.ml.html
@@ -0,0 +1,865 @@
+
+
+  
+    
+    binary_to_text.ml — Coverage report
+    
+    
+    
+    
+  
+  
+    
+    
+    

+      

+        
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+

+      

+      

+        
+  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
+232
+233
+234
+235
+236
+237
+238
+239
+240
+241
+242
+243
+244
+245
+246
+247
+248
+249
+250
+251
+252
+253
+254
+255
+256
+257
+258
+259
+260
+261
+262
+263
+264
+265
+266
+267
+268
+

+
(* SPDX-License-Identifier: AGPL-3.0-or-later *)
+(* Copyright © 2021-2024 OCamlPro *)
+(* Written by the Owi programmers *)
+
+open Binary
+open Text
+open Types
+
+let convert_indice (t : binary indice) : text indice =
+  match t with Raw _ as t -> t
+
+let convert_heap_type (t : binary heap_type) : text heap_type =
+  match t with
+  | ( Any_ht | None_ht | Eq_ht | I31_ht | Struct_ht | Array_ht | Func_ht
+    | No_func_ht | Extern_ht | No_extern_ht ) as t ->
+    t
+  | Def_ht id -> Def_ht (convert_indice id)
+
+let convert_ref_type (t : binary ref_type) : text ref_type =
+  let nullable, heap_type = t in
+  (nullable, convert_heap_type heap_type)
+
+let convert_val_type (t : binary val_type) : text val_type =
+  match t with
+  | Num_type _ as t -> t
+  | Ref_type t -> Ref_type (convert_ref_type t)
+
+let convert_global_type (t : binary global_type) : text global_type =
+  let mut, vt = t in
+  (mut, convert_val_type vt)
+
+let convert_param (p : binary param) : text param =
+  let id, vt = p in
+  (id, convert_val_type vt)
+
+let convert_param_type (pt : binary param_type) : text param_type =
+  List.map convert_param pt
+
+let convert_result_type (rt : binary result_type) : text result_type =
+  List.map convert_val_type rt
+
+let convert_func_type ((pt, rt) : binary func_type) : text func_type =
+  (convert_param_type pt, convert_result_type rt)
+
+let convert_block_type (bt : binary block_type) : text block_type =
+  match bt with
+  | Bt_raw (opt, ft) ->
+    let opt =
+      match opt with None -> None | Some i -> Some (convert_indice i)
+    in
+    let ft = convert_func_type ft in
+    Bt_raw (opt, ft)
+
+let convert_storage_type (t : binary storage_type) : text storage_type =
+  match t with
+  | Val_storage_t vt -> Val_storage_t (convert_val_type vt)
+  | Val_packed_t _ as t -> t
+
+let convert_field_type ((m, t) : binary field_type) : text field_type =
+  (m, convert_storage_type t)
+
+let convert_struct_field ((name, field_types) : binary struct_field) :
+  text struct_field =
+  (name, List.map convert_field_type field_types)
+
+let convert_struct_type (t : binary struct_type) : text struct_type =
+  List.map convert_struct_field t
+
+let convert_str_type (str_t : binary str_type) : text str_type =
+  match str_t with
+  | Def_struct_t t -> Def_struct_t (convert_struct_type t)
+  | Def_array_t t -> Def_array_t (convert_field_type t)
+  | Def_func_t t -> Def_func_t (convert_func_type t)
+
+let convert_sub_type ((final, indices, str_type) : binary sub_type) :
+  text sub_type =
+  (final, List.map convert_indice indices, convert_str_type str_type)
+
+let convert_type_def ((name, sub_type) : binary type_def) : text type_def =
+  (name, convert_sub_type sub_type)
+
+let convert_rec_type (t : binary rec_type) : text rec_type =
+  List.map convert_type_def t
+
+let convert_expr (e : binary expr) : text expr =
+  (* TODO: proper conversion ! *)
+  Obj.magic e
+
+let convert_table_type (t : binary table_type) : text table_type =
+  let limits, t = t in
+  (limits, convert_ref_type t)
+
+let convert_table (t : binary table) : text table =
+  let id, t = t in
+  (id, convert_table_type t)
+
+let convert_elem_mode (e : Binary.elem_mode) : Text.elem_mode =
+  match e with
+  | Elem_passive -> Elem_passive
+  | Elem_declarative -> Elem_declarative
+  | Elem_active (opt, e) ->
+    let opt = Option.map (fun i -> Raw i) opt in
+    let e = convert_expr e in
+    Elem_active (opt, e)
+
+let convert_elem (e : Binary.elem) : Text.elem =
+  let { Binary.id; typ; init; mode } = e in
+  let typ = convert_ref_type typ in
+  let init = List.map convert_expr init in
+  let mode = convert_elem_mode mode in
+  { id; typ; init; mode }
+
+let convert_data_mode (m : Binary.data_mode) : Text.data_mode =
+  match m with
+  | Data_passive -> Data_passive
+  | Data_active (i, e) ->
+    let e = convert_expr e in
+    Data_active (Some (Raw i), e)
+
+let convert_data (e : Binary.data) : Text.data =
+  let { Binary.id; init; mode } : Binary.data = e in
+  let mode = convert_data_mode mode in
+  { id; init; mode }
+
+let from_types (types : Types.binary Types.rec_type Named.t) :
+  Text.module_field list =
+  Named.fold
+    (fun i (t : Types.binary Types.rec_type) acc ->
+      let t = convert_rec_type t in
+      (i, MType t) :: acc )
+    types []
+  |> List.sort (fun (i1, _t1) (i2, _t2) -> Int.compare i1 i2)
+  |> List.map snd
+
+let from_global (global : (Binary.global, binary global_type) Runtime.t Named.t)
+  : Text.module_field list =
+  Named.fold
+    (fun i (g : (Binary.global, binary global_type) Runtime.t) acc ->
+      match g with
+      | Runtime.Local g ->
+        let typ = convert_global_type g.typ in
+        let init = convert_expr g.init in
+        let id = g.id in
+        (i, MGlobal { typ; init; id }) :: acc
+      | Imported { modul; name; assigned_name; desc } ->
+        let desc = Import_global (assigned_name, convert_global_type desc) in
+        (i, MImport { modul; name; desc }) :: acc )
+    global []
+  |> List.sort (fun (i1, _t1) (i2, _t2) -> Int.compare i1 i2)
+  |> List.map snd
+
+let from_table (table : (binary table, binary table_type) Runtime.t Named.t) :
+  Text.module_field list =
+  Named.fold
+    (fun i (t : (binary table, binary table_type) Runtime.t) acc ->
+      match t with
+      | Runtime.Local t ->
+        let t = convert_table t in
+        (i, MTable t) :: acc
+      | Imported { modul; name; assigned_name; desc } ->
+        let desc = Import_table (assigned_name, convert_table_type desc) in
+        (i, MImport { modul; name; desc }) :: acc )
+    table []
+  |> List.sort (fun (i1, _t1) (i2, _t2) -> Int.compare i1 i2)
+  |> List.map snd
+
+let from_mem (mem : (mem, limits) Runtime.t Named.t) : Text.module_field list =
+  Named.fold
+    (fun i mem acc ->
+      match mem with
+      | Runtime.Local mem -> (i, MMem mem) :: acc
+      | Imported { modul; name; assigned_name; desc } ->
+        let desc = Import_mem (assigned_name, desc) in
+        (i, MImport { modul; name; desc }) :: acc )
+    mem []
+  |> List.sort (fun (i1, _t1) (i2, _t2) -> Int.compare i1 i2)
+  |> List.map snd
+
+let from_func (func : (binary func, binary block_type) Runtime.t Named.t) :
+  Text.module_field list =
+  Named.fold
+    (fun i (func : (binary func, binary block_type) Runtime.t) acc ->
+      match func with
+      | Runtime.Local func ->
+        let type_f = convert_block_type func.type_f in
+        let locals = convert_param_type func.locals in
+        let body = convert_expr func.body in
+        let id = func.id in
+        (i, MFunc { type_f; locals; body; id }) :: acc
+      | Imported { modul; name; assigned_name; desc } ->
+        let desc = Import_func (assigned_name, convert_block_type desc) in
+        (i, MImport { modul; name; desc }) :: acc )
+    func []
+  |> List.sort (fun (i1, _t1) (i2, _t2) -> Int.compare i1 i2)
+  |> List.map snd
+
+let from_elem (elem : Binary.elem Named.t) : Text.module_field list =
+  Named.fold
+    (fun i (elem : Binary.elem) acc ->
+      let elem = convert_elem elem in
+      (i, MElem elem) :: acc )
+    elem []
+  |> List.sort (fun (i1, _t1) (i2, _t2) -> Int.compare i1 i2)
+  |> List.map snd
+
+let from_data (data : Binary.data Named.t) : Text.module_field list =
+  Named.fold
+    (fun i (data : Binary.data) acc ->
+      let data = convert_data data in
+      (i, MData data) :: acc )
+    data []
+  |> List.sort (fun (i1, _t1) (i2, _t2) -> Int.compare i1 i2)
+  |> List.map snd
+
+let from_exports (exports : Binary.exports) : Text.module_field list =
+  let global =
+    List.map
+      (fun { name; id } ->
+        let id = Some (Raw id) in
+        MExport { name; desc = Export_global id } )
+      exports.global
+  in
+
+  let mem =
+    List.map
+      (fun { name; id } ->
+        let id = Some (Raw id) in
+        MExport { name; desc = Export_mem id } )
+      exports.mem
+  in
+
+  let table =
+    List.map
+      (fun { name; id } ->
+        let id = Some (Raw id) in
+        MExport { name; desc = Export_table id } )
+      exports.table
+  in
+
+  let func =
+    List.map
+      (fun { name; id } ->
+        let id = Some (Raw id) in
+        MExport { name; desc = Export_func id } )
+      exports.func
+  in
+
+  global @ mem @ table @ func
+
+let from_start = function None -> [] | Some n -> [ MStart (Raw n) ]
+
+let modul
+  { Binary.id; types; global; table; mem; func; elem; data; start; exports } =
+  let fields =
+    from_types types @ from_global global @ from_table table @ from_mem mem
+    @ from_func func @ from_elem elem @ from_data data @ from_exports exports
+    @ from_start start
+  in
+  let imported, locals =
+    List.partition_map
+      (function
+        | MImport _ as import -> Either.Left import
+        | local -> Either.Right local )
+      fields
+  in
+  let fields = imported @ locals in
+
+  { Text.id; fields }
+

+      

+    

+    
+  
+
diff --git a/coverage/src/ast/binary_types.ml.html b/coverage/src/ast/binary_types.ml.html
index 301511d08..385bc0525 100644
--- a/coverage/src/ast/binary_types.ml.html
+++ b/coverage/src/ast/binary_types.ml.html
@@ -3,7 +3,7 @@
   
     
     binary_types.ml — Coverage report
-    
+    
     
     
     
@@ -15,12 +15,19 @@ 

           src/ast/binary_types.ml
         
       

-      
95.52%

+      
77.05%
@@ -33,82 +40,75 @@

95.52%

- - - - - + + + + + - + - - - - - - + + + + + + - - - - - - - - - + + + + + + + + + - + - + - - + + - + - + - - - + + + - - + + - + - - + + - + - + - + - - - - + + + + - - + + - - - - - - -
@@ -190,13 +190,6 @@

95.52%

75 76 77 -78 -79 -80 -81 -82 -83 -84 
(* SPDX-License-Identifier: AGPL-3.0-or-later *)
 (* Copyright © 2021-2024 OCamlPro *)
@@ -205,83 +198,76 @@ 
95.52%

 open Types
 open Syntax
 
-let equal_func_types (a : binary func_type) (b : binary func_type) : bool =
-  let remove_param (pt, rt) =
-    let pt = List.map (fun (_id, vt) -> (None, vt)) pt in
-    (pt, rt)
-  in
-  remove_param a = remove_param b
-
 type tbl = (string, int) Hashtbl.t Option.t
 
 let convert_heap_type tbl = function
-  | ( Any_ht | None_ht | Eq_ht | I31_ht | Struct_ht | Array_ht | Func_ht
-    | No_func_ht | Extern_ht | No_extern_ht
-    | Def_ht (Raw _) ) as t ->
+  | ( Any_ht | None_ht | Eq_ht | I31_ht | Struct_ht | Array_ht | Func_ht
+    | No_func_ht | Extern_ht | No_extern_ht
+    | Def_ht (Raw _) ) as t ->
     Ok t
-  | Def_ht (Text i) -> begin
+  | Def_ht (Text i) -> begin
     match tbl with
-    | None -> Error `Unknown_type
+    | None -> Error (`Unknown_type (Text i))
     | Some tbl -> begin
       match Hashtbl.find_opt tbl i with
-      | None -> Error `Unknown_type
+      | None -> Error (`Unknown_type (Text i))
       | Some i -> ok @@ Def_ht (Raw i)
     end
   end
 
 let convert_ref_type tbl (null, heap_type) =
-  let+ heap_type = convert_heap_type tbl heap_type in
-  (null, heap_type)
+  let+ heap_type = convert_heap_type tbl heap_type in
+  (null, heap_type)
 
-let convert_val_type tbl : text val_type -> binary val_type Result.t = function
-  | Num_type _t as t -> Ok t
-  | Ref_type rt ->
-    let+ rt = convert_ref_type tbl rt in
-    Ref_type rt
+let convert_val_type tbl : text val_type -> binary val_type Result.t = function
+  | Num_type _t as t -> Ok t
+  | Ref_type rt ->
+    let+ rt = convert_ref_type tbl rt in
+    Ref_type rt
 
 let convert_param tbl (n, t) =
-  let+ t = convert_val_type tbl t in
-  (n, t)
+  let+ t = convert_val_type tbl t in
+  (n, t)
 
-let convert_pt tbl l = list_map (convert_param tbl) l
+let convert_pt tbl l = list_map (convert_param tbl) l
 
-let convert_rt tbl l = list_map (convert_val_type tbl) l
+let convert_rt tbl l = list_map (convert_val_type tbl) l
 
 let convert_func_type tbl (pt, rt) =
-  let* pt = convert_pt tbl pt in
-  let+ rt = convert_rt tbl rt in
-  (pt, rt)
+  let* pt = convert_pt tbl pt in
+  let+ rt = convert_rt tbl rt in
+  (pt, rt)
 
 let convert_storage_type tbl = function
-  | Val_storage_t val_type ->
-    let+ val_type = convert_val_type tbl val_type in
-    Val_storage_t val_type
-  | Val_packed_t _packed_type as t -> Ok t
+  | Val_storage_t val_type ->
+    let+ val_type = convert_val_type tbl val_type in
+    Val_storage_t val_type
+  | Val_packed_t _packed_type as t -> Ok t
 
 let convert_field_type tbl (mut, storage_type) =
-  let+ storage_type = convert_storage_type tbl storage_type in
-  (mut, storage_type)
+  let+ storage_type = convert_storage_type tbl storage_type in
+  (mut, storage_type)
 
 let convert_struct_field tbl (id, types) =
-  let+ types = list_map (convert_field_type tbl) types in
-  (id, types)
+  let+ types = list_map (convert_field_type tbl) types in
+  (id, types)
 
-let convert_struct_type tbl fields = list_map (convert_struct_field tbl) fields
+let convert_struct_type tbl fields = list_map (convert_struct_field tbl) fields
 
 let convert_str tbl = function
-  | Def_func_t func_t ->
-    let+ func_t = convert_func_type tbl func_t in
-    Def_func_t func_t
-  | Def_array_t field_t ->
-    let+ field_t = convert_field_type tbl field_t in
-    Def_array_t field_t
-  | Def_struct_t struct_t ->
-    let+ struct_t = convert_struct_type tbl struct_t in
-    Def_struct_t struct_t
+  | Def_func_t func_t ->
+    let+ func_t = convert_func_type tbl func_t in
+    Def_func_t func_t
+  | Def_array_t field_t ->
+    let+ field_t = convert_field_type tbl field_t in
+    Def_array_t field_t
+  | Def_struct_t struct_t ->
+    let+ struct_t = convert_struct_type tbl struct_t in
+    Def_struct_t struct_t
 
 let convert_table_type tbl (limits, ref_type) =
-  let+ ref_type = convert_ref_type tbl ref_type in
-  (limits, ref_type)
+  let+ ref_type = convert_ref_type tbl ref_type in
+  (limits, ref_type)
diff --git a/coverage/src/ast/compile.ml.html b/coverage/src/ast/compile.ml.html new file mode 100644 index 000000000..113b1c85d --- /dev/null +++ b/coverage/src/ast/compile.ml.html @@ -0,0 +1,391 @@ + + + + + compile.ml — Coverage report + + + + + + + + +
+
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+
+
+
+ 
+  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
+
+
(* SPDX-License-Identifier: AGPL-3.0-or-later *)
+(* Copyright © 2021-2024 OCamlPro *)
+(* Written by the Owi programmers *)
+
+open Syntax
+
+module Text = struct
+  let until_check ~unsafe m = if unsafe then Ok m else Check.modul m
+
+  let until_group ~unsafe m =
+    let* m = until_check ~unsafe m in
+    Grouped.of_symbolic m
+
+  let until_assign ~unsafe m =
+    let* m = until_group ~unsafe m in
+    Assigned.of_grouped m
+
+  let until_binary ~unsafe m =
+    let* m = until_assign ~unsafe m in
+    Rewrite.modul m
+
+  let until_typecheck ~unsafe m =
+    let* m = until_binary ~unsafe m in
+    if unsafe then Ok m
+    else
+      let+ () = Typecheck.modul m in
+      m
+
+  let until_optimize ~unsafe ~optimize m =
+    let+ m = until_typecheck ~unsafe m in
+    if optimize then Optimize.modul m else m
+
+  let until_link ~unsafe ~optimize ~name link_state m =
+    let* m = until_optimize ~unsafe ~optimize m in
+    Link.modul link_state ~name m
+
+  let until_interpret ~unsafe ~optimize ~name link_state m =
+    let* m, link_state = until_link ~unsafe ~optimize ~name link_state m in
+    let+ () = Interpret.Concrete.modul link_state.envs m in
+    link_state
+end
+
+module Binary = struct
+  let until_typecheck ~unsafe m =
+    if unsafe then Ok m
+    else
+      let+ () = Typecheck.modul m in
+      m
+
+  let until_optimize ~unsafe ~optimize m =
+    let+ m = until_typecheck ~unsafe m in
+    if optimize then Optimize.modul m else m
+
+  let until_link ~unsafe ~optimize ~name link_state m =
+    let* m = until_optimize ~unsafe ~optimize m in
+    Link.modul link_state ~name m
+
+  let until_interpret ~unsafe ~optimize ~name link_state m =
+    let* m, link_state = until_link ~unsafe ~optimize ~name link_state m in
+    let+ () = Interpret.Concrete.modul link_state.envs m in
+    link_state
+end
+
+module Any = struct
+  let until_typecheck ~unsafe = function
+    | Kind.Wat m -> Text.until_typecheck ~unsafe m
+    | Wasm m -> Binary.until_typecheck ~unsafe m
+    | Wast _ | Ocaml _ -> assert false
+
+  let until_optimize ~unsafe ~optimize = function
+    | Kind.Wat m -> Text.until_optimize ~unsafe ~optimize m
+    | Wasm m -> Binary.until_optimize ~unsafe ~optimize m
+    | Wast _ | Ocaml _ -> assert false
+
+  let until_link ~unsafe ~optimize ~name link_state = function
+    | Kind.Wat m -> Text.until_link ~unsafe ~optimize ~name link_state m
+    | Wasm m -> Binary.until_link ~unsafe ~optimize ~name link_state m
+    | Wast _ | Ocaml _ -> assert false
+
+  let until_interpret ~unsafe ~optimize ~name link_state = function
+    | Kind.Wat m -> Text.until_interpret ~unsafe ~optimize ~name link_state m
+    | Wasm m -> Binary.until_interpret ~unsafe ~optimize ~name link_state m
+    | Wast _ | Ocaml _ -> assert false
+end
+
+module File = struct
+  let until_typecheck ~unsafe filename =
+    let* m = Parse.guess_from_file filename in
+    match m with
+    | Kind.Wat m -> Text.until_typecheck ~unsafe m
+    | Wasm m -> Binary.until_typecheck ~unsafe m
+    | Wast _ | Ocaml _ -> assert false
+
+  let until_optimize ~unsafe ~optimize filename =
+    let* m = Parse.guess_from_file filename in
+    match m with
+    | Kind.Wat m -> Text.until_optimize ~unsafe ~optimize m
+    | Wasm m -> Binary.until_optimize ~unsafe ~optimize m
+    | Wast _ | Ocaml _ -> assert false
+
+  let until_link ~unsafe ~optimize ~name link_state filename =
+    let* m = Parse.guess_from_file filename in
+    match m with
+    | Kind.Wat m -> Text.until_link ~unsafe ~optimize ~name link_state m
+    | Wasm m -> Binary.until_link ~unsafe ~optimize ~name link_state m
+    | Wast _ | Ocaml _ -> assert false
+
+  let until_interpret ~unsafe ~optimize ~name link_state filename =
+    let* m = Parse.guess_from_file filename in
+    match m with
+    | Kind.Wat m -> Text.until_interpret ~unsafe ~optimize ~name link_state m
+    | Wasm m -> Binary.until_interpret ~unsafe ~optimize ~name link_state m
+    | Wast _ | Ocaml _ -> assert false
+end
+
+
+
+ + + diff --git a/coverage/src/ast/kind.ml.html b/coverage/src/ast/kind.ml.html new file mode 100644 index 000000000..be9c658e4 --- /dev/null +++ b/coverage/src/ast/kind.ml.html @@ -0,0 +1,62 @@ + + + + + kind.ml — Coverage report + + + + + + + + +
+
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+
+
+
+ 
+1
+2
+3
+4
+5
+6
+7
+8
+9
+
+
(* SPDX-License-Identifier: AGPL-3.0-or-later *)
+(* Copyright © 2021-2024 OCamlPro *)
+(* Written by the Owi programmers *)
+
+type 'extern_func t =
+  | Wat of Text.modul
+  | Wast of Text.script
+  | Wasm of Binary.modul
+  | Ocaml of 'extern_func Link.extern_module
+
+
+
+ + + diff --git a/coverage/src/ast/text.ml.html b/coverage/src/ast/text.ml.html index f0aaf213d..b036a4cf8 100644 --- a/coverage/src/ast/text.ml.html +++ b/coverage/src/ast/text.ml.html @@ -3,7 +3,7 @@ text.ml — Coverage report - + @@ -15,32 +15,30 @@

src/ast/text.ml

-

56.14%

+

61.02%

@@ -75,7 +73,7 @@

56.14%

- + @@ -85,7 +83,7 @@

56.14%

- + @@ -134,9 +132,9 @@

56.14%

- + - + @@ -231,14 +229,18 @@

56.14%

- - + + - - - - + + + + + + + +
@@ -437,21 +439,25 @@

56.14%

192 193 194 +195 +196 +197 +198 
(* SPDX-License-Identifier: AGPL-3.0-or-later *)
 (* Copyright © 2021-2024 OCamlPro *)
 (* Written by the Owi programmers *)
 
-open Format
+open Fmt
 open Types
 
-let symbolic v = Text v
+let symbolic v = Text v
 
-let raw v = Raw v
+let raw v = Raw v
 
-let bt_ind i = Bt_ind i
+let bt_ind i = Bt_ind i
 
-let bt_raw i t = Bt_raw (i, t)
+let bt_raw i t = Bt_raw (i, t)
 
 type global =
   { typ : text global_type
@@ -460,7 +466,7 @@ 
56.14%

   }
 
 let pp_global fmt (g : global) =
-  pp fmt "(global%a %a %a)" pp_id_opt g.id pp_global_type g.typ pp_expr g.init
+  pf fmt "(global%a %a %a)" pp_id_opt g.id pp_global_type g.typ pp_expr g.init
 
 type data_mode =
   | Data_passive
@@ -468,8 +474,8 @@ 
56.14%

 
 let pp_data_mode fmt = function
   | Data_passive -> ()
-  | Data_active (i, e) ->
-    pp fmt "(memory %a) (offset %a)" pp_indice_opt i pp_expr e
+  | Data_active (i, e) ->
+    pf fmt "(memory %a) (offset %a)" pp_indice_opt i pp_expr e
 
 type data =
   { id : string option
@@ -478,7 +484,7 @@ 
56.14%

   }
 
 let pp_data fmt (d : data) =
-  pp fmt {|(data%a %a %S)|} pp_id_opt d.id pp_data_mode d.mode d.init
+  pf fmt {|(data%a %a %S)|} pp_id_opt d.id pp_data_mode d.mode d.init
 
 type elem_mode =
   | Elem_passive
@@ -487,11 +493,11 @@ 
56.14%

 
 let pp_elem_mode fmt = function
   | Elem_passive -> ()
-  | Elem_declarative -> pp fmt "declare"
-  | Elem_active (i, e) -> (
+  | Elem_declarative -> pf fmt "declare"
+  | Elem_active (i, e) -> (
     match i with
-    | None -> pp fmt "(offset %a)" pp_expr e
-    | Some i -> pp fmt "(table %a) (offset %a)" pp_indice i pp_expr e )
+    | None -> pf fmt "(offset %a)" pp_expr e
+    | Some i -> pf fmt "(table %a) (offset %a)" pp_indice i pp_expr e )
 
 type elem =
   { id : string option
@@ -500,12 +506,12 @@ 
56.14%

   ; mode : elem_mode
   }
 
-let pp_elem_expr fmt e = pp fmt "(item %a)" pp_expr e
+let pp_elem_expr fmt e = pf fmt "(item %a)" pp_expr e
 
 let pp_elem fmt (e : elem) =
-  pp fmt "@[<hov 2>(elem%a %a %a %a)@]" pp_id_opt e.id pp_elem_mode e.mode
+  pf fmt "@[<hov 2>(elem%a %a %a %a)@]" pp_id_opt e.id pp_elem_mode e.mode
     pp_ref_type e.typ
-    (pp_list ~pp_sep:pp_newline pp_elem_expr)
+    (list ~sep:pp_newline pp_elem_expr)
     e.init
 
 type module_field =
@@ -521,16 +527,16 @@ 
56.14%

   | MExport of text export
 
 let pp_module_field fmt = function
-  | MType t -> pp_rec_type fmt t
-  | MGlobal g -> pp_global fmt g
-  | MTable t -> pp_table fmt t
-  | MMem m -> pp_mem fmt m
-  | MFunc f -> pp_func fmt f
-  | MElem e -> pp_elem fmt e
-  | MData d -> pp_data fmt d
-  | MStart s -> pp_start fmt s
-  | MImport i -> pp_import fmt i
-  | MExport e -> pp_export fmt e
+  | MType t -> pp_rec_type fmt t
+  | MGlobal g -> pp_global fmt g
+  | MTable t -> pp_table fmt t
+  | MMem m -> pp_mem fmt m
+  | MFunc f -> pp_func fmt f
+  | MElem e -> pp_elem fmt e
+  | MData d -> pp_data fmt d
+  | MStart s -> pp_start fmt s
+  | MImport i -> pp_import fmt i
+  | MExport e -> pp_export fmt e
 
 type modul =
   { id : string option
@@ -538,8 +544,8 @@ 
56.14%

   }
 
 let pp_modul fmt (m : modul) =
-  pp fmt "(module%a@\n  @[<v>%a@]@\n)" pp_id_opt m.id
-    (pp_list ~pp_sep:pp_newline pp_module_field)
+  pf fmt "(module%a@\n  @[<v>%a@]@\n)" pp_id_opt m.id
+    (list ~sep:pp_newline pp_module_field)
     m.fields
 
 type action =
@@ -548,8 +554,8 @@ 
56.14%

 
 let pp_action fmt = function
   | Invoke (mod_name, name, c) ->
-    pp fmt {|(invoke%a "%s" %a)|} pp_id_opt mod_name name pp_consts c
-  | Get _ -> pp fmt "<action_get TODO>"
+    pf fmt {|(invoke%a "%s" %a)|} pp_id_opt mod_name name pp_consts c
+  | Get _ -> pf fmt "<action_get TODO>"
 
 type result_const =
   | Literal of text const
@@ -558,8 +564,8 @@ 
56.14%

 
 let pp_result_const fmt = function
   | Literal c -> pp_const fmt c
-  | Nan_canon n -> pp fmt "float%a.const nan:canonical" pp_nn n
-  | Nan_arith n -> pp fmt "float%a.const nan:arithmetic" pp_nn n
+  | Nan_canon n -> pf fmt "f%a.const nan:canonical" pp_nn n
+  | Nan_arith n -> pf fmt "f%a.const nan:arithmetic" pp_nn n
 
 type result =
   | Result_const of result_const
@@ -567,14 +573,14 @@ 
56.14%

   | Result_func_ref
 
 let pp_result fmt = function
-  | Result_const c -> pp fmt "(%a)" pp_result_const c
+  | Result_const c -> pf fmt "(%a)" pp_result_const c
   | Result_func_ref | Result_extern_ref -> Log.err "not yet implemented"
 
 let pp_result_bis fmt = function
-  | Result_const c -> pp fmt "%a" pp_result_const c
+  | Result_const c -> pf fmt "%a" pp_result_const c
   | Result_extern_ref | Result_func_ref -> Log.err "not yet implemented"
 
-let pp_results fmt r = pp_list ~pp_sep:pp_space pp_result_bis fmt r
+let pp_results fmt r = list ~sep:sp pp_result_bis fmt r
 
 type assertion =
   | Assert_return of action * result list
@@ -591,47 +597,51 @@ 
56.14%

 
 let pp_assertion fmt = function
   | Assert_return (a, l) ->
-    pp fmt "(assert_return %a %a)" pp_action a pp_results l
+    pf fmt "(assert_return %a %a)" pp_action a pp_results l
   | Assert_exhaustion (a, msg) ->
-    pp fmt "(assert_exhaustion %a %s)" pp_action a msg
-  | Assert_trap (a, f) -> pp fmt {|(assert_trap %a "%s")|} pp_action a f
+    pf fmt "(assert_exhaustion %a %s)" pp_action a msg
+  | Assert_trap (a, f) -> pf fmt {|(assert_trap %a "%s")|} pp_action a f
   | Assert_trap_module (m, f) ->
-    pp fmt {|(assert_trap_module %a "%s")|} pp_modul m f
+    pf fmt {|(assert_trap_module %a "%s")|} pp_modul m f
   | Assert_invalid (m, msg) ->
-    pp fmt "(assert_invalid@\n  @[<v>%a@]@\n  @[<v>%S@]@\n)" pp_modul m msg
+    pf fmt "(assert_invalid@\n  @[<v>%a@]@\n  @[<v>%S@]@\n)" pp_modul m msg
   | Assert_unlinkable (m, msg) ->
-    pp fmt "(assert_unlinkable@\n  @[<v>%a@]@\n  @[<v>%S@]@\n)" pp_modul m msg
+    pf fmt "(assert_unlinkable@\n  @[<v>%a@]@\n  @[<v>%S@]@\n)" pp_modul m msg
   | Assert_malformed (m, msg) ->
-    pp fmt "(assert_malformed (module binary@\n  @[<v>%a@])@\n  @[<v>%S@]@\n)"
+    pf fmt "(assert_malformed (module binary@\n  @[<v>%a@])@\n  @[<v>%S@]@\n)"
       pp_modul m msg
   | Assert_malformed_quote (ls, msg) ->
-    pp fmt "(assert_malformed_quote@\n  @[<v>%S@]@\n  @[<v>%S@]@\n)" ls msg
+    pf fmt "(assert_malformed_quote@\n  @[<v>%S@]@\n  @[<v>%S@]@\n)" ls msg
   | Assert_invalid_quote (ls, msg) ->
-    pp fmt "(assert_invalid_quote@\n  @[<v>%S@]@\n  @[<v>%S@]@\n)" ls msg
+    pf fmt "(assert_invalid_quote@\n  @[<v>%S@]@\n  @[<v>%S@]@\n)" ls msg
   | Assert_malformed_binary (ls, msg) ->
-    pp fmt "(assert_malformed_binary@\n  @[<v>%S@]@\n  @[<v>%S@]@\n)" ls msg
+    pf fmt "(assert_malformed_binary@\n  @[<v>%S@]@\n  @[<v>%S@]@\n)" ls msg
   | Assert_invalid_binary (ls, msg) ->
-    pp fmt "(assert_invalid_binary@\n  @[<v>%S@]@\n  @[<v>%S@]@\n)" ls msg
+    pf fmt "(assert_invalid_binary@\n  @[<v>%S@]@\n  @[<v>%S@]@\n)" ls msg
 
 type register = string * string option
 
-let pp_register fmt (s, _name) = pp fmt "(register %s)" s
+let pp_register fmt (s, _name) = pf fmt "(register %s)" s
 
 type cmd =
-  | Module of modul
+  | Quoted_module of string
+  | Binary_module of string option * string
+  | Text_module of modul
   | Assert of assertion
   | Register of string * string option
   | Action of action
 
 let pp_cmd fmt = function
-  | Module m -> pp_modul fmt m
+  | Quoted_module m -> pf fmt "(module %S)" m
+  | Binary_module (id, m) -> Fmt.pf fmt "(module %a %S)" Types.pp_id_opt id m
+  | Text_module m -> pp_modul fmt m
   | Assert a -> pp_assertion fmt a
   | Register (s, name) -> pp_register fmt (s, name)
-  | Action _a -> pp fmt "<action>"
+  | Action _a -> pf fmt "<action>"
 
 type script = cmd list
 
-let pp_script fmt l = pp_list ~pp_sep:pp_newline pp_cmd fmt l
+let pp_script fmt l = list ~sep:pp_newline pp_cmd fmt l
diff --git a/coverage/src/ast/types.ml.html b/coverage/src/ast/types.ml.html index 2f42b9082..87dbb1b7a 100644 --- a/coverage/src/ast/types.ml.html +++ b/coverage/src/ast/types.ml.html @@ -3,7 +3,7 @@ types.ml — Coverage report - + @@ -15,162 +15,230 @@

src/ast/types.ml

-

44.91%

+

47.34%

@@ -203,100 +271,100 @@

44.91%

- + - + - + - - + + - - - - - - + + + + + + - + - - - + + + - - - - - + + + + + - - - + + + - - - + + + - + - + - + - + - + - - - + + + - + - - - - - - - - - - - + + + + + + + + + + + @@ -308,20 +376,20 @@

44.91%

- - - - - - - - - - - - - - + + + + + + + + + + + + + + @@ -331,19 +399,19 @@

44.91%

- - - - - - - - - - - - - + + + + + + + + + + + + + @@ -353,66 +421,66 @@

44.91%

- + - - - - - - + + + + + + - + - - - - - - - - - - - - + + + + + + + + + + + + - + - - - - - - - - - + + + + + + + + + - + - + - + - - - - + + + + @@ -420,167 +488,167 @@

44.91%

- + - + - + - - - - - - - - - + + + + + + + + + - - - - - - - - + + + + + + + + - - - - - + + + + + - - + + - - - - + + + + - - - - - - + + + + + + - + - - - - - - - - - + + + + + + + + + - + - + - - - - - - - + + + + + + + - - - - - - + + + + + + - + - + - - - - + + + + - - + + - - - + + + - - + + - - - - + + + + - - - - - + + + + + - + - + - + - + - + - + - + - + - + - + - + @@ -589,46 +657,46 @@

44.91%

- - - + + + - + - + - - + + - - + + - + - + - - + + - + - - - + + + @@ -659,126 +727,126 @@

44.91%

- - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + - - - + + + - - - - - - - + + + + + + + - - + + - - - - - - - - - - - - + + + + + + + + + + + + - - - - - - + + + + + + - + - + - - - - - - - - - - - - + + + + + + + + + + + + - + - + - - - + + + - - - + + + - + - - - + + + - - - + + + - - - - - - - - + + + + + + + + - - - - + + + + - - + + - + - + @@ -787,164 +855,164 @@

44.91%

- - - - - - + + + + + + - - - - - - - - - - - - + + + + + + + + + + + + - - + + - - + + - + - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + - - - + + + - - - - - - - + + + + + + + - - - - + + + + - - + + - - - - - - - - - - - + + + + + + + + + + + - - - - + + + + - - - - + + + + - - - + + + - + - + - - - - - - - - - - + + + + + + + + + + - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + - - - + + + - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + @@ -952,12 +1020,206 @@

44.91%

- - + + - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
@@ -1745,12 +2007,206 @@

44.91%

781 782 783 +784 +785 +786 +787 +788 +789 +790 +791 +792 +793 +794 +795 +796 +797 +798 +799 +800 +801 +802 +803 +804 +805 +806 +807 +808 +809 +810 +811 +812 +813 +814 +815 +816 +817 +818 +819 +820 +821 +822 +823 +824 +825 +826 +827 +828 +829 +830 +831 +832 +833 +834 +835 +836 +837 +838 +839 +840 +841 +842 +843 +844 +845 +846 +847 +848 +849 +850 +851 +852 +853 +854 +855 +856 +857 +858 +859 +860 +861 +862 +863 +864 +865 +866 +867 +868 +869 +870 +871 +872 +873 +874 +875 +876 +877 +878 +879 +880 +881 +882 +883 +884 +885 +886 +887 +888 +889 +890 +891 +892 +893 +894 +895 +896 +897 +898 +899 +900 +901 +902 +903 +904 +905 +906 +907 +908 +909 +910 +911 +912 +913 +914 +915 +916 +917 +918 +919 +920 +921 +922 +923 +924 +925 +926 +927 +928 +929 +930 +931 +932 +933 +934 +935 +936 +937 +938 +939 +940 +941 +942 +943 +944 +945 +946 +947 +948 +949 +950 +951 +952 +953 +954 +955 +956 +957 +958 +959 +960 +961 +962 +963 +964 +965 +966 +967 +968 +969 +970 +971 +972 +973 +974 +975 +976 +977 
(* SPDX-License-Identifier: AGPL-3.0-or-later *)
 (* Copyright © 2021-2024 OCamlPro *)
 (* Written by the Owi programmers *)
 
-open Format
+open Fmt
 
 exception Trap of string
 
@@ -1774,23 +2230,32 @@ 
44.91%

 
 type binary = < without_string_indices ; without_ind_bt >
 
+let sp ppf () = Fmt.char ppf ' '
+
 (* identifiers *)
 
 type _ indice =
   | Text : string -> < with_string_indices ; .. > indice
   | Raw : int -> < .. > indice
 
-let pp_id fmt id = pp fmt "$%s" id
+let pp_id fmt id = pf fmt "$%s" id
+
+let pp_id_opt fmt = function None -> () | Some i -> pf fmt " %a" pp_id i
 
-let pp_id_opt fmt = function None -> () | Some i -> pp fmt " %a" pp_id i
+let pp_indice (type kind) fmt : kind indice -> unit = function
+  | Raw u -> int fmt u
+  | Text i -> pp_id fmt i
 
-let pp_indice (type kind) fmt : kind indice -> unit = function
-  | Raw u -> pp_int fmt u
-  | Text i -> pp_id fmt i
+let compare_indice id1 id2 =
+  match (id1, id2) with
+  | Raw i1, Raw i2 -> compare i1 i2
+  | Text s1, Text s2 -> String.compare s1 s2
+  | Raw _, Text _ -> -1
+  | Text _, Raw _ -> 1
 
-let pp_indice_opt fmt = function None -> () | Some i -> pp_indice fmt i
+let pp_indice_opt fmt = function None -> () | Some i -> pp_indice fmt i
 
-let pp_indices fmt ids = pp_list ~pp_sep:pp_space pp_indice fmt ids
+let pp_indices fmt ids = list ~sep:sp pp_indice fmt ids
 
 type nonrec num_type =
   | I32
@@ -1799,10 +2264,19 @@ 
44.91%

   | F64
 
 let pp_num_type fmt = function
-  | I32 -> pp fmt "i32"
-  | I64 -> pp fmt "i64"
-  | F32 -> pp fmt "f32"
-  | F64 -> pp fmt "f64"
+  | I32 -> pf fmt "i32"
+  | I64 -> pf fmt "i64"
+  | F32 -> pf fmt "f32"
+  | F64 -> pf fmt "f64"
+
+let num_type_eq t1 t2 =
+  match (t1, t2) with
+  | I32, I32 | I64, I64 | F32, F32 | F64, F64 -> true
+  | _, _ -> false
+
+let compare_num_type t1 t2 =
+  let to_int = function I32 -> 0 | I64 -> 1 | F32 -> 2 | F64 -> 3 in
+  compare (to_int t1) (to_int t2)
 
 type nullable =
   | No_null
@@ -1811,32 +2285,35 @@ 
44.91%

 let pp_nullable fmt = function
   | No_null ->
     (* TODO: no notation to enforce nonnull ? *)
-    pp fmt ""
-  | Null -> pp fmt "null"
+    pf fmt ""
+  | Null -> pf fmt "null"
 
 type nonrec packed_type =
   | I8
   | I16
 
-let pp_packed_type fmt = function I8 -> pp fmt "i8" | I16 -> pp fmt "i16"
+let pp_packed_type fmt = function I8 -> pf fmt "i8" | I16 -> pf fmt "i16"
+
+let packed_type_eq t1 t2 =
+  match (t1, t2) with I8, I8 | I16, I16 -> true | _, _ -> false
 
 type nonrec mut =
   | Const
   | Var
 
-let pp_mut fmt = function Const -> () | Var -> pp fmt "mut"
+let pp_mut fmt = function Const -> () | Var -> pf fmt "mut"
 
 type nonrec nn =
   | S32
   | S64
 
-let pp_nn fmt = function S32 -> pp fmt "32" | S64 -> pp fmt "64"
+let pp_nn fmt = function S32 -> pf fmt "32" | S64 -> pf fmt "64"
 
 type nonrec sx =
   | U
   | S
 
-let pp_sx fmt = function U -> pp fmt "u" | S -> pp fmt "s"
+let pp_sx fmt = function U -> pf fmt "u" | S -> pf fmt "s"
 
 type nonrec iunop =
   | Clz
@@ -1844,9 +2321,9 @@ 
44.91%

   | Popcnt
 
 let pp_iunop fmt = function
-  | Clz -> pp fmt "clz"
-  | Ctz -> pp fmt "ctz"
-  | Popcnt -> pp fmt "popcnt"
+  | Clz -> pf fmt "clz"
+  | Ctz -> pf fmt "ctz"
+  | Popcnt -> pf fmt "popcnt"
 
 type nonrec funop =
   | Abs
@@ -1858,13 +2335,13 @@ 
44.91%

   | Nearest
 
 let pp_funop fmt = function
-  | Abs -> pp fmt "abs"
-  | Neg -> pp fmt "neg"
-  | Sqrt -> pp fmt "sqrt"
-  | Ceil -> pp fmt "ceil"
-  | Floor -> pp fmt "floor"
-  | Trunc -> pp fmt "trunc"
-  | Nearest -> pp fmt "nearest"
+  | Abs -> pf fmt "abs"
+  | Neg -> pf fmt "neg"
+  | Sqrt -> pf fmt "sqrt"
+  | Ceil -> pf fmt "ceil"
+  | Floor -> pf fmt "floor"
+  | Trunc -> pf fmt "trunc"
+  | Nearest -> pf fmt "nearest"
 
 type nonrec ibinop =
   | Add
@@ -1881,18 +2358,18 @@ 
44.91%

   | Rotr
 
 let pp_ibinop fmt = function
-  | (Add : ibinop) -> pp fmt "add"
-  | Sub -> pp fmt "sub"
-  | Mul -> pp fmt "mul"
-  | Div s -> pp fmt "div_%a" pp_sx s
-  | Rem s -> pp fmt "rem_%a" pp_sx s
-  | And -> pp fmt "and"
-  | Or -> pp fmt "or"
-  | Xor -> pp fmt "xor"
-  | Shl -> pp fmt "shl"
-  | Shr s -> pp fmt "shr_%a" pp_sx s
-  | Rotl -> pp fmt "rotl"
-  | Rotr -> pp fmt "rotr"
+  | (Add : ibinop) -> pf fmt "add"
+  | Sub -> pf fmt "sub"
+  | Mul -> pf fmt "mul"
+  | Div s -> pf fmt "div_%a" pp_sx s
+  | Rem s -> pf fmt "rem_%a" pp_sx s
+  | And -> pf fmt "and"
+  | Or -> pf fmt "or"
+  | Xor -> pf fmt "xor"
+  | Shl -> pf fmt "shl"
+  | Shr s -> pf fmt "shr_%a" pp_sx s
+  | Rotl -> pf fmt "rotl"
+  | Rotr -> pf fmt "rotr"
 
 type nonrec fbinop =
   | Add
@@ -1904,17 +2381,17 @@ 
44.91%

   | Copysign
 
 let pp_fbinop fmt = function
-  | (Add : fbinop) -> pp fmt "add"
-  | Sub -> pp fmt "sub"
-  | Mul -> pp fmt "mul"
-  | Div -> pp fmt "div"
-  | Min -> pp fmt "min"
-  | Max -> pp fmt "max"
-  | Copysign -> pp fmt "copysign"
+  | (Add : fbinop) -> pf fmt "add"
+  | Sub -> pf fmt "sub"
+  | Mul -> pf fmt "mul"
+  | Div -> pf fmt "div"
+  | Min -> pf fmt "min"
+  | Max -> pf fmt "max"
+  | Copysign -> pf fmt "copysign"
 
 type nonrec itestop = Eqz
 
-let pp_itestop fmt = function Eqz -> pp fmt "eqz"
+let pp_itestop fmt = function Eqz -> pf fmt "eqz"
 
 type nonrec irelop =
   | Eq
@@ -1924,13 +2401,13 @@ 
44.91%

   | Le of sx
   | Ge of sx
 
-let pp_irelop fmt : irelop -> Unit.t = function
-  | Eq -> pp fmt "eq"
-  | Ne -> pp fmt "ne"
-  | Lt sx -> pp fmt "lt_%a" pp_sx sx
-  | Gt sx -> pp fmt "gt_%a" pp_sx sx
-  | Le sx -> pp fmt "le_%a" pp_sx sx
-  | Ge sx -> pp fmt "ge_%a" pp_sx sx
+let pp_irelop fmt : irelop -> Unit.t = function
+  | Eq -> pf fmt "eq"
+  | Ne -> pf fmt "ne"
+  | Lt sx -> pf fmt "lt_%a" pp_sx sx
+  | Gt sx -> pf fmt "gt_%a" pp_sx sx
+  | Le sx -> pf fmt "le_%a" pp_sx sx
+  | Ge sx -> pf fmt "ge_%a" pp_sx sx
 
 type nonrec frelop =
   | Eq
@@ -1941,12 +2418,12 @@ 
44.91%

   | Ge
 
 let frelop fmt : frelop -> Unit.t = function
-  | Eq -> pp fmt "eq"
-  | Ne -> pp fmt "ne"
-  | Lt -> pp fmt "lt"
-  | Gt -> pp fmt "gt"
-  | Le -> pp fmt "le"
-  | Ge -> pp fmt "ge"
+  | Eq -> pf fmt "eq"
+  | Ne -> pf fmt "ne"
+  | Lt -> pf fmt "lt"
+  | Gt -> pf fmt "gt"
+  | Le -> pf fmt "le"
+  | Ge -> pf fmt "ge"
 
 type nonrec memarg =
   { offset : Int32.t
@@ -1955,14 +2432,14 @@ 
44.91%

 
 let pp_memarg =
   let pow_2 n =
-    assert (n >= 0l);
+    assert (Int32.ge n 0l);
     Int32.shl 1l n
   in
   fun fmt { offset; align } ->
-    let pp_offset fmt offset =
-      if offset > 0l then pp fmt "offset=%ld " offset
+    let pp_offset fmt offset =
+      if Int32.gt offset 0l then pf fmt "offset=%ld " offset
     in
-    pp fmt "%aalign=%ld" pp_offset offset (pow_2 align)
+    pf fmt "%aalign=%ld" pp_offset offset (pow_2 align)
 
 type nonrec limits =
   { min : int
@@ -1970,19 +2447,19 @@ 
44.91%

   }
 
 let pp_limits fmt { min; max } =
-  match max with None -> pp fmt "%d" min | Some max -> pp fmt "%d %d" min max
+  match max with None -> pf fmt "%d" min | Some max -> pf fmt "%d %d" min max
 
 type nonrec mem = string option * limits
 
-let pp_mem fmt (id, ty) = pp fmt "(memory%a %a)" pp_id_opt id pp_limits ty
+let pp_mem fmt (id, ty) = pf fmt "(memory%a %a)" pp_id_opt id pp_limits ty
 
 type nonrec final =
   | Final
   | No_final
 
 let pp_final fmt = function
-  | Final -> pp fmt "final"
-  | No_final -> pp fmt "no_final"
+  | Final -> pf fmt "final"
+  | No_final -> pf fmt "no_final"
 
 (** Structure *)
 
@@ -2002,64 +2479,135 @@ 
44.91%

   | Def_ht of 'a indice
 
 let pp_heap_type fmt = function
-  | Any_ht -> pp fmt "any"
-  | None_ht -> pp fmt "none"
-  | Eq_ht -> pp fmt "eq"
-  | I31_ht -> pp fmt "i31"
-  | Struct_ht -> pp fmt "struct"
-  | Array_ht -> pp fmt "array"
-  | Func_ht -> pp fmt "func"
-  | No_func_ht -> pp fmt "nofunc"
-  | Extern_ht -> pp fmt "extern"
-  | No_extern_ht -> pp fmt "noextern"
-  | Def_ht i -> pp fmt "%a" pp_indice i
+  | Any_ht -> pf fmt "any"
+  | None_ht -> pf fmt "none"
+  | Eq_ht -> pf fmt "eq"
+  | I31_ht -> pf fmt "i31"
+  | Struct_ht -> pf fmt "struct"
+  | Array_ht -> pf fmt "array"
+  | Func_ht -> pf fmt "func"
+  | No_func_ht -> pf fmt "nofunc"
+  | Extern_ht -> pf fmt "extern"
+  | No_extern_ht -> pf fmt "noextern"
+  | Def_ht i -> pf fmt "%a" pp_indice i
 
 let pp_heap_type_short fmt = function
-  | Any_ht -> pp fmt "anyref"
-  | None_ht -> pp fmt "(ref none)"
-  | Eq_ht -> pp fmt "eqref"
-  | I31_ht -> pp fmt "i31ref"
-  | Struct_ht -> pp fmt "(ref struct)"
-  | Array_ht -> pp fmt "(ref array)"
-  | Func_ht -> pp fmt "funcref"
-  | No_func_ht -> pp fmt "nofunc"
-  | Extern_ht -> pp fmt "externref"
-  | No_extern_ht -> pp fmt "(ref noextern)"
-  | Def_ht i -> pp fmt "(ref %a)" pp_indice i
+  | Any_ht -> pf fmt "anyref"
+  | None_ht -> pf fmt "(ref none)"
+  | Eq_ht -> pf fmt "eqref"
+  | I31_ht -> pf fmt "i31ref"
+  | Struct_ht -> pf fmt "(ref struct)"
+  | Array_ht -> pf fmt "(ref array)"
+  | Func_ht -> pf fmt "funcref"
+  | No_func_ht -> pf fmt "nofunc"
+  | Extern_ht -> pf fmt "externref"
+  | No_extern_ht -> pf fmt "(ref noextern)"
+  | Def_ht i -> pf fmt "(ref %a)" pp_indice i
+
+let heap_type_eq t1 t2 =
+  (* TODO: this is wrong *)
+  match (t1, t2) with
+  | Any_ht, Any_ht
+  | None_ht, None_ht
+  | Eq_ht, Eq_ht
+  | I31_ht, I31_ht
+  | Struct_ht, Struct_ht
+  | Array_ht, Array_ht
+  | Func_ht, Func_ht
+  | No_func_ht, No_func_ht
+  | Extern_ht, Extern_ht
+  | No_extern_ht, No_extern_ht ->
+    true
+  | Def_ht _, Def_ht _ -> assert false
+  | _, _ -> false
+
+let compare_heap_type t1 t2 =
+  (* TODO: this is wrong *)
+  let to_int = function
+    | Any_ht -> 0
+    | None_ht -> 1
+    | Eq_ht -> 2
+    | I31_ht -> 3
+    | Struct_ht -> 4
+    | Array_ht -> 5
+    | Func_ht -> 6
+    | No_func_ht -> 7
+    | Extern_ht -> 8
+    | No_extern_ht -> 9
+    | Def_ht _ -> assert false
+  in
+  Int.compare (to_int t1) (to_int t2)
 
 type nonrec 'a ref_type = nullable * 'a heap_type
 
 let pp_ref_type fmt (n, ht) =
-  match n with
-  | No_null -> pp fmt "%a" pp_heap_type_short ht
-  | Null -> pp fmt "(ref null %a)" pp_heap_type ht
+  match n with
+  | No_null -> pf fmt "%a" pp_heap_type_short ht
+  | Null -> pf fmt "(ref null %a)" pp_heap_type ht
+
+let ref_type_eq t1 t2 =
+  match (t1, t2) with
+  | (Null, t1), (Null, t2) | (No_null, t1), (No_null, t2) -> heap_type_eq t1 t2
+  | _ -> false
+
+let compare_ref_type t1 t2 =
+  match (t1, t2) with
+  | (Null, t1), (Null, t2) | (No_null, t1), (No_null, t2) ->
+    compare_heap_type t1 t2
+  | (Null, _), (No_null, _) -> -1
+  | (No_null, _), (Null, _) -> 1
 
 type nonrec 'a val_type =
   | Num_type of num_type
   | Ref_type of 'a ref_type
 
 let pp_val_type fmt = function
-  | Num_type t -> pp_num_type fmt t
+  | Num_type t -> pp_num_type fmt t
   | Ref_type t -> pp_ref_type fmt t
 
+let val_type_eq t1 t2 =
+  match (t1, t2) with
+  | Num_type t1, Num_type t2 -> num_type_eq t1 t2
+  | Ref_type t1, Ref_type t2 -> ref_type_eq t1 t2
+  | _, _ -> false
+
+let compare_val_type t1 t2 =
+  match (t1, t2) with
+  | Num_type t1, Num_type t2 -> compare_num_type t1 t2
+  | Ref_type t1, Ref_type t2 -> compare_ref_type t1 t2
+  | Num_type _, _ -> 1
+  | Ref_type _, _ -> -1
+
 type nonrec 'a param = string option * 'a val_type
 
-let pp_param fmt (id, vt) = pp fmt "(param%a %a)" pp_id_opt id pp_val_type vt
+let pp_param fmt (id, vt) = pf fmt "(param%a %a)" pp_id_opt id pp_val_type vt
+
+let param_eq (_, t1) (_, t2) = val_type_eq t1 t2
+
+let compare_param (_, t1) (_, t2) = compare_val_type t1 t2
 
 type nonrec 'a param_type = 'a param list
 
-let pp_param_type fmt params = pp_list ~pp_sep:pp_space pp_param fmt params
+let pp_param_type fmt params = list ~sep:sp pp_param fmt params
+
+let param_type_eq t1 t2 = List.equal param_eq t1 t2
+
+let compare_param_type t1 t2 = List.compare compare_param t1 t2
 
 type nonrec 'a result_type = 'a val_type list
 
-let pp_result_ fmt vt = pp fmt "(result %a)" pp_val_type vt
+let pp_result_ fmt vt = pf fmt "(result %a)" pp_val_type vt
+
+let pp_result_type fmt results = list ~sep:sp pp_result_ fmt results
 
-let pp_result_type fmt results = pp_list ~pp_sep:pp_space pp_result_ fmt results
+let result_type_eq t1 t2 = List.equal val_type_eq t1 t2
+
+let compare_result_type t1 t2 = List.compare compare_val_type t1 t2
 
 (* wrap printer to print a space before a non empty list *)
 (* TODO or make it an optional arg of pp_list? *)
 let with_space_list printer fmt l =
-  match l with [] -> () | _l -> pp fmt " %a" printer l
+  match l with [] -> () | _l -> pf fmt " %a" printer l
 
 (* TODO: add a third case that only has (pt * rt) and is the only one used in simplified *)
 type 'a block_type =
@@ -2068,39 +2616,46 @@ 
44.91%

       ('a indice option * ('a param_type * 'a result_type))
       -> (< .. > as 'a) block_type
 
-let pp_block_type (type kind) fmt : kind block_type -> unit = function
-  | Bt_ind ind -> pp fmt "(type %a)" pp_indice ind
-  | Bt_raw (_ind, (pt, rt)) ->
-    pp fmt "%a%a"
-      (with_space_list pp_param_type)
+let pp_block_type (type kind) fmt : kind block_type -> unit = function
+  | Bt_ind ind -> pf fmt "(type %a)" pp_indice ind
+  | Bt_raw (_ind, (pt, rt)) ->
+    pf fmt "%a%a"
+      (with_space_list pp_param_type)
       pt
-      (with_space_list pp_result_type)
+      (with_space_list pp_result_type)
       rt
 
 let pp_block_type_opt fmt = function
   | None -> ()
-  | Some bt -> pp_block_type fmt bt
+  | Some bt -> pp_block_type fmt bt
 
 type nonrec 'a func_type = 'a param_type * 'a result_type
 
 let pp_func_type fmt (params, results) =
-  pp fmt "(func%a%a)"
-    (with_space_list pp_param_type)
+  pf fmt "(func%a%a)"
+    (with_space_list pp_param_type)
     params
-    (with_space_list pp_result_type)
+    (with_space_list pp_result_type)
     results
 
+let func_type_eq (pt1, rt1) (pt2, rt2) =
+  param_type_eq pt1 pt2 && result_type_eq rt1 rt2
+
+let compare_func_type (pt1, rt1) (pt2, rt2) =
+  let pt = compare_param_type pt1 pt2 in
+  if pt = 0 then compare_result_type rt1 rt2 else pt
+
 type nonrec 'a table_type = limits * 'a ref_type
 
 let pp_table_type fmt (limits, ref_type) =
-  pp fmt "%a %a" pp_limits limits pp_ref_type ref_type
+  pf fmt "%a %a" pp_limits limits pp_ref_type ref_type
 
 type nonrec 'a global_type = mut * 'a val_type
 
 let pp_global_type fmt (mut, val_type) =
-  match mut with
-  | Var -> pp fmt "(mut %a)" pp_val_type val_type
-  | Const -> pp fmt "%a" pp_val_type val_type
+  match mut with
+  | Var -> pf fmt "(mut %a)" pp_val_type val_type
+  | Const -> pf fmt "%a" pp_val_type val_type
 
 type nonrec 'a extern_type =
   | Func of string option * 'a func_type
@@ -2229,141 +2784,206 @@ 
44.91%

 
 and 'a expr = 'a instr list
 
+let pp_newline ppf () = pf ppf "@\n"
+
 let rec pp_instr fmt = function
-  | I32_const i -> pp fmt "i32.const %ld" i
-  | I64_const i -> pp fmt "i64.const %Ld" i
-  | F32_const f -> pp fmt "f32.const %a" Float32.pp f
-  | F64_const f -> pp fmt "f64.const %a" Float64.pp f
-  | I_unop (n, op) -> pp fmt "i%a.%a" pp_nn n pp_iunop op
-  | F_unop (n, op) -> pp fmt "f%a.%a" pp_nn n pp_funop op
-  | I_binop (n, op) -> pp fmt "i%a.%a" pp_nn n pp_ibinop op
-  | F_binop (n, op) -> pp fmt "f%a.%a" pp_nn n pp_fbinop op
-  | I_testop (n, op) -> pp fmt "i%a.%a" pp_nn n pp_itestop op
-  | I_relop (n, op) -> pp fmt "i%a.%a" pp_nn n pp_irelop op
-  | F_relop (n, op) -> pp fmt "f%a.%a" pp_nn n frelop op
-  | I_extend8_s n -> pp fmt "i%a.extend8_s" pp_nn n
-  | I_extend16_s n -> pp fmt "i%a.extend16_s" pp_nn n
-  | I64_extend32_s -> pp fmt "i64.extend32_s"
-  | I32_wrap_i64 -> pp fmt "i32.wrap_i64"
-  | I64_extend_i32 sx -> pp fmt "i64.extend_i32_%a" pp_sx sx
-  | I_trunc_f (n, n', sx) -> pp fmt "i%a.trunc_f%a_%a" pp_nn n pp_nn n' pp_sx sx
+  | I32_const i -> pf fmt "i32.const %ld" i
+  | I64_const i -> pf fmt "i64.const %Ld" i
+  | F32_const f -> pf fmt "f32.const %a" Float32.pp f
+  | F64_const f -> pf fmt "f64.const %a" Float64.pp f
+  | I_unop (n, op) -> pf fmt "i%a.%a" pp_nn n pp_iunop op
+  | F_unop (n, op) -> pf fmt "f%a.%a" pp_nn n pp_funop op
+  | I_binop (n, op) -> pf fmt "i%a.%a" pp_nn n pp_ibinop op
+  | F_binop (n, op) -> pf fmt "f%a.%a" pp_nn n pp_fbinop op
+  | I_testop (n, op) -> pf fmt "i%a.%a" pp_nn n pp_itestop op
+  | I_relop (n, op) -> pf fmt "i%a.%a" pp_nn n pp_irelop op
+  | F_relop (n, op) -> pf fmt "f%a.%a" pp_nn n frelop op
+  | I_extend8_s n -> pf fmt "i%a.extend8_s" pp_nn n
+  | I_extend16_s n -> pf fmt "i%a.extend16_s" pp_nn n
+  | I64_extend32_s -> pf fmt "i64.extend32_s"
+  | I32_wrap_i64 -> pf fmt "i32.wrap_i64"
+  | I64_extend_i32 sx -> pf fmt "i64.extend_i32_%a" pp_sx sx
+  | I_trunc_f (n, n', sx) -> pf fmt "i%a.trunc_f%a_%a" pp_nn n pp_nn n' pp_sx sx
   | I_trunc_sat_f (n, n', sx) ->
-    pp fmt "i%a.trunc_sat_f%a_%a" pp_nn n pp_nn n' pp_sx sx
-  | F32_demote_f64 -> pp fmt "f32.demote_f64"
-  | F64_promote_f32 -> pp fmt "f64.promote_f32"
+    pf fmt "i%a.trunc_sat_f%a_%a" pp_nn n pp_nn n' pp_sx sx
+  | F32_demote_f64 -> pf fmt "f32.demote_f64"
+  | F64_promote_f32 -> pf fmt "f64.promote_f32"
   | F_convert_i (n, n', sx) ->
-    pp fmt "f%a.convert_i%a_%a" pp_nn n pp_nn n' pp_sx sx
-  | I_reinterpret_f (n, n') -> pp fmt "i%a.reinterpret_f%a" pp_nn n pp_nn n'
-  | F_reinterpret_i (n, n') -> pp fmt "f%a.reinterpret_i%a" pp_nn n pp_nn n'
-  | Ref_null t -> pp fmt "ref.null %a" pp_heap_type t
-  | Ref_is_null -> pp fmt "ref.is_null"
-  | Ref_func fid -> pp fmt "ref.func %a" pp_indice fid
-  | Drop -> pp fmt "drop"
+    pf fmt "f%a.convert_i%a_%a" pp_nn n pp_nn n' pp_sx sx
+  | I_reinterpret_f (n, n') -> pf fmt "i%a.reinterpret_f%a" pp_nn n pp_nn n'
+  | F_reinterpret_i (n, n') -> pf fmt "f%a.reinterpret_i%a" pp_nn n pp_nn n'
+  | Ref_null t -> pf fmt "ref.null %a" pp_heap_type t
+  | Ref_is_null -> pf fmt "ref.is_null"
+  | Ref_func fid -> pf fmt "ref.func %a" pp_indice fid
+  | Drop -> pf fmt "drop"
   | Select vt -> begin
     match vt with
-    | None -> pp fmt "select"
-    | Some vt -> pp fmt "select (%a)" pp_result_type vt
+    | None -> pf fmt "select"
+    | Some vt -> pf fmt "select (%a)" pp_result_type vt
     (* TODO: are the parens needed ? *)
   end
-  | Local_get id -> pp fmt "local.get %a" pp_indice id
-  | Local_set id -> pp fmt "local.set %a" pp_indice id
-  | Local_tee id -> pp fmt "local.tee %a" pp_indice id
-  | Global_get id -> pp fmt "global.get %a" pp_indice id
-  | Global_set id -> pp fmt "global.set %a" pp_indice id
-  | Table_get id -> pp fmt "table.get %a" pp_indice id
-  | Table_set id -> pp fmt "table.set %a" pp_indice id
-  | Table_size id -> pp fmt "table.size %a" pp_indice id
-  | Table_grow id -> pp fmt "table.grow %a" pp_indice id
-  | Table_fill id -> pp fmt "table.fill %a" pp_indice id
-  | Table_copy (id, id') -> pp fmt "table.copy %a %a" pp_indice id pp_indice id'
-  | Table_init (tid, eid) ->
-    pp fmt "table.init %a %a" pp_indice tid pp_indice eid
-  | Elem_drop id -> pp fmt "elem.drop %a" pp_indice id
-  | I_load (n, memarg) -> pp fmt "i%a.load %a" pp_nn n pp_memarg memarg
-  | F_load (n, memarg) -> pp fmt "f%a.load %a" pp_nn n pp_memarg memarg
-  | I_store (n, memarg) -> pp fmt "i%a.store %a" pp_nn n pp_memarg memarg
-  | F_store (n, memarg) -> pp fmt "f%a.store %a" pp_nn n pp_memarg memarg
+  | Local_get id -> pf fmt "local.get %a" pp_indice id
+  | Local_set id -> pf fmt "local.set %a" pp_indice id
+  | Local_tee id -> pf fmt "local.tee %a" pp_indice id
+  | Global_get id -> pf fmt "global.get %a" pp_indice id
+  | Global_set id -> pf fmt "global.set %a" pp_indice id
+  | Table_get id -> pf fmt "table.get %a" pp_indice id
+  | Table_set id -> pf fmt "table.set %a" pp_indice id
+  | Table_size id -> pf fmt "table.size %a" pp_indice id
+  | Table_grow id -> pf fmt "table.grow %a" pp_indice id
+  | Table_fill id -> pf fmt "table.fill %a" pp_indice id
+  | Table_copy (id, id') -> pf fmt "table.copy %a %a" pp_indice id pp_indice id'
+  | Table_init (tid, eid) ->
+    pf fmt "table.init %a %a" pp_indice tid pp_indice eid
+  | Elem_drop id -> pf fmt "elem.drop %a" pp_indice id
+  | I_load (n, memarg) -> pf fmt "i%a.load %a" pp_nn n pp_memarg memarg
+  | F_load (n, memarg) -> pf fmt "f%a.load %a" pp_nn n pp_memarg memarg
+  | I_store (n, memarg) -> pf fmt "i%a.store %a" pp_nn n pp_memarg memarg
+  | F_store (n, memarg) -> pf fmt "f%a.store %a" pp_nn n pp_memarg memarg
   | I_load8 (n, sx, memarg) ->
-    pp fmt "i%a.load8_%a %a" pp_nn n pp_sx sx pp_memarg memarg
+    pf fmt "i%a.load8_%a %a" pp_nn n pp_sx sx pp_memarg memarg
   | I_load16 (n, sx, memarg) ->
-    pp fmt "i%a.load16_%a %a" pp_nn n pp_sx sx pp_memarg memarg
+    pf fmt "i%a.load16_%a %a" pp_nn n pp_sx sx pp_memarg memarg
   | I64_load32 (sx, memarg) ->
-    pp fmt "i64.load32_%a %a" pp_sx sx pp_memarg memarg
-  | I_store8 (n, memarg) -> pp fmt "i%a.store8 %a" pp_nn n pp_memarg memarg
-  | I_store16 (n, memarg) -> pp fmt "i%a.store16 %a" pp_nn n pp_memarg memarg
-  | I64_store32 memarg -> pp fmt "i64.store32 %a" pp_memarg memarg
-  | Memory_size -> pp fmt "memory.size"
-  | Memory_grow -> pp fmt "memory.grow"
-  | Memory_fill -> pp fmt "memory.fill"
-  | Memory_copy -> pp fmt "memory.copy"
-  | Memory_init id -> pp fmt "memory.init %a" pp_indice id
-  | Data_drop id -> pp fmt "data.drop %a" pp_indice id
-  | Nop -> pp fmt "nop"
-  | Unreachable -> pp fmt "unreachable"
+    pf fmt "i64.load32_%a %a" pp_sx sx pp_memarg memarg
+  | I_store8 (n, memarg) -> pf fmt "i%a.store8 %a" pp_nn n pp_memarg memarg
+  | I_store16 (n, memarg) -> pf fmt "i%a.store16 %a" pp_nn n pp_memarg memarg
+  | I64_store32 memarg -> pf fmt "i64.store32 %a" pp_memarg memarg
+  | Memory_size -> pf fmt "memory.size"
+  | Memory_grow -> pf fmt "memory.grow"
+  | Memory_fill -> pf fmt "memory.fill"
+  | Memory_copy -> pf fmt "memory.copy"
+  | Memory_init id -> pf fmt "memory.init %a" pp_indice id
+  | Data_drop id -> pf fmt "data.drop %a" pp_indice id
+  | Nop -> pf fmt "nop"
+  | Unreachable -> pf fmt "unreachable"
   | Block (id, bt, e) ->
-    pp fmt "(block%a%a@\n  @[<v>%a@])" pp_id_opt id pp_block_type_opt bt pp_expr
+    pf fmt "(block%a%a@\n  @[<v>%a@])" pp_id_opt id pp_block_type_opt bt pp_expr
       e
-  | Loop (id, bt, e) ->
-    pp fmt "(loop%a%a@\n  @[<v>%a@])" pp_id_opt id pp_block_type_opt bt pp_expr
+  | Loop (id, bt, e) ->
+    pf fmt "(loop%a%a@\n  @[<v>%a@])" pp_id_opt id pp_block_type_opt bt pp_expr
       e
-  | If_else (id, bt, e1, e2) ->
+  | If_else (id, bt, e1, e2) ->
     let pp_else fmt e =
-      match e with
-      | [] -> ()
-      | e -> pp fmt "@\n(else@\n  @[<v>%a@]@\n)" pp_expr e
+      match e with
+      | [] -> ()
+      | e -> pf fmt "@\n(else@\n  @[<v>%a@]@\n)" pp_expr e
     in
-    pp fmt "(if%a%a@\n  @[<v>(then@\n  @[<v>%a@]@\n)%a@]@\n)" pp_id_opt id
+    pf fmt "(if%a%a@\n  @[<v>(then@\n  @[<v>%a@]@\n)%a@]@\n)" pp_id_opt id
       pp_block_type_opt bt pp_expr e1 pp_else e2
-  | Br id -> pp fmt "br %a" pp_indice id
-  | Br_if id -> pp fmt "br_if %a" pp_indice id
+  | Br id -> pf fmt "br %a" pp_indice id
+  | Br_if id -> pf fmt "br_if %a" pp_indice id
   | Br_table (ids, id) ->
-    pp fmt "br_table %a %a"
-      (pp_array ~pp_sep:pp_space pp_indice)
-      ids pp_indice id
-  | Return -> pp fmt "return"
-  | Return_call id -> pp fmt "return_call %a" pp_indice id
+    pf fmt "br_table %a %a" (array ~sep:sp pp_indice) ids pp_indice id
+  | Return -> pf fmt "return"
+  | Return_call id -> pf fmt "return_call %a" pp_indice id
   | Return_call_indirect (tbl_id, ty_id) ->
-    pp fmt "return_call_indirect %a %a" pp_indice tbl_id pp_block_type ty_id
-  | Return_call_ref ty_id -> pp fmt "return_call_ref %a" pp_block_type ty_id
-  | Call id -> pp fmt "call %a" pp_indice id
-  | Call_indirect (tbl_id, ty_id) ->
-    pp fmt "call_indirect %a %a" pp_indice tbl_id pp_block_type ty_id
-  | Call_ref ty_id -> pp fmt "call_ref %a" pp_indice ty_id
-  | Array_new id -> pp fmt "array.new %a" pp_indice id
+    pf fmt "return_call_indirect %a %a" pp_indice tbl_id pp_block_type ty_id
+  | Return_call_ref ty_id -> pf fmt "return_call_ref %a" pp_block_type ty_id
+  | Call id -> pf fmt "call %a" pp_indice id
+  | Call_indirect (tbl_id, ty_id) ->
+    pf fmt "call_indirect %a %a" pp_indice tbl_id pp_block_type ty_id
+  | Call_ref ty_id -> pf fmt "call_ref %a" pp_indice ty_id
+  | Array_new id -> pf fmt "array.new %a" pp_indice id
   | Array_new_data (id1, id2) ->
-    pp fmt "array.new_data %a %a" pp_indice id1 pp_indice id2
-  | Array_new_default id -> pp fmt "array.new_default %a" pp_indice id
+    pf fmt "array.new_data %a %a" pp_indice id1 pp_indice id2
+  | Array_new_default id -> pf fmt "array.new_default %a" pp_indice id
   | Array_new_elem (id1, id2) ->
-    pp fmt "array.new_elem %a %a" pp_indice id1 pp_indice id2
-  | Array_new_fixed (id, i) -> pp fmt "array.new_fixed %a %d" pp_indice id i
-  | Array_get id -> pp fmt "array.get %a" pp_indice id
-  | Array_get_u id -> pp fmt "array.get_u %a" pp_indice id
-  | Array_set id -> pp fmt "array.set %a" pp_indice id
-  | Array_len -> pp fmt "array.len"
-  | Ref_i31 -> pp fmt "ref.i31"
-  | I31_get_s -> pp fmt "i31.get_s"
-  | I31_get_u -> pp fmt "i31.get_u"
-  | Struct_get (i1, i2) -> pp fmt "struct.get %a %a" pp_indice i1 pp_indice i2
+    pf fmt "array.new_elem %a %a" pp_indice id1 pp_indice id2
+  | Array_new_fixed (id, i) -> pf fmt "array.new_fixed %a %d" pp_indice id i
+  | Array_get id -> pf fmt "array.get %a" pp_indice id
+  | Array_get_u id -> pf fmt "array.get_u %a" pp_indice id
+  | Array_set id -> pf fmt "array.set %a" pp_indice id
+  | Array_len -> pf fmt "array.len"
+  | Ref_i31 -> pf fmt "ref.i31"
+  | I31_get_s -> pf fmt "i31.get_s"
+  | I31_get_u -> pf fmt "i31.get_u"
+  | Struct_get (i1, i2) -> pf fmt "struct.get %a %a" pp_indice i1 pp_indice i2
   | Struct_get_s (i1, i2) ->
-    pp fmt "struct.get_s %a %a" pp_indice i1 pp_indice i2
-  | Struct_new i -> pp fmt "struct.new %a" pp_indice i
-  | Struct_new_default i -> pp fmt "struct.new_default %a" pp_indice i
-  | Struct_set (i1, i2) -> pp fmt "struct.set %a %a" pp_indice i1 pp_indice i2
-  | Extern_externalize -> pp fmt "extern.externalize"
-  | Extern_internalize -> pp fmt "extern.internalize"
-  | Ref_as_non_null -> pp fmt "ref.as_non_null"
+    pf fmt "struct.get_s %a %a" pp_indice i1 pp_indice i2
+  | Struct_new i -> pf fmt "struct.new %a" pp_indice i
+  | Struct_new_default i -> pf fmt "struct.new_default %a" pp_indice i
+  | Struct_set (i1, i2) -> pf fmt "struct.set %a %a" pp_indice i1 pp_indice i2
+  | Extern_externalize -> pf fmt "extern.externalize"
+  | Extern_internalize -> pf fmt "extern.internalize"
+  | Ref_as_non_null -> pf fmt "ref.as_non_null"
   | Ref_cast (n, t) ->
-    pp fmt "ref.cast (ref %a %a)" pp_nullable n pp_heap_type t
-  | Ref_test (n, t) -> pp fmt "ref.test %a %a" pp_nullable n pp_heap_type t
-  | Br_on_non_null id -> pp fmt "br_on_non_null %a" pp_indice id
-  | Br_on_null id -> pp fmt "br_on_null %a" pp_indice id
+    pf fmt "ref.cast (ref %a %a)" pp_nullable n pp_heap_type t
+  | Ref_test (n, t) -> pf fmt "ref.test %a %a" pp_nullable n pp_heap_type t
+  | Br_on_non_null id -> pf fmt "br_on_non_null %a" pp_indice id
+  | Br_on_null id -> pf fmt "br_on_null %a" pp_indice id
   | Br_on_cast (id, t1, t2) ->
-    pp fmt "br_on_cast %a %a %a" pp_indice id pp_ref_type t1 pp_ref_type t2
+    pf fmt "br_on_cast %a %a %a" pp_indice id pp_ref_type t1 pp_ref_type t2
   | Br_on_cast_fail (id, n, t) ->
-    pp fmt "br_on_cast_fail %a %a %a" pp_indice id pp_nullable n pp_heap_type t
-  | Ref_eq -> pp fmt "ref.eq"
-
-and pp_expr fmt instrs = pp_list ~pp_sep:pp_newline pp_instr fmt instrs
+    pf fmt "br_on_cast_fail %a %a %a" pp_indice id pp_nullable n pp_heap_type t
+  | Ref_eq -> pf fmt "ref.eq"
+
+and pp_expr fmt instrs = list ~sep:pp_newline pp_instr fmt instrs
+
+let rec iter_expr f (e : _ expr) = List.iter (iter_instr f) e
+
+and iter_instr f (i : _ instr) =
+  f i;
+  match i with
+  | I32_const _ | I64_const _ | F32_const _ | F64_const _
+  | I_unop (_, _)
+  | F_unop (_, _)
+  | I_binop (_, _)
+  | F_binop (_, _)
+  | I_testop (_, _)
+  | I_relop (_, _)
+  | F_relop (_, _)
+  | I_extend8_s _ | I_extend16_s _ | I64_extend32_s | I32_wrap_i64
+  | I64_extend_i32 _
+  | I_trunc_f (_, _, _)
+  | I_trunc_sat_f (_, _, _)
+  | F32_demote_f64 | F64_promote_f32
+  | F_convert_i (_, _, _)
+  | I_reinterpret_f (_, _)
+  | F_reinterpret_i (_, _)
+  | Ref_null _ | Ref_is_null | Ref_i31 | Ref_func _ | Ref_as_non_null
+  | Ref_cast (_, _)
+  | Ref_test (_, _)
+  | Ref_eq | Drop | Select _ | Local_get _ | Local_set _ | Local_tee _
+  | Global_get _ | Global_set _ | Table_get _ | Table_set _ | Table_size _
+  | Table_grow _ | Table_fill _
+  | Table_copy (_, _)
+  | Table_init (_, _)
+  | Elem_drop _
+  | I_load (_, _)
+  | F_load (_, _)
+  | I_store (_, _)
+  | F_store (_, _)
+  | I_load8 (_, _, _)
+  | I_load16 (_, _, _)
+  | I64_load32 (_, _)
+  | I_store8 (_, _)
+  | I_store16 (_, _)
+  | I64_store32 _ | Memory_size | Memory_grow | Memory_fill | Memory_copy
+  | Memory_init _ | Data_drop _ | Nop | Unreachable | Br _ | Br_if _
+  | Br_table (_, _)
+  | Br_on_cast (_, _, _)
+  | Br_on_cast_fail (_, _, _)
+  | Br_on_non_null _ | Br_on_null _ | Return | Return_call _
+  | Return_call_indirect (_, _)
+  | Return_call_ref _ | Call _
+  | Call_indirect (_, _)
+  | Call_ref _ | Array_get _ | Array_get_u _ | Array_len | Array_new _
+  | Array_new_data (_, _)
+  | Array_new_default _
+  | Array_new_elem (_, _)
+  | Array_new_fixed (_, _)
+  | Array_set _ | I31_get_u | I31_get_s
+  | Struct_get (_, _)
+  | Struct_get_s (_, _)
+  | Struct_new _ | Struct_new_default _
+  | Struct_set (_, _)
+  | Extern_externalize | Extern_internalize ->
+    ()
+  | Block (_, _, e) | Loop (_, _, e) -> iter_expr f e
+  | If_else (_, _, e1, e2) ->
+    iter_expr f e1;
+    iter_expr f e2
 
 (* TODO: func and expr should also be parametrised on block type:
    using (param_type, result_type) M.block_type before simplify and directly an indice after *)
@@ -2374,25 +2994,24 @@ 
44.91%

   ; id : string option
   }
 
-let pp_local fmt (id, t) = pp fmt "(local%a %a)" pp_id_opt id pp_val_type t
+let pp_local fmt (id, t) = pf fmt "(local%a %a)" pp_id_opt id pp_val_type t
 
-let pp_locals fmt locals = pp_list ~pp_sep:pp_space pp_local fmt locals
+let pp_locals fmt locals = list ~sep:sp pp_local fmt locals
 
 let pp_func : type kind. formatter -> kind func -> unit =
  fun fmt f ->
   (* TODO: typeuse ? *)
-  pp fmt "(func%a%a%a@\n  @[<v>%a@]@\n)" pp_id_opt f.id pp_block_type f.type_f
-    (with_space_list pp_locals)
+  pf fmt "(func%a%a%a@\n  @[<v>%a@]@\n)" pp_id_opt f.id pp_block_type f.type_f
+    (with_space_list pp_locals)
     f.locals pp_expr f.body
 
-let pp_funcs fmt (funcs : 'a func list) =
-  pp_list ~pp_sep:pp_newline pp_func fmt funcs
+let pp_funcs fmt (funcs : 'a func list) = list ~sep:pp_newline pp_func fmt funcs
 
 (* Tables & Memories *)
 
 type 'a table = string option * 'a table_type
 
-let pp_table fmt (id, ty) = pp fmt "(table%a %a)" pp_id_opt id pp_table_type ty
+let pp_table fmt (id, ty) = pf fmt "(table%a %a)" pp_id_opt id pp_table_type ty
 
 (* Modules *)
 
@@ -2402,22 +3021,25 @@ 
44.91%

   | Import_mem of string option * limits
   | Import_global of string option * 'a global_type
 
-let import_desc fmt : 'a import_desc -> Unit.t = function
-  | Import_func (id, t) -> pp fmt "(func%a %a)" pp_id_opt id pp_block_type t
-  | Import_table (id, t) -> pp fmt "(table%a %a)" pp_id_opt id pp_table_type t
-  | Import_mem (id, t) -> pp fmt "(memory%a %a)" pp_id_opt id pp_limits t
+let import_desc fmt : 'a import_desc -> Unit.t = function
+  | Import_func (id, t) -> pf fmt "(func%a %a)" pp_id_opt id pp_block_type t
+  | Import_table (id, t) -> pf fmt "(table%a %a)" pp_id_opt id pp_table_type t
+  | Import_mem (id, t) -> pf fmt "(memory%a %a)" pp_id_opt id pp_limits t
   | Import_global (id, t) ->
-    pp fmt "(global%a %a)" pp_id_opt id pp_global_type t
+    pf fmt "(global%a %a)" pp_id_opt id pp_global_type t
 
 type 'a import =
-  { modul : string
-  ; name : string
+  { modul : string  (** The name of the module from which the import is done *)
+  ; name : string  (** The name of the importee in its module of origin *)
   ; desc : 'a import_desc
+      (** If this import_desc first field is Some s, the importee is made
+          available under name s, else it can only be used via its numerical
+          index.*)
   }
 
 let pp_import fmt i =
-  pp fmt {|(import "%a" "%a" %a)|} pp_string i.modul pp_string i.name
-    import_desc i.desc
+  pf fmt {|(import "%a" "%a" %a)|} string i.modul string i.name import_desc
+    i.desc
 
 type 'a export_desc =
   | Export_func of 'a indice option
@@ -2426,10 +3048,10 @@ 
44.91%

   | Export_global of 'a indice option
 
 let pp_export_desc fmt = function
-  | Export_func id -> pp fmt "(func %a)" pp_indice_opt id
-  | Export_table id -> pp fmt "(table %a)" pp_indice_opt id
-  | Export_mem id -> pp fmt "(memory %a)" pp_indice_opt id
-  | Export_global id -> pp fmt "(global %a)" pp_indice_opt id
+  | Export_func id -> pf fmt "(func %a)" pp_indice_opt id
+  | Export_table id -> pf fmt "(table %a)" pp_indice_opt id
+  | Export_mem id -> pf fmt "(memory %a)" pp_indice_opt id
+  | Export_global id -> pf fmt "(global %a)" pp_indice_opt id
 
 type 'a export =
   { name : string
@@ -2437,7 +3059,7 @@ 
44.91%

   }
 
 let pp_export fmt (e : text export) =
-  pp fmt {|(export "%s" %a)|} e.name pp_export_desc e.desc
+  pf fmt {|(export "%s" %a)|} e.name pp_export_desc e.desc
 
 type 'a storage_type =
   | Val_storage_t of 'a val_type
@@ -2447,26 +3069,40 @@ 
44.91%

   | Val_storage_t t -> pp_val_type fmt t
   | Val_packed_t t -> pp_packed_type fmt t
 
+let storage_type_eq t1 t2 =
+  match (t1, t2) with
+  | Val_storage_t t1, Val_storage_t t2 -> val_type_eq t1 t2
+  | Val_packed_t t1, Val_packed_t t2 -> packed_type_eq t1 t2
+  | _, _ -> false
+
 type 'a field_type = mut * 'a storage_type
 
 let pp_field_type fmt (m, t) =
   match m with
-  | Const -> pp fmt " %a" pp_storage_type t
-  | Var -> pp fmt "(%a %a)" pp_mut m pp_storage_type t
+  | Const -> pf fmt " %a" pp_storage_type t
+  | Var -> pf fmt "(%a %a)" pp_mut m pp_storage_type t
+
+let field_type_eq t1 t2 =
+  match (t1, t2) with
+  | (Const, t1), (Const, t2) | (Var, t1), (Var, t2) -> storage_type_eq t1 t2
+  | _, _ -> false
 
 type 'a struct_field = string option * 'a field_type list
 
-let pp_fields fmt = pp_list ~pp_sep:pp_space pp_field_type fmt
+let pp_fields fmt = list ~sep:sp pp_field_type fmt
 
 let pp_struct_field fmt ((n : string option), f) =
-  pp fmt "@\n  @[<v>(field%a%a)@]" pp_id_opt n pp_fields f
+  pf fmt "@\n  @[<v>(field%a%a)@]" pp_id_opt n pp_fields f
+
+let struct_field_eq (_, t1) (_, t2) = List.equal field_type_eq t1 t2
 
 type 'a struct_type = 'a struct_field list
 
-let pp_struct_type fmt =
-  pp fmt "(struct %a)" (pp_list ~pp_sep:pp_space pp_struct_field)
+let pp_struct_type fmt = pf fmt "(struct %a)" (list ~sep:sp pp_struct_field)
+
+let struct_type_eq t1 t2 = List.equal struct_field_eq t1 t2
 
-let pp_array_type fmt = pp fmt "(array %a)" pp_field_type
+let pp_array_type fmt = pf fmt "(array %a)" pp_field_type
 
 type 'a str_type =
   | Def_struct_t of 'a struct_type
@@ -2476,27 +3112,41 @@ 
44.91%

 let str_type fmt = function
   | Def_struct_t t -> pp_struct_type fmt t
   | Def_array_t t -> pp_array_type fmt t
-  | Def_func_t t -> pp_func_type fmt t
+  | Def_func_t t -> pp_func_type fmt t
+
+let str_type_eq t1 t2 =
+  match (t1, t2) with
+  | Def_struct_t t1, Def_struct_t t2 -> struct_type_eq t1 t2
+  | Def_array_t t1, Def_array_t t2 -> field_type_eq t1 t2
+  | Def_func_t t1, Def_func_t t2 -> func_type_eq t1 t2
+  | _, _ -> false
+
+let compare_str_type t1 t2 =
+  match (t1, t2) with
+  | Def_func_t t1, Def_func_t t2 -> compare_func_type t1 t2
+  | _, _ -> assert false
 
 type 'a sub_type = final * 'a indice list * 'a str_type
 
 let pp_sub_type fmt (f, ids, t) =
-  pp fmt "(sub %a %a %a)" pp_final f pp_indices ids str_type t
+  pf fmt "(sub %a %a %a)" pp_final f pp_indices ids str_type t
 
 type 'a type_def = string option * 'a sub_type
 
-let pp_type_def fmt (id, t) =
-  pp fmt "@\n  @[<v>(type%a %a)@]" pp_id_opt id pp_sub_type t
+let pp_type_def_no_indent fmt (id, t) =
+  pf fmt "(type%a %a)" pp_id_opt id pp_sub_type t
+
+let pp_type_def fmt t = pf fmt "@\n  @[<v>%a@]" pp_type_def_no_indent t
 
 type 'a rec_type = 'a type_def list
 
 let pp_rec_type fmt l =
-  match l with
+  match l with
   | [] -> ()
-  | [ t ] -> pp_type_def fmt t
-  | l -> pp fmt "(rec %a)" (pp_list ~pp_sep:pp_space pp_type_def) l
+  | [ t ] -> pf fmt "@\n%a" pp_type_def_no_indent t
+  | l -> pf fmt "(rec %a)" (list ~sep:sp pp_type_def) l
 
-let pp_start fmt start = pp fmt "(start %a)" pp_indice start
+let pp_start fmt start = pf fmt "(start %a)" pp_indice start
 
 type 'a const =
   | Const_I32 of Int32.t
@@ -2512,23 +3162,23 @@ 
44.91%

   | Const_struct
 
 let pp_const fmt c =
-  pp fmt "(%a)"
+  pf fmt "(%a)"
     (fun fmt c ->
       match c with
-      | Const_I32 i -> pp fmt "i32.const %ld" i
-      | Const_I64 i -> pp fmt "i64.const %Ld" i
-      | Const_F32 f -> pp fmt "f32.const %a" Float32.pp f
-      | Const_F64 f -> pp fmt "f64.const %a" Float64.pp f
-      | Const_null rt -> pp fmt "ref.null %a" pp_heap_type rt
-      | Const_host i -> pp fmt "ref.host %d" i
-      | Const_extern i -> pp fmt "ref.extern %d" i
-      | Const_array -> pp fmt "ref.array"
-      | Const_eq -> pp fmt "ref.eq"
-      | Const_i31 -> pp fmt "ref.i31"
-      | Const_struct -> pp fmt "ref.struct" )
+      | Const_I32 i -> pf fmt "i32.const %ld" i
+      | Const_I64 i -> pf fmt "i64.const %Ld" i
+      | Const_F32 f -> pf fmt "f32.const %a" Float32.pp f
+      | Const_F64 f -> pf fmt "f64.const %a" Float64.pp f
+      | Const_null rt -> pf fmt "ref.null %a" pp_heap_type rt
+      | Const_host i -> pf fmt "ref.host %d" i
+      | Const_extern i -> pf fmt "ref.extern %d" i
+      | Const_array -> pf fmt "ref.array"
+      | Const_eq -> pf fmt "ref.eq"
+      | Const_i31 -> pf fmt "ref.i31"
+      | Const_struct -> pf fmt "ref.struct" )
     c
 
-let pp_consts fmt c = pp_list ~pp_sep:pp_space pp_const fmt c
+let pp_consts fmt c = list ~sep:sp pp_const fmt c
diff --git a/coverage/src/bin/owi.ml.html b/coverage/src/bin/owi.ml.html index c31879037..b86dbe1ec 100644 --- a/coverage/src/bin/owi.ml.html +++ b/coverage/src/bin/owi.ml.html @@ -3,7 +3,7 @@ owi.ml — Coverage report - + @@ -15,56 +15,58 @@

src/bin/owi.ml

-

78.76%

+

80.08%

@@ -95,17 +97,17 @@

78.76%

- + - + - + - - + + @@ -113,44 +115,44 @@

78.76%

- + - - + + - - + + - + - - + + - + - - - + + + - + - + - + @@ -159,225 +161,263 @@

78.76%

- - - + + + - + - + - + - + - + - + - + - + - + - - + + - + - - + + - - - + + + - + - + - + - + - - - - + + + + - + - + - + - + - + - + - + - + - - - + + + - + - - + + - + - - - - + + + + - + - + - - + + - + - + - - - - + + + + - + - + - + - - + + - + - - - - - - - + + + + + + + - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + - + - + - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
@@ -690,6 +730,44 @@

78.76%

306 307 308 +309 +310 +311 +312 +313 +314 +315 +316 +317 +318 +319 +320 +321 +322 +323 +324 +325 +326 +327 +328 +329 +330 +331 +332 +333 +334 +335 +336 +337 +338 +339 +340 +341 +342 +343 +344 +345 +346 
(* SPDX-License-Identifier: AGPL-3.0-or-later *)
 (* Copyright © 2021-2024 OCamlPro *)
@@ -699,14 +777,14 @@ 
78.76%

 
 let debug =
   let doc = "debug mode" in
-  Cmdliner.Arg.(value & flag & info [ "debug"; "d" ] ~doc)
+  Cmdliner.Arg.(value & flag & info [ "debug"; "d" ] ~doc)
 
 let existing_non_dir_file =
   let parse s =
-    let path = Fpath.v s in
-    match Bos.OS.File.exists path with
-    | Ok true -> `Ok path
-    | Ok false -> `Error (Format.asprintf "no file '%a'" Fpath.pp path)
+    let path = Fpath.v s in
+    match Bos.OS.File.exists path with
+    | Ok true -> `Ok path
+    | Ok false -> `Error (Fmt.str "no file '%a'" Fpath.pp path)
     | Error (`Msg s) -> `Error s
   in
   (parse, Fpath.pp)
@@ -715,58 +793,80 @@ 
78.76%

   let parse s = `Ok (Fpath.v s) in
   (parse, Fpath.pp)
 
+let solver_conv =
+  Cmdliner.Arg.conv
+    ( Smtml.Solver_dispatcher.solver_type_of_string
+    , Smtml.Solver_dispatcher.pp_solver_type )
+
+let deterministic_result_order =
+  let doc =
+    "Guarantee a fixed deterministic order of found failures. This implies \
+     --no-stop-at-failure."
+  in
+  Cmdliner.Arg.(value & flag & info [ "deterministic-result-order" ] ~doc)
+
 let files =
   let doc = "source files" in
   let f = existing_non_dir_file in
-  Cmdliner.Arg.(value & pos_all f [] (info [] ~doc))
+  Cmdliner.Arg.(value & pos_all f [] (info [] ~doc))
 
 let no_exhaustion =
   let doc = "no exhaustion tests" in
-  Cmdliner.Arg.(value & flag & info [ "no-exhaustion" ] ~doc)
+  Cmdliner.Arg.(value & flag & info [ "no-exhaustion" ] ~doc)
 
 let no_stop_at_failure =
   let doc = "do not stop when a program failure is encountered" in
-  Cmdliner.Arg.(value & flag & info [ "no-stop-at-failure" ] ~doc)
+  Cmdliner.Arg.(value & flag & info [ "no-stop-at-failure" ] ~doc)
 
 let no_values =
   let doc = "do not display a value for each symbol" in
-  Cmdliner.Arg.(value & flag & info [ "no-value" ] ~doc)
+  Cmdliner.Arg.(value & flag & info [ "no-value" ] ~doc)
 
-let deterministic_result_order =
-  let doc =
-    "Guarantee a fixed deterministic order of found failures. This implies \
-     --no-stop-at-failure."
-  in
-  Cmdliner.Arg.(value & flag & info [ "deterministic-result-order" ] ~doc)
+let fail_mode =
+  let trap_doc = "ignore assertion violations and only report traps" in
+  let assert_doc = "ignore traps and only report assertion violations" in
+  Cmdliner.Arg.(
+    value
+    & vflag `Both
+        [ (`Trap_only, info [ "fail-on-trap-only" ] ~doc:trap_doc)
+        ; (`Assertion_only, info [ "fail-on-assertion-only" ] ~doc:assert_doc)
+        ] )
 
 let optimize =
   let doc = "optimize mode" in
-  Cmdliner.Arg.(value & flag & info [ "optimize" ] ~doc)
+  Cmdliner.Arg.(value & flag & info [ "optimize" ] ~doc)
 
 let profiling =
   let doc = "profiling mode" in
-  Cmdliner.Arg.(value & flag & info [ "profiling"; "p" ] ~doc)
+  Cmdliner.Arg.(value & flag & info [ "profiling"; "p" ] ~doc)
+
+let solver =
+  let doc = "SMT solver to use" in
+  Cmdliner.Arg.(
+    value
+    & opt solver_conv Smtml.Solver_dispatcher.Z3_solver
+    & info [ "solver"; "s" ] ~doc )
 
 let unsafe =
   let doc = "skip typechecking pass" in
-  Cmdliner.Arg.(value & flag & info [ "unsafe"; "u" ] ~doc)
+  Cmdliner.Arg.(value & flag & info [ "unsafe"; "u" ] ~doc)
 
 let workers =
   let doc =
-    "number of workers for symbolic execution. Defaults to a machine-specific \
-     value given by the OCaml Domain.recommended_domain_count function."
+    "number of workers for symbolic execution. Defaults to the number of \
+     physical cores."
   in
   Cmdliner.Arg.(
     value
-    & opt int (Domain.recommended_domain_count ())
-    & info [ "workers"; "w" ] ~doc ~absent:"n" )
+    & opt int Processor.Query.core_count
+    & info [ "workers"; "w" ] ~doc ~absent:"n" )
 
 let workspace =
   let doc = "path to the workspace directory" in
   Cmdliner.Arg.(
-    value & opt dir_file (Fpath.v "owi-out") & info [ "workspace" ] ~doc )
+    value & opt dir_file (Fpath.v "owi-out") & info [ "workspace" ] ~doc )
 
-let copts_t = Cmdliner.Term.(const [])
+let copts_t = Cmdliner.Term.(const [])
 
 let sdocs = Cmdliner.Manpage.s_common_options
 
@@ -782,132 +882,144 @@ 
78.76%

       "Compile a C file to Wasm and run the symbolic interpreter on it"
     in
     let man = [] @ shared_man in
-    Cmd.info "c" ~version ~doc ~sdocs ~man
+    Cmd.info "c" ~version ~doc ~sdocs ~man
   in
   let arch =
     let doc = "data model" in
-    Arg.(value & opt int 32 & info [ "arch"; "m" ] ~doc)
+    Arg.(value & opt int 32 & info [ "arch"; "m" ] ~doc)
   in
   let property =
     let doc = "property file" in
-    Arg.(value & opt (some string) None & info [ "property" ] ~doc)
+    Arg.(value & opt (some string) None & info [ "property" ] ~doc)
   in
   let includes =
     let doc = "headers path" in
-    Arg.(value & opt_all dir_file [] & info [ "I" ] ~doc)
+    Arg.(value & opt_all dir_file [] & info [ "I" ] ~doc)
   in
   let opt_lvl =
     let doc = "specify which optimization level to use" in
-    Arg.(value & opt string "0" & info [ "O" ] ~doc)
+    Arg.(value & opt string "3" & info [ "O" ] ~doc)
   in
   let testcomp =
     let doc = "test-comp mode" in
-    Arg.(value & flag & info [ "testcomp" ] ~doc)
+    Arg.(value & flag & info [ "testcomp" ] ~doc)
   in
   let output =
     let doc = "write results to dir" in
-    Arg.(value & opt string "owi-out" & info [ "output"; "o" ] ~doc)
+    Arg.(value & opt string "owi-out" & info [ "output"; "o" ] ~doc)
   in
   let concolic =
     let doc = "concolic mode" in
-    Arg.(value & flag & info [ "concolic" ] ~doc)
+    Arg.(value & flag & info [ "concolic" ] ~doc)
   in
-  Cmd.v info
+  Cmd.v info
     Term.(
-      const Cmd_c.cmd $ debug $ arch $ property $ testcomp $ output $ workers
-      $ opt_lvl $ includes $ files $ profiling $ unsafe $ optimize
-      $ no_stop_at_failure $ no_values $ deterministic_result_order $ concolic )
+      const Cmd_c.cmd $ debug $ arch $ property $ testcomp $ output $ workers
+      $ opt_lvl $ includes $ files $ profiling $ unsafe $ optimize
+      $ no_stop_at_failure $ no_values $ deterministic_result_order $ fail_mode
+      $ concolic $ solver )
 
 let fmt_cmd =
   let open Cmdliner in
   let info =
     let doc = "Format a .wat or .wast file" in
     let man = [] @ shared_man in
-    Cmd.info "fmt" ~version ~doc ~sdocs ~man
+    Cmd.info "fmt" ~version ~doc ~sdocs ~man
   in
   let inplace =
     let doc = "Format in-place, overwriting input file" in
-    Cmdliner.Arg.(value & flag & info [ "inplace"; "i" ] ~doc)
+    Cmdliner.Arg.(value & flag & info [ "inplace"; "i" ] ~doc)
   in
-  Cmd.v info Term.(const Cmd_fmt.cmd $ inplace $ files)
+  Cmd.v info Term.(const Cmd_fmt.cmd $ inplace $ files)
 
 let opt_cmd =
   let open Cmdliner in
   let info =
     let doc = "Optimize a module" in
     let man = [] @ shared_man in
-    Cmd.info "opt" ~version ~doc ~sdocs ~man
+    Cmd.info "opt" ~version ~doc ~sdocs ~man
   in
-  Cmd.v info Term.(const Cmd_opt.cmd $ debug $ unsafe $ files)
+  Cmd.v info Term.(const Cmd_opt.cmd $ debug $ unsafe $ files)
 
 let run_cmd =
   let open Cmdliner in
   let info =
     let doc = "Run the concrete interpreter" in
     let man = [] @ shared_man in
-    Cmd.info "run" ~version ~doc ~sdocs ~man
+    Cmd.info "run" ~version ~doc ~sdocs ~man
   in
-  Cmd.v info
-    Term.(const Cmd_run.cmd $ profiling $ debug $ unsafe $ optimize $ files)
+  Cmd.v info
+    Term.(const Cmd_run.cmd $ profiling $ debug $ unsafe $ optimize $ files)
 
 let validate_cmd =
   let open Cmdliner in
   let info =
     let doc = "Validate a module" in
     let man = [] @ shared_man in
-    Cmd.info "validate" ~version ~doc ~sdocs ~man
+    Cmd.info "validate" ~version ~doc ~sdocs ~man
   in
-  Cmd.v info Term.(const Cmd_validate.cmd $ debug $ files)
+  Cmd.v info Term.(const Cmd_validate.cmd $ debug $ files)
 
 let script_cmd =
   let open Cmdliner in
   let info =
     let doc = "Run a reference test suite script" in
     let man = [] @ shared_man in
-    Cmd.info "script" ~version ~doc ~sdocs ~man
+    Cmd.info "script" ~version ~doc ~sdocs ~man
   in
-  Cmd.v info
+  Cmd.v info
     Term.(
-      const Cmd_script.cmd $ profiling $ debug $ optimize $ files
-      $ no_exhaustion )
+      const Cmd_script.cmd $ profiling $ debug $ optimize $ files
+      $ no_exhaustion )
 
 let sym_cmd =
   let open Cmdliner in
   let info =
     let doc = "Run the symbolic interpreter" in
     let man = [] @ shared_man in
-    Cmd.info "sym" ~version ~doc ~sdocs ~man
+    Cmd.info "sym" ~version ~doc ~sdocs ~man
   in
-  Cmd.v info
+  Cmd.v info
     Term.(
-      const Cmd_sym.cmd $ profiling $ debug $ unsafe $ optimize $ workers
-      $ no_stop_at_failure $ no_values $ deterministic_result_order $ workspace
-      $ files )
+      const Cmd_sym.cmd $ profiling $ debug $ unsafe $ optimize $ workers
+      $ no_stop_at_failure $ no_values $ deterministic_result_order $ fail_mode
+      $ workspace $ solver $ files )
 
 let conc_cmd =
   let open Cmdliner in
   let info =
     let doc = "Run the concolic interpreter" in
     let man = [] @ shared_man in
-    Cmd.info "conc" ~version ~doc ~sdocs ~man
+    Cmd.info "conc" ~version ~doc ~sdocs ~man
   in
-  Cmd.v info
+  Cmd.v info
     Term.(
-      const Cmd_conc.cmd $ profiling $ debug $ unsafe $ optimize $ workers
-      $ no_stop_at_failure $ no_values $ deterministic_result_order $ workspace
-      $ files )
+      const Cmd_conc.cmd $ profiling $ debug $ unsafe $ optimize $ workers
+      $ no_stop_at_failure $ no_values $ deterministic_result_order $ fail_mode
+      $ workspace $ solver $ files )
 
 let wasm2wat_cmd =
   let open Cmdliner in
   let info =
     let doc =
-      "Generate a text format file (.wat) file from a binary format file \
-       (.wasm)"
+      "Generate a text format file (.wat) from a binary format file (.wasm)"
+    in
+    let man = [] @ shared_man in
+    Cmd.info "wasm2wat" ~version ~doc ~sdocs ~man
+  in
+  Cmd.v info Term.(const Cmd_wasm2wat.cmd $ files)
+
+let wat2wasm_cmd =
+  let open Cmdliner in
+  let info =
+    let doc =
+      "Generate a binary format file (.wasm) from a text format file (.wat)"
     in
     let man = [] @ shared_man in
-    Cmd.info "wasm2wat" ~version ~doc ~sdocs ~man
+    Cmd.info "wat2wasm" ~version ~doc ~sdocs ~man
   in
-  Cmd.v info Term.(const Cmd_wasm2wat.cmd $ files)
+  Cmd.v info
+    Term.(const Cmd_wat2wasm.cmd $ profiling $ debug $ unsafe $ optimize $ files)
 
 let cli =
   let open Cmdliner in
@@ -915,12 +1027,12 @@ 
78.76%

     let doc = "OCaml WebAssembly Interpreter" in
     let sdocs = Manpage.s_common_options in
     let man = [ `S Manpage.s_bugs; `P "Email them to <contact@ndrs.fr>." ] in
-    Cmd.info "owi" ~version ~doc ~sdocs ~man
+    Cmd.info "owi" ~version ~doc ~sdocs ~man
   in
   let default =
-    Term.(ret (const (fun (_ : _ list) -> `Help (`Plain, None)) $ copts_t))
+    Term.(ret (const (fun (_ : _ list) -> `Help (`Plain, None)) $ copts_t))
   in
-  Cmd.group info ~default
+  Cmd.group info ~default
     [ c_cmd
     ; fmt_cmd
     ; opt_cmd
@@ -930,18 +1042,19 @@ 
78.76%

     ; conc_cmd
     ; validate_cmd
     ; wasm2wat_cmd
+    ; wat2wasm_cmd
     ]
 
 let exit_code =
   let open Cmdliner.Cmd.Exit in
   match Cmdliner.Cmd.eval_value cli with
-  | Ok (`Help | `Version) -> ok
-  | Ok (`Ok result) -> begin
+  | Ok (`Help | `Version) -> ok
+  | Ok (`Ok result) -> begin
     match result with
-    | Ok () -> ok
-    | Error e -> begin
-      Format.pp_err "%s" (Result.err_to_string e);
-      match e with
+    | Ok () -> ok
+    | Error e -> begin
+      Fmt.epr "%s" (Result.err_to_string e);
+      match e with
       | `No_error -> ok
       | `Alignment_too_large -> 1
       | `Assert_failure -> 2
@@ -949,13 +1062,13 @@ 
78.76%

       | `Call_stack_exhausted -> 4
       | `Constant_expression_required -> 5
       | `Constant_out_of_range -> 6
-      | `Did_not_fail_but_expected _ -> 7
+      | `Did_not_fail_but_expected _ -> 7
       | `Duplicate_export_name -> 8
       | `Duplicate_global _id -> 9
       | `Duplicate_local _id -> 10
       | `Duplicate_memory _id -> 11
       | `Duplicate_table _id -> 12
-      | `Found_bug _count -> 13
+      | `Found_bug _count -> 13
       | `Global_is_immutable -> 14
       | `Illegal_escape _txt -> 15
       | `Import_after_function -> 16
@@ -965,7 +1078,7 @@ 
78.76%

       | `Incompatible_import_type -> 20
       | `Inline_function_type -> 21
       | `Invalid_result_arity -> 22
-      | `Lexer_unknown_operator _op -> 23
+      | `Lexer_unknown_operator _op -> 23
       | `Malformed_utf8_encoding _txt -> 24
       | `Memory_size_too_large -> 25
       | `Msg _msg -> 26
@@ -981,22 +1094,25 @@ 
78.76%

       | `Unbound_module _id -> 37
       | `Unbound_name _id -> 38
       | `Undeclared_function_reference -> 39
-      | `Unexpected_token -> 40
-      | `Unknown_function _id -> 41
-      | `Unknown_global -> 42
-      | `Unknown_import _ -> 43
-      | `Unknown_label -> 44
-      | `Unknown_local _id -> 45
-      | `Unknown_memory _id -> 46
-      | `Unknown_module _id -> 47
-      | `Unknown_operator -> 48
-      | `Unknown_type -> 49
-      | `Unsupported_file_extension _ext -> 50
-      | `Failed_with_but_expected (_got, _expected) -> 51
+      | `Unexpected_token _token -> 40
+      | `Unknown_data _id -> 41
+      | `Unknown_elem _id -> 42
+      | `Unknown_func _id -> 43
+      | `Unknown_global _id -> 44
+      | `Unknown_import _ -> 45
+      | `Unknown_label _id -> 46
+      | `Unknown_local _id -> 47
+      | `Unknown_memory _id -> 48
+      | `Unknown_module _id -> 49
+      | `Unknown_operator -> 50
+      | `Unknown_table _id -> 51
+      | `Unknown_type _id -> 52
+      | `Unsupported_file_extension _ext -> 53
+      | `Failed_with_but_expected (_got, _expected) -> 54
     end
   end
-  | Error e -> (
-    match e with `Term -> 122 | `Parse -> cli_error | `Exn -> internal_error )
+  | Error e -> (
+    match e with `Term -> 122 | `Parse -> cli_error | `Exn -> internal_error )
 
 let () = exit exit_code
diff --git a/coverage/src/binary_to_text/binary_to_text.ml.html b/coverage/src/binary_to_text/binary_to_text.ml.html deleted file mode 100644 index 6454b2388..000000000 --- a/coverage/src/binary_to_text/binary_to_text.ml.html +++ /dev/null @@ -1,702 +0,0 @@ - - - - - binary_to_text.ml — Coverage report - - - - - - - - -
-
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
-
-
-
- 
-  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
-
-
(* SPDX-License-Identifier: AGPL-3.0-or-later *)
-(* Copyright © 2021-2024 OCamlPro *)
-(* Written by the Owi programmers *)
-
-open Binary
-open Text
-open Types
-
-let convert_indice (t : binary indice) : text indice =
-  match t with Raw _ as t -> t
-
-let convert_heap_type (t : binary heap_type) : text heap_type =
-  match t with
-  | ( Any_ht | None_ht | Eq_ht | I31_ht | Struct_ht | Array_ht | Func_ht
-    | No_func_ht | Extern_ht | No_extern_ht ) as t ->
-    t
-  | Def_ht id -> Def_ht (convert_indice id)
-
-let convert_ref_type (t : binary ref_type) : text ref_type =
-  let nullable, heap_type = t in
-  (nullable, convert_heap_type heap_type)
-
-let convert_val_type (t : binary val_type) : text val_type =
-  match t with
-  | Num_type _ as t -> t
-  | Ref_type t -> Ref_type (convert_ref_type t)
-
-let convert_global_type (t : binary global_type) : text global_type =
-  let mut, vt = t in
-  (mut, convert_val_type vt)
-
-let convert_param (p : binary param) : text param =
-  let id, vt = p in
-  (id, convert_val_type vt)
-
-let convert_param_type (pt : binary param_type) : text param_type =
-  List.map convert_param pt
-
-let convert_result_type (rt : binary result_type) : text result_type =
-  List.map convert_val_type rt
-
-let convert_block_type (bt : binary block_type) : text block_type =
-  match bt with
-  | Bt_raw (opt, (pt, rt)) ->
-    let opt =
-      match opt with None -> None | Some i -> Some (convert_indice i)
-    in
-    let pt = convert_param_type pt in
-    let rt = convert_result_type rt in
-    Bt_raw (opt, (pt, rt))
-
-let convert_expr (e : binary expr) : text expr =
-  (* TODO: proper conversion ! *)
-  Obj.magic e
-
-let convert_table_type (t : binary table_type) : text table_type =
-  let limits, t = t in
-  (limits, convert_ref_type t)
-
-let convert_table (t : binary table) : text table =
-  let id, t = t in
-  (id, convert_table_type t)
-
-let convert_elem_mode (e : Binary.elem_mode) : Text.elem_mode =
-  match e with
-  | Elem_passive -> Elem_passive
-  | Elem_declarative -> Elem_declarative
-  | Elem_active (opt, e) ->
-    let opt = Option.map (fun i -> Raw i) opt in
-    let e = convert_expr e in
-    Elem_active (opt, e)
-
-let convert_elem (e : Binary.elem) : Text.elem =
-  let { Binary.id; typ; init; mode } = e in
-  let typ = convert_ref_type typ in
-  let init = List.map convert_expr init in
-  let mode = convert_elem_mode mode in
-  { id; typ; init; mode }
-
-let convert_data_mode (m : Binary.data_mode) : Text.data_mode =
-  match m with
-  | Data_passive -> Data_passive
-  | Data_active (i, e) ->
-    let i = Option.map (fun i -> Raw i) i in
-    let e = convert_expr e in
-    Data_active (i, e)
-
-let convert_data (e : Binary.data) : Text.data =
-  let { Binary.id; init; mode } : Binary.data = e in
-  let mode = convert_data_mode mode in
-  { id; init; mode }
-
-let from_global (global : (Binary.global, binary global_type) Runtime.t Named.t)
-  : Text.module_field list =
-  Named.fold
-    (fun _i (g : (Binary.global, binary global_type) Runtime.t) acc ->
-      match g with
-      | Runtime.Local g ->
-        let typ = convert_global_type g.typ in
-        let init = convert_expr g.init in
-        let id = g.id in
-        MGlobal { typ; init; id } :: acc
-      | Imported { modul; name; assigned_name; desc } ->
-        let desc = Import_global (assigned_name, convert_global_type desc) in
-        MImport { modul; name; desc } :: acc )
-    global []
-
-let from_table (table : (binary table, binary table_type) Runtime.t Named.t) :
-  Text.module_field list =
-  Named.fold
-    (fun _i (t : (binary table, binary table_type) Runtime.t) acc ->
-      match t with
-      | Runtime.Local t ->
-        let t = convert_table t in
-        MTable t :: acc
-      | Imported { modul; name; assigned_name; desc } ->
-        let desc = Import_table (assigned_name, convert_table_type desc) in
-        MImport { modul; name; desc } :: acc )
-    table []
-
-let from_mem (mem : (mem, limits) Runtime.t Named.t) : Text.module_field list =
-  Named.fold
-    (fun _i mem acc ->
-      match mem with
-      | Runtime.Local mem -> MMem mem :: acc
-      | Imported { modul; name; assigned_name; desc } ->
-        let desc = Import_mem (assigned_name, desc) in
-        MImport { modul; name; desc } :: acc )
-    mem []
-
-let from_func (func : (binary func, binary block_type) Runtime.t Named.t) :
-  Text.module_field list =
-  Named.fold
-    (fun _i (func : (binary func, binary block_type) Runtime.t) acc ->
-      match func with
-      | Runtime.Local func ->
-        let type_f = convert_block_type func.type_f in
-        let locals = convert_param_type func.locals in
-        let body = convert_expr func.body in
-        let id = func.id in
-        MFunc { type_f; locals; body; id } :: acc
-      | Imported { modul; name; assigned_name; desc } ->
-        let desc = Import_func (assigned_name, convert_block_type desc) in
-        MImport { modul; name; desc } :: acc )
-    func []
-
-let from_elem (elem : Binary.elem Named.t) : Text.module_field list =
-  Named.fold
-    (fun _i (elem : Binary.elem) acc ->
-      let elem = convert_elem elem in
-      MElem elem :: acc )
-    elem []
-
-let from_data (data : Binary.data Named.t) : Text.module_field list =
-  Named.fold
-    (fun _i (data : Binary.data) acc ->
-      let data = convert_data data in
-      MData data :: acc )
-    data []
-
-let from_exports (exports : Binary.exports) : Text.module_field list =
-  let global =
-    List.map
-      (fun { name; id } ->
-        let id = Some (Raw id) in
-        MExport { name; desc = Export_global id } )
-      exports.global
-  in
-
-  let mem =
-    List.map
-      (fun { name; id } ->
-        let id = Some (Raw id) in
-        MExport { name; desc = Export_mem id } )
-      exports.mem
-  in
-
-  let table =
-    List.map
-      (fun { name; id } ->
-        let id = Some (Raw id) in
-        MExport { name; desc = Export_table id } )
-      exports.table
-  in
-
-  let func =
-    List.map
-      (fun { name; id } ->
-        let id = Some (Raw id) in
-        MExport { name; desc = Export_func id } )
-      exports.func
-  in
-
-  global @ mem @ table @ func
-
-let from_start = function None -> [] | Some n -> [ MStart (Raw n) ]
-
-let modul { Binary.id; global; table; mem; func; elem; data; start; exports } =
-  let fields =
-    from_global global @ from_table table @ from_mem mem @ from_func func
-    @ from_elem elem @ from_data data @ from_exports exports @ from_start start
-  in
-  let imported, locals =
-    List.fold_left
-      (fun (imported, locals) -> function
-        | MImport _ as import -> (import :: imported, locals)
-        | local -> (imported, local :: locals) )
-      ([], []) fields
-  in
-  let fields = imported @ List.rev locals in
-
-  { Text.id; fields }
-
-
-
- - - diff --git a/coverage/src/c_processing/c_instrumentor.ml.html b/coverage/src/c_processing/c_instrumentor.ml.html deleted file mode 100644 index a1f136aa6..000000000 --- a/coverage/src/c_processing/c_instrumentor.ml.html +++ /dev/null @@ -1,111 +0,0 @@ - - - - - c_instrumentor.ml — Coverage report - - - - - - - - -
-
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
-
-
-
- 
- 1
- 2
- 3
- 4
- 5
- 6
- 7
- 8
- 9
-10
-11
-12
-13
-14
-15
-16
-17
-18
-19
-20
-21
-22
-23
-
-
(* SPDX-License-Identifier: AGPL-3.0-or-later *)
-(* Copyright © 2021-2024 OCamlPro *)
-(* Written by the Owi programmers *)
-
-let py_module = lazy (Py.Import.import_module "instrumentor")
-
-let import_module () = Lazy.force py_module
-
-let instrument file includes =
-  let callable = Py.Module.get (import_module ()) "instrument" in
-  let kwargs =
-    [ ("file", Py.String.of_string @@ Fpath.to_string file)
-    ; ( "includes"
-      , Py.List.of_list
-        @@ List.map
-             (fun path -> Py.String.of_string (Fpath.to_string path))
-             includes )
-    ]
-  in
-  let _ : Py.Object.t =
-    Py.Callable.to_function_with_keywords callable [||] kwargs
-  in
-  ()
-
-
-
- - - diff --git a/coverage/src/c_processing/c_share.ml.html b/coverage/src/c_processing/c_share.ml.html deleted file mode 100644 index e1f0585f6..000000000 --- a/coverage/src/c_processing/c_share.ml.html +++ /dev/null @@ -1,119 +0,0 @@ - - - - - c_share.ml — Coverage report - - - - - - - - -
-
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
-
-
-
- 
- 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
-
-
(* SPDX-License-Identifier: AGPL-3.0-or-later *)
-(* Copyright © 2021-2024 OCamlPro *)
-(* Written by the Owi programmers *)
-
-open Syntax
-
-let py_location = List.map Fpath.v C_share_site.Sites.pyc
-
-let bin_location = List.map Fpath.v C_share_site.Sites.binc
-
-let lib_location = List.map Fpath.v C_share_site.Sites.libc
-
-let find location file =
-  let* l =
-    list_map
-      (fun dir ->
-        let filename = Fpath.append dir file in
-        match Bos.OS.File.exists filename with
-        | Ok true -> Ok (Some filename)
-        | Ok false -> Ok None
-        | Error (`Msg msg) -> Error (`Msg msg) )
-      location
-  in
-  Ok (List.find (function None -> false | Some _filename -> true) l)
-
-let libc =
-  Option.get @@ Result.get_ok @@ find bin_location (Fpath.v "libc.wasm")
-
-
-
- - - diff --git a/coverage/src/cmd/cmd_c.ml.html b/coverage/src/cmd/cmd_c.ml.html index e960bd0bf..8a7e271a0 100644 --- a/coverage/src/cmd/cmd_c.ml.html +++ b/coverage/src/cmd/cmd_c.ml.html @@ -3,7 +3,7 @@ cmd_c.ml — Coverage report - + @@ -15,19 +15,17 @@

src/cmd/cmd_c.ml

-

87.93%

+

87.23%

@@ -45,168 +43,127 @@

87.93%

- - + + - - + + - - + + - - + + - - - + + + - + - - + + - + - - - + + + - + - - - - + + + + - - - - - + + + + + - - + + - + - + - + - + - + - + - + - - - + + + - - - + + + - + - + - + - + - + - + - + - - + + - - + + - - - - + + + + - + - - + + - - + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +
@@ -345,47 +302,6 @@

87.93%

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 
(* SPDX-License-Identifier: AGPL-3.0-or-later *)
 (* Copyright © 2021-2024 OCamlPro *)
@@ -400,74 +316,35 @@ 
87.93%

   ; files : Fpath.t list
   }
 
-let pre_patterns : (Re2.t * string) array =
-  Array.map
-    (fun (regex, template) -> (Re2.create_exn regex, template))
-    [| ( "void\\s+reach_error\\(\\)\\s*\\{.*\\}"
-       , "void reach_error() { owi_assert(0); }" )
-       (* ugly: Hack to solve duplicate errors on compilation *)
-       (* ; ("void\\s+(assert|assume)\\(", "void old_\\1(") *)
-    |]
+let binc_location = List.map Fpath.v C_share_site.Sites.binc
 
-let patch_with_regex ~patterns (data : string) : string =
-  Array.fold_left
-    (fun data (regex, template) -> Re2.rewrite_exn regex ~template data)
-    data patterns
+let libc_location = List.map Fpath.v C_share_site.Sites.libc
 
-let patch ~src ~dst : unit Result.t =
-  let* data = OS.File.read src in
-  let data = patch_with_regex ~patterns:pre_patterns data in
-  let data =
-    String.concat "\n"
-      [ "#define __attribute__(x)"
-      ; "#define __extension__"
-      ; "#define __restrict"
-      ; "#define __inline"
-      ; "#include <owi.h>"
-      ; data
-      ]
+let find location file : Fpath.t Result.t =
+  let* l =
+    list_map
+      (fun dir ->
+        let filename = Fpath.append dir file in
+        match Bos.OS.File.exists filename with
+        | Ok true -> Ok (Some filename)
+        | Ok false -> Ok None
+        | Error (`Msg msg) -> Error (`Msg msg) )
+      location
   in
-  OS.File.write dst data
-
-let copy ~src ~dst : Fpath.t Result.t =
-  let* data = OS.File.read src in
-  let+ () = OS.File.write dst data in
-  dst
-
-let instrument_file ?(skip = false) ~includes ~workspace file : Fpath.t Result.t
-    =
-  let dst = Fpath.(workspace // base (file -+ ".c")) in
-  if skip then copy ~src:file ~dst
-  else begin
-    Logs.app (fun m -> m "instrumenting %a" Fpath.pp file);
-    let* () = patch ~src:file ~dst in
-    let pypath =
-      Format.asprintf "%a"
-        (Format.pp_list
-           ~pp_sep:(fun fmt () -> Format.pp_char fmt ':')
-           Fpath.pp )
-        C_share.py_location
-    in
-    let+ () = OS.Env.set_var "PYTHONPATH" (Some pypath) in
-    begin
-      try
-        Py.initialize ();
-        C_instrumentor.instrument dst includes;
-        Py.finalize ()
-      with Py.E (errtype, errvalue) ->
-        let pp = Py.Object.format in
-        Logs.warn (fun m -> m "instrumentor: %a: %a" pp errtype pp errvalue)
-    end;
-    dst
-  end
+  let rec loop = function
+    | [] -> Error (`Msg (Fmt.str "can't find file %a" Fpath.pp file))
+    | None :: tl -> loop tl
+    | Some file :: _tl -> Ok file
+  in
+  loop l
 
 let compile ~includes ~opt_lvl (files : Fpath.t list) : Fpath.t Result.t =
-  let flags =
+  let flags =
     let stack_size = 8 * 1024 * 1024 |> string_of_int in
-    let includes = Cmd.of_list ~slip:"-I" (List.map Fpath.to_string includes) in
-    Cmd.(
-      of_list
-        [ "-O" ^ opt_lvl
+    let includes = Cmd.of_list ~slip:"-I" (List.map Fpath.to_string includes) in
+    Cmd.(
+      of_list
+        [ Fmt.str "-O%s" opt_lvl
         ; "--target=wasm32"
         ; "-m32"
         ; "-ffreestanding"
@@ -479,89 +356,87 @@ 
87.93%

         ; "-Wl,--export=main"
           (* TODO: allow this behind a flag, this is slooooow *)
         ; "-Wl,--lto-O0"
-        ; "-Wl,-z,stack-size=" ^ stack_size
+        ; Fmt.str "-Wl,-z,stack-size=%s" stack_size
         ]
-      %% includes )
+      %% includes )
   in
 
-  let* clang_bin = OS.Cmd.resolve @@ Cmd.v "clang" in
+  let* clang_bin = OS.Cmd.resolve @@ Cmd.v "clang" in
 
-  let out = Fpath.(v "a.out.wasm") in
-  let files = Cmd.of_list (List.map Fpath.to_string (C_share.libc :: files)) in
-  let clang : Bos.Cmd.t = Cmd.(clang_bin %% flags % "-o" % p out %% files) in
+  let out = Fpath.(v "a.out.wasm") in
 
-  let+ () = OS.Cmd.run clang in
+  let* libc = find binc_location (Fpath.v "libc.wasm") in
 
-  out
+  let files = Cmd.of_list (List.map Fpath.to_string (libc :: files)) in
+  let clang : Bos.Cmd.t = Cmd.(clang_bin %% flags % "-o" % p out %% files) in
+
+  let+ () = OS.Cmd.run clang in
+
+  out
 
 let pp_tm fmt Unix.{ tm_year; tm_mon; tm_mday; tm_hour; tm_min; tm_sec; _ } :
   unit =
-  Format.pp fmt "%04d-%02d-%02dT%02d:%02d:%02dZ" (tm_year + 1900) tm_mon tm_mday
+  Fmt.pf fmt "%04d-%02d-%02dT%02d:%02d:%02dZ" (tm_year + 1900) tm_mon tm_mday
     tm_hour tm_min tm_sec
 
 let metadata ~workspace arch property files : unit Result.t =
-  let out_metadata chan { arch; property; files } =
-    let o = Xmlm.make_output ~nl:true ~indent:(Some 2) (`Channel chan) in
-    let tag n = (("", n), []) in
-    let el n d = `El (tag n, [ `Data d ]) in
+  let out_metadata chan { arch; property; files } =
+    let o = Xmlm.make_output ~nl:true ~indent:(Some 2) (`Channel chan) in
+    let tag n = (("", n), []) in
+    let el n d = `El (tag n, [ `Data d ]) in
     let* spec =
-      match property with None -> Ok "" | Some f -> OS.File.read @@ Fpath.v f
+      match property with None -> Ok "" | Some f -> OS.File.read @@ Fpath.v f
     in
-    let file = String.concat " " (List.map Fpath.to_string files) in
-    let* hash =
-      list_fold_left
+    let file = String.concat " " (List.map Fpath.to_string files) in
+    let* hash =
+      list_fold_left
         (fun context file ->
-          match Bos.OS.File.read file with
+          match Bos.OS.File.read file with
           | Error (`Msg msg) -> Error (`Msg msg)
-          | Ok str -> Ok (Digestif.SHA256.feed_string context str) )
+          | Ok str -> Ok (Digestif.SHA256.feed_string context str) )
         Digestif.SHA256.empty files
     in
-    let hash = Digestif.SHA256.to_hex (Digestif.SHA256.get hash) in
-    let time = Unix.time () |> Unix.localtime in
-    let test_metadata =
+    let hash = Digestif.SHA256.to_hex (Digestif.SHA256.get hash) in
+    let time = Unix.time () |> Unix.localtime in
+    let test_metadata =
       `El
-        ( tag "test-metadata"
-        , [ el "sourcecodelang" "C"
-          ; el "producer" "owic"
-          ; el "specification" (String.trim spec)
-          ; el "programfile" file
-          ; el "programhash" hash
-          ; el "entryfunction" "main"
-          ; el "architecture" (Format.sprintf "%dbit" arch)
-          ; el "creationtime" (Format.asprintf "%a" pp_tm time)
+        ( tag "test-metadata"
+        , [ el "sourcecodelang" "C"
+          ; el "producer" "owic"
+          ; el "specification" (String.trim spec)
+          ; el "programfile" file
+          ; el "programhash" hash
+          ; el "entryfunction" "main"
+          ; el "architecture" (Fmt.str "%dbit" arch)
+          ; el "creationtime" (Fmt.str "%a" pp_tm time)
           ] )
     in
     let dtd =
       {xml|<!DOCTYPE test-metadata PUBLIC "+//IDN sosy-lab.org//DTD test-format test-metadata 1.1//EN" "https://sosy-lab.org/test-format/test-metadata-1.1.dtd">|xml}
     in
     Xmlm.output o (`Dtd (Some dtd));
-    Xmlm.output_tree Fun.id o test_metadata;
-    Ok ()
+    Xmlm.output_tree Fun.id o test_metadata;
+    Ok ()
   in
   let fpath = Fpath.(workspace / "test-suite" / "metadata.xml") in
-  let* (_exists : bool) = OS.Dir.create ~path:true (Fpath.parent fpath) in
-  let* res = OS.File.with_oc fpath out_metadata { arch; property; files } in
-  res
+  let* (_exists : bool) = OS.Dir.create ~path:true (Fpath.parent fpath) in
+  let* res = OS.File.with_oc fpath out_metadata { arch; property; files } in
+  res
 
-let cmd debug arch property testcomp workspace workers opt_lvl includes files
+let cmd debug arch property _testcomp workspace workers opt_lvl includes files
   profiling unsafe optimize no_stop_at_failure no_values
-  deterministic_result_order concolic : unit Result.t =
-  if debug then Logs.set_level (Some Debug);
-  let workspace = Fpath.v workspace in
-  let includes = C_share.lib_location @ includes in
-  let* (_exists : bool) = OS.Dir.create ~path:true workspace in
-  (* skip instrumentation if not in test-comp mode *)
-  let skip = (not testcomp) || Sys.getenv_opt "RUNNER_OS" = Some "macOS" in
-  let* (nfiles : Fpath.t list) =
-    list_map (instrument_file ~skip ~includes ~workspace) files
-  in
-  let* modul = compile ~includes ~opt_lvl nfiles in
-  let* () = metadata ~workspace arch property files in
-  let workspace = Fpath.(workspace / "test-suite") in
+  deterministic_result_order fail_mode concolic solver : unit Result.t =
+  if debug then Logs.set_level (Some Debug);
+  let workspace = Fpath.v workspace in
+  let includes = libc_location @ includes in
+  let* (_exists : bool) = OS.Dir.create ~path:true workspace in
+  let* modul = compile ~includes ~opt_lvl files in
+  let* () = metadata ~workspace arch property files in
+  let workspace = Fpath.(workspace / "test-suite") in
   let files = [ modul ] in
-  (if concolic then Cmd_conc.cmd else Cmd_sym.cmd)
+  (if concolic then Cmd_conc.cmd else Cmd_sym.cmd)
     profiling debug unsafe optimize workers no_stop_at_failure no_values
-    deterministic_result_order workspace files
+    deterministic_result_order fail_mode workspace solver files
diff --git a/coverage/src/cmd/cmd_conc.ml.html b/coverage/src/cmd/cmd_conc.ml.html index e4e1874cb..95070393c 100644 --- a/coverage/src/cmd/cmd_conc.ml.html +++ b/coverage/src/cmd/cmd_conc.ml.html @@ -3,7 +3,7 @@ cmd_conc.ml — Coverage report - + @@ -15,139 +15,97 @@

src/cmd/cmd_conc.ml

-

43.45%

+

56.28%

@@ -160,16 +118,16 @@

43.45%

- + - + - - + + - + @@ -177,63 +135,63 @@

43.45%

- - - - - - - - + + + + + + + + - + - - + + - - + + - - + + - - - - - - + + + + + + - - - + + + - + - - - + + + - - - + + + - + - - + + - - + + - - + + @@ -249,13 +207,13 @@

43.45%

- + - + @@ -273,149 +231,149 @@

43.45%

- - - + + + - - - + + + - + - + - - - + + + - - - + + + - + - - - + + + - - - + + + - + - + - - - + + + - + - + - + - - - - - - + + + + + + - - - - + + + + - - - + + + - - + + - - + + - - + + - - - + + + - - - + + + - + - + - + - + - - + + - - - + + + - - - - - - - + + + + + + + - - - - - - - - - - + + + + + + + + + + - - + + - + - - + + - + - + - - - + + + @@ -423,306 +381,197 @@

43.45%

- + - + - + - - - - - + + + + + - + - + - + - - + + - - + + - + - - + + - - - + + + - + - - - - - + + + + + - - - + + + - - - - - + + + + + - - - - - - - + + + + + + + - + - - - - + + + + - - - + + + - - + + - - + + - - - - + + + + - + - + - - + + - - + + - + - + - - - - + + + + - + - - - - + + + + - - - - + + + + - - + + - + - + - - - - + + + + - + - - - + + + - - - + + + - - + + - + - - + + - - - + + + - + - - + + - - - - + + + + - - + + - + - + - + - - - - - - + + + + + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
@@ -1189,380 +1038,74 @@

43.45%

460 461 462 -463 -464 -465 -466 -467 -468 -469 -470 -471 -472 -473 -474 -475 -476 -477 -478 -479 -480 -481 -482 -483 -484 -485 -486 -487 -488 -489 -490 -491 -492 -493 -494 -495 -496 -497 -498 -499 -500 -501 -502 -503 -504 -505 -506 -507 -508 -509 -510 -511 -512 -513 -514 -515 -516 -517 -518 -519 -520 -521 -522 -523 -524 -525 -526 -527 -528 -529 -530 -531 -532 -533 -534 -535 -536 -537 -538 -539 -540 -541 -542 -543 -544 -545 -546 -547 -548 -549 -550 -551 -552 -553 -554 -555 -556 -557 -558 -559 -560 -561 -562 -563 -564 -565 -566 -567 -568 -569 -570 -571 
(* SPDX-License-Identifier: AGPL-3.0-or-later *)
 (* Copyright © 2021-2024 OCamlPro *)
 (* Written by the Owi programmers *)
 
 open Syntax
-module Expr = Smtml.Expr
-module Value = Concolic_value.V
 module Choice = Concolic.P.Choice
 
 (* let () = Random.self_init () *)
-let () = Random.init 42
+let () = Random.init 42
 
 let debug = false
 
-let symbolic_extern_module :
-  Concolic.P.Extern_func.extern_func Link.extern_module =
-  let symbol_i32 () : Value.int32 Choice.t =
-    Choice.with_new_symbol (Ty_bitv 32) (fun sym forced_value ->
-        let n =
-          match forced_value with
-          | None -> Random.bits32 ()
-          | Some (Num (I32 n)) -> n
-          | _ -> assert false
-        in
-        (I32 n, Value.pair n (Expr.mk_symbol sym)) )
-  in
-  let symbol_i8 () : Value.int32 Choice.t =
-    Choice.with_new_symbol (Ty_bitv 32) (fun sym forced_value ->
-        let n =
-          match forced_value with
-          | None -> Int32.logand 0xFFl (Random.bits32 ())
-          | Some (Num (I32 n)) -> n
-          | _ -> assert false
-        in
-        let sym_expr =
-          Expr.make (Cvtop (Ty_bitv 32, Zero_extend 24, Expr.mk_symbol sym))
-        in
-        (I32 n, Value.pair n sym_expr) )
-  in
-  let symbol_i64 () : Value.int64 Choice.t =
-    Choice.with_new_symbol (Ty_bitv 64) (fun sym forced_value ->
-        let n =
-          match forced_value with
-          | None -> Random.bits64 ()
-          | Some (Num (I64 n)) -> n
-          | _ -> assert false
-        in
-        (I64 n, Value.pair n (Expr.mk_symbol sym)) )
-  in
-  let symbol_f32 () : Value.float32 Choice.t =
-    Choice.with_new_symbol (Ty_fp 32) (fun sym forced_value ->
-        let n =
-          match forced_value with
-          | None -> Random.bits32 ()
-          | Some (Num (F32 n)) -> n
-          | _ -> assert false
-        in
-        let n = Float32.of_bits n in
-        (F32 n, Value.pair n (Expr.mk_symbol sym)) )
-  in
-  let symbol_f64 () : Value.float64 Choice.t =
-    Choice.with_new_symbol (Ty_fp 64) (fun sym forced_value ->
-        let n =
-          match forced_value with
-          | None -> Random.bits64 ()
-          | Some (Num (F64 n)) -> n
-          | _ -> assert false
-        in
-        let n = Float64.of_bits n in
-        (F64 n, Value.pair n (Expr.mk_symbol sym)) )
-  in
-  let assume_i32 (i : Value.int32) : unit Choice.t =
-    let c = Value.I32.to_bool i in
-    Concolic_choice.assume c
-  in
-  let assume_positive_i32 (i : Value.int32) : unit Choice.t =
-    let c = Value.I32.ge i Value.I32.zero in
-    Concolic_choice.assume c
-  in
-  let assert_i32 (i : Value.int32) : unit Choice.t =
-    let c = Value.I32.to_bool i in
-    Concolic_choice.assertion c
-  in
-  (* we need to describe their types *)
-  let functions =
-    [ ( "i8_symbol"
-      , Concolic.P.Extern_func.Extern_func (Func (UArg Res, R1 I32), symbol_i8)
-      )
-    ; ( "i32_symbol"
-      , Concolic.P.Extern_func.Extern_func (Func (UArg Res, R1 I32), symbol_i32)
-      )
-    ; ( "i64_symbol"
-      , Concolic.P.Extern_func.Extern_func (Func (UArg Res, R1 I64), symbol_i64)
-      )
-    ; ( "f32_symbol"
-      , Concolic.P.Extern_func.Extern_func (Func (UArg Res, R1 F32), symbol_f32)
-      )
-    ; ( "f64_symbol"
-      , Concolic.P.Extern_func.Extern_func (Func (UArg Res, R1 F64), symbol_f64)
-      )
-    ; ( "assume"
-      , Concolic.P.Extern_func.Extern_func
-          (Func (Arg (I32, Res), R0), assume_i32) )
-    ; ( "assume_positive_i32"
-      , Concolic.P.Extern_func.Extern_func
-          (Func (Arg (I32, Res), R0), assume_positive_i32) )
-    ; ( "assert"
-      , Concolic.P.Extern_func.Extern_func
-          (Func (Arg (I32, Res), R0), assert_i32) )
-    ]
-  in
-  { functions }
-
-let summaries_extern_module :
-  Concolic.P.Extern_func.extern_func Link.extern_module =
-  let open Expr in
-  let i32 (v : Value.int32) =
-    (* TODO: select_i32 ? *)
-    (* let+ v = Choice.select_i32 v in *)
-    (* let n = v.c in *)
-    (* let x = Choice.assume (Value.I32.eq v (Value.const_i32 n)) in *)
-    match view v.symbolic with
-    | Val (Num (I32 v)) -> v
-    | _ ->
-      Log.err {|alloc: cannot allocate base pointer "%a"|} Expr.pp v.symbolic
-  in
-  let ptr (v : Value.int32) =
-    match view v.symbolic with
-    | Ptr (b, _) -> b
-    | _ ->
-      Log.err {|free: cannot fetch pointer base of "%a"|} Expr.pp v.symbolic
-  in
-  let abort () : unit Choice.t = Choice.abort in
-  let alloc (base : Value.int32) (_size : Value.int32) : Value.int32 Choice.t =
-    let base : int32 = i32 base in
-    Choice.return
-      { Concolic_value.concrete = base
-      ; symbolic = Expr.make (Ptr (base, Symbolic_value.const_i32 0l))
-      }
-    (* WHAT ???? *)
-    (* Choice.with_thread (fun t : Value.int32 -> *)
-    (*     let memories = t.shared.memories in *)
-    (*     Symbolic_memory.iter *)
-    (*       (fun tbl -> *)
-    (*         Symbolic_memory.ITbl.iter *)
-    (*           (fun _ (m : Symbolic_memory.t) -> *)
-    (*             Symbolic_memory.replace_size m base size.s ) *)
-    (*           tbl ) *)
-    (*       memories; *)
-    (*     { c = base; s = Expr.make (Ptr (base, Symbolic_value.const_i32 0l)) }) *)
-  in
-  let free (p : Value.int32) : unit Choice.t =
-    (* WHAT ???? *)
-    let _base = ptr p in
-    (* Choice.with_thread (fun t -> *)
-    (*     let memories = t.shared.memories in *)
-    (*     Symbolic_memory.iter *)
-    (*       (fun tbl -> *)
-    (*         Symbolic_memory.ITbl.iter *)
-    (*           (fun _ (m : Symbolic_memory.t) -> Symbolic_memory.free m base) *)
-    (*           tbl ) *)
-    (*       memories ) *)
-    Choice.return ()
-  in
-  let functions =
-    [ ( "alloc"
-      , Concolic.P.Extern_func.Extern_func
-          (Func (Arg (I32, Arg (I32, Res)), R1 I32), alloc) )
-    ; ( "dealloc"
-      , Concolic.P.Extern_func.Extern_func (Func (Arg (I32, Res), R0), free) )
-    ; ("abort", Concolic.P.Extern_func.Extern_func (Func (UArg Res, R0), abort))
-    ]
-  in
-  { functions }
-
 let ( let** ) (t : 'a Result.t Choice.t) (f : 'a -> 'b Result.t Choice.t) :
   'b Result.t Choice.t =
-  Choice.bind t (fun t ->
-      match t with Error e -> Choice.return (Error e) | Ok x -> f x )
-
-let simplify_then_link_text_module ~unsafe ~optimize link_state (m : Text.modul)
-    =
-  let has_start =
-    List.exists (function Text.MStart _ -> true | _ -> false) m.fields
-  in
-  let has_start_id_function =
-    List.exists
-      (function Text.MFunc { id = Some "_start"; _ } -> true | _ -> false)
-      m.fields
-  in
-  let fields =
-    if has_start || not has_start_id_function then m.fields
-    else MStart (Text "_start") :: m.fields
-  in
-  let m = { m with fields } in
-  Compile.Text.until_link ~unsafe link_state ~optimize ~name:None m
-
-let simplify_then_link_binary_module ~unsafe ~optimize link_state
-  (m : Binary.modul) =
-  let start =
-    if Option.is_some m.start then m.start
-    else
-      match
-        List.find_opt
-          (function { Binary.name = "_start"; _ } -> true | _ -> false)
-          m.exports.func
-      with
-      | None -> None
-      | Some export -> Some export.id
-  in
-  let m = { m with start } in
-  Compile.Binary.until_link ~unsafe link_state ~optimize ~name:None m
+  Choice.bind t (fun t ->
+      match t with Error e -> Choice.return (Error e) | Ok x -> f x )
 
 let simplify_then_link ~unsafe ~optimize link_state m =
-  let+ m, link_state =
+  let* m =
     match m with
-    | Either.Left (Either.Left text_module) ->
-      simplify_then_link_text_module ~unsafe ~optimize link_state text_module
-    | Either.Left (Either.Right _text_script) ->
-      Error (`Msg "can't run concolic interpreter on a script")
-    | Either.Right binary_module ->
-      simplify_then_link_binary_module ~unsafe ~optimize link_state
-        binary_module
+    | Kind.Wat _ | Wasm _ -> Compile.Any.until_typecheck ~unsafe m
+    | Wast _ -> Error (`Msg "can't run concolic interpreter on a script")
+    | Ocaml _ -> assert false
+  in
+  let* m = Cmd_utils.add_main_as_start m in
+  let+ m, link_state =
+    Compile.Binary.until_link ~unsafe link_state ~optimize ~name:None m
   in
-  let module_to_run = Concolic.convert_module_to_run m in
-  (link_state, module_to_run)
+  let module_to_run = Concolic.convert_module_to_run m in
+  (link_state, module_to_run)
 
 let simplify_then_link_files ~unsafe ~optimize filenames =
-  let link_state = Link.empty_state in
+  let link_state = Link.empty_state in
   let link_state =
     Link.extern_module' link_state ~name:"symbolic"
-      ~func_typ:Concolic.P.Extern_func.extern_type symbolic_extern_module
+      ~func_typ:Concolic.P.Extern_func.extern_type
+      Concolic_wasm_ffi.symbolic_extern_module
   in
-  let link_state =
+  let link_state =
     Link.extern_module' link_state ~name:"summaries"
-      ~func_typ:Concolic.P.Extern_func.extern_type summaries_extern_module
+      ~func_typ:Concolic.P.Extern_func.extern_type
+      Concolic_wasm_ffi.summaries_extern_module
   in
-  let+ link_state, modules_to_run =
-    List.fold_left
+  let+ link_state, modules_to_run =
+    List.fold_left
       (fun (acc : (_ * _) Result.t) filename ->
-        let* link_state, modules_to_run = acc in
-        let* m0dule = Parse.guess_from_file filename in
-        let+ link_state, module_to_run =
-          simplify_then_link ~unsafe ~optimize link_state m0dule
+        let* link_state, modules_to_run = acc in
+        let* m0dule = Parse.guess_from_file filename in
+        let+ link_state, module_to_run =
+          simplify_then_link ~unsafe ~optimize link_state m0dule
         in
-        (link_state, module_to_run :: modules_to_run) )
+        (link_state, module_to_run :: modules_to_run) )
       (Ok (link_state, []))
       filenames
   in
-  (link_state, List.rev modules_to_run)
+  (link_state, List.rev modules_to_run)
 
 let run_modules_to_run (link_state : _ Link.state) modules_to_run =
-  List.fold_left
+  List.fold_left
     (fun (acc : unit Result.t Concolic.P.Choice.t) to_run ->
-      let** () = acc in
-      (Interpret.Concolic.modul link_state.envs) to_run )
-    (Choice.return (Ok ())) modules_to_run
+      let** () = acc in
+      (Interpret.Concolic.modul link_state.envs) to_run )
+    (Choice.return (Ok ())) modules_to_run
 
-let get_model (* ~symbols *) solver pc =
-  let expr = Concolic_choice.pc_to_exprs pc in
-  assert (`Sat = Solver.Z3Batch.check solver expr);
-  match Solver.Z3Batch.model (* ~symbols *) solver with
-  | None -> assert false
-  | Some model -> model
+let get_model ~symbols solver pc =
+  let pc = Concolic_choice.pc_to_exprs pc in
+  Solver.model ~symbols ~pc solver
 
 type assignments = (Smtml.Symbol.t * Concrete_value.t) list
 
@@ -1578,7 +1121,31 @@ 
43.45%

   ; end_of_trace : end_of_trace
   }
 
-module IMap = Map.Make (Stdlib.Int32)
+module IMap = Map.Make (Prelude.Int32)
+
+module Unexplored : sig
+  type t
+
+  val none : t -> bool
+
+  val zero : t
+
+  val one : t
+
+  val add : t -> t -> t
+end = struct
+  type t = int
+
+  let none t = t = 0
+
+  let zero = 0
+
+  let one = 1
+
+  let add a b = a + b
+end
+
+type unexplored = Unexplored.t
 
 type node =
   | Select of
@@ -1604,48 +1171,96 @@ 
43.45%

 
 and eval_tree =
   { mutable node : node
+  ; mutable unexplored : unexplored
   ; pc : Concolic_choice.pc
   ; mutable ends : (end_of_trace * assignments) list
   }
 
-let fresh_tree pc = { node = Not_explored; pc; ends = [] }
+let rec rec_count_unexplored tree =
+  match tree.node with
+  | Select { if_true; if_false; _ } ->
+    Unexplored.add
+      (rec_count_unexplored if_true)
+      (rec_count_unexplored if_false)
+  | Select_i32 { branches; _ } ->
+    IMap.fold
+      (fun _ branch -> Unexplored.add (rec_count_unexplored branch))
+      branches Unexplored.zero
+  | Assume { cont; _ } | Assert { cont; _ } -> rec_count_unexplored cont
+  | Unreachable -> Unexplored.zero
+  | Not_explored -> Unexplored.one
+
+let _ = rec_count_unexplored
+
+let count_unexplored tree =
+  match tree.node with
+  | Select { if_true; if_false; _ } ->
+    Unexplored.add if_true.unexplored if_false.unexplored
+  | Select_i32 { branches; _ } ->
+    IMap.fold
+      (fun _ branch -> Unexplored.add branch.unexplored)
+      branches Unexplored.zero
+  | Assume { cont; _ } | Assert { cont; _ } -> cont.unexplored
+  | Unreachable -> Unexplored.zero
+  | Not_explored -> Unexplored.one
+
+let update_unexplored tree = tree.unexplored <- count_unexplored tree
+
+let update_node tree node =
+  tree.node <- node;
+  update_unexplored tree
+
+let fresh_tree pc =
+  { node = Not_explored; unexplored = Unexplored.one; pc; ends = [] }
 
 let new_node pc (head : Concolic_choice.pc_elt) : node =
-  match head with
-  | Select (cond, _) ->
-    Select { cond; if_true = fresh_tree pc; if_false = fresh_tree pc }
+  match head with
+  | Select (cond, _) ->
+    Select
+      { cond
+      ; if_true = fresh_tree (Select (cond, true) :: pc)
+      ; if_false = fresh_tree (Select (cond, false) :: pc)
+      }
   | Select_i32 (value, _) -> Select_i32 { value; branches = IMap.empty }
-  | Assume cond -> Assume { cond; cont = fresh_tree pc }
-  | Assert cond -> Assert { cond; cont = fresh_tree pc; disproved = None }
+  | Assume cond -> Assume { cond; cont = fresh_tree (Assume cond :: pc) }
+  | Assert cond ->
+    Assert { cond; cont = fresh_tree (Assert cond :: pc); disproved = None }
 
 let try_initialize pc node head =
-  match node.node with Not_explored -> node.node <- new_node pc head | _ -> ()
+  match node.node with
+  | Not_explored -> update_node node (new_node pc head)
+  | _ -> ()
 
 let check = true
 
-let rec add_trace pc node (trace : trace) =
-  match trace.remaining_pc with
-  | [] -> begin
+let rec add_trace pc node (trace : trace) to_update : eval_tree list =
+  match trace.remaining_pc with
+  | [] -> begin
     node.ends <- (trace.end_of_trace, trace.assignments) :: node.ends;
-    match trace.end_of_trace with
-    | Trap Unreachable -> begin
-      match node.node with
-      | Not_explored -> node.node <- Unreachable
-      | Unreachable -> ()
-      | _ -> assert false
-    end
-    | _ -> ()
+    let () =
+      match trace.end_of_trace with
+      | Trap Unreachable -> begin
+        match node.node with
+        | Not_explored -> node.node <- Unreachable
+        | Unreachable -> ()
+        | _ -> assert false
+      end
+      | _ -> ()
+    in
+    node :: to_update
   end
-  | head_of_trace :: tail_of_trace -> (
+  | head_of_trace :: tail_of_trace -> (
     try_initialize pc node head_of_trace;
-    let pc = head_of_trace :: pc in
+    let pc = head_of_trace :: pc in
     match (node.node, head_of_trace) with
     | Not_explored, _ -> assert false
     | Unreachable, _ -> assert false
-    | Select { cond; if_true; if_false }, Select (cond', v) ->
-      if check then assert (Smtml.Expr.equal cond cond');
-      let branch = if v then if_true else if_false in
-      add_trace pc branch { trace with remaining_pc = tail_of_trace }
+    | Select { cond; if_true; if_false }, Select (cond', v) ->
+      if check then assert (Smtml.Expr.equal cond cond');
+      let branch = if v then if_true else if_false in
+      add_trace pc branch
+        { trace with remaining_pc = tail_of_trace }
+        (node :: to_update)
     | _, Select _ | Select _, _ -> assert false
     | Select_i32 { value; branches }, Select_i32 (value', v) ->
       if check then assert (Smtml.Expr.equal value value');
@@ -1653,15 +1268,20 @@ 
43.45%

         match IMap.find_opt v branches with
         | None ->
           let t = fresh_tree pc in
-          node.node <- Select_i32 { value; branches = IMap.add v t branches };
-          t
+          update_node node
+            (Select_i32 { value; branches = IMap.add v t branches });
+          t
         | Some t -> t
       in
-      add_trace pc branch { trace with remaining_pc = tail_of_trace }
+      add_trace pc branch
+        { trace with remaining_pc = tail_of_trace }
+        (node :: to_update)
     | _, Select_i32 _ | Select_i32 _, _ -> assert false
     | Assume { cond; cont }, Assume cond' ->
       if check then assert (Smtml.Expr.equal cond cond');
-      add_trace pc cont { trace with remaining_pc = tail_of_trace }
+      add_trace pc cont
+        { trace with remaining_pc = tail_of_trace }
+        (node :: to_update)
     | _, Assume _ | Assume _, _ -> assert false
     | Assert ({ cond; cont; disproved = _ } as assert_), Assert cond' ->
       if check then assert (Smtml.Expr.equal cond cond');
@@ -1670,13 +1290,18 @@ 
43.45%

         | [], Assert_fail -> assert_.disproved <- Some trace.assignments
         | _ -> ()
       end;
-      add_trace pc cont { trace with remaining_pc = tail_of_trace } )
+      add_trace pc cont
+        { trace with remaining_pc = tail_of_trace }
+        (node :: to_update) )
 
-let add_trace tree trace = add_trace [] tree trace
+let add_trace tree trace =
+  let to_update = add_trace [] tree trace [] in
+  List.iter update_unexplored to_update
 
 let run_once tree link_state modules_to_run forced_values =
-  let result = run_modules_to_run link_state modules_to_run in
-  let ( ( result
+  let backups = List.map Concolic.backup modules_to_run in
+  let result = run_modules_to_run link_state modules_to_run in
+  let ( ( result
         , Choice.
             { pc
             ; symbols = _
@@ -1685,121 +1310,130 @@ 
43.45%

             ; preallocated_values = _
             } ) as r ) =
     let forced_values =
-      match forced_values with None -> Hashtbl.create 0 | Some v -> v
+      match forced_values with None -> Hashtbl.create 0 | Some v -> v
     in
-    Choice.run forced_values result
+    Choice.run forced_values result
   in
-  let end_of_trace =
+  let () = List.iter2 Concolic.recover backups modules_to_run in
+  let end_of_trace =
     match result with
-    | Ok (Ok ()) -> Normal
+    | Ok (Ok ()) -> Normal
     | Ok (Error e) -> Result.failwith e
-    | Error (Trap t) -> Trap t
-    | Error Assert_fail -> Assert_fail
+    | Error (Trap t) -> Trap t
+    | Error Assert_fail -> Assert_fail
     | Error (Assume_fail _c) -> Assume_fail
   in
   let trace =
-    { assignments = symbols_value; remaining_pc = List.rev pc; end_of_trace }
+    { assignments = symbols_value; remaining_pc = List.rev pc; end_of_trace }
   in
   if debug then begin
-    Format.pp_std "Add trace:@\n";
-    Format.pp_std "%a@\n" Concolic_choice.pp_pc trace.remaining_pc
+    Fmt.pr "Add trace:@\n";
+    Fmt.pr "%a@\n" Concolic_choice.pp_pc trace.remaining_pc
   end;
-  add_trace tree trace;
-  r
+  add_trace tree trace;
+  r
 
 (* Very naive ! *)
 let rec find_node_to_run tree =
-  match tree.node with
-  | Not_explored ->
+  match tree.node with
+  | Not_explored ->
     if debug then begin
-      Format.pp_std "Try unexplored@.%a@.@." Concolic_choice.pp_pc tree.pc
+      Fmt.pr "Try unexplored@.%a@.@." Concolic_choice.pp_pc tree.pc
     end;
-    Some tree.pc
-  | Select { cond = _; if_true; if_false } ->
-    let b = Random.bool () in
-    if debug then begin
-      Format.pp_std "Select bool %b@." b
+    Some tree.pc
+  | Select { cond = _; if_true; if_false } ->
+    let b =
+      if Unexplored.none if_true.unexplored then false
+      else if Unexplored.none if_false.unexplored then true
+      else Random.bool ()
+    in
+    if debug then begin
+      Fmt.pr "Select bool %b@." b
     end;
-    let tree = if b then if_true else if_false in
+    let tree = if b then if_true else if_false in
     find_node_to_run tree
   | Select_i32 { value = _; branches } ->
     (* TODO: better ! *)
     let branches = IMap.bindings branches in
+    let branches =
+      List.filter (fun (_i, v) -> not (Unexplored.none v.unexplored)) branches
+    in
     let n = List.length branches in
     if n = 0 then None
     else begin
       let i = Random.int n in
+      let i, branch = List.nth branches i in
       if debug then begin
-        Format.pp_std "Select_i32 %i@." i
+        Fmt.pr "Select_i32 %li@." i
       end;
-      let _, branch = List.nth branches i in
       find_node_to_run branch
     end
   | Assume { cond = _; cont } -> find_node_to_run cont
   | Assert { cond; cont = _; disproved = None } ->
     let pc : Concolic_choice.pc = Select (cond, false) :: tree.pc in
-    Format.pp_std "Try Assert@.%a@.@." Concolic_choice.pp_pc pc;
+    Fmt.pr "Try Assert@.%a@.@." Concolic_choice.pp_pc pc;
     Some pc
   | Assert { cond = _; cont; disproved = Some _ } -> find_node_to_run cont
   | Unreachable ->
-    Format.pp_std "Unreachable (Retry)@.%a@." Concolic_choice.pp_pc tree.pc;
+    Fmt.pr "Unreachable (Retry)@.%a@." Concolic_choice.pp_pc tree.pc;
     None
 
 let pc_model solver pc =
-  let expr = Concolic_choice.pc_to_exprs pc in
-  match Solver.Z3Batch.check solver expr with
+  let pc = Concolic_choice.pc_to_exprs pc in
+  match Solver.check solver pc with
   | `Unsat | `Unknown -> None
-  | `Sat -> (
-    match Solver.Z3Batch.model solver with
-    | None -> assert false
-    | Some model -> Some model )
+  | `Sat ->
+    let symbols = None in
+    let model = Solver.model ~symbols ~pc solver in
+    Some model
 
 let find_model_to_run solver tree =
-  match find_node_to_run tree with
+  match find_node_to_run tree with
   | None -> None
-  | Some pc -> pc_model solver pc
+  | Some pc -> pc_model solver pc
 
 let launch solver tree link_state modules_to_run =
-  let rec find_model n =
-    if n = 0 then
-      let () = Format.pp_std "Failed to find something to run@." in
+  let rec find_model n =
+    if n = 0 then begin
+      Fmt.pr "Failed to find something to run@\n";
       None
+    end
     else
-      match find_model_to_run solver tree with
+      match find_model_to_run solver tree with
       | None -> find_model (n - 1)
-      | Some m ->
+      | Some m ->
         if debug then begin
-          Format.pp_std "Found something to run %a@."
-            (fun ppf v -> Smtml.Model.pp ppf v)
+          Fmt.pr "Found something to run %a@\n"
+            (Smtml.Model.pp ~no_values:false)
             m
         end;
-        Some m
+        Some m
   in
   let rec loop count =
-    if count <= 0 then None
+    if count <= 0 then None
     else
-      let model = find_model 20 in
-      run_model model count
+      let model = find_model 20 in
+      run_model model count
   and run_model model count =
-    let r, thread = run_once tree link_state modules_to_run model in
-    match r with
-    | Ok (Ok ()) -> loop (count - 1)
+    let r, thread = run_once tree link_state modules_to_run model in
+    match r with
+    | Ok (Ok ()) -> loop (count - 1)
     | Ok (Error e) -> Result.failwith e
     | Error (Assume_fail c) -> begin
       if debug then begin
-        Format.pp_std "Assume_fail: %a@\n" Smtml.Expr.pp c;
-        Format.pp_std "Assignments:@\n%a@\n" Concolic_choice.pp_assignments
+        Fmt.pr "Assume_fail: %a@\n" Smtml.Expr.pp c;
+        Fmt.pr "Assignments:@\n%a@\n" Concolic_choice.pp_assignments
           thread.symbols_value;
-        Format.pp_std "Retry !@\n"
+        Fmt.pr "Retry !@\n"
       end;
       match pc_model solver thread.pc with
       | None ->
-        Format.pp_err "Can't satisfy assume !@\n";
+        Fmt.epr "Can't satisfy assume !@\n";
         loop (count - 1)
-      | Some model -> run_model (Some model) (count - 1)
+      | Some _model as model -> run_model model (count - 1)
     end
-    | Error (Trap trap) -> Some (`Trap trap, thread)
-    | Error Assert_fail -> Some (`Assert_fail, thread)
+    | Error (Trap trap) -> Some (`Trap trap, thread)
+    | Error Assert_fail -> Some (`Assert_fail, thread)
   in
   loop 10
 
@@ -1807,69 +1441,66 @@ 
43.45%

    during evaluation (OS, syntax error, etc.), except for Trap and Assert,
    which are handled here. Most of the computations are done in the Result
    monad, hence the let*. *)
-let cmd profiling debug unsafe optimize workers no_stop_at_failure no_values
-  deterministic_result_order (workspace : Fpath.t) files =
-  ignore (workers, no_stop_at_failure, deterministic_result_order, workspace);
-
-  if profiling then Log.profiling_on := true;
-  if debug then Log.debug_on := true;
+let cmd profiling debug unsafe optimize _workers _no_stop_at_failure no_values
+  _deterministic_result_order _fail_mode (workspace : Fpath.t) solver files =
+  if profiling then Log.profiling_on := true;
+  if debug then Log.debug_on := true;
 
   (* deterministic_result_order implies no_stop_at_failure *)
   (* let no_stop_at_failure = deterministic_result_order || no_stop_at_failure in *)
-  let* _created_dir = Bos.OS.Dir.create ~path:true ~mode:0o755 workspace in
-  let solver = Solver.Z3Batch.create () in
-  let* link_state, modules_to_run =
-    simplify_then_link_files ~unsafe ~optimize files
+  let* _created_dir = Bos.OS.Dir.create ~path:true ~mode:0o755 workspace in
+  let solver = Solver.fresh solver () in
+  let* link_state, modules_to_run =
+    simplify_then_link_files ~unsafe ~optimize files
   in
-  let tree = fresh_tree [] in
-  let result = launch solver tree link_state modules_to_run in
+  let tree = fresh_tree [] in
+  let result = launch solver tree link_state modules_to_run in
 
-  let print_pc pc =
-    Format.pp_std "PC:@\n";
-    Format.pp_std "%a@\n" Concolic_choice.pp_pc pc
+  let print_pc pc =
+    Fmt.pr "PC:@\n";
+    Fmt.pr "%a@\n" Concolic_choice.pp_pc pc
   in
   let print_values symbols_value =
-    Format.pp_std "Assignments:@\n";
+    Fmt.pr "Assignments:@\n";
     List.iter
-      (fun (s, v) ->
-        Format.pp_std "  %a: %a" Smtml.Symbol.pp s Concrete_value.pp v )
+      (fun (s, v) -> Fmt.pr "  %a: %a" Smtml.Symbol.pp s Concrete_value.pp v)
       symbols_value;
-    Format.pp_std "@\n"
+    Fmt.pr "@\n"
   in
 
   let testcase model =
-    if not no_values then
-      let testcase =
-        List.sort compare (Smtml.Model.get_bindings model) |> List.map snd
-      in
-      Testcase.write_testcase ~dir:workspace ~err:true testcase
+    if not no_values then
+      let testcase = Smtml.Model.get_bindings model |> List.map snd in
+      Cmd_utils.write_testcase ~dir:workspace testcase
     else Ok ()
   in
 
   match result with
-  | None ->
-    Format.pp_std "OK@\n";
-    Ok ()
-  | Some (`Trap trap, thread) ->
-    Format.pp_std "Trap: %s@\n" (Trap.to_string trap);
-    if debug then begin
+  | None ->
+    Fmt.pr "OK@\n";
+    Ok ()
+  | Some (`Trap trap, thread) ->
+    Fmt.pr "Trap: %s@\n" (Trap.to_string trap);
+    if debug then begin
       print_pc thread.pc;
       print_values thread.symbols_value
     end;
-    let model = get_model solver thread.pc in
-    Format.pp_std "Model:@\n  @[<v>%a@]@." (Smtml.Model.pp ~no_values) model;
-    let* () = testcase model in
-    Error (`Found_bug 1)
-  | Some (`Assert_fail, thread) ->
-    Format.pp_std "Assert failure@\n";
-    if debug then begin
+    let symbols = None in
+    let model = get_model ~symbols solver thread.pc in
+    Fmt.pr "Model:@\n  @[<v>%a@]@." (Smtml.Model.pp ~no_values) model;
+    let* () = testcase model in
+    Error (`Found_bug 1)
+  | Some (`Assert_fail, thread) ->
+    Fmt.pr "Assert failure@\n";
+    if debug then begin
       print_pc thread.pc;
       print_values thread.symbols_value
     end;
-    let model = get_model solver thread.pc in
-    Format.pp_std "Model:@\n  @[<v>%a@]@." (Smtml.Model.pp ~no_values) model;
-    let* () = testcase model in
-    Error (`Found_bug 1)
+    let symbols = None in
+    let model = get_model ~symbols solver thread.pc in
+    Fmt.pr "Model:@\n  @[<v>%a@]@." (Smtml.Model.pp ~no_values) model;
+    let* () = testcase model in
+    Error (`Found_bug 1)
diff --git a/coverage/src/cmd/cmd_fmt.ml.html b/coverage/src/cmd/cmd_fmt.ml.html index 963310660..6d1bfde79 100644 --- a/coverage/src/cmd/cmd_fmt.ml.html +++ b/coverage/src/cmd/cmd_fmt.ml.html @@ -3,7 +3,7 @@ cmd_fmt.ml — Coverage report - + @@ -15,12 +15,12 @@

src/cmd/cmd_fmt.ml

-

81.48%

+

77.27%

@@ -47,22 +47,14 @@

81.48%

- + - - - - - - - - - - - - - - + + + + + +
@@ -96,14 +88,6 @@

81.48%

27 28 29 -30 -31 -32 -33 -34 -35 -36 -37 
(* SPDX-License-Identifier: AGPL-3.0-or-later *)
 (* Copyright © 2021-2024 OCamlPro *)
@@ -126,22 +110,14 @@ 
81.48%

   match get_printer file with
   | Error _e as e -> e
   | Ok pp ->
-    if inplace then
-      let* res =
-        Bos.OS.File.with_oc file
-          (fun chan () ->
-            let fmt = Stdlib.Format.formatter_of_out_channel chan in
-            Ok (Format.pp fmt "%a@\n" pp ()) )
-          ()
-      in
-      res
-    else Ok (Format.pp_std "%a@\n" pp ())
+    if inplace then Bos.OS.File.writef file "%a@\n" pp ()
+    else Ok (Fmt.pr "%a@\n" pp ())
 
 let cmd inplace files = list_iter (cmd_one inplace) files
 
 let format_file_to_string file =
   let+ pp = get_printer file in
-  Format.asprintf "%a@\n" pp ()
+  Fmt.str "%a@\n" pp ()
diff --git a/coverage/src/cmd/cmd_opt.ml.html b/coverage/src/cmd/cmd_opt.ml.html index 5a0516730..40cc5e905 100644 --- a/coverage/src/cmd/cmd_opt.ml.html +++ b/coverage/src/cmd/cmd_opt.ml.html @@ -3,7 +3,7 @@ cmd_opt.ml — Coverage report - + @@ -15,13 +15,10 @@

src/cmd/cmd_opt.ml

-

71.43%

+

87.50%

@@ -34,25 +31,15 @@

71.43%

- - - - + + + + - - - + + + - - - - - - - - - -
@@ -74,16 +61,6 @@

71.43%

15 16 17 -18 -19 -20 -21 -22 -23 -24 -25 -26 -27 
(* SPDX-License-Identifier: AGPL-3.0-or-later *)
 (* Copyright © 2021-2024 OCamlPro *)
@@ -92,25 +69,15 @@ 
71.43%

 open Syntax
 
 let optimize_file ~unsafe filename =
-  let* m = Parse.guess_from_file filename in
-  match m with
-  | Either.Left (Either.Left modul) ->
-    Compile.Text.until_optimize ~unsafe ~optimize:true modul
-  | Either.Left (Either.Right _script) ->
-    Error (`Msg "script can't be optimised")
-  | Either.Right modul ->
-    Compile.Binary.until_optimize ~unsafe ~optimize:true modul
+  Compile.File.until_optimize ~unsafe ~optimize:true filename
 
 let cmd debug unsafe files =
   if debug then Log.debug_on := true;
   list_iter
     (fun file ->
-      match optimize_file ~unsafe file with
-      | Ok m ->
-        let m = Binary_to_text.modul m in
-        Format.pp_std "%a@\n" Text.pp_modul m;
-        Ok ()
-      | Error _ as e -> e )
+      let+ m = optimize_file ~unsafe file in
+      let m = Binary_to_text.modul m in
+      Fmt.pr "%a@\n" Text.pp_modul m )
     files
diff --git a/coverage/src/cmd/cmd_run.ml.html b/coverage/src/cmd/cmd_run.ml.html index 6b5d65386..0b9e74e12 100644 --- a/coverage/src/cmd/cmd_run.ml.html +++ b/coverage/src/cmd/cmd_run.ml.html @@ -3,7 +3,7 @@ cmd_run.ml — Coverage report - + @@ -15,10 +15,10 @@

src/cmd/cmd_run.ml

-

92.86%

+

87.50%

@@ -31,28 +31,16 @@

92.86%

- - - + + + - - - - - - - - - - - - - - - + + +
@@ -75,18 +63,6 @@

92.86%

16 17 18 -19 -20 -21 -22 -23 -24 -25 -26 -27 -28 -29 -30 
(* SPDX-License-Identifier: AGPL-3.0-or-later *)
 (* Copyright © 2021-2024 OCamlPro *)
@@ -95,29 +71,17 @@ 
92.86%

 open Syntax
 
 let run_file ~unsafe ~optimize filename =
-  let* m = Parse.guess_from_file filename in
-  let name = None in
-  match m with
-  | Either.Left (Either.Left text_module) ->
-    let+ (_state : Concrete_value.Func.extern_func Link.state) =
-      Compile.Text.until_interpret Link.empty_state ~unsafe ~optimize ~name
-        text_module
-    in
-    ()
-  | Either.Left (Either.Right _text_script) ->
-    (* TODO: merge script and run cmd together and call script here *)
-    assert false
-  | Either.Right binary_module ->
-    let+ (_state : Concrete_value.Func.extern_func Link.state) =
-      Compile.Binary.until_interpret Link.empty_state ~unsafe ~optimize ~name
-        binary_module
-    in
-    ()
+  let name = None in
+  let+ (_ : _ Link.state) =
+    Compile.File.until_interpret ~unsafe ~optimize ~name Link.empty_state
+      filename
+  in
+  ()
 
 let cmd profiling debug unsafe optimize files =
-  if profiling then Log.profiling_on := true;
-  if debug then Log.debug_on := true;
-  list_iter (run_file ~unsafe ~optimize) files
+  if profiling then Log.profiling_on := true;
+  if debug then Log.debug_on := true;
+  list_iter (run_file ~unsafe ~optimize) files
diff --git a/coverage/src/cmd/cmd_script.ml.html b/coverage/src/cmd/cmd_script.ml.html index 0f4b1f1f5..b9985c270 100644 --- a/coverage/src/cmd/cmd_script.ml.html +++ b/coverage/src/cmd/cmd_script.ml.html @@ -66,14 +66,14 @@

77.78%

open Syntax let run_file exec filename = - let* script = Parse.Text.Script.from_file filename in - exec script + let* script = Parse.Text.Script.from_file filename in + exec script let cmd profiling debug optimize files no_exhaustion = - let exec = Script.exec ~no_exhaustion ~optimize in + let exec = Script.exec ~no_exhaustion ~optimize in if profiling then Log.profiling_on := true; - if debug then Log.debug_on := true; - list_iter (run_file exec) files + if debug then Log.debug_on := true; + list_iter (run_file exec) files diff --git a/coverage/src/cmd/cmd_sym.ml.html b/coverage/src/cmd/cmd_sym.ml.html index b66518f87..b800adb61 100644 --- a/coverage/src/cmd/cmd_sym.ml.html +++ b/coverage/src/cmd/cmd_sym.ml.html @@ -3,7 +3,7 @@ cmd_sym.ml — Coverage report - + @@ -15,28 +15,15 @@

src/cmd/cmd_sym.ml

-

85.29%

+

90.59%

@@ -53,92 +40,92 @@

85.29%

- - - - + + + + - + - + - - - + + + - - - - + + + + - - - + + + - - + + - + - + - + - - + + - - - - - - - + + + + + + + - - - + + + - + - + - + - + - - + + - + - + - - - - + + + + - + - - - - - - - - - + + + + + + + + + @@ -149,209 +136,20 @@

85.29%

- + - - - - - + + + + + - - - + + + - + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
@@ -478,195 +276,6 @@

85.29%

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 -232 -233 -234 -235 -236 -237 -238 -239 -240 -241 -242 -243 -244 -245 -246 -247 -248 -249 -250 -251 -252 -253 -254 -255 -256 -257 -258 -259 -260 -261 -262 -263 -264 -265 -266 -267 -268 -269 -270 -271 -272 -273 -274 -275 -276 -277 -278 -279 -280 -281 -282 -283 -284 -285 -286 -287 -288 -289 -290 -291 -292 -293 -294 -295 -296 -297 -298 -299 -300 -301 -302 -303 -304 -305 -306 -307 -308 -309 -310 -311 
(* SPDX-License-Identifier: AGPL-3.0-or-later *)
 (* Copyright © 2021-2024 OCamlPro *)
@@ -674,310 +283,121 @@ 
85.29%

 
 open Syntax
 module Expr = Smtml.Expr
-module Value = Symbolic_value
-module Choice = Symbolic.P.Choice
+module Choice = Symbolic_choice_with_memory
 
-let symbolic_extern_module :
-  Symbolic.P.Extern_func.extern_func Link.extern_module =
-  let sym_cnt = Atomic.make 0 in
-  let symbol ty () : Value.int32 Choice.t =
-    let id = Atomic.fetch_and_add sym_cnt 1 in
-    let sym = Format.kasprintf (Smtml.Symbol.make ty) "symbol_%d" id in
-    let sym_expr = Expr.mk_symbol sym in
-    Choice.with_thread (fun thread ->
-        thread.symbol_set <- sym :: thread.symbol_set;
-        match ty with
-        | Ty_bitv 8 -> Expr.make (Cvtop (Ty_bitv 32, Zero_extend 24, sym_expr))
-        | _ -> sym_expr )
-  in
-  let assume_i32 (i : Value.int32) : unit Choice.t =
-    let c = Value.I32.to_bool i in
-    Choice.add_pc c
-  in
-  let assume_positive_i32 (i : Value.int32) : unit Choice.t =
-    let c = Value.I32.ge i Value.I32.zero in
-    Choice.add_pc c
-  in
-  let assert_i32 (i : Value.int32) : unit Choice.t =
-    let c = Value.I32.to_bool i in
-    Choice.assertion c
-  in
-  (* we need to describe their types *)
-  let functions =
-    [ ( "i8_symbol"
-      , Symbolic.P.Extern_func.Extern_func
-          (Func (UArg Res, R1 I32), symbol (Ty_bitv 8)) )
-    ; ( "i32_symbol"
-      , Symbolic.P.Extern_func.Extern_func
-          (Func (UArg Res, R1 I32), symbol (Ty_bitv 32)) )
-    ; ( "i64_symbol"
-      , Symbolic.P.Extern_func.Extern_func
-          (Func (UArg Res, R1 I64), symbol (Ty_bitv 64)) )
-    ; ( "f32_symbol"
-      , Symbolic.P.Extern_func.Extern_func
-          (Func (UArg Res, R1 F32), symbol (Ty_fp 32)) )
-    ; ( "f64_symbol"
-      , Symbolic.P.Extern_func.Extern_func
-          (Func (UArg Res, R1 F64), symbol (Ty_fp 64)) )
-    ; ( "assume"
-      , Symbolic.P.Extern_func.Extern_func
-          (Func (Arg (I32, Res), R0), assume_i32) )
-    ; ( "assume_positive_i32"
-      , Symbolic.P.Extern_func.Extern_func
-          (Func (Arg (I32, Res), R0), assume_positive_i32) )
-    ; ( "assert"
-      , Symbolic.P.Extern_func.Extern_func
-          (Func (Arg (I32, Res), R0), assert_i32) )
-    ]
-  in
-  { functions }
-
-let summaries_extern_module :
-  Symbolic.P.Extern_func.extern_func Link.extern_module =
-  let open Expr in
-  let abort () : unit Choice.t = Choice.add_pc @@ Value.Bool.const false in
-
-  let i32 v : int32 Choice.t =
-    match view v with
-    | Val (Num (I32 v)) -> Choice.return v
-    | _ ->
-      Log.debug2 {|alloc: cannot allocate base pointer "%a"|} Expr.pp v;
-      Choice.bind (abort ()) (fun () -> Choice.return 666l)
-  in
-  let ptr v : int32 Choice.t =
-    match view v with
-    | Ptr (b, _) -> Choice.return b
-    | _ ->
-      Log.debug2 {|free: cannot fetch pointer base of "%a"|} Expr.pp v;
-      Choice.bind (abort ()) (fun () -> Choice.return 667l)
-  in
-  let alloc (base : Value.int32) (size : Value.int32) : Value.int32 Choice.t =
-    Choice.bind (i32 base) (fun base ->
-        Choice.with_thread (fun t ->
-            let memories = Thread.memories t in
-            Symbolic_memory.iter
-              (fun tbl ->
-                Symbolic_memory.ITbl.iter
-                  (fun _ (m : Symbolic_memory.t) ->
-                    Symbolic_memory.replace_size m base size )
-                  tbl )
-              memories;
-            Expr.make (Ptr (base, Value.const_i32 0l)) ) )
-  in
-  let free (p : Value.int32) : unit Choice.t =
-    Choice.bind (ptr p) (fun base ->
-        Choice.with_thread (fun t ->
-            let memories = Thread.memories t in
-            Symbolic_memory.iter
-              (fun tbl ->
-                Symbolic_memory.ITbl.iter
-                  (fun _ (m : Symbolic_memory.t) -> Symbolic_memory.free m base)
-                  tbl )
-              memories ) )
-  in
-
-  let exit (p : Value.int32) : unit Choice.t =
-    ignore p;
-    abort ()
-  in
-  let functions =
-    [ ( "alloc"
-      , Symbolic.P.Extern_func.Extern_func
-          (Func (Arg (I32, Arg (I32, Res)), R1 I32), alloc) )
-    ; ( "dealloc"
-      , Symbolic.P.Extern_func.Extern_func (Func (Arg (I32, Res), R0), free) )
-    ; ("abort", Symbolic.P.Extern_func.Extern_func (Func (UArg Res, R0), abort))
-    ; ( "exit"
-      , Symbolic.P.Extern_func.Extern_func (Func (Arg (I32, Res), R0), exit) )
-    ]
-  in
-  { functions }
+type fail_mode =
+  [ `Trap_only
+  | `Assertion_only
+  | `Both
+  ]
 
 let ( let*/ ) (t : 'a Result.t) (f : 'a -> 'b Result.t Choice.t) :
   'b Result.t Choice.t =
-  match t with Error e -> Choice.return (Error e) | Ok x -> f x
+  match t with Error e -> Choice.return (Error e) | Ok x -> f x
 
 let link_state =
   lazy
-    (let func_typ = Symbolic.P.Extern_func.extern_type in
+    (let func_typ = Symbolic.P.Extern_func.extern_type in
      let link_state =
        Link.extern_module' Link.empty_state ~name:"symbolic" ~func_typ
-         symbolic_extern_module
+         Symbolic_wasm_ffi.symbolic_extern_module
      in
-     Link.extern_module' link_state ~name:"summaries" ~func_typ
-       summaries_extern_module )
-
-let run_binary_modul ~unsafe ~optimize (pc : unit Result.t Choice.t)
-  (m : Binary.modul) =
-  (* We are checking if there's a start function *)
-  let*/ m =
-    if Option.is_some m.start then Ok m
-    else
-      (* If there is none, we look for a function exported with the name `main` *)
-      match
-        List.find_opt
-          (function { Binary.name = "main"; _ } -> true | _ -> false)
-          m.exports.func
-      with
-      | None ->
-        (* TODO: fail/display a warning saying nothing will be done ? *)
-        Ok m
-      | Some export -> (
-        (* We found a main function, so we check its type and build a start function that put the right values on the stack, call the main function and drop the results *)
-        let main_id = export.id in
-        match Indexed.get_at main_id m.func.values with
-        | None -> Error (`Msg "can't find a main function")
-        | Some main_function ->
-          let (Bt_raw main_type) =
-            match main_function with
-            | Local f -> f.type_f
-            | Imported i -> i.desc
-          in
-          let default_value_of_t = function
-            | Types.Num_type I32 -> Ok (Types.I32_const 0l)
-            | Num_type I64 -> Ok (Types.I64_const 0L)
-            | Num_type F32 -> Ok (Types.F32_const (Float32.of_float 0.))
-            | Num_type F64 -> Ok (Types.F64_const (Float64.of_float 0.))
-            | Ref_type (Types.Null, t) -> Ok (Types.Ref_null t)
-            | Ref_type (Types.No_null, t) ->
-              Error
-                (`Msg
-                  (Format.asprintf "can not create default value of type %a"
-                     Types.pp_heap_type t ) )
-          in
-          let+ body =
-            let pt, rt = snd main_type in
-            let+ args = list_map (fun (_, t) -> default_value_of_t t) pt in
-            let after_call =
-              List.map (fun (_ : _ Types.val_type) -> Types.Drop) rt
-            in
-            args @ [ Types.Call (Raw main_id) ] @ after_call
-          in
-          let type_f : Types.binary Types.block_type =
-            Types.Bt_raw (None, ([], []))
-          in
-          let start_code : Types.binary Types.func =
-            { Types.type_f; locals = []; body; id = None }
-          in
-          let start_func = Runtime.Local start_code in
-          let named = m.func.named in
-          (* We need to add the new start function to the funcs of the module at the next free index *)
-          let next_free_index =
-            List.fold_left
-              (fun next_free_index v ->
-                let index = Indexed.get_index v in
-                if next_free_index > index then next_free_index else index + 1
-                )
-              0 m.func.values
-          in
-          let values =
-            Indexed.return next_free_index start_func :: m.func.values
-          in
-          let func = { Named.named; values } in
-          let start = Some next_free_index in
-          { m with func; start } )
-  in
-
-  let link_state = Lazy.force link_state in
-
-  let*/ m, link_state =
-    Compile.Binary.until_link ~unsafe link_state ~optimize ~name:None m
-  in
-  let m = Symbolic.convert_module_to_run m in
-  let c = Interpret.SymbolicP.modul link_state.envs m in
-  Choice.bind pc (fun r ->
-      match r with Error _ -> Choice.return r | Ok () -> c )
+     Link.extern_module' link_state ~name:"summaries" ~func_typ
+       Symbolic_wasm_ffi.summaries_extern_module )
 
 let run_file ~unsafe ~optimize pc filename =
-  let*/ m = Parse.guess_from_file filename in
-  let*/ m =
-    match m with
-    | Either.Left (Either.Left text_module) ->
-      Compile.Text.until_binary ~unsafe text_module
-    | Either.Left (Either.Right _text_scrpt) ->
-      Error (`Msg "can't run symbolic interpreter on a script")
-    | Either.Right binary_module -> Ok binary_module
-  in
-  run_binary_modul ~unsafe ~optimize pc m
+  let*/ m = Compile.File.until_typecheck ~unsafe filename in
+  let*/ m = Cmd_utils.add_main_as_start m in
+  let link_state = Lazy.force link_state in
 
-let get_model ~symbols solver pc =
-  assert (`Sat = Solver.Z3Batch.check solver pc);
-  match Solver.Z3Batch.model ~symbols solver with
-  | None -> assert false
-  | Some model -> model
+  let*/ m, link_state =
+    Compile.Binary.until_link ~unsafe link_state ~optimize ~name:None m
+  in
+  let m = Symbolic.convert_module_to_run m in
+  let c = Interpret.SymbolicP.modul link_state.envs m in
+  Choice.bind pc (fun r ->
+      match r with Error _ -> Choice.return r | Ok () -> c )
 
 (* NB: This function propagates potential errors (Result.err) occurring
    during evaluation (OS, syntax error, etc.), except for Trap and Assert,
    which are handled here. Most of the computations are done in the Result
    monad, hence the let*. *)
 let cmd profiling debug unsafe optimize workers no_stop_at_failure no_values
-  deterministic_result_order (workspace : Fpath.t) files =
-  if profiling then Log.profiling_on := true;
-  if debug then Log.debug_on := true;
+  deterministic_result_order fail_mode (workspace : Fpath.t) solver files =
+  if profiling then Log.profiling_on := true;
+  if debug then Log.debug_on := true;
   (* deterministic_result_order implies no_stop_at_failure *)
-  let no_stop_at_failure = deterministic_result_order || no_stop_at_failure in
-  let* _created_dir = Bos.OS.Dir.create ~path:true ~mode:0o755 workspace in
-  let pc = Choice.return (Ok ()) in
-  let solver = Solver.Z3Batch.create () in
-  let result = List.fold_left (run_file ~unsafe ~optimize) pc files in
-  let thread : Thread.t = Thread.create () in
-  let results = Choice.run ~workers result thread in
-  let print_bug = function
-    | `ETrap (tr, model) ->
-      Format.pp_std "Trap: %s@\n" (Trap.to_string tr);
-      Format.pp_std "Model:@\n  @[<v>%a@]@." (Smtml.Model.pp ~no_values) model
+  let no_stop_at_failure = deterministic_result_order || no_stop_at_failure in
+  let* _created_dir = Bos.OS.Dir.create ~path:true ~mode:0o755 workspace in
+  let pc = Choice.return (Ok ()) in
+  let result = List.fold_left (run_file ~unsafe ~optimize) pc files in
+  let thread = Thread_with_memory.init () in
+  let res_queue = Wq.init () in
+  let callback v =
+    let open Symbolic_choice_intf in
+    match (fail_mode, v) with
+    | _, (EVal (Ok ()), _) -> ()
+    | _, (EVal (Error e), thread) -> Wq.push (`Error e, thread) res_queue
+    | (`Both | `Trap_only), (ETrap (t, m), thread) ->
+      Wq.push (`ETrap (t, m), thread) res_queue
+    | (`Both | `Assertion_only), (EAssert (e, m), thread) ->
+      Wq.push (`EAssert (e, m), thread) res_queue
+    | (`Trap_only | `Assertion_only), _ -> ()
+  in
+  let join_handles =
+    Symbolic_choice_with_memory.run ~workers solver result thread ~callback
+      ~callback_init:(fun () -> Wq.make_pledge res_queue)
+      ~callback_end:(fun () -> Wq.end_pledge res_queue)
+  in
+  let results =
+    Wq.read_as_seq res_queue ~finalizer:(fun () ->
+        Array.iter Domain.join join_handles )
+  in
+  let print_bug = function
+    | `ETrap (tr, model) ->
+      Fmt.pr "Trap: %s@\n" (Trap.to_string tr);
+      Fmt.pr "Model:@\n  @[<v>%a@]@." (Smtml.Model.pp ~no_values) model
     | `EAssert (assertion, model) ->
-      Format.pp_std "Assert failure: %a@\n" Expr.pp assertion;
-      Format.pp_std "Model:@\n  @[<v>%a@]@." (Smtml.Model.pp ~no_values) model
+      Fmt.pr "Assert failure: %a@\n" Expr.pp assertion;
+      Fmt.pr "Model:@\n  @[<v>%a@]@." (Smtml.Model.pp ~no_values) model
   in
   let rec print_and_count_failures count_acc results =
-    match results () with
-    | Seq.Nil -> Ok count_acc
-    | Seq.Cons ((result, thread), tl) ->
-      let pc = Thread.pc thread in
-      let symbols = thread.symbol_set in
-      let model = get_model ~symbols solver pc in
-      let* is_err =
-        let open Symbolic_choice.Multicore in
+    match results () with
+    | Seq.Nil -> Ok count_acc
+    | Seq.Cons ((result, _thread), tl) ->
+      let* model =
         match result with
-        | EAssert assertion ->
-          print_bug (`EAssert (assertion, model));
-          Ok true
-        | ETrap tr ->
-          print_bug (`ETrap (tr, model));
-          Ok true
-        | EVal (Ok ()) -> Ok false
-        | EVal (Error e) -> Error e
+        | (`EAssert (_, model) | `ETrap (_, model)) as bug ->
+          print_bug bug;
+          Ok model
+        | `Error e -> Error e
       in
-      let count_acc = if is_err then succ count_acc else count_acc in
-      let* () =
+      let count_acc = succ count_acc in
+      let* () =
         if not no_values then
-          let testcase =
-            List.sort compare (Smtml.Model.get_bindings model) |> List.map snd
-          in
-          Testcase.write_testcase ~dir:workspace ~err:is_err testcase
-        else Ok ()
+          let testcase = Smtml.Model.get_bindings model |> List.map snd in
+          Cmd_utils.write_testcase ~dir:workspace testcase
+        else Ok ()
       in
-      if (not is_err) || no_stop_at_failure then
-        print_and_count_failures count_acc tl
-      else Ok count_acc
+      if no_stop_at_failure then print_and_count_failures count_acc tl
+      else Ok count_acc
   in
   let results =
     if deterministic_result_order then
       results
-      |> Seq.map (function (_, th) as x ->
-           (x, List.rev @@ Thread.breadcrumbs th) )
+      |> Seq.map (function (_, thread) as x ->
+           (x, List.rev @@ Thread_with_memory.breadcrumbs thread) )
       |> List.of_seq
       |> List.sort (fun (_, bc1) (_, bc2) ->
-             List.compare Stdlib.Int32.compare bc1 bc2 )
+             List.compare Prelude.Int32.compare bc1 bc2 )
       |> List.to_seq |> Seq.map fst
-    else results
+    else results
   in
-  let* count = print_and_count_failures 0 results in
-  if count > 0 then Error (`Found_bug count)
-  else begin
-    Format.pp_std "All OK";
-    Ok ()
+  let* count = print_and_count_failures 0 results in
+  if count > 0 then Error (`Found_bug count)
+  else begin
+    Fmt.pr "All OK";
+    Ok ()
   end
diff --git a/coverage/src/cmd/cmd_utils.ml.html b/coverage/src/cmd/cmd_utils.ml.html new file mode 100644 index 000000000..8116fd89c --- /dev/null +++ b/coverage/src/cmd/cmd_utils.ml.html @@ -0,0 +1,333 @@ + + + + + cmd_utils.ml — Coverage report + + + + + + + + +
+
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+
+
+
+ 
+ 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
+
+
(* SPDX-License-Identifier: AGPL-3.0-or-later *)
+(* Copyright © 2021-2024 OCamlPro *)
+(* Written by the Owi programmers *)
+
+open Syntax
+
+let out_testcase ~dst testcase =
+  let o = Xmlm.make_output ~nl:true ~indent:(Some 2) dst in
+  let tag atts name = (("", name), atts) in
+  let atts = [ (("", "coversError"), "true") ] in
+  let to_string v = Fmt.str "%a" Smtml.Value.pp v in
+  let input v = `El (tag [] "input", [ `Data (to_string v) ]) in
+  let testcase = `El (tag atts "testcase", List.map input testcase) in
+  let dtd =
+    {|<!DOCTYPE testcase PUBLIC "+//IDN sosy-lab.org//DTD test-format testcase 1.1//EN" "https://sosy-lab.org/test-format/testcase-1.1.dtd">|}
+  in
+  Xmlm.output o (`Dtd (Some dtd));
+  Xmlm.output_tree Fun.id o testcase
+
+let write_testcase =
+  let cnt = ref 0 in
+  fun ~dir testcase ->
+    incr cnt;
+    let name = Fmt.kstr Fpath.v "testcase-%d.xml" !cnt in
+    let path = Fpath.append dir name in
+    let* res =
+      Bos.OS.File.with_oc path
+        (fun chan () -> Ok (out_testcase ~dst:(`Channel chan) testcase))
+        ()
+    in
+    res
+
+let add_main_as_start (m : Binary.modul) =
+  (* We are checking if there's a start function *)
+  if Option.is_some m.start then Ok m
+  else
+    (* If there is none, we look for a function exported with the name `main` *)
+    match
+      List.find_opt
+        (function { Binary.name = "main"; _ } -> true | _ -> false)
+        m.exports.func
+    with
+    | None ->
+      (* TODO: fail/display a warning saying nothing will be done ? *)
+      Ok m
+    | Some export -> (
+      (* We found a main function, so we check its type and build a start function that put the right values on the stack, call the main function and drop the results *)
+      let main_id = export.id in
+      match Indexed.get_at main_id m.func.values with
+      | None -> Error (`Msg "can't find a main function")
+      | Some main_function ->
+        let (Bt_raw main_type) =
+          match main_function with Local f -> f.type_f | Imported i -> i.desc
+        in
+        let default_value_of_t = function
+          | Types.Num_type I32 -> Ok (Types.I32_const 0l)
+          | Num_type I64 -> Ok (Types.I64_const 0L)
+          | Num_type F32 -> Ok (Types.F32_const (Float32.of_float 0.))
+          | Num_type F64 -> Ok (Types.F64_const (Float64.of_float 0.))
+          | Ref_type (Types.Null, t) -> Ok (Types.Ref_null t)
+          | Ref_type (Types.No_null, t) ->
+            Error
+              (`Msg
+                (Fmt.str "can not create default value of type %a"
+                   Types.pp_heap_type t ) )
+        in
+        let+ body =
+          let pt, rt = snd main_type in
+          let+ args = list_map (fun (_, t) -> default_value_of_t t) pt in
+          let after_call =
+            List.map (fun (_ : _ Types.val_type) -> Types.Drop) rt
+          in
+          args @ [ Types.Call (Raw main_id) ] @ after_call
+        in
+        let type_f : Types.binary Types.block_type =
+          Types.Bt_raw (None, ([], []))
+        in
+        let start_code : Types.binary Types.func =
+          { Types.type_f; locals = []; body; id = None }
+        in
+        let start_func = Runtime.Local start_code in
+        let named = m.func.named in
+        (* We need to add the new start function to the funcs of the module at the next free index *)
+        let next_free_index =
+          List.fold_left
+            (fun next_free_index v ->
+              let index = Indexed.get_index v in
+              if next_free_index > index then next_free_index else index + 1 )
+            0 m.func.values
+        in
+        let values =
+          Indexed.return next_free_index start_func :: m.func.values
+        in
+        let func = { Named.named; values } in
+        let start = Some next_free_index in
+        { m with func; start } )
+
+
+
+ + + diff --git a/coverage/src/cmd/cmd_validate.ml.html b/coverage/src/cmd/cmd_validate.ml.html index 16469dc01..df90c7896 100644 --- a/coverage/src/cmd/cmd_validate.ml.html +++ b/coverage/src/cmd/cmd_validate.ml.html @@ -3,7 +3,7 @@ cmd_validate.ml — Coverage report - + @@ -15,10 +15,10 @@

src/cmd/cmd_validate.ml

-

87.50%

+

83.33%

@@ -32,11 +32,12 @@

87.50%

- - + + - + +
@@ -55,6 +56,7 @@

87.50%

12 13 14 +15 
(* SPDX-License-Identifier: AGPL-3.0-or-later *)
 (* Copyright © 2021-2024 OCamlPro *)
@@ -63,8 +65,9 @@ 
87.50%

 open Syntax
 
 let validate filename =
-  let* modul = Parse.Text.Module.from_file filename in
-  let+ _modul = Compile.Text.until_typecheck ~unsafe:false modul in
+  let+ (_modul : Binary.modul) =
+    Compile.File.until_typecheck ~unsafe:false filename
+  in
   ()
 
 let cmd debug files =
diff --git a/coverage/src/cmd/cmd_wasm2wat.ml.html b/coverage/src/cmd/cmd_wasm2wat.ml.html
index faf92fb89..ab45f6b55 100644
--- a/coverage/src/cmd/cmd_wasm2wat.ml.html
+++ b/coverage/src/cmd/cmd_wasm2wat.ml.html
@@ -3,7 +3,7 @@
   
     
     cmd_wasm2wat.ml — Coverage report
-    
+    
     
     
     
@@ -15,10 +15,9 @@ 

           src/cmd/cmd_wasm2wat.ml
         
       

-      
80.00%

+      
100.00%
@@ -36,7 +35,7 @@

80.00%

- + @@ -67,15 +66,15 @@

80.00%

open Syntax let cmd_one file = - let ext = Fpath.get_ext file in - match ext with - | ".wasm" -> - let* m = Parse.Binary.Module.from_file file in - let m = Binary_to_text.modul m in - Ok (Format.pp_std "%a@\n" Text.pp_modul m) - | ext -> Error (`Msg (Format.sprintf "invalid extension: `%s`" ext)) + let ext = Fpath.get_ext file in + match ext with + | ".wasm" -> + let* m = Parse.Binary.Module.from_file file in + let m = Binary_to_text.modul m in + Ok (Fmt.pr "%a@\n" Text.pp_modul m) + | ext -> Error (`Unsupported_file_extension ext) -let cmd files = list_iter cmd_one files +let cmd files = list_iter cmd_one files
diff --git a/coverage/src/cmd/cmd_wat2wasm.ml.html b/coverage/src/cmd/cmd_wat2wasm.ml.html new file mode 100644 index 000000000..4ad66e780 --- /dev/null +++ b/coverage/src/cmd/cmd_wat2wasm.ml.html @@ -0,0 +1,91 @@ + + + + + cmd_wat2wasm.ml — Coverage report + + + + + + + + +
+
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+
+
+
+ 
+ 1
+ 2
+ 3
+ 4
+ 5
+ 6
+ 7
+ 8
+ 9
+10
+11
+12
+13
+14
+15
+16
+17
+18
+
+
(* SPDX-License-Identifier: AGPL-3.0-or-later *)
+(* Copyright © 2021-2024 OCamlPro *)
+(* Written by the Owi programmers *)
+
+open Syntax
+
+let cmd_one ~unsafe ~optimize file =
+  let ext = Fpath.get_ext file in
+  match ext with
+  | ".wat" ->
+    let* modul = Parse.Text.Module.from_file file in
+    Binary_encoder.convert file ~unsafe ~optimize modul
+  | ext -> Error (`Unsupported_file_extension ext)
+
+let cmd profiling debug unsafe optimize files =
+  if profiling then Log.profiling_on := true;
+  if debug then Log.debug_on := true;
+  list_iter (cmd_one ~unsafe ~optimize) files
+
+
+
+ + + diff --git a/coverage/src/cmd/testcase.ml.html b/coverage/src/cmd/testcase.ml.html deleted file mode 100644 index 66d7c3d05..000000000 --- a/coverage/src/cmd/testcase.ml.html +++ /dev/null @@ -1,128 +0,0 @@ - - - - - testcase.ml — Coverage report - - - - - - - - -
-
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
-
-
-
- 
- 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
-
-
(* SPDX-License-Identifier: AGPL-3.0-or-later *)
-(* Copyright © 2021-2024 OCamlPro *)
-(* Written by the Owi programmers *)
-
-open Syntax
-
-let out_testcase ~dst ~err testcase =
-  let o = Xmlm.make_output ~nl:true ~indent:(Some 2) dst in
-  let tag ?(atts = []) name = (("", name), atts) in
-  let atts = if err then Some [ (("", "coversError"), "true") ] else None in
-  let to_string v = Format.asprintf "%a" Smtml.Value.pp_num v in
-  let input v = `El (tag "input", [ `Data (to_string v) ]) in
-  let testcase = `El (tag ?atts "testcase", List.map input testcase) in
-  let dtd =
-    {|<!DOCTYPE testcase PUBLIC "+//IDN sosy-lab.org//DTD test-format testcase 1.1//EN" "https://sosy-lab.org/test-format/testcase-1.1.dtd">|}
-  in
-  Xmlm.output o (`Dtd (Some dtd));
-  Xmlm.output_tree Fun.id o testcase
-
-let write_testcase =
-  let cnt = ref 0 in
-  fun ~dir ~err testcase ->
-    incr cnt;
-    let name = Format.ksprintf Fpath.v "testcase-%d.xml" !cnt in
-    let path = Fpath.append dir name in
-    let* res =
-      Bos.OS.File.with_oc path
-        (fun chan () -> Ok (out_testcase ~dst:(`Channel chan) ~err testcase))
-        ()
-    in
-    res
-
-
-
- - - diff --git a/coverage/src/compile.ml.html b/coverage/src/compile.ml.html deleted file mode 100644 index ba01f64f3..000000000 --- a/coverage/src/compile.ml.html +++ /dev/null @@ -1,248 +0,0 @@ - - - - - compile.ml — Coverage report - - - - - - - - -
-
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
-
-
-
- 
- 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
-
-
(* SPDX-License-Identifier: AGPL-3.0-or-later *)
-(* Copyright © 2021-2024 OCamlPro *)
-(* Written by the Owi programmers *)
-
-open Syntax
-
-module Text = struct
-  let until_check ~unsafe m = if unsafe then Ok m else Check.modul m
-
-  let until_group ~unsafe m =
-    let* m = until_check ~unsafe m in
-    Grouped.of_symbolic m
-
-  let until_assign ~unsafe m =
-    let* m = until_group ~unsafe m in
-    Assigned.of_grouped m
-
-  let until_binary ~unsafe m =
-    let* m = until_assign ~unsafe m in
-    Rewrite.modul m
-
-  let until_typecheck ~unsafe m =
-    let* m = until_binary ~unsafe m in
-    if unsafe then Ok m
-    else
-      let+ () = Typecheck.modul m in
-      m
-
-  let until_optimize ~unsafe ~optimize m =
-    let+ m = until_typecheck ~unsafe m in
-    if optimize then Optimize.modul m else m
-
-  let until_link ~unsafe link_state ~optimize ~name m =
-    let* m = until_optimize ~unsafe ~optimize m in
-    Link.modul link_state ~name m
-
-  let until_interpret link_state ~unsafe ~optimize ~name m =
-    let* m, link_state = until_link link_state ~unsafe ~optimize ~name m in
-    let+ () = Interpret.Concrete.modul link_state.envs m in
-    link_state
-end
-
-module Binary = struct
-  let until_typecheck ~unsafe m =
-    if unsafe then Ok m
-    else
-      let+ () = Typecheck.modul m in
-      m
-
-  let until_optimize ~unsafe ~optimize m =
-    let+ m = until_typecheck ~unsafe m in
-    if optimize then Optimize.modul m else m
-
-  let until_link ~unsafe link_state ~optimize ~name m =
-    let* m = until_optimize ~unsafe ~optimize m in
-    Link.modul link_state ~name m
-
-  let until_interpret link_state ~unsafe ~optimize ~name m =
-    let* m =
-      if unsafe then Ok m
-      else
-        let+ () = Typecheck.modul m in
-        m
-    in
-    let* m = if optimize then Ok (Optimize.modul m) else Ok m in
-    let* m, link_state = Link.modul link_state ~name m in
-    let+ () = Interpret.Concrete.modul link_state.envs m in
-    link_state
-end
-
-
-
- - - diff --git a/coverage/src/concolic/concolic.ml.html b/coverage/src/concolic/concolic.ml.html index dfa8e3e35..09e0dd584 100644 --- a/coverage/src/concolic/concolic.ml.html +++ b/coverage/src/concolic/concolic.ml.html @@ -3,7 +3,7 @@ concolic.ml — Coverage report - + @@ -15,93 +15,87 @@

src/concolic/concolic.ml

-

6.12%

+

20.00%

@@ -170,131 +164,131 @@

6.12%

- - - - - - - - + + + + + + + + - + - + - + - - + + - - - - - - - - + + + + + + + + - + - - + + - + - - - - + + + + - - - - - + + + + + - + - + - + - - - - - - - - - - - + + + + + + + + + + + - - + + - - + + - - - - - - + + + + + + - + - - - - - + + + + + - + - - + + - - + + - + - - + + - + - + @@ -303,72 +297,89 @@

6.12%

- - - + + + - + - + - - - + + + - - - + + + - + - + - + - - - - + + + + - + - - + + - - - - - + + + + + - + - - - + + + - + - + + + + + + + + + + + + + + + + + +
@@ -636,6 +647,23 @@

6.12%

261 262 263 +264 +265 +266 +267 +268 +269 +270 +271 +272 +273 +274 +275 +276 +277 +278 +279 +280 
(* SPDX-License-Identifier: AGPL-3.0-or-later *)
 (* Copyright © 2021-2024 OCamlPro *)
@@ -692,28 +720,26 @@ 
6.12%

            }
     | Ref _, Ref _ ->
       (* Concretization: add something to the PC *)
-      failwith "TODO"
+      Fmt.failwith "TODO"
     | _, _ -> assert false
 
-  module Extern_func = Concrete_value.Make_extern_func (Value) (Choice)
-
   module Global = struct
     open Concolic_value
 
     type t = (Concrete_global.t, Symbolic_global.t) cs
 
     let value (g : t) : Value.t =
-      Concolic_value.V.value_pair
-        (Concrete_global.value g.concrete)
-        (Symbolic_global.value g.symbolic)
+      Concolic_value.V.value_pair
+        (Concrete_global.value g.concrete)
+        (Symbolic_global.value g.symbolic)
 
     let set_value (g : t) cs =
-      Concrete_global.set_value g.concrete (Concolic_value.V.concrete_value cs);
-      Symbolic_global.set_value g.symbolic (Concolic_value.V.symbolic_value cs)
+      Concrete_global.set_value g.concrete (Concolic_value.V.concrete_value cs);
+      Symbolic_global.set_value g.symbolic (Concolic_value.V.symbolic_value cs)
 
     let mut (g : t) = Concrete_global.mut g.concrete
 
-    let typ (g : t) = Concrete_global.typ g.concrete
+    let typ (g : t) = Concrete_global.typ g.concrete
   end
 
   module Table = struct
@@ -721,9 +747,14 @@ 
6.12%

 
     type t = (Concrete_table.t, Symbolic_table.t) cs
 
-    let get _t _i = failwith "TODO"
+    let get t i =
+      Concolic_value.V.pair
+        (Concrete_table.get t.concrete i)
+        (Symbolic_table.get t.symbolic i)
 
-    let set _t _i _v = failwith "TODO"
+    let set t i v =
+      Concrete_table.set t.concrete i v.concrete;
+      Symbolic_table.set t.symbolic i v.symbolic
 
     let size t = Concrete_table.size t.concrete
 
@@ -731,11 +762,19 @@ 
6.12%

 
     let max_size t = Concrete_table.max_size t.concrete
 
-    let grow _t _new_size _x = failwith "TODO"
+    let grow t new_size x =
+      Concrete_table.grow t.concrete new_size x.concrete;
+      Symbolic_table.grow t.symbolic new_size x.symbolic
 
-    let fill _t _pos _len _x = failwith "TODO"
+    let fill t pos len x =
+      Concrete_table.fill t.concrete pos len x.concrete;
+      Symbolic_table.fill t.symbolic pos len x.symbolic
 
-    let copy ~t_src:_ ~t_dst:_ ~src:_ ~dst:_ ~len:_ = failwith "TODO"
+    let copy ~t_src ~t_dst ~src ~dst ~len =
+      Concrete_table.copy ~t_src:t_src.concrete ~t_dst:t_dst.concrete ~src ~dst
+        ~len;
+      Symbolic_table.copy ~t_src:t_src.symbolic ~t_dst:t_dst.symbolic ~src ~dst
+        ~len
   end
 
   module Memory = struct
@@ -806,9 +845,11 @@ 
6.12%

             ~dst:dst.symbolic ~len:len.symbolic
       }
 
-    let get_limit_max _ = failwith "TODO"
+    let get_limit_max _ = Fmt.failwith "TODO"
   end
 
+  module Extern_func = Concrete_value.Make_extern_func (Value) (Choice) (Memory)
+
   module Data = struct
     type t = Link_env.data
 
@@ -842,9 +883,9 @@ 
6.12%

       in
       Choice.with_thread f
 
-    let get_func env id = Link_env.get_func env id
+    let get_func env id = Link_env.get_func env id
 
-    let get_extern_func env id = Link_env.get_extern_func env id
+    let get_extern_func env id = Link_env.get_extern_func env id
 
     let get_table env id : Table.t Choice.t =
       let orig_table = Link_env.get_table env id in
@@ -864,13 +905,13 @@ 
6.12%

       Choice.return data
 
     let get_global env id : Global.t Choice.t =
-      let orig_global = Link_env.get_global env id in
-      let f (t : thread) : Global.t =
-        let sym_global =
-          Symbolic_global.get_global (Link_env.id env) orig_global
+      let orig_global = Link_env.get_global env id in
+      let f (t : thread) : Global.t =
+        let sym_global =
+          Symbolic_global.get_global (Link_env.id env) orig_global
             t.shared.globals id
         in
-        { concrete = orig_global; symbolic = sym_global }
+        { concrete = orig_global; symbolic = sym_global }
       in
       Choice.with_thread f
 
@@ -888,18 +929,22 @@ 
6.12%

       ; to_run : Types.binary Types.expr list
       }
 
-    let env (t : t) = t.env
+    let env (t : t) = t.env
 
-    let modul (t : t) = t.modul
+    let modul (t : t) = t.modul
 
-    let to_run (t : t) = t.to_run
+    let to_run (t : t) = t.to_run
   end
 end
 
 module P' : Interpret_intf.P = P
 
 let convert_module_to_run (m : 'f Link.module_to_run) =
-  P.Module_to_run.{ modul = m.modul; env = m.env; to_run = m.to_run }
+  P.Module_to_run.{ modul = m.modul; env = m.env; to_run = m.to_run }
+
+let backup (m : P.Module_to_run.t) = Link_env.backup m.env
+
+let recover b (m : P.Module_to_run.t) = Link_env.recover b m.env
diff --git a/coverage/src/concolic/concolic_choice.ml.html b/coverage/src/concolic/concolic_choice.ml.html index 03456fe6c..0c6066400 100644 --- a/coverage/src/concolic/concolic_choice.ml.html +++ b/coverage/src/concolic/concolic_choice.ml.html @@ -3,7 +3,7 @@ concolic_choice.ml — Coverage report - + @@ -15,7 +15,7 @@

src/concolic/concolic_choice.ml

-

45.24%

+

60.71%

@@ -81,7 +74,7 @@

45.24%

- + @@ -146,7 +139,7 @@

45.24%

- + @@ -169,18 +162,18 @@

45.24%

- + - - + + - - + + - + @@ -390,26 +383,26 @@

45.24%

| Assert of Symbolic_value.vbool let pp_pc_elt fmt = function - | Select (c, v) -> Format.pp fmt "Select(%a, %b)" Smtml.Expr.pp c v - | Select_i32 (c, v) -> Format.pp fmt "Select_i32(%a, %li)" Smtml.Expr.pp c v - | Assume c -> Format.pp fmt "Assume(%a)" Smtml.Expr.pp c - | Assert c -> Format.pp fmt "Assert(%a)" Smtml.Expr.pp c + | Select (c, v) -> Fmt.pf fmt "Select(%a, %b)" Smtml.Expr.pp c v + | Select_i32 (c, v) -> Fmt.pf fmt "Select_i32(%a, %li)" Smtml.Expr.pp c v + | Assume c -> Fmt.pf fmt "Assume(%a)" Smtml.Expr.pp c + | Assert c -> Fmt.pf fmt "Assert(%a)" Smtml.Expr.pp c -let pp_pc fmt pc = List.iter (fun e -> Format.pp fmt " %a@\n" pp_pc_elt e) pc +let pp_pc fmt pc = List.iter (fun e -> Fmt.pf fmt " %a@\n" pp_pc_elt e) pc let pp_assignments fmt assignments = List.iter (fun (sym, v) -> - Format.pp fmt " %a : %a@\n" Smtml.Symbol.pp sym Concrete_value.pp v ) + Fmt.pf fmt " %a : %a@\n" Smtml.Symbol.pp sym Concrete_value.pp v ) assignments let pc_elt_to_expr = function - | Select (c, v) -> Some (if v then c else Smtml.Expr.Bool.not c) + | Select (c, v) -> Some (if v then c else Smtml.Expr.Bool.not c) | Select_i32 (c, n) -> Some Smtml.Expr.Bitv.I32.(c = v n) | Assume c -> Some c | Assert _ -> None -let pc_to_exprs pc = List.filter_map pc_elt_to_expr pc +let pc_to_exprs pc = List.filter_map pc_elt_to_expr pc type pc = pc_elt list @@ -428,30 +421,30 @@

45.24%

} let init_thread preallocated_values shared = - { symbols = 0; pc = []; symbols_value = []; preallocated_values; shared } + { symbols = 0; pc = []; symbols_value = []; preallocated_values; shared } -type 'a run_result = ('a, err) Stdlib.Result.t * thread +type 'a run_result = ('a, err) Prelude.Result.t * thread type 'a t = M of (thread -> 'a run_result) [@@unboxed] -let return v = M (fun t -> (Ok v, t)) [@@inline] +let return v = M (fun t -> (Ok v, t)) [@@inline] -let run (M v) st : _ run_result = v st [@@inline] +let run (M v) st : _ run_result = v st [@@inline] let bind v f = - M + M (fun init_s -> - let v_final, tmp_st = run v init_s in - match v_final with - | Ok v_final -> run (f v_final) tmp_st - | Error _ as e -> (e, tmp_st) ) + let v_final, tmp_st = run v init_s in + match v_final with + | Ok v_final -> run (f v_final) tmp_st + | Error _ as e -> (e, tmp_st) ) [@@inline] let ( let* ) = bind let map v f = - let* v in - return (f v) + let* v in + return (f v) [@@inline] let ( let+ ) = map @@ -465,17 +458,17 @@

45.24%

let add_pc (c : Concolic_value.V.vbool) = M (fun st -> (Ok (), { st with pc = Assume c.symbolic :: st.pc })) -let add_pc_to_thread (st : thread) c = { st with pc = c :: st.pc } +let add_pc_to_thread (st : thread) c = { st with pc = c :: st.pc } let no_choice e = - let v = Smtml.Expr.simplify e in - match Smtml.Expr.view v with Val _ -> true | _ -> false + let v = Smtml.Expr.simplify e in + match Smtml.Expr.view v with Val _ -> true | _ -> false let select (vb : Concolic_value.V.vbool) = - let r = vb.concrete in + let r = vb.concrete in let cond = Select (vb.symbolic, r) in let no_choice = no_choice vb.symbolic in - M (fun st -> (Ok r, if no_choice then st else add_pc_to_thread st cond)) + M (fun st -> (Ok r, if no_choice then st else add_pc_to_thread st cond)) [@@inline] let select_i32 (i : Concolic_value.V.int32) = @@ -492,27 +485,27 @@

45.24%

else M (fun st -> (Error (Assume_fail vb.symbolic), st)) let assertion (vb : Concolic_value.V.vbool) = - let assert_pc = Assert vb.symbolic in + let assert_pc = Assert vb.symbolic in let r = vb.concrete in if r then - let no_choice = no_choice vb.symbolic in - M + let no_choice = no_choice vb.symbolic in + M (fun st -> - (Ok (), if no_choice then st else add_pc_to_thread st assert_pc) ) - else M (fun st -> (Error (Assume_fail vb.symbolic), st)) + (Ok (), if no_choice then st else add_pc_to_thread st assert_pc) ) + else M (fun st -> (Error Assert_fail, st)) -let trap t = M (fun th -> (Error (Trap t), th)) +let trap t = M (fun th -> (Error (Trap t), th)) -let with_thread f = M (fun st -> (Ok (f st), st)) +let with_thread f = M (fun st -> (Ok (f st), st)) let with_new_symbol ty f = - M + M (fun st -> - let id = st.symbols + 1 in - let sym = Format.kasprintf (Smtml.Symbol.make ty) "symbol_%d" id in - let value = Hashtbl.find_opt st.preallocated_values sym in - let concrete, v = f sym value in - let st = + let id = st.symbols + 1 in + let sym = Fmt.kstr (Smtml.Symbol.make ty) "symbol_%d" id in + let value = Hashtbl.find_opt st.preallocated_values sym in + let concrete, v = f sym value in + let st = { st with symbols = st.symbols + 1 ; symbols_value = (sym, concrete) :: st.symbols_value @@ -521,13 +514,13 @@

45.24%

(Ok v, st) ) let run preallocated_values (M v) : _ run_result = - let shared = - { memories = Symbolic_memory.init () - ; tables = Symbolic_table.init () - ; globals = Symbolic_global.init () + let shared = + { memories = Symbolic_memory.init () + ; tables = Symbolic_table.init () + ; globals = Symbolic_global.init () } in - v (init_thread preallocated_values shared) + v (init_thread preallocated_values shared) let run' t : _ run_result = let preallocated_values = Hashtbl.create 0 in diff --git a/coverage/src/concolic/concolic_value.ml.html b/coverage/src/concolic/concolic_value.ml.html index 35aaf5e4d..796b637b4 100644 --- a/coverage/src/concolic/concolic_value.ml.html +++ b/coverage/src/concolic/concolic_value.ml.html @@ -3,7 +3,7 @@ concolic_value.ml — Coverage report - + @@ -15,54 +15,57 @@

src/concolic/concolic_value.ml

-

60.90%

+

61.21%

@@ -86,143 +89,143 @@

60.90%

- + - + - + - + - - - - + + + + - + - - - - - - + + + + + + - - - + + + - + - + - - - - - - + + + + + + - - - + + + - - - - + + + + - - + + - - - + + + - + - + - - + + - + - - + + - + - - - + + + - - - + + + - - + + - - + + - - - + + + - + - + - - - - - - + + + + + + - + - - - + + + - - - + + + @@ -230,17 +233,17 @@

60.90%

- + - + - + - + - + - + @@ -262,27 +265,27 @@

60.90%

- + - + - + - + - + - + - + - + - + - + - + @@ -316,27 +319,27 @@

60.90%

- + - + - + - + - + - + - + - + - + - + - + @@ -357,27 +360,27 @@

60.90%

- + - + - + - + - + - + - + - + - + - + - + @@ -433,33 +436,33 @@

60.90%

- - - + + + - + - + - + - + - + - + - + - + - + - - + + - + @@ -479,10 +482,10 @@

60.90%

- - - - + + + + @@ -500,7 +503,7 @@

60.90%

- + @@ -528,9 +531,9 @@

60.90%

- + - + @@ -544,8 +547,30 @@

60.90%

- + + + + + + + + + + + + + + + + + + + + + + +
@@ -1029,6 +1054,28 @@

60.90%

477 478 479 +480 +481 +482 +483 +484 +485 +486 +487 +488 +489 +490 +491 +492 +493 +494 +495 +496 +497 +498 +499 +500 +501 
(* SPDX-License-Identifier: AGPL-3.0-or-later *)
 (* Copyright © 2021-2024 OCamlPro *)
@@ -1048,16 +1095,34 @@ 
60.90%

 
   type int32 = (C.int32, S.int32) cs
 
+  let pp_int32 fmt v =
+    Fmt.pf fmt "{ c = %a ; s = %a }" C.pp_int32 v.concrete S.pp_int32 v.symbolic
+
   type int64 = (C.int64, S.int64) cs
 
+  let pp_int64 fmt v =
+    Fmt.pf fmt "{ c = %a ; s = %a }" C.pp_int64 v.concrete S.pp_int64 v.symbolic
+
   type float32 = (C.float32, S.float32) cs
 
+  let pp_float32 fmt v =
+    Fmt.pf fmt "{ c = %a ; s = %a }" C.pp_float32 v.concrete S.pp_float32
+      v.symbolic
+
   type float64 = (C.float64, S.float64) cs
 
+  let pp_float64 fmt v =
+    Fmt.pf fmt "{ c = %a ; s = %a }" C.pp_float64 v.concrete S.pp_float64
+      v.symbolic
+
   (* TODO: Probably beter not to have a different value for both,
      there are no good reason for that right now *)
   type ref_value = (C.ref_value, S.ref_value) cs
 
+  let pp_ref_value fmt v =
+    Fmt.pf fmt "{ c = %a ; s = %a }" C.pp_ref_value v.concrete S.pp_ref_value
+      v.symbolic
+
   type t =
     | I32 of int32
     | I64 of int64
@@ -1065,12 +1130,12 @@ 
60.90%

     | F64 of float64
     | Ref of ref_value
 
-  let pair concrete symbolic = { concrete; symbolic }
+  let pair concrete symbolic = { concrete; symbolic }
 
   (* Bof... *)
   let value_pair (c : C.t) (s : S.t) =
-    match (c, s) with
-    | I32 concrete, I32 symbolic -> I32 { concrete; symbolic }
+    match (c, s) with
+    | I32 concrete, I32 symbolic -> I32 { concrete; symbolic }
     | I64 concrete, I64 symbolic -> I64 { concrete; symbolic }
     | F32 concrete, F32 symbolic -> F32 { concrete; symbolic }
     | F64 concrete, F64 symbolic -> F64 { concrete; symbolic }
@@ -1078,32 +1143,32 @@ 
60.90%

     | _, _ -> assert false
 
   let concrete_value (cs : t) : C.t =
-    match cs with
-    | I32 cs -> I32 cs.concrete
+    match cs with
+    | I32 cs -> I32 cs.concrete
     | I64 cs -> I64 cs.concrete
     | F32 cs -> F32 cs.concrete
     | F64 cs -> F64 cs.concrete
     | Ref cs -> Ref cs.concrete
 
   let symbolic_value (cs : t) : S.t =
-    match cs with
-    | I32 cs -> I32 cs.symbolic
+    match cs with
+    | I32 cs -> I32 cs.symbolic
     | I64 cs -> I64 cs.symbolic
     | F32 cs -> F32 cs.symbolic
     | F64 cs -> F64 cs.symbolic
     | Ref cs -> Ref cs.symbolic
 
   let f_pair_1 fc fs cs =
-    { concrete = fc cs.concrete; symbolic = fs cs.symbolic }
+    { concrete = fc cs.concrete; symbolic = fs cs.symbolic }
   [@@inline always]
 
   let f_pair_2 fc fs cs1 cs2 =
-    { concrete = fc cs1.concrete cs2.concrete
-    ; symbolic = fs cs1.symbolic cs2.symbolic
+    { concrete = fc cs1.concrete cs2.concrete
+    ; symbolic = fs cs1.symbolic cs2.symbolic
     }
   [@@inline always]
 
-  let f_pair_1_cst fc fs v = { concrete = fc v; symbolic = fs v }
+  let f_pair_1_cst fc fs v = { concrete = fc v; symbolic = fs v }
   [@@inline always]
 
   let f_pair_2_cst fc fs v1 v2 = { concrete = fc v1 v2; symbolic = fs v1 v2 }
@@ -1113,9 +1178,9 @@ 
60.90%

     { concrete = fc cs.concrete v2; symbolic = fs cs.symbolic v2 }
   [@@inline always]
 
-  let const_i32 v = f_pair_1_cst C.const_i32 S.const_i32 v
+  let const_i32 v = f_pair_1_cst C.const_i32 S.const_i32 v
 
-  let const_i64 v = f_pair_1_cst C.const_i64 S.const_i64 v
+  let const_i64 v = f_pair_1_cst C.const_i64 S.const_i64 v
 
   let const_f32 v = f_pair_1_cst C.const_f32 S.const_f32 v
 
@@ -1138,14 +1203,18 @@ 
60.90%

   let ref_is_null v = f_pair_1 C.ref_is_null S.ref_is_null v
 
   let mk_pp c symbolic ppf v =
-    Stdlib.Format.fprintf ppf "@[<hov 2>{c: %a@, s: %a}@]" c v.concrete symbolic
-      v.symbolic
+    Fmt.pf ppf "@[<hov 2>{c: %a@, s: %a}@]" c v.concrete symbolic v.symbolic
 
-  let pp _ _ = failwith "TODO PP"
+  let pp fmt = function
+    | I32 i -> pp_int32 fmt i
+    | I64 i -> pp_int64 fmt i
+    | F32 f -> pp_float32 fmt f
+    | F64 f -> pp_float64 fmt f
+    | Ref r -> pp_ref_value fmt r
 
   module Ref = struct
     let equal_func_intf (_ : Func_intf.t) (_ : Func_intf.t) : bool =
-      failwith "TODO equal_func_intf"
+      Fmt.failwith "TODO equal_func_intf"
 
     let get_func ref : Func_intf.t Value_intf.get_ref =
       match (C.Ref.get_func ref.concrete, S.Ref.get_func ref.symbolic) with
@@ -1171,17 +1240,17 @@ 
60.90%

   end
 
   module Bool = struct
-    let const = f_pair_1_cst C.Bool.const S.Bool.const
+    let const = f_pair_1_cst C.Bool.const S.Bool.const
 
-    let not = f_pair_1 C.Bool.not S.Bool.not
+    let not = f_pair_1 C.Bool.not S.Bool.not
 
-    let or_ = f_pair_2 C.Bool.or_ S.Bool.or_
+    let or_ = f_pair_2 C.Bool.or_ S.Bool.or_
 
-    let and_ = f_pair_2 C.Bool.and_ S.Bool.and_
+    let and_ = f_pair_2 C.Bool.and_ S.Bool.and_
 
-    let int32 = f_pair_1 C.Bool.int32 S.Bool.int32
+    let int32 = f_pair_1 C.Bool.int32 S.Bool.int32
 
-    let pp = mk_pp C.Bool.pp S.Bool.pp
+    let pp = mk_pp C.Bool.pp S.Bool.pp
   end
 
   module type CFop = sig
@@ -1225,59 +1294,59 @@ 
60.90%

        and type int32 := int32
        and type int64 := int64
        and type same_size_int := (CIT.t, SIT.t) cs = struct
-    let zero = pair CFop.zero SFop.zero
+    let zero = pair CFop.zero SFop.zero
 
-    let abs = f_pair_1 CFop.abs SFop.abs
+    let abs = f_pair_1 CFop.abs SFop.abs
 
-    let neg = f_pair_1 CFop.neg SFop.neg
+    let neg = f_pair_1 CFop.neg SFop.neg
 
-    let sqrt = f_pair_1 CFop.sqrt SFop.sqrt
+    let sqrt = f_pair_1 CFop.sqrt SFop.sqrt
 
-    let ceil = f_pair_1 CFop.ceil SFop.ceil
+    let ceil = f_pair_1 CFop.ceil SFop.ceil
 
-    let floor = f_pair_1 CFop.floor SFop.floor
+    let floor = f_pair_1 CFop.floor SFop.floor
 
-    let trunc = f_pair_1 CFop.trunc SFop.trunc
+    let trunc = f_pair_1 CFop.trunc SFop.trunc
 
-    let nearest = f_pair_1 CFop.nearest SFop.nearest
+    let nearest = f_pair_1 CFop.nearest SFop.nearest
 
-    let add = f_pair_2 CFop.add SFop.add
+    let add = f_pair_2 CFop.add SFop.add
 
-    let sub = f_pair_2 CFop.sub SFop.sub
+    let sub = f_pair_2 CFop.sub SFop.sub
 
-    let mul = f_pair_2 CFop.mul SFop.mul
+    let mul = f_pair_2 CFop.mul SFop.mul
 
-    let div = f_pair_2 CFop.div SFop.div
+    let div = f_pair_2 CFop.div SFop.div
 
-    let min = f_pair_2 CFop.min SFop.min
+    let min = f_pair_2 CFop.min SFop.min
 
-    let max = f_pair_2 CFop.max SFop.max
+    let max = f_pair_2 CFop.max SFop.max
 
-    let copy_sign = f_pair_2 CFop.copy_sign SFop.copy_sign
+    let copy_sign = f_pair_2 CFop.copy_sign SFop.copy_sign
 
-    let eq = f_pair_2 CFop.eq SFop.eq
+    let eq = f_pair_2 CFop.eq SFop.eq
 
-    let ne = f_pair_2 CFop.ne SFop.ne
+    let ne = f_pair_2 CFop.ne SFop.ne
 
-    let lt = f_pair_2 CFop.lt SFop.lt
+    let lt = f_pair_2 CFop.lt SFop.lt
 
-    let gt = f_pair_2 CFop.gt SFop.gt
+    let gt = f_pair_2 CFop.gt SFop.gt
 
-    let le = f_pair_2 CFop.le SFop.le
+    let le = f_pair_2 CFop.le SFop.le
 
-    let ge = f_pair_2 CFop.ge SFop.ge
+    let ge = f_pair_2 CFop.ge SFop.ge
 
-    let convert_i32_s = f_pair_1 CFop.convert_i32_s SFop.convert_i32_s
+    let convert_i32_s = f_pair_1 CFop.convert_i32_s SFop.convert_i32_s
 
-    let convert_i32_u = f_pair_1 CFop.convert_i32_u SFop.convert_i32_u
+    let convert_i32_u = f_pair_1 CFop.convert_i32_u SFop.convert_i32_u
 
-    let convert_i64_s = f_pair_1 CFop.convert_i64_s SFop.convert_i64_s
+    let convert_i64_s = f_pair_1 CFop.convert_i64_s SFop.convert_i64_s
 
-    let convert_i64_u = f_pair_1 CFop.convert_i64_u SFop.convert_i64_u
+    let convert_i64_u = f_pair_1 CFop.convert_i64_u SFop.convert_i64_u
 
-    let of_bits = f_pair_1 CFop.of_bits SFop.of_bits
+    let of_bits = f_pair_1 CFop.of_bits SFop.of_bits
 
-    let to_bits = f_pair_1 CFop.to_bits SFop.to_bits
+    let to_bits = f_pair_1 CFop.to_bits SFop.to_bits
   end
 
   module type CIop = sig
@@ -1320,81 +1389,81 @@ 
60.90%

        and type vbool := vbool
        and type float32 := float32
        and type float64 := float64 = struct
-    let zero = pair CIop.zero SIop.zero
+    let zero = pair CIop.zero SIop.zero
 
-    let clz = f_pair_1 CIop.clz SIop.clz
+    let clz = f_pair_1 CIop.clz SIop.clz
 
-    let ctz = f_pair_1 CIop.ctz SIop.ctz
+    let ctz = f_pair_1 CIop.ctz SIop.ctz
 
-    let popcnt = f_pair_1 CIop.popcnt SIop.popcnt
+    let popcnt = f_pair_1 CIop.popcnt SIop.popcnt
 
-    let add = f_pair_2 CIop.add SIop.add
+    let add = f_pair_2 CIop.add SIop.add
 
-    let sub = f_pair_2 CIop.sub SIop.sub
+    let sub = f_pair_2 CIop.sub SIop.sub
 
-    let mul = f_pair_2 CIop.mul SIop.mul
+    let mul = f_pair_2 CIop.mul SIop.mul
 
-    let div = f_pair_2 CIop.div SIop.div
+    let div = f_pair_2 CIop.div SIop.div
 
-    let unsigned_div = f_pair_2 CIop.unsigned_div SIop.unsigned_div
+    let unsigned_div = f_pair_2 CIop.unsigned_div SIop.unsigned_div
 
-    let rem = f_pair_2 CIop.rem SIop.rem
+    let rem = f_pair_2 CIop.rem SIop.rem
 
-    let unsigned_rem = f_pair_2 CIop.unsigned_rem SIop.unsigned_rem
+    let unsigned_rem = f_pair_2 CIop.unsigned_rem SIop.unsigned_rem
 
-    let logand = f_pair_2 CIop.logand SIop.logand
+    let logand = f_pair_2 CIop.logand SIop.logand
 
-    let logor = f_pair_2 CIop.logor SIop.logor
+    let logor = f_pair_2 CIop.logor SIop.logor
 
-    let logxor = f_pair_2 CIop.logxor SIop.logxor
+    let logxor = f_pair_2 CIop.logxor SIop.logxor
 
-    let shl = f_pair_2 CIop.shl SIop.shl
+    let shl = f_pair_2 CIop.shl SIop.shl
 
-    let shr_s = f_pair_2 CIop.shr_s SIop.shr_s
+    let shr_s = f_pair_2 CIop.shr_s SIop.shr_s
 
-    let shr_u = f_pair_2 CIop.shr_u SIop.shr_u
+    let shr_u = f_pair_2 CIop.shr_u SIop.shr_u
 
-    let rotl = f_pair_2 CIop.rotl SIop.rotl
+    let rotl = f_pair_2 CIop.rotl SIop.rotl
 
-    let rotr = f_pair_2 CIop.rotr SIop.rotr
+    let rotr = f_pair_2 CIop.rotr SIop.rotr
 
-    let eq_const = f_pair_2_cst' CIop.eq_const SIop.eq_const
+    let eq_const = f_pair_2_cst' CIop.eq_const SIop.eq_const
 
-    let eq = f_pair_2 CIop.eq SIop.eq
+    let eq = f_pair_2 CIop.eq SIop.eq
 
-    let ne = f_pair_2 CIop.ne SIop.ne
+    let ne = f_pair_2 CIop.ne SIop.ne
 
-    let lt = f_pair_2 CIop.lt SIop.lt
+    let lt = f_pair_2 CIop.lt SIop.lt
 
-    let gt = f_pair_2 CIop.gt SIop.gt
+    let gt = f_pair_2 CIop.gt SIop.gt
 
-    let lt_u = f_pair_2 CIop.lt_u SIop.lt_u
+    let lt_u = f_pair_2 CIop.lt_u SIop.lt_u
 
-    let gt_u = f_pair_2 CIop.gt_u SIop.gt_u
+    let gt_u = f_pair_2 CIop.gt_u SIop.gt_u
 
-    let le = f_pair_2 CIop.le SIop.le
+    let le = f_pair_2 CIop.le SIop.le
 
-    let ge = f_pair_2 CIop.ge SIop.ge
+    let ge = f_pair_2 CIop.ge SIop.ge
 
-    let le_u = f_pair_2 CIop.le_u SIop.le_u
+    let le_u = f_pair_2 CIop.le_u SIop.le_u
 
-    let ge_u = f_pair_2 CIop.ge_u SIop.ge_u
+    let ge_u = f_pair_2 CIop.ge_u SIop.ge_u
 
-    let trunc_f32_s = f_pair_1 CIop.trunc_f32_s SIop.trunc_f32_s
+    let trunc_f32_s = f_pair_1 CIop.trunc_f32_s SIop.trunc_f32_s
 
-    let trunc_f32_u = f_pair_1 CIop.trunc_f32_u SIop.trunc_f32_u
+    let trunc_f32_u = f_pair_1 CIop.trunc_f32_u SIop.trunc_f32_u
 
-    let trunc_f64_s = f_pair_1 CIop.trunc_f64_s SIop.trunc_f64_s
+    let trunc_f64_s = f_pair_1 CIop.trunc_f64_s SIop.trunc_f64_s
 
-    let trunc_f64_u = f_pair_1 CIop.trunc_f64_u SIop.trunc_f64_u
+    let trunc_f64_u = f_pair_1 CIop.trunc_f64_u SIop.trunc_f64_u
 
-    let trunc_sat_f32_s = f_pair_1 CIop.trunc_sat_f32_s SIop.trunc_sat_f32_s
+    let trunc_sat_f32_s = f_pair_1 CIop.trunc_sat_f32_s SIop.trunc_sat_f32_s
 
-    let trunc_sat_f32_u = f_pair_1 CIop.trunc_sat_f32_u SIop.trunc_sat_f32_u
+    let trunc_sat_f32_u = f_pair_1 CIop.trunc_sat_f32_u SIop.trunc_sat_f32_u
 
-    let trunc_sat_f64_s = f_pair_1 CIop.trunc_sat_f64_s SIop.trunc_sat_f64_s
+    let trunc_sat_f64_s = f_pair_1 CIop.trunc_sat_f64_s SIop.trunc_sat_f64_s
 
-    let trunc_sat_f64_u = f_pair_1 CIop.trunc_sat_f64_u SIop.trunc_sat_f64_u
+    let trunc_sat_f64_u = f_pair_1 CIop.trunc_sat_f64_u SIop.trunc_sat_f64_u
 
     let extend_s symbolic cs =
       { concrete = CIop.extend_s symbolic cs.concrete
@@ -1420,9 +1489,9 @@ 
60.90%

         (C.F32)
         (S.F32)
 
-    let demote_f64 = f_pair_1 C.F32.demote_f64 S.F32.demote_f64
+    let demote_f64 = f_pair_1 C.F32.demote_f64 S.F32.demote_f64
 
-    let reinterpret_i32 = f_pair_1 C.F32.reinterpret_i32 S.F32.reinterpret_i32
+    let reinterpret_i32 = f_pair_1 C.F32.reinterpret_i32 S.F32.reinterpret_i32
   end
 
   module F64 = struct
@@ -1443,16 +1512,16 @@ 
60.90%

         (C.F64)
         (S.F64)
 
-    let promote_f32 = f_pair_1 C.F64.promote_f32 S.F64.promote_f32
+    let promote_f32 = f_pair_1 C.F64.promote_f32 S.F64.promote_f32
 
-    let reinterpret_i64 = f_pair_1 C.F64.reinterpret_i64 S.F64.reinterpret_i64
+    let reinterpret_i64 = f_pair_1 C.F64.reinterpret_i64 S.F64.reinterpret_i64
   end
 
   module I32 = struct
     include
       MK_Iop
         (struct
-          type t = Stdlib.Int32.t
+          type t = Int32.t
         end)
         (struct
           type t = C.int32
@@ -1463,18 +1532,18 @@ 
60.90%

         (C.I32)
         (S.I32)
 
-    let to_bool = f_pair_1 C.I32.to_bool S.I32.to_bool
+    let to_bool = f_pair_1 C.I32.to_bool S.I32.to_bool
 
-    let reinterpret_f32 = f_pair_1 C.I32.reinterpret_f32 S.I32.reinterpret_f32
+    let reinterpret_f32 = f_pair_1 C.I32.reinterpret_f32 S.I32.reinterpret_f32
 
-    let wrap_i64 = f_pair_1 C.I32.wrap_i64 S.I32.wrap_i64
+    let wrap_i64 = f_pair_1 C.I32.wrap_i64 S.I32.wrap_i64
   end
 
   module I64 = struct
     include
       MK_Iop
         (struct
-          type t = Stdlib.Int64.t
+          type t = Int64.t
         end)
         (struct
           type t = C.int64
@@ -1485,15 +1554,15 @@ 
60.90%

         (C.I64)
         (S.I64)
 
-    let of_int32 = f_pair_1 C.I64.of_int32 S.I64.of_int32
+    let of_int32 = f_pair_1 C.I64.of_int32 S.I64.of_int32
 
-    let to_int32 = f_pair_1 C.I64.to_int32 S.I64.to_int32
+    let to_int32 = f_pair_1 C.I64.to_int32 S.I64.to_int32
 
-    let reinterpret_f64 = f_pair_1 C.I64.reinterpret_f64 S.I64.reinterpret_f64
+    let reinterpret_f64 = f_pair_1 C.I64.reinterpret_f64 S.I64.reinterpret_f64
 
-    let extend_i32_s = f_pair_1 C.I64.extend_i32_s S.I64.extend_i32_s
+    let extend_i32_s = f_pair_1 C.I64.extend_i32_s S.I64.extend_i32_s
 
-    let extend_i32_u = f_pair_1 C.I64.extend_i32_u S.I64.extend_i32_u
+    let extend_i32_u = f_pair_1 C.I64.extend_i32_u S.I64.extend_i32_u
   end
 end
 
diff --git a/coverage/src/concolic/concolic_wasm_ffi.ml.html b/coverage/src/concolic/concolic_wasm_ffi.ml.html
new file mode 100644
index 000000000..ca8b5b81c
--- /dev/null
+++ b/coverage/src/concolic/concolic_wasm_ffi.ml.html
@@ -0,0 +1,633 @@
+
+
+  
+    
+    concolic_wasm_ffi.ml — Coverage report
+    
+    
+    
+    
+  
+  
+    
+    
+    

+      

+        
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+

+      

+      

+        
+  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
+

+
(* SPDX-License-Identifier: AGPL-3.0-or-later *)
+(* Copyright © 2021-2024 OCamlPro *)
+(* Written by the Owi programmers *)
+
+module Expr = Smtml.Expr
+module Choice = Concolic.P.Choice
+module Memory = Concolic.P.Memory
+
+(* The constraint is used here to make sure we don't forget to define one of the expected FFI functions, this whole file is further constrained such that if one function of M is unused in the FFI module below, an error will be displayed *)
+module M :
+  Wasm_ffi_intf.S0
+    with type 'a t = 'a Choice.t
+     and type memory = Memory.t
+     and module Value = Concolic_value.V = struct
+  type 'a t = 'a Choice.t
+
+  type memory = Memory.t
+
+  module Value = Concolic_value.V
+
+  let symbol_i32 () : Value.int32 Choice.t =
+    Choice.with_new_symbol (Ty_bitv 32) (fun sym forced_value ->
+        let n =
+          match forced_value with
+          | None -> Random.bits32 ()
+          | Some (Num (I32 n)) -> n
+          | _ -> assert false
+        in
+        (I32 n, Value.pair n (Expr.mk_symbol sym)) )
+
+  let symbol_i8 () : Value.int32 Choice.t =
+    Choice.with_new_symbol (Ty_bitv 32) (fun sym forced_value ->
+        let n =
+          match forced_value with
+          | None -> Int32.logand 0xFFl (Random.bits32 ())
+          | Some (Num (I32 n)) -> n
+          | _ -> assert false
+        in
+        let sym_expr =
+          Expr.make (Cvtop (Ty_bitv 32, Zero_extend 24, Expr.mk_symbol sym))
+        in
+        (I32 n, Value.pair n sym_expr) )
+
+  let symbol_char () : Value.int32 Choice.t =
+    Choice.with_new_symbol (Ty_bitv 32) (fun sym forced_value ->
+        let n =
+          match forced_value with
+          | None -> Int32.logand 0xFFl (Random.bits32 ())
+          | Some (Num (I32 n)) -> n
+          | _ -> assert false
+        in
+        let sym_expr =
+          Expr.make (Cvtop (Ty_bitv 32, Zero_extend 24, Expr.mk_symbol sym))
+        in
+        (I32 n, Value.pair n sym_expr) )
+
+  let symbol_i64 () : Value.int64 Choice.t =
+    Choice.with_new_symbol (Ty_bitv 64) (fun sym forced_value ->
+        let n =
+          match forced_value with
+          | None -> Random.bits64 ()
+          | Some (Num (I64 n)) -> n
+          | _ -> assert false
+        in
+        (I64 n, Value.pair n (Expr.mk_symbol sym)) )
+
+  let symbol_f32 () : Value.float32 Choice.t =
+    Choice.with_new_symbol (Ty_fp 32) (fun sym forced_value ->
+        let n =
+          match forced_value with
+          | None -> Random.bits32 ()
+          | Some (Num (F32 n)) -> n
+          | _ -> assert false
+        in
+        let n = Float32.of_bits n in
+        (F32 n, Value.pair n (Expr.mk_symbol sym)) )
+
+  let symbol_f64 () : Value.float64 Choice.t =
+    Choice.with_new_symbol (Ty_fp 64) (fun sym forced_value ->
+        let n =
+          match forced_value with
+          | None -> Random.bits64 ()
+          | Some (Num (F64 n)) -> n
+          | _ -> assert false
+        in
+        let n = Float64.of_bits n in
+        (F64 n, Value.pair n (Expr.mk_symbol sym)) )
+
+  let assume_i32 (i : Value.int32) : unit Choice.t =
+    let c = Value.I32.to_bool i in
+    Concolic_choice.assume c
+
+  let assume_positive_i32 (i : Value.int32) : unit Choice.t =
+    let c = Value.I32.ge i Value.I32.zero in
+    Concolic_choice.assume c
+
+  let assert_i32 (i : Value.int32) : unit Choice.t =
+    let c = Value.I32.to_bool i in
+    Concolic_choice.assertion c
+
+  open Expr
+
+  let abort () : unit Choice.t = Choice.abort
+
+  let i32 (v : Value.int32) : int32 Choice.t =
+    (* TODO: select_i32 ? *)
+    (* let+ v = Choice.select_i32 v in *)
+    (* let n = v.c in *)
+    (* let x = Choice.assume (Value.I32.eq v (Value.const_i32 n)) in *)
+    match view v.symbolic with
+    | Val (Num (I32 v)) -> Choice.return v
+    | _ ->
+      Log.debug2 {|alloc: cannot allocate base pointer "%a"|} Expr.pp v.symbolic;
+      Choice.bind (abort ()) (fun () -> assert false)
+
+  let ptr (v : Value.int32) : int32 Choice.t =
+    match view v.symbolic with
+    | Ptr { base; _ } -> Choice.return base
+    | _ ->
+      Log.debug2 {|free: cannot fetch pointer base of "%a"|} Expr.pp v.symbolic;
+      Choice.bind (abort ()) (fun () -> assert false)
+
+  let exit (_p : Value.int32) : unit Choice.t = abort ()
+
+  let alloc _ (base : Value.int32) (_size : Value.int32) : Value.int32 Choice.t
+      =
+    Choice.bind (i32 base) (fun (base : int32) ->
+        Choice.return
+          { Concolic_value.concrete = base
+          ; symbolic = Expr.ptr base (Symbolic_value.const_i32 0l)
+          } )
+
+  let free _ (p : Value.int32) : unit Choice.t =
+    (* WHAT ???? *)
+    let _base = ptr p in
+    Choice.return ()
+end
+
+type extern_func = Concolic.P.Extern_func.extern_func
+
+open M
+
+let symbolic_extern_module =
+  let functions =
+    [ ( "i8_symbol"
+      , Concolic.P.Extern_func.Extern_func (Func (UArg Res, R1 I32), symbol_i8)
+      )
+    ; ( "i32_symbol"
+      , Concolic.P.Extern_func.Extern_func (Func (UArg Res, R1 I32), symbol_i32)
+      )
+    ; ( "i64_symbol"
+      , Concolic.P.Extern_func.Extern_func (Func (UArg Res, R1 I64), symbol_i64)
+      )
+    ; ( "f32_symbol"
+      , Concolic.P.Extern_func.Extern_func (Func (UArg Res, R1 F32), symbol_f32)
+      )
+    ; ( "f64_symbol"
+      , Concolic.P.Extern_func.Extern_func (Func (UArg Res, R1 F64), symbol_f64)
+      )
+    ; ( "assume"
+      , Concolic.P.Extern_func.Extern_func
+          (Func (Arg (I32, Res), R0), assume_i32) )
+    ; ( "assume_positive_i32"
+      , Concolic.P.Extern_func.Extern_func
+          (Func (Arg (I32, Res), R0), assume_positive_i32) )
+    ; ( "assert"
+      , Concolic.P.Extern_func.Extern_func
+          (Func (Arg (I32, Res), R0), assert_i32) )
+    ]
+  in
+  { Link.functions }
+
+let summaries_extern_module =
+  let functions =
+    [ ( "alloc"
+      , Concolic.P.Extern_func.Extern_func
+          (Func (Mem (Arg (I32, Arg (I32, Res))), R1 I32), alloc) )
+    ; ( "dealloc"
+      , Concolic.P.Extern_func.Extern_func
+          (Func (Mem (Arg (I32, Res)), R0), free) )
+    ; ("abort", Concolic.P.Extern_func.Extern_func (Func (UArg Res, R0), abort))
+    ]
+  in
+  { Link.functions }
+

+      

+    

+    
+  
+
diff --git a/coverage/src/concrete/concrete.ml.html b/coverage/src/concrete/concrete.ml.html
index 920bae4d5..593e3073a 100644
--- a/coverage/src/concrete/concrete.ml.html
+++ b/coverage/src/concrete/concrete.ml.html
@@ -174,21 +174,21 @@ 
100.00%

 module Choice = Concrete_choice
 
 let select cond ~if_true ~if_false =
-  if cond then Choice.return if_true else Choice.return if_false
+  if cond then Choice.return if_true else Choice.return if_false
 [@@inline]
 
 module Elem = struct
   type t = Link_env.elem
 
-  let get (e : t) i = e.value.(i)
+  let get (e : t) i = e.value.(i)
 
-  let size (e : t) = Array.length e.value
+  let size (e : t) = Array.length e.value
 end
 
 module Data = struct
   type t = Link_env.data
 
-  let value data = data.Link_env.value
+  let value data = data.Link_env.value
 end
 
 module Env = struct
@@ -203,8 +203,8 @@ 
100.00%

   let get_elem = Link_env.get_elem
 
   let get_data env n =
-    let data = Link_env.get_data env n in
-    Choice.return data
+    let data = Link_env.get_data env n in
+    Choice.return data
 
   let get_global = Link_env.get_global
 
@@ -219,11 +219,11 @@ 
100.00%

   (** runnable module *)
   type t = Concrete_value.Func.extern_func Link.module_to_run
 
-  let env (t : Concrete_value.Func.extern_func Link.module_to_run) = t.env
+  let env (t : Concrete_value.Func.extern_func Link.module_to_run) = t.env
 
-  let modul (t : Concrete_value.Func.extern_func Link.module_to_run) = t.modul
+  let modul (t : Concrete_value.Func.extern_func Link.module_to_run) = t.modul
 
-  let to_run (t : Concrete_value.Func.extern_func Link.module_to_run) = t.to_run
+  let to_run (t : Concrete_value.Func.extern_func Link.module_to_run) = t.to_run
 end
diff --git a/coverage/src/concrete/concrete_choice.ml.html b/coverage/src/concrete/concrete_choice.ml.html index 2d1cc5114..d39ea54f1 100644 --- a/coverage/src/concrete/concrete_choice.ml.html +++ b/coverage/src/concrete/concrete_choice.ml.html @@ -89,26 +89,26 @@

100.00%

type 'a t = 'a -let return x = x [@@inline] +let return x = x [@@inline] -let bind x f = f x [@@inline] +let bind x f = f x [@@inline] let ( let* ) = bind let map v f = - let* v in - return (f v) + let* v in + return (f v) [@@inline] let ( let+ ) = map -let select b = b [@@inline] +let select b = b [@@inline] -let select_i32 i = i [@@inline] +let select_i32 i = i [@@inline] -let trap msg = raise (Types.Trap msg) +let trap msg = raise (Types.Trap msg) -let trap : Trap.t -> 'a t = fun tr -> trap (Trap.to_string tr) +let trap : Trap.t -> 'a t = fun tr -> trap (Trap.to_string tr) let run = Fun.id diff --git a/coverage/src/concrete/concrete_global.ml.html b/coverage/src/concrete/concrete_global.ml.html index eee8273e4..a950ff3b5 100644 --- a/coverage/src/concrete/concrete_global.ml.html +++ b/coverage/src/concrete/concrete_global.ml.html @@ -3,7 +3,7 @@ concrete_global.ml — Coverage report - + @@ -15,9 +15,10 @@

src/concrete/concrete_global.ml

-

100.00%

+

83.33%

@@ -39,9 +40,13 @@

100.00%

- + + + + +
@@ -66,6 +71,10 @@

100.00%

18 19 20 +21 +22 +23 +24 
(* SPDX-License-Identifier: AGPL-3.0-or-later *)
 (* Copyright © 2021-2024 OCamlPro *)
@@ -80,13 +89,17 @@ 
100.00%

   ; typ : binary val_type
   }
 
-let value g = g.value
+let value g = g.value
 
-let set_value g v = g.value <- v
+let set_value g v = g.value <- v
 
-let mut g = g.mut
+let mut g = g.mut
 
-let typ g = g.typ
+let typ g = g.typ
+
+let backup t = { t with value = t.value }
+
+let recover ~from_ ~to_ = to_.value <- from_.value
diff --git a/coverage/src/concrete/concrete_memory.ml.html b/coverage/src/concrete/concrete_memory.ml.html index 25f5e914e..ad98908cc 100644 --- a/coverage/src/concrete/concrete_memory.ml.html +++ b/coverage/src/concrete/concrete_memory.ml.html @@ -3,7 +3,7 @@ concrete_memory.ml — Coverage report - + @@ -15,13 +15,13 @@

src/concrete/concrete_memory.ml

-

94.81%

+

95.00%

@@ -39,106 +39,112 @@

94.81%

- - - - + + + + - - - - + + + + - + - - - - + + + + - + - - - + + + - - - - - + + + + + - - - - - + + + + + - - - - - + + + + + - - - - + + + + - - + + - - + + - - + + - + - + - + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - + + + + + + +
@@ -256,6 +262,12 @@

94.81%

111 112 113 +114 +115 +116 +117 +118 +119 
(* SPDX-License-Identifier: AGPL-3.0-or-later *)
 (* Copyright © 2021-2024 OCamlPro *)
@@ -270,23 +282,29 @@ 
94.81%

   ; mutable data : bytes
   }
 
+let backup t = { t with data = Bytes.copy t.data }
+
+let recover ~from_ ~to_ =
+  to_.limits <- from_.limits;
+  to_.data <- from_.data
+
 let init limits : t =
-  let data = Bytes.make (page_size * limits.min) '\x00' in
-  { limits; data }
+  let data = Bytes.make (page_size * limits.min) '\x00' in
+  { limits; data }
 
 let update_memory mem data =
-  let limits =
-    { mem.limits with min = max mem.limits.min (Bytes.length data / page_size) }
+  let limits =
+    { mem.limits with min = max mem.limits.min (Bytes.length data / page_size) }
   in
   mem.limits <- limits;
   mem.data <- data
 
 let grow mem delta =
-  let delta = Int32.to_int delta in
-  let old_size = Bytes.length mem.data in
-  let new_mem = Bytes.extend mem.data 0 delta in
-  Bytes.unsafe_fill new_mem old_size delta (Char.chr 0);
-  update_memory mem new_mem
+  let delta = Int32.to_int delta in
+  let old_size = Bytes.length mem.data in
+  let new_mem = Bytes.extend mem.data 0 delta in
+  Bytes.unsafe_fill new_mem old_size delta (Char.chr 0);
+  update_memory mem new_mem
 
 let fill mem ~pos ~len c =
   let pos = Int32.to_int pos in
@@ -310,25 +328,25 @@ 
94.81%

     false )
 
 let blit_string mem str ~src ~dst ~len =
-  let str_len = String.length str in
-  let src = Int32.to_int src in
-  let dst = Int32.to_int dst in
-  let len = Int32.to_int len in
-  src < 0 || dst < 0 || len < 0
+  let str_len = String.length str in
+  let src = Int32.to_int src in
+  let dst = Int32.to_int dst in
+  let len = Int32.to_int len in
+  src < 0 || dst < 0 || len < 0
   || src + len > str_len
-  || dst + len > Bytes.length mem.data
+  || dst + len > Bytes.length mem.data
   ||
   ( Bytes.unsafe_blit_string str src mem.data dst len;
-    false )
+    false )
 
-let get_limit_max { limits; _ } = Option.map Int64.of_int limits.max
+let get_limit_max { limits; _ } = Option.map Int64.of_int limits.max
 
-let get_limits { limits; _ } = limits
+let get_limits { limits; _ } = limits
 
 let store_8 mem ~addr n =
-  let addr = Int32.to_int addr in
-  let n = Int32.to_int n in
-  Bytes.set_int8 mem.data addr n
+  let addr = Int32.to_int addr in
+  let n = Int32.to_int n in
+  Bytes.set_int8 mem.data addr n
 
 let store_16 mem ~addr n =
   let addr = Int32.to_int addr in
@@ -336,12 +354,12 @@ 
94.81%

   Bytes.set_int16_le mem.data addr n
 
 let store_32 mem ~addr n =
-  let addr = Int32.to_int addr in
-  Bytes.set_int32_le mem.data addr n
+  let addr = Int32.to_int addr in
+  Bytes.set_int32_le mem.data addr n
 
 let store_64 mem ~addr n =
-  let addr = Int32.to_int addr in
-  Bytes.set_int64_le mem.data addr n
+  let addr = Int32.to_int addr in
+  Bytes.set_int64_le mem.data addr n
 
 let load_8_s mem addr =
   let addr = Int32.to_int addr in
@@ -360,16 +378,16 @@ 
94.81%

   Int32.of_int @@ Bytes.get_uint16_le mem.data addr
 
 let load_32 mem addr =
-  let addr = Int32.to_int addr in
-  Bytes.get_int32_le mem.data addr
+  let addr = Int32.to_int addr in
+  Bytes.get_int32_le mem.data addr
 
 let load_64 mem addr =
-  let addr = Int32.to_int addr in
-  Bytes.get_int64_le mem.data addr
+  let addr = Int32.to_int addr in
+  Bytes.get_int64_le mem.data addr
 
-let size_in_pages mem = Int32.of_int @@ (Bytes.length mem.data / page_size)
+let size_in_pages mem = Int32.of_int @@ (Bytes.length mem.data / page_size)
 
-let size mem = Int32.of_int @@ Bytes.length mem.data
+let size mem = Int32.of_int @@ Bytes.length mem.data
diff --git a/coverage/src/concrete/concrete_table.ml.html b/coverage/src/concrete/concrete_table.ml.html index 11a6591e2..af0166241 100644 --- a/coverage/src/concrete/concrete_table.ml.html +++ b/coverage/src/concrete/concrete_table.ml.html @@ -3,7 +3,7 @@ concrete_table.ml — Coverage report - + @@ -15,9 +15,11 @@

src/concrete/concrete_table.ml

-

100.00%

+

88.89%

@@ -39,20 +41,20 @@

100.00%

- + - - - + + + - - - - - - + + + + + + @@ -63,22 +65,26 @@

100.00%

- - + + - - - - + + + + - + - + - - + + + + + +
@@ -140,6 +146,10 @@

100.00%

55 56 57 +58 +59 +60 +61 
(* SPDX-License-Identifier: AGPL-3.0-or-later *)
 (* Copyright © 2021-2024 OCamlPro *)
@@ -158,27 +168,31 @@ 
100.00%

   ; mutable data : table
   }
 
+let backup t = { t with data = Array.copy t.data }
+
+let recover ~from_ ~to_ = to_.data <- from_.data
+
 let fresh =
   let r = ref (-1) in
   fun () ->
-    incr r;
-    !r
+    incr r;
+    !r
 
 let init ?label (typ : binary table_type) : t =
-  let limits, ((_null, heap_type) as ref_type) = typ in
+  let limits, ((_null, heap_type) as ref_type) = typ in
   let null = Concrete_value.ref_null' heap_type in
-  let table = Array.make limits.min null in
-  { id = fresh (); label; limits; typ = ref_type; data = table }
+  let table = Array.make limits.min null in
+  { id = fresh (); label; limits; typ = ref_type; data = table }
 
 let update table data = table.data <- data
 
-let get t i = t.data.(i)
+let get t i = t.data.(i)
 
-let set t i v = t.data.(i) <- v
+let set t i v = t.data.(i) <- v
 
-let size t = Array.length t.data
+let size t = Array.length t.data
 
-let typ t = t.typ
+let typ t = t.typ
 
 let max_size t = t.limits.max
 
diff --git a/coverage/src/concrete/concrete_value.ml.html b/coverage/src/concrete/concrete_value.ml.html
index 40d38f612..696e202c7 100644
--- a/coverage/src/concrete/concrete_value.ml.html
+++ b/coverage/src/concrete/concrete_value.ml.html
@@ -3,7 +3,7 @@
   
     
     concrete_value.ml — Coverage report
-    
+    
     
     
     
@@ -15,23 +15,21 @@ 

           src/concrete/concrete_value.ml
         
       

-      
63.38%

+      
66.67%
@@ -73,49 +71,49 @@

63.38%

- - - - - - - - + + + + + + + + - - - - - + + + + + - + - + - - - - - + + + + + - + - + - + - + - - + + - + @@ -137,7 +135,7 @@

63.38%

- + @@ -145,24 +143,24 @@

63.38%

- - - + + + - - - + + + - - - - - + + + + + @@ -170,33 +168,41 @@

63.38%

- + - - - - - + + + + + - + - - - - + + + + - - + + - + - + - - + + + + + + + + + +
@@ -361,18 +367,31 @@

63.38%

158 159 160 +161 +162 +163 +164 +165 +166 +167 +168 
(* SPDX-License-Identifier: AGPL-3.0-or-later *)
 (* Copyright © 2021-2024 OCamlPro *)
 (* Written by the Owi programmers *)
 
 open Types
-open Format
+open Fmt
 
-module Make_extern_func (V : Func_intf.Value_types) (M : Func_intf.Monad_type) =
+module Make_extern_func
+    (V : Func_intf.Value_types)
+    (M : Func_intf.Monad_type)
+    (Memory : Func_intf.Memory_type) =
 struct
   type 'a m = 'a M.t
 
+  type memory = Memory.t
+
   type _ telt =
     | I32 : V.int32 telt
     | I64 : V.int64 telt
@@ -388,6 +407,7 @@ 
63.38%

     | 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
@@ -398,42 +418,43 @@ 
63.38%

   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
+    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 ]
+    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
-    | UArg tl -> arg_type tl
-    | Arg (hd, tl) -> (None, elt_type hd) :: arg_type tl
+    | 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 -> []
+    | Res -> []
 
   (* let extern_type (Func (arg, res)) : Simplified.func_type = *)
   (*   (arg_type arg, res_type res) *)
 
   let extern_type (Extern_func (Func (arg, res), _)) : binary Types.func_type =
-    (arg_type arg, res_type res)
+    (arg_type arg, res_type res)
 
   type t = Func_intf.t
 
   let fresh =
-    let r = ref ~-1 in
+    let r = ref ~-1 in
     fun () ->
-      incr r;
-      !r
+      incr r;
+      !r
 
-  let wasm func env : t = WASM (fresh (), func, env)
+  let wasm func env : t = WASM (fresh (), func, env)
 
   (* let typ = function *)
   (*   | Func_intf.WASM (_, func, _env) -> func.type_f *)
@@ -457,12 +478,13 @@ 
63.38%

       (struct
         type 'a t = 'a
       end)
+      (Concrete_memory)
 end
 
 type externref = E : 'a Type.Id.t * 'a -> externref
 
 let cast_ref (type r) (E (rty, r) : externref) (ty : r Type.Id.t) : r option =
-  match Type.Id.provably_equal rty ty with None -> None | Some Equal -> Some r
+  match Type.Id.provably_equal rty ty with None -> None | Some Equal -> Some r
 
 type ref_value =
   | Externref of externref option
@@ -470,9 +492,9 @@ 
63.38%

   | Arrayref of unit Array.t option
 
 let pp_ref_value fmt = function
-  | Externref _ -> pp fmt "externref"
-  | Funcref _ -> pp fmt "funcref"
-  | Arrayref _ -> pp fmt "array"
+  | Externref _ -> pf fmt "externref"
+  | Funcref _ -> pf fmt "funcref"
+  | Arrayref _ -> pf fmt "array"
 
 type t =
   | I32 of Int32.t
@@ -483,36 +505,36 @@ 
63.38%

 
 (* TODO: make a new kind of instr for this *)
 let of_instr (i : binary instr) : t =
-  match i with
-  | I32_const c -> I32 c
+  match i with
+  | I32_const c -> I32 c
   | I64_const c -> I64 c
-  | F32_const c -> F32 c
-  | F64_const c -> F64 c
+  | F32_const c -> F32 c
+  | F64_const c -> F64 c
   | _ -> assert false
 
 let to_instr = function
-  | I32 c -> I32_const c
-  | I64 c -> I64_const c
+  | I32 c -> I32_const c
+  | I64 c -> I64_const c
   | F32 c -> F32_const c
   | F64 c -> F64_const c
   | Ref _ -> assert false
 
 let pp fmt = function
-  | I32 i -> pp fmt "i32.const %ld" i
-  | I64 i -> pp fmt "i64.const %Ld" i
-  | F32 f -> pp fmt "f32.const %a" Float32.pp f
-  | F64 f -> pp fmt "f64.const %a" Float64.pp f
+  | I32 i -> pf fmt "i32.const %ld" i
+  | I64 i -> pf fmt "i64.const %Ld" i
+  | F32 f -> pf fmt "f32.const %a" Float32.pp f
+  | F64 f -> pf fmt "f64.const %a" Float64.pp f
   | Ref r -> pp_ref_value fmt r
 
 let ref_null' = function
-  | Func_ht -> Funcref None
-  | Extern_ht -> Externref None
+  | Func_ht -> Funcref None
+  | Extern_ht -> Externref None
   | Array_ht -> Arrayref None
   | Any_ht | None_ht | Eq_ht | I31_ht | Struct_ht | No_func_ht | No_extern_ht
   | Def_ht _ ->
     assert false
 
-let ref_null typ = Ref (ref_null' typ)
+let ref_null typ = Ref (ref_null' typ)
 
 let ref_func (f : Func.t) : t = Ref (Funcref (Some f))
 
diff --git a/coverage/src/concrete/v.ml.html b/coverage/src/concrete/v.ml.html
new file mode 100644
index 000000000..d5cbf32ed
--- /dev/null
+++ b/coverage/src/concrete/v.ml.html
@@ -0,0 +1,341 @@
+
+
+  
+    
+    v.ml — Coverage report
+    
+    
+    
+    
+  
+  
+    
+    
+    

+      

+        
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+

+      

+      

+        
+  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
+

+
(* SPDX-License-Identifier: AGPL-3.0-or-later *)
+(* Copyright © 2021-2024 OCamlPro *)
+(* Written by the Owi programmers *)
+
+include (
+  struct
+    type vbool = bool
+
+    type int32 = Int32.t
+
+    let pp_int32 fmt i = Fmt.pf fmt "%ld" i
+
+    type int64 = Int64.t
+
+    let pp_int64 fmt i = Fmt.pf fmt "%Ld" i
+
+    type float32 = Float32.t
+
+    let pp_float32 = Float32.pp
+
+    type float64 = Float64.t
+
+    let pp_float64 = Float64.pp
+
+    let const_i32 x = x
+
+    let const_i64 x = x
+
+    let const_f32 x = x
+
+    let const_f64 x = x
+
+    include Concrete_value
+
+    let pp_ref_value = Concrete_value.pp_ref_value
+
+    module Ref = struct
+      let get_func (r : ref_value) : Func_intf.t Value_intf.get_ref =
+        match r with
+        | Funcref (Some f) -> Ref_value f
+        | Funcref None -> Null
+        | _ -> Type_mismatch
+
+      let get_externref (type t) (r : ref_value) (t : t Type.Id.t) :
+        t Value_intf.get_ref =
+        match r with
+        | Externref (Some (E (ety, v))) -> (
+          match Type.Id.provably_equal t ety with
+          | None -> assert false
+          | Some Equal -> Ref_value v )
+        | _ -> assert false
+    end
+
+    module Bool = struct
+      let const c = c
+
+      let not = not
+
+      let and_ = ( && )
+
+      let or_ = ( || )
+
+      let int32 = function true -> 1l | false -> 0l
+
+      let pp = Fmt.bool
+    end
+
+    module I32 = struct
+      include Int32
+      include Convert.Int32
+
+      let to_bool i = Int32.ne i 0l
+
+      let eq_const = eq
+    end
+
+    module I64 = struct
+      include Int64
+      include Convert.Int64
+
+      let eq_const = eq
+    end
+
+    module F32 = struct
+      include Float32
+      include Convert.Float32
+    end
+
+    module F64 = struct
+      include Float64
+      include Convert.Float64
+    end
+  end :
+    Value_intf.T
+      with type vbool = Bool.t
+       and type int32 = Int32.t
+       and type int64 = Int64.t
+       and type float32 = Float32.t
+       and type float64 = Float64.t
+       and type ref_value = Concrete_value.ref_value
+       and type t = Concrete_value.t )
+

+      

+    

+    
+  
+
diff --git a/coverage/src/data_structures/env_id.ml.html b/coverage/src/data_structures/env_id.ml.html
index 94f7efe19..3d7aedef5 100644
--- a/coverage/src/data_structures/env_id.ml.html
+++ b/coverage/src/data_structures/env_id.ml.html
@@ -106,20 +106,20 @@ 
77.78%

 let empty = { c = Map.empty; last = 0 }
 
 let with_fresh_id f { c; last } =
-  let open Syntax in
-  let+ e, r = f last in
-  let c = Map.add last e c in
-  let last = succ last in
-  ({ c; last }, r)
+  let open Syntax in
+  let+ e, r = f last in
+  let c = Map.add last e c in
+  let last = succ last in
+  ({ c; last }, r)
 
-let get i c = Map.find i c.c
+let get i c = Map.find i c.c
 
 let map f c = { c with c = Map.map f c.c }
 
 module Tbl = Hashtbl.Make (struct
   include Int
 
-  let hash x = x
+  let hash x = x
 end)
diff --git a/coverage/src/data_structures/func_id.ml.html b/coverage/src/data_structures/func_id.ml.html index 9b5c9d32e..b413088d0 100644 --- a/coverage/src/data_structures/func_id.ml.html +++ b/coverage/src/data_structures/func_id.ml.html @@ -101,16 +101,16 @@

100.00%

let empty = { c = IMap.empty; last = 0 } let add f t { last; c } = - let c = IMap.add last (f, t) c in - (last, { c; last = succ last }) + let c = IMap.add last (f, t) c in + (last, { c; last = succ last }) let get i c = - let v, _ = IMap.find i c.c in - v + let v, _ = IMap.find i c.c in + v let get_typ i c = - let _, t = IMap.find i c.c in - t + let _, t = IMap.find i c.c in + t
diff --git a/coverage/src/data_structures/indexed.ml.html b/coverage/src/data_structures/indexed.ml.html index 40f5c1c95..5f71e2d66 100644 --- a/coverage/src/data_structures/indexed.ml.html +++ b/coverage/src/data_structures/indexed.ml.html @@ -3,7 +3,7 @@ indexed.ml — Coverage report - + @@ -15,9 +15,11 @@

src/data_structures/indexed.ml

-

92.86%

+

71.43%

@@ -43,8 +45,8 @@

92.86%

- - + + @@ -95,24 +97,24 @@

92.86%

; value : 'a } -let get v = v.value +let get v = v.value -let get_index v = v.index +let get_index v = v.index -let map f v = { index = v.index; value = f v.value } +let map f v = { index = v.index; value = f v.value } -let return index value = { index; value } +let return index value = { index; value } -let has_index idx { index; _ } = idx = index +let has_index idx { index; _ } = idx = index let get_at_exn i values = - let { value; _ } = List.find (has_index i) values in - value + let { value; _ } = List.find (has_index i) values in + value let get_at i values = - match List.find_opt (has_index i) values with - | None -> None - | Some { value; _ } -> Some value + match List.find_opt (has_index i) values with + | None -> None + | Some { value; _ } -> Some value let pp f fmt v = f fmt v.value diff --git a/coverage/src/data_structures/named.ml.html b/coverage/src/data_structures/named.ml.html index 400b3ff47..860fc6dcf 100644 --- a/coverage/src/data_structures/named.ml.html +++ b/coverage/src/data_structures/named.ml.html @@ -80,13 +80,13 @@

100.00%

let empty = { values = []; named = String_map.empty } let fold f v acc = - List.fold_left - (fun acc v -> f (Indexed.get_index v) (Indexed.get v) acc) + List.fold_left + (fun acc v -> f (Indexed.get_index v) (Indexed.get v) acc) acc v.values let map f v = - let values = List.map f v.values in - { v with values } + let values = List.map f v.values in + { v with values }
diff --git a/coverage/src/data_structures/stack.ml.html b/coverage/src/data_structures/stack.ml.html index 49d1b5501..50a1618a1 100644 --- a/coverage/src/data_structures/stack.ml.html +++ b/coverage/src/data_structures/stack.ml.html @@ -18,21 +18,21 @@

82.76%

@@ -252,8 +252,11 @@

82.76%

- - + + + + +
@@ -475,6 +478,9 @@

82.76%

215 216 217 +218 +219 +220 
(* SPDX-License-Identifier: AGPL-3.0-or-later *)
 (* Copyright © 2021-2024 OCamlPro *)
@@ -499,7 +505,7 @@ 
82.76%

 
   val empty : t
 
-  val pp : Format.formatter -> t -> unit
+  val pp : Fmt.formatter -> t -> unit
 
   (** pop operations *)
 
@@ -581,25 +587,25 @@ 
82.76%

 
   let empty = []
 
-  let push s v = v :: s
+  let push s v = v :: s
 
-  let push_bool s b = push s (I32 (V.Bool.int32 b))
+  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_const_i32 s i = push s (I32 (V.const_i32 i))
 
-  let push_i32 s i = push s (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_const_i64 s i = push s (I64 (V.const_i64 i))
 
-  let push_i64 s i = push s (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_const_f32 s f = push s (F32 (V.const_f32 f))
 
-  let push_f32 s f = push s (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_const_f64 s f = push s (F64 (V.const_f64 f))
 
   let push_f64 s f = push s (F64 f)
 
@@ -608,55 +614,55 @@ 
82.76%

   let push_array _ _ = assert false
 
   let pp fmt (s : t) =
-    Format.pp_list ~pp_sep:(fun fmt () -> Format.pp_string fmt " ; ") V.pp fmt s
+    Fmt.list ~sep:(fun fmt () -> Fmt.string fmt " ; ") V.pp fmt s
 
-  let pop = function [] -> raise Empty | hd :: tl -> (hd, tl)
+  let pop = function [] -> raise Empty | hd :: tl -> (hd, tl)
 
-  let drop = function [] -> raise Empty | _hd :: tl -> 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)
+    let hd, tl = pop s in
+    match hd with
+    | I32 n -> (n, tl)
     | _ -> Log.err "invalid type (expected i32)"
 
   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)
+    let n2, s = pop s in
+    let n1, tl = pop s in
+    match (n1, n2) with
+    | I32 n1, I32 n2 -> ((n1, n2), tl)
     | _ -> Log.err "invalid type (expected i32)"
 
   let pop_i64 s =
-    let hd, tl = pop s in
-    match hd with
-    | I64 n -> (n, tl)
+    let hd, tl = pop s in
+    match hd with
+    | I64 n -> (n, tl)
     | _ -> Log.err "invalid type (expected i64)"
 
   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)
+    let n2, s = pop s in
+    let n1, tl = pop s in
+    match (n1, n2) with
+    | I64 n1, I64 n2 -> ((n1, n2), tl)
     | _ -> Log.err "invalid type (expected i64)"
 
   let pop_f32 s =
-    let hd, tl = pop s in
-    match hd with
-    | F32 f -> (f, tl)
+    let hd, tl = pop s in
+    match hd with
+    | F32 f -> (f, tl)
     | _ -> Log.err "invalid type (expected f32)"
 
   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)
+    let n2, s = pop s in
+    let n1, tl = pop s in
+    match (n1, n2) with
+    | F32 n1, F32 n2 -> ((n1, n2), tl)
     | _ -> Log.err "invalid type (expected f32)"
 
   let pop_f64 s =
-    let hd, tl = pop s in
-    match hd with
-    | F64 f -> (f, tl)
+    let hd, tl = pop s in
+    match hd with
+    | F64 f -> (f, tl)
     | _ -> Log.err "invalid type (expected f64)"
 
   let pop2_f64 s =
@@ -667,31 +673,34 @@ 
82.76%

     | _ -> Log.err "invalid type (expected f64)"
 
   let pop_ref s =
-    let hd, tl = pop s in
-    match hd with
-    | Ref _ -> (hd, tl)
+    let hd, tl = pop s in
+    match hd with
+    | Ref _ -> (hd, tl)
     | _ -> Log.err "invalid type (expected ref)"
 
   let pop_as_ref s =
-    let hd, tl = pop s in
-    match hd with
-    | Ref hd -> (hd, tl)
+    let hd, tl = pop s in
+    match hd with
+    | Ref hd -> (hd, tl)
     | _ -> Log.err "invalid type (expected ref)"
 
   let pop_bool s =
-    let hd, tl = pop s in
-    match hd with
-    | I32 n -> (V.I32.to_bool n, tl)
+    let hd, tl = pop s in
+    match hd with
+    | I32 n -> (V.I32.to_bool n, tl)
     | _ -> Log.err "invalid type (expected i32 (bool))"
 
   let pop_n s n =
-    (List.filteri (fun i _hd -> i < n) s, List.filteri (fun i _hd -> i >= n) s)
+    (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 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 [] -> invalid_arg "drop_n" | _ :: tl -> drop_n tl (n - 1)
+    if n = 0 then s
+    else
+      match s with
+      | [] -> Fmt.invalid_arg "drop_n"
+      | _ :: tl -> drop_n tl (n - 1)
 end
diff --git a/coverage/src/data_structures/wq.ml.html b/coverage/src/data_structures/wq.ml.html new file mode 100644 index 000000000..c670dc5de --- /dev/null +++ b/coverage/src/data_structures/wq.ml.html @@ -0,0 +1,246 @@ + + + + + wq.ml — Coverage report + + + + + + + + +
+
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+
+
+
+ 
+ 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
+
+
(* SPDX-License-Identifier: AGPL-3.0-or-later *)
+(* Copyright © 2021-2024 OCamlPro *)
+(* Written by the Owi programmers *)
+
+type 'a t =
+  { mutex : Mutex.t
+  ; cond : Condition.t
+  ; queue : 'a Queue.t
+  ; mutable pledges : int
+  ; mutable failed : bool
+  }
+
+let pop q pledge =
+  Mutex.lock q.mutex;
+  let r =
+    try
+      while Queue.is_empty q.queue do
+        if q.pledges = 0 || q.failed then raise Exit;
+        Condition.wait q.cond q.mutex
+      done;
+      let v = Queue.pop q.queue in
+      if pledge then q.pledges <- q.pledges + 1;
+      Some v
+    with Exit ->
+      Condition.broadcast q.cond;
+      None
+  in
+  Mutex.unlock q.mutex;
+  r
+
+let make_pledge q =
+  Mutex.lock q.mutex;
+  q.pledges <- q.pledges + 1;
+  Mutex.unlock q.mutex
+
+let end_pledge q =
+  Mutex.lock q.mutex;
+  q.pledges <- q.pledges - 1;
+  Condition.broadcast q.cond;
+  Mutex.unlock q.mutex
+
+let rec read_as_seq (q : 'a t) ~finalizer : 'a Seq.t =
+ fun () ->
+  match pop q false with
+  | None ->
+    finalizer ();
+    Nil
+  | Some v -> Cons (v, read_as_seq q ~finalizer)
+
+let push v q =
+  Mutex.lock q.mutex;
+  let was_empty = Queue.is_empty q.queue in
+  Queue.push v q.queue;
+  if was_empty then Condition.broadcast q.cond;
+  Mutex.unlock q.mutex
+
+let fail q =
+  Mutex.lock q.mutex;
+  q.failed <- true;
+  Condition.broadcast q.cond;
+  Mutex.unlock q.mutex
+
+let init () =
+  { mutex = Mutex.create ()
+  ; cond = Condition.create ()
+  ; queue = Queue.create ()
+  ; pledges = 0
+  ; failed = false
+  }
+
+
+
+ + + diff --git a/coverage/src/interpret/interpret.ml.html b/coverage/src/interpret/interpret.ml.html index 2a950dd9e..fea85faeb 100644 --- a/coverage/src/interpret/interpret.ml.html +++ b/coverage/src/interpret/interpret.ml.html @@ -3,7 +3,7 @@ interpret.ml — Coverage report - + @@ -15,83 +15,80 @@

src/interpret/interpret.ml

-

91.59%

+

91.89%

@@ -3283,6 +3290,16 @@

91.59%

1588 1589 1590 +1591 +1592 +1593 +1594 +1595 +1596 +1597 +1598 +1599 +1600 
(* SPDX-License-Identifier: AGPL-3.0-or-later *)
 (* Copyright © 2021-2024 OCamlPro *)
@@ -3306,7 +3323,7 @@ 
91.59%

   open P
   open Value
   open Choice
-  module Stack = Stack.Make (Value) [@@inlined hint]
+  module Stack = Stack.Make [@inlined hint] (Value)
 
   module I32 = struct
     include I32
@@ -3333,9 +3350,9 @@ 
91.59%

 
     let ( = ) = eq
 
-    let eqz v = v = zero
+    let eqz v = v = zero
 
-    let min_int = const_i32 Int32.min_int
+    let min_int = const_i32 Int32.min_int
   end
 
   module I64 = struct
@@ -3365,33 +3382,31 @@ 
91.59%

 
     let eqz v = v = zero
 
-    let min_int = const_i64 Int64.min_int
+    let min_int = const_i64 Int64.min_int
   end
 
-  let page_size = const_i64 65_536L
+  let page_size = const_i64 65_536L
 
   let pop_choice stack =
-    let b, stack = Stack.pop_bool stack in
-    let* b = select b in
-    return (b, stack)
-
-  let p_type_eq (_id1, t1) (_id2, t2) = t1 = t2
+    let b, stack = Stack.pop_bool stack in
+    let* b = select b in
+    return (b, stack)
 
   let ( let> ) v f =
-    let* v = select v in
-    f v
+    let* v = select v in
+    f v
 
   let const = const_i32
 
-  let consti i = const_i32 (Int32.of_int i)
+  let consti i = const_i32 (Int32.of_int i)
 
   let exec_iunop stack nn op =
-    match nn with
-    | S32 ->
+    match nn with
+    | S32 ->
       let n, stack = Stack.pop_i32 stack in
-      let res =
+      let res =
         let open I32 in
-        match op with Clz -> clz n | Ctz -> ctz n | Popcnt -> popcnt n
+        match op with Clz -> clz n | Ctz -> ctz n | Popcnt -> popcnt n
       in
       Stack.push_i32 stack res
     | S64 ->
@@ -3434,50 +3449,50 @@ 
91.59%

       Stack.push_f64 stack res
 
   let exec_ibinop (stack : Stack.t) nn (op : ibinop) : Stack.t Choice.t =
-    match nn with
-    | S32 ->
+    match nn with
+    | S32 ->
       let (n1, n2), stack = Stack.pop2_i32 stack in
-      let+ res =
+      let+ res =
         let open I32 in
         match op with
-        | Add -> Choice.return @@ add n1 n2
-        | Sub -> Choice.return @@ sub n1 n2
-        | Mul -> Choice.return @@ mul n1 n2
-        | Div s -> begin
-          let> cond = eqz n2 in
-          if cond then Choice.trap Integer_divide_by_zero
+        | Add -> Choice.return @@ add n1 n2
+        | Sub -> Choice.return @@ sub n1 n2
+        | Mul -> Choice.return @@ mul n1 n2
+        | Div s -> begin
+          let> cond = eqz n2 in
+          if cond then Choice.trap Integer_divide_by_zero
           else
-            match s with
+            match s with
             | S ->
               let> overflow = Bool.and_ (eq n1 min_int) @@ eq n2 ~-(const 1l) in
               if overflow then Choice.trap Integer_overflow
               else Choice.return @@ div n1 n2
-            | U -> Choice.return @@ unsigned_div n1 n2
+            | U -> Choice.return @@ unsigned_div n1 n2
         end
-        | Rem s -> begin
-          let> cond = eqz n2 in
-          if cond then Choice.trap Integer_divide_by_zero
+        | Rem s -> begin
+          let> cond = eqz n2 in
+          if cond then Choice.trap Integer_divide_by_zero
           else
-            match s with
-            | S -> Choice.return @@ rem n1 n2
+            match s with
+            | S -> Choice.return @@ rem n1 n2
             | U -> Choice.return @@ unsigned_rem n1 n2
         end
-        | And -> Choice.return @@ logand n1 n2
-        | Or -> Choice.return @@ logor n1 n2
-        | Xor -> Choice.return @@ logxor n1 n2
-        | Shl -> Choice.return @@ shl n1 n2
-        | Shr S -> Choice.return @@ shr_s n1 n2
-        | Shr U -> Choice.return @@ shr_u n1 n2
+        | And -> Choice.return @@ logand n1 n2
+        | Or -> Choice.return @@ logor n1 n2
+        | Xor -> Choice.return @@ logxor n1 n2
+        | Shl -> Choice.return @@ shl n1 n2
+        | Shr S -> Choice.return @@ shr_s n1 n2
+        | Shr U -> Choice.return @@ shr_u n1 n2
         | Rotl -> Choice.return @@ rotl n1 n2
         | Rotr -> Choice.return @@ rotr n1 n2
       in
-      Stack.push_i32 stack res
-    | S64 ->
+      Stack.push_i32 stack res
+    | S64 ->
       let (n1, n2), stack = Stack.pop2_i64 stack in
-      let+ res =
+      let+ res =
         let open I64 in
         match op with
-        | Add -> Choice.return @@ add n1 n2
+        | Add -> Choice.return @@ add n1 n2
         | Sub -> Choice.return @@ sub n1 n2
         | Mul -> Choice.return @@ mul n1 n2
         | Div s -> begin
@@ -3511,16 +3526,16 @@ 
91.59%

         | Rotl -> Choice.return @@ rotl n1 n2
         | Rotr -> Choice.return @@ rotr n1 n2
       in
-      Stack.push_i64 stack res
+      Stack.push_i64 stack res
 
   let exec_fbinop stack nn (op : fbinop) =
-    match nn with
-    | S32 ->
+    match nn with
+    | S32 ->
       let (f1, f2), stack = Stack.pop2_f32 stack in
-      Stack.push_f32 stack
+      Stack.push_f32 stack
         (let open F32 in
          match op with
-         | Add -> add f1 f2
+         | Add -> add f1 f2
          | Sub -> sub f1 f2
          | Mul -> mul f1 f2
          | Div -> div f1 f2
@@ -3541,10 +3556,10 @@ 
91.59%

          | Copysign -> copy_sign f1 f2 )
 
   let exec_itestop stack nn op =
-    match nn with
-    | S32 ->
+    match nn with
+    | S32 ->
       let n, stack = Stack.pop_i32 stack in
-      let res = match op with Eqz -> I32.eq_const n 0l in
+      let res = match op with Eqz -> I32.eq_const n 0l in
       Stack.push_bool stack res
     | S64 ->
       let n, stack = Stack.pop_i64 stack in
@@ -3552,22 +3567,22 @@ 
91.59%

       Stack.push_bool stack res
 
   let exec_irelop stack nn (op : irelop) =
-    match nn with
-    | S32 ->
+    match nn with
+    | S32 ->
       let (n1, n2), stack = Stack.pop2_i32 stack in
-      let res =
+      let res =
         let open I32 in
         match op with
-        | Eq -> eq n1 n2
-        | Ne -> ne n1 n2
-        | Lt S -> lt n1 n2
-        | Lt U -> lt_u n1 n2
-        | Gt S -> gt n1 n2
-        | Gt U -> gt_u n1 n2
-        | Le S -> le n1 n2
-        | Le U -> le_u n1 n2
-        | Ge S -> ge n1 n2
-        | Ge U -> ge_u n1 n2
+        | Eq -> eq n1 n2
+        | Ne -> ne n1 n2
+        | Lt S -> lt n1 n2
+        | Lt U -> lt_u n1 n2
+        | Gt S -> gt n1 n2
+        | Gt U -> gt_u n1 n2
+        | Le S -> le n1 n2
+        | Le U -> le_u n1 n2
+        | Ge S -> ge n1 n2
+        | Ge U -> ge_u n1 n2
       in
       Stack.push_bool stack res
     | S64 ->
@@ -3589,18 +3604,18 @@ 
91.59%

       Stack.push_bool stack res
 
   let exec_frelop stack nn (op : frelop) =
-    match nn with
-    | S32 ->
+    match nn with
+    | S32 ->
       let (n1, n2), stack = Stack.pop2_f32 stack in
-      let res =
+      let res =
         let open F32 in
         match op with
         | Eq -> eq n1 n2
         | Ne -> ne n1 n2
         | Lt -> lt n1 n2
         | Gt -> gt n1 n2
-        | Le -> le n1 n2
-        | Ge -> ge n1 n2
+        | Le -> le n1 n2
+        | Ge -> ge n1 n2
       in
       Stack.push_bool stack res
     | S64 ->
@@ -3686,53 +3701,54 @@ 
91.59%

     end
 
   let exec_fconverti stack nn nn' sx =
-    match nn with
-    | S32 -> (
+    let is_signed = match sx with S -> true | U -> false in
+    match nn with
+    | S32 -> (
       let open F32 in
       match nn' with
-      | S32 ->
+      | S32 ->
         let n, stack = Stack.pop_i32 stack in
-        let n = if sx = S then convert_i32_s n else convert_i32_u n in
+        let n = if is_signed then convert_i32_s n else convert_i32_u n in
         Stack.push_f32 stack n
       | S64 ->
         let n, stack = Stack.pop_i64 stack in
-        let n = if sx = S then convert_i64_s n else convert_i64_u n in
+        let n = if is_signed then convert_i64_s n else convert_i64_u n in
         Stack.push_f32 stack n )
     | S64 -> (
       let open F64 in
       match nn' with
       | S32 ->
         let n, stack = Stack.pop_i32 stack in
-        let n = if sx = S then convert_i32_s n else convert_i32_u n in
+        let n = if is_signed then convert_i32_s n else convert_i32_u n in
         Stack.push_f64 stack n
       | S64 ->
         let n, stack = Stack.pop_i64 stack in
-        let n = if sx = S then convert_i64_s n else convert_i64_u n in
+        let n = if is_signed then convert_i64_s n else convert_i64_u n in
         Stack.push_f64 stack n )
 
   let exec_ireinterpretf stack nn nn' =
-    match nn with
-    | S32 -> begin
+    match nn with
+    | S32 -> begin
       match nn' with
-      | S32 ->
+      | S32 ->
         let n, stack = Stack.pop_f32 stack in
-        let n = I32.reinterpret_f32 n in
-        Stack.push_i32 stack n
+        let n = I32.reinterpret_f32 n in
+        Stack.push_i32 stack n
       | S64 ->
         let n, stack = Stack.pop_f64 stack in
         let n = I32.reinterpret_f32 (F32.demote_f64 n) in
         Stack.push_i32 stack n
     end
-    | S64 -> begin
+    | S64 -> begin
       match nn' with
       | S32 ->
         let n, stack = Stack.pop_f32 stack in
         let n = I64.reinterpret_f64 (F64.promote_f32 n) in
         Stack.push_i64 stack n
-      | S64 ->
+      | S64 ->
         let n, stack = Stack.pop_f64 stack in
-        let n = I64.reinterpret_f64 n in
-        Stack.push_i64 stack n
+        let n = I64.reinterpret_f64 n in
+        Stack.push_i64 stack n
     end
 
   let exec_freinterpreti stack nn nn' =
@@ -3761,10 +3777,10 @@ 
91.59%

     end
 
   let init_local (_id, t) : Value.t =
-    match t with
-    | Num_type I32 -> I32 I32.zero
+    match t with
+    | Num_type I32 -> I32 I32.zero
     | Num_type I64 -> I64 I64.zero
-    | Num_type F32 -> F32 F32.zero
+    | Num_type F32 -> F32 F32.zero
     | Num_type F64 -> F64 F64.zero
     | Ref_type (_null, rt) -> ref_null rt
 
@@ -3773,12 +3789,12 @@ 
91.59%

 
   type extern_func = Extern_func.extern_func
 
-  let exec_extern_func stack (f : extern_func) =
-    let pop_arg (type ty) stack (arg : ty Extern_func.telt) :
+  let exec_extern_func env stack (f : extern_func) =
+    let pop_arg (type ty) stack (arg : ty Extern_func.telt) :
       (ty * Stack.t) Choice.t =
-      match arg with
-      | I32 -> Choice.return @@ Stack.pop_i32 stack
-      | I64 -> Choice.return @@ Stack.pop_i64 stack
+      match arg with
+      | I32 -> Choice.return @@ Stack.pop_i32 stack
+      | I64 -> Choice.return @@ Stack.pop_i64 stack
       | F32 -> Choice.return @@ Stack.pop_f32 stack
       | F64 -> Choice.return @@ Stack.pop_f64 stack
       | Externref ety -> (
@@ -3791,45 +3807,49 @@ 
91.59%

     let rec split_args :
       type f r. Stack.t -> (f, r) Extern_func.atype -> Stack.t * Stack.t =
      fun stack ty ->
-      let[@local] split_one_arg args =
-        let elt, stack = Stack.pop stack in
-        let elts, stack = split_args stack args in
-        (elt :: elts, stack)
+      let[@local] split_one_arg args =
+        let elt, stack = Stack.pop stack in
+        let elts, stack = split_args stack args in
+        (elt :: elts, stack)
       in
       match ty with
-      | Extern_func.Arg (_, args) -> split_one_arg args
-      | UArg args -> split_args stack args
+      | Mem args -> split_args stack args
+      | Arg (_, args) -> split_one_arg args
+      | UArg args -> split_args stack args
       | NArg (_, _, args) -> split_one_arg args
-      | Res -> ([], stack)
+      | Res -> ([], stack)
     in
     let rec apply :
       type f r. Stack.t -> (f, r) Extern_func.atype -> f -> r Choice.t =
      fun stack ty f ->
-      match ty with
-      | Extern_func.Arg (arg, args) ->
-        let* v, stack = pop_arg stack arg in
-        apply stack args (f v)
-      | UArg args -> apply stack args (f ())
+      match ty with
+      | Mem args ->
+        let* mem = Env.get_memory env mem_0 in
+        apply stack args (f mem)
+      | Arg (arg, args) ->
+        let* v, stack = pop_arg stack arg in
+        apply stack args (f v)
+      | UArg args -> apply stack args (f ())
       | NArg (_, arg, args) ->
         let* v, stack = pop_arg stack arg in
         apply stack args (f v)
-      | Res -> Choice.return f
+      | Res -> Choice.return f
     in
     let (Extern_func.Extern_func (Func (atype, rtype), func)) = f in
     let args, stack = split_args stack atype in
-    let* r = apply (List.rev args) atype func in
-    let push_val (type ty) (arg : ty Extern_func.telt) (v : ty) stack =
-      match arg with
-      | I32 -> Stack.push_i32 stack v
+    let* r = apply (List.rev args) atype func in
+    let push_val (type ty) (arg : ty Extern_func.telt) (v : ty) stack =
+      match arg with
+      | I32 -> Stack.push_i32 stack v
       | I64 -> Stack.push_i64 stack v
       | F32 -> Stack.push_f32 stack v
       | F64 -> Stack.push_f64 stack v
       | Externref ty -> Stack.push_as_externref stack ty v
     in
     let+ r in
-    match (rtype, r) with
-    | R0, () -> stack
-    | R1 t1, v1 -> push_val t1 v1 stack
+    match (rtype, r) with
+    | R0, () -> stack
+    | R1 t1, v1 -> push_val t1 v1 stack
     | R2 (t1, t2), (v1, v2) -> push_val t1 v1 stack |> push_val t2 v2
     | R3 (t1, t2, t3), (v1, v2, v3) ->
       push_val t1 v1 stack |> push_val t2 v2 |> push_val t3 v3
@@ -3854,12 +3874,12 @@ 
91.59%

 
       let of_list = Array.of_list
 
-      let get t i = Array.unsafe_get t i
+      let get t i = Array.unsafe_get t i
 
       let set t i v =
-        let locals = Array.copy t in
-        Array.unsafe_set locals i v;
-        locals
+        let locals = Array.copy t in
+        Array.unsafe_set locals i v;
+        locals
     end
 
     type pc = binary instr list
@@ -3895,9 +3915,9 @@ 
91.59%

       }
 
     let empty_exec_state ~locals ~env ~envs =
-      { return_state = None
+      { return_state = None
       ; stack = []
-      ; locals = Locals.of_list locals
+      ; locals = Locals.of_list locals
       ; pc = []
       ; block_stack = []
       ; func_rt = []
@@ -3906,7 +3926,7 @@ 
91.59%

           { name = None
           ; enter = 0
           ; instructions = 0
-          ; calls = Hashtbl.create 512
+          ; calls = Hashtbl.create 512
           }
       ; envs
       }
@@ -3914,41 +3934,45 @@ 
91.59%

     let rec print_count ppf count =
       let calls ppf tbl =
         let l =
-          List.sort (fun (id1, _) (id2, _) -> compare id1 id2)
+          (* TODO: move this to Types.ml *)
+          List.sort
+            (fun
+              ((Raw id1 : binary indice), _) ((Raw id2 : binary indice), _) ->
+              compare id1 id2 )
           @@ List.of_seq @@ Hashtbl.to_seq tbl
         in
         match l with
         | [] -> ()
         | _ :: _ ->
-          Format.pp ppf "@ @[<v 2>calls@ %a@]"
-            (Format.pp_list
-               ~pp_sep:(fun ppf () -> Format.pp ppf "@ ")
+          Fmt.pf ppf "@ @[<v 2>calls@ %a@]"
+            (Fmt.list
+               ~sep:(fun ppf () -> Fmt.pf ppf "@ ")
                (fun ppf ((Raw id : binary indice), count) ->
                  let name ppf = function
                    | None -> ()
-                   | Some name -> Format.pp ppf " %s" name
+                   | Some name -> Fmt.pf ppf " %s" name
                  in
-                 Format.pp ppf "@[<v 2>id %i%a@ %a@]" id name count.name
+                 Fmt.pf ppf "@[<v 2>id %i%a@ %a@]" id name count.name
                    print_count count ) )
             l
       in
-      Format.pp ppf "@[<v>enter %i@ intrs %i%a@]" count.enter count.instructions
+      Fmt.pf ppf "@[<v>enter %i@ intrs %i%a@]" count.enter count.instructions
         calls count.calls
 
     let empty_count name =
-      { name; enter = 0; instructions = 0; calls = Hashtbl.create 0 }
+      { name; enter = 0; instructions = 0; calls = Hashtbl.create 0 }
 
     let count_instruction state =
-      state.count.instructions <- state.count.instructions + 1
+      state.count.instructions <- state.count.instructions + 1
 
     let enter_function_count count func_name func =
-      let c =
+      let c =
         match Hashtbl.find_opt count.calls func with
-        | None ->
+        | None ->
           let c = empty_count func_name in
-          Hashtbl.add count.calls func c;
-          c
-        | Some c -> c
+          Hashtbl.add count.calls func c;
+          c
+        | Some c -> c
       in
       c.enter <- c.enter + 1;
       c
@@ -3958,50 +3982,50 @@ 
91.59%

       | Continue of exec_state
 
     let return (state : exec_state) =
-      let args = Stack.keep state.stack (List.length state.func_rt) in
-      match state.return_state with
-      | None -> Return args
-      | Some state ->
+      let args = Stack.keep state.stack (List.length state.func_rt) in
+      match state.return_state with
+      | None -> Return args
+      | Some state ->
         let stack = args @ state.stack in
         Continue { state with stack }
 
     let branch (state : exec_state) n =
-      let block_stack = Stack.drop_n state.block_stack n in
-      match block_stack with
-      | [] -> Choice.return (return state)
-      | block :: block_stack_tl ->
+      let block_stack = Stack.drop_n state.block_stack n in
+      match block_stack with
+      | [] -> Choice.return (return state)
+      | block :: block_stack_tl ->
         let block_stack =
-          if block.is_loop then block_stack else block_stack_tl
+          if block.is_loop then block_stack else block_stack_tl
         in
-        let args = Stack.keep state.stack (List.length block.branch_rt) in
-        let stack = args @ block.stack in
+        let args = Stack.keep state.stack (List.length block.branch_rt) in
+        let stack = args @ block.stack in
         Choice.return
           (Continue { state with block_stack; pc = block.branch; stack })
 
     let end_block (state : exec_state) =
-      match state.block_stack with
-      | [] -> Choice.return (return state)
-      | block :: block_stack ->
-        let args = Stack.keep state.stack (List.length block.continue_rt) in
-        let stack = args @ block.stack in
+      match state.block_stack with
+      | [] -> Choice.return (return state)
+      | block :: block_stack ->
+        let args = Stack.keep state.stack (List.length block.continue_rt) in
+        let stack = args @ block.stack in
         Choice.return
           (Continue { state with block_stack; pc = block.continue; stack })
   end
 
   let exec_block (state : State.exec_state) ~is_loop
     (bt : binary block_type option) expr =
-    let pt, rt =
+    let pt, rt =
       match bt with
-      | None -> ([], [])
-      | Some (Bt_raw ((None | Some _), (pt, rt))) -> (List.map snd pt, rt)
+      | None -> ([], [])
+      | Some (Bt_raw ((None | Some _), (pt, rt))) -> (List.map snd pt, rt)
     in
     let block : State.block =
-      let branch_rt, branch = if is_loop then (pt, expr) else (rt, state.pc) in
+      let branch_rt, branch = if is_loop then (pt, expr) else (rt, state.pc) in
       { branch
       ; branch_rt
       ; continue = state.pc
       ; continue_rt = rt
-      ; stack = Stack.drop_n state.stack (List.length pt)
+      ; stack = Stack.drop_n state.stack (List.length pt)
       ; is_loop
       }
     in
@@ -4011,17 +4035,17 @@ 
91.59%

 
   let exec_func ~return ~id (state : State.exec_state) env
     (func : binary Types.func) =
-    Log.debug1 "calling func : func %s@."
-      (Option.value func.id ~default:"anonymous");
-    let (Bt_raw ((None | Some _), (param_type, result_type))) = func.type_f in
-    let args, stack = Stack.pop_n state.stack (List.length param_type) in
-    let return_state =
-      if return then state.return_state else Some { state with stack }
+    Log.debug1 "calling func : func %s@."
+      (Option.value func.id ~default:"anonymous");
+    let (Bt_raw ((None | Some _), (param_type, result_type))) = func.type_f in
+    let args, stack = Stack.pop_n state.stack (List.length param_type) in
+    let return_state =
+      if return then state.return_state else Some { state with stack }
     in
     let locals =
-      State.Locals.of_list @@ List.rev args @ List.map init_local func.locals
+      State.Locals.of_list @@ List.rev args @ List.map init_local func.locals
     in
-    State.
+    State.
       { stack = []
       ; locals
       ; pc = func.body
@@ -4030,34 +4054,33 @@ 
91.59%

       ; return_state
       ; env
       ; envs = state.envs
-      ; count = enter_function_count state.count func.id id
+      ; count = enter_function_count state.count func.id id
       }
 
   let exec_vfunc ~return (state : State.exec_state) (func : Func_intf.t) =
-    match func with
-    | WASM (id, func, env_id) ->
+    match func with
+    | WASM (id, func, env_id) ->
       let env = Env_id.get env_id state.envs in
-      let id = Raw id in
-      Choice.return (State.Continue (exec_func ~return ~id state env func))
-    | Extern f ->
+      let id = Raw id in
+      Choice.return (State.Continue (exec_func ~return ~id state env func))
+    | Extern f ->
       let f = Env.get_extern_func state.env f in
-      let+ stack = exec_extern_func state.stack f in
-      let state = { state with stack } in
-      if return then State.return state else State.Continue state
+      let+ stack = exec_extern_func state.env state.stack f in
+      let state = { state with stack } in
+      if return then State.return state else State.Continue state
 
   let func_type (state : State.exec_state) (f : Func_intf.t) =
-    match f with
-    | WASM (_, func, _) ->
+    match f with
+    | WASM (_, func, _) ->
       let (Bt_raw ((None | Some _), t)) = func.type_f in
       t
     | Extern f ->
       let f = Env.get_extern_func state.env f in
       Extern_func.extern_type f
 
-  let call_ref ~return (state : State.exec_state) typ_i =
-    ignore (return, state, typ_i);
+  let call_ref ~return:_ (_state : State.exec_state) _typ_i =
     (* TODO *)
-    assert false
+    assert false
   (* let fun_ref, stack = Stack.pop_as_ref state.stack in *)
   (* let state = { state with stack } in *)
   (* let func = *)
@@ -4075,57 +4098,60 @@ 
91.59%

 
   let call_indirect ~return (state : State.exec_state)
     (tbl_i, (Bt_raw ((None | Some _), typ_i) : binary block_type)) =
-    let fun_i, stack = Stack.pop_i32 state.stack in
-    let state = { state with stack } in
-    let* t = Env.get_table state.env tbl_i in
-    let _null, ref_kind = Table.typ t in
-    if ref_kind <> Func_ht then Choice.trap Indirect_call_type_mismatch
-    else
-      let size = Table.size t in
-      let> out_of_bounds =
-        Bool.or_ I32.(fun_i < const 0l) @@ I32.(consti size <= fun_i)
+    let fun_i, stack = Stack.pop_i32 state.stack in
+    let state = { state with stack } in
+    let* t = Env.get_table state.env tbl_i in
+    let _null, ref_kind = Table.typ t in
+    match ref_kind with
+    | Func_ht ->
+      let size = Table.size t in
+      let> out_of_bounds =
+        Bool.or_ I32.(fun_i < const 0l) @@ I32.(consti size <= fun_i)
       in
-      if out_of_bounds then Choice.trap Undefined_element
+      if out_of_bounds then Choice.trap Undefined_element
       else
-        let* fun_i = Choice.select_i32 fun_i in
-        let fun_i = Int32.to_int fun_i in
-        let f_ref = Table.get t fun_i in
-        match Ref.get_func f_ref with
-        | Null -> Choice.trap (Uninitialized_element fun_i)
-        | Type_mismatch -> Choice.trap Element_type_error
-        | Ref_value func ->
-          let pt, rt = func_type state func in
-          let pt', rt' = typ_i in
-          if not (rt = rt' && List.equal p_type_eq pt pt') then
-            Choice.trap Indirect_call_type_mismatch
-          else exec_vfunc ~return state func
+        let* fun_i = Choice.select_i32 fun_i in
+        let fun_i = Int32.to_int fun_i in
+        let f_ref = Table.get t fun_i in
+        begin
+          match Ref.get_func f_ref with
+          | Null -> Choice.trap (Uninitialized_element fun_i)
+          | Type_mismatch -> Choice.trap Element_type_error
+          | Ref_value func ->
+            let ft = func_type state func in
+            let ft' = typ_i in
+            if not (Types.func_type_eq ft ft') then
+              Choice.trap Indirect_call_type_mismatch
+            else exec_vfunc ~return state func
+        end
+    | _ -> Choice.trap Indirect_call_type_mismatch
 
   let exec_instr instr (state : State.exec_state) : State.instr_result Choice.t
       =
-    State.count_instruction state;
-    let stack = state.stack in
+    State.count_instruction state;
+    let stack = state.stack in
     let env = state.env in
     let locals = state.locals in
-    let st stack = Choice.return (State.Continue { state with stack }) in
+    let st stack = Choice.return (State.Continue { state with stack }) in
     Log.debug2 "stack        : [ %a ]@." Stack.pp stack;
-    Log.debug2 "running instr: %a@." Types.pp_instr instr;
-    match instr with
-    | Return -> Choice.return (State.return state)
-    | Nop -> Choice.return (State.Continue state)
-    | Unreachable -> Choice.trap Unreachable
-    | I32_const n -> st @@ Stack.push_const_i32 stack n
-    | I64_const n -> st @@ Stack.push_const_i64 stack n
-    | F32_const f -> st @@ Stack.push_const_f32 stack f
-    | F64_const f -> st @@ Stack.push_const_f64 stack f
-    | I_unop (nn, op) -> st @@ exec_iunop stack nn op
+    Log.debug2 "running instr: %a@." Types.pp_instr instr;
+    match instr with
+    | Return -> Choice.return (State.return state)
+    | Nop -> Choice.return (State.Continue state)
+    | Unreachable -> Choice.trap Unreachable
+    | I32_const n -> st @@ Stack.push_const_i32 stack n
+    | I64_const n -> st @@ Stack.push_const_i64 stack n
+    | F32_const f -> st @@ Stack.push_const_f32 stack f
+    | F64_const f -> st @@ Stack.push_const_f64 stack f
+    | I_unop (nn, op) -> st @@ exec_iunop stack nn op
     | F_unop (nn, op) -> st @@ exec_funop stack nn op
-    | I_binop (nn, op) ->
-      let* stack = exec_ibinop stack nn op in
-      st stack
-    | F_binop (nn, op) -> st @@ exec_fbinop stack nn op
-    | I_testop (nn, op) -> st @@ exec_itestop stack nn op
-    | I_relop (nn, op) -> st @@ exec_irelop stack nn op
-    | F_relop (nn, op) -> st @@ exec_frelop stack nn op
+    | I_binop (nn, op) ->
+      let* stack = exec_ibinop stack nn op in
+      st stack
+    | F_binop (nn, op) -> st @@ exec_fbinop stack nn op
+    | I_testop (nn, op) -> st @@ exec_itestop stack nn op
+    | I_relop (nn, op) -> st @@ exec_irelop stack nn op
+    | F_relop (nn, op) -> st @@ exec_frelop stack nn op
     | I_extend8_s nn -> begin
       match nn with
       | S32 ->
@@ -4172,8 +4198,8 @@ 
91.59%

       let n, stack = Stack.pop_f32 stack in
       let n = F64.promote_f32 n in
       st @@ Stack.push_f64 stack n
-    | F_convert_i (nn, nn', s) -> st @@ exec_fconverti stack nn nn' s
-    | I_reinterpret_f (nn, nn') -> st @@ exec_ireinterpretf stack nn nn'
+    | F_convert_i (nn, nn', s) -> st @@ exec_fconverti stack nn nn' s
+    | I_reinterpret_f (nn, nn') -> st @@ exec_ireinterpretf stack nn nn'
     | F_reinterpret_i (nn, nn') -> st @@ exec_freinterpreti stack nn nn'
     | Ref_null t -> st @@ Stack.push stack (ref_null t)
     | Ref_is_null ->
@@ -4183,62 +4209,62 @@ 
91.59%

     | Ref_func (Raw i) ->
       let f = Env.get_func env i in
       st @@ Stack.push stack (ref_func f)
-    | Drop -> st @@ Stack.drop stack
-    | Local_get (Raw i) -> st @@ Stack.push stack (State.Locals.get locals i)
-    | Local_set (Raw i) ->
+    | Drop -> st @@ Stack.drop stack
+    | Local_get (Raw i) -> st @@ Stack.push stack (State.Locals.get locals i)
+    | Local_set (Raw i) ->
       let v, stack = Stack.pop stack in
-      let locals = State.Locals.set locals i v in
-      Choice.return (State.Continue { state with locals; stack })
-    | If_else (_id, bt, e1, e2) ->
-      let* b, stack = pop_choice stack in
-      let state = { state with stack } in
-      exec_block state ~is_loop:false bt (if b then e1 else e2)
-    | Call (Raw i) -> begin
+      let locals = State.Locals.set locals i v in
+      Choice.return (State.Continue { state with locals; stack })
+    | If_else (_id, bt, e1, e2) ->
+      let* b, stack = pop_choice stack in
+      let state = { state with stack } in
+      exec_block state ~is_loop:false bt (if b then e1 else e2)
+    | Call (Raw i) -> begin
       let func = Env.get_func env i in
-      exec_vfunc ~return:false state func
+      exec_vfunc ~return:false state func
     end
-    | Return_call (Raw i) -> begin
+    | Return_call (Raw i) -> begin
       let func = Env.get_func env i in
-      exec_vfunc ~return:true state func
+      exec_vfunc ~return:true state func
     end
-    | Br (Raw i) -> State.branch state i
-    | Br_if (Raw i) ->
-      let* b, stack = pop_choice stack in
-      let state = { state with stack } in
-      if b then State.branch state i else Choice.return (State.Continue state)
-    | Loop (_id, bt, e) -> exec_block state ~is_loop:true bt e
-    | Block (_id, bt, e) -> exec_block state ~is_loop:false bt e
-    | Memory_size ->
-      let* mem = Env.get_memory env mem_0 in
-      let len = Memory.size_in_pages mem in
-      st @@ Stack.push_i32 stack len
-    | Memory_grow -> begin
-      let* mem = Env.get_memory env mem_0 in
-      let old_size = I64.of_int32 @@ Memory.size mem in
-      let max_size = Memory.get_limit_max mem in
-      let delta, stack =
+    | Br (Raw i) -> State.branch state i
+    | Br_if (Raw i) ->
+      let* b, stack = pop_choice stack in
+      let state = { state with stack } in
+      if b then State.branch state i else Choice.return (State.Continue state)
+    | Loop (_id, bt, e) -> exec_block state ~is_loop:true bt e
+    | Block (_id, bt, e) -> exec_block state ~is_loop:false bt e
+    | Memory_size ->
+      let* mem = Env.get_memory env mem_0 in
+      let len = Memory.size_in_pages mem in
+      st @@ Stack.push_i32 stack len
+    | Memory_grow -> begin
+      let* mem = Env.get_memory env mem_0 in
+      let old_size = I64.of_int32 @@ Memory.size mem in
+      let max_size = Memory.get_limit_max mem in
+      let delta, stack =
         (* TODO: convert to unsigned *)
         Stack.pop_i32 stack
       in
-      let delta = I64.(of_int32 delta * page_size) in
+      let delta = I64.(of_int32 delta * page_size) in
       let new_size = I64.(old_size + delta) in
       let> too_big =
-        Bool.or_ I64.(delta < const_i64 0L)
-        @@ Bool.or_ I64.(ge_u new_size (page_size * page_size))
+        Bool.or_ I64.(delta < const_i64 0L)
+        @@ Bool.or_ I64.(ge_u new_size (page_size * page_size))
         @@
         match max_size with
         | Some max -> I64.(new_size > max * page_size)
-        | None ->
+        | None ->
           (* TODO: replace by false... *)
-          I64.(const_i64 0L <> const_i64 0L)
+          I64.(const_i64 0L <> const_i64 0L)
       in
-      st
+      st
       @@
       if too_big then Stack.push_i32 stack I32.(sub (const 0l) (const 1l))
-      else begin
-        Memory.grow mem I64.(to_int32 delta);
-        let res = I64.(to_int32 @@ (old_size / page_size)) in
-        Stack.push_i32 stack res
+      else begin
+        Memory.grow mem I64.(to_int32 delta);
+        let res = I64.(to_int32 @@ (old_size / page_size)) in
+        Stack.push_i32 stack res
       end
     end
     | Memory_fill ->
@@ -4265,24 +4291,24 @@ 
91.59%

       let> out_of_bounds = Memory.blit mem ~src ~dst ~len in
       if out_of_bounds then Choice.trap Out_of_bounds_memory_access
       else st stack
-    | Memory_init (Raw i) ->
-      let* mem = Env.get_memory env mem_0 in
-      let len, stack = Stack.pop_i32 stack in
-      let src, stack = Stack.pop_i32 stack in
-      let dst, stack = Stack.pop_i32 stack in
-      let* data = Env.get_data env i in
-      let data = Data.value data in
+    | Memory_init (Raw i) ->
+      let* mem = Env.get_memory env mem_0 in
+      let len, stack = Stack.pop_i32 stack in
+      let src, stack = Stack.pop_i32 stack in
+      let dst, stack = Stack.pop_i32 stack in
+      let* data = Env.get_data env i in
+      let data = Data.value data in
       (* TODO: move out of bonds check here ! *)
-      let> out_of_bounds = Memory.blit_string mem data ~src ~dst ~len in
-      if out_of_bounds then Choice.trap Out_of_bounds_memory_access
-      else st stack
-    | Select _t ->
-      if use_ite_for_select then begin
+      let> out_of_bounds = Memory.blit_string mem data ~src ~dst ~len in
+      if out_of_bounds then Choice.trap Out_of_bounds_memory_access
+      else st stack
+    | Select _t ->
+      if use_ite_for_select then begin
         let b, stack = Stack.pop_bool stack in
-        let o2, stack = Stack.pop stack in
-        let o1, stack = Stack.pop stack in
-        let* res = P.select b ~if_true:o1 ~if_false:o2 in
-        st @@ Stack.push stack res
+        let o2, stack = Stack.pop stack in
+        let o1, stack = Stack.pop stack in
+        let* res = P.select b ~if_true:o1 ~if_false:o2 in
+        st @@ Stack.push stack res
       end
       else begin
         let* b, stack = pop_choice stack in
@@ -4290,58 +4316,57 @@ 
91.59%

         let o1, stack = Stack.pop stack in
         st @@ Stack.push stack (if b then o1 else o2)
       end
-    | Local_tee (Raw i) ->
+    | Local_tee (Raw i) ->
       let v, stack = Stack.pop stack in
-      let locals = State.Locals.set locals i v in
-      let stack = Stack.push stack v in
-      Choice.return (State.Continue { state with locals; stack })
-    | Global_get (Raw i) ->
-      let* g = Env.get_global env i in
-      st @@ Stack.push stack (Global.value g)
-    | Global_set (Raw i) ->
-      let* global = Env.get_global env i in
-      if Global.mut global = Const then Log.err "Can't set const global";
-      let v, stack =
+      let locals = State.Locals.set locals i v in
+      let stack = Stack.push stack v in
+      Choice.return (State.Continue { state with locals; stack })
+    | Global_get (Raw i) ->
+      let* g = Env.get_global env i in
+      st @@ Stack.push stack (Global.value g)
+    | Global_set (Raw i) ->
+      let* global = Env.get_global env i in
+      let v, stack =
         match Global.typ global with
-        | Ref_type _rt -> Stack.pop_ref stack
-        | Num_type nt -> (
+        | Ref_type _rt -> Stack.pop_ref stack
+        | Num_type nt -> (
           match nt with
-          | I32 ->
+          | I32 ->
             let v, stack = Stack.pop_i32 stack in
-            (I32 v, stack)
-          | I64 ->
+            (I32 v, stack)
+          | I64 ->
             let v, stack = Stack.pop_i64 stack in
-            (I64 v, stack)
-          | F32 ->
+            (I64 v, stack)
+          | F32 ->
             let v, stack = Stack.pop_f32 stack in
-            (F32 v, stack)
-          | F64 ->
+            (F32 v, stack)
+          | F64 ->
             let v, stack = Stack.pop_f64 stack in
-            (F64 v, stack) )
+            (F64 v, stack) )
       in
       Global.set_value global v;
-      st stack
-    | Table_get (Raw i) ->
-      let* t = Env.get_table env i in
-      let i, stack = Stack.pop_i32 stack in
-      let* i = Choice.select_i32 i in
-      let i = Int32.to_int i in
-      let size = Table.size t in
-      if i < 0 || i >= size then Choice.trap Out_of_bounds_table_access
+      st stack
+    | Table_get (Raw i) ->
+      let* t = Env.get_table env i in
+      let i, stack = Stack.pop_i32 stack in
+      let* i = Choice.select_i32 i in
+      let i = Int32.to_int i in
+      let size = Table.size t in
+      if i < 0 || i >= size then Choice.trap Out_of_bounds_table_access
       else
-        let v = Table.get t i in
-        st @@ Stack.push stack (Ref v)
-    | Table_set (Raw indice) ->
-      let* t = Env.get_table env indice in
-      let v, stack = Stack.pop_as_ref stack in
-      let indice, stack = Stack.pop_i32 stack in
-      let* indice = Choice.select_i32 indice in
-      let indice = Int32.to_int indice in
-      if indice < 0 || indice >= Table.size t then
+        let v = Table.get t i in
+        st @@ Stack.push stack (Ref v)
+    | Table_set (Raw indice) ->
+      let* t = Env.get_table env indice in
+      let v, stack = Stack.pop_as_ref stack in
+      let indice, stack = Stack.pop_i32 stack in
+      let* indice = Choice.select_i32 indice in
+      let indice = Int32.to_int indice in
+      if indice < 0 || indice >= Table.size t then
         Choice.trap Out_of_bounds_table_access
-      else begin
+      else begin
         Table.set t indice v;
-        st stack
+        st stack
       end
     | Table_size (Raw indice) ->
       let* t = Env.get_table env indice in
@@ -4353,14 +4378,14 @@ 
91.59%

       let delta, stack = Stack.pop_i32 stack in
       let new_size = I32.(size + delta) in
       let allowed =
-        ( match Table.max_size t with
-        | None -> true
-        | Some max -> consti max >= new_size )
-        && new_size >= const 0l
-        && new_size >= size
+        Bool.and_
+          ( match Table.max_size t with
+          | None -> Bool.const true
+          | Some max -> I32.ge (consti max) new_size )
+        @@ Bool.and_ (I32.ge new_size (const 0l)) (I32.ge new_size size)
       in
-
-      if not allowed then
+      let> allowed in
+      if not allowed then
         let stack = Stack.drop stack in
         st @@ Stack.push_i32_of_int stack (-1)
       else
@@ -4373,12 +4398,13 @@ 
91.59%

       let len, stack = Stack.pop_i32 stack in
       let x, stack = Stack.pop_as_ref stack in
       let pos, stack = Stack.pop_i32 stack in
-      let out_of_bounds =
-        len < const 0l
-        || pos < const 0l
-        || I32.(pos + len) > consti (Table.size t)
+      let> out_of_bounds =
+        Bool.or_ (I32.lt len (const 0l))
+        @@ Bool.or_
+             (I32.lt pos (const 0l))
+             (I32.gt I32.(pos + len) (consti (Table.size t)))
       in
-      if out_of_bounds then Choice.trap Out_of_bounds_table_access
+      if out_of_bounds then Choice.trap Out_of_bounds_table_access
       else begin
         let* pos = Choice.select_i32 pos in
         let* len = Choice.select_i32 len in
@@ -4391,41 +4417,41 @@ 
91.59%

       let len, stack = Stack.pop_i32 stack in
       let src, stack = Stack.pop_i32 stack in
       let dst, stack = Stack.pop_i32 stack in
-      let out_of_bounds =
+      let> out_of_bounds =
         let t_src_len = Table.size t_src in
         let t_dst_len = Table.size t_dst in
-        I32.(src + len) > consti t_src_len
-        || I32.(dst + len) > consti t_dst_len
-        || len < const 0l
-        || src < const 0l
-        || dst < const 0l
+        Bool.or_ (I32.gt I32.(src + len) (consti t_src_len))
+        @@ Bool.or_ (I32.gt I32.(dst + len) (consti t_dst_len))
+        @@ Bool.or_ (I32.lt len (const 0l))
+        @@ Bool.or_ (I32.lt src (const 0l)) (I32.lt dst (const 0l))
       in
-      if out_of_bounds then Choice.trap Out_of_bounds_table_access
+      if out_of_bounds then Choice.trap Out_of_bounds_table_access
       else begin
         let* () =
-          if len <> const 0l then begin
+          let> len_is_not_zero = I32.ne len (const 0l) in
+          if len_is_not_zero then begin
             let* src = Choice.select_i32 src in
             let* dst = Choice.select_i32 dst in
             let+ len = Choice.select_i32 len in
             Table.copy ~t_src ~t_dst ~src ~dst ~len
           end
-          else return ()
+          else return ()
         in
         st stack
       end
     end
-    | Table_init (Raw t_i, Raw e_i) -> begin
-      let* t = Env.get_table env t_i in
-      let elem = Env.get_elem env e_i in
-      let len, stack = Stack.pop_i32 stack in
-      let pos_x, stack = Stack.pop_i32 stack in
-      let pos, stack = Stack.pop_i32 stack in
+    | Table_init (Raw t_i, Raw e_i) -> begin
+      let* t = Env.get_table env t_i in
+      let elem = Env.get_elem env e_i in
+      let len, stack = Stack.pop_i32 stack in
+      let pos_x, stack = Stack.pop_i32 stack in
+      let pos, stack = Stack.pop_i32 stack in
 
-      let table_size = Table.size t in
-      let elem_len = Elem.size elem in
-      let> out_of_bounds =
-        Bool.or_ I32.(pos_x + len > consti elem_len)
-        @@ Bool.or_ I32.(pos + len > consti table_size)
+      let table_size = Table.size t in
+      let elem_len = Elem.size elem in
+      let> out_of_bounds =
+        Bool.or_ I32.(pos_x + len > consti elem_len)
+        @@ Bool.or_ I32.(pos + len > consti table_size)
         (* TODO: this is dumb, why do we have to fail even when len = 0 ?
            * I don't remember where exactly but somewhere else it's the opposite:
            * if len is 0 then we do not fail...
@@ -4433,29 +4459,29 @@ 
91.59%

            * as the next one would take care of it
            * (or maybe not because we don't want to fail
            * in the middle of the loop but still...)*)
-        @@ Bool.or_ I32.(const 0l > len)
-        @@ Bool.or_ I32.(const 0l > pos)
-        @@ I32.(const 0l > pos_x)
+        @@ Bool.or_ I32.(const 0l > len)
+        @@ Bool.or_ I32.(const 0l > pos)
+        @@ I32.(const 0l > pos_x)
       in
-      if out_of_bounds then Choice.trap Out_of_bounds_table_access
-      else begin
-        let* len = Choice.select_i32 len in
-        let* pos_x = Choice.select_i32 pos_x in
-        let* pos = Choice.select_i32 pos in
-        let len = Int32.to_int len in
-        let pos_x = Int32.to_int pos_x in
-        let pos = Int32.to_int pos in
-        for i = 0 to len - 1 do
-          let elt = Elem.get elem (pos_x + i) in
-          Table.set t (pos + i) elt
+      if out_of_bounds then Choice.trap Out_of_bounds_table_access
+      else begin
+        let* len = Choice.select_i32 len in
+        let* pos_x = Choice.select_i32 pos_x in
+        let* pos = Choice.select_i32 pos in
+        let len = Int32.to_int len in
+        let pos_x = Int32.to_int pos_x in
+        let pos = Int32.to_int pos in
+        for i = 0 to len - 1 do
+          let elt = Elem.get elem (pos_x + i) in
+          Table.set t (pos + i) elt
         done;
         st stack
       end
     end
-    | Elem_drop (Raw i) ->
+    | Elem_drop (Raw i) ->
       let elem = Env.get_elem env i in
-      Env.drop_elem elem;
-      st stack
+      Env.drop_elem elem;
+      st stack
     | I_load16 (nn, sx, { offset; _ }) -> (
       let* mem = Env.get_memory env mem_0 in
       let pos, stack = Stack.pop_i32 stack in
@@ -4471,183 +4497,184 @@ 
91.59%

       if out_of_bounds then Choice.trap Out_of_bounds_memory_access
       else
         let* res =
-          (if sx = S then Memory.load_16_s else Memory.load_16_u) mem addr
+          (match sx with S -> Memory.load_16_s | U -> Memory.load_16_u)
+            mem addr
         in
         st
         @@
         match nn with
         | S32 -> Stack.push_i32 stack res
         | S64 -> Stack.push_i64 stack (I64.of_int32 res) )
-    | I_load8 (nn, sx, { offset; _ }) -> (
-      let* mem = Env.get_memory env mem_0 in
-      let pos, stack = Stack.pop_i32 stack in
-      let offset = const offset in
-      let addr = I32.(pos + offset) in
+    | I_load8 (nn, sx, { offset; _ }) -> (
+      let* mem = Env.get_memory env mem_0 in
+      let pos, stack = Stack.pop_i32 stack in
+      let offset = const offset in
+      let addr = I32.(pos + offset) in
       let> out_of_bounds =
-        Bool.or_ I32.(offset < const 0l)
-        @@ Bool.or_ I32.(Memory.size mem < addr + const 1l)
-        @@ Bool.or_ I32.(pos < const 0l)
-        @@ Bool.or_ I32.(addr + const 1l < const 0l)
-        @@ I32.(addr < const 0l)
+        Bool.or_ I32.(offset < const 0l)
+        @@ Bool.or_ I32.(Memory.size mem < addr + const 1l)
+        @@ Bool.or_ I32.(pos < const 0l)
+        @@ Bool.or_ I32.(addr + const 1l < const 0l)
+        @@ I32.(addr < const 0l)
       in
-      if out_of_bounds then Choice.trap Out_of_bounds_memory_access
+      if out_of_bounds then Choice.trap Out_of_bounds_memory_access
       else
-        let* res =
-          (if sx = S then Memory.load_8_s else Memory.load_8_u) mem addr
+        let* res =
+          (match sx with S -> Memory.load_8_s | U -> Memory.load_8_u) mem addr
         in
-        st
+        st
         @@
         match nn with
-        | S32 -> Stack.push_i32 stack res
+        | S32 -> Stack.push_i32 stack res
         | S64 -> Stack.push_i64 stack (I64.of_int32 res) )
-    | I_store8 (nn, { offset; _ }) ->
-      let* mem = Env.get_memory env mem_0 in
-      let n, stack =
+    | I_store8 (nn, { offset; _ }) ->
+      let* mem = Env.get_memory env mem_0 in
+      let n, stack =
         match nn with
-        | S32 ->
+        | S32 ->
           let n, stack = Stack.pop_i32 stack in
-          (n, stack)
+          (n, stack)
         | S64 ->
           let n, stack = Stack.pop_i64 stack in
           (I64.to_int32 n, stack)
       in
       let pos, stack = Stack.pop_i32 stack in
-      let offset = const offset in
-      let addr = I32.(pos + offset) in
+      let offset = const offset in
+      let addr = I32.(pos + offset) in
       let> out_of_bounds =
-        Bool.or_ I32.(offset < const 0l)
-        @@ Bool.or_ I32.(Memory.size mem < addr + const 1l)
-        @@ Bool.or_ I32.(pos < const 0l)
-        @@ Bool.or_ I32.(addr + const 1l < const 0l)
-        @@ I32.(addr < const 0l)
+        Bool.or_ I32.(offset < const 0l)
+        @@ Bool.or_ I32.(Memory.size mem < addr + const 1l)
+        @@ Bool.or_ I32.(pos < const 0l)
+        @@ Bool.or_ I32.(addr + const 1l < const 0l)
+        @@ I32.(addr < const 0l)
       in
-      if out_of_bounds then Choice.trap Out_of_bounds_memory_access
-      else begin
-        let* () = Memory.store_8 mem ~addr n in
+      if out_of_bounds then Choice.trap Out_of_bounds_memory_access
+      else begin
+        let* () = Memory.store_8 mem ~addr n in
         (* Thread memory ? *)
-        st stack
+        st stack
       end
-    | I_load (nn, { offset; _ }) ->
-      let* mem = Env.get_memory env mem_0 in
-      let pos, stack = Stack.pop_i32 stack in
-      let memory_length = Memory.size mem in
-      let offset = const offset in
-      let addr = I32.(pos + offset) in
+    | I_load (nn, { offset; _ }) ->
+      let* mem = Env.get_memory env mem_0 in
+      let pos, stack = Stack.pop_i32 stack in
+      let memory_length = Memory.size mem in
+      let offset = const offset in
+      let addr = I32.(pos + offset) in
       let> out_of_bounds =
-        Bool.or_ I32.(offset < const 0l)
-        @@ Bool.or_ I32.(pos < const 0l)
-        @@ I32.(addr < const 0l)
+        Bool.or_ I32.(offset < const 0l)
+        @@ Bool.or_ I32.(pos < const 0l)
+        @@ I32.(addr < const 0l)
       in
-      if out_of_bounds then Choice.trap Out_of_bounds_memory_access
-      else begin
+      if out_of_bounds then Choice.trap Out_of_bounds_memory_access
+      else begin
         match nn with
-        | S32 ->
-          let> out_of_bounds = I32.(lt_u memory_length (addr + const 4l)) in
-          if out_of_bounds then Choice.trap Out_of_bounds_memory_access
+        | S32 ->
+          let> out_of_bounds = I32.(lt_u memory_length (addr + const 4l)) in
+          if out_of_bounds then Choice.trap Out_of_bounds_memory_access
           else
-            let* res = Memory.load_32 mem addr in
-            st @@ Stack.push_i32 stack res
-        | S64 ->
-          let> out_of_bounds = I32.(lt_u memory_length (addr + const 8l)) in
-          if out_of_bounds then Choice.trap Out_of_bounds_memory_access
+            let* res = Memory.load_32 mem addr in
+            st @@ Stack.push_i32 stack res
+        | S64 ->
+          let> out_of_bounds = I32.(lt_u memory_length (addr + const 8l)) in
+          if out_of_bounds then Choice.trap Out_of_bounds_memory_access
           else
-            let* res = Memory.load_64 mem addr in
-            st @@ Stack.push_i64 stack res
+            let* res = Memory.load_64 mem addr in
+            st @@ Stack.push_i64 stack res
       end
-    | F_load (nn, { offset; _ }) ->
-      let* mem = Env.get_memory env mem_0 in
-      let pos, stack = Stack.pop_i32 stack in
-      let memory_length = Memory.size mem in
-      let offset = const offset in
-      let addr = I32.(pos + offset) in
+    | F_load (nn, { offset; _ }) ->
+      let* mem = Env.get_memory env mem_0 in
+      let pos, stack = Stack.pop_i32 stack in
+      let memory_length = Memory.size mem in
+      let offset = const offset in
+      let addr = I32.(pos + offset) in
       let> out_of_bounds =
-        Bool.or_ I32.(offset < const 0l) @@ I32.(pos < const 0l)
+        Bool.or_ I32.(offset < const 0l) @@ I32.(pos < const 0l)
       in
-      if out_of_bounds then Choice.trap Out_of_bounds_memory_access
-      else begin
+      if out_of_bounds then Choice.trap Out_of_bounds_memory_access
+      else begin
         match nn with
-        | S32 ->
-          let> out_of_bounds = I32.(lt_u memory_length (addr + const 4l)) in
-          if out_of_bounds then Choice.trap Out_of_bounds_memory_access
+        | S32 ->
+          let> out_of_bounds = I32.(lt_u memory_length (addr + const 4l)) in
+          if out_of_bounds then Choice.trap Out_of_bounds_memory_access
           else
-            let* res = Memory.load_32 mem addr in
-            let res = F32.of_bits res in
-            st @@ Stack.push_f32 stack res
-        | S64 ->
-          let> out_of_bounds = I32.(lt_u memory_length (addr + const 8l)) in
-          if out_of_bounds then Choice.trap Out_of_bounds_memory_access
+            let* res = Memory.load_32 mem addr in
+            let res = F32.of_bits res in
+            st @@ Stack.push_f32 stack res
+        | S64 ->
+          let> out_of_bounds = I32.(lt_u memory_length (addr + const 8l)) in
+          if out_of_bounds then Choice.trap Out_of_bounds_memory_access
           else
-            let* res = Memory.load_64 mem addr in
-            let res = F64.of_bits res in
-            st @@ Stack.push_f64 stack res
+            let* res = Memory.load_64 mem addr in
+            let res = F64.of_bits res in
+            st @@ Stack.push_f64 stack res
       end
-    | I_store (nn, { offset; _ }) -> (
-      let* mem = Env.get_memory env mem_0 in
-      let memory_length = Memory.size mem in
-      let offset = const offset in
-      let> out_of_bounds = I32.(offset < const 0l) in
-      if out_of_bounds then Choice.trap Out_of_bounds_memory_access
+    | I_store (nn, { offset; _ }) -> (
+      let* mem = Env.get_memory env mem_0 in
+      let memory_length = Memory.size mem in
+      let offset = const offset in
+      let> out_of_bounds = I32.(offset < const 0l) in
+      if out_of_bounds then Choice.trap Out_of_bounds_memory_access
       else
-        match nn with
-        | S32 ->
+        match nn with
+        | S32 ->
           let n, stack = Stack.pop_i32 stack in
-          let pos, stack = Stack.pop_i32 stack in
-          let addr = I32.(pos + offset) in
+          let pos, stack = Stack.pop_i32 stack in
+          let addr = I32.(pos + offset) in
           let> out_of_bounds =
-            Bool.or_ I32.(lt_u memory_length (addr + const 4l))
-            @@ I32.(pos < const 0l)
+            Bool.or_ I32.(lt_u memory_length (addr + const 4l))
+            @@ I32.(pos < const 0l)
           in
-          if out_of_bounds then Choice.trap Out_of_bounds_memory_access
-          else begin
-            let* () = Memory.store_32 mem ~addr n in
-            st stack
+          if out_of_bounds then Choice.trap Out_of_bounds_memory_access
+          else begin
+            let* () = Memory.store_32 mem ~addr n in
+            st stack
           end
-        | S64 ->
+        | S64 ->
           let n, stack = Stack.pop_i64 stack in
-          let pos, stack = Stack.pop_i32 stack in
-          let addr = I32.(pos + offset) in
+          let pos, stack = Stack.pop_i32 stack in
+          let addr = I32.(pos + offset) in
           let> out_of_bounds =
-            Bool.or_ I32.(lt_u memory_length (addr + const 8l))
-            @@ I32.(pos < const 0l)
+            Bool.or_ I32.(lt_u memory_length (addr + const 8l))
+            @@ I32.(pos < const 0l)
           in
-          if out_of_bounds then Choice.trap Out_of_bounds_memory_access
-          else begin
-            let* () = Memory.store_64 mem ~addr n in
-            st stack
+          if out_of_bounds then Choice.trap Out_of_bounds_memory_access
+          else begin
+            let* () = Memory.store_64 mem ~addr n in
+            st stack
           end )
-    | F_store (nn, { offset; _ }) -> (
-      let* mem = Env.get_memory env mem_0 in
-      let memory_length = Memory.size mem in
-      let offset = const offset in
-      let> out_of_bounds = I32.(offset < const 0l) in
-      if out_of_bounds then Choice.trap Out_of_bounds_memory_access
+    | F_store (nn, { offset; _ }) -> (
+      let* mem = Env.get_memory env mem_0 in
+      let memory_length = Memory.size mem in
+      let offset = const offset in
+      let> out_of_bounds = I32.(offset < const 0l) in
+      if out_of_bounds then Choice.trap Out_of_bounds_memory_access
       else
-        match nn with
-        | S32 ->
+        match nn with
+        | S32 ->
           let n, stack = Stack.pop_f32 stack in
-          let pos, stack = Stack.pop_i32 stack in
-          let addr = I32.(pos + offset) in
+          let pos, stack = Stack.pop_i32 stack in
+          let addr = I32.(pos + offset) in
           let> out_of_bounds =
-            Bool.or_ I32.(lt_u memory_length (addr + const 4l))
-            @@ I32.(pos < const 0l)
+            Bool.or_ I32.(lt_u memory_length (addr + const 4l))
+            @@ I32.(pos < const 0l)
           in
-          if out_of_bounds then Choice.trap Out_of_bounds_memory_access
-          else begin
-            let* () = Memory.store_32 mem ~addr (F32.to_bits n) in
-            st stack
+          if out_of_bounds then Choice.trap Out_of_bounds_memory_access
+          else begin
+            let* () = Memory.store_32 mem ~addr (F32.to_bits n) in
+            st stack
           end
-        | S64 ->
+        | S64 ->
           let n, stack = Stack.pop_f64 stack in
-          let pos, stack = Stack.pop_i32 stack in
-          let addr = I32.(pos + offset) in
+          let pos, stack = Stack.pop_i32 stack in
+          let addr = I32.(pos + offset) in
           let> out_of_bounds =
-            Bool.or_ I32.(lt_u memory_length (addr + const 8l))
-            @@ I32.(pos < const 0l)
+            Bool.or_ I32.(lt_u memory_length (addr + const 8l))
+            @@ I32.(pos < const 0l)
           in
-          if out_of_bounds then Choice.trap Out_of_bounds_memory_access
-          else begin
-            let* () = Memory.store_64 mem ~addr (F64.to_bits n) in
-            st stack
+          if out_of_bounds then Choice.trap Out_of_bounds_memory_access
+          else begin
+            let* () = Memory.store_64 mem ~addr (F64.to_bits n) in
+            st stack
           end )
     | I64_load32 (sx, { offset; _ }) ->
       let* mem = Env.get_memory env mem_0 in
@@ -4721,30 +4748,30 @@ 
91.59%

         let* () = Memory.store_32 mem ~addr n in
         st stack
       end
-    | Data_drop (Raw i) ->
-      let* data = Env.get_data env i in
-      Env.drop_data data;
-      st stack
-    | Br_table (inds, Raw i) ->
+    | Data_drop (Raw i) ->
+      let* data = Env.get_data env i in
+      Env.drop_data data;
+      st stack
+    | Br_table (inds, Raw i) ->
       let target, stack = Stack.pop_i32 stack in
-      let> out =
-        Bool.or_
-          I32.(target < const 0l)
-          I32.(target >= const (Int32.of_int (Array.length inds)))
+      let> out =
+        Bool.or_
+          I32.(target < const 0l)
+          I32.(target >= const (Int32.of_int (Array.length inds)))
       in
-      let* target =
-        if out then return i
+      let* target =
+        if out then return i
         else
-          let+ target = Choice.select_i32 target in
-          let target = Int32.to_int target in
-          let (Raw i) = inds.(target) in
-          i
+          let+ target = Choice.select_i32 target in
+          let target = Int32.to_int target in
+          let (Raw i) = inds.(target) in
+          i
       in
-      let state = { state with stack } in
+      let state = { state with stack } in
       State.branch state target
-    | Call_indirect (Raw tbl_i, typ_i) ->
+    | Call_indirect (Raw tbl_i, typ_i) ->
       call_indirect ~return:false state (tbl_i, typ_i)
-    | Return_call_indirect (Raw tbl_i, typ_i) ->
+    | Return_call_indirect (Raw tbl_i, typ_i) ->
       call_indirect ~return:true state (tbl_i, typ_i)
     | Call_ref typ_i -> call_ref ~return:false state typ_i
     | Return_call_ref typ_i -> call_ref ~return:true state typ_i
@@ -4763,34 +4790,34 @@ 
91.59%

       let a = Array.init (Int32.to_int len) (fun _i -> default) in
       st @@ Stack.push_array stack a
     | ( Array_new_data _ | Array_new_elem _ | Array_new_fixed _ | Array_get _
-      | Array_get_u _ | Array_set _ | Array_len | Ref_i31 | I31_get_s
+      | Array_get_u _ | Array_set _ | Array_len | Ref_i31 | I31_get_s
       | I31_get_u | Struct_get _ | Struct_get_s _ | Struct_set _ | Struct_new _
       | Struct_new_default _ | Extern_externalize | Extern_internalize
       | Ref_as_non_null | Ref_cast _ | Ref_test _ | Ref_eq | Br_on_cast _
       | Br_on_cast_fail _ | Br_on_non_null _ | Br_on_null _ ) as i ->
       Log.debug2 "TODO (Interpret.exec_instr) %a@\n" Types.pp_instr i;
-      st stack
+      st stack
 
   let rec loop (state : State.exec_state) =
-    match state.pc with
-    | instr :: pc -> begin
-      let* state = exec_instr instr { state with pc } in
-      match state with
-      | State.Continue state -> loop state
-      | State.Return res -> Choice.return res
+    match state.pc with
+    | instr :: pc -> begin
+      let* state = exec_instr instr { state with pc } in
+      match state with
+      | State.Continue state -> loop state
+      | State.Return res -> Choice.return res
     end
-    | [] -> (
+    | [] -> (
       Log.debug2 "stack        : [ %a ]@." Stack.pp state.stack;
-      let* state = State.end_block state in
-      match state with
-      | State.Continue state -> loop state
-      | State.Return res -> Choice.return res )
+      let* state = State.end_block state in
+      match state with
+      | State.Continue state -> loop state
+      | State.Return res -> Choice.return res )
 
   let exec_expr envs env locals stack expr bt =
-    let count = State.empty_count (Some "start") in
-    count.enter <- count.enter + 1;
+    let count = State.empty_count (Some "start") in
+    count.enter <- count.enter + 1;
     let state : State.exec_state =
-      let func_rt = match bt with None -> [] | Some rt -> rt in
+      let func_rt = match bt with None -> [] | Some rt -> rt in
       { stack
       ; locals
       ; env
@@ -4802,78 +4829,78 @@ 
91.59%

       ; count
       }
     in
-    let+ state = loop state in
-    (state, count)
+    let+ state = loop state in
+    (state, count)
 
   let modul envs (modul : Module_to_run.t) =
-    Log.debug0 "interpreting ...@\n";
+    Log.debug0 "interpreting ...@\n";
 
-    try
+    try
       begin
         let+ () =
-          List.fold_left
+          List.fold_left
             (fun u to_run ->
-              let* () = u in
-              let+ end_stack, count =
+              let* () = u in
+              let+ end_stack, count =
                 let env = Module_to_run.env modul in
-                exec_expr envs env (State.Locals.of_list []) Stack.empty to_run
+                exec_expr envs env (State.Locals.of_list []) Stack.empty to_run
                   None
               in
-              Log.profile3 "Exec module %s@.%a@."
-                (Option.value (Module_to_run.modul modul).id
+              Log.profile3 "Exec module %s@.%a@."
+                (Option.value (Module_to_run.modul modul).id
                    ~default:"anonymous" )
                 State.print_count count;
-              match end_stack with
-              | [] -> ()
+              match end_stack with
+              | [] -> ()
               | _ :: _ ->
-                Format.pp_err "non empty stack@\n%a@." Stack.pp end_stack;
+                Fmt.epr "non empty stack@\n%a@." Stack.pp end_stack;
                 assert false )
-            (Choice.return ())
-            (Module_to_run.to_run modul)
+            (Choice.return ())
+            (Module_to_run.to_run modul)
         in
-        Ok ()
+        Ok ()
       end
     with
-    | Trap msg -> Choice.return (Error (`Msg msg))
+    | Trap msg -> Choice.return (Error (`Msg msg))
     | Stack_overflow -> Choice.return (Error `Call_stack_exhausted)
 
   let exec_vfunc_from_outside ~locals ~env ~envs func =
-    let env = Env_id.get env envs in
-    let exec_state = State.empty_exec_state ~locals ~env ~envs in
+    let env = Env_id.get env envs in
+    let exec_state = State.empty_exec_state ~locals ~env ~envs in
     try
       begin
         let* state =
           match func with
-          | Func_intf.WASM (id, func, env_id) ->
+          | Func_intf.WASM (id, func, env_id) ->
             let env = Env_id.get env_id exec_state.State.envs in
-            let stack = locals in
+            let stack = locals in
             let state = State.{ exec_state with stack } in
             let id = Raw id in
-            Choice.return
-              (State.Continue (exec_func ~return:true ~id state env func))
+            Choice.return
+              (State.Continue (exec_func ~return:true ~id state env func))
           | Extern f ->
             let f = Env.get_extern_func exec_state.env f in
-            let+ stack = exec_extern_func exec_state.stack f in
+            let+ stack = exec_extern_func exec_state.env exec_state.stack f in
             let state = State.{ exec_state with stack } in
             State.return state
         in
-        match state with
+        match state with
         | State.Return res -> Choice.return (Ok res)
-        | State.Continue state ->
-          let+ res = loop state in
-          Ok res
+        | State.Continue state ->
+          let+ res = loop state in
+          Ok res
       end
     with
-    | Trap msg -> Choice.return (Error (`Msg msg))
+    | Trap msg -> Choice.return (Error (`Msg msg))
     | Stack_overflow -> Choice.return (Error `Call_stack_exhausted)
 
   type value = Value.t
 end
 
-module Concrete = Make (Concrete) [@@inlined hint]
-module SymbolicP = Make (Symbolic.P) [@@inlined hint]
-module SymbolicM = Make (Symbolic.M) [@@inlined hint]
-module Concolic = Make (Concolic.P) [@@inlined hint]
+module Concrete = Make [@inlined hint] (Concrete)
+module SymbolicP = Make [@inlined hint] (Symbolic.P)
+module SymbolicM = Make [@inlined hint] (Symbolic.M)
+module Concolic = Make [@inlined hint] (Concolic.P)
diff --git a/coverage/src/interpret/trap.ml.html b/coverage/src/interpret/trap.ml.html index 6ca7d3b07..1455e5962 100644 --- a/coverage/src/interpret/trap.ml.html +++ b/coverage/src/interpret/trap.ml.html @@ -18,10 +18,10 @@

69.23%

@@ -50,16 +50,15 @@

69.23%

- + - - + + - + - - +
@@ -97,7 +96,6 @@

69.23%

31 32 33 -34 
(* SPDX-License-Identifier: AGPL-3.0-or-later *)
 (* Copyright © 2021-2024 OCamlPro *)
@@ -119,15 +117,14 @@ 
69.23%

   | Memory_heap_buffer_overflow
 
 let to_string = function
-  | Out_of_bounds_table_access -> "out of bounds table access"
-  | Out_of_bounds_memory_access -> "out of bounds memory access"
-  | Undefined_element -> "undefined element"
-  | Uninitialized_element fun_i ->
-    Printf.sprintf "uninitialized element %i" fun_i
+  | Out_of_bounds_table_access -> "out of bounds table access"
+  | Out_of_bounds_memory_access -> "out of bounds memory access"
+  | Undefined_element -> "undefined element"
+  | Uninitialized_element fun_i -> Fmt.str "uninitialized element %i" fun_i
   | Integer_overflow -> "integer overflow"
   | Integer_divide_by_zero -> "integer divide by zero"
   | Element_type_error -> "element_type_error"
-  | Unreachable -> "unreachable"
+  | Unreachable -> "unreachable"
   | Indirect_call_type_mismatch -> "indirect call type mismatch"
   | Extern_call_arg_type_mismatch -> "extern call arg type mismatch"
   | Extern_call_null_arg -> "extern call null arg"
diff --git a/coverage/src/interpret/choice_intf.ml.html b/coverage/src/intf/choice_intf.ml.html
similarity index 95%
rename from coverage/src/interpret/choice_intf.ml.html
rename to coverage/src/intf/choice_intf.ml.html
index 82a894ae1..28ea3b0a2 100644
--- a/coverage/src/interpret/choice_intf.ml.html
+++ b/coverage/src/intf/choice_intf.ml.html
@@ -3,7 +3,7 @@
   
     
     choice_intf.ml — Coverage report
-    
+    
     
     
     
@@ -12,7 +12,7 @@
diff --git a/coverage/src/func_intf.ml.html b/coverage/src/intf/func_intf.ml.html similarity index 88% rename from coverage/src/func_intf.ml.html rename to coverage/src/intf/func_intf.ml.html index fee48f0d2..59159aea4 100644 --- a/coverage/src/func_intf.ml.html +++ b/coverage/src/intf/func_intf.ml.html @@ -3,16 +3,16 @@ func_intf.ml — Coverage report - - - + + +
@@ -174,6 +181,13 @@

100.00%

72 73 74 +75 +76 +77 +78 +79 +80 +81 
(* SPDX-License-Identifier: AGPL-3.0-or-later *)
 (* Copyright © 2021-2024 OCamlPro *)
@@ -197,6 +211,10 @@ 
100.00%

   type 'a t
 end
 
+module type Memory_type = sig
+  type t
+end
+
 module type T_Extern_func = sig
   type int32
 
@@ -208,6 +226,8 @@ 
100.00%

 
   type 'a m
 
+  type memory
+
   type _ telt =
     | I32 : int32 telt
     | I64 : int64 telt
@@ -223,6 +243,7 @@ 
100.00%

     | 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
@@ -252,6 +273,6 @@ 
100.00%
- + diff --git a/coverage/src/interpret/interpret_intf.ml.html b/coverage/src/intf/interpret_intf.ml.html similarity index 86% rename from coverage/src/interpret/interpret_intf.ml.html rename to coverage/src/intf/interpret_intf.ml.html index a1e83cb03..8a0e793fe 100644 --- a/coverage/src/interpret/interpret_intf.ml.html +++ b/coverage/src/intf/interpret_intf.ml.html @@ -3,7 +3,7 @@ interpret_intf.ml — Coverage report - + @@ -12,7 +12,7 @@
@@ -471,41 +436,6 @@

100.00%

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 -232 -233 -234 -235 -236 -237 -238 -239 -240 
(* SPDX-License-Identifier: AGPL-3.0-or-later *)
 (* Copyright © 2021-2024 OCamlPro *)
@@ -513,42 +443,6 @@ 
100.00%

 
 open Types
 
-module type Memory_data = sig
-  type int32
-
-  type int64
-
-  type t
-
-  val load_8_s : t -> int32 -> int32
-
-  val load_8_u : t -> int32 -> int32
-
-  val load_16_s : t -> int32 -> int32
-
-  val load_16_u : t -> int32 -> int32
-
-  val load_32 : t -> int32 -> int32
-
-  val load_64 : t -> int32 -> int64
-
-  val store_8 : t -> addr:int32 -> int32 -> unit
-
-  val store_16 : t -> addr:int32 -> int32 -> unit
-
-  val store_32 : t -> addr:int32 -> int32 -> unit
-
-  val store_64 : t -> addr:int32 -> int64 -> unit
-
-  val create : Int32.t -> t
-
-  val grow : t -> int32 -> unit
-
-  val size : t -> int32
-
-  val size_in_pages : t -> int32
-end
-
 module type P = sig
   type thread
 
@@ -559,14 +453,6 @@ 
100.00%

   val select :
     Value.vbool -> if_true:Value.t -> if_false:Value.t -> Value.t Choice.t
 
-  module Extern_func :
-    Func_intf.T_Extern_func
-      with type int32 := Value.int32
-       and type int64 := Value.int64
-       and type float32 := Value.float32
-       and type float64 := Value.float64
-       and type 'a m := 'a Choice.t
-
   module Global : sig
     type t
 
@@ -644,6 +530,15 @@ 
100.00%

     val get_limit_max : t -> Value.int64 option
   end
 
+  module Extern_func :
+    Func_intf.T_Extern_func
+      with type int32 := Value.int32
+       and type int64 := Value.int64
+       and type float32 := Value.float32
+       and type float64 := Value.float64
+       and type 'a m := 'a Choice.t
+       and type memory := Memory.t
+
   module Data : sig
     type t
 
diff --git a/coverage/src/v.ml.html b/coverage/src/intf/symbolic_choice_intf.ml.html
similarity index 55%
rename from coverage/src/v.ml.html
rename to coverage/src/intf/symbolic_choice_intf.ml.html
index e813d2270..3ed36007b 100644
--- a/coverage/src/v.ml.html
+++ b/coverage/src/intf/symbolic_choice_intf.ml.html
@@ -2,24 +2,22 @@
 
   
     
-    v.ml — Coverage report
-    
-    
-    
+    symbolic_choice_intf.ml — Coverage report
+    
+    
+    
     
   
   
     
     
     

       

@@ -40,35 +38,35 @@ 
86.67%

  
  
  
- 
+ 
  
- 
+ 
  
- 
+ 
  
- 
+ 
  
  
  
  
  
- 
- 
- 
- 
+ 
+ 
+ 
+ 
  
  
  
- 
- 
+ 
+ 
  
  
- 
+ 
  
  
  
  
- 
+ 
  
  
  
@@ -76,7 +74,7 @@ 
86.67%

  
  
  
- 
+ 
  
  
  
@@ -85,7 +83,7 @@ 
86.67%

  
  
  
- 
+ 
  
  
  
@@ -105,12 +103,6 @@ 
86.67%

  
  
  
- 
- 
- 
- 
- 
-
@@ -196,103 +188,91 @@

86.67%

79 80 81 -82 -83 -84 -85 -86 -87 
(* SPDX-License-Identifier: AGPL-3.0-or-later *)
 (* Copyright © 2021-2024 OCamlPro *)
 (* Written by the Owi programmers *)
 
-include (
-  struct
-    type vbool = bool
+type 'a eval =
+  | EVal of 'a
+  | ETrap of Trap.t * Smtml.Model.t
+  | EAssert of Smtml.Expr.t * Smtml.Model.t
 
-    type int32 = Int32.t
+module type S = sig
+  module V : Func_intf.Value_types
 
-    type int64 = Int64.t
+  type thread
 
-    type float32 = Float32.t
+  type 'a t
 
-    type float64 = Float64.t
+  val return : 'a -> 'a t
 
-    let const_i32 x = x
+  val bind : 'a t -> ('a -> 'b t) -> 'b t
 
-    let const_i64 x = x
+  val ( let* ) : 'a t -> ('a -> 'b t) -> 'b t
 
-    let const_f32 x = x
+  val map : 'a t -> ('a -> 'b) -> 'b t
 
-    let const_f64 x = x
+  val ( let+ ) : 'a t -> ('a -> 'b) -> 'b t
 
-    include Concrete_value
+  val trap : Trap.t -> 'a t
 
-    module Ref = struct
-      let get_func (r : ref_value) : Func_intf.t Value_intf.get_ref =
-        match r with
-        | Funcref (Some f) -> Ref_value f
-        | Funcref None -> Null
-        | _ -> Type_mismatch
+  val select : V.vbool -> bool t
 
-      let get_externref (type t) (r : ref_value) (t : t Type.Id.t) :
-        t Value_intf.get_ref =
-        match r with
-        | Externref (Some (E (ety, v))) -> (
-          match Type.Id.provably_equal t ety with
-          | None -> assert false
-          | Some Equal -> Ref_value v )
-        | _ -> assert false
-    end
+  val select_i32 : V.int32 -> Int32.t t
 
-    module Bool = struct
-      let const c = c
+  val assertion : V.vbool -> unit t
 
-      let not = not
+  val with_thread : (thread -> 'a) -> 'a t
 
-      let and_ = ( && )
+  val with_new_symbol : Smtml.Ty.t -> (Smtml.Symbol.t -> 'b) -> 'b t
 
-      let or_ = ( || )
+  val solver : Solver.t t
 
-      let int32 = function true -> 1l | false -> 0l
+  val thread : thread t
 
-      let pp = Format.pp_bool
-    end
+  val add_pc : V.vbool -> unit t
 
-    module I32 = struct
-      include Int32
-      include Convert.Int32
+  type 'a run_result = ('a eval * thread) Seq.t
 
-      let to_bool i = Int32.ne i 0l
-    end
+  val run :
+       workers:int
+    -> Smtml.Solver_dispatcher.solver_type
+    -> 'a t
+    -> thread
+    -> callback:('a eval * thread -> unit)
+    -> callback_init:(unit -> unit)
+    -> callback_end:(unit -> unit)
+    -> unit Domain.t array
+end
 
-    module I64 = struct
-      include Int64
-      include Convert.Int64
-    end
+module type Intf = sig
+  module type S = S
 
-    module F32 = struct
-      include Float32
-      include Convert.Float32
-    end
+  module CoreImpl : sig
+    (* The core implementation of the monad. It is isolated in a module to *)
+    (* restict its exposed interface and maintain its invariant. *)
+
+    module State : sig
+      type ('a, 's) t
 
-    module F64 = struct
-      include Float64
-      include Convert.Float64
+      val project_state :
+           ('st1 -> 'st2 * 'backup)
+        -> ('backup -> 'st2 -> 'st1)
+        -> ('a, 'st2) t
+        -> ('a, 'st1) t
     end
-  end :
-    Value_intf.T
-      with type vbool = Bool.t
-       and type int32 = Int32.t
-       and type int64 = Int64.t
-       and type float32 = Float32.t
-       and type float64 = Float64.t
-       and type ref_value = Concrete_value.ref_value
-       and type t = Concrete_value.t )
+  end
+
+  module Make (Thread : Thread.S) :
+    S
+      with type 'a t = ('a eval, Thread.t) CoreImpl.State.t
+       and type thread := Thread.t
+       and module V := Symbolic_value
+end
- + diff --git a/coverage/src/intf/symbolic_memory_intf.ml.html b/coverage/src/intf/symbolic_memory_intf.ml.html new file mode 100644 index 000000000..a3fa56f69 --- /dev/null +++ b/coverage/src/intf/symbolic_memory_intf.ml.html @@ -0,0 +1,449 @@ + + + + + symbolic_memory_intf.ml — Coverage report + + + + + + + + +
+
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+
+
+
+ 
+  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
+
+
module type M = sig
+  type t
+
+  type address
+
+  val address : Smtml.Expr.t -> address Symbolic_choice_without_memory.t
+
+  val address_i32 : Int32.t -> address
+
+  val make : unit -> t
+
+  val clone : t -> t
+
+  val loadn : t -> address -> int -> Smtml.Expr.t
+
+  val storen : t -> address -> Smtml.Expr.t -> int -> unit
+
+  val validate_address :
+       t
+    -> Smtml.Expr.t
+    -> (Smtml.Expr.t, Trap.t) result Symbolic_choice_without_memory.t
+
+  val realloc :
+       t
+    -> ptr:Smtml.Expr.t
+    -> size:Smtml.Expr.t
+    -> Smtml.Expr.t Symbolic_choice_without_memory.t
+
+  val free : t -> Smtml.Expr.t -> unit Symbolic_choice_without_memory.t
+end
+
+module type S = sig
+  type t
+
+  type collection
+
+  val init : unit -> collection
+
+  val clone : collection -> collection
+
+  val get_memory : Env_id.t -> Concrete_memory.t -> collection -> int -> t
+
+  (* val check_within_bounds : *)
+  (*   t -> Smtml.Expr.t -> (Smtml.Expr.t * Symbolic_value.int32, Trap.t) result *)
+
+  val realloc :
+       t
+    -> ptr:Smtml.Expr.t
+    -> size:Smtml.Expr.t
+    -> Smtml.Expr.t Symbolic_choice_without_memory.t
+
+  val free : t -> Smtml.Expr.t -> unit Symbolic_choice_without_memory.t
+
+  val load_8_s :
+    t -> Smtml.Expr.t -> Symbolic_value.int32 Symbolic_choice_without_memory.t
+
+  val load_8_u :
+    t -> Smtml.Expr.t -> Symbolic_value.int32 Symbolic_choice_without_memory.t
+
+  val load_16_s :
+    t -> Smtml.Expr.t -> Symbolic_value.int32 Symbolic_choice_without_memory.t
+
+  val load_16_u :
+    t -> Smtml.Expr.t -> Symbolic_value.int32 Symbolic_choice_without_memory.t
+
+  val load_32 :
+    t -> Smtml.Expr.t -> Symbolic_value.int32 Symbolic_choice_without_memory.t
+
+  val load_64 :
+    t -> Smtml.Expr.t -> Symbolic_value.int32 Symbolic_choice_without_memory.t
+
+  val store_8 :
+       t
+    -> addr:Smtml.Expr.t
+    -> Smtml.Expr.t
+    -> unit Symbolic_choice_without_memory.t
+
+  val store_16 :
+       t
+    -> addr:Smtml.Expr.t
+    -> Smtml.Expr.t
+    -> unit Symbolic_choice_without_memory.t
+
+  val store_32 :
+       t
+    -> addr:Smtml.Expr.t
+    -> Smtml.Expr.t
+    -> unit Symbolic_choice_without_memory.t
+
+  val store_64 :
+       t
+    -> addr:Smtml.Expr.t
+    -> Smtml.Expr.t
+    -> unit Symbolic_choice_without_memory.t
+
+  val grow : t -> Smtml.Expr.t -> unit
+
+  val fill : t -> pos:Smtml.Expr.t -> len:Smtml.Expr.t -> char -> Smtml.Expr.t
+
+  val blit :
+       t
+    -> src:Smtml.Expr.t
+    -> dst:Smtml.Expr.t
+    -> len:Smtml.Expr.t
+    -> Smtml.Expr.t
+
+  val blit_string :
+       t
+    -> string
+    -> src:Smtml.Expr.t
+    -> dst:Smtml.Expr.t
+    -> len:Smtml.Expr.t
+    -> Smtml.Expr.t
+
+  val size : t -> Smtml.Expr.t
+
+  val size_in_pages : t -> Smtml.Expr.t
+
+  val get_limit_max : t -> Smtml.Expr.t option
+
+  module ITbl : sig
+    type 'a t
+
+    type key
+
+    val iter : (key -> 'a -> unit) -> 'a t -> unit
+  end
+
+  val iter : (t ITbl.t -> unit) -> collection -> unit
+end
+
+module type Intf = sig
+  module type M = M
+
+  module type S = S
+
+  module Make (_ : M) : S
+end
+
+
+
+ + + diff --git a/coverage/src/intf/thread_intf.ml.html b/coverage/src/intf/thread_intf.ml.html new file mode 100644 index 000000000..e550df13b --- /dev/null +++ b/coverage/src/intf/thread_intf.ml.html @@ -0,0 +1,221 @@ + + + + + thread_intf.ml — Coverage report + + + + + + + + +
+
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+
+
+
+ 
+ 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
+
+
(* SPDX-License-Identifier: AGPL-3.0-or-later *)
+(* Copyright © 2021-2024 OCamlPro *)
+(* Written by the Owi programmers *)
+
+module type M = sig
+  type collection
+
+  val init : unit -> collection
+
+  val clone : collection -> collection
+end
+
+module type S = sig
+  type t
+
+  module Memory : M
+
+  val init : unit -> t
+
+  val create :
+       int
+    -> Smtml.Symbol.t list
+    -> Symbolic_value.vbool list
+    -> Memory.collection
+    -> Symbolic_table.collection
+    -> Symbolic_global.collection
+    -> int32 list
+    -> t
+
+  val pc : t -> Symbolic_value.vbool list
+
+  val memories : t -> Memory.collection
+
+  val tables : t -> Symbolic_table.collection
+
+  val globals : t -> Symbolic_global.collection
+
+  val breadcrumbs : t -> int32 list
+
+  val symbols_set : t -> Smtml.Symbol.t list
+
+  val symbols : t -> int
+
+  val clone : t -> t
+
+  val add_pc : t -> Symbolic_value.vbool -> t
+
+  val add_breadcrumb : t -> int32 -> t
+
+  val add_symbol : t -> Smtml.Symbol.t -> t
+
+  val incr_symbols : t -> t
+end
+
+module type Intf = sig
+  module type M = M
+
+  module type S = S
+
+  module Make (Symbolic_memory : M) :
+    S with type Memory.collection = Symbolic_memory.collection
+end
+
+
+
+ + + diff --git a/coverage/src/value_intf.ml.html b/coverage/src/intf/value_intf.ml.html similarity index 94% rename from coverage/src/value_intf.ml.html rename to coverage/src/intf/value_intf.ml.html index 5e635d63b..b0c114cc2 100644 --- a/coverage/src/value_intf.ml.html +++ b/coverage/src/intf/value_intf.ml.html @@ -3,16 +3,16 @@ value_intf.ml — Coverage report - - - + + +
@@ -606,6 +616,16 @@

100.00%

288 289 290 +291 +292 +293 +294 +295 +296 +297 +298 +299 +300 
(* SPDX-License-Identifier: AGPL-3.0-or-later *)
 (* Copyright © 2021-2024 OCamlPro *)
@@ -779,14 +799,24 @@ 
100.00%

 
   type int32
 
+  val pp_int32 : Fmt.formatter -> int32 -> unit
+
   type int64
 
+  val pp_int64 : Fmt.formatter -> int64 -> unit
+
   type float32
 
+  val pp_float32 : Fmt.formatter -> float32 -> unit
+
   type float64
 
+  val pp_float64 : Fmt.formatter -> float64 -> unit
+
   type ref_value
 
+  val pp_ref_value : Fmt.formatter -> ref_value -> unit
+
   type t =
     | I32 of int32
     | I64 of int64
@@ -794,6 +824,8 @@ 
100.00%

     | F64 of float64
     | Ref of ref_value
 
+  val pp : Fmt.formatter -> t -> unit
+
   val const_i32 : Int32.t -> int32
 
   val const_i64 : Int64.t -> int64
@@ -811,8 +843,6 @@ 
100.00%

 
   val ref_is_null : ref_value -> vbool
 
-  val pp : Format.formatter -> t -> unit
-
   module Ref : sig
     val get_func : ref_value -> Func_intf.t get_ref
 
@@ -830,7 +860,7 @@ 
100.00%

 
     val int32 : vbool -> int32
 
-    val pp : Format.formatter -> vbool -> unit
+    val pp : Fmt.formatter -> vbool -> unit
   end
 
   module F32 : sig
@@ -900,6 +930,6 @@ 
100.00%
- + diff --git a/coverage/src/concrete/thread.ml.html b/coverage/src/intf/wasm_ffi_intf.ml.html similarity index 53% rename from coverage/src/concrete/thread.ml.html rename to coverage/src/intf/wasm_ffi_intf.ml.html index 0c450e38e..ac6c7d4f8 100644 --- a/coverage/src/concrete/thread.ml.html +++ b/coverage/src/intf/wasm_ffi_intf.ml.html @@ -2,8 +2,8 @@ - thread.ml — Coverage report - + wasm_ffi_intf.ml — Coverage report + @@ -12,7 +12,7 @@
@@ -108,48 +120,72 @@

100.00%

39 40 41 +42 +43 +44 +45 +46 +47 +48 +49 +50 +51 +52 +53 
(* SPDX-License-Identifier: AGPL-3.0-or-later *)
 (* Copyright © 2021-2024 OCamlPro *)
 (* Written by the Owi programmers *)
 
-type t =
-  { choices : int
-  ; mutable symbol_set : Smtml.Symbol.t list
-  ; pc : Symbolic_value.vbool list
-  ; memories : Symbolic_memory.collection
-  ; tables : Symbolic_table.collection
-  ; globals : Symbolic_global.collection
-      (** Breadcrumbs represent the list of choices that were made so far. They
-          identify one given symbolic execution trace. *)
-  ; breadcrumbs : int32 list
-  }
-
-let pc t = t.pc
-
-let memories t = t.memories
-
-let tables t = t.tables
-
-let globals t = t.globals
-
-let breadcrumbs t = t.breadcrumbs
-
-let create () =
-  { choices = 0
-  ; symbol_set = []
-  ; pc = []
-  ; memories = Symbolic_memory.init ()
-  ; tables = Symbolic_table.init ()
-  ; globals = Symbolic_global.init ()
-  ; breadcrumbs = []
-  }
-
-let clone { choices; symbol_set; pc; memories; tables; globals; breadcrumbs } =
-  let memories = Symbolic_memory.clone memories in
-  let tables = Symbolic_table.clone tables in
-  let globals = Symbolic_global.clone globals in
-  { choices; symbol_set; pc; memories; tables; globals; breadcrumbs }
+module type S0 = sig
+  type 'a t
+
+  type memory
+
+  module Value : sig
+    type int32
+
+    type int64
+
+    type float32
+
+    type float64
+  end
+
+  val symbol_i8 : unit -> Value.int32 t
+
+  val symbol_char : unit -> Value.int32 t
+
+  val symbol_i32 : unit -> Value.int32 t
+
+  val symbol_i64 : unit -> Value.int64 t
+
+  val symbol_f32 : unit -> Value.float32 t
+
+  val symbol_f64 : unit -> Value.float64 t
+
+  val assume_i32 : Value.int32 -> unit t
+
+  val assume_positive_i32 : Value.int32 -> unit t
+
+  val assert_i32 : Value.int32 -> unit t
+
+  val abort : unit -> unit t
+
+  val alloc : memory -> Value.int32 -> Value.int32 -> Value.int32 t
+
+  val free : memory -> Value.int32 -> unit t
+
+  val exit : Value.int32 -> unit t
+end
+
+module type S = sig
+  type extern_func
+
+  val symbolic_extern_module : extern_func Link.extern_module
+
+  val summaries_extern_module : extern_func Link.extern_module
+end
diff --git a/coverage/src/link/link.ml.html b/coverage/src/link/link.ml.html index f21b0a664..869415373 100644 --- a/coverage/src/link/link.ml.html +++ b/coverage/src/link/link.ml.html @@ -3,7 +3,7 @@ link.ml — Coverage report - + @@ -15,37 +15,27 @@

src/link/link.ml

-

85.29%

+

91.39%

@@ -130,24 +120,24 @@

85.29%

- - + + - + - - - + + + - + - + - - - + + + @@ -157,7 +147,7 @@

85.29%

- + @@ -178,7 +168,7 @@

85.29%

- + @@ -287,218 +277,209 @@

85.29%

- - + + - - - + + + - + - + - - - - - - + + + + + + - + - + - + - - - + + + - + - - - + + + - + - + - + - - - - - - + + + + + + - + - + - - - + + + - + - + - + - - + + - + - + - + - + - - - + + + - - + + - - - - - + + + + + - + - + - - + + - + - - + + - - - + + + - + - - + + - - - + + + - - - + + + - - + + - - + + - + - - - - + + + + - + - - - + + + - - + + - + - - + + - + - + - + - - - - - + + + + + - - - - - - - - -
@@ -943,15 +924,6 @@

85.29%

438 439 440 -441 -442 -443 -444 -445 -446 -447 -448 -449 
(* SPDX-License-Identifier: AGPL-3.0-or-later *)
 (* Copyright © 2021-2024 OCamlPro *)
@@ -1005,70 +977,70 @@ 
85.29%

   }
 
 let load_from_module ls f (import : _ Imported.t) =
-  match StringMap.find import.modul ls.by_name with
+  match StringMap.find import.modul ls.by_name with
   | exception Not_found -> Error (`Unknown_module import.modul)
-  | exports -> (
-    match StringMap.find import.name (f exports) with
+  | exports -> (
+    match StringMap.find import.name (f exports) with
     | exception Not_found ->
       if StringSet.mem import.name exports.defined_names then
         Error `Incompatible_import_type
       else Error (`Unknown_import (import.modul, import.name))
-    | v -> Ok v )
+    | v -> Ok v )
 
 let load_global (ls : 'f state) (import : binary global_type Imported.t) :
   global Result.t =
-  let* global = load_from_module ls (fun (e : exports) -> e.globals) import in
-  let* () =
-    match (fst import.desc, global.mut) with
+  let* global = load_from_module ls (fun (e : exports) -> e.globals) import in
+  let* () =
+    match (fst import.desc, global.mut) with
     | Var, Const | Const, Var -> Error `Incompatible_import_type
-    | Const, Const | Var, Var -> Ok ()
+    | Const, Const | Var, Var -> Ok ()
   in
-  if snd import.desc <> global.typ then begin
+  if not @@ Types.val_type_eq (snd import.desc) global.typ then begin
     Error `Incompatible_import_type
   end
-  else Ok global
+  else Ok global
 
 module Eval_const = struct
-  module Stack = Stack.Make (V) [@@inlined hint]
+  module Stack = Stack.Make [@inlined hint] (V)
 
   (* TODO: const ibinop *)
   let ibinop stack nn (op : ibinop) =
-    match nn with
-    | S32 ->
+    match nn with
+    | S32 ->
       let (n1, n2), stack = Stack.pop2_i32 stack in
-      Stack.push_i32 stack
+      Stack.push_i32 stack
         (let open Int32 in
          match op with
-         | Add -> add n1 n2
-         | Sub -> sub n1 n2
-         | Mul -> mul n1 n2
+         | Add -> add n1 n2
+         | Sub -> sub n1 n2
+         | Mul -> mul n1 n2
          | _ -> assert false )
-    | S64 ->
+    | S64 ->
       let (n1, n2), stack = Stack.pop2_i64 stack in
-      Stack.push_i64 stack
+      Stack.push_i64 stack
         (let open Int64 in
          match op with
-         | Add -> add n1 n2
-         | Sub -> sub n1 n2
-         | Mul -> mul n1 n2
+         | Add -> add n1 n2
+         | Sub -> sub n1 n2
+         | Mul -> mul n1 n2
          | _ -> assert false )
 
   (* TODO: binary+const instr *)
   let instr env stack instr =
-    match instr with
-    | I32_const n -> ok @@ Stack.push_i32 stack n
-    | I64_const n -> ok @@ Stack.push_i64 stack n
-    | F32_const f -> ok @@ Stack.push_f32 stack f
-    | F64_const f -> ok @@ Stack.push_f64 stack f
-    | I_binop (nn, op) -> ok @@ ibinop stack nn op
-    | Ref_null t -> ok @@ Stack.push stack (Concrete_value.ref_null t)
-    | Ref_func (Raw f) ->
-      let* f = Link_env.Build.get_func env f in
-      let value = Concrete_value.Ref (Funcref (Some f)) in
-      ok @@ Stack.push stack value
-    | Global_get (Raw id) ->
-      let* g = Link_env.Build.get_const_global env id in
-      ok @@ Stack.push stack g
+    match instr with
+    | I32_const n -> ok @@ Stack.push_i32 stack n
+    | I64_const n -> ok @@ Stack.push_i64 stack n
+    | F32_const f -> ok @@ Stack.push_f32 stack f
+    | F64_const f -> ok @@ Stack.push_f64 stack f
+    | I_binop (nn, op) -> ok @@ ibinop stack nn op
+    | Ref_null t -> ok @@ Stack.push stack (Concrete_value.ref_null t)
+    | Ref_func (Raw f) ->
+      let* f = Link_env.Build.get_func env f in
+      let value = Concrete_value.Ref (Funcref (Some f)) in
+      ok @@ Stack.push stack value
+    | Global_get (Raw id) ->
+      let* g = Link_env.Build.get_const_global env id in
+      ok @@ Stack.push stack g
     | Array_new _i ->
       let len, stack = Stack.pop_i32 stack in
       let len = Int32.to_int len in
@@ -1081,38 +1053,38 @@ 
85.29%

       let len = Int32.to_int len in
       let a = Array.init len (fun _i -> ()) in
       ok @@ Stack.push_array stack a
-    | Ref_i31 ->
+    | Ref_i31 ->
       (* TODO *)
       ok stack
     | _ -> assert false
 
   (* TODO: binary+const expr *)
   let expr env e : Concrete_value.t Result.t =
-    let* stack = list_fold_left (instr env) Stack.empty e in
-    match stack with
+    let* stack = list_fold_left (instr env) Stack.empty e in
+    match stack with
     | [] -> Error (`Type_mismatch "const expr returning zero values")
     | _ :: _ :: _ ->
       Error (`Type_mismatch "const expr returning more than one value")
-    | [ result ] -> Ok result
+    | [ result ] -> Ok result
 end
 
 let eval_global ls env (global : (Binary.global, binary global_type) Runtime.t)
   : global Result.t =
-  match global with
-  | Local global ->
-    let* value = Eval_const.expr env global.init in
-    let mut, typ = global.typ in
+  match global with
+  | Local global ->
+    let* value = Eval_const.expr env global.init in
+    let mut, typ = global.typ in
     let global : global = { value; label = global.id; mut; typ } in
     Ok global
-  | Imported import -> load_global ls import
+  | Imported import -> load_global ls import
 
 let eval_globals ls env globals : Link_env.Build.t Result.t =
-  Named.fold
+  Named.fold
     (fun id global env ->
-      let* env in
-      let* global = eval_global ls env global in
-      let env = Link_env.Build.add_global id global env in
-      Ok env )
+      let* env in
+      let* global = eval_global ls env global in
+      let env = Link_env.Build.add_global id global env in
+      Ok env )
     globals (Ok env)
 
 (*
@@ -1128,97 +1100,89 @@ 
85.29%

 *)
 
 let limit_is_included ~import ~imported =
-  imported.min >= import.min
+  imported.min >= import.min
   &&
-  match (imported.max, import.max) with
-  | _, None -> true
+  match (imported.max, import.max) with
+  | _, None -> true
   | None, Some _ -> false
-  | Some i, Some j -> i <= j
+  | Some i, Some j -> i <= j
 
 let load_memory (ls : 'f state) (import : limits Imported.t) :
   Concrete_memory.t Result.t =
-  let* mem = load_from_module ls (fun (e : exports) -> e.memories) import in
-  let imported_limit = Concrete_memory.get_limits mem in
-  if limit_is_included ~import:import.desc ~imported:imported_limit then Ok mem
+  let* mem = load_from_module ls (fun (e : exports) -> e.memories) import in
+  let imported_limit = Concrete_memory.get_limits mem in
+  if limit_is_included ~import:import.desc ~imported:imported_limit then Ok mem
   else Error `Incompatible_import_type
 
 let eval_memory ls (memory : (mem, limits) Runtime.t) :
   Concrete_memory.t Result.t =
-  match memory with
-  | Local (_label, mem_type) -> ok @@ Concrete_memory.init mem_type
-  | Imported import -> load_memory ls import
+  match memory with
+  | Local (_label, mem_type) -> ok @@ Concrete_memory.init mem_type
+  | Imported import -> load_memory ls import
 
 let eval_memories ls env memories =
-  Named.fold
+  Named.fold
     (fun id mem env ->
-      let* env in
-      let* memory = eval_memory ls mem in
-      let env = Link_env.Build.add_memory id memory env in
-      Ok env )
+      let* env in
+      let* memory = eval_memory ls mem in
+      let env = Link_env.Build.add_memory id memory env in
+      Ok env )
     memories (Ok env)
 
 let table_types_are_compatible (import, (t1 : binary ref_type)) (imported, t2) =
-  limit_is_included ~import ~imported && t1 = t2
+  limit_is_included ~import ~imported && Types.ref_type_eq t1 t2
 
 let load_table (ls : 'f state) (import : binary table_type Imported.t) :
   table Result.t =
-  let typ : binary table_type = import.desc in
-  let* t = load_from_module ls (fun (e : exports) -> e.tables) import in
-  if table_types_are_compatible typ (t.limits, t.typ) then Ok t
+  let typ : binary table_type = import.desc in
+  let* t = load_from_module ls (fun (e : exports) -> e.tables) import in
+  if table_types_are_compatible typ (t.limits, t.typ) then Ok t
   else Error `Incompatible_import_type
 
 let eval_table ls (table : (_, binary table_type) Runtime.t) : table Result.t =
-  match table with
-  | Local (label, table_type) -> ok @@ Concrete_table.init ?label table_type
-  | Imported import -> load_table ls import
+  match table with
+  | Local (label, table_type) -> ok @@ Concrete_table.init ?label table_type
+  | Imported import -> load_table ls import
 
 let eval_tables ls env tables =
-  Named.fold
+  Named.fold
     (fun id table env ->
-      let* env in
-      let* table = eval_table ls table in
-      let env = Link_env.Build.add_table id table env in
-      Ok env )
+      let* env in
+      let* table = eval_table ls table in
+      let env = Link_env.Build.add_table id table env in
+      Ok env )
     tables (Ok env)
 
-let func_types_are_compatible a b =
-  (* TODO: copied from Simplify_bis.equal_func_types => should factorize *)
-  let remove_param (pt, rt) =
-    let pt = List.map (fun (_id, vt) -> (None, vt)) pt in
-    (pt, rt)
-  in
-  remove_param a = remove_param b
-
 let load_func (ls : 'f state) (import : binary block_type Imported.t) :
   func Result.t =
-  let (Bt_raw ((None | Some _), typ)) = import.desc in
-  let* func = load_from_module ls (fun (e : exports) -> e.functions) import in
-  let type' =
+  let (Bt_raw ((None | Some _), typ)) = import.desc in
+  let* func = load_from_module ls (fun (e : exports) -> e.functions) import in
+  let type' =
     match func with
     | Func_intf.WASM (_, func, _) ->
       let (Bt_raw ((None | Some _), t)) = func.type_f in
       t
-    | Extern func_id -> Func_id.get_typ func_id ls.collection
+    | Extern func_id -> Func_id.get_typ func_id ls.collection
   in
-  if func_types_are_compatible typ type' then Ok func
+  if Types.func_type_eq typ type' then Ok func
   else Error `Incompatible_import_type
 
 let eval_func ls (finished_env : Link_env.t') func : func Result.t =
-  match func with
-  | Runtime.Local func -> ok @@ Concrete_value.Func.wasm func finished_env
-  | Imported import -> load_func ls import
+  match func with
+  | Runtime.Local func -> ok @@ Concrete_value.Func.wasm func finished_env
+  | Imported import -> load_func ls import
 
 let eval_functions ls (finished_env : Link_env.t') env functions =
-  Named.fold
+  Named.fold
     (fun id func env ->
-      let* env in
-      let* func = eval_func ls finished_env func in
-      let env = Link_env.Build.add_func id func env in
-      Ok env )
+      let* env in
+      let* func = eval_func ls finished_env func in
+      let env = Link_env.Build.add_func id func env in
+      Ok env )
     functions (Ok env)
 
 let active_elem_expr ~offset ~length ~table ~elem =
-  [ I32_const offset
+  [ I32_const offset
   ; I32_const 0l
   ; I32_const length
   ; Table_init (Raw table, Raw elem)
@@ -1226,9 +1190,9 @@ 
85.29%

   ]
 
 let active_data_expr ~offset ~length ~mem ~data =
-  if mem <> 0 then Error (`Unknown_memory mem)
+  if mem <> 0 then Error (`Unknown_memory (Raw mem))
   else
-    Ok
+    Ok
       [ I32_const offset
       ; I32_const 0l
       ; I32_const length
@@ -1237,144 +1201,143 @@ 
85.29%

       ]
 
 let get_i32 = function
-  | Concrete_value.I32 i -> Ok i
-  | _ -> Error (`Type_mismatch "get_i32")
+  | Concrete_value.I32 i -> Ok i
+  | _ -> Error (`Type_mismatch "get_i32")
 
 let define_data env data =
-  Named.fold
+  Named.fold
     (fun id (data : Binary.data) env_and_init ->
-      let* env, init = env_and_init in
-      let data' : Link_env.data = { value = data.init } in
+      let* env, init = env_and_init in
+      let data' : Link_env.data = { value = data.init } in
       let env = Link_env.Build.add_data id data' env in
-      let* init =
+      let* init =
         match data.mode with
-        | Data_active (None, _) -> assert false
-        | Data_active (Some mem, offset) ->
-          let* offset = Eval_const.expr env offset in
-          let length = Int32.of_int @@ String.length data.init in
-          let* offset = get_i32 offset in
-          let id = Raw id in
+        | Data_active (mem, offset) ->
+          let* offset = Eval_const.expr env offset in
+          let length = Int32.of_int @@ String.length data.init in
+          let* offset = get_i32 offset in
+          let id = Raw id in
           let* v = active_data_expr ~offset ~length ~mem ~data:id in
-          ok @@ (v :: init)
-        | Data_passive -> Ok init
+          ok @@ (v :: init)
+        | Data_passive -> Ok init
       in
-      Ok (env, init) )
+      Ok (env, init) )
     data
     (Ok (env, []))
 
 let define_elem env elem =
-  Named.fold
+  Named.fold
     (fun id (elem : Binary.elem) env_and_inits ->
-      let* env, inits = env_and_inits in
-      let* init = list_map (Eval_const.expr env) elem.init in
-      let* init_as_ref =
-        list_map
+      let* env, inits = env_and_inits in
+      let* init = list_map (Eval_const.expr env) elem.init in
+      let* init_as_ref =
+        list_map
           (fun v ->
-            match v with
-            | Concrete_value.Ref v -> Ok v
+            match v with
+            | Concrete_value.Ref v -> Ok v
             | _ -> Error `Constant_expression_required )
           init
       in
-      let env =
+      let env =
         match elem.mode with
-        | Elem_active _ | Elem_passive ->
-          Link_env.Build.add_elem id { value = Array.of_list init_as_ref } env
-        | Elem_declarative ->
+        | Elem_active _ | Elem_passive ->
+          Link_env.Build.add_elem id { value = Array.of_list init_as_ref } env
+        | Elem_declarative ->
           (* Declarative element have no runtime value *)
-          Link_env.Build.add_elem id { value = [||] } env
+          Link_env.Build.add_elem id { value = [||] } env
       in
       let* inits =
         match elem.mode with
         | Elem_active (None, _) -> assert false
-        | Elem_active (Some table, offset) ->
-          let length = Int32.of_int @@ List.length init in
-          let* offset = Eval_const.expr env offset in
-          let* offset = get_i32 offset in
-          ok @@ (active_elem_expr ~offset ~length ~table ~elem:id :: inits)
-        | Elem_passive | Elem_declarative -> Ok inits
+        | Elem_active (Some table, offset) ->
+          let length = Int32.of_int @@ List.length init in
+          let* offset = Eval_const.expr env offset in
+          let* offset = get_i32 offset in
+          ok @@ (active_elem_expr ~offset ~length ~table ~elem:id :: inits)
+        | Elem_passive | Elem_declarative -> Ok inits
       in
-      Ok (env, inits) )
+      Ok (env, inits) )
     elem
     (Ok (env, []))
 
 let populate_exports env (exports : Binary.exports) : exports Result.t =
-  let fill_exports get_env exports names =
-    list_fold_left
+  let fill_exports get_env exports names =
+    list_fold_left
       (fun (acc, names) (export : Binary.export) ->
-        let value = get_env env export.id in
-        if StringSet.mem export.name names then Error `Duplicate_export_name
+        let value = get_env env export.id in
+        if StringSet.mem export.name names then Error `Duplicate_export_name
         else
-          Ok
-            ( StringMap.add export.name value acc
-            , StringSet.add export.name names ) )
+          Ok
+            ( StringMap.add export.name value acc
+            , StringSet.add export.name names ) )
       (StringMap.empty, names) exports
   in
   let names = StringSet.empty in
-  let* globals, names = fill_exports Link_env.get_global exports.global names in
-  let* memories, names = fill_exports Link_env.get_memory exports.mem names in
-  let* tables, names = fill_exports Link_env.get_table exports.table names in
-  let* functions, names = fill_exports Link_env.get_func exports.func names in
-  Ok { globals; memories; tables; functions; defined_names = names }
+  let* globals, names = fill_exports Link_env.get_global exports.global names in
+  let* memories, names = fill_exports Link_env.get_memory exports.mem names in
+  let* tables, names = fill_exports Link_env.get_table exports.table names in
+  let* functions, names = fill_exports Link_env.get_func exports.func names in
+  Ok { globals; memories; tables; functions; defined_names = names }
 
 let modul (ls : 'f state) ~name (modul : Binary.modul) =
-  Log.debug0 "linking      ...@\n";
-  let* envs, (env, init_active_data, init_active_elem) =
-    Env_id.with_fresh_id
+  Log.debug0 "linking      ...@\n";
+  let* envs, (env, init_active_data, init_active_elem) =
+    Env_id.with_fresh_id
       (fun env_id ->
-        let env = Link_env.Build.empty in
-        let* env = eval_functions ls env_id env modul.func in
-        let* env = eval_globals ls env modul.global in
-        let* env = eval_memories ls env modul.mem in
-        let* env = eval_tables ls env modul.table in
-        let* env, init_active_data = define_data env modul.data in
-        let+ env, init_active_elem = define_elem env modul.elem in
-        let finished_env = Link_env.freeze env_id env ls.collection in
-        (finished_env, (finished_env, init_active_data, init_active_elem)) )
+        let env = Link_env.Build.empty in
+        let* env = eval_functions ls env_id env modul.func in
+        let* env = eval_globals ls env modul.global in
+        let* env = eval_memories ls env modul.mem in
+        let* env = eval_tables ls env modul.table in
+        let* env, init_active_data = define_data env modul.data in
+        let+ env, init_active_elem = define_elem env modul.elem in
+        let finished_env = Link_env.freeze env_id env ls.collection in
+        (finished_env, (finished_env, init_active_data, init_active_elem)) )
       ls.envs
   in
-  let* by_id_exports = populate_exports env modul.exports in
-  let by_id =
+  let* by_id_exports = populate_exports env modul.exports in
+  let by_id =
     match modul.id with
-    | None -> ls.by_id
-    | Some id -> StringMap.add id (by_id_exports, Link_env.id env) ls.by_id
+    | None -> ls.by_id
+    | Some id -> StringMap.add id (by_id_exports, Link_env.id env) ls.by_id
   in
   let by_name =
     match name with
-    | None -> ls.by_name
+    | None -> ls.by_name
     | Some name -> StringMap.add name by_id_exports ls.by_name
   in
   let start =
-    Option.map (fun start_id -> [ Call (Raw start_id) ]) modul.start
+    Option.map (fun start_id -> [ Call (Raw start_id) ]) modul.start
   in
-  let start = Option.fold ~none:[] ~some:(fun s -> [ s ]) start in
-  let to_run = (init_active_data @ init_active_elem) @ start in
+  let start = Option.fold ~none:[] ~some:(fun s -> [ s ]) start in
+  let to_run = (init_active_data @ init_active_elem) @ start in
   let module_to_run = { modul; env; to_run } in
   Ok
     ( module_to_run
     , { by_id
       ; by_name
-      ; last = Some (by_id_exports, Link_env.id env)
+      ; last = Some (by_id_exports, Link_env.id env)
       ; collection = ls.collection
       ; envs
       } )
 
 let extern_module' (ls : 'f state) ~name ~(func_typ : 'f -> binary func_type)
   (module_ : 'f extern_module) =
-  let functions, collection =
+  let functions, collection =
     List.fold_left
       (fun (functions, collection) (name, func) ->
-        let typ = func_typ func in
-        let id, collection = Func_id.add func typ collection in
-        ((name, Func_intf.Extern id) :: functions, collection) )
+        let typ = func_typ func in
+        let id, collection = Func_id.add func typ collection in
+        ((name, Func_intf.Extern id) :: functions, collection) )
       ([], ls.collection) module_.functions
   in
-  let functions = StringMap.of_seq (List.to_seq functions) in
-  let defined_names =
+  let functions = StringMap.of_seq (List.to_seq functions) in
+  let defined_names =
     StringMap.fold
-      (fun name _ set -> StringSet.add name set)
+      (fun name _ set -> StringSet.add name set)
       functions StringSet.empty
   in
-  let exports =
+  let exports =
     { functions
     ; globals = StringMap.empty
     ; memories = StringMap.empty
@@ -1382,24 +1345,24 @@ 
85.29%

     ; defined_names
     }
   in
-  { ls with by_name = StringMap.add name exports ls.by_name; collection }
+  { ls with by_name = StringMap.add name exports ls.by_name; collection }
 
 let extern_module ls ~name modul =
-  extern_module' ls ~name ~func_typ:Concrete_value.Func.extern_type modul
+  extern_module' ls ~name ~func_typ:Concrete_value.Func.extern_type modul
 
 let register_module (ls : 'f state) ~name ~(id : string option) :
   'f state Result.t =
-  let* exports, _env_id =
+  let* exports, _env_id =
     match id with
-    | Some id -> begin
+    | Some id -> begin
       match StringMap.find_opt id ls.by_id with
       | None -> Error (`Unbound_module id)
-      | Some e -> Ok e
+      | Some e -> Ok e
     end
     | None -> (
       match ls.last with Some e -> Ok e | None -> Error `Unbound_last_module )
   in
-  Ok { ls with by_name = StringMap.add name exports ls.by_name }
+  Ok { ls with by_name = StringMap.add name exports ls.by_name }
 
 type extern_func = Concrete_value.Func.extern_func Func_id.collection
diff --git a/coverage/src/link/link_env.ml.html b/coverage/src/link/link_env.ml.html index 5afd35046..904926add 100644 --- a/coverage/src/link/link_env.ml.html +++ b/coverage/src/link/link_env.ml.html @@ -3,7 +3,7 @@ link_env.ml — Coverage report - + @@ -15,12 +15,16 @@

src/link/link_env.ml

-

91.18%

+

87.72%

@@ -56,72 +60,72 @@

91.18%

- + - + - + - + - + - - + + - + - - + + - - - + + + - + - - + + - - + + - - - - + + + + - - - - - - - + + + + + + + - + - - - - + + + + - - - + + + @@ -132,36 +136,36 @@

91.18%

- + - + - + - + - + - + - - - + + + - - - - + + + + - - - + + + @@ -172,7 +176,47 @@

91.18%

- + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
@@ -325,6 +369,46 @@

91.18%

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 
(* SPDX-License-Identifier: AGPL-3.0-or-later *)
 (* Copyright © 2021-2024 OCamlPro *)
@@ -336,11 +420,11 @@ 
91.18%

 
 type data = { mutable value : string }
 
-let drop_data data = data.value <- ""
+let drop_data data = data.value <- ""
 
 type elem = { mutable value : Concrete_value.ref_value array }
 
-let drop_elem (elem : elem) = elem.value <- [||]
+let drop_elem (elem : elem) = elem.value <- [||]
 
 type extern_funcs = Concrete_value.Func.extern_func Func_id.collection
 
@@ -357,21 +441,61 @@ 
91.18%

   ; id : Env_id.t
   }
 
-let id (env : _ t) = env.id
+type 'ext backup = 'ext t
 
-let get_global (env : _ t) id = IMap.find id env.globals
+let backup_data (data : data) : data = { value = data.value }
 
-let get_memory (env : _ t) id = IMap.find id env.memories
+let backup_elem (elem : elem) : elem = { value = elem.value }
 
-let get_table (env : _ t) id = IMap.find id env.tables
+let recover_data ~(from_ : data) ~(to_ : data) = to_.value <- from_.value
 
-let get_func (env : _ t) id = IMap.find id env.functions
+let recover_elem ~(from_ : elem) ~(to_ : elem) = to_.value <- from_.value
 
-let get_data (env : _ t) id = IMap.find id env.data
+let backup t =
+  { t with
+    globals = IMap.map Concrete_global.backup t.globals
+  ; memories = IMap.map Concrete_memory.backup t.memories
+  ; tables = IMap.map Concrete_table.backup t.tables
+  ; data = IMap.map backup_data t.data
+  ; elem = IMap.map backup_elem t.elem
+  }
+
+let recover backup into =
+  let apply f _key v1 v2 =
+    match (v1, v2) with
+    | Some v1, Some v2 ->
+      f ~from_:v1 ~to_:v2;
+      None
+    | _ -> assert false
+  in
+  let _ : _ IMap.t =
+    IMap.merge (apply Concrete_global.recover) backup.globals into.globals
+  in
+  let _ : _ IMap.t =
+    IMap.merge (apply Concrete_memory.recover) backup.memories into.memories
+  in
+  let _ : _ IMap.t =
+    IMap.merge (apply Concrete_table.recover) backup.tables into.tables
+  in
+  let _ : _ IMap.t = IMap.merge (apply recover_data) backup.data into.data in
+  let _ : _ IMap.t = IMap.merge (apply recover_elem) backup.elem into.elem in
+  ()
+
+let id (env : _ t) = env.id
+
+let get_global (env : _ t) id = IMap.find id env.globals
+
+let get_memory (env : _ t) id = IMap.find id env.memories
+
+let get_table (env : _ t) id = IMap.find id env.tables
+
+let get_func (env : _ t) id = IMap.find id env.functions
+
+let get_data (env : _ t) id = IMap.find id env.data
 
-let get_elem (env : _ t) id = IMap.find id env.elem
+let get_elem (env : _ t) id = IMap.find id env.elem
 
-let get_extern_func env id = Func_id.get id env.extern_funcs
+let get_extern_func env id = Func_id.get id env.extern_funcs
 
 module Build = struct
   type t =
@@ -393,36 +517,36 @@ 
91.18%

     }
 
   let add_global id const (env : t) =
-    { env with globals = IMap.add id const env.globals }
+    { env with globals = IMap.add id const env.globals }
 
   let add_memory id mem (env : t) =
-    { env with memories = IMap.add id mem env.memories }
+    { env with memories = IMap.add id mem env.memories }
 
   let add_table id table (env : t) =
-    { env with tables = IMap.add id table env.tables }
+    { env with tables = IMap.add id table env.tables }
 
   let add_func id func (env : t) =
-    { env with functions = IMap.add id func env.functions }
+    { env with functions = IMap.add id func env.functions }
 
-  let add_data id data (env : t) = { env with data = IMap.add id data env.data }
+  let add_data id data (env : t) = { env with data = IMap.add id data env.data }
 
-  let add_elem id elem (env : t) = { env with elem = IMap.add id elem env.elem }
+  let add_elem id elem (env : t) = { env with elem = IMap.add id elem env.elem }
 
   let get_global (env : t) id =
-    match IMap.find_opt id env.globals with
-    | None -> Error `Unknown_global
-    | Some v -> Ok v
+    match IMap.find_opt id env.globals with
+    | None -> Error (`Unknown_global (Raw id))
+    | Some v -> Ok v
 
   let get_const_global (env : t) id =
-    let* g = get_global env id in
-    match g.mut with
-    | Const -> ok g.value
+    let* g = get_global env id in
+    match g.mut with
+    | Const -> ok g.value
     | Var -> Error `Constant_expression_required
 
   let get_func (env : t) id =
-    match IMap.find_opt id env.functions with
-    | None -> Error (`Unknown_function id)
-    | Some v -> Ok v
+    match IMap.find_opt id env.functions with
+    | None -> Error (`Unknown_func (Raw id))
+    | Some v -> Ok v
 end
 
 module type T = sig
@@ -456,7 +580,7 @@ 
91.18%

 
   val get_func_typ : t -> func -> binary func_type
 
-  val pp : Format.formatter -> t -> unit
+  val pp : Fmt.formatter -> t -> unit
 
   val freeze : Build.t -> extern_func Func_id.collection -> t
 end
@@ -473,7 +597,7 @@ 
91.18%

 
 let freeze id ({ globals; memories; tables; functions; data; elem } : Build.t)
   extern_funcs =
-  { id; globals; memories; tables; functions; data; elem; extern_funcs }
+  { id; globals; memories; tables; functions; data; elem; extern_funcs }
diff --git a/coverage/src/optimize/optimize.ml.html b/coverage/src/optimize/optimize.ml.html index 41ded49bb..9e4652c68 100644 --- a/coverage/src/optimize/optimize.ml.html +++ b/coverage/src/optimize/optimize.ml.html @@ -1134,7 +1134,7 @@

86.41%

open Types let rec optimize_expr expr : bool * binary instr list = - match expr with + match expr with | ((I32_const _ | I64_const _) as x) :: ((I32_const _ | I64_const _) as y) :: (I_binop (nn, op) as i_binop) @@ -1202,17 +1202,17 @@

86.41%

(true, e) | _ -> assert false end - | ((I32_const _ | I64_const _) as x) :: I_testop (nn, op) :: tl -> + | ((I32_const _ | I64_const _) as x) :: I_testop (nn, op) :: tl -> let result = - Interpret.Concrete.exec_itestop [ Concrete_value.of_instr x ] nn op + Interpret.Concrete.exec_itestop [ Concrete_value.of_instr x ] nn op in - begin + begin match result with - | [ (I32 _ as result) ] -> + | [ (I32 _ as result) ] -> let _has_changed, e = - optimize_expr (Concrete_value.to_instr result :: tl) + optimize_expr (Concrete_value.to_instr result :: tl) in - (true, e) + (true, e) | _ -> assert false end | ((I32_const _ | I64_const _) as x) @@ -1354,14 +1354,14 @@

86.41%

(true, e) | _ -> assert false end - | ((F32_const _ | F64_const _) as x) :: I_reinterpret_f (nn, nn') :: tl -> + | ((F32_const _ | F64_const _) as x) :: I_reinterpret_f (nn, nn') :: tl -> let result = - Interpret.Concrete.exec_ireinterpretf [ Concrete_value.of_instr x ] nn nn' + Interpret.Concrete.exec_ireinterpretf [ Concrete_value.of_instr x ] nn nn' in - begin + begin match result with - | [ ((I32 _ | I64 _) as result) ] -> - optimize_expr (Concrete_value.to_instr result :: tl) + | [ ((I32 _ | I64 _) as result) ] -> + optimize_expr (Concrete_value.to_instr result :: tl) | _ -> assert false end | ((I32_const _ | I64_const _) as x) :: F_reinterpret_i (nn, nn') :: tl -> @@ -1380,8 +1380,8 @@

86.41%

| (I32_const _ | I64_const _ | F32_const _ | F64_const _) :: Drop :: tl -> let _has_changed, e = optimize_expr tl in (true, e) - | Local_set x :: Local_get y :: tl when x = y -> - let _has_changed, e = optimize_expr (Local_tee x :: tl) in + | Local_set (Raw x) :: Local_get (Raw y) :: tl when x = y -> + let _has_changed, e = optimize_expr (Local_tee (Raw x) :: tl) in (true, e) | Local_get _ :: Drop :: tl -> let _has_changed, e = optimize_expr tl in @@ -1389,7 +1389,7 @@

86.41%

| Global_get _ :: Drop :: tl -> let _has_changed, e = optimize_expr tl in (true, e) - | (Br _ as br) :: _ :: _ -> (true, [ br ]) + | (Br _ as br) :: _ :: _ -> (true, [ br ]) | I32_const c :: Br_if l :: tl -> begin match c with | 0l -> @@ -1403,9 +1403,9 @@

86.41%

| Ref_null _ :: Ref_is_null :: tl -> let _has_changed, e = optimize_expr (I32_const 1l :: tl) in (true, e) - | Nop :: tl -> + | Nop :: tl -> let _has_changed, e = optimize_expr tl in - (true, e) + (true, e) | ((I32_const _ | I64_const _ | F32_const _ | F64_const _) as v1) :: ((I32_const _ | I64_const _ | F32_const _ | F64_const _) as v2) :: I32_const c @@ -1417,14 +1417,14 @@

86.41%

in (true, e) end - | Block (n, bt, e) :: tl -> begin + | Block (n, bt, e) :: tl -> begin match optimize_expr e with - | has_changed, [] -> + | has_changed, [] -> let has_changed', e = optimize_expr tl in - (has_changed || has_changed', e) - | has_changed, oe -> + (has_changed || has_changed', e) + | has_changed, oe -> let has_changed', e = optimize_expr tl in - (has_changed || has_changed', Block (n, bt, oe) :: e) + (has_changed || has_changed', Block (n, bt, oe) :: e) end | Loop (n, bt, e) :: tl -> begin match optimize_expr e with @@ -1435,9 +1435,9 @@

86.41%

let has_changed', e = optimize_expr tl in (has_changed || has_changed', Loop (n, bt, oe) :: e) end - | I32_const 0l :: If_else (n, bt, _e1, e2) :: tl -> + | I32_const 0l :: If_else (n, bt, _e1, e2) :: tl -> let _has_changed, e = optimize_expr (Block (n, bt, e2) :: tl) in - (true, e) + (true, e) | I32_const _ :: If_else (n, bt, e1, _e2) :: tl -> let _has_changed, e = optimize_expr (Block (n, bt, e1) :: tl) in (true, e) @@ -1453,49 +1453,49 @@

86.41%

( has_changed1 || has_changed2 || has_changed' , If_else (n, bt, oe1, oe2) :: e ) end - | hd :: tl -> + | hd :: tl -> let has_changed, e = optimize_expr tl in - (has_changed, hd :: e) - | [] -> (false, []) + (has_changed, hd :: e) + | [] -> (false, []) let locals_func (body_expr : binary expr) = - let locals_hashtbl = Hashtbl.create 16 in - let rec aux_instr (instr : binary instr) = - match instr with - | Local_get ind | Local_set ind | Local_tee ind -> + let locals_hashtbl = Hashtbl.create 16 in + let rec aux_instr (instr : binary instr) = + match instr with + | Local_get ind | Local_set ind | Local_tee ind -> Hashtbl.replace locals_hashtbl ind () - | Block (_, _, e) -> aux_expr e + | Block (_, _, e) -> aux_expr e | Loop (_, _, e) -> aux_expr e | If_else (_, _, e1, e2) -> aux_expr e1; aux_expr e2 | I64_extend32_s | I32_wrap_i64 | F32_demote_f64 | F64_promote_f32 | Ref_is_null | Ref_as_non_null | Ref_eq | Drop | Memory_size | Memory_grow - | Memory_fill | Memory_copy | Nop | Unreachable | Return | Array_len + | Memory_fill | Memory_copy | Nop | Unreachable | Return | Array_len | I31_get_u | I31_get_s | Ref_i31 | Extern_externalize | Extern_internalize - | I32_const _ | I64_const _ | F32_const _ | F64_const _ + | I32_const _ | I64_const _ | F32_const _ | F64_const _ | I_unop (_, _) | F_unop (_, _) - | I_binop (_, _) + | I_binop (_, _) | F_binop (_, _) | I_testop (_, _) | I_relop (_, _) | F_relop (_, _) | I_extend8_s _ | I_extend16_s _ | I64_extend_i32 _ | I_trunc_f (_, _, _) - | I_trunc_sat_f (_, _, _) + | I_trunc_sat_f (_, _, _) | F_convert_i (_, _, _) | I_reinterpret_f (_, _) | F_reinterpret_i (_, _) | Ref_null _ | Ref_func _ | Ref_cast (_, _) | Ref_test (_, _) - | Select _ | Global_get _ | Global_set _ | Table_get _ | Table_set _ - | Table_size _ | Table_grow _ | Table_fill _ + | Select _ | Global_get _ | Global_set _ | Table_get _ | Table_set _ + | Table_size _ | Table_grow _ | Table_fill _ | Table_copy (_, _) | Table_init (_, _) | Elem_drop _ - | I_load (_, _) + | I_load (_, _) | F_load (_, _) | I_store (_, _) | F_store (_, _) @@ -1504,14 +1504,14 @@

86.41%

| I64_load32 (_, _) | I_store8 (_, _) | I_store16 (_, _) - | I64_store32 _ | Memory_init _ | Data_drop _ | Br _ | Br_if _ - | Br_table (_, _) + | I64_store32 _ | Memory_init _ | Data_drop _ | Br _ | Br_if _ + | Br_table (_, _) | Br_on_cast (_, _, _) | Br_on_cast_fail (_, _, _) | Br_on_non_null _ | Br_on_null _ | Return_call _ | Return_call_indirect (_, _) - | Call _ - | Call_indirect (_, _) + | Call _ + | Call_indirect (_, _) | Call_ref _ | Return_call_ref _ | Array_get _ | Array_get_u _ | Array_new _ | Array_new_data (_, _) | Array_new_default _ @@ -1523,50 +1523,50 @@

86.41%

| Struct_new _ | Struct_new_default _ | Struct_set (_, _) -> () - and aux_expr expr = List.iter aux_instr expr in + and aux_expr expr = List.iter aux_instr expr in aux_expr body_expr; - locals_hashtbl + locals_hashtbl let remove_local map body = - let new_x (Raw x : binary indice) = - let x = match Hashtbl.find_opt map x with None -> x | Some x -> x in + let new_x (Raw x : binary indice) = + let x = match Hashtbl.find_opt map x with None -> x | Some x -> x in Raw x in let rec aux_instr (instr : binary instr) : binary instr = - match instr with - | Local_get ind -> Local_get (new_x ind) + match instr with + | Local_get ind -> Local_get (new_x ind) | Local_set ind -> Local_set (new_x ind) | Local_tee ind -> Local_tee (new_x ind) - | Block (m, t, e) -> Block (m, t, aux_expr e) + | Block (m, t, e) -> Block (m, t, aux_expr e) | Loop (m, t, e) -> Loop (m, t, aux_expr e) | If_else (m, t, e1, e2) -> If_else (m, t, aux_expr e1, aux_expr e2) | I64_extend32_s | I32_wrap_i64 | F32_demote_f64 | F64_promote_f32 | Ref_is_null | Ref_as_non_null | Ref_eq | Drop | Memory_size | Memory_grow - | Memory_fill | Memory_copy | Nop | Unreachable | Return | Array_len + | Memory_fill | Memory_copy | Nop | Unreachable | Return | Array_len | I31_get_u | I31_get_s | Ref_i31 | Extern_externalize | Extern_internalize - | I32_const _ | I64_const _ | F32_const _ | F64_const _ + | I32_const _ | I64_const _ | F32_const _ | F64_const _ | I_unop (_, _) | F_unop (_, _) - | I_binop (_, _) + | I_binop (_, _) | F_binop (_, _) | I_testop (_, _) | I_relop (_, _) | F_relop (_, _) | I_extend8_s _ | I_extend16_s _ | I64_extend_i32 _ | I_trunc_f (_, _, _) - | I_trunc_sat_f (_, _, _) + | I_trunc_sat_f (_, _, _) | F_convert_i (_, _, _) | I_reinterpret_f (_, _) | F_reinterpret_i (_, _) | Ref_null _ | Ref_func _ | Ref_cast (_, _) | Ref_test (_, _) - | Select _ | Global_get _ | Global_set _ | Table_get _ | Table_set _ - | Table_size _ | Table_grow _ | Table_fill _ + | Select _ | Global_get _ | Global_set _ | Table_get _ | Table_set _ + | Table_size _ | Table_grow _ | Table_fill _ | Table_copy (_, _) | Table_init (_, _) | Elem_drop _ - | I_load (_, _) + | I_load (_, _) | F_load (_, _) | I_store (_, _) | F_store (_, _) @@ -1575,14 +1575,14 @@

86.41%

| I64_load32 (_, _) | I_store8 (_, _) | I_store16 (_, _) - | I64_store32 _ | Memory_init _ | Data_drop _ | Br _ | Br_if _ - | Br_table (_, _) + | I64_store32 _ | Memory_init _ | Data_drop _ | Br _ | Br_if _ + | Br_table (_, _) | Br_on_cast (_, _, _) | Br_on_cast_fail (_, _, _) | Br_on_non_null _ | Br_on_null _ | Return_call _ | Return_call_indirect (_, _) - | Call _ - | Call_indirect (_, _) + | Call _ + | Call_indirect (_, _) | Call_ref _ | Return_call_ref _ | Array_get _ | Array_get_u _ | Array_new _ | Array_new_data (_, _) | Array_new_default _ @@ -1594,17 +1594,17 @@

86.41%

| Struct_new _ | Struct_new_default _ | Struct_set (_, _) -> instr - and aux_expr expr = List.map aux_instr expr in + and aux_expr expr = List.map aux_instr expr in aux_expr body let remove_unused_locals locals nb_args body = - let unused_locals = + let unused_locals = let used_locals = locals_func body in - let locals = List.mapi (fun i _x -> Raw (nb_args + i)) locals in - List.filter (fun x -> not @@ Hashtbl.mem used_locals x) locals + let locals = List.mapi (fun i _x -> Raw (nb_args + i)) locals in + List.filter (fun x -> not @@ Hashtbl.mem used_locals x) locals in let rename_map = Hashtbl.create 16 in - List.iteri + List.iteri (fun j x -> let name, _ = x in let _x = Option.value name ~default:"anon" in @@ -1616,44 +1616,44 @@

86.41%

Hashtbl.replace rename_map (nb_args + j) (nb_args + j - !count) end ) locals; - let locals = List.mapi (fun i x -> (nb_args + i, x)) locals in - let locals = + let locals = List.mapi (fun i x -> (nb_args + i, x)) locals in + let locals = List.filter_map (fun (i, x) -> if List.mem (Raw i) unused_locals then None else Some x) locals in - let body = remove_local rename_map body in - (locals, body) + let body = remove_local rename_map body in + (locals, body) let optimize_func (func : binary func) = - let { type_f; locals; body; id } = func in + let { type_f; locals; body; id } = func in let rec loop has_changed e = - if not has_changed then + if not has_changed then (* TODO: it should be enough to return e directly, but doing one more call to optimize_expr seems to perform more optimizations... *) - snd @@ optimize_expr e + snd @@ optimize_expr e else - let has_changed, e = optimize_expr e in - loop has_changed e + let has_changed, e = optimize_expr e in + loop has_changed e in let body = loop true body in - let (Bt_raw ((None | Some _), (pt, _))) = type_f in + let (Bt_raw ((None | Some _), (pt, _))) = type_f in let nb_args = List.length pt in - let locals, body = remove_unused_locals locals nb_args body in - { type_f; locals; body; id } + let locals, body = remove_unused_locals locals nb_args body in + { type_f; locals; body; id } let optimize_runtime_func f = - Indexed.map + Indexed.map (function - | Runtime.Imported _ as f -> f - | Local f -> Runtime.Local (optimize_func f) ) + | Runtime.Imported _ as f -> f + | Local f -> Runtime.Local (optimize_func f) ) f -let optimize_funcs funs = Named.map optimize_runtime_func funs +let optimize_funcs funs = Named.map optimize_runtime_func funs let modul m = - Log.debug0 "optimizing ...@\n"; - let func = optimize_funcs m.func in - { m with func } + Log.debug0 "optimizing ...@\n"; + let func = optimize_funcs m.func in + { m with func }
diff --git a/coverage/src/parser/binary_parser.ml.html b/coverage/src/parser/binary_parser.ml.html index bb63216e3..caa692871 100644 --- a/coverage/src/parser/binary_parser.ml.html +++ b/coverage/src/parser/binary_parser.ml.html @@ -3,7 +3,7 @@ binary_parser.ml — Coverage report - + @@ -15,351 +15,278 @@

src/parser/binary_parser.ml

-

60.69%

+

71.32%

@@ -497,7 +424,7 @@

60.69%

- + @@ -515,27 +442,27 @@

60.69%

- - - + + + - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + @@ -552,72 +479,72 @@

60.69%

- + - - - - + + + + - - - - + + + + - - - + + + - + - + - + - - - + + + - + - + - - + + - + - + - + - + - - + + - - - + + + - - - + + + - + - + - + @@ -626,29 +553,29 @@

60.69%

- - + + - + - + - - + + - - - - - - + + + + + + - - + + @@ -681,63 +608,63 @@

60.69%

- - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + - - + + - - - - + + + + - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + - - - + + + - - + + - + @@ -747,57 +674,57 @@

60.69%

- - - + + + - - - + + + - - - - - - + + + + + + - - - - - - + + + + + + - - - - - - - - - + + + + + + + + + @@ -813,30 +740,30 @@

60.69%

- - - + + + - - - - - - + + + + + + - - - - - - - - - + + + + + + + + + @@ -846,18 +773,18 @@

60.69%

- - - + + + - + - - - + + + @@ -869,60 +796,60 @@

60.69%

- - - - - - - - - + + + + + + + + + - + - - + + - - - - - - - - - - + + + + + + + + + + - - + + - + - - - - - - - + + + + + + + - + @@ -937,16 +864,16 @@

60.69%

- + - + - + @@ -958,7 +885,7 @@

60.69%

- + @@ -967,8 +894,8 @@

60.69%

- - + + @@ -977,7 +904,7 @@

60.69%

- + @@ -993,58 +920,58 @@

60.69%

- + - - - - - - - + + + + + + + - + - - + + - - + + - - + + - - - + + + - + - + - - - - - + + + + + - - + + - - + + @@ -1052,142 +979,142 @@

60.69%

- + - - - + + + - + - - + + - + - + - + - - + + - - + + - + - - + + - - - - + + + + - + - + - - - - - - - + + + + + + + - - - - + + + + - - - - - - - - + + + + + + + + - - + + - - - - - - - - - - - - - + + + + + + + + + + + + + - + - - - - + + + + - - + + - + - + - + - - - - - - - - - - + + + + + + + + + + - + - - - - - + + + + + - + @@ -1197,152 +1124,152 @@

60.69%

- + - - - - - - - - - - - - - - + + + + + + + + + + + + + + - + - - - - + + + + - + - - + + - + - + - + - - + + - + - + - + - + - + - - - + + + - - + + - + - + - + - - - + + + - - - - + + + + - + - + - + - - - + + + - - - + + + - + - - - - - + + + + + - + - + - - - - + + + + - + - + - - - - + + + + - - - + + + - + - + - - + + - + - + - + @@ -1354,54 +1281,54 @@

60.69%

- + - + - + - + - - + + - + - + - + - + - - + + - - + + - + - + - + - - - - - - - + + + + + + + @@ -1409,24 +1336,24 @@

60.69%

- + - + - - - - + + + + - + - - + + - - + + @@ -1437,66 +1364,66 @@

60.69%

- - + + - + - - + + - + - + - - + + - - + + - - + + - - + + - - + + - - - - - - + + + + + + - + - - + + - + @@ -1507,63 +1434,103 @@

60.69%

- + - - + + - - + + - - + + - + - + - + - - - + + + - + - + - + - - - + + + - - + + - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
@@ -2768,6 +2735,46 @@

60.69%

1198 1199 1200 +1201 +1202 +1203 +1204 +1205 +1206 +1207 +1208 +1209 +1210 +1211 +1212 +1213 +1214 +1215 +1216 +1217 +1218 +1219 +1220 +1221 +1222 +1223 +1224 +1225 +1226 +1227 +1228 +1229 +1230 +1231 +1232 +1233 +1234 +1235 +1236 +1237 +1238 +1239 +1240 
(* SPDX-License-Identifier: AGPL-3.0-or-later *)
 (* Copyright © 2021-2024 OCamlPro *)
@@ -2803,188 +2810,189 @@ 
60.69%

     ; size : int
     }
 
-  let size s = s.size
+  let size s = s.size
 
-  let is_empty input = input.size = 0
+  let is_empty input = input.size = 0
 
   let of_string str =
-    let size = String.length str in
-    { bytes = str; pt = 0; size }
+    let size = String.length str in
+    { bytes = str; pt = 0; size }
 
   let sub ~pos ~len input =
-    if pos <= input.size && len <= input.size - pos then
-      Ok { input with pt = input.pt + pos; size = len }
-    else Error (`Msg (Format.sprintf "length out of bounds in section"))
+    if pos <= input.size && len <= input.size - pos then
+      Ok { input with pt = input.pt + pos; size = len }
+    else Error (`Msg (Fmt.str "length out of bounds in section"))
 
-  let sub_suffix pos input = sub ~pos ~len:(input.size - pos) input
+  let sub_suffix pos input = sub ~pos ~len:(input.size - pos) input
 
-  let sub_prefix len input = sub ~pos:0 ~len input
+  let sub_prefix len input = sub ~pos:0 ~len input
 
   let get n input =
-    if n < input.size then Some (String.get input.bytes (input.pt + n))
-    else None
+    if n < input.size then Some (String.get input.bytes (input.pt + n))
+    else None
 end
 
 let string_of_char_list char_list =
-  let buf = Buffer.create 64 in
-  List.iter (Buffer.add_char buf) char_list;
-  Buffer.contents buf
+  let buf = Buffer.create 64 in
+  List.iter (Buffer.add_char buf) char_list;
+  Buffer.contents buf
 
 let read_byte ~msg input =
-  match Input.get 0 input with
-  | None -> Error (`Msg msg)
-  | Some c ->
-    let+ next_input = Input.sub_suffix 1 input in
-    (c, next_input)
+  match Input.get 0 input with
+  | None -> Error (`Msg msg)
+  | Some c ->
+    let+ next_input = Input.sub_suffix 1 input in
+    (c, next_input)
 
 (* https://en.wikipedia.org/wiki/LEB128#Unsigned_LEB128 *)
 let read_UN n input =
-  let rec aux n input =
-    let* () =
-      if n <= 0 then Error (`Msg "integer representation too long") else Ok ()
+  let rec aux n input =
+    let* () =
+      if n <= 0 then Error (`Msg "integer representation too long") else Ok ()
     in
-    let* b, input = read_byte ~msg:"integer representation too long" input in
-    let b = Char.code b in
-    let* () =
-      if n >= 7 || b land 0x7f < 1 lsl n then Ok ()
-      else Error (`Msg "integer too large")
+    let* b, input = read_byte ~msg:"integer representation too long" input in
+    let b = Char.code b in
+    let* () =
+      if n >= 7 || b land 0x7f < 1 lsl n then Ok ()
+      else Error (`Msg "integer too large")
     in
-    let x = Int64.of_int (b land 0x7f) in
-    if b land 0x80 = 0 then Ok (x, input)
+    let x = Int64.of_int (b land 0x7f) in
+    if b land 0x80 = 0 then Ok (x, input)
     else
       (* TODO: make this tail-rec *)
-      let+ i64, input = aux (n - 7) input in
-      (Int64.logor x (Int64.shl i64 7L), input)
+      let+ i64, input = aux (n - 7) input in
+      (Int64.logor x (Int64.shl i64 7L), input)
   in
   aux n input
 
 let read_U32 input =
-  let+ i64, input = read_UN 32 input in
-  (Int64.to_int i64, input)
+  let+ i64, input = read_UN 32 input in
+  (Int64.to_int i64, input)
 
 (* https://en.wikipedia.org/wiki/LEB128#Signed_LEB128 *)
 let read_SN n input =
-  let rec aux n input =
-    let* () =
-      if n <= 0 then Error (`Msg "integer representation too long") else Ok ()
+  let rec aux n input =
+    let* () =
+      if n <= 0 then Error (`Msg "integer representation too long") else Ok ()
     in
-    let* b, input = read_byte ~msg:"integer representation too long" input in
-    let b = Char.code b in
-    let mask = (-1 lsl (n - 1)) land 0x7f in
+    let* b, input = read_byte ~msg:"integer representation too long" input in
+    let b = Char.code b in
+    let mask = (-1 lsl (n - 1)) land 0x7f in
     let* () =
-      if n >= 7 || b land mask = 0 || b land mask = mask then Ok ()
-      else Error (`Msg "integer too large")
+      if n >= 7 || b land mask = 0 || b land mask = mask then Ok ()
+      else Error (`Msg "integer too large")
     in
-    let x = Int64.of_int (b land 0x7f) in
-    if b land 0x80 = 0 then
-      let x =
-        if b land 0x40 = 0 then x else Int64.(logor x (logxor (-1L) 0x7fL))
+    let x = Int64.of_int (b land 0x7f) in
+    if b land 0x80 = 0 then
+      let x =
+        if b land 0x40 = 0 then x else Int64.(logor x (logxor (-1L) 0x7fL))
       in
       Ok (x, input)
     else
       (* TODO: make this tail-rec *)
-      let+ i64, input = aux (n - 7) input in
-      (Int64.logor x (Int64.shl i64 7L), input)
+      let+ i64, input = aux (n - 7) input in
+      (Int64.logor x (Int64.shl i64 7L), input)
   in
   aux n input
 
 let read_S7 input =
-  let+ i64, input = read_SN 7 input in
-  (Int64.to_int i64, input)
+  let+ i64, input = read_SN 7 input in
+  (Int64.to_int i64, input)
 
 let read_S32 input =
-  let+ i64, input = read_SN 32 input in
-  (Int64.to_int32 i64, input)
+  let+ i64, input = read_SN 32 input in
+  (Int64.to_int32 i64, input)
 
 let read_S33 input =
-  let+ i64, input = read_SN 33 input in
-  (i64, input)
+  let+ i64, input = read_SN 33 input in
+  (i64, input)
 
 let read_S64 input =
-  let+ i64, input = read_SN 64 input in
-  (i64, input)
+  let+ i64, input = read_SN 64 input in
+  (i64, input)
 
 let read_F32 input =
-  let i32_of_byte input =
-    let+ b, input = read_byte ~msg:"read_F32" input in
-    (Int32.of_int (int_of_char b), input)
+  let i32_of_byte input =
+    let+ b, input = read_byte ~msg:"read_F32" input in
+    (Int32.of_int (int_of_char b), input)
   in
-  let* i1, input = i32_of_byte input in
-  let* i2, input = i32_of_byte input in
-  let* i3, input = i32_of_byte input in
-  let+ i4, input = i32_of_byte input in
-  let i32 = Int32.shl i4 24l in
-  let i32 = Int32.logor i32 (Int32.shl i3 16l) in
-  let i32 = Int32.logor i32 (Int32.shl i2 8l) in
-  let i32 = Int32.logor i32 i1 in
-  (Float32.of_bits i32, input)
+  let* i1, input = i32_of_byte input in
+  let* i2, input = i32_of_byte input in
+  let* i3, input = i32_of_byte input in
+  let+ i4, input = i32_of_byte input in
+  let i32 = Int32.shl i4 24l in
+  let i32 = Int32.logor i32 (Int32.shl i3 16l) in
+  let i32 = Int32.logor i32 (Int32.shl i2 8l) in
+  let i32 = Int32.logor i32 i1 in
+  (Float32.of_bits i32, input)
 
 let read_F64 input =
-  let i64_of_byte input =
-    let+ b, input = read_byte ~msg:"read_F64" input in
-    (Int64.of_int (int_of_char b), input)
+  let i64_of_byte input =
+    let+ b, input = read_byte ~msg:"read_F64" input in
+    (Int64.of_int (int_of_char b), input)
   in
-  let* i1, input = i64_of_byte input in
-  let* i2, input = i64_of_byte input in
-  let* i3, input = i64_of_byte input in
-  let* i4, input = i64_of_byte input in
-  let* i5, input = i64_of_byte input in
-  let* i6, input = i64_of_byte input in
-  let* i7, input = i64_of_byte input in
-  let+ i8, input = i64_of_byte input in
-  let i64 = Int64.shl i8 56L in
-  let i64 = Int64.logor i64 (Int64.shl i7 48L) in
-  let i64 = Int64.logor i64 (Int64.shl i6 40L) in
-  let i64 = Int64.logor i64 (Int64.shl i5 32L) in
-  let i64 = Int64.logor i64 (Int64.shl i4 24L) in
-  let i64 = Int64.logor i64 (Int64.shl i3 16L) in
-  let i64 = Int64.logor i64 (Int64.shl i2 8L) in
-  let i64 = Int64.logor i64 i1 in
-  (Float64.of_bits i64, input)
+  let* i1, input = i64_of_byte input in
+  let* i2, input = i64_of_byte input in
+  let* i3, input = i64_of_byte input in
+  let* i4, input = i64_of_byte input in
+  let* i5, input = i64_of_byte input in
+  let* i6, input = i64_of_byte input in
+  let* i7, input = i64_of_byte input in
+  let+ i8, input = i64_of_byte input in
+  let i64 = Int64.shl i8 56L in
+  let i64 = Int64.logor i64 (Int64.shl i7 48L) in
+  let i64 = Int64.logor i64 (Int64.shl i6 40L) in
+  let i64 = Int64.logor i64 (Int64.shl i5 32L) in
+  let i64 = Int64.logor i64 (Int64.shl i4 24L) in
+  let i64 = Int64.logor i64 (Int64.shl i3 16L) in
+  let i64 = Int64.logor i64 (Int64.shl i2 8L) in
+  let i64 = Int64.logor i64 i1 in
+  (Float64.of_bits i64, input)
 
 let vector parse_elt input =
-  let* nb_elt, input = read_U32 input in
-  let rec loop loop_id input acc =
-    if nb_elt = loop_id then Ok (List.rev acc, input)
+  let* nb_elt, input = read_U32 input in
+  let rec loop loop_id input acc =
+    if nb_elt = loop_id then Ok (List.rev acc, input)
     else
-      let* acc_elt, input = parse_elt loop_id input in
-      let acc = acc_elt :: acc in
+      let* acc_elt, input = parse_elt loop_id input in
+      let acc = acc_elt :: acc in
       loop (loop_id + 1) input acc
   in
   loop 0 input []
 
-let vector_no_id f input = vector (fun _id -> f) input
+let vector_no_id f input = vector (fun _id -> f) input
 
-let check_end_opcode input =
-  let msg = "END opcode expected" in
-  match read_byte ~msg input with
-  | Ok ('\x0B', input) -> Ok input
-  | Ok (c, _input) ->
-    Error (`Msg (Format.sprintf "%s (got %s instead)" msg (Char.escaped c)))
+let check_end_opcode ?unexpected_eoi_msg input =
+  let msg = Option.value unexpected_eoi_msg ~default:"END opcode expected" in
+  match read_byte ~msg input with
+  | Ok ('\x0B', input) -> Ok input
+  | Ok (c, _input) ->
+    Error
+      (`Msg (Fmt.str "END opcode expected (got %s instead)" (Char.escaped c)))
   | Error _ as e -> e
 
 let check_zero_opcode input =
-  let msg = "zero byte expected" in
+  let msg = "zero byte expected" in
   match read_byte ~msg input with
-  | Ok ('\x00', input) -> Ok input
+  | Ok ('\x00', input) -> Ok input
   | Ok (c, _input) ->
-    Error (`Msg (Format.sprintf "%s (got %s instead)" msg (Char.escaped c)))
+    Error (`Msg (Fmt.str "%s (got %s instead)" msg (Char.escaped c)))
   | Error _ as e -> e
 
-let read_bytes ~msg input = vector_no_id (read_byte ~msg) input
+let read_bytes ~msg input = vector_no_id (read_byte ~msg) input
 
 let read_indice input : (Types.binary Types.indice * Input.t, _) result =
-  let+ indice, input = read_U32 input in
-  (Raw indice, input)
+  let+ indice, input = read_U32 input in
+  (Raw indice, input)
 
 let read_numtype input =
-  let* b, input = read_S7 input in
-  match b with
-  | -0x01 -> Ok (I32, input)
-  | -0x02 -> Ok (I64, input)
-  | -0x03 -> Ok (F32, input)
-  | -0x04 -> Ok (F64, input)
-  | b -> Error (`Msg (Format.sprintf "malformed number type: %d" b))
+  let* b, input = read_S7 input in
+  match b with
+  | -0x01 -> Ok (I32, input)
+  | -0x02 -> Ok (I64, input)
+  | -0x03 -> Ok (F32, input)
+  | -0x04 -> Ok (F64, input)
+  | b -> Error (`Msg (Fmt.str "malformed number type: %d" b))
 
 let read_vectype input =
   let* b, _input = read_S7 input in
@@ -2992,18 +3000,18 @@ 
60.69%

   | -0x05 ->
     (* V128 *)
     assert false
-  | b -> Error (`Msg (Format.sprintf "malformed vector type: %d" b))
+  | b -> Error (`Msg (Fmt.str "malformed vector type: %d" b))
 
 let read_reftype input =
-  let* b, input = read_S7 input in
-  match b with
-  | -0x10 -> Ok ((Null, Func_ht), input)
+  let* b, input = read_S7 input in
+  match b with
+  | -0x10 -> Ok ((Null, Func_ht), input)
   | -0x11 -> Ok ((Null, Extern_ht), input)
-  | b -> Error (`Msg (Format.sprintf "malformed reference type: %d" b))
+  | b -> Error (`Msg (Fmt.str "malformed reference type: %d" b))
 
 let read_valtype input =
-  match read_numtype input with
-  | Ok (t, input) -> Ok (Num_type t, input)
+  match read_numtype input with
+  | Ok (t, input) -> Ok (Num_type t, input)
   | Error _ -> (
     match read_vectype input with
     | Ok (_t, _input) -> assert false
@@ -3012,45 +3020,47 @@ 
60.69%

       | Ok (t, input) -> Ok (Ref_type t, input)
       | Error _ as e -> e ) )
 
-let read_valtypes input = vector_no_id read_valtype input
+let read_valtypes input = vector_no_id read_valtype input
 
 let read_mut input =
-  let* b, input = read_byte ~msg:"read_mut" input in
-  match b with
-  | '\x00' -> Ok (Const, input)
-  | '\x01' -> Ok (Var, input)
-  | _c -> Error (`Msg "malformed mutability")
+  let* b, input = read_byte ~msg:"read_mut" input in
+  match b with
+  | '\x00' -> Ok (Const, input)
+  | '\x01' -> Ok (Var, input)
+  | _c -> Error (`Msg "malformed mutability")
 
 let read_limits input =
-  let* b, input = read_byte ~msg:"read_limits" input in
-  match b with
-  | '\x00' ->
-    let+ min, input = read_U32 input in
-    ({ min; max = None }, input)
-  | '\x01' ->
-    let* min, input = read_U32 input in
-    let+ max, input = read_U32 input in
-    ({ min; max = Some max }, input)
+  let* b, input = read_byte ~msg:"read_limits" input in
+  match b with
+  | '\x00' ->
+    let+ min, input = read_U32 input in
+    ({ min; max = None }, input)
+  | '\x01' ->
+    let* min, input = read_U32 input in
+    let+ max, input = read_U32 input in
+    ({ min; max = Some max }, input)
   | _c -> Error (`Msg "integer too large (read_limits)")
 
-let read_memarg input =
-  let* align, input = read_U32 input in
-  let+ offset, input = read_U32 input in
-  let align = Int32.of_int align in
-  let offset = Int32.of_int offset in
-  ({ align; offset }, input)
+let read_memarg max_align input =
+  let* align, input = read_U32 input in
+  if align >= max_align then Error (`Msg "malformed memop flags")
+  else
+    let+ offset, input = read_U32 input in
+    let align = Int32.of_int align in
+    let offset = Int32.of_int offset in
+    ({ align; offset }, input)
 
 let read_FC input =
-  let* i, input = read_U32 input in
-  match i with
-  | 0 -> Ok (I_trunc_sat_f (S32, S32, S), input)
-  | 1 -> Ok (I_trunc_sat_f (S32, S32, U), input)
+  let* i, input = read_U32 input in
+  match i with
+  | 0 -> Ok (I_trunc_sat_f (S32, S32, S), input)
+  | 1 -> Ok (I_trunc_sat_f (S32, S32, U), input)
   | 2 -> Ok (I_trunc_sat_f (S32, S64, S), input)
   | 3 -> Ok (I_trunc_sat_f (S32, S64, U), input)
   | 4 -> Ok (I_trunc_sat_f (S64, S32, S), input)
   | 5 -> Ok (I_trunc_sat_f (S64, S32, U), input)
-  | 6 -> Ok (I_trunc_sat_f (S64, S64, S), input)
-  | 7 -> Ok (I_trunc_sat_f (S64, S64, U), input)
+  | 6 -> Ok (I_trunc_sat_f (S64, S64, S), input)
+  | 7 -> Ok (I_trunc_sat_f (S64, S64, U), input)
   | 8 ->
     let* dataidx, input = read_indice input in
     let+ input = check_zero_opcode input in
@@ -3085,195 +3095,201 @@ 
60.69%

   | 17 ->
     let+ tableidx, input = read_indice input in
     (Table_fill tableidx, input)
-  | i -> Error (`Msg (Format.sprintf "illegal opcode (1) %i" i))
+  | i -> Error (`Msg (Fmt.str "illegal opcode (1) %i" i))
+
+let block_type_of_rec_type t =
+  (* TODO: this is a ugly hack, it is necessary for now and should be removed at some point... *)
+  match t with
+  | [ (_id, (_final, _subtypes, Def_func_t (pt, rt))) ] ->
+    Bt_raw (None, (pt, rt))
+  | _ -> assert false
 
 let read_block_type types input =
-  match read_S33 input with
-  | Ok (i, input) when i >= 0L ->
-    let block_type = types.(Int64.to_int i) in
+  match read_S33 input with
+  | Ok (i, input) when Int64.ge i 0L ->
+    let block_type = block_type_of_rec_type types.(Int64.to_int i) in
     Ok (block_type, input)
-  | Error _ | Ok _ -> begin
+  | Error _ | Ok _ -> begin
     match read_byte ~msg:"read_block_type" input with
-    | Ok ('\x40', input) -> Ok (Bt_raw (None, ([], [])), input)
-    | Error _ | Ok _ ->
-      let* vt, input = read_valtype input in
-      let pt, rt = ([], [ vt ]) in
+    | Ok ('\x40', input) -> Ok (Bt_raw (None, ([], [])), input)
+    | Error _ | Ok _ ->
+      let* vt, input = read_valtype input in
+      let pt, rt = ([], [ vt ]) in
       Ok (Bt_raw (None, (pt, rt)), input)
   end
 
 let rec read_instr types input =
-  let old_input = input in
-  let* b, input = read_byte ~msg:"read_instr" input in
-  match b with
-  | '\x00' -> Ok (Unreachable, input)
-  | '\x01' -> Ok (Nop, input)
-  | '\x02' ->
-    let* bt, input = read_block_type types input in
-    let* expr, input = read_expr types input in
-    let+ input = check_end_opcode input in
-    (Block (None, Some bt, expr), input)
-  | '\x03' ->
-    let* bt, input = read_block_type types input in
-    let* expr, input = read_expr types input in
-    let+ input = check_end_opcode input in
-    (Loop (None, Some bt, expr), input)
-  | '\x04' ->
-    let* bt, input = read_block_type types input in
-    let* expr1, input = read_expr types input in
-    let* expr2, input =
+  let* b, input = read_byte ~msg:"read_instr" input in
+  match b with
+  | '\x00' -> Ok (Unreachable, input)
+  | '\x01' -> Ok (Nop, input)
+  | '\x02' ->
+    let* bt, input = read_block_type types input in
+    let* expr, input = read_expr types input in
+    let+ input = check_end_opcode input in
+    (Block (None, Some bt, expr), input)
+  | '\x03' ->
+    let* bt, input = read_block_type types input in
+    let* expr, input = read_expr types input in
+    let+ input = check_end_opcode input in
+    (Loop (None, Some bt, expr), input)
+  | '\x04' ->
+    let* bt, input = read_block_type types input in
+    let* expr1, input = read_expr types input in
+    let* expr2, input =
       begin
         match read_byte ~msg:"read_instr (0x04)" input with
-        | Ok ('\x05', input) -> read_expr types input
-        | Ok _ | Error _ -> Ok ([], input)
+        | Ok ('\x05', input) -> read_expr types input
+        | Ok _ | Error _ -> Ok ([], input)
       end
     in
-    let+ input = check_end_opcode input in
-    (If_else (None, Some bt, expr1, expr2), input)
+    let+ input = check_end_opcode input in
+    (If_else (None, Some bt, expr1, expr2), input)
   | '\x05' -> Error (`Msg "misplaced ELSE opcode")
   | '\x0B' -> Error (`Msg "misplaced END opcode")
-  | '\x0C' ->
-    let+ labelidx, input = read_indice input in
-    (Br labelidx, input)
-  | '\x0D' ->
-    let+ labelidx, input = read_indice input in
-    (Br_if labelidx, input)
-  | '\x0E' ->
-    let* xs, input = vector_no_id read_indice input in
-    let xs = Array.of_list xs in
-    let+ x, input = read_indice input in
-    (Br_table (xs, x), input)
-  | '\x0F' -> Ok (Return, input)
-  | '\x10' ->
-    let+ funcidx, input = read_indice input in
-    (Call funcidx, input)
-  | '\x11' ->
-    let* Raw typeidx, input = read_indice input in
-    let+ tableidx, input = read_indice input in
-    (Call_indirect (tableidx, types.(typeidx)), input)
-  | '\x1A' -> Ok (Drop, input)
-  | '\x1B' -> Ok (Select None, input)
+  | '\x0C' ->
+    let+ labelidx, input = read_indice input in
+    (Br labelidx, input)
+  | '\x0D' ->
+    let+ labelidx, input = read_indice input in
+    (Br_if labelidx, input)
+  | '\x0E' ->
+    let* xs, input = vector_no_id read_indice input in
+    let xs = Array.of_list xs in
+    let+ x, input = read_indice input in
+    (Br_table (xs, x), input)
+  | '\x0F' -> Ok (Return, input)
+  | '\x10' ->
+    let+ funcidx, input = read_indice input in
+    (Call funcidx, input)
+  | '\x11' ->
+    let* Raw typeidx, input = read_indice input in
+    let+ tableidx, input = read_indice input in
+    (Call_indirect (tableidx, block_type_of_rec_type types.(typeidx)), input)
+  | '\x1A' -> Ok (Drop, input)
+  | '\x1B' -> Ok (Select None, input)
   | '\x1C' ->
     let+ valtypes, input = read_valtypes input in
     (Select (Some valtypes), input)
-  | '\x20' ->
-    let+ localidx, input = read_indice input in
-    (Local_get localidx, input)
-  | '\x21' ->
-    let+ localidx, input = read_indice input in
-    (Local_set localidx, input)
-  | '\x22' ->
-    let+ localidx, input = read_indice input in
-    (Local_tee localidx, input)
-  | '\x23' ->
-    let+ globalidx, input = read_indice input in
-    (Global_get globalidx, input)
-  | '\x24' ->
-    let+ globalidx, input = read_indice input in
-    (Global_set globalidx, input)
+  | '\x20' ->
+    let+ localidx, input = read_indice input in
+    (Local_get localidx, input)
+  | '\x21' ->
+    let+ localidx, input = read_indice input in
+    (Local_set localidx, input)
+  | '\x22' ->
+    let+ localidx, input = read_indice input in
+    (Local_tee localidx, input)
+  | '\x23' ->
+    let+ globalidx, input = read_indice input in
+    (Global_get globalidx, input)
+  | '\x24' ->
+    let+ globalidx, input = read_indice input in
+    (Global_set globalidx, input)
   | '\x25' ->
     let+ tableidx, input = read_indice input in
     (Table_get tableidx, input)
   | '\x26' ->
     let+ tableidx, input = read_indice input in
     (Table_set tableidx, input)
-  | '\x28' ->
-    let+ memarg, input = read_memarg input in
-    (I_load (S32, memarg), input)
-  | '\x29' ->
-    let+ memarg, input = read_memarg input in
-    (I_load (S64, memarg), input)
-  | '\x2A' ->
-    let+ memarg, input = read_memarg input in
-    (F_load (S32, memarg), input)
-  | '\x2B' ->
-    let+ memarg, input = read_memarg input in
-    (F_load (S64, memarg), input)
+  | '\x28' ->
+    let+ memarg, input = read_memarg 32 input in
+    (I_load (S32, memarg), input)
+  | '\x29' ->
+    let+ memarg, input = read_memarg 64 input in
+    (I_load (S64, memarg), input)
+  | '\x2A' ->
+    let+ memarg, input = read_memarg 32 input in
+    (F_load (S32, memarg), input)
+  | '\x2B' ->
+    let+ memarg, input = read_memarg 64 input in
+    (F_load (S64, memarg), input)
   | '\x2C' ->
-    let+ memarg, input = read_memarg input in
+    let+ memarg, input = read_memarg 32 input in
     (I_load8 (S32, S, memarg), input)
-  | '\x2D' ->
-    let+ memarg, input = read_memarg input in
-    (I_load8 (S32, U, memarg), input)
+  | '\x2D' ->
+    let+ memarg, input = read_memarg 32 input in
+    (I_load8 (S32, U, memarg), input)
   | '\x2E' ->
-    let+ memarg, input = read_memarg input in
+    let+ memarg, input = read_memarg 32 input in
     (I_load16 (S32, S, memarg), input)
   | '\x2F' ->
-    let+ memarg, input = read_memarg input in
+    let+ memarg, input = read_memarg 32 input in
     (I_load16 (S32, U, memarg), input)
   | '\x30' ->
-    let+ memarg, input = read_memarg input in
+    let+ memarg, input = read_memarg 64 input in
     (I_load8 (S64, S, memarg), input)
   | '\x31' ->
-    let+ memarg, input = read_memarg input in
+    let+ memarg, input = read_memarg 64 input in
     (I_load8 (S64, U, memarg), input)
   | '\x32' ->
-    let+ memarg, input = read_memarg input in
+    let+ memarg, input = read_memarg 64 input in
     (I_load16 (S64, S, memarg), input)
   | '\x33' ->
-    let+ memarg, input = read_memarg input in
+    let+ memarg, input = read_memarg 64 input in
     (I_load16 (S64, U, memarg), input)
   | '\x34' ->
-    let+ memarg, input = read_memarg input in
+    let+ memarg, input = read_memarg 32 input in
     (I64_load32 (S, memarg), input)
   | '\x35' ->
-    let+ memarg, input = read_memarg input in
+    let+ memarg, input = read_memarg 32 input in
     (I64_load32 (U, memarg), input)
-  | '\x36' ->
-    let+ memarg, input = read_memarg input in
-    (I_store (S32, memarg), input)
-  | '\x37' ->
-    let+ memarg, input = read_memarg input in
-    (I_store (S64, memarg), input)
-  | '\x38' ->
-    let+ memarg, input = read_memarg input in
-    (F_store (S32, memarg), input)
-  | '\x39' ->
-    let+ memarg, input = read_memarg input in
-    (F_store (S64, memarg), input)
-  | '\x3A' ->
-    let+ memarg, input = read_memarg input in
-    (I_store8 (S32, memarg), input)
+  | '\x36' ->
+    let+ memarg, input = read_memarg 32 input in
+    (I_store (S32, memarg), input)
+  | '\x37' ->
+    let+ memarg, input = read_memarg 64 input in
+    (I_store (S64, memarg), input)
+  | '\x38' ->
+    let+ memarg, input = read_memarg 32 input in
+    (F_store (S32, memarg), input)
+  | '\x39' ->
+    let+ memarg, input = read_memarg 64 input in
+    (F_store (S64, memarg), input)
+  | '\x3A' ->
+    let+ memarg, input = read_memarg 32 input in
+    (I_store8 (S32, memarg), input)
   | '\x3B' ->
-    let+ memarg, input = read_memarg input in
+    let+ memarg, input = read_memarg 32 input in
     (I_store16 (S32, memarg), input)
   | '\x3C' ->
-    let+ memarg, input = read_memarg input in
+    let+ memarg, input = read_memarg 64 input in
     (I_store8 (S64, memarg), input)
   | '\x3D' ->
-    let+ memarg, input = read_memarg input in
+    let+ memarg, input = read_memarg 64 input in
     (I_store16 (S64, memarg), input)
   | '\x3E' ->
-    let+ memarg, input = read_memarg input in
+    let+ memarg, input = read_memarg 32 input in
     (I64_store32 memarg, input)
-  | '\x3F' ->
-    let+ input = check_zero_opcode input in
-    (Memory_size, input)
-  | '\x40' ->
-    let+ input = check_zero_opcode input in
-    (Memory_grow, input)
-  | '\x41' ->
-    let+ i32, input = read_S32 input in
-    (I32_const i32, input)
-  | '\x42' ->
-    let+ i64, input = read_S64 input in
-    (I64_const i64, input)
-  | '\x43' ->
-    let+ f32, input = read_F32 input in
-    (F32_const f32, input)
-  | '\x44' ->
-    let+ f64, input = read_F64 input in
-    (F64_const f64, input)
-  | '\x45' -> Ok (I_testop (S32, Eqz), input)
-  | '\x46' -> Ok (I_relop (S32, Eq), input)
-  | '\x47' -> Ok (I_relop (S32, Ne), input)
-  | '\x48' -> Ok (I_relop (S32, Lt S), input)
-  | '\x49' -> Ok (I_relop (S32, Lt U), input)
-  | '\x4A' -> Ok (I_relop (S32, Gt S), input)
-  | '\x4B' -> Ok (I_relop (S32, Gt U), input)
-  | '\x4C' -> Ok (I_relop (S32, Le S), input)
-  | '\x4D' -> Ok (I_relop (S32, Le U), input)
-  | '\x4E' -> Ok (I_relop (S32, Ge S), input)
-  | '\x4F' -> Ok (I_relop (S32, Ge U), input)
+  | '\x3F' ->
+    let+ input = check_zero_opcode input in
+    (Memory_size, input)
+  | '\x40' ->
+    let+ input = check_zero_opcode input in
+    (Memory_grow, input)
+  | '\x41' ->
+    let+ i32, input = read_S32 input in
+    (I32_const i32, input)
+  | '\x42' ->
+    let+ i64, input = read_S64 input in
+    (I64_const i64, input)
+  | '\x43' ->
+    let+ f32, input = read_F32 input in
+    (F32_const f32, input)
+  | '\x44' ->
+    let+ f64, input = read_F64 input in
+    (F64_const f64, input)
+  | '\x45' -> Ok (I_testop (S32, Eqz), input)
+  | '\x46' -> Ok (I_relop (S32, Eq), input)
+  | '\x47' -> Ok (I_relop (S32, Ne), input)
+  | '\x48' -> Ok (I_relop (S32, Lt S), input)
+  | '\x49' -> Ok (I_relop (S32, Lt U), input)
+  | '\x4A' -> Ok (I_relop (S32, Gt S), input)
+  | '\x4B' -> Ok (I_relop (S32, Gt U), input)
+  | '\x4C' -> Ok (I_relop (S32, Le S), input)
+  | '\x4D' -> Ok (I_relop (S32, Le U), input)
+  | '\x4E' -> Ok (I_relop (S32, Ge S), input)
+  | '\x4F' -> Ok (I_relop (S32, Ge U), input)
   | '\x50' -> Ok (I_testop (S64, Eqz), input)
   | '\x51' -> Ok (I_relop (S64, Eq), input)
   | '\x52' -> Ok (I_relop (S64, Ne), input)
@@ -3287,10 +3303,10 @@ 
60.69%

   | '\x5A' -> Ok (I_relop (S64, Ge U), input)
   | '\x5B' -> Ok (F_relop (S32, Eq), input)
   | '\x5C' -> Ok (F_relop (S32, Ne), input)
-  | '\x5D' -> Ok (F_relop (S32, Lt), input)
+  | '\x5D' -> Ok (F_relop (S32, Lt), input)
   | '\x5E' -> Ok (F_relop (S32, Gt), input)
-  | '\x5F' -> Ok (F_relop (S32, Le), input)
-  | '\x60' -> Ok (F_relop (S32, Ge), input)
+  | '\x5F' -> Ok (F_relop (S32, Le), input)
+  | '\x60' -> Ok (F_relop (S32, Ge), input)
   | '\x61' -> Ok (F_relop (S64, Eq), input)
   | '\x62' -> Ok (F_relop (S64, Ne), input)
   | '\x63' -> Ok (F_relop (S64, Lt), input)
@@ -3300,25 +3316,25 @@ 
60.69%

   | '\x67' -> Ok (I_unop (S32, Clz), input)
   | '\x68' -> Ok (I_unop (S32, Ctz), input)
   | '\x69' -> Ok (I_unop (S32, Popcnt), input)
-  | '\x6A' -> Ok (I_binop (S32, Add), input)
-  | '\x6B' -> Ok (I_binop (S32, Sub), input)
-  | '\x6C' -> Ok (I_binop (S32, Mul), input)
+  | '\x6A' -> Ok (I_binop (S32, Add), input)
+  | '\x6B' -> Ok (I_binop (S32, Sub), input)
+  | '\x6C' -> Ok (I_binop (S32, Mul), input)
   | '\x6D' -> Ok (I_binop (S32, Div S), input)
-  | '\x6E' -> Ok (I_binop (S32, Div U), input)
-  | '\x6F' -> Ok (I_binop (S32, Rem S), input)
+  | '\x6E' -> Ok (I_binop (S32, Div U), input)
+  | '\x6F' -> Ok (I_binop (S32, Rem S), input)
   | '\x70' -> Ok (I_binop (S32, Rem U), input)
-  | '\x71' -> Ok (I_binop (S32, And), input)
-  | '\x72' -> Ok (I_binop (S32, Or), input)
-  | '\x73' -> Ok (I_binop (S32, Xor), input)
-  | '\x74' -> Ok (I_binop (S32, Shl), input)
-  | '\x75' -> Ok (I_binop (S32, Shr S), input)
-  | '\x76' -> Ok (I_binop (S32, Shr U), input)
+  | '\x71' -> Ok (I_binop (S32, And), input)
+  | '\x72' -> Ok (I_binop (S32, Or), input)
+  | '\x73' -> Ok (I_binop (S32, Xor), input)
+  | '\x74' -> Ok (I_binop (S32, Shl), input)
+  | '\x75' -> Ok (I_binop (S32, Shr S), input)
+  | '\x76' -> Ok (I_binop (S32, Shr U), input)
   | '\x77' -> Ok (I_binop (S32, Rotl), input)
   | '\x78' -> Ok (I_binop (S32, Rotr), input)
   | '\x79' -> Ok (I_unop (S64, Clz), input)
   | '\x7A' -> Ok (I_unop (S64, Ctz), input)
   | '\x7B' -> Ok (I_unop (S64, Popcnt), input)
-  | '\x7C' -> Ok (I_binop (S64, Add), input)
+  | '\x7C' -> Ok (I_binop (S64, Add), input)
   | '\x7D' -> Ok (I_binop (S64, Sub), input)
   | '\x7E' -> Ok (I_binop (S64, Mul), input)
   | '\x7F' -> Ok (I_binop (S64, Div S), input)
@@ -3340,9 +3356,9 @@ 
60.69%

   | '\x8F' -> Ok (F_unop (S32, Trunc), input)
   | '\x90' -> Ok (F_unop (S32, Nearest), input)
   | '\x91' -> Ok (F_unop (S32, Sqrt), input)
-  | '\x92' -> Ok (F_binop (S32, Add), input)
+  | '\x92' -> Ok (F_binop (S32, Add), input)
   | '\x93' -> Ok (F_binop (S32, Sub), input)
-  | '\x94' -> Ok (F_binop (S32, Mul), input)
+  | '\x94' -> Ok (F_binop (S32, Mul), input)
   | '\x95' -> Ok (F_binop (S32, Div), input)
   | '\x96' -> Ok (F_binop (S32, Min), input)
   | '\x97' -> Ok (F_binop (S32, Max), input)
@@ -3363,7 +3379,7 @@ 
60.69%

   | '\xA6' -> Ok (F_binop (S64, Copysign), input)
   | '\xA7' -> Ok (I32_wrap_i64, input)
   | '\xA8' -> Ok (I_trunc_f (S32, S32, S), input)
-  | '\xA9' -> Ok (I_trunc_f (S32, S32, U), input)
+  | '\xA9' -> Ok (I_trunc_f (S32, S32, U), input)
   | '\xAA' -> Ok (I_trunc_f (S32, S64, S), input)
   | '\xAB' -> Ok (I_trunc_f (S32, S64, U), input)
   | '\xAC' -> Ok (I64_extend_i32 S, input)
@@ -3373,7 +3389,7 @@ 
60.69%

   | '\xB0' -> Ok (I_trunc_f (S64, S64, S), input)
   | '\xB1' -> Ok (I_trunc_f (S64, S64, U), input)
   | '\xB2' -> Ok (F_convert_i (S32, S32, S), input)
-  | '\xB3' -> Ok (F_convert_i (S32, S32, U), input)
+  | '\xB3' -> Ok (F_convert_i (S32, S32, U), input)
   | '\xB4' -> Ok (F_convert_i (S32, S64, S), input)
   | '\xB5' -> Ok (F_convert_i (S32, S64, U), input)
   | '\xB6' -> Ok (F32_demote_f64, input)
@@ -3398,24 +3414,24 @@ 
60.69%

   | '\xD2' ->
     let+ funcidx, input = read_indice input in
     (Ref_func funcidx, input)
-  | '\xFC' -> read_FC old_input
-  | c -> Error (`Msg (Format.sprintf "illegal opcode (2) %s" (Char.escaped c)))
+  | '\xFC' -> read_FC input
+  | c -> Error (`Msg (Fmt.str "illegal opcode (2) %s" (Char.escaped c)))
 
 and read_expr types input =
-  let rec aux acc input =
-    match read_byte ~msg:"read_expr" input with
-    | Ok (('\x05' | '\x0b'), _) -> Ok (List.rev acc, input)
+  let rec aux acc input =
+    match read_byte ~msg:"read_expr" input with
+    | Ok (('\x05' | '\x0B'), _) -> Ok (List.rev acc, input)
     | Error _ -> Ok (List.rev acc, input)
-    | Ok _ ->
-      let* instr, input = read_instr types input in
-      aux (instr :: acc) input
+    | Ok _ ->
+      let* instr, input = read_instr types input in
+      aux (instr :: acc) input
   in
   aux [] input
 
 let read_const types input =
-  let* c, input = read_expr types input in
-  let+ input = check_end_opcode input in
-  (c, input)
+  let* c, input = read_expr types input in
+  let+ input = check_end_opcode input in
+  (c, input)
 
 type ('a, 'b) import =
   | Func of int
@@ -3424,86 +3440,91 @@ 
60.69%

   | Global of mut * 'b val_type
 
 let magic_check str =
-  if String.length str < 4 then Error (`Msg "unexpected end")
+  if String.length str < 4 then Error (`Msg "unexpected end")
   else
-    let magic = String.sub str 0 4 in
-    if String.equal magic "\x00\x61\x73\x6d" then Ok ()
+    let magic = String.sub str 0 4 in
+    if String.equal magic "\x00\x61\x73\x6d" then Ok ()
     else Error (`Msg "magic header not detected")
 
 let version_check str =
-  if String.length str < 8 then Error (`Msg "unexpected end")
+  if String.length str < 8 then Error (`Msg "unexpected end")
   else
-    let version = String.sub str 4 4 in
-    if String.equal version "\x01\x00\x00\x00" then Ok ()
+    let version = String.sub str 4 4 in
+    if String.equal version "\x01\x00\x00\x00" then Ok ()
     else Error (`Msg "unknown binary version")
 
 let check_section_id = function
-  | '\x00' .. '\x0C' -> Ok ()
-  | c -> Error (`Msg (Format.sprintf "malformed section id %s" (Char.escaped c)))
+  | '\x00' .. '\x0C' -> Ok ()
+  | c -> Error (`Msg (Fmt.str "malformed section id %s" (Char.escaped c)))
 
 let section_parse input ~expected_id default section_content_parse =
-  match Input.get 0 input with
-  | Some id when id = expected_id ->
-    let* () = check_section_id id in
-    let* input = Input.sub_suffix 1 input in
-    let* size, input = read_U32 input in
-    let* () =
-      if size > Input.size input then Error (`Msg "section size mismatch")
-      else Ok ()
+  match Input.get 0 input with
+  | Some id when Char.equal id expected_id ->
+    let* () = check_section_id id in
+    let* input = Input.sub_suffix 1 input in
+    let* () =
+      if Input.size input = 0 then Error (`Msg "unexpected end") else Ok ()
     in
-    let* section_input = Input.sub_prefix size input in
-    let* next_input = Input.sub_suffix size input in
-    let* res, after_section_input = section_content_parse section_input in
-    if
-      Input.size input - (Input.size next_input + Input.size section_input)
-      <> Input.size after_section_input
-    then Error (`Msg "section size mismatch")
-    else Ok (res, next_input)
-  | None -> Ok (default, input)
-  | Some id ->
-    let* () = check_section_id id in
-    Ok (default, input)
+    let* size, input = read_U32 input in
+    let* () =
+      if size > Input.size input then Error (`Msg "length out of bounds")
+      else Ok ()
+    in
+    let* section_input = Input.sub_prefix size input in
+    let* next_input = Input.sub_suffix size input in
+    let* res, after_section_input = section_content_parse section_input in
+    if Input.size after_section_input > 0 then
+      Error (`Msg "section size mismatch")
+    else Ok (res, next_input)
+  | None -> Ok (default, input)
+  | Some id ->
+    let* () = check_section_id id in
+    Ok (default, input)
 
 let parse_utf8_name input =
-  let* name, input = read_bytes ~msg:"parse_utf8_name" input in
-  let name = string_of_char_list name in
-  let+ () = Wutf8.check_utf8 name in
-  (name, input)
+  let* () =
+    if Input.size input = 0 then Error (`Msg "unexpected end") else Ok ()
+  in
+  let* name, input = read_bytes ~msg:"parse_utf8_name" input in
+  let name = string_of_char_list name in
+  let+ () = Wutf8.check_utf8 name in
+  (name, input)
 
 let section_custom input =
-  let consume_to_end x input =
-    let+ input = Input.sub ~pos:0 ~len:0 input in
-    (x, input)
+  let consume_to_end x input =
+    let+ input = Input.sub ~pos:0 ~len:0 input in
+    (x, input)
   in
   section_parse input ~expected_id:'\x00' None @@ fun input ->
-  let* name, input = parse_utf8_name input in
-  let+ (), input = consume_to_end () input in
-  (Some name, input)
-
-let read_type id input =
-  let* fcttype, input = read_byte ~msg:"read_type" input in
-  let* () =
-    if fcttype <> '\x60' then Error (`Msg "integer representation too long")
-    else Ok ()
+  let* name, input = parse_utf8_name input in
+  let+ (), input = consume_to_end () input in
+  (Some name, input)
+
+let read_type _id input =
+  let* fcttype, input = read_byte ~msg:"read_type" input in
+  let* () =
+    match fcttype with
+    | '\x60' -> Ok ()
+    | _ -> Error (`Msg "integer representation too long")
   in
-  let* params, input = read_valtypes input in
-  let+ results, input = read_valtypes input in
-  let params = List.map (fun param -> (None, param)) params in
-  (Bt_raw (Some (Raw id), (params, results)), input)
+  let* params, input = read_valtypes input in
+  let+ results, input = read_valtypes input in
+  let params = List.map (fun param -> (None, param)) params in
+  ([ (None, (Final, [], Def_func_t (params, results))) ], input)
 
 let read_global_type input =
-  let* val_type, input = read_valtype input in
-  let+ mut, input = read_mut input in
-  ((mut, val_type), input)
+  let* val_type, input = read_valtype input in
+  let+ mut, input = read_mut input in
+  ((mut, val_type), input)
 
 let read_import input =
-  let* modul, input = parse_utf8_name input in
-  let* name, input = parse_utf8_name input in
-  let* import_typeidx, input = read_byte ~msg:"read_import" input in
-  match import_typeidx with
-  | '\x00' ->
-    let+ typeidx, input = read_U32 input in
-    ((modul, name, Func typeidx), input)
+  let* modul, input = parse_utf8_name input in
+  let* name, input = parse_utf8_name input in
+  let* import_typeidx, input = read_byte ~msg:"read_import" input in
+  match import_typeidx with
+  | '\x00' ->
+    let+ typeidx, input = read_U32 input in
+    ((modul, name, Func typeidx), input)
   | '\x01' ->
     let* ref_type, input = read_reftype input in
     let+ limits, input = read_limits input in
@@ -3511,74 +3532,72 @@ 
60.69%

   | '\x02' ->
     let+ limits, input = read_limits input in
     ((modul, name, Mem limits), input)
-  | '\x03' ->
-    let+ (mut, val_type), input = read_global_type input in
+  | '\x03' ->
+    let+ (mut, val_type), input = read_global_type input in
     ((modul, name, Global (mut, val_type)), input)
-  | _c -> Error (`Msg "SECTION_IMPORT_NO_MATCH")
+  | _c -> Error (`Msg "malformed import kind")
 
 let read_table input =
-  let* ref_type, input = read_reftype input in
-  let+ limits, input = read_limits input in
-  ((limits, ref_type), input)
+  let* ref_type, input = read_reftype input in
+  let+ limits, input = read_limits input in
+  ((limits, ref_type), input)
 
 let read_memory input =
-  let+ limits, input = read_limits input in
-  ((None, limits), input)
+  let+ limits, input = read_limits input in
+  ((None, limits), input)
 
 let read_global types input =
-  let* typ, input = read_global_type input in
-  let+ init, input = read_const types input in
-  ({ typ; init; id = None }, input)
+  let* typ, input = read_global_type input in
+  let+ init, input = read_const types input in
+  ({ typ; init; id = None }, input)
 
 let read_export input =
-  let* name, input = read_bytes ~msg:"read_export 1" input in
-  let name = string_of_char_list name in
-  let* export_typeidx, input = read_byte ~msg:"read_export 2" input in
-  let+ id, input = read_U32 input in
-  ((export_typeidx, { id; name }), input)
+  let* name, input = read_bytes ~msg:"read_export 1" input in
+  let name = string_of_char_list name in
+  let* export_typeidx, input = read_byte ~msg:"read_export 2" input in
+  let+ id, input = read_U32 input in
+  ((export_typeidx, { id; name }), input)
 
 let read_elem_active types input =
-  let* Raw index, input = read_indice input in
-  let+ offset, input = read_const types input in
-  (Elem_active (Some index, offset), input)
+  let* Raw index, input = read_indice input in
+  let+ offset, input = read_const types input in
+  (Elem_active (Some index, offset), input)
 
 let read_elem_active_zero types input =
-  let+ offset, input = read_const types input in
-  (Elem_active (Some 0, offset), input)
+  let+ offset, input = read_const types input in
+  (Elem_active (Some 0, offset), input)
 
 let read_elem_index input =
-  let+ index, input = read_indice input in
-  ([ Ref_func index ], input)
+  let+ index, input = read_indice input in
+  ([ Ref_func index ], input)
 
 let read_elem_kind input =
-  let msg = "malformed element kind" in
+  let msg = "malformed element kind" in
   match read_byte ~msg input with
-  | Ok ('\x00', input) -> Ok ((Null, Func_ht), input)
+  | Ok ('\x00', input) -> Ok ((Null, Func_ht), input)
   | Ok (c, _input) ->
-    Error
-      (`Msg
-        (Format.sprintf "%s (expected 0x00 but got %s)" msg (Char.escaped c)) )
+    Error (`Msg (Fmt.str "%s (expected 0x00 but got %s)" msg (Char.escaped c)))
   | Error _ as e -> e
 
 let read_element types input =
-  let* i, input = read_U32 input in
-  let id = None in
+  let* i, input = read_U32 input in
+  let id = None in
   match i with
-  | 0 ->
-    let* mode, input = read_elem_active_zero types input in
-    let+ init, input = vector_no_id read_elem_index input in
-    let typ = (Null, Func_ht) in
+  | 0 ->
+    let* mode, input = read_elem_active_zero types input in
+    let+ init, input = vector_no_id read_elem_index input in
+    let typ = (Null, Func_ht) in
     ({ id; typ; init; mode }, input)
   | 1 ->
     let mode = Elem_passive in
     let* typ, input = read_elem_kind input in
     let+ init, input = vector_no_id read_elem_index input in
     ({ id; typ; init; mode }, input)
-  | 2 ->
-    let* mode, input = read_elem_active types input in
-    let* typ, input = read_elem_kind input in
-    let+ init, input = vector_no_id read_elem_index input in
-    ({ id; typ; init; mode }, input)
+  | 2 ->
+    let* mode, input = read_elem_active types input in
+    let* typ, input = read_elem_kind input in
+    let+ init, input = vector_no_id read_elem_index input in
+    ({ id; typ; init; mode }, input)
   | 3 ->
     let mode = Elem_declarative in
     let* typ, input = read_elem_kind input in
@@ -3604,253 +3623,276 @@ 
60.69%

     let* typ, input = read_reftype input in
     let+ init, input = vector_no_id (read_const types) input in
     ({ id; typ; init; mode }, input)
-  | i -> Error (`Msg (Format.sprintf "malformed elements segment kind: %d" i))
+  | i -> Error (`Msg (Fmt.str "malformed elements segment kind: %d" i))
 
 let read_local input =
-  let* n, input = read_U32 input in
-  let+ t, input = read_valtype input in
-  ((n, t), input)
+  let* n, input = read_U32 input in
+  let+ t, input = read_valtype input in
+  ((n, t), input)
 
 let read_locals input =
-  let* nts, input = vector_no_id read_local input in
-  let ns =
-    List.map (fun (n, _t) -> Convert.Int64.extend_i32_u @@ Int32.of_int n) nts
+  let* nts, input = vector_no_id read_local input in
+  let ns =
+    List.map (fun (n, _t) -> Convert.Int64.extend_i32_u @@ Int32.of_int n) nts
   in
-  let+ () =
-    if not @@ Int64.lt_u (List.fold_left Int64.add 0L ns) 0x1_0000_0000L then
+  let+ () =
+    if not @@ Int64.lt_u (List.fold_left Int64.add 0L ns) 0x1_0000_0000L then
       Error (`Msg "too many locals")
-    else Ok ()
+    else Ok ()
   in
-  let locals = List.map (fun (n, t) -> List.init n (fun _i -> (None, t))) nts in
-  let locals = List.flatten locals in
-  (locals, input)
+  let locals = List.map (fun (n, t) -> List.init n (fun _i -> (None, t))) nts in
+  let locals = List.flatten locals in
+  (locals, input)
 
 let read_code types input =
-  let* _size, input = read_U32 input in
-  let* locals, input = read_locals input in
-  let* code, input = read_expr types input in
-  let+ input = check_end_opcode input in
-  ((locals, code), input)
+  let* size, input = read_U32 input in
+  let* code_input = Input.sub_prefix size input in
+  let* next_input = Input.sub_suffix size input in
+  let* locals, code_input = read_locals code_input in
+  let* code, code_input = read_expr types code_input in
+  let* () =
+    if Input.size code_input = 0 && Input.size next_input = 0 then
+      Error (`Msg "unexpected end of section or function")
+    else Ok ()
+  in
+  let* code_input =
+    check_end_opcode ~unexpected_eoi_msg:"unexpected end of section or function"
+      code_input
+  in
+  if Input.size code_input > 0 then
+    Error (`Msg "unexpected end of section or function")
+  else Ok ((locals, code), next_input)
 
 (* TODO: merge Elem and Data modes ? *)
 let read_data_active types input =
-  let* Raw index, input = read_indice input in
-  let+ offset, input = read_const types input in
-  (Data_active (Some index, offset), input)
+  let* Raw index, input = read_indice input in
+  let+ offset, input = read_const types input in
+  (Data_active (index, offset), input)
 
 let read_data_active_zero types input =
-  let+ offset, input = read_const types input in
-  (Data_active (Some 0, offset), input)
+  let+ offset, input = read_const types input in
+  (Data_active (0, offset), input)
 
-let read_data types memories input =
-  let* i, input = read_U32 input in
-  let id = None in
+let read_data types input =
+  let* i, input = read_U32 input in
+  let id = None in
   match i with
-  | 0 ->
-    let* mode, input = read_data_active_zero types input in
-    let* init, input = read_bytes ~msg:"read_data 0" input in
-    let init = string_of_char_list init in
-    (* TODO: this should be removed once we do proper validation of binary modules *)
-    let+ () =
-      if List.is_empty memories then Error (`Unknown_memory 0) else Ok ()
-    in
-    ({ id; init; mode }, input)
+  | 0 ->
+    let* mode, input = read_data_active_zero types input in
+    let+ init, input = read_bytes ~msg:"read_data 0" input in
+    let init = string_of_char_list init in
+    ({ id; init; mode }, input)
   | 1 ->
     let mode = Data_passive in
     let+ init, input = read_bytes ~msg:"read_data 1" input in
     let init = string_of_char_list init in
     ({ id; init; mode }, input)
-  | 2 ->
-    let* mode, input = read_data_active types input in
-    let+ init, input = read_bytes ~msg:"read_data 2" input in
-    let init = string_of_char_list init in
-    ({ id; init; mode }, input)
-  | i -> Error (`Msg (Format.sprintf "malformed data segment kind %d" i))
+  | 2 ->
+    let* mode, input = read_data_active types input in
+    let+ init, input = read_bytes ~msg:"read_data 2" input in
+    let init = string_of_char_list init in
+    ({ id; init; mode }, input)
+  | i -> Error (`Msg (Fmt.str "malformed data segment kind %d" i))
 
 let parse_many_custom_section input =
-  let rec aux acc input =
-    let* custom_section, input = section_custom input in
-    match custom_section with
-    | None -> Ok (List.rev acc, input)
-    | Some _ as custom_section -> aux (custom_section :: acc) input
+  let rec aux acc input =
+    let* custom_section, input = section_custom input in
+    match custom_section with
+    | None -> Ok (List.rev acc, input)
+    | Some _ as custom_section -> aux (custom_section :: acc) input
   in
   aux [] input
 
 let sections_iterate (input : Input.t) =
   (* Custom *)
-  let* _custom_sections, input = parse_many_custom_section input in
+  let* _custom_sections, input = parse_many_custom_section input in
 
   (* Type *)
-  let* type_section, input =
-    section_parse input ~expected_id:'\x01' [] (vector read_type)
+  let* type_section, input =
+    section_parse input ~expected_id:'\x01' [] (vector read_type)
   in
-  let type_section = Array.of_list type_section in
+  let type_section = Array.of_list type_section in
 
   (* Custom *)
-  let* _custom_sections', input = parse_many_custom_section input in
-  let _custom_sections = _custom_sections @ _custom_sections' in
+  let* _custom_sections', input = parse_many_custom_section input in
+  let _custom_sections = _custom_sections @ _custom_sections' in
 
   (* Imports *)
   let* import_section, input =
-    section_parse input ~expected_id:'\x02' [] (vector_no_id read_import)
+    section_parse input ~expected_id:'\x02' [] (vector_no_id read_import)
   in
 
   (* Custom *)
-  let* _custom_sections', input = parse_many_custom_section input in
-  let _custom_sections = _custom_sections @ _custom_sections' in
+  let* _custom_sections', input = parse_many_custom_section input in
+  let _custom_sections = _custom_sections @ _custom_sections' in
 
   (* Function *)
   let* function_section, input =
-    section_parse input ~expected_id:'\x03' [] (vector_no_id read_U32)
+    section_parse input ~expected_id:'\x03' [] (vector_no_id read_U32)
   in
 
   (* Custom *)
-  let* _custom_sections', input = parse_many_custom_section input in
-  let _custom_sections = _custom_sections @ _custom_sections' in
+  let* _custom_sections', input = parse_many_custom_section input in
+  let _custom_sections = _custom_sections @ _custom_sections' in
 
   (* Tables *)
   let* table_section, input =
-    section_parse input ~expected_id:'\x04' [] (vector_no_id read_table)
+    section_parse input ~expected_id:'\x04' [] (vector_no_id read_table)
   in
 
   (* Custom *)
-  let* _custom_sections', input = parse_many_custom_section input in
-  let _custom_sections = _custom_sections @ _custom_sections' in
+  let* _custom_sections', input = parse_many_custom_section input in
+  let _custom_sections = _custom_sections @ _custom_sections' in
 
   (* Memory *)
   let* memory_section, input =
-    section_parse input ~expected_id:'\x05' [] (vector_no_id read_memory)
+    section_parse input ~expected_id:'\x05' [] (vector_no_id read_memory)
   in
 
   (* Custom *)
-  let* _custom_sections', input = parse_many_custom_section input in
-  let _custom_sections = _custom_sections @ _custom_sections' in
+  let* _custom_sections', input = parse_many_custom_section input in
+  let _custom_sections = _custom_sections @ _custom_sections' in
 
   (* Globals *)
   let* global_section, input =
-    section_parse input ~expected_id:'\x06' []
-      (vector_no_id (read_global type_section))
+    section_parse input ~expected_id:'\x06' []
+      (vector_no_id (read_global type_section))
   in
 
   (* Custom *)
-  let* _custom_sections', input = parse_many_custom_section input in
-  let _custom_sections = _custom_sections @ _custom_sections' in
+  let* _custom_sections', input = parse_many_custom_section input in
+  let _custom_sections = _custom_sections @ _custom_sections' in
 
   (* Exports *)
   let* export_section, input =
-    section_parse input ~expected_id:'\x07' [] (vector_no_id read_export)
+    section_parse input ~expected_id:'\x07' [] (vector_no_id read_export)
   in
 
   (* Custom *)
-  let* _custom_sections', input = parse_many_custom_section input in
-  let _custom_sections = _custom_sections @ _custom_sections' in
+  let* _custom_sections', input = parse_many_custom_section input in
+  let _custom_sections = _custom_sections @ _custom_sections' in
 
   (* Start *)
   let* start_section, input =
-    section_parse input ~expected_id:'\x08' None @@ fun input ->
-    let+ idx_start_func, input = read_U32 input in
-    (Some idx_start_func, input)
+    section_parse input ~expected_id:'\x08' None @@ fun input ->
+    let+ idx_start_func, input = read_U32 input in
+    (Some idx_start_func, input)
   in
 
   (* Custom *)
-  let* _custom_sections', input = parse_many_custom_section input in
-  let _custom_sections = _custom_sections @ _custom_sections' in
+  let* _custom_sections', input = parse_many_custom_section input in
+  let _custom_sections = _custom_sections @ _custom_sections' in
 
   (* Elements *)
   let* element_section, input =
-    section_parse input ~expected_id:'\x09' []
-    @@ vector_no_id (read_element type_section)
+    section_parse input ~expected_id:'\x09' []
+    @@ vector_no_id (read_element type_section)
   in
 
   (* Custom *)
-  let* _custom_sections', input = parse_many_custom_section input in
-  let _custom_sections = _custom_sections @ _custom_sections' in
+  let* _custom_sections', input = parse_many_custom_section input in
+  let _custom_sections = _custom_sections @ _custom_sections' in
 
   (* Data_count *)
   let* data_count_section, input =
-    section_parse input ~expected_id:'\x0C' None @@ fun input ->
-    let+ i, input = read_U32 input in
-    (Some i, input)
+    section_parse input ~expected_id:'\x0C' None @@ fun input ->
+    let+ i, input = read_U32 input in
+    (Some i, input)
   in
 
   (* Custom *)
-  let* _custom_sections', input = parse_many_custom_section input in
-  let _custom_sections = _custom_sections @ _custom_sections' in
+  let* _custom_sections', input = parse_many_custom_section input in
+  let _custom_sections = _custom_sections @ _custom_sections' in
 
   (* Code *)
   let* code_section, input =
-    section_parse input ~expected_id:'\x0A' []
-      (vector_no_id (read_code type_section))
+    section_parse input ~expected_id:'\x0A' []
+      (vector_no_id (read_code type_section))
   in
 
-  let* () =
-    if List.compare_lengths function_section code_section <> 0 then
-      Error (`Msg "function and code section have inconsistent lengths")
-    else Ok ()
+  let* () =
+    if List.compare_lengths function_section code_section <> 0 then
+      Error (`Msg "function and code section have inconsistent lengths")
+    else Ok ()
   in
 
   (* Custom *)
-  let* _custom_sections', input = parse_many_custom_section input in
-  let _custom_sections = _custom_sections @ _custom_sections' in
+  let* _custom_sections', input = parse_many_custom_section input in
+  let _custom_sections = _custom_sections @ _custom_sections' in
 
   (* Data *)
   let+ data_section, input =
-    section_parse input ~expected_id:'\x0B' []
-      (vector_no_id (read_data type_section memory_section))
+    section_parse input ~expected_id:'\x0B' []
+      (vector_no_id (read_data type_section))
   in
 
-  let* () =
-    match data_count_section with
-    | None -> Ok ()
-    | Some len ->
-      if List.compare_length_with data_section len <> 0 then
-        Error (`Msg "data count and data section have inconsistent lengths")
-      else Ok ()
+  let* () =
+    match (List.length data_section, data_count_section) with
+    | 0, None -> Ok ()
+    | _data_len, None ->
+      let code_use_dataidx = ref false in
+      let f_iter = function
+        | Data_drop _ | Memory_init _ -> code_use_dataidx := true
+        | _ -> ()
+      in
+      let expr = List.concat_map snd code_section in
+      iter_expr f_iter expr;
+      if !code_use_dataidx then Error (`Msg "data count section required")
+      else Ok ()
+    | data_len, Some data_count when data_len = data_count -> Ok ()
+    | _ -> Error (`Msg "data count and data section have inconsistent lengths")
   in
 
   (* Custom *)
   (* TODO: actually use the various custom sections *)
-  let* _custom_sections', input = parse_many_custom_section input in
-  let _custom_sections = _custom_sections @ _custom_sections' in
+  let* _custom_sections', input = parse_many_custom_section input in
+  let _custom_sections = _custom_sections @ _custom_sections' in
 
   let+ () =
-    if not @@ Input.is_empty input then Error (`Msg "malformed section id")
-    else Ok ()
+    if not @@ Input.is_empty input then Error (`Msg "malformed section id")
+    else Ok ()
   in
 
-  let indexed_of_list l = List.mapi Indexed.return l in
+  let indexed_of_list l = List.mapi Indexed.return l in
+  let indexed_of_array l = Array.mapi Indexed.return l |> Array.to_list in
+
+  (* Types *)
+  let types =
+    let values = indexed_of_array type_section in
+    { Named.values; named = String_map.empty }
+  in
 
   (* Memories *)
   let mem =
-    let local = List.map (fun mem -> Runtime.Local mem) memory_section in
-    let imported =
+    let local = List.map (fun mem -> Runtime.Local mem) memory_section in
+    let imported =
       List.filter_map
         (function
           | modul, name, Mem desc ->
             Option.some
             @@ Runtime.Imported { modul; name; assigned_name = None; desc }
-          | _not_a_memory_import -> None )
+          | _not_a_memory_import -> None )
         import_section
     in
-    let values = indexed_of_list (imported @ local) in
-    { Named.values; named = String_map.empty }
+    let values = indexed_of_list (imported @ local) in
+    { Named.values; named = String_map.empty }
   in
 
   (* Globals *)
   let global =
-    let local = List.map (fun g -> Runtime.Local g) global_section in
-    let imported =
+    let local = List.map (fun g -> Runtime.Local g) global_section in
+    let imported =
       List.filter_map
         (function
           | modul, name, Global (mut, val_type) ->
             Option.some
             @@ Runtime.Imported
                  { modul; name; assigned_name = None; desc = (mut, val_type) }
-          | _not_a_global_import -> None )
+          | _not_a_global_import -> None )
         import_section
     in
-    let values = indexed_of_list (imported @ local) in
-    { Named.values; named = String_map.empty }
+    let values = indexed_of_list (imported @ local) in
+    { Named.values; named = String_map.empty }
   in
 
   (* Functions *)
@@ -3858,32 +3900,36 @@ 
60.69%

     let local =
       List.map2
         (fun typeidx (locals, body) ->
-          Runtime.Local
-            { type_f = type_section.(typeidx); locals; body; id = None } )
+          Runtime.Local
+            { type_f = block_type_of_rec_type type_section.(typeidx)
+            ; locals
+            ; body
+            ; id = None
+            } )
         function_section code_section
     in
-    let imported =
+    let imported =
       List.filter_map
         (function
-          | modul, name, Func typeidx ->
+          | modul, name, Func typeidx ->
             Option.some
             @@ Runtime.Imported
                  { modul
                  ; name
                  ; assigned_name = None
-                 ; desc = type_section.(typeidx)
+                 ; desc = block_type_of_rec_type type_section.(typeidx)
                  }
           | _not_a_function_import -> None )
         import_section
     in
-    let values = indexed_of_list (imported @ local) in
-    { Named.values; named = String_map.empty }
+    let values = indexed_of_list (imported @ local) in
+    { Named.values; named = String_map.empty }
   in
 
   (* Tables *)
   let table =
-    let local = List.map (fun tbl -> Runtime.Local (None, tbl)) table_section in
-    let imported =
+    let local = List.map (fun tbl -> Runtime.Local (None, tbl)) table_section in
+    let imported =
       List.filter_map
         (function
           | modul, name, Table (limits, ref_type) ->
@@ -3894,23 +3940,23 @@ 
60.69%

                  ; assigned_name = None
                  ; desc = (limits, ref_type)
                  }
-          | _not_a_table_import -> None )
+          | _not_a_table_import -> None )
         import_section
     in
-    let values = indexed_of_list (imported @ local) in
-    { Named.values; named = String_map.empty }
+    let values = indexed_of_list (imported @ local) in
+    { Named.values; named = String_map.empty }
   in
 
   (* Elems *)
   let elem =
     let values = indexed_of_list element_section in
-    { Named.values; named = String_map.empty }
+    { Named.values; named = String_map.empty }
   in
 
   (* Data *)
   let data =
     let values = indexed_of_list data_section in
-    { Named.values; named = String_map.empty }
+    { Named.values; named = String_map.empty }
   in
 
   (* Exports *)
@@ -3918,31 +3964,32 @@ 
60.69%

   let exports =
     List.fold_left
       (fun (exports : exports) (export_typeidx, export) ->
-        match export_typeidx with
-        | '\x00' ->
+        match export_typeidx with
+        | '\x00' ->
           let func = export :: exports.func in
           { exports with func }
         | '\x01' ->
           let table = export :: exports.table in
           { exports with table }
-        | '\x02' ->
+        | '\x02' ->
           let mem = export :: exports.mem in
           { exports with mem }
         | '\x03' ->
           let global = export :: exports.global in
           { exports with global }
-        | _ -> failwith "read_exportdesc error" )
+        | _ -> Fmt.failwith "read_exportdesc error" )
       empty_exports export_section
   in
-  let exports =
-    { func = List.rev exports.func
-    ; table = List.rev exports.table
-    ; mem = List.rev exports.mem
-    ; global = List.rev exports.global
+  let exports =
+    { func = List.rev exports.func
+    ; table = List.rev exports.table
+    ; mem = List.rev exports.mem
+    ; global = List.rev exports.global
     }
   in
 
   { id = None
+  ; types
   ; global
   ; mem
   ; elem
@@ -3954,21 +4001,21 @@ 
60.69%

   }
 
 let from_string content =
-  let* () = magic_check content in
-  let* () = version_check content in
-  let* input = Input.of_string content |> Input.sub_suffix 8 in
-  let* m = sections_iterate input in
-  m
+  let* () = magic_check content in
+  let* () = version_check content in
+  let* input = Input.of_string content |> Input.sub_suffix 8 in
+  let* m = sections_iterate input in
+  m
 
 let from_channel chan =
-  let content = In_channel.input_all chan in
-  from_string content
+  let content = In_channel.input_all chan in
+  from_string content
 
 let from_file (filename : Fpath.t) =
-  let* res =
-    Bos.OS.File.with_ic filename (fun chan () -> from_channel chan) ()
+  let* res =
+    Bos.OS.File.with_ic filename (fun chan () -> from_channel chan) ()
   in
-  res
+  res
diff --git a/coverage/src/parser/parse.ml.html b/coverage/src/parser/parse.ml.html index 25a4e2029..b1df0d563 100644 --- a/coverage/src/parser/parse.ml.html +++ b/coverage/src/parser/parse.ml.html @@ -3,7 +3,7 @@ parse.ml — Coverage report - + @@ -15,13 +15,317 @@

src/parser/parse.ml

-

82.35%

+

10.40%

@@ -37,170 +341,798 @@

82.35%

- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + 
- 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
+  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
+232
+233
+234
+235
+236
+237
+238
+239
+240
+241
+242
+243
+244
+245
+246
+247
+248
+249
+250
+251
+252
+253
+254
+255
+256
+257
+258
+259
+260
+261
+262
+263
+264
+265
+266
+267
+268
+269
+270
+271
+272
+273
+274
+275
+276
+277
+278
+279
+280
+281
+282
+283
+284
+285
+286
+287
+288
+289
+290
+291
+292
+293
+294
+295
+296
+297
+298
+299
+300
+301
+302
+303
+304
+305
+306
+307
+308
+309
+310
+311
+312
+313
+314
+315
+316
+317
+318
+319
+320
+321
+322
+323
+324
+325
+326
+327
+328
+329
+330
+331
+332
+333
+334
+335
+336
+337
+338
+339
+340
+341
+342
+343
+344
+345
+346
+347
+348
+349
+350
+351
+352
+353
+354
+355
+356
+357
+358
+359
+360
+361
+362
+363
+364
+365
+366
+367
+368
+369
+370
+371
+372
+373
+374
+375
+376
+377
+378
+379
+380
+381
+382
+383
+384
+385
+386
+387
+388
+389
+390
+391
+392
+393
+394
+395
+396
+397
+398
+399
 
(* SPDX-License-Identifier: AGPL-3.0-or-later *)
 (* Copyright © 2021-2024 OCamlPro *)
@@ -211,6 +1143,318 @@ 
82.35%

 
 open Syntax
 
+let token_to_string = function
+  | Text_parser.OFFSET -> "offset"
+  | UNREACHABLE -> "unreachable"
+  | TYPE -> "type"
+  | THEN -> "then"
+  | TABLE_SIZE -> "table.size"
+  | TABLE_SET -> "table.set"
+  | TABLE_INIT -> "table.init"
+  | TABLE_GROW -> "table.grow"
+  | TABLE_GET -> "table.get"
+  | TABLE_FILL -> "table.fill"
+  | TABLE_COPY -> "table.copy"
+  | TABLE -> "table"
+  | SUB -> "sub"
+  | STRUCT_SET -> "struct.set"
+  | STRUCT_NEW_CANON_DEFAULT -> "struct.new_canon_default"
+  | STRUCT_NEW_CANON -> "struct.new_canon"
+  | STRUCT_GET_S -> "struct.get_s"
+  | STRUCT_GET -> "struct.get"
+  | STRUCTREF -> "structref"
+  | STRUCT -> "struct"
+  | START -> "start"
+  | SELECT -> "select"
+  | RPAR -> ")"
+  | RETURN_CALL_REF -> "return_call_ref"
+  | RETURN_CALL_INDIRECT -> "return_call_indirect"
+  | RETURN_CALL -> "return_call"
+  | RETURN -> "return"
+  | RESULT -> "result"
+  | REGISTER -> "register"
+  | REF_TEST -> "ref.test"
+  | REF_STRUCT -> "ref.struct"
+  | REF_NULL -> "ref.null"
+  | REF_IS_NULL -> "ref.is_null"
+  | REF_I31 -> "ref.i31"
+  | REF_HOST -> "ref.host"
+  | REF_FUNC -> "ref.func"
+  | REF_EXTERN -> "ref.extern"
+  | REF_EQ -> "ref.eq"
+  | REF_CAST -> "ref.cast"
+  | REF_AS_NON_NULL -> "ref.as_non_null"
+  | REF_ARRAY -> "ref.array"
+  | REF -> "ref"
+  | REC -> "rec"
+  | QUOTE -> "quote"
+  | PARAM -> "param"
+  | NULL_REF -> "null.ref"
+  | NULL_FUNC_REF -> "null.func_ref"
+  | NULL_EXTERN_REF -> "null.extern_ref"
+  | NULL -> "null"
+  | NOP -> "nop"
+  | NONE -> "none"
+  | NOFUNC -> "nofunc"
+  | NOEXTERN -> "noextern"
+  | NAN_CANON -> "nan_canon"
+  | NAN_ARITH -> "nan_arith"
+  | MUTABLE -> "mutable"
+  | MODULE -> "module"
+  | MEMORY_SIZE -> "memory.size"
+  | MEMORY_INIT -> "memory.init"
+  | MEMORY_GROW -> "memory.grow"
+  | MEMORY_FILL -> "memory.fill"
+  | MEMORY_COPY -> "memory.copy"
+  | MEMORY -> "memory"
+  | LPAR -> "("
+  | LOOP -> "loop"
+  | LOCAL_TEE -> "local.tee"
+  | LOCAL_SET -> "local.set"
+  | LOCAL_GET -> "local.get"
+  | LOCAL -> "local"
+  | ITEM -> "item"
+  | INVOKE -> "invoke"
+  | IMPORT -> "import"
+  | IF -> "if"
+  | I8 -> "i8"
+  | I64_XOR -> "i64.xor"
+  | I64_TRUNC_SAT_F64_U -> "i64.trunc_sat_f64_u"
+  | I64_TRUNC_SAT_F64_S -> "i64.trunc_sat_f64_s"
+  | I64_TRUNC_SAT_F32_U -> "i64.trunc_sat_f32_s"
+  | I64_TRUNC_SAT_F32_S -> "i64.trunc_sat_f32_u"
+  | I64_TRUNC_F64_U -> "i64.trunc_f64_u"
+  | I64_TRUNC_F64_S -> "i64.trunc_f64_s"
+  | I64_TRUNC_F32_U -> "i64.trunc_f32_u"
+  | I64_TRUNC_F32_S -> "i64.trunc_f32_s"
+  | I64_SUB -> "i64.sub"
+  | I64_STORE8 -> "i64.store8"
+  | I64_STORE32 -> "i64.store32"
+  | I64_STORE16 -> "i64.store16"
+  | I64_STORE -> "i64.store"
+  | I64_SHR_U -> "i64.shr_u"
+  | I64_SHR_S -> "i64.shr_s"
+  | I64_SHL -> "i64.shl"
+  | I64_ROTR -> "i64.rotr"
+  | I64_ROTL -> "i64.rotl"
+  | I64_REM_U -> "i64.rem_u"
+  | I64_REM_S -> "i64.rem_s"
+  | I64_REINTERPRET_F64 -> "i64.reinterpret_f64"
+  | I64_REINTERPRET_F32 -> "i64.reinterpret_f32"
+  | I64_POPCNT -> "i64.popcnt"
+  | I64_OR -> "i64.or"
+  | I64_NE -> "i64.ne"
+  | I64_MUL -> "i64.mul"
+  | I64_LT_U -> "i64.lt_u"
+  | I64_LT_S -> "i64.lt_s"
+  | I64_LOAD8_U -> "i64.load8_u"
+  | I64_LOAD8_S -> "i64.load32_u"
+  | I64_LOAD32_U -> "i64.load32_u"
+  | I64_LOAD32_S -> "i64.load32_s"
+  | I64_LOAD16_U -> "i64.load16_u"
+  | I64_LOAD16_S -> "i64.load16_s"
+  | I64_LOAD -> "i64.load"
+  | I64_LE_U -> "i64.le_u"
+  | I64_LE_S -> "i64.le_q"
+  | I64_GT_U -> "i64.gt_u"
+  | I64_GT_S -> "i64.gt_s"
+  | I64_GE_U -> "i64.ge_u"
+  | I64_GE_S -> "i64.ge_s"
+  | I64_EXTEND_I32_U -> "i64.extend_i32_u"
+  | I64_EXTEND_I32_S -> "i64.extend_i32_s"
+  | I64_EXTEND8_S -> "i64_extend8_s"
+  | I64_EXTEND32_S -> "i64.extend32_s"
+  | I64_EXTEND16_S -> "i64.extend16_s"
+  | I64_EQZ -> "i64.eqz"
+  | I64_EQ -> "i64.eq"
+  | I64_DIV_U -> "i64.div_u"
+  | I64_DIV_S -> "i64.div_s"
+  | I64_CTZ -> "i64.ctz"
+  | I64_CONST -> "i64.const"
+  | I64_CLZ -> "i64.clz"
+  | I64_AND -> "i64.and"
+  | I64_ADD -> "i64.add"
+  | I64 -> "i64"
+  | I32_XOR -> "i32.xor"
+  | I32_WRAP_I64 -> "i32.wrap_i64"
+  | I32_TRUNC_SAT_F64_U -> "i32.trunc_sat_f64_u"
+  | I32_TRUNC_SAT_F64_S -> "i32.trunc_sat_f64_s"
+  | I32_TRUNC_SAT_F32_U -> "i32.trunc_sat_f32_u"
+  | I32_TRUNC_SAT_F32_S -> "i32.trunc_sat_f32_s"
+  | I32_TRUNC_F64_U -> "i32.trunc_f64_u"
+  | I32_TRUNC_F64_S -> "i32.trunc_f64_s"
+  | I32_TRUNC_F32_U -> "i32.trunc_f32_u"
+  | I32_TRUNC_F32_S -> "i32.trunc_f32_s"
+  | I32_SUB -> "i32.sub"
+  | I32_STORE8 -> "i32.store8"
+  | I32_STORE16 -> "i32.store16"
+  | I32_STORE -> "i32.store"
+  | I32_SHR_U -> "i32.shr_u"
+  | I32_SHR_S -> "i32.shr_s"
+  | I32_SHL -> "i32.shl"
+  | I32_ROTR -> "i32.rotr"
+  | I32_ROTL -> "i32.rotl"
+  | I32_REM_U -> "i32.rem_u"
+  | I32_REM_S -> "i32.rem_s"
+  | I32_REINTERPRET_F64 -> "i32.reinterpret_f64"
+  | I32_REINTERPRET_F32 -> "i32.reinterpret_f32"
+  | I32_POPCNT -> "i32.popcnt"
+  | I32_OR -> "i32.or"
+  | I32_NE -> "i32.ne"
+  | I32_MUL -> "i32.mul"
+  | I32_LT_U -> "i32.lt_u"
+  | I32_LT_S -> "i32.lt_s"
+  | I32_LOAD8_U -> "i32.load8_u"
+  | I32_LOAD8_S -> "i32.load8_s"
+  | I32_LOAD16_U -> "i32.load16_u"
+  | I32_LOAD16_S -> "i32.load16_s"
+  | I32_LOAD -> "i32.load"
+  | I32_LE_U -> "i32.le_u"
+  | I32_LE_S -> "i32.le_s"
+  | I32_GT_U -> "i32.gt_u"
+  | I32_GT_S -> "i32.gt_s"
+  | I32_GE_U -> "i32.ge_u"
+  | I32_GE_S -> "i32.ge_s"
+  | I32_EXTEND8_S -> "i32.extend8_s"
+  | I32_EXTEND16_S -> "i32.extend16_s"
+  | I32_EQZ -> "i32.eqz"
+  | I32_EQ -> "i32.eq"
+  | I32_DIV_U -> "i32.div_u"
+  | I32_DIV_S -> "i32.div_s"
+  | I32_CTZ -> "i32.ctz"
+  | I32_CONST -> "i32.const"
+  | I32_CLZ -> "i32.clz"
+  | I32_AND -> "i32;and"
+  | I32_ADD -> "i32.add"
+  | I32 -> "i32"
+  | I31_REF -> "i31.ref"
+  | I31_GET_U -> "i31.get_u"
+  | I31_GET_S -> "i31.get_s"
+  | I31 -> "i31"
+  | I16 -> "i16"
+  | GLOBAL_SET -> "global.set"
+  | GLOBAL_GET -> "global.get"
+  | GLOBAL -> "global"
+  | GET -> "get"
+  | FUNC_REF -> "func_ref"
+  | FUNC -> "func"
+  | FINAL -> "final"
+  | FIELD -> "field"
+  | F64_TRUNC -> "f64.trunc"
+  | F64_SUB -> "f64.sub"
+  | F64_STORE -> "f64.store"
+  | F64_SQRT -> "f64.sqrt"
+  | F64_REINTERPRET_I64 -> "f64.reinterpret_i64"
+  | F64_REINTERPRET_I32 -> "f64.reinterpret_i32"
+  | F64_PROMOTE_F32 -> "f64.promote_f32"
+  | F64_NEG -> "f64.neg"
+  | F64_NEAREST -> "f64.nearest"
+  | F64_NE -> "f64.ne"
+  | F64_MUL -> "f64.mul"
+  | F64_MIN -> "f64.min"
+  | F64_MAX -> "f64.max"
+  | F64_LT -> "f64.lt"
+  | F64_LOAD -> "f64.load"
+  | F64_LE -> "f64.le"
+  | F64_GT -> "f64.gt"
+  | F64_GE -> "f64.ge"
+  | F64_FLOOR -> "f64.floor"
+  | F64_EQ -> "f64.eq"
+  | F64_DIV -> "f64.div"
+  | F64_COPYSIGN -> "f64.copysign"
+  | F64_CONVERT_I64_U -> "f64.convert_i64_u"
+  | F64_CONVERT_I64_S -> "f64.convert_i64_s"
+  | F64_CONVERT_I32_U -> "f64.convert_i32_u"
+  | F64_CONVERT_I32_S -> "f64.convert_i32_s"
+  | F64_CONST -> "f64.const"
+  | F64_CEIL -> "f64.ceil"
+  | F64_ADD -> "f64.add"
+  | F64_ABS -> "f64.abs"
+  | F64 -> "f64"
+  | F32_TRUNC -> "f32.trunc"
+  | F32_SUB -> "f32.sub"
+  | F32_STORE -> "f32.store"
+  | F32_SQRT -> "f32.sqrt"
+  | F32_REINTERPRET_I64 -> "f32.reinterpret_i64"
+  | F32_REINTERPRET_I32 -> "f32.reinterpret_i32"
+  | F32_NEG -> "f32.neg"
+  | F32_NEAREST -> "f32.nearest"
+  | F32_NE -> "f32.ne"
+  | F32_MUL -> "f32.mul"
+  | F32_MIN -> "f32.min"
+  | F32_MAX -> "f32.max"
+  | F32_LT -> "f32.lt"
+  | F32_LOAD -> "f32.load"
+  | F32_LE -> "f32.le"
+  | F32_GT -> "f32.gt"
+  | F32_GE -> "f32.ge"
+  | F32_FLOOR -> "f32.floor"
+  | F32_EQ -> "f32.eq"
+  | F32_DIV -> "f32.div"
+  | F32_DEMOTE_F64 -> "f32.demote_f64"
+  | F32_COPYSIGN -> "f32.copysign"
+  | F32_CONVERT_I64_U -> "f32.convert_i64_u"
+  | F32_CONVERT_I64_S -> "f32.convert_i64_s"
+  | F32_CONVERT_I32_U -> "f32.convert_i32_u"
+  | F32_CONVERT_I32_S -> "f32.convert_i32_s"
+  | F32_CONST -> "f32.const"
+  | F32_CEIL -> "f32.ceil"
+  | F32_ADD -> "f32.add"
+  | F32_ABS -> "f32.abs"
+  | F32 -> "f32"
+  | EXTERN_REF -> "externref"
+  | EXTERN_INTERNALIZE -> "extern.internalize"
+  | EXTERN_EXTERNALIZE -> "extern.externalize"
+  | EXTERN -> "extern"
+  | EXPORT -> "export"
+  | EQ_REF -> "eqref"
+  | EQUAL -> "equal"
+  | EQ -> "eq"
+  | EOF -> "EOF"
+  | END -> "end"
+  | ELSE -> "else"
+  | ELEM_DROP -> "elem.drop"
+  | ELEM -> "elem"
+  | DROP -> "drop"
+  | DECLARE -> "declare"
+  | DATA_DROP -> "data.drop"
+  | DATA -> "data"
+  | CALL_REF -> "call_ref"
+  | CALL_INDIRECT -> "call_indirect"
+  | CALL -> "call"
+  | BR_TABLE -> "br_table"
+  | BR_ON_NULL -> "br_on_null"
+  | BR_ON_NON_NULL -> "br_on_non_null"
+  | BR_ON_CAST_FAIL -> "br_on_cast_fail"
+  | BR_ON_CAST -> "br_on_cast"
+  | BR_IF -> "br_if"
+  | BR -> "br"
+  | BLOCK -> "block"
+  | BINARY -> "binary"
+  | ASSERT_UNLINKABLE -> "assert_unlinkable"
+  | ASSERT_TRAP -> "assert_trap"
+  | ASSERT_RETURN -> "assert_return"
+  | ASSERT_MALFORMED -> "assert_malformed"
+  | ASSERT_INVALID -> "assert_exhaustion"
+  | ASSERT_EXHAUSTION -> "assert_exhaustion"
+  | ARRAY_SET -> "array.set"
+  | ARRAY_REF -> "arrayrref"
+  | ARRAY_NEW_CANON_FIXED -> "array.new_canon_fixed"
+  | ARRAY_NEW_CANON_ELEM -> "array.new_canon_elem"
+  | ARRAY_NEW_CANON_DEFAULT -> "array.new_canon_default"
+  | ARRAY_NEW_CANON_DATA -> "array.new_canon_data"
+  | ARRAY_NEW_CANON -> "array.new_canon"
+  | ARRAY_LEN -> "array.len"
+  | ARRAY_GET_U -> "array.get_u"
+  | ARRAY_GET -> "array.get"
+  | ARRAY -> "array"
+  | ANY_REF -> "anyref"
+  | ANY -> "any"
+  | ALIGN -> "align"
+  | NUM s -> Fmt.str "%s" s
+  | NAME s -> Fmt.str {|"%s"|} s
+  | ID s -> Fmt.str "$%s" s
+
 module Make (M : sig
   type t
 
@@ -219,34 +1463,36 @@ 
82.35%

 struct
   let from_lexbuf =
     let parser = MenhirLib.Convert.Simplified.traditional2revised M.rule in
-    fun buf ->
-      Log.debug0 "parsing      ...@\n";
-      let provider () =
-        let tok = Text_lexer.token buf in
-        let start, stop = Sedlexing.lexing_positions buf in
-        (tok, start, stop)
+    fun buf ->
+      Log.debug0 "parsing      ...@\n";
+      let provider () =
+        let tok = Text_lexer.token buf in
+        let start, stop = Sedlexing.lexing_positions buf in
+        (tok, start, stop)
       in
-      try Ok (parser provider) with
-      | Types.Parse_fail msg -> Error (`Parse_fail msg)
+      try Ok (parser provider) with
+      | Types.Parse_fail msg -> Error (`Parse_fail msg)
       | Text_lexer.Illegal_escape msg -> Error (`Illegal_escape msg)
-      | Text_lexer.Unknown_operator msg -> Error (`Lexer_unknown_operator msg)
+      | Text_lexer.Unknown_operator msg -> Error (`Lexer_unknown_operator msg)
       | Text_lexer.Unexpected_character msg ->
         Error (`Lexer_unknown_operator msg)
-      | Text_parser.Error -> Error `Unexpected_token
+      | Text_parser.Error ->
+        let tok = Text_lexer.token buf |> token_to_string in
+        Error (`Unexpected_token tok)
 
   let from_file filename =
-    let open Syntax in
+    let open Syntax in
     let* res =
-      Bos.OS.File.with_ic filename
+      Bos.OS.File.with_ic filename
         (fun chan () ->
-          let lb = Sedlexing.Utf8.from_channel chan in
-          Sedlexing.set_filename lb (Fpath.to_string filename);
-          from_lexbuf lb )
+          let lb = Sedlexing.Utf8.from_channel chan in
+          Sedlexing.set_filename lb (Fpath.to_string filename);
+          from_lexbuf lb )
         ()
     in
-    res
+    res
 
-  let from_string s = from_lexbuf (Sedlexing.Utf8.from_string s)
+  let from_string s = from_lexbuf (Sedlexing.Utf8.from_string s)
 
   let from_channel c = from_lexbuf (Sedlexing.Utf8.from_channel c)
 end
@@ -276,16 +1522,16 @@ 
82.35%

 end
 
 let guess_from_file file =
-  match Fpath.get_ext ~multi:false file with
-  | ".wat" ->
-    let+ m = Text.Module.from_file file in
-    Either.Left (Either.Left m)
+  match Fpath.get_ext ~multi:false file with
+  | ".wat" ->
+    let+ m = Text.Module.from_file file in
+    Kind.Wat m
   | ".wast" ->
     let+ m = Text.Script.from_file file in
-    Either.Left (Either.Right m)
-  | ".wasm" ->
-    let+ m = Binary.Module.from_file file in
-    Either.Right m
+    Kind.Wast m
+  | ".wasm" ->
+    let+ m = Binary.Module.from_file file in
+    Kind.Wasm m
   | ext -> Error (`Unsupported_file_extension ext)
diff --git a/coverage/src/primitives/convert.ml.html b/coverage/src/primitives/convert.ml.html index 5c25dd598..841ce39d9 100644 --- a/coverage/src/primitives/convert.ml.html +++ b/coverage/src/primitives/convert.ml.html @@ -3,7 +3,7 @@ convert.ml — Coverage report - + @@ -15,10 +15,10 @@

src/primitives/convert.ml

-

99.63%

+

99.71%

@@ -41,54 +41,54 @@

99.63%

- + - - + + - + - + - + - + - - + + - - + + - + - - + + - + - + - - - + + + - + - + - - - + + + @@ -96,43 +96,43 @@

99.63%

- + - - - - - - + + + + + + - + - + - + - + - + - + - - + + - - + + - + @@ -140,152 +140,152 @@

99.63%

- + - - - - + + + + - + - + - - - + + + - + - - - + + + - - - - - + + + + + - + - - + + - + - - + + - - + + - - + + - + - - + + - - + + - - - + + + - + - + - + - + - + - + - + - - - + + + - + - - + + - - - + + + - + - - + + - - - + + + - - - - + + + + - + - - + + - - + + @@ -293,6 +293,19 @@

99.63%

+ + + + + + + + + + + + +
@@ -567,6 +580,19 @@

99.63%

268 269 270 +271 +272 +273 +274 +275 +276 +277 +278 +279 +280 +281 +282 +283 
(* SPDX-License-Identifier: Apache-2.0 *)
 (* Copyright 2017 WebAssembly Community Group participants *)
@@ -585,67 +611,74 @@ 
99.63%

     if Float32.ne x x then raise @@ Types.Trap "invalid conversion to integer"
     else
       let xf = Float32.to_float x in
-      if xf >= -.Int32.(to_float min_int) || xf < Int32.(to_float min_int) then
-        raise @@ Types.Trap "integer overflow"
+      if
+        let xf = Float64.of_float xf in
+        let mif = Int32.(to_float min_int) in
+        Float64.(ge xf (of_float ~-.mif)) || Float64.(lt xf (of_float mif))
+      then raise @@ Types.Trap "integer overflow"
       else Int32.of_float xf
 
   let trunc_f32_u x =
     if Float32.ne x x then raise @@ Types.Trap "invalid conversion to integer"
     else
       let xf = Float32.to_float x in
-      if xf >= -.Int32.(to_float min_int) *. 2.0 || xf <= -1.0 then
-        raise @@ Types.Trap "integer overflow"
+      if
+        let xf = Float64.of_float xf in
+        Float64.(ge xf (of_float @@ (-.Int32.(to_float min_int) *. 2.0)))
+        || Float64.(le xf (Float64.of_float ~-.1.0))
+      then raise @@ Types.Trap "integer overflow"
       else Int64.(to_int32 (of_float xf))
 
   let trunc_f64_s x =
     if Float64.ne x x then raise @@ Types.Trap "invalid conversion to integer"
-    else
-      let xf = Float64.to_float x in
-      if
-        xf >= -.Int32.(to_float min_int)
-        || xf <= Int32.(to_float min_int) -. 1.0
-      then raise @@ Types.Trap "integer overflow"
-      else Int32.of_float xf
+    else if
+      let mif = Int32.(to_float min_int) in
+      Float64.(ge x (of_float @@ -.mif))
+      || Float64.(le x (of_float @@ (mif -. 1.0)))
+    then raise @@ Types.Trap "integer overflow"
+    else Int32.of_float (Float64.to_float x)
 
   let trunc_f64_u x =
     if Float64.ne x x then raise @@ Types.Trap "invalid conversion to integer"
-    else
-      let xf = Float64.to_float x in
-      if xf >= -.Int32.(to_float min_int) *. 2.0 || xf <= -1.0 then
-        raise @@ Types.Trap "integer overflow"
-      else Int64.(to_int32 (of_float xf))
+    else if
+      let mif = Int32.to_float Int32.min_int in
+      Float64.(ge x (of_float @@ (-.mif *. 2.0)))
+      || Float64.(le x (of_float ~-.1.0))
+    then raise @@ Types.Trap "integer overflow"
+    else Int64.(to_int32 (of_float (Float64.to_float x)))
 
   let trunc_sat_f32_s x =
     if Float32.ne x x then 0l
     else
-      let xf = Float32.to_float x in
-      if xf < Int32.(to_float min_int) then Int32.min_int
-      else if xf >= -.Int32.(to_float min_int) then Int32.max_int
-      else Int32.of_float xf
+      let xf = Float32.to_float x |> Float64.of_float in
+      let mif = Int32.(to_float min_int) in
+      if Float64.(lt xf (of_float mif)) then Int32.min_int
+      else if Float64.(ge xf (of_float ~-.mif)) then Int32.max_int
+      else Int32.of_float (Float64.to_float xf)
 
   let trunc_sat_f32_u x =
     if Float32.ne x x then 0l
     else
-      let xf = Float32.to_float x in
-      if xf <= -1.0 then 0l
-      else if xf >= -.Int32.(to_float min_int) *. 2.0 then -1l
-      else Int64.(to_int32 (of_float xf))
+      let xf = Float32.to_float x |> Float64.of_float in
+      if Float64.(le xf (of_float ~-.1.0)) then 0l
+      else if Float64.(ge xf @@ of_float @@ (~-.Int32.(to_float min_int) *. 2.0))
+      then -1l
+      else Int64.(to_int32 @@ of_float (Float64.to_float xf))
 
   let trunc_sat_f64_s x =
     if Float64.ne x x then 0l
-    else
-      let xf = Float64.to_float x in
-      if xf < Int32.(to_float min_int) then Int32.min_int
-      else if xf >= -.Int32.(to_float min_int) then Int32.max_int
-      else Int32.of_float xf
+    else if Float64.(le x @@ of_float @@ Int32.(to_float min_int)) then
+      Int32.min_int
+    else if Float64.(ge x @@ of_float @@ ~-.Int32.(to_float min_int)) then
+      Int32.max_int
+    else Int32.of_float @@ Float64.to_float x
 
   let trunc_sat_f64_u x =
     if Float64.ne x x then 0l
-    else
-      let xf = Float64.to_float x in
-      if xf <= -1.0 then 0l
-      else if xf >= -.Int32.(to_float min_int) *. 2.0 then -1l
-      else Int64.(to_int32 (of_float xf))
+    else if Float64.(le x @@ of_float ~-.1.0) then 0l
+    else if Float64.(ge x @@ of_float @@ ~-.(Int32.(to_float min_int) *. 2.0))
+    then -1l
+    else Int64.(to_int32 (of_float @@ Float64.to_float x))
 
   let reinterpret_f32 = Float32.to_bits
 end
@@ -655,79 +688,87 @@ 
99.63%

 
   let extend_i32_s x = Int64.of_int32 x
 
-  let extend_i32_u x = Int64.logand (Int64.of_int32 x) 0x0000_0000_ffff_ffffL
+  let extend_i32_u x = Int64.logand (Int64.of_int32 x) 0x0000_0000_ffff_ffffL
 
   let trunc_f32_s x =
     if Float32.ne x x then raise @@ Types.Trap "invalid conversion to integer"
-    else
-      let xf = Float32.to_float x in
-      if xf >= -.Int64.(to_float min_int) || xf < Int64.(to_float min_int) then
-        raise @@ Types.Trap "integer overflow"
-      else Int64.of_float xf
+    else if
+      let mif = Int64.(to_float min_int) in
+      Float32.(ge x @@ of_float @@ ~-.mif) || Float32.(lt x @@ of_float mif)
+    then raise @@ Types.Trap "integer overflow"
+    else Int64.of_float @@ Float32.to_float x
 
   let trunc_f32_u x =
-    if Float32.ne x x then raise @@ Types.Trap "invalid conversion to integer"
-    else
-      let xf = Float32.to_float x in
-      if xf >= -.Int64.(to_float min_int) *. 2.0 || xf <= -1.0 then
-        raise @@ Types.Trap "integer overflow"
-      else if xf >= -.Int64.(to_float min_int) then
-        Int64.(logxor (of_float (xf -. 0x1p63)) min_int)
-      else Int64.of_float xf
+    let mif = Int64.(to_float min_int) in
+    if Float32.ne x x then raise @@ Types.Trap "invalid conversion to integer"
+    else if
+      Float32.(ge x @@ of_float ~-.(mif *. 2.0))
+      || Float32.(le x @@ of_float ~-.1.0)
+    then raise @@ Types.Trap "integer overflow"
+    else if Float32.(ge x @@ of_float ~-.mif) then
+      Int64.(logxor (of_float (Float32.to_float x -. 0x1p63)) min_int)
+    else Int64.of_float @@ Float32.to_float x
 
   let trunc_f64_s x =
     if Float64.ne x x then raise @@ Types.Trap "invalid conversion to integer"
-    else
-      let xf = Float64.to_float x in
-      if xf >= -.Int64.(to_float min_int) || xf < Int64.(to_float min_int) then
-        raise @@ Types.Trap "integer overflow"
-      else Int64.of_float xf
+    else if
+      let mif = Int64.(to_float min_int) in
+      Float64.(ge x @@ of_float ~-.mif) || Float64.(lt x @@ of_float mif)
+    then raise @@ Types.Trap "integer overflow"
+    else Int64.of_float @@ Float64.to_float x
 
   let trunc_f64_u x =
-    if Float64.ne x x then raise @@ Types.Trap "invalid conversion to integer"
-    else
-      let xf = Float64.to_float x in
-      if xf >= -.Int64.(to_float min_int) *. 2.0 || xf <= -1.0 then
-        raise @@ Types.Trap "integer overflow"
-      else if xf >= -.Int64.(to_float min_int) then
-        Int64.(logxor (of_float (xf -. 0x1p63)) min_int)
-      else Int64.of_float xf
+    let mif = Int64.(to_float min_int) in
+    if Float64.ne x x then raise @@ Types.Trap "invalid conversion to integer"
+    else if
+      Float64.(ge x @@ of_float (~-.mif *. 2.0))
+      || Float64.(le x @@ of_float ~-.1.0)
+    then raise @@ Types.Trap "integer overflow"
+    else if Float64.(ge x @@ of_float ~-.mif) then
+      Int64.(logxor (of_float (Float64.to_float x -. 0x1p63)) min_int)
+    else Int64.of_float @@ Float64.to_float x
 
   let trunc_sat_f32_s x =
     if Float32.ne x x then 0L
     else
-      let xf = Float32.to_float x in
-      if xf < Int64.(to_float min_int) then Int64.min_int
-      else if xf >= -.Int64.(to_float min_int) then Int64.max_int
-      else Int64.of_float xf
+      let mif = Int64.(to_float min_int) in
+      if Float32.(lt x @@ of_float mif) then Int64.min_int
+      else if Float32.(ge x @@ of_float ~-.mif) then Int64.max_int
+      else Int64.of_float (Float32.to_float x)
 
   let trunc_sat_f32_u x =
     if Float32.ne x x then 0L
     else
-      let xf = Float32.to_float x in
-      if xf <= -1.0 then 0L
-      else if xf >= -.Int64.(to_float min_int) *. 2.0 then -1L
-      else if xf >= -.Int64.(to_float min_int) then
-        Int64.(logxor (of_float (xf -. 9223372036854775808.0)) min_int)
-      else Int64.of_float xf
+      let mif = Int64.(to_float min_int) in
+      if Float32.(le x @@ of_float ~-.1.0) then 0L
+      else if Float32.(ge x @@ of_float (~-.mif *. 2.0)) then -1L
+      else if Float32.(ge x @@ of_float ~-.mif) then
+        Int64.(
+          logxor
+            (of_float (Float32.to_float x -. 9223372036854775808.0))
+            min_int )
+      else Int64.of_float @@ Float32.to_float x
 
   let trunc_sat_f64_s x =
     if Float64.ne x x then 0L
     else
-      let xf = Float64.to_float x in
-      if xf < Int64.(to_float min_int) then Int64.min_int
-      else if xf >= -.Int64.(to_float min_int) then Int64.max_int
-      else Int64.of_float xf
+      let mif = Int64.(to_float min_int) in
+      if Float64.(lt x @@ of_float mif) then Int64.min_int
+      else if Float64.(ge x @@ of_float ~-.mif) then Int64.max_int
+      else Int64.of_float @@ Float64.to_float x
 
   let trunc_sat_f64_u x =
     if Float64.ne x x then 0L
     else
-      let xf = Float64.to_float x in
-      if xf <= -1.0 then 0L
-      else if xf >= -.Int64.(to_float min_int) *. 2.0 then -1L
-      else if xf >= -.Int64.(to_float min_int) then
-        Int64.(logxor (of_float (xf -. 9223372036854775808.0)) min_int)
-      else Int64.of_float xf
+      let mif = Int64.(to_float min_int) in
+      if Float64.(le x @@ of_float ~-.1.0) then 0L
+      else if Float64.(ge x @@ of_float @@ (~-.mif *. 2.0)) then -1L
+      else if Float64.(ge x @@ of_float ~-.mif) then
+        Int64.(
+          logxor
+            (of_float (Float64.to_float x -. 9223372036854775808.0))
+            min_int )
+      else Int64.of_float @@ Float64.to_float x
 
   let reinterpret_f64 = Float64.to_bits
 end
@@ -736,8 +777,7 @@ 
99.63%

   type t = Float32.t
 
   let demote_f64 x =
-    let xf = Float64.to_float x in
-    if xf = xf then Float32.of_float xf
+    if Float64.eq x x then Float32.of_float @@ Float64.to_float x
     else
       let nan64bits = Float64.to_bits x in
       let sign_field =
@@ -760,7 +800,7 @@ 
99.63%

   let convert_i32_u x =
     Float32.of_float
       Int32.(
-        if x >= zero then to_float x
+        if Int32.ge x zero then to_float x
         else to_float (logor (shift_right_logical x 1) (logand x 1l)) *. 2.0 )
 
   (*
@@ -772,17 +812,17 @@ 
99.63%

   let convert_i64_s (x : int64) =
     Float32.of_float
       Int64.(
-        if abs x < 0x10_0000_0000_0000L then to_float x
+        if Int64.lt (abs x) 0x10_0000_0000_0000L then to_float x
         else
-          let r = if logand x 0xfffL = 0L then 0L else 1L in
+          let r = if Int64.eq (logand x 0xfffL) 0L then 0L else 1L in
           to_float (logor (shift_right x 12) r) *. 0x1p12 )
 
   let convert_i64_u x =
     Float32.of_float
       Int64.(
-        if lt_u x 0x10_0000_0000_0000L then to_float x
+        if Int64.lt_u x 0x10_0000_0000_0000L then to_float x
         else
-          let r = if logand x 0xfffL = 0L then 0L else 1L in
+          let r = if Int64.eq (logand x 0xfffL) 0L then 0L else 1L in
           to_float (logor (shift_right_logical x 12) r) *. 0x1p12 )
 
   let reinterpret_i32 = Float32.of_bits
@@ -792,8 +832,7 @@ 
99.63%

   type t = Float64.t
 
   let promote_f32 x =
-    let xf = Float32.to_float x in
-    if xf = xf then Float64.of_float xf
+    if Float32.eq x x then Float64.of_float @@ Float32.to_float x
     else
       let nan32bits = MInt64.extend_i32_u (Float32.to_bits x) in
       let sign_field =
@@ -828,7 +867,7 @@ 
99.63%

   let convert_i64_u x =
     Float64.of_float
       Int64.(
-        if x >= zero then to_float x
+        if Int64.ge x zero then to_float x
         else to_float (logor (shift_right_logical x 1) (logand x 1L)) *. 2.0 )
 
   let reinterpret_i64 = Float64.of_bits
diff --git a/coverage/src/primitives/float32.ml.html b/coverage/src/primitives/float32.ml.html
index a8d95378e..e112449c8 100644
--- a/coverage/src/primitives/float32.ml.html
+++ b/coverage/src/primitives/float32.ml.html
@@ -3,7 +3,7 @@
   
     
     float32.ml — Coverage report
-    
+    
     
     
     
@@ -15,22 +15,17 @@ 

           src/primitives/float32.ml
         
       

-      
91.84%

+      
96.93%
@@ -65,21 +60,21 @@

91.84%

- + - + - + - + - + @@ -89,11 +84,11 @@

91.84%

- + - + @@ -103,21 +98,21 @@

91.84%

- + - - - - - + + + + + - - + + @@ -132,241 +127,275 @@

91.84%

- - - - + + + + - - - - + + + + - + - - + + - + - + - - - - + + + + - + - - + + - + - - - + + + - - - - - + + + + + - - + + - - + + - + - - - - - - + + + + + + - - + + - - + + - + - - - - - - + + + + + + - - + + - + - + - - - + + + - + - + - + - + - - - - + + + + - - + + - + - + - + - + - + - - + + - - + + - + - - - - + + + + - - + + - + - - + + - - - + + + - + - + - + - - - - + + + + - + - - - - + + + + - - + + - + - - - + + + - - + + - - - - + + + + - - - - + + + + - - - + + + - - - - + + + + - - + + - - - - - - - + + + + + + + - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
@@ -703,6 +732,40 @@

91.84%

330 331 332 +333 +334 +335 +336 +337 +338 +339 +340 +341 +342 +343 +344 +345 +346 +347 +348 +349 +350 +351 +352 +353 +354 +355 +356 +357 +358 +359 +360 +361 +362 +363 +364 +365 +366 
(* SPDX-License-Identifier: Apache-2.0 *)
 (* Copyright 2017 WebAssembly Community Group participants *)
@@ -718,27 +781,31 @@ 
91.84%

 
 let bare_nan = 0x7f80_0000l
 
-let to_hex_string = Printf.sprintf "%lx"
+let to_hex_string = Fmt.str "%lx"
 
 type t = Int32.t
 
-let pos_inf = Int32.bits_of_float (1.0 /. 0.0)
+let pos_inf = Int32.bits_of_float (1.0 /. 0.0)
 
-let neg_inf = Int32.bits_of_float (-.(1.0 /. 0.0))
+let neg_inf = Int32.bits_of_float (-.(1.0 /. 0.0))
 
 let of_float = Int32.bits_of_float
 
 let to_float = Int32.float_of_bits
 
-let of_bits x = x
+let of_bits x = x
 
-let to_bits x = x
+let to_bits x = x
 
-let is_inf x = x = pos_inf || x = neg_inf
+let is_inf x = Int32.eq x pos_inf || Int32.eq x neg_inf
 
 let is_nan x =
-  let xf = Int32.float_of_bits x in
-  xf <> xf
+  let xf = Int32.float_of_bits x in
+  Float.is_nan xf
+
+let is_pos_nan f = Int32.eq f pos_nan
+
+let is_neg_nan f = Int32.eq f neg_nan
 
 (*
  * When the result of an arithmetic operation is NaN, the most significant
@@ -776,18 +843,18 @@ 
91.84%

   canonicalize_nan nan
 
 let binary x op y =
-  let xf = to_float x in
-  let yf = to_float y in
-  let t = op xf yf in
-  if t = t then of_float t else determine_binary_nan x y
+  let xf = to_float x in
+  let yf = to_float y in
+  let t = op xf yf in
+  if not @@ Float.is_nan t then of_float t else determine_binary_nan x y
 
 let unary op x =
   let t = op (to_float x) in
-  if t = t then of_float t else determine_unary_nan x
+  if not @@ Float.is_nan t then of_float t else determine_unary_nan x
 
-let zero = of_float 0.0
+let zero = of_float 0.0
 
-let add x y = binary x ( +. ) y
+let add x y = binary x ( +. ) y
 
 let sub x y = binary x ( -. ) y
 
@@ -795,87 +862,114 @@ 
91.84%

 
 let div x y = binary x ( /. ) y
 
-let sqrt x = unary Stdlib.sqrt x
+let sqrt x = unary Float.sqrt x
 
-let ceil x = unary Stdlib.ceil x
+let ceil x = unary Float.ceil x
 
-let floor x = unary Stdlib.floor x
+let floor x = unary Float.floor x
 
 let trunc x =
   let xf = to_float x in
   (* preserve the sign of zero *)
-  if xf = 0.0 then x
+  if Float.equal xf 0.0 then x
   else
     (* trunc is either ceil or floor depending on which one is toward zero *)
-    let f = if xf < 0.0 then Stdlib.ceil xf else Stdlib.floor xf in
+    let f =
+      if Float.compare xf 0.0 < 0 then Float.ceil xf else Float.floor xf
+    in
     let result = of_float f in
     if is_nan result then determine_unary_nan result else result
 
 let nearest x =
   let xf = to_float x in
   (* preserve the sign of zero *)
-  if xf = 0.0 then x
+  if Float.equal xf 0.0 then x
   else
     (* nearest is either ceil or floor depending on which is nearest or even *)
-    let u = Stdlib.ceil xf in
-    let d = Stdlib.floor xf in
+    let u = Float.ceil xf in
+    let d = Float.floor xf in
     let um = abs_float (xf -. u) in
     let dm = abs_float (xf -. d) in
+    let delta_u_d = Float.compare um dm in
     let u_or_d =
-      um < dm
-      || um = dm
+      delta_u_d < 0
+      || delta_u_d = 0
          &&
-         let h = u /. 2. in
-         Stdlib.floor h = h
+         let h = u /. 2. in
+         Float.equal (Float.floor h) h
     in
-    let f = if u_or_d then u else d in
+    let f = if u_or_d then u else d in
     let result = of_float f in
     if is_nan result then determine_unary_nan result else result
 
 let min x y =
   let xf = to_float x in
   let yf = to_float y in
-  (* min -0 0 is -0 *)
-  if xf = yf then Int32.logor x y
-  else if xf < yf then x
-  else if xf > yf then y
-  else determine_binary_nan x y
+
+  if Float.is_nan xf || Float.is_nan yf then determine_binary_nan x y
+  else
+    let delta = Float.compare xf yf in
+    if delta < 0 then x
+    else if delta > 0 then y
+    else (* min -0 0 is -0 *)
+      Int32.logor x y
 
 let max x y =
   let xf = to_float x in
   let yf = to_float y in
-  (* max -0 0 is 0 *)
-  if xf = yf then Int32.logand x y
-  else if xf > yf then x
-  else if xf < yf then y
-  else determine_binary_nan x y
+
+  if Float.is_nan xf || Float.is_nan yf then determine_binary_nan x y
+  else
+    let delta = Float.compare xf yf in
+    if delta < 0 then y
+    else if delta > 0 then x
+    else (* max -0 0 is 0 *)
+      Int32.logand x y
 
 (* abs, neg, copysign are purely bitwise operations, even on NaN values *)
-let abs x = Int32.logand x Int32.max_int
+let abs x = Int32.logand x Int32.max_int
 
-let neg x = Int32.logxor x Int32.min_int
+let neg x = Int32.logxor x Int32.min_int
 
 let copy_sign x y = Int32.logor (abs x) (Int32.logand y Int32.min_int)
 
-let eq x y = to_float x = to_float y
+let eq x y =
+  let x = to_float x in
+  let y = to_float y in
+  if Float.is_nan x || Float.is_nan y then false else Float.compare x y = 0
 
-let ne x y = to_float x <> to_float y
+let ne x y =
+  let x = to_float x in
+  let y = to_float y in
+  if Float.is_nan x || Float.is_nan y then true else Float.compare x y <> 0
 
-let lt x y = to_float x < to_float y
+let lt x y =
+  let x = to_float x in
+  let y = to_float y in
+  if Float.is_nan x || Float.is_nan y then false else Float.compare x y < 0
 
-let gt x y = to_float x > to_float y
+let gt x y =
+  let x = to_float x in
+  let y = to_float y in
+  if Float.is_nan x || Float.is_nan y then false else Float.compare x y > 0
 
-let le x y = to_float x <= to_float y
+let le x y =
+  let x = to_float x in
+  let y = to_float y in
+  if Float.is_nan x || Float.is_nan y then false else Float.compare x y <= 0
 
-let ge x y = to_float x >= to_float y
+let ge x y =
+  let x = to_float x in
+  let y = to_float y in
+  if Float.is_nan x || Float.is_nan y then false else Float.compare x y >= 0
 
 (*
  * Compare mantissa of two floats in string representation (hex or dec).
  * This is a gross hack to detect rounding during parsing of floats.
  *)
-let is_hex c = ('0' <= c && c <= '9') || ('A' <= c && c <= 'F')
+let is_hex = function '0' .. '9' -> true | 'A' .. 'F' -> true | _ -> false
 
-let is_exp hex c = c = if hex then 'P' else 'E'
+let is_exp hex c = Char.compare c (if hex then 'P' else 'E') = 0
 
 let at_end hex s i = i = String.length s || is_exp hex s.[i]
 
@@ -885,7 +979,8 @@ 
91.84%

 
 let rec skip_zeroes s i =
   let i' = skip_non_hex s i in
-  if at_end true s i' || s.[i'] <> '0' then i' else skip_zeroes s (i' + 1)
+  if at_end true s i' || Char.compare s.[i'] '0' <> 0 then i'
+  else skip_zeroes s (i' + 1)
 
 let rec compare_mantissa_str' hex s1 i1 s2 i2 =
   let i1' = skip_non_hex s1 i1 in
@@ -895,7 +990,7 @@ 
91.84%

   | true, false -> if at_end hex s2 (skip_zeroes s2 i2') then 0 else -1
   | false, true -> if at_end hex s1 (skip_zeroes s1 i1') then 0 else 1
   | false, false -> (
-    match compare s1.[i1'] s2.[i2'] with
+    match Char.compare s1.[i1'] s2.[i2'] with
     | 0 -> compare_mantissa_str' hex s1 (i1' + 1) s2 (i2' + 1)
     | n -> n )
 
@@ -914,19 +1009,19 @@ 
91.84%

  *)
 let float_of_string_prevent_double_rounding s =
   (* First parse to a 64 bit float. *)
-  let z = float_of_string s in
+  let z = match float_of_string s with None -> assert false | Some z -> z in
   (* If value is already infinite we are done. *)
-  if abs_float z = 1.0 /. 0.0 then z
+  if Float.compare (abs_float z) (1.0 /. 0.0) = 0 then z
   else
     (* Else, bit twiddling to see what rounding to target precision will do. *)
-    let open Int64 in
+    let open Int64 in
     let bits = bits_of_float z in
-    let lsb = shift_left 1L 29 in
+    let lsb = shift_left 1L 29 in
     (* Check for tie, i.e. whether the bits right of target LSB are 10000... *)
-    let tie = shift_right lsb 1 in
-    let mask = lognot (shift_left (-1L) 29) in
+    let tie = shift_right lsb 1 in
+    let mask = lognot (shift_left (-1L) 29) in
     (* If we have no tie, we are good. *)
-    if logand bits mask <> tie then z
+    if Int64.ne (logand bits mask) tie then z
     else
       (* Else, define epsilon to be the value of the tie bit. *)
       let exp = float_of_bits (logand bits 0xfff0_0000_0000_0000L) in
@@ -934,14 +1029,14 @@ 
91.84%

       (* Convert 64 bit float back to string to compare to input. *)
       let hex = String.contains s 'x' in
       let s' =
-        if not hex then Printf.sprintf "%.*g" (String.length s) z
+        if not hex then Fmt.str "%.*g" (String.length s) z
         else
           let m =
             logor (logand bits 0xf_ffff_ffff_ffffL) 0x10_0000_0000_0000L
           in
           (* Shift mantissa to match msb position in most significant hex digit *)
           let i = skip_zeroes (String.uppercase_ascii s) 0 in
-          if i = String.length s then Printf.sprintf "%.*g" (String.length s) z
+          if i = String.length s then Fmt.str "%.*g" (String.length s) z
           else
             let sh =
               match s.[i] with
@@ -950,7 +1045,7 @@ 
91.84%

               | '4' .. '7' -> 2
               | _ -> 3
             in
-            Printf.sprintf "%Lx" (shift_left m sh)
+            Fmt.str "%Lx" (shift_left m sh)
       in
       (* - If mantissa became larger, float was rounded up to tie already;
        *   round-to-even might round up again: sub epsilon to round down.
@@ -964,78 +1059,80 @@ 
91.84%

       | _ -> z
 
 let of_signless_string s =
-  if s = "inf" then pos_inf
-  else if s = "nan" then pos_nan
-  else if String.length s > 6 && String.sub s 0 6 = "nan:0x" then
-    let x = Int32.of_string (String.sub s 4 (String.length s - 4)) in
-    if x = Int32.zero then failwith "nan payload must not be zero"
-    else if Int32.logand x bare_nan <> Int32.zero then
-      failwith "nan payload must not overlap with exponent bits"
-    else if x < Int32.zero then
-      failwith "nan payload must not overlap with sign bit"
+  if String.equal s "inf" then pos_inf
+  else if String.equal s "nan" then pos_nan
+  else if String.length s > 6 && String.equal (String.sub s 0 6) "nan:0x" then
+    let x = Int32.of_string (String.sub s 4 (String.length s - 4)) in
+    if Int32.eq x Int32.zero then Fmt.failwith "nan payload must not be zero"
+    else if Int32.ne (Int32.logand x bare_nan) Int32.zero then
+      Fmt.failwith "nan payload must not overlap with exponent bits"
+    else if Int32.lt x Int32.zero then
+      Fmt.failwith "nan payload must not overlap with sign bit"
     else Int32.logor x bare_nan
   else
-    let s' = String.concat "" (String.split_on_char '_' s) in
-    let x = of_float (float_of_string_prevent_double_rounding s') in
-    if is_inf x then Log.err "of_string" else x
+    let s' = String.concat "" (String.split_on_char '_' s) in
+    let x = of_float (float_of_string_prevent_double_rounding s') in
+    if is_inf x then Log.err "of_string" else x
 
 let of_string s =
-  if s = "" then Log.err "of_string"
-  else if s.[0] = '+' || s.[0] = '-' then
-    let x = of_signless_string (String.sub s 1 (String.length s - 1)) in
-    if s.[0] = '+' then x else neg x
-  else of_signless_string s
+  if String.equal s "" then Log.err "of_string"
+  else if Char.equal s.[0] '+' || Char.equal s.[0] '-' then
+    let x = of_signless_string (String.sub s 1 (String.length s - 1)) in
+    if Char.equal s.[0] '+' then x else neg x
+  else of_signless_string s
 
 (* String conversion that groups digits for readability *)
 
-let is_digit c = '0' <= c && c <= '9'
+let is_digit = function '0' .. '9' -> true | _ -> false
 
-let is_hex_digit c = is_digit c || ('a' <= c && c <= 'f')
+let is_hex_digit = function '0' .. '9' | 'a' .. 'f' -> true | _ -> false
 
 let rec add_digits buf s i j k n =
-  if i < j then begin
-    if k = 0 then Buffer.add_char buf '_';
-    Buffer.add_char buf s.[i];
-    add_digits buf s (i + 1) j ((k + n - 1) mod n) n
+  if i < j then begin
+    if k = 0 then Buffer.add_char buf '_';
+    Buffer.add_char buf s.[i];
+    add_digits buf s (i + 1) j ((k + n - 1) mod n) n
   end
 
 let group_digits =
   let rec find_from_opt f s i =
-    if i = String.length s then None
-    else if f s.[i] then Some i
-    else find_from_opt f s (i + 1)
+    if i = String.length s then None
+    else if f s.[i] then Some i
+    else find_from_opt f s (i + 1)
   in
   fun is_digit n s ->
-    let isnt_digit c = not (is_digit c) in
+    let isnt_digit c = not (is_digit c) in
     let len = String.length s in
-    let x = Option.value (find_from_opt (( = ) 'x') s 0) ~default:0 in
-    let mant = Option.value (find_from_opt is_digit s x) ~default:len in
-    let point = Option.value (find_from_opt isnt_digit s mant) ~default:len in
-    let frac = Option.value (find_from_opt is_digit s point) ~default:len in
-    let exp = Option.value (find_from_opt isnt_digit s frac) ~default:len in
-    let buf = Buffer.create (len * (n + 1) / n) in
-    Buffer.add_substring buf s 0 mant;
-    add_digits buf s mant point (((point - mant) mod n) + n) n;
-    Buffer.add_substring buf s point (frac - point);
-    add_digits buf s frac exp n n;
-    Buffer.add_substring buf s exp (len - exp);
-    Buffer.contents buf
+    let x = Option.value (find_from_opt (Char.equal 'x') s 0) ~default:0 in
+    let mant = Option.value (find_from_opt is_digit s x) ~default:len in
+    let point = Option.value (find_from_opt isnt_digit s mant) ~default:len in
+    let frac = Option.value (find_from_opt is_digit s point) ~default:len in
+    let exp = Option.value (find_from_opt isnt_digit s frac) ~default:len in
+    let buf = Buffer.create (len * (n + 1) / n) in
+    Buffer.add_substring buf s 0 mant;
+    add_digits buf s mant point (((point - mant) mod n) + n) n;
+    Buffer.add_substring buf s point (frac - point);
+    add_digits buf s frac exp n n;
+    Buffer.add_substring buf s exp (len - exp);
+    Buffer.contents buf
 
-(* TODO: convert all the following to a proper use of Format and stop concatenating strings *)
+(* TODO: convert all the following to a proper use of Fmt and stop concatenating strings *)
 let to_string' convert is_digit n x =
-  (if x < Int32.zero then "-" else "")
-  ^
-  if is_nan x then
-    let payload = Int32.logand (abs x) (Int32.lognot bare_nan) in
-    "nan:0x" ^ group_digits is_hex_digit 4 (to_hex_string payload)
-  else
-    let s = convert (to_float (abs x)) in
-    group_digits is_digit n
-      (if s.[String.length s - 1] = '.' then s ^ "0" else s)
+  Fmt.str "%s%s"
+    (if Int32.lt x Int32.zero then "-" else "")
+    ( if is_nan x then
+        let payload = Int32.logand (abs x) (Int32.lognot bare_nan) in
+        Fmt.str "%s%s" "nan:0x"
+          (group_digits is_hex_digit 4 (to_hex_string payload))
+      else
+        let s = convert (to_float (abs x)) in
+        group_digits is_digit n
+          (if Char.equal s.[String.length s - 1] '.' then Fmt.str "%s0" s else s)
+    )
 
-let to_string = to_string' (Printf.sprintf "%.17g") is_digit 3
+let to_string = to_string' (Fmt.str "%.17g") is_digit 3
 
-let pp fmt v = Format.pp_string fmt (to_string v)
+let pp fmt v = Fmt.string fmt (to_string v)
diff --git a/coverage/src/primitives/float64.ml.html b/coverage/src/primitives/float64.ml.html index 28b59654e..abf4e17dd 100644 --- a/coverage/src/primitives/float64.ml.html +++ b/coverage/src/primitives/float64.ml.html @@ -3,7 +3,7 @@ float64.ml — Coverage report - + @@ -15,22 +15,15 @@

src/primitives/float64.ml

-

91.28%

+

96.69%

@@ -65,21 +58,21 @@

91.28%

- + - + - + - + - + @@ -89,11 +82,11 @@

91.28%

- + - + @@ -103,21 +96,21 @@

91.28%

- + - - - - - + + + + + - - + + @@ -132,67 +125,67 @@

91.28%

- - - - + + + + - - - - + + + + - + - - + + - + - + - - - - + + + + - + - - - - - + + + + + - - + + - + - - + + - + - - - - - + + + + + - - - - + + + + @@ -201,176 +194,208 @@

91.28%

- - - - + + + + - + - + - + - + - - - - + + + + - - - + + + - - - - + + + + - + - + - + - + - + - + - - - - - - - - + + + + + + + + - + - - + + - - + + - + - + - + - + - - + + - + - + - + - - + + - - - - + + + + - - - + + + - - - + + + - + - - - - - + + + + + - - - - + + + + - - + + - + - - - + + + - - - + + + - + - - - - - + + + + + - - - - + + + + - + - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
@@ -711,6 +736,38 @@

91.28%

334 335 336 +337 +338 +339 +340 +341 +342 +343 +344 +345 +346 +347 +348 +349 +350 +351 +352 +353 +354 +355 +356 +357 +358 +359 +360 +361 +362 +363 +364 +365 +366 +367 +368 
(* SPDX-License-Identifier: Apache-2.0 *)
 (* Copyright 2017 WebAssembly Community Group participants *)
@@ -726,27 +783,31 @@ 
91.28%

 
 let bare_nan = 0x7ff0_0000_0000_0000L
 
-let to_hex_string = Printf.sprintf "%Lx"
+let to_hex_string = Fmt.str "%Lx"
 
 type t = Int64.t
 
-let pos_inf = Int64.bits_of_float (1.0 /. 0.0)
+let pos_inf = Int64.bits_of_float (1.0 /. 0.0)
 
-let neg_inf = Int64.bits_of_float (-.(1.0 /. 0.0))
+let neg_inf = Int64.bits_of_float (-.(1.0 /. 0.0))
 
 let of_float = Int64.bits_of_float
 
 let to_float = Int64.float_of_bits
 
-let of_bits x = x
+let of_bits x = x
 
-let to_bits x = x
+let to_bits x = x
 
-let is_inf x = x = pos_inf || x = neg_inf
+let is_inf x = Int64.eq x pos_inf || Int64.eq x neg_inf
 
 let is_nan x =
-  let xf = Int64.float_of_bits x in
-  xf <> xf
+  let xf = Int64.float_of_bits x in
+  Float.is_nan xf
+
+let is_pos_nan f = Int64.eq f pos_nan
+
+let is_neg_nan f = Int64.eq f neg_nan
 
 (*
  * When the result of an arithmetic operation is NaN, the most significant
@@ -787,13 +848,13 @@ 
91.28%

   let xf = to_float x in
   let yf = to_float y in
   let t = op xf yf in
-  if t = t then of_float t else determine_binary_nan x y
+  if not @@ Float.is_nan t then of_float t else determine_binary_nan x y
 
 let unary op x =
   let t = op (to_float x) in
-  if t = t then of_float t else determine_unary_nan x
+  if not @@ Float.is_nan t then of_float t else determine_unary_nan x
 
-let zero = of_float 0.0
+let zero = of_float 0.0
 
 let add x y = binary x ( +. ) y
 
@@ -803,114 +864,141 @@ 
91.28%

 
 let div x y = binary x ( /. ) y
 
-let sqrt x = unary Stdlib.sqrt x
+let sqrt x = unary Float.sqrt x
 
-let ceil x = unary Stdlib.ceil x
+let ceil x = unary Float.ceil x
 
-let floor x = unary Stdlib.floor x
+let floor x = unary Float.floor x
 
 let trunc x =
   let xf = to_float x in
   (* preserve the sign of zero *)
-  if xf = 0.0 then x
+  if Float.equal xf 0.0 then x
   else
     (* trunc is either ceil or floor depending on which one is toward zero *)
-    let f = if xf < 0.0 then Stdlib.ceil xf else Stdlib.floor xf in
+    let f =
+      if Float.compare xf 0.0 < 0 then Float.ceil xf else Float.floor xf
+    in
     let result = of_float f in
     if is_nan result then determine_unary_nan result else result
 
 let nearest x =
   let xf = to_float x in
   (* preserve the sign of zero *)
-  if xf = 0.0 then x
+  if Float.compare xf 0.0 = 0 then x
   else
     (* nearest is either ceil or floor depending on which is nearest or even *)
-    let u = Stdlib.ceil xf in
-    let d = Stdlib.floor xf in
+    let u = Float.ceil xf in
+    let d = Float.floor xf in
     let um = abs_float (xf -. u) in
     let dm = abs_float (xf -. d) in
     let u_or_d =
-      um < dm
-      || um = dm
+      Float.compare um dm < 0
+      || Float.compare um dm = 0
          &&
-         let h = u /. 2. in
-         Stdlib.floor h = h
+         let h = u /. 2. in
+         Float.compare (Float.floor h) h = 0
     in
-    let f = if u_or_d then u else d in
+    let f = if u_or_d then u else d in
     let result = of_float f in
     if is_nan result then determine_unary_nan result else result
 
 let min x y =
   let xf = to_float x in
   let yf = to_float y in
-  (* min -0 0 is -0 *)
-  if xf = yf then Int64.logor x y
-  else if xf < yf then x
-  else if xf > yf then y
-  else determine_binary_nan x y
+
+  if Float.is_nan xf || Float.is_nan yf then determine_binary_nan x y
+  else
+    let delta = Float.compare xf yf in
+    if delta < 0 then x
+    else if delta > 0 then y
+    else (* min -0 0 is -0 *)
+      Int64.logor x y
 
 let max x y =
   let xf = to_float x in
   let yf = to_float y in
-  (* max -0 0 is 0 *)
-  if xf = yf then Int64.logand x y
-  else if xf > yf then x
-  else if xf < yf then y
-  else determine_binary_nan x y
+
+  if Float.is_nan xf || Float.is_nan yf then determine_binary_nan x y
+  else
+    let delta = Float.compare xf yf in
+    if delta > 0 then x
+    else if delta < 0 then y
+    else (* max -0 0 is 0 *)
+      Int64.logand x y
 
 (* abs, neg, copysign are purely bitwise operations, even on NaN values *)
-let abs x = Int64.logand x Int64.max_int
+let abs x = Int64.logand x Int64.max_int
 
-let neg x = Int64.logxor x Int64.min_int
+let neg x = Int64.logxor x Int64.min_int
 
 let copy_sign x y = Int64.logor (abs x) (Int64.logand y Int64.min_int)
 
-let eq x y = to_float x = to_float y
+let eq x y =
+  let x = to_float x in
+  let y = to_float y in
+  if Float.is_nan x || Float.is_nan y then false else Float.compare x y = 0
 
-let ne x y = to_float x <> to_float y
+let ne x y =
+  let x = to_float x in
+  let y = to_float y in
+  if Float.is_nan x || Float.is_nan y then true else Float.compare x y <> 0
 
-let lt x y = to_float x < to_float y
+let lt x y =
+  let x = to_float x in
+  let y = to_float y in
+  if Float.is_nan x || Float.is_nan y then false else Float.compare x y < 0
 
-let gt x y = to_float x > to_float y
+let gt x y =
+  let x = to_float x in
+  let y = to_float y in
+  if Float.is_nan x || Float.is_nan y then false else Float.compare x y > 0
 
-let le x y = to_float x <= to_float y
+let le x y =
+  let x = to_float x in
+  let y = to_float y in
+  if Float.is_nan x || Float.is_nan y then false else Float.compare x y <= 0
 
-let ge x y = to_float x >= to_float y
+let ge x y =
+  let x = to_float x in
+  let y = to_float y in
+  if Float.is_nan x || Float.is_nan y then false else Float.compare x y >= 0
 
 (*
  * Compare mantissa of two floats in string representation (hex or dec).
  * This is a gross hack to detect rounding during parsing of floats.
  *)
-let is_hex c = ('0' <= c && c <= '9') || ('A' <= c && c <= 'F')
+let is_hex = function '0' .. '9' | 'A' .. 'F' -> true | _ -> false
 
-let is_exp hex c = c = if hex then 'P' else 'E'
+let is_exp hex c = Char.compare c (if hex then 'P' else 'E') = 0
 
-let at_end hex s i = i = String.length s || is_exp hex s.[i]
+let at_end hex s i = i = String.length s || is_exp hex s.[i]
 
 let rec skip_non_hex s i =
   (* to skip sign, 'x', '.', '_', etc. *)
-  if at_end true s i || is_hex s.[i] then i else skip_non_hex s (i + 1)
+  if at_end true s i || is_hex s.[i] then i else skip_non_hex s (i + 1)
 
 let rec skip_zeroes s i =
-  let i' = skip_non_hex s i in
-  if at_end true s i' || s.[i'] <> '0' then i' else skip_zeroes s (i' + 1)
+  let i' = skip_non_hex s i in
+  if at_end true s i' || Char.compare s.[i'] '0' <> 0 then i'
+  else skip_zeroes s (i' + 1)
 
 let rec compare_mantissa_str' hex s1 i1 s2 i2 =
-  let i1' = skip_non_hex s1 i1 in
-  let i2' = skip_non_hex s2 i2 in
-  match (at_end hex s1 i1', at_end hex s2 i2') with
-  | true, true -> 0
-  | true, false -> if at_end hex s2 (skip_zeroes s2 i2') then 0 else -1
-  | false, true -> if at_end hex s1 (skip_zeroes s1 i1') then 0 else 1
-  | false, false -> (
-    match compare s1.[i1'] s2.[i2'] with
-    | 0 -> compare_mantissa_str' hex s1 (i1' + 1) s2 (i2' + 1)
+  let i1' = skip_non_hex s1 i1 in
+  let i2' = skip_non_hex s2 i2 in
+  match (at_end hex s1 i1', at_end hex s2 i2') with
+  | true, true -> 0
+  | true, false -> if at_end hex s2 (skip_zeroes s2 i2') then 0 else -1
+  | false, true -> if at_end hex s1 (skip_zeroes s1 i1') then 0 else 1
+  | false, false -> (
+    match Char.compare s1.[i1'] s2.[i2'] with
+    | 0 -> compare_mantissa_str' hex s1 (i1' + 1) s2 (i2' + 1)
     | n -> n )
 
 let compare_mantissa_str hex s1 s2 =
-  let s1' = String.uppercase_ascii s1 in
-  let s2' = String.uppercase_ascii s2 in
-  compare_mantissa_str' hex s1' (skip_zeroes s1' 0) s2' (skip_zeroes s2' 0)
+  let s1' = String.uppercase_ascii s1 in
+  let s2' = String.uppercase_ascii s2 in
+  compare_mantissa_str' hex s1' (skip_zeroes s1' 0) s2' (skip_zeroes s2' 0)
 
 (*
  * Convert a string to a float in target precision by going through
@@ -922,43 +1010,43 @@ 
91.28%

  *)
 let float_of_string_prevent_double_rounding s =
   (* First parse to a 64 bit float. *)
-  let z = float_of_string s in
+  let z = match float_of_string s with None -> assert false | Some z -> z in
   (* If value is already infinite we are done. *)
-  if abs_float z = 1.0 /. 0.0 then z
+  if Float.equal (abs_float z) (1.0 /. 0.0) then z
   else
     (* Else, bit twiddling to see what rounding to target precision will do. *)
-    let open Int64 in
+    let open Int64 in
     let bits = bits_of_float z in
-    let lsb = shift_left 1L 0 in
+    let lsb = shift_left 1L 0 in
     (* Check for tie, i.e. whether the bits right of target LSB are 10000... *)
-    let tie = shift_right lsb 1 in
-    let mask = lognot (shift_left (-1L) 0) in
+    let tie = shift_right lsb 1 in
+    let mask = lognot (shift_left (-1L) 0) in
     (* If we have no tie, we are good. *)
-    if logand bits mask <> tie then z
+    if Int64.ne (logand bits mask) tie then z
     else
       (* Else, define epsilon to be the value of the tie bit. *)
-      let exp = float_of_bits (logand bits 0xfff0_0000_0000_0000L) in
-      let eps = float_of_bits (logor tie (bits_of_float exp)) -. exp in
+      let exp = float_of_bits (logand bits 0xfff0_0000_0000_0000L) in
+      let eps = float_of_bits (logor tie (bits_of_float exp)) -. exp in
       (* Convert 64 bit float back to string to compare to input. *)
       let hex = String.contains s 'x' in
-      let s' =
-        if not hex then Printf.sprintf "%.*g" (String.length s) z
+      let s' =
+        if not hex then Fmt.str "%.*g" (String.length s) z
         else
-          let m =
-            logor (logand bits 0xf_ffff_ffff_ffffL) 0x10_0000_0000_0000L
+          let m =
+            logor (logand bits 0xf_ffff_ffff_ffffL) 0x10_0000_0000_0000L
           in
           (* Shift mantissa to match msb position in most significant hex digit *)
-          let i = skip_zeroes (String.uppercase_ascii s) 0 in
-          if i = String.length s then Printf.sprintf "%.*g" (String.length s) z
+          let i = skip_zeroes (String.uppercase_ascii s) 0 in
+          if i = String.length s then Fmt.str "%.*g" (String.length s) z
           else
-            let sh =
+            let sh =
               match s.[i] with
-              | '1' -> 0
+              | '1' -> 0
               | '2' .. '3' -> 1
               | '4' .. '7' -> 2
-              | _ -> 3
+              | _ -> 3
             in
-            Printf.sprintf "%Lx" (shift_left m sh)
+            Fmt.str "%Lx" (shift_left m sh)
       in
       (* - If mantissa became larger, float was rounded up to tie already;
        *   round-to-even might round up again: sub epsilon to round down.
@@ -967,87 +1055,88 @@ 
91.28%

        * - If tie is not the result of prior rounding, then we are good.
        *)
       match compare_mantissa_str hex s s' with
-      | -1 -> z -. eps
-      | 1 -> z +. eps
-      | _ -> z
+      | -1 -> z -. eps
+      | 1 -> z +. eps
+      | _ -> z
 
 let of_signless_string s =
-  if s = "inf" then pos_inf
-  else if s = "nan" then pos_nan
-  else if String.length s > 6 && String.sub s 0 6 = "nan:0x" then
-    let x = Int64.of_string (String.sub s 4 (String.length s - 4)) in
-    if x = Int64.zero then failwith "nan payload must not be zero"
-    else if Int64.logand x bare_nan <> Int64.zero then
-      failwith "nan payload must not overlap with exponent bits"
-    else if x < Int64.zero then
-      failwith "nan payload must not overlap with sign bit"
+  if String.equal s "inf" then pos_inf
+  else if String.equal s "nan" then pos_nan
+  else if String.length s > 6 && String.equal (String.sub s 0 6) "nan:0x" then
+    let x = Int64.of_string (String.sub s 4 (String.length s - 4)) in
+    if Int64.eq x Int64.zero then Fmt.failwith "nan payload must not be zero"
+    else if Int64.ne (Int64.logand x bare_nan) Int64.zero then
+      Fmt.failwith "nan payload must not overlap with exponent bits"
+    else if Int64.lt x Int64.zero then
+      Fmt.failwith "nan payload must not overlap with sign bit"
     else Int64.logor x bare_nan
   else
-    let s' = String.concat "" (String.split_on_char '_' s) in
-    let x = of_float (float_of_string_prevent_double_rounding s') in
-    if is_inf x then Log.err "of_string" else x
+    let s' = String.concat "" (String.split_on_char '_' s) in
+    let x = of_float (float_of_string_prevent_double_rounding s') in
+    if is_inf x then Log.err "of_string" else x
 
 let of_string s =
-  if s = "" then Log.err "of_string"
-  else if s.[0] = '+' || s.[0] = '-' then
-    let x = of_signless_string (String.sub s 1 (String.length s - 1)) in
-    if s.[0] = '+' then x else neg x
-  else of_signless_string s
+  if String.equal s "" then Log.err "of_string"
+  else if Char.equal s.[0] '+' || Char.equal s.[0] '-' then
+    let x = of_signless_string (String.sub s 1 (String.length s - 1)) in
+    if Char.equal s.[0] '+' then x else neg x
+  else of_signless_string s
 
 (* String conversion that groups digits for readability *)
 
-let is_digit c = '0' <= c && c <= '9'
+let is_digit = function '0' .. '9' -> true | _ -> false
 
-let is_hex_digit c = is_digit c || ('a' <= c && c <= 'f')
+let is_hex_digit = function 'a' .. 'f' -> true | _ -> false
 
 let rec add_digits buf s i j k n =
-  if i < j then begin
-    if k = 0 then Buffer.add_char buf '_';
-    Buffer.add_char buf s.[i];
-    add_digits buf s (i + 1) j ((k + n - 1) mod n) n
+  if i < j then begin
+    if k = 0 then Buffer.add_char buf '_';
+    Buffer.add_char buf s.[i];
+    add_digits buf s (i + 1) j ((k + n - 1) mod n) n
   end
 
 let group_digits =
   let rec find_from_opt f s i =
-    if i = String.length s then None
-    else if f s.[i] then Some i
-    else find_from_opt f s (i + 1)
+    if i = String.length s then None
+    else if f s.[i] then Some i
+    else find_from_opt f s (i + 1)
   in
   fun is_digit n s ->
-    let isnt_digit c = not (is_digit c) in
+    let isnt_digit c = not (is_digit c) in
     let len = String.length s in
-    let x = Option.value (find_from_opt (( = ) 'x') s 0) ~default:0 in
-    let mant = Option.value (find_from_opt is_digit s x) ~default:len in
-    let point = Option.value (find_from_opt isnt_digit s mant) ~default:len in
-    let frac = Option.value (find_from_opt is_digit s point) ~default:len in
-    let exp = Option.value (find_from_opt isnt_digit s frac) ~default:len in
-    let buf = Buffer.create (len * (n + 1) / n) in
-    Buffer.add_substring buf s 0 mant;
-    add_digits buf s mant point (((point - mant) mod n) + n) n;
-    Buffer.add_substring buf s point (frac - point);
-    add_digits buf s frac exp n n;
-    Buffer.add_substring buf s exp (len - exp);
-    Buffer.contents buf
+    let x = Option.value (find_from_opt (Char.equal 'x') s 0) ~default:0 in
+    let mant = Option.value (find_from_opt is_digit s x) ~default:len in
+    let point = Option.value (find_from_opt isnt_digit s mant) ~default:len in
+    let frac = Option.value (find_from_opt is_digit s point) ~default:len in
+    let exp = Option.value (find_from_opt isnt_digit s frac) ~default:len in
+    let buf = Buffer.create (len * (n + 1) / n) in
+    Buffer.add_substring buf s 0 mant;
+    add_digits buf s mant point (((point - mant) mod n) + n) n;
+    Buffer.add_substring buf s point (frac - point);
+    add_digits buf s frac exp n n;
+    Buffer.add_substring buf s exp (len - exp);
+    Buffer.contents buf
 
 (* TODO: convert all the following to a proper use of Format and stop concatenating strings *)
 let to_string' convert is_digit n x =
-  (if x < Int64.zero then "-" else "")
-  ^
-  if is_nan x then
-    let payload = Int64.logand (abs x) (Int64.lognot bare_nan) in
-    "nan:0x" ^ group_digits is_hex_digit 4 (to_hex_string payload)
-  else
-    let s = convert (to_float (abs x)) in
-    group_digits is_digit n
-      (if s.[String.length s - 1] = '.' then s ^ "0" else s)
+  Fmt.str "%s%s"
+    (if Int64.lt x Int64.zero then "-" else "")
+    ( if is_nan x then
+        let payload = Int64.logand (abs x) (Int64.lognot bare_nan) in
+        Fmt.str "%s%s" "nan:0x"
+          (group_digits is_hex_digit 4 (to_hex_string payload))
+      else
+        let s = convert (to_float (abs x)) in
+        group_digits is_digit n
+          (if Char.equal s.[String.length s - 1] '.' then Fmt.str "%s0" s else s)
+    )
 
-let to_string = to_string' (Printf.sprintf "%.17g") is_digit 3
+let to_string = to_string' (Fmt.str "%.17g") is_digit 3
 
 let to_hex_string x =
-  if is_inf x then to_string x
-  else to_string' (Printf.sprintf "%h") is_hex_digit 4 x
+  if is_inf x then to_string x else to_string' (Fmt.str "%h") is_hex_digit 4 x
 
-let pp fmt v = Format.pp_string fmt (to_string v)
+let pp fmt v = Fmt.string fmt (to_string v)
diff --git a/coverage/src/primitives/int32.ml.html b/coverage/src/primitives/int32.ml.html index d9a6c9369..7e3abf571 100644 --- a/coverage/src/primitives/int32.ml.html +++ b/coverage/src/primitives/int32.ml.html @@ -3,7 +3,7 @@ int32.ml — Coverage report - + @@ -15,11 +15,11 @@

src/primitives/int32.ml

-

98.35%

+

98.47%

@@ -55,41 +55,41 @@

98.35%

- + - - + + - + - + - - - + + + - + - - - - - + + + + + - + - + @@ -99,16 +99,16 @@

98.35%

- - + + - - + + - - + + @@ -174,8 +174,6 @@

98.35%

- -
@@ -330,8 +328,6 @@

98.35%

148 149 150 -151 -152 
(* SPDX-License-Identifier: Apache-2.0 *)
 (* Copyright 2017 WebAssembly Community Group participants *)
@@ -345,48 +341,68 @@ 
98.35%

 (* Copyright © 2021-2024 OCamlPro *)
 (* Modified by the Owi programmers *)
 
-include Stdlib.Int32
+include Prelude.Int32
 
-let clz n = Stdlib.Int32.of_int (Ocaml_intrinsics.Int32.count_leading_zeros n)
+let clz n = of_int (Ocaml_intrinsics.Int32.count_leading_zeros n)
 
-let ctz n = Stdlib.Int32.of_int (Ocaml_intrinsics.Int32.count_trailing_zeros n)
+let ctz n = of_int (Ocaml_intrinsics.Int32.count_trailing_zeros n)
 
 (* Taken from Base *)
 let popcnt =
   let mask = 0xffff_ffffL in
   fun [@inline] x ->
-    Stdlib.Int64.to_int32 (Int64.popcnt (Int64.logand (Int64.of_int32 x) mask))
+    Int64.to_int32 (Int64.popcnt (Int64.logand (Int64.of_int32 x) mask))
 
 let of_int64 = Int64.to_int32
 
 let to_int64 = Int64.of_int32
 
 (* Unsigned comparison in terms of signed comparison. *)
-let cmp_u x op y = op (add x min_int) (add y min_int)
+let cmp_u x op y = op (add x min_int) (add y min_int)
+
+let eq (x : int32) y = equal x y
+
+let ne (x : int32) y = compare x y <> 0
+
+let lt (x : int32) y = compare x y < 0
+
+let gt (x : int32) y = compare x y > 0
+
+let le (x : int32) y = compare x y <= 0
+
+let ge (x : int32) y = compare x y >= 0
+
+let lt_u x y = cmp_u x lt y
+
+let le_u x y = cmp_u x le y
+
+let gt_u x y = cmp_u x gt y
+
+let ge_u x y = cmp_u x ge y
 
 (* If bit (32 - 1) is set, sx will sign-extend t to maintain the
  * invariant that small ints are stored sign-extended inside a wider int. *)
 let sx x =
-  Int64.to_int32
-  @@ Int64.shift_right (Int64.shift_left (Int64.of_int32 x) 32) 32
+  Int64.to_int32
+  @@ Int64.shift_right (Int64.shift_left (Int64.of_int32 x) 32) 32
 
 (* We don't override min_int and max_int since those are used
  * by other functions (like parsing), and rely on it being
  * min/max for int32 *)
 (* The smallest signed |32|-bits int. *)
-let low_int = shift_left minus_one 31
+let low_int = shift_left minus_one 31
 
 (* The largest signed |32|-bits int. *)
-let high_int = logxor low_int minus_one
+let high_int = logxor low_int minus_one
 
 (* WebAssembly's shifts mask the shift count according to the 32. *)
-let shift f x y = f x (to_int (logand y 31l))
+let shift f x y = f x (to_int (logand y 31l))
 
-let shl x y = sx (shift shift_left x y)
+let shl x y = sx (shift shift_left x y)
 
-let shr_s x y = shift shift_right x y
+let shr_s x y = shift shift_right x y
 
-let shr_u x y = sx (shift shift_right_logical x y)
+let shr_u x y = sx (shift shift_right_logical x y)
 
 let rotl x y =
   let n = logand y 31l in
@@ -397,94 +413,72 @@ 
98.35%

   logor (shr_u x n) (shl x (sub 32l n))
 
 let extend_s n x =
-  let shift = 32 - n in
-  shift_right (shift_left x shift) shift
-
-let eq (x : int32) y = x = y
-
-let ne (x : int32) y = x <> y
-
-let lt (x : int32) y = x < y
-
-let gt (x : int32) y = x > y
-
-let le (x : int32) y = x <= y
-
-let ge (x : int32) y = x >= y
-
-let lt_u x y = cmp_u x ( < ) y
-
-let le_u x y = cmp_u x ( <= ) y
-
-let gt_u x y = cmp_u x ( > ) y
-
-let ge_u x y = cmp_u x ( >= ) y
+  let shift = 32 - n in
+  shift_right (shift_left x shift) shift
 
 (* String conversion that allows leading signs and unsigned values *)
 
-let require b = if not b then Log.err "of_string (int32)"
+let require b = if not b then Log.err "of_string (int32)"
 
 let dec_digit = function
-  | '0' .. '9' as c -> Char.code c - Char.code '0'
+  | '0' .. '9' as c -> Char.code c - Char.code '0'
   | _ -> Log.err "of_string"
 
 let hex_digit = function
-  | '0' .. '9' as c -> Char.code c - Char.code '0'
-  | 'a' .. 'f' as c -> 0xa + Char.code c - Char.code 'a'
-  | 'A' .. 'F' as c -> 0xa + Char.code c - Char.code 'A'
+  | '0' .. '9' as c -> Char.code c - Char.code '0'
+  | 'a' .. 'f' as c -> 0xa + Char.code c - Char.code 'a'
+  | 'A' .. 'F' as c -> 0xa + Char.code c - Char.code 'A'
   | _ -> Log.err "of_string"
 
-let max_upper = unsigned_div minus_one 10l
+let max_upper = unsigned_div minus_one 10l
 
-let max_lower = unsigned_rem minus_one 10l
+let max_lower = unsigned_rem minus_one 10l
 
 let sign_extend i =
-  let sign_bit = logand (of_int (1 lsl (32 - 1))) i in
-  if sign_bit = zero then i
+  let sign_bit = logand (of_int (1 lsl (32 - 1))) i in
+  if eq sign_bit zero then i
   else
     (* Build a sign-extension mask *)
-    let sign_mask = shift_left minus_one 32 in
-    logor sign_mask i
+    let sign_mask = shift_left minus_one 32 in
+    logor sign_mask i
 
 let of_string s =
-  let len = String.length s in
-  let rec parse_hex i num =
-    if i = len then num
-    else if s.[i] = '_' then parse_hex (i + 1) num
+  let len = String.length s in
+  let rec parse_hex i num =
+    if i = len then num
+    else if Char.equal s.[i] '_' then parse_hex (i + 1) num
     else
-      let digit = of_int (hex_digit s.[i]) in
-      require (le_u num (shr_u minus_one (of_int 4)));
-      parse_hex (i + 1) (logor (shift_left num 4) digit)
+      let digit = of_int (hex_digit s.[i]) in
+      require (le_u num (shr_u minus_one (of_int 4)));
+      parse_hex (i + 1) (logor (shift_left num 4) digit)
   in
   let rec parse_dec i num =
-    if i = len then num
-    else if s.[i] = '_' then parse_dec (i + 1) num
+    if i = len then num
+    else if Char.equal s.[i] '_' then parse_dec (i + 1) num
     else
-      let digit = of_int (dec_digit s.[i]) in
-      require (lt_u num max_upper || (num = max_upper && le_u digit max_lower));
-      parse_dec (i + 1) (add (mul num 10l) digit)
+      let digit = of_int (dec_digit s.[i]) in
+      require (lt_u num max_upper || (eq num max_upper && le_u digit max_lower));
+      parse_dec (i + 1) (add (mul num 10l) digit)
   in
   let parse_int i =
-    require (len - i > 0);
-    if i + 2 <= len && s.[i] = '0' && s.[i + 1] = 'x' then
-      parse_hex (i + 2) zero
-    else parse_dec i zero
+    require (len - i > 0);
+    if i + 2 <= len && Char.equal s.[i] '0' && Char.equal s.[i + 1] 'x' then
+      parse_hex (i + 2) zero
+    else parse_dec i zero
   in
   require (len > 0);
-  let parsed =
+  let parsed =
     match s.[0] with
     | '+' -> parse_int 1
-    | '-' ->
+    | '-' ->
       let n = parse_int 1 in
-      require (sub n one >= minus_one);
-      neg n
-    | _ -> parse_int 0
+      require (ge (sub n one) minus_one);
+      neg n
+    | _ -> parse_int 0
   in
   let parsed = sign_extend parsed in
-  require (low_int <= parsed && parsed <= high_int);
-  parsed
-
-let eq_const (i : int32) j = i = j
+  require (le low_int parsed && le parsed high_int);
+  parsed
diff --git a/coverage/src/primitives/int64.ml.html b/coverage/src/primitives/int64.ml.html index 1694e03ab..0549d1a04 100644 --- a/coverage/src/primitives/int64.ml.html +++ b/coverage/src/primitives/int64.ml.html @@ -3,7 +3,7 @@ int64.ml — Coverage report - + @@ -15,13 +15,13 @@

src/primitives/int64.ml

-

96.67%

+

96.92%

@@ -74,49 +74,49 @@

96.67%

- + - + - + - + - + - - + + - + - + - + - + - + - + - - - - + + + + - + - + @@ -126,16 +126,16 @@

96.67%

- - + + - - + + - - + + @@ -190,8 +190,6 @@

96.67%

- -
@@ -360,8 +358,6 @@

96.67%

162 163 164 -165 -166 
(* SPDX-License-Identifier: Apache-2.0 *)
 (* Copyright 2017 WebAssembly Community Group participants *)
@@ -375,11 +371,11 @@ 
96.67%

 (* Copyright © 2021-2024 OCamlPro *)
 (* Modified by the Owi programmers *)
 
-include Stdlib.Int64
+include Prelude.Int64
 
-let clz n = Stdlib.Int64.of_int (Ocaml_intrinsics.Int64.count_leading_zeros n)
+let clz n = of_int (Ocaml_intrinsics.Int64.count_leading_zeros n)
 
-let ctz n = Stdlib.Int64.of_int (Ocaml_intrinsics.Int64.count_trailing_zeros n)
+let ctz n = of_int (Ocaml_intrinsics.Int64.count_trailing_zeros n)
 
 (* Taken from Base *)
 let popcnt =
@@ -409,7 +405,27 @@ 
96.67%

 (*
    * Unsigned comparison in terms of signed comparison.
    *)
-let cmp_u x op y = op (add x min_int) (add y min_int)
+let cmp_u x op y = op (add x min_int) (add y min_int)
+
+let eq (x : int64) y = equal x y
+
+let ne (x : int64) y = not (equal x y)
+
+let lt (x : int64) y = compare x y < 0
+
+let gt (x : int64) y = compare x y > 0
+
+let le (x : int64) y = compare x y <= 0
+
+let ge (x : int64) y = compare x y >= 0
+
+let lt_u x y = cmp_u x lt y
+
+let le_u x y = cmp_u x le y
+
+let gt_u x y = cmp_u x gt y
+
+let ge_u x y = cmp_u x ge y
 
 (*
  * Unsigned division and remainder in terms of signed division; algorithm from
@@ -417,31 +433,31 @@ 
96.67%

  * "Unsigned Short Division from Signed Division".
  *)
 let divrem_u n d =
-  if d = zero then raise Division_by_zero
+  if equal d zero then raise Division_by_zero
   else
-    let t = shift_right d 63 in
-    let n' = logand n (lognot t) in
-    let q = shift_left (div (shift_right_logical n' 1) d) 1 in
-    let r = sub n (mul q d) in
-    if cmp_u r ( < ) d then (q, r) else (add q one, sub r d)
+    let t = shift_right d 63 in
+    let n' = logand n (lognot t) in
+    let q = shift_left (div (shift_right_logical n' 1) d) 1 in
+    let r = sub n (mul q d) in
+    if cmp_u r lt d then (q, r) else (add q one, sub r d)
 
 (* We don't override min_int and max_int since those are used
  * by other functions (like parsing), and rely on it being
  * min/max for int32 *)
 (* The smallest signed |bitwidth|-bits int. *)
-let low_int = shift_left minus_one 63
+let low_int = shift_left minus_one 63
 
 (* The largest signed |bitwidth|-bits int. *)
-let high_int = logxor low_int minus_one
+let high_int = logxor low_int minus_one
 
 (* WebAssembly's shifts mask the shift count according to the bitwidth. *)
-let shift f x y = f x (to_int (logand y (of_int 63)))
+let shift f x y = f x (to_int (logand y (of_int 63)))
 
-let shl x y = shift shift_left x y
+let shl x y = shift shift_left x y
 
-let shr_s x y = shift shift_right x y
+let shr_s x y = shift shift_right x y
 
-let shr_u x y = shift shift_right_logical x y
+let shr_u x y = shift shift_right_logical x y
 
 let rotl x y =
   let n = logand y 63L in
@@ -455,80 +471,58 @@ 
96.67%

   let shift = 64 - n in
   shift_right (shift_left x shift) shift
 
-let eq (x : int64) y = x = y
-
-let ne (x : int64) y = x <> y
-
-let lt (x : int64) y = x < y
-
-let gt (x : int64) y = x > y
-
-let le (x : int64) y = x <= y
-
-let ge (x : int64) y = x >= y
-
-let lt_u x y = cmp_u x ( < ) y
-
-let le_u x y = cmp_u x ( <= ) y
-
-let gt_u x y = cmp_u x ( > ) y
-
-let ge_u x y = cmp_u x ( >= ) y
-
 (* String conversion that allows leading signs and unsigned values *)
 
-let require b = if not b then Log.err "of_string (int64)"
+let require b = if not b then Log.err "of_string (int64)"
 
 let dec_digit = function
-  | '0' .. '9' as c -> Char.code c - Char.code '0'
+  | '0' .. '9' as c -> Char.code c - Char.code '0'
   | _ -> Log.err "of_string"
 
 let hex_digit = function
-  | '0' .. '9' as c -> Char.code c - Char.code '0'
-  | 'a' .. 'f' as c -> 0xa + Char.code c - Char.code 'a'
+  | '0' .. '9' as c -> Char.code c - Char.code '0'
+  | 'a' .. 'f' as c -> 0xa + Char.code c - Char.code 'a'
   | 'A' .. 'F' as c -> 0xa + Char.code c - Char.code 'A'
   | _ -> Log.err "of_string"
 
-let max_upper, max_lower = divrem_u minus_one 10L
+let max_upper, max_lower = divrem_u minus_one 10L
 
 let of_string s =
-  let len = String.length s in
-  let rec parse_hex i num =
-    if i = len then num
-    else if s.[i] = '_' then parse_hex (i + 1) num
+  let len = String.length s in
+  let rec parse_hex i num =
+    if i = len then num
+    else if Char.equal s.[i] '_' then parse_hex (i + 1) num
     else
-      let digit = of_int (hex_digit s.[i]) in
-      require (le_u num (shr_u minus_one (of_int 4)));
-      parse_hex (i + 1) (logor (shift_left num 4) digit)
+      let digit = of_int (hex_digit s.[i]) in
+      require (le_u num (shr_u minus_one (of_int 4)));
+      parse_hex (i + 1) (logor (shift_left num 4) digit)
   in
   let rec parse_dec i num =
-    if i = len then num
-    else if s.[i] = '_' then parse_dec (i + 1) num
+    if i = len then num
+    else if Char.equal s.[i] '_' then parse_dec (i + 1) num
     else
-      let digit = of_int (dec_digit s.[i]) in
-      require (lt_u num max_upper || (num = max_upper && le_u digit max_lower));
-      parse_dec (i + 1) (add (mul num 10L) digit)
+      let digit = of_int (dec_digit s.[i]) in
+      require (lt_u num max_upper || (eq num max_upper && le_u digit max_lower));
+      parse_dec (i + 1) (add (mul num 10L) digit)
   in
   let parse_int i =
-    require (len - i > 0);
-    if i + 2 <= len && s.[i] = '0' && s.[i + 1] = 'x' then
-      parse_hex (i + 2) zero
-    else parse_dec i zero
+    require (len - i > 0);
+    if i + 2 <= len && Char.equal s.[i] '0' && Char.equal s.[i + 1] 'x' then
+      parse_hex (i + 2) zero
+    else parse_dec i zero
   in
   require (len > 0);
-  let parsed =
+  let parsed =
     match s.[0] with
     | '+' -> parse_int 1
-    | '-' ->
+    | '-' ->
       let n = parse_int 1 in
-      require (sub n one >= minus_one);
-      neg n
-    | _ -> parse_int 0
+      require (ge (sub n one) minus_one);
+      neg n
+    | _ -> parse_int 0
   in
-  require (low_int <= parsed && parsed <= high_int);
-  parsed
-
-let eq_const (i : int64) j = i = j
+  require (le low_int parsed && le parsed high_int);
+  parsed
diff --git a/coverage/src/script/script.ml.html b/coverage/src/script/script.ml.html index c59282fb2..4802645af 100644 --- a/coverage/src/script/script.ml.html +++ b/coverage/src/script/script.ml.html @@ -3,7 +3,7 @@ script.ml — Coverage report - + @@ -15,43 +15,49 @@

src/script/script.ml

-

80.83%

+

80.09%

@@ -76,247 +82,277 @@

80.83%

- - + + - - - - + + + + - + - + - - + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - + - - + + - - + + - + - - + + - - + + - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + - + - - - - - - + + + + + + - - + + - - - + + + - + - - + + - - - + + + - - + + - + - + - - + + - - - - + + + + - + - - - + + + - + - - + + - - - - + + + + - - + + - + - - - - - - - - + + + + + + + + - + - + - - - - - + + + + + - + - - - - - - - - - - - + + + + + + + + + + + - + - + - + - - - - - - + + + + + + - - + + - - - - + + + + - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
@@ -582,6 +618,36 @@

80.83%

259 260 261 +262 +263 +264 +265 +266 +267 +268 +269 +270 +271 +272 +273 +274 +275 +276 +277 +278 +279 +280 +281 +282 +283 +284 +285 +286 +287 +288 +289 +290 +291 
(* SPDX-License-Identifier: AGPL-3.0-or-later *)
 (* Copyright © 2021-2024 OCamlPro *)
@@ -589,50 +655,56 @@ 
80.83%

 
 open Types
 open Syntax
-module Stack = Stack.Make (V) [@@inlined hint]
+module Stack = Stack.Make [@inlined hint] (V)
 
 module Host_externref = struct
   type t = int
 
-  let ty : t Type.Id.t = Type.Id.make ()
+  let ty : t Type.Id.t = Type.Id.make ()
 
-  let value i = Concrete_value.Externref (Some (Concrete_value.E (ty, i)))
+  let value i = Concrete_value.Externref (Some (Concrete_value.E (ty, i)))
 end
 
 let check_error ~expected ~got : unit Result.t =
-  let ok =
-    Result.err_to_string got = expected
-    || String.starts_with ~prefix:expected (Result.err_to_string got)
-    || ( got = `Constant_out_of_range
-       || got = `Msg "constant out of range"
-       || got = `Parse_fail "constant out of range" )
-       && (expected = "i32 constant out of range" || expected = "i32 constant")
+  let ok =
+    String.equal (Result.err_to_string got) expected
+    || String.starts_with ~prefix:expected (Result.err_to_string got)
+    ||
+    match got with
+    | (`Msg s | `Parse_fail s)
+      when String.starts_with ~prefix:"constant out of range" s ->
+      String.starts_with ~prefix:"i32 constant" expected
+    | `Constant_out_of_range ->
+      String.starts_with ~prefix:"i32 constant" expected
+    | `Msg "unexpected end of section or function" ->
+      String.equal expected "section size mismatch"
+    | _ -> false
   in
-  if not ok then begin
+  if not ok then begin
     Error (`Failed_with_but_expected (got, expected))
   end
-  else Ok ()
+  else Ok ()
 
 let check_error_result expected = function
-  | Ok _whatever -> Error (`Did_not_fail_but_expected expected)
-  | Error got -> check_error ~expected ~got
+  | Ok _whatever -> Error (`Did_not_fail_but_expected expected)
+  | Error got -> check_error ~expected ~got
 
 let load_func_from_module ls mod_id f_name =
-  let* exports, env_id =
+  let* exports, env_id =
     match mod_id with
-    | None -> begin
+    | None -> begin
       match ls.Link.last with
       | None -> Error `Unbound_last_module
-      | Some m -> Ok m
+      | Some m -> Ok m
     end
-    | Some mod_id -> (
+    | Some mod_id -> (
       match Link.StringMap.find mod_id ls.Link.by_id with
       | exception Not_found -> Error (`Unbound_module mod_id)
-      | exports -> Ok exports )
+      | exports -> Ok exports )
   in
-  match Link.StringMap.find f_name exports.functions with
+  match Link.StringMap.find f_name exports.functions with
   | exception Not_found -> Error (`Unbound_name f_name)
-  | v -> Ok (v, env_id)
+  | v -> Ok (v, env_id)
 
 let load_global_from_module ls mod_id name =
   let* exports =
@@ -652,28 +724,30 @@ 
80.83%

   | v -> Ok v
 
 let compare_result_const result (const : Concrete_value.t) =
-  match (result, const) with
-  | Text.Result_const (Literal (Const_I32 n)), I32 n' -> n = n'
-  | Result_const (Literal (Const_I64 n)), I64 n' -> n = n'
-  | Result_const (Literal (Const_F32 n)), F32 n' -> n = n'
-  | Result_const (Literal (Const_F64 n)), F64 n' -> n = n'
+  match (result, const) with
+  | Text.Result_const (Literal (Const_I32 n)), I32 n' -> Int32.eq n n'
+  | Result_const (Literal (Const_I64 n)), I64 n' -> Int64.eq n n'
+  | Result_const (Literal (Const_F32 n)), F32 n' ->
+    Float32.eq n n' || String.equal (Float32.to_string n) (Float32.to_string n')
+  | Result_const (Literal (Const_F64 n)), F64 n' ->
+    Float64.eq n n' || String.equal (Float64.to_string n) (Float64.to_string n')
   | Result_const (Literal (Const_null Func_ht)), Ref (Funcref None) -> true
-  | Result_const (Literal (Const_null Extern_ht)), Ref (Externref None) -> true
-  | Result_const (Literal (Const_extern n)), Ref (Externref (Some ref)) -> begin
+  | Result_const (Literal (Const_null Extern_ht)), Ref (Externref None) -> true
+  | Result_const (Literal (Const_extern n)), Ref (Externref (Some ref)) -> begin
     match Concrete_value.cast_ref ref Host_externref.ty with
     | None -> false
-    | Some n' -> n = n'
+    | Some n' -> n = n'
   end
   | Result_const (Nan_canon S32), F32 f ->
-    f = Float32.pos_nan || f = Float32.neg_nan
+    Float32.is_pos_nan f || Float32.is_neg_nan f
   | Result_const (Nan_canon S64), F64 f ->
-    f = Float64.pos_nan || f = Float64.neg_nan
+    Float64.is_pos_nan f || Float64.is_neg_nan f
   | Result_const (Nan_arith S32), F32 f ->
     let pos_nan = Float32.to_bits Float32.pos_nan in
-    Int32.logand (Float32.to_bits f) pos_nan = pos_nan
+    Int32.eq (Int32.logand (Float32.to_bits f) pos_nan) pos_nan
   | Result_const (Nan_arith S64), F64 f ->
     let pos_nan = Float64.to_bits Float64.pos_nan in
-    Int64.logand (Float64.to_bits f) pos_nan = pos_nan
+    Int64.eq (Int64.logand (Float64.to_bits f) pos_nan) pos_nan
   | Result_const (Nan_arith _), _
   | Result_const (Nan_canon _), _
   | Result_const (Literal (Const_I32 _)), _
@@ -683,32 +757,32 @@ 
80.83%

   | Result_const (Literal (Const_null _)), _
   | Result_const (Literal (Const_host _)), _ ->
     false
-  | _ ->
+  | _ ->
     Log.debug0 "TODO (Script.compare_result_const)@\n";
-    assert false
+    assert false
 
 let value_of_const : text const -> V.t Result.t = function
-  | Const_I32 v -> ok @@ Concrete_value.I32 v
-  | Const_I64 v -> ok @@ Concrete_value.I64 v
-  | Const_F32 v -> ok @@ Concrete_value.F32 v
-  | Const_F64 v -> ok @@ Concrete_value.F64 v
+  | Const_I32 v -> ok @@ Concrete_value.I32 v
+  | Const_I64 v -> ok @@ Concrete_value.I64 v
+  | Const_F32 v -> ok @@ Concrete_value.F32 v
+  | Const_F64 v -> ok @@ Concrete_value.F64 v
   | Const_null rt ->
     let+ rt = Binary_types.convert_heap_type None rt in
     Concrete_value.ref_null rt
-  | Const_extern i -> ok @@ Concrete_value.Ref (Host_externref.value i)
+  | Const_extern i -> ok @@ Concrete_value.Ref (Host_externref.value i)
   | i ->
     Log.debug2 "TODO (Script.value_of_const) %a@\n" Types.pp_const i;
     assert false
 
 let action (link_state : Concrete_value.Func.extern_func Link.state) = function
-  | Text.Invoke (mod_id, f, args) -> begin
+  | Text.Invoke (mod_id, f, args) -> begin
     Log.debug5 "invoke %a %s %a...@\n"
-      (Format.pp_option ~none:Format.pp_nothing Format.pp_string)
+      (Fmt.option ~none:Fmt.nop Fmt.string)
       mod_id f Types.pp_consts args;
-    let* f, env_id = load_func_from_module link_state mod_id f in
-    let* stack = list_map value_of_const args in
-    let stack = List.rev stack in
-    Interpret.Concrete.exec_vfunc_from_outside ~locals:stack ~env:env_id
+    let* f, env_id = load_func_from_module link_state mod_id f in
+    let* stack = list_map value_of_const args in
+    let stack = List.rev stack in
+    Interpret.Concrete.exec_vfunc_from_outside ~locals:stack ~env:env_id
       ~envs:link_state.envs f
   end
   | Get (mod_id, name) ->
@@ -719,71 +793,92 @@ 
80.83%

 let unsafe = false
 
 let run ~no_exhaustion ~optimize script =
-  let state =
+  let state =
     Link.extern_module Link.empty_state ~name:"spectest_extern"
       Spectest.extern_m
   in
-  let script = Spectest.m :: Register ("spectest", Some "spectest") :: script in
+  let script = Spectest.m :: Register ("spectest", Some "spectest") :: script in
   let debug_on = !Log.debug_on in
   let registered = ref false in
   let curr_module = ref 0 in
   list_fold_left
     (fun (link_state : Concrete_value.Func.extern_func Link.state) -> function
-      | Text.Module m ->
-        if !curr_module = 0 then Log.debug_on := false;
-        Log.debug0 "*** module@\n";
-        incr curr_module;
-        let+ link_state =
-          Compile.Text.until_interpret link_state ~unsafe ~optimize ~name:None m
+      | Text.Text_module m ->
+        if !curr_module = 0 then Log.debug_on := false;
+        Log.debug0 "*** module@\n";
+        incr curr_module;
+        let+ link_state =
+          Compile.Text.until_interpret link_state ~unsafe ~optimize ~name:None m
         in
-        Log.debug_on := debug_on;
+        Log.debug_on := debug_on;
         link_state
-      | Assert (Assert_trap_module (m, expected)) ->
+      | Text.Quoted_module m ->
+        Log.debug0 "*** quoted module@\n";
+        incr curr_module;
+        let* m = Parse.Text.Inline_module.from_string m in
+        let+ link_state =
+          Compile.Text.until_interpret link_state ~unsafe ~optimize ~name:None m
+        in
+        link_state
+      | Text.Binary_module (id, m) ->
+        Log.debug0 "*** binary module@\n";
+        incr curr_module;
+        let* m = Parse.Binary.Module.from_string m in
+        let m = { m with id } in
+        let+ link_state =
+          Compile.Binary.until_interpret link_state ~unsafe ~optimize ~name:None
+            m
+        in
+        link_state
+      | Assert (Assert_trap_module (m, expected)) ->
         Log.debug0 "*** assert_trap@\n";
-        incr curr_module;
-        let* m, link_state =
-          Compile.Text.until_link link_state ~unsafe ~optimize ~name:None m
+        incr curr_module;
+        let* m, link_state =
+          Compile.Text.until_link link_state ~unsafe ~optimize ~name:None m
         in
-        let got = Interpret.Concrete.modul link_state.envs m in
-        let+ () = check_error_result expected got in
-        link_state
-      | Assert (Assert_malformed_binary (m, expected)) ->
+        let got = Interpret.Concrete.modul link_state.envs m in
+        let+ () = check_error_result expected got in
+        link_state
+      | Assert (Assert_malformed_binary (m, expected)) ->
         Log.debug0 "*** assert_malformed_binary@\n";
-        let got = Parse.Binary.Module.from_string m in
-        let+ () = check_error_result expected got in
-        link_state
-      | Assert (Assert_malformed_quote (m, expected)) ->
+        let got = Parse.Binary.Module.from_string m in
+        let+ () = check_error_result expected got in
+        link_state
+      | Assert (Assert_malformed_quote (m, expected)) ->
         Log.debug0 "*** assert_malformed_quote@\n";
         (* TODO: use Parse.Text.Module.from_string instead *)
-        let got = Parse.Text.Script.from_string m in
-        let+ () =
+        let got = Parse.Text.Script.from_string m in
+        let+ () =
           match got with
-          | Error got -> check_error ~expected ~got
-          | Ok [ Module m ] ->
+          | Error got -> check_error ~expected ~got
+          | Ok [ Text_module m ] ->
             let got = Compile.Text.until_binary ~unsafe m in
-            check_error_result expected got
+            check_error_result expected got
           | _ -> assert false
         in
-        link_state
-      | Assert (Assert_invalid_binary (m, expected)) ->
+        link_state
+      | Assert (Assert_invalid_binary (m, expected)) ->
         Log.debug0 "*** assert_invalid_binary@\n";
-        let got = Parse.Binary.Module.from_string m in
-        let+ () =
+        let got = Parse.Binary.Module.from_string m in
+        let+ () =
           match got with
-          | Error got -> check_error ~expected ~got
-          | Ok m ->
-            (* TODO: there should be some checks here before linking ! *)
-            let got = Link.modul link_state ~name:None m in
-            check_error_result expected got
+          | Error got -> check_error ~expected ~got
+          | Ok m -> begin
+            match Typecheck.modul m with
+            | Error got -> check_error ~expected ~got
+            | Ok () ->
+              let got = Link.modul link_state ~name:None m in
+              check_error_result expected got
+          end
         in
-        link_state
-      | Assert (Assert_invalid (m, expected)) ->
+        link_state
+      | Assert (Assert_invalid (m, expected)) ->
         Log.debug0 "*** assert_invalid@\n";
-        let got =
+        let got =
           Compile.Text.until_link link_state ~unsafe ~optimize ~name:None m
         in
-        let+ () = check_error_result expected got in
-        link_state
+        let+ () = check_error_result expected got in
+        link_state
       | Assert (Assert_invalid_quote (m, expected)) ->
         Log.debug0 "*** assert_invalid_quote@\n";
         let got = Parse.Text.Module.from_string m in
@@ -803,23 +898,24 @@ 
80.83%

         in
         let+ () = check_error_result expected got in
         Log.err "TODO"
-      | Assert (Assert_return (a, res)) ->
+      | Assert (Assert_return (a, res)) ->
         Log.debug0 "*** assert_return@\n";
-        let* stack = action link_state a in
-        if
-          List.compare_lengths res stack <> 0
-          || not (List.for_all2 compare_result_const res (List.rev stack))
+        let* stack = action link_state a in
+        let stack = List.rev stack in
+        if
+          List.compare_lengths res stack <> 0
+          || not (List.for_all2 compare_result_const res stack)
         then begin
-          Format.pp_err "got:      %a@.expected: %a@." Stack.pp (List.rev stack)
-            Text.pp_results res;
+          Fmt.epr "got:      %a@.expected: %a@." Stack.pp stack Text.pp_results
+            res;
           Error `Bad_result
         end
-        else Ok link_state
-      | Assert (Assert_trap (a, expected)) ->
+        else Ok link_state
+      | Assert (Assert_trap (a, expected)) ->
         Log.debug0 "*** assert_trap@\n";
-        let got = action link_state a in
-        let+ () = check_error_result expected got in
-        link_state
+        let got = action link_state a in
+        let+ () = check_error_result expected got in
+        link_state
       | Assert (Assert_exhaustion (a, expected)) ->
         Log.debug0 "*** assert_exhaustion@\n";
         let+ () =
@@ -829,11 +925,11 @@ 
80.83%

             check_error_result expected got
         in
         link_state
-      | Register (name, mod_name) ->
-        if !curr_module = 1 && !registered = false then Log.debug_on := false;
-        Log.debug0 "*** register@\n";
-        let+ state = Link.register_module link_state ~name ~id:mod_name in
-        Log.debug_on := debug_on;
+      | Register (name, mod_name) ->
+        if !curr_module = 1 && not !registered then Log.debug_on := false;
+        Log.debug0 "*** register@\n";
+        let+ state = Link.register_module link_state ~name ~id:mod_name in
+        Log.debug_on := debug_on;
         state
       | Action a ->
         Log.debug0 "*** action@\n";
@@ -842,8 +938,8 @@ 
80.83%

     state script
 
 let exec ~no_exhaustion ~optimize script =
-  let+ _link_state = run ~no_exhaustion ~optimize script in
-  ()
+  let+ _link_state = run ~no_exhaustion ~optimize script in
+  ()
diff --git a/coverage/src/script/spectest.ml.html b/coverage/src/script/spectest.ml.html index 7bea722a0..96a4ee863 100644 --- a/coverage/src/script/spectest.ml.html +++ b/coverage/src/script/spectest.ml.html @@ -3,7 +3,7 @@ spectest.ml — Coverage report - + @@ -15,7 +15,7 @@

src/script/spectest.ml

-

80.00%

+

83.33%

@@ -60,6 +72,18 @@

100.00%

15 16 17 +18 +19 +20 +21 +22 +23 +24 +25 +26 +27 +28 +29 
(* SPDX-License-Identifier: AGPL-3.0-or-later *)
 (* Copyright © 2021-2024 OCamlPro *)
@@ -67,17 +91,29 @@ 
100.00%

 
 type 'a solver_module = (module Smtml.Solver_intf.S with type t = 'a)
 
-type solver = S : ('a solver_module * 'a) -> solver [@@unboxed]
+type t = S : ('a solver_module * 'a) -> t [@@unboxed]
 
-module Z3Batch = Smtml.Solver.Batch (Smtml.Z3_mappings)
-
-let solver_mod : Z3Batch.t solver_module = (module Z3Batch)
-
-let fresh_solver () =
-  let module Mapping = Smtml.Z3_mappings.Fresh.Make () in
+let fresh solver () =
+  let module Mapping = (val Smtml.Solver_dispatcher.mappings_of_solver solver)
+  in
+  let module Mapping = Mapping.Fresh.Make () in
   let module Batch = Smtml.Solver.Batch (Mapping) in
   let solver = Batch.create ~logic:QF_BVFP () in
-  S ((module Batch), solver)
+  S ((module Batch), solver)
+
+let check (S (solver_module, s)) pc =
+  let module Solver = (val solver_module) in
+  Solver.check s pc
+
+let model (S (solver_module, s)) ~symbols ~pc =
+  let module Solver = (val solver_module) in
+  match Solver.check s pc with
+  | `Sat -> begin
+    match Solver.model ?symbols s with
+    | None -> assert false
+    | Some model -> model
+  end
+  | `Unsat | `Unknown -> assert false
diff --git a/coverage/src/symbolic/symbolic.ml.html b/coverage/src/symbolic/symbolic.ml.html index 168c508e4..84d89d4df 100644 --- a/coverage/src/symbolic/symbolic.ml.html +++ b/coverage/src/symbolic/symbolic.ml.html @@ -3,7 +3,7 @@ symbolic.ml — Coverage report - + @@ -15,22 +15,16 @@

src/symbolic/symbolic.ml

-

78.21%

+

83.87%

@@ -57,104 +51,104 @@

78.21%

- - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + - - + + - + - + - - - - - + + + + + - + - + - + - - - - - - + + + + + + - + - - - + + + - + - - - - - - + + + + + + - + - - + + - + - + - + - - - + + + - + - + - + - + @@ -163,77 +157,28 @@

78.21%

- - + + - - + + - + - - - - + + + + - - + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +
@@ -387,94 +332,35 @@

78.21%

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 
(* SPDX-License-Identifier: AGPL-3.0-or-later *)
 (* Copyright © 2021-2024 OCamlPro *)
 (* Written by the Owi programmers *)
 
-module type Thread = sig
-  type t
-
-  val memories : t -> Symbolic_memory.collection
-
-  val tables : t -> Symbolic_table.collection
-
-  val globals : t -> Symbolic_global.collection
-
-  val pc : t -> Symbolic_value.vbool list
-end
-
 module MakeP
-    (Thread : Thread)
+    (Memory : Symbolic_memory_intf.S)
+    (Thread : Thread.S with type Memory.collection = Memory.collection)
     (Choice : Choice_intf.Complete
                 with module V := Symbolic_value
                  and type thread := Thread.t) =
 struct
   module Value = Symbolic_value
+  module Choice = Choice
+  module Extern_func = Concrete_value.Make_extern_func (Value) (Choice) (Memory)
+  module Global = Symbolic_global
+  module Table = Symbolic_table
 
   type thread = Thread.t
 
-  module Choice = Choice
-  module Extern_func = Concrete_value.Make_extern_func (Value) (Choice)
-
   let select (c : Value.vbool) ~(if_true : Value.t) ~(if_false : Value.t) :
     Value.t Choice.t =
-    match (if_true, if_false) with
-    | I32 if_true, I32 if_false ->
-      Choice.return (Value.I32 (Value.Bool.select_expr c ~if_true ~if_false))
+    match (if_true, if_false) with
+    | I32 if_true, I32 if_false ->
+      Choice.return (Value.I32 (Value.Bool.select_expr c ~if_true ~if_false))
     | I64 if_true, I64 if_false ->
       Choice.return (Value.I64 (Value.Bool.select_expr c ~if_true ~if_false))
-    | F32 if_true, F32 if_false ->
-      Choice.return (Value.F32 (Value.Bool.select_expr c ~if_true ~if_false))
+    | F32 if_true, F32 if_false ->
+      Choice.return (Value.F32 (Value.Bool.select_expr c ~if_true ~if_false))
     | F64 if_true, F64 if_false ->
       Choice.return (Value.F64 (Value.Bool.select_expr c ~if_true ~if_false))
     | Ref _, Ref _ ->
@@ -483,73 +369,37 @@ 
78.21%

       if b then if_true else if_false
     | _, _ -> assert false
 
-  module Global = Symbolic_global
-  module Table = Symbolic_table
-
   module Elem = struct
     type t = Link_env.elem
 
     let get (elem : t) i : Value.ref_value =
-      match elem.value.(i) with Funcref f -> Funcref f | _ -> assert false
+      match elem.value.(i) with Funcref f -> Funcref f | _ -> assert false
 
     let size (elem : t) = Array.length elem.value
   end
 
   module Memory = struct
-    include Symbolic_memory
-
-    let concretise (a : Smtml.Expr.t) : Smtml.Expr.t Choice.t =
-      let open Choice in
-      let open Smtml in
-      match Expr.view a with
-      (* Avoid unecessary re-hashconsing and allocation when the value
-         is already concrete. *)
-      | Val _ | Ptr (_, { node = Val _; _ }) -> return a
-      | Ptr (base, offset) ->
-        let+ offset = select_i32 offset in
-        Expr.make (Ptr (base, Symbolic_value.const_i32 offset))
-      | _ ->
-        let+ v = select_i32 a in
-        Symbolic_value.const_i32 v
+    include Memory
 
-    let check_within_bounds m a =
-      match check_within_bounds m a with
-      | Error t -> Choice.trap t
-      | Ok (cond, ptr) ->
-        let open Choice in
-        let* out_of_bounds = select cond in
-        if out_of_bounds then trap Trap.Memory_heap_buffer_overflow
-        else return ptr
+    let load_8_s m a = Choice.lift_mem @@ load_8_s m a
 
-    let with_concrete (m : t) a f : 'a Choice.t =
-      let open Choice in
-      let* addr = concretise a in
-      let+ ptr = check_within_bounds m addr in
-      f m ptr
+    let load_8_u m a = Choice.lift_mem @@ load_8_u m a
 
-    let load_8_s m a = with_concrete m a load_8_s
+    let load_16_s m a = Choice.lift_mem @@ load_16_s m a
 
-    let load_8_u m a = with_concrete m a load_8_u
+    let load_16_u m a = Choice.lift_mem @@ load_16_u m a
 
-    let load_16_s m a = with_concrete m a load_16_s
+    let load_32 m a = Choice.lift_mem @@ load_32 m a
 
-    let load_16_u m a = with_concrete m a load_16_u
+    let load_64 m a = Choice.lift_mem @@ load_64 m a
 
-    let load_32 m a = with_concrete m a load_32
+    let store_8 m ~addr v = Choice.lift_mem @@ store_8 m ~addr v
 
-    let load_64 m a = with_concrete m a load_64
+    let store_16 m ~addr v = Choice.lift_mem @@ store_16 m ~addr v
 
-    let store_8 m ~addr v =
-      with_concrete m addr (fun m addr -> store_8 m ~addr v)
+    let store_32 m ~addr v = Choice.lift_mem @@ store_32 m ~addr v
 
-    let store_16 m ~addr v =
-      with_concrete m addr (fun m addr -> store_16 m ~addr v)
-
-    let store_32 m ~addr v =
-      with_concrete m addr (fun m addr -> store_32 m ~addr v)
-
-    let store_64 m ~addr v =
-      with_concrete m addr (fun m addr -> store_64 m ~addr v)
+    let store_64 m ~addr v = Choice.lift_mem @@ store_64 m ~addr v
   end
 
   module Data = struct
@@ -564,10 +414,10 @@ 
78.21%

     type t' = Env_id.t
 
     let get_memory env id =
-      let orig_mem = Link_env.get_memory env id in
-      let f (t : thread) =
-        let memories = Thread.memories t in
-        Symbolic_memory.get_memory (Link_env.id env) orig_mem memories id
+      let orig_mem = Link_env.get_memory env id in
+      let f (t : thread) =
+        let memories = Thread.memories t in
+        Memory.get_memory (Link_env.id env) orig_mem memories id
       in
       Choice.with_thread f
 
@@ -576,10 +426,10 @@ 
78.21%

     let get_extern_func = Link_env.get_extern_func
 
     let get_table (env : t) i : Table.t Choice.t =
-      let orig_table = Link_env.get_table env i in
-      let f (t : thread) =
-        let tables = Thread.tables t in
-        Symbolic_table.get_table (Link_env.id env) orig_table tables i
+      let orig_table = Link_env.get_table env i in
+      let f (t : thread) =
+        let tables = Thread.tables t in
+        Symbolic_table.get_table (Link_env.id env) orig_table tables i
       in
       Choice.with_thread f
 
@@ -590,10 +440,10 @@ 
78.21%

       Choice.return data
 
     let get_global (env : t) i : Global.t Choice.t =
-      let orig_global = Link_env.get_global env i in
-      let f (t : thread) =
-        let globals = Thread.globals t in
-        Symbolic_global.get_global (Link_env.id env) orig_global globals i
+      let orig_global = Link_env.get_global env i in
+      let f (t : thread) =
+        let globals = Thread.globals t in
+        Symbolic_global.get_global (Link_env.id env) orig_global globals i
       in
       Choice.with_thread f
 
@@ -612,26 +462,23 @@ 
78.21%

       ; to_run : Types.binary Types.expr list
       }
 
-    let env (t : t) = t.env
+    let env (t : t) = t.env
 
-    let modul (t : t) = t.modul
+    let modul (t : t) = t.modul
 
-    let to_run (t : t) = t.to_run
+    let to_run (t : t) = t.to_run
   end
 end
 
-module P = struct
-  include MakeP (Thread) (Symbolic_choice.Multicore) [@@inlined hint]
-  module Choice = Symbolic_choice.Multicore
-end
-
-module M = struct
-  include MakeP (Thread) (Symbolic_choice.Minimalist) [@@inlined hint]
-  module Choice = Symbolic_choice.Minimalist
-end
+module P =
+  MakeP [@inlined hint] (Symbolic_memory_concretizing) (Thread_with_memory)
+    (Symbolic_choice_with_memory)
+module M =
+  MakeP [@inlined hint] (Symbolic_memory_concretizing) (Thread_with_memory)
+    (Symbolic_choice_minimalist)
 
 let convert_module_to_run (m : 'f Link.module_to_run) =
-  P.Module_to_run.{ modul = m.modul; env = m.env; to_run = m.to_run }
+  P.Module_to_run.{ modul = m.modul; env = m.env; to_run = m.to_run }
 
 let convert_module_to_run_minimalist (m : 'f Link.module_to_run) =
   M.Module_to_run.{ modul = m.modul; env = m.env; to_run = m.to_run }
diff --git a/coverage/src/symbolic/symbolic_choice.ml.html b/coverage/src/symbolic/symbolic_choice.ml.html
index 9393cd58d..a7928ba2a 100644
--- a/coverage/src/symbolic/symbolic_choice.ml.html
+++ b/coverage/src/symbolic/symbolic_choice.ml.html
@@ -3,7 +3,7 @@
   
     
     symbolic_choice.ml — Coverage report
-    
+    
     
     
     
@@ -15,51 +15,18 @@ 

           src/symbolic/symbolic_choice.ml
         
       

-      
82.19%

+      
95.80%
@@ -84,59 +51,59 @@

82.19%

- + - + - + - - - - + + + + - - - + + + - + - - - - - - + + + + + + - - - - + + + + - - - - + + + + - - - + + + - + - + - + - + - + @@ -145,95 +112,95 @@

82.19%

- - + + - - - + + + - + - + - - - - + + + + - + - - - + + + - + - - - + + + - - + + - + - - - - - - + + + + + + - - + + - + - - + + - + - + - - + + - + - - - + + + - - + + - + - + - + - + - + - - + + @@ -245,30 +212,30 @@

82.19%

- + - + - + - + - - - - + + + + - + - - - - + + + + @@ -282,43 +249,43 @@

82.19%

- + - + - + - - - - - - - + + + + + + + - + - - + + - - + + - + - + - + - + @@ -335,314 +302,217 @@

82.19%

- - - + + + - - - - - + + + + + - + - - + + - + - + - + - - - - - - + + + + + + - - - + + + - + - - - + + + - - + + - - + + - + - + - + - - - + + + - - + + - - - - + + + + - + - - - - - - - + + + + + + + - + - + - + - + - - - + + + - - - + + + - - - - + + + + - - - - - - + + + + + + - - + + - - + + - + - - - + + + - + - - + + - - - - + + + + - - + + - + - + - + - - + + - - - - + + + + - + - + - - - + + + - - + + - - + + - + - - + + - + - + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
@@ -1129,572 +999,367 @@

82.19%

480 481 482 -483 -484 -485 -486 -487 -488 -489 -490 -491 -492 -493 -494 -495 -496 -497 -498 -499 -500 -501 -502 -503 -504 -505 -506 -507 -508 -509 -510 -511 -512 -513 -514 -515 -516 -517 -518 -519 -520 -521 -522 -523 -524 -525 -526 -527 -528 -529 -530 -531 -532 -533 -534 -535 -536 -537 -538 -539 -540 -541 -542 -543 -544 -545 -546 -547 -548 -549 -550 -551 -552 -553 -554 -555 -556 -557 -558 -559 -560 -561 -562 -563 -564 -565 -566 -567 -568 -569 -570 -571 -572 -573 -574 -575 -576 -577 -578 -579 
(* SPDX-License-Identifier: AGPL-3.0-or-later *)
 (* Copyright © 2021-2024 OCamlPro *)
 (* Written by the Owi programmers *)
 
-open Solver
-open Smtml
-open Symbolic_value
+include Symbolic_choice_intf
 
-exception Assertion of Expr.t * Thread.t
-
-module Minimalist = struct
-  type err =
-    | Assert_fail
-    | Trap of Trap.t
-
-  type 'a t = M of (Thread.t -> solver -> ('a, err) Stdlib.Result.t * Thread.t)
-  [@@unboxed]
-
-  type 'a run_result = ('a, err) Stdlib.Result.t * Thread.t
-
-  let return v = M (fun t _sol -> (Ok v, t))
-
-  let run (M v) st s : _ run_result = v st s
-
-  let bind v f =
-    M
-      (fun init_s sol ->
-        let v_final, tmp_st = run v init_s sol in
-        match v_final with
-        | Ok v_final -> run (f v_final) tmp_st sol
-        | Error _ as e -> (e, tmp_st) )
-
-  let ( let* ) = bind
-
-  let map v f =
-    let* v in
-    return (f v)
-
-  let ( let+ ) = map
-
-  let select (vb : vbool) =
-    let v = Expr.simplify vb in
-    match Expr.view v with
-    | Val True -> return true
-    | Val False -> return false
-    | _ -> Format.kasprintf failwith "%a" Expr.pp v
-
-  let select_i32 (i : int32) =
-    let v = Expr.simplify i in
-    match Expr.view v with Val (Num (I32 i)) -> return i | _ -> assert false
-
-  let trap t = M (fun th _sol -> (Error (Trap t), th))
-
-  let assertion (vb : vbool) =
-    let v = Expr.simplify vb in
-    match Expr.view v with
-    | Val True -> return ()
-    | Val False -> M (fun th _sol -> (Error Assert_fail, th))
-    | _ -> assert false
-
-  let with_thread f = M (fun st _sol -> (Ok (f st), st))
-
-  let thread = M (fun st _sol -> (Ok st, st))
-
-  let solver = M (fun st sol -> (Ok sol, st))
-
-  let add_pc (_vb : vbool) = return ()
-
-  let run ~workers:_ t thread = run t thread (fresh_solver ())
-end
-
-module WQ = struct
-  type 'a t =
-    { mutex : Mutex.t
-    ; cond : Condition.t
-    ; queue : 'a Queue.t
-    ; mutable pledges : int
-    ; mutable failed : bool
-    }
-
-  let take q pledge =
-    Mutex.lock q.mutex;
-    let r =
-      try
-        while Queue.is_empty q.queue do
-          if q.pledges = 0 || q.failed then raise Exit;
-          Condition.wait q.cond q.mutex
-        done;
-        let v = Queue.pop q.queue in
-        if pledge then q.pledges <- q.pledges + 1;
-        Some v
-      with Exit ->
-        Condition.broadcast q.cond;
-        None
-    in
-    Mutex.unlock q.mutex;
-    r
-
-  let make_pledge q =
-    Mutex.lock q.mutex;
-    q.pledges <- q.pledges + 1;
-    Mutex.unlock q.mutex
-
-  let end_pledge q =
-    Mutex.lock q.mutex;
-    q.pledges <- q.pledges - 1;
-    Condition.broadcast q.cond;
-    Mutex.unlock q.mutex
-
-  let rec read_as_seq (q : 'a t) ?(finalizer = Fun.const ()) : 'a Seq.t =
-   fun () ->
-    match take q false with
-    | None ->
-      finalizer ();
-      Nil
-    | Some v -> Cons (v, read_as_seq q ~finalizer)
-
-  let push v q =
-    Mutex.lock q.mutex;
-    let was_empty = Queue.is_empty q.queue in
-    Queue.push v q.queue;
-    if was_empty then Condition.broadcast q.cond;
-    Mutex.unlock q.mutex
-
-  let fail q =
-    Mutex.lock q.mutex;
-    q.failed <- true;
-    Condition.broadcast q.cond;
-    Mutex.unlock q.mutex
-
-  let init () =
-    { mutex = Mutex.create ()
-    ; cond = Condition.create ()
-    ; queue = Queue.create ()
-    ; pledges = 0
-    ; failed = false
-    }
-end
-
-module Multicore = struct
-  (*
+(*
      Multicore is based on several layers of monad transformers defined here
      in submodules. The module as a whole is made to provide a monad to explore in parallel
      different possibilites, with a notion of priority.
   *)
-  module Prio = struct
-    (*
+module Prio = struct
+  (*
       Currently there is no real notion of priority. Future extensions adding it will ho here.
     *)
-    type t = Default
+  type t = Default
 
-    let default = Default
-  end
+  let default = Default
+end
 
-  module CoreImpl : sig
+module CoreImpl = struct
+  module Schedulable = struct
     (*
-      The core implementation of the monad. It is isolated in a module to restict its exposed interface
-      and maintain its invariant. In particular, choose must guarantee that the Thread.t is cloned in each branch.
-      Using functions defined here should be foolproof.
-    *)
-    type 'a t
-
-    val return : 'a -> 'a t
+        A monad representing computation that can be cooperatively scheduled and may need
+        Worker Local Storage (WLS). Computations can yield, and fork (Choice).
+      *)
+    type ('a, 'wls) t = Sched of ('wls -> ('a, 'wls) status) [@@unboxed]
+
+    and ('a, 'wls) status =
+      | Now of 'a
+      | Yield of Prio.t * ('a, 'wls) t
+      | Choice of (('a, 'wls) status * ('a, 'wls) status)
+      | Stop
+
+    let run (Sched mxf) wls = mxf wls
+
+    let return x : _ t = Sched (Fun.const (Now x))
+
+    let return_status status = Sched (Fun.const status)
+
+    let rec bind (mx : ('a, 'wls) t) (f : 'a -> ('b, 'wls) t) : _ t =
+      let rec bind_status (x : _ status) (outter_wls : 'wls) f : _ status =
+        match x with
+        | Now x -> run (f x) outter_wls
+        | Yield (prio, lx) ->
+          Yield (prio, Sched (fun wls -> bind_status (run lx wls) wls f))
+        | Choice (mx1, mx2) ->
+          let mx1' = bind_status mx1 outter_wls f in
+          let mx2' = bind_status mx2 outter_wls f in
+          Choice (mx1', mx2')
+        | Stop -> Stop
+      in
+      Sched
+        (fun wls ->
+          match run mx wls with
+          | Yield (prio, mx) -> Yield (prio, bind mx f)
+          | x -> bind_status x wls f )
 
-    val bind : 'a t -> ('a -> 'b t) -> 'b t
+    let ( let* ) = bind
 
-    val ( let* ) : 'a t -> ('a -> 'b t) -> 'b t
+    let map x f =
+      let* x in
+      return (f x)
 
-    val map : 'a t -> ('a -> 'b) -> 'b t
+    let ( let+ ) = map
 
-    val ( let+ ) : 'a t -> ('a -> 'b) -> 'b t
+    let yield prio = return_status (Yield (prio, Sched (Fun.const (Now ()))))
 
-    val stop : 'a t
+    let choose a b = Sched (fun wls -> Choice (run a wls, run b wls))
 
-    val assertion_fail : Expr.t -> 'a t
+    let stop : ('a, 'b) t = return_status Stop
 
-    val trap : Trap.t -> 'a t
+    let worker_local : ('a, 'a) t = Sched (fun wls -> Now wls)
+  end
 
-    val thread : Thread.t t
+  module Scheduler = struct
+    (*
+        A scheduler for Schedulable values.
+      *)
+    type ('a, 'wls) work_queue = ('a, 'wls) Schedulable.t Wq.t
 
-    val yield : unit t
+    type ('a, 'wls) t = { work_queue : ('a, 'wls) work_queue } [@@unboxed]
 
-    val solver : solver t
+    let init_scheduler () =
+      let work_queue = Wq.init () in
+      { work_queue }
 
-    val with_thread : (Thread.t -> 'a) -> 'a t
+    let add_init_task sched task = Wq.push task sched.work_queue
 
-    val set_thread : Thread.t -> unit t
+    let rec work wls sched callback =
+      let rec handle_status (t : _ Schedulable.status) sched =
+        match t with
+        | Stop -> ()
+        | Now x -> callback x
+        | Yield (_prio, f) -> Wq.push f sched.work_queue
+        | Choice (m1, m2) ->
+          handle_status m1 sched;
+          handle_status m2 sched
+      in
+      match Wq.pop sched.work_queue true with
+      | None -> ()
+      | Some f -> begin
+        handle_status (Schedulable.run f wls) sched;
+        Wq.end_pledge sched.work_queue;
+        work wls sched callback
+      end
 
-    val modify_thread : (Thread.t -> Thread.t) -> unit t
+    let spawn_worker sched wls_init callback callback_init callback_close =
+      callback_init ();
+      Domain.spawn (fun () ->
+          Fun.protect
+            ~finally:(fun () -> callback_close ())
+            (fun () ->
+              let wls = wls_init () in
+              try work wls sched callback
+              with e ->
+                let bt = Printexc.get_raw_backtrace () in
+                Wq.fail sched.work_queue;
+                Printexc.raise_with_backtrace e bt ) )
+  end
 
+  module State = struct
     (*
-       Indicates a possible choice between two values. Thread duplication
-       is already handled by choose and should not be done before by the caller.
-    *)
-    val choose : 'a t -> 'a t -> 'a t
+        Add a notion of State to the Schedulable monad
+        ("Transformer without module functor" style)
+      *)
+    module M = Schedulable
 
-    type 'a eval =
-      | EVal of 'a
-      | ETrap of Trap.t
-      | EAssert of Expr.t
+    type ('a, 's) t = St of ('s -> ('a * 's, Solver.t) M.t) [@@unboxed]
 
-    type 'a run_result = ('a eval * Thread.t) Seq.t
+    let run (St mxf) st = mxf st
 
-    val run : workers:int -> 'a t -> Thread.t -> 'a run_result
-  end = struct
-    module Schedulable = struct
-      (*
-        A monad representing computation that can be cooperatively scheduled and may need
-        Worker Local Storage (WLS). Computations can yield, and fork (Choice).
-      *)
-      type ('a, 'wls) t = Sched of ('wls -> ('a, 'wls) status) [@@unboxed]
+    let return x = St (fun st -> M.return (x, st))
 
-      and ('a, 'wls) status =
-        | Now of 'a
-        | Yield of Prio.t * ('a, 'wls) t
-        | Choice of (('a, 'wls) status * ('a, 'wls) status)
-        | Stop
+    let lift (x : ('a, _) M.t) : ('a, 's) t =
+      let ( let+ ) = M.( let+ ) in
+      St
+        (fun (st : 's) ->
+          let+ x in
+          (x, st) )
 
-      let run (Sched mxf) wls = mxf wls
+    let bind mx f =
+      St
+        (fun st ->
+          let ( let* ) = M.( let* ) in
+          let* x, new_st = run mx st in
+          run (f x) new_st )
 
-      let return x : _ t = Sched (Fun.const (Now x))
+    let ( let* ) = bind
 
-      let return_status status = Sched (Fun.const status)
+    let map x f =
+      let* x in
+      return (f x)
 
-      let rec bind (mx : ('a, 'wls) t) (f : 'a -> ('b, 'wls) t) : _ t =
-        let rec bind_status (x : _ status) (f : _ -> _ status) : _ status =
-          match x with
-          | Now x -> f x
-          | Yield (prio, lx) ->
-            Yield (prio, Sched (fun wls -> bind_status (run lx wls) f))
-          | Choice (mx1, mx2) -> Choice (bind_status mx1 f, bind_status mx2 f)
-          | Stop -> Stop
-        in
-        Sched
-          (fun wls ->
-            let argumented_f x = run (f x) wls in
-            match run mx wls with
-            | Yield (prio, mx) -> Yield (prio, bind mx f)
-            | x -> bind_status x argumented_f )
+    let liftF2 f x y = St (fun st -> f (run x st) (run y st))
 
-      let ( let* ) = bind
+    let ( let+ ) = map
 
-      let map x f =
-        let* x in
-        return (f x)
+    let with_state f = St (fun st -> M.return (f st))
 
-      let ( let+ ) = map
+    let modify_state f = St (fun st -> M.return ((), f st))
 
-      let yield prio = return_status (Yield (prio, Sched (Fun.const (Now ()))))
+    let project_state (project_and_backup : 'st1 -> 'st2 * 'backup) restore
+      other =
+      St
+        (fun st ->
+          let ( let+ ) = M.( let+ ) in
+          let proj, backup = project_and_backup st in
+          let+ res, new_state = run other proj in
+          (res, restore backup new_state) )
+  end
 
-      let choose a b = Sched (fun wls -> Choice (run a wls, run b wls))
+  module Eval = struct
+    (*
+        Add a notion of faillibility to the evaluation
+        ("Transformer without module functor" style)
+      *)
+    module M = State
 
-      let stop : ('a, 'b) t = return_status Stop
+    type ('a, 's) t = ('a eval, 's) M.t
 
-      let worker_local : ('a, 'a) t = Sched (fun wls -> Now wls)
-    end
+    let return x : _ t = M.return (EVal x)
 
-    module Scheduler = struct
-      (*
-        A scheduler for Schedulable values.
-      *)
-      type ('a, 'wls) work_queue = ('a, 'wls) Schedulable.t WQ.t
-
-      type 'a res_queue = 'a WQ.t
-
-      type ('a, 'wls) t =
-        { work_queue : ('a, 'wls) work_queue
-        ; res_writer : 'a res_queue
-        }
-
-      let init_scheduler () =
-        let work_queue = WQ.init () in
-        let res_writer = WQ.init () in
-        { work_queue; res_writer }
-
-      let add_init_task sched task = WQ.push task sched.work_queue
-
-      let rec work wls sched =
-        let rec handle_status (t : _ Schedulable.status) sched =
-          match t with
-          | Stop -> ()
-          | Now x -> WQ.push x sched.res_writer
-          | Yield (_prio, f) -> WQ.push f sched.work_queue
-          | Choice (m1, m2) ->
-            handle_status m1 sched;
-            handle_status m2 sched
-        in
-        match WQ.take sched.work_queue true with
-        | None -> ()
-        | Some f -> begin
-          handle_status (Schedulable.run f wls) sched;
-          WQ.end_pledge sched.work_queue;
-          work wls sched
-        end
-
-      let spawn_worker sched wls_init =
-        WQ.make_pledge sched.res_writer;
-        Domain.spawn (fun () ->
-            let wls = wls_init () in
-            try
-              work wls sched;
-              WQ.end_pledge sched.res_writer
-            with e ->
-              let bt = Printexc.get_raw_backtrace () in
-              WQ.fail sched.work_queue;
-              WQ.end_pledge sched.res_writer;
-              Printexc.raise_with_backtrace e bt )
-    end
+    let lift x =
+      let ( let+ ) = M.( let+ ) in
+      let+ x in
+      EVal x
 
-    module State = struct
-      (*
-        Add a notion of State to the Schedulable monad
-        ("Transformer without module functor" style)
-      *)
-      module M = Schedulable
+    let bind (mx : _ t) f : _ t =
+      let ( let* ) = M.( let* ) in
+      let* mx in
+      match mx with
+      | EVal x -> f x
+      | ETrap _ as mx -> M.return mx
+      | EAssert _ as mx -> M.return mx
 
-      type 'a t = St of (Thread.t -> ('a * Thread.t, solver) M.t) [@@unboxed]
+    let ( let* ) = bind
 
-      let run (St mxf) st = mxf st
+    let map mx f =
+      let ( let+ ) = M.( let+ ) in
+      let+ mx in
+      match mx with
+      | EVal x -> EVal (f x)
+      | ETrap _ as mx -> mx
+      | EAssert _ as mx -> mx
 
-      let return x = St (fun st -> M.return (x, st))
+    let ( let+ ) = map
+  end
 
-      let lift x =
-        let ( let+ ) = M.( let+ ) in
-        St
-          (fun st ->
-            let+ x in
-            (x, st) )
+  module Make (Thread : Thread.S) : sig
+    (*
+      The core implementation of the monad. It is isolated in a module to restict its exposed interface
+      and maintain its invariant. In particular, choose must guarantee that the Thread.t is cloned in each branch.
+      Using functions defined here should be foolproof.
+    *)
 
-      let bind mx f =
-        St
-          (fun st ->
-            let ( let* ) = M.( let* ) in
-            let* x, new_st = run mx st in
-            run (f x) new_st )
+    type thread := Thread.t
 
-      let ( let* ) = bind
+    type 'a t = ('a, Thread.t) Eval.t
 
-      let map x f =
-        let* x in
-        return (f x)
+    val return : 'a -> 'a t
 
-      let liftF2 f x y = St (fun st -> f (run x st) (run y st))
+    val bind : 'a t -> ('a -> 'b t) -> 'b t
 
-      let ( let+ ) = map
+    val ( let* ) : 'a t -> ('a -> 'b t) -> 'b t
 
-      let with_state f = St (fun st -> M.return (f st))
+    val map : 'a t -> ('a -> 'b) -> 'b t
 
-      let modify_state f = St (fun st -> M.return ((), f st))
-    end
+    val ( let+ ) : 'a t -> ('a -> 'b) -> 'b t
 
-    module Eval = struct
-      (*
-        Add a notion of faillibility to the evaluation
-        ("Transformer without module functor" style)
-      *)
-      module M = State
+    val assertion_fail : Smtml.Expr.t -> Smtml.Model.t -> 'a t
 
-      type 'a eval =
-        | EVal of 'a
-        | ETrap of Trap.t
-        | EAssert of Expr.t
+    val stop : 'a t
 
-      type 'a t = 'a eval M.t
+    val trap : Trap.t -> 'a t
 
-      let return x : _ t = M.return (EVal x)
+    val thread : thread t
 
-      let lift x =
-        let ( let+ ) = M.( let+ ) in
-        let+ x in
-        EVal x
+    val yield : unit t
 
-      let bind (mx : _ t) f : _ t =
-        let ( let* ) = M.( let* ) in
-        let* mx in
-        match mx with
-        | EVal x -> f x
-        | ETrap _ as mx -> M.return mx
-        | EAssert _ as mx -> M.return mx
+    val solver : Solver.t t
 
-      let ( let* ) = bind
+    val with_thread : (thread -> 'a) -> 'a t
 
-      let map mx f =
-        let ( let+ ) = M.( let+ ) in
-        let+ mx in
-        match mx with
-        | EVal x -> EVal (f x)
-        | ETrap _ as mx -> mx
-        | EAssert _ as mx -> mx
+    val set_thread : thread -> unit t
 
-      let ( let+ ) = map
-    end
+    val modify_thread : (thread -> thread) -> unit t
 
+    (*
+       Indicates a possible choice between two values. Thread duplication
+       is already handled by choose and should not be done before by the caller.
+    *)
+    val choose : 'a t -> 'a t -> 'a t
+
+    type 'a run_result = ('a eval * thread) Seq.t
+
+    val run :
+         workers:int
+      -> Smtml.Solver_dispatcher.solver_type
+      -> 'a t
+      -> thread
+      -> callback:('a eval * thread -> unit)
+      -> callback_init:(unit -> unit)
+      -> callback_end:(unit -> unit)
+      -> unit Domain.t array
+  end = struct
     include Eval
 
+    type 'a t = ('a, Thread.t) Eval.t
+
     (*
        Here we define functions to seamlessly
        operate on the three monads layers
     *)
 
     let lift_schedulable (v : ('a, _) Schedulable.t) : 'a t =
-      lift (State.lift v)
+      let v = State.lift v in
+      lift v
 
-    let with_thread f = lift (State.with_state (fun st -> (f st, st)))
+    let with_thread (f : Thread.t -> 'a) : 'a t =
+      let x = State.with_state (fun st -> (f st, st)) in
+      lift x
 
-    let thread = with_thread Fun.id
+    let thread = with_thread Fun.id
 
-    let modify_thread f = lift (State.modify_state f)
+    let modify_thread f = lift (State.modify_state f)
 
-    let set_thread st = modify_thread (Fun.const st)
+    let set_thread st = modify_thread (Fun.const st)
 
-    let clone_thread = modify_thread Thread.clone
+    let clone_thread = modify_thread Thread.clone
 
-    let solver = lift_schedulable Schedulable.worker_local
+    let solver = lift_schedulable Schedulable.worker_local
 
     let choose a b =
-      let a =
+      let a =
         let* () = clone_thread in
-        a
+        a
       in
       let b =
         let* () = clone_thread in
-        b
+        b
       in
       State.liftF2 Schedulable.choose a b
 
-    let yield = lift_schedulable @@ Schedulable.yield Prio.default
+    let yield = lift_schedulable @@ Schedulable.yield Prio.default
 
-    let stop = lift_schedulable Schedulable.stop
+    let stop = lift_schedulable Schedulable.stop
 
     type 'a run_result = ('a eval * Thread.t) Seq.t
 
-    let run ~workers t thread =
-      let open Scheduler in
+    let run ~workers solver t thread ~callback ~callback_init ~callback_end =
+      let open Scheduler in
       let sched = init_scheduler () in
-      add_init_task sched (State.run t thread);
-      let join_handles =
-        Array.map
-          (fun () -> spawn_worker sched fresh_solver)
-          (Array.init workers (Fun.const ()))
-      in
-      WQ.read_as_seq sched.res_writer ~finalizer:(fun () ->
-          Array.iter Domain.join join_handles )
-
-    let trap t = State.return (ETrap t)
-
-    let assertion_fail c = State.return (EAssert c)
+      add_init_task sched (State.run t thread);
+      Array.init workers (fun _i ->
+          spawn_worker sched (Solver.fresh solver) callback callback_init
+            callback_end )
+
+    let trap t =
+      let* thread in
+      let* solver in
+      let pc = Thread.pc thread in
+      let symbols = Thread.symbols_set thread |> Option.some in
+      let model = Solver.model solver ~symbols ~pc in
+      State.return (ETrap (t, model))
+
+    let assertion_fail c model = State.return (EAssert (c, model))
   end
+end
 
-  (*
+(*
     We can now use CoreImpl only through its exposed signature which
     maintains all invariants.
   *)
+module Make (Thread : Thread.S) = struct
+  include CoreImpl.Make (Thread)
 
-  include CoreImpl
-
-  let add_pc (c : vbool) =
-    match Expr.view c with
+  let add_pc (c : Symbolic_value.vbool) =
+    match Smtml.Expr.view c with
     | Val True -> return ()
-    | Val False -> stop
-    | _ ->
+    | Val False -> stop
+    | _ ->
       let* thread in
-      let new_thread = { thread with pc = c :: thread.pc } in
-      set_thread new_thread
+      let new_thread = Thread.add_pc thread c in
+      set_thread new_thread
   [@@inline]
 
   let add_breadcrumb crumb =
-    modify_thread (fun t -> { t with breadcrumbs = crumb :: t.breadcrumbs })
+    modify_thread (fun t -> Thread.add_breadcrumb t crumb)
+
+  let with_new_symbol ty f =
+    let* thread in
+    let n = Thread.symbols thread in
+    let sym = Fmt.kstr (Smtml.Symbol.make ty) "symbol_%d" n in
+    let+ () =
+      modify_thread (fun thread ->
+          let thread = Thread.add_symbol thread sym in
+          Thread.incr_symbols thread )
+    in
+    f sym
 
   (*
     Yielding is currently done each time the solver is about to be called,
@@ -1702,109 +1367,120 @@ 
82.19%

   *)
   let check_reachability =
     let* () = yield in
-    let* (S (solver_module, s)) = solver in
-    let module Solver = (val solver_module) in
-    let* thread in
-    match Solver.check s thread.pc with
-    | `Sat -> return ()
-    | `Unsat | `Unknown -> stop
-
-  let get_model symbol =
-    let* () = yield in
-    let* (S (solver_module, s)) = solver in
-    let module Solver = (val solver_module) in
-    let+ thread in
-    match Solver.check s thread.pc with
-    | `Unsat | `Unknown -> None
-    | `Sat -> begin
-      let model = Solver.model ~symbols:[ symbol ] s in
-      match model with
-      | None ->
-        failwith "Unreachable: The problem is sat so a model should exist"
-      | Some model -> begin
-        match Model.evaluate model symbol with
-        | None ->
-          failwith
-            "Unreachable: The model exists so this symbol should evaluate"
-        | Some _ as v -> v
-      end
-    end
+    let* thread in
+    let* solver in
+    let pc = Thread.pc thread in
+    match Solver.check solver pc with
+    | `Sat -> return ()
+    | `Unsat | `Unknown -> stop
 
   let get_model_or_stop symbol =
-    let* model = get_model symbol in
-    match model with Some v -> return v | None -> stop
+    let* () = yield in
+    let* solver in
+    let+ thread in
+    let pc = Thread.pc thread in
+    match Solver.check solver pc with
+    | `Unsat | `Unknown -> stop
+    | `Sat -> begin
+      let symbols = [ symbol ] |> Option.some in
+      let model = Solver.model solver ~symbols ~pc in
+      match Smtml.Model.evaluate model symbol with
+      | None ->
+        Fmt.failwith
+          "Unreachable: The model exists so this symbol should evaluate"
+      | Some v -> return v
+    end
 
-  let select (cond : Symbolic_value.vbool) =
-    let v = Expr.simplify cond in
-    match Expr.view v with
-    | Val True -> return true
-    | Val False -> return false
-    | Val (Num (I32 _)) -> failwith "unreachable (type error)"
-    | _ ->
+  let select_inner ~explore_first (cond : Symbolic_value.vbool) =
+    let v = Smtml.Expr.simplify cond in
+    match Smtml.Expr.view v with
+    | Val True -> return true
+    | Val False -> return false
+    | Val (Num (I32 _)) -> Fmt.failwith "unreachable (type error)"
+    | _ ->
       let true_branch =
-        let* () = add_pc v in
-        let* () = add_breadcrumb 1l in
-        let+ () = check_reachability in
-        true
+        let* () = add_pc v in
+        let* () = add_breadcrumb 1l in
+        let+ () = check_reachability in
+        true
       in
       let false_branch =
-        let* () = add_pc (Symbolic_value.Bool.not v) in
-        let* () = add_breadcrumb 0l in
-        let+ () = check_reachability in
-        false
+        let* () = add_pc (Symbolic_value.Bool.not v) in
+        let* () = add_breadcrumb 0l in
+        let+ () = check_reachability in
+        false
       in
-      choose true_branch false_branch
+      if explore_first then choose true_branch false_branch
+      else choose false_branch true_branch
   [@@inline]
 
-  let summary_symbol (e : Expr.t) =
-    let* thread in
-    match Expr.view e with
+  let select (cond : Symbolic_value.vbool) =
+    select_inner cond ~explore_first:true
+  [@@inline]
+
+  let summary_symbol (e : Smtml.Expr.t) =
+    let* thread in
+    match Smtml.Expr.view e with
     | Symbol sym -> return (None, sym)
-    | _ ->
-      let choices = thread.choices in
-      let symbol_name = Format.sprintf "choice_i32_%i" choices in
-      let+ () = modify_thread (fun t -> { t with choices = choices + 1 }) in
-      let sym = Symbol.(symbol_name @: Ty_bitv 32) in
-      let assign = Expr.(relop Ty_bool Eq (mk_symbol sym) e) in
+    | _ ->
+      let num_symbols = Thread.symbols thread in
+      let+ () = modify_thread Thread.incr_symbols in
+      let sym_name = Fmt.str "choice_i32_%i" num_symbols in
+      let sym_type = Smtml.Ty.Ty_bitv 32 in
+      let sym = Smtml.Symbol.make sym_type sym_name in
+      let assign = Smtml.Expr.(relop Ty_bool Eq (mk_symbol sym) e) in
       (Some assign, sym)
 
   let select_i32 (i : Symbolic_value.int32) =
-    let sym_int = Expr.simplify i in
-    match Expr.view sym_int with
-    | Val (Num (I32 i)) -> return i
-    | _ ->
-      let* assign, symbol = summary_symbol sym_int in
-      let* () =
-        match assign with Some assign -> add_pc assign | None -> return ()
+    let sym_int = Smtml.Expr.simplify i in
+    match Smtml.Expr.view sym_int with
+    | Val (Num (I32 i)) -> return i
+    | _ ->
+      let* assign, symbol = summary_symbol sym_int in
+      let* () =
+        match assign with Some assign -> add_pc assign | None -> return ()
       in
-      let rec generator () =
-        let* possible_value = get_model_or_stop symbol in
-        let i =
+      let rec generator () =
+        let* possible_value = get_model_or_stop symbol in
+        let* possible_value in
+        let i =
           match possible_value with
-          | Num (I32 i) -> i
-          | _ -> failwith "Unreachable: found symbol must be a value"
+          | Smtml.Value.Num (I32 i) -> i
+          | _ -> Fmt.failwith "Unreachable: found symbol must be a value"
+        in
+        let s = Smtml.Expr.mk_symbol symbol in
+        let this_value_cond =
+          let open Smtml.Expr in
+          Bitv.I32.(s = v i)
         in
-        let this_value_cond = Expr.Bitv.I32.(Expr.mk_symbol symbol = v i) in
         let not_this_value_cond =
-          (* != is **not** the physical equality here *)
-          Expr.Bitv.I32.(Expr.mk_symbol symbol != v i)
+          let open Smtml.Expr in
+          (* != is **not** the physical inequality here *)
+          Bitv.I32.(s != v i)
         in
         let this_val_branch =
-          let* () = add_breadcrumb i in
-          let+ () = add_pc this_value_cond in
-          i
+          let* () = add_breadcrumb i in
+          let+ () = add_pc this_value_cond in
+          i
         in
         let not_this_val_branch =
-          let* () = add_pc not_this_value_cond in
-          generator ()
+          let* () = add_pc not_this_value_cond in
+          generator ()
         in
         choose this_val_branch not_this_val_branch
       in
       generator ()
 
   let assertion c =
-    let* assertion_true = select c in
-    if assertion_true then return () else assertion_fail c
+    let* assertion_true = select_inner c ~explore_first:false in
+    if assertion_true then return ()
+    else
+      let* thread in
+      let* solver in
+      let symbols = Thread.symbols_set thread |> Option.some in
+      let pc = Thread.pc thread in
+      let model = Solver.model ~symbols ~pc solver in
+      assertion_fail c model
 end
diff --git a/coverage/src/symbolic/symbolic_choice_minimalist.ml.html b/coverage/src/symbolic/symbolic_choice_minimalist.ml.html new file mode 100644 index 000000000..7b4219322 --- /dev/null +++ b/coverage/src/symbolic/symbolic_choice_minimalist.ml.html @@ -0,0 +1,282 @@ + + + + + symbolic_choice_minimalist.ml — Coverage report + + + + + + + + +
+
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+
+
+
+ 
+ 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
+
+
(* SPDX-License-Identifier: AGPL-3.0-or-later *)
+(* Copyright © 2021-2024 OCamlPro *)
+(* Written by the Owi programmers *)
+
+open Symbolic_value
+
+module Make (Thread : Thread.S) = struct
+  type err =
+    | Assert_fail
+    | Trap of Trap.t
+
+  type 'a t =
+    | M of (Thread.t -> Solver.t -> ('a, err) Prelude.Result.t * Thread.t)
+  [@@unboxed]
+
+  type 'a run_result = ('a, err) Prelude.Result.t * Thread.t
+
+  let return v = M (fun t _sol -> (Ok v, t))
+
+  let run (M v) st s : _ run_result = v st s
+
+  let bind v f =
+    M
+      (fun init_s sol ->
+        let v_final, tmp_st = run v init_s sol in
+        match v_final with
+        | Ok v_final -> run (f v_final) tmp_st sol
+        | Error _ as e -> (e, tmp_st) )
+
+  let ( let* ) = bind
+
+  let map v f =
+    let* v in
+    return (f v)
+
+  let ( let+ ) = map
+
+  let select (vb : vbool) =
+    let v = Smtml.Expr.simplify vb in
+    match Smtml.Expr.view v with
+    | Val True -> return true
+    | Val False -> return false
+    | _ -> Fmt.failwith "%a" Smtml.Expr.pp v
+
+  let select_i32 (i : int32) =
+    let v = Smtml.Expr.simplify i in
+    match Smtml.Expr.view v with
+    | Val (Num (I32 i)) -> return i
+    | _ -> assert false
+
+  let trap t = M (fun th _sol -> (Error (Trap t), th))
+
+  let assertion (vb : vbool) =
+    let v = Smtml.Expr.simplify vb in
+    match Smtml.Expr.view v with
+    | Val True -> return ()
+    | Val False -> M (fun th _sol -> (Error Assert_fail, th))
+    | _ -> assert false
+
+  let with_thread f = M (fun st _sol -> (Ok (f st), st))
+
+  let thread = M (fun st _sol -> (Ok st, st))
+
+  let solver = M (fun st sol -> (Ok sol, st))
+
+  let add_pc (_vb : vbool) = return ()
+
+  let run ~workers:_ solver t thread = run t thread (Solver.fresh solver ())
+
+  let lift_mem _ = assert false
+end
+
+include Make (Thread_with_memory)
+
+
+
+ + + diff --git a/coverage/src/symbolic/symbolic_choice_with_memory.ml.html b/coverage/src/symbolic/symbolic_choice_with_memory.ml.html new file mode 100644 index 000000000..e68d1979e --- /dev/null +++ b/coverage/src/symbolic/symbolic_choice_with_memory.ml.html @@ -0,0 +1,62 @@ + + + + + symbolic_choice_with_memory.ml — Coverage report + + + + + + + + +
+
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+
+
+
+ 
+1
+2
+3
+4
+5
+6
+7
+8
+9
+
+
(* SPDX-License-Identifier: AGPL-3.0-or-later *)
+(* Copyright © 2021-2024 OCamlPro *)
+(* Written by the Owi programmers *)
+
+include Symbolic_choice.Make (Thread_with_memory)
+
+let lift_mem (mem_op : 'a Symbolic_choice_without_memory.t) : 'a t =
+  Symbolic_choice.CoreImpl.State.project_state Thread_with_memory.project
+    Thread_with_memory.restore mem_op
+
+
+
+ + + diff --git a/coverage/src/symbolic/symbolic_choice_without_memory.ml.html b/coverage/src/symbolic/symbolic_choice_without_memory.ml.html new file mode 100644 index 000000000..62a0b1a6a --- /dev/null +++ b/coverage/src/symbolic/symbolic_choice_without_memory.ml.html @@ -0,0 +1,50 @@ + + + + + symbolic_choice_without_memory.ml — Coverage report + + + + + + + + +
+
+ 
+ 
+ 
+ 
+ 
+ 
+
+
+
+ 
+1
+2
+3
+4
+5
+
+
(* SPDX-License-Identifier: AGPL-3.0-or-later *)
+(* Copyright © 2021-2024 OCamlPro *)
+(* Written by the Owi programmers *)
+
+include Symbolic_choice.Make (Thread_without_memory)
+
+
+
+ + + diff --git a/coverage/src/symbolic/symbolic_global.ml.html b/coverage/src/symbolic/symbolic_global.ml.html index 4b5cc27bc..865320333 100644 --- a/coverage/src/symbolic/symbolic_global.ml.html +++ b/coverage/src/symbolic/symbolic_global.ml.html @@ -3,7 +3,7 @@ symbolic_global.ml — Coverage report - + @@ -15,10 +15,11 @@

src/symbolic/symbolic_global.ml

-

97.44%

+

94.87%

@@ -88,7 +89,7 @@

97.44%

- + @@ -171,7 +172,7 @@

97.44%

module ITbl = Hashtbl.Make (struct include Int - let hash x = x + let hash x = x end) type t = @@ -181,24 +182,24 @@

97.44%

type collection = t ITbl.t Env_id.Tbl.t -let init () = Env_id.Tbl.create 0 +let init () = Env_id.Tbl.create 0 -let global_copy r = { r with value = r.value } +let global_copy r = { r with value = r.value } let clone collection = (* TODO: this is ugly and should be rewritten... *) - let s = Env_id.Tbl.to_seq collection in - Env_id.Tbl.of_seq - @@ Seq.map + let s = Env_id.Tbl.to_seq collection in + Env_id.Tbl.of_seq + @@ Seq.map (fun (i, t) -> - let s = ITbl.to_seq t in - (i, ITbl.of_seq @@ Seq.map (fun (i, a) -> (i, global_copy a)) s) ) + let s = ITbl.to_seq t in + (i, ITbl.of_seq @@ Seq.map (fun (i, a) -> (i, global_copy a)) s) ) s let convert_values (v : Concrete_value.t) : Symbolic_value.t = (* TODO share various versions *) - match v with - | I32 v -> I32 (Symbolic_value.const_i32 v) + match v with + | I32 v -> I32 (Symbolic_value.const_i32 v) | I64 v -> I64 (Symbolic_value.const_i64 v) | F32 v -> F32 (Symbolic_value.const_f32 v) | F64 v -> F64 (Symbolic_value.const_f64 v) @@ -206,32 +207,32 @@

97.44%

| Ref _ -> assert false let convert (orig_global : Concrete_global.t) : t = - { value = convert_values orig_global.value; orig = orig_global } + { value = convert_values orig_global.value; orig = orig_global } let get_env env_id tables = - match Env_id.Tbl.find_opt tables env_id with - | Some env -> env - | None -> + match Env_id.Tbl.find_opt tables env_id with + | Some env -> env + | None -> let t = ITbl.create 0 in - Env_id.Tbl.add tables env_id t; - t + Env_id.Tbl.add tables env_id t; + t let get_global env_id (orig_global : Concrete_global.t) collection g_id = - let env = get_env env_id collection in - match ITbl.find_opt env g_id with - | Some t -> t - | None -> + let env = get_env env_id collection in + match ITbl.find_opt env g_id with + | Some t -> t + | None -> let t = convert orig_global in - ITbl.add env g_id t; - t + ITbl.add env g_id t; + t -let value v = v.value +let value v = v.value -let set_value v x = v.value <- x +let set_value v x = v.value <- x -let mut v = v.orig.mut +let mut v = v.orig.mut -let typ v = v.orig.typ +let typ v = v.orig.typ
diff --git a/coverage/src/symbolic/symbolic_memory.ml.html b/coverage/src/symbolic/symbolic_memory.ml.html index d4b25ae87..23acb1813 100644 --- a/coverage/src/symbolic/symbolic_memory.ml.html +++ b/coverage/src/symbolic/symbolic_memory.ml.html @@ -3,7 +3,7 @@ symbolic_memory.ml — Coverage report - + @@ -15,28 +15,137 @@

src/symbolic/symbolic_memory.ml

-

83.90%

+

0.96%

@@ -60,26 +169,26 @@

83.90%

- + - - + + - - + + - - + + - - + + - + @@ -89,52 +198,52 @@

83.90%

- - - - - - + + + + + + - + - - - + + + - + - + - - + + - - + + - - - - + + + + - - - - - + + + + + - + @@ -142,146 +251,148 @@

83.90%

- + - - - + + + - - + + - + - + - + - - - - + + + + - - - - + + + + - - + + - + - - + + - + - + - + - - - + + + - + - - - + + + - - - - - + + + + + - + - + - + - + - + - - - + + + - - - - + + + + - - + + - + - - - - + + + + - + - + - + - + - + - - - - - - - - + + + + + + + + - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + +
@@ -527,6 +638,8 @@

83.90%

239 240 241 +242 +243 
(* SPDX-License-Identifier: AGPL-3.0-or-later *)
 (* Copyright © 2021-2024 OCamlPro *)
@@ -537,7 +650,7 @@ 
83.90%

 module Ty = Smtml.Ty
 open Expr
 
-let page_size = Symbolic_value.const_i32 65_536l
+let page_size = Symbolic_value.const_i32 65_536l
 
 type t =
   { data : (Int32.t, Value.int32) Hashtbl.t
@@ -547,26 +660,26 @@ 
83.90%

   }
 
 let create size =
-  { data = Hashtbl.create 128
+  { data = Hashtbl.create 128
   ; parent = None
-  ; size = Value.const_i32 size
-  ; chunks = Hashtbl.create 16
+  ; size = Value.const_i32 size
+  ; chunks = Hashtbl.create 16
   }
 
 let i32 v =
-  match view v with
-  | Val (Num (I32 i)) -> i
+  match view v with
+  | Val (Num (I32 i)) -> i
   | _ -> Log.err {|Unsupported symbolic value reasoning over "%a"|} Expr.pp v
 
 let grow m delta =
-  let old_size = Value.I32.mul m.size page_size in
-  let new_size = Value.I32.(div (add old_size delta) page_size) in
+  let old_size = Value.I32.mul m.size page_size in
+  let new_size = Value.I32.(div (add old_size delta) page_size) in
   m.size <-
-    Value.Bool.select_expr
-      (Value.I32.gt new_size m.size)
+    Value.Bool.select_expr
+      (Value.I32.gt new_size m.size)
       ~if_true:new_size ~if_false:m.size
 
-let size { size; _ } = Value.I32.mul size page_size
+let size { size; _ } = Value.I32.mul size page_size
 
 let size_in_pages { size; _ } = size
 
@@ -576,52 +689,52 @@ 
83.90%

 
 let blit_string m str ~src ~dst ~len =
   (* This function is only used in memory init so everything will be concrete *)
-  let str_len = String.length str in
-  let mem_len = Int32.(to_int (i32 m.size) * to_int (i32 page_size)) in
-  let src = Int32.to_int @@ i32 src in
-  let dst = Int32.to_int @@ i32 dst in
-  let len = Int32.to_int @@ i32 len in
-  if src < 0 || dst < 0 || len < 0 || src + len > str_len || dst + len > mem_len
+  let str_len = String.length str in
+  let mem_len = Int32.(to_int (i32 m.size) * to_int (i32 page_size)) in
+  let src = Int32.to_int @@ i32 src in
+  let dst = Int32.to_int @@ i32 dst in
+  let len = Int32.to_int @@ i32 len in
+  if src < 0 || dst < 0 || len < 0 || src + len > str_len || dst + len > mem_len
   then Value.Bool.const true
-  else begin
+  else begin
     for i = 0 to len - 1 do
-      let byte = Char.code @@ String.get str (src + i) in
-      let dst = Int32.of_int (dst + i) in
-      Hashtbl.replace m.data dst (make (Val (Num (I8 byte))))
+      let byte = Char.code @@ String.get str (src + i) in
+      let dst = Int32.of_int (dst + i) in
+      Hashtbl.replace m.data dst (make (Val (Num (I8 byte))))
     done;
     Value.Bool.const false
   end
 
 let clone m =
-  { data = Hashtbl.create 16
+  { data = Hashtbl.create 16
   ; parent = Some m
   ; size = m.size
-  ; chunks = Hashtbl.copy m.chunks (* TODO: we can make this lazy as well *)
+  ; chunks = Hashtbl.copy m.chunks (* TODO: we can make this lazy as well *)
   }
 
 let rec load_byte { parent; data; _ } a =
-  try Hashtbl.find data a
-  with Not_found -> (
+  try Hashtbl.find data a
+  with Not_found -> (
     match parent with
-    | None -> make (Val (Num (I8 0)))
-    | Some parent -> load_byte parent a )
+    | None -> make (Val (Num (I8 0)))
+    | Some parent -> load_byte parent a )
 
 (* TODO: don't rebuild so many values it generates unecessary hc lookups *)
 let merge_extracts (e1, h, m1) (e2, m2, l) =
-  let ty = Expr.ty e1 in
-  if m1 = m2 && Expr.equal e1 e2 then
-    if h - l = Ty.size ty then e1 else make (Extract (e1, h, l))
-  else make (Concat (make (Extract (e1, h, m1)), make (Extract (e2, m2, l))))
+  let ty = Expr.ty e1 in
+  if m1 = m2 && Expr.equal e1 e2 then
+    if h - l = Ty.size ty then e1 else make (Extract (e1, h, l))
+  else make (Concat (make (Extract (e1, h, m1)), make (Extract (e2, m2, l))))
 
 let concat ~msb ~lsb offset =
-  assert (offset > 0 && offset <= 8);
-  match (view msb, view lsb) with
-  | Val (Num (I8 i1)), Val (Num (I8 i2)) ->
-    Value.const_i32 Int32.(logor (shl (of_int i1) 8l) (of_int i2))
-  | Val (Num (I8 i1)), Val (Num (I32 i2)) ->
+  assert (offset > 0 && offset <= 8);
+  match (view msb, view lsb) with
+  | Val (Num (I8 i1)), Val (Num (I8 i2)) ->
+    Value.const_i32 Int32.(logor (shl (of_int i1) 8l) (of_int i2))
+  | Val (Num (I8 i1)), Val (Num (I32 i2)) ->
     let offset = offset * 8 in
     if offset < 32 then
-      Value.const_i32 Int32.(logor (shl (of_int i1) (of_int offset)) i2)
+      Value.const_i32 Int32.(logor (shl (of_int i1) (of_int offset)) i2)
     else
       let i1' = Int64.of_int i1 in
       let i2' = Int64.of_int32 i2 in
@@ -629,146 +742,148 @@ 
83.90%

   | Val (Num (I8 i1)), Val (Num (I64 i2)) ->
     let offset = Int64.of_int (offset * 8) in
     Value.const_i64 Int64.(logor (shl (of_int i1) offset) i2)
-  | Extract (e1, h, m1), Extract (e2, m2, l) ->
+  | Extract (e1, h, m1), Extract (e2, m2, l) ->
     merge_extracts (e1, h, m1) (e2, m2, l)
-  | Extract (e1, h, m1), Concat ({ node = Extract (e2, m2, l); _ }, e3) ->
-    make (Concat (merge_extracts (e1, h, m1) (e2, m2, l), e3))
-  | _ -> make (Concat (msb, lsb))
+  | Extract (e1, h, m1), Concat ({ node = Extract (e2, m2, l); _ }, e3) ->
+    make (Concat (merge_extracts (e1, h, m1) (e2, m2, l), e3))
+  | _ -> make (Concat (msb, lsb))
 
 let loadn m a n =
-  let rec loop addr size i acc =
-    if i = size then acc
+  let rec loop addr size i acc =
+    if i = size then acc
     else
-      let addr' = Int32.(add addr (of_int i)) in
+      let addr' = Int32.(add addr (of_int i)) in
       let byte = load_byte m addr' in
-      loop addr size (i + 1) (concat i ~msb:byte ~lsb:acc)
+      loop addr size (i + 1) (concat i ~msb:byte ~lsb:acc)
   in
   let v0 = load_byte m a in
-  loop a n 1 v0
+  loop a n 1 v0
 
 let load_8_s m a =
-  let v = loadn m (i32 a) 1 in
-  match view v with
-  | Val (Num (I8 i8)) -> Value.const_i32 (Int32.extend_s 8 (Int32.of_int i8))
-  | _ -> cvtop (Ty_bitv 32) (Sign_extend 24) v
+  let v = loadn m (i32 a) 1 in
+  match view v with
+  | Val (Num (I8 i8)) -> Value.const_i32 (Int32.extend_s 8 (Int32.of_int i8))
+  | _ -> cvtop (Ty_bitv 32) (Sign_extend 24) v
 
 let load_8_u m a =
-  let v = loadn m (i32 a) 1 in
-  match view v with
-  | Val (Num (I8 i)) -> Value.const_i32 (Int32.of_int i)
-  | _ -> cvtop (Ty_bitv 32) (Zero_extend 24) v
+  let v = loadn m (i32 a) 1 in
+  match view v with
+  | Val (Num (I8 i)) -> Value.const_i32 (Int32.of_int i)
+  | _ -> cvtop (Ty_bitv 32) (Zero_extend 24) v
 
 let load_16_s m a =
-  let v = loadn m (i32 a) 2 in
-  match view v with
+  let v = loadn m (i32 a) 2 in
+  match view v with
   | Val (Num (I32 i16)) -> Value.const_i32 (Int32.extend_s 16 i16)
-  | _ -> cvtop (Ty_bitv 32) (Sign_extend 16) v
+  | _ -> cvtop (Ty_bitv 32) (Sign_extend 16) v
 
 let load_16_u m a =
-  let v = loadn m (i32 a) 2 in
-  match view v with
+  let v = loadn m (i32 a) 2 in
+  match view v with
   | Val (Num (I32 _)) -> v
-  | _ -> cvtop (Ty_bitv 32) (Zero_extend 16) v
+  | _ -> cvtop (Ty_bitv 32) (Zero_extend 16) v
 
-let load_32 m a = loadn m (i32 a) 4
+let load_32 m a = loadn m (i32 a) 4
 
-let load_64 m a = loadn m (i32 a) 8
+let load_64 m a = loadn m (i32 a) 8
 
 let extract v pos =
-  match view v with
-  | Val (Num (I32 i)) ->
-    let i' = Int32.(to_int @@ logand 0xffl @@ shr_s i @@ of_int (pos * 8)) in
+  match view v with
+  | Val (Num (I32 i)) ->
+    let i' = Int32.(to_int @@ logand 0xffl @@ shr_s i @@ of_int (pos * 8)) in
     value (Num (I8 i'))
   | Val (Num (I64 i)) ->
     let i' = Int64.(to_int @@ logand 0xffL @@ shr_s i @@ of_int (pos * 8)) in
     value (Num (I8 i'))
-  | Cvtop (_, Zero_extend 24, ({ node = Symbol _; _ } as sym))
+  | Cvtop (_, Zero_extend 24, ({ node = Symbol _; _ } as sym))
   | Cvtop (_, Sign_extend 24, ({ node = Symbol _; _ } as sym))
-    when ty sym = Ty_bitv 8 ->
-    sym
-  | _ -> make (Extract (v, pos + 1, pos))
+    when Smtml.Ty.equal (Ty_bitv 8) (ty sym) ->
+    sym
+  | _ -> make (Extract (v, pos + 1, pos))
 
 let storen m ~addr v n =
-  let a0 = i32 addr in
-  for i = 0 to n - 1 do
-    let addr' = Int32.add a0 (Int32.of_int i) in
-    let v' = extract v i in
-    Hashtbl.replace m.data addr' v'
+  let a0 = i32 addr in
+  for i = 0 to n - 1 do
+    let addr' = Int32.add a0 (Int32.of_int i) in
+    let v' = extract v i in
+    Hashtbl.replace m.data addr' v'
   done
 
-let store_8 m ~addr v = storen m ~addr v 1
+let store_8 m ~addr v = storen m ~addr v 1
 
-let store_16 m ~addr v = storen m ~addr v 2
+let store_16 m ~addr v = storen m ~addr v 2
 
-let store_32 m ~addr v = storen m ~addr v 4
+let store_32 m ~addr v = storen m ~addr v 4
 
-let store_64 m ~addr v = storen m ~addr v 8
+let store_64 m ~addr v = storen m ~addr v 8
 
-let get_limit_max _m = None (* TODO *)
+let get_limit_max _m = None (* TODO *)
 
 let check_within_bounds m a =
-  match view a with
-  | Val (Num (I32 _)) -> Ok (Value.Bool.const false, a)
-  | Ptr (base, offset) -> (
+  match view a with
+  | Val (Num (I32 _)) -> Ok (Value.Bool.const false, a)
+  | Ptr { base; offset } -> (
     match Hashtbl.find m.chunks base with
     | exception Not_found -> Error Trap.Memory_leak_use_after_free
-    | size ->
-      let ptr = Int32.add base (i32 offset) in
-      let upper_bound =
-        Value.(I32.ge (const_i32 ptr) (I32.add (const_i32 base) size))
+    | size ->
+      let ptr = Int32.add base (i32 offset) in
+      let upper_bound =
+        Value.(I32.ge (const_i32 ptr) (I32.add (const_i32 base) size))
       in
-      Ok (Value.Bool.(or_ (const (ptr < base)) upper_bound), Value.const_i32 ptr)
-    )
+      Ok
+        ( Value.Bool.(or_ (const (Int32.lt ptr base)) upper_bound)
+        , Value.const_i32 ptr ) )
   | _ -> Log.err {|Unable to calculate address of: "%a"|} Expr.pp a
 
 let free m base =
-  if not @@ Hashtbl.mem m.chunks base then failwith "Memory leak double free";
-  Hashtbl.remove m.chunks base
+  if not @@ Hashtbl.mem m.chunks base then
+    Fmt.failwith "Memory leak double free";
+  Hashtbl.remove m.chunks base
 
-let replace_size m base size = Hashtbl.replace m.chunks base size
+let realloc m base size = Hashtbl.replace m.chunks base size
 
 module ITbl = Hashtbl.Make (struct
   include Int
 
-  let hash x = x
+  let hash x = x
 end)
 
 type collection = t ITbl.t Env_id.Tbl.t
 
-let init () = Env_id.Tbl.create 0
+let init () = Env_id.Tbl.create 0
 
-let iter f collection = Env_id.Tbl.iter (fun _ tbl -> f tbl) collection
+let iter f collection = Env_id.Tbl.iter (fun _ tbl -> f tbl) collection
 
 let clone collection =
   (* TODO: this is ugly and should be rewritten *)
-  let s = Env_id.Tbl.to_seq collection in
-  Env_id.Tbl.of_seq
-  @@ Seq.map
+  let s = Env_id.Tbl.to_seq collection in
+  Env_id.Tbl.of_seq
+  @@ Seq.map
        (fun (i, t) ->
-         let s = ITbl.to_seq t in
-         (i, ITbl.of_seq @@ Seq.map (fun (i, a) -> (i, clone a)) s) )
+         let s = ITbl.to_seq t in
+         (i, ITbl.of_seq @@ Seq.map (fun (i, a) -> (i, clone a)) s) )
        s
 
 let convert (orig_mem : Concrete_memory.t) : t =
-  let s = Concrete_memory.size_in_pages orig_mem in
-  create s
+  let s = Concrete_memory.size_in_pages orig_mem in
+  create s
 
 let get_env env_id memories =
-  match Env_id.Tbl.find_opt memories env_id with
-  | Some env -> env
-  | None ->
+  match Env_id.Tbl.find_opt memories env_id with
+  | Some env -> env
+  | None ->
     let t = ITbl.create 0 in
-    Env_id.Tbl.add memories env_id t;
-    t
+    Env_id.Tbl.add memories env_id t;
+    t
 
 let get_memory env_id (orig_memory : Concrete_memory.t) collection g_id =
-  let env = get_env env_id collection in
-  match ITbl.find_opt env g_id with
-  | Some t -> t
-  | None ->
+  let env = get_env env_id collection in
+  match ITbl.find_opt env g_id with
+  | Some t -> t
+  | None ->
     let t = convert orig_memory in
-    ITbl.add env g_id t;
-    t
+    ITbl.add env g_id t;
+    t
diff --git a/coverage/src/symbolic/symbolic_memory_concretizing.ml.html b/coverage/src/symbolic/symbolic_memory_concretizing.ml.html new file mode 100644 index 000000000..aae41960d --- /dev/null +++ b/coverage/src/symbolic/symbolic_memory_concretizing.ml.html @@ -0,0 +1,492 @@ + + + + + symbolic_memory_concretizing.ml — Coverage report + + + + + + + + +
+
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+
+
+
+ 
+  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
+
+
module Backend = struct
+  open Smtml
+
+  type address = Int32.t
+
+  type t =
+    { data : (address, Symbolic_value.int32) Hashtbl.t
+    ; parent : t option
+    ; chunks : (address, Symbolic_value.int32) Hashtbl.t
+    }
+
+  let make () =
+    { data = Hashtbl.create 16; parent = None; chunks = Hashtbl.create 16 }
+
+  let clone m =
+    (* TODO: Make chunk copying lazy *)
+    { data = Hashtbl.create 16
+    ; parent = Some m
+    ; chunks = Hashtbl.copy m.chunks
+    }
+
+  let address a =
+    let open Symbolic_choice_without_memory in
+    match Expr.view a with
+    | Val (Num (I32 i)) -> return i
+    | Ptr { base; offset } ->
+      select_i32 Symbolic_value.(I32.add (const_i32 base) offset)
+    | _ -> select_i32 a
+
+  let address_i32 a = a
+
+  let rec load_byte { parent; data; _ } a =
+    try Hashtbl.find data a
+    with Not_found -> (
+      match parent with
+      | None -> Expr.value (Num (I8 0))
+      | Some parent -> load_byte parent a )
+
+  (* TODO: don't rebuild so many values it generates unecessary hc lookups *)
+  let merge_extracts (e1, h, m1) (e2, m2, l) =
+    let ty = Expr.ty e1 in
+    if m1 = m2 && Expr.equal e1 e2 then
+      if h - l = Ty.size ty then e1 else Expr.make (Extract (e1, h, l))
+    else
+      Expr.(
+        make (Concat (make (Extract (e1, h, m1)), make (Extract (e2, m2, l)))) )
+
+  let concat ~msb ~lsb offset =
+    assert (offset > 0 && offset <= 8);
+    match (Expr.view msb, Expr.view lsb) with
+    | Val (Num (I8 i1)), Val (Num (I8 i2)) ->
+      Symbolic_value.const_i32 Int32.(logor (shl (of_int i1) 8l) (of_int i2))
+    | Val (Num (I8 i1)), Val (Num (I32 i2)) ->
+      let offset = offset * 8 in
+      if offset < 32 then
+        Symbolic_value.const_i32
+          Int32.(logor (shl (of_int i1) (of_int offset)) i2)
+      else
+        let i1' = Int64.of_int i1 in
+        let i2' = Int64.of_int32 i2 in
+        Symbolic_value.const_i64 Int64.(logor (shl i1' (of_int offset)) i2')
+    | Val (Num (I8 i1)), Val (Num (I64 i2)) ->
+      let offset = Int64.of_int (offset * 8) in
+      Symbolic_value.const_i64 Int64.(logor (shl (of_int i1) offset) i2)
+    | Extract (e1, h, m1), Extract (e2, m2, l) ->
+      merge_extracts (e1, h, m1) (e2, m2, l)
+    | Extract (e1, h, m1), Concat ({ node = Extract (e2, m2, l); _ }, e3) ->
+      Expr.(make (Concat (merge_extracts (e1, h, m1) (e2, m2, l), e3)))
+    | _ -> Expr.make (Concat (msb, lsb))
+
+  let loadn m a n =
+    let rec loop addr size i acc =
+      if i = size then acc
+      else
+        let addr' = Int32.(add addr (of_int i)) in
+        let byte = load_byte m addr' in
+        loop addr size (i + 1) (concat i ~msb:byte ~lsb:acc)
+    in
+    let v0 = load_byte m a in
+    loop a n 1 v0
+
+  let extract v pos =
+    match Expr.view v with
+    | Val (Num (I8 _)) -> v
+    | Val (Num (I32 i)) ->
+      let i' = Int32.(to_int @@ logand 0xffl @@ shr_s i @@ of_int (pos * 8)) in
+      Expr.value (Num (I8 i'))
+    | Val (Num (I64 i)) ->
+      let i' = Int64.(to_int @@ logand 0xffL @@ shr_s i @@ of_int (pos * 8)) in
+      Expr.value (Num (I8 i'))
+    | Cvtop
+        (_, Zero_extend 24, ({ node = Symbol { ty = Ty_bitv 8; _ }; _ } as sym))
+    | Cvtop
+        (_, Sign_extend 24, ({ node = Symbol { ty = Ty_bitv 8; _ }; _ } as sym))
+      ->
+      sym
+    | _ -> Expr.make (Extract (v, pos + 1, pos))
+
+  let storen m a v n =
+    for i = 0 to n - 1 do
+      let a' = Int32.add a (Int32.of_int i) in
+      let v' = extract v i in
+      Hashtbl.replace m.data a' v'
+    done
+
+  let validate_address m a =
+    let open Symbolic_choice_without_memory in
+    match Smtml.Expr.view a with
+    | Val (Num (I32 _)) -> return (Ok a) (* An i32 is a valid address *)
+    | Ptr { base; offset } -> (
+      let (* A pointer is valid if it's within bounds. *)
+      open Symbolic_value in
+      match Hashtbl.find m.chunks base with
+      | exception Not_found -> return (Error Trap.Memory_leak_use_after_free)
+      | size ->
+        let base = const_i32 base in
+        let ptr = I32.add base offset in
+        let+ is_out_of_bounds =
+          select (Bool.or_ (I32.lt ptr base) (I32.ge ptr (I32.add base size)))
+        in
+        if is_out_of_bounds then Error Trap.Memory_heap_buffer_overflow
+        else Ok a )
+    | _ ->
+      (* A symbolic expression should be a valid address *)
+      return (Ok a)
+
+  let ptr v =
+    let open Symbolic_choice_without_memory in
+    match Expr.view v with
+    | Ptr { base; _ } -> return base
+    | _ ->
+      Log.debug2 {|free: cannot fetch pointer base of "%a"|} Expr.pp v;
+      let* () = add_pc @@ Expr.value False in
+      assert false
+
+  let free m p =
+    let open Symbolic_choice_without_memory in
+    let+ base = ptr p in
+    if not @@ Hashtbl.mem m.chunks base then
+      Fmt.failwith "Memory leak double free";
+    Hashtbl.remove m.chunks base
+
+  let realloc m ~ptr ~size =
+    let open Symbolic_choice_without_memory in
+    let+ base = address ptr in
+    Hashtbl.replace m.chunks base size;
+    Expr.ptr base (Symbolic_value.const_i32 0l)
+end
+
+include Symbolic_memory_make.Make (Backend)
+
+
+
+ + + diff --git a/coverage/src/symbolic/symbolic_memory_make.ml.html b/coverage/src/symbolic/symbolic_memory_make.ml.html new file mode 100644 index 000000000..31fed12a7 --- /dev/null +++ b/coverage/src/symbolic/symbolic_memory_make.ml.html @@ -0,0 +1,586 @@ + + + + + symbolic_memory_make.ml — Coverage report + + + + + + + + +
+
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+
+
+
+ 
+  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
+
+
(* SPDX-License-Identifier: AGPL-3.0-or-later *)
+(* Copyright © 2021-2024 OCamlPro *)
+(* Written by the Owi programmers *)
+
+include Symbolic_memory_intf
+
+let page_size = Symbolic_value.const_i32 65_536l
+
+module Make (Backend : M) = struct
+  type t =
+    { data : Backend.t
+    ; mutable size : Symbolic_value.int32
+    }
+
+  let create size =
+    { data = Backend.make (); size = Symbolic_value.const_i32 size }
+
+  let i32 v =
+    match Smtml.Expr.view v with
+    | Val (Num (I32 i)) -> i
+    | _ ->
+      Log.err {|Unsupported symbolic value reasoning over "%a"|} Smtml.Expr.pp v
+
+  let grow m delta =
+    let old_size = Symbolic_value.I32.mul m.size page_size in
+    let new_size = Symbolic_value.I32.(div (add old_size delta) page_size) in
+    m.size <-
+      Symbolic_value.Bool.select_expr
+        (Symbolic_value.I32.gt new_size m.size)
+        ~if_true:new_size ~if_false:m.size
+
+  let size { size; _ } = Symbolic_value.I32.mul size page_size
+
+  let size_in_pages { size; _ } = size
+
+  let fill _ = assert false
+
+  let blit _ = assert false
+
+  let blit_string m str ~src ~dst ~len =
+    (* This function is only used in memory init so everything will be concrete *)
+    let str_len = String.length str in
+    let mem_len = Int32.(to_int (i32 m.size) * to_int (i32 page_size)) in
+    let src = Int32.to_int @@ i32 src in
+    let dst = Int32.to_int @@ i32 dst in
+    let len = Int32.to_int @@ i32 len in
+    if
+      src < 0 || dst < 0 || len < 0
+      || src + len > str_len
+      || dst + len > mem_len
+    then Symbolic_value.Bool.const true
+    else begin
+      for i = 0 to len - 1 do
+        let byte = Char.code @@ String.get str (src + i) in
+        let a = Backend.address_i32 (Int32.of_int (dst + i)) in
+        Backend.storen m.data a (Smtml.Expr.value (Num (I8 byte))) 1
+      done;
+      Symbolic_value.Bool.const false
+    end
+
+  let clone m = { data = Backend.clone m.data; size = m.size }
+
+  let must_be_valid_address m a =
+    let open Symbolic_choice_without_memory in
+    let* addr = Backend.validate_address m a in
+    match addr with Error t -> trap t | Ok ptr -> Backend.address ptr
+
+  let load_8_s m a =
+    let open Symbolic_choice_without_memory in
+    let+ a = must_be_valid_address m.data a in
+    let v = Backend.loadn m.data a 1 in
+    match Smtml.Expr.view v with
+    | Val (Num (I8 i8)) ->
+      Symbolic_value.const_i32 (Int32.extend_s 8 (Int32.of_int i8))
+    | _ -> Smtml.Expr.cvtop (Ty_bitv 32) (Sign_extend 24) v
+
+  let load_8_u m a =
+    let open Symbolic_choice_without_memory in
+    let+ a = must_be_valid_address m.data a in
+    let v = Backend.loadn m.data a 1 in
+    match Smtml.Expr.view v with
+    | Val (Num (I8 i)) -> Symbolic_value.const_i32 (Int32.of_int i)
+    | _ -> Smtml.Expr.cvtop (Ty_bitv 32) (Zero_extend 24) v
+
+  let load_16_s m a =
+    let open Symbolic_choice_without_memory in
+    let+ a = must_be_valid_address m.data a in
+    let v = Backend.loadn m.data a 2 in
+    match Smtml.Expr.view v with
+    | Val (Num (I32 i16)) -> Symbolic_value.const_i32 (Int32.extend_s 16 i16)
+    | _ -> Smtml.Expr.cvtop (Ty_bitv 32) (Sign_extend 16) v
+
+  let load_16_u m a =
+    let open Symbolic_choice_without_memory in
+    let+ a = must_be_valid_address m.data a in
+    let v = Backend.loadn m.data a 2 in
+    match Smtml.Expr.view v with
+    | Val (Num (I32 _)) -> v
+    | _ -> Smtml.Expr.cvtop (Ty_bitv 32) (Zero_extend 16) v
+
+  let load_32 m a =
+    let open Symbolic_choice_without_memory in
+    let+ a = must_be_valid_address m.data a in
+    Backend.loadn m.data a 4
+
+  let load_64 m a =
+    let open Symbolic_choice_without_memory in
+    let+ a = must_be_valid_address m.data a in
+    Backend.loadn m.data a 8
+
+  let store_8 m ~addr v =
+    let open Symbolic_choice_without_memory in
+    let+ a = must_be_valid_address m.data addr in
+    Backend.storen m.data a v 1
+
+  let store_16 m ~addr v =
+    let open Symbolic_choice_without_memory in
+    let+ a = must_be_valid_address m.data addr in
+    Backend.storen m.data a v 2
+
+  let store_32 m ~addr v =
+    let open Symbolic_choice_without_memory in
+    let+ a = must_be_valid_address m.data addr in
+    Backend.storen m.data a v 4
+
+  let store_64 m ~addr v =
+    let open Symbolic_choice_without_memory in
+    let+ a = must_be_valid_address m.data addr in
+    Backend.storen m.data a v 8
+
+  let get_limit_max _m = None (* TODO *)
+
+  let free m base = Backend.free m.data base
+
+  let realloc m ~ptr ~size = Backend.realloc m.data ~ptr ~size
+
+  (* TODO: Move this into a separate module? *)
+  module ITbl = Hashtbl.Make (struct
+    include Int
+
+    let hash x = x
+  end)
+
+  type collection = t ITbl.t Env_id.Tbl.t
+
+  let init () = Env_id.Tbl.create 0
+
+  let iter f collection = Env_id.Tbl.iter (fun _ tbl -> f tbl) collection
+
+  let clone collection =
+    (* TODO: this is ugly and should be rewritten *)
+    let s = Env_id.Tbl.to_seq collection in
+    Env_id.Tbl.of_seq
+    @@ Seq.map
+         (fun (i, t) ->
+           let s = ITbl.to_seq t in
+           (i, ITbl.of_seq @@ Seq.map (fun (i, a) -> (i, clone a)) s) )
+         s
+
+  let convert (orig_mem : Concrete_memory.t) : t =
+    let s = Concrete_memory.size_in_pages orig_mem in
+    create s
+
+  let get_env env_id memories =
+    match Env_id.Tbl.find_opt memories env_id with
+    | Some env -> env
+    | None ->
+      let t = ITbl.create 0 in
+      Env_id.Tbl.add memories env_id t;
+      t
+
+  let get_memory env_id (orig_memory : Concrete_memory.t) collection g_id =
+    let env = get_env env_id collection in
+    match ITbl.find_opt env g_id with
+    | Some t -> t
+    | None ->
+      let t = convert orig_memory in
+      ITbl.add env g_id t;
+      t
+end
+
+
+
+ + + diff --git a/coverage/src/symbolic/symbolic_table.ml.html b/coverage/src/symbolic/symbolic_table.ml.html index ad6680c1c..d599022b3 100644 --- a/coverage/src/symbolic/symbolic_table.ml.html +++ b/coverage/src/symbolic/symbolic_table.ml.html @@ -224,7 +224,7 @@

71.11%

module ITbl = Hashtbl.Make (struct include Int - let hash x = x + let hash x = x end) type t = @@ -233,25 +233,25 @@

71.11%

; typ : binary ref_type } -let clone_t { limits; data; typ } = { typ; limits; data = Array.copy data } +let clone_t { limits; data; typ } = { typ; limits; data = Array.copy data } type collection = t ITbl.t Env_id.Tbl.t -let init () = Env_id.Tbl.create 0 +let init () = Env_id.Tbl.create 0 let clone (collection : collection) = (* TODO: this is ugly and should be rewritten *) - let s = Env_id.Tbl.to_seq collection in - Env_id.Tbl.of_seq - @@ Seq.map + let s = Env_id.Tbl.to_seq collection in + Env_id.Tbl.of_seq + @@ Seq.map (fun (i, t) -> - let s = ITbl.to_seq t in - (i, ITbl.of_seq @@ Seq.map (fun (i, a) -> (i, clone_t a)) s) ) + let s = ITbl.to_seq t in + (i, ITbl.of_seq @@ Seq.map (fun (i, a) -> (i, clone_t a)) s) ) s let convert_ref_values (v : Concrete_value.ref_value) : Symbolic_value.ref_value = - match v with Funcref f -> Funcref f | _ -> assert false + match v with Funcref f -> Funcref f | _ -> assert false let convert (orig_table : Concrete_table.t) = { data = Array.map convert_ref_values orig_table.data @@ -260,8 +260,8 @@

71.11%

} let get_env env_id tables = - match Env_id.Tbl.find_opt tables env_id with - | Some env -> env + match Env_id.Tbl.find_opt tables env_id with + | Some env -> env | None -> let t = ITbl.create 0 in Env_id.Tbl.add tables env_id t; @@ -269,21 +269,21 @@

71.11%

let get_table env_id (orig_table : Concrete_table.t) (collection : collection) t_id = - let env = get_env env_id collection in - match ITbl.find_opt env t_id with - | Some t -> t + let env = get_env env_id collection in + match ITbl.find_opt env t_id with + | Some t -> t | None -> let t = convert orig_table in ITbl.add env t_id t; t -let get t i = t.data.(i) +let get t i = t.data.(i) -let set t i v = t.data.(i) <- v +let set t i v = t.data.(i) <- v -let size t = Array.length t.data +let size t = Array.length t.data -let typ t = t.typ +let typ t = t.typ let max_size t = t.limits.max diff --git a/coverage/src/symbolic/symbolic_value.ml.html b/coverage/src/symbolic/symbolic_value.ml.html index effebf02a..6c095c16f 100644 --- a/coverage/src/symbolic/symbolic_value.ml.html +++ b/coverage/src/symbolic/symbolic_value.ml.html @@ -3,7 +3,7 @@ symbolic_value.ml — Coverage report - + @@ -15,42 +15,43 @@

src/symbolic/symbolic_value.ml

-

85.12%

+

84.77%

@@ -86,76 +87,76 @@

85.12%

- - - + + + - + - + - + - + - + - - - + + + - - - - + + + + - - - - + + + + - + - - + + - - + + - - - - + + + + - - - + + + - - - + + + - + - - - - - - - + + + + + + + - - - - + + + + @@ -164,83 +165,83 @@

85.12%

- + - + - + - + - - + + - + - - + + - - - - + + + + - - + + - - + + - + - - + + - - - - - - - + + + + + + + - - + + - - - + + + - - - + + + - - - + + + - + @@ -248,55 +249,55 @@

85.12%

- - - + + + - + - - - - + + + + - + - + - + - + - + - + - + - + - + - + - + - + - + @@ -344,17 +345,17 @@

85.12%

- + - + - + - + - + @@ -362,17 +363,17 @@

85.12%

- + - + - + - + - + @@ -380,9 +381,9 @@

85.12%

- + - + @@ -390,7 +391,7 @@

85.12%

- + @@ -422,32 +423,32 @@

85.12%

- - + + - - + + - + - - - - - - - - - - + + + + + + + + + + - + - + - + @@ -455,7 +456,7 @@

85.12%

- + @@ -487,11 +488,29 @@

85.12%

- - + + - - + + + + + + + + + + + + + + + + + + + +
@@ -933,6 +952,24 @@

85.12%

435 436 437 +438 +439 +440 +441 +442 +443 +444 +445 +446 +447 +448 +449 +450 +451 +452 +453 +454 +455 
(* SPDX-License-Identifier: AGPL-3.0-or-later *)
 (* Copyright © 2021-2024 OCamlPro *)
@@ -946,18 +983,28 @@ 
85.12%

 
 type int32 = Expr.t
 
+let pp_int32 = Expr.pp
+
 type int64 = Expr.t
 
+let pp_int64 = Expr.pp
+
 type float32 = Expr.t
 
+let pp_float32 = Expr.pp
+
 type float64 = Expr.t
 
+let pp_float64 = Expr.pp
+
 type externref = Concrete_value.externref
 
 type ref_value =
   | Funcref of Func_intf.t option
   | Externref of externref option
 
+let pp_ref_value _fmt _v = assert false
+
 type t =
   | I32 of int32
   | I64 of int64
@@ -965,13 +1012,13 @@ 
85.12%

   | F64 of float64
   | Ref of ref_value
 
-let const_i32 (i : Int32.t) : int32 = value (Num (I32 i))
+let const_i32 (i : Int32.t) : int32 = value (Num (I32 i))
 
-let const_i64 (i : Int64.t) : int64 = value (Num (I64 i))
+let const_i64 (i : Int64.t) : int64 = value (Num (I64 i))
 
-let const_f32 (f : Float32.t) : float32 = value (Num (F32 (Float32.to_bits f)))
+let const_f32 (f : Float32.t) : float32 = value (Num (F32 (Float32.to_bits f)))
 
-let const_f64 (f : Float64.t) : float64 = value (Num (F64 (Float64.to_bits f)))
+let const_f64 (f : Float64.t) : float64 = value (Num (F64 (Float64.to_bits f)))
 
 let ref_null _ty = Ref (Funcref None)
 
@@ -996,8 +1043,8 @@ 
85.12%

 
 module Ref = struct
   let get_func (r : ref_value) : Func_intf.t Value_intf.get_ref =
-    match r with
-    | Funcref (Some f) -> Ref_value f
+    match r with
+    | Funcref (Some f) -> Ref_value f
     | Funcref None -> Null
     | Externref _ -> Type_mismatch
 
@@ -1012,22 +1059,22 @@ 
85.12%

 end
 
 module Bool = struct
-  let const b = Bool.v b
+  let const b = Bool.v b
 
-  let not e = Bool.not e
+  let not e = Bool.not e
 
-  let or_ e1 e2 = Bool.or_ e1 e2
+  let or_ e1 e2 = Bool.or_ e1 e2
 
-  let and_ e1 e2 = Bool.and_ e1 e2
+  let and_ e1 e2 = Bool.and_ e1 e2
 
   let int32 e =
-    match view e with
-    | Val True -> const_i32 1l
-    | Val False -> const_i32 0l
+    match view e with
+    | Val True -> const_i32 1l
+    | Val False -> const_i32 0l
     | Cvtop (Ty_bitv 32, ToBool, e') -> e'
-    | _ -> make (Cvtop (Ty_bitv 32, OfBool, e))
+    | _ -> make (Cvtop (Ty_bitv 32, OfBool, e))
 
-  let select_expr c ~if_true ~if_false = Bool.ite c if_true if_false
+  let select_expr c ~if_true ~if_false = Bool.ite c if_true if_false
 
   let pp ppf (e : vbool) = Expr.pp ppf e
 end
@@ -1035,9 +1082,9 @@ 
85.12%

 module I32 = struct
   let ty = Ty_bitv 32
 
-  let zero = const_i32 0l
+  let zero = const_i32 0l
 
-  let clz e = unop ty Clz e
+  let clz e = unop ty Clz e
 
   let ctz e = unop ty Ctz e
 
@@ -1045,81 +1092,89 @@ 
85.12%

     (* TODO *)
     assert false
 
-  let add e1 e2 = binop ty Add e1 e2
+  let add e1 e2 = binop ty Add e1 e2
 
-  let sub e1 e2 = binop ty Sub e1 e2
+  let sub e1 e2 = binop ty Sub e1 e2
 
-  let mul e1 e2 = binop ty Mul e1 e2
+  let mul e1 e2 = binop ty Mul e1 e2
 
   let div e1 e2 = binop ty Div e1 e2
 
-  let unsigned_div e1 e2 = binop ty DivU e1 e2
+  let unsigned_div e1 e2 = binop ty DivU e1 e2
 
-  let rem e1 e2 = binop ty Rem e1 e2
+  let rem e1 e2 = binop ty Rem e1 e2
 
   let unsigned_rem e1 e2 = binop ty RemU e1 e2
 
   let boolify e =
-    match view e with
-    | Val (Num (I32 0l)) -> Some (Bool.const false)
-    | Val (Num (I32 1l)) -> Some (Bool.const true)
-    | Cvtop (_, OfBool, cond) -> Some cond
-    | _ -> None
+    match view e with
+    | Val (Num (I32 0l)) -> Some (Bool.const false)
+    | Val (Num (I32 1l)) -> Some (Bool.const true)
+    | Cvtop (_, OfBool, cond) -> Some cond
+    | _ -> None
 
   let logand e1 e2 =
-    match (boolify e1, boolify e2) with
-    | Some b1, Some b2 -> Bool.int32 (Bool.and_ b1 b2)
-    | _ -> binop ty And e1 e2
+    match (boolify e1, boolify e2) with
+    | Some b1, Some b2 -> Bool.int32 (Bool.and_ b1 b2)
+    | _ -> binop ty And e1 e2
 
   let logor e1 e2 =
-    match (boolify e1, boolify e2) with
+    match (boolify e1, boolify e2) with
     | Some b1, Some b2 -> Bool.int32 (Bool.or_ b1 b2)
-    | _ -> binop ty Or e1 e2
+    | _ -> binop ty Or e1 e2
 
-  let logxor e1 e2 = binop ty Xor e1 e2
+  let logxor e1 e2 = binop ty Xor e1 e2
 
-  let shl e1 e2 = binop ty Shl e1 e2
+  let shl e1 e2 = binop ty Shl e1 e2
 
-  let shr_s e1 e2 = binop ty ShrA e1 e2
+  let shr_s e1 e2 = binop ty ShrA e1 e2
 
-  let shr_u e1 e2 = binop ty ShrL e1 e2
+  let shr_u e1 e2 = binop ty ShrL e1 e2
 
   let rotl e1 e2 = binop ty Rotl e1 e2
 
   let rotr e1 e2 = binop ty Rotr e1 e2
 
   let eq_const e c =
-    match view e with
-    | Cvtop (_, OfBool, cond) -> begin
-      match c with 0l -> Bool.not cond | 1l -> cond | _ -> Bool.const false
+    match view e with
+    | Cvtop (_, OfBool, cond) -> begin
+      match c with 0l -> Bool.not cond | 1l -> cond | _ -> Bool.const false
     end
-    | _ -> relop Ty_bool Eq e (const_i32 c)
+    | _ -> relop Ty_bool Eq e (const_i32 c)
 
-  let eq e1 e2 = if e1 == e2 then Bool.const true else relop Ty_bool Eq e1 e2
+  let eq e1 e2 =
+    if phys_equal e1 e2 then Bool.const true else relop Ty_bool Eq e1 e2
 
-  let ne e1 e2 = if e1 == e2 then Bool.const false else relop Ty_bool Ne e1 e2
+  let ne e1 e2 =
+    if phys_equal e1 e2 then Bool.const false else relop Ty_bool Ne e1 e2
 
-  let lt e1 e2 = if e1 == e2 then Bool.const false else relop ty Lt e1 e2
+  let lt e1 e2 =
+    if phys_equal e1 e2 then Bool.const false else relop ty Lt e1 e2
 
-  let gt e1 e2 = if e1 == e2 then Bool.const false else relop ty Gt e1 e2
+  let gt e1 e2 =
+    if phys_equal e1 e2 then Bool.const false else relop ty Gt e1 e2
 
-  let lt_u e1 e2 = if e1 == e2 then Bool.const false else relop ty LtU e1 e2
+  let lt_u e1 e2 =
+    if phys_equal e1 e2 then Bool.const false else relop ty LtU e1 e2
 
-  let gt_u e1 e2 = if e1 == e2 then Bool.const false else relop ty GtU e1 e2
+  let gt_u e1 e2 =
+    if phys_equal e1 e2 then Bool.const false else relop ty GtU e1 e2
 
-  let le e1 e2 = if e1 == e2 then Bool.const true else relop ty Le e1 e2
+  let le e1 e2 = if phys_equal e1 e2 then Bool.const true else relop ty Le e1 e2
 
-  let ge e1 e2 = if e1 == e2 then Bool.const true else relop ty Ge e1 e2
+  let ge e1 e2 = if phys_equal e1 e2 then Bool.const true else relop ty Ge e1 e2
 
-  let le_u e1 e2 = if e1 == e2 then Bool.const true else relop ty LeU e1 e2
+  let le_u e1 e2 =
+    if phys_equal e1 e2 then Bool.const true else relop ty LeU e1 e2
 
-  let ge_u e1 e2 = if e1 == e2 then Bool.const true else relop ty GeU e1 e2
+  let ge_u e1 e2 =
+    if phys_equal e1 e2 then Bool.const true else relop ty GeU e1 e2
 
   let to_bool (e : vbool) =
-    match view e with
-    | Val (Num (I32 i)) -> Bool.const @@ Int32.ne i 0l
-    | Cvtop (_, OfBool, cond) -> cond
-    | _ -> make (Cvtop (ty, ToBool, e))
+    match view e with
+    | Val (Num (I32 i)) -> Bool.const @@ Int32.ne i 0l
+    | Cvtop (_, OfBool, cond) -> cond
+    | _ -> make (Cvtop (ty, ToBool, e))
 
   let trunc_f32_s x = cvtop ty TruncSF32 x
 
@@ -1149,7 +1204,7 @@ 
85.12%

 module I64 = struct
   let ty = Ty_bitv 64
 
-  let zero = const_i64 0L
+  let zero = const_i64 0L
 
   let clz e = unop ty Clz e
 
@@ -1245,7 +1300,7 @@ 
85.12%

 module F32 = struct
   let ty = Ty_fp 32
 
-  let zero = const_f32 Float32.zero
+  let zero = const_f32 Float32.zero
 
   let abs x = unop ty Abs x
 
@@ -1281,13 +1336,13 @@ 
85.12%

 
   let gt x y = relop ty Gt x y
 
-  let le x y = relop ty Le x y
+  let le x y = relop ty Le x y
 
-  let ge x y = relop ty Ge x y
+  let ge x y = relop ty Ge x y
 
   let convert_i32_s x = cvtop ty ConvertSI32 x
 
-  let convert_i32_u x = cvtop ty ConvertUI32 x
+  let convert_i32_u x = cvtop ty ConvertUI32 x
 
   let convert_i64_s x = cvtop ty ConvertSI64 x
 
@@ -1297,9 +1352,9 @@ 
85.12%

 
   let reinterpret_i32 x = cvtop ty Reinterpret_int x
 
-  let of_bits x = cvtop ty Reinterpret_int x
+  let of_bits x = cvtop ty Reinterpret_int x
 
-  let to_bits x = cvtop (Ty_bitv 32) Reinterpret_float x
+  let to_bits x = cvtop (Ty_bitv 32) Reinterpret_float x
 
   let copy_sign x y =
     let xi = to_bits (abs x) in
@@ -1310,7 +1365,7 @@ 
85.12%

 module F64 = struct
   let ty = Ty_fp 64
 
-  let zero = const_f64 Float64.zero
+  let zero = const_f64 Float64.zero
 
   let abs x = unop ty Abs x
 
diff --git a/coverage/src/symbolic/symbolic_wasm_ffi.ml.html b/coverage/src/symbolic/symbolic_wasm_ffi.ml.html
new file mode 100644
index 000000000..29438ceca
--- /dev/null
+++ b/coverage/src/symbolic/symbolic_wasm_ffi.ml.html
@@ -0,0 +1,356 @@
+
+
+  
+    
+    symbolic_wasm_ffi.ml — Coverage report
+    
+    
+    
+    
+  
+  
+    
+    
+    

+      

+        
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+

+      

+      

+        
+  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
+

+
(* SPDX-License-Identifier: AGPL-3.0-or-later *)
+(* Copyright © 2021-2024 OCamlPro *)
+(* Written by the Owi programmers *)
+
+module Expr = Smtml.Expr
+module Choice = Symbolic_choice_with_memory
+module Memory = Symbolic.P.Memory
+
+(* The constraint is used here to make sure we don't forget to define one of the expected FFI functions, this whole file is further constrained such that if one function of M is unused in the FFI module below, an error will be displayed *)
+module M :
+  Wasm_ffi_intf.S0
+    with type 'a t = 'a Choice.t
+     and type memory = Memory.t
+     and module Value = Symbolic_value = struct
+  type 'a t = 'a Choice.t
+
+  type memory = Memory.t
+
+  module Value = Symbolic_value
+
+  let assume_i32 (i : Value.int32) : unit Choice.t =
+    Choice.add_pc @@ Value.I32.to_bool i
+
+  let assume_positive_i32 (i : Value.int32) : unit Choice.t =
+    Choice.add_pc @@ Value.I32.ge i Value.I32.zero
+
+  let assert_i32 (i : Value.int32) : unit Choice.t =
+    Choice.assertion @@ Value.I32.to_bool i
+
+  let symbol_i8 () =
+    Choice.with_new_symbol (Ty_bitv 8) (fun sym ->
+        Expr.make (Cvtop (Ty_bitv 32, Zero_extend 24, Expr.symbol sym)) )
+
+  let symbol_char () =
+    Choice.with_new_symbol (Ty_bitv 8) (fun sym ->
+        Expr.make (Cvtop (Ty_bitv 32, Zero_extend 24, Expr.symbol sym)) )
+
+  let symbol_i32 () = Choice.with_new_symbol (Ty_bitv 32) Expr.symbol
+
+  let symbol_i64 () = Choice.with_new_symbol (Ty_bitv 64) Expr.symbol
+
+  let symbol_f32 () = Choice.with_new_symbol (Ty_fp 32) Expr.symbol
+
+  let symbol_f64 () = Choice.with_new_symbol (Ty_fp 64) Expr.symbol
+
+  let abort () : unit Choice.t = Choice.add_pc @@ Value.Bool.const false
+
+  let alloc m (base : Value.int32) (size : Value.int32) : Value.int32 Choice.t =
+    Choice.lift_mem @@ Memory.realloc m ~ptr:base ~size
+
+  let free m (ptr : Value.int32) : unit Choice.t =
+    Choice.lift_mem @@ Memory.free m ptr
+
+  let exit (_p : Value.int32) : unit Choice.t = abort ()
+end
+
+type extern_func = Symbolic.P.Extern_func.extern_func
+
+open M
+
+let symbolic_extern_module =
+  let functions =
+    [ ( "i8_symbol"
+      , Symbolic.P.Extern_func.Extern_func (Func (UArg Res, R1 I32), symbol_i8)
+      )
+    ; ( "char_symbol"
+      , Symbolic.P.Extern_func.Extern_func (Func (UArg Res, R1 I32), symbol_char)
+      )
+    ; ( "i32_symbol"
+      , Symbolic.P.Extern_func.Extern_func (Func (UArg Res, R1 I32), symbol_i32)
+      )
+    ; ( "i64_symbol"
+      , Symbolic.P.Extern_func.Extern_func (Func (UArg Res, R1 I64), symbol_i64)
+      )
+    ; ( "f32_symbol"
+      , Symbolic.P.Extern_func.Extern_func (Func (UArg Res, R1 F32), symbol_f32)
+      )
+    ; ( "f64_symbol"
+      , Symbolic.P.Extern_func.Extern_func (Func (UArg Res, R1 F64), symbol_f64)
+      )
+    ; ( "assume"
+      , Symbolic.P.Extern_func.Extern_func
+          (Func (Arg (I32, Res), R0), assume_i32) )
+    ; ( "assume_positive_i32"
+      , Symbolic.P.Extern_func.Extern_func
+          (Func (Arg (I32, Res), R0), assume_positive_i32) )
+    ; ( "assert"
+      , Symbolic.P.Extern_func.Extern_func
+          (Func (Arg (I32, Res), R0), assert_i32) )
+    ]
+  in
+  { Link.functions }
+
+let summaries_extern_module =
+  let functions =
+    [ ( "alloc"
+      , Symbolic.P.Extern_func.Extern_func
+          (Func (Mem (Arg (I32, Arg (I32, Res))), R1 I32), alloc) )
+    ; ( "dealloc"
+      , Symbolic.P.Extern_func.Extern_func
+          (Func (Mem (Arg (I32, Res)), R0), free) )
+    ; ("abort", Symbolic.P.Extern_func.Extern_func (Func (UArg Res, R0), abort))
+    ; ( "exit"
+      , Symbolic.P.Extern_func.Extern_func (Func (Arg (I32, Res), R0), exit) )
+    ]
+  in
+  { Link.functions }
+

+      

+    

+    
+  
+
diff --git a/coverage/src/symbolic/thread.ml.html b/coverage/src/symbolic/thread.ml.html
new file mode 100644
index 000000000..4c5c833c3
--- /dev/null
+++ b/coverage/src/symbolic/thread.ml.html
@@ -0,0 +1,227 @@
+
+
+  
+    
+    thread.ml — Coverage report
+    
+    
+    
+    
+  
+  
+    
+    
+    

+      

+        
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+

+      

+      

+        
+ 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
+

+
(* SPDX-License-Identifier: AGPL-3.0-or-later *)
+(* Copyright © 2021-2024 OCamlPro *)
+(* Written by the Owi programmers *)
+include Thread_intf
+
+module Make (Symbolic_memory : M) :
+  S with type Memory.collection = Symbolic_memory.collection = struct
+  module Memory : M with type collection = Symbolic_memory.collection =
+    Symbolic_memory
+
+  type t =
+    { symbols : int
+    ; symbol_set : Smtml.Symbol.t list
+    ; pc : Symbolic_value.vbool list
+    ; memories : Memory.collection
+    ; tables : Symbolic_table.collection
+    ; globals : Symbolic_global.collection
+        (** Breadcrumbs represent the list of choices that were made so far.
+            They identify one given symbolic execution trace. *)
+    ; breadcrumbs : int32 list
+    }
+
+  let create symbols symbol_set pc memories tables globals breadcrumbs =
+    { symbols; symbol_set; pc; memories; tables; globals; breadcrumbs }
+
+  let init () =
+    let symbols = 0 in
+    let symbol_set = [] in
+    let pc = [] in
+    let memories = Memory.init () in
+    let tables = Symbolic_table.init () in
+    let globals = Symbolic_global.init () in
+    let breadcrumbs = [] in
+    create symbols symbol_set pc memories tables globals breadcrumbs
+
+  let symbols t = t.symbols
+
+  let symbols_set t = t.symbol_set
+
+  let pc t = t.pc
+
+  let memories t = t.memories
+
+  let tables t = t.tables
+
+  let globals t = t.globals
+
+  let breadcrumbs t = t.breadcrumbs
+
+  let add_symbol t s = { t with symbol_set = s :: t.symbol_set }
+
+  let add_pc t c = { t with pc = c :: t.pc }
+
+  let add_breadcrumb t crumb = { t with breadcrumbs = crumb :: t.breadcrumbs }
+
+  let incr_symbols t = { t with symbols = succ t.symbols }
+
+  let clone { symbols; symbol_set; pc; memories; tables; globals; breadcrumbs }
+      =
+    let memories = Memory.clone memories in
+    let tables = Symbolic_table.clone tables in
+    let globals = Symbolic_global.clone globals in
+    { symbols; symbol_set; pc; memories; tables; globals; breadcrumbs }
+end
+

+      

+    

+    
+  
+
diff --git a/coverage/src/symbolic/thread_with_memory.ml.html b/coverage/src/symbolic/thread_with_memory.ml.html
new file mode 100644
index 000000000..faaf5851d
--- /dev/null
+++ b/coverage/src/symbolic/thread_with_memory.ml.html
@@ -0,0 +1,137 @@
+
+
+  
+    
+    thread_with_memory.ml — Coverage report
+    
+    
+    
+    
+  
+  
+    
+    
+    

+      

+        
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+

+      

+      

+        
+ 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
+

+
(* SPDX-License-Identifier: AGPL-3.0-or-later *)
+(* Copyright © 2021-2024 OCamlPro *)
+(* Written by the Owi programmers *)
+
+include Thread.Make (Symbolic_memory_concretizing)
+
+let project (th : t) : Thread_without_memory.t * _ =
+  let projected =
+    let symbols = symbols th in
+    let symbols_set = symbols_set th in
+    let pc = pc th in
+    let memories = Thread_without_memory.Memory.init () in
+    let tables = tables th in
+    let globals = globals th in
+    let breadcrumbs = breadcrumbs th in
+    Thread_without_memory.create symbols symbols_set pc memories tables globals
+      breadcrumbs
+  in
+  let backup = memories th in
+  (projected, backup)
+
+let restore backup th =
+  let symbols = Thread_without_memory.symbols th in
+  let symbols_set = Thread_without_memory.symbols_set th in
+  let pc = Thread_without_memory.pc th in
+  let memories =
+    if Thread_without_memory.memories th then
+      Symbolic_memory_concretizing.clone backup
+    else backup
+  in
+  let tables = Thread_without_memory.tables th in
+  let globals = Thread_without_memory.globals th in
+  let breadcrumbs = Thread_without_memory.breadcrumbs th in
+  create symbols symbols_set pc memories tables globals breadcrumbs
+

+      

+    

+    
+  
+
diff --git a/coverage/src/symbolic/thread_without_memory.ml.html b/coverage/src/symbolic/thread_without_memory.ml.html
new file mode 100644
index 000000000..fae740f13
--- /dev/null
+++ b/coverage/src/symbolic/thread_without_memory.ml.html
@@ -0,0 +1,68 @@
+
+
+  
+    
+    thread_without_memory.ml — Coverage report
+    
+    
+    
+    
+  
+  
+    
+    
+    

+      

+        
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+

+      

+      

+        
+ 1
+ 2
+ 3
+ 4
+ 5
+ 6
+ 7
+ 8
+ 9
+10
+11
+

+
(* SPDX-License-Identifier: AGPL-3.0-or-later *)
+(* Copyright © 2021-2024 OCamlPro *)
+(* Written by the Owi programmers *)
+
+include Thread.Make (struct
+  type collection = bool
+
+  let init () = false
+
+  let clone _ = true
+end)
+

+      

+    

+    
+  
+
diff --git a/coverage/src/text_to_binary/assigned.ml.html b/coverage/src/text_to_binary/assigned.ml.html
index dabc8d544..7846402bc 100644
--- a/coverage/src/text_to_binary/assigned.ml.html
+++ b/coverage/src/text_to_binary/assigned.ml.html
@@ -3,7 +3,7 @@
   
     
     assigned.ml — Coverage report
-    
+    
     
     
     
@@ -15,11 +15,11 @@ 

           src/text_to_binary/assigned.ml
         
       

-      
97.80%

+      
97.65%
@@ -40,11 +40,11 @@

97.80%

- - - + + + - + @@ -61,98 +61,98 @@

97.80%

- + - + - + - + - + - + - - + + - + - + - - + + - - + + - - + + - - - - + + + + - + - - + + - + - - + + - + - + - - + + - - - + + + - - + + - + - + - + @@ -160,47 +160,39 @@

97.80%

- + - - + + - - - - + + + + - - - - + + + + - + - - - - - + + + + + - - + + - - + + - - - - - - - -
@@ -374,14 +366,6 @@

97.80%

167 168 169 -170 -171 -172 -173 -174 -175 -176 -177 
(* SPDX-License-Identifier: AGPL-3.0-or-later *)
 (* Copyright © 2021-2024 OCamlPro *)
@@ -393,18 +377,11 @@ 
97.80%

 module StrType = struct
   type t = binary str_type
 
-  let compare = compare
+  let compare = Types.compare_str_type
 end
 
 module TypeMap = Map.Make (StrType)
 
-let equal_func_types (a : binary func_type) (b : binary func_type) : bool =
-  let remove_param (pt, rt) =
-    let pt = List.map (fun (_id, vt) -> (None, vt)) pt in
-    (pt, rt)
-  in
-  remove_param a = remove_param b
-
 type t =
   { id : string option
   ; typ : binary str_type Named.t
@@ -427,48 +404,48 @@ 
97.80%

   }
 
 let assign_type (acc : type_acc) (name, sub_type) : type_acc Result.t =
-  let { declared_types; func_types; named_types; last_assigned_int; all_types }
+  let { declared_types; func_types; named_types; last_assigned_int; all_types }
       =
     acc
   in
   let+ last_assigned_int, declared_types, named_types, all_types =
     let _final, _indices, str_type = sub_type in
-    let+ str_type = Binary_types.convert_str None str_type in
-    let id = last_assigned_int in
+    let+ str_type = Binary_types.convert_str None str_type in
+    let id = last_assigned_int in
     let last_assigned_int = succ last_assigned_int in
-    let declared_types = Indexed.return id str_type :: declared_types in
+    let declared_types = Indexed.return id str_type :: declared_types in
     let named_types =
       match name with
-      | None -> named_types
-      | Some name -> String_map.add name id named_types
+      | None -> named_types
+      | Some name -> String_map.add name id named_types
     in
     let all_types = TypeMap.add str_type id all_types in
-    (last_assigned_int, declared_types, named_types, all_types)
+    (last_assigned_int, declared_types, named_types, all_types)
   in
 
   (* Is there something to do/check when a type is already declared ? *)
-  { declared_types; func_types; named_types; last_assigned_int; all_types }
+  { declared_types; func_types; named_types; last_assigned_int; all_types }
 
 let assign_heap_type (acc : type_acc) typ : type_acc Result.t =
-  let { func_types; last_assigned_int; all_types; _ } = acc in
-  let+ typ = Binary_types.convert_func_type None typ in
-  let typ = Def_func_t typ in
+  let { func_types; last_assigned_int; all_types; _ } = acc in
+  let+ typ = Binary_types.convert_func_type None typ in
+  let typ = Def_func_t typ in
   match TypeMap.find_opt typ all_types with
-  | Some _id -> acc
-  | None ->
+  | Some _id -> acc
+  | None ->
     let id = last_assigned_int in
     let last_assigned_int = succ last_assigned_int in
-    let all_types = TypeMap.add typ id all_types in
-    let func_types =
+    let all_types = TypeMap.add typ id all_types in
+    let func_types =
       match typ with
-      | Def_func_t _ftype -> Indexed.return id typ :: func_types
+      | Def_func_t _ftype -> Indexed.return id typ :: func_types
       | Def_array_t (_mut, _storage_type) -> func_types
       | Def_struct_t _ -> func_types
     in
     { acc with func_types; last_assigned_int; all_types }
 
 let assign_types (modul : Grouped.t) : binary str_type Named.t Result.t =
-  let empty_acc : type_acc =
+  let empty_acc : type_acc =
     { declared_types = []
     ; func_types = []
     ; named_types = String_map.empty
@@ -476,80 +453,79 @@ 
97.80%

     ; all_types = TypeMap.empty
     }
   in
-  let* acc = list_fold_left assign_type empty_acc (List.rev modul.typ) in
-  let+ acc =
-    list_fold_left assign_heap_type acc (List.rev modul.function_type)
+  let* acc = list_fold_left assign_type empty_acc (List.rev modul.typ) in
+  let+ acc =
+    list_fold_left assign_heap_type acc (List.rev modul.function_type)
   in
-  let values = List.rev acc.declared_types @ List.rev acc.func_types in
+  let values = List.rev acc.declared_types @ List.rev acc.func_types in
   { Named.values; named = acc.named_types }
 
 let get_runtime_name (get_name : 'a -> string option) (elt : ('a, 'b) Runtime.t)
   : string option =
-  match elt with
-  | Local v -> get_name v
-  | Imported { assigned_name; _ } -> assigned_name
+  match elt with
+  | Local v -> get_name v
+  | Imported { assigned_name; _ } -> assigned_name
 
 let name kind ~get_name values =
-  let assign_one (named : int String_map.t) (elt : _ Indexed.t) =
-    let elt_v = Indexed.get elt in
-    match get_name elt_v with
-    | None -> Ok named
-    | Some name ->
+  let assign_one (named : int String_map.t) (elt : _ Indexed.t) =
+    let elt_v = Indexed.get elt in
+    match get_name elt_v with
+    | None -> Ok named
+    | Some name ->
       let index = Indexed.get_index elt in
-      if String_map.mem name named then
-        Error (`Msg (Format.sprintf "duplicate %s %s" kind name))
-      else ok @@ String_map.add name index named
+      if String_map.mem name named then
+        Error (`Msg (Fmt.str "duplicate %s %s" kind name))
+      else ok @@ String_map.add name index named
   in
-  let+ named = list_fold_left assign_one String_map.empty values in
-  { Named.values; named }
+  let+ named = list_fold_left assign_one String_map.empty values in
+  { Named.values; named }
 
-let check_type_id (types : binary str_type Named.t) (check : Grouped.type_check)
-    =
-  let id, func_type = check in
-  let id =
+let check_type_id (types : binary str_type Named.t)
+  ((id, func_type) : Grouped.type_check) =
+  let id =
     match id with Raw i -> i | Text name -> String_map.find name types.named
   in
   (* TODO more efficient version of that *)
   match Indexed.get_at id types.values with
-  | None -> Error `Unknown_type
+  | None -> Error (`Unknown_type (Raw id))
   | Some (Def_func_t func_type') ->
     let* func_type = Binary_types.convert_func_type None func_type in
-    if not (equal_func_types func_type func_type') then
+    if not (Types.func_type_eq func_type func_type') then
       Error `Inline_function_type
     else Ok ()
   | Some _ -> assert false
 
 let of_grouped (modul : Grouped.t) : t Result.t =
-  Log.debug0 "assigning    ...@\n";
-  let* typ = assign_types modul in
-  let* global =
-    name "global"
-      ~get_name:(get_runtime_name (fun ({ id; _ } : Text.global) -> id))
+  Log.debug0 "assigning    ...@\n";
+  let* typ = assign_types modul in
+  let* global =
+    name "global"
+      ~get_name:(get_runtime_name (fun ({ id; _ } : Text.global) -> id))
       modul.global
   in
-  let* table =
-    name "table"
-      ~get_name:(get_runtime_name (fun ((id, _) : binary table) -> id))
+  let* table =
+    name "table"
+      ~get_name:(get_runtime_name (fun ((id, _) : binary table) -> id))
       modul.table
   in
-  let* mem =
-    name "mem"
-      ~get_name:(get_runtime_name (fun ((id, _) : mem) -> id))
+  let* mem =
+    name "mem"
+      ~get_name:(get_runtime_name (fun ((id, _) : mem) -> id))
       modul.mem
   in
-  let* func =
-    name "func"
-      ~get_name:(get_runtime_name (fun ({ id; _ } : text func) -> id))
+  let* func =
+    name "func"
+      ~get_name:(get_runtime_name (fun ({ id; _ } : text func) -> id))
       modul.func
   in
-  let* elem =
-    name "elem" ~get_name:(fun (elem : Text.elem) -> elem.id) modul.elem
+  let* elem =
+    name "elem" ~get_name:(fun (elem : Text.elem) -> elem.id) modul.elem
   in
-  let* data =
-    name "data" ~get_name:(fun (data : Text.data) -> data.id) modul.data
+  let* data =
+    name "data" ~get_name:(fun (data : Text.data) -> data.id) modul.data
   in
-  let+ () = list_iter (check_type_id typ) modul.type_checks in
-  { id = modul.id
+  let+ () = list_iter (check_type_id typ) modul.type_checks in
+  { id = modul.id
   ; typ
   ; global
   ; table
diff --git a/coverage/src/text_to_binary/grouped.ml.html b/coverage/src/text_to_binary/grouped.ml.html
index d16a22ce9..17456d3bc 100644
--- a/coverage/src/text_to_binary/grouped.ml.html
+++ b/coverage/src/text_to_binary/grouped.ml.html
@@ -132,116 +132,98 @@ 
100.00%

  
  
  
- 
+ 
  
- 
+ 
  
- 
- 
- 
+ 
+ 
+ 
  
- 
+ 
  
  
  
- 
+ 
  
  
  
- 
+ 
  
  
- 
- 
- 
- 
- 
- 
- 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
  
  
  
  
- 
+ 
  
  
- 
+ 
  
- 
+ 
  
- 
- 
+ 
+ 
  
- 
- 
+ 
+ 
  
  
  
  
  
  
- 
- 
+ 
+ 
  
  
- 
- 
- 
- 
- 
- 
+ 
+ 
+ 
+ 
+ 
+ 
  
  
- 
+ 
  
- 
- 
+ 
+ 
  
- 
- 
- 
+ 
+ 
+ 
  
  
- 
- 
- 
- 
+ 
+ 
+ 
+ 
  
  
  
- 
- 
+ 
+ 
  
- 
- 
- 
+ 
+ 
+ 
  
  
  
- 
+ 
  
- 
+ 
  
  
  
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
-
@@ -448,24 +430,6 @@

100.00%

200 201 202 -203 -204 -205 -206 -207 -208 -209 -210 -211 -212 -213 -214 -215 -216 -217 -218 -219 -220 
(* SPDX-License-Identifier: AGPL-3.0-or-later *)
 (* Copyright © 2021-2024 OCamlPro *)
@@ -493,7 +457,7 @@ 
100.00%

   }
 
 let curr_id (curr : int) (i : text indice option) =
-  match i with None -> Curr (pred curr) | Some id -> Indice id
+  match i with None -> Curr (pred curr) | Some id -> Indice id
 
 type t =
   { id : string option
@@ -515,10 +479,10 @@ 
100.00%

   }
 
 let imp (import : text import) (assigned_name, desc) : 'a Imported.t =
-  { modul = import.modul; name = import.name; assigned_name; desc }
+  { modul = import.modul; name = import.name; assigned_name; desc }
 
 let empty_module id =
-  { id
+  { id
   ; typ = []
   ; function_type = []
   ; type_checks = []
@@ -544,149 +508,131 @@ 
100.00%

 let init_curr = { global = 0; table = 0; mem = 0; func = 0; elem = 0; data = 0 }
 
 let add_global value (fields : t) (curr : curr) =
-  let index = curr.global in
-  ( { fields with global = Indexed.return index value :: fields.global }
-  , { curr with global = succ curr.global } )
+  let index = curr.global in
+  ( { fields with global = Indexed.return index value :: fields.global }
+  , { curr with global = succ curr.global } )
 
 let add_table value (fields : t) (curr : curr) =
-  let index = curr.table in
-  ( { fields with table = Indexed.return index value :: fields.table }
-  , { curr with table = succ curr.table } )
+  let index = curr.table in
+  ( { fields with table = Indexed.return index value :: fields.table }
+  , { curr with table = succ curr.table } )
 
 let add_mem value (fields : t) (curr : curr) =
-  let index = curr.mem in
-  ( { fields with mem = Indexed.return index value :: fields.mem }
-  , { curr with mem = succ curr.mem } )
+  let index = curr.mem in
+  ( { fields with mem = Indexed.return index value :: fields.mem }
+  , { curr with mem = succ curr.mem } )
 
 let add_func value (fields : t) (curr : curr) =
-  let index = curr.func in
-  ( { fields with func = Indexed.return index value :: fields.func }
-  , { curr with func = succ curr.func } )
+  let index = curr.func in
+  ( { fields with func = Indexed.return index value :: fields.func }
+  , { curr with func = succ curr.func } )
 
 let add_elem value (fields : t) (curr : curr) =
-  let index = curr.elem in
-  ( { fields with elem = Indexed.return index value :: fields.elem }
-  , { curr with elem = succ curr.elem } )
+  let index = curr.elem in
+  ( { fields with elem = Indexed.return index value :: fields.elem }
+  , { curr with elem = succ curr.elem } )
 
 let add_data value (fields : t) (curr : curr) =
-  let index = curr.data in
-  ( { fields with data = Indexed.return index value :: fields.data }
-  , { curr with data = succ curr.data } )
+  let index = curr.data in
+  ( { fields with data = Indexed.return index value :: fields.data }
+  , { curr with data = succ curr.data } )
 
-let check_limit { min; max } =
-  match max with
-  | None -> Ok ()
-  | Some max ->
-    if min > max then Error `Size_minimum_greater_than_maximum else Ok ()
+let declare_func_type type_f (fields : t) =
+  match type_f with
+  | Bt_ind _ -> fields
+  | Bt_raw (id, typ) ->
+    let type_checks =
+      match id with
+      | None -> fields.type_checks
+      | Some id -> (id, typ) :: fields.type_checks
+    in
+    { fields with function_type = typ :: fields.function_type; type_checks }
 
 let of_symbolic (modul : Text.modul) : t Result.t =
-  Log.debug0 "grouping     ...@\n";
-  let add ((fields : t), curr) field : (t * curr) Result.t =
-    match field with
-    | Text.MType typ ->
+  Log.debug0 "grouping     ...@\n";
+  let add ((fields : t), curr) field : (t * curr) Result.t =
+    match field with
+    | Text.MType typ ->
       let typ = typ @ fields.typ in
-      ok @@ ({ fields with typ }, curr)
-    | MGlobal global -> ok @@ add_global (Local global) fields curr
-    | MImport ({ desc = Import_global (a, (mut, val_type)); _ } as import) ->
-      let+ val_type = Binary_types.convert_val_type None val_type in
-      let b = (mut, val_type) in
+      Ok ({ fields with typ }, curr)
+    | MGlobal global -> ok @@ add_global (Local global) fields curr
+    | MImport ({ desc = Import_global (a, (mut, val_type)); _ } as import) ->
+      let+ val_type = Binary_types.convert_val_type None val_type in
+      let b = (mut, val_type) in
       let imported = imp import (a, b) in
-      add_global (Imported imported) fields curr
-    | MExport { name; desc = Export_global id } ->
+      add_global (Imported imported) fields curr
+    | MExport { name; desc = Export_global id } ->
       let id = curr_id curr.global id in
-      let exports =
+      let exports =
         { fields.exports with global = { name; id } :: fields.exports.global }
       in
-      ok ({ fields with exports }, curr)
-    | MTable table ->
-      let _, (limits, _) = table in
-      let* () = check_limit limits in
-      let id, table_type = table in
-      let+ table_type = Binary_types.convert_table_type None table_type in
-      let table = (id, table_type) in
+      Ok ({ fields with exports }, curr)
+    | MTable table ->
+      let id, table_type = table in
+      let+ table_type = Binary_types.convert_table_type None table_type in
+      let table = (id, table_type) in
       add_table (Local table) fields curr
-    | MImport ({ desc = Import_table (id, table_type); _ } as import) ->
-      let+ table_type = Binary_types.convert_table_type None table_type in
-      let imported = imp import (id, table_type) in
-      add_table (Imported imported) fields curr
-    | MExport { name; desc = Export_table id } ->
+    | MImport ({ desc = Import_table (id, table_type); _ } as import) ->
+      let+ table_type = Binary_types.convert_table_type None table_type in
+      let imported = imp import (id, table_type) in
+      add_table (Imported imported) fields curr
+    | MExport { name; desc = Export_table id } ->
       let id = curr_id curr.table id in
-      let exports =
+      let exports =
         { fields.exports with table = { name; id } :: fields.exports.table }
       in
-      ok ({ fields with exports }, curr)
-    | MMem ((_, limits) as mem) ->
-      let* () =
-        if limits.min > 65536 then Error `Memory_size_too_large else Ok ()
-      in
-      let* () =
-        match limits.max with
-        | Some max when max > 65536 -> Error `Memory_size_too_large
-        | Some _ | None -> Ok ()
-      in
-      let* () = check_limit limits in
-      ok @@ add_mem (Local mem) fields curr
-    | MImport ({ desc = Import_mem (id, limits); _ } as import) ->
+      Ok ({ fields with exports }, curr)
+    | MMem mem -> ok @@ add_mem (Local mem) fields curr
+    | MImport ({ desc = Import_mem (id, limits); _ } as import) ->
       let imported = imp import (id, limits) in
-      ok @@ add_mem (Imported imported) fields curr
-    | MExport { name; desc = Export_mem id } ->
+      ok @@ add_mem (Imported imported) fields curr
+    | MExport { name; desc = Export_mem id } ->
       let id = curr_id curr.mem id in
-      let exports =
+      let exports =
         { fields.exports with mem = { name; id } :: fields.exports.mem }
       in
       Ok ({ fields with exports }, curr)
-    | MFunc func ->
-      let function_type, type_checks =
-        match func.type_f with
-        | Bt_ind _ -> (fields.function_type, fields.type_checks)
-        | Bt_raw (id, typ) ->
-          let type_checks =
-            match id with
-            | None -> fields.type_checks
-            | Some id -> (id, typ) :: fields.type_checks
-          in
-          (typ :: fields.function_type, type_checks)
-      in
-      let index = curr.func in
+    | MFunc func ->
+      let fields = declare_func_type func.type_f fields in
+      let index = curr.func in
       let value = Runtime.Local func in
-      let func = Indexed.return index value :: fields.func in
-      Ok
-        ( { fields with func; function_type; type_checks }
-        , { curr with func = succ curr.func } )
-    | MImport ({ desc = Import_func (a, b); _ } as import) ->
-      let imported : text block_type Imported.t = imp import (a, b) in
-      ok @@ add_func (Imported imported) fields curr
-    | MExport { name; desc = Export_func id } ->
+      let func = Indexed.return index value :: fields.func in
+      Ok ({ fields with func }, { curr with func = succ curr.func })
+    | MImport ({ desc = Import_func (a, type_f); _ } as import) ->
+      let imported : text block_type Imported.t = imp import (a, type_f) in
+      let fields = declare_func_type type_f fields in
+      ok @@ add_func (Imported imported) fields curr
+    | MExport { name; desc = Export_func id } ->
       let id = curr_id curr.func id in
-      let exports =
+      let exports =
         { fields.exports with func = { name; id } :: fields.exports.func }
       in
       Ok ({ fields with exports }, curr)
-    | MElem elem ->
+    | MElem elem ->
       let mode =
         match elem.mode with
-        | (Text.Elem_passive | Elem_declarative) as mode -> mode
-        | Elem_active (id, expr) ->
+        | (Text.Elem_passive | Elem_declarative) as mode -> mode
+        | Elem_active (id, expr) ->
           let id = Option.value id ~default:(Raw (curr.table - 1)) in
-          Elem_active (Some id, expr)
+          Elem_active (Some id, expr)
       in
-      ok @@ add_elem { elem with mode } fields curr
-    | MData data ->
+      ok @@ add_elem { elem with mode } fields curr
+    | MData data ->
       let mode =
         match data.mode with
-        | Data_passive -> Text.Data_passive
-        | Data_active (id, expr) ->
+        | Data_passive -> Text.Data_passive
+        | Data_active (id, expr) ->
           let id = Option.value id ~default:(Raw (curr.mem - 1)) in
-          Data_active (Some id, expr)
+          Data_active (Some id, expr)
       in
       let data : Text.data = { id = data.id; init = data.init; mode } in
-      ok @@ add_data data fields curr
-    | MStart start -> Ok ({ fields with start = Some start }, curr)
+      ok @@ add_data data fields curr
+    | MStart start -> Ok ({ fields with start = Some start }, curr)
   in
   let+ modul, _curr =
-    list_fold_left add (empty_module modul.id, init_curr) modul.fields
+    list_fold_left add (empty_module modul.id, init_curr) modul.fields
   in
-  modul
+  modul
diff --git a/coverage/src/text_to_binary/rewrite.ml.html b/coverage/src/text_to_binary/rewrite.ml.html index d539ff904..2b82f18b7 100644 --- a/coverage/src/text_to_binary/rewrite.ml.html +++ b/coverage/src/text_to_binary/rewrite.ml.html @@ -3,7 +3,7 @@ rewrite.ml — Coverage report - + @@ -15,48 +15,51 @@

src/text_to_binary/rewrite.ml

-

91.10%

+

86.91%

@@ -70,134 +73,134 @@

91.10%

- - - + + + - + - + - + - + - + - - - - + + + + - - - + + + - + - + - - + + - - - + + + - - - - + + + + - + - - + + - + - + - - - - - - + + + + + + - - - - - + + + + + - - + + - + - + - + - - + + - + - - + + - - - + + + - + - - - - - - - - - + + + + + + + + + - + - - + + - + @@ -231,12 +234,12 @@

91.10%

- - - - - - + + + + + + @@ -244,18 +247,18 @@

91.10%

- - - - - - + + + + + + - + @@ -279,317 +282,238 @@

91.10%

- + - - - - - - - - - - + + + + + + + + + + - + - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + - + - - - + + + - - + + - - - + + + - + - - - + + + - - + + - + - - + + - + - - - + + + - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + - - - - + + + + - + - - - + + + - + - - - - + + + + - - + + - + - - + + - + - - + + - + - - - + + + - + - - - - - - - + + + + + + + - + - - + + - + - - - - - - - + + + + + + + - - - + + + - + - - + + - + - - + + - + - - + + - + - + - + - - - - - + + + + + - + - - + + - - + + - - + + - - - - + + + + - - - - - + + + + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
@@ -1044,85 +968,6 @@

91.10%

448 449 450 -451 -452 -453 -454 -455 -456 -457 -458 -459 -460 -461 -462 -463 -464 -465 -466 -467 -468 -469 -470 -471 -472 -473 -474 -475 -476 -477 -478 -479 -480 -481 -482 -483 -484 -485 -486 -487 -488 -489 -490 -491 -492 -493 -494 -495 -496 -497 -498 -499 -500 -501 -502 -503 -504 -505 -506 -507 -508 -509 -510 -511 -512 -513 -514 -515 -516 -517 -518 -519 -520 -521 -522 -523 -524 -525 -526 -527 -528 -529 
(* SPDX-License-Identifier: AGPL-3.0-or-later *)
 (* Copyright © 2021-2024 OCamlPro *)
@@ -1131,519 +976,440 @@ 
91.10%

 open Types
 open Syntax
 
-let find msg (named : 'a Named.t) (indice : text indice option) :
-  binary indice Result.t =
-  match indice with
-  | None -> Error (`Msg msg)
-  | Some indice -> (
-    match indice with
-    | Raw i as indice ->
-      (* TODO change Indexed.t strucure for that to be more efficient *)
-      if not (List.exists (Indexed.has_index i) named.values) then
-        Error (`Msg (Format.sprintf "%s %i" msg i))
-      else Ok indice
-    | Text name -> (
-      match String_map.find_opt name named.named with
-      | None -> Error (`Msg (Format.sprintf "%s %s" msg name))
-      | Some i -> Ok (Raw i) ) )
+module StrType = struct
+  type t = binary str_type
 
-let get msg (named : 'a Named.t) indice : 'a Indexed.t Result.t =
-  let* (Raw i) = find msg named indice in
+  let compare (x : t) (y : t) = Types.compare_str_type x y
+end
+
+module TypeMap = Map.Make (StrType)
+
+let typemap (types : binary str_type Named.t) =
+  Named.fold
+    (fun idx typ acc -> TypeMap.add typ (Raw idx) acc)
+    types TypeMap.empty
+
+let find error (named : 'a Named.t) : _ -> binary indice Result.t = function
+  | Raw _i as indice -> Ok indice
+  | Text name -> (
+    match String_map.find_opt name named.named with
+    | None -> Error error
+    | Some i -> Ok (Raw i) )
+
+let get error (named : 'a Named.t) indice : 'a Indexed.t Result.t =
+  let* (Raw i) = find error named indice in
   (* TODO change Named.t structure to make that sensible *)
-  match List.nth_opt named.values i with
-  | None -> Error (`Msg msg)
-  | Some v -> Ok v
+  match List.nth_opt named.values i with None -> Error error | Some v -> Ok v
 
-let find_global (modul : Assigned.t) ~imported_only id : (int * mut) Result.t =
-  let* (Raw idx) = find "unknown global" modul.global id in
-  let va = List.find (Indexed.has_index idx) modul.global.values in
-  let+ mut, _typ =
-    match Indexed.get va with
-    | Imported imported -> Ok imported.desc
-    | Local global ->
-      if imported_only then Error `Unknown_global
-      else
-        let mut, val_type = global.typ in
-        let+ val_type = Binary_types.convert_val_type None val_type in
-        (mut, val_type)
-  in
-  (idx, mut)
+let find_global (modul : Assigned.t) id : binary indice Result.t =
+  find (`Unknown_global id) modul.global id
+
+let find_memory (modul : Assigned.t) id : binary indice Result.t =
+  find (`Unknown_memory id) modul.mem id
 
 let rewrite_expr (modul : Assigned.t) (locals : binary param list)
   (iexpr : text expr) : binary expr Result.t =
   (* block_ids handling *)
-  let block_id_to_raw (loop_count, block_ids) id =
-    let* id =
+  let block_id_to_raw (loop_count, block_ids) id =
+    let* id =
       match id with
-      | Text id ->
-        let pos = ref (-1) in
-        begin
-          try
-            List.iteri
-              (fun i n ->
-                if n = Some id then begin
-                  pos := i;
-                  raise Exit
-                end )
-              block_ids
-          with Exit -> ()
-        end;
-        if !pos = -1 then Error `Unknown_label else Ok !pos
-      | Raw id -> Ok id
+      | Text id -> begin
+        match
+          List.find_index
+            (function Some id' -> String.equal id id' | None -> false)
+            block_ids
+        with
+        | None -> Error (`Unknown_label (Text id))
+        | Some id -> Ok id
+      end
+      | Raw id -> Ok id
     in
     (* this is > and not >= because you can `br 0` without any block to target the function *)
-    if id > List.length block_ids + loop_count then Error `Unknown_label
-    else Ok (Raw id)
+    if id > List.length block_ids + loop_count then
+      Error (`Unknown_label (Raw id))
+    else Ok (Raw id)
   in
 
   let bt_some_to_raw : text block_type -> binary block_type Result.t = function
-    | Bt_ind ind -> begin
-      let* v = get "unknown type" modul.typ (Some ind) in
-      match Indexed.get v with
-      | Def_func_t t' -> Ok (Bt_raw (None, t'))
+    | Bt_ind ind -> begin
+      let+ v = get (`Unknown_type ind) modul.typ ind in
+      match Indexed.get v with
+      | Def_func_t t' ->
+        let idx = Indexed.get_index v in
+        Bt_raw (Some (Raw idx), t')
       | _ -> assert false
     end
-    | Bt_raw (type_use, t) -> (
-      let* t = Binary_types.convert_func_type None t in
-      match type_use with
-      | None -> Ok (Bt_raw (None, t))
+    | Bt_raw (type_use, t) -> (
+      let* t = Binary_types.convert_func_type None t in
+      match type_use with
+      | None -> Ok (Bt_raw (None, t))
       | Some ind ->
         (* we check that the explicit type match the type_use, we have to remove parameters names to do so *)
         let* t' =
-          let* v = get "unknown type" modul.typ (Some ind) in
-          match Indexed.get v with Def_func_t t' -> Ok t' | _ -> assert false
+          let+ v = get (`Unknown_type ind) modul.typ ind in
+          match Indexed.get v with Def_func_t t' -> t' | _ -> assert false
         in
-        let ok = Binary_types.equal_func_types t t' in
+        let ok = Types.func_type_eq t t' in
         if not ok then Error `Inline_function_type else Ok (Bt_raw (None, t)) )
   in
 
   let bt_to_raw : text block_type option -> binary block_type option Result.t =
     function
-    | None -> Ok None
-    | Some bt ->
-      let+ raw = bt_some_to_raw bt in
-      Some raw
+    | None -> Ok None
+    | Some bt ->
+      let+ raw = bt_some_to_raw bt in
+      Some raw
   in
 
-  let* locals, after_last_assigned_local =
-    List.fold_left
+  let* locals, _after_last_assigned_local =
+    List.fold_left
       (fun acc ((name, _type) : binary param) ->
-        let* locals, next_free_int = acc in
-        match name with
-        | None -> Ok (locals, next_free_int + 1)
-        | Some name ->
+        let* locals, next_free_int = acc in
+        match name with
+        | None -> Ok (locals, next_free_int + 1)
+        | Some name ->
           if String_map.mem name locals then Error (`Duplicate_local name)
-          else Ok (String_map.add name next_free_int locals, next_free_int + 1)
+          else Ok (String_map.add name next_free_int locals, next_free_int + 1)
         )
       (Ok (String_map.empty, 0))
       locals
   in
 
-  let find_local = function
-    | Raw i as id ->
-      if i >= after_last_assigned_local then
-        Error (`Unknown_local (string_of_int i))
-      else Ok id
-    | Text name -> (
+  let find_local = function
+    | Raw _i as id -> Ok id
+    | Text name as id -> (
       match String_map.find_opt name locals with
-      | None -> Error (`Unknown_local name)
-      | Some id -> Ok (Raw id) )
+      | None -> Error (`Unknown_local id)
+      | Some id -> Ok (Raw id) )
   in
 
-  let find_table id = find "unknown table" modul.table id in
-  let find_func id = find "unknown function" modul.func id in
-  let _find_mem id = find "unknown memory" modul.mem id in
-  let find_data id = find "unknown data segment" modul.data id in
-  let find_elem id = find "unknown elem segment" modul.elem id in
-  let find_type id = find "unknown type" modul.typ id in
+  let find_table id = find (`Unknown_table id) modul.table id in
+  let find_func id = find (`Unknown_func id) modul.func id in
+  let find_data id = find (`Unknown_data id) modul.data id in
+  let find_elem id = find (`Unknown_elem id) modul.elem id in
+  let find_type id = find (`Unknown_type id) modul.typ id in
 
   let rec body (loop_count, block_ids) : text instr -> binary instr Result.t =
-    function
-    | Br_table (ids, id) ->
+    function
+    | Br_table (ids, id) ->
       let block_id_to_raw = block_id_to_raw (loop_count, block_ids) in
-      let* ids = array_map block_id_to_raw ids in
-      let* id = block_id_to_raw id in
-      ok @@ Br_table (ids, id)
-    | Br_if id ->
-      let* id = block_id_to_raw (loop_count, block_ids) id in
-      ok @@ Br_if id
-    | Br id ->
-      let* id = block_id_to_raw (loop_count, block_ids) id in
-      ok @@ Br id
-    | Call id ->
-      let* id = find_func (Some id) in
-      ok @@ Call id
-    | Return_call id ->
-      let* id = find_func (Some id) in
-      ok @@ Return_call id
-    | Local_set id ->
-      let* id = find_local id in
-      ok @@ Local_set id
-    | Local_get id ->
-      let* id = find_local id in
-      ok @@ Local_get id
-    | Local_tee id ->
-      let* id = find_local id in
-      ok @@ Local_tee id
-    | If_else (id, bt, e1, e2) ->
-      let* bt = bt_to_raw bt in
-      let block_ids = id :: block_ids in
-      let* e1 = expr e1 (loop_count, block_ids) in
-      let* e2 = expr e2 (loop_count, block_ids) in
-      ok @@ If_else (id, bt, e1, e2)
-    | Loop (id, bt, e) ->
-      let* bt = bt_to_raw bt in
-      let* e = expr e (loop_count + 1, id :: block_ids) in
-      ok @@ Loop (id, bt, e)
-    | Block (id, bt, e) ->
-      let* bt = bt_to_raw bt in
-      let* e = expr e (loop_count, id :: block_ids) in
-      ok @@ Block (id, bt, e)
-    | Call_indirect (tbl_i, bt) ->
-      let* tbl_i = find_table (Some tbl_i) in
-      let* bt = bt_some_to_raw bt in
-      ok @@ Call_indirect (tbl_i, bt)
-    | Return_call_indirect (tbl_i, bt) ->
-      let* tbl_i = find_table (Some tbl_i) in
-      let* bt = bt_some_to_raw bt in
-      ok @@ Return_call_indirect (tbl_i, bt)
+      let* ids = array_map block_id_to_raw ids in
+      let+ id = block_id_to_raw id in
+      Br_table (ids, id)
+    | Br_if id ->
+      let+ id = block_id_to_raw (loop_count, block_ids) id in
+      Br_if id
+    | Br id ->
+      let+ id = block_id_to_raw (loop_count, block_ids) id in
+      Br id
+    | Call id ->
+      let+ id = find_func id in
+      Call id
+    | Return_call id ->
+      let+ id = find_func id in
+      Return_call id
+    | Local_set id ->
+      let+ id = find_local id in
+      Local_set id
+    | Local_get id ->
+      let+ id = find_local id in
+      Local_get id
+    | Local_tee id ->
+      let+ id = find_local id in
+      Local_tee id
+    | If_else (id, bt, e1, e2) ->
+      let* bt = bt_to_raw bt in
+      let block_ids = id :: block_ids in
+      let* e1 = expr e1 (loop_count, block_ids) in
+      let+ e2 = expr e2 (loop_count, block_ids) in
+      If_else (id, bt, e1, e2)
+    | Loop (id, bt, e) ->
+      let* bt = bt_to_raw bt in
+      let+ e = expr e (loop_count + 1, id :: block_ids) in
+      Loop (id, bt, e)
+    | Block (id, bt, e) ->
+      let* bt = bt_to_raw bt in
+      let+ e = expr e (loop_count, id :: block_ids) in
+      Block (id, bt, e)
+    | Call_indirect (tbl_i, bt) ->
+      let* tbl_i = find_table tbl_i in
+      let+ bt = bt_some_to_raw bt in
+      Call_indirect (tbl_i, bt)
+    | Return_call_indirect (tbl_i, bt) ->
+      let* tbl_i = find_table tbl_i in
+      let+ bt = bt_some_to_raw bt in
+      Return_call_indirect (tbl_i, bt)
     | Call_ref t ->
-      let* t = find_type (Some t) in
-      ok @@ Call_ref t
+      let+ t = find_type t in
+      Call_ref t
     | Return_call_ref bt ->
-      let* bt = bt_some_to_raw bt in
-      ok @@ Return_call_ref bt
-    | Global_set id -> begin
-      let* idx, mut = find_global modul ~imported_only:false (Some id) in
-      match mut with
-      | Const -> Error `Global_is_immutable
-      | Var -> ok @@ Global_set (Raw idx)
-    end
-    | Global_get id ->
-      let* idx, _mut = find_global modul ~imported_only:false (Some id) in
-      ok @@ Global_get (Raw idx)
-    | Ref_func id ->
-      let* id = find_func (Some id) in
-      ok @@ Ref_func id
+      let+ bt = bt_some_to_raw bt in
+      Return_call_ref bt
+    | Global_set id ->
+      let+ idx = find_global modul id in
+      Global_set idx
+    | Global_get id ->
+      let+ idx = find_global modul id in
+      Global_get idx
+    | Ref_func id ->
+      let+ id = find_func id in
+      Ref_func id
     | Table_size id ->
-      let* id = find_table (Some id) in
-      ok @@ Table_size id
-    | Table_get id ->
-      let* id = find_table (Some id) in
-      ok @@ Table_get id
-    | Table_set id ->
-      let* id = find_table (Some id) in
-      ok @@ Table_set id
-    | Table_grow id ->
-      let* id = find_table (Some id) in
-      ok @@ Table_grow id
-    | Table_init (i, i') ->
-      let* table = find_table (Some i) in
-      let* elem = find_elem (Some i') in
-      ok @@ Table_init (table, elem)
-    | Table_fill id ->
-      let* id = find_table (Some id) in
-      ok @@ Table_fill id
+      let+ id = find_table id in
+      Table_size id
+    | Table_get id ->
+      let+ id = find_table id in
+      Table_get id
+    | Table_set id ->
+      let+ id = find_table id in
+      Table_set id
+    | Table_grow id ->
+      let+ id = find_table id in
+      Table_grow id
+    | Table_init (i, i') ->
+      let* table = find_table i in
+      let+ elem = find_elem i' in
+      Table_init (table, elem)
+    | Table_fill id ->
+      let+ id = find_table id in
+      Table_fill id
     | Table_copy (i, i') ->
-      let* table = find_table (Some i) in
-      let* table' = find_table (Some i') in
-      ok @@ Table_copy (table, table')
+      let* table = find_table i in
+      let+ table' = find_table i' in
+      Table_copy (table, table')
     | Memory_init id ->
-      if List.length modul.mem.values < 1 then Error (`Unknown_memory 0)
-      else
-        let* id = find_data (Some id) in
-        ok @@ Memory_init id
+      let+ id = find_data id in
+      Memory_init id
     | Data_drop id ->
-      let* id = find_data (Some id) in
-      ok @@ Data_drop id
+      let+ id = find_data id in
+      Data_drop id
     | Elem_drop id ->
-      let* id = find_elem (Some id) in
-      ok @@ Elem_drop id
-    (* TODO: should we check alignment or memory existence first ? is it tested in the reference implementation ? *)
-    | I_load8 (nn, sx, memarg) ->
-      if List.length modul.mem.values < 1 then Error (`Unknown_memory 0)
-      else if memarg.align >= 1l then Error `Alignment_too_large
-      else Ok (I_load8 (nn, sx, memarg))
-    | I_store8 (nn, memarg) ->
-      if List.length modul.mem.values < 1 then Error (`Unknown_memory 0)
-      else if memarg.align >= 1l then Error `Alignment_too_large
-      else ok @@ I_store8 (nn, memarg)
-    | I_load16 (nn, sx, memarg) ->
-      if List.length modul.mem.values < 1 then Error (`Unknown_memory 0)
-      else if memarg.align >= 2l then Error `Alignment_too_large
-      else ok @@ I_load16 (nn, sx, memarg)
-    | I_store16 (nn, memarg) ->
-      if List.length modul.mem.values < 1 then Error (`Unknown_memory 0)
-      else if memarg.align >= 2l then Error `Alignment_too_large
-      else ok @@ I_store16 (nn, memarg)
-    | I64_load32 (nn, memarg) ->
-      if List.length modul.mem.values < 1 then Error (`Unknown_memory 0)
-      else if memarg.align >= 4l then Error `Alignment_too_large
-      else ok @@ I64_load32 (nn, memarg)
-    | I64_store32 memarg ->
-      if List.length modul.mem.values < 1 then Error (`Unknown_memory 0)
-      else if memarg.align >= 4l then Error `Alignment_too_large
-      else ok @@ I64_store32 memarg
-    | I_load (nn, memarg) ->
-      if List.length modul.mem.values < 1 then Error (`Unknown_memory 0)
-      else
-        let max_allowed = match nn with S32 -> 4l | S64 -> 8l in
-        if memarg.align >= max_allowed then Error `Alignment_too_large
-        else ok @@ I_load (nn, memarg)
-    | F_load (nn, memarg) ->
-      if List.length modul.mem.values < 1 then Error (`Unknown_memory 0)
-      else
-        let max_allowed = match nn with S32 -> 4l | S64 -> 8l in
-        if memarg.align >= max_allowed then Error `Alignment_too_large
-        else ok @@ F_load (nn, memarg)
-    | F_store (nn, memarg) ->
-      if List.length modul.mem.values < 1 then Error (`Unknown_memory 0)
-      else
-        let max_allowed = match nn with S32 -> 4l | S64 -> 8l in
-        if memarg.align >= max_allowed then Error `Alignment_too_large
-        else ok @@ F_store (nn, memarg)
-    | I_store (nn, memarg) ->
-      if List.length modul.mem.values < 1 then Error (`Unknown_memory 0)
-      else
-        let max_allowed = match nn with S32 -> 4l | S64 -> 8l in
-        if memarg.align >= max_allowed then Error `Alignment_too_large
-        else ok @@ I_store (nn, memarg)
-    | (Memory_copy | Memory_size | Memory_fill | Memory_grow) as i ->
-      if List.length modul.mem.values < 1 then Error (`Unknown_memory 0)
-      else Ok i
-    | Select typ -> begin
+      let+ id = find_elem id in
+      Elem_drop id
+    | Select typ -> begin
       match typ with
-      | None -> ok @@ Select None
-      | Some [ t ] ->
-        let+ t = Binary_types.convert_val_type None t in
-        Select (Some [ t ])
+      | None -> ok @@ Select None
+      | Some [ t ] ->
+        let+ t = Binary_types.convert_val_type None t in
+        Select (Some [ t ])
       | Some [] | Some (_ :: _ :: _) -> Error `Invalid_result_arity
     end
-    | Array_new_default id ->
-      let* id = find_type (Some id) in
-      ok @@ Array_new_default id
+    | Array_new_default id ->
+      let+ id = find_type id in
+      Array_new_default id
     | Array_set id ->
-      let* id = find_type (Some id) in
-      ok @@ Array_set id
+      let+ id = find_type id in
+      Array_set id
     | Array_get id ->
-      let* id = find_type (Some id) in
-      ok @@ Array_set id
-    | Ref_null heap_type ->
-      let+ t = Binary_types.convert_heap_type None heap_type in
-      Ref_null t
+      let+ id = find_type id in
+      Array_set id
+    | Ref_null heap_type ->
+      let+ t = Binary_types.convert_heap_type None heap_type in
+      Ref_null t
     | Br_on_cast (i, t1, t2) ->
-      let* i = find_type (Some i) in
+      let* i = find_type i in
       let* t1 = Binary_types.convert_ref_type None t1 in
       let+ t2 = Binary_types.convert_ref_type None t2 in
       Br_on_cast (i, t1, t2)
     | Br_on_cast_fail (i, null, ht) ->
-      let* i = find_type (Some i) in
+      let* i = find_type i in
       let+ ht = Binary_types.convert_heap_type None ht in
       Br_on_cast_fail (i, null, ht)
-    | Struct_new_default i ->
-      let+ i = find_type (Some i) in
-      Struct_new_default i
-    | Ref_cast (null, ht) ->
-      let+ ht = Binary_types.convert_heap_type None ht in
-      Ref_cast (null, ht)
-    | Ref_test (null, ht) ->
-      let+ ht = Binary_types.convert_heap_type None ht in
-      Ref_test (null, ht)
-    | ( I_unop _ | I_binop _ | I_testop _ | I_relop _ | F_unop _ | F_relop _
-      | I32_wrap_i64 | F_reinterpret_i _ | I_reinterpret_f _ | I64_extend_i32 _
+    | Struct_new_default i ->
+      let+ i = find_type i in
+      Struct_new_default i
+    | Ref_cast (null, ht) ->
+      let+ ht = Binary_types.convert_heap_type None ht in
+      Ref_cast (null, ht)
+    | Ref_test (null, ht) ->
+      let+ ht = Binary_types.convert_heap_type None ht in
+      Ref_test (null, ht)
+    | ( I_unop _ | I_binop _ | I_testop _ | I_relop _ | F_unop _ | F_relop _
+      | I32_wrap_i64 | F_reinterpret_i _ | I_reinterpret_f _ | I64_extend_i32 _
       | I64_extend32_s | F32_demote_f64 | I_extend8_s _ | I_extend16_s _
       | F64_promote_f32 | F_convert_i _ | I_trunc_f _ | I_trunc_sat_f _
-      | Ref_is_null | F_binop _ | F32_const _ | F64_const _ | I32_const _
-      | I64_const _ | Unreachable | Drop | Nop | Return | Ref_i31 | I31_get_s
-      | I31_get_u | Array_len | Ref_as_non_null | Extern_externalize
-      | Extern_internalize | Ref_eq ) as i ->
+      | Ref_is_null | F_binop _ | F32_const _ | F64_const _ | I32_const _
+      | I64_const _ | Unreachable | Drop | Nop | Return | Ref_i31 | I31_get_s
+      | I31_get_u | Array_len | Ref_as_non_null | Extern_externalize
+      | Extern_internalize | Ref_eq | I_load8 _ | I_store8 _ | I_load16 _
+      | I_store16 _ | I64_load32 _ | I64_store32 _ | I_load _ | F_load _
+      | F_store _ | I_store _ | Memory_copy | Memory_size | Memory_fill
+      | Memory_grow ) as i ->
       Ok i
     | ( Array_new_data _ | Array_new _ | Array_new_elem _ | Array_new_fixed _
       | Array_get_u _ | Struct_get _ | Struct_get_s _ | Struct_set _
       | Struct_new _ | Br_on_non_null _ | Br_on_null _ ) as _i ->
       assert false
   and expr (e : text expr) (loop_count, block_ids) : binary expr Result.t =
-    list_map (fun i -> body (loop_count, block_ids) i) e
+    list_map (fun i -> body (loop_count, block_ids) i) e
   in
   expr iexpr (0, [])
 
-(* TODO: binary+const expr/list *)
-let rewrite_const_expr (modul : Assigned.t) (expr : text expr) :
-  binary expr Result.t =
-  let const_instr (instr : text instr) : binary instr Result.t =
-    match instr with
-    | Global_get id -> begin
-      let* idx, mut = find_global modul ~imported_only:true (Some id) in
-      match mut with
-      | Const -> ok @@ Global_get (Raw idx)
-      | Var -> Error `Constant_expression_required
-    end
-    | Ref_null v ->
-      let+ v = Binary_types.convert_heap_type None v in
-      Ref_null v
-    | Ref_func f ->
-      let+ f = find "unknown function" modul.func (Some f) in
-      Ref_func f
-    | Array_new t ->
-      let+ t = find "unknown type" modul.typ (Some t) in
-      Array_new t
-    | Array_new_default t ->
-      let+ t = find "unknown type" modul.typ (Some t) in
-      Array_new_default t
-    | (I32_const _ | I64_const _ | F32_const _ | F64_const _ | Ref_i31) as i ->
-      Ok i
-    | _i -> Error `Constant_expression_required
-  in
-  list_map const_instr expr
-
-let rewrite_block_type (modul : Assigned.t) (block_type : text block_type) :
-  binary block_type Result.t =
-  match block_type with
-  | Bt_ind id -> begin
-    let* v = get "unknown type" modul.typ (Some id) in
-    match Indexed.get v with
-    | Def_func_t t' -> Ok (Bt_raw (None, t'))
+let rewrite_block_type (typemap : binary indice TypeMap.t) (modul : Assigned.t)
+  (block_type : text block_type) : binary block_type Result.t =
+  match block_type with
+  | Bt_ind id -> begin
+    let+ v = get (`Unknown_type id) modul.typ id in
+    match Indexed.get v with
+    | Def_func_t t' ->
+      let idx = Indexed.get_index v in
+      Bt_raw (Some (Raw idx), t')
     | _ -> assert false
   end
-  | Bt_raw (_, func_type) ->
-    let* t = Binary_types.convert_func_type None func_type in
-    Ok (Bt_raw (None, t))
+  | Bt_raw (_, func_type) ->
+    let* t = Binary_types.convert_func_type None func_type in
+    let+ idx =
+      try Ok (TypeMap.find (Def_func_t t) typemap)
+      with Not_found ->
+        Error
+          (`Msg (Fmt.str "Missing func type in index table %a" pp_func_type t))
+    in
+    Bt_raw (Some idx, t)
 
 let rewrite_global (modul : Assigned.t) (global : Text.global) :
   Binary.global Result.t =
-  let* init = rewrite_const_expr modul global.init in
-  let mut, val_type = global.typ in
-  let+ val_type = Binary_types.convert_val_type None val_type in
-  let typ = (mut, val_type) in
+  let* init = rewrite_expr modul [] global.init in
+  let mut, val_type = global.typ in
+  let+ val_type = Binary_types.convert_val_type None val_type in
+  let typ = (mut, val_type) in
   { Binary.id = global.id; init; typ }
 
 let rewrite_elem (modul : Assigned.t) (elem : Text.elem) : Binary.elem Result.t
     =
-  let* (mode : Binary.elem_mode) =
+  let* (mode : Binary.elem_mode) =
     match elem.mode with
-    | Elem_declarative -> Ok Binary.Elem_declarative
-    | Elem_passive -> Ok Elem_passive
-    | Elem_active (indice, expr) ->
-      let* (Raw indice) = find "unknown table" modul.table indice in
-      let+ expr = rewrite_const_expr modul expr in
-      Binary.Elem_active (Some indice, expr)
+    | Elem_declarative -> Ok Binary.Elem_declarative
+    | Elem_passive -> Ok Elem_passive
+    | Elem_active (None, _expr) ->
+      (* TODO: does this really happen ? *)
+      Error (`Unknown_table (Raw 0))
+    | Elem_active (Some id, expr) ->
+      let* (Raw indice) = find (`Unknown_table id) modul.table id in
+      let+ expr = rewrite_expr modul [] expr in
+      Binary.Elem_active (Some indice, expr)
   in
-  let* init = list_map (rewrite_const_expr modul) elem.init in
-  let+ typ = Binary_types.convert_ref_type None elem.typ in
-  { Binary.init; mode; id = elem.id; typ }
+  let* init = list_map (rewrite_expr modul []) elem.init in
+  let+ typ = Binary_types.convert_ref_type None elem.typ in
+  { Binary.init; mode; id = elem.id; typ }
 
 let rewrite_data (modul : Assigned.t) (data : Text.data) : Binary.data Result.t
     =
-  let+ mode =
+  let+ mode =
     match data.mode with
-    | Data_passive -> Ok Binary.Data_passive
-    | Data_active (indice, expr) ->
-      let* (Raw indice) = find "unknown memory" modul.mem indice in
-      let* expr = rewrite_const_expr modul expr in
-      ok @@ Binary.Data_active (Some indice, expr)
+    | Data_passive -> Ok Binary.Data_passive
+    | Data_active (None, _expr) ->
+      (* TODO: maybe we should change the type in assigned to avoid this case ? *)
+      assert false
+    | Data_active (Some indice, expr) ->
+      let* (Raw indice) = find_memory modul indice in
+      let+ expr = rewrite_expr modul [] expr in
+      Binary.Data_active (indice, expr)
   in
-  { Binary.mode; id = data.id; init = data.init }
+  { Binary.mode; id = data.id; init = data.init }
 
-let rewrite_export msg named (exports : Grouped.opt_export list) :
+let rewrite_export err named (exports : Grouped.opt_export list) :
   Binary.export list Result.t =
-  list_map
+  list_map
     (fun { Grouped.name; id } ->
-      let+ id =
+      let+ id =
         match id with
-        | Curr id -> Ok id
-        | Indice id ->
-          let+ (Raw id) = find msg named (Some id) in
-          id
+        | Curr id -> Ok id
+        | Indice id ->
+          let+ (Raw id) = find (err id) named id in
+          id
       in
-      { Binary.name; id } )
+      { Binary.name; id } )
     exports
 
 let rewrite_exports (modul : Assigned.t) (exports : Grouped.opt_exports) :
   Binary.exports Result.t =
-  let* global = rewrite_export "unknown global" modul.global exports.global in
-  let* mem = rewrite_export "unknown memory" modul.mem exports.mem in
-  let* table = rewrite_export "unknown table" modul.table exports.table in
-  let+ func = rewrite_export "unknown function" modul.func exports.func in
-  { Binary.global; mem; table; func }
+  let* global =
+    rewrite_export (fun id -> `Unknown_global id) modul.global exports.global
+  in
+  let* mem =
+    rewrite_export (fun id -> `Unknown_memory id) modul.mem exports.mem
+  in
+  let* table =
+    rewrite_export (fun id -> `Unknown_table id) modul.table exports.table
+  in
+  let+ func =
+    rewrite_export (fun id -> `Unknown_func id) modul.func exports.func
+  in
+  { Binary.global; mem; table; func }
 
-let rewrite_func (modul : Assigned.t) (func : text func) : binary func Result.t
-    =
-  let* type_f = rewrite_block_type modul func.type_f in
-  let (Bt_raw ((None | Some _), (params, _))) = type_f in
-  let* locals = list_map (Binary_types.convert_param None) func.locals in
-  let+ body = rewrite_expr modul (params @ locals) func.body in
-  { body; type_f; id = func.id; locals }
+let rewrite_func (typemap : binary indice TypeMap.t) (modul : Assigned.t)
+  ({ id; type_f; locals; body; _ } : text func) : binary func Result.t =
+  let* (Bt_raw (_, (params, _)) as type_f) =
+    rewrite_block_type typemap modul type_f
+  in
+  let* locals = list_map (Binary_types.convert_param None) locals in
+  let+ body = rewrite_expr modul (params @ locals) body in
+  { body; type_f; id; locals }
 
 let rewrite_import (f : 'a -> 'b Result.t) (import : 'a Imported.t) :
   'b Imported.t Result.t =
-  let+ desc = f import.desc in
-  { import with desc }
+  let+ desc = f import.desc in
+  { import with desc }
 
 let rewrite_runtime f g r =
-  match r with
-  | Runtime.Local v ->
-    let+ v = f v in
-    Runtime.Local v
-  | Imported i ->
-    let+ i = g i in
-    Runtime.Imported i
+  match r with
+  | Runtime.Local v ->
+    let+ v = f v in
+    Runtime.Local v
+  | Imported i ->
+    let+ i = g i in
+    Runtime.Imported i
 
 let rewrite_named f named =
-  let+ values =
-    list_map
+  let+ values =
+    list_map
       (fun ind ->
-        let index = Indexed.get_index ind in
-        let value = Indexed.get ind in
-        let+ value = f value in
-        Indexed.return index value )
+        let index = Indexed.get_index ind in
+        let value = Indexed.get ind in
+        let+ value = f value in
+        Indexed.return index value )
       named.Named.values
   in
-  { named with Named.values }
+  { named with Named.values }
+
+let rewrite_types (_modul : Assigned.t) (t : binary str_type) :
+  binary rec_type Result.t =
+  (* TODO: the input `t` should actually be a `binary rec_type` *)
+  let t = [ (None, (Final, [], t)) ] in
+  Ok t
 
 let modul (modul : Assigned.t) : Binary.modul Result.t =
-  Log.debug0 "rewriting    ...@\n";
-  let* (global : (Binary.global, binary global_type) Runtime.t Named.t) =
-    let* { Named.named; values } =
-      rewrite_named (rewrite_runtime (rewrite_global modul) ok) modul.global
+  Log.debug0 "rewriting    ...@\n";
+  let typemap = typemap modul.typ in
+  let* global =
+    let+ { Named.named; values } =
+      rewrite_named (rewrite_runtime (rewrite_global modul) ok) modul.global
     in
-    let values = List.rev values in
-    let global : (Binary.global, binary global_type) Runtime.t Named.t =
-      { Named.named; values }
-    in
-    Ok global
+    let values = List.rev values in
+    { Named.named; values }
   in
-  let* elem = rewrite_named (rewrite_elem modul) modul.elem in
-  let* data = rewrite_named (rewrite_data modul) modul.data in
-  let* exports = rewrite_exports modul modul.exports in
-  let* (func : (binary func, binary block_type) Runtime.t Named.t) =
-    let import = rewrite_import (rewrite_block_type modul) in
-    let runtime = rewrite_runtime (rewrite_func modul) import in
-    rewrite_named runtime modul.func
+  let* elem = rewrite_named (rewrite_elem modul) modul.elem in
+  let* data = rewrite_named (rewrite_data modul) modul.data in
+  let* exports = rewrite_exports modul modul.exports in
+  let* func =
+    let import = rewrite_import (rewrite_block_type typemap modul) in
+    let runtime = rewrite_runtime (rewrite_func typemap modul) import in
+    rewrite_named runtime modul.func
   in
-  let+ start =
+  let* types = rewrite_named (rewrite_types modul) modul.typ in
+  let+ start =
     match modul.start with
-    | None -> Ok None
-    | Some start -> (
-      let* (Raw idx) = find "unknown function" func (Some start) in
-      let va = List.find (Indexed.has_index idx) func.Named.values in
-      let param_typ, result_typ =
-        match Indexed.get va with
-        | Local func ->
-          let (Bt_raw ((None | Some _), t)) = func.type_f in
-          t
-        | Imported imported ->
-          let (Bt_raw ((None | Some _), t)) = imported.desc in
-          t
-      in
-      match (param_typ, result_typ) with
-      | [], [] -> Ok (Some idx)
-      | _, _ -> Error `Start_function )
+    | None -> Ok None
+    | Some id ->
+      let* (Raw id) = find (`Unknown_func id) func id in
+      Ok (Some id)
   in
 
-  let modul : Binary.modul =
+  let modul : Binary.modul =
     { id = modul.id
     ; mem = modul.mem
     ; table = modul.table
+    ; types
     ; global
     ; elem
     ; data
diff --git a/coverage/src/typecheck/typecheck.ml.html b/coverage/src/typecheck/typecheck.ml.html
deleted file mode 100644
index 18188fb29..000000000
--- a/coverage/src/typecheck/typecheck.ml.html
+++ /dev/null
@@ -1,1946 +0,0 @@
-
-
-  
-    
-    typecheck.ml — Coverage report
-    
-    
-    
-    
-  
-  
-    
-    
-    

-      

-        
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
-

-      

-      

-        
-  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
-232
-233
-234
-235
-236
-237
-238
-239
-240
-241
-242
-243
-244
-245
-246
-247
-248
-249
-250
-251
-252
-253
-254
-255
-256
-257
-258
-259
-260
-261
-262
-263
-264
-265
-266
-267
-268
-269
-270
-271
-272
-273
-274
-275
-276
-277
-278
-279
-280
-281
-282
-283
-284
-285
-286
-287
-288
-289
-290
-291
-292
-293
-294
-295
-296
-297
-298
-299
-300
-301
-302
-303
-304
-305
-306
-307
-308
-309
-310
-311
-312
-313
-314
-315
-316
-317
-318
-319
-320
-321
-322
-323
-324
-325
-326
-327
-328
-329
-330
-331
-332
-333
-334
-335
-336
-337
-338
-339
-340
-341
-342
-343
-344
-345
-346
-347
-348
-349
-350
-351
-352
-353
-354
-355
-356
-357
-358
-359
-360
-361
-362
-363
-364
-365
-366
-367
-368
-369
-370
-371
-372
-373
-374
-375
-376
-377
-378
-379
-380
-381
-382
-383
-384
-385
-386
-387
-388
-389
-390
-391
-392
-393
-394
-395
-396
-397
-398
-399
-400
-401
-402
-403
-404
-405
-406
-407
-408
-409
-410
-411
-412
-413
-414
-415
-416
-417
-418
-419
-420
-421
-422
-423
-424
-425
-426
-427
-428
-429
-430
-431
-432
-433
-434
-435
-436
-437
-438
-439
-440
-441
-442
-443
-444
-445
-446
-447
-448
-449
-450
-451
-452
-453
-454
-455
-456
-457
-458
-459
-460
-461
-462
-463
-464
-465
-466
-467
-468
-469
-470
-471
-472
-473
-474
-475
-476
-477
-478
-479
-480
-481
-482
-483
-484
-485
-486
-487
-488
-489
-490
-491
-492
-493
-494
-495
-496
-497
-498
-499
-500
-501
-502
-503
-504
-505
-506
-507
-508
-509
-510
-511
-512
-513
-514
-515
-516
-517
-518
-519
-520
-521
-522
-523
-524
-525
-526
-527
-528
-529
-530
-531
-532
-533
-534
-535
-536
-537
-538
-539
-540
-541
-542
-543
-544
-545
-546
-547
-548
-549
-550
-551
-552
-553
-554
-555
-556
-557
-558
-559
-560
-561
-562
-563
-564
-565
-566
-567
-568
-569
-570
-571
-572
-573
-574
-575
-576
-577
-578
-579
-580
-581
-582
-583
-584
-585
-586
-587
-588
-589
-590
-591
-592
-593
-594
-595
-596
-597
-598
-599
-600
-601
-602
-603
-604
-605
-606
-607
-608
-609
-610
-611
-612
-613
-614
-615
-616
-617
-618
-619
-620
-621
-

-
(* SPDX-License-Identifier: AGPL-3.0-or-later *)
-(* Copyright © 2021-2024 OCamlPro *)
-(* Written by the Owi programmers *)
-
-open Types
-open Binary
-open Syntax
-open Format
-
-type typ =
-  | Num_type of num_type
-  | Ref_type of binary heap_type
-  | Any
-  | Something
-
-let pp_typ fmt = function
-  | Num_type t -> pp_num_type fmt t
-  | Ref_type t -> pp_heap_type fmt t
-  | Any -> pp_string fmt "any"
-  | Something -> pp_string fmt "something"
-
-let pp_typ_list fmt l = pp_list ~pp_sep:pp_space pp_typ fmt l
-
-let typ_of_val_type = function
-  | Types.Ref_type (_null, t) -> Ref_type t
-  | Num_type t -> Num_type t
-
-let typ_of_pt pt = typ_of_val_type @@ snd pt
-
-module Index = struct
-  module M = Int
-  module Map = Map.Make (Int)
-  include M
-end
-
-module Env = struct
-  type t =
-    { locals : typ Index.Map.t
-    ; globals : (global, binary global_type) Runtime.t Named.t
-    ; result_type : binary result_type
-    ; funcs : (binary func, binary block_type) Runtime.t Named.t
-    ; blocks : typ list list
-    ; tables : (binary table, binary table_type) Runtime.t Named.t
-    ; elems : elem Named.t
-    ; refs : (int, unit) Hashtbl.t
-    }
-
-  let local_get i env = match Index.Map.find i env.locals with v -> v
-
-  let global_get i env =
-    let value = Indexed.get_at_exn i env.globals.values in
-    let _mut, typ =
-      match value with Local { typ; _ } -> typ | Runtime.Imported t -> t.desc
-    in
-    typ
-
-  let func_get i env =
-    let value = Indexed.get_at_exn i env.funcs.values in
-    match value with
-    | Local { type_f; _ } ->
-      let (Bt_raw ((None | Some _), t)) = type_f in
-      t
-    | Runtime.Imported t ->
-      let (Bt_raw ((None | Some _), t)) = t.desc in
-      t
-
-  let block_type_get i env =
-    match List.nth_opt env.blocks i with
-    | None -> Error `Unknown_label
-    | Some bt -> Ok bt
-
-  let table_type_get_from_module i (modul : Binary.modul) =
-    let value = Indexed.get_at_exn i modul.table.values in
-    match value with
-    | Local table -> snd (snd table)
-    | Runtime.Imported t -> snd t.desc
-
-  let table_type_get i env =
-    let value = Indexed.get_at_exn i env.tables.values in
-    match value with
-    | Local table -> snd (snd table)
-    | Runtime.Imported t -> snd t.desc
-
-  let elem_type_get i env =
-    let value = Indexed.get_at_exn i env.elems.values in
-    value.typ
-
-  let make ~params ~locals ~globals ~funcs ~result_type ~tables ~elems ~refs =
-    let l = List.mapi (fun i v -> (i, v)) (params @ locals) in
-    let locals =
-      List.fold_left
-        (fun locals (i, (_, typ)) ->
-          let typ = typ_of_val_type typ in
-          Index.Map.add i typ locals )
-        Index.Map.empty l
-    in
-    { locals; globals; result_type; funcs; tables; elems; blocks = []; refs }
-end
-
-type env = Env.t
-
-type stack = typ list
-
-let i32 = Num_type I32
-
-let i64 = Num_type I64
-
-let f32 = Num_type F32
-
-let f64 = Num_type F64
-
-let i31 = Ref_type I31_ht
-
-let any = Any
-
-let itype = function S32 -> i32 | S64 -> i64
-
-let ftype = function S32 -> f32 | S64 -> f64
-
-let arraytype _modul _i = (* TODO *) assert false
-
-module Stack : sig
-  type t = typ list
-
-  val drop : t -> t Result.t
-
-  val pop : t -> t -> t Result.t
-
-  val push : t -> t -> t Result.t
-
-  val pop_push : binary block_type -> t -> t Result.t
-
-  val pop_ref : t -> t Result.t
-
-  val equal : t -> t -> bool
-
-  val match_ref_type : binary heap_type -> binary heap_type -> bool
-
-  val match_types : typ -> typ -> bool
-
-  val pp : formatter -> t -> unit
-
-  val match_prefix : prefix:t -> stack:t -> t option
-end = struct
-  type t = typ list
-
-  let pp fmt (s : stack) = pp fmt "[%a]" pp_typ_list s
-
-  let match_num_type (required : num_type) (got : num_type) =
-    match (required, got) with
-    | I32, I32 -> true
-    | I64, I64 -> true
-    | F32, F32 -> true
-    | F64, F64 -> true
-    | _, _ -> false
-
-  let match_ref_type required got =
-    match (required, got) with
-    | Any_ht, _ -> true
-    | None_ht, None_ht -> true
-    | Eq_ht, Eq_ht -> true
-    | I31_ht, I31_ht -> true
-    | Struct_ht, Struct_ht -> true
-    | Array_ht, Array_ht -> true
-    | No_func_ht, No_func_ht -> true
-    | Func_ht, Func_ht -> true
-    | Extern_ht, Extern_ht -> true
-    | No_extern_ht, No_extern_ht -> true
-    | _ ->
-      (* TODO: complete this *)
-      false
-
-  let match_types required got =
-    match (required, got) with
-    | Something, _ | _, Something -> true
-    | Any, _ | _, Any -> true
-    | Num_type required, Num_type got -> match_num_type required got
-    | Ref_type required, Ref_type got -> match_ref_type required got
-    | Num_type _, Ref_type _ | Ref_type _, Num_type _ -> false
-
-  let rec equal s s' =
-    match (s, s') with
-    | [], s | s, [] -> List.for_all (( = ) Any) s
-    | Any :: tl, Any :: tl' -> equal tl s' || equal s tl'
-    | Any :: tl, hd :: tl' | hd :: tl', Any :: tl ->
-      equal tl (hd :: tl') || equal (Any :: tl) tl'
-    | hd :: tl, hd' :: tl' -> match_types hd hd' && equal tl tl'
-
-  let ( ||| ) l r = match (l, r) with None, v | v, None -> v | _l, r -> r
-
-  let rec match_prefix ~prefix ~stack =
-    match (prefix, stack) with
-    | [], stack -> Some stack
-    | _hd :: _tl, [] -> None
-    | _hd :: tl, Any :: tl' ->
-      match_prefix ~prefix ~stack:tl' ||| match_prefix ~prefix:tl ~stack
-    | hd :: tl, hd' :: tl' ->
-      if match_types hd hd' then match_prefix ~prefix:tl ~stack:tl' else None
-
-  let pop required stack =
-    match match_prefix ~prefix:required ~stack with
-    | None -> Error (`Type_mismatch "pop")
-    | Some stack -> Ok stack
-
-  let pop_ref = function
-    | (Something | Ref_type _) :: tl -> Ok tl
-    | Any :: _ as stack -> Ok stack
-    | _ -> Error (`Type_mismatch "pop_ref")
-
-  let drop stack =
-    match stack with
-    | [] -> Error (`Type_mismatch "drop")
-    | Any :: _ -> Ok [ Any ]
-    | _ :: tl -> Ok tl
-
-  let push t stack = ok @@ t @ stack
-
-  let pop_push (Bt_raw ((None | Some _), (pt, rt))) stack =
-    let pt, rt = (List.rev_map typ_of_pt pt, List.rev_map typ_of_val_type rt) in
-    let* stack = pop pt stack in
-    push rt stack
-end
-
-let rec typecheck_instr (env : env) (stack : stack) (instr : binary instr) :
-  stack Result.t =
-  match instr with
-  | Nop -> Ok stack
-  | Drop -> Stack.drop stack
-  | Return ->
-    let+ _stack =
-      Stack.pop (List.rev_map typ_of_val_type env.result_type) stack
-    in
-    [ any ]
-  | Unreachable -> Ok [ any ]
-  | I32_const _ -> Stack.push [ i32 ] stack
-  | I64_const _ -> Stack.push [ i64 ] stack
-  | F32_const _ -> Stack.push [ f32 ] stack
-  | F64_const _ -> Stack.push [ f64 ] stack
-  | I_unop (s, _op) ->
-    let t = itype s in
-    let* stack = Stack.pop [ t ] stack in
-    Stack.push [ t ] stack
-  | I_binop (s, _op) ->
-    let t = itype s in
-    let* stack = Stack.pop [ t; t ] stack in
-    Stack.push [ t ] stack
-  | F_unop (s, _op) ->
-    let t = ftype s in
-    let* stack = Stack.pop [ t ] stack in
-    Stack.push [ t ] stack
-  | F_binop (s, _op) ->
-    let t = ftype s in
-    let* stack = Stack.pop [ t; t ] stack in
-    Stack.push [ t ] stack
-  | I_testop (nn, _) ->
-    let* stack = Stack.pop [ itype nn ] stack in
-    Stack.push [ i32 ] stack
-  | I_relop (nn, _) ->
-    let t = itype nn in
-    let* stack = Stack.pop [ t; t ] stack in
-    Stack.push [ i32 ] stack
-  | F_relop (nn, _) ->
-    let t = ftype nn in
-    let* stack = Stack.pop [ t; t ] stack in
-    Stack.push [ i32 ] stack
-  | Local_get (Raw i) -> Stack.push [ Env.local_get i env ] stack
-  | Local_set (Raw i) ->
-    let t = Env.local_get i env in
-    Stack.pop [ t ] stack
-  | Local_tee (Raw i) ->
-    let t = Env.local_get i env in
-    let* stack = Stack.pop [ t ] stack in
-    Stack.push [ t ] stack
-  | Global_get (Raw i) ->
-    Stack.push [ typ_of_val_type @@ Env.global_get i env ] stack
-  | Global_set (Raw i) ->
-    let t = Env.global_get i env in
-    Stack.pop [ typ_of_val_type t ] stack
-  | If_else (_id, block_type, e1, e2) ->
-    let* stack = Stack.pop [ i32 ] stack in
-    let* stack_e1 = typecheck_expr env e1 ~is_loop:false block_type ~stack in
-    let+ _stack_e2 = typecheck_expr env e2 ~is_loop:false block_type ~stack in
-    stack_e1
-  | I_load (nn, _) | I_load16 (nn, _, _) | I_load8 (nn, _, _) ->
-    let* stack = Stack.pop [ i32 ] stack in
-    Stack.push [ itype nn ] stack
-  | I64_load32 _ ->
-    let* stack = Stack.pop [ i32 ] stack in
-    Stack.push [ i64 ] stack
-  | I_store8 (nn, _) | I_store16 (nn, _) | I_store (nn, _) ->
-    Stack.pop [ itype nn; i32 ] stack
-  | I64_store32 _ -> Stack.pop [ i64; i32 ] stack
-  | F_load (nn, _) ->
-    let* stack = Stack.pop [ i32 ] stack in
-    Stack.push [ ftype nn ] stack
-  | F_store (nn, _) -> Stack.pop [ ftype nn; i32 ] stack
-  | I_reinterpret_f (inn, fnn) ->
-    let* stack = Stack.pop [ ftype fnn ] stack in
-    Stack.push [ itype inn ] stack
-  | F_reinterpret_i (fnn, inn) ->
-    let* stack = Stack.pop [ itype inn ] stack in
-    Stack.push [ ftype fnn ] stack
-  | F32_demote_f64 ->
-    let* stack = Stack.pop [ f64 ] stack in
-    Stack.push [ f32 ] stack
-  | F64_promote_f32 ->
-    let* stack = Stack.pop [ f32 ] stack in
-    Stack.push [ f64 ] stack
-  | F_convert_i (fnn, inn, _) ->
-    let* stack = Stack.pop [ itype inn ] stack in
-    Stack.push [ ftype fnn ] stack
-  | I_trunc_f (inn, fnn, _) | I_trunc_sat_f (inn, fnn, _) ->
-    let* stack = Stack.pop [ ftype fnn ] stack in
-    Stack.push [ itype inn ] stack
-  | I32_wrap_i64 ->
-    let* stack = Stack.pop [ i64 ] stack in
-    Stack.push [ i32 ] stack
-  | I_extend8_s nn | I_extend16_s nn ->
-    let t = itype nn in
-    let* stack = Stack.pop [ t ] stack in
-    Stack.push [ t ] stack
-  | I64_extend32_s ->
-    let* stack = Stack.pop [ i64 ] stack in
-    Stack.push [ i64 ] stack
-  | I64_extend_i32 _ ->
-    let* stack = Stack.pop [ i32 ] stack in
-    Stack.push [ i64 ] stack
-  | Memory_grow ->
-    let* stack = Stack.pop [ i32 ] stack in
-    Stack.push [ i32 ] stack
-  | Memory_size -> Stack.push [ i32 ] stack
-  | Memory_copy | Memory_init _ | Memory_fill ->
-    Stack.pop [ i32; i32; i32 ] stack
-  | Block (_, bt, expr) -> typecheck_expr env expr ~is_loop:false bt ~stack
-  | Loop (_, bt, expr) -> typecheck_expr env expr ~is_loop:true bt ~stack
-  | Call_indirect (_, bt) ->
-    let* stack = Stack.pop [ i32 ] stack in
-    Stack.pop_push bt stack
-  | Call (Raw i) ->
-    let pt, rt = Env.func_get i env in
-    let* stack = Stack.pop (List.rev_map typ_of_pt pt) stack in
-    Stack.push (List.rev_map typ_of_val_type rt) stack
-  | Call_ref _t ->
-    let+ stack = Stack.pop_ref stack in
-    (* TODO:
-       let bt = Env.type_get t env in
-         Stack.pop_push (Some bt) stack
-    *)
-    stack
-  | Return_call (Raw i) ->
-    let pt, rt = Env.func_get i env in
-    if
-      not
-        (Stack.equal
-           (List.rev_map typ_of_val_type rt)
-           (List.rev_map typ_of_val_type env.result_type) )
-    then Error (`Type_mismatch "return_call")
-    else
-      let+ _stack = Stack.pop (List.rev_map typ_of_pt pt) stack in
-      [ any ]
-  | Return_call_indirect (_, Bt_raw ((None | Some _), (pt, rt))) ->
-    if
-      not
-        (Stack.equal
-           (List.rev_map typ_of_val_type rt)
-           (List.rev_map typ_of_val_type env.result_type) )
-    then Error (`Type_mismatch "return_call_indirect")
-    else
-      let* stack = Stack.pop [ i32 ] stack in
-      let+ _stack = Stack.pop (List.rev_map typ_of_pt pt) stack in
-      [ any ]
-  | Return_call_ref (Bt_raw ((None | Some _), (pt, rt))) ->
-    if
-      not
-        (Stack.equal
-           (List.rev_map typ_of_val_type rt)
-           (List.rev_map typ_of_val_type env.result_type) )
-    then Error (`Type_mismatch "return_call_ref")
-    else
-      let* stack = Stack.pop_ref stack in
-      let+ _stack = Stack.pop (List.rev_map typ_of_pt pt) stack in
-      [ any ]
-  | Data_drop _i -> Ok stack
-  | Table_init (Raw ti, Raw ei) ->
-    let table_typ = Env.table_type_get ti env in
-    let elem_typ = Env.elem_type_get ei env in
-    if not @@ Stack.match_ref_type (snd table_typ) (snd elem_typ) then
-      Error (`Type_mismatch "table_init")
-    else Stack.pop [ i32; i32; i32 ] stack
-  | Table_copy (Raw i, Raw i') ->
-    let typ = Env.table_type_get i env in
-    let typ' = Env.table_type_get i' env in
-    if typ <> typ' then Error (`Type_mismatch "table_copy")
-    else Stack.pop [ i32; i32; i32 ] stack
-  | Table_fill (Raw i) ->
-    let _null, t = Env.table_type_get i env in
-    Stack.pop [ i32; Ref_type t; i32 ] stack
-  | Table_grow (Raw i) ->
-    let _null, t = Env.table_type_get i env in
-    let* stack = Stack.pop [ i32; Ref_type t ] stack in
-    Stack.push [ i32 ] stack
-  | Table_size _ -> Stack.push [ i32 ] stack
-  | Ref_is_null ->
-    let* stack = Stack.pop_ref stack in
-    Stack.push [ i32 ] stack
-  | Ref_null rt -> Stack.push [ Ref_type rt ] stack
-  | Elem_drop _ -> Ok stack
-  | Select t ->
-    let* stack = Stack.pop [ i32 ] stack in
-    begin
-      match t with
-      | None -> begin
-        match stack with
-        | Ref_type _ :: _tl -> Error (`Type_mismatch "select implicit")
-        | Any :: _ -> Ok [ Something; Any ]
-        | hd :: Any :: _ -> ok @@ (hd :: [ Any ])
-        | hd :: hd' :: tl when Stack.match_types hd hd' -> ok @@ (hd :: tl)
-        | _ -> Error (`Type_mismatch "select")
-      end
-      | Some t ->
-        let t = List.map typ_of_val_type t in
-        let* stack = Stack.pop t stack in
-        let* stack = Stack.pop t stack in
-        Stack.push t stack
-    end
-  | Ref_func (Raw i) ->
-    if not @@ Hashtbl.mem env.refs i then Error `Undeclared_function_reference
-    else Stack.push [ Ref_type Func_ht ] stack
-  | Br (Raw i) ->
-    let* jt = Env.block_type_get i env in
-    let* _stack = Stack.pop jt stack in
-    Ok [ any ]
-  | Br_if (Raw i) ->
-    let* stack = Stack.pop [ i32 ] stack in
-    let* jt = Env.block_type_get i env in
-    let* stack = Stack.pop jt stack in
-    Stack.push jt stack
-  | Br_table (branches, Raw i) ->
-    let* stack = Stack.pop [ i32 ] stack in
-    let* default_jt = Env.block_type_get i env in
-    let* _stack = Stack.pop default_jt stack in
-    let* () =
-      array_iter
-        (fun (Raw i : binary indice) ->
-          let* jt = Env.block_type_get i env in
-          if not (List.length jt = List.length default_jt) then
-            Error (`Type_mismatch "br_table")
-          else
-            let* _stack = Stack.pop jt stack in
-            Ok () )
-        branches
-    in
-    Ok [ any ]
-  | Table_get (Raw i) ->
-    let _null, t = Env.table_type_get i env in
-    let* stack = Stack.pop [ i32 ] stack in
-    Stack.push [ Ref_type t ] stack
-  | Table_set (Raw i) ->
-    let _null, t = Env.table_type_get i env in
-    Stack.pop [ Ref_type t; i32 ] stack
-  | Array_len ->
-    (* TODO: fixme, Something is not right *)
-    let* stack = Stack.pop [ Something ] stack in
-    Stack.push [ i32 ] stack
-  | Ref_i31 ->
-    let* stack = Stack.pop [ i32 ] stack in
-    Stack.push [ i31 ] stack
-  | I31_get_s | I31_get_u ->
-    let* stack = Stack.pop [ i31 ] stack in
-    Stack.push [ i32 ] stack
-  | ( Array_new_data _ | Array_new _ | Array_new_default _ | Array_new_elem _
-    | Array_new_fixed _ | Array_get _ | Array_get_u _ | Array_set _
-    | Struct_get _ | Struct_get_s _ | Struct_set _ | Struct_new _
-    | Struct_new_default _ | Extern_externalize | Extern_internalize
-    | Ref_as_non_null | Ref_cast _ | Ref_test _ | Br_on_non_null _
-    | Br_on_null _ | Br_on_cast _ | Br_on_cast_fail _ | Ref_eq ) as i ->
-    Log.debug2 "TODO (typecheck instr) %a" pp_instr i;
-    assert false
-
-and typecheck_expr env expr ~is_loop (block_type : binary block_type option)
-  ~stack:previous_stack : stack Result.t =
-  let pt, rt =
-    Option.fold ~none:([], [])
-      ~some:(fun (Bt_raw ((None | Some _), (pt, rt)) : binary block_type) ->
-        (List.rev_map typ_of_pt pt, List.rev_map typ_of_val_type rt) )
-      block_type
-  in
-  let jump_type = if is_loop then pt else rt in
-  let env = { env with blocks = jump_type :: env.blocks } in
-  let* stack = list_fold_left (typecheck_instr env) pt expr in
-  if not (Stack.equal rt stack) then Error (`Type_mismatch "typecheck_expr 1")
-  else
-    match Stack.match_prefix ~prefix:pt ~stack:previous_stack with
-    | None ->
-      Error
-        (`Type_mismatch
-          (Format.asprintf "expected a prefix of %a but stack has type %a"
-             Stack.pp pt Stack.pp previous_stack ) )
-    | Some stack_to_push -> Stack.push rt stack_to_push
-
-let typecheck_function (modul : modul) func refs =
-  match func with
-  | Runtime.Imported _ -> Ok ()
-  | Local func ->
-    let (Bt_raw ((None | Some _), (params, result))) = func.type_f in
-    let env =
-      Env.make ~params ~funcs:modul.func ~locals:func.locals
-        ~globals:modul.global ~result_type:result ~tables:modul.table
-        ~elems:modul.elem ~refs
-    in
-    let* stack =
-      typecheck_expr env func.body ~is_loop:false
-        (Some (Bt_raw (None, ([], result))))
-        ~stack:[]
-    in
-    let required = List.rev_map typ_of_val_type result in
-    if not @@ Stack.equal required stack then
-      Error (`Type_mismatch "typecheck_function")
-    else Ok ()
-
-let typecheck_const_instr (modul : modul) refs stack = function
-  | I32_const _ -> Stack.push [ i32 ] stack
-  | I64_const _ -> Stack.push [ i64 ] stack
-  | F32_const _ -> Stack.push [ f32 ] stack
-  | F64_const _ -> Stack.push [ f64 ] stack
-  | Ref_null t -> Stack.push [ Ref_type t ] stack
-  | Ref_func (Raw i) ->
-    Hashtbl.add refs i ();
-    Stack.push [ Ref_type Func_ht ] stack
-  | Global_get (Raw i) ->
-    let value = Indexed.get_at_exn i modul.global.values in
-    let* _mut, typ =
-      match value with
-      | Local _ -> Error `Unknown_global
-      | Imported t -> Ok t.desc
-    in
-    Stack.push [ typ_of_val_type typ ] stack
-  | I_binop (t, _op) ->
-    let t = itype t in
-    let* stack = Stack.pop [ t; t ] stack in
-    Stack.push [ t ] stack
-  | Array_new t ->
-    let t = arraytype modul t in
-    let* stack = Stack.pop [ i32; t ] stack in
-    Stack.push [ Ref_type Array_ht ] stack
-  | Array_new_default _i -> assert false
-  | Ref_i31 ->
-    let* stack = Stack.pop [ i32 ] stack in
-    Stack.push [ i31 ] stack
-  | _ -> assert false
-
-let typecheck_const_expr (modul : modul) refs =
-  list_fold_left (typecheck_const_instr modul refs) []
-
-let typecheck_global (modul : modul) refs
-  (global : (global, binary global_type) Runtime.t Indexed.t) =
-  match Indexed.get global with
-  | Imported _ -> Ok ()
-  | Local { typ; init; _ } -> (
-    let* real_type = typecheck_const_expr modul refs init in
-    match real_type with
-    | [ real_type ] ->
-      let expected = typ_of_val_type @@ snd typ in
-      if expected <> real_type then Error (`Type_mismatch "typecheck global 1")
-      else Ok ()
-    | _whatever -> Error (`Type_mismatch "typecheck_global 2") )
-
-let typecheck_elem modul refs (elem : elem Indexed.t) =
-  let elem = Indexed.get elem in
-  let _null, expected_type = elem.typ in
-  let* () =
-    list_iter
-      (fun init ->
-        let* real_type = typecheck_const_expr modul refs init in
-        match real_type with
-        | [ real_type ] ->
-          if Ref_type expected_type <> real_type then
-            Error (`Type_mismatch "typecheck_elem 1")
-          else Ok ()
-        | _whatever -> Error (`Type_mismatch "typecheck elem 2") )
-      elem.init
-  in
-  match elem.mode with
-  | Elem_passive | Elem_declarative -> Ok ()
-  | Elem_active (None, _e) -> assert false
-  | Elem_active (Some tbl_i, e) -> (
-    let _null, tbl_type = Env.table_type_get_from_module tbl_i modul in
-    if tbl_type <> expected_type then Error (`Type_mismatch "typecheck elem 3")
-    else
-      let* t = typecheck_const_expr modul refs e in
-      match t with
-      | [ Ref_type t ] ->
-        if t <> tbl_type then Error (`Type_mismatch "typecheck_elem 4")
-        else Ok ()
-      | [ _t ] -> Ok ()
-      | _whatever -> Error (`Type_mismatch "typecheck_elem 5") )
-
-let typecheck_data modul refs (data : data Indexed.t) =
-  let data = Indexed.get data in
-  match data.mode with
-  | Data_passive -> Ok ()
-  | Data_active (_i, e) -> (
-    let* t = typecheck_const_expr modul refs e in
-    match t with
-    | [ _t ] -> Ok ()
-    | _whatever -> Error (`Type_mismatch "typecheck_data") )
-
-let modul (modul : modul) =
-  Log.debug0 "typechecking ...@\n";
-  let refs = Hashtbl.create 512 in
-  let* () = list_iter (typecheck_global modul refs) modul.global.values in
-  let* () = list_iter (typecheck_elem modul refs) modul.elem.values in
-  let* () = list_iter (typecheck_data modul refs) modul.data.values in
-  List.iter
-    (fun (export : export) -> Hashtbl.add refs export.id ())
-    modul.exports.func;
-  Named.fold
-    (fun _index func acc ->
-      let* () = acc in
-      typecheck_function modul func refs )
-    modul.func (Ok ())
-

-      

-    

-    
-  
-
diff --git a/coverage/src/utils/format.ml.html b/coverage/src/utils/format.ml.html
deleted file mode 100644
index 35e0c36f7..000000000
--- a/coverage/src/utils/format.ml.html
+++ /dev/null
@@ -1,141 +0,0 @@
-
-
-  
-    
-    format.ml — Coverage report
-    
-    
-    
-    
-  
-  
-    
-    
-    

-      

-        
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
-

-      

-      

-        
- 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
-

-
(* SPDX-License-Identifier: AGPL-3.0-or-later *)
-(* Copyright © 2021-2024 OCamlPro *)
-(* Written by the Owi programmers *)
-
-include Stdlib.Format
-
-let pp = fprintf
-
-let pp_err = eprintf
-
-let pp_std = printf
-
-let pp_nothing _fmt () = ()
-
-let pp_char = pp_print_char
-
-let pp_list = pp_print_list
-
-let pp_array = pp_print_array
-
-let pp_iter = pp_print_iter
-
-let pp_string = pp_print_string
-
-let pp_option = pp_print_option
-
-let pp_bool = pp_print_bool
-
-let pp_flush = pp_print_flush
-
-let pp_space fmt () = pp_string fmt " "
-
-let pp_newline fmt () = pp fmt "@\n"
-
-let pp_int = pp_print_int
-

-      

-    

-    
-  
-
diff --git a/coverage/src/utils/log.ml.html b/coverage/src/utils/log.ml.html
index 0333709ea..4bb409d3f 100644
--- a/coverage/src/utils/log.ml.html
+++ b/coverage/src/utils/log.ml.html
@@ -3,7 +3,7 @@
   
     
     log.ml — Coverage report
-    
+    
     
     
     
@@ -15,11 +15,11 @@ 

           src/utils/log.ml
         
       

-      
81.82%

+      
83.33%
@@ -32,17 +32,22 @@

81.82%

- - - - - + + + + + - + - + - + + + + + +
@@ -66,6 +71,11 @@

81.82%

17 18 19 +20 +21 +22 +23 +24 
(* SPDX-License-Identifier: AGPL-3.0-or-later *)
 (* Copyright © 2021-2024 OCamlPro *)
@@ -75,17 +85,22 @@ 
81.82%

 
 let profiling_on = ref false
 
-let debug0 t : unit = if !debug_on then Format.pp_err t
+let debug0 t : unit =
+  if !debug_on then begin
+    Fmt.epr t;
+    Fmt.flush Fmt.stderr ()
+  end
 
-let debug1 t a : unit = if !debug_on then Format.pp_err t a
+let debug1 t a : unit = if !debug_on then Fmt.epr t a
 
-let debug2 t a b : unit = if !debug_on then Format.pp_err t a b
+let debug2 t a b : unit = if !debug_on then Fmt.epr t a b
 
-let debug5 t a b c d e : unit = if !debug_on then Format.pp_err t a b c d e
+let debug5 t a b c d e : unit = if !debug_on then Fmt.epr t a b c d e
 
-let profile3 t a b c : unit = if !profiling_on then Format.pp_err t a b c
+let profile3 t a b c : unit = if !profiling_on then Fmt.epr t a b c
 
-let err f = Format.kasprintf failwith f
+(* TODO: remove this *)
+let err f = Fmt.failwith f
diff --git a/coverage/src/result.ml.html b/coverage/src/utils/result.ml.html similarity index 62% rename from coverage/src/result.ml.html rename to coverage/src/utils/result.ml.html index 92fc07939..87d994e69 100644 --- a/coverage/src/result.ml.html +++ b/coverage/src/utils/result.ml.html @@ -3,35 +3,34 @@ result.ml — Coverage report - - - + + +
@@ -100,17 +99,17 @@

70.18%

- - - - - + + + + + - - - - - + + + + + @@ -129,38 +128,42 @@

70.18%

- + - + - - + + - - - + + + - + - - - + + + - + - - + + - - - + + + + + + +
@@ -289,12 +292,16 @@

70.18%

122 123 124 +125 +126 +127 +128 
(* SPDX-License-Identifier: AGPL-3.0-or-later *)
 (* Copyright © 2021-2024 OCamlPro *)
 (* Written by the Owi programmers *)
 
-include Stdlib.Result
+include Prelude.Result
 
 type err =
   [ `Alignment_too_large
@@ -337,42 +344,45 @@ 
70.18%

   | `Unbound_module of string
   | `Unbound_name of string
   | `Undeclared_function_reference
-  | `Unexpected_token
-  | `Unknown_function of int
-  | `Unknown_global
+  | `Unexpected_token of string
+  | `Unknown_data of Types.text Types.indice
+  | `Unknown_elem of Types.text Types.indice
+  | `Unknown_func of Types.text Types.indice
+  | `Unknown_global of Types.text Types.indice
   | `Unknown_import of string * string
-  | `Unknown_label
-  | `Unknown_local of string
-  | `Unknown_memory of int
+  | `Unknown_label of Types.text Types.indice
+  | `Unknown_local of Types.text Types.indice
+  | `Unknown_memory of Types.text Types.indice
   | `Unknown_module of string
   | `Unknown_operator
-  | `Unknown_type
+  | `Unknown_table of Types.text Types.indice
+  | `Unknown_type of Types.text Types.indice
   | `Unsupported_file_extension of string
   ]
 
-type 'a t = ('a, err) Stdlib.Result.t
+type 'a t = ('a, err) Prelude.Result.t
 
 let rec err_to_string = function
-  | `Alignment_too_large -> "alignment must not be larger than natural"
+  | `Alignment_too_large -> "alignment must not be larger than natural"
   | `Assert_failure -> "script assert failure"
   | `Bad_result -> "bad result"
   | `Call_stack_exhausted -> "call stack exhausted"
-  | `Constant_expression_required -> "constant expression required"
+  | `Constant_expression_required -> "constant expression required"
   | `Constant_out_of_range -> "constant out of range"
-  | `Did_not_fail_but_expected expected ->
-    Format.sprintf "expected %s but there was no error" expected
+  | `Did_not_fail_but_expected expected ->
+    Fmt.str "expected %s but there was no error" expected
   | `Duplicate_export_name -> "duplicate export name"
-  | `Duplicate_global id -> Format.sprintf "duplicate global %s" id
-  | `Duplicate_local id -> Format.sprintf "duplicate local %s" id
-  | `Duplicate_memory id -> Format.sprintf "duplicate memory %s" id
-  | `Duplicate_table id -> Format.sprintf "duplicate table %s" id
-  | `Failed_with_but_expected (got, expected) ->
-    Format.sprintf "expected %s but got (%s)" expected (err_to_string got)
-  | `Found_bug n ->
-    if n > 1 then Format.sprintf "Reached %d problems!" n
-    else Format.sprintf "Reached problem!"
-  | `Global_is_immutable -> "global is immutable"
-  | `Illegal_escape txt -> Format.sprintf "illegal escape %S" txt
+  | `Duplicate_global id -> Fmt.str "duplicate global %s" id
+  | `Duplicate_local id -> Fmt.str "duplicate local %s" id
+  | `Duplicate_memory id -> Fmt.str "duplicate memory %s" id
+  | `Duplicate_table id -> Fmt.str "duplicate table %s" id
+  | `Failed_with_but_expected (got, expected) ->
+    Fmt.str "expected %s but got (%s)" expected (err_to_string got)
+  | `Found_bug n ->
+    if n > 1 then Fmt.str "Reached %d problems!" n
+    else Fmt.str "Reached problem!"
+  | `Global_is_immutable -> "global is immutable"
+  | `Illegal_escape txt -> Fmt.str "illegal escape %S" txt
   | `Import_after_function -> "import after function"
   | `Import_after_global -> "import after global"
   | `Import_after_memory -> "import after memory"
@@ -380,43 +390,44 @@ 
70.18%

   | `Incompatible_import_type -> "incompatible import type"
   | `Inline_function_type -> "inline function type"
   | `Invalid_result_arity -> "invalid result arity"
-  | `Lexer_unknown_operator op -> Format.sprintf "unknown operator %s" op
-  | `Malformed_utf8_encoding txt ->
-    Format.sprintf "malformed UTF-8 encoding %S" txt
+  | `Lexer_unknown_operator op -> Fmt.str "unknown operator %s" op
+  | `Malformed_utf8_encoding txt -> Fmt.str "malformed UTF-8 encoding %S" txt
   | `Memory_size_too_large -> "memory size must be at most 65536 pages (4GiB)"
-  | `Msg msg -> msg
+  | `Msg msg -> msg
   | `Multiple_memories -> "multiple memories"
   | `Multiple_start_sections -> "multiple start sections"
   | `No_error -> "no error"
-  | `Parse_fail msg -> msg
+  | `Parse_fail msg -> msg
   | `Size_minimum_greater_than_maximum ->
     "size minimum must not be greater than maximum"
   | `Start_function -> "start function must have type [] -> []"
   | `Timeout -> "timeout"
-  | `Trap t -> Format.sprintf "trap: %s" (Trap.to_string t)
-  | `Type_mismatch msg -> Format.sprintf "type mismatch (%s)" msg
+  | `Trap t -> Fmt.str "trap: %s" (Trap.to_string t)
+  | `Type_mismatch msg -> Fmt.str "type mismatch (%s)" msg
   | `Unbound_last_module -> "unbound last module"
-  | `Unbound_module id -> Format.sprintf "unbound module %s" id
-  | `Unbound_name id -> Format.sprintf "unbound name %s" id
+  | `Unbound_module id -> Fmt.str "unbound module %s" id
+  | `Unbound_name id -> Fmt.str "unbound name %s" id
   | `Undeclared_function_reference -> "undeclared function reference"
-  | `Unexpected_token -> "unexpected token"
-  | `Unknown_function id -> Format.sprintf "unknown function %d" id
-  | `Unknown_global -> "unknown global"
-  | `Unknown_import (modul, value) ->
-    Format.sprintf "unknown import %S %S" modul value
-  | `Unknown_label -> "unknown label"
-  | `Unknown_local id -> Format.sprintf "unknown local %s" id
-  | `Unknown_memory id -> Format.sprintf "unknown memory %d" id
-  | `Unknown_module id -> Format.sprintf "unknown module %s" id
-  | `Unknown_operator -> Format.sprintf "unknown operator"
-  | `Unknown_type -> "unknown type"
-  | `Unsupported_file_extension ext ->
-    Format.sprintf "unsupported file_extension %S" ext
+  | `Unexpected_token s -> Fmt.str "unexpected token %S" s
+  | `Unknown_data id -> Fmt.str "unknown data segment %a" Types.pp_indice id
+  | `Unknown_elem id -> Fmt.str "unknown elem segment %a" Types.pp_indice id
+  | `Unknown_func id -> Fmt.str "unknown function %a" Types.pp_indice id
+  | `Unknown_global id -> Fmt.str "unknown global %a" Types.pp_indice id
+  | `Unknown_import (modul, value) -> Fmt.str "unknown import %S %S" modul value
+  | `Unknown_label id -> Fmt.str "unknown label %a" Types.pp_indice id
+  | `Unknown_local id -> Fmt.str "unknown local %a" Types.pp_indice id
+  | `Unknown_memory id -> Fmt.str "unknown memory %a" Types.pp_indice id
+  | `Unknown_module name -> Fmt.str "unknown module %s" name
+  | `Unknown_operator -> Fmt.str "unknown operator"
+  | `Unknown_table id -> Fmt.str "unknown table %a" Types.pp_indice id
+  | `Unknown_type id -> Fmt.str "unknown type %a" Types.pp_indice id
+  | `Unsupported_file_extension ext ->
+    Fmt.str "unsupported file_extension %S" ext
 
-let failwith e = failwith (err_to_string e)
+let failwith e = Fmt.failwith "%s" (err_to_string e)
- + diff --git a/coverage/src/utils/syntax.ml.html b/coverage/src/utils/syntax.ml.html index 89d77f9e7..5cba464bd 100644 --- a/coverage/src/utils/syntax.ml.html +++ b/coverage/src/utils/syntax.ml.html @@ -3,7 +3,7 @@ syntax.ml — Coverage report - + @@ -15,16 +15,15 @@

src/utils/syntax.ml

-

81.63%

+

83.33%

@@ -42,84 +41,82 @@

81.63%

- + - - + + - + - - - - - + + + + + - - - - + + + + - - + + - - - - + + + + - - + + - - - + + + - + - + - - - + + + - - + + - - + + - + - - - - - - - + + + + + + + - - - + + + - - - + + + - - - - + +
@@ -212,84 +209,80 @@

81.63%

86 87 88 -89 -90 
(* SPDX-License-Identifier: AGPL-3.0-or-later *)
 (* Copyright © 2021-2024 OCamlPro *)
 (* Written by the Owi programmers *)
 
-open Stdlib.Result
+open Prelude.Result
 
-let ( let* ) o f = match o with Ok v -> f v | Error _ as e -> e
+let ( let* ) o f = match o with Ok v -> f v | Error _ as e -> e
 
-let ( let+ ) o f = match o with Ok v -> Ok (f v) | Error _ as e -> e
+let ( let+ ) o f = match o with Ok v -> Ok (f v) | Error _ as e -> e
 
 let error v = Error v
 
-let error_s format = Format.kasprintf error format
-
-let ok v = Ok v
+let ok v = Ok v
 
 let list_iter f l =
-  let err = ref None in
+  let err = ref None in
   try
     List.iter
       (fun v ->
-        match f v with
-        | Error _e as e ->
+        match f v with
+        | Error _e as e ->
           err := Some e;
           raise Exit
-        | Ok () -> () )
+        | Ok () -> () )
       l;
-    Ok ()
-  with Exit -> Option.get !err
+    Ok ()
+  with Exit -> Option.get !err
 
 let list_map f l =
-  let err = ref None in
+  let err = ref None in
   try
-    ok
-    @@ List.map
+    ok
+    @@ List.map
          (fun v ->
-           match f v with
-           | Error _e as e ->
+           match f v with
+           | Error _e as e ->
              err := Some e;
              raise Exit
-           | Ok v -> v )
+           | Ok v -> v )
          l
-  with Exit -> Option.get !err
+  with Exit -> Option.get !err
 
 let list_fold_left f acc l =
-  List.fold_left
+  List.fold_left
     (fun acc v ->
-      let* acc in
-      f acc v )
+      let* acc in
+      f acc v )
     (Ok acc) l
 
 let array_iter f a =
-  let err = ref None in
+  let err = ref None in
   try
-    for i = 0 to Array.length a - 1 do
-      match f (Array.unsafe_get a i) with
+    for i = 0 to Array.length a - 1 do
+      match f (Array.unsafe_get a i) with
       | Error _e as e ->
         err := Some e;
         raise Exit
-      | Ok () -> ()
+      | Ok () -> ()
     done;
     Ok ()
   with Exit -> Option.get !err
 
 let array_map f a =
-  let err = ref None in
+  let err = ref None in
   try
-    ok
-    @@ Array.init (Array.length a) (fun i ->
-           let v = Array.get a i in
-           match f v with
+    ok
+    @@ Array.init (Array.length a) (fun i ->
+           let v = Array.get a i in
+           match f v with
            | Error _e as e ->
              err := Some e;
              raise Exit
-           | Ok v -> v )
+           | Ok v -> v )
   with Exit -> Option.get !err
 
 let array_fold_left f acc a =
diff --git a/coverage/src/tracing.ml.html b/coverage/src/utils/tracing.ml.html
similarity index 85%
rename from coverage/src/tracing.ml.html
rename to coverage/src/utils/tracing.ml.html
index 0ec592805..4b6b7839c 100644
--- a/coverage/src/tracing.ml.html
+++ b/coverage/src/utils/tracing.ml.html
@@ -3,16 +3,16 @@
   
     
     tracing.ml — Coverage report
-    
-    
-    
+    
+    
+
- + diff --git a/coverage/src/utils/wutf8.ml.html b/coverage/src/utils/wutf8.ml.html index af26d34f4..78c0117aa 100644 --- a/coverage/src/utils/wutf8.ml.html +++ b/coverage/src/utils/wutf8.ml.html @@ -166,14 +166,14 @@

16.67%

| _ -> raise Utf8 let check_utf8 s = - let open Uutf in + let open Uutf in let decoder = decoder ~encoding:`UTF_8 (`String s) in - let rec loop () = - match decode decoder with + let rec loop () = + match decode decoder with | `Malformed s -> Error (`Malformed_utf8_encoding s) | `Await -> assert false - | `End -> Ok () - | `Uchar _ -> loop () + | `End -> Ok () + | `Uchar _ -> loop () in loop () diff --git a/coverage/src/check/check.ml.html b/coverage/src/validate/check.ml.html similarity index 71% rename from coverage/src/check/check.ml.html rename to coverage/src/validate/check.ml.html index eb66633ee..6dc10af55 100644 --- a/coverage/src/check/check.ml.html +++ b/coverage/src/validate/check.ml.html @@ -3,7 +3,7 @@ check.ml — Coverage report - + @@ -12,7 +12,7 @@ diff --git a/coverage/src/validate/typecheck.ml.html b/coverage/src/validate/typecheck.ml.html new file mode 100644 index 000000000..a95902e54 --- /dev/null +++ b/coverage/src/validate/typecheck.ml.html @@ -0,0 +1,2424 @@ + + + + + typecheck.ml — Coverage report + + + + + + + + +
+
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+
+
+
+ 
+  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
+232
+233
+234
+235
+236
+237
+238
+239
+240
+241
+242
+243
+244
+245
+246
+247
+248
+249
+250
+251
+252
+253
+254
+255
+256
+257
+258
+259
+260
+261
+262
+263
+264
+265
+266
+267
+268
+269
+270
+271
+272
+273
+274
+275
+276
+277
+278
+279
+280
+281
+282
+283
+284
+285
+286
+287
+288
+289
+290
+291
+292
+293
+294
+295
+296
+297
+298
+299
+300
+301
+302
+303
+304
+305
+306
+307
+308
+309
+310
+311
+312
+313
+314
+315
+316
+317
+318
+319
+320
+321
+322
+323
+324
+325
+326
+327
+328
+329
+330
+331
+332
+333
+334
+335
+336
+337
+338
+339
+340
+341
+342
+343
+344
+345
+346
+347
+348
+349
+350
+351
+352
+353
+354
+355
+356
+357
+358
+359
+360
+361
+362
+363
+364
+365
+366
+367
+368
+369
+370
+371
+372
+373
+374
+375
+376
+377
+378
+379
+380
+381
+382
+383
+384
+385
+386
+387
+388
+389
+390
+391
+392
+393
+394
+395
+396
+397
+398
+399
+400
+401
+402
+403
+404
+405
+406
+407
+408
+409
+410
+411
+412
+413
+414
+415
+416
+417
+418
+419
+420
+421
+422
+423
+424
+425
+426
+427
+428
+429
+430
+431
+432
+433
+434
+435
+436
+437
+438
+439
+440
+441
+442
+443
+444
+445
+446
+447
+448
+449
+450
+451
+452
+453
+454
+455
+456
+457
+458
+459
+460
+461
+462
+463
+464
+465
+466
+467
+468
+469
+470
+471
+472
+473
+474
+475
+476
+477
+478
+479
+480
+481
+482
+483
+484
+485
+486
+487
+488
+489
+490
+491
+492
+493
+494
+495
+496
+497
+498
+499
+500
+501
+502
+503
+504
+505
+506
+507
+508
+509
+510
+511
+512
+513
+514
+515
+516
+517
+518
+519
+520
+521
+522
+523
+524
+525
+526
+527
+528
+529
+530
+531
+532
+533
+534
+535
+536
+537
+538
+539
+540
+541
+542
+543
+544
+545
+546
+547
+548
+549
+550
+551
+552
+553
+554
+555
+556
+557
+558
+559
+560
+561
+562
+563
+564
+565
+566
+567
+568
+569
+570
+571
+572
+573
+574
+575
+576
+577
+578
+579
+580
+581
+582
+583
+584
+585
+586
+587
+588
+589
+590
+591
+592
+593
+594
+595
+596
+597
+598
+599
+600
+601
+602
+603
+604
+605
+606
+607
+608
+609
+610
+611
+612
+613
+614
+615
+616
+617
+618
+619
+620
+621
+622
+623
+624
+625
+626
+627
+628
+629
+630
+631
+632
+633
+634
+635
+636
+637
+638
+639
+640
+641
+642
+643
+644
+645
+646
+647
+648
+649
+650
+651
+652
+653
+654
+655
+656
+657
+658
+659
+660
+661
+662
+663
+664
+665
+666
+667
+668
+669
+670
+671
+672
+673
+674
+675
+676
+677
+678
+679
+680
+681
+682
+683
+684
+685
+686
+687
+688
+689
+690
+691
+692
+693
+694
+695
+696
+697
+698
+699
+700
+701
+702
+703
+704
+705
+706
+707
+708
+709
+710
+711
+712
+713
+714
+715
+716
+717
+718
+719
+720
+721
+722
+723
+724
+725
+726
+727
+728
+729
+730
+731
+732
+733
+734
+735
+736
+737
+738
+739
+740
+741
+742
+743
+744
+745
+746
+747
+748
+749
+750
+751
+752
+753
+754
+755
+756
+757
+758
+759
+760
+761
+762
+763
+764
+765
+766
+767
+768
+769
+770
+771
+772
+773
+774
+775
+776
+777
+778
+
+
(* SPDX-License-Identifier: AGPL-3.0-or-later *)
+(* Copyright © 2021-2024 OCamlPro *)
+(* Written by the Owi programmers *)
+
+open Types
+open Binary
+open Syntax
+open Fmt
+
+type typ =
+  | Num_type of num_type
+  | Ref_type of binary heap_type
+  | Any
+  | Something
+
+let typ_equal t1 t2 =
+  match (t1, t2) with
+  | Num_type t1, Num_type t2 -> Types.num_type_eq t1 t2
+  | Ref_type t1, Ref_type t2 -> Types.heap_type_eq t1 t2
+  | Any, _ | _, Any -> true
+  | Something, _ | _, Something -> true
+  | _, _ -> false
+
+let pp_typ fmt = function
+  | Num_type t -> pp_num_type fmt t
+  | Ref_type t -> pp_heap_type fmt t
+  | Any -> string fmt "any"
+  | Something -> string fmt "something"
+
+let pp_typ_list fmt l = list ~sep:sp pp_typ fmt l
+
+let typ_of_val_type = function
+  | Types.Ref_type (_null, t) -> Ref_type t
+  | Num_type t -> Num_type t
+
+let typ_of_pt pt = typ_of_val_type @@ snd pt
+
+module Index = struct
+  module M = Int
+  module Map = Map.Make (Int)
+  include M
+end
+
+let check_mem modul n =
+  if n >= List.length modul.mem.values then Error (`Unknown_memory (Raw n))
+  else Ok ()
+
+let check_data modul n =
+  if n >= List.length modul.data.values then Error (`Unknown_data (Raw n))
+  else Ok ()
+
+let check_align memarg_align align =
+  if Int32.ge memarg_align align then Error `Alignment_too_large else Ok ()
+
+module Env = struct
+  type t =
+    { locals : typ Index.Map.t
+    ; result_type : binary result_type
+    ; blocks : typ list list
+    ; modul : Binary.modul
+    ; refs : (int, unit) Hashtbl.t
+    }
+
+  let local_get i env =
+    match Index.Map.find_opt i env.locals with
+    | None -> Error (`Unknown_local (Raw i))
+    | Some v -> Ok v
+
+  let global_get i modul =
+    let value = Indexed.get_at i modul.global.values in
+    match value with
+    | None -> Error (`Unknown_global (Raw i))
+    | Some (Runtime.Local { typ = desc; _ } | Imported { desc; _ }) -> Ok desc
+
+  let func_get i modul =
+    let value = Indexed.get_at i modul.func.values in
+    match value with
+    | None -> Error (`Unknown_func (Raw i))
+    | Some
+        ( Runtime.Local { type_f = Bt_raw (_, t); _ }
+        | Imported { desc = Bt_raw (_, t); _ } ) ->
+      Ok t
+
+  let block_type_get i env =
+    match List.nth_opt env.blocks i with
+    | None -> Error (`Unknown_label (Raw i))
+    | Some bt -> Ok bt
+
+  let table_type_get i (modul : Binary.modul) =
+    let value = Indexed.get_at i modul.table.values in
+    match value with
+    | None -> Error (`Unknown_table (Raw i))
+    | Some (Runtime.Local (_, (_, t)) | Imported { desc = _, t; _ }) -> Ok t
+
+  let elem_type_get i env =
+    let value = Indexed.get_at i env.modul.elem.values in
+    match value with
+    | None -> Error (`Unknown_elem (Raw i))
+    | Some value -> Ok value.typ
+
+  let make ~params ~locals ~modul ~result_type ~refs =
+    let l = List.mapi (fun i v -> (i, v)) (params @ locals) in
+    let locals =
+      List.fold_left
+        (fun locals (i, (_, typ)) ->
+          let typ = typ_of_val_type typ in
+          Index.Map.add i typ locals )
+        Index.Map.empty l
+    in
+    { locals; modul; result_type; blocks = []; refs }
+end
+
+type stack = typ list
+
+let i32 = Num_type I32
+
+let i64 = Num_type I64
+
+let f32 = Num_type F32
+
+let f64 = Num_type F64
+
+let i31 = Ref_type I31_ht
+
+let any = Any
+
+let itype = function S32 -> i32 | S64 -> i64
+
+let ftype = function S32 -> f32 | S64 -> f64
+
+let arraytype _modul _i = (* TODO *) assert false
+
+module Stack : sig
+  type t = typ list
+
+  val drop : t -> t Result.t
+
+  val pop : t -> t -> t Result.t
+
+  val push : t -> t -> t Result.t
+
+  val pop_push : binary block_type -> t -> t Result.t
+
+  val pop_ref : t -> t Result.t
+
+  val equal : t -> t -> bool
+
+  val match_ref_type : binary heap_type -> binary heap_type -> bool
+
+  val match_types : typ -> typ -> bool
+
+  val pp : formatter -> t -> unit
+
+  val match_prefix : prefix:t -> stack:t -> t option
+end = struct
+  type t = typ list
+
+  let pp fmt (s : stack) = pf fmt "[%a]" pp_typ_list s
+
+  let match_num_type (required : num_type) (got : num_type) =
+    match (required, got) with
+    | I32, I32 -> true
+    | I64, I64 -> true
+    | F32, F32 -> true
+    | F64, F64 -> true
+    | _, _ -> false
+
+  let match_ref_type required got =
+    match (required, got) with
+    | Any_ht, _ -> true
+    | None_ht, None_ht -> true
+    | Eq_ht, Eq_ht -> true
+    | I31_ht, I31_ht -> true
+    | Struct_ht, Struct_ht -> true
+    | Array_ht, Array_ht -> true
+    | No_func_ht, No_func_ht -> true
+    | Func_ht, Func_ht -> true
+    | Extern_ht, Extern_ht -> true
+    | No_extern_ht, No_extern_ht -> true
+    | _ ->
+      (* TODO: complete this *)
+      false
+
+  let match_types required got =
+    match (required, got) with
+    | Something, _ | _, Something -> true
+    | Any, _ | _, Any -> true
+    | Num_type required, Num_type got -> match_num_type required got
+    | Ref_type required, Ref_type got -> match_ref_type required got
+    | Num_type _, Ref_type _ | Ref_type _, Num_type _ -> false
+
+  let rec equal s s' =
+    match (s, s') with
+    | [], s | s, [] -> List.for_all (function Any -> true | _ -> false) s
+    | Any :: tl, Any :: tl' -> equal tl s' || equal s tl'
+    | Any :: tl, hd :: tl' | hd :: tl', Any :: tl ->
+      equal tl (hd :: tl') || equal (Any :: tl) tl'
+    | hd :: tl, hd' :: tl' -> match_types hd hd' && equal tl tl'
+
+  let ( ||| ) l r = match (l, r) with None, v | v, None -> v | _l, r -> r
+
+  let rec match_prefix ~prefix ~stack =
+    match (prefix, stack) with
+    | [], stack -> Some stack
+    | _hd :: _tl, [] -> None
+    | _hd :: tl, Any :: tl' ->
+      match_prefix ~prefix ~stack:tl' ||| match_prefix ~prefix:tl ~stack
+    | hd :: tl, hd' :: tl' ->
+      if match_types hd hd' then match_prefix ~prefix:tl ~stack:tl' else None
+
+  let pop required stack =
+    match match_prefix ~prefix:required ~stack with
+    | None -> Error (`Type_mismatch "pop")
+    | Some stack -> Ok stack
+
+  let pop_ref = function
+    | (Something | Ref_type _) :: tl -> Ok tl
+    | Any :: _ as stack -> Ok stack
+    | _ -> Error (`Type_mismatch "pop_ref")
+
+  let drop stack =
+    match stack with
+    | [] -> Error (`Type_mismatch "drop")
+    | Any :: _ -> Ok [ Any ]
+    | _ :: tl -> Ok tl
+
+  let push t stack = ok @@ t @ stack
+
+  let pop_push (Bt_raw (_, (pt, rt))) stack =
+    let pt, rt = (List.rev_map typ_of_pt pt, List.rev_map typ_of_val_type rt) in
+    let* stack = pop pt stack in
+    push rt stack
+end
+
+let rec typecheck_instr (env : Env.t) (stack : stack) (instr : binary instr) :
+  stack Result.t =
+  match instr with
+  | Nop -> Ok stack
+  | Drop -> Stack.drop stack
+  | Return ->
+    let+ _stack =
+      Stack.pop (List.rev_map typ_of_val_type env.result_type) stack
+    in
+    [ any ]
+  | Unreachable -> Ok [ any ]
+  | I32_const _ -> Stack.push [ i32 ] stack
+  | I64_const _ -> Stack.push [ i64 ] stack
+  | F32_const _ -> Stack.push [ f32 ] stack
+  | F64_const _ -> Stack.push [ f64 ] stack
+  | I_unop (s, _op) ->
+    let t = itype s in
+    let* stack = Stack.pop [ t ] stack in
+    Stack.push [ t ] stack
+  | I_binop (s, _op) ->
+    let t = itype s in
+    let* stack = Stack.pop [ t; t ] stack in
+    Stack.push [ t ] stack
+  | F_unop (s, _op) ->
+    let t = ftype s in
+    let* stack = Stack.pop [ t ] stack in
+    Stack.push [ t ] stack
+  | F_binop (s, _op) ->
+    let t = ftype s in
+    let* stack = Stack.pop [ t; t ] stack in
+    Stack.push [ t ] stack
+  | I_testop (nn, _) ->
+    let* stack = Stack.pop [ itype nn ] stack in
+    Stack.push [ i32 ] stack
+  | I_relop (nn, _) ->
+    let t = itype nn in
+    let* stack = Stack.pop [ t; t ] stack in
+    Stack.push [ i32 ] stack
+  | F_relop (nn, _) ->
+    let t = ftype nn in
+    let* stack = Stack.pop [ t; t ] stack in
+    Stack.push [ i32 ] stack
+  | Local_get (Raw i) ->
+    let* t = Env.local_get i env in
+    Stack.push [ t ] stack
+  | Local_set (Raw i) ->
+    let* t = Env.local_get i env in
+    Stack.pop [ t ] stack
+  | Local_tee (Raw i) ->
+    let* t = Env.local_get i env in
+    let* stack = Stack.pop [ t ] stack in
+    Stack.push [ t ] stack
+  | Global_get (Raw i) ->
+    let* _mut, t = Env.global_get i env.modul in
+    let t = typ_of_val_type t in
+    Stack.push [ t ] stack
+  | Global_set (Raw i) ->
+    let* mut, t = Env.global_get i env.modul in
+    let* () =
+      match mut with Var -> Ok () | Const -> Error `Global_is_immutable
+    in
+    let t = typ_of_val_type t in
+    Stack.pop [ t ] stack
+  | If_else (_id, block_type, e1, e2) ->
+    let* stack = Stack.pop [ i32 ] stack in
+    let* stack_e1 = typecheck_expr env e1 ~is_loop:false block_type ~stack in
+    let+ _stack_e2 = typecheck_expr env e2 ~is_loop:false block_type ~stack in
+    stack_e1
+  | I_load8 (nn, _, memarg) ->
+    let* () = check_mem env.modul 0 in
+    let* () = check_align memarg.align 1l in
+    let* stack = Stack.pop [ i32 ] stack in
+    Stack.push [ itype nn ] stack
+  | I_load16 (nn, _, memarg) ->
+    let* () = check_mem env.modul 0 in
+    let* () = check_align memarg.align 2l in
+    let* stack = Stack.pop [ i32 ] stack in
+    Stack.push [ itype nn ] stack
+  | I_load (nn, memarg) ->
+    let* () = check_mem env.modul 0 in
+    let max_allowed = match nn with S32 -> 4l | S64 -> 8l in
+    let* () = check_align memarg.align max_allowed in
+    let* stack = Stack.pop [ i32 ] stack in
+    Stack.push [ itype nn ] stack
+  | I64_load32 (_, memarg) ->
+    let* () = check_mem env.modul 0 in
+    let* () = check_align memarg.align 4l in
+    let* stack = Stack.pop [ i32 ] stack in
+    Stack.push [ i64 ] stack
+  | I_store8 (nn, memarg) ->
+    let* () = check_mem env.modul 0 in
+    let* () = check_align memarg.align 1l in
+    Stack.pop [ itype nn; i32 ] stack
+  | I_store16 (nn, memarg) ->
+    let* () = check_mem env.modul 0 in
+    let* () = check_align memarg.align 2l in
+    Stack.pop [ itype nn; i32 ] stack
+  | I_store (nn, memarg) ->
+    let* () = check_mem env.modul 0 in
+    let max_allowed = match nn with S32 -> 4l | S64 -> 8l in
+    let* () = check_align memarg.align max_allowed in
+    Stack.pop [ itype nn; i32 ] stack
+  | I64_store32 memarg ->
+    let* () = check_mem env.modul 0 in
+    let* () = check_align memarg.align 4l in
+    Stack.pop [ i64; i32 ] stack
+  | F_load (nn, memarg) ->
+    let* () = check_mem env.modul 0 in
+    let max_allowed = match nn with S32 -> 4l | S64 -> 8l in
+    let* () = check_align memarg.align max_allowed in
+    let* stack = Stack.pop [ i32 ] stack in
+    Stack.push [ ftype nn ] stack
+  | F_store (nn, memarg) ->
+    let* () = check_mem env.modul 0 in
+    let max_allowed = match nn with S32 -> 4l | S64 -> 8l in
+    let* () = check_align memarg.align max_allowed in
+    Stack.pop [ ftype nn; i32 ] stack
+  | I_reinterpret_f (inn, fnn) ->
+    let* stack = Stack.pop [ ftype fnn ] stack in
+    Stack.push [ itype inn ] stack
+  | F_reinterpret_i (fnn, inn) ->
+    let* stack = Stack.pop [ itype inn ] stack in
+    Stack.push [ ftype fnn ] stack
+  | F32_demote_f64 ->
+    let* stack = Stack.pop [ f64 ] stack in
+    Stack.push [ f32 ] stack
+  | F64_promote_f32 ->
+    let* stack = Stack.pop [ f32 ] stack in
+    Stack.push [ f64 ] stack
+  | F_convert_i (fnn, inn, _) ->
+    let* stack = Stack.pop [ itype inn ] stack in
+    Stack.push [ ftype fnn ] stack
+  | I_trunc_f (inn, fnn, _) | I_trunc_sat_f (inn, fnn, _) ->
+    let* stack = Stack.pop [ ftype fnn ] stack in
+    Stack.push [ itype inn ] stack
+  | I32_wrap_i64 ->
+    let* stack = Stack.pop [ i64 ] stack in
+    Stack.push [ i32 ] stack
+  | I_extend8_s nn | I_extend16_s nn ->
+    let t = itype nn in
+    let* stack = Stack.pop [ t ] stack in
+    Stack.push [ t ] stack
+  | I64_extend32_s ->
+    let* stack = Stack.pop [ i64 ] stack in
+    Stack.push [ i64 ] stack
+  | I64_extend_i32 _ ->
+    let* stack = Stack.pop [ i32 ] stack in
+    Stack.push [ i64 ] stack
+  | Memory_grow ->
+    let* () = check_mem env.modul 0 in
+    let* stack = Stack.pop [ i32 ] stack in
+    Stack.push [ i32 ] stack
+  | Memory_size ->
+    let* () = check_mem env.modul 0 in
+    Stack.push [ i32 ] stack
+  | Memory_copy | Memory_fill ->
+    let* () = check_mem env.modul 0 in
+    Stack.pop [ i32; i32; i32 ] stack
+  | Memory_init (Raw id) ->
+    let* () = check_mem env.modul 0 in
+    let* () = check_data env.modul id in
+    Stack.pop [ i32; i32; i32 ] stack
+  | Block (_, bt, expr) -> typecheck_expr env expr ~is_loop:false bt ~stack
+  | Loop (_, bt, expr) -> typecheck_expr env expr ~is_loop:true bt ~stack
+  | Call_indirect (Raw tbl_id, bt) ->
+    let* _tbl_type = Env.table_type_get tbl_id env.modul in
+    let* stack = Stack.pop [ i32 ] stack in
+    Stack.pop_push bt stack
+  | Call (Raw i) ->
+    let* pt, rt = Env.func_get i env.modul in
+    let* stack = Stack.pop (List.rev_map typ_of_pt pt) stack in
+    Stack.push (List.rev_map typ_of_val_type rt) stack
+  | Call_ref _t ->
+    let+ stack = Stack.pop_ref stack in
+    (* TODO:
+       let bt = Env.type_get t env in
+         Stack.pop_push (Some bt) stack
+    *)
+    stack
+  | Return_call (Raw i) ->
+    let* pt, rt = Env.func_get i env.modul in
+    if
+      not
+        (Stack.equal
+           (List.rev_map typ_of_val_type rt)
+           (List.rev_map typ_of_val_type env.result_type) )
+    then Error (`Type_mismatch "return_call")
+    else
+      let+ _stack = Stack.pop (List.rev_map typ_of_pt pt) stack in
+      [ any ]
+  | Return_call_indirect (Raw tbl_id, Bt_raw (_, (pt, rt))) ->
+    let* _tbl_type = Env.table_type_get tbl_id env.modul in
+    if
+      not
+        (Stack.equal
+           (List.rev_map typ_of_val_type rt)
+           (List.rev_map typ_of_val_type env.result_type) )
+    then Error (`Type_mismatch "return_call_indirect")
+    else
+      let* stack = Stack.pop [ i32 ] stack in
+      let+ _stack = Stack.pop (List.rev_map typ_of_pt pt) stack in
+      [ any ]
+  | Return_call_ref (Bt_raw (_, (pt, rt))) ->
+    if
+      not
+        (Stack.equal
+           (List.rev_map typ_of_val_type rt)
+           (List.rev_map typ_of_val_type env.result_type) )
+    then Error (`Type_mismatch "return_call_ref")
+    else
+      let* stack = Stack.pop_ref stack in
+      let+ _stack = Stack.pop (List.rev_map typ_of_pt pt) stack in
+      [ any ]
+  | Data_drop (Raw id) ->
+    let* () = check_data env.modul id in
+    Ok stack
+  | Table_init (Raw ti, Raw ei) ->
+    let* table_typ = Env.table_type_get ti env.modul in
+    let* elem_typ = Env.elem_type_get ei env in
+    if not @@ Stack.match_ref_type (snd table_typ) (snd elem_typ) then
+      Error (`Type_mismatch "table_init")
+    else Stack.pop [ i32; i32; i32 ] stack
+  | Table_copy (Raw i, Raw i') ->
+    let* typ = Env.table_type_get i env.modul in
+    let* typ' = Env.table_type_get i' env.modul in
+    if not @@ Types.ref_type_eq typ typ' then Error (`Type_mismatch "table_copy")
+    else Stack.pop [ i32; i32; i32 ] stack
+  | Table_fill (Raw i) ->
+    let* _null, t = Env.table_type_get i env.modul in
+    Stack.pop [ i32; Ref_type t; i32 ] stack
+  | Table_grow (Raw i) ->
+    let* _null, t = Env.table_type_get i env.modul in
+    let* stack = Stack.pop [ i32; Ref_type t ] stack in
+    Stack.push [ i32 ] stack
+  | Table_size (Raw i) ->
+    let* _null, _t = Env.table_type_get i env.modul in
+    Stack.push [ i32 ] stack
+  | Ref_is_null ->
+    let* stack = Stack.pop_ref stack in
+    Stack.push [ i32 ] stack
+  | Ref_null rt -> Stack.push [ Ref_type rt ] stack
+  | Elem_drop (Raw id) ->
+    let* _elem_typ = Env.elem_type_get id env in
+    Ok stack
+  | Select t ->
+    let* stack = Stack.pop [ i32 ] stack in
+    begin
+      match t with
+      | None -> begin
+        match stack with
+        | Ref_type _ :: _tl -> Error (`Type_mismatch "select implicit")
+        | Any :: _ -> Ok [ Something; Any ]
+        | hd :: Any :: _ -> ok @@ (hd :: [ Any ])
+        | hd :: hd' :: tl when Stack.match_types hd hd' -> ok @@ (hd :: tl)
+        | _ -> Error (`Type_mismatch "select")
+      end
+      | Some t ->
+        let t = List.map typ_of_val_type t in
+        let* stack = Stack.pop t stack in
+        let* stack = Stack.pop t stack in
+        Stack.push t stack
+    end
+  | Ref_func (Raw i) ->
+    if not @@ Hashtbl.mem env.refs i then Error `Undeclared_function_reference
+    else Stack.push [ Ref_type Func_ht ] stack
+  | Br (Raw i) ->
+    let* jt = Env.block_type_get i env in
+    let* _stack = Stack.pop jt stack in
+    Ok [ any ]
+  | Br_if (Raw i) ->
+    let* stack = Stack.pop [ i32 ] stack in
+    let* jt = Env.block_type_get i env in
+    let* stack = Stack.pop jt stack in
+    Stack.push jt stack
+  | Br_table (branches, Raw i) ->
+    let* stack = Stack.pop [ i32 ] stack in
+    let* default_jt = Env.block_type_get i env in
+    let* _stack = Stack.pop default_jt stack in
+    let* () =
+      array_iter
+        (fun (Raw i : binary indice) ->
+          let* jt = Env.block_type_get i env in
+          if not (List.length jt = List.length default_jt) then
+            Error (`Type_mismatch "br_table")
+          else
+            let* _stack = Stack.pop jt stack in
+            Ok () )
+        branches
+    in
+    Ok [ any ]
+  | Table_get (Raw i) ->
+    let* _null, t = Env.table_type_get i env.modul in
+    let* stack = Stack.pop [ i32 ] stack in
+    Stack.push [ Ref_type t ] stack
+  | Table_set (Raw i) ->
+    let* _null, t = Env.table_type_get i env.modul in
+    Stack.pop [ Ref_type t; i32 ] stack
+  | Array_len ->
+    (* TODO: fixme, Something is not right *)
+    let* stack = Stack.pop [ Something ] stack in
+    Stack.push [ i32 ] stack
+  | Ref_i31 ->
+    let* stack = Stack.pop [ i32 ] stack in
+    Stack.push [ i31 ] stack
+  | I31_get_s | I31_get_u ->
+    let* stack = Stack.pop [ i31 ] stack in
+    Stack.push [ i32 ] stack
+  | ( Array_new_data _ | Array_new _ | Array_new_default _ | Array_new_elem _
+    | Array_new_fixed _ | Array_get _ | Array_get_u _ | Array_set _
+    | Struct_get _ | Struct_get_s _ | Struct_set _ | Struct_new _
+    | Struct_new_default _ | Extern_externalize | Extern_internalize
+    | Ref_as_non_null | Ref_cast _ | Ref_test _ | Br_on_non_null _
+    | Br_on_null _ | Br_on_cast _ | Br_on_cast_fail _ | Ref_eq ) as i ->
+    Log.debug2 "TODO (typecheck instr) %a" pp_instr i;
+    assert false
+
+and typecheck_expr env expr ~is_loop (block_type : binary block_type option)
+  ~stack:previous_stack : stack Result.t =
+  let pt, rt =
+    Option.fold ~none:([], [])
+      ~some:(fun (Bt_raw (_, (pt, rt)) : binary block_type) ->
+        (List.rev_map typ_of_pt pt, List.rev_map typ_of_val_type rt) )
+      block_type
+  in
+  let jump_type = if is_loop then pt else rt in
+  let env = { env with blocks = jump_type :: env.blocks } in
+  let* stack = list_fold_left (typecheck_instr env) pt expr in
+  if not (Stack.equal rt stack) then Error (`Type_mismatch "typecheck_expr 1")
+  else
+    match Stack.match_prefix ~prefix:pt ~stack:previous_stack with
+    | None ->
+      Error
+        (`Type_mismatch
+          (Fmt.str "expected a prefix of %a but stack has type %a" Stack.pp pt
+             Stack.pp previous_stack ) )
+    | Some stack_to_push -> Stack.push rt stack_to_push
+
+let typecheck_function (modul : modul) func refs =
+  match func with
+  | Runtime.Imported _ -> Ok ()
+  | Local func ->
+    let (Bt_raw (_, (params, result))) = func.type_f in
+    let env =
+      Env.make ~params ~modul ~locals:func.locals ~result_type:result ~refs
+    in
+    let* stack =
+      typecheck_expr env func.body ~is_loop:false
+        (Some (Bt_raw (None, ([], result))))
+        ~stack:[]
+    in
+    let required = List.rev_map typ_of_val_type result in
+    if not @@ Stack.equal required stack then
+      Error (`Type_mismatch "typecheck_function")
+    else Ok ()
+
+let typecheck_const_instr (modul : modul) refs stack = function
+  | I32_const _ -> Stack.push [ i32 ] stack
+  | I64_const _ -> Stack.push [ i64 ] stack
+  | F32_const _ -> Stack.push [ f32 ] stack
+  | F64_const _ -> Stack.push [ f64 ] stack
+  | Ref_null t -> Stack.push [ Ref_type t ] stack
+  | Ref_func (Raw i) ->
+    let* _t = Env.func_get i modul in
+    Hashtbl.add refs i ();
+    Stack.push [ Ref_type Func_ht ] stack
+  | Global_get (Raw i as idx) ->
+    let value = Indexed.get_at i modul.global.values in
+    let* mut, typ =
+      match value with
+      | None | Some (Local _) -> Error (`Unknown_global idx)
+      | Some (Imported t) -> Ok t.desc
+    in
+    let* () =
+      match mut with
+      | Const -> Ok ()
+      | Var -> Error `Constant_expression_required
+    in
+    Stack.push [ typ_of_val_type typ ] stack
+  | I_binop (t, _op) ->
+    let t = itype t in
+    let* stack = Stack.pop [ t; t ] stack in
+    Stack.push [ t ] stack
+  | Array_new t ->
+    let t = arraytype modul t in
+    let* stack = Stack.pop [ i32; t ] stack in
+    Stack.push [ Ref_type Array_ht ] stack
+  | Array_new_default _i -> assert false
+  | Ref_i31 ->
+    let* stack = Stack.pop [ i32 ] stack in
+    Stack.push [ i31 ] stack
+  | _ -> Error `Constant_expression_required
+
+let typecheck_const_expr (modul : modul) refs =
+  list_fold_left (typecheck_const_instr modul refs) []
+
+let typecheck_global (modul : modul) refs
+  (global : (global, binary global_type) Runtime.t Indexed.t) =
+  match Indexed.get global with
+  | Imported _ -> Ok ()
+  | Local { typ; init; _ } -> (
+    let* real_type = typecheck_const_expr modul refs init in
+    match real_type with
+    | [ real_type ] ->
+      let expected = typ_of_val_type @@ snd typ in
+      if not @@ typ_equal expected real_type then
+        Error (`Type_mismatch "typecheck global 1")
+      else Ok ()
+    | _whatever -> Error (`Type_mismatch "typecheck_global 2") )
+
+let typecheck_elem modul refs (elem : elem Indexed.t) =
+  let elem = Indexed.get elem in
+  let _null, expected_type = elem.typ in
+  let* () =
+    list_iter
+      (fun init ->
+        let* real_type = typecheck_const_expr modul refs init in
+        match real_type with
+        | [ real_type ] ->
+          if not @@ typ_equal (Ref_type expected_type) real_type then
+            Error (`Type_mismatch "typecheck_elem 1")
+          else Ok ()
+        | _whatever -> Error (`Type_mismatch "typecheck elem 2") )
+      elem.init
+  in
+  match elem.mode with
+  | Elem_passive | Elem_declarative -> Ok ()
+  | Elem_active (None, _e) -> assert false
+  | Elem_active (Some tbl_i, e) -> (
+    let* _null, tbl_type = Env.table_type_get tbl_i modul in
+    if not @@ Types.heap_type_eq tbl_type expected_type then
+      Error (`Type_mismatch "typecheck elem 3")
+    else
+      let* t = typecheck_const_expr modul refs e in
+      match t with
+      | [ Ref_type t ] ->
+        if not @@ Types.heap_type_eq t tbl_type then
+          Error (`Type_mismatch "typecheck_elem 4")
+        else Ok ()
+      | [ _t ] -> Ok ()
+      | _whatever -> Error (`Type_mismatch "typecheck_elem 5") )
+
+let typecheck_data modul refs (data : data Indexed.t) =
+  let data = Indexed.get data in
+  match data.mode with
+  | Data_passive -> Ok ()
+  | Data_active (n, e) -> (
+    let* () = check_mem modul n in
+    let* t = typecheck_const_expr modul refs e in
+    match t with
+    | [ _t ] -> Ok ()
+    | _whatever -> Error (`Type_mismatch "typecheck_data") )
+
+let typecheck_start { start; func; _ } =
+  match start with
+  | None -> Ok ()
+  | Some idx -> (
+    let* f =
+      match List.find_opt (Indexed.has_index idx) func.values with
+      | None -> Error (`Unknown_func (Raw idx))
+      | Some f -> Ok f
+    in
+    let pt, rt =
+      match Indexed.get f with
+      | Local { type_f = Bt_raw (_, t); _ }
+      | Imported { desc = Bt_raw (_, t); _ } ->
+        t
+    in
+    match (pt, rt) with [], [] -> Ok () | _, _ -> Error `Start_function )
+
+let validate_exports modul =
+  let* () =
+    list_iter
+      (fun { id; name = _ } ->
+        let* _t = Env.func_get id modul in
+        Ok () )
+      modul.exports.func
+  in
+  let* () =
+    list_iter
+      (fun { id; name = _ } ->
+        let* _t = Env.table_type_get id modul in
+        Ok () )
+      modul.exports.table
+  in
+  let* () =
+    list_iter
+      (fun { id; name = _ } ->
+        let* _t = Env.global_get id modul in
+        Ok () )
+      modul.exports.global
+  in
+  list_iter
+    (fun { id; name = _ } ->
+      let* () = check_mem modul id in
+      Ok () )
+    modul.exports.mem
+
+let check_limit { min; max } =
+  match max with
+  | None -> Ok ()
+  | Some max ->
+    if min > max then Error `Size_minimum_greater_than_maximum else Ok ()
+
+let validate_tables modul =
+  list_iter
+    (fun t ->
+      match Indexed.get t with
+      | Runtime.Local (_, (limits, _)) | Imported { desc = limits, _; _ } ->
+        check_limit limits )
+    modul.table.values
+
+let validate_mem modul =
+  list_iter
+    (fun t ->
+      match Indexed.get t with
+      | Runtime.Local (_, desc) | Imported { desc; _ } ->
+        let* () =
+          if desc.min > 65536 then Error `Memory_size_too_large
+          else
+            match desc.max with
+            | Some max when max > 65536 -> Error `Memory_size_too_large
+            | Some _ | None -> Ok ()
+        in
+        check_limit desc )
+    modul.mem.values
+
+let modul (modul : modul) =
+  Log.debug0 "typechecking ...@\n";
+  let refs = Hashtbl.create 512 in
+  let* () = list_iter (typecheck_global modul refs) modul.global.values in
+  let* () = list_iter (typecheck_elem modul refs) modul.elem.values in
+  let* () = list_iter (typecheck_data modul refs) modul.data.values in
+  let* () = typecheck_start modul in
+  let* () = validate_exports modul in
+  let* () = validate_tables modul in
+  let* () = validate_mem modul in
+  List.iter
+    (fun (export : export) -> Hashtbl.add refs export.id ())
+    modul.exports.func;
+  Named.fold
+    (fun _index func acc ->
+      let* () = acc in
+      typecheck_function modul func refs )
+    modul.func (Ok ())
+
+
+
+ + + diff --git a/index.mld b/index.mld index 0afe73ac6..bdd381611 100644 --- a/index.mld +++ b/index.mld @@ -11,16 +11,29 @@ Here you will only find the API documentation which is written towards people us {1:api API} {!modules: -Owi.Parse -Owi.Types -Owi.Compile +Owi.Binary +Owi.Binary_to_text Owi.Check -Owi.Typecheck -Owi.Optimize -Owi.Link -Owi.Log +Owi.Cmd_c +Owi.Cmd_conc +Owi.Cmd_fmt +Owi.Cmd_opt +Owi.Cmd_run +Owi.Cmd_script +Owi.Cmd_sym +Owi.Cmd_validate +Owi.Cmd_wasm2wat +Owi.Compile +Owi.Format Owi.Interpret +Owi.Link +Owi.Optimize +Owi.Parse +Owi.Result Owi.Script +Owi.Text +Owi.Typecheck +Owi.Types } {1:private_api Private API} @@ -29,16 +42,15 @@ You shouldn't have to use any of these modules, they're used internally only. No {!modules: Owi.Assigned -Owi.C_instrumentor -Owi.C_share +Owi.Binary_parser +Owi.Binary_types Owi.C_share_site Owi.Choice_intf -Owi.Cmd_c -Owi.Cmd_fmt -Owi.Cmd_opt -Owi.Cmd_run -Owi.Cmd_script -Owi.Cmd_sym +Owi.Cmd_utils +Owi.Concolic +Owi.Concolic_choice +Owi.Concolic_value +Owi.Concolic_wasm_ffi Owi.Concrete Owi.Concrete_choice Owi.Concrete_global @@ -49,7 +61,6 @@ Owi.Convert Owi.Env_id Owi.Float32 Owi.Float64 -Owi.Format Owi.Func_id Owi.Func_intf Owi.Grouped @@ -57,32 +68,35 @@ Owi.Imported Owi.Indexed Owi.Int32 Owi.Int64 +Owi.Interpret Owi.Interpret_intf -Owi.Lexer Owi.Link_env -Owi.Menhir_parser +Owi.Log Owi.Named -Owi.Result Owi.Rewrite Owi.Runtime -Owi.Simplified -Owi.Simplified_types +Owi.Script +Owi.Solver Owi.Symbolic Owi.Symbolic_choice +Owi.Symbolic_choice_minimalist Owi.Symbolic_global Owi.Symbolic_memory Owi.Symbolic_table Owi.Symbolic_value +Owi.Symbolic_wasm_ffi Owi.Spectest Owi.Stack Owi.String_map Owi.Syntax -Owi.Text +Owi.Text_lexer +Owi.Text_parser Owi.Thread Owi.Tracing Owi.Trap -Owi.Typecheck Owi.Value_intf Owi.V +Owi.Wasm_ffi_intf +Owi.Wq Owi.Wutf8 }