data Heap = Node {-# UNPACK #-} !Int {-# UNPACK #-} !(Heap) {-# UNPACK #-} !(Heap) | None

instance Show(Heap) where
    show None = ""
    show (Node a l r) = "("++(show a)++":"++(show l)++","++(show r)++")"

makeUnHeap k n = if k >= n
                 then None
                 else Node k (makeUnHeap (2*k+1) n) (makeUnHeap (2*k+2) n)

pushDown None = None
pushDown (Node a None None) = Node a None None
pushDown (Node a None (Node b l r)) = if a >= b then Node a None (Node b l r)
                                    else Node b None (pushDown(Node a l r))
pushDown (Node a (Node b l r) None) = if a >= b then Node a (Node b l r) None
                                    else Node b (pushDown(Node a l r)) None
pushDown (Node a (Node b l r) (Node c h s)) = if a >= b && a >= c
                                            then Node a (Node b l r) (Node c h s)
                                            else (if b >= c && b >= a
                                                  then Node b (pushDown(Node a l r)) (Node c h s)
                                                  else Node c (Node b l r) (pushDown(Node a h s))
                                                 )

buildHeap None = None
buildHeap (Node a l r) = pushDown(Node a (buildHeap l) (buildHeap r) )

{- Too slow!

_popElem :: Ord a => Heap a -> [Bool] -> (Heap a, a)
_popElem (Node a l r) [] = (None, a)
_popElem (Node a l r) (f:tail) = if f
                                 then (let (nh,e) = _popElem r tail
                                       in (Node a l nh, e))
                                 else (let (nh,e) = _popElem l tail
                                       in (Node a nh r, e))

_path :: Integer -> [Bool]
_path 0 = []
_path n = even n : _path ( quot (n-1) 2 )

popLast :: Ord a => Heap a -> Integer -> (Heap a, a)
popLast h n = _popElem h (reverse (_path (n - 1)))
-}

popEny (Node a None None) = (None, a)
popEny (Node a None r) = (Node a None nh, e)
                         where (nh, e) = popEny r
popEny (Node a l r) = (Node a nh r, e)
                         where (nh, e) = popEny l


changeHead (Node a l r) b = Node b l r

getRSorted None 0 = []
getRSorted (Node a l r) 1 = [a]
getRSorted (Node a l r) n = a : getRSorted ( pushDown(changeHead nh e) ) (n - 1)
                            where (nh, e) = popEny (Node a l r)
--                            where (nh, e) = popLast (Node a l r) n

getSorted h n = reverse(getRSorted h n)

main :: IO ()
main = let n = 1000000
       in putStrLn ( if ([0..n-1] == (getSorted(buildHeap(makeUnHeap 0 n)) n))
                     then "OK"
                     else "FAIL"
                   )