Sexp.Traverse, to extract information from S-expr

misc/sexp.ml

@@ -39,6 +39,15 @@ let compare a b = Pervasives.compare a b
 
 let hash a = Hashtbl.hash a
 
+let of_int x = Atom (string_of_int x)
+let of_float x = Atom (string_of_float x)
+let of_bool x = Atom (string_of_bool x)
+let of_string x = Atom x
+let of_unit = List []
+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 _with_in filename f =
   let ic = open_in filename in
   try
@@ -552,3 +561,59 @@ module L = struct
     | OhNoes msg -> `Error msg
     | StopNaow -> `Ok (List.rev !l)
 end
+
+(** {6 Traversal of S-exp} *)
+
+module Traverse = struct
+  let rec _list_any f l = match l with
+    | [] -> None
+    | x::tl ->
+        match f x with
+        | Some _ as res -> res
+        | None -> _list_any f tl
+
+  let list_any e f = match e with
+    | Atom _ -> None
+    | List l -> _list_any f l
+
+  let rec _list_all f acc l = match l with
+    | [] -> List.rev acc
+    | x::tl ->
+        match f x with
+        | Some y -> _list_all f (y::acc) tl
+        | None -> _list_all f acc tl
+
+  let list_all e f = match e with
+    | Atom _ -> []
+    | List l -> _list_all f [] l
+
+  let _try_atom e f = match e with
+    | List _ -> None
+    | Atom x -> try Some (f x) with _ -> None
+
+  let to_int e = _try_atom e int_of_string
+  let to_bool e = _try_atom e bool_of_string
+  let to_string e = _try_atom e (fun x->x)
+
+  let to_pair e = match e with
+    | List [x;y] -> Some (x,y)
+    | _ -> None
+
+  let to_triple e = match e with
+    | List [x;y;z] -> Some (x,y,z)
+    | _ -> None
+
+  let to_list e = match e with
+    | List l -> Some l
+    | Atom _ -> None
+
+  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
+end

misc/sexp.mli

@@ -41,6 +41,15 @@ val equal : t -> t -> bool
 val compare : t -> t -> int
 val hash : t -> int
 
+val of_int : int -> t
+val of_bool : bool -> t
+val of_list : t list -> t
+val of_string : string -> t
+val of_float : float -> t
+val of_unit : t
+val of_pair : t * t -> t
+val of_triple : t * t * t -> t
+
 (** {2 Serialization (encoding)} *)
 
 val to_buf : Buffer.t -> t -> unit
@@ -200,3 +209,35 @@ module L : sig
 
   val of_seq : string sequence -> t list or_error
 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],
+      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]
+      and [f x = Some y] *)
+
+  val to_int : t -> int option
+
+  val to_string : t -> string option
+
+  val to_bool : t -> bool option
+
+  val to_list : t -> t list option
+
+  val to_pair : t -> (t * t) option
+
+  val to_triple : t -> (t * t * t) option
+
+  val (>>=) : 'a option -> ('a -> 'b option) -> 'b option
+
+  val return : 'a -> 'a option
+
+  val get_exn : 'a option -> 'a
+  (** Unwrap an option, possibly failing.
+      @raise Invalid_argument if the argument is [None] *)
+end