From 3e2dc2517d886a3158424e0c939a70d58e8fbea6 Mon Sep 17 00:00:00 2001 From: Christophe Troestler Date: Sun, 28 Jan 2018 00:14:04 +0100 Subject: [PATCH 01/17] Document the interface of String_with_vars --- src/string_with_vars.mli | 35 +++++++++++++++++++++++++++++++---- 1 file changed, 31 insertions(+), 4 deletions(-) diff --git a/src/string_with_vars.mli b/src/string_with_vars.mli index 5c7ea39a..de02a0bc 100644 --- a/src/string_with_vars.mli +++ b/src/string_with_vars.mli @@ -6,25 +6,52 @@ open Import type t +(** A sequence of text and variables. *) + val t : t Sexp.Of_sexp.t -val sexp_of_t : t -> Sexp.t +(** [t ast] takes an [ast] sexp and return a *) val loc : t -> Loc.t +(** [loc t] returns the location of [t] — typically, in the jbuild file. *) + +val sexp_of_t : t -> Sexp.t val to_string : t -> string -(** [t] generated by the OCaml code. The first argument should be [__POS__]. The second is - either a string to parse, a variable name or plain text. *) +(** [t] generated by the OCaml code. The first argument should be + [__POS__]. The second is either a string to parse, a variable name + or plain text. *) val virt : (string * int * int * int) -> string -> t val virt_var : (string * int * int * int) -> string -> t val virt_text : (string * int * int * int) -> string -> t val just_a_var : t -> string option +(** [just_a_var t] return the [Some name] where [name] is the name of + the variable if [t] is solely made of a variable and [None] otherwise. *) val vars : t -> String_set.t +(** [vars t] returns the set of all variables in [t]. *) val fold : t -> init:'a -> f:('a -> Loc.t -> string -> 'a) -> 'a +(** [fold t ~init ~f] fold [f] on all variables of [t], the text + portions being ignored. *) + val iter : t -> f:(Loc.t -> string -> unit) -> unit +(** [iter t ~f] iterates [f] over all variables of [t], the text + portions being ignored. *) val expand : t -> f:(Loc.t -> string -> string option) -> string -val partial_expand : t -> f:(Loc.t -> string -> string option) -> (string, t) either +(** [expand t ~f] return [t] where all variables have been expanded + using [f]. If [f] returns [Some x], the variable is replaced by + [x]; if [f] returns [None], the variable is inserted as [${v}] or + [$(v)] — depending on the original concrete syntax used — where [v] + is the name if the variable. *) + +val partial_expand : t -> f:(Loc.t -> string -> string option) + -> (string, t) either +(** [partial_expand t ~f] is like [expand] where all variables that + could be expanded (i.e., those for which [f] returns [Some _]) are. + If all the variables of [t] were expanded, a string is returned. + If [f] returns [None] on at least a variable of [t], it returns a + string-with-vars. *) + From e8e3698e154eaecb1a16863484c2a4f843c5d3f2 Mon Sep 17 00:00:00 2001 From: Christophe Troestler Date: Mon, 29 Jan 2018 00:14:42 +0100 Subject: [PATCH 02/17] String_with_vars: represent quoted vars differently from unquoted ones Define the representation for quoted variables, adapt the test of strings made of a single variable, and add a constructor. [String_with_vars.t] is not yet able to use that representation because the necessary information is not available from the parser. --- src/action.ml | 4 ++-- src/string_with_vars.ml | 6 +++++- src/string_with_vars.mli | 11 ++++++----- 3 files changed, 13 insertions(+), 8 deletions(-) diff --git a/src/action.ml b/src/action.ml index 00fe164e..22b5bb96 100644 --- a/src/action.ml +++ b/src/action.ml @@ -363,7 +363,7 @@ module Unexpanded = struct let expand ~generic ~special ~map ~dir ~f = function | Inl x -> map x | Inr template as x -> - match SW.just_a_var template with + match SW.unquoted_var template with | None -> generic ~dir (string ~dir ~f x) | Some var -> match f (SW.loc template) var with @@ -452,7 +452,7 @@ module Unexpanded = struct | Some e -> Some (VE.to_string ~dir e)) let expand ~generic ~special ~dir ~f template = - match SW.just_a_var template with + match SW.unquoted_var template with | None -> begin match string ~dir ~f template with | Inl x -> Inl (generic ~dir x) diff --git a/src/string_with_vars.ml b/src/string_with_vars.ml index 0ce1353d..8e8f73d7 100644 --- a/src/string_with_vars.ml +++ b/src/string_with_vars.ml @@ -6,6 +6,8 @@ type item = | Text of string | Var of var_syntax * string +(* A single unquoted variable is encoded as the list [Var v]. A + quoted variable is encoded as [Var v; Text ""]. *) type t = { items : item list ; loc : Loc.t @@ -67,9 +69,11 @@ let loc t = t.loc let virt pos s = of_string ~loc:(Loc.of_pos pos) s let virt_var pos s = { loc = Loc.of_pos pos; items = [Var (Braces, s)] } +let virt_quoted_var pos s = { loc = Loc.of_pos pos; + items = [Var (Braces, s); Text ""] } let virt_text pos s = { loc = Loc.of_pos pos; items = [Text s] } -let just_a_var t = +let unquoted_var t = match t.items with | [Var (_, s)] -> Some s | _ -> None diff --git a/src/string_with_vars.mli b/src/string_with_vars.mli index de02a0bc..ed22a78f 100644 --- a/src/string_with_vars.mli +++ b/src/string_with_vars.mli @@ -21,12 +21,13 @@ val to_string : t -> string (** [t] generated by the OCaml code. The first argument should be [__POS__]. The second is either a string to parse, a variable name or plain text. *) -val virt : (string * int * int * int) -> string -> t -val virt_var : (string * int * int * int) -> string -> t -val virt_text : (string * int * int * int) -> string -> t +val virt : (string * int * int * int) -> string -> t +val virt_var : (string * int * int * int) -> string -> t +val virt_quoted_var : (string * int * int * int) -> string -> t +val virt_text : (string * int * int * int) -> string -> t -val just_a_var : t -> string option -(** [just_a_var t] return the [Some name] where [name] is the name of +val unquoted_var : t -> string option +(** [unquoted_var t] return the [Some name] where [name] is the name of the variable if [t] is solely made of a variable and [None] otherwise. *) val vars : t -> String_set.t From c27cb3541eee546245209a1f2e20772974a2e67e Mon Sep 17 00:00:00 2001 From: Christophe Troestler Date: Mon, 29 Jan 2018 10:14:09 +0100 Subject: [PATCH 03/17] Let the parser distinguish quoted strings Fixes https://github.com/ocaml/dune/issues/408 --- src/action.ml | 2 +- src/jbuild.ml | 10 +++++----- src/ordered_set_lang.ml | 4 ++-- src/sexp.ml | 19 ++++++++++-------- src/sexp.mli | 1 + src/string_with_vars.ml | 20 +++++++++++++------ src/string_with_vars.mli | 4 +++- vendor/usexp/src/parser_automaton_internal.ml | 2 +- vendor/usexp/src/sexp_ast.ml | 1 + vendor/usexp/src/usexp.ml | 13 ++++++++++-- vendor/usexp/src/usexp.mli | 5 ++++- 11 files changed, 54 insertions(+), 27 deletions(-) diff --git a/src/action.ml b/src/action.ml index 22b5bb96..7669f40b 100644 --- a/src/action.ml +++ b/src/action.ml @@ -328,7 +328,7 @@ module Unexpanded = struct let t sexp = match sexp with - | Atom _ -> + | Atom _ | String _ -> of_sexp_errorf sexp "if you meant for this to be executed with bash, write (bash \"...\") instead" | List _ -> t sexp diff --git a/src/jbuild.ml b/src/jbuild.ml index 819cbc52..d975f786 100644 --- a/src/jbuild.ml +++ b/src/jbuild.ml @@ -190,7 +190,7 @@ module Pp_or_flags = struct PP (Pp.of_string s) let t = function - | Atom (_, s) -> of_string s + | Atom (_, s) | String (_, s) -> of_string s | List (_, l) -> Flags (List.map l ~f:string) let split l = @@ -225,7 +225,7 @@ module Dep_conf = struct in fun sexp -> match sexp with - | Atom _ -> File (String_with_vars.t sexp) + | Atom _ | String _ -> File (String_with_vars.t sexp) | List _ -> t sexp open Sexp @@ -356,7 +356,7 @@ module Lib_dep = struct let choice = function | List (_, l) as sexp -> let rec loop required forbidden = function - | [Atom (_, "->"); fsexp] -> + | [Atom (_, "->"); fsexp] | [String (_, "->"); fsexp] -> let common = String_set.inter required forbidden in if not (String_set.is_empty common) then of_sexp_errorf sexp @@ -366,9 +366,9 @@ module Lib_dep = struct ; forbidden ; file = file fsexp } - | Atom (_, "->") :: _ | List _ :: _ | [] -> + | Atom (_, "->") :: _ | String (_, "->") :: _ | List _ :: _ | [] -> of_sexp_error sexp "(<[!]libraries>... -> ) expected" - | Atom (_, s) :: l -> + | (Atom (_, s) | 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 diff --git a/src/ordered_set_lang.ml b/src/ordered_set_lang.ml index e2e88ed2..a1a33694 100644 --- a/src/ordered_set_lang.ml +++ b/src/ordered_set_lang.ml @@ -25,7 +25,7 @@ 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 (_, "") as t -> Ast.Element (f t) + | (Atom (_, "") | String (_, _)) as t -> Ast.Element (f t) | Atom (loc, s) as t -> if s.[0] = ':' then Special (loc, String.sub s ~pos:1 ~len:(String.length s - 1)) @@ -43,7 +43,7 @@ let parse_general sexp ~f = let t sexp : t = let ast = parse_general sexp ~f:(function - | Atom (loc, s) -> (loc, s) + | Atom (loc, s) | String (loc, s) -> (loc, s) | List _ -> assert false) in { ast diff --git a/src/sexp.ml b/src/sexp.ml index 1a2e51a1..2eb17d08 100644 --- a/src/sexp.ml +++ b/src/sexp.ml @@ -85,7 +85,7 @@ end module To_sexp = struct type nonrec 'a t = 'a -> t let unit () = List [] - let string s = Atom s + let string s = 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) @@ -109,6 +109,7 @@ end module Of_sexp = struct type ast = Ast.t = | Atom of Loc.t * string + | String of Loc.t * string | List of Loc.t * ast list type 'a t = ast -> 'a @@ -125,6 +126,7 @@ module Of_sexp = struct let string = function | Atom (_, s) -> s + | String (_, s) -> s | List _ as sexp -> of_sexp_error sexp "Atom expected" let int sexp = @@ -156,7 +158,7 @@ module Of_sexp = struct | sexp -> of_sexp_error sexp "S-expression of the form (_ _ _) expected" let list f = function - | Atom _ as sexp -> of_sexp_error sexp "List expected" + | (Atom _ | String _) as sexp -> of_sexp_error sexp "List expected" | List (_, l) -> List.map l ~f let array f sexp = Array.of_list (list f sexp) @@ -290,7 +292,7 @@ module Of_sexp = struct let make_record_parser_state sexp = match sexp with - | Atom _ -> of_sexp_error sexp "List expected" + | Atom _ | String _ -> of_sexp_error sexp "List expected" | List (loc, sexps) -> let unparsed = List.fold_left sexps ~init:Name_map.empty ~f:(fun acc sexp -> @@ -299,8 +301,9 @@ module Of_sexp = struct Name_map.add acc ~key:name ~data:{ value = None; entry = sexp } | List (_, [name_sexp; value]) -> begin match name_sexp with - | Atom (_, name) -> - Name_map.add acc ~key:name ~data:{ value = Some value; entry = sexp } + | Atom (_, name) | String (_, name) -> + Name_map.add acc ~key:name ~data:{ value = Some value; + entry = sexp } | List _ -> of_sexp_error name_sexp "Atom expected" end @@ -407,7 +410,7 @@ module Of_sexp = struct let sum cstrs sexp = match sexp with - | Atom (loc, s) -> begin + | Atom (loc, s) | String (loc, 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" @@ -416,7 +419,7 @@ module Of_sexp = struct | List (loc, name_sexp :: args) -> match name_sexp with | List _ -> of_sexp_error name_sexp "Atom expected" - | Atom (_, s) -> + | Atom (_, s) | String (_, 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)) @@ -424,7 +427,7 @@ module Of_sexp = struct let enum cstrs sexp = match sexp with | List _ -> of_sexp_error sexp "Atom expected" - | Atom (_, s) -> + | Atom (_, s) | String (_, s) -> match List.find cstrs ~f:(fun (name, _) -> equal_cstr_name name s) diff --git a/src/sexp.mli b/src/sexp.mli index 98f87307..3c420fd5 100644 --- a/src/sexp.mli +++ b/src/sexp.mli @@ -40,6 +40,7 @@ end with type sexp := t module Of_sexp : sig type ast = Ast.t = | Atom of Loc.t * string + | String of Loc.t * string | List of Loc.t * ast list include Combinators with type 'a t = Ast.t -> 'a diff --git a/src/string_with_vars.ml b/src/string_with_vars.ml index 8e8f73d7..154b4f14 100644 --- a/src/string_with_vars.ml +++ b/src/string_with_vars.ml @@ -63,7 +63,20 @@ let of_string ~loc s = ; loc } -let t sexp = of_string ~loc:(Sexp.Ast.loc sexp) (Sexp.Of_sexp.string sexp) +let unquoted_var t = + match t.items with + | [Var (_, s)] -> Some s + | _ -> None + +let t : Sexp.Of_sexp.ast -> t = function + | Atom(loc, s) -> of_string ~loc s + | String(loc, s) -> + (* If [unquoted_var], then add [""] at the end (see [type t]). *) + let t = of_string ~loc s in + (match t.items with + | [Var _ as v] -> {t with items = [v; Text ""] } + | _ -> t) + | List _ as sexp -> Sexp.Of_sexp.of_sexp_error sexp "Atom expected" let loc t = t.loc @@ -73,11 +86,6 @@ let virt_quoted_var pos s = { loc = Loc.of_pos pos; items = [Var (Braces, s); Text ""] } let virt_text pos s = { loc = Loc.of_pos pos; items = [Text s] } -let unquoted_var t = - match t.items with - | [Var (_, s)] -> Some s - | _ -> None - let sexp_of_var_syntax = function | Parens -> Sexp.Atom "parens" | Braces -> Sexp.Atom "braces" diff --git a/src/string_with_vars.mli b/src/string_with_vars.mli index ed22a78f..04eef271 100644 --- a/src/string_with_vars.mli +++ b/src/string_with_vars.mli @@ -9,7 +9,9 @@ type t (** A sequence of text and variables. *) val t : t Sexp.Of_sexp.t -(** [t ast] takes an [ast] sexp and return a *) +(** [t ast] takes an [ast] sexp and returns a string-with-vars. This + function distinguishes between unquoted variables — such as ${@} — + and quoted variables — such as "${@}". *) val loc : t -> Loc.t (** [loc t] returns the location of [t] — typically, in the jbuild file. *) diff --git a/vendor/usexp/src/parser_automaton_internal.ml b/vendor/usexp/src/parser_automaton_internal.ml index ee06cf2e..79fe45ae 100644 --- a/vendor/usexp/src/parser_automaton_internal.ml +++ b/vendor/usexp/src/parser_automaton_internal.ml @@ -344,7 +344,7 @@ let push_quoted_atom state _char stack = Buffer.clear state.atom_buffer; let stack = if state.ignoring = 0 then - Sexp (Atom (make_loc state ~delta:1, str), stack) + Sexp (String (make_loc state ~delta:1, str), stack) else stack in diff --git a/vendor/usexp/src/sexp_ast.ml b/vendor/usexp/src/sexp_ast.ml index 959ec8bc..b61dcf29 100644 --- a/vendor/usexp/src/sexp_ast.ml +++ b/vendor/usexp/src/sexp_ast.ml @@ -7,4 +7,5 @@ end type t = | Atom of Loc.t * string + | String of Loc.t * string | List of Loc.t * t list diff --git a/vendor/usexp/src/usexp.ml b/vendor/usexp/src/usexp.ml index 9efa2bfb..f76a77b4 100644 --- a/vendor/usexp/src/usexp.ml +++ b/vendor/usexp/src/usexp.ml @@ -64,17 +64,21 @@ end type t = | Atom of string + | String of string | List of t list type sexp = t let rec to_string = function | Atom s -> Atom.serialize s + | String s -> Atom.serialize 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) + | String s -> + Format.pp_print_string ppf (Atom.serialize s) | List [] -> Format.pp_print_string ppf "()" | List (first :: rest) -> @@ -101,7 +105,7 @@ let split_string s ~on = loop 0 0 let rec pp_split_strings ppf = function - | Atom s -> + | Atom s | String s -> if Atom.must_escape s then begin if String.contains s '\n' then begin match split_string s ~on:'\n' with @@ -177,17 +181,20 @@ module Loc = Sexp_ast.Loc module Ast = struct type t = Sexp_ast.t = | Atom of Loc.t * string + | String of Loc.t * string | List of Loc.t * t list - let loc (Atom (loc, _) | List (loc, _)) = loc + let loc (Atom (loc, _) | String (loc, _) | List (loc, _)) = loc let rec remove_locs : t -> sexp = function | Atom (_, s) -> Atom s + | String (_, s) -> String s | List (_, l) -> List (List.map l ~f:remove_locs) module Token = struct type t = | Atom of Loc.t * string + | String of Loc.t * string | Lparen of Loc.t | Rparen of Loc.t end @@ -196,6 +203,7 @@ module Ast = struct let rec loop acc t = match t with | Atom (loc, s) -> Token.Atom (loc, s) :: acc + | String (loc, s) -> Token.String (loc, s) :: acc | List (loc, l) -> let shift (pos : Lexing.position) delta = { pos with pos_cnum = pos.pos_cnum + delta } @@ -213,6 +221,7 @@ end let rec add_loc t ~loc : Ast.t = match t with | Atom s -> Atom (loc, s) + | String s -> String (loc, s) | List l -> List (loc, List.map l ~f:(add_loc ~loc)) module Parser = struct diff --git a/vendor/usexp/src/usexp.mli b/vendor/usexp/src/usexp.mli index 65d8f278..33592e63 100644 --- a/vendor/usexp/src/usexp.mli +++ b/vendor/usexp/src/usexp.mli @@ -23,7 +23,8 @@ end (** The S-expression type *) type t = - | Atom of string + | Atom of Atom.t + | String of string (** Quoted string *) | List of t list (** Serialize a S-expression *) @@ -46,6 +47,7 @@ module Ast : sig type sexp = t type t = | Atom of Loc.t * Atom.t + | String of Loc.t * string (** Quoted string *) | List of Loc.t * t list val loc : t -> Loc.t @@ -55,6 +57,7 @@ module Ast : sig module Token : sig type t = | Atom of Loc.t * string + | String of Loc.t * string | Lparen of Loc.t | Rparen of Loc.t end From 8b50352db7b7c1bfa51d6edd99b8ae664fe927db Mon Sep 17 00:00:00 2001 From: Christophe Troestler Date: Mon, 29 Jan 2018 14:16:39 +0100 Subject: [PATCH 04/17] Properly convert quoted atoms to strings --- vendor/usexp/src/usexp.ml | 33 ++++++++++++++++++++++++++++----- 1 file changed, 28 insertions(+), 5 deletions(-) diff --git a/vendor/usexp/src/usexp.ml b/vendor/usexp/src/usexp.ml index f76a77b4..038688ca 100644 --- a/vendor/usexp/src/usexp.ml +++ b/vendor/usexp/src/usexp.ml @@ -1,5 +1,15 @@ +module UnlabeledBytes = Bytes open StdLabels +module Bytes = struct + include StdLabels.Bytes + + (* [blit_string] was forgotten from the labeled version in OCaml + 4.02—4.04. *) + let blit_string ~src ~src_pos ~dst ~dst_pos ~len = + UnlabeledBytes.blit_string src src_pos dst dst_pos len +end + module A = Parser_automaton_internal module Atom = struct @@ -20,9 +30,18 @@ module Atom = struct let len = String.length s in len = 0 || escaped_length s > len - let escaped_internal s ~with_double_quotes = + let escaped_internal s ~with_double_quotes ~always_quote = let n = escaped_length s in - if n > 0 && n = String.length s then s else begin + 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 @@ -58,8 +77,12 @@ module Atom = struct Bytes.unsafe_to_string s' end - let escaped s = escaped_internal s ~with_double_quotes:false - let serialize s = escaped_internal s ~with_double_quotes:true + 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 end type t = @@ -71,7 +94,7 @@ type sexp = t let rec to_string = function | Atom s -> Atom.serialize s - | String s -> Atom.serialize s + | String s -> Atom.quote s | List l -> Printf.sprintf "(%s)" (List.map l ~f:to_string |> String.concat ~sep:" ") let rec pp ppf = function From 4ddb268b39f3cf44843274242bb75ae06d465f17 Mon Sep 17 00:00:00 2001 From: Christophe Troestler Date: Mon, 29 Jan 2018 11:08:47 +0100 Subject: [PATCH 05/17] Update the documentation for quoted strings --- doc/jbuild.rst | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/doc/jbuild.rst b/doc/jbuild.rst index 2059b887..60bcbee4 100644 --- a/doc/jbuild.rst +++ b/doc/jbuild.rst @@ -765,14 +765,13 @@ you have to quote the variable as in: .. code:: scheme - (run foo "${^} ") + (run foo "${^}") -(for now the final space is necessary) which is equivalent to the following shell command: .. code:: shell - $ foo "a b " + $ foo "a b" (the items of the list are concatenated with space). Note that, since ``${^}`` is a list of items, the first one may be From 75ad9736f8e06fb6ad729ca288ebb56b101f770f Mon Sep 17 00:00:00 2001 From: Christophe Troestler Date: Mon, 29 Jan 2018 14:47:51 +0100 Subject: [PATCH 06/17] Move usexp in src/ as it diverged from parsexp --- bootstrap.ml | 2 +- doc/project-layout-specification.rst | 91 ++++++-- {vendor/usexp/src => src/usexp}/jbuild | 0 .../usexp}/parser_automaton_internal.ml | 0 .../usexp}/parser_automaton_internal.mli | 0 {vendor/usexp/src => src/usexp}/sexp_ast.ml | 0 {vendor/usexp/src => src/usexp}/table.ml | 0 {vendor/usexp/src => src/usexp}/table.mli | 0 {vendor/usexp/src => src/usexp}/usexp.ml | 0 {vendor/usexp/src => src/usexp}/usexp.mli | 0 vendor/usexp/LICENSE.md | 202 ------------------ 11 files changed, 72 insertions(+), 223 deletions(-) rename {vendor/usexp/src => src/usexp}/jbuild (100%) rename {vendor/usexp/src => src/usexp}/parser_automaton_internal.ml (100%) rename {vendor/usexp/src => src/usexp}/parser_automaton_internal.mli (100%) rename {vendor/usexp/src => src/usexp}/sexp_ast.ml (100%) rename {vendor/usexp/src => src/usexp}/table.ml (100%) rename {vendor/usexp/src => src/usexp}/table.mli (100%) rename {vendor/usexp/src => src/usexp}/usexp.ml (100%) rename {vendor/usexp/src => src/usexp}/usexp.mli (100%) delete mode 100644 vendor/usexp/LICENSE.md diff --git a/bootstrap.ml b/bootstrap.ml index 96060f42..46482c34 100644 --- a/bootstrap.ml +++ b/bootstrap.ml @@ -33,7 +33,7 @@ let dirs = ; "src/fiber" , Some "Fiber" ; "src/xdg" , Some "Xdg" ; "vendor/boot" , None - ; "vendor/usexp/src" , Some "Usexp" + ; "src/usexp" , Some "Usexp" ; "src" , None ] diff --git a/doc/project-layout-specification.rst b/doc/project-layout-specification.rst index 90378060..44305a30 100644 --- a/doc/project-layout-specification.rst +++ b/doc/project-layout-specification.rst @@ -26,30 +26,81 @@ Metadata format =============== Most configuration files read by Jbuilder are using the S-expression -syntax, which is very simple. Everything is either an atom or a list. -The exact specification of S-expressions is described in the -documentation of the `parsexp `__ -library. - -In a nutshell, the syntax is as follows: - -- atoms that do no contain special characters are simply written as - is. For instance: ``foo``, ``bar`` are valid atomic S-expressions - -- atoms containing special characters or spaces must be quoted using - the syntax ``"..."``: ``"foo bar\n"`` - -- lists are formed by surrounding a sequence of S-expressions separated - by spaces with parentheses: ``(a b (c d))`` - -- single-line comments are introduced with the ``;`` character and may - appear anywhere except in the middle of a quoted atom - -- block comment are enclosed by ``#|`` and ``|#`` and can be nested +syntax, which is very simple. It is described below. Note that the format is completely static. However you can do meta-programming on jbuilds files by writing them in :ref:`ocaml-syntax`. + +Lexical conventions of s-expressions +------------------------------------ + +Whitespace, which consists of space, newline, horizontal tab, and form +feed, is ignored unless within an OCaml-string, where it is treated +according to OCaml-conventions. The left parenthesis opens a new +list, the right one closes it. Lists can be empty. + +The double quote denotes the beginning and end of a string using +similar lexing conventions to the ones of OCaml (see the OCaml-manual +for details). Differences are: + +- octal escape sequences (``\o123``) are not supported; +- backslash that's not a part of any escape sequence is kept as it is + instead of resulting in parse error; +- a backslash followed by a space does not form an escape sequence, so + it’s interpreted as is, while it is interpreted as just a space by + OCaml. + +All characters other than double quotes, left- and right parentheses, +whitespace, carriage return, and comment-introducing characters or +sequences (see next paragraph) are considered part of a contiguous +string. + +Comments +-------- + +There are three kinds of comments: + +- line comments are introduced with ``;``, and end at the newline; +- sexp comments are introduced with ``#;``, and end at the end of the + following s-expression; +- block comments are introduced with ``#|`` and end with ``|#``. + These can be nested, and double-quotes within them must be balanced + and be lexically correct OCaml strings. + +Grammar of s-expressions +------------------------ + +S-expressions are either sequences of non-whitespace characters +(= atoms), doubly quoted strings or lists. The lists can recursively +contain further s-expressions or be empty, and must be balanced, +i.e. parentheses must match. + +Examples +-------- + +:: + + this_is_an_atom_123'&^%! ; this is a comment + "another atom in an OCaml-string \"string in a string\" \123" + + ; empty list follows below + () + + ; a more complex example + ( + ( + list in a list ; comment within a list + (list in a list in a list) + 42 is the answer to all questions + #; (this S-expression + (has been commented out) + ) + #| Block comments #| can be "nested" |# |# + ) + ) + + .. _opam-files: .opam files diff --git a/vendor/usexp/src/jbuild b/src/usexp/jbuild similarity index 100% rename from vendor/usexp/src/jbuild rename to src/usexp/jbuild diff --git a/vendor/usexp/src/parser_automaton_internal.ml b/src/usexp/parser_automaton_internal.ml similarity index 100% rename from vendor/usexp/src/parser_automaton_internal.ml rename to src/usexp/parser_automaton_internal.ml diff --git a/vendor/usexp/src/parser_automaton_internal.mli b/src/usexp/parser_automaton_internal.mli similarity index 100% rename from vendor/usexp/src/parser_automaton_internal.mli rename to src/usexp/parser_automaton_internal.mli diff --git a/vendor/usexp/src/sexp_ast.ml b/src/usexp/sexp_ast.ml similarity index 100% rename from vendor/usexp/src/sexp_ast.ml rename to src/usexp/sexp_ast.ml diff --git a/vendor/usexp/src/table.ml b/src/usexp/table.ml similarity index 100% rename from vendor/usexp/src/table.ml rename to src/usexp/table.ml diff --git a/vendor/usexp/src/table.mli b/src/usexp/table.mli similarity index 100% rename from vendor/usexp/src/table.mli rename to src/usexp/table.mli diff --git a/vendor/usexp/src/usexp.ml b/src/usexp/usexp.ml similarity index 100% rename from vendor/usexp/src/usexp.ml rename to src/usexp/usexp.ml diff --git a/vendor/usexp/src/usexp.mli b/src/usexp/usexp.mli similarity index 100% rename from vendor/usexp/src/usexp.mli rename to src/usexp/usexp.mli diff --git a/vendor/usexp/LICENSE.md b/vendor/usexp/LICENSE.md deleted file mode 100644 index d6456956..00000000 --- a/vendor/usexp/LICENSE.md +++ /dev/null @@ -1,202 +0,0 @@ - - Apache License - Version 2.0, January 2004 - http://www.apache.org/licenses/ - - TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION - - 1. Definitions. - - "License" shall mean the terms and conditions for use, reproduction, - and distribution as defined by Sections 1 through 9 of this document. - - "Licensor" shall mean the copyright owner or entity authorized by - the copyright owner that is granting the License. - - "Legal Entity" shall mean the union of the acting entity and all - other entities that control, are controlled by, or are under common - control with that entity. For the purposes of this definition, - "control" means (i) the power, direct or indirect, to cause the - direction or management of such entity, whether by contract or - otherwise, or (ii) ownership of fifty percent (50%) or more of the - outstanding shares, or (iii) beneficial ownership of such entity. - - "You" (or "Your") shall mean an individual or Legal Entity - exercising permissions granted by this License. - - "Source" form shall mean the preferred form for making modifications, - including but not limited to software source code, documentation - source, and configuration files. - - "Object" form shall mean any form resulting from mechanical - transformation or translation of a Source form, including but - not limited to compiled object code, generated documentation, - and conversions to other media types. - - "Work" shall mean the work of authorship, whether in Source or - Object form, made available under the License, as indicated by a - copyright notice that is included in or attached to the work - (an example is provided in the Appendix below). - - "Derivative Works" shall mean any work, whether in Source or Object - form, that is based on (or derived from) the Work and for which the - editorial revisions, annotations, elaborations, or other modifications - represent, as a whole, an original work of authorship. For the purposes - of this License, Derivative Works shall not include works that remain - separable from, or merely link (or bind by name) to the interfaces of, - the Work and Derivative Works thereof. - - "Contribution" shall mean any work of authorship, including - the original version of the Work and any modifications or additions - to that Work or Derivative Works thereof, that is intentionally - submitted to Licensor for inclusion in the Work by the copyright owner - or by an individual or Legal Entity authorized to submit on behalf of - the copyright owner. For the purposes of this definition, "submitted" - means any form of electronic, verbal, or written communication sent - to the Licensor or its representatives, including but not limited to - communication on electronic mailing lists, source code control systems, - and issue tracking systems that are managed by, or on behalf of, the - Licensor for the purpose of discussing and improving the Work, but - excluding communication that is conspicuously marked or otherwise - designated in writing by the copyright owner as "Not a Contribution." - - "Contributor" shall mean Licensor and any individual or Legal Entity - on behalf of whom a Contribution has been received by Licensor and - subsequently incorporated within the Work. - - 2. Grant of Copyright License. Subject to the terms and conditions of - this License, each Contributor hereby grants to You a perpetual, - worldwide, non-exclusive, no-charge, royalty-free, irrevocable - copyright license to reproduce, prepare Derivative Works of, - publicly display, publicly perform, sublicense, and distribute the - Work and such Derivative Works in Source or Object form. - - 3. Grant of Patent License. Subject to the terms and conditions of - this License, each Contributor hereby grants to You a perpetual, - worldwide, non-exclusive, no-charge, royalty-free, irrevocable - (except as stated in this section) patent license to make, have made, - use, offer to sell, sell, import, and otherwise transfer the Work, - where such license applies only to those patent claims licensable - by such Contributor that are necessarily infringed by their - Contribution(s) alone or by combination of their Contribution(s) - with the Work to which such Contribution(s) was submitted. If You - institute patent litigation against any entity (including a - cross-claim or counterclaim in a lawsuit) alleging that the Work - or a Contribution incorporated within the Work constitutes direct - or contributory patent infringement, then any patent licenses - granted to You under this License for that Work shall terminate - as of the date such litigation is filed. - - 4. Redistribution. You may reproduce and distribute copies of the - Work or Derivative Works thereof in any medium, with or without - modifications, and in Source or Object form, provided that You - meet the following conditions: - - (a) You must give any other recipients of the Work or - Derivative Works a copy of this License; and - - (b) You must cause any modified files to carry prominent notices - stating that You changed the files; and - - (c) You must retain, in the Source form of any Derivative Works - that You distribute, all copyright, patent, trademark, and - attribution notices from the Source form of the Work, - excluding those notices that do not pertain to any part of - the Derivative Works; and - - (d) If the Work includes a "NOTICE" text file as part of its - distribution, then any Derivative Works that You distribute must - include a readable copy of the attribution notices contained - within such NOTICE file, excluding those notices that do not - pertain to any part of the Derivative Works, in at least one - of the following places: within a NOTICE text file distributed - as part of the Derivative Works; within the Source form or - documentation, if provided along with the Derivative Works; or, - within a display generated by the Derivative Works, if and - wherever such third-party notices normally appear. The contents - of the NOTICE file are for informational purposes only and - do not modify the License. You may add Your own attribution - notices within Derivative Works that You distribute, alongside - or as an addendum to the NOTICE text from the Work, provided - that such additional attribution notices cannot be construed - as modifying the License. - - You may add Your own copyright statement to Your modifications and - may provide additional or different license terms and conditions - for use, reproduction, or distribution of Your modifications, or - for any such Derivative Works as a whole, provided Your use, - reproduction, and distribution of the Work otherwise complies with - the conditions stated in this License. - - 5. Submission of Contributions. Unless You explicitly state otherwise, - any Contribution intentionally submitted for inclusion in the Work - by You to the Licensor shall be under the terms and conditions of - this License, without any additional terms or conditions. - Notwithstanding the above, nothing herein shall supersede or modify - the terms of any separate license agreement you may have executed - with Licensor regarding such Contributions. - - 6. Trademarks. This License does not grant permission to use the trade - names, trademarks, service marks, or product names of the Licensor, - except as required for reasonable and customary use in describing the - origin of the Work and reproducing the content of the NOTICE file. - - 7. Disclaimer of Warranty. Unless required by applicable law or - agreed to in writing, Licensor provides the Work (and each - Contributor provides its Contributions) on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or - implied, including, without limitation, any warranties or conditions - of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A - PARTICULAR PURPOSE. You are solely responsible for determining the - appropriateness of using or redistributing the Work and assume any - risks associated with Your exercise of permissions under this License. - - 8. Limitation of Liability. In no event and under no legal theory, - whether in tort (including negligence), contract, or otherwise, - unless required by applicable law (such as deliberate and grossly - negligent acts) or agreed to in writing, shall any Contributor be - liable to You for damages, including any direct, indirect, special, - incidental, or consequential damages of any character arising as a - result of this License or out of the use or inability to use the - Work (including but not limited to damages for loss of goodwill, - work stoppage, computer failure or malfunction, or any and all - other commercial damages or losses), even if such Contributor - has been advised of the possibility of such damages. - - 9. Accepting Warranty or Additional Liability. While redistributing - the Work or Derivative Works thereof, You may choose to offer, - and charge a fee for, acceptance of support, warranty, indemnity, - or other liability obligations and/or rights consistent with this - License. However, in accepting such obligations, You may act only - on Your own behalf and on Your sole responsibility, not on behalf - of any other Contributor, and only if You agree to indemnify, - defend, and hold each Contributor harmless for any liability - incurred by, or claims asserted against, such Contributor by reason - of your accepting any such warranty or additional liability. - - END OF TERMS AND CONDITIONS - - APPENDIX: How to apply the Apache License to your work. - - To apply the Apache License to your work, attach the following - boilerplate notice, with the fields enclosed by brackets "[]" - replaced with your own identifying information. (Don't include - the brackets!) The text should be enclosed in the appropriate - comment syntax for the file format. We also recommend that a - file or class name and description of purpose be included on the - same "printed page" as the copyright notice for easier - identification within third-party archives. - - Copyright [yyyy] [name of copyright owner] - - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. From 73f529ae822e176f3cf95cbc0d698dc73ffa7df7 Mon Sep 17 00:00:00 2001 From: Christophe Troestler Date: Mon, 29 Jan 2018 18:57:57 +0100 Subject: [PATCH 07/17] Rename String to Quoted_string --- src/action.ml | 2 +- src/jbuild.ml | 11 ++++++----- src/ordered_set_lang.ml | 4 ++-- src/sexp.ml | 18 +++++++++--------- src/sexp.mli | 2 +- src/string_with_vars.ml | 2 +- src/usexp/parser_automaton_internal.ml | 2 +- src/usexp/sexp_ast.ml | 2 +- src/usexp/usexp.ml | 18 +++++++++--------- src/usexp/usexp.mli | 4 ++-- 10 files changed, 33 insertions(+), 32 deletions(-) diff --git a/src/action.ml b/src/action.ml index 7669f40b..0503502d 100644 --- a/src/action.ml +++ b/src/action.ml @@ -328,7 +328,7 @@ module Unexpanded = struct let t sexp = match sexp with - | Atom _ | String _ -> + | Atom _ | Quoted_string _ -> of_sexp_errorf sexp "if you meant for this to be executed with bash, write (bash \"...\") instead" | List _ -> t sexp diff --git a/src/jbuild.ml b/src/jbuild.ml index d975f786..71cf224c 100644 --- a/src/jbuild.ml +++ b/src/jbuild.ml @@ -190,7 +190,7 @@ module Pp_or_flags = struct PP (Pp.of_string s) let t = function - | Atom (_, s) | String (_, s) -> of_string s + | Atom (_, s) | Quoted_string (_, s) -> of_string s | List (_, l) -> Flags (List.map l ~f:string) let split l = @@ -225,7 +225,7 @@ module Dep_conf = struct in fun sexp -> match sexp with - | Atom _ | String _ -> File (String_with_vars.t sexp) + | Atom _ | Quoted_string _ -> File (String_with_vars.t sexp) | List _ -> t sexp open Sexp @@ -356,7 +356,7 @@ module Lib_dep = struct let choice = function | List (_, l) as sexp -> let rec loop required forbidden = function - | [Atom (_, "->"); fsexp] | [String (_, "->"); fsexp] -> + | [Atom (_, "->"); fsexp] | [Quoted_string (_, "->"); fsexp] -> let common = String_set.inter required forbidden in if not (String_set.is_empty common) then of_sexp_errorf sexp @@ -366,9 +366,10 @@ module Lib_dep = struct ; forbidden ; file = file fsexp } - | Atom (_, "->") :: _ | String (_, "->") :: _ | List _ :: _ | [] -> + | Atom (_, "->") :: _ | Quoted_string (_, "->") :: _ + | List _ :: _ | [] -> of_sexp_error sexp "(<[!]libraries>... -> ) expected" - | (Atom (_, s) | String (_, s)) :: l -> + | (Atom (_, 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 diff --git a/src/ordered_set_lang.ml b/src/ordered_set_lang.ml index a1a33694..365878a2 100644 --- a/src/ordered_set_lang.ml +++ b/src/ordered_set_lang.ml @@ -25,7 +25,7 @@ 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 (_, "") | String (_, _)) as t -> Ast.Element (f t) + | (Atom (_, "") | Quoted_string (_, _)) as t -> Ast.Element (f t) | Atom (loc, s) as t -> if s.[0] = ':' then Special (loc, String.sub s ~pos:1 ~len:(String.length s - 1)) @@ -43,7 +43,7 @@ let parse_general sexp ~f = let t sexp : t = let ast = parse_general sexp ~f:(function - | Atom (loc, s) | String (loc, s) -> (loc, s) + | Atom (loc, s) | Quoted_string (loc, s) -> (loc, s) | List _ -> assert false) in { ast diff --git a/src/sexp.ml b/src/sexp.ml index 2eb17d08..c9c824a0 100644 --- a/src/sexp.ml +++ b/src/sexp.ml @@ -85,7 +85,7 @@ end module To_sexp = struct type nonrec 'a t = 'a -> t let unit () = List [] - let string s = String s + let 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) @@ -109,7 +109,7 @@ end module Of_sexp = struct type ast = Ast.t = | Atom of Loc.t * string - | String of Loc.t * string + | Quoted_string of Loc.t * string | List of Loc.t * ast list type 'a t = ast -> 'a @@ -126,7 +126,7 @@ module Of_sexp = struct let string = function | Atom (_, s) -> s - | String (_, s) -> s + | Quoted_string (_, s) -> s | List _ as sexp -> of_sexp_error sexp "Atom expected" let int sexp = @@ -158,7 +158,7 @@ module Of_sexp = struct | sexp -> of_sexp_error sexp "S-expression of the form (_ _ _) expected" let list f = function - | (Atom _ | String _) as sexp -> of_sexp_error sexp "List expected" + | (Atom _ | Quoted_string _) as sexp -> of_sexp_error sexp "List expected" | List (_, l) -> List.map l ~f let array f sexp = Array.of_list (list f sexp) @@ -292,7 +292,7 @@ module Of_sexp = struct let make_record_parser_state sexp = match sexp with - | Atom _ | String _ -> of_sexp_error sexp "List expected" + | Atom _ | Quoted_string _ -> of_sexp_error sexp "List expected" | List (loc, sexps) -> let unparsed = List.fold_left sexps ~init:Name_map.empty ~f:(fun acc sexp -> @@ -301,7 +301,7 @@ module Of_sexp = struct Name_map.add acc ~key:name ~data:{ value = None; entry = sexp } | List (_, [name_sexp; value]) -> begin match name_sexp with - | Atom (_, name) | String (_, name) -> + | Atom (_, name) | Quoted_string (_, name) -> Name_map.add acc ~key:name ~data:{ value = Some value; entry = sexp } | List _ -> @@ -410,7 +410,7 @@ module Of_sexp = struct let sum cstrs sexp = match sexp with - | Atom (loc, s) | String (loc, s) -> begin + | Atom (loc, s) | Quoted_string (loc, 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" @@ -419,7 +419,7 @@ module Of_sexp = struct | List (loc, name_sexp :: args) -> match name_sexp with | List _ -> of_sexp_error name_sexp "Atom expected" - | Atom (_, s) | String (_, s) -> + | Atom (_, s) | Quoted_string (_, 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)) @@ -427,7 +427,7 @@ module Of_sexp = struct let enum cstrs sexp = match sexp with | List _ -> of_sexp_error sexp "Atom expected" - | Atom (_, s) | String (_, s) -> + | Atom (_, s) | Quoted_string (_, s) -> match List.find cstrs ~f:(fun (name, _) -> equal_cstr_name name s) diff --git a/src/sexp.mli b/src/sexp.mli index 3c420fd5..36af356d 100644 --- a/src/sexp.mli +++ b/src/sexp.mli @@ -40,7 +40,7 @@ end with type sexp := t module Of_sexp : sig type ast = Ast.t = | Atom of Loc.t * string - | String of Loc.t * string + | Quoted_string of Loc.t * string | List of Loc.t * ast list include Combinators with type 'a t = Ast.t -> 'a diff --git a/src/string_with_vars.ml b/src/string_with_vars.ml index 154b4f14..5ed40e7f 100644 --- a/src/string_with_vars.ml +++ b/src/string_with_vars.ml @@ -70,7 +70,7 @@ let unquoted_var t = let t : Sexp.Of_sexp.ast -> t = function | Atom(loc, s) -> of_string ~loc s - | String(loc, s) -> + | Quoted_string (loc, s) -> (* If [unquoted_var], then add [""] at the end (see [type t]). *) let t = of_string ~loc s in (match t.items with diff --git a/src/usexp/parser_automaton_internal.ml b/src/usexp/parser_automaton_internal.ml index 79fe45ae..3efe016c 100644 --- a/src/usexp/parser_automaton_internal.ml +++ b/src/usexp/parser_automaton_internal.ml @@ -344,7 +344,7 @@ let push_quoted_atom state _char stack = Buffer.clear state.atom_buffer; let stack = if state.ignoring = 0 then - Sexp (String (make_loc state ~delta:1, str), stack) + Sexp (Quoted_string (make_loc state ~delta:1, str), stack) else stack in diff --git a/src/usexp/sexp_ast.ml b/src/usexp/sexp_ast.ml index b61dcf29..cb7c39aa 100644 --- a/src/usexp/sexp_ast.ml +++ b/src/usexp/sexp_ast.ml @@ -7,5 +7,5 @@ end type t = | Atom of Loc.t * string - | String of Loc.t * string + | Quoted_string of Loc.t * string | List of Loc.t * t list diff --git a/src/usexp/usexp.ml b/src/usexp/usexp.ml index 038688ca..726c171c 100644 --- a/src/usexp/usexp.ml +++ b/src/usexp/usexp.ml @@ -87,20 +87,20 @@ end type t = | Atom of string - | String of string + | Quoted_string of string | List of t list type sexp = t let rec to_string = function | Atom s -> Atom.serialize s - | String s -> Atom.quote s + | Quoted_string s -> Atom.quote 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) - | String s -> + | Quoted_string s -> Format.pp_print_string ppf (Atom.serialize s) | List [] -> Format.pp_print_string ppf "()" @@ -128,7 +128,7 @@ let split_string s ~on = loop 0 0 let rec pp_split_strings ppf = function - | Atom s | String s -> + | Atom s | Quoted_string s -> if Atom.must_escape s then begin if String.contains s '\n' then begin match split_string s ~on:'\n' with @@ -204,14 +204,14 @@ module Loc = Sexp_ast.Loc module Ast = struct type t = Sexp_ast.t = | Atom of Loc.t * string - | String of Loc.t * string + | Quoted_string of Loc.t * string | List of Loc.t * t list - let loc (Atom (loc, _) | String (loc, _) | List (loc, _)) = loc + let loc (Atom (loc, _) | Quoted_string (loc, _) | List (loc, _)) = loc let rec remove_locs : t -> sexp = function | Atom (_, s) -> Atom s - | String (_, s) -> String s + | Quoted_string (_, s) -> Quoted_string s | List (_, l) -> List (List.map l ~f:remove_locs) module Token = struct @@ -226,7 +226,7 @@ module Ast = struct let rec loop acc t = match t with | Atom (loc, s) -> Token.Atom (loc, s) :: acc - | String (loc, s) -> Token.String (loc, s) :: acc + | Quoted_string (loc, s) -> Token.String (loc, s) :: acc | List (loc, l) -> let shift (pos : Lexing.position) delta = { pos with pos_cnum = pos.pos_cnum + delta } @@ -244,7 +244,7 @@ end let rec add_loc t ~loc : Ast.t = match t with | Atom s -> Atom (loc, s) - | String s -> String (loc, s) + | Quoted_string s -> Quoted_string (loc, s) | List l -> List (loc, List.map l ~f:(add_loc ~loc)) module Parser = struct diff --git a/src/usexp/usexp.mli b/src/usexp/usexp.mli index 33592e63..c1bff335 100644 --- a/src/usexp/usexp.mli +++ b/src/usexp/usexp.mli @@ -24,7 +24,7 @@ end (** The S-expression type *) type t = | Atom of Atom.t - | String of string (** Quoted string *) + | Quoted_string of string | List of t list (** Serialize a S-expression *) @@ -47,7 +47,7 @@ module Ast : sig type sexp = t type t = | Atom of Loc.t * Atom.t - | String of Loc.t * string (** Quoted string *) + | Quoted_string of Loc.t * string | List of Loc.t * t list val loc : t -> Loc.t From f9e17f76e0fd0be0f7076bf73142ad6228d0dbec Mon Sep 17 00:00:00 2001 From: Christophe Troestler Date: Mon, 29 Jan 2018 22:51:20 +0100 Subject: [PATCH 08/17] Requires that atoms are unquoted is some contexts --- src/sexp.ml | 46 +++++++++++++++++++++------------------------- 1 file changed, 21 insertions(+), 25 deletions(-) diff --git a/src/sexp.ml b/src/sexp.ml index c9c824a0..e192573f 100644 --- a/src/sexp.ml +++ b/src/sexp.ml @@ -127,27 +127,22 @@ module Of_sexp = struct let string = function | Atom (_, s) -> s | Quoted_string (_, s) -> s - | List _ as sexp -> of_sexp_error sexp "Atom expected" + | List _ as sexp -> of_sexp_error sexp "Atom or quoted string expected" - let int sexp = - let s = string sexp in - try - int_of_string s - with _ -> - of_sexp_error sexp "Integer expected" + let int sexp = match sexp with + | Atom (_, s) -> (try int_of_string s + with _ -> of_sexp_error sexp "Integer expected") + | _ -> of_sexp_error sexp "Integer expected" - let float sexp = - let s = string sexp in - try - float_of_string s - with _ -> - of_sexp_error sexp "Float expected" + let float sexp = match sexp with + | Atom (_, s) -> (try float_of_string s + with _ -> of_sexp_error sexp "Float expected") + | _ -> of_sexp_error sexp "Float expected" - let bool sexp = - match string sexp with - | "true" -> true - | "false" -> false - | _ -> of_sexp_error sexp "'true' or 'false' expected" + let bool = function + | Atom (_, "true") -> true + | Atom (_, "false") -> false + | sexp -> of_sexp_error sexp "'true' or 'false' expected" let pair fa fb = function | List (_, [a; b]) -> (fa a, fb b) @@ -301,10 +296,10 @@ module Of_sexp = struct Name_map.add acc ~key:name ~data:{ value = None; entry = sexp } | List (_, [name_sexp; value]) -> begin match name_sexp with - | Atom (_, name) | Quoted_string (_, name) -> + | Atom (_, name) -> Name_map.add acc ~key:name ~data:{ value = Some value; entry = sexp } - | List _ -> + | List _ | Quoted_string _ -> of_sexp_error name_sexp "Atom expected" end | _ -> @@ -410,24 +405,25 @@ module Of_sexp = struct let sum cstrs sexp = match sexp with - | Atom (loc, s) | Quoted_string (loc, s) -> begin + | Atom (loc, 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" end + | Quoted_string _ -> of_sexp_error sexp "Atom expected" | List (_, []) -> of_sexp_error sexp "non-empty list expected" | List (loc, name_sexp :: args) -> match name_sexp with - | List _ -> of_sexp_error name_sexp "Atom expected" - | Atom (_, s) | Quoted_string (_, s) -> + | Quoted_string _ | List _ -> of_sexp_error name_sexp "Atom expected" + | Atom (_, 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)) let enum cstrs sexp = match sexp with - | List _ -> of_sexp_error sexp "Atom expected" - | Atom (_, s) | Quoted_string (_, s) -> + | Quoted_string _ | List _ -> of_sexp_error sexp "Atom expected" + | Atom (_, s) -> match List.find cstrs ~f:(fun (name, _) -> equal_cstr_name name s) From cc9c71661e10aadaa4f252a1772fcdb892213680 Mon Sep 17 00:00:00 2001 From: Christophe Troestler Date: Wed, 31 Jan 2018 02:31:47 +0100 Subject: [PATCH 09/17] =?UTF-8?q?Fix=20J=C3=A9r=C3=A9mie=20Dimino=20remark?= =?UTF-8?q?s?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- src/usexp/usexp.ml | 15 +++++++++++++-- 1 file changed, 13 insertions(+), 2 deletions(-) diff --git a/src/usexp/usexp.ml b/src/usexp/usexp.ml index 726c171c..f100f1bb 100644 --- a/src/usexp/usexp.ml +++ b/src/usexp/usexp.ml @@ -101,7 +101,7 @@ let rec pp ppf = function | Atom s -> Format.pp_print_string ppf (Atom.serialize s) | Quoted_string s -> - Format.pp_print_string ppf (Atom.serialize s) + Format.pp_print_string ppf (Atom.quote s) | List [] -> Format.pp_print_string ppf "()" | List (first :: rest) -> @@ -128,7 +128,7 @@ let split_string s ~on = loop 0 0 let rec pp_split_strings ppf = function - | Atom s | Quoted_string s -> + | Atom s -> if Atom.must_escape s then begin if String.contains s '\n' then begin match split_string s ~on:'\n' with @@ -142,6 +142,17 @@ let rec pp_split_strings ppf = function Format.fprintf ppf "%S" s end else Format.pp_print_string ppf s + | Quoted_string s -> + if String.contains s '\n' then begin + match split_string s ~on:'\n' with + | [] -> Format.pp_print_string ppf (Atom.quote s) + | first :: rest -> + Format.fprintf ppf "@[\"@{%s" (String.escaped first); + List.iter rest ~f:(fun s -> + Format.fprintf ppf "@,\\n%s" (String.escaped s)); + Format.fprintf ppf "@}\"@]" + end else + Format.pp_print_string ppf (Atom.quote s) | List [] -> Format.pp_print_string ppf "()" | List (first :: rest) -> From 754aa59cc32411be95a5afa1f60f3fe8d2f81d24 Mon Sep 17 00:00:00 2001 From: Christophe Troestler Date: Tue, 30 Jan 2018 18:08:28 +0100 Subject: [PATCH 10/17] String_with_vars: Distinguish quoted and unquoted strings This implies that an atom can only contain a single variable, such as ${@}, and not something like xxx${@}xxx. The internal representation was changed not to be able to represent the latter. --- src/string_with_vars.ml | 61 ++++++++++++++++++---------------------- src/string_with_vars.mli | 7 ++--- 2 files changed, 30 insertions(+), 38 deletions(-) diff --git a/src/string_with_vars.ml b/src/string_with_vars.ml index 5ed40e7f..30b4eeb3 100644 --- a/src/string_with_vars.ml +++ b/src/string_with_vars.ml @@ -6,12 +6,10 @@ type item = | Text of string | Var of var_syntax * string -(* A single unquoted variable is encoded as the list [Var v]. A - quoted variable is encoded as [Var v; Text ""]. *) type t = { items : item list - ; loc : Loc.t - } + ; loc : Loc.t + ; quoted : bool } module Token = struct type t = @@ -48,6 +46,7 @@ module Token = struct | Close Parens -> ")" end +(* Remark: Consecutive [Text] items are concatenated. *) let rec of_tokens : Token.t list -> item list = function | [] -> [] | Open a :: String s :: Close b :: rest when a = b -> @@ -58,33 +57,27 @@ let rec of_tokens : Token.t list -> item list = function | Text s' :: l -> Text (s ^ s') :: l | l -> Text s :: l -let of_string ~loc s = - { items = of_tokens (Token.tokenise s) - ; loc - } +let items_of_string s = of_tokens (Token.tokenise s) let unquoted_var t = - match t.items with - | [Var (_, s)] -> Some s + match t.quoted, t.items with + | true, [Var(_, s)] -> Some s | _ -> None let t : Sexp.Of_sexp.ast -> t = function - | Atom(loc, s) -> of_string ~loc s + | Atom(loc, s) -> { items = items_of_string s; loc; quoted = false } | Quoted_string (loc, s) -> - (* If [unquoted_var], then add [""] at the end (see [type t]). *) - let t = of_string ~loc s in - (match t.items with - | [Var _ as v] -> {t with items = [v; Text ""] } - | _ -> t) + { items = items_of_string s; loc; quoted = true } | List _ as sexp -> Sexp.Of_sexp.of_sexp_error sexp "Atom expected" let loc t = t.loc -let virt pos s = of_string ~loc:(Loc.of_pos pos) s -let virt_var pos s = { loc = Loc.of_pos pos; items = [Var (Braces, s)] } -let virt_quoted_var pos s = { loc = Loc.of_pos pos; - items = [Var (Braces, s); Text ""] } -let virt_text pos s = { loc = Loc.of_pos pos; items = [Text s] } +let virt ?(quoted=true) pos s = + { items = items_of_string s; loc = Loc.of_pos pos; quoted } +let virt_var ?(quoted=true) pos s = + { items = [Var (Braces, s)]; loc = Loc.of_pos pos; quoted } +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" @@ -100,14 +93,13 @@ let sexp_of_t t = Sexp.To_sexp.list sexp_of_item t.items let fold t ~init ~f = List.fold_left t.items ~init ~f:(fun acc item -> - match item with - | Text _ -> acc - | Var (_, v) -> f acc t.loc v) + match item with + | Text _ -> acc + | Var (_, v) -> f acc t.loc v) -let iter t ~f = - List.iter t.items ~f:(function - | Text _ -> () - | Var (_, v) -> f t.loc v) +let iter t ~f = List.iter t.items ~f:(function + | Text _ -> () + | Var (_, v) -> f t.loc v) let vars t = fold t ~init:String_set.empty ~f:(fun acc _ x -> String_set.add x acc) @@ -118,11 +110,11 @@ let string_of_var syntax v = let expand t ~f = List.map t.items ~f:(function - | Text s -> s - | Var (syntax, v) -> - match f t.loc v with - | Some x -> x - | None -> string_of_var syntax v) + | Text s -> s + | Var (syntax, v) -> + match f t.loc v with + | Some x -> x + | None -> string_of_var syntax v) |> String.concat ~sep:"" let concat_rev = function @@ -140,7 +132,8 @@ let partial_expand t ~f = | [] -> begin match acc with | [] -> Inl (concat_rev acc_text) - | _ -> Inr { t with items = List.rev (commit_text acc_text acc) } + | _ -> + Inr { t with items = List.rev (commit_text acc_text acc) } end | Text s :: items -> loop (s :: acc_text) acc items | Var (_, v) as it :: items -> diff --git a/src/string_with_vars.mli b/src/string_with_vars.mli index 04eef271..5249f8cf 100644 --- a/src/string_with_vars.mli +++ b/src/string_with_vars.mli @@ -23,10 +23,9 @@ val to_string : t -> string (** [t] generated by the OCaml code. The first argument should be [__POS__]. The second is either a string to parse, a variable name or plain text. *) -val virt : (string * int * int * int) -> string -> t -val virt_var : (string * int * int * int) -> string -> t -val virt_quoted_var : (string * int * int * int) -> string -> t -val virt_text : (string * int * int * int) -> string -> t +val virt : ?quoted: bool -> (string * int * int * int) -> string -> t +val virt_var : ?quoted: bool -> (string * int * int * int) -> string -> t +val virt_text : (string * int * int * int) -> string -> t val unquoted_var : t -> string option (** [unquoted_var t] return the [Some name] where [name] is the name of From a91cf637ae9bb60be627579c49f83efcbd782a1e Mon Sep 17 00:00:00 2001 From: Christophe Troestler Date: Thu, 1 Feb 2018 23:45:30 +0100 Subject: [PATCH 11/17] Trigger an error for unquoted concatenations with list variables Thus x${v} where v is a variable that returns several values must necessarily be quoted: "x${v}". --- src/action.ml | 72 +++++++++++++++++++++------------------- src/action.mli | 6 ++-- src/string_with_vars.ml | 72 ++++++++++++++++++++++++++++------------ src/string_with_vars.mli | 53 +++++++++++++++++++---------- src/super_context.ml | 11 ++---- 5 files changed, 130 insertions(+), 84 deletions(-) diff --git a/src/action.ml b/src/action.ml index 0503502d..c9dcf678 100644 --- a/src/action.ml +++ b/src/action.ml @@ -272,20 +272,29 @@ module Var_expansion = struct | Paths of Path.t list * Concat_or_split.t | Strings of string list * Concat_or_split.t + let is_multivalued = function + | Paths (_, Split) | Strings (_, Split) -> true + | Paths (_, Concat) | Strings (_, Concat) -> false + let concat = function | [s] -> s | l -> String.concat ~sep:" " l + let to_string = function + | Strings (l, _) -> concat l + | Paths (l, _) -> concat (List.map l ~f:Path.to_string) + + (* Relative to [dir]. *) let string_of_path ~dir p = Path.reach ~from:dir p let path_of_string ~dir s = Path.relative dir s - let to_strings ~dir = function + let to_strings_rel ~dir = function | Strings (l, Split ) -> l | Strings (l, Concat) -> [concat l] | Paths (l, Split ) -> List.map l ~f:(string_of_path ~dir) | Paths (l, Concat) -> [concat (List.map l ~f:(string_of_path ~dir))] - let to_string ~dir = function + let to_string_rel ~dir = function | Strings (l, _) -> concat l | Paths (l, _) -> concat (List.map l ~f:(string_of_path ~dir)) @@ -352,29 +361,27 @@ module Unexpanded = struct include Past module E = struct - let string ~dir ~f = function - | Inl x -> x - | Inr template -> - SW.expand template ~f:(fun loc var -> - match f loc var with - | None -> None - | Some e -> Some (VE.to_string ~dir e)) - let expand ~generic ~special ~map ~dir ~f = function | Inl x -> map x - | Inr template as x -> - match SW.unquoted_var template with - | None -> generic ~dir (string ~dir ~f x) - | Some var -> - match f (SW.loc template) var with - | None -> generic ~dir (SW.to_string template) - | Some e -> special ~dir e + | Inr template -> + match SW.expand_generic template ~f + ~is_multivalued:VE.is_multivalued + ~to_string:(VE.to_string_rel ~dir) + with + | Inl e -> special ~dir e + | Inr s -> generic ~dir s [@@inlined always] + let string ~dir ~f x = + expand ~dir ~f x + ~generic:(fun ~dir:_ x -> x) + ~special:VE.to_string_rel + ~map:(fun x -> x) + let strings ~dir ~f x = expand ~dir ~f x ~generic:(fun ~dir:_ x -> [x]) - ~special:VE.to_strings + ~special:VE.to_strings_rel ~map:(fun x -> [x]) let path ~dir ~f x = @@ -445,28 +452,23 @@ module Unexpanded = struct end module E = struct - let string ~dir ~f template = - SW.partial_expand template ~f:(fun loc var -> - match f loc var with - | None -> None - | Some e -> Some (VE.to_string ~dir e)) - let expand ~generic ~special ~dir ~f template = - match SW.unquoted_var template with - | None -> begin - match string ~dir ~f template with - | Inl x -> Inl (generic ~dir x) - | Inr _ as x -> x - end - | Some var -> - match f (SW.loc template) var with - | None -> Inr template - | Some e -> Inl (special ~dir e) + match SW.partial_expand_generic template ~f + ~is_multivalued:VE.is_multivalued + ~to_string:(VE.to_string_rel ~dir) with + | Inl (Inl e) -> Inl(special ~dir e) + | Inl (Inr s) -> Inl(generic ~dir s) + | Inr _ as x -> x + + let string ~dir ~f x = + expand ~dir ~f x + ~generic:(fun ~dir:_ x -> x) + ~special:VE.to_string_rel let strings ~dir ~f x = expand ~dir ~f x ~generic:(fun ~dir:_ x -> [x]) - ~special:VE.to_strings + ~special:VE.to_strings_rel let path ~dir ~f x = expand ~dir ~f x diff --git a/src/action.mli b/src/action.mli index 93a77c73..e9cb8f2f 100644 --- a/src/action.mli +++ b/src/action.mli @@ -3,13 +3,15 @@ open! Import module Var_expansion : sig module Concat_or_split : sig type t = - | Concat (* default *) - | Split (* the variable is a "split" list of items *) + | Concat (** default *) + | Split (** the variable is a "split" list of items *) end type t = | Paths of Path.t list * Concat_or_split.t | Strings of string list * Concat_or_split.t + + val to_string : t -> string end module Outputs : module type of struct include Action_intf.Outputs end diff --git a/src/string_with_vars.ml b/src/string_with_vars.ml index 30b4eeb3..b0ceeec1 100644 --- a/src/string_with_vars.ml +++ b/src/string_with_vars.ml @@ -59,11 +59,6 @@ let rec of_tokens : Token.t list -> item list = function let items_of_string s = of_tokens (Token.tokenise s) -let unquoted_var t = - match t.quoted, t.items with - | true, [Var(_, s)] -> Some s - | _ -> None - let t : Sexp.Of_sexp.ast -> t = function | Atom(loc, s) -> { items = items_of_string s; loc; quoted = false } | Quoted_string (loc, s) -> @@ -72,9 +67,9 @@ let t : Sexp.Of_sexp.ast -> t = function let loc t = t.loc -let virt ?(quoted=true) pos s = +let virt ?(quoted=false) pos s = { items = items_of_string s; loc = Loc.of_pos pos; quoted } -let virt_var ?(quoted=true) pos s = +let virt_var ?(quoted=false) pos s = { items = [Var (Braces, s)]; loc = Loc.of_pos pos; quoted } let virt_text pos s = { items = [Text s]; loc = Loc.of_pos pos; quoted = true } @@ -108,21 +103,41 @@ let string_of_var syntax v = | Parens -> sprintf "$(%s)" v | Braces -> sprintf "${%s}" v +let expand_generic t ~f ~is_multivalued ~to_string = + match t.items with + | [Var (syntax, v)] when not t.quoted -> + (* Unquoted single var *) + (match f t.loc v with + | Some e -> Inl e + | None -> Inr(string_of_var syntax v)) + | _ -> + Inr(List.map t.items ~f:(function + | Text s -> s + | Var (syntax, v) -> + match f t.loc v with + | Some x -> + if not t.quoted && is_multivalued x then + Loc.fail t.loc "please quote the string \ + containing the list variable %s" + (string_of_var syntax v) + else to_string x + | None -> string_of_var syntax v) + |> String.concat ~sep:"") + +let always_false _ = false +let identity_string (s: string) = s + let expand t ~f = - List.map t.items ~f:(function - | Text s -> s - | Var (syntax, v) -> - match f t.loc v with - | Some x -> x - | None -> string_of_var syntax v) - |> String.concat ~sep:"" + match expand_generic t ~f ~is_multivalued:always_false + ~to_string:identity_string with + | Inl s | Inr s -> s let concat_rev = function | [] -> "" | [s] -> s | l -> String.concat (List.rev l) ~sep:"" -let partial_expand t ~f = +let partial_expand_generic t ~f ~is_multivalued ~to_string = let commit_text acc_text acc = let s = concat_rev acc_text in if s = "" then acc else Text s :: acc @@ -131,17 +146,32 @@ let partial_expand t ~f = match items with | [] -> begin match acc with - | [] -> Inl (concat_rev acc_text) - | _ -> - Inr { t with items = List.rev (commit_text acc_text acc) } + | [] -> Inl (Inr(concat_rev acc_text)) + | _ -> Inr { t with items = List.rev (commit_text acc_text acc) } end | Text s :: items -> loop (s :: acc_text) acc items - | Var (_, v) as it :: items -> + | Var (syntax, v) as it :: items -> match f t.loc v with | None -> loop [] (it :: commit_text acc_text acc) items - | Some s -> loop (s :: acc_text) acc items + | Some x -> + if not t.quoted && is_multivalued x then + Loc.fail t.loc "please quote the string containing the \ + list variable %s" (string_of_var syntax v) + else loop (to_string x :: acc_text) acc items in - loop [] [] t.items + match t.items with + | [Var (_, v)] when not t.quoted -> + (* Unquoted single var *) + (match f t.loc v with + | Some e -> Inl (Inl e) + | None -> Inr t) + | _ -> loop [] [] t.items + +let partial_expand t ~f = + match partial_expand_generic t ~f ~is_multivalued:always_false + ~to_string:identity_string with + | Inl(Inl s | Inr s) -> Inl s + | Inr _ as x -> x let to_string t = match t.items with diff --git a/src/string_with_vars.mli b/src/string_with_vars.mli index 5249f8cf..a14cfc6a 100644 --- a/src/string_with_vars.mli +++ b/src/string_with_vars.mli @@ -22,15 +22,12 @@ val to_string : t -> string (** [t] generated by the OCaml code. The first argument should be [__POS__]. The second is either a string to parse, a variable name - or plain text. *) + or plain text. [quoted] says whether the string is quoted ([false] + by default). *) val virt : ?quoted: bool -> (string * int * int * int) -> string -> t val virt_var : ?quoted: bool -> (string * int * int * int) -> string -> t val virt_text : (string * int * int * int) -> string -> t -val unquoted_var : t -> string option -(** [unquoted_var t] return the [Some name] where [name] is the name of - the variable if [t] is solely made of a variable and [None] otherwise. *) - val vars : t -> String_set.t (** [vars t] returns the set of all variables in [t]. *) @@ -42,18 +39,38 @@ val iter : t -> f:(Loc.t -> string -> unit) -> unit (** [iter t ~f] iterates [f] over all variables of [t], the text portions being ignored. *) -val expand : t -> f:(Loc.t -> string -> string option) -> string -(** [expand t ~f] return [t] where all variables have been expanded - using [f]. If [f] returns [Some x], the variable is replaced by - [x]; if [f] returns [None], the variable is inserted as [${v}] or - [$(v)] — depending on the original concrete syntax used — where [v] - is the name if the variable. *) +val expand_generic : + t -> f:(Loc.t -> string -> 'a option) -> is_multivalued:('a -> bool) -> + to_string:('a -> string) -> ('a, string) either +(** [expand_generic t ~f] return [t] where all variables have been expanded + using [f]. If [f loc var] return [Some x], the variable [var] is + replaced by [x]; otherwise, the variable is inserted as [${var}] or + [$(var)] — depending on the original concrete syntax used. -val partial_expand : t -> f:(Loc.t -> string -> string option) - -> (string, t) either -(** [partial_expand t ~f] is like [expand] where all variables that - could be expanded (i.e., those for which [f] returns [Some _]) are. - If all the variables of [t] were expanded, a string is returned. - If [f] returns [None] on at least a variable of [t], it returns a - string-with-vars. *) + - [is_multivalued]: says whether the variables is a multivalued + one (such as for example ${@}) which much be in quoted strings to + be concatenated to text or other variables. + - [to_string]: For single unquoted variables, the outcome of [f] is + directly returned. For variables containing text portions or which + are quoted, the value returned by [f] is converted to a string + using [to_string]. *) + +val expand : + t -> f:(Loc.t -> string -> string option) -> string +(** Specialized version [expand_generic] that returns a string (so + variables are assumed to expand to a single value). *) + +val partial_expand_generic : + t -> f:(Loc.t -> string -> 'a option) -> is_multivalued:('a -> bool) -> + to_string:('a -> string) -> (('a, string) either, t) either +(** [partial_expand_generic t ~f] is like [expand_generic] where all + variables that could be expanded (i.e., those for which [f] returns + [Some _]) are. If all the variables of [t] were expanded, a string + is returned. If [f] returns [None] on at least a variable of [t], + it returns a string-with-vars. *) + +val partial_expand : + t -> f:(Loc.t -> string -> string option) -> (string, t) either +(** [partial_expand] is a specialized version of + [partial_expand_generic] that returns a string. *) diff --git a/src/super_context.ml b/src/super_context.ml index 6197c215..b6ec5c9f 100644 --- a/src/super_context.ml +++ b/src/super_context.ml @@ -50,12 +50,8 @@ let expand_vars t ~(scope : Lib_db.Scope.t) ~dir s = | "SCOPE_ROOT" -> Some (Path.reach ~from:dir (Lib_db.Scope.root scope)) | var -> - let open Action.Var_expansion in expand_var_no_root t var - |> Option.map ~f:(function - | Paths(p,_) -> let p = List.map p ~f:Path.to_string in - String.concat ~sep:" " p - | Strings(s,_) -> String.concat ~sep:" " s)) + |> Option.map ~f:(fun e -> Action.Var_expansion.to_string e)) let resolve_program t ?hint bin = Artifacts.binary ?hint t.artifacts bin @@ -139,7 +135,6 @@ let create | Some p -> p in let open Action.Var_expansion in - let open Action.Var_expansion.Concat_or_split in let make = match Bin.make with | None -> Strings (["make"], Split) @@ -657,9 +652,9 @@ module Action = struct | [] -> Loc.warn loc "Variable '<' used with no explicit \ dependencies@."; - Strings ([""], Split) + Strings ([""], Concat) | dep :: _ -> - Paths ([dep], Split)) + Paths ([dep], Concat)) | "^" -> Some (Paths (deps_written_by_user, Split)) | _ -> None) From 453ce1eb5626f9ec2af5f74ecca506ea47ac8d0d Mon Sep 17 00:00:00 2001 From: Christophe Troestler Date: Fri, 2 Feb 2018 19:19:17 +0100 Subject: [PATCH 12/17] String_with_vars: Use a functor to create generic expansion fun This required to remove the labeled ~dir arguments in Action because one would have had to use the same label for the expansion context in String_with_vars, which would have been odd for generic expansion functions. --- src/action.ml | 61 +++++++++---------- src/action.mli | 5 +- src/string_with_vars.ml | 127 +++++++++++++++++++++------------------ src/string_with_vars.mli | 62 +++++++++++-------- src/super_context.ml | 2 +- 5 files changed, 138 insertions(+), 119 deletions(-) diff --git a/src/action.ml b/src/action.ml index c9dcf678..761d77c3 100644 --- a/src/action.ml +++ b/src/action.ml @@ -276,35 +276,32 @@ module Var_expansion = struct | Paths (_, Split) | Strings (_, Split) -> true | Paths (_, Concat) | Strings (_, Concat) -> false + type context = Path.t (* For String_with_vars.Expand_to *) + let concat = function | [s] -> s | l -> String.concat ~sep:" " l - let to_string = function - | Strings (l, _) -> concat l - | Paths (l, _) -> concat (List.map l ~f:Path.to_string) - - (* Relative to [dir]. *) let string_of_path ~dir p = Path.reach ~from:dir p - let path_of_string ~dir s = Path.relative dir s + let path_of_string dir s = Path.relative dir s - let to_strings_rel ~dir = function + let to_strings dir = function | Strings (l, Split ) -> l | Strings (l, Concat) -> [concat l] | Paths (l, Split ) -> List.map l ~f:(string_of_path ~dir) | Paths (l, Concat) -> [concat (List.map l ~f:(string_of_path ~dir))] - let to_string_rel ~dir = function + let to_string (dir: context) = function | Strings (l, _) -> concat l | Paths (l, _) -> concat (List.map l ~f:(string_of_path ~dir)) - let to_path ~dir = function - | Strings (l, _) -> path_of_string ~dir (concat l) + let to_path dir = function + | Strings (l, _) -> path_of_string dir (concat l) | Paths ([p], _) -> p | Paths (l, _) -> - path_of_string ~dir (concat (List.map l ~f:(string_of_path ~dir))) + path_of_string dir (concat (List.map l ~f:(string_of_path ~dir))) - let to_prog_and_args ~dir exp : Unresolved.Program.t * string list = + let to_prog_and_args dir exp : Unresolved.Program.t * string list = let module P = Unresolved.Program in match exp with | Paths ([p], _) -> (This p, []) @@ -312,7 +309,7 @@ module Var_expansion = struct | Paths ([], _) | Strings ([], _) -> (Search "", []) | Paths (l, Concat) -> (This - (path_of_string ~dir + (path_of_string dir (concat (List.map l ~f:(string_of_path ~dir)))), []) | Strings (l, Concat) -> @@ -324,6 +321,7 @@ module Var_expansion = struct end module VE = Var_expansion +module To_VE = String_with_vars.Expand_to(VE) module SW = String_with_vars module Unexpanded = struct @@ -364,24 +362,21 @@ module Unexpanded = struct let expand ~generic ~special ~map ~dir ~f = function | Inl x -> map x | Inr template -> - match SW.expand_generic template ~f - ~is_multivalued:VE.is_multivalued - ~to_string:(VE.to_string_rel ~dir) - with - | Inl e -> special ~dir e - | Inr s -> generic ~dir s + match To_VE.expand dir template ~f with + | Inl e -> special dir e + | Inr s -> generic dir s [@@inlined always] let string ~dir ~f x = expand ~dir ~f x - ~generic:(fun ~dir:_ x -> x) - ~special:VE.to_string_rel + ~generic:(fun _dir x -> x) + ~special:VE.to_string ~map:(fun x -> x) let strings ~dir ~f x = expand ~dir ~f x - ~generic:(fun ~dir:_ x -> [x]) - ~special:VE.to_strings_rel + ~generic:(fun _dir x -> [x]) + ~special:VE.to_strings ~map:(fun x -> [x]) let path ~dir ~f x = @@ -392,7 +387,7 @@ module Unexpanded = struct let prog_and_args ~dir ~f x = expand ~dir ~f x - ~generic:(fun ~dir:_ s -> (Program.of_string ~dir s, [])) + ~generic:(fun _dir s -> (Program.of_string ~dir s, [])) ~special:VE.to_prog_and_args ~map:(fun x -> (x, [])) end @@ -453,22 +448,20 @@ module Unexpanded = struct module E = struct let expand ~generic ~special ~dir ~f template = - match SW.partial_expand_generic template ~f - ~is_multivalued:VE.is_multivalued - ~to_string:(VE.to_string_rel ~dir) with - | Inl (Inl e) -> Inl(special ~dir e) - | Inl (Inr s) -> Inl(generic ~dir s) + match To_VE.partial_expand dir template ~f with + | Inl (Inl e) -> Inl(special dir e) + | Inl (Inr s) -> Inl(generic dir s) | Inr _ as x -> x let string ~dir ~f x = expand ~dir ~f x - ~generic:(fun ~dir:_ x -> x) - ~special:VE.to_string_rel + ~generic:(fun _dir x -> x) + ~special:VE.to_string let strings ~dir ~f x = expand ~dir ~f x - ~generic:(fun ~dir:_ x -> [x]) - ~special:VE.to_strings_rel + ~generic:(fun _dir x -> [x]) + ~special:VE.to_strings let path ~dir ~f x = expand ~dir ~f x @@ -477,7 +470,7 @@ module Unexpanded = struct let prog_and_args ~dir ~f x = expand ~dir ~f x - ~generic:(fun ~dir s -> (Unresolved.Program.of_string ~dir s, [])) + ~generic:(fun dir s -> (Unresolved.Program.of_string ~dir s, [])) ~special:VE.to_prog_and_args end diff --git a/src/action.mli b/src/action.mli index e9cb8f2f..b85f7254 100644 --- a/src/action.mli +++ b/src/action.mli @@ -11,7 +11,10 @@ module Var_expansion : sig | Paths of Path.t list * Concat_or_split.t | Strings of string list * Concat_or_split.t - val to_string : t -> string + val to_string : Path.t -> t -> string + (** [to_string dir v] convert the variable expansion to a string. + If it is a path, the corresponding string will be relative to + [dir]. *) end module Outputs : module type of struct include Action_intf.Outputs end diff --git a/src/string_with_vars.ml b/src/string_with_vars.ml index b0ceeec1..74b25260 100644 --- a/src/string_with_vars.ml +++ b/src/string_with_vars.ml @@ -103,73 +103,86 @@ let string_of_var syntax v = | Parens -> sprintf "$(%s)" v | Braces -> sprintf "${%s}" v -let expand_generic t ~f ~is_multivalued ~to_string = - match t.items with - | [Var (syntax, v)] when not t.quoted -> - (* Unquoted single var *) - (match f t.loc v with - | Some e -> Inl e - | None -> Inr(string_of_var syntax v)) - | _ -> - Inr(List.map t.items ~f:(function - | Text s -> s - | Var (syntax, v) -> - match f t.loc v with - | Some x -> - if not t.quoted && is_multivalued x then - Loc.fail t.loc "please quote the string \ - containing the list variable %s" - (string_of_var syntax v) - else to_string x - | None -> string_of_var syntax v) - |> String.concat ~sep:"") - -let always_false _ = false -let identity_string (s: string) = s - -let expand t ~f = - match expand_generic t ~f ~is_multivalued:always_false - ~to_string:identity_string with - | Inl s | Inr s -> s +module type EXPANSION = sig + type t + val is_multivalued : t -> bool + type context + val to_string : context -> t -> string +end let concat_rev = function | [] -> "" | [s] -> s | l -> String.concat (List.rev l) ~sep:"" -let partial_expand_generic t ~f ~is_multivalued ~to_string = - let commit_text acc_text acc = - let s = concat_rev acc_text in - if s = "" then acc else Text s :: acc - in - let rec loop acc_text acc items = - match items with - | [] -> begin - match acc with - | [] -> Inl (Inr(concat_rev acc_text)) - | _ -> Inr { t with items = List.rev (commit_text acc_text acc) } - end - | Text s :: items -> loop (s :: acc_text) acc items - | Var (syntax, v) as it :: items -> - match f t.loc v with - | None -> loop [] (it :: commit_text acc_text acc) items - | Some x -> - if not t.quoted && is_multivalued x then +module Expand_to(V: EXPANSION) = struct + + let expand ctx t ~f = + match t.items with + | [Var (syntax, v)] when not t.quoted -> + (* Unquoted single var *) + (match f t.loc v with + | Some e -> Inl e + | None -> Inr(string_of_var syntax v)) + | _ -> + Inr(List.map t.items ~f:(function + | Text s -> s + | Var (syntax, v) -> + match f t.loc v with + | Some x -> + if not t.quoted && V.is_multivalued x then + Loc.fail t.loc "please quote the string \ + containing the list variable %s" + (string_of_var syntax v) + else V.to_string ctx x + | None -> string_of_var syntax v) + |> String.concat ~sep:"") + + let partial_expand ctx t ~f = + let commit_text acc_text acc = + let s = concat_rev acc_text in + if s = "" then acc else Text s :: acc + in + let rec loop acc_text acc items = + match items with + | [] -> begin + match acc with + | [] -> Inl (Inr(concat_rev acc_text)) + | _ -> Inr { t with items = List.rev (commit_text acc_text acc) } + end + | Text s :: items -> loop (s :: acc_text) acc items + | Var (syntax, v) as it :: items -> + match f t.loc v with + | None -> loop [] (it :: commit_text acc_text acc) items + | Some x -> + if not t.quoted && V.is_multivalued x then Loc.fail t.loc "please quote the string containing the \ list variable %s" (string_of_var syntax v) - else loop (to_string x :: acc_text) acc items - in - match t.items with - | [Var (_, v)] when not t.quoted -> - (* Unquoted single var *) - (match f t.loc v with - | Some e -> Inl (Inl e) - | None -> Inr t) - | _ -> loop [] [] t.items + else loop (V.to_string ctx x :: acc_text) acc items + in + match t.items with + | [Var (_, v)] when not t.quoted -> + (* Unquoted single var *) + (match f t.loc v with + | Some e -> Inl (Inl e) + | None -> Inr t) + | _ -> loop [] [] t.items +end + +module String_expansion = struct + type t = string + let is_multivalued _ = false + type context = unit + let to_string () (s: string) = s +end + +module S = Expand_to(String_expansion) + +let expand t ~f = + match S.expand () t ~f with Inl s | Inr s -> s let partial_expand t ~f = - match partial_expand_generic t ~f ~is_multivalued:always_false - ~to_string:identity_string with + match S.partial_expand () t ~f with | Inl(Inl s | Inr s) -> Inl s | Inr _ as x -> x diff --git a/src/string_with_vars.mli b/src/string_with_vars.mli index a14cfc6a..6f7fcf3f 100644 --- a/src/string_with_vars.mli +++ b/src/string_with_vars.mli @@ -39,38 +39,48 @@ val iter : t -> f:(Loc.t -> string -> unit) -> unit (** [iter t ~f] iterates [f] over all variables of [t], the text portions being ignored. *) -val expand_generic : - t -> f:(Loc.t -> string -> 'a option) -> is_multivalued:('a -> bool) -> - to_string:('a -> string) -> ('a, string) either -(** [expand_generic t ~f] return [t] where all variables have been expanded - using [f]. If [f loc var] return [Some x], the variable [var] is - replaced by [x]; otherwise, the variable is inserted as [${var}] or - [$(var)] — depending on the original concrete syntax used. +module type EXPANSION = sig + type t + (** The value to which variables are expanded. *) - - [is_multivalued]: says whether the variables is a multivalued - one (such as for example ${@}) which much be in quoted strings to - be concatenated to text or other variables. - - [to_string]: For single unquoted variables, the outcome of [f] is - directly returned. For variables containing text portions or which - are quoted, the value returned by [f] is converted to a string - using [to_string]. *) + val is_multivalued : t -> bool + (** Report whether the value is a multivalued one (such as for + example ${@}) which much be in quoted strings to be concatenated + to text or other variables. *) + + type context + (** Context needed to expand values of type [t] to strings. *) + + val to_string : context -> t -> string + (** When needing to expand with text portions or if the + string-with-vars is quoted, the value is converted to a string + using [to_string]. *) +end + +module Expand_to(V : EXPANSION) : sig + val expand : V.context -> t -> f:(Loc.t -> string -> V.t option) -> + (V.t, string) either + (** [expand t ~f] return [t] where all variables have been expanded + using [f]. If [f loc var] return [Some x], the variable [var] is + replaced by [x]; otherwise, the variable is inserted as [${var}] + or [$(var)] — depending on the original concrete syntax used. *) + + val partial_expand : + V.context -> t -> f:(Loc.t -> string -> V.t option) -> + ((V.t, string) either, t) either + (** [partial_expand t ~f] is like [expand_generic] where all + variables that could be expanded (i.e., those for which [f] + returns [Some _]) are. If all the variables of [t] were + expanded, a string is returned. If [f] returns [None] on at + least a variable of [t], it returns a string-with-vars. *) +end val expand : t -> f:(Loc.t -> string -> string option) -> string -(** Specialized version [expand_generic] that returns a string (so +(** Specialized version [Expand_to.expand] that returns a string (so variables are assumed to expand to a single value). *) -val partial_expand_generic : - t -> f:(Loc.t -> string -> 'a option) -> is_multivalued:('a -> bool) -> - to_string:('a -> string) -> (('a, string) either, t) either -(** [partial_expand_generic t ~f] is like [expand_generic] where all - variables that could be expanded (i.e., those for which [f] returns - [Some _]) are. If all the variables of [t] were expanded, a string - is returned. If [f] returns [None] on at least a variable of [t], - it returns a string-with-vars. *) - val partial_expand : t -> f:(Loc.t -> string -> string option) -> (string, t) either (** [partial_expand] is a specialized version of - [partial_expand_generic] that returns a string. *) - + [Expand_to.partial_expand] that returns a string. *) diff --git a/src/super_context.ml b/src/super_context.ml index b6ec5c9f..4ec2e691 100644 --- a/src/super_context.ml +++ b/src/super_context.ml @@ -51,7 +51,7 @@ let expand_vars t ~(scope : Lib_db.Scope.t) ~dir s = Some (Path.reach ~from:dir (Lib_db.Scope.root scope)) | var -> expand_var_no_root t var - |> Option.map ~f:(fun e -> Action.Var_expansion.to_string e)) + |> Option.map ~f:(fun e -> Action.Var_expansion.to_string dir e)) let resolve_program t ?hint bin = Artifacts.binary ?hint t.artifacts bin From 0cbd1c74501904b32ff112515cb458bb6fece335 Mon Sep 17 00:00:00 2001 From: Christophe Troestler Date: Fri, 2 Feb 2018 20:40:26 +0100 Subject: [PATCH 13/17] Usexp: factorize pp of atoms & fix serialization --- src/usexp/usexp.ml | 38 ++++++++++++++++---------------------- 1 file changed, 16 insertions(+), 22 deletions(-) diff --git a/src/usexp/usexp.ml b/src/usexp/usexp.ml index f100f1bb..8b73df2d 100644 --- a/src/usexp/usexp.ml +++ b/src/usexp/usexp.ml @@ -127,32 +127,26 @@ let split_string s ~on = in loop 0 0 +let pp_print_atom ppf ~serialize s = + if String.contains s '\n' then begin + match split_string s ~on:'\n' with + | [] -> Format.pp_print_string ppf (serialize s) + | first :: rest -> + Format.fprintf ppf "@[\"@{%s" (serialize first); + List.iter rest ~f:(fun s -> + Format.fprintf ppf "@,\\n%s" (serialize s)); + Format.fprintf ppf "@}\"@]" + end else + Format.fprintf ppf "%S" (serialize s) + let rec pp_split_strings ppf = function | Atom s -> - if Atom.must_escape s then begin - if String.contains s '\n' then begin - match split_string s ~on:'\n' with - | [] -> Format.pp_print_string ppf (Atom.serialize s) - | first :: rest -> - Format.fprintf ppf "@[\"@{%s" (String.escaped first); - List.iter rest ~f:(fun s -> - Format.fprintf ppf "@,\\n%s" (String.escaped s)); - Format.fprintf ppf "@}\"@]" - end else - Format.fprintf ppf "%S" s - end else + if Atom.must_escape s then + pp_print_atom ppf s ~serialize:Atom.serialize + else Format.pp_print_string ppf s | Quoted_string s -> - if String.contains s '\n' then begin - match split_string s ~on:'\n' with - | [] -> Format.pp_print_string ppf (Atom.quote s) - | first :: rest -> - Format.fprintf ppf "@[\"@{%s" (String.escaped first); - List.iter rest ~f:(fun s -> - Format.fprintf ppf "@,\\n%s" (String.escaped s)); - Format.fprintf ppf "@}\"@]" - end else - Format.pp_print_string ppf (Atom.quote s) + pp_print_atom ppf s ~serialize:Atom.quote | List [] -> Format.pp_print_string ppf "()" | List (first :: rest) -> From 8e9ec4a52a975551cd4689a1dbc332961f3c3ea9 Mon Sep 17 00:00:00 2001 From: Christophe Troestler Date: Tue, 6 Feb 2018 21:14:33 +0100 Subject: [PATCH 14/17] Do not accept the quoted form "->" in place of -> --- src/jbuild.ml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/jbuild.ml b/src/jbuild.ml index 71cf224c..c8295080 100644 --- a/src/jbuild.ml +++ b/src/jbuild.ml @@ -356,7 +356,7 @@ module Lib_dep = struct let choice = function | List (_, l) as sexp -> let rec loop required forbidden = function - | [Atom (_, "->"); fsexp] | [Quoted_string (_, "->"); fsexp] -> + | [Atom (_, "->"); fsexp] -> let common = String_set.inter required forbidden in if not (String_set.is_empty common) then of_sexp_errorf sexp @@ -366,7 +366,7 @@ module Lib_dep = struct ; forbidden ; file = file fsexp } - | Atom (_, "->") :: _ | Quoted_string (_, "->") :: _ + | Atom (_, "->") :: _ | List _ :: _ | [] -> of_sexp_error sexp "(<[!]libraries>... -> ) expected" | (Atom (_, s) | Quoted_string (_, s)) :: l -> From b48a9fec536f69c9ea11f235e3755f39920af645 Mon Sep 17 00:00:00 2001 From: Christophe Troestler Date: Tue, 6 Feb 2018 21:15:35 +0100 Subject: [PATCH 15/17] Usexp: Properly quote atoms when pretty printing --- src/usexp/usexp.ml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/usexp/usexp.ml b/src/usexp/usexp.ml index 8b73df2d..96d76a80 100644 --- a/src/usexp/usexp.ml +++ b/src/usexp/usexp.ml @@ -132,12 +132,12 @@ let pp_print_atom ppf ~serialize s = match split_string s ~on:'\n' with | [] -> Format.pp_print_string ppf (serialize s) | first :: rest -> - Format.fprintf ppf "@[\"@{%s" (serialize first); + Format.fprintf ppf "@[\"@{%s" (Atom.escaped first); List.iter rest ~f:(fun s -> - Format.fprintf ppf "@,\\n%s" (serialize s)); + Format.fprintf ppf "@,\\n%s" (Atom.escaped s)); Format.fprintf ppf "@}\"@]" end else - Format.fprintf ppf "%S" (serialize s) + Format.pp_print_string ppf (serialize s) let rec pp_split_strings ppf = function | Atom s -> From 91b38b637679812e1b80faed6e2cc76789e976c9 Mon Sep 17 00:00:00 2001 From: Christophe Troestler Date: Sat, 10 Feb 2018 16:06:27 +0100 Subject: [PATCH 16/17] Update Changelog --- CHANGES.md | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/CHANGES.md b/CHANGES.md index 98273531..82c4358a 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -1,6 +1,11 @@ 1.0+beta18 (14/02/2018) ----------------------- +- Let the parser distinguish quoted strings from atoms. This makes + possible to use "${v}" to concatenate the list of values provided by + a split-variable. Concatenating split-variables with text is also + now required to be quoted. + - Split calls to ocamldep. Before ocamldep would be called once per `library`/`executables` stanza. Now it is called once per file (#486) From 67c9363c7db8c82d759dac469b26f1d1dc09d21d Mon Sep 17 00:00:00 2001 From: Christophe Troestler Date: Mon, 12 Feb 2018 23:35:56 +0100 Subject: [PATCH 17/17] Use more precise combinators "atom" and "quoted_string" --- src/action.ml | 4 ++-- src/context.ml | 16 ++++++++-------- src/gen_rules.ml | 2 +- src/ocamldep.ml | 2 +- src/ordered_set_lang.ml | 2 +- src/path.ml | 2 +- src/sexp.ml | 37 ++++++++++++++++++++++++------------- src/sexp.mli | 20 ++++++++++++++++---- src/super_context.ml | 6 +++--- src/with_required_by.ml | 2 +- 10 files changed, 58 insertions(+), 35 deletions(-) diff --git a/src/action.ml b/src/action.ml index 761d77c3..64680056 100644 --- a/src/action.ml +++ b/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 diff --git a/src/context.ml b/src/context.ml index afba65c6..294ed3c4 100644 --- a/src/context.ml +++ b/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 - ; "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 diff --git a/src/gen_rules.ml b/src/gen_rules.ml index 68af9dee..a71ab0b0 100644 --- a/src/gen_rules.ml +++ b/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 diff --git a/src/ocamldep.ml b/src/ocamldep.ml index 84ba559b..bb396329 100644 --- a/src/ocamldep.ml +++ b/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 ] diff --git a/src/ordered_set_lang.ml b/src/ordered_set_lang.ml index 365878a2..5417bddf 100644 --- a/src/ordered_set_lang.ml +++ b/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 -> diff --git a/src/path.ml b/src/path.ml index b25d399a..2a25b861 100644 --- a/src/path.ml +++ b/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 diff --git a/src/sexp.ml b/src/sexp.ml index e192573f..03e58596 100644 --- a/src/sexp.ml +++ b/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 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); diff --git a/src/sexp.mli b/src/sexp.mli index 36af356d..8258374a 100644 --- a/src/sexp.mli +++ b/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 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 diff --git a/src/super_context.ml b/src/super_context.ml index 4ec2e691..48b9d1cd 100644 --- a/src/super_context.ml +++ b/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 diff --git a/src/with_required_by.ml b/src/with_required_by.ml index 845de6e4..9faadff4 100644 --- a/src/with_required_by.ml +++ b/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)