Introduce short syntax for sexps
This commit is contained in:
parent
5a73753095
commit
6e7d297ea3
38
src/sexp.ml
38
src/sexp.ml
|
@ -252,34 +252,44 @@ module Of_sexp = struct
|
||||||
in
|
in
|
||||||
Loc.fail loc "%s" msg
|
Loc.fail loc "%s" msg
|
||||||
|
|
||||||
let field name ?default value_of_sexp state =
|
module Short_syntax = struct
|
||||||
|
type 'a t =
|
||||||
|
| Not_allowed
|
||||||
|
| This of 'a
|
||||||
|
| Located of (Loc.t -> 'a)
|
||||||
|
|
||||||
|
let parse t entry name =
|
||||||
|
match t with
|
||||||
|
| Not_allowed ->
|
||||||
|
Loc.fail (Ast.loc entry) "field %s needs a value" name
|
||||||
|
| This x -> x
|
||||||
|
| Located f -> f (Ast.loc entry)
|
||||||
|
end
|
||||||
|
|
||||||
|
let field name ?(short=Short_syntax.Not_allowed)
|
||||||
|
?default value_of_sexp state =
|
||||||
match Name_map.find state.unparsed name with
|
match Name_map.find state.unparsed name with
|
||||||
| Some { value = Some value; _ } ->
|
| Some { value = Some value; _ } ->
|
||||||
(value_of_sexp value, consume name state)
|
(value_of_sexp value, consume name state)
|
||||||
| Some { value = None; _ } ->
|
| Some { value = None; entry } ->
|
||||||
Loc.fail state.loc "field %s needs a value" name
|
(Short_syntax.parse short entry name,
|
||||||
|
consume name state)
|
||||||
| None ->
|
| None ->
|
||||||
match default with
|
match default with
|
||||||
| Some v -> (v, add_known name state)
|
| Some v -> (v, add_known name state)
|
||||||
| None ->
|
| None ->
|
||||||
Loc.fail state.loc "field %s missing" name
|
Loc.fail state.loc "field %s missing" name
|
||||||
|
|
||||||
let field_o name value_of_sexp state =
|
let field_o name ?(short=Short_syntax.Not_allowed) value_of_sexp state =
|
||||||
match Name_map.find state.unparsed name with
|
match Name_map.find state.unparsed name with
|
||||||
| Some { value = Some value; _ } ->
|
| Some { value = Some value; _ } ->
|
||||||
(Some (value_of_sexp value), consume name state)
|
(Some (value_of_sexp value), consume name state)
|
||||||
| Some { value = None; _ } ->
|
| Some { value = None; entry } ->
|
||||||
Loc.fail state.loc "field %s needs a value" name
|
(Some (Short_syntax.parse short entry name),
|
||||||
|
consume name state)
|
||||||
| None -> (None, add_known name state)
|
| None -> (None, add_known name state)
|
||||||
|
|
||||||
let field_b name state =
|
let field_b name = field name bool ~default:false ~short:(This true)
|
||||||
match Name_map.find state.unparsed name with
|
|
||||||
| Some { value = Some value; _ } ->
|
|
||||||
(bool value, consume name state)
|
|
||||||
| Some { value = None; _ } ->
|
|
||||||
(true, consume name state)
|
|
||||||
| None ->
|
|
||||||
(false, add_known name state)
|
|
||||||
|
|
||||||
let make_record_parser_state sexp =
|
let make_record_parser_state sexp =
|
||||||
match sexp with
|
match sexp with
|
||||||
|
|
20
src/sexp.mli
20
src/sexp.mli
|
@ -69,8 +69,24 @@ module Of_sexp : sig
|
||||||
(** Return the location of the record being parsed *)
|
(** Return the location of the record being parsed *)
|
||||||
val record_loc : Loc.t record_parser
|
val record_loc : Loc.t record_parser
|
||||||
|
|
||||||
val field : string -> ?default:'a -> 'a t -> 'a record_parser
|
module Short_syntax : sig
|
||||||
val field_o : string -> 'a t -> 'a option record_parser
|
type 'a t =
|
||||||
|
| Not_allowed
|
||||||
|
| This of 'a
|
||||||
|
| Located of (Loc.t -> 'a)
|
||||||
|
end
|
||||||
|
|
||||||
|
val field
|
||||||
|
: string
|
||||||
|
-> ?short:'a Short_syntax.t
|
||||||
|
-> ?default:'a
|
||||||
|
-> 'a t
|
||||||
|
-> 'a record_parser
|
||||||
|
val field_o
|
||||||
|
: string
|
||||||
|
-> ?short:'a Short_syntax.t
|
||||||
|
-> 'a t
|
||||||
|
-> 'a option record_parser
|
||||||
val field_b : string -> bool record_parser
|
val field_b : string -> bool record_parser
|
||||||
|
|
||||||
val map_validate : 'a record_parser -> f:('a -> ('b, string) result) -> 'b record_parser
|
val map_validate : 'a record_parser -> f:('a -> ('b, string) result) -> 'b record_parser
|
||||||
|
|
Loading…
Reference in New Issue