matthieu
/
dune
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Invert the stdune and dsexp dependency 

Signed-off-by: Rudi Grinberg <rudi.grinberg@gmail.com>
This commit is contained in:
Rudi Grinberg 2018-08-22 02:38:11 +03:00
parent bc9e8dba1c
commit 463ee3653a
209 changed files with 1033 additions and 932 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
bin/main.ml
View File

@ -1,3 +1,4 @@
open! Stdune
open Dune
open Import
open Cmdliner
@ -1005,7 +1006,7 @@ let rules =
List.iter rules ~f:(fun (rule : Build_system.Rule.t) ->
let sexp =
let paths ps =
Dsexp.To_sexp.list Path.dgen (Path.Set.to_list ps)
Dsexp.To_sexp.list Path_dsexp.dgen (Path.Set.to_list ps)
in
Dsexp.To_sexp.record (
List.concat

2
bootstrap.ml
View File

@ -36,7 +36,7 @@ let dirs =
; "src/xdg" , Some "Xdg"
; "src/ocaml-config" , Some "Ocaml_config"
; "vendor/boot" , None
; "src/usexp" , Some "Usexp"
; "src/dsexp" , Some "Dsexp"
; "src" , None
]

15
src/action.ml
View File

@ -1,3 +1,4 @@
open! Stdune
open Import
open Dsexp.Of_sexp
@ -269,10 +270,10 @@ module Prog = struct
type t = (Path.t, Not_found.t) result
let dparse : t Dsexp.Of_sexp.t =
Dsexp.Of_sexp.map Path.dparse ~f:Result.ok
Dsexp.Of_sexp.map Path_dsexp.dparse ~f:Result.ok
let dgen = function
| Ok s -> Path.dgen s
| Ok s -> Path_dsexp.dgen s
| Error (e : Not_found.t) -> Dsexp.To_sexp.string e.program
end
@ -290,7 +291,7 @@ end
include Make_ast
(Prog)
(Path)
(Path_dsexp)
(String_with_sexp)
(Ast)
@ -384,11 +385,11 @@ module Unexpanded = struct
let check_mkdir loc path =
if not (Path.is_managed path) then
Loc.fail loc
Dloc.fail loc
"(mkdir ...) is not supported for paths outside of the workspace:\n\
\ %a\n"
(Dsexp.pp Dune)
(List [Dsexp.unsafe_atom_of_string "mkdir"; Path.dgen path])
(List [Dsexp.unsafe_atom_of_string "mkdir"; Path_dsexp.dgen path])
module Partial = struct
module Program = Unresolved.Program
@ -539,7 +540,7 @@ module Unexpanded = struct
Chdir (res, partial_expand t ~dir ~map_exe ~f)
| Right fn ->
let loc = String_with_vars.loc fn in
Loc.fail loc
Dloc.fail loc
"This directory cannot be evaluated statically.\n\
This is not allowed by dune"
end
@ -734,7 +735,7 @@ module Infer = struct
match fn with
| Left fn -> { acc with targets = Path.Set.add acc.targets fn }
| Right sw ->
Loc.fail (String_with_vars.loc sw)
Dloc.fail (String_with_vars.loc sw)
"Cannot determine this target statically."
let ( +< ) acc fn =
match fn with

1
src/action.mli
View File

@ -1,3 +1,4 @@
open! Stdune
open! Import
module Outputs : module type of struct include Action_intf.Outputs end

1
src/action_exec.ml
View File

@ -1,3 +1,4 @@
open! Stdune
open Import
open Fiber.O

2
src/action_exec.mli
View File

@ -1,4 +1,4 @@
open Stdune
open! Stdune
val exec
: targets:Path.Set.t

2
src/action_intf.ml
View File

@ -1,4 +1,4 @@
open Stdune
open! Stdune
module Outputs = struct
type t =

1
src/arg_spec.ml
View File

@ -1,3 +1,4 @@
open! Stdune
open Import
type 'a t =

1
src/arg_spec.mli
View File

@ -1,3 +1,4 @@
open! Stdune
(** Command line arguments specification *)
(** This module implements a small DSL to specify the command line

1
src/artifacts.ml
View File

@ -1,3 +1,4 @@
open! Stdune
open Import
open Dune_file

1
src/artifacts.mli
View File

@ -1,3 +1,4 @@
open! Stdune
open! Import
type t

2
src/bin.ml
View File

@ -1,4 +1,4 @@
open Import
open! Stdune
let path_sep =
if Sys.win32 then

2
src/bin.mli
View File

@ -1,6 +1,6 @@
(** OCaml binaries *)
open Stdune
open! Stdune
(** Character used to separate entries in [PATH] and similar
environment variables *)

2
src/binary_kind.ml
View File

@ -1,4 +1,4 @@
open Stdune
open! Stdune
type t =
| Exe

2
src/binary_kind.mli
View File

@ -1,6 +1,6 @@
(** Linking modes for binaries *)
open Stdune
open! Stdune
type t =
| Exe

2
src/blang.ml
View File

@ -35,7 +35,7 @@ let rec eval_bool t ~dir ~(f : 'a expander) =
begin match f.f ~mode:Single a with
| _, String "true" -> true
| _, String "false" -> false
| loc, _ -> Loc.fail loc "This value must be either true or false"
| loc, _ -> Dloc.fail loc "This value must be either true or false"
end
| And xs -> List.for_all ~f:(eval_bool ~f ~dir) xs
| Or xs -> List.exists ~f:(eval_bool ~f ~dir) xs

2
src/blang.mli
View File

@ -1,4 +1,4 @@
open Stdune
open! Stdune
module Op : sig
type t =

3
src/build.ml
View File

@ -1,3 +1,4 @@
open! Stdune
open Import
module Vspec = struct
@ -130,7 +131,7 @@ let strings p =
let read_sexp p syntax =
contents p
>>^ fun s ->
Usexp.parse_string s
Dsexp.parse_string s
~lexer:(File_tree.Dune_file.Kind.lexer syntax)
~fname:(Path.to_string p) ~mode:Single

3
src/build.mli
View File

@ -1,5 +1,6 @@
(** The build arrow *)
open! Stdune
open! Import
type ('a, 'b) t
@ -95,7 +96,7 @@ val lines_of : Path.t -> ('a, string list) t
val strings : Path.t -> ('a, string list) t
(** Load an S-expression from a file *)
val read_sexp : Path.t -> Usexp.syntax -> (unit, Dsexp.Ast.t) t
val read_sexp : Path.t -> Dsexp.syntax -> (unit, Dsexp.Ast.t) t
(** Evaluates to [true] if the file is present on the file system or is the target of a
rule. *)

9
src/build_interpret.ml
View File

@ -1,3 +1,4 @@
open! Stdune
open Import
open Build.Repr
@ -82,11 +83,11 @@ let static_deps t ~all_targets ~file_tree =
if Path.Set.is_empty result then begin
match inspect_path file_tree dir with
| None ->
Loc.warn loc "Directory %s doesn't exist."
Dloc.warn loc "Directory %s doesn't exist."
(Path.to_string_maybe_quoted
(Path.drop_optional_build_context dir))
| Some Reg ->
Loc.warn loc "%s is not a directory."
Dloc.warn loc "%s is not a directory."
(Path.to_string_maybe_quoted
(Path.drop_optional_build_context dir))
| Some Dir ->
@ -219,7 +220,7 @@ module Rule = struct
match targets with
| [] ->
begin match loc with
| Some loc -> Loc.fail loc "Rule has no targets specified"
| Some loc -> Dloc.fail loc "Rule has no targets specified"
| None -> Exn.code_error "Build_interpret.Rule.make: no targets" []
end
| x :: l ->
@ -234,7 +235,7 @@ module Rule = struct
(List.map targets ~f:Target.path)
]
| Some loc ->
Loc.fail loc
Dloc.fail loc
"Rule has targets in different directories.\nTargets:\n%s"
(String.concat ~sep:"\n"
(List.map targets ~f:(fun t ->

1
src/build_interpret.mli
View File

@ -1,3 +1,4 @@
open! Stdune
open! Import
module Target : sig

15
src/build_system.ml
View File

@ -1,3 +1,4 @@
open! Stdune
open Import
open Fiber.O
@ -239,7 +240,7 @@ module Alias0 = struct
let of_user_written_path ~loc path =
if not (Path.is_in_build_dir path) then
Loc.fail loc "Invalid alias!\n\
Dloc.fail loc "Invalid alias!\n\
Tried to reference path outside build dir: %S"
(Path.to_string_maybe_quoted path);
{ dir = Path.parent_exn path
@ -304,13 +305,13 @@ module Alias0 = struct
match File_tree.find_dir file_tree src_dir with
| None ->
Build.fail { fail = fun () ->
Loc.fail loc "Don't know about directory %s!"
Dloc.fail loc "Don't know about directory %s!"
(Path.to_string_maybe_quoted src_dir) }
| Some dir ->
dep_rec_internal ~name:t.name ~dir ~ctx_dir
>>^ fun is_empty ->
if is_empty && not (is_standard t.name) then
Loc.fail loc
Dloc.fail loc
"This alias is empty.\n\
Alias %S is not defined in %s or any of its descendants."
t.name (Path.to_string_maybe_quoted src_dir)
@ -564,7 +565,7 @@ let add_spec t fn spec ~copy_source =
| Some (File_spec.T { rule; _ }) ->
match copy_source, rule.mode with
| true, (Standard | Not_a_rule_stanza) ->
Loc.warn (Internal_rule.loc rule ~dir:(Path.parent_exn fn)
Dloc.warn (Internal_rule.loc rule ~dir:(Path.parent_exn fn)
~file_tree:t.file_tree)
"File %s is both generated by a rule and present in the source tree.\n\
As a result, the rule is currently ignored, however this will become an error \
@ -686,7 +687,7 @@ let remove_old_artifacts t ~dir ~subdirs_to_keep =
let no_rule_found =
let fail fn ~loc =
Loc.fail_opt loc "No rule found for %s" (Utils.describe_target fn)
Dloc.fail_opt loc "No rule found for %s" (Utils.describe_target fn)
in
fun t ~loc fn ->
match Utils.analyse_target fn with
@ -1067,7 +1068,7 @@ and load_dir_step2_exn t ~dir ~collector ~lazy_generators =
let present_targets =
Path.Set.diff source_files_for_targtes absent_targets
in
Loc.fail
Dloc.fail
(rule_loc
~file_tree:t.file_tree
~loc:rule.loc
@ -1276,7 +1277,7 @@ let update_universe t =
let n =
if Path.exists universe_file then
Dsexp.Of_sexp.(parse int) Univ_map.empty
(Io.Dsexp.load ~mode:Single universe_file) + 1
(Dsexp.Io.load ~mode:Single universe_file) + 1
else
0
in

1
src/build_system.mli
View File

@ -1,5 +1,6 @@
(** Build rules *)
open! Stdune
open! Import
type t

1
src/colors.ml
View File

@ -1,3 +1,4 @@
open! Stdune
open Import
type styles = Ansi_color.Style.t list

2
src/colors.mli
View File

@ -1,4 +1,4 @@
open Stdune
open! Stdune
val colorize : key:string -> string -> string

1
src/compilation_context.ml
View File

@ -1,3 +1,4 @@
open! Stdune
open Import
module SC = Super_context

1
src/compilation_context.mli
View File

@ -1,5 +1,6 @@
(** High-level API for compiling OCaml files *)
open! Stdune
open Import
(** Represent a compilation context.

3
src/config.ml
View File

@ -1,3 +1,4 @@
open! Stdune
open! Import
let local_install_dir =
@ -135,7 +136,7 @@ let load_config_file p =
| None ->
parse (enter dparse)
(Univ_map.singleton (Syntax.key syntax) (0, 0))
(Io.Dsexp.load p ~mode:Many_as_one ~lexer:Dsexp.Lexer.jbuild_token)
(Dsexp.Io.load p ~mode:Many_as_one ~lexer:Dsexp.Lexer.jbuild_token)
| Some first_line ->
parse_contents lb first_line ~f:(fun _lang -> dparse))

2
src/configurator/dune
View File

@ -3,6 +3,6 @@
(library
(name configurator)
(public_name dune.configurator)
(libraries stdune ocaml_config)
(libraries stdune ocaml_config dsexp)
(flags (:standard -safe-string (:include flags/flags.sexp)))
(preprocess no_preprocessing))

6
src/configurator/v1.ml
View File

@ -1,4 +1,4 @@
open Stdune
open! Stdune
let sprintf = Printf.sprintf
let eprintf = Printf.eprintf
@ -75,8 +75,8 @@ module Flags = struct
let write_sexp fname s =
let path = Path.in_source fname in
let sexp = Usexp.List (List.map s ~f:(fun s -> Usexp.Quoted_string s)) in
Io.write_file path (Usexp.to_string sexp ~syntax:Dune)
let sexp = Dsexp.List (List.map s ~f:(fun s -> Dsexp.Quoted_string s)) in
Io.write_file path (Dsexp.to_string sexp ~syntax:Dune)
end
module Find_in_path = struct

3
src/context.ml
View File

@ -1,3 +1,4 @@
open! Stdune
open Import
open Fiber.O
@ -451,7 +452,7 @@ let create_for_opam ?root ~env ~env_nodes ~targets ~profile ~switch ~name
["config"; "env"; "--root"; root; "--switch"; switch; "--sexp"]
>>= fun s ->
let vars =
Usexp.parse_string ~fname:"<opam output>" ~mode:Single s
Dsexp.parse_string ~fname:"<opam output>" ~mode:Single s
|> Dsexp.Of_sexp.(parse (list (pair string string)) Univ_map.empty)
|> Env.Map.of_list_multi
|> Env.Map.mapi ~f:(fun var values ->

1
src/context.mli
View File

@ -18,6 +18,7 @@
it is obtained by looking in another context.
*)
open! Stdune
open! Import
module Kind : sig

2
src/dep_path.ml
View File

@ -1,4 +1,4 @@
open Import
open! Stdune
module Entry = struct
type t =

2
src/dep_path.mli
View File

@ -1,6 +1,6 @@
(** Dependency path *)
open Stdune
open! Stdune
module Entry : sig
type t =

27
src/dir_contents.ml
View File

@ -1,3 +1,4 @@
open! Stdune
open Import
module Menhir_rules = Menhir
open Dune_file
@ -39,7 +40,7 @@ end = struct
match m with
| Ok m -> Some m
| Error s ->
Loc.fail loc "Module %a doesn't exist." Module.Name.pp s)
Dloc.fail loc "Module %a doesn't exist." Module.Name.pp s)
, modules
)
@ -100,7 +101,7 @@ end = struct
if missing_intf_only <> [] then begin
match Ordered_set_lang.loc buildable.modules_without_implementation with
| None ->
Loc.warn buildable.loc
Dloc.warn buildable.loc
"Some modules don't have an implementation.\
\nYou need to add the following field to this stanza:\
\n\
@ -121,7 +122,7 @@ end = struct
|> List.map ~f:(sprintf "- %s")
|> String.concat ~sep:"\n"
in
Loc.warn loc
Dloc.warn loc
"The following modules must be listed here as they don't \
have an implementation:\n\
%s\n\
@ -135,7 +136,7 @@ end = struct
|> Option.value_exn
in
(* CR-soon jdimino for jdimino: report all errors *)
Loc.fail loc
Dloc.fail loc
"Module %a has an implementation, it cannot be listed here"
Module.Name.pp module_name
end
@ -154,7 +155,7 @@ end = struct
)
in
Module.Name.Map.iteri fake_modules ~f:(fun m loc ->
Loc.warn loc "Module %a is excluded but it doesn't exist."
Dloc.warn loc "Module %a is excluded but it doesn't exist."
Module.Name.pp m
);
check_invalid_module_listing ~buildable:conf ~intf_only ~modules
@ -378,7 +379,7 @@ let build_modules_map (d : Super_context.Dir_with_jbuild.t) ~modules =
with
| Ok x -> x
| Error (name, _, (lib2, _)) ->
Loc.fail lib2.buildable.loc
Dloc.fail lib2.buildable.loc
"Library %S appears for the second time \
in this directory"
name
@ -390,7 +391,7 @@ let build_modules_map (d : Super_context.Dir_with_jbuild.t) ~modules =
with
| Ok x -> x
| Error (name, _, (exes2, _)) ->
Loc.fail exes2.buildable.loc
Dloc.fail exes2.buildable.loc
"Executable %S appears for the second time \
in this directory"
name
@ -416,7 +417,7 @@ let build_modules_map (d : Super_context.Dir_with_jbuild.t) ~modules =
Option.some_if (n = name) b.loc)
|> List.sort ~compare
in
Loc.fail (Loc.in_file (List.hd locs).start.pos_fname)
Dloc.fail (Loc.in_file (List.hd locs).start.pos_fname)
"Module %a is used in several stanzas:@\n\
@[<v>%a@]@\n\
@[%a@]"
@ -441,7 +442,7 @@ let build_modules_map (d : Super_context.Dir_with_jbuild.t) ~modules =
List.sort ~compare
(b.Buildable.loc :: List.map rest ~f:(fun b -> b.Buildable.loc))
in
Loc.warn (Loc.in_file b.loc.start.pos_fname)
Dloc.warn (Loc.in_file b.loc.start.pos_fname)
"Module %a is used in several stanzas:@\n\
@[<v>%a@]@\n\
@[%a@]@\n\
@ -477,7 +478,7 @@ let build_mlds_map (d : Super_context.Dir_with_jbuild.t) ~files =
| Some s ->
s
| None ->
Loc.fail loc "%s.mld doesn't exist in %s" s
Dloc.fail loc "%s.mld doesn't exist in %s" s
(Path.to_string_maybe_quoted
(Path.drop_optional_build_context dir))
)
@ -513,7 +514,7 @@ module Dir_status = struct
match stanza with
| Include_subdirs (loc, x) ->
if Option.is_some acc then
Loc.fail loc "The 'include_subdirs' stanza cannot appear \
Dloc.fail loc "The 'include_subdirs' stanza cannot appear \
more than once";
Some x
| _ -> acc)
@ -523,7 +524,7 @@ module Dir_status = struct
match stanza with
| Library { buildable; _} | Executables { buildable; _ }
| Tests { exes = { buildable; _ }; _ } ->
Loc.fail buildable.loc
Dloc.fail buildable.loc
"This stanza is not allowed in a sub-directory of directory with \
(include_subdirs unqualified).\n\
Hint: add (include_subdirs no) to this file."
@ -663,7 +664,7 @@ let rec get sctx ~dir =
~f:(fun acc (dir, files) ->
let modules = modules_of_files ~dir ~files in
Module.Name.Map.union acc modules ~f:(fun name x y ->
Loc.fail (Loc.in_file
Dloc.fail (Loc.in_file
(Path.to_string
(match File_tree.Dir.dune_file ft_dir with
| None ->

1
src/dir_contents.mli
View File

@ -4,6 +4,7 @@
in the source tree or generated by user rules to library,
executables, tests and documentation stanzas. *)
open! Stdune
open Import
type t

62
src/loc.ml → src/dloc.ml
View File

@ -1,25 +1,10 @@
open! Stdune
open Import
include Usexp.Loc
let sexp_of_position_no_file (p : Lexing.position) =
let open Sexp.To_sexp in
record
[ "pos_lnum", int p.pos_lnum
; "pos_bol", int p.pos_bol
; "pos_cnum", int p.pos_cnum
]
let sexp_of_t t =
let open Sexp.To_sexp in
record (* TODO handle when pos_fname differs *)
[ "pos_fname", string t.start.pos_fname
; "start", sexp_of_position_no_file t.start
; "stop", sexp_of_position_no_file t.stop
]
include Loc
let of_lexbuf lb =
{ start = Lexing.lexeme_start_p lb
{ Loc.start = Lexing.lexeme_start_p lb
; stop = Lexing.lexeme_end_p lb
}
@ -41,19 +26,7 @@ let fail_opt t fmt =
| None -> die fmt
| Some t -> fail t fmt
let in_file = Usexp.Loc.in_file
let of_pos (fname, lnum, cnum, enum) =
let pos : Lexing.position =
{ pos_fname = fname
; pos_lnum = lnum
; pos_cnum = cnum
; pos_bol = 0
}
in
{ start = pos
; stop = { pos with pos_cnum = enum }
}
let in_file = Loc.in_file
let file_line path n =
Io.with_file_in ~binary:false path
@ -81,7 +54,7 @@ let file_lines path ~start ~stop =
)
let print ppf loc =
let { start; stop } = loc in
let { Loc.start; stop } = loc in
let start_c = start.pos_cnum - start.pos_bol in
let stop_c = stop.pos_cnum - start.pos_bol in
let num_lines = stop.pos_lnum - start.pos_lnum in
@ -113,28 +86,3 @@ let print ppf loc =
let warn t fmt =
Errors.kerrf ~f:print_to_console
("%a@{<warning>Warning@}: " ^^ fmt ^^ "@.") print t
let to_file_colon_line t =
sprintf "%s:%d" t.start.pos_fname t.start.pos_lnum
let pp_file_colon_line ppf t =
Format.pp_print_string ppf (to_file_colon_line t)
let equal_position
{ Lexing.pos_fname = f_a; pos_lnum = l_a
; pos_bol = b_a; pos_cnum = c_a }
{ Lexing.pos_fname = f_b; pos_lnum = l_b
; pos_bol = b_b; pos_cnum = c_b }
=
let open Int.Infix in
String.equal f_a f_b
&& l_a = l_b
&& b_a = b_b
&& c_a = c_b
let equal
{ start = start_a ; stop = stop_a }
{ start = start_b ; stop = stop_b }
=
equal_position start_a start_b
&& equal_position stop_a stop_b

16
src/loc.mli → src/dloc.mli
View File

@ -1,16 +1,10 @@
open Stdune
open! Stdune
type t = Usexp.Loc.t =
type t = Loc.t =
{ start : Lexing.position
; stop : Lexing.position
}
val equal : t -> t -> bool
val sexp_of_t : t Sexp.To_sexp.t
val of_lexbuf : Lexing.lexbuf -> t
val exnf : t -> ('a, Format.formatter, unit, exn) format4 -> 'a
val fail : t -> ('a, Format.formatter, unit, 'b ) format4 -> 'a
val fail_lex : Lexing.lexbuf -> ('a, Format.formatter, unit, 'b ) format4 -> 'a
@ -18,14 +12,8 @@ val fail_opt : t option -> ('a, Format.formatter, unit, 'b ) format4 -> 'a
val in_file : string -> t
(** To be used with [__POS__] *)
val of_pos : (string * int * int * int) -> t
val none : t
val to_file_colon_line : t -> string
val pp_file_colon_line : Format.formatter -> t -> unit
(** Prints "File ..., line ..., characters ...:\n" *)
val print : Format.formatter -> t -> unit

0
src/usexp/atom.ml → src/dsexp/atom.ml
View File

0
src/usexp/atom.mli → src/dsexp/atom.mli
View File

270
src/stdune/dsexp.ml → src/dsexp/dsexp.ml
View File

@ -1,9 +1,264 @@
include Usexp
open! Stdune
module Atom = Atom
module Template = Template
type syntax = Atom.syntax = Jbuild | Dune
include Dsexp0
let atom s = Atom (Atom.of_string s)
let unsafe_atom_of_string s = atom s
let rec to_string t ~syntax =
match t with
| Atom a -> Atom.print a syntax
| Quoted_string s -> Escape.quoted s ~syntax
| List l ->
Printf.sprintf "(%s)" (List.map l ~f:(to_string ~syntax)
|> String.concat ~sep:" ")
| Template t -> Template.to_string t ~syntax
let rec pp syntax ppf = function
| Atom s ->
Format.pp_print_string ppf (Atom.print s syntax)
| Quoted_string s ->
Format.pp_print_string ppf (Escape.quoted ~syntax s)
| List [] ->
Format.pp_print_string ppf "()"
| List (first :: rest) ->
Format.pp_open_box ppf 1;
Format.pp_print_string ppf "(";
Format.pp_open_hvbox ppf 0;
pp syntax ppf first;
List.iter rest ~f:(fun sexp ->
Format.pp_print_space ppf ();
pp syntax ppf sexp);
Format.pp_close_box ppf ();
Format.pp_print_string ppf ")";
Format.pp_close_box ppf ()
| Template t -> Template.pp syntax ppf t
let pp_quoted =
let rec loop = function
| Atom (A s) as t ->
if Atom.is_valid_dune s then
t
else
Quoted_string s
| List xs -> List (List.map ~f:loop xs)
| (Quoted_string _ | Template _) as t -> t
in
fun ppf t -> pp Dune ppf (loop t)
let pp_print_quoted_string ppf s =
let syntax = Dune in
if String.contains s '\n' then begin
match String.split s ~on:'\n' with
| [] -> Format.pp_print_string ppf (Escape.quoted ~syntax s)
| first :: rest ->
Format.fprintf ppf "@[<hv 1>\"@{<atom>%s"
(Escape.escaped ~syntax first);
List.iter rest ~f:(fun s ->
Format.fprintf ppf "@,\\n%s" (Escape.escaped ~syntax s));
Format.fprintf ppf "@}\"@]"
end else
Format.pp_print_string ppf (Escape.quoted ~syntax s)
let rec pp_split_strings ppf = function
| Atom s -> Format.pp_print_string ppf (Atom.print s Atom.Dune)
| Quoted_string s -> pp_print_quoted_string ppf s
| List [] ->
Format.pp_print_string ppf "()"
| List (first :: rest) ->
Format.pp_open_box ppf 1;
Format.pp_print_string ppf "(";
Format.pp_open_hvbox ppf 0;
pp_split_strings ppf first;
List.iter rest ~f:(fun sexp ->
Format.pp_print_space ppf ();
pp_split_strings ppf sexp);
Format.pp_close_box ppf ();
Format.pp_print_string ppf ")";
Format.pp_close_box ppf ()
| Template t -> Template.pp_split_strings ppf t
type formatter_state =
| In_atom
| In_makefile_action
| In_makefile_stuff
let prepare_formatter ppf =
let state = ref [] in
Format.pp_set_mark_tags ppf true;
let ofuncs = Format.pp_get_formatter_out_functions ppf () in
let tfuncs = Format.pp_get_formatter_tag_functions ppf () in
Format.pp_set_formatter_tag_functions ppf
{ tfuncs with
mark_open_tag = (function
| "atom" -> state := In_atom :: !state; ""
| "makefile-action" -> state := In_makefile_action :: !state; ""
| "makefile-stuff" -> state := In_makefile_stuff :: !state; ""
| s -> tfuncs.mark_open_tag s)
; mark_close_tag = (function
| "atom" | "makefile-action" | "makefile-stuff" -> state := List.tl !state; ""
| s -> tfuncs.mark_close_tag s)
};
Format.pp_set_formatter_out_functions ppf
{ ofuncs with
out_newline = (fun () ->
match !state with
| [In_atom; In_makefile_action] ->
ofuncs.out_string "\\\n\t" 0 3
| [In_atom] ->
ofuncs.out_string "\\\n" 0 2
| [In_makefile_action] ->
ofuncs.out_string " \\\n\t" 0 4
| [In_makefile_stuff] ->
ofuncs.out_string " \\\n" 0 3
| [] ->
ofuncs.out_string "\n" 0 1
| _ -> assert false)
; out_spaces = (fun n ->
ofuncs.out_spaces
(match !state with
| In_atom :: _ -> max 0 (n - 2)
| _ -> n))
}
module Ast = struct
type t =
| Atom of Loc.t * Atom.t
| Quoted_string of Loc.t * string
| Template of Template.t
| List of Loc.t * t list
let atom_or_quoted_string loc s =
match atom_or_quoted_string s with
| Atom a -> Atom (loc, a)
| Quoted_string s -> Quoted_string (loc, s)
| Template _
| List _ -> assert false
let loc (Atom (loc, _) | Quoted_string (loc, _) | List (loc, _)
| Template { loc ; _ }) = loc
let rec remove_locs t : Dsexp0.t =
match t with
| Template t -> Template (Template.remove_locs t)
| Atom (_, s) -> Atom s
| Quoted_string (_, s) -> Quoted_string s
| List (_, l) -> List (List.map l ~f:remove_locs)
end
let rec add_loc t ~loc : Ast.t =
match t with
| Atom s -> Atom (loc, s)
| Quoted_string s -> Quoted_string (loc, s)
| List l -> List (loc, List.map l ~f:(add_loc ~loc))
| Template t -> Template { t with loc }
module Parse_error = struct
include Lexer.Error
let loc t : Loc.t = { start = t.start; stop = t.stop }
let message t = t.message
end
exception Parse_error = Lexer.Error
module Lexer = Lexer
module Parser = struct
let error (loc : Loc.t) message =
raise (Parse_error
{ start = loc.start
; stop = loc.stop
; message
})
module Mode = struct
type 'a t =
| Single : Ast.t t
| Many : Ast.t list t
| Many_as_one : Ast.t t
let make_result : type a. a t -> Lexing.lexbuf -> Ast.t list -> a
= fun t lexbuf sexps ->
match t with
| Single -> begin
match sexps with
| [sexp] -> sexp
| [] -> error (Loc.of_lexbuf lexbuf) "no s-expression found in input"
| _ :: sexp :: _ ->
error (Ast.loc sexp) "too many s-expressions found in input"
end
| Many -> sexps
| Many_as_one ->
match sexps with
| [] -> List (Loc.in_file lexbuf.lex_curr_p.pos_fname, [])
| x :: l ->
let last = List.fold_left l ~init:x ~f:(fun _ x -> x) in
let loc = { (Ast.loc x) with stop = (Ast.loc last).stop } in
List (loc, x :: l)
end
let rec loop depth lexer lexbuf acc =
match (lexer lexbuf : Lexer.Token.t) with
| Atom a ->
let loc = Loc.of_lexbuf lexbuf in
loop depth lexer lexbuf (Ast.Atom (loc, a) :: acc)
| Quoted_string s ->
let loc = Loc.of_lexbuf lexbuf in
loop depth lexer lexbuf (Quoted_string (loc, s) :: acc)
| Template t ->
let loc = Loc.of_lexbuf lexbuf in
loop depth lexer lexbuf (Template { t with loc } :: acc)
| Lparen ->
let start = Lexing.lexeme_start_p lexbuf in
let sexps = loop (depth + 1) lexer lexbuf [] in
let stop = Lexing.lexeme_end_p lexbuf in
loop depth lexer lexbuf (List ({ start; stop }, sexps) :: acc)
| Rparen ->
if depth = 0 then
error (Loc.of_lexbuf lexbuf)
"right parenthesis without matching left parenthesis";
List.rev acc
| Sexp_comment ->
let sexps =
let loc = Loc.of_lexbuf lexbuf in
match loop depth lexer lexbuf [] with
| _ :: sexps -> sexps
| [] -> error loc "s-expression missing after #;"
in
List.rev_append acc sexps
| Eof ->
if depth > 0 then
error (Loc.of_lexbuf lexbuf)
"unclosed parenthesis at end of input";
List.rev acc
let parse ~mode ?(lexer=Lexer.token) lexbuf =
loop 0 lexer lexbuf []
|> Mode.make_result mode lexbuf
end
let parse_string ~fname ~mode ?lexer str =
let lb = Lexing.from_string str in
lb.lex_curr_p <-
{ pos_fname = fname
; pos_lnum = 1
; pos_bol = 0
; pos_cnum = 0
};
Parser.parse ~mode ?lexer lb
type dsexp = t
module To_sexp = struct
type nonrec 'a t = 'a -> t
let unit () = List []
let string = Usexp.atom_or_quoted_string
let string = atom_or_quoted_string
let atom = string
let int n = Atom (Atom.of_int n)
let float f = Atom (Atom.of_float f)
@ -24,7 +279,7 @@ module To_sexp = struct
(Hashtbl.foldi h ~init:String.Map.empty ~f:(fun key data acc ->
String.Map.add acc key data))
type field = string * Usexp.t option
type field = string * dsexp option
let field name f ?(equal=(=)) ?default v =
match default with
@ -543,7 +798,7 @@ module Of_sexp = struct
let field_b ?check ?on_dup name =
field name ~default:false ?on_dup
(Option.value check ~default:(return ()) >>= fun () ->
eos >>= function
eos >>= function
| true -> return true
| _ -> bool)
@ -616,5 +871,10 @@ let rec sexp_of_t = function
| Template t ->
List
[ Atom "template"
; Atom (Usexp.Template.to_string ~syntax:Dune t)
; Atom (Template.to_string ~syntax:Dune t)
]
module Io = struct
let load ?lexer path ~mode =
Io.with_lexbuf_from_file path ~f:(Parser.parse ~mode ?lexer)
end

157
src/stdune/dsexp.mli → src/dsexp/dsexp.mli
View File

@ -1,4 +1,151 @@
include module type of struct include Usexp end with module Loc := Usexp.Loc
open! Stdune
(** Parsing of s-expressions.
This library is internal to jbuilder and guarantees no API stability.*)
type syntax = Jbuild | Dune
module Atom : sig
type t = private A of string [@@unboxed]
val is_valid : t -> syntax -> bool
val of_string : string -> t
val to_string : t -> string
val of_int : int -> t
val of_float : float -> t
val of_bool : bool -> t
val of_int64 : Int64.t -> t
val of_digest : Digest.t -> t
end
module Template : sig
type var_syntax = Dollar_brace | Dollar_paren | Percent
type var =
{ loc: Loc.t
; name: string
; payload: string option
; syntax: var_syntax
}
type part =
| Text of string
| Var of var
type t =
{ quoted: bool
; parts: part list
; loc: Loc.t
}
val string_of_var : var -> string
val to_string : t -> syntax:syntax -> string
end
(** The S-expression type *)
type t =
| Atom of Atom.t
| Quoted_string of string
| List of t list
| Template of Template.t
val atom : string -> t
(** [atom s] convert the string [s] to an Atom.
@raise Invalid_argument if [s] does not satisfy [Atom.is_valid s]. *)
val atom_or_quoted_string : string -> t
val unsafe_atom_of_string : string -> t
(** Serialize a S-expression *)
val to_string : t -> syntax:syntax -> string
(** Serialize a S-expression using indentation to improve readability *)
val pp : syntax -> Format.formatter -> t -> unit
(** Serialization that never fails because it quotes atoms when necessary
TODO remove this once we have a proper sexp type *)
val pp_quoted : Format.formatter -> t -> unit
(** Same as [pp ~syntax:Dune], but split long strings. The formatter
must have been prepared with [prepare_formatter]. *)
val pp_split_strings : Format.formatter -> t -> unit
(** Prepare a formatter for [pp_split_strings]. Additionaly the
formatter escape newlines when the tags "makefile-action" or
"makefile-stuff" are active. *)
val prepare_formatter : Format.formatter -> unit
(** Abstract syntax tree *)
module Ast : sig
type sexp = t
type t =
| Atom of Loc.t * Atom.t
| Quoted_string of Loc.t * string
| Template of Template.t
| List of Loc.t * t list
val atom_or_quoted_string : Loc.t -> string -> t
val loc : t -> Loc.t
val remove_locs : t -> sexp
end with type sexp := t
val add_loc : t -> loc:Loc.t -> Ast.t
module Parse_error : sig
type t
val loc : t -> Loc.t
val message : t -> string
end
(** Exception raised in case of a parsing error *)
exception Parse_error of Parse_error.t
module Lexer : sig
module Token : sig
type t =
| Atom of Atom.t
| Quoted_string of string
| Lparen
| Rparen
| Sexp_comment
| Eof
| Template of Template.t
end
type t = Lexing.lexbuf -> Token.t
val token : t
val jbuild_token : t
end
module Parser : sig
module Mode : sig
type 'a t =
| Single : Ast.t t
| Many : Ast.t list t
| Many_as_one : Ast.t t
end
val parse
: mode:'a Mode.t
-> ?lexer:Lexer.t
-> Lexing.lexbuf
-> 'a
end
val parse_string
: fname:string
-> mode:'a Parser.Mode.t
-> ?lexer:Lexer.t
-> string
-> 'a
module To_sexp : sig
type sexp = t
@ -22,8 +169,6 @@ module To_sexp : sig
val unknown : _ t
end with type sexp := t
module Loc = Usexp.Loc
module Of_sexp : sig
type ast = Ast.t =
| Atom of Loc.t * Atom.t
@ -101,7 +246,7 @@ module Of_sexp : sig
-> 'a t
(** If the next element of the sequence is of the form [(:<name>
...)], use [then_] to parse [...]. Otherwise use [else_]. *)
...)], use [then_] to parse [...]. Otherwise use [else_]. *)
val if_paren_colon_form
: then_:(Loc.t * string -> 'a) t
-> else_:'a t
@ -257,3 +402,7 @@ module type Sexpable = sig
end
val sexp_of_t : t Sexp.To_sexp.t
module Io : sig
val load : ?lexer:Lexer.t -> Path.t -> mode:'a Parser.Mode.t -> 'a
end

0
src/usexp/sexp.ml → src/dsexp/dsexp0.ml
View File

0
src/usexp/sexp.mli → src/dsexp/dsexp0.mli
View File

5
src/usexp/dune → src/dsexp/dune
View File

@ -1,6 +1,7 @@
(library
(name usexp)
(name dsexp)
(synopsis "[Internal] S-expression library")
(public_name dune._usexp))
(libraries stdune)
(public_name dune._dsexp))
(ocamllex dune_lexer jbuild_lexer)

0
src/usexp/dune_lexer.mli → src/dsexp/dune_lexer.mli
View File

1
src/usexp/dune_lexer.mll → src/dsexp/dune_lexer.mll
View File

@ -1,4 +1,5 @@
{
open! Stdune
open Lexer_shared
type block_string_line_kind =

2
src/usexp/escape.ml → src/dsexp/escape.ml
View File

@ -1,4 +1,4 @@
open Import
open! Stdune
let quote_length s ~syntax =
let n = ref 0 in

0
src/usexp/escape.mli → src/dsexp/escape.mli
View File

0
src/usexp/jbuild_lexer.boot.ml → src/dsexp/jbuild_lexer.boot.ml
View File

0
src/usexp/jbuild_lexer.mli → src/dsexp/jbuild_lexer.mli
View File

0
src/usexp/jbuild_lexer.mll → src/dsexp/jbuild_lexer.mll
View File

0
src/usexp/lexer.ml → src/dsexp/lexer.ml
View File

0
src/usexp/lexer.mli → src/dsexp/lexer.mli
View File

0
src/usexp/lexer_shared.ml → src/dsexp/lexer_shared.ml
View File

0
src/usexp/lexer_shared.mli → src/dsexp/lexer_shared.mli
View File

4
src/usexp/template.ml → src/dsexp/template.ml
View File

@ -1,4 +1,4 @@
open Import
open! Stdune
include Types.Template
@ -76,7 +76,7 @@ let pp_split_strings ppf (t : t) =
| Var s ->
Format.pp_print_string ppf (string_of_var s)
| Text s ->
begin match String.split_on_char s ~on:'\n' with
begin match String.split s ~on:'\n' with
| [] -> assert false
| [s] -> Format.pp_print_string ppf (Escape.escaped ~syntax s)
| split ->

2
src/usexp/template.mli → src/dsexp/template.mli
View File

@ -1,3 +1,5 @@
open! Stdune
type var_syntax = Types.Template.var_syntax =
| Dollar_brace
| Dollar_paren

2
src/usexp/types.ml → src/dsexp/types.ml
View File

@ -1,3 +1,5 @@
open! Stdune
module Template = struct
type var_syntax = Dollar_brace | Dollar_paren | Percent

2
src/dune
View File

@ -6,7 +6,7 @@
xdg
re
opam_file_format
usexp
dsexp
ocaml_config
which_program)
(synopsis "Internal Dune library, do not use!")

1
src/dune_env.ml
View File

@ -1,3 +1,4 @@
open! Stdune
type stanza = Stanza.t = ..
module Stanza = struct

2
src/dune_env.mli
View File

@ -1,4 +1,4 @@
open Import
open! Stdune
type stanza = Stanza.t = ..

27
src/dune_file.ml
View File

@ -1,3 +1,4 @@
open! Stdune
open Import
open Stanza.Of_sexp
@ -78,9 +79,9 @@ end = struct
let validate (loc, res) ~wrapped =
match res, wrapped with
| Ok s, _ -> s
| Warn _, true -> Loc.fail loc "%s" wrapped_message
| Warn s, false -> Loc.warn loc "%s" wrapped_message; s
| Invalid, _ -> Loc.fail loc "%s" invalid_message
| Warn _, true -> Dloc.fail loc "%s" wrapped_message
| Warn s, false -> Dloc.warn loc "%s" wrapped_message; s
| Invalid, _ -> Dloc.fail loc "%s" invalid_message
let valid_char = function
| 'A'..'Z' | 'a'..'z' | '_' | '0'..'9' -> true
@ -215,7 +216,7 @@ module Pkg = struct
and (loc, name) = located Package.Name.dparse in
match resolve p name with
| Ok x -> x
| Error e -> Loc.fail loc "%s" e
| Error e -> Dloc.fail loc "%s" e
let field stanza =
map_validate
@ -1252,7 +1253,7 @@ module Executables = struct
let mode_to_string mode =
" - " ^ Dsexp.to_string ~syntax:Dune (Link_mode.dgen mode) in
let mode_strings = List.map ~f:mode_to_string Link_mode.installable_modes in
Loc.fail
Dloc.fail
buildable.loc
"No installable mode found for %s.\n\
One of the following modes is required:\n\
@ -1288,8 +1289,8 @@ module Executables = struct
| Some (loc, _) ->
let func =
match file_kind with
| Jbuild -> Loc.warn
| Dune -> Loc.fail
| Jbuild -> Dloc.warn
| Dune -> Dloc.fail
in
func loc
"This field is useless without a (public_name%s ...) field."
@ -1856,11 +1857,11 @@ module Stanzas = struct
let dir = Path.parent_exn current_file in
let current_file = Path.relative dir fn in
if not (Path.exists current_file) then
Loc.fail loc "File %s doesn't exist."
Dloc.fail loc "File %s doesn't exist."
(Path.to_string_maybe_quoted current_file);
if List.exists include_stack ~f:(fun (_, f) -> Path.equal f current_file) then
raise (Include_loop (current_file, include_stack));
let sexps = Io.Dsexp.load ~lexer current_file ~mode:Many in
let sexps = Dsexp.Io.load ~lexer current_file ~mode:Many in
parse stanza_parser sexps ~lexer ~current_file ~include_stack
| stanza -> [stanza])
@ -1868,8 +1869,8 @@ module Stanzas = struct
let (stanza_parser, lexer) =
let (parser, lexer) =
match (kind : File_tree.Dune_file.Kind.t) with
| Jbuild -> (jbuild_parser, Usexp.Lexer.jbuild_token)
| Dune -> (Dune_project.stanza_parser project, Usexp.Lexer.token)
| Jbuild -> (jbuild_parser, Dsexp.Lexer.jbuild_token)
| Dune -> (Dune_project.stanza_parser project, Dsexp.Lexer.token)
in
(Dune_project.set project parser, lexer)
in
@ -1885,7 +1886,7 @@ module Stanzas = struct
(Path.to_string_maybe_quoted file)
loc.Loc.start.pos_lnum
in
Loc.fail loc
Dloc.fail loc
"Recursive inclusion of jbuild files detected:\n\
File %s is included from %s%s"
(Path.to_string_maybe_quoted file)
@ -1901,6 +1902,6 @@ module Stanzas = struct
~f:(function Dune_env.T e -> Some e | _ -> None)
with
| _ :: e :: _ ->
Loc.fail e.loc "The 'env' stanza cannot appear more than once"
Dloc.fail e.loc "The 'env' stanza cannot appear more than once"
| _ -> stanzas
end

1
src/dune_file.mli
View File

@ -1,5 +1,6 @@
(** Representation and parsing of jbuild files *)
open! Stdune
open Import
(** Ppx preprocessors *)

29
src/dune_fmt.ml
View File

@ -1,3 +1,4 @@
open! Stdune
open! Import
let parse_file path_opt =
@ -15,18 +16,18 @@ let parse_file path_opt =
in
Dsexp.parse_string
~fname
~mode:Usexp.Parser.Mode.Many
~mode:Dsexp.Parser.Mode.Many
contents
let can_be_displayed_inline =
List.for_all ~f:(function
| Usexp.Atom _
| Usexp.Quoted_string _
| Usexp.Template _
| Usexp.List [_]
| Dsexp.Atom _
| Dsexp.Quoted_string _
| Dsexp.Template _
| Dsexp.List [_]
->
true
| Usexp.List _
| Dsexp.List _
->
false
)
@ -42,21 +43,21 @@ let print_inline_list fmt indent sexps =
first := false
else
Format.pp_print_string fmt " ";
Usexp.pp Usexp.Dune fmt sexp
Dsexp.pp Dsexp.Dune fmt sexp
);
Format.pp_print_string fmt ")"
let rec pp_sexp indent fmt =
function
( Usexp.Atom _
| Usexp.Quoted_string _
| Usexp.Template _
( Dsexp.Atom _
| Dsexp.Quoted_string _
| Dsexp.Template _
) as sexp
->
Format.fprintf fmt "%a%a"
pp_indent indent
(Usexp.pp Usexp.Dune) sexp
| Usexp.List sexps
(Dsexp.pp Dsexp.Dune) sexp
| Dsexp.List sexps
->
if can_be_displayed_inline sexps then
print_inline_list fmt indent sexps
@ -110,10 +111,10 @@ let with_output path_opt k =
let format_file ~input ~output =
match parse_file input with
| exception Usexp.Parse_error e ->
| exception Dsexp.Parse_error e ->
Printf.printf
"Parse error: %s\n"
(Usexp.Parse_error.message e)
(Dsexp.Parse_error.message e)
| sexps ->
with_output output (fun fmt ->
pp_top_sexps fmt sexps;

2
src/dune_lexer.mli
View File

@ -1,3 +1,5 @@
open! Stdune
(** Returns [true] if the input starts with "(* -*- tuareg -*- *)" *)
val is_script : Lexing.lexbuf -> bool

3
src/dune_lexer.mll
View File

@ -1,4 +1,5 @@
{
open! Stdune
type first_line =
{ lang : Loc.t * string
; version : Loc.t * string
@ -11,7 +12,7 @@ let make_loc lexbuf : Loc.t =
let invalid_lang_line start lexbuf =
lexbuf.Lexing.lex_start_p <- start;
Loc.fail_lex lexbuf
Dloc.fail_lex lexbuf
"Invalid first line, expected: (lang <lang> <version>)"
}

7
src/dune_project.ml
View File

@ -1,3 +1,4 @@
open! Stdune
open Import
open Dsexp.Of_sexp
@ -224,7 +225,7 @@ module Extension = struct
let instantiate ~loc ~parse_args (name_loc, name) (ver_loc, ver) =
match Hashtbl.find extensions name with
| None ->
Loc.fail name_loc "Unknown extension %S.%s" name
Dloc.fail name_loc "Unknown extension %S.%s" name
(hint name (Hashtbl.keys extensions))
| Some t ->
Syntax.check_supported t.syntax (ver_loc, ver);
@ -330,7 +331,7 @@ let default_name ~dir ~packages =
match Name.named name with
| Some x -> x
| None ->
Loc.fail (Loc.in_file (Path.to_string (Package.opam_file pkg)))
Dloc.fail (Loc.in_file (Path.to_string (Package.opam_file pkg)))
"%S is not a valid opam package name."
name
@ -361,7 +362,7 @@ let parse ~dir ~lang ~packages ~file =
(Syntax.name e.extension.syntax, e.loc)))
with
| Error (name, _, loc) ->
Loc.fail loc "Extension %S specified for the second time." name
Dloc.fail loc "Extension %S specified for the second time." name
| Ok map ->
let project_file : Project_file.t = { file; exists = true } in
let extensions =

1
src/dune_project.mli
View File

@ -1,3 +1,4 @@
open! Stdune
(** dune-project files *)
open Import

1
src/env.ml
View File

@ -1,3 +1,4 @@
open! Stdune
open Import
module Var = struct

2
src/env.mli
View File

@ -1,4 +1,4 @@
open Import
open! Stdune
module Var : sig
type t = string

2
src/errors.ml
View File

@ -1,4 +1,4 @@
open Stdune
open! Stdune
exception Already_reported

1
src/exe.ml
View File

@ -1,3 +1,4 @@
open! Stdune
open Import
open Build.O

2
src/fiber/fiber.ml
View File

@ -1,4 +1,4 @@
open Stdune
open! Stdune
module Execution_context : sig
type t

2
src/fiber/fiber.mli
View File

@ -1,6 +1,6 @@
(** Concurrency library *)
open Stdune
open! Stdune
(** {1 Generals} *)

16
src/file_tree.ml
View File

@ -1,8 +1,9 @@
open! Stdune
open! Import
module Dune_file = struct
module Kind = struct
type t = Usexp.syntax = Jbuild | Dune
type t = Dsexp.syntax = Jbuild | Dune
let of_basename = function
| "dune" -> Dune
@ -75,7 +76,7 @@ module Dune_file = struct
(Contents.Ocaml_script file, String.Set.empty)
else
let sexps =
Usexp.Parser.parse lb ~lexer:(Kind.lexer kind) ~mode:Many
Dsexp.Parser.parse lb ~lexer:(Kind.lexer kind) ~mode:Many
in
let ignored_subdirs, sexps = extract_ignored_subdirs sexps in
(Plain { path = file; sexps }, ignored_subdirs)
@ -88,11 +89,12 @@ let load_jbuild_ignore path =
if Filename.dirname fn = Filename.current_dir_name then
true
else begin
Loc.(warn (of_pos ( Path.to_string path
, i + 1, 0
, String.length fn
))
"subdirectory expression %s ignored" fn);
Dloc.(warn (Loc.of_pos
( Path.to_string path
, i + 1, 0
, String.length fn
))
"subdirectory expression %s ignored" fn);
false
end)
|> String.Set.of_list

3
src/file_tree.mli
View File

@ -1,10 +1,11 @@
open! Stdune
(** Dune representation of the source tree *)
open! Import
module Dune_file : sig
module Kind : sig
type t = Usexp.syntax = Jbuild | Dune
type t = Dsexp.syntax = Jbuild | Dune
val lexer : t -> Dsexp.Lexer.t
end

1
src/findlib.ml
View File

@ -1,3 +1,4 @@
open! Stdune
open Import
module P = Variant

1
src/findlib.mli
View File

@ -1,5 +1,6 @@
(** Findlib database *)
open! Stdune
open Import
(** Findlib database *)

1
src/gen_meta.ml
View File

@ -1,3 +1,4 @@
open! Stdune
open Import
open Meta

7
src/gen_rules.ml
View File

@ -1,3 +1,4 @@
open! Stdune
open Import
module Menhir_rules = Menhir
open Dune_file
@ -61,11 +62,11 @@ module Gen(P : Install_rules.Params) = struct
match Module.Name.Map.find modules mod_name with
| Some m ->
if not (Module.has_impl m) then
Loc.fail loc "Module %a has no implementation."
Dloc.fail loc "Module %a has no implementation."
Module.Name.pp mod_name
else
{ Exe.Program.name; main_module_name = mod_name }
| None -> Loc.fail loc "Module %a doesn't exist."
| None -> Dloc.fail loc "Module %a doesn't exist."
Module.Name.pp mod_name)
in
@ -295,7 +296,7 @@ module Gen(P : Install_rules.Params) = struct
SC.add_rule sctx
(Build.fail ~targets
{ fail = fun () ->
Loc.fail m.loc
Dloc.fail m.loc
"I can't determine what library/executable the files \
produced by this stanza are part of."
})

1
src/gen_rules.mli
View File

@ -1,3 +1,4 @@
open! Stdune
open! Import
(* Generate rules. Returns evaluated jbuilds per context names. *)

2
src/glob_lexer.mli
View File

@ -1,3 +1 @@
open Import
val parse_string : string -> (Re.t, int * string) result

5
src/glob_lexer.mll
View File

@ -1,4 +1,5 @@
{
open! Stdune
open Re
let no_slash = diff any (char '/')
@ -59,8 +60,8 @@ and char_set st = parse
let parse_string s =
let lb = Lexing.from_string s in
match initial lb with
| re -> Import.Ok re
| re -> Result.Ok re
| exception Failure msg ->
Import.Error (Lexing.lexeme_start lb, msg)
Error (Lexing.lexeme_start lb, msg)
}

2
src/import.ml
View File

@ -1,3 +1,5 @@
open! Stdune
include Stdune
include Errors

3
src/inline_tests.ml
View File

@ -1,3 +1,4 @@
open! Stdune
open Import
open Dune_file
open Build.O
@ -74,7 +75,7 @@ module Backend = struct
resolve x >>= fun lib ->
match get ~loc lib with
| None ->
Error (Loc.exnf loc "%S is not an %s" name
Error (Dloc.exnf loc "%S is not an %s" name
(desc ~plural:false))
| Some t -> Ok t))
}

3
src/install.ml
View File

@ -1,3 +1,4 @@
open! Stdune
open Import
module Section = struct
@ -271,7 +272,7 @@ let load_install_file path =
; pos_cnum = col
}
in
Loc.fail { start = pos; stop = pos } fmt
Dloc.fail { start = pos; stop = pos } fmt
in
List.concat_map file.file_contents ~f:(function
| Variable (pos, section, files) -> begin

2
src/install.mli
View File

@ -1,6 +1,6 @@
(** Opam install file *)
open Stdune
open! Stdune
module Section : sig
type t =

1
src/install_rules.ml
View File

@ -1,3 +1,4 @@
open! Stdune
open Import
open Dune_file
open Build.O

8
src/installed_dune_file.ml
View File

@ -1,4 +1,4 @@
open Import
open! Stdune
let parse_sub_systems ~parsing_context sexps =
List.filter_map sexps ~f:(fun sexp ->
@ -17,7 +17,7 @@ let parse_sub_systems ~parsing_context sexps =
|> (function
| Ok x -> x
| Error (name, _, (loc, _, _)) ->
Loc.fail loc "%S present twice" (Sub_system_name.to_string name))
Dloc.fail loc "%S present twice" (Sub_system_name.to_string name))
|> Sub_system_name.Map.mapi ~f:(fun name (_, version, data) ->
let (module M) = Dune_file.Sub_system_info.get name in
Syntax.check_supported M.syntax version;
@ -73,10 +73,10 @@ let load fname =
| 2, Atom (A "1") -> state := 3; lexer := Dsexp.Lexer.jbuild_token
| 2, Atom (A "2") -> state := 3; lexer := Dsexp.Lexer.token
| 2, Atom (A version) ->
Loc.fail (Dsexp.Loc.of_lexbuf lexbuf) "Unsupported version %S" version
Dloc.fail (Loc.of_lexbuf lexbuf) "Unsupported version %S" version
| 3, _ -> ()
| _ ->
Loc.fail (Dsexp.Loc.of_lexbuf lexbuf)
Dloc.fail (Loc.of_lexbuf lexbuf)
"This <lib>.dune file looks invalid, it should \
contain a S-expression of the form (dune x.y ..)"
);

2
src/installed_dune_file.mli
View File

@ -1,6 +1,6 @@
(** Dune files that are installed on the system *)
open Stdune
open! Stdune
val load : Path.t -> Dune_file.Sub_system_info.t Sub_system_name.Map.t
val gen

7
src/jbuild_load.ml
View File

@ -1,3 +1,4 @@
open! Stdune
open Import
open Dune_file
@ -73,7 +74,7 @@ module Jbuilds = struct
(match (kind : File_tree.Dune_file.Kind.t) with
| Jbuild -> ()
| Dune ->
Loc.fail loc
Dloc.fail loc
"#require is no longer supported in dune files.\n\
You can use the following function instead of \
Unix.open_process_in:\n\
@ -84,7 +85,7 @@ module Jbuilds = struct
| [] -> acc
| ["unix"] -> Unix
| _ ->
Loc.fail loc
Dloc.fail loc
"Using libraries other that \"unix\" is not supported.\n\
See the manual for details.";
in
@ -207,7 +208,7 @@ end
Did you forgot to call [Jbuild_plugin.V*.send]?"
(Path.to_string file);
Fiber.return
(Io.Dsexp.load generated_jbuild ~mode:Many
(Dsexp.Io.load generated_jbuild ~mode:Many
~lexer:(File_tree.Dune_file.Kind.lexer kind)
|> Jbuild.parse ~dir ~file ~project ~kind ~ignore_promoted_rules))
>>| fun dynamic ->

2
src/jbuild_load.mli
View File

@ -1,4 +1,4 @@
open Stdune
open! Stdune
module Jbuild : sig
type t =

1
src/js_of_ocaml_rules.ml
View File

@ -1,3 +1,4 @@
open! Stdune
open Import
open! No_io
open Build.O

1
src/js_of_ocaml_rules.mli
View File

@ -1,5 +1,6 @@
(** Generate rules for js_of_ocaml *)
open! Stdune
open Import
open Dune_file

7
src/lib.ml
View File

@ -1,4 +1,5 @@
open Import
open! Stdune
open Result.O
(* +-----------------------------------------------------------------+
@ -319,7 +320,7 @@ exception Error of Error.t
let not_available ~loc reason fmt =
Errors.kerrf fmt ~f:(fun s ->
Loc.fail loc "%s %a" s
Dloc.fail loc "%s %a" s
Error.Library_not_available.Reason.pp reason)
(* +-----------------------------------------------------------------+
@ -491,7 +492,7 @@ module Sub_system = struct
| M.Info.T info ->
let get ~loc lib' =
if lib.unique_id = lib'.unique_id then
Loc.fail loc "Library %S depends on itself" lib.name
Dloc.fail loc "Library %S depends on itself" lib.name
else
M.get lib'
in
@ -1137,7 +1138,7 @@ let report_lib_error ppf (e : Error.t) =
| No_solution_found_for_select { loc } ->
Format.fprintf ppf
"%a@{<error>Error@}: No solution found for this select form.\n"
Loc.print loc
Dloc.print loc
| Dependency_cycle cycle ->
Format.fprintf ppf
"@{<error>Error@}: Dependency cycle detected between the \

1
src/lib.mli
View File

@ -1,3 +1,4 @@
open! Stdune
open Import
(** {1 Generals} *)

2
src/lib_deps_info.ml
View File

@ -1,4 +1,4 @@
open Import
open! Stdune
module Kind = struct
type t =

2
src/lib_deps_info.mli
View File

@ -3,7 +3,7 @@
(** This module implements tracking of external library dependencies,
for [dune external-lib-deps] *)
open Import
open! Stdune
module Kind : sig
type t =

3
src/lib_rules.ml
View File

@ -1,3 +1,4 @@
open! Stdune
open Import
open Build.O
open Dune_file
@ -226,7 +227,7 @@ module Gen (P : Install_rules.Params) = struct
if not (match Path.parent p with
| None -> false
| Some p -> Path.Set.mem all_dirs p) then
Loc.fail loc
Dloc.fail loc
"File %a is not part of the current directory group. \
This is not allowed."
Path.pp (Path.drop_optional_build_context p)

Some files were not shown because too many files have changed in this diff Show More