Using associated data types to create unpacked data structures
Simon Marlow
marlowsd at gmail.com
Thu Aug 12 06:25:49 EDT 2010
On 12/08/2010 11:13, Johan Tibell wrote:
> There needs to be some amount of code generation, but much of the
> implementation can still be shared. I previously tried to defined the
> type class as
>
> {-# LANGUAGE MultiParamTypeClasses, TypeFamilies #-}
> module Ex2 where
>
> import Prelude hiding (lookup)
>
> data MapView k v = TipView
> | BinView {-# UNPACK #-} !Size !k !v !(Map k v)
> !(Map k v)
>
> class Unbox k v where
> data Map k v :: *
> tip :: Map k v
> bin :: Size -> k -> v -> Map k v -> Map k v -> Map k v
> view :: Map k v -> MapView k v
>
> type Size = Int
>
> lookup :: (Ord k, Unbox k v) => k -> Map k v -> Maybe v
> lookup k m = case view m of
> TipView -> Nothing
> BinView _ kx x l r -> case compare k kx of
> LT -> lookup k l
> GT -> lookup k r
> EQ -> Just x
> {-# INLINE lookup #-}
>
> Calling lookup from a different module at a know type gives exactly the
> Core you'd like to see (unpacked types, no MapView constructors).
I'm not sure I want lookup (and other operations) to be inlined at every
call site though.
> Rather than try to solve this problem in one go, I would go for a
> low-tech approach for now: write a TH library to generate the code,
> and ask the user to declare the versions they need. To make a
> particular version, the user would say something like
>
> module MapIntDouble (module MapIntDouble) where
> import TibbeMagicMapGenerator
> make_me_a_map ...
>
> there's no type class of course, so you can't write functions that
> work over all specialised Maps. But this at least lets you generate
> optimised maps for only a little boilerplate, and get the
> performance boost you were after.
>
>
> This doesn't quite work though as two MapIntDouble defined in two
> different libraries are incompatible. This is essentially the same
> problem as with instance collisions.
But you get to choose the module name, so you can avoid collisions by
using qualified names.
Cheers,
Simon
More information about the Glasgow-haskell-users
mailing list