diff --git a/src/action.ml b/src/action.ml index c0c7586e..82768fde 100644 --- a/src/action.ml +++ b/src/action.ml @@ -352,7 +352,7 @@ module Unexpanded = struct let t = let open Sexp.Of_sexp in - peek raw >>= function + peek_exn >>= function | Template _ | Atom _ | Quoted_string _ as sexp -> of_sexp_errorf (Sexp.Ast.loc sexp) "if you meant for this to be executed with bash, write (bash \"...\") instead" @@ -613,7 +613,7 @@ module Promotion = struct let t = let open Sexp.Of_sexp in - peek raw >>= function + peek_exn >>= function | List (_, [_; Atom (_, A "as"); _]) -> enter (Path.t >>= fun src -> diff --git a/src/jbuild.ml b/src/jbuild.ml index ef288beb..77416036 100644 --- a/src/jbuild.ml +++ b/src/jbuild.ml @@ -190,7 +190,7 @@ module Pps_and_flags = struct Left (loc, Pp.of_string s) let item = - peek raw >>= function + peek_exn >>= function | Template { loc; _ } -> no_templates loc "in the preprocessors field" | Atom _ | Quoted_string _ -> plain_string of_string @@ -261,7 +261,7 @@ module Dep_conf = struct sw >>| fun x -> Source_tree x) ] in - peek raw >>= function + peek_exn >>= function | Template _ | Atom _ | Quoted_string _ -> String_with_vars.t >>| fun x -> File x | List _ -> t @@ -316,7 +316,7 @@ module Per_module = struct include Per_item.Make(Module.Name) let t ~default a = - peek raw >>= function + peek_exn >>= function | List (loc, Atom (_, A "per_module") :: _) -> sum [ "per_module", repeat @@ -407,7 +407,7 @@ module Lib_dep = struct enter ( loc >>= fun loc -> let rec loop required forbidden = - peek raw >>= function + peek_exn >>= function | Atom (_, A "->") -> junk >>> file >>| fun file -> let common = String.Set.inter required forbidden in @@ -435,7 +435,7 @@ module Lib_dep = struct ) let t = - peek raw >>= function + peek_exn >>= function | Atom _ | Quoted_string _ -> plain_string (fun ~loc s -> Direct (loc, s)) | List (loc, Atom (_, A "select") :: _ :: Atom (_, A "from") :: _) -> @@ -806,7 +806,7 @@ module Install_conf = struct } let file = - peek raw >>= function + peek_exn >>= function | Atom (_, A src) -> junk >>| fun () -> { src; dst = None } | List (_, [Atom (_, A src); Atom (_, A "as"); Atom (_, A dst)]) -> junk >>> return { src; dst = Some dst } @@ -881,7 +881,7 @@ module Executables = struct Sexp.Of_sexp.enum simple_representations let t = - peek raw >>= function + peek_exn >>= function | List _ -> enter (Mode_conf.t >>= fun mode -> Binary_kind.t >>= fun kind -> @@ -1148,12 +1148,12 @@ module Rule = struct } let jbuild_syntax = - peek raw >>= function + peek_exn >>= function | List (_, (Atom _ :: _)) -> short_form | _ -> record long_form let dune_syntax = - peek raw >>= function + peek_exn >>= function | List (_, Atom (loc, A s) :: _) -> begin match String.Map.find atom_table s with | None -> @@ -1181,7 +1181,7 @@ module Rule = struct } let ocamllex_jbuild = - peek raw >>= function + peek_exn >>= function | List (_, List (_, _) :: _) -> record (field "modules" (list string) >>= fun modules -> @@ -1194,20 +1194,18 @@ module Rule = struct } let ocamllex_dune = - eos >>= function - | true -> + peek >>= function + | None -> return { modules = [] ; mode = Standard } - | false -> - peek raw >>= function - | List _ -> + | Some (List _) -> fields (field "modules" (list string) >>= fun modules -> Mode.field >>= fun mode -> return { modules; mode }) - | _ -> + | Some _ -> repeat string >>| fun modules -> { modules ; mode = Standard @@ -1395,7 +1393,7 @@ module Env = struct return { flags; ocamlc_flags; ocamlopt_flags } let rule = - peek raw >>= function + peek_exn >>= function | List (_, Atom (_, A pat) :: _) -> enter ( junk >>= fun () -> diff --git a/src/stdune/path.ml b/src/stdune/path.ml index 1a0664aa..3fba5483 100644 --- a/src/stdune/path.ml +++ b/src/stdune/path.ml @@ -589,9 +589,8 @@ let of_string ?error_loc s = let t = Sexp.Of_sexp.( - peek raw >>= function - | Template _ - | Atom _ | Quoted_string _ -> + peek_exn >>= function + | Template _ | Atom _ | Quoted_string _ -> (* necessary for old build dirs *) plain_string (fun ~loc:_ s -> of_string s) | List _ -> diff --git a/src/stdune/sexp.ml b/src/stdune/sexp.ml index f32be5b5..4a067807 100644 --- a/src/stdune/sexp.ml +++ b/src/stdune/sexp.ml @@ -232,9 +232,16 @@ module Of_sexp = struct | sexp :: sexps -> (f (get_user_context ctx) sexp, sexps) [@@inline always] - let peek t ctx sexps = - let x, _ = t ctx sexps in - (x, sexps) + let peek _ctx sexps = + match sexps with + | [] -> (None, sexps) + | sexp :: _ -> (Some sexp, sexps) + [@@inline always] + + let peek_exn ctx sexps = + match sexps with + | [] -> end_of_list ctx + | sexp :: _ -> (sexp, sexps) [@@inline always] let junk = next ignore diff --git a/src/stdune/sexp.mli b/src/stdune/sexp.mli index 43c8d4cf..68f7331d 100644 --- a/src/stdune/sexp.mli +++ b/src/stdune/sexp.mli @@ -155,8 +155,11 @@ module Of_sexp : sig (** Unparsed next element of the input *) val raw : ast t - (** Inspect the input without consuming it *) - val peek : 'a t -> 'a t + (** Inspect the next element of the input without consuming it *) + val peek : ast option t + + (** Same as [peek] but fail if the end of input is reached *) + val peek_exn : ast t (** Consume and ignore the next element of the input *) val junk : unit t diff --git a/src/workspace.ml b/src/workspace.ml index cc177cf8..42722a4f 100644 --- a/src/workspace.ml +++ b/src/workspace.ml @@ -57,7 +57,7 @@ module Context = struct let t ~profile = Sexp.Of_sexp.( - peek raw >>= function + peek_exn >>= function | Atom _ | Quoted_string _ -> enum [ "default", Default { targets = [Native]