[Haskell] Re: help with some basic code that doesn't work
kahl at cas.mcmaster.ca
kahl at cas.mcmaster.ca
Mon Feb 14 00:56:38 EST 2005
Shin-Cheng Mu <scm at ipl.t.u-tokyo.ac.jp> wrote:
>
> Occasionally I would need to define recursive datatypes
> using an explicit fixed-point operator, such as:
>
> > data Fix f = In (f (Fix f)) deriving (Show, Eq)
> > data L a x = Nil | Cons a x deriving (Show, Eq)
>
> However, Haskell was not able to derive from Fix f any
> instances. The following is what happens in GHCi:
>
> *Main> In Nil == In Nil
>
> Context reduction stack overflow; size = 21
[...]
>
> > Instance Show (f (Fix f)) => Show (Fix f) where
> > showsPrec _ (In x) = ("In ("++) . showsPrec 1 x . (')':)
>
> This is rather unsatisfactory, because I would not be able
> to inspect values of type Fix f in the interpreter. Is there
> a way to get around this?
You have to tie the knot yourself --- unfortunately this involves
re-coding the instance functors behind ``deriving''.
I did this last summer for demonstration purposes ---
you need only -fglasgow-exts for the ``deep instance'':
\begin{code}
module Fix where
data Fix f = F (f (Fix f))
data L a b = L (Maybe (a,b))
deriving Show
oParen = ('(' :)
cParen = (')' :)
parens shows = oParen . shows . cParen
mkShowsPair showsA showsB (a,b) = parens $ showsA a . (", " ++) . showsB b
mkShowsMaybe showsA Nothing = ("Nothing" ++)
mkShowsMaybe showsA (Just a) = parens $ ("Just " ++) . showsA a
mkShowsL showsA showsB (L m) = parens $
("L " ++) . mkShowsMaybe (mkShowsPair showsA showsB) m
mkShowsFix :: ((Fix f -> ShowS) -> (f (Fix f) -> ShowS)) ->
(Fix f -> ShowS)
mkShowsFix mkShowsF = showsF
where
showsF (F x) = parens $ ("F " ++) . mkShowsF showsF x
showsFL :: (Show a) => Fix (L a) -> ShowS
showsFL = mkShowsFix (mkShowsL shows)
instance (Show a) => Show (Fix (L a)) where
showsPrec _ = showsFL
flEmpty = F (L Nothing)
flCons x xs = F (L (Just (x,xs)))
infixr 5 `flCons`
\end{code}
Wolfram
More information about the Haskell
mailing list