very strange behavior (crashes!) with Dynamics
Hal Daume
t-hald at microsoft.com
Thu Aug 14 15:37:07 EDT 2003
First, I apologize for the length of this message. Unfortunately, I
cannot whittle this down to a smaller example.
I'm dealing with parse trees, whose datatype looks like:
> data AnnTree a
> = Term { treeTag :: PackedString, treeText :: PackedString ,
treeAnn :: a }
> | NonTerm { treeTag :: PackedString, treeChildren :: [AnnTree a],
treeAnn :: a }
> deriving (Eq, Ord)
In particular, I parameterize these over a DynamicMap datatype, which
looks like:
> import Data.Dynamic
> type DynamicMap = FiniteMap String Dynamic -- cuz TypeRep \not \in
Ord :(
This supports, for instance:
> stypeOf x = show (typeOf x)
> ttypeOf (x :: T a) = stypeOf (undefined :: a)
>
> emptyDM :: DynamicMap
> emptyDM = emptyFM
>
> addToDM :: Typeable a => DynamicMap -> a -> DynamicMap
> addToDM dm a = addToFM dm (stypeOf a) (toDyn a)
>
> lookupDM :: Typeable a => DynamicMap -> Maybe a
> lookupDM dm :: Maybe a =
> case lookupFM dm (stypeOf (undefined :: a)) of
> Nothing -> Nothing
> Just x -> fromDynamic x
as well as a few other of the standard FM functions that I need.
I have a type synonym:
> type DTree = AnnTree DynamicMap
so that I can add whatever types of annotations I want to the tree.
I also provide methods of showing the trees with various annotations
shown, based on a DShow type:
> type DShow = Dynamic -> Maybe ShowS
> dshowLabel :: Typeable a => (a -> ShowS) -> DShow
> dshowLabel x d =
> case fromDynamic d of
> Nothing -> Nothing
> Just v -> Just (shows (typeOf v) . showChar '=' . x v)
>
> showDTreeWith :: DShow -> DTree -> ShowS
> showDTreeWith shws t =
> showChar '(' .
> showString (unpackPS (treeTag t)) .
> showChar ' ' . showAnn (treeAnn t) .
> (if isTerm t
> then showString (unpackPS (treeText t))
> else showChildren (treeChildren t)) .
> showChar ')'
> where
> showChildren [] = showString "<<EMPTY>>"
> showChildren [ch] = showDTreeWith shws ch
> showChildren (ch:chl) = showDTreeWith shws ch . showChar ' ' .
showChildren chl
> showAnn a = showList (foldDM showAnn' [] a)
> showAnn' dyn acc =
> case shws dyn of
> Nothing -> acc
> Just ss -> showChar '{' . ss . showChar '}' : acc
> showList [] = id
> showList [x] = showChar '{' . x . showChar '}' . showChar ' '
> showList (x:xs) = showChar '{' . x . showList' xs . showChar '}' .
showChar ' '
> showList' [] = id
> showList' (x:xs) = showChar ';' . x . showList' xs
Basically, what this does is it is given a DShow (which can be combined,
of course, using non-shown functions), and prints the tree with the
dynamic annotations shown in braces. The dshowLabel function takes a
shows function and creates a DShow function based on it.
For instance, I have a coreference data type, which looks like:
> data Coref = Coref Int Int Bool (Maybe String)
> -- Id, ref, in-min; eventually we cannonicalize these
> -- and we can assume id= ref, type
> deriving (Eq, Ord, Show)
We make this an instance of Typeable so we can put it in dynamic maps:
> corefTypeCon = mkTyCon "Coref" ; corefTypeRep = mkAppTy corefTypeCon
[]
> instance Typeable Coref where typeOf _ = corefTypeRep
> {-# NOINLINE corefTypeCon #-}
> {-# NOINLINE corefTypeRep #-}
Now, we have another annotation type, Range, which specifies what subset
of the sentence a given node covers.
> data Range = Single Int
> | Range Int Int
>
> instance Show Range where
> showsPrec _ (Single i) = shows i
> showsPrec _ (Range i j) = shows i . showChar '^' . shows j
>
> rangeTypeCon = mkTyCon "Range" ; rangeTypeRep = mkAppTy rangeTypeCon
[]
> instance Typeable Range where typeOf _ = rangeTypeRep
> {-# NOINLINE rangeTypeCon #-}
> {-# NOINLINE rangeTypeRep #-}
And we can take a DTree and add ranges with:
> numberTree :: Int -> DTree -> (Int, DTree)
> numberTree n t@(Term _ _ _) = (n+1, addAnn t (Single n))
> numberTree n t@(NonTerm _ chl _) =
> let (n',chl') = mapAccumL numberTree n chl
> in (n', addAnn (t { treeChildren = chl' }) (mkRange n (n'-1)))
The associate DShow function is:
> rangeDShow :: DShow
> rangeDShow = dshowLabel (shows :: Range -> ShowS)
Now, we parse a tree, convert it into a dtree and number it:
We do:
> (_:Right (_,tree):_) = parseFile "wsj93_005.0011.par" (unsafePerformIO
$ readFile "wsj93_005.0011.par")
now, tree is of type AnnTree (). We can convert this to a DTree with
nothing in it by applying the mkDTree function:
> mkDTree :: Tree -> DTree
> mkDTree (Term tag txt _) = Term tag txt emptyDM
> mkDTree (NonTerm tag chl _) = NonTerm tag (map mkDTree chl) emptyDM
And the number it, by doing:
> pTree :: DTree
> pTree = snd $ numberTree 1 $ mkDTree tree
we can test showing this by:
*ReadCorefData> showDTreeWith rangeDShow pTree ""
"(TOP {{Range=1^32}} (S {{Range=1^32}} (NP-A {{Range=1^11}} (NPB
{{Range=1^4}} (NE {{Range=1^3}} (NNP {{Range=1}} Michael) (NNP
{{Range=2}} D.) (NNP {{Range=3}} Casey)) (COMMA {{Range=4}} ,)) (NP
{{Range=5^11}} (NPB {{Range=5^11}} (DT {{Range=5}} a) (JJ {{Range=6}}
top) (NE {{Range=7}} (NNP {{Range=7}} Johnson)) (CC {{Range=8}} &) (NE
{{Range=9}} (NNP {{Range=9}} Johnson)) (NN {{Range=10}} manager) (COMMA
{{Range=11}} ,)))) (VP {{Range=12^32}} (VBD {{Range=12}} moved) (PP
{{Range=13^23}} (TO {{Range=13}} to) (NP-A {{Range=14^23}} (NPB
{{Range=14^17}} (NE {{Range=14^16}} (NNP {{Range=14}} Genetic) (NNP
{{Range=15}} Therapy) (NNP {{Range=16}} Inc.)) (COMMA {{Range=17}} ,))
(NP {{Range=18^23}} (NPB {{Range=18^21}} (DT {{Range=18}} a) (JJ
{{Range=19}} small) (NN {{Range=20}} biotechnology) (NN {{Range=21}}
concern)) (ADVP {{Range=22^23}} (RB {{Range=22}} here) (COMMA
{{Range=23}} ,))))) (SG {{Range=24^32}} (VP {{Range=24^32}} (TO
{{Range=24}} to) (VP-A {{Range=25^32}} (VB {{Range=25}} become)
(NP-A_AND {{Range=26^32}} (NP {{Range=26^27}} (NPB {{Range=26^27}} (PRP$
{{Range=26}} its) (NN {{Range=27}} president))) (CC {{Range=28}} and)
(NP {{Range=29^32}} (NPB {{Range=29^32}} (NN {{Range=29}} chief) (VBG
{{Range=30}} operating) (NN {{Range=31}} officer) (PERIOD {{Range=32}}
.))))))))))"
you can take my word that this is correct :).
We can show it without the annotations by:
*ReadCorefData> showDTreeWith dshow0 pTree ""
"(TOP (S (NP-A (NPB (NE (NNP Michael) (NNP D.) (NNP Casey)) (COMMA ,))
(NP (NPB (DT a) (JJ top) (NE (NNP Johnson)) (CC &) (NE (NNP Johnson))
(NN manager) (COMMA ,)))) (VP (VBD moved) (PP (TO to) (NP-A (NPB (NE
(NNP Genetic) (NNP Therapy) (NNP Inc.)) (COMMA ,)) (NP (NPB (DT a) (JJ
small) (NN biotechnology) (NN concern)) (ADVP (RB here) (COMMA ,)))))
(SG (VP (TO to) (VP-A (VB become) (NP-A_AND (NP (NPB (PRP$ its) (NN
president))) (CC and) (NP (NPB (NN chief) (VBG operating) (NN officer)
(PERIOD .))))))))))"
now, note that we have *NOT* ever added any annotations having to do
with corefs to it.
however, we can still segfault ghci by doing:
*ReadCorefData> showDTreeWith corefDShow pTree ""
"(TOP {{Coref=Coref 1 32
Process ghci exited abnormally with code 5
where it gets the 1 32 is beyond me :).
now, for some more fun, I can reload this module into ghci, and run it
and it works fine:
___ ___ _
/ _ \ /\ /\/ __(_)
/ /_\// /_/ / / | | GHC Interactive, version 6.0, for Haskell 98.
/ /_\\/ __ / /___| | http://www.haskell.org/ghc/
\____/\/ /_/\____/|_| Type :? for help.
Loading package base ... linking ... done.
Loading package lang ... linking ... done.
: Can't find module `'
(use -v to see a list of the files searched for)
Prelude> :load c:/home/t-hald/projects/PennUtil/ReadCorefData.hs
Skipping Common ( /home/t-hald/projects/Common.hs,
/home/t-hald/projects/Common.o )
Compiling NLP.Util ( /home/t-hald/projects/NLP/Util.hs,
interpreted )
Skipping NLP.String ( /home/t-hald/projects/NLP/String.lhs,
/home/t-hald/projects/NLP/String.o )
Skipping NLP.FiniteMap ( /home/t-hald/projects/NLP/FiniteMap.hs,
/home/t-hald/projects/NLP/FiniteMap.o )
Compiling NLP.PennParser ( /home/t-hald/projects/NLP/PennParser.hs,
interpreted )
Compiling Util.DynamicMap ( /home/t-hald/projects/Util/DynamicMap.hs,
interpreted )
Compiling PennUtil.Util ( /home/t-hald/projects/PennUtil/Util.hs,
interpreted )
Compiling ReadCorefData (
c:/home/t-hald/projects/PennUtil/ReadCorefData.hs, interpreted )
Ok, modules loaded: ReadCorefData, PennUtil.Util, Util.DynamicMap,
NLP.PennParser, NLP.FiniteMap, NLP.String, NLP.Util, Common.
*ReadCorefData> showDTreeWith corefDShow pTree ""
Loading package haskell98 ... linking ... done.
"(TOP (S (NP-A (NPB (NE (NNP Michael) (NNP D.) (NNP Casey)) (COMMA ,))
(NP (NPB (DT a) (JJ top) (NE (NNP Johnson)) (CC &) (NE (NNP Johnson))
(NN manager) (COMMA ,)))) (VP (VBD moved) (PP (TO to) (NP-A (NPB (NE
(NNP Genetic) (NNP Therapy) (NNP Inc.)) (COMMA ,)) (NP (NPB (DT a) (JJ
small) (NN biotechnology) (NN concern)) (ADVP (RB here) (COMMA ,)))))
(SG (VP (TO to) (VP-A (VB become) (NP-A_AND (NP (NPB (PRP$ its) (NN
president))) (CC and) (NP (NPB (NN chief) (VBG operating) (NN officer)
(PERIOD .))))))))))"
*ReadCorefData>
just as it shouldn't print any coref data (as it doesn't know any!), it
doesn't.
now, i insert a blank line somewhere in the source, save it, and reload
(just to force ghci to actually reload it), and:
*ReadCorefData> :r
Compiling ReadCorefData (
c:/home/t-hald/projects/PennUtil/ReadCorefData.hs, interpreted )
Ok, modules loaded: ReadCorefData, PennUtil.Util, Util.DynamicMap,
NLP.PennParser, NLP.FiniteMap, NLP.String, NLP.Util, Common.
*ReadCorefData> showDTreeWith corefDShow pTree ""
"(TOP {{Coref=Coref 1 32
Process ghci exited abnormally with code 5
I can do this every time :).
I should mention that NLP.FiniteMap was created by stealing the code
from Data.FiniteMap and adding a few functions I felt were missing.
I've attached all the relevant source code. The
PennUtil/ReadCorefData.hs is the module we're trying to run. You should
untar it into a new directory if you want to experiment with it.
Any help would really be incredibly appreciated.
Thanks!
- Hal
--
Hal Daume III | hdaume at isi.edu
"Arrest this man, he talks in maths." | www.isi.edu/~hdaume
-------------- next part --------------
A non-text attachment was scrubbed...
Name: PennError.tar.gz
Type: application/x-gzip
Size: 19729 bytes
Desc: PennError.tar.gz
Url : http://www.haskell.org/pipermail/glasgow-haskell-bugs/attachments/20030814/a2b50a03/PennError.tar.bin
More information about the Glasgow-haskell-bugs
mailing list