RE: very strange behavior (crashes!) with Dynamics

Okay, this is the last spam from me.

Here's exactly what you need to do to get the bug.

Create three modules, DynamicMap.hs, Range.hs and Coref.hs, containing
the following:

------------ DynamicMap.hs ------------
module DynamicMap
    ( DynamicMap,
      emptyDM,
      addToDM,
      foldDM
    )
    where

import Data.FiniteMap
import Data.Dynamic

type DynamicMap = FiniteMap String Dynamic  -- cuz TypeRep \not \in Ord
:(

stypeOf x = show (typeOf x)

emptyDM :: DynamicMap
emptyDM = emptyFM

addToDM :: Typeable a => DynamicMap -> a -> DynamicMap
addToDM dm a = addToFM dm (stypeOf a) (toDyn a)

foldDM :: (Dynamic -> b -> b) -> b -> DynamicMap -> b
foldDM f = foldFM (const f)


-------------- Range.hs ---------------
module Range where

import Data.Dynamic

data Range = Single Int
           | Range  Int Int

minRange (Single x) = x
minRange (Range x _) = x

maxRange (Single x) = x
maxRange (Range _ x) = x

instance Show Range where
  showsPrec _ (Single i) = shows i
  showsPrec _ (Range i j) = shows i . showChar '^' . shows j

instance Eq Range where
    Single i == Single k = i == k
    Single i == Range k l = i == k && k == l
    Range i j == Range k l = i == k && j == l
    Range i j == Single k = i == k && j == k

instance Read Range where
  readsPrec i s
      | '^' `elem` s = 
          let n1 = takeWhile (/='^') s
              n2 = drop (length n1+1) s
          in  [(Range l h, rest) | (l,[]) <- readsPrec i n1, (h,rest) <-
readsPrec i n2]
      | otherwise = map (\ (a,s) -> (Single a,s)) (readsPrec i s)

instance Ord Range where
    r `compare` s = case minRange r `compare` minRange s of
                      EQ -> maxRange r `compare` maxRange s
                      x  -> x

rangeTypeCon = mkTyCon "Range" ; rangeTypeRep = mkAppTy rangeTypeCon []
instance Typeable Range where typeOf _ = rangeTypeRep
{-# NOINLINE rangeTypeCon #-}
{-# NOINLINE rangeTypeRep #-}

rangeDShow :: DShow
rangeDShow = dshowLabel (shows :: Range -> ShowS)

type DShow = Dynamic -> Maybe ShowS

dshow0 :: DShow
dshow0 = const Nothing

dshowLabel :: Typeable a => (a -> ShowS) -> DShow
dshowLabel x d = 
  case fromDynamic d of
    Nothing -> Nothing
    Just v  -> Just (shows (typeOf v) . showChar '=' . x v)


-------------- Coref.hs ---------------
module Coref where

import DynamicMap
import Data.Dynamic
import Range

data Coref = Coref Int Int Bool (Maybe String) 
         deriving (Eq, Ord, Show)

corefTypeCon = mkTyCon "Coref" ; corefTypeRep = mkAppTy corefTypeCon []
instance Typeable Coref where typeOf _ = corefTypeRep
{-# NOINLINE corefTypeCon #-}
{-# NOINLINE corefTypeRep #-}

corefDShow = dshowLabel (shows :: Coref -> ShowS)


showDM :: DShow -> DynamicMap -> ShowS
showDM sd = foldDM (\d b -> case sd d of { Nothing -> b ; Just s -> s .
b }) id

dm1 = addToDM emptyDM (Range 1 2)
---------------------------------------

Now, load Coref.hs in GHCi:

   ___         ___ _
  / _ \ /\  /\/ __(_)
 / /_\// /_/ / /  | |      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.
Prelude> :load c:/home/t-hald/projects/Bugs/Coref.hs
Compiling DynamicMap       ( DynamicMap.hs, interpreted )
Compiling Range            ( Range.hs, interpreted )
Compiling Coref            ( c:/home/t-hald/projects/Bugs/Coref.hs,
interpreted )
Ok, modules loaded: Coref, Range, DynamicMap.
*Coref> showDM corefDShow dm1 ""
""
*Coref> :!touch Coref.hs
*Coref> :r
Compiling Coref            ( c:/home/t-hald/projects/Bugs/Coref.hs,
interpreted )
Ok, modules loaded: Coref, Range, DynamicMap.
*Coref> showDM corefDShow dm1 ""
"Coref=Coref 1 2 
Process ghci exited abnormally with code 5


for some reason having the DShow definitions in the same file as Range
is important (I originally tried having the DShow definitions in their
own file, imported by all the others, but that didn't exhibit the bug).


 --
 Hal Daume III                                   | hdaume@xxxxxxx
 "Arrest this man, he talks in maths."           | www.isi.edu/~hdaume


> -----Original Message-----
> From: glasgow-haskell-bugs-admin@xxxxxxxxxxx 
> [mailto:glasgow-haskell-bugs-admin@xxxxxxxxxxx] On Behalf Of Hal Daume
> Sent: Thursday, August 14, 2003 3:46 PM
> To: Hal Daume; glasgow-haskell-bugs@xxxxxxxxxxx
> Subject: RE: very strange behavior (crashes!) with Dynamics
> 
> 
> This hasn't yet been posted, but I've actually whittled it 
> down quite a
> bit.
> 
> All we need is to import the Util.DynamicMap and do:
> 
> > dm1 = addToDM emptyDM (Range 1 2)
> > showDM :: DShow -> DynamicMap -> ShowS
> > showDM sd = foldDM (\d b -> case sd d of { Nothing -> b ; 
> Just s -> s
> . b }) id
> 
> and do the show definition for Coref and then we get:
> 
> 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> showDM corefDShow dm1 ""
> Loading package haskell98 ... linking ... done.
> ""
> *ReadCorefData> :!touch ReadCorefData.hs
> *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> showDM corefDShow dm1 ""
> "Coref=Coref 1 2 
> Process ghci exited abnormally with code 5
> 
> 
> interestingly it seems to be trying to read this as the range 
> (since the
> two ints are the same as the initial ones)...
> 
>  --
>  Hal Daume III                                   | hdaume@xxxxxxx
>  "Arrest this man, he talks in maths."           | www.isi.edu/~hdaume
> 
> 
> > -----Original Message-----
> > From: Hal Daume 
> > Sent: Thursday, August 14, 2003 12:37 PM
> > To: 'glasgow-haskell-bugs@xxxxxxxxxxx'
> > Subject: very strange behavior (crashes!) with Dynamics
> > 
> > 
> > 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@xxxxxxx
> >  "Arrest this man, he talks in maths."           | 
www.isi.edu/~hdaume
> 
_______________________________________________
Glasgow-haskell-bugs mailing list
Glasgow-haskell-bugs@xxxxxxxxxxx
http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs