Let the parser distinguish quoted strings
Fixes https://github.com/ocaml/dune/issues/408
This commit is contained in:
parent
e8e3698e15
commit
c27cb3541e
|
@ -328,7 +328,7 @@ module Unexpanded = struct
|
||||||
|
|
||||||
let t sexp =
|
let t sexp =
|
||||||
match sexp with
|
match sexp with
|
||||||
| Atom _ ->
|
| Atom _ | String _ ->
|
||||||
of_sexp_errorf sexp
|
of_sexp_errorf sexp
|
||||||
"if you meant for this to be executed with bash, write (bash \"...\") instead"
|
"if you meant for this to be executed with bash, write (bash \"...\") instead"
|
||||||
| List _ -> t sexp
|
| List _ -> t sexp
|
||||||
|
|
|
@ -190,7 +190,7 @@ module Pp_or_flags = struct
|
||||||
PP (Pp.of_string s)
|
PP (Pp.of_string s)
|
||||||
|
|
||||||
let t = function
|
let t = function
|
||||||
| Atom (_, s) -> of_string s
|
| Atom (_, s) | String (_, s) -> of_string s
|
||||||
| List (_, l) -> Flags (List.map l ~f:string)
|
| List (_, l) -> Flags (List.map l ~f:string)
|
||||||
|
|
||||||
let split l =
|
let split l =
|
||||||
|
@ -225,7 +225,7 @@ module Dep_conf = struct
|
||||||
in
|
in
|
||||||
fun sexp ->
|
fun sexp ->
|
||||||
match sexp with
|
match sexp with
|
||||||
| Atom _ -> File (String_with_vars.t sexp)
|
| Atom _ | String _ -> File (String_with_vars.t sexp)
|
||||||
| List _ -> t sexp
|
| List _ -> t sexp
|
||||||
|
|
||||||
open Sexp
|
open Sexp
|
||||||
|
@ -356,7 +356,7 @@ module Lib_dep = struct
|
||||||
let choice = function
|
let choice = function
|
||||||
| List (_, l) as sexp ->
|
| List (_, l) as sexp ->
|
||||||
let rec loop required forbidden = function
|
let rec loop required forbidden = function
|
||||||
| [Atom (_, "->"); fsexp] ->
|
| [Atom (_, "->"); fsexp] | [String (_, "->"); fsexp] ->
|
||||||
let common = String_set.inter required forbidden in
|
let common = String_set.inter required forbidden in
|
||||||
if not (String_set.is_empty common) then
|
if not (String_set.is_empty common) then
|
||||||
of_sexp_errorf sexp
|
of_sexp_errorf sexp
|
||||||
|
@ -366,9 +366,9 @@ module Lib_dep = struct
|
||||||
; forbidden
|
; forbidden
|
||||||
; file = file fsexp
|
; file = file fsexp
|
||||||
}
|
}
|
||||||
| Atom (_, "->") :: _ | List _ :: _ | [] ->
|
| Atom (_, "->") :: _ | String (_, "->") :: _ | List _ :: _ | [] ->
|
||||||
of_sexp_error sexp "(<[!]libraries>... -> <file>) expected"
|
of_sexp_error sexp "(<[!]libraries>... -> <file>) expected"
|
||||||
| Atom (_, s) :: l ->
|
| (Atom (_, s) | String (_, s)) :: l ->
|
||||||
let len = String.length s in
|
let len = String.length s in
|
||||||
if len > 0 && s.[0] = '!' then
|
if len > 0 && s.[0] = '!' then
|
||||||
let s = String.sub s ~pos:1 ~len:(len - 1) in
|
let s = String.sub s ~pos:1 ~len:(len - 1) in
|
||||||
|
|
|
@ -25,7 +25,7 @@ let loc t = t.loc
|
||||||
let parse_general sexp ~f =
|
let parse_general sexp ~f =
|
||||||
let rec of_sexp : Sexp.Ast.t -> _ = function
|
let rec of_sexp : Sexp.Ast.t -> _ = function
|
||||||
| Atom (loc, "\\") -> Loc.fail loc "unexpected \\"
|
| 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 ->
|
| Atom (loc, s) as t ->
|
||||||
if s.[0] = ':' then
|
if s.[0] = ':' then
|
||||||
Special (loc, String.sub s ~pos:1 ~len:(String.length s - 1))
|
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 t sexp : t =
|
||||||
let ast =
|
let ast =
|
||||||
parse_general sexp ~f:(function
|
parse_general sexp ~f:(function
|
||||||
| Atom (loc, s) -> (loc, s)
|
| Atom (loc, s) | String (loc, s) -> (loc, s)
|
||||||
| List _ -> assert false)
|
| List _ -> assert false)
|
||||||
in
|
in
|
||||||
{ ast
|
{ ast
|
||||||
|
|
19
src/sexp.ml
19
src/sexp.ml
|
@ -85,7 +85,7 @@ end
|
||||||
module To_sexp = struct
|
module To_sexp = struct
|
||||||
type nonrec 'a t = 'a -> t
|
type nonrec 'a t = 'a -> t
|
||||||
let unit () = List []
|
let unit () = List []
|
||||||
let string s = Atom s
|
let string s = String s
|
||||||
let int n = Atom (string_of_int n)
|
let int n = Atom (string_of_int n)
|
||||||
let float f = Atom (string_of_float f)
|
let float f = Atom (string_of_float f)
|
||||||
let bool b = Atom (string_of_bool b)
|
let bool b = Atom (string_of_bool b)
|
||||||
|
@ -109,6 +109,7 @@ end
|
||||||
module Of_sexp = struct
|
module Of_sexp = struct
|
||||||
type ast = Ast.t =
|
type ast = Ast.t =
|
||||||
| Atom of Loc.t * string
|
| Atom of Loc.t * string
|
||||||
|
| String of Loc.t * string
|
||||||
| List of Loc.t * ast list
|
| List of Loc.t * ast list
|
||||||
|
|
||||||
type 'a t = ast -> 'a
|
type 'a t = ast -> 'a
|
||||||
|
@ -125,6 +126,7 @@ module Of_sexp = struct
|
||||||
|
|
||||||
let string = function
|
let string = function
|
||||||
| Atom (_, s) -> s
|
| Atom (_, s) -> s
|
||||||
|
| String (_, s) -> s
|
||||||
| List _ as sexp -> of_sexp_error sexp "Atom expected"
|
| List _ as sexp -> of_sexp_error sexp "Atom expected"
|
||||||
|
|
||||||
let int sexp =
|
let int sexp =
|
||||||
|
@ -156,7 +158,7 @@ module Of_sexp = struct
|
||||||
| sexp -> of_sexp_error sexp "S-expression of the form (_ _ _) expected"
|
| sexp -> of_sexp_error sexp "S-expression of the form (_ _ _) expected"
|
||||||
|
|
||||||
let list f = function
|
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
|
| List (_, l) -> List.map l ~f
|
||||||
|
|
||||||
let array f sexp = Array.of_list (list f sexp)
|
let array f sexp = Array.of_list (list f sexp)
|
||||||
|
@ -290,7 +292,7 @@ module Of_sexp = struct
|
||||||
|
|
||||||
let make_record_parser_state sexp =
|
let make_record_parser_state sexp =
|
||||||
match sexp with
|
match sexp with
|
||||||
| Atom _ -> of_sexp_error sexp "List expected"
|
| Atom _ | String _ -> of_sexp_error sexp "List expected"
|
||||||
| List (loc, sexps) ->
|
| List (loc, sexps) ->
|
||||||
let unparsed =
|
let unparsed =
|
||||||
List.fold_left sexps ~init:Name_map.empty ~f:(fun acc sexp ->
|
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 }
|
Name_map.add acc ~key:name ~data:{ value = None; entry = sexp }
|
||||||
| List (_, [name_sexp; value]) -> begin
|
| List (_, [name_sexp; value]) -> begin
|
||||||
match name_sexp with
|
match name_sexp with
|
||||||
| Atom (_, name) ->
|
| Atom (_, name) | String (_, name) ->
|
||||||
Name_map.add acc ~key:name ~data:{ value = Some value; entry = sexp }
|
Name_map.add acc ~key:name ~data:{ value = Some value;
|
||||||
|
entry = sexp }
|
||||||
| List _ ->
|
| List _ ->
|
||||||
of_sexp_error name_sexp "Atom expected"
|
of_sexp_error name_sexp "Atom expected"
|
||||||
end
|
end
|
||||||
|
@ -407,7 +410,7 @@ module Of_sexp = struct
|
||||||
|
|
||||||
let sum cstrs sexp =
|
let sum cstrs sexp =
|
||||||
match sexp with
|
match sexp with
|
||||||
| Atom (loc, s) -> begin
|
| Atom (loc, s) | String (loc, s) -> begin
|
||||||
match find_cstr cstrs sexp s with
|
match find_cstr cstrs sexp s with
|
||||||
| C.Tuple t -> Constructor_args_spec.convert t.args t.rest sexp [] (t.make loc)
|
| C.Tuple t -> Constructor_args_spec.convert t.args t.rest sexp [] (t.make loc)
|
||||||
| C.Record _ -> of_sexp_error sexp "'%s' expect arguments"
|
| C.Record _ -> of_sexp_error sexp "'%s' expect arguments"
|
||||||
|
@ -416,7 +419,7 @@ module Of_sexp = struct
|
||||||
| List (loc, name_sexp :: args) ->
|
| List (loc, name_sexp :: args) ->
|
||||||
match name_sexp with
|
match name_sexp with
|
||||||
| List _ -> of_sexp_error name_sexp "Atom expected"
|
| List _ -> of_sexp_error name_sexp "Atom expected"
|
||||||
| Atom (_, s) ->
|
| Atom (_, s) | String (_, s) ->
|
||||||
match find_cstr cstrs sexp s with
|
match find_cstr cstrs sexp s with
|
||||||
| C.Tuple t -> Constructor_args_spec.convert t.args t.rest sexp args (t.make loc)
|
| 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))
|
| C.Record r -> record r.parse (List (loc, args))
|
||||||
|
@ -424,7 +427,7 @@ module Of_sexp = struct
|
||||||
let enum cstrs sexp =
|
let enum cstrs sexp =
|
||||||
match sexp with
|
match sexp with
|
||||||
| List _ -> of_sexp_error sexp "Atom expected"
|
| List _ -> of_sexp_error sexp "Atom expected"
|
||||||
| Atom (_, s) ->
|
| Atom (_, s) | String (_, s) ->
|
||||||
match
|
match
|
||||||
List.find cstrs ~f:(fun (name, _) ->
|
List.find cstrs ~f:(fun (name, _) ->
|
||||||
equal_cstr_name name s)
|
equal_cstr_name name s)
|
||||||
|
|
|
@ -40,6 +40,7 @@ end with type sexp := t
|
||||||
module Of_sexp : sig
|
module Of_sexp : sig
|
||||||
type ast = Ast.t =
|
type ast = Ast.t =
|
||||||
| Atom of Loc.t * string
|
| Atom of Loc.t * string
|
||||||
|
| String of Loc.t * string
|
||||||
| List of Loc.t * ast list
|
| List of Loc.t * ast list
|
||||||
|
|
||||||
include Combinators with type 'a t = Ast.t -> 'a
|
include Combinators with type 'a t = Ast.t -> 'a
|
||||||
|
|
|
@ -63,7 +63,20 @@ let of_string ~loc s =
|
||||||
; loc
|
; 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
|
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 ""] }
|
items = [Var (Braces, s); Text ""] }
|
||||||
let virt_text pos s = { loc = Loc.of_pos pos; items = [Text s] }
|
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
|
let sexp_of_var_syntax = function
|
||||||
| Parens -> Sexp.Atom "parens"
|
| Parens -> Sexp.Atom "parens"
|
||||||
| Braces -> Sexp.Atom "braces"
|
| Braces -> Sexp.Atom "braces"
|
||||||
|
|
|
@ -9,7 +9,9 @@ type t
|
||||||
(** A sequence of text and variables. *)
|
(** A sequence of text and variables. *)
|
||||||
|
|
||||||
val t : t Sexp.Of_sexp.t
|
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
|
val loc : t -> Loc.t
|
||||||
(** [loc t] returns the location of [t] — typically, in the jbuild file. *)
|
(** [loc t] returns the location of [t] — typically, in the jbuild file. *)
|
||||||
|
|
|
@ -344,7 +344,7 @@ let push_quoted_atom state _char stack =
|
||||||
Buffer.clear state.atom_buffer;
|
Buffer.clear state.atom_buffer;
|
||||||
let stack =
|
let stack =
|
||||||
if state.ignoring = 0 then
|
if state.ignoring = 0 then
|
||||||
Sexp (Atom (make_loc state ~delta:1, str), stack)
|
Sexp (String (make_loc state ~delta:1, str), stack)
|
||||||
else
|
else
|
||||||
stack
|
stack
|
||||||
in
|
in
|
||||||
|
|
|
@ -7,4 +7,5 @@ end
|
||||||
|
|
||||||
type t =
|
type t =
|
||||||
| Atom of Loc.t * string
|
| Atom of Loc.t * string
|
||||||
|
| String of Loc.t * string
|
||||||
| List of Loc.t * t list
|
| List of Loc.t * t list
|
||||||
|
|
|
@ -64,17 +64,21 @@ end
|
||||||
|
|
||||||
type t =
|
type t =
|
||||||
| Atom of string
|
| Atom of string
|
||||||
|
| String of string
|
||||||
| List of t list
|
| List of t list
|
||||||
|
|
||||||
type sexp = t
|
type sexp = t
|
||||||
|
|
||||||
let rec to_string = function
|
let rec to_string = function
|
||||||
| Atom s -> Atom.serialize s
|
| Atom s -> Atom.serialize s
|
||||||
|
| String s -> Atom.serialize s
|
||||||
| List l -> Printf.sprintf "(%s)" (List.map l ~f:to_string |> String.concat ~sep:" ")
|
| List l -> Printf.sprintf "(%s)" (List.map l ~f:to_string |> String.concat ~sep:" ")
|
||||||
|
|
||||||
let rec pp ppf = function
|
let rec pp ppf = function
|
||||||
| Atom s ->
|
| Atom s ->
|
||||||
Format.pp_print_string ppf (Atom.serialize s)
|
Format.pp_print_string ppf (Atom.serialize s)
|
||||||
|
| String s ->
|
||||||
|
Format.pp_print_string ppf (Atom.serialize s)
|
||||||
| List [] ->
|
| List [] ->
|
||||||
Format.pp_print_string ppf "()"
|
Format.pp_print_string ppf "()"
|
||||||
| List (first :: rest) ->
|
| List (first :: rest) ->
|
||||||
|
@ -101,7 +105,7 @@ let split_string s ~on =
|
||||||
loop 0 0
|
loop 0 0
|
||||||
|
|
||||||
let rec pp_split_strings ppf = function
|
let rec pp_split_strings ppf = function
|
||||||
| Atom s ->
|
| Atom s | String s ->
|
||||||
if Atom.must_escape s then begin
|
if Atom.must_escape s then begin
|
||||||
if String.contains s '\n' then begin
|
if String.contains s '\n' then begin
|
||||||
match split_string s ~on:'\n' with
|
match split_string s ~on:'\n' with
|
||||||
|
@ -177,17 +181,20 @@ module Loc = Sexp_ast.Loc
|
||||||
module Ast = struct
|
module Ast = struct
|
||||||
type t = Sexp_ast.t =
|
type t = Sexp_ast.t =
|
||||||
| Atom of Loc.t * string
|
| Atom of Loc.t * string
|
||||||
|
| String of Loc.t * string
|
||||||
| List of Loc.t * t list
|
| 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
|
let rec remove_locs : t -> sexp = function
|
||||||
| Atom (_, s) -> Atom s
|
| Atom (_, s) -> Atom s
|
||||||
|
| String (_, s) -> String s
|
||||||
| List (_, l) -> List (List.map l ~f:remove_locs)
|
| List (_, l) -> List (List.map l ~f:remove_locs)
|
||||||
|
|
||||||
module Token = struct
|
module Token = struct
|
||||||
type t =
|
type t =
|
||||||
| Atom of Loc.t * string
|
| Atom of Loc.t * string
|
||||||
|
| String of Loc.t * string
|
||||||
| Lparen of Loc.t
|
| Lparen of Loc.t
|
||||||
| Rparen of Loc.t
|
| Rparen of Loc.t
|
||||||
end
|
end
|
||||||
|
@ -196,6 +203,7 @@ module Ast = struct
|
||||||
let rec loop acc t =
|
let rec loop acc t =
|
||||||
match t with
|
match t with
|
||||||
| Atom (loc, s) -> Token.Atom (loc, s) :: acc
|
| Atom (loc, s) -> Token.Atom (loc, s) :: acc
|
||||||
|
| String (loc, s) -> Token.String (loc, s) :: acc
|
||||||
| List (loc, l) ->
|
| List (loc, l) ->
|
||||||
let shift (pos : Lexing.position) delta =
|
let shift (pos : Lexing.position) delta =
|
||||||
{ pos with pos_cnum = pos.pos_cnum + delta }
|
{ pos with pos_cnum = pos.pos_cnum + delta }
|
||||||
|
@ -213,6 +221,7 @@ end
|
||||||
let rec add_loc t ~loc : Ast.t =
|
let rec add_loc t ~loc : Ast.t =
|
||||||
match t with
|
match t with
|
||||||
| Atom s -> Atom (loc, s)
|
| Atom s -> Atom (loc, s)
|
||||||
|
| String s -> String (loc, s)
|
||||||
| List l -> List (loc, List.map l ~f:(add_loc ~loc))
|
| List l -> List (loc, List.map l ~f:(add_loc ~loc))
|
||||||
|
|
||||||
module Parser = struct
|
module Parser = struct
|
||||||
|
|
|
@ -23,7 +23,8 @@ end
|
||||||
|
|
||||||
(** The S-expression type *)
|
(** The S-expression type *)
|
||||||
type t =
|
type t =
|
||||||
| Atom of string
|
| Atom of Atom.t
|
||||||
|
| String of string (** Quoted string *)
|
||||||
| List of t list
|
| List of t list
|
||||||
|
|
||||||
(** Serialize a S-expression *)
|
(** Serialize a S-expression *)
|
||||||
|
@ -46,6 +47,7 @@ module Ast : sig
|
||||||
type sexp = t
|
type sexp = t
|
||||||
type t =
|
type t =
|
||||||
| Atom of Loc.t * Atom.t
|
| Atom of Loc.t * Atom.t
|
||||||
|
| String of Loc.t * string (** Quoted string *)
|
||||||
| List of Loc.t * t list
|
| List of Loc.t * t list
|
||||||
|
|
||||||
val loc : t -> Loc.t
|
val loc : t -> Loc.t
|
||||||
|
@ -55,6 +57,7 @@ module Ast : sig
|
||||||
module Token : sig
|
module Token : sig
|
||||||
type t =
|
type t =
|
||||||
| Atom of Loc.t * string
|
| Atom of Loc.t * string
|
||||||
|
| String of Loc.t * string
|
||||||
| Lparen of Loc.t
|
| Lparen of Loc.t
|
||||||
| Rparen of Loc.t
|
| Rparen of Loc.t
|
||||||
end
|
end
|
||||||
|
|
Loading…
Reference in New Issue