(*
// This file is for Assignment 2, BU CAS CS 520, Fall, 2009
//
// Instructor: Hongwei Xi (hwxi AT cs DOT bu DOT edu)
//
*)

(* ****** ****** *)

datasort bt = B of (bt, bt) | E of ()

(* ****** ****** *)

dataprop btsz (bt, int) =
  | {t1,t2:bt} {s1,s2:nat}
    btsz_B (B (t1, t2), 1 + s1 + s2) of (btsz (t1, s1), btsz (t2, s2))
  | btsz_E (E (), 0)
// end of [btsz]
  
prfun btsz_istot {t:bt} .<t>. (): [s:nat] btsz (t, s) =
  scase t of
  | B (t1, t2) => btsz_B (btsz_istot {t1} (), btsz_istot {t2} ())
  | E () => btsz_E ()
// end of [btsz_istot]
  
prfun btsz_isfun {t:bt} {s1,s2:nat} .<t>.
  (pf1: btsz (t, s1), pf2: btsz (t, s2)): [s1==s2] void =
  case+ pf1 of
  | btsz_B (pf11, pf12) => let
      prval btsz_B (pf21, pf22) = pf2
      prval () = btsz_isfun (pf11, pf21) and () = btsz_isfun (pf12, pf22)
    in
      // nothing
    end // end of [btsz_B]
  | btsz_E () => let prval btsz_E () = pf2 in () end
// end of [btsz_isfun]

(* ****** ****** *)

dataprop btht (bt, int) =
  | {t1,t2:bt} {h1,h2:nat}
    btht_B (B (t1, t2), 1 + max (h1, h2)) of (btht (t1, h1), btht (t2, h2))
  | btht_E (E (), 0)
// end of [btht]

prfun btht_isfun {t:bt} {h1,h2:nat} .<t>.
  (pf1: btht (t, h1), pf2: btht (t, h2)): [h1==h2] void =
  case+ (pf1, pf2) of
  | (btht_B (pf11, pf12), btht_B (pf21, pf22)) => let
      prval () = btht_isfun (pf11, pf21) and () = btht_isfun (pf12, pf22)
    in
      // nothing
    end // end of [btht_B, btht_B]
  | (btht_E (), btht_E ()) => ()
// end of [btht_isfun]

(* ****** ****** *)

dataprop POW2 (int, int) =
  | POW2bas (0, 1) | {n,p:nat} POW2ind (n+1, p+p) of POW2 (n, p)
// end of [POW2]

(* ****** ****** *)

dataprop isBraun (bt) =
  | {t1,t2:bt} {s1,s2:nat | s2 <= s1; s1 <= 1 + s2}
    isBraun_B (B (t1, t2)) of (isBraun t1, isBraun t2, btsz (t1, s1), btsz (t2, s2))
  | isBraun_E (E ()) of ()
// end of [isBraun]

(* ****** ****** *)

extern prfun brauntree_height_lemma {t1,t2:bt} {h,h1:nat}
  (pf0: isBraun (B (t1, t2)), pf1: btht (B (t1, t2), h), pf2: btht (t1, h1))
  : [h == h1+1] void

extern prfun brauntree_size_height_lemma {t:bt} {s,h,p:nat}
  (pf0: isBraun (t), pf1: btsz (t, s), pf2: btht (t, h), pf3: POW2 (h, p))
  : [p <= s + s + 1] void

(* ****** ****** *)

prfun lemma1 {t1,t2:bt}
 {s1,s2:nat | s1 >= s2} {h1,h2:nat} .<s2>. (
    pf1: isBraun t1, pf2: isBraun t2
  , pf1_sz: btsz (t1, s1), pf2_sz: btsz (t2, s2)
  , pf1_ht: btht (t1, h1), pf2_ht: btht (t2, h2)
  ) : [h1 >= h2] void = case+ pf2_sz of
  | btsz_B (pf21_sz, pf22_sz) => let
      prval btsz_B (pf11_sz, pf12_sz) = pf1_sz
      prval isBraun_B (pf11, pf12, pf11'_sz, pf12'_sz) = pf1
      prval isBraun_B (pf21, pf22, pf21'_sz, pf22'_sz) = pf2
      prval () = btsz_isfun (pf11_sz, pf11'_sz)
      prval () = btsz_isfun (pf12_sz, pf12'_sz)
      prval () = btsz_isfun (pf21_sz, pf21'_sz)
      prval () = btsz_isfun (pf22_sz, pf22'_sz)
      prval btht_B (pf11_ht, pf12_ht) = pf1_ht
      prval btht_B (pf21_ht, pf22_ht) = pf2_ht
      prval () = lemma1
        (pf11, pf21, pf11_sz, pf21_sz, pf11_ht, pf21_ht)
      prval () = lemma1
        (pf12, pf22, pf12_sz, pf22_sz, pf12_ht, pf22_ht)
    in
      // nothing
    end // end of [btsz_B]
  | btsz_E () => let
      prval btht_E () = pf2_ht in ()
    end // end of [btht_E]
// end of [lemma1]

implement brauntree_height_lemma (pf0, pf1, pf2) = let
  prval isBraun_B {t1,t2} {s1,s2} (pf01, pf02, pf1_sz, pf2_sz) = pf0
  prval btht_B {t1,t2} {h1,h2} (pf1_ht, pf2_ht) = pf1
  prval () = btht_isfun (pf2, pf1_ht)
  prval () = lemma1 (pf01, pf02, pf1_sz, pf2_sz, pf1_ht, pf2_ht)
in
  // nothing
end // end of [brauntree_height_lemma]

(* ****** ****** *)

prfun lemma2 {t:bt} {s:pos;h,n:nat} .<t>.
  (pf0: isBraun (t), pf1: btsz (t, s), pf2: btht (t, h), pf3: POW2 (h, n))
  : [n <= s + s] void = let
  val btsz_B (pf11, pf12) = pf1
  val isBraun_B (pf01, pf02, pf03, pf04) = pf0
  val () = btsz_isfun (pf03, pf11); val () = btsz_isfun (pf04, pf12)
  val btht_B (pf21, pf22) = pf2
  val POW2ind pf31 = pf3 // pf31: 2^(h-1) = n/2
in
  case+ pf11 of
  | btsz_B _ => let
      prval () = brauntree_height_lemma (pf0, pf2, pf21)
      prval () = lemma2 (pf01, pf11, pf21, pf31)
    in
      // empty
    end // end of [btsz_B]
  | btsz_E () => let
      prval btsz_E () = pf12
      prval btht_E () = pf21; prval btht_E () = pf22
      prval POW2ind (POW2bas ()) = pf3 // proving: 2^1 = 1+1
   in
     // empty
   end // end of [btsz_E]
end // end of [lemma2]

implement brauntree_size_height_lemma
  (pf0, pf1, pf2, pf3) = begin case+ pf1 of
  | btsz_E () => let
      prval btht_E () = pf2; prval POW2bas () = pf3 // 2^0 = 1
    in
      // empty
    end // end of [btsz_E]
  | btsz_B _ => lemma2 (pf0, pf1, pf2, pf3)
end // end of [brauntree_size_height_lemma]

(* ****** ****** *)

(* end of [brauntree_solution.dats] *)