Source file treeContext.ml

open UtilsLib

module Tree =
struct
  type 'a tree = Node of ('a * 'a tree list)
                         
  let rec pp ppf fmt t = 
    match t with
    | Node (v, []) -> Format.fprintf fmt "@[%a@]" ppf v
    | Node (v, children) ->
      Format.fprintf
        fmt
        "@[%a @[<v>%a@]@]"
        ppf
        v
        (PPUtils.pp_list ~sep:"@;" (fun fmt t -> Format.fprintf fmt "@[-- @[%a@]@]" (pp ppf) t))
        children
        
  let rec fold_depth_first ((transform, apply) as f) t =
    match t with
    | Node (v, []) -> transform v
    | Node (v, children) ->
      List.fold_left
        (fun acc child -> apply acc (fold_depth_first f child))
        (transform v)
        children

  let label (Node (a, _)) = a
    
end

  

module TreeContext =
struct
  type 'a t =
    | Top
    | Zipper of ('a * 'a Tree.tree ListContext.focused_list * 'a t)
                
  
  type 'a focused_tree = 'a t * 'a Tree.tree

  type direction = | Up | Down [@warning "-unused-constructor"] | Right [@warning "-unused-constructor"]

  exception Move_failure of direction

  let up = function
    | Top, _ -> raise (Move_failure Up)
    | Zipper (label, (elders, youngers), z), t -> z, Tree.Node (label, ListContext.zip_up elders (t::youngers))

end