Ticket #1885: OtherP.hs

{-# OPTIONS -fglasgow-exts -fbang-patterns -cpp -fallow-undecidable-instances #-}

module OtherP where

import Foreign

{- to see heap explosion, snip form HERE ... -}
data C a b = C {-# UNPACK #-} !a {-# UNPACK #-} !b deriving (Eq,Show)

type Vec3 = C Double (C Double (C Double ())) 

vec3 !a !b !c = C a (C b (C c ()))

instance (Show a, Eq a, Num a) => Num (C a ()) where
  (C a ()) + (C b ()) = C (a+b) ()

instance (Show (C a (C a b)), Eq (C a (C a b)), Num (C a b), Num a) => Num (C a (C a b)) where
  (C i (C j k)) + (C x (C y z)) = C (i+x) ((C j k)+(C y z))

instance Storable a => Storable (C a ()) where
  sizeOf _ = sizeOf (undefined::a)
  alignment _ = alignment (undefined::a)
  peek p = peek (castPtr p) >>= \a -> return (C a ())
  poke p (C a _) = poke (castPtr p) a

instance (Storable a, Storable (C a v)) => Storable (C a (C a v)) 
  where
  sizeOf _ = sizeOf (undefined::a) + sizeOf (undefined::(C a v))
  alignment _ = alignment (undefined::a)
  peek !p = 
    peek (castPtr p) >>= \a -> 
    peek (castPtr (p`plusPtr`sizeOf(undefined::a))) >>= \v -> 
    return (C a v)
  poke !p !(C a v) = 
    poke (castPtr p) a >> 
    poke (castPtr (p`plusPtr`sizeOf(undefined::a))) v

--  also, inlining these seem to defeat unboxing
--  {-# INLINE peek #-}
--  {-# INLINE poke #-}
--  {-# INLINE sizeOf #-}
--  {-# INLINE alignment #-}

{- ... TO HERE and move to another file -}