module _ where open import level open import maybe open import eq open import nat open import nat-thms open import bool open import bool-thms open import product open import product-thms open import neq open import empty open import list open import list-thms max-comm : ∀ x y -> max x y ≡ max y x max-comm zero zero = refl max-comm zero (suc y) = refl max-comm (suc x) zero = refl max-comm (suc x) (suc y) rewrite max-suc y x | max-suc x y | max-comm x y = refl max-<2' : ∀ {n u} -> n ≤ max u n ≡ tt max-<2' {n} {u} rewrite max-comm u n = max-<1{n}{u} suc-< : ∀ x y -> x < y ≡ tt -> x < suc y ≡ tt suc-< zero zero x 0 < y ≡ ff -> y ≡ 0 <ℕff zero 0 x < y ≡ tt -> suc x < y ≡ ff -> suc x ≡ y <<-tt-ff-≡ zero zero () <<-tt-ff-≡ zero (suc y) x x < y ≡ ff -> suc x < y ≡ tt -> x ≡ y <<-ff-tt-≡ zero zero x x < suc x ≡ tt x max x y ≤ max (suc x) y ≡ tt max-sucr x y with keep (x < y) max-sucr x y | tt , x l ≤ l' ≡ tt -> max l r ≤ max l' r ≡ tt max-mono1 zero zero zero l≤l' = refl max-mono1 zero zero (suc r) l≤l' rewrite =ℕ-refl r = ||-tt (r < r) max-mono1 zero (suc l') zero l≤l' = refl max-mono1 zero (suc l') (suc r) l≤l' = ≤-trans {max zero (suc r)} {max l' (suc r)} {max (suc l') (suc r)} (max-mono1 zero l' (suc r) (0-≤ l')) (max-sucr l' (suc r)) max-mono1 (suc l) zero r () max-mono1 (suc l) (suc l') zero l≤l' = l≤l' max-mono1 (suc l) (suc l') (suc r) l≤l' rewrite max-suc l r | max-suc l' r | max-mono1 l l' r l≤l' = refl maxlbl : ∀ m n -> n < m ≡ tt -> max m n ≡ m maxlbl zero zero n n < m ≡ ff -> min m n ≡ m minubl zero zero n ℕ -> Set where leaf : ∀ {n m} -> {n≤m : n ≤ m ≡ tt} -> BST n m node : ∀ {l' l u' u} -> (n : ℕ) -> (left : BST l' n) -> (right : BST n u') -> {l≤l' : l ≤ l' ≡ tt} -> {u'≤u : u' ≤ u ≡ tt} -> BST l u rewritebounds : ∀ l l' u u' -> l ≡ l' -> u ≡ u' -> BST l u -> BST l' u' rewritebounds l l' u u' refl refl bst = bst insert : ∀ {l u} -> BST l u -> (n : ℕ) -> BST (min l n) (max u n) insert {l} {u} (node m left right) n with keep (n < m) insert {l} {u} (node {l'} {u' = u'} m left right {l≤l'} {u'≤u}) n | tt , n BST l u -> ℕ -> 𝔹 lookup leaf m = ff lookup (node n left right) m with n =ℕ m lookup (node n left right) m | tt = tt lookup (node n left right) m | ff with n < m ... | tt = lookup right m ... | ff = lookup left m