alist.ml

type (_, _) eq =
  | Eq : ('a, 'a) eq
  | NEq : (_, _) eq

module type Eq = sig
  type 'a key
  type 'a value
  val eq : 'a key -> 'b key -> ('a, 'b) eq
end

module Make (E : Eq) = struct
  type 'a key = 'a E.key
  type 'a value = 'a E.value
  type t = Nil | Cons : 'a key * 'a value * t -> t

  let rec mem : type a . a key -> t -> bool =
    fun key -> function
      | Nil -> false
      | Cons (k, _, rest) ->
        match E.eq key k with
        | NEq -> mem key rest
        | Eq -> true

  let length list =
    let rec count len = function
      | Nil -> len
      | Cons (_, _, rest) -> count (len + 1) rest in
    count 0 list

  let rec find : type a . a key -> t -> a value option =
    fun key -> function
      | Nil -> None
      | Cons (k, v, rest) ->
        match E.eq key k with
        | NEq -> find key rest
        | Eq -> Some v

  let rec append a b = match a with
    | Nil -> b
    | Cons (k, v, rest) -> Cons (k, v, append rest b)

  let rec fold_broken f init = function
    | Nil -> init
    | Cons (k, v, rest) -> fold_broken f (f k v init) rest

  type 'a polymorphic_op = {
    f : 'b . 'b key -> 'b value -> 'a;
  }

  let rec fold f init = function
    | Nil -> init
    | Cons (k, v, rest) -> fold f (f.f k v init) rest
end