zipper.fs

module test
#light
type 'element Tree =
    | TreeNode of 'element Tree * 'element Tree
    | TreeLeaf of 'element

type 'element Zipper =
    | LeftNode  of 'element Zipper * 'element Tree
    | RightNode of 'element Zipper * 'element Tree
    | Root

type 'element Location =
    | Location of 'element Zipper * 'element Tree * 'element Tree
    | Leaf     of 'element * 'element Zipper
    
let left = function
    | Location(up, TreeNode(nl,nr), right) -> Location(LeftNode(up,right), nl, nr)
    | Location(up, TreeLeaf(el), right) -> Leaf(el, LeftNode(up,right))
        
let right = function
    | Location(up, left, TreeNode(nl,nr))  -> Location(RightNode(up,left), nl, nr)
    | Location(up, left, TreeLeaf(el)) -> Leaf(el, RightNode(up,left))
            
let up = function
    | Location(LeftNode(up,nr), left, right)  -> Location(up, TreeNode(left,right), nr)
    | Location(RightNode(up,nl), left, right) -> Location(up, nl, TreeNode(left,right))
    | Leaf(el, LeftNode(up,nr))  -> Location(up, TreeLeaf(el), nr)
    | Leaf(el, RightNode(up,nl)) -> Location(up, nl, TreeLeaf(el))

let toLoc = function
    | TreeNode(a, b) -> Location(Root,a,b)
    | TreeLeaf(a)    -> Leaf(a, Root)

let zap action leaf =
    match leaf with 
      Leaf(value, up) -> Leaf(action(value) ,up)

let plus5 x = x+5

// TreeNode(TreeLeaf(2),TreeLeaf(3)) |> toLoc |> left |> zap plus5 |> up;;