Newer
Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
data Tree a = Leaf a | Node (Tree a) (Tree a)
data Ctxt a = Empty
| Le (Ctxt a) (Tree a)
| Ri (Tree a) (Ctxt a)
newtype Loc a = Loc (Tree a, Ctxt a)
top :: Tree a-> Loc a
top t = (Loc (t, Empty))
go_left :: Loc a-> Loc a
go_left (Loc(t, ctx)) = case ctx of
Empty -> error "go_left at empty"
Le c r -> error "go_left of left"
Ri l c -> Loc(l, Le c t)
go_right :: Loc a-> Loc a
go_right (Loc(t, ctx)) = case ctx of
Empty -> error "go_right at empty"
Le c r -> Loc(r, Ri t c)
Ri _ _ -> error "go_right of right"
go_up :: Loc a-> Loc a
go_up (Loc(t, ctx)) = case ctx of
Empty -> error "go_up of empty"
Le c r -> Loc(Node t r, c)
Ri l c -> Loc(Node l t, c)
go_down_left :: Loc a-> Loc a
go_down_left (Loc(t, c)) = case t of
Leaf _ -> error "go_down at leaf"
Node l r -> Loc(l, Le c r)
go_down_right :: Loc a-> Loc a
go_down_right (Loc(t, c)) = case t of
Leaf _ -> error "go_down at leaf"
Node l r -> Loc(r, Ri l c)
ins_left :: Tree a-> Loc a-> Loc a
ins_left t1 (Loc(t, ctx)) = Loc(t, Ri t1 ctx)
ins_right :: Tree a-> Loc a-> Loc a
ins_right t1 (Loc(t, ctx)) = Loc(t, Le ctx t1)
delete :: Loc a-> Loc a
delete (Loc(_, c)) = case c of
Empty -> error "delete of empty"
Le c r -> Loc(r, c)
Ri l c -> Loc(l, c)
update :: Tree a-> Loc a-> Loc a
update t (Loc(_, c)) = Loc(t, c)