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

Use more precise combinators "atom" and "quoted_string"

This commit is contained in:
Christophe Troestler 2018-02-12 23:35:56 +01:00
parent 91b38b6376
commit 67c9363c7d
10 changed files with 58 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
src/action.ml
View File

@ -180,7 +180,7 @@ module Prog = struct
let sexp_of_t = function
| Ok s -> Path.sexp_of_t s
| Error (e : Not_found.t) -> Sexp.To_sexp.string e.program
| Error (e : Not_found.t) -> Sexp.To_sexp.atom e.program
end
module type Ast = Action_intf.Ast
@ -192,7 +192,7 @@ module rec Ast : Ast = Ast
module String_with_sexp = struct
type t = string
let t = Sexp.Of_sexp.string
let sexp_of_t = Sexp.To_sexp.string
let sexp_of_t = Sexp.To_sexp.atom
end
include Make_ast

16
src/context.ml
View File

@ -13,8 +13,8 @@ module Kind = struct
let sexp_of_t : t -> Sexp.t = function
| Default -> Atom "default"
| Opam o ->
Sexp.To_sexp.(record [ "root" , string o.root
; "switch", string o.switch
Sexp.To_sexp.(record [ "root" , atom o.root
; "switch", atom o.switch
])
end
@ -92,10 +92,10 @@ let sexp_of_t t =
let open Sexp.To_sexp in
let path = Path.sexp_of_t in
record
[ "name", string t.name
[ "name", atom t.name
; "kind", Kind.sexp_of_t t.kind
; "merlin", bool t.merlin
; "for_host", option string (Option.map t.for_host ~f:(fun t -> t.name))
; "for_host", option atom (Option.map t.for_host ~f:(fun t -> t.name))
; "build_dir", path t.build_dir
; "toplevel_path", option path t.toplevel_path
; "ocaml_bin", path t.ocaml_bin
@ -104,13 +104,13 @@ let sexp_of_t t =
; "ocamlopt", option path t.ocamlopt
; "ocamldep", path t.ocamldep
; "ocamlmklib", path t.ocamlmklib
; "env", list (pair string string) (Env_var_map.bindings t.env_extra)
; "env", list (pair atom atom) (Env_var_map.bindings t.env_extra)
; "findlib_path", list path (Findlib.path t.findlib)
; "arch_sixtyfour", bool t.arch_sixtyfour
; "natdynlink_supported", bool t.natdynlink_supported
; "opam_vars", string_hashtbl string t.opam_var_cache
; "ocamlc_config", list (pair string string) t.ocamlc_config
; "which", string_hashtbl (option path) t.which_cache
; "opam_vars", atom_hashtbl atom t.opam_var_cache
; "ocamlc_config", list (pair atom atom) t.ocamlc_config
; "which", atom_hashtbl (option path) t.which_cache
]
let compare a b = compare a.name b.name

2
src/gen_rules.ml
View File

@ -84,7 +84,7 @@ module Gen(P : Params) = struct
\n\
\nThis will become an error in the future."
(Sexp.to_string (List [ Atom "modules_without_implementation"
; Sexp.To_sexp.(list string) should_be_listed
; Sexp.To_sexp.(list atom) should_be_listed
]))
| Some loc ->
Loc.warn loc

2
src/ocamldep.ml
View File

@ -15,7 +15,7 @@ module Dep_graph = struct
| None ->
Sexp.code_error "Ocamldep.Dep_graph.deps_of"
[ "dir", Path.sexp_of_t t.dir
; "modules", Sexp.To_sexp.(list string) (String_map.keys t.per_module)
; "modules", Sexp.To_sexp.(list atom) (String_map.keys t.per_module)
; "module", Atom m.name
]

2
src/ordered_set_lang.ml
View File

@ -195,7 +195,7 @@ module Unexpanded = struct
Sexp.code_error
"Ordered_set_lang.Unexpanded.expand"
[ "included-file", Atom fn
; "files", Sexp.To_sexp.(list string) (String_map.keys files_contents)
; "files", Sexp.To_sexp.(list atom) (String_map.keys files_contents)
]
in
parse_general sexp ~f:(fun sexp ->

2
src/path.ml
View File

@ -222,7 +222,7 @@ let compare = String.compare
module Set = struct
include String_set
let sexp_of_t t = Sexp.To_sexp.(list string) (String_set.elements t)
let sexp_of_t t = Sexp.To_sexp.(list atom) (String_set.elements t)
let of_string_set = map
end

37
src/sexp.ml
View File

@ -68,7 +68,8 @@ let load_many_or_ocaml_script fname =
module type Combinators = sig
type 'a t
val unit : unit t
val string : string t
val atom : string t
val quoted_string : string t
val int : int t
val float : float t
val bool : bool t
@ -77,15 +78,16 @@ module type Combinators = sig
val list : 'a t -> 'a list t
val array : 'a t -> 'a array t
val option : 'a t -> 'a option t
val string_set : String_set.t t
val string_map : 'a t -> 'a String_map.t t
val string_hashtbl : 'a t -> (string, 'a) Hashtbl.t t
val atom_set : String_set.t t
val atom_map : 'a t -> 'a String_map.t t
val atom_hashtbl : 'a t -> (string, 'a) Hashtbl.t t
end
module To_sexp = struct
type nonrec 'a t = 'a -> t
let unit () = List []
let string s = Quoted_string s
let atom a = Atom a
let quoted_string s = Quoted_string s
let int n = Atom (string_of_int n)
let float f = Atom (string_of_float f)
let bool b = Atom (string_of_bool b)
@ -96,12 +98,12 @@ module To_sexp = struct
let option f = function
| None -> List []
| Some x -> List [f x]
let string_set set = list string (String_set.elements set)
let string_map f map = list (pair string f) (String_map.bindings map)
let atom_set set = list atom (String_set.elements set)
let atom_map f map = list (pair atom f) (String_map.bindings map)
let record l =
List (List.map l ~f:(fun (n, v) -> List [Atom n; v]))
let string_hashtbl f h =
string_map f
let atom_hashtbl f h =
atom_map f
(Hashtbl.fold h ~init:String_map.empty ~f:(fun ~key ~data acc ->
String_map.add acc ~key ~data))
end
@ -124,6 +126,15 @@ module Of_sexp = struct
| List (_, []) -> ()
| sexp -> of_sexp_error sexp "() expected"
let atom = function
| Atom (_, s) -> s
| (Quoted_string _ | List _) as sexp ->
of_sexp_error sexp "Atom expected"
let quoted_string = function
| Quoted_string (_, s) -> s
| (Atom _ | List _) as sexp -> of_sexp_error sexp "Quoted_string expected"
let string = function
| Atom (_, s) -> s
| Quoted_string (_, s) -> s
@ -163,15 +174,15 @@ module Of_sexp = struct
| List (_, [x]) -> Some (f x)
| sexp -> of_sexp_error sexp "S-expression of the form () or (_) expected"
let string_set sexp = String_set.of_list (list string sexp)
let string_map f sexp =
let atom_set sexp = String_set.of_list (list string sexp)
let atom_map f sexp =
match String_map.of_alist (list (pair string f) sexp) with
| Ok x -> x
| Error (key, _v1, _v2) ->
of_sexp_error sexp (sprintf "key %S present multiple times" key)
let string_hashtbl f sexp =
let map = string_map f sexp in
let atom_hashtbl f sexp =
let map = atom_map f sexp in
let tbl = Hashtbl.create (String_map.cardinal map + 32) in
String_map.iter map ~f:(fun ~key ~data ->
Hashtbl.add tbl ~key ~data);

20
src/sexp.mli
View File

@ -16,7 +16,8 @@ val load_many_or_ocaml_script : string -> sexps_or_ocaml_script
module type Combinators = sig
type 'a t
val unit : unit t
val string : string t
val atom : string t
val quoted_string : string t
val int : int t
val float : float t
val bool : bool t
@ -25,9 +26,17 @@ module type Combinators = sig
val list : 'a t -> 'a list t
val array : 'a t -> 'a array t
val option : 'a t -> 'a option t
val string_set : String_set.t t
val string_map : 'a t -> 'a String_map.t t
val string_hashtbl : 'a t -> (string, 'a) Hashtbl.t t
val atom_set : String_set.t t
(** [atom_set] is a conversion to/from a set of strings representing atoms. *)
val atom_map : 'a t -> 'a String_map.t t
(** [atom_map conv]: given a conversion [conv] to/from ['a], returns
a conversion to/from a map where the keys are atoms and the
values are of type ['a]. *)
val atom_hashtbl : 'a t -> (string, 'a) Hashtbl.t t
(** [atom_hashtbl conv] is similar to [atom_map] for hash tables. *)
end
module To_sexp : sig
@ -45,6 +54,9 @@ module Of_sexp : sig
include Combinators with type 'a t = Ast.t -> 'a
val string : Ast.t -> string
(** Convert and [Atom] or a [Quoted_string] to s string. *)
val of_sexp_error : Ast.t -> string -> _
val of_sexp_errorf : Ast.t -> ('a, unit, string, 'b) format4 -> 'a

6
src/super_context.ml
View File

@ -111,7 +111,7 @@ let create
(struct type t = Lib.t list end)
(struct
open Sexp.To_sexp
let t _dir l = list string (List.map l ~f:Lib.best_name)
let t _dir l = list atom (List.map l ~f:Lib.best_name)
end)
(struct
open Sexp.Of_sexp
@ -439,7 +439,7 @@ module Pkg_version = struct
module V = Vfile_kind.Make(struct type t = string option end)
(functor (C : Sexp.Combinators) -> struct
let t = C.option C.string
let t = C.option C.atom
end)
let spec sctx (p : Package.t) =
@ -966,7 +966,7 @@ module PP = struct
let add_alias fn build =
Alias.add_action sctx.build_system alias build
~stamp:(List [ Atom "lint"
; Sexp.To_sexp.(option string) lib_name
; Sexp.To_sexp.(option atom) lib_name
; Atom fn
])
in

2
src/with_required_by.ml
View File

@ -13,7 +13,7 @@ module Entry = struct
| Path p -> Utils.describe_target p
| Alias p -> "alias " ^ Utils.describe_target p
| Library s -> sprintf "library %S" s
| Preprocess l -> Sexp.to_string (List [Atom "pps"; Sexp.To_sexp.(list string) l])
| Preprocess l -> Sexp.to_string (List [Atom "pps"; Sexp.To_sexp.(list atom) l])
let pp ppf x =
Format.pp_print_string ppf (to_string x)