(** Zippers *) (* zipper des listes *) (* un bloc sur la pile contient juste un 'a *) type 'a pile = 'a list type 'a listzipper = 'a pile * 'a list exception Zipper of string;; let a_gauche : 'a listzipper -> 'a listzipper = function | ([],_) -> raise (Zipper "Deja a gauche") | (a::p,l) -> (p, a::l);; let a_droite : 'a listzipper -> 'a listzipper = function | (p,[]) -> raise (Zipper "Deja a droite") | (p,a::l) -> (a::p, l);; let insert v : 'a listzipper -> 'a listzipper = function (pile,liste) -> (pile, v::liste);; let delete : 'a listzipper -> 'a listzipper = function | (p,[]) -> raise (Zipper "Trop a droite pour effacer") | (p,a::r) -> (p, r);; (* zippers des arbres binaires *) type 'a arbre = Feuille | Noeud of 'a * 'a arbre * 'a arbre type marqueur = Gauche | Droite type 'a block = marqueur * 'a * 'a arbre type 'a pile = 'a block list type 'a arbrezipper = 'a pile * 'a arbre;; let bas_a_gauche : 'a arbrezipper -> 'a arbrezipper = function (pile, arbre) -> match arbre with | Feuille -> raise (Zipper "Feuille") | Noeud (x, t1, t2) -> (Gauche, x, t2)::pile, t1;; let bas_a_droite : 'a arbrezipper -> 'a arbrezipper = function (pile, arbre) -> match arbre with | Feuille -> raise (Zipper "Feuille") | Noeud (x, t1, t2) -> (Droite, x, t1)::pile, t2;; let en_haut: 'a arbrezipper -> 'a arbrezipper = function (pile, arbre) -> match pile with | (Gauche, x, t)::p -> p, Noeud (x, arbre, t) | (Droite, x, t)::p -> p, Noeud (x, t, arbre) | _ -> raise (Zipper "Racine");; (* zippers des arbres n-aires *) type 'a narbre = | Feuille of 'a | Noeud of 'a narbre list;; type 'a block = 'a narbre listzipper type 'a pile = 'a block list type 'a narbrezipper = 'a pile * 'a narbre;; (* ces operations sont celles du zippeur de liste : - on se deplace dans la liste des fils d'un noeud n-aire *) let a_gauche : 'a narbrezipper -> 'a narbrezipper = function (pile, arbre) -> match pile with | (a::lp,l)::p -> (lp,arbre::l)::p,a | ([],_)::p -> raise (Zipper "Deja a gauche") | _ -> failwith "Racine";; let a_droite : 'a narbrezipper -> 'a narbrezipper = function (pile, arbre) -> match pile with | (lp,a::l)::p -> (arbre::lp,l)::p,a | (_,[])::pile' -> raise (Zipper "Deja a droite") | _ -> raise (Zipper "Racine");; (* ces opérations sont propres au zippeur d'arbre : on descend ou on remonte entre pere et un des fils *) let en_bas : 'a narbrezipper -> 'a narbrezipper = function (pile, arbre) -> match arbre with | Noeud (a'::arbres) -> ([],arbres)::pile,a' | Noeud _ | Feuille _ -> raise (Zipper "Deja en bas");; let en_haut : 'a narbrezipper -> 'a narbrezipper = function (pile, arbre) -> match pile with | (lp,l)::p -> p,Noeud(List.rev(lp)@(arbre::l)) | _ -> raise (Zipper "Deja en haut");;