diff --git a/misc/sexp.ml b/misc/sexp.ml index e65d6f76..d877817b 100644 --- a/misc/sexp.ml +++ b/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 diff --git a/misc/sexp.mli b/misc/sexp.mli index 50950b53..6dd731df 100644 --- a/misc/sexp.mli +++ b/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