BSTSort.hs

{-@ LIQUID "--typed-holes" @-}

module BSTSort where

import qualified Data.Set as S
import Language.Haskell.Liquid.Synthesize.Error


{-@ data BST [size] a = 
      Empty 
    | Node { x :: a, l :: BST { v: a | v < x }, r :: BST { v: a | x < v } } 
  @-}
data BST a = Empty | Node a (BST a) (BST a)

{-@ measure size @-}
{-@ size :: BST a -> Nat @-}
size :: BST a -> Int
size Empty        = 0
size (Node x l r) = 1 + size l + size r

{-@ measure bstElts @-}
{-@ bstElts :: BST a -> S.Set a @-}
bstElts :: Ord a => BST a -> S.Set a 
bstElts Empty = S.empty
bstElts (Node x l r) = S.union (S.singleton x) (S.union (bstElts l) (bstElts r))

{-@ insert :: x: a -> t: BST a -> { v: BST a | bstElts v == S.union (S.singleton x) (bstElts t) } @-}
insert :: Ord a => a -> BST a -> BST a
insert x t = 
    case t of 
        Empty -> Node x Empty Empty
        Node y l r -> 
            if x == y
                then t
                else if y <= x 
                        then Node y l (insert x r)
                        else Node y (insert x l) r

{-@ toBST :: xs: [a] -> { v: BST a | listElts xs == bstElts v } @-}
toBST :: Ord a => [a] -> BST a
toBST xs = 
    case xs of
        [] -> Empty
        x:xs' -> insert x (toBST xs')

{-@ data IList [iLen] a = N | ICons { x0 :: a, xs0 :: IList { v: a | x0 < v } } @-}
data IList a = N | ICons a (IList a)

{-@ measure iLen @-}
{-@ iLen :: IList a -> Nat @-}
iLen :: IList a -> Int
iLen N            = 0
iLen (ICons x xs) = 1 + iLen xs

{-@ measure iElts @-}
{-@ iElts :: IList a -> S.Set a @-}
iElts N            = S.empty
iElts (ICons x xs) = S.union (S.singleton x) (iElts xs)

{-@ pivotAppend :: p: a -> xs: IList { v: a | v < p } -> ys: IList { v: a | v > p } 
        -> { v: IList a | iLen v == iLen xs + iLen ys + 1 && 
                          iElts v == S.union (S.union (iElts xs) (iElts ys)) (S.singleton p) } 
  @-}
pivotAppend :: a -> IList a -> IList a -> IList a
pivotAppend p xs ys =
      case xs of
        N -> ICons p ys
        ICons x5 x6 -> ICons x5 (pivotAppend p x6 ys)

{-@ flatten :: t: BST a -> { v: IList a | iElts v == bstElts t } @-}
flatten :: BST a -> IList a 
flatten t = 
  case t of
    Empty -> N
    Node x4 x5 x6 -> pivotAppend x4 (flatten x5) (flatten x6)

{-@ sort' :: xs: [a] -> { v: IList a | iElts v == listElts xs } @-}
sort' :: Ord a => [a] -> IList a
sort' x_S1 = flatten (toBST x_S1)