diff --git a/core/CCList.ml b/core/CCList.ml index 8a240539..34d04392 100644 --- a/core/CCList.ml +++ b/core/CCList.ml @@ -424,6 +424,54 @@ module Assoc = struct *) end +(** {2 Zipper} *) + +module Zipper = struct + type 'a t = 'a list * 'a list + + let empty = [], [] + + let is_empty = function + | _, [] -> true + | _, _::_ -> false + + let to_list (l,r) = + let rec append l acc = match l with + | [] -> acc + | x::l' -> append l' (x::acc) + in append l r + + let make l = [], l + + let left = function + | x::l, r -> l, x::r + | [], r -> [], r + + let right = function + | l, x::r -> x::l, r + | l, [] -> l, [] + + let modify f z = match z with + | l, [] -> + begin match f None with + | None -> z + | Some x -> l, [x] + end + | l, x::r -> + begin match f (Some x) with + | None -> l,r + | Some x' -> l, x::r + end + + let focused = function + | _, x::_ -> Some x + | _, [] -> None + + let focused_exn = function + | _, x::_ -> x + | _, [] -> raise Not_found +end + (** {2 Conversions} *) type 'a sequence = ('a -> unit) -> unit diff --git a/core/CCList.mli b/core/CCList.mli index 7ccc71a7..54338a68 100644 --- a/core/CCList.mli +++ b/core/CCList.mli @@ -175,6 +175,42 @@ module Assoc : sig (** Add the binding into the list (erase it if already present) *) end +(** {2 Zipper} *) + +module Zipper : sig + type 'a t = 'a list * 'a list + + val empty : 'a t + (** Empty zipper *) + + val is_empty : _ t -> bool + (** Empty zipper, or at the end of the zipper? *) + + val to_list : 'a t -> 'a list + (** Convert the zipper back to a list *) + + val make : 'a list -> 'a t + (** Create a zipper pointing at the first element of the list *) + + val left : 'a t -> 'a t + (** Go to the left, or do nothing if the zipper is already at leftmost pos *) + + val right : 'a t -> 'a t + (** Go to the right, or do nothing if the zipper is already at rightmost pos *) + + val modify : ('a option -> 'a option) -> 'a t -> 'a t + (** Modify the current element, if any, by returning a new element, or + returning [None] if the element is to be deleted *) + + val focused : 'a t -> 'a option + (** Returns the focused element, if any. [focused zip = Some _] iff + [empty zip = false] *) + + val focused_exn : 'a t -> 'a + (** Returns the focused element, or + @raise Not_found if the zipper is at an end *) +end + (** {2 Conversions} *) type 'a sequence = ('a -> unit) -> unit