Prelude> :reload
Compiling XBar ( /nfs/isd/hdaume/projects/XBar/XBar.hs,
interpreted )
ghc-5.02.1: panic! (the `impossible' happened, GHC version 5.02.1):
TcGenDeriv:mk_FunMonoBind
Please report it as a compiler bug to [EMAIL PROTECTED],
or http://sourceforge.net/projects/ghc/.
This happened immediately after I change line 35 in the attached program
from:
data DummyHead
to
data DummyHead deriving (Show, Eq)
I wasn't sure whether it would allow me to derive instances on a datatype
with no constructors...I know this was recently added and I guess all the
bugs haven't been worked out. I'm using the solaris build of ghc.
--
Hal Daume III
"Computer science is no more about computers | [EMAIL PROTECTED]
than astronomy is about telescopes." -Dijkstra | www.isi.edu/~hdaume
module XBar
where
data IsHead x => XP x = forall y . IsHead y => XP (Maybe (XP y)) (X' x)
data IsHead x => X' x = forall y . IsHead y => X' (X x) (Maybe (XP y))
| forall y . IsHead y => X'L (XP y) (X' x)
| forall y . IsHead y => X'R (X' x) (XP y)
data IsHead x => X x = X x
data Tree = Branch String [Tree]
| Leaf String
class HasHead t h where
getHead :: t -> h
instance HasHead (XP x) (X' x) where
getHead (XP _ head) = head
instance HasHead (X' x) (X x) where
getHead (X' head _) = head
getHead (X'L _ x) = getHead x
getHead (X'R x _) = getHead x
class (Show x, Eq x) => IsHead x where
headType :: x -> String -- should ignore it's argument
headString :: x -> String
headString = headType
data N = N String deriving (Show, Eq)
data V = V String deriving (Show, Eq)
data D = D String deriving (Show, Eq)
data I = I String deriving (Show, Eq)
data DummyHead deriving (Show, Eq)
instance IsHead N where { headString _ = "N" }
instance IsHead V where { headString _ = "V" }
instance IsHead D where { headString _ = "D" }
instance IsHead I where { headString _ = "I" }
instance IsHead x => Show (XP x) where
show _ = (headString (undefined :: x)) ++ "P"
instance IsHead x => Show (X' x) where
show _ = (headString (undefined :: x)) ++ "'"
instance IsHead x => Show (X x) where
show _ = (headString (undefined :: x)) ++ "0"
class ShowTree a where
showTree :: a -> Tree
instance IsHead x => ShowTree (XP x) where
showTree x@(XP (Just spec) proj) = Branch (show x) [showTree spec, showTree proj]
showTree x@(XP Nothing proj) = Branch (show x) [showTree proj]
instance IsHead x => ShowTree (X' x) where
showTree x@(X' head (Just arg)) = Branch (show x) [showTree head, showTree arg]
showTree x@(X' head Nothing ) = Branch (show x) [showTree head]
showTree x@(X'L adj proj) = Branch (show x) [showTree adj, showTree proj]
showTree x@(X'R proj adj) = Branch (show x) [showTree proj, showTree adj]
instance IsHead x => ShowTree (X x) where
showTree x@(X head) = Branch (show x) [Leaf (show head)]
instance Show Tree where
show (Branch name clist) = "[." ++ name ++ " " ++ unwords (map show clist) ++ " ]"
show (Leaf head) = head
-- now the code to build trees
mergeArgument :: (IsHead x, IsHead y) => X x -> XP y -> X' x
mergeArgument head arg = X' head (Just arg)
--projectHead :: (IsHead x, IsHead y) => X x -> X' x
projectHead head = X' head (Nothing)
mergeAdjunctR :: (IsHead x, IsHead y) => X' x -> XP y -> X' x
mergeAdjunctR proj adj = X'R proj adj
mergeAdjunctL :: (IsHead x, IsHead y) => XP y -> X' x -> X' x
mergeAdjunctL adj proj = X'L adj proj
mergeSpec :: (IsHead x, IsHead y) => XP y -> X' x -> XP x
mergeSpec spec proj = XP (Just spec) proj
projectFull :: IsHead x => X' x -> XP x
projectFull proj = XP Nothing proj
