{-# OPTIONS_GHC -O2 -fasm              #-}
{-# LANGUAGE BangPatterns              #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
module BreadthFirstSearch where

import BinaryTree
import qualified Control.Monad.Queue.Allison  as A
import qualified Control.Monad.Queue.Corec    as C
import qualified Control.Monad.Queue.ST       as STQ
import qualified CpSt
import qualified SideChannelQ                 as SCQ
import qualified Data.Queue.TwoStack          as Two
import qualified Data.Queue.Okasaki           as Oka
import Data.Sequence
import qualified Data.Sequence as Seq

isBranch = labelDisj (const False) (const True)

direct ::  Tree a b  ->  [Tree a b]
direct     tree      =   queue
  where
    queue  | isBranch tree   = tree :  explore 1 queue
           | otherwise       =         explore 0 queue

    explore :: Int -> [Tree a b] -> [Tree a b]
    explore  0 _ = []
    explore  (n+1) (Branch _ l r : head')
      =  if (isBranch  l)
         then   if (isBranch r)
                then   l :  r :  explore  (  n+2)  head'
                else   l :       explore  (  n+1)  head'
         else   if (isBranch r)
                then        r :  explore  (  n+1)  head'
                else             explore     n     head'

allison tree = A.runQueue (handle tree >> explore)
  where
    handle t@(Leaf   _      ) = return ()
    handle t@(Branch _ _ _  ) = A.enQ t

    explore = do
      branch <- A.deQ
      case branch of
        Nothing -> return ()
        (Just (Branch _ !l !r)) -> handle l >> handle r >> explore


allison2  tree = A.runQueue (handle tree >> explore)
  where
    handle t@(Leaf   _      ) = return ()
    handle t@(Branch _ _ _  ) = A.enQ t

    explore = do
      (Branch _ !l !r) <- A.deQ_break
      handle l
      handle r
      explore


stq tree = STQ.runResult (handle tree >> explore)
  where
    handle t@(Leaf   _      ) = return ()
    handle t@(Branch _ _ _  ) = STQ.enQ t

    explore = do
      branch <- STQ.deQ
      case branch of
        Nothing -> return ()
        (Just (Branch _ !l !r)) -> handle l >> handle r >> explore

corec1   tree = case C.runResultQueue (handle tree >> explore) of
                 (_,q) -> q
  where

    handle t@(Leaf   _      ) = return ()
    handle t@(Branch _ _ _  ) = C.enQ t

    explore = do
      branch <- C.deQ
      case branch of
        Nothing -> return ()
        (Just (Branch _ !l !r)) -> handle l >> handle r >> explore



corec2   tree = case C.runResultQueue (handle tree >> explore) of
                  ((),q) -> q
  where
    handle t@(Leaf   _      ) = return ()
    handle t@(Branch _ _ _  ) = C.enQ t

    explore = do
      branch <- C.deQ
      case branch of
        Nothing -> return ()
        (Just (Branch _ !l !r)) -> handle l >> handle r >> explore

sidechan1 tree
    = case SCQ.runResultQueue (handle tree >> explore) of
        (_,q) -> q
  where
    handle t@(Leaf   _      ) = return ()
    handle t@(Branch _ _ _  ) = SCQ.enQ t

    explore = do
      branch <- SCQ.deQ
      case branch of
        Nothing -> return ()
        (Just (Branch _ !l !r)) -> handle l >> handle r >> explore



sidechan2 tree
    = case SCQ.runResultQueue (handle tree >> explore) of
       ((),q) -> q
  where
    handle t@(Leaf   _      ) = return ()
    handle t@(Branch _ _ _  ) = SCQ.enQ t

    explore = do
      branch <- SCQ.deQ
      case branch of
        Nothing -> return ()
        (Just (Branch _ !l !r)) -> handle l >> handle r >> explore



twostack t = loop (handle t Two.empty)
  where
    handle t@(Leaf   _    ) q = q
    handle t@(Branch _ _ _) q = Two.enque t q

    loop q = case Two.deque q of
               (Nothing, q') ->  ()
               (Just (Branch _ !l !r), q') -> loop (handle r (handle l q'))


twostack_cpst tree = CpSt.runResult (handle tree >> explore)
  where
    handle t@(Leaf   _      ) = return ()
    handle t@(Branch _ _ _  ) = CpSt.enQ t

    explore = do
      branch <- CpSt.deQ
      case branch of
        Nothing -> return ()
        (Just (Branch _ !l !r)) -> handle l >> handle r >> explore


twostack_list t = loop (handle t Two.empty)
  where
    handle t@(Leaf   _    ) q = q
    handle t@(Branch _ _ _) q = Two.enque t q

    loop q = case Two.deque q of
               (Nothing, q') ->  []
               (Just t@(Branch _ !l !r), q') -> t : loop (handle r (handle l q'))

okasaki t = loop (handle t Oka.empty)
  where
    handle t@(Leaf   _    ) q = q
    handle t@(Branch _ _ _) q = Oka.enque t q

    loop q = case Oka.deque q of
               (Nothing, q') ->  ()
               (Just (Branch _ !l !r), q') -> loop (handle r (handle l q'))


okasaki_list t = loop (handle t Oka.empty)
  where
    handle t@(Leaf   _    ) q = q
    handle t@(Branch _ _ _) q = Oka.enque t q

    loop q = case Oka.deque q of
               (Nothing, q') ->  []
               (Just t@(Branch _ !l !r), q') -> t:loop (handle r (handle l q'))

sequence t = loop (handle t empty)
  where
    handle t@(Leaf   _    ) q = q
    handle t@(Branch _ _ _) q = q |> t

    loop q = case viewl q of
               EmptyL -> ()
               (Branch _ !l !r) :< q' -> loop (handle r (handle l q'))

sequence_list t = loop (handle t empty)
  where
    handle t@(Leaf   _    ) q = q
    handle t@(Branch _ _ _) q = q |> t

    loop q = case viewl q of
               EmptyL -> []
               t@(Branch _ !l !r) :< q' -> t:loop (handle r (handle l q'))

sequence2 t = loop (Seq.singleton t)
   where
   handle t@(Leaf   _     ) q = q
   handle t@(Branch _ _ _ ) q = q |> t

   loop q | Seq.null q = ()
          | otherwise  = case Seq.index q 0 of
                           x@(Branch _ l r) -> loop (handle r (handle l (Seq.drop 1 q)))