Merge pull request #1068 from ocaml/more-applicative-syntax
More applicative syntax
This commit is contained in:
commit
9afd3d2157
|
@ -368,12 +368,13 @@ module Unexpanded = struct
|
||||||
include Make_ast(String_with_vars)(String_with_vars)(String_with_vars)(Uast)
|
include Make_ast(String_with_vars)(String_with_vars)(String_with_vars)(Uast)
|
||||||
|
|
||||||
let t =
|
let t =
|
||||||
let open Sexp.Of_sexp in
|
if_list
|
||||||
peek_exn >>= function
|
~then_:t
|
||||||
| Template _ | Atom _ | Quoted_string _ as sexp ->
|
~else_:
|
||||||
of_sexp_errorf (Sexp.Ast.loc sexp)
|
(loc >>| fun loc ->
|
||||||
"if you meant for this to be executed with bash, write (bash \"...\") instead"
|
of_sexp_errorf
|
||||||
| List _ -> t
|
loc
|
||||||
|
"if you meant for this to be executed with bash, write (bash \"...\") instead")
|
||||||
|
|
||||||
let check_mkdir loc path =
|
let check_mkdir loc path =
|
||||||
if not (Path.is_managed path) then
|
if not (Path.is_managed path) then
|
||||||
|
|
|
@ -130,22 +130,22 @@ include Sub_system.Register_end_point(
|
||||||
open Stanza.Of_sexp
|
open Stanza.Of_sexp
|
||||||
|
|
||||||
let parse =
|
let parse =
|
||||||
eos >>= function
|
if_eos
|
||||||
| true -> loc >>| empty
|
~then_:(loc >>| empty)
|
||||||
| false ->
|
~else_:
|
||||||
record
|
(record
|
||||||
(let%map loc = loc
|
(let%map loc = loc
|
||||||
and deps = field "deps" (list Dep_conf.t) ~default:[]
|
and deps = field "deps" (list Dep_conf.t) ~default:[]
|
||||||
and flags = Ordered_set_lang.Unexpanded.field "flags"
|
and flags = Ordered_set_lang.Unexpanded.field "flags"
|
||||||
and backend = field_o "backend" (located string)
|
and backend = field_o "backend" (located string)
|
||||||
and libraries = field "libraries" (list (located string)) ~default:[]
|
and libraries = field "libraries" (list (located string)) ~default:[]
|
||||||
in
|
in
|
||||||
{ loc
|
{ loc
|
||||||
; deps
|
; deps
|
||||||
; flags
|
; flags
|
||||||
; backend
|
; backend
|
||||||
; libraries
|
; libraries
|
||||||
})
|
}))
|
||||||
end
|
end
|
||||||
|
|
||||||
let gen_rules c ~(info:Info.t) ~backends =
|
let gen_rules c ~(info:Info.t) ~backends =
|
||||||
|
|
|
@ -225,11 +225,9 @@ module Pps_and_flags = struct
|
||||||
end
|
end
|
||||||
|
|
||||||
let t =
|
let t =
|
||||||
Syntax.get_exn Stanza.syntax >>= fun ver ->
|
switch_file_kind
|
||||||
if ver < (1, 0) then
|
~jbuild:Jbuild_syntax.t
|
||||||
Jbuild_syntax.t
|
~dune:Dune_syntax.t
|
||||||
else
|
|
||||||
Dune_syntax.t
|
|
||||||
end
|
end
|
||||||
|
|
||||||
module Bindings = struct
|
module Bindings = struct
|
||||||
|
@ -255,10 +253,11 @@ module Bindings = struct
|
||||||
|
|
||||||
let singleton x = [Unnamed x]
|
let singleton x = [Unnamed x]
|
||||||
|
|
||||||
let t elem =
|
let jbuild elem =
|
||||||
Stanza.file_kind () >>= function
|
list (elem >>| fun x -> Unnamed x)
|
||||||
| Jbuild -> list (elem >>| fun x -> Unnamed x)
|
|
||||||
| Dune -> parens_removed_in_dune (
|
let dune elem =
|
||||||
|
parens_removed_in_dune (
|
||||||
let%map l =
|
let%map l =
|
||||||
repeat
|
repeat
|
||||||
(if_paren_colon_form
|
(if_paren_colon_form
|
||||||
|
@ -283,6 +282,11 @@ module Bindings = struct
|
||||||
in
|
in
|
||||||
loop String.Set.empty [] l)
|
loop String.Set.empty [] l)
|
||||||
|
|
||||||
|
let t elem =
|
||||||
|
switch_file_kind
|
||||||
|
~jbuild:(jbuild elem)
|
||||||
|
~dune:(dune elem)
|
||||||
|
|
||||||
let sexp_of_t sexp_of_a bindings =
|
let sexp_of_t sexp_of_a bindings =
|
||||||
Sexp.List (
|
Sexp.List (
|
||||||
List.map bindings ~f:(function
|
List.map bindings ~f:(function
|
||||||
|
@ -323,10 +327,9 @@ module Dep_conf = struct
|
||||||
Source_tree x)
|
Source_tree x)
|
||||||
]
|
]
|
||||||
in
|
in
|
||||||
peek_exn >>= function
|
if_list
|
||||||
| Template _ | Atom _ | Quoted_string _ ->
|
~then_:t
|
||||||
String_with_vars.t >>| fun x -> File x
|
~else_:(String_with_vars.t >>| fun x -> File x)
|
||||||
| List _ -> t
|
|
||||||
|
|
||||||
open Sexp
|
open Sexp
|
||||||
let sexp_of_t = function
|
let sexp_of_t = function
|
||||||
|
@ -1028,12 +1031,13 @@ module Executables = struct
|
||||||
Sexp.Of_sexp.enum simple_representations
|
Sexp.Of_sexp.enum simple_representations
|
||||||
|
|
||||||
let t =
|
let t =
|
||||||
peek_exn >>= function
|
if_list
|
||||||
| List _ ->
|
~then_:
|
||||||
enter (let%map mode = Mode_conf.t
|
(enter
|
||||||
and kind = Binary_kind.t in
|
(let%map mode = Mode_conf.t
|
||||||
{ mode; kind })
|
and kind = Binary_kind.t in
|
||||||
| _ -> simple
|
{ mode; kind }))
|
||||||
|
~else_:simple
|
||||||
|
|
||||||
let simple_sexp_of_t link_mode =
|
let simple_sexp_of_t link_mode =
|
||||||
let is_ok (_, candidate) =
|
let is_ok (_, candidate) =
|
||||||
|
@ -1397,11 +1401,9 @@ module Rule = struct
|
||||||
"S-expression of the form (<atom> ...) expected"
|
"S-expression of the form (<atom> ...) expected"
|
||||||
|
|
||||||
let t =
|
let t =
|
||||||
Syntax.get_exn Stanza.syntax >>= fun ver ->
|
switch_file_kind
|
||||||
if ver < (1, 0) then
|
~jbuild:jbuild_syntax
|
||||||
jbuild_syntax
|
~dune:dune_syntax
|
||||||
else
|
|
||||||
dune_syntax
|
|
||||||
|
|
||||||
type lex_or_yacc =
|
type lex_or_yacc =
|
||||||
{ modules : string list
|
{ modules : string list
|
||||||
|
@ -1443,11 +1445,9 @@ module Rule = struct
|
||||||
}))
|
}))
|
||||||
|
|
||||||
let ocamllex =
|
let ocamllex =
|
||||||
Syntax.get_exn Stanza.syntax >>= fun ver ->
|
switch_file_kind
|
||||||
if ver < (1, 0) then
|
~jbuild:ocamllex_jbuild
|
||||||
ocamllex_jbuild
|
~dune:ocamllex_dune
|
||||||
else
|
|
||||||
ocamllex_dune
|
|
||||||
|
|
||||||
let ocamlyacc = ocamllex
|
let ocamlyacc = ocamllex
|
||||||
|
|
||||||
|
|
|
@ -22,8 +22,7 @@ end
|
||||||
|
|
||||||
let file_kind () =
|
let file_kind () =
|
||||||
let open Sexp.Of_sexp in
|
let open Sexp.Of_sexp in
|
||||||
Syntax.get_exn syntax >>| fun ver ->
|
Syntax.get_exn syntax >>| File_kind.of_syntax
|
||||||
if ver < (1, 0) then File_kind.Jbuild else Dune
|
|
||||||
|
|
||||||
module Of_sexp = struct
|
module Of_sexp = struct
|
||||||
include Sexp.Of_sexp
|
include Sexp.Of_sexp
|
||||||
|
@ -45,11 +44,15 @@ module Of_sexp = struct
|
||||||
}
|
}
|
||||||
| _ -> None)
|
| _ -> None)
|
||||||
|
|
||||||
|
let switch_file_kind ~jbuild ~dune =
|
||||||
|
file_kind () >>= function
|
||||||
|
| Jbuild -> jbuild
|
||||||
|
| Dune -> dune
|
||||||
|
|
||||||
let parens_removed_in_dune_generic ~is_record t =
|
let parens_removed_in_dune_generic ~is_record t =
|
||||||
Syntax.get_exn syntax >>= fun ver ->
|
switch_file_kind
|
||||||
if ver < (1, 0) then
|
~jbuild:(enter t)
|
||||||
enter t
|
~dune:(
|
||||||
else
|
|
||||||
try_
|
try_
|
||||||
t
|
t
|
||||||
(function
|
(function
|
||||||
|
@ -70,6 +73,7 @@ module Of_sexp = struct
|
||||||
(function
|
(function
|
||||||
| Parens_no_longer_necessary _ as exn -> raise exn
|
| Parens_no_longer_necessary _ as exn -> raise exn
|
||||||
| _ -> raise exn))
|
| _ -> raise exn))
|
||||||
|
)
|
||||||
|
|
||||||
let record parse =
|
let record parse =
|
||||||
parens_removed_in_dune_generic (fields parse) ~is_record:true
|
parens_removed_in_dune_generic (fields parse) ~is_record:true
|
||||||
|
|
|
@ -56,4 +56,12 @@ module Of_sexp : sig
|
||||||
displays a nice error messages when parentheses are used in dune
|
displays a nice error messages when parentheses are used in dune
|
||||||
files. *)
|
files. *)
|
||||||
val parens_removed_in_dune : 'a t -> 'a t
|
val parens_removed_in_dune : 'a t -> 'a t
|
||||||
|
|
||||||
|
(** Use a different parser depending on the syntax in the current file.
|
||||||
|
If the syntax version is strictly less than `(1, 0)`, use `jbuild`.
|
||||||
|
Otherwise use `dune`. *)
|
||||||
|
val switch_file_kind :
|
||||||
|
jbuild:('a, 'b) parser ->
|
||||||
|
dune:('a, 'b) parser ->
|
||||||
|
('a, 'b) parser
|
||||||
end
|
end
|
||||||
|
|
|
@ -602,17 +602,17 @@ let of_string ?error_loc s =
|
||||||
make_local_path (Local.of_string s ?error_loc)
|
make_local_path (Local.of_string s ?error_loc)
|
||||||
|
|
||||||
let t =
|
let t =
|
||||||
Sexp.Of_sexp.(
|
let open Sexp.Of_sexp in
|
||||||
peek_exn >>= function
|
if_list
|
||||||
| Template _ | Atom _ | Quoted_string _ ->
|
~then_:
|
||||||
|
(sum
|
||||||
|
[ "In_build_dir" , Local.t >>| in_build_dir
|
||||||
|
; "In_source_tree", Local.t >>| in_source_tree
|
||||||
|
; "External" , External.t >>| external_
|
||||||
|
])
|
||||||
|
~else_:
|
||||||
(* necessary for old build dirs *)
|
(* necessary for old build dirs *)
|
||||||
plain_string (fun ~loc:_ s -> of_string s)
|
(plain_string (fun ~loc:_ s -> of_string s))
|
||||||
| List _ ->
|
|
||||||
sum
|
|
||||||
[ "In_build_dir" , Local.t >>| in_build_dir
|
|
||||||
; "In_source_tree", Local.t >>| in_source_tree
|
|
||||||
; "External" , External.t >>| external_
|
|
||||||
])
|
|
||||||
|
|
||||||
let sexp_of_t t =
|
let sexp_of_t t =
|
||||||
let constr f x y = Sexp.To_sexp.(pair string f) (x, y) in
|
let constr f x y = Sexp.To_sexp.(pair string f) (x, y) in
|
||||||
|
|
|
@ -117,9 +117,8 @@ module Of_sexp : sig
|
||||||
(** Return the location of the list currently being parsed. *)
|
(** Return the location of the list currently being parsed. *)
|
||||||
val loc : (Loc.t, _) parser
|
val loc : (Loc.t, _) parser
|
||||||
|
|
||||||
(** End of sequence condition. Returns [true] iff they are no more
|
(** End of sequence condition. Uses [then_] if there are no more
|
||||||
S-expressions to parse *)
|
S-expressions to parse, [else_] otherwise. *)
|
||||||
val eos : (bool, _) parser
|
|
||||||
val if_eos : then_:('a, 'b) parser -> else_:('a, 'b) parser -> ('a, 'b) parser
|
val if_eos : then_:('a, 'b) parser -> else_:('a, 'b) parser -> ('a, 'b) parser
|
||||||
|
|
||||||
(** If the next element of the sequence is a list, parse it with
|
(** If the next element of the sequence is a list, parse it with
|
||||||
|
|
|
@ -113,13 +113,10 @@ let t =
|
||||||
| Quoted_string (loc, s) -> literal ~quoted:true ~loc s
|
| Quoted_string (loc, s) -> literal ~quoted:true ~loc s
|
||||||
| List (loc, _) -> Sexp.Of_sexp.of_sexp_error loc "Unexpected list"
|
| List (loc, _) -> Sexp.Of_sexp.of_sexp_error loc "Unexpected list"
|
||||||
in
|
in
|
||||||
Syntax.get_exn Stanza.syntax >>= fun syntax_version ->
|
let template_parser = Stanza.Of_sexp.switch_file_kind ~jbuild ~dune in
|
||||||
let template =
|
let%map syntax_version = Syntax.get_exn Stanza.syntax
|
||||||
match syntax_version with
|
and template = template_parser
|
||||||
| (0, _) -> jbuild
|
|
||||||
| (_, _) -> dune
|
|
||||||
in
|
in
|
||||||
template >>| fun template ->
|
|
||||||
{template; syntax_version}
|
{template; syntax_version}
|
||||||
|
|
||||||
let loc t = t.template.loc
|
let loc t = t.template.loc
|
||||||
|
|
|
@ -76,12 +76,13 @@ module Context = struct
|
||||||
}
|
}
|
||||||
|
|
||||||
let t ~profile ~x =
|
let t ~profile ~x =
|
||||||
Common.t ~profile >>= fun base ->
|
let%map base = Common.t ~profile
|
||||||
field "switch" string >>= fun switch ->
|
and switch = field "switch" string
|
||||||
let%map name = field "name" Name.t ~default:switch
|
and name = field_o "name" Name.t
|
||||||
and root = field_o "root" string
|
and root = field_o "root" string
|
||||||
and merlin = field_b "merlin"
|
and merlin = field_b "merlin"
|
||||||
in
|
in
|
||||||
|
let name = Option.value ~default:switch name in
|
||||||
let base = { base with targets = Target.add base.targets x } in
|
let base = { base with targets = Target.add base.targets x } in
|
||||||
{ base
|
{ base
|
||||||
; switch
|
; switch
|
||||||
|
@ -116,14 +117,14 @@ module Context = struct
|
||||||
]
|
]
|
||||||
|
|
||||||
let t ~profile ~x =
|
let t ~profile ~x =
|
||||||
Syntax.get_exn syntax >>= function
|
switch_file_kind
|
||||||
| (0, _) ->
|
~jbuild:
|
||||||
(* jbuild-workspace files *)
|
(* jbuild-workspace files *)
|
||||||
(peek_exn >>= function
|
(peek_exn >>= function
|
||||||
| List (_, List _ :: _) ->
|
| List (_, List _ :: _) ->
|
||||||
Sexp.Of_sexp.record (Opam.t ~profile ~x) >>| fun x -> Opam x
|
Sexp.Of_sexp.record (Opam.t ~profile ~x) >>| fun x -> Opam x
|
||||||
| _ -> t ~profile ~x)
|
| _ -> t ~profile ~x)
|
||||||
| _ -> t ~profile ~x
|
~dune:(t ~profile ~x)
|
||||||
|
|
||||||
let name = function
|
let name = function
|
||||||
| Default _ -> "default"
|
| Default _ -> "default"
|
||||||
|
|
Loading…
Reference in New Issue