by Tom Ellis on 4th April 2013
The best Haskell version of The ML Module example on Wikipedia that I could manage.
{-# Language Rank2Types #-}
data Queue queue = Queue { empty :: forall a. queue a
-- I'm leaving out the exception for simplicity
, isEmpty :: forall a. queue a -> Bool
, singleton :: forall a. a -> queue a
, insert :: forall a. (a, queue a) -> queue a
, peek :: forall a. queue a -> a
, remove :: forall a. queue a -> (a, queue a)
}
newtype TwoLists a = TL ([a], [a])
twolistqueue :: Queue TwoLists
twolistqueue = Queue { empty = TL ([], [])
, isEmpty = \x -> case x of TL ([], []) -> True
_ -> False
, singleton = \a -> TL ([a], [])
, insert = \(a, TL (ins, outs)) -> TL (a:ins, outs)
, peek = \x -> case x of TL ([], []) -> undefined
TL (ins, []) -> head (reverse ins)
TL (ins, a:outs) -> a
, remove = \x -> case x of TL ([], []) -> undefined
TL (ins, []) -> let newouts = reverse ins
in (head newouts, TL ([], tail newouts))
TL (ins, a:outs) -> (a, TL (ins, outs))
}
data Tree a = E | T a (Tree a) (Tree a)
(^.) :: a -> (a -> b) -> b
(^.) = flip ($)
btfQ :: (Queue queue) -> queue (Tree a) -> [a]
btfQ qq q = if (qq^.isEmpty) q then []
else let (t, q') = (qq^.remove) q
in case t of
E -> btfQ qq q'
T x l r -> let q'' = (qq^.insert) (r, (qq^.insert) (l, q'))
in x : btfQ qq q''
bft qq t = btfQ qq ((qq^.singleton) t)