
It is really hard to help you if you don't supply the context. Which version of GHC? Send the code for Trie.lhs. etc. Otherwise we're all guessing. Simon | -----Original Message----- | From: Hal Daume III [mailto:hdaume@ISI.EDU] | Sent: 22 April 2002 23:46 | To: GHC Users Mailing List | Subject: misplaces SPECIALISE | | | /nfs/isd/hdaume/projects/NLP/Trie.lhs:162: | Misplaced SPECIALISE instance pragma: | {-# SPECIALIZE instance {Binary (Trie Token Double)} #-} | Failed, modules loaded: NLP.NLPPrelude, Util.BinUtil, | Util.Binary, NLP.HashMap, Util.ShrinkString, Util.FastMutInt, | NLP.Util. | | | what does that mean? | | -- | Hal Daume III | | "Computer science is no more about computers | hdaume@isi.edu | than astronomy is about telescopes." -Dijkstra | www.isi.edu/~hdaume | | _______________________________________________ | Glasgow-haskell-users mailing list | Glasgow-haskell-users@haskell.org | http://www.haskell.org/mailman/listinfo/glasgow-| haskell-users |

Here is sufficient code, using ghc5.02.1 for solaris: module Test where import Util.Binary -- this is the GHC binary distribution import PrelWord import Array newtype Token = Token [Word8] class TrieKey key where mkKey :: key -> [Word8] unKey :: [Word8] -> key data Trie key elem = Trie !(Maybe elem) (Array Word8 (Maybe (Trie key elem))) instance (TrieKey key, Binary elem) => Binary (Trie key elem) where put_ h (Trie e arr) = put_ h e >> put_ h (assocs arr) get h = get h >>= \e -> get h >>= \a -> return (Trie e (listArray (0,255) a)) {-# SPECIALIZE instance Binary (Trie Token Double) #-} wherever I put the specialize pragma, it complains: /nfs/isd/hdaume/projects/Test.hs:18: Misplaced SPECIALISE instance pragma: {-# SPECIALIZE instance {Binary (Trie Token Double)} #-} I also tried something like (I don't have the 100% correct code but something like): putTDT :: BinHandle -> Trie Token Double -> IO () putTDT h (Trie e arr) = put_ h e' >> put_ h (assocs arr) where e' = case e of {Nothing->0; Just x->x} and a corresponding "getTDT" then: {-# SPECIALIZE put_ :: BinHandle -> Trie Token Double -> IO () = putTDT #-} and the corresponding for get, but it complained with a parse error on "=" - Hal -- Hal Daume III "Computer science is no more about computers | hdaume@isi.edu than astronomy is about telescopes." -Dijkstra | www.isi.edu/~hdaume On Mon, 22 Apr 2002, Simon Peyton-Jones wrote:
It is really hard to help you if you don't supply the context. Which version of GHC? Send the code for Trie.lhs. etc.
Otherwise we're all guessing.
Simon
| -----Original Message----- | From: Hal Daume III [mailto:hdaume@ISI.EDU] | Sent: 22 April 2002 23:46 | To: GHC Users Mailing List | Subject: misplaces SPECIALISE | | | /nfs/isd/hdaume/projects/NLP/Trie.lhs:162: | Misplaced SPECIALISE instance pragma: | {-# SPECIALIZE instance {Binary (Trie Token Double)} #-} | Failed, modules loaded: NLP.NLPPrelude, Util.BinUtil, | Util.Binary, NLP.HashMap, Util.ShrinkString, Util.FastMutInt, | NLP.Util. | | | what does that mean? | | -- | Hal Daume III | | "Computer science is no more about computers | hdaume@isi.edu | than astronomy is about telescopes." -Dijkstra | www.isi.edu/~hdaume | | _______________________________________________ | Glasgow-haskell-users mailing list | Glasgow-haskell-users@haskell.org | http://www.haskell.org/mailman/listinfo/glasgow-| haskell-users |
participants (2)
-
Hal Daume III
-
Simon Peyton-Jones