module type Elem = sig type t val pp : t -> string end ;;
+module type ZipTree = sig
+ type t
+ type tree = Node of (t * tree) list
+ type position
+
+ val start : tree -> position
+
+ val up : position -> position option
+ val down : position -> position option
+ val left : position -> position option
+ val right : position -> position option
+
+ val root: position -> tree
+ val previsit: ('a -> t -> 'a) -> 'a -> position -> 'a
+
+ val get: position -> t
+ val set: t -> position -> position
+
+ val inject: tree -> position -> position
+ val eject: position -> tree
+
+end
+
+let rec repeat f l = match f l with None -> l | Some l -> repeat f l;;
+
module Make(T : Elem) = struct
+type t = T.t
+
type tree = Node of (T.t * tree) list
type tree_ctx =
type position = Loc of tree_ctx * tree
-
let start (t : tree) : position = Loc (Top, t);;
let down = function
| Loc (Ctx(ctx,(lx,lt)::tl,x,r),t) -> Some (Loc(Ctx(ctx,tl,lx,(x,t)::r),lt))
;;
-let rec repeat f l = match f l with None -> l | Some l -> repeat f l;;
+let get = function
+ | Loc(Top,_) -> assert false
+ | Loc(Ctx(_,_,x,_),_) -> x
+;;
+
+let set x = function
+ | Loc(Top,_) -> assert false
+ | Loc(Ctx(c,l,_,r),t) -> Loc(Ctx(c,l,x,r),t)
+;;
let root t =
match repeat up t with
| _ -> assert false
;;
-let previsit f acc (t : position) =
+let eject (Loc (_,t)) = t ;;
+
+let inject t (Loc (c,_)) = Loc(c,t) ;;
+
+let previsit f acc (p : position) =
let rec aux acc = function
| Node [] -> acc
| Node ((x,t)::tl) ->
let acc = f acc x in
aux acc (Node tl)
in
- aux acc (root t)
+ aux acc (eject p)
;;
-
-
end
(* $Id: nCic.ml 9058 2008-10-13 17:42:30Z tassi $ *)
+val repeat : ('a -> 'a option) -> 'a -> 'a
+
+module type Elem = sig type t val pp : t -> string end ;;
+
+module type ZipTree = sig
+ type t
+ type tree = Node of (t * tree) list
+ type position
+
+ val start : tree -> position
+
+ val up : position -> position option
+ val down : position -> position option
+ val left : position -> position option
+ val right : position -> position option
+
+ val root: position -> tree
+ val previsit: ('a -> t -> 'a) -> 'a -> position -> 'a
+
+ val get: position -> t
+ val set: t -> position -> position
+
+ val inject: tree -> position -> position
+ val eject: position -> tree
+
+end
+
+module Make(T : Elem) : ZipTree with type t = T.t