From bb070c7f788fa5d1deefd5546c86af88d1569385 Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Thu, 18 Sep 2014 00:28:58 +0200
Subject: [PATCH] Sexp: constructors and Sexp.Traverse (with new functions)

---
 misc/sexp.ml  | 28 ++++++++++++++++++++++++++--
 misc/sexp.mli | 28 ++++++++++++++++++++++++----
 2 files changed, 50 insertions(+), 6 deletions(-)

diff --git a/misc/sexp.ml b/misc/sexp.ml
index d877817b..2ba688e5 100644
--- a/misc/sexp.ml
+++ b/misc/sexp.ml
@@ -48,6 +48,11 @@ let of_list l = List l
 let of_pair (x,y) = List[x;y]
 let of_triple (x,y,z) = List[x;y;z]
 
+let of_variant name args = List (Atom name :: args)
+let of_field name t = List [Atom name; t]
+let of_record l =
+  List (List.map (fun (n,x) -> of_field n x) l)
+
 let _with_in filename f =
   let ic = open_in filename in
   try
@@ -572,7 +577,7 @@ module Traverse = struct
         | Some _ as res -> res
         | None -> _list_any f tl
 
-  let list_any e f = match e with
+  let list_any f e = match e with
     | Atom _ -> None
     | List l -> _list_any f l
 
@@ -583,7 +588,7 @@ module Traverse = struct
         | Some y -> _list_all f (y::acc) tl
         | None -> _list_all f acc tl
 
-  let list_all e f = match e with
+  let list_all f e = match e with
     | Atom _ -> []
     | List l -> _list_all f [] l
 
@@ -607,6 +612,25 @@ module Traverse = struct
     | List l -> Some l
     | Atom _ -> None
 
+  let rec _get_field name l = match l with
+    | List [Atom n; x] :: _ when name=n -> Some x
+    | _ :: tl -> _get_field name tl
+    | [] -> None
+
+  let get_field name e = match e with
+    | List l -> _get_field name l
+    | Atom _ -> None
+
+  let rec _get_variant s args l = match l with
+    | [] -> None
+    | (s', f) :: _ when s=s' -> f args
+    | _ :: tl -> _get_variant s args tl
+
+  let get_variant l e = match e with
+    | List (Atom s :: args) -> _get_variant s args l
+    | List _ -> None
+    | Atom s -> _get_variant s [] l
+
   let return x = Some x
 
   let (>>=) e f = match e with
diff --git a/misc/sexp.mli b/misc/sexp.mli
index 6dd731df..8d8def17 100644
--- a/misc/sexp.mli
+++ b/misc/sexp.mli
@@ -50,6 +50,17 @@ val of_unit : t
 val of_pair : t * t -> t
 val of_triple : t * t * t -> t
 
+val of_variant : string -> t list -> t
+(** [of_variant name args] is used to encode algebraic variants
+    into a S-expr. For instance [of_variant "some" (of_int 1)]
+    represents the value [Some 1] *)
+
+val of_field : string -> t -> t
+(** Used to represent one record field *)
+
+val of_record : (string * t) list -> t
+(** Represent a record by its named fields *)
+
 (** {2 Serialization (encoding)} *)
 
 val to_buf : Buffer.t -> t -> unit
@@ -213,12 +224,12 @@ end
 (** {6 Traversal of S-exp} *)
 
 module Traverse : sig
-  val list_any : t -> (t -> 'a option) -> 'a option
-  (** [list_any (List l) f] tries [f x] for every element [x] in [List l],
+  val list_any : (t -> 'a option) -> t -> 'a option
+  (** [list_any f (List l)] tries [f x] for every element [x] in [List l],
       and returns the first non-None result (if any). *)
 
-  val list_all : t -> (t -> 'a option) -> 'a list
-  (** [list_all (List l) f] returns the list of all [y] such that [x] in [l]
+  val list_all : (t -> 'a option) -> t -> 'a list
+  (** [list_all f (List l)] returns the list of all [y] such that [x] in [l]
       and [f x = Some y] *)
 
   val to_int : t -> int option
@@ -233,6 +244,15 @@ module Traverse : sig
 
   val to_triple : t -> (t * t * t) option
 
+  val get_field : string -> t -> t option
+  (** [get_field name e], when [e = List [(n1,x1); (n2,x2) ... ]], extracts
+      the [xi] such that [name = ni], if it can find it. *)
+
+  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]
+      and returns its result, otherwise it returns None. *)
+
   val (>>=) : 'a option -> ('a -> 'b option) -> 'b option
 
   val return : 'a -> 'a option