(*
 *  Principi di Linguaggi di Programmazione
 *  Modulo Paradigmi
 *
 *  Appello IV: 25/06/2013
 *  Esercizio 2
 *)

module type ITREE =
  sig
    type 'a tree
    val newEmpty: 'a tree
    val newVertex: 'a -> 'a tree
    val addEdge: 'a tree -> 'a -> 'a -> 'a tree
    val sons: 'a tree -> 'a -> 'a tree list
  end;;

module ITree:ITREE =
  struct
    open List
    type 'a tree = Empty | Node of 'a * 'a tree list

    let newEmpty = Empty
    let newVertex a = Node(a, [])

    let inList l r =
      let f x y =
        match y with
        | true -> true
        | false -> (
          match x with
          | Node(v, _) when v = r -> true
          | _ -> false
        )
      in List.fold_right f l false

    let rec addEdge t r s =
      match t with
      | Empty -> raise (Failure "Error")
      | Node(x, l) when x = r -> (
        if inList (sons r) s
          then raise (Failure "Error")
          else Node(x, (newVertex s)::l)
        )
      | Node(x, l) -> Node(x, List.map (fun x -> addEdge x r s) l)

    let rec sons t r =
      let f x = sons x r
      match t with
      | Empty -> []
      | Node(x, l) when x = r -> l
      | Node(x, l) -> List.flatten (List.map f l)
  end;;