Move a bunch of parsing to Dsexp

Signed-off-by: Rudi Grinberg <rudi.grinberg@gmail.com>
This commit is contained in:
Rudi Grinberg 2018-08-21 19:31:54 +03:00
parent 9c9ea7c60a
commit 328ad3411c
36 changed files with 147 additions and 139 deletions

View File

@ -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

View File

@ -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 *)

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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 +=

View File

@ -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 }
} }

View File

@ -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

View File

@ -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 =

View File

@ -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),

View File

@ -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

View File

@ -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. *)

View File

@ -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"

View File

@ -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)

View File

@ -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

View File

@ -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) =

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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 []

View File

@ -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 }

View File

@ -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
| _ -> | _ ->

View File

@ -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

View File

@ -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

View File

@ -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 *)

10
src/stdune/sexp.mli Normal file
View File

@ -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

View File

@ -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 }

View File

@ -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 "${@}". *)

View File

@ -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

View File

@ -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

View File

@ -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)

View File

@ -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>

View File

@ -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;;