Tweak parsing of bindings
Signed-off-by: Jeremie Dimino <jeremie@dimino.org>
This commit is contained in:
parent
8fa41edcff
commit
fd27e371bc
|
@ -264,8 +264,10 @@ module Named = struct
|
||||||
peek_exn >>= function
|
peek_exn >>= function
|
||||||
| List (_, Atom (loc, A s) :: _) when
|
| List (_, Atom (loc, A s) :: _) when
|
||||||
String.length s > 1 && s.[0] = ':' ->
|
String.length s > 1 && s.[0] = ':' ->
|
||||||
binding elem >>| fun (name, values) ->
|
let name = String.sub s ~pos:1 ~len:(String.length s - 1) in
|
||||||
Left (name, (loc, values))
|
enter (junk >>= fun () ->
|
||||||
|
repeat elem >>| fun values ->
|
||||||
|
Left (name, (loc, values)))
|
||||||
| _ ->
|
| _ ->
|
||||||
elem >>| fun elem -> Right elem
|
elem >>| fun elem -> Right elem
|
||||||
in
|
in
|
||||||
|
|
|
@ -380,26 +380,6 @@ module Of_sexp = struct
|
||||||
}
|
}
|
||||||
"Unknown constructor %s" name
|
"Unknown constructor %s" name
|
||||||
|
|
||||||
let binding t =
|
|
||||||
let t name = repeat t >>| fun t -> (name, t) in
|
|
||||||
next_with_user_context (fun uc sexp ->
|
|
||||||
match sexp with
|
|
||||||
| Atom (loc, A s) ->
|
|
||||||
let ctx = Values (loc, Some s, uc) in
|
|
||||||
result ctx (t s ctx [])
|
|
||||||
| Template { loc; _ }
|
|
||||||
| Quoted_string (loc, _) ->
|
|
||||||
of_sexp_error loc "Atom expected"
|
|
||||||
| List (loc, []) ->
|
|
||||||
of_sexp_error loc "Non-empty list expected"
|
|
||||||
| List (loc, name :: args) ->
|
|
||||||
match name with
|
|
||||||
| Quoted_string (loc, _) | List (loc, _) | Template { loc; _ } ->
|
|
||||||
of_sexp_error loc "Atom expected"
|
|
||||||
| Atom (s_loc, A s) ->
|
|
||||||
let ctx loc = Values (loc, Some s, uc) in
|
|
||||||
result (ctx s_loc) (t s (ctx loc) args))
|
|
||||||
|
|
||||||
let sum cstrs =
|
let sum cstrs =
|
||||||
next_with_user_context (fun uc sexp ->
|
next_with_user_context (fun uc sexp ->
|
||||||
match sexp with
|
match sexp with
|
||||||
|
|
|
@ -201,8 +201,6 @@ module Of_sexp : sig
|
||||||
list parser. *)
|
list parser. *)
|
||||||
val sum : (string * 'a t) list -> 'a t
|
val sum : (string * 'a t) list -> 'a t
|
||||||
|
|
||||||
val binding : 'a t -> (string * ('a list)) t
|
|
||||||
|
|
||||||
(** Check the result of a list parser, and raise a properly located
|
(** Check the result of a list parser, and raise a properly located
|
||||||
error in case of failure. *)
|
error in case of failure. *)
|
||||||
val map_validate
|
val map_validate
|
||||||
|
|
Loading…
Reference in New Issue