Make Atom.t private and consequences (#524)
This commit is contained in:
parent
8a81c79531
commit
fbafb3d47a
|
@ -872,7 +872,8 @@ let rules =
|
|||
; "targets", paths rule.targets ]
|
||||
; (match rule.context with
|
||||
| None -> []
|
||||
| Some c -> ["context", Atom c.name])
|
||||
| Some c -> ["context",
|
||||
Sexp.atom_or_quoted_string c.name])
|
||||
; [ "action" , sexp_of_action rule.action ]
|
||||
])
|
||||
in
|
||||
|
|
|
@ -69,38 +69,45 @@ struct
|
|||
let rec sexp_of_t : _ -> Sexp.t =
|
||||
let path = Path.sexp_of_t and string = String.sexp_of_t in
|
||||
function
|
||||
| Run (a, xs) -> List (Atom "run" :: Program.sexp_of_t a :: List.map xs ~f:string)
|
||||
| Chdir (a, r) -> List [Atom "chdir" ; path a ; sexp_of_t r]
|
||||
| Setenv (k, v, r) -> List [Atom "setenv" ; string k ; string v ; sexp_of_t r]
|
||||
| Run (a, xs) -> List (Sexp.unsafe_atom_of_string "run"
|
||||
:: Program.sexp_of_t a :: List.map xs ~f:string)
|
||||
| Chdir (a, r) -> List [Sexp.unsafe_atom_of_string "chdir" ;
|
||||
path a ; sexp_of_t r]
|
||||
| Setenv (k, v, r) -> List [Sexp.unsafe_atom_of_string "setenv" ;
|
||||
string k ; string v ; sexp_of_t r]
|
||||
| Redirect (outputs, fn, r) ->
|
||||
List [ Atom (sprintf "with-%s-to" (Outputs.to_string outputs))
|
||||
List [ Sexp.atom (sprintf "with-%s-to" (Outputs.to_string outputs))
|
||||
; path fn
|
||||
; sexp_of_t r
|
||||
]
|
||||
| Ignore (outputs, r) ->
|
||||
List [ Atom (sprintf "ignore-%s" (Outputs.to_string outputs))
|
||||
List [ Sexp.atom (sprintf "ignore-%s" (Outputs.to_string outputs))
|
||||
; sexp_of_t r
|
||||
]
|
||||
| Progn l -> List (Atom "progn" :: List.map l ~f:sexp_of_t)
|
||||
| Echo x -> List [Atom "echo"; string x]
|
||||
| Cat x -> List [Atom "cat"; path x]
|
||||
| Progn l -> List (Sexp.unsafe_atom_of_string "progn"
|
||||
:: List.map l ~f:sexp_of_t)
|
||||
| Echo x -> List [Sexp.unsafe_atom_of_string "echo"; string x]
|
||||
| Cat x -> List [Sexp.unsafe_atom_of_string "cat"; path x]
|
||||
| Copy (x, y) ->
|
||||
List [Atom "copy"; path x; path y]
|
||||
List [Sexp.unsafe_atom_of_string "copy"; path x; path y]
|
||||
| Symlink (x, y) ->
|
||||
List [Atom "symlink"; path x; path y]
|
||||
List [Sexp.unsafe_atom_of_string "symlink"; path x; path y]
|
||||
| Copy_and_add_line_directive (x, y) ->
|
||||
List [Atom "copy#"; path x; path y]
|
||||
| System x -> List [Atom "system"; string x]
|
||||
| Bash x -> List [Atom "bash"; string x]
|
||||
| Write_file (x, y) -> List [Atom "write-file"; path x; string y]
|
||||
| Rename (x, y) -> List [Atom "rename"; path x; path y]
|
||||
| Remove_tree x -> List [Atom "remove-tree"; path x]
|
||||
| Mkdir x -> List [Atom "mkdir"; path x]
|
||||
| Digest_files paths -> List [Atom "digest-files"; List (List.map paths ~f:path)]
|
||||
List [Sexp.unsafe_atom_of_string "copy#"; path x; path y]
|
||||
| System x -> List [Sexp.unsafe_atom_of_string "system"; string x]
|
||||
| Bash x -> List [Sexp.unsafe_atom_of_string "bash"; string x]
|
||||
| Write_file (x, y) -> List [Sexp.unsafe_atom_of_string "write-file";
|
||||
path x; string y]
|
||||
| Rename (x, y) -> List [Sexp.unsafe_atom_of_string "rename";
|
||||
path x; path y]
|
||||
| Remove_tree x -> List [Sexp.unsafe_atom_of_string "remove-tree"; path x]
|
||||
| Mkdir x -> List [Sexp.unsafe_atom_of_string "mkdir"; path x]
|
||||
| Digest_files paths -> List [Sexp.unsafe_atom_of_string "digest-files";
|
||||
List (List.map paths ~f:path)]
|
||||
| Diff { optional = false; file1; file2 } ->
|
||||
List [Atom "diff"; path file1; path file2]
|
||||
List [Sexp.unsafe_atom_of_string "diff"; path file1; path file2]
|
||||
| Diff { optional = true; file1; file2 } ->
|
||||
List [Atom "diff?"; path file1; path file2]
|
||||
List [Sexp.unsafe_atom_of_string "diff?"; path file1; path file2]
|
||||
|
||||
let run prog args = Run (prog, args)
|
||||
let chdir path t = Chdir (path, t)
|
||||
|
@ -180,7 +187,7 @@ module Prog = struct
|
|||
|
||||
let sexp_of_t = function
|
||||
| Ok s -> Path.sexp_of_t s
|
||||
| Error (e : Not_found.t) -> Sexp.To_sexp.atom e.program
|
||||
| Error (e : Not_found.t) -> Sexp.To_sexp.string e.program
|
||||
end
|
||||
|
||||
module type Ast = Action_intf.Ast
|
||||
|
@ -192,7 +199,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.atom
|
||||
let sexp_of_t = Sexp.To_sexp.string
|
||||
end
|
||||
|
||||
include Make_ast
|
||||
|
@ -345,7 +352,7 @@ module Unexpanded = struct
|
|||
Loc.fail loc
|
||||
"(mkdir ...) is not supported for paths outside of the workspace:\n\
|
||||
\ %a\n"
|
||||
Sexp.pp (List [Atom "mkdir"; Path.sexp_of_t path])
|
||||
Sexp.pp (List [Sexp.unsafe_atom_of_string "mkdir"; Path.sexp_of_t path])
|
||||
|
||||
module Partial = struct
|
||||
module Program = Unresolved.Program
|
||||
|
@ -594,7 +601,7 @@ module Promotion = struct
|
|||
}
|
||||
|
||||
let t = function
|
||||
| Sexp.Ast.List (_, [src; Atom (_, "as"); dst]) ->
|
||||
| Sexp.Ast.List (_, [src; Atom (_, A "as"); dst]) ->
|
||||
{ src = Path.t src
|
||||
; dst = Path.t dst
|
||||
}
|
||||
|
@ -602,7 +609,8 @@ module Promotion = struct
|
|||
Sexp.Of_sexp.of_sexp_errorf sexp "(<file> as <file>) expected"
|
||||
|
||||
let sexp_of_t { src; dst } =
|
||||
Sexp.List [Path.sexp_of_t src; Atom "as"; Path.sexp_of_t dst]
|
||||
Sexp.List [Path.sexp_of_t src; Sexp.unsafe_atom_of_string "as";
|
||||
Path.sexp_of_t dst]
|
||||
|
||||
let db : t list ref = ref []
|
||||
|
||||
|
|
|
@ -1086,7 +1086,8 @@ module Trace = struct
|
|||
Pmap.add acc ~key ~data)
|
||||
|> Path.Map.bindings
|
||||
|> List.map ~f:(fun (path, hash) ->
|
||||
Sexp.List [ Atom (Path.to_string path); Atom (Digest.to_hex hash) ]))
|
||||
Sexp.List [ Path.sexp_of_t path;
|
||||
Atom (Sexp.Atom.of_digest hash) ]))
|
||||
in
|
||||
if Sys.file_exists "_build" then
|
||||
Io.write_file file (Sexp.to_string sexp)
|
||||
|
|
|
@ -11,10 +11,10 @@ module Kind = struct
|
|||
type t = Default | Opam of Opam.t
|
||||
|
||||
let sexp_of_t : t -> Sexp.t = function
|
||||
| Default -> Atom "default"
|
||||
| Default -> Sexp.unsafe_atom_of_string "default"
|
||||
| Opam o ->
|
||||
Sexp.To_sexp.(record [ "root" , atom o.root
|
||||
; "switch", atom o.switch
|
||||
Sexp.To_sexp.(record [ "root" , string o.root
|
||||
; "switch", string 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", atom t.name
|
||||
[ "name", string t.name
|
||||
; "kind", Kind.sexp_of_t t.kind
|
||||
; "merlin", bool t.merlin
|
||||
; "for_host", option atom (Option.map t.for_host ~f:(fun t -> t.name))
|
||||
; "for_host", option string (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 atom atom) (Env_var_map.bindings t.env_extra)
|
||||
; "env", list (pair string string) (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", atom_hashtbl atom t.opam_var_cache
|
||||
; "opam_vars", string_hashtbl string t.opam_var_cache
|
||||
; "ocamlc_config", Ocamlc_config.sexp_of_t t.ocamlc_config
|
||||
; "which", atom_hashtbl (option path) t.which_cache
|
||||
; "which", string_hashtbl (option path) t.which_cache
|
||||
]
|
||||
|
||||
let compare a b = compare a.name b.name
|
||||
|
|
|
@ -101,8 +101,10 @@ module Gen(P : Params) = struct
|
|||
\n %s\
|
||||
\n\
|
||||
\nThis will become an error in the future."
|
||||
(Sexp.to_string (List [ Atom "modules_without_implementation"
|
||||
; Sexp.To_sexp.(list atom) should_be_listed
|
||||
(let tag = Sexp.unsafe_atom_of_string
|
||||
"modules_without_implementation" in
|
||||
Sexp.to_string (List [ tag
|
||||
; Sexp.To_sexp.(list string) should_be_listed
|
||||
]))
|
||||
| Some loc ->
|
||||
Loc.warn loc
|
||||
|
@ -804,7 +806,7 @@ module Gen(P : Params) = struct
|
|||
let stamp =
|
||||
let module S = Sexp.To_sexp in
|
||||
Sexp.List
|
||||
[ Atom "user-alias"
|
||||
[ Sexp.unsafe_atom_of_string "user-alias"
|
||||
; S.list Jbuild.Dep_conf.sexp_of_t alias_conf.deps
|
||||
; S.option Action.Unexpanded.sexp_of_t alias_conf.action
|
||||
]
|
||||
|
|
|
@ -205,7 +205,7 @@ module Pp_or_flags = struct
|
|||
PP (Pp.of_string s)
|
||||
|
||||
let t = function
|
||||
| Atom (_, s) | Quoted_string (_, s) -> of_string s
|
||||
| Atom (_, A s) | Quoted_string (_, s) -> of_string s
|
||||
| List (_, l) -> Flags (List.map l ~f:string)
|
||||
|
||||
let split l =
|
||||
|
@ -246,15 +246,18 @@ module Dep_conf = struct
|
|||
open Sexp
|
||||
let sexp_of_t = function
|
||||
| File t ->
|
||||
List [Atom "file" ; String_with_vars.sexp_of_t t]
|
||||
List [Sexp.unsafe_atom_of_string "file" ; String_with_vars.sexp_of_t t]
|
||||
| Alias t ->
|
||||
List [Atom "alias" ; String_with_vars.sexp_of_t t]
|
||||
List [Sexp.unsafe_atom_of_string "alias" ; String_with_vars.sexp_of_t t]
|
||||
| Alias_rec t ->
|
||||
List [Atom "alias_rec" ; String_with_vars.sexp_of_t t]
|
||||
List [Sexp.unsafe_atom_of_string "alias_rec" ;
|
||||
String_with_vars.sexp_of_t t]
|
||||
| Glob_files t ->
|
||||
List [Atom "glob_files" ; String_with_vars.sexp_of_t t]
|
||||
List [Sexp.unsafe_atom_of_string "glob_files" ;
|
||||
String_with_vars.sexp_of_t t]
|
||||
| Files_recursively_in t ->
|
||||
List [Atom "files_recursively_in" ; String_with_vars.sexp_of_t t]
|
||||
List [Sexp.unsafe_atom_of_string "files_recursively_in" ;
|
||||
String_with_vars.sexp_of_t t]
|
||||
end
|
||||
|
||||
module Preprocess = struct
|
||||
|
@ -283,7 +286,7 @@ module Per_module = struct
|
|||
|
||||
let t ~default a sexp =
|
||||
match sexp with
|
||||
| List (_, Atom (_, "per_module") :: rest) -> begin
|
||||
| List (_, Atom (_, A "per_module") :: rest) -> begin
|
||||
List.map rest ~f:(fun sexp ->
|
||||
let pp, names = pair a module_names sexp in
|
||||
(String_set.elements names, pp))
|
||||
|
@ -364,7 +367,7 @@ module Lib_dep = struct
|
|||
let choice = function
|
||||
| List (_, l) as sexp ->
|
||||
let rec loop required forbidden = function
|
||||
| [Atom (_, "->"); fsexp] ->
|
||||
| [Atom (_, A "->"); fsexp] ->
|
||||
let common = String_set.inter required forbidden in
|
||||
if not (String_set.is_empty common) then
|
||||
of_sexp_errorf sexp
|
||||
|
@ -374,10 +377,10 @@ module Lib_dep = struct
|
|||
; forbidden
|
||||
; file = file fsexp
|
||||
}
|
||||
| Atom (_, "->") :: _
|
||||
| Atom (_, A "->") :: _
|
||||
| List _ :: _ | [] ->
|
||||
of_sexp_error sexp "(<[!]libraries>... -> <file>) expected"
|
||||
| (Atom (_, s) | Quoted_string (_, s)) :: l ->
|
||||
| (Atom (_, A s) | Quoted_string (_, s)) :: l ->
|
||||
let len = String.length s in
|
||||
if len > 0 && s.[0] = '!' then
|
||||
let s = String.sub s ~pos:1 ~len:(len - 1) in
|
||||
|
@ -389,9 +392,9 @@ module Lib_dep = struct
|
|||
| sexp -> of_sexp_error sexp "(<library-name> <code>) expected"
|
||||
|
||||
let t = function
|
||||
| Atom (_, s) ->
|
||||
| Atom (_, A s) ->
|
||||
Direct s
|
||||
| List (loc, Atom (_, "select") :: m :: Atom (_, "from") :: libs) ->
|
||||
| List (loc, Atom (_, A "select") :: m :: Atom (_, A "from") :: libs) ->
|
||||
Select { result_fn = file m
|
||||
; choices = List.map libs ~f:choice
|
||||
; loc
|
||||
|
@ -641,8 +644,8 @@ module Install_conf = struct
|
|||
|
||||
let file sexp =
|
||||
match sexp with
|
||||
| Atom (_, src) -> { src; dst = None }
|
||||
| List (_, [Atom (_, src); Atom (_, "as"); Atom (_, dst)]) ->
|
||||
| Atom (_, A src) -> { src; dst = None }
|
||||
| List (_, [Atom (_, A src); Atom (_, A "as"); Atom (_, A dst)]) ->
|
||||
{ src; dst = Some dst }
|
||||
| _ ->
|
||||
of_sexp_error sexp
|
||||
|
@ -1064,7 +1067,7 @@ module Stanzas = struct
|
|||
and parse ~default_version ~file ~include_stack pkgs sexps =
|
||||
let versions, sexps =
|
||||
List.partition_map sexps ~f:(function
|
||||
| List (loc, [Atom (_, "jbuild_version"); ver]) ->
|
||||
| List (loc, [Atom (_, A "jbuild_version"); ver]) ->
|
||||
Inl (Jbuild_version.t ver, loc)
|
||||
| sexp -> Inr sexp)
|
||||
in
|
||||
|
|
15
src/lib.ml
15
src/lib.ml
|
@ -452,19 +452,22 @@ and resolve_name db name ~stack =
|
|||
in
|
||||
(* Add [init] to the table, to detect loops *)
|
||||
Option.iter (Hashtbl.find db.table name) ~f:(fun x ->
|
||||
let to_sexp = Sexp.To_sexp.(pair Path.sexp_of_t atom) in
|
||||
let to_sexp = Sexp.To_sexp.(pair Path.sexp_of_t string) in
|
||||
let sexp =
|
||||
match x with
|
||||
| Initializing x ->
|
||||
Sexp.List [Atom "Initializing"; Path.sexp_of_t x.path]
|
||||
| Done (Ok t) -> List [Atom "Ok"; Path.sexp_of_t t.src_dir]
|
||||
| Done (Error Not_found) -> Atom "Not_found"
|
||||
Sexp.List [Sexp.unsafe_atom_of_string "Initializing";
|
||||
Path.sexp_of_t x.path]
|
||||
| Done (Ok t) -> List [Sexp.unsafe_atom_of_string "Ok";
|
||||
Path.sexp_of_t t.src_dir]
|
||||
| Done (Error Not_found) -> Sexp.unsafe_atom_of_string "Not_found"
|
||||
| Done (Error (Hidden { info; reason; _ })) ->
|
||||
List [Atom "Hidden"; Path.sexp_of_t info.src_dir; Atom reason]
|
||||
List [Sexp.unsafe_atom_of_string "Hidden";
|
||||
Path.sexp_of_t info.src_dir; Sexp.atom reason]
|
||||
in
|
||||
Sexp.code_error
|
||||
"Lib_db.DB: resolver returned name that's already in the table"
|
||||
[ "name" , Atom name
|
||||
[ "name" , Sexp.atom name
|
||||
; "returned_lib" , to_sexp (info.src_dir, name)
|
||||
; "conflicting_with", sexp
|
||||
]);
|
||||
|
|
|
@ -11,7 +11,7 @@ let ocamlc_config_cmd ocamlc =
|
|||
|
||||
let sexp_of_t t =
|
||||
let open Sexp.To_sexp in
|
||||
atom_map atom t.bindings
|
||||
string_map Sexp.atom_or_quoted_string t.bindings
|
||||
|
||||
let read ~ocamlc ~env =
|
||||
Process.run_capture_lines ~env Strict (Path.to_string ocamlc) ["-config"]
|
||||
|
|
|
@ -15,8 +15,8 @@ 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 atom) (String_map.keys t.per_module)
|
||||
; "module", Atom m.name
|
||||
; "modules", Sexp.To_sexp.(list string) (String_map.keys t.per_module)
|
||||
; "module", Sexp.atom m.name
|
||||
]
|
||||
|
||||
module Dep_closure =
|
||||
|
|
|
@ -24,16 +24,17 @@ let loc t = t.loc
|
|||
|
||||
let parse_general sexp ~f =
|
||||
let rec of_sexp : Sexp.Ast.t -> _ = function
|
||||
| Atom (loc, "\\") -> Loc.fail loc "unexpected \\"
|
||||
| (Atom (_, "") | Quoted_string (_, _)) as t -> Ast.Element (f t)
|
||||
| Atom (loc, s) as t ->
|
||||
| Atom (loc, A "\\") -> Loc.fail loc "unexpected \\"
|
||||
| (Atom (_, A "") | Quoted_string (_, _)) as t -> Ast.Element (f t)
|
||||
| Atom (loc, A s) as t ->
|
||||
if s.[0] = ':' then
|
||||
Special (loc, String.sub s ~pos:1 ~len:(String.length s - 1))
|
||||
else
|
||||
Element (f t)
|
||||
| List (_, sexps) -> of_sexps [] sexps
|
||||
and of_sexps acc = function
|
||||
| Atom (_, "\\") :: sexps -> Diff (Union (List.rev acc), of_sexps [] sexps)
|
||||
| Atom (_, A "\\") :: sexps ->
|
||||
Diff (Union (List.rev acc), of_sexps [] sexps)
|
||||
| elt :: sexps ->
|
||||
of_sexps (of_sexp elt :: acc) sexps
|
||||
| [] -> Union (List.rev acc)
|
||||
|
@ -43,7 +44,7 @@ let parse_general sexp ~f =
|
|||
let t sexp : t =
|
||||
let ast =
|
||||
parse_general sexp ~f:(function
|
||||
| Atom (loc, s) | Quoted_string (loc, s) -> (loc, s)
|
||||
| Atom (loc, A s) | Quoted_string (loc, s) -> (loc, s)
|
||||
| List _ -> assert false)
|
||||
in
|
||||
{ ast
|
||||
|
@ -194,8 +195,8 @@ module Unexpanded = struct
|
|||
| None ->
|
||||
Sexp.code_error
|
||||
"Ordered_set_lang.Unexpanded.expand"
|
||||
[ "included-file", Atom fn
|
||||
; "files", Sexp.To_sexp.(list atom) (String_map.keys files_contents)
|
||||
[ "included-file", Quoted_string fn
|
||||
; "files", Sexp.To_sexp.(list string) (String_map.keys files_contents)
|
||||
]
|
||||
in
|
||||
parse_general sexp ~f:(fun sexp ->
|
||||
|
|
11
src/path.ml
11
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 atom) (String_set.elements t)
|
||||
let sexp_of_t t = Sexp.To_sexp.(list string) (String_set.elements t)
|
||||
let of_string_set = map
|
||||
end
|
||||
|
||||
|
@ -270,7 +270,7 @@ let of_string ?error_loc s =
|
|||
s
|
||||
|
||||
let t sexp = of_string (Sexp.Of_sexp.string sexp) ~error_loc:(Sexp.Ast.loc sexp)
|
||||
let sexp_of_t t = Sexp.Atom (to_string t)
|
||||
let sexp_of_t t = Sexp.atom_or_quoted_string (to_string t)
|
||||
|
||||
let absolute fn =
|
||||
if is_local fn then
|
||||
|
@ -424,7 +424,8 @@ let explode_exn t =
|
|||
else if is_local t then
|
||||
String.split t ~on:'/'
|
||||
else
|
||||
Sexp.code_error "Path.explode_exn" ["path", Atom t]
|
||||
Sexp.code_error "Path.explode_exn"
|
||||
["path", Sexp.atom_or_quoted_string t]
|
||||
|
||||
let exists t = Sys.file_exists (to_string t)
|
||||
let readdir t = Sys.readdir (to_string t) |> Array.to_list
|
||||
|
@ -457,8 +458,8 @@ let insert_after_build_dir_exn =
|
|||
let error a b =
|
||||
Sexp.code_error
|
||||
"Path.insert_after_build_dir_exn"
|
||||
[ "path" , Atom a
|
||||
; "insert", Atom b
|
||||
[ "path" , Sexp.unsafe_atom_of_string a
|
||||
; "insert", Sexp.unsafe_atom_of_string b
|
||||
]
|
||||
in
|
||||
fun a b ->
|
||||
|
|
|
@ -29,7 +29,7 @@ module DB = struct
|
|||
if Path.is_root d || not (Path.is_local d) then
|
||||
Sexp.code_error "Scope.DB.find_by_dir got an invalid path"
|
||||
[ "dir" , Path.sexp_of_t dir
|
||||
; "context", Sexp.To_sexp.atom t.context
|
||||
; "context", Sexp.To_sexp.string t.context
|
||||
];
|
||||
let scope = loop (Path.parent d) in
|
||||
Hashtbl.add t.by_dir ~key:d ~data:scope;
|
||||
|
@ -42,8 +42,8 @@ module DB = struct
|
|||
| Some x -> x
|
||||
| None ->
|
||||
Sexp.code_error "Scope.DB.find_by_name"
|
||||
[ "name" , Sexp.To_sexp.(option atom) name
|
||||
; "context", Sexp.To_sexp.atom t.context
|
||||
[ "name" , Sexp.To_sexp.(option string) name
|
||||
; "context", Sexp.To_sexp.string t.context
|
||||
]
|
||||
|
||||
let create ~scopes ~context ~installed_libs internal_libs =
|
||||
|
@ -55,7 +55,7 @@ module DB = struct
|
|||
| Ok x -> x
|
||||
| Error (_name, scope1, scope2) ->
|
||||
let to_sexp (scope : Jbuild.Scope_info.t) =
|
||||
Sexp.To_sexp.(pair (option atom) Path.sexp_of_t)
|
||||
Sexp.To_sexp.(pair (option string) Path.sexp_of_t)
|
||||
(scope.name, scope.root)
|
||||
in
|
||||
Sexp.code_error "Scope.DB.create got two scopes with the same name"
|
||||
|
|
75
src/sexp.ml
75
src/sexp.ml
|
@ -5,9 +5,9 @@ include (Usexp : module type of struct include Usexp end
|
|||
|
||||
let code_error message vars =
|
||||
code_errorf "%a" pp
|
||||
(List (Atom message
|
||||
(List (Usexp.atom_or_quoted_string message
|
||||
:: List.map vars ~f:(fun (name, value) ->
|
||||
List [Atom name; value])))
|
||||
List [Usexp.atom_or_quoted_string name; value])))
|
||||
|
||||
let buf_len = 65_536
|
||||
|
||||
|
@ -68,8 +68,7 @@ let load_many_or_ocaml_script fname =
|
|||
module type Combinators = sig
|
||||
type 'a t
|
||||
val unit : unit t
|
||||
val atom : string t
|
||||
val quoted_string : string t
|
||||
val string : string t
|
||||
val int : int t
|
||||
val float : float t
|
||||
val bool : bool t
|
||||
|
@ -78,19 +77,18 @@ 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 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
|
||||
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
|
||||
end
|
||||
|
||||
module To_sexp = struct
|
||||
type nonrec 'a t = 'a -> t
|
||||
let unit () = List []
|
||||
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)
|
||||
let string = Usexp.atom_or_quoted_string
|
||||
let int n = Atom (Atom.of_int n)
|
||||
let float f = Atom (Atom.of_float f)
|
||||
let bool b = Atom (Atom.of_bool b)
|
||||
let pair fa fb (a, b) = List [fa a; fb b]
|
||||
let triple fa fb fc (a, b, c) = List [fa a; fb b; fc c]
|
||||
let list f l = List (List.map l ~f)
|
||||
|
@ -98,19 +96,19 @@ module To_sexp = struct
|
|||
let option f = function
|
||||
| None -> List []
|
||||
| Some x -> List [f x]
|
||||
let atom_set set = list atom (String_set.elements set)
|
||||
let atom_map f map = list (pair atom f) (String_map.bindings map)
|
||||
let string_set set = list atom (String_set.elements set)
|
||||
let string_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 atom_hashtbl f h =
|
||||
atom_map f
|
||||
List (List.map l ~f:(fun (n, v) -> List [Atom(Atom.of_string n); v]))
|
||||
let string_hashtbl f h =
|
||||
string_map f
|
||||
(Hashtbl.fold h ~init:String_map.empty ~f:(fun ~key ~data acc ->
|
||||
String_map.add acc ~key ~data))
|
||||
end
|
||||
|
||||
module Of_sexp = struct
|
||||
type ast = Ast.t =
|
||||
| Atom of Loc.t * string
|
||||
| Atom of Loc.t * Atom.t
|
||||
| Quoted_string of Loc.t * string
|
||||
| List of Loc.t * ast list
|
||||
|
||||
|
@ -126,33 +124,24 @@ 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
|
||||
| Atom (_, A s) -> s
|
||||
| Quoted_string (_, s) -> s
|
||||
| List _ as sexp -> of_sexp_error sexp "Atom or quoted string expected"
|
||||
|
||||
let int sexp = match sexp with
|
||||
| Atom (_, s) -> (try int_of_string s
|
||||
with _ -> of_sexp_error sexp "Integer expected")
|
||||
| Atom (_, A s) -> (try int_of_string s
|
||||
with _ -> of_sexp_error sexp "Integer expected")
|
||||
| _ -> of_sexp_error sexp "Integer expected"
|
||||
|
||||
let float sexp = match sexp with
|
||||
| Atom (_, s) -> (try float_of_string s
|
||||
with _ -> of_sexp_error sexp "Float expected")
|
||||
| Atom (_, A s) -> (try float_of_string s
|
||||
with _ -> of_sexp_error sexp "Float expected")
|
||||
| _ -> of_sexp_error sexp "Float expected"
|
||||
|
||||
let bool = function
|
||||
| Atom (_, "true") -> true
|
||||
| Atom (_, "false") -> false
|
||||
| Atom (_, A "true") -> true
|
||||
| Atom (_, A "false") -> false
|
||||
| sexp -> of_sexp_error sexp "'true' or 'false' expected"
|
||||
|
||||
let pair fa fb = function
|
||||
|
@ -174,15 +163,15 @@ module Of_sexp = struct
|
|||
| List (_, [x]) -> Some (f x)
|
||||
| sexp -> of_sexp_error sexp "S-expression of the form () or (_) expected"
|
||||
|
||||
let atom_set sexp = String_set.of_list (list string sexp)
|
||||
let atom_map f sexp =
|
||||
let string_set sexp = String_set.of_list (list string sexp)
|
||||
let string_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 atom_hashtbl f sexp =
|
||||
let map = atom_map f sexp in
|
||||
let string_hashtbl f sexp =
|
||||
let map = string_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);
|
||||
|
@ -303,11 +292,11 @@ module Of_sexp = struct
|
|||
let unparsed =
|
||||
List.fold_left sexps ~init:Name_map.empty ~f:(fun acc sexp ->
|
||||
match sexp with
|
||||
| List (_, [Atom (_, name)]) ->
|
||||
| List (_, [Atom (_, A name)]) ->
|
||||
Name_map.add acc ~key:name ~data:{ value = None; entry = sexp }
|
||||
| List (_, [name_sexp; value]) -> begin
|
||||
match name_sexp with
|
||||
| Atom (_, name) ->
|
||||
| Atom (_, A name) ->
|
||||
Name_map.add acc ~key:name ~data:{ value = Some value;
|
||||
entry = sexp }
|
||||
| List _ | Quoted_string _ ->
|
||||
|
@ -416,7 +405,7 @@ module Of_sexp = struct
|
|||
|
||||
let sum cstrs sexp =
|
||||
match sexp with
|
||||
| Atom (loc, s) -> begin
|
||||
| Atom (loc, A s) -> begin
|
||||
match find_cstr cstrs sexp s with
|
||||
| C.Tuple t -> Constructor_args_spec.convert t.args t.rest sexp [] (t.make loc)
|
||||
| C.Record _ -> of_sexp_error sexp "'%s' expect arguments"
|
||||
|
@ -426,7 +415,7 @@ module Of_sexp = struct
|
|||
| List (loc, name_sexp :: args) ->
|
||||
match name_sexp with
|
||||
| Quoted_string _ | List _ -> of_sexp_error name_sexp "Atom expected"
|
||||
| Atom (_, s) ->
|
||||
| Atom (_, A s) ->
|
||||
match find_cstr cstrs sexp s with
|
||||
| C.Tuple t -> Constructor_args_spec.convert t.args t.rest sexp args (t.make loc)
|
||||
| C.Record r -> record r.parse (List (loc, args))
|
||||
|
@ -434,7 +423,7 @@ module Of_sexp = struct
|
|||
let enum cstrs sexp =
|
||||
match sexp with
|
||||
| Quoted_string _ | List _ -> of_sexp_error sexp "Atom expected"
|
||||
| Atom (_, s) ->
|
||||
| Atom (_, A s) ->
|
||||
match
|
||||
List.find cstrs ~f:(fun (name, _) ->
|
||||
equal_cstr_name name s)
|
||||
|
|
17
src/sexp.mli
17
src/sexp.mli
|
@ -16,8 +16,10 @@ val load_many_or_ocaml_script : string -> sexps_or_ocaml_script
|
|||
module type Combinators = sig
|
||||
type 'a t
|
||||
val unit : unit t
|
||||
val atom : string t
|
||||
val quoted_string : string t
|
||||
|
||||
val string : string t
|
||||
(** Convert an [Atom] or a [Quoted_string] from/to a string. *)
|
||||
|
||||
val int : int t
|
||||
val float : float t
|
||||
val bool : bool t
|
||||
|
@ -27,15 +29,15 @@ module type Combinators = sig
|
|||
val array : 'a t -> 'a array t
|
||||
val option : 'a t -> 'a option t
|
||||
|
||||
val atom_set : String_set.t t
|
||||
val string_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
|
||||
val string_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
|
||||
val string_hashtbl : 'a t -> (string, 'a) Hashtbl.t t
|
||||
(** [atom_hashtbl conv] is similar to [atom_map] for hash tables. *)
|
||||
end
|
||||
|
||||
|
@ -48,15 +50,12 @@ end with type sexp := t
|
|||
|
||||
module Of_sexp : sig
|
||||
type ast = Ast.t =
|
||||
| Atom of Loc.t * string
|
||||
| Atom of Loc.t * Atom.t
|
||||
| Quoted_string of Loc.t * string
|
||||
| List of Loc.t * ast list
|
||||
|
||||
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
|
||||
|
||||
|
|
|
@ -60,7 +60,7 @@ let rec of_tokens : Token.t list -> item list = function
|
|||
let items_of_string s = of_tokens (Token.tokenise s)
|
||||
|
||||
let t : Sexp.Of_sexp.ast -> t = function
|
||||
| Atom(loc, s) -> { items = items_of_string s; loc; quoted = false }
|
||||
| Atom(loc, A s) -> { items = items_of_string s; loc; quoted = false }
|
||||
| Quoted_string (loc, s) ->
|
||||
{ items = items_of_string s; loc; quoted = true }
|
||||
| List _ as sexp -> Sexp.Of_sexp.of_sexp_error sexp "Atom expected"
|
||||
|
@ -75,13 +75,15 @@ let virt_text pos s =
|
|||
{ items = [Text s]; loc = Loc.of_pos pos; quoted = true }
|
||||
|
||||
let sexp_of_var_syntax = function
|
||||
| Parens -> Sexp.Atom "parens"
|
||||
| Braces -> Sexp.Atom "braces"
|
||||
| Parens -> Sexp.unsafe_atom_of_string "parens"
|
||||
| Braces -> Sexp.unsafe_atom_of_string "braces"
|
||||
|
||||
let sexp_of_item =
|
||||
let open Sexp in function
|
||||
| Text s -> List [Atom "text" ; Atom s]
|
||||
| Var (vs, s) -> List [sexp_of_var_syntax vs ; Atom s]
|
||||
| Text s -> List [Sexp.unsafe_atom_of_string "text" ;
|
||||
Sexp.atom_or_quoted_string s]
|
||||
| Var (vs, s) -> List [sexp_of_var_syntax vs ;
|
||||
Sexp.atom_or_quoted_string s]
|
||||
|
||||
let sexp_of_t t = Sexp.To_sexp.list sexp_of_item t.items
|
||||
|
||||
|
|
|
@ -427,7 +427,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.atom
|
||||
let t = C.option C.string
|
||||
end)
|
||||
|
||||
let spec sctx (p : Package.t) =
|
||||
|
@ -969,9 +969,9 @@ module PP = struct
|
|||
let alias = Alias.lint ~dir in
|
||||
let add_alias fn build =
|
||||
Alias.add_action sctx.build_system alias build
|
||||
~stamp:(List [ Atom "lint"
|
||||
; Sexp.To_sexp.(option atom) lib_name
|
||||
; Atom fn
|
||||
~stamp:(List [ Sexp.unsafe_atom_of_string "lint"
|
||||
; Sexp.To_sexp.(option string) lib_name
|
||||
; Sexp.atom fn
|
||||
])
|
||||
in
|
||||
let lint =
|
||||
|
|
|
@ -333,7 +333,7 @@ let eps_push_atom state stack =
|
|||
Buffer.clear state.atom_buffer;
|
||||
let stack =
|
||||
if state.ignoring = 0 then
|
||||
Sexp (Atom (make_loc state, str), stack)
|
||||
Sexp (Atom (make_loc state, A str), stack)
|
||||
else
|
||||
stack
|
||||
in
|
||||
|
|
|
@ -5,7 +5,9 @@ module Loc = struct
|
|||
}
|
||||
end
|
||||
|
||||
type atom = A of string [@@unboxed]
|
||||
|
||||
type t =
|
||||
| Atom of Loc.t * string
|
||||
| Atom of Loc.t * atom
|
||||
| Quoted_string of Loc.t * string
|
||||
| List of Loc.t * t list
|
||||
|
|
|
@ -13,95 +13,122 @@ end
|
|||
module A = Parser_automaton_internal
|
||||
|
||||
module Atom = struct
|
||||
type t = string
|
||||
type t = Sexp_ast.atom = A of string [@@unboxed]
|
||||
|
||||
let escaped_length s =
|
||||
let n = ref 0 in
|
||||
for i = 0 to String.length s - 1 do
|
||||
n := !n +
|
||||
(match String.unsafe_get s i with
|
||||
| '\"' | '\\' | '\n' | '\t' | '\r' | '\b' -> 2
|
||||
| ' ' .. '~' -> 1
|
||||
| _ -> 4)
|
||||
done;
|
||||
!n
|
||||
let is_valid s =
|
||||
if s = "" then false
|
||||
else
|
||||
try
|
||||
for i = 0 to String.length s - 1 do
|
||||
match String.unsafe_get s i with
|
||||
| ' ' .. '~' -> ()
|
||||
| _ -> raise Exit
|
||||
done;
|
||||
true
|
||||
with Exit -> false
|
||||
|
||||
let must_escape s =
|
||||
let len = String.length s in
|
||||
len = 0 || escaped_length s > len
|
||||
(* XXX eventually we want to report a nice error message to the user
|
||||
at the point the conversion is made. *)
|
||||
let of_string s =
|
||||
if is_valid s then A s
|
||||
else invalid_arg(Printf.sprintf "Usexp.Atom.of_string: %S" s)
|
||||
|
||||
let escaped_internal s ~with_double_quotes ~always_quote =
|
||||
let n = escaped_length s in
|
||||
if n > 0 && n = String.length s then
|
||||
if always_quote then begin
|
||||
let s' = Bytes.create (n + 2) in
|
||||
Bytes.unsafe_set s' 0 '"';
|
||||
Bytes.blit_string ~src:s ~src_pos:0 ~dst:s' ~dst_pos:1 ~len:n;
|
||||
Bytes.unsafe_set s' (n + 1) '"';
|
||||
Bytes.unsafe_to_string s'
|
||||
end
|
||||
else s
|
||||
else begin
|
||||
let s' = Bytes.create (n + if with_double_quotes then 2 else 0) in
|
||||
let n = ref 0 in
|
||||
if with_double_quotes then begin
|
||||
Bytes.unsafe_set s' 0 '"';
|
||||
n := 1
|
||||
end;
|
||||
for i = 0 to String.length s - 1 do
|
||||
begin match String.unsafe_get s i with
|
||||
| ('\"' | '\\') as c ->
|
||||
Bytes.unsafe_set s' !n '\\'; incr n; Bytes.unsafe_set s' !n c
|
||||
| '\n' ->
|
||||
Bytes.unsafe_set s' !n '\\'; incr n; Bytes.unsafe_set s' !n 'n'
|
||||
| '\t' ->
|
||||
Bytes.unsafe_set s' !n '\\'; incr n; Bytes.unsafe_set s' !n 't'
|
||||
| '\r' ->
|
||||
Bytes.unsafe_set s' !n '\\'; incr n; Bytes.unsafe_set s' !n 'r'
|
||||
| '\b' ->
|
||||
Bytes.unsafe_set s' !n '\\'; incr n; Bytes.unsafe_set s' !n 'b'
|
||||
| (' ' .. '~') as c -> Bytes.unsafe_set s' !n c
|
||||
| c ->
|
||||
let a = Char.code c in
|
||||
Bytes.unsafe_set s' !n '\\';
|
||||
incr n;
|
||||
Bytes.unsafe_set s' !n (Char.unsafe_chr (48 + a / 100));
|
||||
incr n;
|
||||
Bytes.unsafe_set s' !n (Char.unsafe_chr (48 + (a / 10) mod 10));
|
||||
incr n;
|
||||
Bytes.unsafe_set s' !n (Char.unsafe_chr (48 + a mod 10));
|
||||
end;
|
||||
incr n
|
||||
done;
|
||||
if with_double_quotes then Bytes.unsafe_set s' !n '"';
|
||||
Bytes.unsafe_to_string s'
|
||||
end
|
||||
let of_int i = A (string_of_int i)
|
||||
let of_float x = A (string_of_float x)
|
||||
let of_bool x = A (string_of_bool x)
|
||||
let of_int64 i = A (Int64.to_string i)
|
||||
let of_digest d = A (Digest.to_hex d)
|
||||
|
||||
let escaped s =
|
||||
escaped_internal s ~with_double_quotes:false ~always_quote:false
|
||||
let serialize s =
|
||||
escaped_internal s ~with_double_quotes:true ~always_quote:false
|
||||
let quote s =
|
||||
escaped_internal s ~with_double_quotes:true ~always_quote:true
|
||||
let to_string (A s) = s
|
||||
end
|
||||
|
||||
type t =
|
||||
| Atom of string
|
||||
| Atom of Atom.t
|
||||
| Quoted_string of string
|
||||
| List of t list
|
||||
|
||||
type sexp = t
|
||||
|
||||
let atom s =
|
||||
if Atom.is_valid s then Atom (A s)
|
||||
else invalid_arg "Usexp.atom"
|
||||
|
||||
let unsafe_atom_of_string s = Atom(A s)
|
||||
|
||||
let atom_or_quoted_string s =
|
||||
if Atom.is_valid s then Atom (A s)
|
||||
else Quoted_string s
|
||||
|
||||
let quote_length s =
|
||||
let n = ref 0 in
|
||||
for i = 0 to String.length s - 1 do
|
||||
n := !n + (match String.unsafe_get s i with
|
||||
| '\"' | '\\' | '\n' | '\t' | '\r' | '\b' -> 2
|
||||
| ' ' .. '~' -> 1
|
||||
| _ -> 4)
|
||||
done;
|
||||
!n
|
||||
|
||||
let escape_to s ~dst:s' ~ofs =
|
||||
let n = ref ofs in
|
||||
for i = 0 to String.length s - 1 do
|
||||
begin match String.unsafe_get s i with
|
||||
| ('\"' | '\\') as c ->
|
||||
Bytes.unsafe_set s' !n '\\'; incr n; Bytes.unsafe_set s' !n c
|
||||
| '\n' ->
|
||||
Bytes.unsafe_set s' !n '\\'; incr n; Bytes.unsafe_set s' !n 'n'
|
||||
| '\t' ->
|
||||
Bytes.unsafe_set s' !n '\\'; incr n; Bytes.unsafe_set s' !n 't'
|
||||
| '\r' ->
|
||||
Bytes.unsafe_set s' !n '\\'; incr n; Bytes.unsafe_set s' !n 'r'
|
||||
| '\b' ->
|
||||
Bytes.unsafe_set s' !n '\\'; incr n; Bytes.unsafe_set s' !n 'b'
|
||||
| (' ' .. '~') as c -> Bytes.unsafe_set s' !n c
|
||||
| c ->
|
||||
let a = Char.code c in
|
||||
Bytes.unsafe_set s' !n '\\';
|
||||
incr n;
|
||||
Bytes.unsafe_set s' !n (Char.unsafe_chr (48 + a / 100));
|
||||
incr n;
|
||||
Bytes.unsafe_set s' !n (Char.unsafe_chr (48 + (a / 10) mod 10));
|
||||
incr n;
|
||||
Bytes.unsafe_set s' !n (Char.unsafe_chr (48 + a mod 10));
|
||||
end;
|
||||
incr n
|
||||
done
|
||||
|
||||
(* Escape [s] if needed. *)
|
||||
let escaped s =
|
||||
let n = quote_length s in
|
||||
if n = 0 || n > String.length s then
|
||||
let s' = Bytes.create n in
|
||||
escape_to s ~dst:s' ~ofs:0;
|
||||
Bytes.unsafe_to_string s'
|
||||
else s
|
||||
|
||||
(* Surround [s] with quotes, escaping it if necessary. *)
|
||||
let quoted s =
|
||||
let len = String.length s in
|
||||
let n = quote_length s in
|
||||
let s' = Bytes.create (n + 2) in
|
||||
Bytes.unsafe_set s' 0 '"';
|
||||
if len = 0 || n > len then
|
||||
escape_to s ~dst:s' ~ofs:1
|
||||
else
|
||||
Bytes.blit_string ~src:s ~src_pos:0 ~dst:s' ~dst_pos:1 ~len;
|
||||
Bytes.unsafe_set s' (n + 1) '"';
|
||||
Bytes.unsafe_to_string s'
|
||||
|
||||
let rec to_string = function
|
||||
| Atom s -> Atom.serialize s
|
||||
| Quoted_string s -> Atom.quote s
|
||||
| Atom (A s) -> s
|
||||
| Quoted_string s -> quoted s
|
||||
| List l -> Printf.sprintf "(%s)" (List.map l ~f:to_string |> String.concat ~sep:" ")
|
||||
|
||||
let rec pp ppf = function
|
||||
| Atom s ->
|
||||
Format.pp_print_string ppf (Atom.serialize s)
|
||||
| Atom (A s) ->
|
||||
Format.pp_print_string ppf s
|
||||
| Quoted_string s ->
|
||||
Format.pp_print_string ppf (Atom.quote s)
|
||||
Format.pp_print_string ppf (quoted s)
|
||||
| List [] ->
|
||||
Format.pp_print_string ppf "()"
|
||||
| List (first :: rest) ->
|
||||
|
@ -127,26 +154,21 @@ let split_string s ~on =
|
|||
in
|
||||
loop 0 0
|
||||
|
||||
let pp_print_atom ppf ~serialize s =
|
||||
let pp_print_quoted_string ppf s =
|
||||
if String.contains s '\n' then begin
|
||||
match split_string s ~on:'\n' with
|
||||
| [] -> Format.pp_print_string ppf (serialize s)
|
||||
| [] -> Format.pp_print_string ppf (quoted s)
|
||||
| first :: rest ->
|
||||
Format.fprintf ppf "@[<hv 1>\"@{<atom>%s" (Atom.escaped first);
|
||||
Format.fprintf ppf "@[<hv 1>\"@{<atom>%s" (escaped first);
|
||||
List.iter rest ~f:(fun s ->
|
||||
Format.fprintf ppf "@,\\n%s" (Atom.escaped s));
|
||||
Format.fprintf ppf "@,\\n%s" (escaped s));
|
||||
Format.fprintf ppf "@}\"@]"
|
||||
end else
|
||||
Format.pp_print_string ppf (serialize s)
|
||||
Format.pp_print_string ppf (quoted s)
|
||||
|
||||
let rec pp_split_strings ppf = function
|
||||
| Atom s ->
|
||||
if Atom.must_escape s then
|
||||
pp_print_atom ppf s ~serialize:Atom.serialize
|
||||
else
|
||||
Format.pp_print_string ppf s
|
||||
| Quoted_string s ->
|
||||
pp_print_atom ppf s ~serialize:Atom.quote
|
||||
| Atom (A s) -> Format.pp_print_string ppf s
|
||||
| Quoted_string s -> pp_print_quoted_string ppf s
|
||||
| List [] ->
|
||||
Format.pp_print_string ppf "()"
|
||||
| List (first :: rest) ->
|
||||
|
@ -208,11 +230,15 @@ module Loc = Sexp_ast.Loc
|
|||
|
||||
module Ast = struct
|
||||
type t = Sexp_ast.t =
|
||||
| Atom of Loc.t * string
|
||||
| Atom of Loc.t * Atom.t
|
||||
| Quoted_string of Loc.t * string
|
||||
| List of Loc.t * t list
|
||||
|
||||
let loc (Atom (loc, _) | Quoted_string (loc, _) | List (loc, _)) = loc
|
||||
let atom_or_quoted_string loc s =
|
||||
if Atom.is_valid s then Atom (loc, A s)
|
||||
else Quoted_string (loc, s)
|
||||
|
||||
let loc (Atom (loc, _) | Quoted_string (loc, _) | List (loc, _)) = loc
|
||||
|
||||
let rec remove_locs : t -> sexp = function
|
||||
| Atom (_, s) -> Atom s
|
||||
|
@ -221,7 +247,7 @@ module Ast = struct
|
|||
|
||||
module Token = struct
|
||||
type t =
|
||||
| Atom of Loc.t * string
|
||||
| Atom of Loc.t * Atom.t
|
||||
| String of Loc.t * string
|
||||
| Lparen of Loc.t
|
||||
| Rparen of Loc.t
|
||||
|
|
|
@ -1,17 +1,24 @@
|
|||
(** Parsing of s-expressions *)
|
||||
|
||||
module Atom : sig
|
||||
type t = string
|
||||
type t = private A of string [@@unboxed]
|
||||
(** Acceptable atoms are composed of chars in the range [' ' .. '~']
|
||||
and must be nonempty. *)
|
||||
|
||||
(** Whether the atom must be escaped when serialized *)
|
||||
val must_escape : t -> bool
|
||||
val is_valid : string -> bool
|
||||
(** [is_valid s] checks that [s] respects the constraints to be an atom. *)
|
||||
|
||||
(** Escape all special characters in the atom *)
|
||||
val escaped : t -> string
|
||||
val of_string : string -> t
|
||||
(** Convert a string to an atom. If the string contains invalid
|
||||
characters, raise [Invalid_argument]. *)
|
||||
|
||||
(** [serialize t] is the serialized representation of [t], so either
|
||||
[t] either [escaped t] surrounded by double quotes. *)
|
||||
val serialize : t -> string
|
||||
val of_int : int -> t
|
||||
val of_float : float -> t
|
||||
val of_bool : bool -> t
|
||||
val of_int64 : Int64.t -> t
|
||||
val of_digest : Digest.t -> t
|
||||
|
||||
val to_string : t -> string
|
||||
end
|
||||
|
||||
module Loc : sig
|
||||
|
@ -27,6 +34,14 @@ type t =
|
|||
| Quoted_string of string
|
||||
| List of t list
|
||||
|
||||
val atom : string -> t
|
||||
(** [atom s] convert the string [s] to an Atom.
|
||||
@raise Invalid_argument if [s] does not satisfy [Atom.is_valid s]. *)
|
||||
|
||||
val atom_or_quoted_string : string -> t
|
||||
|
||||
val unsafe_atom_of_string : string -> t
|
||||
|
||||
(** Serialize a S-expression *)
|
||||
val to_string : t -> string
|
||||
|
||||
|
@ -50,13 +65,15 @@ module Ast : sig
|
|||
| Quoted_string of Loc.t * string
|
||||
| List of Loc.t * t list
|
||||
|
||||
val atom_or_quoted_string : Loc.t -> string -> t
|
||||
|
||||
val loc : t -> Loc.t
|
||||
|
||||
val remove_locs : t -> sexp
|
||||
|
||||
module Token : sig
|
||||
type t =
|
||||
| Atom of Loc.t * string
|
||||
| Atom of Loc.t * Atom.t
|
||||
| String of Loc.t * string
|
||||
| Lparen of Loc.t
|
||||
| Rparen of Loc.t
|
||||
|
|
|
@ -192,9 +192,10 @@ module Cached_digest = struct
|
|||
Pmap.add acc ~key ~data)
|
||||
|> Path.Map.bindings
|
||||
|> List.map ~f:(fun (path, file) ->
|
||||
Sexp.List [ Atom (Path.to_string path)
|
||||
; Atom (Digest.to_hex file.digest)
|
||||
; Atom (Int64.to_string (Int64.bits_of_float file.timestamp))
|
||||
Sexp.List [ Quoted_string (Path.to_string path)
|
||||
; Atom (Sexp.Atom.of_digest file.digest)
|
||||
; Atom (Sexp.Atom.of_int64
|
||||
(Int64.bits_of_float file.timestamp))
|
||||
]))
|
||||
in
|
||||
if Sys.file_exists "_build" then
|
||||
|
|
|
@ -16,7 +16,8 @@ module Entry = struct
|
|||
| Library (path, lib_name) ->
|
||||
sprintf "library %S in %s" lib_name (Path.to_string_maybe_quoted path)
|
||||
| Preprocess l ->
|
||||
Sexp.to_string (List [Atom "pps"; Sexp.To_sexp.(list atom) l])
|
||||
Sexp.to_string (List [Sexp.unsafe_atom_of_string "pps";
|
||||
Sexp.To_sexp.(list string) l])
|
||||
| Loc loc ->
|
||||
Loc.to_file_colon_line loc
|
||||
|
||||
|
|
|
@ -39,7 +39,7 @@ module Context = struct
|
|||
type t = Default of Target.t list | Opam of Opam.t
|
||||
|
||||
let t = function
|
||||
| Atom (_, "default") -> Default [Native]
|
||||
| Atom (_, A "default") -> Default [Native]
|
||||
| List (_, List _ :: _) as sexp -> Opam (record Opam.t sexp)
|
||||
| sexp ->
|
||||
sum
|
||||
|
|
Loading…
Reference in New Issue