From 0b2c183dbf275fbca3f9e0522cc583f85edccab5 Mon Sep 17 00:00:00 2001 From: Federico Igne Date: Mon, 22 Jan 2024 23:44:14 +0100 Subject: refactor: naming convention in zipper Unless specified otherwise: - "before" and "left" mean "before the cursor"; - "right" mean "after (and including) the cursor"; - "after" mean "after (i.e., excluding) the cursor". --- lib/zipper.ml | 96 +++++++++++++++++++------------------------- lib/zipper.mli | 125 ++++++++++++++++++++++++++++++++------------------------- 2 files changed, 112 insertions(+), 109 deletions(-) diff --git a/lib/zipper.ml b/lib/zipper.ml index 9313518..202f6d4 100644 --- a/lib/zipper.ml +++ b/lib/zipper.ml @@ -2,28 +2,14 @@ open Base -type !+'a zipper = { - pos : int; - popped : 'a Sequence.t; - before : 'a Sequence.t; - after : 'a Sequence.t; -} - +type !+'a zipper = { pos : int; before : 'a Sequence.t; after : 'a Sequence.t } type !+'a t = 'a zipper -let empty = - { - pos = 0; - popped = Sequence.empty; - before = Sequence.empty; - after = Sequence.empty; - } - +let empty = { pos = 0; before = Sequence.empty; after = Sequence.empty } let before z = z.before let after z = z.after let focus z = after z |> Sequence.next |> Option.map ~f:fst -let focus_or z ~default = Option.value ~default (focus z) -let history z = z.popped +let focus_or ~default z = Option.value ~default (focus z) let is_far_left z = before z |> Sequence.is_empty let is_far_right z = after z |> Sequence.is_empty let is_empty z = is_far_left z && is_far_right z @@ -35,12 +21,7 @@ let left z = match Sequence.next z.before with | None -> z | Some (h, t) -> - { - z with - pos = z.pos - 1; - before = t; - after = Sequence.shift_right z.after h; - } + { pos = z.pos - 1; before = t; after = Sequence.shift_right z.after h } let rec left_while f z = if (not (is_far_left z)) && Option.(focus z |> map ~f |> value ~default:false) @@ -53,12 +34,7 @@ let right z = match Sequence.next z.after with | None -> z | Some (h, t) -> - { - z with - pos = z.pos + 1; - before = Sequence.shift_right z.before h; - after = t; - } + { pos = z.pos + 1; before = Sequence.shift_right z.before h; after = t } let rec right_while f z = if @@ -73,34 +49,46 @@ let goto n z = let step = if n < 0 then left else right in Fn.apply_n_times ~n:(abs n) step z -let pop_after z = { z with after = Sequence.drop_eagerly z.after 1 } -let pop_before z = if is_far_left z then z else z |> left |> pop_after -let pop = pop_before -let push_after x z = { z with after = Sequence.shift_right z.after x } +let pop ?(n = 1) z = { z with after = Sequence.drop_eagerly z.after n } + +let pop_before ?(n = 1) = + let rec aux m z = + if m < n && not (is_far_left z) then aux (m + 1) (left z) else pop ~n:m z + in + aux 0 + +let pop_after ?(n = 1) z = + if right_length z < 2 then z else right z |> pop ~n |> left + +let push x z = { z with after = Sequence.shift_right z.after x } +let push_after x z = right z |> push x |> left let push_before x z = { z with pos = z.pos + 1; before = Sequence.shift_right z.before x } -let push = push_before - let split z = ( { z with after = Sequence.empty }, { z with pos = 0; before = Sequence.empty } ) -let join z1 z2 = { z1 with after = z2.after } -let iter_before f z = Sequence.iter ~f z.before -let iter_after f z = Sequence.iter ~f z.after +let join z1 ~z2 = + let z1 = far_right z1 and z2 = far_left z2 in + { z1 with after = z2.after } + +let iter_left f z = Sequence.iter ~f z.before +let iter_right f z = Sequence.iter ~f z.after let iter f z = - iter_before f z; - iter_after f z + iter_left f z; + iter_right f z let for_all f z = Sequence.(for_all ~f z.before && for_all ~f z.after) let exists f z = Sequence.(exists ~f z.before || exists ~f z.after) -let find_before f z = Sequence.find ~f z.before -let find_after f z = Sequence.find ~f z.after -let map_before f z = { z with before = Sequence.map ~f z.before } -let map_after f z = { z with after = Sequence.map ~f z.after } +let find_left f z = Sequence.find ~f z.before +let find_right f z = Sequence.find ~f z.after +let apply_focus f z = Option.map ~f (focus z) +let apply_focus_or ~default f z = Option.value ~default (apply_focus f z) +let map_left f z = { z with before = Sequence.map ~f z.before } +let map_right f z = { z with after = Sequence.map ~f z.after } let map_focus f z = match Sequence.next z.after with @@ -115,8 +103,8 @@ let map_focus_or ~default f z = let map f z = { z with before = Sequence.map ~f z.before; after = Sequence.map ~f z.after } -let mapi_before f z = { z with before = Sequence.mapi ~f z.before } -let mapi_after f z = { z with after = Sequence.mapi ~f z.after } +let mapi_left f z = { z with before = Sequence.mapi ~f z.before } +let mapi_right f z = { z with after = Sequence.mapi ~f z.after } let mapi f z = { @@ -125,13 +113,13 @@ let mapi f z = after = Sequence.mapi ~f z.after; } -let filter_before f z = { z with before = Sequence.filter ~f z.before } -let filter_after f z = { z with after = Sequence.filter ~f z.after } -let filter p z = z |> filter_before p |> filter_after p -let context_before n z = { z with before = Sequence.take z.before n } -let context_after n z = { z with after = Sequence.take z.after n } -let context ~b ?(a = b) z = z |> context_before b |> context_after a -let clear_history z = { z with popped = Sequence.empty } +let filter_left f z = { z with before = Sequence.filter ~f z.before } +let filter_right f z = { z with after = Sequence.filter ~f z.after } +let filter p z = z |> filter_left p |> filter_right p +let context_left n z = { z with before = Sequence.take z.before n } +let context_right n z = { z with after = Sequence.take z.after n } +let context ~l ?(r = l) z = z |> context_left l |> context_right r +let swap_focus a = map_focus (Fn.const a) let of_seq s = { empty with after = s } let to_seq z = z |> far_left |> after -let window ~from ~len z = goto from z |> context_after len |> after +let window ~from ~len z = goto from z |> context_right len |> after diff --git a/lib/zipper.mli b/lib/zipper.mli index e25d57b..d79604e 100644 --- a/lib/zipper.mli +++ b/lib/zipper.mli @@ -35,17 +35,14 @@ val before : 'a zipper -> 'a Sequence.t (** Return the sequence before the cursor *) val after : 'a zipper -> 'a Sequence.t -(** Return the sequence after the cursor *) +(** Return the sequence after (and including) the cursor *) val focus : 'a zipper -> 'a option (** Return the focus of the zipper, if any. *) -val focus_or : 'a zipper -> default:'a -> 'a +val focus_or : default:'a -> 'a zipper -> 'a (** Return the focus of the zipper, or a user-provided default, otherwise. *) -val history : 'a zipper -> 'a Sequence.t -(** Returns the sequence of elements [pop]ped so far from the zipper. *) - val is_far_left : 'a zipper -> bool (** Return whether the cursor is at the beginning of the zipper. *) @@ -109,43 +106,52 @@ val goto : int -> 'a zipper -> 'a zipper This involve [push]ing and [pop]ping elements before and after the cursor. *) -val pop_after : 'a zipper -> 'a zipper -(** Remove the element at the cursor position, if any, and return the - modified zipper. Calling [pop_after z], +val pop : ?n:int -> 'a zipper -> 'a zipper +(** Remove [n] elements at the cursor position (1 by default), if any, + and return the modified zipper. Calling [pop z], - - if [z] is [([3; 2; 1], [4; 5])], the result is [([3; 2; 1], [5])], + - if [z] is [([3; 2; 1], [4; 5])], the result is [([3; 2; 1], [5])], - if [z] is [([1; 2; 3], [])], the result is [([1; 2; 3], [])]. *) -val pop_before : 'a zipper -> 'a zipper -(** Remove the element before the cursor, if any, and return the - modified zipper. Calling [pop_before z], +val pop_before : ?n:int -> 'a zipper -> 'a zipper +(** Remove [n] elements before the cursor (1 by default), if any, and + return the modified zipper. Calling [pop_before z], - - if [z] is [([3; 2; 1], [4; 5])], the result is [([2; 1], [4, 5])], + - if [z] is [([3; 2; 1], [4; 5])], the result is [([2; 1], [4, 5])], - if [z] is [([], [1; 2; 3])], the result is [([], [1; 2; 3])]. *) -val pop : 'a zipper -> 'a zipper -(** [pop] is an alias for [pop_before]. *) +val pop_after : ?n:int -> 'a zipper -> 'a zipper +(** Remove [n] elements after (and {b not} including) the cursor + (1 by default), if any, and return the modified zipper. + Calling [pop_after z], + + - if [z] is [([3; 2; 1], [4; 5])], the result is [([3; 2; 1], [4])], + - if [z] is [([1; 2; 3], [4])], the result is [([1; 2; 3], [4])]. + *) + +val push : 'a -> 'a zipper -> 'a zipper +(** Insert an element at the cursor position. + Calling [push 0 z], if [z] is [([3; 2; 1], [4; 5])], + the result is [([3; 2; 1], [0; 4; 5]))], *) val push_after : 'a -> 'a zipper -> 'a zipper -(** Insert an element after the cursor. +(** Insert an element after the cursor. Behaves like {!Zipper.push} if + the cursor is at the far right of the zipper. Calling [push_after 0 z], if [z] is [([3; 2; 1], [4; 5])], - the result is [([3; 2; 1], [0; 4, 5]))], *) + the result is [([3; 2; 1], [4; 0; 5]))], *) val push_before : 'a -> 'a zipper -> 'a zipper (** Insert an element before the cursor. Return the modified zipper. Calling [push_before 0 z], if [z] is [([3; 2; 1], [4; 5])], - the result is [([0; 3; 2; 1], [4, 5]))]. *) - -val push : 'a -> 'a zipper -> 'a zipper -(** [push] is an alias for [push_before]. *) + the result is [([0; 3; 2; 1], [4; 5]))]. *) val split : 'a zipper -> 'a zipper * 'a zipper (** [split z] splits the zipper in two. [([3; 2; 1], [4; 5])] becomes [([3; 2; 1], []), ([], [4; 5])]. *) -val join : 'a zipper -> 'a zipper -> 'a zipper +val join : 'a zipper -> z2:'a zipper -> 'a zipper (** [join z1 z2] creates a new zipper using [before z1] and [after z2]. [([3; 2; 1], []) ([4; 2], [4; 5])] becomes [([3; 2; 1], [4; 5])]. *) @@ -156,16 +162,16 @@ val join : 'a zipper -> 'a zipper -> 'a zipper Unless otherwise stated, these functions will iterate on the elements before the cursor, first. *) -val iter_before : ('a -> unit) -> 'a zipper -> unit -(** [iter_before f z] will call [f x] for all [x], elements before the +val iter_left : ('a -> unit) -> 'a zipper -> unit +(** [iter_left f z] will call [f x] for all [x], elements before the cursor in [z].*) -val iter_after : ('a -> unit) -> 'a zipper -> unit -(** [iter_after f z] will call [f x] for all [x], elements after the - cursor in [z].*) +val iter_right : ('a -> unit) -> 'a zipper -> unit +(** [iter_right f z] will call [f x] for all [x], elements after (in + including) the cursor in [z]. *) val iter : ('a -> unit) -> 'a zipper -> unit -(** [iter f z] is equivalent to [iter_before f z; iter_after f z] *) +(** [iter f z] is equivalent to [iter_left f z; iter_right f z] *) val for_all : ('a -> bool) -> 'a zipper -> bool (** [for_all p z] tests whether a predicate [p] is [true] for all @@ -175,25 +181,33 @@ val exists : ('a -> bool) -> 'a zipper -> bool (** [exists p z] tests whether at least one element in the zipper is [true] according to the predicate [p]. *) -val find_before : ('a -> bool) -> 'a zipper -> 'a option -(** [find_before p z] will return the first element before the cursor in +val find_left : ('a -> bool) -> 'a zipper -> 'a option +(** [find_left p z] will return the first element before the cursor in [z] satisfying the predicate [p], if any. *) -val find_after : ('a -> bool) -> 'a zipper -> 'a option -(** [find_after p z] will return the first element after the cursor in +val find_right : ('a -> bool) -> 'a zipper -> 'a option +(** [find_right p z] will return the first element after the cursor in [z] satisfying the predicate [p], if any. *) +val apply_focus : ('a -> 'b) -> 'a zipper -> 'b option +(** [apply focus f z] applies f to the current focus, if any, and + returns its result *) + +val apply_focus_or : default:'b -> ('a -> 'b) -> 'a zipper -> 'b +(** [apply focus f z] applies f to the current focus and returns its + result. Return a default value if no element is in focus. *) + (** {1 Transforming zippers} *) (** Since zippers are based on sequences, the functions in this section are lazy; i.e., resulting elements of the zipper are computed only when demanded. *) -val map_before : ('a -> 'a) -> 'a zipper -> 'a zipper +val map_left : ('a -> 'a) -> 'a zipper -> 'a zipper (** Map a function over all elements before the cursor. *) -val map_after : ('a -> 'a) -> 'a zipper -> 'a zipper -(** Map a function over all elements after the cursor. *) +val map_right : ('a -> 'a) -> 'a zipper -> 'a zipper +(** Map a function over all elements after (and including) the cursor. *) val map_focus : ('a -> 'a) -> 'a zipper -> 'a zipper (** Map a function over the element focused by the cursor, if any. *) @@ -202,31 +216,31 @@ val map_focus_or : default:'a -> ('a -> 'a) -> 'a zipper -> 'a zipper (** Map a function over the element focused by the cursor. Push [default] if no element is focused. *) -val map : ('a -> 'a) -> 'a zipper -> 'a zipper +val map : ('a -> 'b) -> 'a zipper -> 'b zipper (** Map a function over all elements of a zipper. *) -val mapi_before : (int -> 'a -> 'a) -> 'a zipper -> 'a zipper -(** [mapi_before] is analogous to {!Zipper.map_before}, but the function +val mapi_left : (int -> 'a -> 'a) -> 'a zipper -> 'a zipper +(** [mapi_left] is analogous to {!Zipper.map_left}, but the function takes an index and an element. The index indicates the distance of an element from the cursor. *) -val mapi_after : (int -> 'a -> 'a) -> 'a zipper -> 'a zipper -(** [mapi_after] is analogous to {!Zipper.map_after}, but the function +val mapi_right : (int -> 'a -> 'a) -> 'a zipper -> 'a zipper +(** [mapi_right] is analogous to {!Zipper.map_right}, but the function takes an index and an element. The index indicates the distance of an element from the cursor. *) -val mapi : (int -> 'a -> 'a) -> 'a zipper -> 'a zipper +val mapi : (int -> 'a -> 'b) -> 'a zipper -> 'b zipper (** [mapi] is analogous to {!Zipper.map}, but the function takes an index and an element. The index indicates the distance of an element from the cursor. *) -val filter_before : ('a -> bool) -> 'a zipper -> 'a zipper -(** [filter_before p z] filters the elements before the cursor in a +val filter_left : ('a -> bool) -> 'a zipper -> 'a zipper +(** [filter_left p z] filters the elements before the cursor in a zipper [z] according to a predicate [p], i.e., keeping the elements that satisfy the predicate. *) -val filter_after : ('a -> bool) -> 'a zipper -> 'a zipper -(** [filter_after p z] filters the elements after the cursor in a +val filter_right : ('a -> bool) -> 'a zipper -> 'a zipper +(** [filter_right p z] filters the elements after the cursor in a zipper [z] according to a predicate [p], i.e., keeping the elements that satisfy the predicate. *) @@ -235,21 +249,22 @@ val filter : ('a -> bool) -> 'a zipper -> 'a zipper predicate [p], i.e., keeping the elements that satisfy the predicate. *) -val context_before : int -> 'a zipper -> 'a zipper -(** [context_before n z] will limit the zipper [z] to [n] elements before +val context_left : int -> 'a zipper -> 'a zipper +(** [context_left n z] will limit the zipper [z] to [n] elements before the cursor. *) -val context_after : int -> 'a zipper -> 'a zipper -(** [context_after n z] will limit the zipper [z] to [n] elements after +val context_right : int -> 'a zipper -> 'a zipper +(** [context_right n z] will limit the zipper [z] to [n] elements after the cursor. *) -val context : b:int -> ?a:int -> 'a zipper -> 'a zipper -(** [context ~b ~a z] will limit the zipper [z] to [b] elements before - the cursor and [a] elements after the cursor. When [a] is not - provided, it defaults to [b]. *) +val context : l:int -> ?r:int -> 'a zipper -> 'a zipper +(** [context ~l ~r z] will limit the zipper [z] to [l] elements before + the cursor and [r] elements after the cursor. When [r] is not + provided, it defaults to [l]. *) -val clear_history : 'a zipper -> 'a zipper -(** Clear the history of the zipper. See {!Zipper.history}. *) +val swap_focus : 'a -> 'a zipper -> 'a zipper +(** Swap the element in focus with a newly provided element. Nothing + happens if no element is in focus. *) (** {1 Zippers and sequences} *) -- cgit v1.2.3