[Haskell-cafe] Dynamic choice of "reverse" implementation
Ryan Ingram
ryani.spam at gmail.com
Fri Sep 28 18:08:10 EDT 2007
Here's the problem:
> In my oppinion reversor would have type
>
> > reversor :: (Foldable f) => [a] -> f a
The type of reversor you state is equivalent to
forall f a. (Foldable f) => [a] -> f a
but reverseList has the type
forall a. [a] -> [a]
and reverseSeq has the type
forall a. [a] -> Seq a
What you mean instead is
forall a. exists f. (Foldable f) => [a] -> f a
but that type isn't directly supported in Haskell. Instead, you need
to wrap it in an existential constructor:
> {-# LANGUAGE ExistentialQuantification #-}
> module Main where
> import Prelude hiding (foldr, foldr1, reverse, mapM_)
> import System.Environment
> import Data.List hiding (foldr, foldr1)
> import Data.Foldable
> import Data.Traversable
> import Data.Sequence
>
> data Rev a = forall f. Foldable f => Rev ([a] -> f a)
in this case,
Rev :: forall f a. Foldable f => ([a] -> f a) -> Rev a
Once you have this, the rest of the implementation is pretty simple:
> mkReversor :: [String] -> Rev a
> mkReversor ["sequence"] = Rev reverseSeq
> mkReversor ["list"] = Rev reverseList
> mkReversor _ = error "bad args"
> reverseList :: [a] -> [a]
> reverseList = Data.List.reverse
> reverseSeq :: [a] -> Seq a
> reverseSeq = foldr (<|) empty
> main = do
> args <- getArgs
> (Rev reversor) <- return (mkReversor args)
> input <- getContents
> let output = reversor $ lines $ input
> mapM_ putStrLn output
This line is particularily interesting:
(Rev reversor) <- return (mkReversor args)
Replacing it with the more obvious
let reversor = mkReversor args
causes the best error message in the history of compilers:
My brain just exploded.
I can't handle pattern bindings for existentially-quantified constructors.
The reason why the "<- return" construct works is because it desugars
differently (and more strictly):
return (mkReversor args) >>= \r ->
case r of
(Rev reversor) -> do (rest of do block)
_ -> fail "Pattern match failure"
which binds the type of reversor in a case statement; Simon
Peyton-Jones says it's not obvious how to write a typing rule for
let-bindings.
-- ryan
More information about the Haskell-Cafe
mailing list