importe compile interface

src/ast/compile.ml

@@ -30,12 +30,12 @@ module Text = struct
     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 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 link_state ~unsafe ~optimize ~name m =
-    let* m, link_state = until_link link_state ~unsafe ~optimize ~name m in
+  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
@@ -51,19 +51,64 @@ module Binary = struct
     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 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 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 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

src/ast/compile.mli

@@ -4,6 +4,61 @@
 
 (** Utility functions to compile a module until a given step. *)
 
+module Any : sig
+  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_link :
+       unsafe:bool
+    -> optimize:bool
+    -> name:string option
+    -> 'extern_func Link.state
+    -> 'extern_func Kind.t
+    -> ('extern_func Link.module_to_run * 'extern_func Link.state) Result.t
+
+  (** compile and interpret a module with a given link state and produce a new
+      link state *)
+  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
+end
+
+module File : sig
+  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_link :
+       unsafe:bool
+    -> optimize:bool
+    -> name:string option
+    -> 'extern_func Link.state
+    -> Fpath.t
+    -> ('extern_func Link.module_to_run * 'extern_func Link.state) Result.t
+
+  (** compile and interpret a file with a given link state and produce a new
+      link state *)
+  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
+end
+
 module Text : sig
   val until_check : unsafe:bool -> Text.modul -> Text.modul Result.t
 
@@ -18,19 +73,19 @@ module Text : sig
       a runnable module *)
   val until_link :
        unsafe:bool
-    -> 'f Link.state
     -> optimize:bool
     -> name:string option
+    -> 'f Link.state
     -> Text.modul
     -> ('f Link.module_to_run * 'f Link.state) Result.t
 
   (** compile and interpret a module with a given link state and produce a new
       link state *)
   val until_interpret :
-       Concrete_value.Func.extern_func Link.state
-    -> unsafe:bool
+       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
 end
@@ -45,19 +100,19 @@ module Binary : sig
       a runnable module *)
   val until_link :
        unsafe:bool
-    -> 'f Link.state
     -> optimize:bool
     -> name:string option
+    -> 'f Link.state
     -> Binary.modul
     -> ('f Link.module_to_run * 'f Link.state) Result.t
 
   (** compile and interpret a module with a given link state and produce a new
       link state *)
   val until_interpret :
-       Concrete_value.Func.extern_func Link.state
-    -> unsafe:bool
+       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
 end

src/ast/kind.ml

@@ -0,0 +1,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

src/ast/kind.mli

@@ -0,0 +1,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

src/cmd/cmd_conc.ml

@@ -18,11 +18,9 @@ let ( let** ) (t : 'a Result.t Choice.t) (f : 'a -> 'b Result.t Choice.t) :
 let simplify_then_link ~unsafe ~optimize link_state m =
   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 concolic interpreter on a script")
-    | Either.Right binary_module -> Ok 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 =

src/cmd/cmd_opt.ml

@@ -5,23 +5,13 @@
 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
+      Format.pp_std "%a@\n" Text.pp_modul m )
     files

src/cmd/cmd_run.ml

@@ -5,24 +5,12 @@
 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+ (_ : _ 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;

src/cmd/cmd_sym.ml

@@ -20,8 +20,8 @@ let link_state =
      Link.extern_module' link_state ~name:"summaries" ~func_typ
        Symbolic_wasm_ffi.summaries_extern_module )
 
-let run_binary_modul ~unsafe ~optimize (pc : unit Result.t Choice.t)
-  (m : Binary.modul) =
+let run_file ~unsafe ~optimize pc filename =
+  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
 
@@ -33,18 +33,6 @@ let run_binary_modul ~unsafe ~optimize (pc : unit Result.t Choice.t)
   Choice.bind pc (fun r ->
       match r with Error _ -> Choice.return r | Ok () -> c )
 
-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
-
 (* 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

src/cmd/cmd_validate.ml

@@ -5,16 +5,10 @@
 open Syntax
 
 let validate filename =
-  let* modul = Parse.guess_from_file filename in
-  match modul with
-  | Either.Left (Either.Left text_module) ->
-    let+ _modul = Compile.Text.until_typecheck ~unsafe:false text_module in
-    ()
-  | Either.Left (Either.Right _text_script) ->
-    Error (`Msg "can not run validation on a script (.wast) file")
-  | Either.Right binary_module ->
-    let+ _module = Compile.Binary.until_typecheck ~unsafe:false binary_module in
-    ()
+  let+ (_modul : Binary.modul) =
+    Compile.File.until_typecheck ~unsafe:false filename
+  in
+  ()
 
 let cmd debug files =
   if debug then Log.debug_on := true;

src/dune

@@ -48,6 +48,7 @@
   int64
   interpret
   interpret_intf
+  kind
   link
   link_env
   log

src/parser/parse.ml

@@ -389,11 +389,11 @@ 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)
+    Kind.Wat m
   | ".wast" ->
     let+ m = Text.Script.from_file file in
-    Either.Left (Either.Right m)
+    Kind.Wast m
   | ".wasm" ->
     let+ m = Binary.Module.from_file file in
-    Either.Right m
+    Kind.Wasm m
   | ext -> Error (`Unsupported_file_extension ext)

src/parser/parse.mli

@@ -5,9 +5,7 @@
 (** Module providing functions to parse a wasm script from various kind of
     inputs. *)
 
-val guess_from_file :
-     Fpath.t
-  -> ((Text.modul, Text.script) Either.t, Binary.modul) Either.t Result.t
+val guess_from_file : Fpath.t -> 'extern_func Kind.t Result.t
 
 module Text : sig
   module Script : sig