boilerplate for haskell subcommand

Author: redianthus

doc/src/manpages/owi.md

@@ -21,6 +21,10 @@ COMMANDS
        fmt [--inplace] [OPTION]… FILE…
            Format a .wat or .wast file
 
+       haskell [OPTION]… FILE…
+           Compile a Haskell file to Wasm and run the symbolic interpreter on
+           it
+
        instrument COMMAND …
            Instrument a program in various ways
 

src/bin/owi.ml

@@ -402,6 +402,22 @@ let fmt_cmd =
   and+ () = setup_log in
   Cmd_fmt.cmd ~inplace ~files
 
+(* owi haskell *)
+
+let haskell_info =
+  let doc =
+    "Compile a Haskell file to Wasm and run the symbolic interpreter on it"
+  in
+  let man = [] @ shared_man in
+  Cmd.info "haskell" ~version ~doc ~sdocs ~man
+
+let haskell_cmd =
+  let+ files
+  and+ out_file
+  and+ () = setup_log
+  and+ symbolic_parameters = symbolic_parameters (Some "_start") in
+  Cmd_haskell.cmd ~symbolic_parameters ~files ~out_file
+
 (* owi instrument *)
 
 let instrument_info =
@@ -658,6 +674,7 @@ let cli =
     ; Cmd.v fmt_info fmt_cmd
     ; Cmd.group instrument_info
         [ Cmd.v instrument_label_info instrument_label_cmd ]
+    ; Cmd.v haskell_info haskell_cmd
     ; Cmd.v iso_info iso_cmd
     ; Cmd.v replay_info replay_cmd
     ; Cmd.v run_info run_cmd

src/cmd/cmd_haskell.ml

@@ -0,0 +1,63 @@
+(* SPDX-License-Identifier: AGPL-3.0-or-later *)
+(* Copyright © 2021-2024 OCamlPro *)
+(* Written by the Owi programmers *)
+
+open Bos
+open Syntax
+
+let compile ~workspace ~out_file (files : Fpath.t list) : Fpath.t Result.t =
+  let* haskell_bin =
+    let name = "haskell" in
+    match OS.Cmd.resolve @@ Cmd.v name with
+    | Error _ ->
+      Fmt.error_msg
+        "The `%s` binary was not found, please make sure it is in your path."
+        name
+    | Ok _ as ok -> ok
+  in
+
+  let out = Option.value ~default:Fpath.(workspace / "out.wasm") out_file in
+  let haskell : Cmd.t =
+    Cmd.(
+      haskell_bin
+      (* output and input *)
+      % "-o"
+      % p out
+      %% Cmd.of_list (List.map p files)
+      (* % p libhaskell *) )
+  in
+
+  let err =
+    match Logs.Src.level Log.main_src with
+    | Some (Logs.Debug | Logs.Info) -> OS.Cmd.err_run_out
+    | None | Some _ -> OS.Cmd.err_null
+  in
+
+  let+ () =
+    Log.bench_fn "compiling time" @@ fun () ->
+    match OS.Cmd.run ~err haskell with
+    | Ok _ as v -> v
+    | Error (`Msg e) ->
+      Log.debug (fun m -> m "haskell failed: %s" e);
+      Fmt.error_msg
+        "haskell failed: run with -vv to get the full error message if it was \
+         not displayed above"
+  in
+
+  out
+
+let cmd ~(symbolic_parameters : Symbolic_parameters.t) ~files ~out_file :
+  unit Result.t =
+  let* workspace =
+    match symbolic_parameters.workspace with
+    | Some path -> Ok path
+    | None -> OS.Dir.tmp "cmd_haskell_%s"
+  in
+  let* _did_create : bool = OS.Dir.create workspace in
+
+  let* source_file = compile ~workspace ~out_file files in
+  let workspace = Some workspace in
+
+  let parameters = { symbolic_parameters with workspace } in
+
+  Cmd_sym.cmd ~parameters ~source_file

src/cmd/cmd_haskell.mli

@@ -0,0 +1,9 @@
+(* SPDX-License-Identifier: AGPL-3.0-or-later *)
+(* Copyright © 2021-2024 OCamlPro *)
+(* Written by the Owi programmers *)
+
+val cmd :
+     symbolic_parameters:Symbolic_parameters.t
+  -> files:Fpath.t list
+  -> out_file:Fpath.t option
+  -> unit Result.t

src/dune

@@ -21,6 +21,7 @@
   cmd_cfg
   cmd_cpp
   cmd_fmt
+  cmd_haskell
   cmd_instrument_label
   cmd_iso
   cmd_replay

src/owi.ml

@@ -8,6 +8,7 @@ module Cmd_call_graph = Cmd_call_graph
 module Cmd_cfg = Cmd_cfg
 module Cmd_cpp = Cmd_cpp
 module Cmd_fmt = Cmd_fmt
+module Cmd_haskell = Cmd_haskell
 module Cmd_instrument_label = Cmd_instrument_label
 module Cmd_iso = Cmd_iso
 module Cmd_replay = Cmd_replay

src/owi.mli

@@ -1336,6 +1336,14 @@ module Cmd_fmt : sig
   val cmd : inplace:bool -> files:Fpath.t list -> unit Result.t
 end
 
+module Cmd_haskell : sig
+  val cmd :
+       symbolic_parameters:Symbolic_parameters.t
+    -> files:Fpath.t list
+    -> out_file:Fpath.t option
+    -> unit Result.t
+end
+
 module Cmd_instrument_label : sig
   val cmd :
        unsafe:bool

test/help/help.t

@@ -19,6 +19,10 @@ no subcommand should print help
          fmt [--inplace] [OPTION]… FILE…
              Format a .wat or .wast file
 
+         haskell [OPTION]… FILE…
+             Compile a Haskell file to Wasm and run the symbolic interpreter on
+             it
+  
          instrument COMMAND …
              Instrument a program in various ways