Source file BwdNoLabels.ml

type 'a t = 'a BwdDef.bwd =
  | Emp
  | Snoc of 'a t * 'a

let length xs =
  let rec go acc =
    function
    | Emp -> acc
    | Snoc (xs, _) -> (go[@tailcall]) (acc+1) xs
  in
  go 0 xs

let compare_lengths xs ys =
  let rec go =
    function
    | Emp, Emp -> 0
    | Snoc _, Emp -> 1
    | Emp, Snoc _ -> -1
    | Snoc (xs, _), Snoc (ys, _) ->
      (go[@tailcall]) (xs, ys)
  in go (xs, ys)

let compare_length_with xs len =
  let rec go len =
    function
    | Emp -> Int.compare 0 len
    | Snoc (xs, _) ->
      (go[@tailcall]) (len-1) xs
  in go len xs

let snoc l x = Snoc (l, x)

let nth xs i =
  if i < 0 then
    invalid_arg "Bwd.nth"
  else
    let rec go =
      function
      | Emp, _ -> failwith "Bwd.nth"
      | Snoc (_, x), 0 -> x
      | Snoc (xs, _), i -> (go[@tailcall]) (xs, i - 1)
    in go (xs, i)

let nth_opt xs i =
  if i < 0 then
    invalid_arg "Bwd.nth_opt"
  else
    let rec go =
      function
      | Emp, _ -> None
      | Snoc (_, x), 0 -> Some x
      | Snoc (xs, _), i -> (go[@tailcall]) (xs, i - 1)
    in go (xs, i)

let append xs ys =
  let rec go =
    function
    | xs, [] -> xs
    | xs, y :: ys ->
      (go[@tailcall]) (Snoc (xs, y), ys)
  in go (xs, ys)

let prepend xs ys =
  let rec go =
    function
    | Emp, ys -> ys
    | Snoc (xs, x), ys ->
      (go[@tailcall]) (xs, x :: ys)
  in go (xs, ys)

let equal eq xs ys =
  let rec go =
    function
    | Emp, Emp -> true
    | Snoc (xs, x), Snoc (ys, y) ->
      eq x y && (go[@tailcall]) (xs, ys)
    | _ -> false
  in go (xs, ys)

let compare cmp xs ys =
  let rec go =
    function
    | Emp, Emp -> 0
    | Emp, _ -> -1
    | _, Emp -> 1
    | Snoc (xs, x), Snoc (ys, y) ->
      let c = cmp x y in
      if c <> 0 then c else (go[@tailcall]) (xs, ys)
  in go (xs, ys)

let iter f =
  let rec go =
    function
    | Emp -> ()
    | Snoc (xs, x) ->
      f x; (go[@tailcall]) xs
  in go

let iteri f =
  let[@tail_mod_cons] rec go i =
    function
    | Emp -> ()
    | Snoc (xs, x) ->
      f i x; (go[@tailcall]) (i + 1) xs
  in go 0

let map f =
  let[@tail_mod_cons] rec go =
    function
    | Emp -> Emp
    | Snoc (xs, x) -> let y = f x in Snoc ((go[@tailcall]) xs, y)
  in go

let mapi f =
  let[@tail_mod_cons] rec go i =
    function
    | Emp -> Emp
    | Snoc (xs, x) -> let y = f i x in Snoc ((go[@tailcall]) (i + 1) xs, y)
  in
  go 0

let filter_map f =
  let[@tail_mod_cons] rec go =
    function
    | Emp -> Emp
    | Snoc (xs, x) ->
      match f x with
      | None -> go xs
      | Some fx -> Snoc ((go[@tailcall]) xs, fx)
  in go

let fold_left f init =
  let rec go =
    function
    | Emp -> init
    | Snoc (xs, x) ->
      f (go xs) x
  in go

let fold_right_map f xs init =
  let rec go init =
    function
    | Emp -> init, Emp
    | Snoc (xs, x) ->
      let init, y = f x init in
      let z, ys = go init xs in
      z, Snoc (ys, y)
  in go init xs

let fold_right f xs init =
  let rec go init =
    function
    | Emp -> init
    | Snoc (xs, x) ->
      let init = f x init in
      (go[@tailcall]) init xs
  in go init xs

let iter2 f xs ys =
  let rec go =
    function
    | Emp, Emp -> ()
    | Snoc (xs, x), Snoc (ys, y) -> f x y; go (xs, ys)
    | _ -> invalid_arg "Bwd.iter2"
  in go (xs, ys)

let map2 f xs ys =
  let[@tail_mod_cons] rec go =
    function
    | Emp, Emp -> Emp
    | Snoc (xs, x), Snoc (ys, y) ->
      let z = f x y in Snoc ((go[@tailcall]) (xs, ys), z)
    | _ -> invalid_arg "Bwd.map2"
  in go (xs, ys)

let fold_left2 f init xs ys =
  let rec go =
    function
    | Emp, Emp -> init
    | Snoc (xs, x), Snoc (ys, y) ->
      f (go (xs, ys)) x y
    | _ -> invalid_arg "Bwd.fold_left2"
  in go (xs, ys)

let fold_right2 f xs ys init =
  let rec go init =
    function
    | Emp, Emp -> init
    | Snoc (xs, x), Snoc (ys, y) ->
      let init = f x y init in
      (go[@tailcall]) init (xs, ys)
    | _ -> invalid_arg "Bwd.fold_right2"
  in
  go init (xs, ys)

let for_all f =
  let rec go =
    function
    | Emp -> true
    | Snoc (xs, x) ->
      f x && (go[@tailcall]) xs
  in go

let for_all2 f xs ys =
  let rec go =
    function
    | Emp, Emp -> true
    | Snoc (xs, x), Snoc (ys, y) ->
      f x y && (go[@tailcall]) (xs, ys)
    | _ -> invalid_arg "Bwd.for_all2"
  in go (xs, ys)

let exists f =
  let rec go =
    function
    | Emp -> false
    | Snoc (xs, x) ->
      f x || (go[@tailcall]) xs
  in go

let exists2 f xs ys =
  let rec go =
    function
    | Emp, Emp -> false
    | Snoc (xs, x), Snoc (ys, y) ->
      f x y || (go[@tailcall]) (xs, ys)
    | _ -> invalid_arg "Bwd.exists2"
  in go (xs, ys)

let mem a set =
  let rec go =
    function
    | Emp -> false
    | Snoc (xs, x) ->
      a = x || (go[@tailcall]) xs
  in go set

let memq a set =
  let rec go =
    function
    | Emp -> false
    | Snoc (xs, x) ->
      a == x || (go[@tailcall]) xs
  in go set

let find f =
  let rec go =
    function
    | Emp -> raise Not_found
    | Snoc (xs, x) ->
      if f x then x else go xs
  in go

let find_opt f =
  let rec go =
    function
    | Emp -> None
    | Snoc (xs, x) ->
      if f x then Some x else go xs
  in go

let find_map f =
  let rec go =
    function
    | Emp -> None
    | Snoc (xs, x) ->
      match f x with
      | Some y -> Some y
      | None -> go xs
  in go

let filter f =
  let[@tail_mod_cons] rec go =
    function
    | Emp -> Emp
    | Snoc (xs, x) ->
      if f x then
        Snoc ((go[@tailcall]) xs, x)
      else
        (go[@tailcall]) xs
  in go

let find_all f = filter f

let filteri f =
  let[@tail_mod_cons] rec go i =
    function
    | Emp -> Emp
    | Snoc (xs, x) ->
      if f i x then
        Snoc ((go[@tailcall]) (i + 1) xs, x)
      else
        (go[@tailcall]) (i + 1) xs
  in go 0

let partition f =
  let rec go =
    function
    | Emp -> Emp, Emp
    | Snoc (xs, x) ->
      if f x then
        let ys, zs = go xs in
        Snoc (ys, x), zs
      else
        let ys, zs = go xs in
        ys, Snoc (zs, x)
  in go

let partition_map f =
  let rec go =
    function
    | Emp -> Emp, Emp
    | Snoc (xs, x) ->
      match f x with
      | Either.Left y ->
        let ys, zs = go xs in
        Snoc (ys, y), zs
      | Either.Right z ->
        let ys, zs = go xs in
        ys, Snoc (zs, z)
  in go

let rec split =
  function
  | Emp -> Emp, Emp
  | Snoc (xys, (x, y)) ->
    let xs, ys = split xys in
    Snoc (xs, x), Snoc (ys, y)

let combine xs ys =
  let[@tail_mod_cons] rec go =
    function
    | Emp, Emp -> Emp
    | Snoc (xs, x), Snoc (ys, y) ->
      Snoc (go (xs, ys), (x, y))
    | _ -> invalid_arg "Bwd.combine"
  in go (xs, ys)

let to_list xs =
  prepend xs []

let of_list xs =
  append Emp xs

module Infix =
struct
  let (#<) = snoc
  let (<><) = append
  let (<>>) = prepend
end

module Notation = Infix