Signed-off-by: Jim Pryor <profjim@jimpryor.net>
type 'a starred_level = Root | Starring_Left of 'a starred_nonroot | Starring_Right of 'a starred_nonroot
and 'a starred_nonroot = { parent : 'a starred_level; sibling: 'a tree };;
type 'a starred_level = Root | Starring_Left of 'a starred_nonroot | Starring_Right of 'a starred_nonroot
and 'a starred_nonroot = { parent : 'a starred_level; sibling: 'a tree };;
- type 'a zipper = { tree : 'a starred_level; filler: 'a tree };;
+ type 'a zipper = { level : 'a starred_level; filler: 'a tree };;
let rec move_botleft (z : 'a zipper) : 'a zipper =
(* returns z if the targetted node in z has no children *)
let rec move_botleft (z : 'a zipper) : 'a zipper =
(* returns z if the targetted node in z has no children *)
let new_zipper (t : 'a tree) : 'a zipper =
let new_zipper (t : 'a tree) : 'a zipper =
- {tree = Root; filler = t}
+ {level = Root; filler = t}
type 'a starred_level = Root | Starring_Left of 'a starred_nonroot | Starring_Right of 'a starred_nonroot
and 'a starred_nonroot = { parent : 'a starred_level; sibling: 'a tree };;
type 'a starred_level = Root | Starring_Left of 'a starred_nonroot | Starring_Right of 'a starred_nonroot
and 'a starred_nonroot = { parent : 'a starred_level; sibling: 'a tree };;
- type 'a zipper = { tree : 'a starred_level; filler: 'a tree };;
+ type 'a zipper = { level : 'a starred_level; filler: 'a tree };;
let rec move_botleft (z : 'a zipper) : 'a zipper =
(* returns z if the targetted node in z has no children *)
(* else returns move_botleft (zipper which results from moving down and left in z) *)
<!--
let rec move_botleft (z : 'a zipper) : 'a zipper =
(* returns z if the targetted node in z has no children *)
(* else returns move_botleft (zipper which results from moving down and left in z) *)
<!--
+ let {level; filler} = z
in match filler with
| Leaf _ -> z
| Node(left, right) ->
in match filler with
| Leaf _ -> z
| Node(left, right) ->
- let zdown = {tree = Starring_Left {parent = tree; sibling = right}; filler = left}
+ let zdown = {level = Starring_Left {parent = level; sibling = right}; filler = left}
in move_botleft zdown
;;
-->
in move_botleft zdown
;;
-->
(* else returns move_right_or_up (result of moving up in z) *)
<!--
(* else returns move_right_or_up (result of moving up in z) *)
<!--
- let {tree; filler} = z
- in match tree with
- | Starring_Left {parent; sibling = right} -> Some {tree = Starring_Right {parent; sibling = filler}; filler = right}
+ let {level; filler} = z
+ in match level with
+ | Starring_Left {parent; sibling = right} -> Some {level = Starring_Right {parent; sibling = filler}; filler = right}
| Root -> None
| Starring_Right {parent; sibling = left} ->
| Root -> None
| Starring_Right {parent; sibling = left} ->
- let z' = {tree = parent; filler = Node(left, filler)}
+ let z' = {level = parent; filler = Node(left, filler)}
in move_right_or_up z'
;;
-->
in move_right_or_up z'
;;
-->
The following function takes an 'a tree and returns an 'a zipper focused on its root:
let new_zipper (t : 'a tree) : 'a zipper =
The following function takes an 'a tree and returns an 'a zipper focused on its root:
let new_zipper (t : 'a tree) : 'a zipper =
- {tree = Root; filler = t}
+ {level = Root; filler = t}
;;
Finally, we can use a mutable reference cell to define a function that enumerates a tree's fringe until it's exhausted:
;;
Finally, we can use a mutable reference cell to define a function that enumerates a tree's fringe until it's exhausted: