Distinguish quoted and unquoted variables
Now only quoted strings support concatenation of text and a split-variable.
This commit is contained in:
commit
75ab3946f6
|
@ -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)
|
||||
|
|
|
@ -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
|
||||
]
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 <https://github.com/janestreet/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:
|
||||
|
||||
<package>.opam files
|
||||
|
|
|
@ -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
|
||||
|
@ -272,30 +272,36 @@ 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
|
||||
|
||||
type context = Path.t (* For String_with_vars.Expand_to *)
|
||||
|
||||
let concat = function
|
||||
| [s] -> s
|
||||
| l -> String.concat ~sep:" " l
|
||||
|
||||
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 ~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 ~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, [])
|
||||
|
@ -303,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) ->
|
||||
|
@ -315,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
|
||||
|
@ -328,7 +335,7 @@ module Unexpanded = struct
|
|||
|
||||
let t sexp =
|
||||
match sexp with
|
||||
| Atom _ ->
|
||||
| Atom _ | Quoted_string _ ->
|
||||
of_sexp_errorf sexp
|
||||
"if you meant for this to be executed with bash, write (bash \"...\") instead"
|
||||
| List _ -> t sexp
|
||||
|
@ -352,28 +359,23 @@ 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.just_a_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 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
|
||||
~map:(fun x -> x)
|
||||
|
||||
let strings ~dir ~f x =
|
||||
expand ~dir ~f x
|
||||
~generic:(fun ~dir:_ x -> [x])
|
||||
~generic:(fun _dir x -> [x])
|
||||
~special:VE.to_strings
|
||||
~map:(fun x -> [x])
|
||||
|
||||
|
@ -385,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
|
||||
|
@ -445,27 +447,20 @@ 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.just_a_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 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
|
||||
|
||||
let strings ~dir ~f x =
|
||||
expand ~dir ~f x
|
||||
~generic:(fun ~dir:_ x -> [x])
|
||||
~generic:(fun _dir x -> [x])
|
||||
~special:VE.to_strings
|
||||
|
||||
let path ~dir ~f x =
|
||||
|
@ -475,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
|
||||
|
||||
|
|
|
@ -3,13 +3,18 @@ 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 : 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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -190,7 +190,7 @@ module Pp_or_flags = struct
|
|||
PP (Pp.of_string s)
|
||||
|
||||
let t = function
|
||||
| Atom (_, 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 _ -> File (String_with_vars.t sexp)
|
||||
| Atom _ | Quoted_string _ -> File (String_with_vars.t sexp)
|
||||
| List _ -> t sexp
|
||||
|
||||
open Sexp
|
||||
|
@ -366,9 +366,10 @@ module Lib_dep = struct
|
|||
; forbidden
|
||||
; file = file fsexp
|
||||
}
|
||||
| Atom (_, "->") :: _ | List _ :: _ | [] ->
|
||||
| Atom (_, "->") :: _
|
||||
| List _ :: _ | [] ->
|
||||
of_sexp_error sexp "(<[!]libraries>... -> <file>) expected"
|
||||
| Atom (_, 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
|
||||
|
|
|
@ -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
|
||||
]
|
||||
|
||||
|
|
|
@ -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 (_, "") | 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) -> (loc, s)
|
||||
| Atom (loc, s) | Quoted_string (loc, s) -> (loc, s)
|
||||
| List _ -> assert false)
|
||||
in
|
||||
{ ast
|
||||
|
@ -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 ->
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
84
src/sexp.ml
84
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 = Atom 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
|
||||
|
@ -109,6 +111,7 @@ end
|
|||
module Of_sexp = struct
|
||||
type ast = Ast.t =
|
||||
| Atom of Loc.t * string
|
||||
| Quoted_string of Loc.t * string
|
||||
| List of Loc.t * ast list
|
||||
|
||||
type 'a t = ast -> 'a
|
||||
|
@ -123,29 +126,34 @@ 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
|
||||
| List _ as sexp -> of_sexp_error sexp "Atom expected"
|
||||
| Quoted_string (_, s) -> s
|
||||
| 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)
|
||||
|
@ -156,7 +164,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 _ | 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)
|
||||
|
@ -166,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);
|
||||
|
@ -290,7 +298,7 @@ module Of_sexp = struct
|
|||
|
||||
let make_record_parser_state sexp =
|
||||
match sexp with
|
||||
| Atom _ -> 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 ->
|
||||
|
@ -300,8 +308,9 @@ module Of_sexp = struct
|
|||
| List (_, [name_sexp; value]) -> begin
|
||||
match name_sexp with
|
||||
| Atom (_, name) ->
|
||||
Name_map.add acc ~key:name ~data:{ value = Some value; entry = sexp }
|
||||
| List _ ->
|
||||
Name_map.add acc ~key:name ~data:{ value = Some value;
|
||||
entry = sexp }
|
||||
| List _ | Quoted_string _ ->
|
||||
of_sexp_error name_sexp "Atom expected"
|
||||
end
|
||||
| _ ->
|
||||
|
@ -412,10 +421,11 @@ module Of_sexp = struct
|
|||
| 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"
|
||||
| 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)
|
||||
|
@ -423,7 +433,7 @@ module Of_sexp = struct
|
|||
|
||||
let enum cstrs sexp =
|
||||
match sexp with
|
||||
| List _ -> of_sexp_error sexp "Atom expected"
|
||||
| Quoted_string _ | List _ -> of_sexp_error sexp "Atom expected"
|
||||
| Atom (_, s) ->
|
||||
match
|
||||
List.find cstrs ~f:(fun (name, _) ->
|
||||
|
|
21
src/sexp.mli
21
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
|
||||
|
@ -40,10 +49,14 @@ end with type sexp := t
|
|||
module Of_sexp : sig
|
||||
type ast = Ast.t =
|
||||
| Atom 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
|
||||
|
||||
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
|
||||
|
||||
|
|
|
@ -8,8 +8,8 @@ type item =
|
|||
|
||||
type t =
|
||||
{ items : item list
|
||||
; loc : Loc.t
|
||||
}
|
||||
; loc : Loc.t
|
||||
; quoted : bool }
|
||||
|
||||
module Token = struct
|
||||
type t =
|
||||
|
@ -46,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 ->
|
||||
|
@ -56,23 +57,22 @@ 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 t sexp = of_string ~loc:(Sexp.Ast.loc sexp) (Sexp.Of_sexp.string sexp)
|
||||
let t : Sexp.Of_sexp.ast -> t = function
|
||||
| Atom(loc, s) -> { items = items_of_string s; loc; quoted = false }
|
||||
| Quoted_string (loc, s) ->
|
||||
{ items = items_of_string s; loc; quoted = true }
|
||||
| List _ as sexp -> Sexp.Of_sexp.of_sexp_error sexp "Atom expected"
|
||||
|
||||
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_text pos s = { loc = Loc.of_pos pos; items = [Text s] }
|
||||
|
||||
let just_a_var t =
|
||||
match t.items with
|
||||
| [Var (_, s)] -> Some s
|
||||
| _ -> None
|
||||
let virt ?(quoted=false) pos s =
|
||||
{ items = items_of_string s; loc = Loc.of_pos pos; quoted }
|
||||
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 }
|
||||
|
||||
let sexp_of_var_syntax = function
|
||||
| Parens -> Sexp.Atom "parens"
|
||||
|
@ -88,14 +88,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)
|
||||
|
||||
|
@ -104,39 +103,88 @@ let string_of_var syntax v =
|
|||
| Parens -> sprintf "$(%s)" v
|
||||
| Braces -> sprintf "${%s}" 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)
|
||||
|> String.concat ~sep:""
|
||||
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:""
|
||||
|
||||
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 (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 =
|
||||
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 (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 ->
|
||||
match f t.loc v with
|
||||
| None -> loop [] (it :: commit_text acc_text acc) items
|
||||
| Some s -> loop (s :: acc_text) acc items
|
||||
in
|
||||
loop [] [] t.items
|
||||
match S.partial_expand () t ~f with
|
||||
| Inl(Inl s | Inr s) -> Inl s
|
||||
| Inr _ as x -> x
|
||||
|
||||
let to_string t =
|
||||
match t.items with
|
||||
|
|
|
@ -6,25 +6,81 @@
|
|||
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 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. *)
|
||||
|
||||
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. *)
|
||||
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
|
||||
(** [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. [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 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
|
||||
val iter : t -> f:(Loc.t -> string -> unit) -> unit
|
||||
(** [fold t ~init ~f] fold [f] on 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
|
||||
val iter : t -> f:(Loc.t -> string -> unit) -> unit
|
||||
(** [iter t ~f] iterates [f] over all variables of [t], the text
|
||||
portions being ignored. *)
|
||||
|
||||
module type EXPANSION = sig
|
||||
type t
|
||||
(** The value to which variables are expanded. *)
|
||||
|
||||
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_to.expand] that returns a string (so
|
||||
variables are assumed to expand to a single value). *)
|
||||
|
||||
val partial_expand :
|
||||
t -> f:(Loc.t -> string -> string option) -> (string, t) either
|
||||
(** [partial_expand] is a specialized version of
|
||||
[Expand_to.partial_expand] that returns a string. *)
|
||||
|
|
|
@ -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 dir e))
|
||||
|
||||
let resolve_program t ?hint bin =
|
||||
Artifacts.binary ?hint t.artifacts bin
|
||||
|
@ -115,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
|
||||
|
@ -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)
|
||||
|
@ -444,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) =
|
||||
|
@ -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)
|
||||
|
||||
|
@ -971,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
|
||||
|
|
|
@ -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 (Quoted_string (make_loc state ~delta:1, str), stack)
|
||||
else
|
||||
stack
|
||||
in
|
|
@ -7,4 +7,5 @@ end
|
|||
|
||||
type t =
|
||||
| Atom of Loc.t * string
|
||||
| Quoted_string of Loc.t * string
|
||||
| List of Loc.t * t list
|
|
@ -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,23 +77,31 @@ 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 =
|
||||
| Atom of string
|
||||
| Quoted_string of string
|
||||
| List of t list
|
||||
|
||||
type sexp = t
|
||||
|
||||
let rec to_string = function
|
||||
| Atom s -> Atom.serialize 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)
|
||||
| Quoted_string s ->
|
||||
Format.pp_print_string ppf (Atom.quote s)
|
||||
| List [] ->
|
||||
Format.pp_print_string ppf "()"
|
||||
| List (first :: rest) ->
|
||||
|
@ -100,21 +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 "@[<hv 1>\"@{<atom>%s" (Atom.escaped first);
|
||||
List.iter rest ~f:(fun s ->
|
||||
Format.fprintf ppf "@,\\n%s" (Atom.escaped s));
|
||||
Format.fprintf ppf "@}\"@]"
|
||||
end else
|
||||
Format.pp_print_string ppf (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 "@[<hv 1>\"@{<atom>%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 ->
|
||||
pp_print_atom ppf s ~serialize:Atom.quote
|
||||
| List [] ->
|
||||
Format.pp_print_string ppf "()"
|
||||
| List (first :: rest) ->
|
||||
|
@ -177,17 +209,20 @@ module Loc = Sexp_ast.Loc
|
|||
module Ast = struct
|
||||
type t = Sexp_ast.t =
|
||||
| Atom of Loc.t * string
|
||||
| Quoted_string of Loc.t * string
|
||||
| List of Loc.t * t list
|
||||
|
||||
let loc (Atom (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
|
||||
| Quoted_string (_, s) -> Quoted_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 +231,7 @@ module Ast = struct
|
|||
let rec loop acc t =
|
||||
match t with
|
||||
| Atom (loc, s) -> Token.Atom (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 }
|
||||
|
@ -213,6 +249,7 @@ end
|
|||
let rec add_loc t ~loc : Ast.t =
|
||||
match t with
|
||||
| Atom s -> Atom (loc, s)
|
||||
| Quoted_string s -> Quoted_string (loc, s)
|
||||
| List l -> List (loc, List.map l ~f:(add_loc ~loc))
|
||||
|
||||
module Parser = struct
|
|
@ -23,7 +23,8 @@ end
|
|||
|
||||
(** The S-expression type *)
|
||||
type t =
|
||||
| Atom of string
|
||||
| Atom of Atom.t
|
||||
| Quoted_string of 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
|
||||
| Quoted_string of Loc.t * 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
|
|
@ -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)
|
||||
|
|
|
@ -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.
|
Loading…
Reference in New Issue