Move a bunch of parsing to Dsexp
Signed-off-by: Rudi Grinberg <rudi.grinberg@gmail.com>
This commit is contained in:
parent
9c9ea7c60a
commit
328ad3411c
|
@ -1,5 +1,5 @@
|
||||||
open Import
|
open Import
|
||||||
open Sexp.Of_sexp
|
open Dsexp.Of_sexp
|
||||||
|
|
||||||
let ignore_loc k ~loc:_ = k
|
let ignore_loc k ~loc:_ = k
|
||||||
|
|
||||||
|
@ -27,7 +27,7 @@ struct
|
||||||
|
|
||||||
let t =
|
let t =
|
||||||
let path = Path.t and string = String.t in
|
let path = Path.t and string = String.t in
|
||||||
Sexp.Of_sexp.fix (fun t ->
|
Dsexp.Of_sexp.fix (fun t ->
|
||||||
sum
|
sum
|
||||||
[ "run",
|
[ "run",
|
||||||
(let%map prog = Program.t
|
(let%map prog = Program.t
|
||||||
|
@ -268,7 +268,7 @@ module Prog = struct
|
||||||
|
|
||||||
type t = (Path.t, Not_found.t) result
|
type t = (Path.t, Not_found.t) result
|
||||||
|
|
||||||
let t : t Sexp.Of_sexp.t = Sexp.Of_sexp.map Path.t ~f:Result.ok
|
let t : t Dsexp.Of_sexp.t = Dsexp.Of_sexp.map Path.t ~f:Result.ok
|
||||||
|
|
||||||
let sexp_of_t = function
|
let sexp_of_t = function
|
||||||
| Ok s -> Path.sexp_of_t s
|
| Ok s -> Path.sexp_of_t s
|
||||||
|
@ -283,7 +283,7 @@ module rec Ast : Ast = Ast
|
||||||
|
|
||||||
module String_with_sexp = struct
|
module String_with_sexp = struct
|
||||||
type t = string
|
type t = string
|
||||||
let t = Sexp.Of_sexp.string
|
let t = Dsexp.Of_sexp.string
|
||||||
let sexp_of_t = Sexp.To_sexp.string
|
let sexp_of_t = Sexp.To_sexp.string
|
||||||
end
|
end
|
||||||
|
|
||||||
|
|
|
@ -31,7 +31,7 @@ include Action_intf.Helpers
|
||||||
with type string := string
|
with type string := string
|
||||||
with type t := t
|
with type t := t
|
||||||
|
|
||||||
val t : t Sexp.Of_sexp.t
|
val t : t Dsexp.Of_sexp.t
|
||||||
|
|
||||||
module For_shell : sig
|
module For_shell : sig
|
||||||
include Action_intf.Ast
|
include Action_intf.Ast
|
||||||
|
@ -39,7 +39,7 @@ module For_shell : sig
|
||||||
with type path := string
|
with type path := string
|
||||||
with type string := string
|
with type string := string
|
||||||
|
|
||||||
val sexp_of_t : t Sexp.To_sexp.t
|
val sexp_of_t : t Dsexp.To_sexp.t
|
||||||
end
|
end
|
||||||
|
|
||||||
(** Convert the action to a format suitable for printing *)
|
(** Convert the action to a format suitable for printing *)
|
||||||
|
|
|
@ -6,7 +6,7 @@ type t =
|
||||||
| Shared_object
|
| Shared_object
|
||||||
|
|
||||||
let t =
|
let t =
|
||||||
let open Sexp.Of_sexp in
|
let open Dsexp.Of_sexp in
|
||||||
enum
|
enum
|
||||||
[ "exe" , Exe
|
[ "exe" , Exe
|
||||||
; "object" , Object
|
; "object" , Object
|
||||||
|
|
|
@ -7,7 +7,7 @@ type t =
|
||||||
| Object
|
| Object
|
||||||
| Shared_object
|
| Shared_object
|
||||||
|
|
||||||
val t : t Sexp.Of_sexp.t
|
val t : t Dsexp.Of_sexp.t
|
||||||
|
|
||||||
val sexp_of_t : t Sexp.To_sexp.t
|
val sexp_of_t : t Sexp.To_sexp.t
|
||||||
|
|
||||||
|
|
|
@ -1275,7 +1275,7 @@ let update_universe t =
|
||||||
Utils.Cached_digest.remove universe_file;
|
Utils.Cached_digest.remove universe_file;
|
||||||
let n =
|
let n =
|
||||||
if Path.exists universe_file then
|
if Path.exists universe_file then
|
||||||
Sexp.Of_sexp.(parse int) Univ_map.empty
|
Dsexp.Of_sexp.(parse int) Univ_map.empty
|
||||||
(Io.Dsexp.load ~mode:Single universe_file) + 1
|
(Io.Dsexp.load ~mode:Single universe_file) + 1
|
||||||
else
|
else
|
||||||
0
|
0
|
||||||
|
|
|
@ -32,7 +32,7 @@ module Display : sig
|
||||||
| Verbose (** Display all commands fully *)
|
| Verbose (** Display all commands fully *)
|
||||||
| Quiet (** Only display errors *)
|
| Quiet (** Only display errors *)
|
||||||
|
|
||||||
val t : t Sexp.Of_sexp.t
|
val t : t Dsexp.Of_sexp.t
|
||||||
val all : (string * t) list
|
val all : (string * t) list
|
||||||
end
|
end
|
||||||
|
|
||||||
|
@ -58,7 +58,7 @@ include S with type 'a field = 'a
|
||||||
|
|
||||||
module Partial : S with type 'a field := 'a option
|
module Partial : S with type 'a field := 'a option
|
||||||
|
|
||||||
val t : t Sexp.Of_sexp.t
|
val t : t Dsexp.Of_sexp.t
|
||||||
|
|
||||||
val merge : t -> Partial.t -> t
|
val merge : t -> Partial.t -> t
|
||||||
|
|
||||||
|
|
|
@ -452,7 +452,7 @@ let create_for_opam ?root ~env ~env_nodes ~targets ~profile ~switch ~name
|
||||||
>>= fun s ->
|
>>= fun s ->
|
||||||
let vars =
|
let vars =
|
||||||
Usexp.parse_string ~fname:"<opam output>" ~mode:Single s
|
Usexp.parse_string ~fname:"<opam output>" ~mode:Single s
|
||||||
|> Sexp.Of_sexp.(parse (list (pair string string)) Univ_map.empty)
|
|> Dsexp.Of_sexp.(parse (list (pair string string)) Univ_map.empty)
|
||||||
|> Env.Map.of_list_multi
|
|> Env.Map.of_list_multi
|
||||||
|> Env.Map.mapi ~f:(fun var values ->
|
|> Env.Map.mapi ~f:(fun var values ->
|
||||||
match List.rev values with
|
match List.rev values with
|
||||||
|
|
|
@ -18,7 +18,7 @@ module Stanza : sig
|
||||||
; rules : (pattern * config) list
|
; rules : (pattern * config) list
|
||||||
}
|
}
|
||||||
|
|
||||||
val t : t Sexp.Of_sexp.t
|
val t : t Dsexp.Of_sexp.t
|
||||||
end
|
end
|
||||||
|
|
||||||
type stanza +=
|
type stanza +=
|
||||||
|
|
|
@ -1,5 +1,5 @@
|
||||||
open Import
|
open Import
|
||||||
open Sexp.Of_sexp
|
open Dsexp.Of_sexp
|
||||||
|
|
||||||
module Kind = struct
|
module Kind = struct
|
||||||
type t =
|
type t =
|
||||||
|
@ -7,7 +7,7 @@ module Kind = struct
|
||||||
| Jbuilder
|
| Jbuilder
|
||||||
|
|
||||||
let sexp_of_t t =
|
let sexp_of_t t =
|
||||||
Sexp.atom_or_quoted_string
|
Dsexp.atom_or_quoted_string
|
||||||
(match t with
|
(match t with
|
||||||
| Dune -> "dune"
|
| Dune -> "dune"
|
||||||
| Jbuilder -> "jbuilder")
|
| Jbuilder -> "jbuilder")
|
||||||
|
@ -22,8 +22,8 @@ module Name : sig
|
||||||
|
|
||||||
val to_string_hum : t -> string
|
val to_string_hum : t -> string
|
||||||
|
|
||||||
val named_of_sexp : t Sexp.Of_sexp.t
|
val named_of_sexp : t Dsexp.Of_sexp.t
|
||||||
val sexp_of_t : t Sexp.To_sexp.t
|
val sexp_of_t : t Dsexp.To_sexp.t
|
||||||
|
|
||||||
val encode : t -> string
|
val encode : t -> string
|
||||||
val decode : string -> t
|
val decode : string -> t
|
||||||
|
@ -59,9 +59,9 @@ end = struct
|
||||||
| Anonymous p -> sprintf "<anonymous %s>" (Path.to_string_maybe_quoted p)
|
| Anonymous p -> sprintf "<anonymous %s>" (Path.to_string_maybe_quoted p)
|
||||||
|
|
||||||
let sexp_of_t = function
|
let sexp_of_t = function
|
||||||
| Named s -> Sexp.To_sexp.string s
|
| Named s -> Dsexp.To_sexp.string s
|
||||||
| Anonymous p ->
|
| Anonymous p ->
|
||||||
List [ Sexp.unsafe_atom_of_string "anonymous"
|
List [ Dsexp.unsafe_atom_of_string "anonymous"
|
||||||
; Path.sexp_of_t p
|
; Path.sexp_of_t p
|
||||||
]
|
]
|
||||||
|
|
||||||
|
@ -85,11 +85,11 @@ end = struct
|
||||||
None
|
None
|
||||||
|
|
||||||
let named_of_sexp =
|
let named_of_sexp =
|
||||||
Sexp.Of_sexp.plain_string (fun ~loc s ->
|
Dsexp.Of_sexp.plain_string (fun ~loc s ->
|
||||||
if validate s then
|
if validate s then
|
||||||
Named s
|
Named s
|
||||||
else
|
else
|
||||||
Sexp.Of_sexp.of_sexp_errorf loc "invalid project name")
|
Dsexp.Of_sexp.of_sexp_errorf loc "invalid project name")
|
||||||
|
|
||||||
let encode = function
|
let encode = function
|
||||||
| Named s -> s
|
| Named s -> s
|
||||||
|
@ -132,7 +132,7 @@ module Project_file = struct
|
||||||
}
|
}
|
||||||
|
|
||||||
let sexp_of_t { file; exists } =
|
let sexp_of_t { file; exists } =
|
||||||
Sexp.To_sexp.(
|
Dsexp.To_sexp.(
|
||||||
record
|
record
|
||||||
[ "file", Path.sexp_of_t file
|
[ "file", Path.sexp_of_t file
|
||||||
; "exists", bool exists
|
; "exists", bool exists
|
||||||
|
@ -145,7 +145,7 @@ type t =
|
||||||
; root : Path.Local.t
|
; root : Path.Local.t
|
||||||
; version : string option
|
; version : string option
|
||||||
; packages : Package.t Package.Name.Map.t
|
; packages : Package.t Package.Name.Map.t
|
||||||
; stanza_parser : Stanza.t list Sexp.Of_sexp.t
|
; stanza_parser : Stanza.t list Dsexp.Of_sexp.t
|
||||||
; project_file : Project_file.t
|
; project_file : Project_file.t
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -202,14 +202,14 @@ let append_to_project_file t str =
|
||||||
module Extension = struct
|
module Extension = struct
|
||||||
type t =
|
type t =
|
||||||
{ syntax : Syntax.t
|
{ syntax : Syntax.t
|
||||||
; stanzas : Stanza.Parser.t list Sexp.Of_sexp.t
|
; stanzas : Stanza.Parser.t list Dsexp.Of_sexp.t
|
||||||
}
|
}
|
||||||
|
|
||||||
type instance =
|
type instance =
|
||||||
{ extension : t
|
{ extension : t
|
||||||
; version : Syntax.Version.t
|
; version : Syntax.Version.t
|
||||||
; loc : Loc.t
|
; loc : Loc.t
|
||||||
; parse_args : Stanza.Parser.t list Sexp.Of_sexp.t -> Stanza.Parser.t list
|
; parse_args : Stanza.Parser.t list Dsexp.Of_sexp.t -> Stanza.Parser.t list
|
||||||
}
|
}
|
||||||
|
|
||||||
let extensions = Hashtbl.create 32
|
let extensions = Hashtbl.create 32
|
||||||
|
@ -242,7 +242,7 @@ module Extension = struct
|
||||||
if f name then
|
if f name then
|
||||||
let version = Syntax.greatest_supported_version ext.syntax in
|
let version = Syntax.greatest_supported_version ext.syntax in
|
||||||
let parse_args p =
|
let parse_args p =
|
||||||
let open Sexp.Of_sexp in
|
let open Dsexp.Of_sexp in
|
||||||
let dune_project_edited = ref false in
|
let dune_project_edited = ref false in
|
||||||
parse (enter p) Univ_map.empty (List (Loc.of_pos __POS__, []))
|
parse (enter p) Univ_map.empty (List (Loc.of_pos __POS__, []))
|
||||||
|> List.map ~f:(fun (name, p) ->
|
|> List.map ~f:(fun (name, p) ->
|
||||||
|
@ -251,10 +251,10 @@ module Extension = struct
|
||||||
if not !dune_project_edited then begin
|
if not !dune_project_edited then begin
|
||||||
dune_project_edited := true;
|
dune_project_edited := true;
|
||||||
Project_file_edit.append project_file
|
Project_file_edit.append project_file
|
||||||
(Sexp.to_string ~syntax:Dune
|
(Dsexp.to_string ~syntax:Dune
|
||||||
(List [ Sexp.atom "using"
|
(List [ Dsexp.atom "using"
|
||||||
; Sexp.atom name
|
; Dsexp.atom name
|
||||||
; Sexp.atom (Syntax.Version.to_string version)
|
; Dsexp.atom (Syntax.Version.to_string version)
|
||||||
]))
|
]))
|
||||||
end;
|
end;
|
||||||
p))
|
p))
|
||||||
|
@ -278,17 +278,17 @@ let key =
|
||||||
Univ_map.Key.create ~name:"dune-project"
|
Univ_map.Key.create ~name:"dune-project"
|
||||||
(fun { name; root; version; project_file; kind
|
(fun { name; root; version; project_file; kind
|
||||||
; stanza_parser = _; packages = _ } ->
|
; stanza_parser = _; packages = _ } ->
|
||||||
Sexp.To_sexp.record
|
Dsexp.To_sexp.record
|
||||||
[ "name", Name.sexp_of_t name
|
[ "name", Name.sexp_of_t name
|
||||||
; "root", Path.Local.sexp_of_t root
|
; "root", Path.Local.sexp_of_t root
|
||||||
; "version", Sexp.To_sexp.(option string) version
|
; "version", Dsexp.To_sexp.(option string) version
|
||||||
; "project_file", Project_file.sexp_of_t project_file
|
; "project_file", Project_file.sexp_of_t project_file
|
||||||
; "kind", Kind.sexp_of_t kind
|
; "kind", Kind.sexp_of_t kind
|
||||||
])
|
])
|
||||||
|
|
||||||
let set t = Sexp.Of_sexp.set key t
|
let set t = Dsexp.Of_sexp.set key t
|
||||||
let get_exn () =
|
let get_exn () =
|
||||||
let open Sexp.Of_sexp in
|
let open Dsexp.Of_sexp in
|
||||||
get key >>| function
|
get key >>| function
|
||||||
| Some t -> t
|
| Some t -> t
|
||||||
| None ->
|
| None ->
|
||||||
|
@ -310,7 +310,7 @@ let anonymous = lazy (
|
||||||
; root = get_local_path Path.root
|
; root = get_local_path Path.root
|
||||||
; version = None
|
; version = None
|
||||||
; stanza_parser =
|
; stanza_parser =
|
||||||
Sexp.Of_sexp.(set_many parsing_context (sum lang.data))
|
Dsexp.Of_sexp.(set_many parsing_context (sum lang.data))
|
||||||
; project_file = { file = Path.relative Path.root filename; exists = false }
|
; project_file = { file = Path.relative Path.root filename; exists = false }
|
||||||
})
|
})
|
||||||
|
|
||||||
|
@ -375,14 +375,14 @@ let parse ~dir ~lang ~packages ~file =
|
||||||
(lang.data ::
|
(lang.data ::
|
||||||
List.map extensions ~f:(fun (ext : Extension.instance) ->
|
List.map extensions ~f:(fun (ext : Extension.instance) ->
|
||||||
ext.parse_args
|
ext.parse_args
|
||||||
(Sexp.Of_sexp.set_many parsing_context ext.extension.stanzas)))
|
(Dsexp.Of_sexp.set_many parsing_context ext.extension.stanzas)))
|
||||||
in
|
in
|
||||||
{ kind = Dune
|
{ kind = Dune
|
||||||
; name
|
; name
|
||||||
; root = get_local_path dir
|
; root = get_local_path dir
|
||||||
; version
|
; version
|
||||||
; packages
|
; packages
|
||||||
; stanza_parser = Sexp.Of_sexp.(set_many parsing_context (sum stanzas))
|
; stanza_parser = Dsexp.Of_sexp.(set_many parsing_context (sum stanzas))
|
||||||
; project_file
|
; project_file
|
||||||
})
|
})
|
||||||
|
|
||||||
|
@ -399,7 +399,7 @@ let make_jbuilder_project ~dir packages =
|
||||||
; version = None
|
; version = None
|
||||||
; packages
|
; packages
|
||||||
; stanza_parser =
|
; stanza_parser =
|
||||||
Sexp.Of_sexp.(set_many parsing_context (sum lang.data))
|
Dsexp.Of_sexp.(set_many parsing_context (sum lang.data))
|
||||||
; project_file = { file = Path.relative dir filename; exists = false }
|
; project_file = { file = Path.relative dir filename; exists = false }
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
|
@ -22,7 +22,7 @@ module Name : sig
|
||||||
(** Convert to a string that is suitable for human readable messages *)
|
(** Convert to a string that is suitable for human readable messages *)
|
||||||
val to_string_hum : t -> string
|
val to_string_hum : t -> string
|
||||||
|
|
||||||
val sexp_of_t : t -> Sexp.t
|
val sexp_of_t : t -> Dsexp.t
|
||||||
|
|
||||||
(** Convert to/from an encoded string that is suitable to use in filenames *)
|
(** Convert to/from an encoded string that is suitable to use in filenames *)
|
||||||
val encode : t -> string
|
val encode : t -> string
|
||||||
|
@ -41,7 +41,7 @@ val packages : t -> Package.t Package.Name.Map.t
|
||||||
val version : t -> string option
|
val version : t -> string option
|
||||||
val name : t -> Name.t
|
val name : t -> Name.t
|
||||||
val root : t -> Path.Local.t
|
val root : t -> Path.Local.t
|
||||||
val stanza_parser : t -> Stanza.t list Sexp.Of_sexp.t
|
val stanza_parser : t -> Stanza.t list Dsexp.Of_sexp.t
|
||||||
|
|
||||||
module Lang : sig
|
module Lang : sig
|
||||||
(** [register id stanzas_parser] register a new language. Users will
|
(** [register id stanzas_parser] register a new language. Users will
|
||||||
|
@ -62,7 +62,7 @@ module Extension : sig
|
||||||
|
|
||||||
in their [dune-project] file. [parser] is used to describe
|
in their [dune-project] file. [parser] is used to describe
|
||||||
what [<args>] might be. *)
|
what [<args>] might be. *)
|
||||||
val register : Syntax.t -> Stanza.Parser.t list Sexp.Of_sexp.t -> unit
|
val register : Syntax.t -> Stanza.Parser.t list Dsexp.Of_sexp.t -> unit
|
||||||
end
|
end
|
||||||
|
|
||||||
(** Load a project description from the following directory. [files]
|
(** Load a project description from the following directory. [files]
|
||||||
|
@ -86,5 +86,5 @@ val ensure_project_file_exists : t -> unit
|
||||||
val append_to_project_file : t -> string -> unit
|
val append_to_project_file : t -> string -> unit
|
||||||
|
|
||||||
(** Set the project we are currently parsing dune files for *)
|
(** Set the project we are currently parsing dune files for *)
|
||||||
val set : t -> ('a, 'k) Sexp.Of_sexp.parser -> ('a, 'k) Sexp.Of_sexp.parser
|
val set : t -> ('a, 'k) Dsexp.Of_sexp.parser -> ('a, 'k) Dsexp.Of_sexp.parser
|
||||||
val get_exn : unit -> (t, 'k) Sexp.Of_sexp.parser
|
val get_exn : unit -> (t, 'k) Dsexp.Of_sexp.parser
|
||||||
|
|
|
@ -10,14 +10,14 @@ module Dune_file = struct
|
||||||
| _ -> assert false
|
| _ -> assert false
|
||||||
|
|
||||||
let lexer = function
|
let lexer = function
|
||||||
| Dune -> Sexp.Lexer.token
|
| Dune -> Dsexp.Lexer.token
|
||||||
| Jbuild -> Sexp.Lexer.jbuild_token
|
| Jbuild -> Dsexp.Lexer.jbuild_token
|
||||||
end
|
end
|
||||||
|
|
||||||
module Plain = struct
|
module Plain = struct
|
||||||
type t =
|
type t =
|
||||||
{ path : Path.t
|
{ path : Path.t
|
||||||
; mutable sexps : Sexp.Ast.t list
|
; mutable sexps : Dsexp.Ast.t list
|
||||||
}
|
}
|
||||||
end
|
end
|
||||||
|
|
||||||
|
@ -39,7 +39,7 @@ module Dune_file = struct
|
||||||
|
|
||||||
let extract_ignored_subdirs =
|
let extract_ignored_subdirs =
|
||||||
let stanza =
|
let stanza =
|
||||||
let open Sexp.Of_sexp in
|
let open Dsexp.Of_sexp in
|
||||||
let sub_dir =
|
let sub_dir =
|
||||||
plain_string (fun ~loc dn ->
|
plain_string (fun ~loc dn ->
|
||||||
if Filename.dirname dn <> Filename.current_dir_name ||
|
if Filename.dirname dn <> Filename.current_dir_name ||
|
||||||
|
@ -58,9 +58,9 @@ module Dune_file = struct
|
||||||
fun sexps ->
|
fun sexps ->
|
||||||
let ignored_subdirs, sexps =
|
let ignored_subdirs, sexps =
|
||||||
List.partition_map sexps ~f:(fun sexp ->
|
List.partition_map sexps ~f:(fun sexp ->
|
||||||
match (sexp : Sexp.Ast.t) with
|
match (sexp : Dsexp.Ast.t) with
|
||||||
| List (_, (Atom (_, A "ignored_subdirs") :: _)) ->
|
| List (_, (Atom (_, A "ignored_subdirs") :: _)) ->
|
||||||
Left (Sexp.Of_sexp.parse stanza Univ_map.empty sexp)
|
Left (Dsexp.Of_sexp.parse stanza Univ_map.empty sexp)
|
||||||
| _ -> Right sexp)
|
| _ -> Right sexp)
|
||||||
in
|
in
|
||||||
let ignored_subdirs =
|
let ignored_subdirs =
|
||||||
|
|
|
@ -80,7 +80,7 @@ module Backend = struct
|
||||||
}
|
}
|
||||||
|
|
||||||
let to_sexp t =
|
let to_sexp t =
|
||||||
let open Sexp.To_sexp in
|
let open Dsexp.To_sexp in
|
||||||
let lib x = string (Lib.name x) in
|
let lib x = string (Lib.name x) in
|
||||||
let f x = string (Lib.name x.lib) in
|
let f x = string (Lib.name x.lib) in
|
||||||
((1, 0),
|
((1, 0),
|
||||||
|
|
|
@ -59,7 +59,7 @@ module Section = struct
|
||||||
| _ -> None
|
| _ -> None
|
||||||
|
|
||||||
let t =
|
let t =
|
||||||
let open Sexp.Of_sexp in
|
let open Dsexp.Of_sexp in
|
||||||
enum
|
enum
|
||||||
[ "lib" , Lib
|
[ "lib" , Lib
|
||||||
; "lib_root" , Lib_root
|
; "lib_root" , Lib_root
|
||||||
|
|
|
@ -19,7 +19,7 @@ module Section : sig
|
||||||
| Man
|
| Man
|
||||||
| Misc
|
| Misc
|
||||||
|
|
||||||
val t : t Sexp.Of_sexp.t
|
val t : t Dsexp.Of_sexp.t
|
||||||
|
|
||||||
(** [true] iff the executable bit should be set for files installed
|
(** [true] iff the executable bit should be set for files installed
|
||||||
in this location. *)
|
in this location. *)
|
||||||
|
|
|
@ -3,7 +3,7 @@ open Import
|
||||||
let parse_sub_systems ~parsing_context sexps =
|
let parse_sub_systems ~parsing_context sexps =
|
||||||
List.filter_map sexps ~f:(fun sexp ->
|
List.filter_map sexps ~f:(fun sexp ->
|
||||||
let name, ver, data =
|
let name, ver, data =
|
||||||
Sexp.Of_sexp.(parse (triple string (located Syntax.Version.t) raw)
|
Dsexp.Of_sexp.(parse (triple string (located Syntax.Version.t) raw)
|
||||||
parsing_context) sexp
|
parsing_context) sexp
|
||||||
in
|
in
|
||||||
match Sub_system_name.get name with
|
match Sub_system_name.get name with
|
||||||
|
@ -12,7 +12,7 @@ let parse_sub_systems ~parsing_context sexps =
|
||||||
correspond to plugins that are not in use in the current
|
correspond to plugins that are not in use in the current
|
||||||
workspace. *)
|
workspace. *)
|
||||||
None
|
None
|
||||||
| Some name -> Some (name, (Sexp.Ast.loc sexp, ver, data)))
|
| Some name -> Some (name, (Dsexp.Ast.loc sexp, ver, data)))
|
||||||
|> Sub_system_name.Map.of_list
|
|> Sub_system_name.Map.of_list
|
||||||
|> (function
|
|> (function
|
||||||
| Ok x -> x
|
| Ok x -> x
|
||||||
|
@ -32,10 +32,10 @@ let parse_sub_systems ~parsing_context sexps =
|
||||||
| (_, _) ->
|
| (_, _) ->
|
||||||
Univ_map.add parsing_context (Syntax.key M.syntax) (snd version)
|
Univ_map.add parsing_context (Syntax.key M.syntax) (snd version)
|
||||||
in
|
in
|
||||||
M.T (Sexp.Of_sexp.parse M.parse parsing_context data))
|
M.T (Dsexp.Of_sexp.parse M.parse parsing_context data))
|
||||||
|
|
||||||
let of_sexp =
|
let of_sexp =
|
||||||
let open Sexp.Of_sexp in
|
let open Dsexp.Of_sexp in
|
||||||
let version =
|
let version =
|
||||||
plain_string (fun ~loc -> function
|
plain_string (fun ~loc -> function
|
||||||
| "1" -> (0, 0)
|
| "1" -> (0, 0)
|
||||||
|
@ -64,40 +64,40 @@ let load fname =
|
||||||
which point we can decide what lexer to use for the reset of
|
which point we can decide what lexer to use for the reset of
|
||||||
the file. *)
|
the file. *)
|
||||||
let state = ref 0 in
|
let state = ref 0 in
|
||||||
let lexer = ref Sexp.Lexer.token in
|
let lexer = ref Dsexp.Lexer.token in
|
||||||
let lexer lb =
|
let lexer lb =
|
||||||
let token : Sexp.Lexer.Token.t = !lexer lb in
|
let token : Dsexp.Lexer.Token.t = !lexer lb in
|
||||||
(match !state, token with
|
(match !state, token with
|
||||||
| 0, Lparen -> state := 1
|
| 0, Lparen -> state := 1
|
||||||
| 1, Atom (A "dune") -> state := 2
|
| 1, Atom (A "dune") -> state := 2
|
||||||
| 2, Atom (A "1") -> state := 3; lexer := Sexp.Lexer.jbuild_token
|
| 2, Atom (A "1") -> state := 3; lexer := Dsexp.Lexer.jbuild_token
|
||||||
| 2, Atom (A "2") -> state := 3; lexer := Sexp.Lexer.token
|
| 2, Atom (A "2") -> state := 3; lexer := Dsexp.Lexer.token
|
||||||
| 2, Atom (A version) ->
|
| 2, Atom (A version) ->
|
||||||
Loc.fail (Sexp.Loc.of_lexbuf lexbuf) "Unsupported version %S" version
|
Loc.fail (Dsexp.Loc.of_lexbuf lexbuf) "Unsupported version %S" version
|
||||||
| 3, _ -> ()
|
| 3, _ -> ()
|
||||||
| _ ->
|
| _ ->
|
||||||
Loc.fail (Sexp.Loc.of_lexbuf lexbuf)
|
Loc.fail (Dsexp.Loc.of_lexbuf lexbuf)
|
||||||
"This <lib>.dune file looks invalid, it should \
|
"This <lib>.dune file looks invalid, it should \
|
||||||
contain a S-expression of the form (dune x.y ..)"
|
contain a S-expression of the form (dune x.y ..)"
|
||||||
);
|
);
|
||||||
token
|
token
|
||||||
in
|
in
|
||||||
Sexp.Of_sexp.parse of_sexp Univ_map.empty
|
Dsexp.Of_sexp.parse of_sexp Univ_map.empty
|
||||||
(Sexp.Parser.parse ~lexer ~mode:Single lexbuf))
|
(Dsexp.Parser.parse ~lexer ~mode:Single lexbuf))
|
||||||
|
|
||||||
let gen ~(dune_version : Syntax.Version.t) confs =
|
let gen ~(dune_version : Syntax.Version.t) confs =
|
||||||
let sexps =
|
let sexps =
|
||||||
Sub_system_name.Map.to_list confs
|
Sub_system_name.Map.to_list confs
|
||||||
|> List.map ~f:(fun (name, (ver, conf)) ->
|
|> List.map ~f:(fun (name, (ver, conf)) ->
|
||||||
let (module M) = Dune_file.Sub_system_info.get name in
|
let (module M) = Dune_file.Sub_system_info.get name in
|
||||||
Sexp.List [ Sexp.atom (Sub_system_name.to_string name)
|
Dsexp.List [ Dsexp.atom (Sub_system_name.to_string name)
|
||||||
; Syntax.Version.sexp_of_t ver
|
; Syntax.Version.sexp_of_t ver
|
||||||
; conf
|
; conf
|
||||||
])
|
])
|
||||||
in
|
in
|
||||||
Sexp.List
|
Dsexp.List
|
||||||
[ Sexp.unsafe_atom_of_string "dune"
|
[ Dsexp.unsafe_atom_of_string "dune"
|
||||||
; Sexp.unsafe_atom_of_string
|
; Dsexp.unsafe_atom_of_string
|
||||||
(match dune_version with
|
(match dune_version with
|
||||||
| (0, 0) -> "1"
|
| (0, 0) -> "1"
|
||||||
| (x, _) when x >= 1 -> "2"
|
| (x, _) when x >= 1 -> "2"
|
||||||
|
|
|
@ -5,7 +5,7 @@ type t = Byte | Native
|
||||||
let all = [Byte; Native]
|
let all = [Byte; Native]
|
||||||
|
|
||||||
let t =
|
let t =
|
||||||
let open Sexp.Of_sexp in
|
let open Dsexp.Of_sexp in
|
||||||
enum
|
enum
|
||||||
[ "byte" , Byte
|
[ "byte" , Byte
|
||||||
; "native" , Native
|
; "native" , Native
|
||||||
|
@ -73,7 +73,7 @@ module Dict = struct
|
||||||
; native = List.mem Native ~set:l
|
; native = List.mem Native ~set:l
|
||||||
}
|
}
|
||||||
|
|
||||||
let t = Sexp.Of_sexp.(map (list t) ~f:of_list)
|
let t = Dsexp.Of_sexp.(map (list t) ~f:of_list)
|
||||||
|
|
||||||
let is_empty t = not (t.byte || t.native)
|
let is_empty t = not (t.byte || t.native)
|
||||||
|
|
||||||
|
|
|
@ -2,7 +2,7 @@ open! Import
|
||||||
|
|
||||||
type t = Byte | Native
|
type t = Byte | Native
|
||||||
|
|
||||||
val t : t Sexp.Of_sexp.t
|
val t : t Dsexp.Of_sexp.t
|
||||||
|
|
||||||
val all : t list
|
val all : t list
|
||||||
|
|
||||||
|
@ -35,7 +35,7 @@ module Dict : sig
|
||||||
module Set : sig
|
module Set : sig
|
||||||
|
|
||||||
type nonrec t = bool t
|
type nonrec t = bool t
|
||||||
val t : t Sexp.Of_sexp.t
|
val t : t Dsexp.Of_sexp.t
|
||||||
val all : t
|
val all : t
|
||||||
val is_empty : t -> bool
|
val is_empty : t -> bool
|
||||||
val to_list : t -> mode list
|
val to_list : t -> mode list
|
||||||
|
|
|
@ -19,7 +19,7 @@ end
|
||||||
type 'ast generic =
|
type 'ast generic =
|
||||||
{ ast : 'ast
|
{ ast : 'ast
|
||||||
; loc : Loc.t option
|
; loc : Loc.t option
|
||||||
; context : Univ_map.t (* Parsing context for Sexp.Of_sexp.parse *)
|
; context : Univ_map.t (* Parsing context for Dsexp.Of_sexp.parse *)
|
||||||
}
|
}
|
||||||
|
|
||||||
type ast_expanded = (Loc.t * string, Ast.expanded) Ast.t
|
type ast_expanded = (Loc.t * string, Ast.expanded) Ast.t
|
||||||
|
@ -235,14 +235,14 @@ let field ?(default=standard) ?check name =
|
||||||
let t =
|
let t =
|
||||||
match check with
|
match check with
|
||||||
| None -> t
|
| None -> t
|
||||||
| Some x -> Sexp.Of_sexp.(>>>) x t
|
| Some x -> Dsexp.Of_sexp.(>>>) x t
|
||||||
in
|
in
|
||||||
Sexp.Of_sexp.field name t ~default
|
Dsexp.Of_sexp.field name t ~default
|
||||||
|
|
||||||
module Unexpanded = struct
|
module Unexpanded = struct
|
||||||
type ast = (String_with_vars.t, Ast.unexpanded) Ast.t
|
type ast = (String_with_vars.t, Ast.unexpanded) Ast.t
|
||||||
type t = ast generic
|
type t = ast generic
|
||||||
let t : t Sexp.Of_sexp.t =
|
let t : t Dsexp.Of_sexp.t =
|
||||||
let open Stanza.Of_sexp in
|
let open Stanza.Of_sexp in
|
||||||
let%map context = get_all
|
let%map context = get_all
|
||||||
and (loc, ast) =
|
and (loc, ast) =
|
||||||
|
@ -275,9 +275,9 @@ module Unexpanded = struct
|
||||||
let t =
|
let t =
|
||||||
match check with
|
match check with
|
||||||
| None -> t
|
| None -> t
|
||||||
| Some x -> Sexp.Of_sexp.(>>>) x t
|
| Some x -> Dsexp.Of_sexp.(>>>) x t
|
||||||
in
|
in
|
||||||
Sexp.Of_sexp.field name t ~default
|
Dsexp.Of_sexp.field name t ~default
|
||||||
|
|
||||||
let files t ~f =
|
let files t ~f =
|
||||||
let rec loop acc (ast : ast) =
|
let rec loop acc (ast : ast) =
|
||||||
|
|
|
@ -4,7 +4,7 @@
|
||||||
open Import
|
open Import
|
||||||
|
|
||||||
type t
|
type t
|
||||||
val t : t Sexp.Of_sexp.t
|
val t : t Dsexp.Of_sexp.t
|
||||||
|
|
||||||
(** Return the location of the set. [loc standard] returns [None] *)
|
(** Return the location of the set. [loc standard] returns [None] *)
|
||||||
val loc : t -> Loc.t option
|
val loc : t -> Loc.t option
|
||||||
|
@ -68,9 +68,9 @@ val is_standard : t -> bool
|
||||||
|
|
||||||
val field
|
val field
|
||||||
: ?default:t
|
: ?default:t
|
||||||
-> ?check:unit Sexp.Of_sexp.t
|
-> ?check:unit Dsexp.Of_sexp.t
|
||||||
-> string
|
-> string
|
||||||
-> t Sexp.Of_sexp.fields_parser
|
-> t Dsexp.Of_sexp.fields_parser
|
||||||
|
|
||||||
module Unexpanded : sig
|
module Unexpanded : sig
|
||||||
type expanded = t
|
type expanded = t
|
||||||
|
@ -81,9 +81,9 @@ module Unexpanded : sig
|
||||||
|
|
||||||
val field
|
val field
|
||||||
: ?default:t
|
: ?default:t
|
||||||
-> ?check:unit Sexp.Of_sexp.t
|
-> ?check:unit Dsexp.Of_sexp.t
|
||||||
-> string
|
-> string
|
||||||
-> t Sexp.Of_sexp.fields_parser
|
-> t Dsexp.Of_sexp.fields_parser
|
||||||
|
|
||||||
val has_special_forms : t -> bool
|
val has_special_forms : t -> bool
|
||||||
|
|
||||||
|
@ -91,7 +91,7 @@ module Unexpanded : sig
|
||||||
val files
|
val files
|
||||||
: t
|
: t
|
||||||
-> f:(String_with_vars.t -> Path.t)
|
-> f:(String_with_vars.t -> Path.t)
|
||||||
-> Sexp.syntax * Path.Set.t
|
-> Dsexp.syntax * Path.Set.t
|
||||||
|
|
||||||
(** Expand [t] using with the given file contents. [file_contents] is a map from
|
(** Expand [t] using with the given file contents. [file_contents] is a map from
|
||||||
filenames to their parsed contents. Every [(:include fn)] in [t] is replaced by
|
filenames to their parsed contents. Every [(:include fn)] in [t] is replaced by
|
||||||
|
@ -99,7 +99,7 @@ module Unexpanded : sig
|
||||||
val expand
|
val expand
|
||||||
: t
|
: t
|
||||||
-> dir:Path.t
|
-> dir:Path.t
|
||||||
-> files_contents:Sexp.Ast.t Path.Map.t
|
-> files_contents:Dsexp.Ast.t Path.Map.t
|
||||||
-> f:(String_with_vars.t -> Value.t list)
|
-> f:(String_with_vars.t -> Value.t list)
|
||||||
-> expanded
|
-> expanded
|
||||||
|
|
||||||
|
|
|
@ -15,7 +15,7 @@ module Name = struct
|
||||||
|
|
||||||
let pp fmt t = Format.pp_print_string fmt (to_string t)
|
let pp fmt t = Format.pp_print_string fmt (to_string t)
|
||||||
|
|
||||||
let t = Sexp.Of_sexp.(map string ~f:of_string)
|
let t = Dsexp.Of_sexp.(map string ~f:of_string)
|
||||||
|
|
||||||
module Infix = Comparable.Operators(T)
|
module Infix = Comparable.Operators(T)
|
||||||
end
|
end
|
||||||
|
|
|
@ -13,7 +13,7 @@ module Name : sig
|
||||||
|
|
||||||
include Interned.S with type t := t
|
include Interned.S with type t := t
|
||||||
|
|
||||||
val t : t Sexp.Of_sexp.t
|
val t : t Dsexp.Of_sexp.t
|
||||||
|
|
||||||
module Infix : Comparable.OPS with type t = t
|
module Infix : Comparable.OPS with type t = t
|
||||||
end
|
end
|
||||||
|
|
|
@ -194,7 +194,7 @@ module Jbuild_driver = struct
|
||||||
in
|
in
|
||||||
Sexp.parse_string ~mode:Single ~fname:"<internal>" info
|
Sexp.parse_string ~mode:Single ~fname:"<internal>" info
|
||||||
~lexer:Sexp.Lexer.jbuild_token
|
~lexer:Sexp.Lexer.jbuild_token
|
||||||
|> Sexp.Of_sexp.parse Driver.Info.parse parsing_context
|
|> Dsexp.Of_sexp.parse Driver.Info.parse parsing_context
|
||||||
in
|
in
|
||||||
(Pp.of_string name,
|
(Pp.of_string name,
|
||||||
{ info
|
{ info
|
||||||
|
|
|
@ -7,23 +7,23 @@ module File = struct
|
||||||
}
|
}
|
||||||
|
|
||||||
(* XXX these sexp converters will be useful for the dump command *)
|
(* XXX these sexp converters will be useful for the dump command *)
|
||||||
let _t =
|
(* let _t =
|
||||||
let open Sexp.Of_sexp in
|
* let open Dsexp.Of_sexp in
|
||||||
peek_exn >>= function
|
* peek_exn >>= function
|
||||||
| List (_, [_; Atom (_, A "as"); _]) ->
|
* | List (_, [_; Atom (_, A "as"); _]) ->
|
||||||
enter
|
* enter
|
||||||
(let%map src = Path.t
|
* (let % map src = Path.t
|
||||||
and () = junk
|
* and () = junk
|
||||||
and dst = Path.t
|
* and dst = Path.t
|
||||||
in
|
* in
|
||||||
{ src; dst })
|
* { src; dst })
|
||||||
| sexp ->
|
* | sexp ->
|
||||||
Sexp.Of_sexp.of_sexp_errorf (Sexp.Ast.loc sexp)
|
* Dsexp.Of_sexp.of_sexp_errorf (Sexp.Ast.loc sexp)
|
||||||
"(<file> as <file>) expected"
|
* "(<file> as <file>) expected" *)
|
||||||
|
|
||||||
let _sexp_of_t { src; dst } =
|
(* let _sexp_of_t { src; dst } =
|
||||||
Sexp.List [Path.sexp_of_t src; Sexp.unsafe_atom_of_string "as";
|
* Sexp.List [Path.sexp_of_t src; Sexp.unsafe_atom_of_string "as";
|
||||||
Path.sexp_of_t dst]
|
* Path.sexp_of_t dst] *)
|
||||||
|
|
||||||
let db : t list ref = ref []
|
let db : t list ref = ref []
|
||||||
|
|
||||||
|
|
|
@ -44,7 +44,7 @@ let report_with_backtrace exn =
|
||||||
in
|
in
|
||||||
let pp ppf = Format.fprintf ppf "@{<error>Error@}: %s\n" msg in
|
let pp ppf = Format.fprintf ppf "@{<error>Error@}: %s\n" msg in
|
||||||
{ p with loc = Some loc; pp }
|
{ p with loc = Some loc; pp }
|
||||||
| Sexp.Of_sexp.Of_sexp (loc, msg, hint') ->
|
| Dsexp.Of_sexp.Of_sexp (loc, msg, hint') ->
|
||||||
let loc =
|
let loc =
|
||||||
{ loc with
|
{ loc with
|
||||||
start = { loc.start with pos_fname = !map_fname loc.start.pos_fname }
|
start = { loc.start with pos_fname = !map_fname loc.start.pos_fname }
|
||||||
|
@ -53,7 +53,7 @@ let report_with_backtrace exn =
|
||||||
let pp ppf = Format.fprintf ppf "@{<error>Error@}: %s%s\n" msg
|
let pp ppf = Format.fprintf ppf "@{<error>Error@}: %s%s\n" msg
|
||||||
(match hint' with
|
(match hint' with
|
||||||
| None -> ""
|
| None -> ""
|
||||||
| Some { Sexp.Of_sexp. on; candidates } ->
|
| Some { Dsexp.Of_sexp. on; candidates } ->
|
||||||
hint on candidates)
|
hint on candidates)
|
||||||
in
|
in
|
||||||
{ p with loc = Some loc; pp }
|
{ p with loc = Some loc; pp }
|
||||||
|
|
|
@ -3,7 +3,7 @@ open Stdune
|
||||||
type t = ..
|
type t = ..
|
||||||
|
|
||||||
module Parser = struct
|
module Parser = struct
|
||||||
type nonrec t = string * t list Sexp.Of_sexp.t
|
type nonrec t = string * t list Dsexp.Of_sexp.t
|
||||||
end
|
end
|
||||||
|
|
||||||
let syntax =
|
let syntax =
|
||||||
|
@ -13,7 +13,7 @@ let syntax =
|
||||||
]
|
]
|
||||||
|
|
||||||
module File_kind = struct
|
module File_kind = struct
|
||||||
type t = Sexp.syntax = Jbuild | Dune
|
type t = Dsexp.syntax = Jbuild | Dune
|
||||||
|
|
||||||
let of_syntax = function
|
let of_syntax = function
|
||||||
| (0, _) -> Jbuild
|
| (0, _) -> Jbuild
|
||||||
|
@ -21,11 +21,11 @@ module File_kind = struct
|
||||||
end
|
end
|
||||||
|
|
||||||
let file_kind () =
|
let file_kind () =
|
||||||
let open Sexp.Of_sexp in
|
let open Dsexp.Of_sexp in
|
||||||
Syntax.get_exn syntax >>| File_kind.of_syntax
|
Syntax.get_exn syntax >>| File_kind.of_syntax
|
||||||
|
|
||||||
module Of_sexp = struct
|
module Of_sexp = struct
|
||||||
include Sexp.Of_sexp
|
include Dsexp.Of_sexp
|
||||||
|
|
||||||
exception Parens_no_longer_necessary of Loc.t
|
exception Parens_no_longer_necessary of Loc.t
|
||||||
|
|
||||||
|
@ -88,7 +88,7 @@ module Of_sexp = struct
|
||||||
match Univ_map.find parsing_context (Syntax.key syntax) with
|
match Univ_map.find parsing_context (Syntax.key syntax) with
|
||||||
| Some (0, _) ->
|
| Some (0, _) ->
|
||||||
let last = Option.value_exn (List.last entries) in
|
let last = Option.value_exn (List.last entries) in
|
||||||
Loc.warn (Sexp.Ast.loc last)
|
Loc.warn (Dsexp.Ast.loc last)
|
||||||
"Field %S is present several times, previous occurrences are ignored."
|
"Field %S is present several times, previous occurrences are ignored."
|
||||||
name
|
name
|
||||||
| _ ->
|
| _ ->
|
||||||
|
|
|
@ -9,7 +9,7 @@ module Parser : sig
|
||||||
|
|
||||||
Each stanza in a configuration file might produce several values
|
Each stanza in a configuration file might produce several values
|
||||||
of type [t], hence the [t list] here. *)
|
of type [t], hence the [t list] here. *)
|
||||||
type nonrec t = string * t list Sexp.Of_sexp.t
|
type nonrec t = string * t list Dsexp.Of_sexp.t
|
||||||
end
|
end
|
||||||
|
|
||||||
(** Syntax identifier for the Dune language. [(0, X)] correspond to
|
(** Syntax identifier for the Dune language. [(0, X)] correspond to
|
||||||
|
@ -18,21 +18,21 @@ end
|
||||||
val syntax : Syntax.t
|
val syntax : Syntax.t
|
||||||
|
|
||||||
module File_kind : sig
|
module File_kind : sig
|
||||||
type t = Sexp.syntax = Jbuild | Dune
|
type t = Dsexp.syntax = Jbuild | Dune
|
||||||
|
|
||||||
val of_syntax : Syntax.Version.t -> t
|
val of_syntax : Syntax.Version.t -> t
|
||||||
end
|
end
|
||||||
|
|
||||||
(** Whether we are parsing a [jbuild] or [dune] file. *)
|
(** Whether we are parsing a [jbuild] or [dune] file. *)
|
||||||
val file_kind : unit -> (File_kind.t, _) Sexp.Of_sexp.parser
|
val file_kind : unit -> (File_kind.t, _) Dsexp.Of_sexp.parser
|
||||||
|
|
||||||
(** Overlay for [Sexp.Of_sexp] where lists and records don't require
|
(** Overlay for [Dsexp.Of_sexp] where lists and records don't require
|
||||||
an extra level of parentheses in Dune files.
|
an extra level of parentheses in Dune files.
|
||||||
|
|
||||||
Additionally, [field_xxx] functions only warn about duplicated
|
Additionally, [field_xxx] functions only warn about duplicated
|
||||||
fields in jbuild files, for backward compatibility. *)
|
fields in jbuild files, for backward compatibility. *)
|
||||||
module Of_sexp : sig
|
module Of_sexp : sig
|
||||||
include module type of struct include Sexp.Of_sexp end
|
include module type of struct include Dsexp.Of_sexp end
|
||||||
|
|
||||||
val record : 'a fields_parser -> 'a t
|
val record : 'a fields_parser -> 'a t
|
||||||
val list : 'a t -> 'a list t
|
val list : 'a t -> 'a list t
|
||||||
|
|
|
@ -34,10 +34,10 @@ let explode_path =
|
||||||
module External : sig
|
module External : sig
|
||||||
type t
|
type t
|
||||||
|
|
||||||
|
include Dsexp.Sexpable with type t := t
|
||||||
|
|
||||||
val compare : t -> t -> Ordering.t
|
val compare : t -> t -> Ordering.t
|
||||||
val compare_val : t -> t -> Ordering.t
|
val compare_val : t -> t -> Ordering.t
|
||||||
val t : t Sexp.Of_sexp.t
|
|
||||||
val sexp_of_t : t Sexp.To_sexp.t
|
|
||||||
val to_string : t -> string
|
val to_string : t -> string
|
||||||
val of_string : string -> t
|
val of_string : string -> t
|
||||||
val relative : t -> string -> t
|
val relative : t -> string -> t
|
||||||
|
@ -72,9 +72,9 @@ end = struct
|
||||||
make t
|
make t
|
||||||
|
|
||||||
let sexp_of_t t = Sexp.To_sexp.string (to_string t)
|
let sexp_of_t t = Sexp.To_sexp.string (to_string t)
|
||||||
let t = Sexp.Of_sexp.plain_string (fun ~loc t ->
|
let t = Dsexp.Of_sexp.plain_string (fun ~loc t ->
|
||||||
if Filename.is_relative t then
|
if Filename.is_relative t then
|
||||||
Sexp.Of_sexp.of_sexp_errorf loc "Absolute path expected"
|
Dsexp.Of_sexp.of_sexp_errorf loc "Absolute path expected"
|
||||||
else
|
else
|
||||||
of_string t)
|
of_string t)
|
||||||
|
|
||||||
|
@ -130,8 +130,7 @@ end
|
||||||
module Local : sig
|
module Local : sig
|
||||||
type t
|
type t
|
||||||
|
|
||||||
val t : t Sexp.Of_sexp.t
|
include Dsexp.Sexpable with type t := t
|
||||||
val sexp_of_t : t Sexp.To_sexp.t
|
|
||||||
val root : t
|
val root : t
|
||||||
val is_root : t -> bool
|
val is_root : t -> bool
|
||||||
val compare : t -> t -> Ordering.t
|
val compare : t -> t -> Ordering.t
|
||||||
|
@ -292,7 +291,7 @@ end = struct
|
||||||
relative root s ?error_loc
|
relative root s ?error_loc
|
||||||
|
|
||||||
let t =
|
let t =
|
||||||
Sexp.Of_sexp.plain_string (fun ~loc:error_loc s ->
|
Dsexp.Of_sexp.plain_string (fun ~loc:error_loc s ->
|
||||||
of_string s ~error_loc)
|
of_string s ~error_loc)
|
||||||
|
|
||||||
let rec mkdir_p t =
|
let rec mkdir_p t =
|
||||||
|
@ -608,7 +607,7 @@ let of_string ?error_loc s =
|
||||||
make_local_path (Local.of_string s ?error_loc)
|
make_local_path (Local.of_string s ?error_loc)
|
||||||
|
|
||||||
let t =
|
let t =
|
||||||
let open Sexp.Of_sexp in
|
let open Dsexp.Of_sexp in
|
||||||
if_list
|
if_list
|
||||||
~then_:
|
~then_:
|
||||||
(sum
|
(sum
|
||||||
|
|
|
@ -26,8 +26,7 @@ end
|
||||||
|
|
||||||
type t
|
type t
|
||||||
|
|
||||||
val t : t Sexp.Of_sexp.t
|
include Dsexp.Sexpable with type t := t
|
||||||
val sexp_of_t : t Sexp.To_sexp.t
|
|
||||||
|
|
||||||
val compare : t -> t -> Ordering.t
|
val compare : t -> t -> Ordering.t
|
||||||
(** a directory is smaller than its descendants *)
|
(** a directory is smaller than its descendants *)
|
||||||
|
|
|
@ -0,0 +1,10 @@
|
||||||
|
include module type of struct include Usexp end with module Loc := Usexp.Loc
|
||||||
|
|
||||||
|
module To_sexp : sig
|
||||||
|
type sexp = t
|
||||||
|
include Sexp_intf.Combinators with type 'a t = 'a -> t
|
||||||
|
|
||||||
|
val record : (string * sexp) list -> sexp
|
||||||
|
|
||||||
|
val unknown : _ t
|
||||||
|
end with type sexp := t
|
|
@ -95,7 +95,7 @@ end = struct
|
||||||
end
|
end
|
||||||
|
|
||||||
let t =
|
let t =
|
||||||
let open Sexp.Of_sexp in
|
let open Dsexp.Of_sexp in
|
||||||
let jbuild =
|
let jbuild =
|
||||||
raw >>| function
|
raw >>| function
|
||||||
| Template _ as t ->
|
| Template _ as t ->
|
||||||
|
@ -104,14 +104,14 @@ let t =
|
||||||
]
|
]
|
||||||
| Atom(loc, A s) -> Jbuild.parse s ~loc ~quoted:false
|
| Atom(loc, A s) -> Jbuild.parse s ~loc ~quoted:false
|
||||||
| Quoted_string (loc, s) -> Jbuild.parse s ~loc ~quoted:true
|
| Quoted_string (loc, s) -> Jbuild.parse s ~loc ~quoted:true
|
||||||
| List (loc, _) -> Sexp.Of_sexp.of_sexp_error loc "Atom expected"
|
| List (loc, _) -> Dsexp.Of_sexp.of_sexp_error loc "Atom expected"
|
||||||
in
|
in
|
||||||
let dune =
|
let dune =
|
||||||
raw >>| function
|
raw >>| function
|
||||||
| Template t -> t
|
| Template t -> t
|
||||||
| Atom(loc, A s) -> literal ~quoted:false ~loc s
|
| Atom(loc, A s) -> literal ~quoted:false ~loc s
|
||||||
| Quoted_string (loc, s) -> literal ~quoted:true ~loc s
|
| Quoted_string (loc, s) -> literal ~quoted:true ~loc s
|
||||||
| List (loc, _) -> Sexp.Of_sexp.of_sexp_error loc "Unexpected list"
|
| List (loc, _) -> Dsexp.Of_sexp.of_sexp_error loc "Unexpected list"
|
||||||
in
|
in
|
||||||
let template_parser = Stanza.Of_sexp.switch_file_kind ~jbuild ~dune in
|
let template_parser = Stanza.Of_sexp.switch_file_kind ~jbuild ~dune in
|
||||||
let%map syntax_version = Syntax.get_exn Stanza.syntax
|
let%map syntax_version = Syntax.get_exn Stanza.syntax
|
||||||
|
@ -203,7 +203,7 @@ module Var = struct
|
||||||
|
|
||||||
let to_string = string_of_var
|
let to_string = string_of_var
|
||||||
|
|
||||||
let sexp_of_t t = Sexp.atom (to_string t)
|
let sexp_of_t t = Dsexp.atom (to_string t)
|
||||||
|
|
||||||
let with_name t ~name =
|
let with_name t ~name =
|
||||||
{ t with name }
|
{ t with name }
|
||||||
|
|
|
@ -8,7 +8,7 @@ open Import
|
||||||
type t
|
type t
|
||||||
(** A sequence of text and variables. *)
|
(** A sequence of text and variables. *)
|
||||||
|
|
||||||
val t : t Sexp.Of_sexp.t
|
val t : t Dsexp.Of_sexp.t
|
||||||
(** [t ast] takes an [ast] sexp and returns a string-with-vars. This
|
(** [t ast] takes an [ast] sexp and returns a string-with-vars. This
|
||||||
function distinguishes between unquoted variables — such as ${@} —
|
function distinguishes between unquoted variables — such as ${@} —
|
||||||
and quoted variables — such as "${@}". *)
|
and quoted variables — such as "${@}". *)
|
||||||
|
|
|
@ -18,8 +18,8 @@ module Version = struct
|
||||||
|
|
||||||
let sexp_of_t t = Sexp.unsafe_atom_of_string (to_string t)
|
let sexp_of_t t = Sexp.unsafe_atom_of_string (to_string t)
|
||||||
|
|
||||||
let t : t Sexp.Of_sexp.t =
|
let t : t Dsexp.Of_sexp.t =
|
||||||
let open Sexp.Of_sexp in
|
let open Dsexp.Of_sexp in
|
||||||
raw >>| function
|
raw >>| function
|
||||||
| Atom (loc, A s) -> begin
|
| Atom (loc, A s) -> begin
|
||||||
try
|
try
|
||||||
|
@ -123,7 +123,7 @@ let greatest_supported_version t =
|
||||||
|
|
||||||
let key t = t.key
|
let key t = t.key
|
||||||
|
|
||||||
open Sexp.Of_sexp
|
open Dsexp.Of_sexp
|
||||||
|
|
||||||
let set t ver parser =
|
let set t ver parser =
|
||||||
set t.key ver parser
|
set t.key ver parser
|
||||||
|
|
|
@ -30,14 +30,14 @@ module type S = sig
|
||||||
(** [load fn ~f] loads a versioned file. It parses the first line,
|
(** [load fn ~f] loads a versioned file. It parses the first line,
|
||||||
looks up the language, checks that the version is supported and
|
looks up the language, checks that the version is supported and
|
||||||
parses the rest of the file with [f]. *)
|
parses the rest of the file with [f]. *)
|
||||||
val load : Path.t -> f:(Lang.Instance.t -> 'a Sexp.Of_sexp.t) -> 'a
|
val load : Path.t -> f:(Lang.Instance.t -> 'a Dsexp.Of_sexp.t) -> 'a
|
||||||
|
|
||||||
(** Parse the contents of a versioned file after the first line has
|
(** Parse the contents of a versioned file after the first line has
|
||||||
been read. *)
|
been read. *)
|
||||||
val parse_contents
|
val parse_contents
|
||||||
: Lexing.lexbuf
|
: Lexing.lexbuf
|
||||||
-> Dune_lexer.first_line
|
-> Dune_lexer.first_line
|
||||||
-> f:(Lang.Instance.t -> 'a Sexp.Of_sexp.t)
|
-> f:(Lang.Instance.t -> 'a Dsexp.Of_sexp.t)
|
||||||
-> 'a
|
-> 'a
|
||||||
end
|
end
|
||||||
|
|
||||||
|
|
|
@ -122,7 +122,7 @@ module Context = struct
|
||||||
(* jbuild-workspace files *)
|
(* jbuild-workspace files *)
|
||||||
(peek_exn >>= function
|
(peek_exn >>= function
|
||||||
| List (_, List _ :: _) ->
|
| List (_, List _ :: _) ->
|
||||||
Sexp.Of_sexp.record (Opam.t ~profile ~x) >>| fun x -> Opam x
|
Dsexp.Of_sexp.record (Opam.t ~profile ~x) >>| fun x -> Opam x
|
||||||
| _ -> t ~profile ~x)
|
| _ -> t ~profile ~x)
|
||||||
~dune:(t ~profile ~x)
|
~dune:(t ~profile ~x)
|
||||||
|
|
||||||
|
|
|
@ -9,7 +9,7 @@ let sexp_pp = Sexp.pp Dune;;
|
||||||
|
|
||||||
(* Dune_file.Executables.Link_mode.t *)
|
(* Dune_file.Executables.Link_mode.t *)
|
||||||
let test s =
|
let test s =
|
||||||
Sexp.Of_sexp.parse Dune_file.Executables.Link_mode.t Univ_map.empty
|
Dsexp.Of_sexp.parse Dune_file.Executables.Link_mode.t Univ_map.empty
|
||||||
(Sexp.parse_string ~fname:"" ~mode:Sexp.Parser.Mode.Single s)
|
(Sexp.parse_string ~fname:"" ~mode:Sexp.Parser.Mode.Single s)
|
||||||
[%%expect{|
|
[%%expect{|
|
||||||
val sexp_pp : Format.formatter -> Usexp.t -> unit = <fun>
|
val sexp_pp : Format.formatter -> Usexp.t -> unit = <fun>
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
(* -*- tuareg -*- *)
|
(* -*- tuareg -*- *)
|
||||||
open Stdune;;
|
open Stdune;;
|
||||||
open Sexp.Of_sexp;;
|
open Dsexp.Of_sexp;;
|
||||||
|
|
||||||
let print_loc ppf (_ : Sexp.Loc.t) = Format.pp_print_string ppf "<loc>";;
|
let print_loc ppf (_ : Sexp.Loc.t) = Format.pp_print_string ppf "<loc>";;
|
||||||
#install_printer print_loc;;
|
#install_printer print_loc;;
|
||||||
|
|
Loading…
Reference in New Issue