From f19845f3d6c5d8cf679eb9ef1cd97ad2277f724f Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Thu, 18 Sep 2014 00:49:24 +0200 Subject: [PATCH] Sexp.Traverse.field, and an example in doc --- misc/sexp.ml | 19 +++++++++++++------ misc/sexp.mli | 29 ++++++++++++++++++++++++++++- 2 files changed, 41 insertions(+), 7 deletions(-) diff --git a/misc/sexp.ml b/misc/sexp.ml index 2ba688e5..7657c777 100644 --- a/misc/sexp.ml +++ b/misc/sexp.ml @@ -570,6 +570,16 @@ end (** {6 Traversal of S-exp} *) module Traverse = struct + let return x = Some x + + let (>|=) e f = match e with + | None -> None + | Some x -> Some (f x) + + let (>>=) e f = match e with + | None -> None + | Some x -> f x + let rec _list_any f l = match l with | [] -> None | x::tl -> @@ -621,6 +631,9 @@ module Traverse = struct | List l -> _get_field name l | Atom _ -> None + let field name f e = + get_field name e >>= f + let rec _get_variant s args l = match l with | [] -> None | (s', f) :: _ when s=s' -> f args @@ -631,12 +644,6 @@ module Traverse = struct | List _ -> None | Atom s -> _get_variant s [] l - let return x = Some x - - let (>>=) e f = match e with - | None -> None - | Some x -> f x - let get_exn e = match e with | None -> failwith "Sexp.Traverse.get_exn" | Some x -> x diff --git a/misc/sexp.mli b/misc/sexp.mli index 8d8def17..e7f2ec0b 100644 --- a/misc/sexp.mli +++ b/misc/sexp.mli @@ -221,7 +221,29 @@ module L : sig val of_seq : string sequence -> t list or_error end -(** {6 Traversal of S-exp} *) +(** {6 Traversal of S-exp} + +Example: serializing 2D points +{[ +type pt = {x:int; y:int };; + +let pt_of_sexp e = + Sexp.Traverse.( + field "x" to_int e >>= fun x -> + field "y" to_int e >>= fun y -> + return {x;y} + );; + +let sexp_of_pt pt = Sexp.(of_record ["x", of_int pt.x; "y", of_int pt.y]);; + +let l = [{x=1;y=1}; {x=2;y=10}];; + +let sexp = Sexp.(of_list (List.map sexp_of_pt l));; + +Sexp.Traverse.list_all pt_of_sexp sexp;; +]} + +*) module Traverse : sig val list_any : (t -> 'a option) -> t -> 'a option @@ -248,6 +270,9 @@ module Traverse : sig (** [get_field name e], when [e = List [(n1,x1); (n2,x2) ... ]], extracts the [xi] such that [name = ni], if it can find it. *) + val field : string -> (t -> 'a option) -> t -> 'a option + (** Enriched version of {!get_field}, with a converter as argument *) + val get_variant : (string * (t list -> 'a option)) list -> t -> 'a option (** [get_variant l e] checks whether [e = List (Atom s :: args)], and if some pair of [l] is [s, f]. In this case, it calls [f args] @@ -255,6 +280,8 @@ module Traverse : sig val (>>=) : 'a option -> ('a -> 'b option) -> 'b option + val (>|=) : 'a option -> ('a -> 'b) -> 'b option + val return : 'a -> 'a option val get_exn : 'a option -> 'a