Source file listContext.ml

type 'a t = 'a list
let empty = []
            
let is_empty = function
  | [] -> true
  | _ -> false
    
let push elt ctx = elt :: ctx
                   
let size = List.length
               
type 'a focused_list = 'a t * 'a list
                         
type direction = Right | Left
exception Move_failure of direction
    
let rec forward ?(step=1) =
  function
  | f_l when step = 0 -> f_l
  | ctx, h :: tl when step > 0 -> forward ~step:(step - 1) ((h :: ctx), tl)
  | _, [] when step > 0 -> raise (Move_failure Right)
  (* n is negative *)
  | h :: ctx, l -> forward ~step:(step + 1) (ctx, h :: l)
  | [], _ -> raise (Move_failure Left)
               
let right f_l = forward ~step:1 f_l
    
let left f_l = forward ~step:(-1) f_l
    
let rec zip_up ctx l =
  match ctx, l with
  | [], _ -> l
  | elt::c, _ -> zip_up c (elt :: l)
                   
let fold focused_list f acc =
  let rec fold_aux (c, l) acc =
    let new_acc = f (c, l) acc in
    match l with
    | [] -> new_acc
    | elt :: tl -> fold_aux (elt::c, tl) new_acc in
  fold_aux focused_list acc
    
let full_left (ctx, l) =
  [], zip_up ctx l
    
let forward_insert elt (c, l) = (c, elt :: l)
let backward_insert elt (c, l) = (elt :: c, l)
                                 
let nth_context n l =
  let rec nth_context_aux n ctx = function
    | [] -> raise (Move_failure Right)
    | elt :: tl ->
      if n = 1 then
        ((ctx, tl), elt)
      else
        nth_context_aux (n-1) (elt :: ctx) tl in
  nth_context_aux n [] l