Use more precise combinators "atom" and "quoted_string"

src/action.ml

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

src/context.ml

@@ -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
+      Sexp.To_sexp.(record [ "root"  , atom o.root
-                           ; "switch", string o.switch
+                           ; "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
+    ; "opam_vars", atom_hashtbl atom t.opam_var_cache
-    ; "ocamlc_config", list (pair string string) t.ocamlc_config
+    ; "ocamlc_config", list (pair atom atom) t.ocamlc_config
-    ; "which", string_hashtbl (option path) t.which_cache
+    ; "which", atom_hashtbl (option path) t.which_cache
     ]
 
 let compare a b = compare a.name b.name

src/gen_rules.ml

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

src/ocamldep.ml

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

src/ordered_set_lang.ml

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

src/path.ml

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

src/sexp.ml

@@ -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 atom_set   : String_set.t            t
-  val string_map : 'a t -> 'a String_map.t   t
+  val atom_map   : 'a t -> 'a String_map.t   t
-  val string_hashtbl : 'a t -> (string, 'a) Hashtbl.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 atom_set set = list atom (String_set.elements set)
-  let string_map f map = list (pair string f) (String_map.bindings map)
+  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 =
+  let atom_hashtbl f h =
-    string_map f
+    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 atom_set sexp = String_set.of_list (list string sexp)
-  let string_map f 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 atom_hashtbl f sexp =
-    let map = string_map f sexp in
+    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);

src/sexp.mli

@@ -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 atom_set   : String_set.t            t
-  val string_hashtbl : 'a t -> (string, 'a) Hashtbl.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
 

src/super_context.ml

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

src/with_required_by.ml

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