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