Refactor IO functions and fix invalid IOs in gen_rules
This commit is contained in:
parent
9df1bad58c
commit
a3ee81055d
|
@ -302,13 +302,13 @@ module Mini_shexp = struct
|
||||||
| None -> print_string str; flush stdout
|
| None -> print_string str; flush stdout
|
||||||
| Some (_, oc) -> output_string oc str)
|
| Some (_, oc) -> output_string oc str)
|
||||||
| Cat fn ->
|
| Cat fn ->
|
||||||
with_file_in (Path.to_string fn) ~f:(fun ic ->
|
Io.with_file_in (Path.to_string fn) ~f:(fun ic ->
|
||||||
let oc =
|
let oc =
|
||||||
match stdout_to with
|
match stdout_to with
|
||||||
| None -> stdout
|
| None -> stdout
|
||||||
| Some (_, oc) -> oc
|
| Some (_, oc) -> oc
|
||||||
in
|
in
|
||||||
copy_channels ic oc);
|
Io.copy_channels ic oc);
|
||||||
return ()
|
return ()
|
||||||
| Create_file fn ->
|
| Create_file fn ->
|
||||||
let fn = Path.to_string fn in
|
let fn = Path.to_string fn in
|
||||||
|
@ -316,11 +316,11 @@ module Mini_shexp = struct
|
||||||
Unix.close (Unix.openfile fn [O_CREAT; O_TRUNC; O_WRONLY] 0o666);
|
Unix.close (Unix.openfile fn [O_CREAT; O_TRUNC; O_WRONLY] 0o666);
|
||||||
return ()
|
return ()
|
||||||
| Copy (src, dst) ->
|
| Copy (src, dst) ->
|
||||||
copy_file ~src:(Path.to_string src) ~dst:(Path.to_string dst);
|
Io.copy_file ~src:(Path.to_string src) ~dst:(Path.to_string dst);
|
||||||
return ()
|
return ()
|
||||||
| Symlink (src, dst) ->
|
| Symlink (src, dst) ->
|
||||||
if Sys.win32 then
|
if Sys.win32 then
|
||||||
copy_file ~src:(Path.to_string src) ~dst:(Path.to_string dst)
|
Io.copy_file ~src:(Path.to_string src) ~dst:(Path.to_string dst)
|
||||||
else begin
|
else begin
|
||||||
let src =
|
let src =
|
||||||
if Path.is_root dst then
|
if Path.is_root dst then
|
||||||
|
@ -340,11 +340,11 @@ module Mini_shexp = struct
|
||||||
end;
|
end;
|
||||||
return ()
|
return ()
|
||||||
| Copy_and_add_line_directive (src, dst) ->
|
| Copy_and_add_line_directive (src, dst) ->
|
||||||
with_file_in (Path.to_string src) ~f:(fun ic ->
|
Io.with_file_in (Path.to_string src) ~f:(fun ic ->
|
||||||
with_file_out (Path.to_string dst) ~f:(fun oc ->
|
Io.with_file_out (Path.to_string dst) ~f:(fun oc ->
|
||||||
let fn = Path.drop_build_context src in
|
let fn = Path.drop_build_context src in
|
||||||
Printf.fprintf oc "# 1 %S\n" (Path.to_string fn);
|
Printf.fprintf oc "# 1 %S\n" (Path.to_string fn);
|
||||||
copy_channels ic oc));
|
Io.copy_channels ic oc));
|
||||||
return ()
|
return ()
|
||||||
| System cmd ->
|
| System cmd ->
|
||||||
let path, arg =
|
let path, arg =
|
||||||
|
@ -357,10 +357,10 @@ module Mini_shexp = struct
|
||||||
["-e"; "-u"; "-o"; "pipefail"; "-c"; cmd]
|
["-e"; "-u"; "-o"; "pipefail"; "-c"; cmd]
|
||||||
| Update_file (fn, s) ->
|
| Update_file (fn, s) ->
|
||||||
let fn = Path.to_string fn in
|
let fn = Path.to_string fn in
|
||||||
if Sys.file_exists fn && read_file fn = s then
|
if Sys.file_exists fn && Io.read_file fn = s then
|
||||||
()
|
()
|
||||||
else
|
else
|
||||||
write_file fn s;
|
Io.write_file fn s;
|
||||||
return ()
|
return ()
|
||||||
| Rename (src, dst) ->
|
| Rename (src, dst) ->
|
||||||
Unix.rename (Path.to_string src) (Path.to_string dst);
|
Unix.rename (Path.to_string src) (Path.to_string dst);
|
||||||
|
@ -368,7 +368,7 @@ module Mini_shexp = struct
|
||||||
|
|
||||||
and redirect outputs fn t ~purpose ~dir ~env ~env_extra ~stdout_to ~stderr_to =
|
and redirect outputs fn t ~purpose ~dir ~env ~env_extra ~stdout_to ~stderr_to =
|
||||||
let fn = Path.to_string fn in
|
let fn = Path.to_string fn in
|
||||||
let oc = open_out_bin fn in
|
let oc = Io.open_out fn in
|
||||||
let out = Some (fn, oc) in
|
let out = Some (fn, oc) in
|
||||||
let stdout_to, stderr_to =
|
let stdout_to, stderr_to =
|
||||||
match outputs with
|
match outputs with
|
||||||
|
|
|
@ -237,8 +237,8 @@ module Build_exec = struct
|
||||||
(a, b)
|
(a, b)
|
||||||
| Paths _ -> x
|
| Paths _ -> x
|
||||||
| Paths_glob _ -> x
|
| Paths_glob _ -> x
|
||||||
| Contents p -> read_file (Path.to_string p)
|
| Contents p -> Io.read_file (Path.to_string p)
|
||||||
| Lines_of p -> lines_of_file (Path.to_string p)
|
| Lines_of p -> Io.lines_of_file (Path.to_string p)
|
||||||
| Vpath (Vspec.T (fn, kind)) ->
|
| Vpath (Vspec.T (fn, kind)) ->
|
||||||
let file : b File_spec.t = get_file bs fn (Sexp_file kind) in
|
let file : b File_spec.t = get_file bs fn (Sexp_file kind) in
|
||||||
Option.value_exn file.data
|
Option.value_exn file.data
|
||||||
|
@ -524,12 +524,12 @@ module Trace = struct
|
||||||
Sexp.List [ Atom (Path.to_string path); Atom (Digest.to_hex hash) ]))
|
Sexp.List [ Atom (Path.to_string path); Atom (Digest.to_hex hash) ]))
|
||||||
in
|
in
|
||||||
if Sys.file_exists "_build" then
|
if Sys.file_exists "_build" then
|
||||||
write_file file (Sexp.to_string sexp)
|
Io.write_file file (Sexp.to_string sexp)
|
||||||
|
|
||||||
let load () =
|
let load () =
|
||||||
let trace = Hashtbl.create 1024 in
|
let trace = Hashtbl.create 1024 in
|
||||||
if Sys.file_exists file then begin
|
if Sys.file_exists file then begin
|
||||||
let sexp = Sexp_load.single file in
|
let sexp = Sexp_lexer.Load.single file in
|
||||||
let bindings =
|
let bindings =
|
||||||
let open Sexp.Of_sexp in
|
let open Sexp.Of_sexp in
|
||||||
list (pair Path.t (fun s -> Digest.from_hex (string s))) sexp
|
list (pair Path.t (fun s -> Digest.from_hex (string s))) sexp
|
||||||
|
|
|
@ -118,7 +118,7 @@ let compare a b = compare a.name b.name
|
||||||
|
|
||||||
let get_arch_sixtyfour stdlib_dir =
|
let get_arch_sixtyfour stdlib_dir =
|
||||||
let config_h = Path.relative stdlib_dir "caml/config.h" in
|
let config_h = Path.relative stdlib_dir "caml/config.h" in
|
||||||
List.exists (lines_of_file (Path.to_string config_h)) ~f:(fun line ->
|
List.exists (Io.lines_of_file (Path.to_string config_h)) ~f:(fun line ->
|
||||||
match String.extract_blank_separated_words line with
|
match String.extract_blank_separated_words line with
|
||||||
| ["#define"; "ARCH_SIXTYFOUR"] -> true
|
| ["#define"; "ARCH_SIXTYFOUR"] -> true
|
||||||
| _ -> false)
|
| _ -> false)
|
||||||
|
|
|
@ -245,12 +245,12 @@ let run_capture_gen ?dir ?env ?(purpose=Internal_job) fail_mode prog args ~f =
|
||||||
Temp.destroy fn;
|
Temp.destroy fn;
|
||||||
x)
|
x)
|
||||||
|
|
||||||
let run_capture = run_capture_gen ~f:read_file
|
let run_capture = run_capture_gen ~f:Io.read_file
|
||||||
let run_capture_lines = run_capture_gen ~f:lines_of_file
|
let run_capture_lines = run_capture_gen ~f:Io.lines_of_file
|
||||||
|
|
||||||
let run_capture_line ?dir ?env ?(purpose=Internal_job) fail_mode prog args =
|
let run_capture_line ?dir ?env ?(purpose=Internal_job) fail_mode prog args =
|
||||||
run_capture_gen ?dir ?env ~purpose fail_mode prog args ~f:(fun fn ->
|
run_capture_gen ?dir ?env ~purpose fail_mode prog args ~f:(fun fn ->
|
||||||
match lines_of_file fn with
|
match Io.lines_of_file fn with
|
||||||
| [x] -> x
|
| [x] -> x
|
||||||
| l ->
|
| l ->
|
||||||
let cmdline =
|
let cmdline =
|
||||||
|
@ -414,7 +414,7 @@ module Scheduler = struct
|
||||||
match job.output_filename with
|
match job.output_filename with
|
||||||
| None -> ""
|
| None -> ""
|
||||||
| Some fn ->
|
| Some fn ->
|
||||||
let s = read_file fn in
|
let s = Io.read_file fn in
|
||||||
Temp.destroy fn;
|
Temp.destroy fn;
|
||||||
let len = String.length s in
|
let len = String.length s in
|
||||||
if len > 0 && s.[len - 1] <> '\n' then
|
if len > 0 && s.[len - 1] <> '\n' then
|
||||||
|
|
|
@ -1,6 +1,7 @@
|
||||||
open Import
|
open Import
|
||||||
open Jbuild_types
|
open Jbuild_types
|
||||||
open Build.O
|
open Build.O
|
||||||
|
open! No_io
|
||||||
|
|
||||||
(* +-----------------------------------------------------------------+
|
(* +-----------------------------------------------------------------+
|
||||||
| Utils |
|
| Utils |
|
||||||
|
@ -666,21 +667,22 @@ module Gen(P : Params) = struct
|
||||||
match pkg.version_from_opam_file with
|
match pkg.version_from_opam_file with
|
||||||
| Some s -> Build.return (Some s)
|
| Some s -> Build.return (Some s)
|
||||||
| None ->
|
| None ->
|
||||||
let candicates =
|
let rec loop = function
|
||||||
|
| [] -> Build.return None
|
||||||
|
| candidate :: rest ->
|
||||||
|
let p = Path.relative path candidate in
|
||||||
|
Build.if_file_exists p
|
||||||
|
~then_:(Build.lines_of p
|
||||||
|
>>^ function
|
||||||
|
| ver :: _ -> Some ver
|
||||||
|
| _ -> Some "")
|
||||||
|
~else_:(loop rest)
|
||||||
|
in
|
||||||
|
loop
|
||||||
[ pkg.name ^ ".version"
|
[ pkg.name ^ ".version"
|
||||||
; "version"
|
; "version"
|
||||||
; "VERSION"
|
; "VERSION"
|
||||||
]
|
]
|
||||||
in
|
|
||||||
match List.find candicates ~f:(fun fn -> String_set.mem fn files) with
|
|
||||||
| None -> Build.return None
|
|
||||||
| Some fn ->
|
|
||||||
let p = Path.relative path fn in
|
|
||||||
Build.path p
|
|
||||||
>>^ fun () ->
|
|
||||||
match lines_of_file (Path.to_string p) with
|
|
||||||
| ver :: _ -> Some ver
|
|
||||||
| _ -> Some ""
|
|
||||||
in
|
in
|
||||||
Super_context.Pkg_version.set sctx pkg get
|
Super_context.Pkg_version.set sctx pkg get
|
||||||
in
|
in
|
||||||
|
|
|
@ -397,43 +397,6 @@ let protectx x ~finally ~f =
|
||||||
| y -> finally x; y
|
| y -> finally x; y
|
||||||
| exception e -> finally x; raise e
|
| exception e -> finally x; raise e
|
||||||
|
|
||||||
let with_file_in ?(binary=true) fn ~f =
|
|
||||||
protectx ((if binary then open_in_bin else open_in) fn)
|
|
||||||
~finally:close_in ~f
|
|
||||||
|
|
||||||
let with_file_out ?(binary=true)fn ~f =
|
|
||||||
protectx ((if binary then open_out_bin else open_out) fn)
|
|
||||||
~finally:close_out ~f
|
|
||||||
|
|
||||||
let with_lexbuf_from_file fn ~f =
|
|
||||||
with_file_in fn ~f:(fun ic ->
|
|
||||||
let lb = Lexing.from_channel ic in
|
|
||||||
lb.lex_curr_p <-
|
|
||||||
{ pos_fname = fn
|
|
||||||
; pos_lnum = 1
|
|
||||||
; pos_bol = 0
|
|
||||||
; pos_cnum = 0
|
|
||||||
};
|
|
||||||
f lb)
|
|
||||||
|
|
||||||
let input_lines =
|
|
||||||
let rec loop ic acc =
|
|
||||||
match input_line ic with
|
|
||||||
| exception End_of_file -> List.rev acc
|
|
||||||
| line ->
|
|
||||||
loop ic (line :: acc)
|
|
||||||
in
|
|
||||||
fun ic -> loop ic []
|
|
||||||
|
|
||||||
let read_file fn =
|
|
||||||
protectx (open_in_bin fn) ~finally:close_in ~f:(fun ic ->
|
|
||||||
let len = in_channel_length ic in
|
|
||||||
really_input_string ic len)
|
|
||||||
|
|
||||||
let lines_of_file fn = with_file_in fn ~f:input_lines ~binary:false
|
|
||||||
|
|
||||||
let write_file fn data = with_file_out fn ~f:(fun oc -> output_string oc data)
|
|
||||||
|
|
||||||
exception Fatal_error of string
|
exception Fatal_error of string
|
||||||
let die_buf = Buffer.create 128
|
let die_buf = Buffer.create 128
|
||||||
let die_ppf (* Referenced in Ansi_color *) = Format.formatter_of_buffer die_buf
|
let die_ppf (* Referenced in Ansi_color *) = Format.formatter_of_buffer die_buf
|
||||||
|
@ -451,27 +414,6 @@ let warn fmt =
|
||||||
prerr_endline ("Warning: jbuild: " ^ msg))
|
prerr_endline ("Warning: jbuild: " ^ msg))
|
||||||
fmt
|
fmt
|
||||||
|
|
||||||
let copy_channels =
|
|
||||||
let buf_len = 65536 in
|
|
||||||
let buf = Bytes.create buf_len in
|
|
||||||
let rec loop ic oc =
|
|
||||||
match input ic buf 0 buf_len with
|
|
||||||
| 0 -> ()
|
|
||||||
| n -> output oc buf 0 n; loop ic oc
|
|
||||||
in
|
|
||||||
loop
|
|
||||||
|
|
||||||
let copy_file ~src ~dst =
|
|
||||||
with_file_in src ~f:(fun ic ->
|
|
||||||
let perm = (Unix.fstat (Unix.descr_of_in_channel ic)).st_perm in
|
|
||||||
protectx (open_out_gen
|
|
||||||
[Open_wronly; Open_creat; Open_trunc; Open_binary]
|
|
||||||
perm
|
|
||||||
dst)
|
|
||||||
~finally:close_out
|
|
||||||
~f:(fun oc ->
|
|
||||||
copy_channels ic oc))
|
|
||||||
|
|
||||||
module Staged : sig
|
module Staged : sig
|
||||||
type +'a t
|
type +'a t
|
||||||
val unstage : 'a t -> 'a
|
val unstage : 'a t -> 'a
|
||||||
|
@ -516,3 +458,17 @@ let hint name candidates =
|
||||||
| [] -> ""
|
| [] -> ""
|
||||||
in
|
in
|
||||||
sprintf "\nHint: did you mean %s?" (mk_hint l)
|
sprintf "\nHint: did you mean %s?" (mk_hint l)
|
||||||
|
|
||||||
|
(* Disable file operations to force to use the IO module *)
|
||||||
|
let open_in = `Use_Io
|
||||||
|
let open_in_bin = `Use_Io
|
||||||
|
let open_in_gen = `Use_Io
|
||||||
|
let open_out = `Use_Io
|
||||||
|
let open_out_bin = `Use_Io
|
||||||
|
let open_out_gen = `Use_Io
|
||||||
|
|
||||||
|
(* We open this module at the top of module generating rules, to make sure they don't do
|
||||||
|
Io manually *)
|
||||||
|
module No_io = struct
|
||||||
|
module Io = struct end
|
||||||
|
end
|
||||||
|
|
|
@ -0,0 +1,68 @@
|
||||||
|
open Import
|
||||||
|
|
||||||
|
module P = Pervasives
|
||||||
|
|
||||||
|
let open_in ?(binary=true) fn =
|
||||||
|
if binary then P.open_in_bin fn else P.open_in fn
|
||||||
|
|
||||||
|
let open_out ?(binary=true) fn =
|
||||||
|
if binary then P.open_out_bin fn else P.open_out fn
|
||||||
|
|
||||||
|
let close_in = close_in
|
||||||
|
let close_out = close_out
|
||||||
|
|
||||||
|
let with_file_in ?binary fn ~f =
|
||||||
|
protectx (open_in ?binary fn) ~finally:close_in ~f
|
||||||
|
|
||||||
|
let with_file_out ?binary fn ~f =
|
||||||
|
protectx (open_out ?binary fn) ~finally:close_out ~f
|
||||||
|
|
||||||
|
let with_lexbuf_from_file fn ~f =
|
||||||
|
with_file_in fn ~f:(fun ic ->
|
||||||
|
let lb = Lexing.from_channel ic in
|
||||||
|
lb.lex_curr_p <-
|
||||||
|
{ pos_fname = fn
|
||||||
|
; pos_lnum = 1
|
||||||
|
; pos_bol = 0
|
||||||
|
; pos_cnum = 0
|
||||||
|
};
|
||||||
|
f lb)
|
||||||
|
|
||||||
|
let input_lines =
|
||||||
|
let rec loop ic acc =
|
||||||
|
match input_line ic with
|
||||||
|
| exception End_of_file -> List.rev acc
|
||||||
|
| line ->
|
||||||
|
loop ic (line :: acc)
|
||||||
|
in
|
||||||
|
fun ic -> loop ic []
|
||||||
|
|
||||||
|
let read_file fn =
|
||||||
|
with_file_in fn ~f:(fun ic ->
|
||||||
|
let len = in_channel_length ic in
|
||||||
|
really_input_string ic len)
|
||||||
|
|
||||||
|
let lines_of_file fn = with_file_in fn ~f:input_lines ~binary:false
|
||||||
|
|
||||||
|
let write_file fn data = with_file_out fn ~f:(fun oc -> output_string oc data)
|
||||||
|
|
||||||
|
let copy_channels =
|
||||||
|
let buf_len = 65536 in
|
||||||
|
let buf = Bytes.create buf_len in
|
||||||
|
let rec loop ic oc =
|
||||||
|
match input ic buf 0 buf_len with
|
||||||
|
| 0 -> ()
|
||||||
|
| n -> output oc buf 0 n; loop ic oc
|
||||||
|
in
|
||||||
|
loop
|
||||||
|
|
||||||
|
let copy_file ~src ~dst =
|
||||||
|
with_file_in src ~f:(fun ic ->
|
||||||
|
let perm = (Unix.fstat (Unix.descr_of_in_channel ic)).st_perm in
|
||||||
|
protectx (P.open_out_gen
|
||||||
|
[Open_wronly; Open_creat; Open_trunc; Open_binary]
|
||||||
|
perm
|
||||||
|
dst)
|
||||||
|
~finally:close_out
|
||||||
|
~f:(fun oc ->
|
||||||
|
copy_channels ic oc))
|
|
@ -0,0 +1,21 @@
|
||||||
|
(** IO operations *)
|
||||||
|
|
||||||
|
val open_in : ?binary:bool (* default true *) -> string -> in_channel
|
||||||
|
val open_out : ?binary:bool (* default true *) -> string -> out_channel
|
||||||
|
|
||||||
|
val close_in : in_channel -> unit
|
||||||
|
val close_out : out_channel -> unit
|
||||||
|
|
||||||
|
val with_file_in : ?binary:bool (* default true *) -> string -> f:(in_channel -> 'a) -> 'a
|
||||||
|
val with_file_out : ?binary:bool (* default true *) -> string -> f:(out_channel -> 'a) -> 'a
|
||||||
|
|
||||||
|
val with_lexbuf_from_file : string -> f:(Lexing.lexbuf -> 'a) -> 'a
|
||||||
|
|
||||||
|
val lines_of_file : string -> string list
|
||||||
|
|
||||||
|
val read_file : string -> string
|
||||||
|
val write_file : string -> string -> unit
|
||||||
|
|
||||||
|
val copy_channels : in_channel -> out_channel -> unit
|
||||||
|
|
||||||
|
val copy_file : src:string -> dst:string -> unit
|
|
@ -31,8 +31,8 @@ module Jbuilds = struct
|
||||||
|
|
||||||
let create_plugin_wrapper (context : Context.t) ~exec_dir ~plugin ~wrapper ~target =
|
let create_plugin_wrapper (context : Context.t) ~exec_dir ~plugin ~wrapper ~target =
|
||||||
let plugin = Path.to_string plugin in
|
let plugin = Path.to_string plugin in
|
||||||
let plugin_contents = read_file plugin in
|
let plugin_contents = Io.read_file plugin in
|
||||||
with_file_out (Path.to_string wrapper) ~f:(fun oc ->
|
Io.with_file_out (Path.to_string wrapper) ~f:(fun oc ->
|
||||||
Printf.fprintf oc {|
|
Printf.fprintf oc {|
|
||||||
let () = Hashtbl.add Toploop.directive_table "require" (Toploop.Directive_string ignore)
|
let () = Hashtbl.add Toploop.directive_table "require" (Toploop.Directive_string ignore)
|
||||||
module Jbuild_plugin = struct
|
module Jbuild_plugin = struct
|
||||||
|
@ -117,7 +117,7 @@ end
|
||||||
die "@{<error>Error:@} %s failed to produce a valid jbuild file.\n\
|
die "@{<error>Error:@} %s failed to produce a valid jbuild file.\n\
|
||||||
Did you forgot to call [Jbuild_plugin.V*.send]?"
|
Did you forgot to call [Jbuild_plugin.V*.send]?"
|
||||||
(Path.to_string file);
|
(Path.to_string file);
|
||||||
let sexps = Sexp_load.many (Path.to_string generated_jbuild) in
|
let sexps = Sexp_lexer.Load.many (Path.to_string generated_jbuild) in
|
||||||
return (dir, pkgs_ctx, Stanzas.parse pkgs_ctx sexps))
|
return (dir, pkgs_ctx, Stanzas.parse pkgs_ctx sexps))
|
||||||
|> Future.all
|
|> Future.all
|
||||||
end
|
end
|
||||||
|
@ -132,7 +132,7 @@ type conf =
|
||||||
let load ~dir ~visible_packages ~closest_packages =
|
let load ~dir ~visible_packages ~closest_packages =
|
||||||
let file = Path.relative dir "jbuild" in
|
let file = Path.relative dir "jbuild" in
|
||||||
let pkgs = { Pkgs. visible_packages; closest_packages } in
|
let pkgs = { Pkgs. visible_packages; closest_packages } in
|
||||||
match Sexp_load.many_or_ocaml_script (Path.to_string file) with
|
match Sexp_lexer.Load.many_or_ocaml_script (Path.to_string file) with
|
||||||
| Sexps sexps ->
|
| Sexps sexps ->
|
||||||
Jbuilds.Literal (dir, pkgs, Stanzas.parse pkgs sexps)
|
Jbuilds.Literal (dir, pkgs, Stanzas.parse pkgs sexps)
|
||||||
| Ocaml_script ->
|
| Ocaml_script ->
|
||||||
|
@ -164,7 +164,7 @@ let load ?(extra_ignored_subtrees=Path.Set.empty) () =
|
||||||
if String_set.mem "jbuild-ignore" files then
|
if String_set.mem "jbuild-ignore" files then
|
||||||
let ignore_set =
|
let ignore_set =
|
||||||
String_set.of_list
|
String_set.of_list
|
||||||
(lines_of_file (Path.to_string (Path.relative path "jbuild-ignore")))
|
(Io.lines_of_file (Path.to_string (Path.relative path "jbuild-ignore")))
|
||||||
in
|
in
|
||||||
Dont_recurse_in
|
Dont_recurse_in
|
||||||
(ignore_set,
|
(ignore_set,
|
||||||
|
|
|
@ -1,4 +1,5 @@
|
||||||
open Import
|
open Import
|
||||||
|
open! No_io
|
||||||
|
|
||||||
module SC = Super_context
|
module SC = Super_context
|
||||||
|
|
||||||
|
|
|
@ -13,7 +13,7 @@ let no_log = None
|
||||||
let create () =
|
let create () =
|
||||||
if not (Sys.file_exists "_build") then
|
if not (Sys.file_exists "_build") then
|
||||||
Unix.mkdir "_build" 0o777;
|
Unix.mkdir "_build" 0o777;
|
||||||
let oc = open_out_bin "_build/log" in
|
let oc = Io.open_out "_build/log" in
|
||||||
Printf.fprintf oc "# %s\n%!"
|
Printf.fprintf oc "# %s\n%!"
|
||||||
(String.concat (List.map (Array.to_list Sys.argv) ~f:quote_for_shell) ~sep:" ");
|
(String.concat (List.map (Array.to_list Sys.argv) ~f:quote_for_shell) ~sep:" ");
|
||||||
let buf = Buffer.create 1024 in
|
let buf = Buffer.create 1024 in
|
||||||
|
|
|
@ -1,5 +1,6 @@
|
||||||
open Import
|
open Import
|
||||||
open Build.O
|
open Build.O
|
||||||
|
open! No_io
|
||||||
|
|
||||||
module SC = Super_context
|
module SC = Super_context
|
||||||
|
|
||||||
|
|
|
@ -103,7 +103,7 @@ module Parse = struct
|
||||||
end
|
end
|
||||||
|
|
||||||
let load fn =
|
let load fn =
|
||||||
with_lexbuf_from_file fn ~f:(fun lb ->
|
Io.with_lexbuf_from_file fn ~f:(fun lb ->
|
||||||
Parse.entries lb 0 [])
|
Parse.entries lb 0 [])
|
||||||
|
|
||||||
module Simplified = struct
|
module Simplified = struct
|
||||||
|
|
|
@ -1,5 +1,6 @@
|
||||||
open Import
|
open Import
|
||||||
open Build.O
|
open Build.O
|
||||||
|
open! No_io
|
||||||
|
|
||||||
module SC = Super_context
|
module SC = Super_context
|
||||||
|
|
||||||
|
|
|
@ -5,7 +5,7 @@ open OpamParserTypes
|
||||||
type t = opamfile
|
type t = opamfile
|
||||||
|
|
||||||
let load fn =
|
let load fn =
|
||||||
with_lexbuf_from_file fn ~f:(fun lb ->
|
Io.with_lexbuf_from_file fn ~f:(fun lb ->
|
||||||
try
|
try
|
||||||
OpamBaseParser.main OpamLexer.token lb fn
|
OpamBaseParser.main OpamLexer.token lb fn
|
||||||
with
|
with
|
||||||
|
|
|
@ -6,3 +6,9 @@ type sexps_or_ocaml_script =
|
||||||
| Ocaml_script
|
| Ocaml_script
|
||||||
|
|
||||||
val many_or_ocaml_script : Lexing.lexbuf -> sexps_or_ocaml_script
|
val many_or_ocaml_script : Lexing.lexbuf -> sexps_or_ocaml_script
|
||||||
|
|
||||||
|
module Load : sig
|
||||||
|
val single : string -> Sexp.Ast.t
|
||||||
|
val many : string -> Sexp.Ast.t list
|
||||||
|
val many_or_ocaml_script : string -> sexps_or_ocaml_script
|
||||||
|
end
|
||||||
|
|
|
@ -202,4 +202,15 @@ and is_ocaml_script = parse
|
||||||
match is_ocaml_script lexbuf with
|
match is_ocaml_script lexbuf with
|
||||||
| true -> Ocaml_script
|
| true -> Ocaml_script
|
||||||
| false -> Sexps (many lexbuf)
|
| false -> Sexps (many lexbuf)
|
||||||
|
|
||||||
|
module Load = struct
|
||||||
|
let single fn =
|
||||||
|
Io.with_lexbuf_from_file fn ~f:single
|
||||||
|
|
||||||
|
let many fn =
|
||||||
|
Io.with_lexbuf_from_file fn ~f:many
|
||||||
|
|
||||||
|
let many_or_ocaml_script fn =
|
||||||
|
Io.with_lexbuf_from_file fn ~f:many_or_ocaml_script
|
||||||
|
end
|
||||||
}
|
}
|
||||||
|
|
|
@ -1,10 +0,0 @@
|
||||||
open Import
|
|
||||||
|
|
||||||
let single fn =
|
|
||||||
with_lexbuf_from_file fn ~f:Sexp_lexer.single
|
|
||||||
|
|
||||||
let many fn =
|
|
||||||
with_lexbuf_from_file fn ~f:Sexp_lexer.many
|
|
||||||
|
|
||||||
let many_or_ocaml_script fn =
|
|
||||||
with_lexbuf_from_file fn ~f:Sexp_lexer.many_or_ocaml_script
|
|
|
@ -1,5 +0,0 @@
|
||||||
open! Import
|
|
||||||
|
|
||||||
val single : string -> Sexp.Ast.t
|
|
||||||
val many : string -> Sexp.Ast.t list
|
|
||||||
val many_or_ocaml_script : string -> Sexp_lexer.sexps_or_ocaml_script
|
|
|
@ -55,7 +55,7 @@ struct
|
||||||
let to_string path x = To_sexp.t path x |> Sexp.to_string
|
let to_string path x = To_sexp.t path x |> Sexp.to_string
|
||||||
|
|
||||||
let load path =
|
let load path =
|
||||||
Of_sexp.t path (Sexp_load.single (Path.to_string path))
|
Of_sexp.t path (Sexp_lexer.Load.single (Path.to_string path))
|
||||||
end
|
end
|
||||||
|
|
||||||
|
|
||||||
|
|
|
@ -154,7 +154,7 @@ let subst_string s ~fname ~map =
|
||||||
Some (Buffer.contents buf)
|
Some (Buffer.contents buf)
|
||||||
|
|
||||||
let subst_file fn ~map =
|
let subst_file fn ~map =
|
||||||
let s = read_file fn in
|
let s = Io.read_file fn in
|
||||||
let s =
|
let s =
|
||||||
if Filename.dirname fn = "." && String.is_suffix fn ~suffix:".opam" then
|
if Filename.dirname fn = "." && String.is_suffix fn ~suffix:".opam" then
|
||||||
"version: \"%%" ^ "VERSION_NUM" ^ "%%\"\n" ^ s
|
"version: \"%%" ^ "VERSION_NUM" ^ "%%\"\n" ^ s
|
||||||
|
@ -163,7 +163,7 @@ let subst_file fn ~map =
|
||||||
in
|
in
|
||||||
match subst_string s ~map ~fname:fn with
|
match subst_string s ~map ~fname:fn with
|
||||||
| None -> ()
|
| None -> ()
|
||||||
| Some s -> write_file fn s
|
| Some s -> Io.write_file fn s
|
||||||
|
|
||||||
let get_name ~files ?name () =
|
let get_name ~files ?name () =
|
||||||
let package_names =
|
let package_names =
|
||||||
|
|
|
@ -78,4 +78,4 @@ let t sexps =
|
||||||
; contexts = List.rev contexts
|
; contexts = List.rev contexts
|
||||||
}
|
}
|
||||||
|
|
||||||
let load fn = t (Sexp_load.many fn)
|
let load fn = t (Sexp_lexer.Load.many fn)
|
||||||
|
|
Loading…
Reference in New Issue