Start moving dune related sexp stuff to Dsexp

Signed-off-by: Rudi Grinberg <rudi.grinberg@gmail.com>
This commit is contained in:
Rudi Grinberg 2018-08-21 18:59:47 +03:00
parent 05705c7a79
commit b34394509a
9 changed files with 34 additions and 36 deletions

View File

@ -1276,7 +1276,7 @@ let update_universe t =
let n = let n =
if Path.exists universe_file then if Path.exists universe_file then
Sexp.Of_sexp.(parse int) Univ_map.empty Sexp.Of_sexp.(parse int) Univ_map.empty
(Io.Sexp.load ~mode:Single universe_file) + 1 (Dsexp.Io.load ~mode:Single universe_file) + 1
else else
0 0
in in

View File

@ -135,7 +135,7 @@ let load_config_file p =
| None -> | None ->
parse (enter t) parse (enter t)
(Univ_map.singleton (Syntax.key syntax) (0, 0)) (Univ_map.singleton (Syntax.key syntax) (0, 0))
(Io.Sexp.load p ~mode:Many_as_one ~lexer:Sexp.Lexer.jbuild_token) (Dsexp.Io.load p ~mode:Many_as_one ~lexer:Sexp.Lexer.jbuild_token)
| Some first_line -> | Some first_line ->
parse_contents lb first_line ~f:(fun _lang -> t)) parse_contents lb first_line ~f:(fun _lang -> t))

View File

@ -53,7 +53,7 @@ module Lib_name : sig
val validate : (Loc.t * result) -> wrapped:bool -> t val validate : (Loc.t * result) -> wrapped:bool -> t
val t : (Loc.t * result) Sexp.Of_sexp.t val t : (Loc.t * result) Dsexp.Of_sexp.t
end = struct end = struct
type t = string type t = string
@ -350,11 +350,11 @@ module Bindings = struct
~dune:(dune elem) ~dune:(dune elem)
let sexp_of_t sexp_of_a bindings = let sexp_of_t sexp_of_a bindings =
Sexp.List ( Dsexp.List (
List.map bindings ~f:(function List.map bindings ~f:(function
| Unnamed a -> sexp_of_a a | Unnamed a -> sexp_of_a a
| Named (name, bindings) -> | Named (name, bindings) ->
Sexp.List (Sexp.atom (":" ^ name) :: List.map ~f:sexp_of_a bindings)) Dsexp.List (Dsexp.atom (":" ^ name) :: List.map ~f:sexp_of_a bindings))
) )
end end
@ -393,28 +393,28 @@ module Dep_conf = struct
~then_:t ~then_:t
~else_:(String_with_vars.t >>| fun x -> File x) ~else_:(String_with_vars.t >>| fun x -> File x)
open Sexp open Dsexp
let sexp_of_t = function let sexp_of_t = function
| File t -> | File t ->
List [ Sexp.unsafe_atom_of_string "file" List [ Dsexp.unsafe_atom_of_string "file"
; String_with_vars.sexp_of_t t ] ; String_with_vars.sexp_of_t t ]
| Alias t -> | Alias t ->
List [ Sexp.unsafe_atom_of_string "alias" List [ Dsexp.unsafe_atom_of_string "alias"
; String_with_vars.sexp_of_t t ] ; String_with_vars.sexp_of_t t ]
| Alias_rec t -> | Alias_rec t ->
List [ Sexp.unsafe_atom_of_string "alias_rec" List [ Dsexp.unsafe_atom_of_string "alias_rec"
; String_with_vars.sexp_of_t t ] ; String_with_vars.sexp_of_t t ]
| Glob_files t -> | Glob_files t ->
List [ Sexp.unsafe_atom_of_string "glob_files" List [ Dsexp.unsafe_atom_of_string "glob_files"
; String_with_vars.sexp_of_t t ] ; String_with_vars.sexp_of_t t ]
| Source_tree t -> | Source_tree t ->
List [ Sexp.unsafe_atom_of_string "files_recursively_in" List [ Dsexp.unsafe_atom_of_string "files_recursively_in"
; String_with_vars.sexp_of_t t ] ; String_with_vars.sexp_of_t t ]
| Package t -> | Package t ->
List [ Sexp.unsafe_atom_of_string "package" List [ Dsexp.unsafe_atom_of_string "package"
; String_with_vars.sexp_of_t t] ; String_with_vars.sexp_of_t t]
| Universe -> | Universe ->
Sexp.unsafe_atom_of_string "universe" Dsexp.unsafe_atom_of_string "universe"
end end
module Preprocess = struct module Preprocess = struct
@ -474,7 +474,7 @@ module Blang = struct
Compare (op, x, y)))) Compare (op, x, y))))
in in
let t = let t =
fix begin fun (t : String_with_vars.t Blang.t Sexp.Of_sexp.t) -> fix begin fun (t : String_with_vars.t Blang.t Dsexp.Of_sexp.t) ->
if_list if_list
~then_:( ~then_:(
[ "or", repeat t >>| (fun x -> Or x) [ "or", repeat t >>| (fun x -> Or x)
@ -803,7 +803,7 @@ module Sub_system_info = struct
val name : Sub_system_name.t val name : Sub_system_name.t
val loc : t -> Loc.t val loc : t -> Loc.t
val syntax : Syntax.t val syntax : Syntax.t
val parse : t Sexp.Of_sexp.t val parse : t Dsexp.Of_sexp.t
end end
let all = Sub_system_name.Table.create ~default_value:None let all = Sub_system_name.Table.create ~default_value:None
@ -862,7 +862,7 @@ module Mode_conf = struct
Format.pp_print_string fmt (to_string t) Format.pp_print_string fmt (to_string t)
let sexp_of_t t = let sexp_of_t t =
Sexp.unsafe_atom_of_string (to_string t) Dsexp.unsafe_atom_of_string (to_string t)
module Set = struct module Set = struct
include Set.Make(T) include Set.Make(T)
@ -1038,7 +1038,7 @@ module Install_conf = struct
| List (_, [Atom (_, A src); Atom (_, A "as"); Atom (_, A dst)]) -> | List (_, [Atom (_, A src); Atom (_, A "as"); Atom (_, A dst)]) ->
junk >>> return { src; dst = Some dst } junk >>> return { src; dst = Some dst }
| sexp -> | sexp ->
of_sexp_error (Sexp.Ast.loc sexp) of_sexp_error (Dsexp.Ast.loc sexp)
"invalid format, <name> or (<name> as <install-as>) expected" "invalid format, <name> or (<name> as <install-as>) expected"
type t = type t =
@ -1105,7 +1105,7 @@ module Executables = struct
] ]
let simple = let simple =
Sexp.Of_sexp.enum simple_representations Dsexp.Of_sexp.enum simple_representations
let t = let t =
if_list if_list
@ -1121,7 +1121,7 @@ module Executables = struct
compare candidate link_mode = Eq compare candidate link_mode = Eq
in in
match List.find ~f:is_ok simple_representations with match List.find ~f:is_ok simple_representations with
| Some (s, _) -> Some (Sexp.unsafe_atom_of_string s) | Some (s, _) -> Some (Dsexp.unsafe_atom_of_string s)
| None -> None | None -> None
let sexp_of_t link_mode = let sexp_of_t link_mode =
@ -1129,7 +1129,7 @@ module Executables = struct
| Some s -> s | Some s -> s
| None -> | None ->
let { mode; kind } = link_mode in let { mode; kind } = link_mode in
Sexp.To_sexp.pair Mode_conf.sexp_of_t Binary_kind.sexp_of_t (mode, kind) Dsexp.To_sexp.pair Mode_conf.sexp_of_t Binary_kind.sexp_of_t (mode, kind)
module Set = struct module Set = struct
include Set.Make(T) include Set.Make(T)
@ -1240,7 +1240,7 @@ module Executables = struct
match Link_mode.Set.best_install_mode t.modes with match Link_mode.Set.best_install_mode t.modes with
| None when has_public_name -> | None when has_public_name ->
let mode_to_string mode = let mode_to_string mode =
" - " ^ Sexp.to_string ~syntax:Dune (Link_mode.sexp_of_t mode) in " - " ^ Dsexp.to_string ~syntax:Dune (Link_mode.sexp_of_t mode) in
let mode_strings = List.map ~f:mode_to_string Link_mode.installable_modes in let mode_strings = List.map ~f:mode_to_string Link_mode.installable_modes in
Loc.fail Loc.fail
buildable.loc buildable.loc
@ -1472,7 +1472,7 @@ module Rule = struct
| Some Action -> short_form | Some Action -> short_form
end end
| sexp -> | sexp ->
of_sexp_errorf (Sexp.Ast.loc sexp) of_sexp_errorf (Dsexp.Ast.loc sexp)
"S-expression of the form (<atom> ...) expected" "S-expression of the form (<atom> ...) expected"
let t = let t =
@ -1756,7 +1756,7 @@ module Stanzas = struct
type Stanza.t += Include of Loc.t * string type Stanza.t += Include of Loc.t * string
type constructors = (string * Stanza.t list Sexp.Of_sexp.t) list type constructors = (string * Stanza.t list Dsexp.Of_sexp.t) list
let stanzas : constructors = let stanzas : constructors =
[ "library", [ "library",
@ -1837,7 +1837,7 @@ module Stanzas = struct
exception Include_loop of Path.t * (Loc.t * Path.t) list exception Include_loop of Path.t * (Loc.t * Path.t) list
let rec parse stanza_parser ~lexer ~current_file ~include_stack sexps = let rec parse stanza_parser ~lexer ~current_file ~include_stack sexps =
List.concat_map sexps ~f:(Sexp.Of_sexp.parse stanza_parser Univ_map.empty) List.concat_map sexps ~f:(Dsexp.Of_sexp.parse stanza_parser Univ_map.empty)
|> List.concat_map ~f:(function |> List.concat_map ~f:(function
| Include (loc, fn) -> | Include (loc, fn) ->
let include_stack = (loc, current_file) :: include_stack in let include_stack = (loc, current_file) :: include_stack in
@ -1848,7 +1848,7 @@ module Stanzas = struct
(Path.to_string_maybe_quoted current_file); (Path.to_string_maybe_quoted current_file);
if List.exists include_stack ~f:(fun (_, f) -> Path.equal f current_file) then if List.exists include_stack ~f:(fun (_, f) -> Path.equal f current_file) then
raise (Include_loop (current_file, include_stack)); raise (Include_loop (current_file, include_stack));
let sexps = Io.Sexp.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 parse stanza_parser sexps ~lexer ~current_file ~include_stack
| stanza -> [stanza]) | stanza -> [stanza])

View File

@ -207,7 +207,7 @@ end
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);
Fiber.return Fiber.return
(Io.Sexp.load generated_jbuild ~mode:Many (Dsexp.Io.load generated_jbuild ~mode:Many
~lexer:(File_tree.Dune_file.Kind.lexer kind) ~lexer:(File_tree.Dune_file.Kind.lexer kind)
|> Jbuild.parse ~dir ~file ~project ~kind ~ignore_promoted_rules)) |> Jbuild.parse ~dir ~file ~project ~kind ~ignore_promoted_rules))
>>| fun dynamic -> >>| fun dynamic ->

6
src/stdune/dsexp.ml Normal file
View File

@ -0,0 +1,6 @@
include Sexp
module Io = struct
let load ?lexer path ~mode =
Io.with_lexbuf_from_file path ~f:(Usexp.Parser.parse ~mode ?lexer)
end

View File

@ -123,8 +123,3 @@ let compare_text_files fn1 fn2 =
let s1 = read_file_and_normalize_eols fn1 in let s1 = read_file_and_normalize_eols fn1 in
let s2 = read_file_and_normalize_eols fn2 in let s2 = read_file_and_normalize_eols fn2 in
String.compare s1 s2 String.compare s1 s2
module Sexp = struct
let load ?lexer path ~mode =
with_lexbuf_from_file path ~f:(Usexp.Parser.parse ~mode ?lexer)
end

View File

@ -27,7 +27,3 @@ val copy_channels : in_channel -> out_channel -> unit
val copy_file : ?chmod:(int -> int) -> src:Path.t -> dst:Path.t -> unit -> unit val copy_file : ?chmod:(int -> int) -> src:Path.t -> dst:Path.t -> unit -> unit
val read_all : in_channel -> string val read_all : in_channel -> string
module Sexp : sig
val load : ?lexer:Usexp.Lexer.t -> Path.t -> mode:'a Sexp.Parser.Mode.t -> 'a
end

View File

@ -20,6 +20,7 @@ module String = String
module Char = Char module Char = Char
module Bool = Bool module Bool = Bool
module Sexp = Sexp module Sexp = Sexp
module Dsexp = Dsexp
module Path = Path module Path = Path
module Fmt = Fmt module Fmt = Fmt
module Interned = Interned module Interned = Interned

View File

@ -224,7 +224,7 @@ let load ?x ?profile p =
parse_contents lb first_line ~f:(fun _lang -> t ?x ?profile ())) parse_contents lb first_line ~f:(fun _lang -> t ?x ?profile ()))
| Jbuilder -> | Jbuilder ->
let sexp = let sexp =
Io.Sexp.load p ~mode:Many_as_one ~lexer:Sexp.Lexer.jbuild_token Dsexp.Io.load p ~mode:Many_as_one ~lexer:Sexp.Lexer.jbuild_token
in in
parse parse
(enter (t ?x ?profile ())) (enter (t ?x ?profile ()))