more Bos and Fpath

src/bin/owi.ml

@@ -6,30 +6,16 @@ let debug =
 
 let existing_non_dir_file =
   let parse s =
-    match Sys.file_exists s with
-    | true -> begin
-      if not (Sys.is_directory s) then begin
-        match Fpath.of_string s with
-        | Ok v -> `Ok v
-        | Error (`Msg s) -> `Error s
-      end
-      else `Error (Format.sprintf "'%s' is a directory" s)
-    end
-    | false -> `Error (Format.sprintf "no file '%s'" 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)
+    | Error (`Msg s) -> `Error s
   in
   (parse, Fpath.pp)
 
 let dir_file =
-  let parse s =
-    match Sys.file_exists s with
-    | true -> begin
-      if Sys.is_directory s then begin
-        `Ok (Fpath.v s)
-      end
-      else `Error (Format.sprintf "'%s' is not a directory" s)
-    end
-    | false -> `Ok (Fpath.v s)
-  in
+  let parse s = `Ok (Fpath.v s) in
   (parse, Fpath.pp)
 
 let files =
@@ -97,7 +83,7 @@ let c_cmd =
   in
   let includes =
     let doc = "headers path" in
-    Arg.(value & opt_all dir [] & 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

src/c_instrumentor.ml

@@ -5,8 +5,15 @@ 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 file)
-    ; ("includes", Py.List.of_list @@ List.map Py.String.of_string includes)
+    [ ("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
-  ignore @@ Py.Callable.to_function_with_keywords callable [||] kwargs
+  let _ : Py.Object.t =
+    Py.Callable.to_function_with_keywords callable [||] kwargs
+  in
+  ()

src/c_instrumentor.mli

@@ -1 +1 @@
-val instrument : string -> string list -> unit
+val instrument : Fpath.t -> Fpath.t list -> unit

src/c_share.ml

@@ -1,14 +1,17 @@
-let py_location = C_share_site.Sites.pyc
+let py_location = List.map Fpath.v C_share_site.Sites.pyc
 
-let bin_location = C_share_site.Sites.binc
+let bin_location = List.map Fpath.v C_share_site.Sites.binc
 
-let lib_location = C_share_site.Sites.libc
+let lib_location = List.map Fpath.v C_share_site.Sites.libc
 
 let find location file =
   List.find_map
     (fun dir ->
-      let filename = Filename.concat dir file in
-      if Sys.file_exists filename then Some filename else None )
+      let filename = Fpath.append dir file in
+      match Bos.OS.File.exists filename with
+      | Ok true -> Some filename
+      | Ok false -> None
+      | Error (`Msg msg) -> failwith msg )
     location
 
-let get_libc () = find bin_location "libc.wasm"
+let get_libc () = find bin_location (Fpath.v "libc.wasm")

src/c_share.mli

@@ -1,7 +1,7 @@
-val py_location : string list
+val py_location : Fpath.t list
 
-val bin_location : string list
+val bin_location : Fpath.t list
 
-val lib_location : string list
+val lib_location : Fpath.t list
 
-val get_libc : unit -> string option
+val get_libc : unit -> Fpath.t option

src/cmd_c.ml

@@ -38,7 +38,7 @@ let llc bin ~bc ~obj =
 let ld bin ~flags ~out files =
   let libc = C_share.get_libc () |> Option.get in
   let files = List.fold_left (fun acc f -> Cmd.(acc % p f)) Cmd.empty files in
-  Cmd.(bin %% flags % "-o" % p out %% files % libc)
+  Cmd.(bin %% flags % "-o" % p out %% files % p libc)
 
 let wasm2wat bin0 ~out bin = Cmd.(bin0 % "-o" % p out % p bin)
 
@@ -70,7 +70,7 @@ let patch_with_regex ~patterns (data : string) : string =
     (fun data (regex, template) -> Re2.rewrite_exn regex ~template data)
     data patterns
 
-let patch ~(src : Fpath.t) ~(dst : Fpath.t) =
+let patch ~src ~dst =
   let* data = OS.File.read src in
   let data = patch_with_regex ~patterns:pre_patterns data in
   let data =
@@ -90,19 +90,24 @@ let copy ~src ~dst =
   let* () = OS.File.write dst data in
   Ok dst
 
-let instrument_file ?(skip = false) ~(includes : string list)
-  ~(workspace : Fpath.t) (file : Fpath.t) =
+let instrument_file ?(skip = false) ~includes ~workspace file =
   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 = String.concat ":" C_share.py_location 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 (Fpath.to_string dst) includes;
+        C_instrumentor.instrument dst includes;
         Py.finalize ()
       with Py.E (errtype, errvalue) ->
         let pp = Py.Object.format in
@@ -111,11 +116,10 @@ let instrument_file ?(skip = false) ~(includes : string list)
     Ok dst
   end
 
-let compile ~(deps : deps) ~(includes : string list) ~(opt_lvl : string)
-  (file : Fpath.t) =
+let compile ~deps ~includes ~opt_lvl file =
   Logs.app (fun m -> m "compiling %a" Fpath.pp file);
   let cflags =
-    let includes = Cmd.of_list ~slip:"-I" includes in
+    let includes = Cmd.of_list ~slip:"-I" (List.map Fpath.to_string includes) in
     let warnings =
       Cmd.of_list
         [ "-Wno-int-conversion"
@@ -139,7 +143,7 @@ let compile ~(deps : deps) ~(includes : string list) ~(opt_lvl : string)
   let* () = OS.Cmd.run @@ deps.llc ~bc ~obj in
   Ok obj
 
-let link ~deps ~workspace (files : Fpath.t list) =
+let link ~deps ~workspace files =
   let ldflags ~entry =
     let stack_size = 8 * (1024 * 1024) in
     Cmd.(
@@ -168,7 +172,7 @@ let pp_tm fmt Unix.{ tm_year; tm_mon; tm_mday; tm_hour; tm_min; tm_sec; _ } =
   Format.pp 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 : Fpath.t list) =
+let metadata ~workspace arch property files =
   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
@@ -208,8 +212,8 @@ let metadata ~workspace arch property (files : Fpath.t list) =
   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 : Fpath.t list) profiling unsafe optimize no_stop_at_failure =
+let cmd debug arch property testcomp workspace workers opt_lvl includes files
+  profiling unsafe optimize no_stop_at_failure =
   if debug then Logs.set_level (Some Debug);
   let workspace = Fpath.v workspace in
   let includes = C_share.lib_location @ includes in
@@ -227,8 +231,8 @@ let cmd debug arch property testcomp workspace workers opt_lvl includes
   Cmd_sym.cmd profiling debug unsafe optimize workers no_stop_at_failure
     workspace files
 
-let cmd debug arch property testcomp workspace workers opt_lvl includes
-  (files : Fpath.t list) profiling unsafe optimize no_stop_at_failure =
+let cmd debug arch property testcomp workspace workers opt_lvl includes files
+  profiling unsafe optimize no_stop_at_failure =
   let res =
     cmd debug arch property testcomp workspace workers opt_lvl includes files
       profiling unsafe optimize no_stop_at_failure

src/cmd_c.mli

@@ -6,7 +6,7 @@ val cmd :
   -> string
   -> int
   -> string
-  -> string list
+  -> Fpath.t list
   -> Fpath.t list
   -> bool
   -> bool

src/cmd_sym.ml

@@ -178,17 +178,6 @@ let get_model solver pc =
   | None -> assert false
   | Some model -> model
 
-let mkdir_p_exn (dir : Fpath.t) =
-  let rec get_intermediate_dirs (d : Fpath.t) acc =
-    if Sys.file_exists (Fpath.to_string d) then acc
-    else
-      get_intermediate_dirs
-        (Fpath.normalize d |> Fpath.split_base |> fst)
-        (d :: acc)
-  in
-  let intermediate_dirs = get_intermediate_dirs dir [] in
-  List.iter (fun d -> Sys.mkdir (Fpath.to_string d) 0o755) intermediate_dirs
-
 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
@@ -220,7 +209,11 @@ let cmd profiling debug unsafe optimize workers no_stop_at_failure
   (workspace : Fpath.t) files =
   if profiling then Log.profiling_on := true;
   if debug then Log.debug_on := true;
-  mkdir_p_exn workspace;
+  begin
+    match Bos.OS.Dir.create ~path:true ~mode:0o755 workspace with
+    | Ok true | Ok false -> ()
+    | Error (`Msg msg) -> failwith msg
+  end;
   let pc = Choice.return (Ok ()) in
   let solver = Thread.Solver.create () in
   let result = List.fold_left (run_file ~unsafe ~optimize) pc files in

src/format.ml

@@ -8,6 +8,8 @@ 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

src/format.mli

@@ -12,6 +12,8 @@ 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