module type MultiSet_S = sig
  type 'a t
  val empty : 'a t
  val occurrences : 'a t -> 'a -> int
  val insert : 'a t -> 'a -> 'a t
  val remove : 'a t -> 'a -> 'a t
end

module MultiSet:MultiSet_S =
struct
  type 'a t = | Empty | Node of ('a * int * 'a t)

  let empty = Empty

  let rec occurrences c e =
    match c with
    | Empty -> 0
    | Node(elem, v, next) ->
      if e = elem
      then
        v
      else
        occurrences next e

  let rec insert c e =
    match c with
    | Empty -> Node(e, 1, Empty)
    | Node(elem, v, next) ->
      if elem = e
      then
        Node(elem, v + 1, next)
      else
        Node(elem, v, (insert next e))

  let rec remove c e =
    match c with
    | Empty -> Empty
    | Node(elem, v, next) ->
      if elem = e
      then
        if v > 1
        then
          Node(elem, v - 1, next)
        else
          next
      else
        Node(elem, v, (insert next e))
end

let explode s =
  let rec exp i l =
    if i < 0 then l else exp (i - 1) (s.[i] :: l) in
  exp (String.length s - 1) [];;

let letters word =
  let chars = explode word in
  List.fold_left (fun m c -> MultiSet.insert m c) MultiSet.empty chars;;

let anagram word1 word2 =
  let rec compare ms chars =
    match ms, chars with
    | MultiSet.Empty, []   -> true             (* Unbound constructor Empty)
    | MultiSet.Node (_, _, next), _ :: cs ->
      compare next cs
    | _ -> false in
  compare (letters word1) (explode word2);;