Let the parser distinguish quoted strings

Fixes https://github.com/ocaml/dune/issues/408

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

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>... -> <file>) 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

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

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)

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

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"

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. *)

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

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

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

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