{-# LINE 1 "WinDll/Lib/Tuples_Debug.hsc" #-}
{-# LINE 1 "WinDll/Lib/Tuples_Debug.xpphs" #-}
{-# LINE 2 "WinDll/Lib/Tuples_Debug.hsc" #-}


{-# LANGUAGE FlexibleInstances        #-}
{-# LANGUAGE MultiParamTypeClasses    #-}
{-# LANGUAGE TypeSynonymInstances     #-}
{-# LANGUAGE ForeignFunctionInterface #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Windll
-- Copyright   :  (c) Tamar Christina 2009 - 2010
-- License     :  BSD3
-- 
-- Maintainer  :  tamar@zhox.com
-- Stability   :  experimental
-- Portability :  portable
--
-- Module containing definitions for tuples, since those can't be automatically
-- translated. We This file contains predefined mappings of tuples till 8-tuples.
-- If you need more you need to unfortunately add these yourself
--
-----------------------------------------------------------------------------

module WinDll.Lib.Tuples_Debug where

import Foreign hiding (free, malloc, alloca, realloc)
import Foreign.Marshal.Alloc hiding (free, malloc, alloca, realloc)
import WinDll.Lib.NativeMapping_Debug

import Foreign
import Foreign.C
import Foreign.Ptr
import qualified Foreign.Marshal.Alloc as F
import Foreign.Marshal.Utils

import Control.Monad
import Control.Monad.Instances

import WinDll.Debug.Stack
import WinDll.Debug.Alloc



{-# LINE 44 "WinDll/Lib/Tuples_Debug.xpphs" #-}

{-# LINE 45 "WinDll/Lib/Tuples_Debug.xpphs" #-}

-- * The datatypes to replace the tupples with

data Tuple2 a b             = Tuple2 a b
data Tuple3 a b c           = Tuple3 a b c
data Tuple4 a b c d         = Tuple4 a b c d
data Tuple5 a b c d e       = Tuple5 a b c d e
data Tuple6 a b c d e f     = Tuple6 a b c d e f
data Tuple7 a b c d e f g   = Tuple7 a b c d e f g
data Tuple8 a b c d e f g h = Tuple8 a b c d e f g h

-- * Type namings

type Tuple2Ptr a b             = Ptr (Tuple2 a b)
type Tuple3Ptr a b c           = Ptr (Tuple3 a b c)
type Tuple4Ptr a b c d         = Ptr (Tuple4 a b c d)
type Tuple5Ptr a b c d e       = Ptr (Tuple5 a b c d e)
type Tuple6Ptr a b c d e f     = Ptr (Tuple6 a b c d e f)
type Tuple7Ptr a b c d e f g   = Ptr (Tuple7 a b c d e f g)
type Tuple8Ptr a b c d e f g h = Ptr (Tuple8 a b c d e f g h)

-- * Functor instances so that these new tuple types can
--   fit into the functor instance of the FFIType class.
instance Storable a => Functor (Tuple2 a) where
    fmap f (Tuple2 a b) = Tuple2 a (f b)
    
instance Storable a => Functor (Tuple3 a b) where
    fmap f (Tuple3 a b c) = Tuple3 a b (f c)
    
instance Storable a => Functor (Tuple4 a b c) where
    fmap f (Tuple4 a b c d) = Tuple4 a b c (f d)
    
instance Storable a => Functor (Tuple5 a b c d) where
    fmap f (Tuple5 a b c d e) = Tuple5 a b c d (f e)
    
instance Storable a => Functor (Tuple6 a b c d e) where
    fmap f (Tuple6 a b c d e f') = Tuple6 a b c d e (f f')
    
instance Storable a => Functor (Tuple7 a b c d e f) where
    fmap f (Tuple7 a b c d e f' g) = Tuple7 a b c d e f' (f g)
    
instance Storable a => Functor (Tuple8 a b c d e f g) where
    fmap f (Tuple8 a b c d e f' g h) = Tuple8 a b c d e f' g (f h)

-- * The isomorphic type conversions

instance (FFIType a b,FFIType c d) => FFIType (a,c) 
                                              (Tuple2 b d) where
    toFFI   st (a,b)        = (Tuple2 (toFFI st a) (toFFI st b))
    fromFFI st (Tuple2 a b) = (fromFFI st a, fromFFI st b)
    
instance (FFIType a b,FFIType c d
         ,FFIType e f) => FFIType (a,c,e) 
                                  (Tuple3 b d f) where
    toFFI   st (a,b,c)        = (Tuple3 (toFFI st a) (toFFI st b) (toFFI st c))
    fromFFI st (Tuple3 a b c) = (fromFFI st a, fromFFI st b, fromFFI st c)
    
instance (FFIType a b,FFIType c d
         ,FFIType e f,FFIType g h) => FFIType (a,c,e,g) 
                                              (Tuple4 b d f h) where
    toFFI   st (a,b,c,d)        = (Tuple4 (toFFI st a) (toFFI st b) (toFFI st c) (toFFI st d))
    fromFFI st (Tuple4 a b c d) = (fromFFI st a, fromFFI st b, fromFFI st c, fromFFI st d)
    
instance (FFIType a b,FFIType c d
         ,FFIType e f,FFIType g h
         ,FFIType i j) => FFIType (a,c,e,g,i) 
                                  (Tuple5 b d f h j) where
    toFFI   st (a,b,c,d,e)        = (Tuple5 (toFFI st a) (toFFI st b) (toFFI st c) (toFFI st d) 
                                              (toFFI st e))
    fromFFI st (Tuple5 a b c d e) = (fromFFI st a, fromFFI st b, fromFFI st c, fromFFI st d
                                      ,fromFFI st e)
    
instance (FFIType a b,FFIType c d
         ,FFIType e f,FFIType g h
         ,FFIType i j,FFIType k l) => FFIType (a,c,e,g,i,k) (Tuple6 b d f h j l) where
    toFFI   st (a,b,c,d,e,f)        = (Tuple6 (toFFI st a) (toFFI st b) (toFFI st c) (toFFI st d) 
                                                (toFFI st e) (toFFI st f))
    fromFFI st (Tuple6 a b c d e f) = (fromFFI st a, fromFFI st b, fromFFI st c, fromFFI st d
                                        ,fromFFI st e, fromFFI st f)
    
instance (FFIType a b,FFIType c d
         ,FFIType e f,FFIType g h
         ,FFIType i j,FFIType k l
         ,FFIType m n) => FFIType (a,c,e,g,i,k,m) 
                                  (Tuple7 b d f h j l n) where
    toFFI   st (a,b,c,d,e,f,g)        = (Tuple7 (toFFI st a) (toFFI st b) (toFFI st c) (toFFI st d) 
                                                  (toFFI st e) (toFFI st f) (toFFI st g))
    fromFFI st (Tuple7 a b c d e f g) = (fromFFI st a, fromFFI st b, fromFFI st c, fromFFI st d
                                          ,fromFFI st e, fromFFI st f, fromFFI st g)
    
instance (FFIType a b,FFIType c d
         ,FFIType e f,FFIType g h
         ,FFIType i j,FFIType k l
         ,FFIType m n,FFIType o p) => FFIType (a,c,e,g,i,k,m,o) 
                                              (Tuple8 b d f h j l n p) where
    toFFI   st (a,b,c,d,e,f,g,h)        = (Tuple8 (toFFI st a) (toFFI st b) (toFFI st c) (toFFI st d) 
                                                    (toFFI st e) (toFFI st f) (toFFI st g) (toFFI st h))
    fromFFI st (Tuple8 a b c d e f g h) = (fromFFI st a, fromFFI st b, fromFFI st c, fromFFI st d
                                            ,fromFFI st e, fromFFI st f, fromFFI st g, fromFFI st h)

instance (FFIType a b,FFIType c d
         ,Storable b, Storable d) => FFIType (a,c) 
                                             (Tuple2Ptr b d) where
    toNative   = \st val -> recordM  (pushStack st ("WinDll/Lib/Tuples_Base.cpphs" ++ ":" ++ (show  179) ++ "(" ++  "newTuple2"  ++ ")")) val  (new . (toFFI st))
    fromNative = \st ptr -> record   (pushStack st ("WinDll/Lib/Tuples_Base.cpphs" ++ ":" ++ (show  180) ++ "(" ++  "fromTuple2"  ++ ")")) ptr >> return ( id ptr) >>= fmap (fromFFI st) . peek
    freeFFI    = \st _ ptr -> freeDefault (pushStack st (  "WinDll/Lib/Tuples_Base.cpphs" ++ ":" ++ (show  181) ++ "(" ++  "freeTuple2" ++ ")")) ptr  F.free
    
instance (FFIType a b,FFIType c d
         ,FFIType e f,Storable b
         ,Storable d, Storable f) => FFIType (a,c,e) 
                                  (Tuple3Ptr b d f) where
    toNative   = \st val -> recordM  (pushStack st ("WinDll/Lib/Tuples_Base.cpphs" ++ ":" ++ (show  187) ++ "(" ++  "newTuple3"  ++ ")")) val  (new . (toFFI st))
    fromNative = \st ptr -> record   (pushStack st ("WinDll/Lib/Tuples_Base.cpphs" ++ ":" ++ (show  188) ++ "(" ++  "fromTuple3"  ++ ")")) ptr >> return ( id ptr) >>= fmap (fromFFI st) . peek
    freeFFI    = \st _ ptr -> freeDefault (pushStack st (   "WinDll/Lib/Tuples_Base.cpphs" ++ ":" ++ (show  189) ++ "(" ++  "freeTuple3" ++ ")")) ptr  F.free
    
instance (FFIType a b,FFIType c d
         ,FFIType e f,FFIType g h
         ,Storable b,Storable d
         ,Storable f,Storable h) => FFIType (a,c,e,g) 
                                            (Tuple4Ptr b d f h) where
    toNative   = \st val -> recordM  (pushStack st ("WinDll/Lib/Tuples_Base.cpphs" ++ ":" ++ (show  196) ++ "(" ++  "newTuple4"  ++ ")")) val  (new . (toFFI st))
    fromNative = \st ptr -> record   (pushStack st ("WinDll/Lib/Tuples_Base.cpphs" ++ ":" ++ (show  197) ++ "(" ++  "fromTuple4"  ++ ")")) ptr >> return ( id ptr) >>= fmap (fromFFI st) . peek
    freeFFI    = \st _ ptr -> freeDefault (pushStack st (   "WinDll/Lib/Tuples_Base.cpphs" ++ ":" ++ (show  198) ++ "(" ++  "freeTuple4" ++ ")")) ptr  F.free
    
instance (FFIType a b,FFIType c d
         ,FFIType e f,FFIType g h
         ,FFIType i j,Storable j
         ,Storable b,Storable d
         ,Storable f,Storable h) => FFIType (a,c,e,g,i) 
                                           (Tuple5Ptr b d f h j) where
    toNative   = \st val -> recordM  (pushStack st ("WinDll/Lib/Tuples_Base.cpphs" ++ ":" ++ (show  206) ++ "(" ++  "newTuple5"  ++ ")")) val  (new . (toFFI st))
    fromNative = \st ptr -> record   (pushStack st ("WinDll/Lib/Tuples_Base.cpphs" ++ ":" ++ (show  207) ++ "(" ++  "fromTuple5"  ++ ")")) ptr >> return ( id ptr) >>= fmap (fromFFI st) . peek
    freeFFI  = \st _ ptr -> freeDefault (pushStack st (   "WinDll/Lib/Tuples_Base.cpphs" ++ ":" ++ (show  208) ++ "(" ++  "freeTuple5" ++ ")")) ptr  F.free
    
instance (FFIType a b,FFIType c d
         ,FFIType e f,FFIType g h
         ,FFIType i j,FFIType k l
         ,Storable j,Storable l
         ,Storable b,Storable d
         ,Storable f,Storable h) => FFIType (a,c,e,g,i,k) 
                                            (Tuple6Ptr b d f h j l) where
    toNative   = \st val -> recordM  (pushStack st ("WinDll/Lib/Tuples_Base.cpphs" ++ ":" ++ (show  217) ++ "(" ++  "newTuple6"  ++ ")")) val  (new . (toFFI st))
    fromNative = \st ptr -> record   (pushStack st ("WinDll/Lib/Tuples_Base.cpphs" ++ ":" ++ (show  218) ++ "(" ++  "fromTuple6"  ++ ")")) ptr >> return ( id ptr) >>= fmap (fromFFI st) . peek
    freeFFI    = \st _ ptr -> freeDefault (pushStack st (   "WinDll/Lib/Tuples_Base.cpphs" ++ ":" ++ (show  219) ++ "(" ++  "freeTuple6" ++ ")")) ptr  F.free
    
instance (FFIType a b,FFIType c d
         ,FFIType e f,FFIType g h
         ,FFIType i j,FFIType k l
         ,FFIType m n,Storable n
         ,Storable j,Storable l
         ,Storable b,Storable d
         ,Storable f,Storable h) => FFIType (a,c,e,g,i,k,m) 
                                            (Tuple7Ptr b d f h j l n) where
    toNative   = \st val -> recordM  (pushStack st ("WinDll/Lib/Tuples_Base.cpphs" ++ ":" ++ (show  229) ++ "(" ++  "newTuple7"  ++ ")")) val  (new . (toFFI st))
    fromNative = \st ptr -> record   (pushStack st ("WinDll/Lib/Tuples_Base.cpphs" ++ ":" ++ (show  230) ++ "(" ++  "fromTuple7"  ++ ")")) ptr >> return ( id ptr) >>= fmap (fromFFI st) . peek
    freeFFI    = \st _ ptr -> freeDefault (pushStack st (   "WinDll/Lib/Tuples_Base.cpphs" ++ ":" ++ (show  231) ++ "(" ++  "freeTuple7" ++ ")")) ptr  F.free
    
instance (FFIType a b,FFIType c d
         ,FFIType e f,FFIType g h
         ,FFIType i j,FFIType k l
         ,FFIType m n,FFIType o p
         ,Storable n,Storable p
         ,Storable j,Storable l
         ,Storable b,Storable d
         ,Storable f,Storable h) => FFIType (a,c,e,g,i,k,m,o) 
                                              (Tuple8Ptr b d f h j l n p) where
    toNative   = \st val -> recordM  (pushStack st ("WinDll/Lib/Tuples_Base.cpphs" ++ ":" ++ (show  242) ++ "(" ++  "newTuple8"  ++ ")")) val  (new . (toFFI st))
    fromNative = \st ptr -> record   (pushStack st ("WinDll/Lib/Tuples_Base.cpphs" ++ ":" ++ (show  243) ++ "(" ++  "fromTuple8"  ++ ")")) ptr >> return ( id ptr) >>= fmap (fromFFI st) . peek
    freeFFI    = \st _ ptr -> freeDefault (pushStack st (   "WinDll/Lib/Tuples_Base.cpphs" ++ ":" ++ (show  244) ++ "(" ++  "freeTuple8" ++ ")")) ptr  F.free
    
-- * Storage instances

instance (Storable a, Storable b) => Storable (Tuple2 a b) where
    sizeOf    _ = (8)
{-# LINE 219 "WinDll/Lib/Tuples_Debug.xpphs" #-}
    alignment _ = 4
{-# LINE 220 "WinDll/Lib/Tuples_Debug.xpphs" #-}
    
    poke ptr (Tuple2 a1 a2) = do
        ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) ptr a1
{-# LINE 223 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 4)) ptr a2
{-# LINE 224 "WinDll/Lib/Tuples_Debug.xpphs" #-}
    peek ptr = do
        a1' <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) ptr
{-# LINE 226 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        a2' <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) ptr
{-# LINE 227 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        return $ (Tuple2 a1' a2')
        
instance (Storable a, Storable b, Storable c) => Storable (Tuple3 a b c) where
    sizeOf    _ = (12)
{-# LINE 231 "WinDll/Lib/Tuples_Debug.xpphs" #-}
    alignment _ = 4
{-# LINE 232 "WinDll/Lib/Tuples_Debug.xpphs" #-}
    
    poke ptr (Tuple3 a1 a2 a3) = do
        ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) ptr a1
{-# LINE 235 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 4)) ptr a2
{-# LINE 236 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 8)) ptr a3
{-# LINE 237 "WinDll/Lib/Tuples_Debug.xpphs" #-}
    peek ptr = do
        a1' <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) ptr
{-# LINE 239 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        a2' <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) ptr
{-# LINE 240 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        a3' <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) ptr
{-# LINE 241 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        return $ (Tuple3 a1' a2' a3')

instance (Storable a, Storable b, Storable c, Storable d) => Storable (Tuple4 a b c d) where
    sizeOf    _ = (16)
{-# LINE 245 "WinDll/Lib/Tuples_Debug.xpphs" #-}
    alignment _ = 4
{-# LINE 246 "WinDll/Lib/Tuples_Debug.xpphs" #-}
    
    poke ptr (Tuple4 a1 a2 a3 a4) = do
        ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) ptr a1
{-# LINE 249 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 4)) ptr a2
{-# LINE 250 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 8)) ptr a3
{-# LINE 251 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 12)) ptr a4
{-# LINE 252 "WinDll/Lib/Tuples_Debug.xpphs" #-}
    peek ptr = do
        a1' <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) ptr
{-# LINE 254 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        a2' <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) ptr
{-# LINE 255 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        a3' <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) ptr
{-# LINE 256 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        a4' <- ((\hsc_ptr -> peekByteOff hsc_ptr 12)) ptr
{-# LINE 257 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        return $ (Tuple4 a1' a2' a3' a4')

instance (Storable a, Storable b, Storable c, Storable d, Storable e) => Storable (Tuple5 a b c d e) where
    sizeOf    _ = (20)
{-# LINE 261 "WinDll/Lib/Tuples_Debug.xpphs" #-}
    alignment _ = 4
{-# LINE 262 "WinDll/Lib/Tuples_Debug.xpphs" #-}
    
    poke ptr (Tuple5 a1 a2 a3 a4 a5) = do
        ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) ptr a1
{-# LINE 265 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 4)) ptr a2
{-# LINE 266 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 8)) ptr a3
{-# LINE 267 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 12)) ptr a4
{-# LINE 268 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 16)) ptr a5
{-# LINE 269 "WinDll/Lib/Tuples_Debug.xpphs" #-}
    peek ptr = do
        a1' <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) ptr
{-# LINE 271 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        a2' <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) ptr
{-# LINE 272 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        a3' <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) ptr
{-# LINE 273 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        a4' <- ((\hsc_ptr -> peekByteOff hsc_ptr 12)) ptr
{-# LINE 274 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        a5' <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) ptr
{-# LINE 275 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        return $ (Tuple5 a1' a2' a3' a4' a5')

instance (Storable a, Storable b, Storable c, Storable d, Storable e, Storable f) => Storable (Tuple6 a b c d e f) where
    sizeOf    _ = (24)
{-# LINE 279 "WinDll/Lib/Tuples_Debug.xpphs" #-}
    alignment _ = 4
{-# LINE 280 "WinDll/Lib/Tuples_Debug.xpphs" #-}
    
    poke ptr (Tuple6 a1 a2 a3 a4 a5 a6) = do
        ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) ptr a1
{-# LINE 283 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 4)) ptr a2
{-# LINE 284 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 8)) ptr a3
{-# LINE 285 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 12)) ptr a4
{-# LINE 286 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 16)) ptr a5
{-# LINE 287 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 20)) ptr a6
{-# LINE 288 "WinDll/Lib/Tuples_Debug.xpphs" #-}
    peek ptr = do
        a1' <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) ptr
{-# LINE 290 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        a2' <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) ptr
{-# LINE 291 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        a3' <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) ptr
{-# LINE 292 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        a4' <- ((\hsc_ptr -> peekByteOff hsc_ptr 12)) ptr
{-# LINE 293 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        a5' <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) ptr
{-# LINE 294 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        a6' <- ((\hsc_ptr -> peekByteOff hsc_ptr 20)) ptr
{-# LINE 295 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        return $ (Tuple6 a1' a2' a3' a4' a5' a6')

instance (Storable a, Storable b, Storable c, Storable d, Storable e, Storable f, Storable g) => Storable (Tuple7 a b c d e f g) where
    sizeOf    _ = (28)
{-# LINE 299 "WinDll/Lib/Tuples_Debug.xpphs" #-}
    alignment _ = 4
{-# LINE 300 "WinDll/Lib/Tuples_Debug.xpphs" #-}
    
    poke ptr (Tuple7 a1 a2 a3 a4 a5 a6 a7) = do
        ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) ptr a1
{-# LINE 303 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 4)) ptr a2
{-# LINE 304 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 8)) ptr a3
{-# LINE 305 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 12)) ptr a4
{-# LINE 306 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 16)) ptr a5
{-# LINE 307 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 20)) ptr a6
{-# LINE 308 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 24)) ptr a7
{-# LINE 309 "WinDll/Lib/Tuples_Debug.xpphs" #-}
    peek ptr = do
        a1' <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) ptr
{-# LINE 311 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        a2' <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) ptr
{-# LINE 312 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        a3' <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) ptr
{-# LINE 313 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        a4' <- ((\hsc_ptr -> peekByteOff hsc_ptr 12)) ptr
{-# LINE 314 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        a5' <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) ptr
{-# LINE 315 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        a6' <- ((\hsc_ptr -> peekByteOff hsc_ptr 20)) ptr
{-# LINE 316 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        a7' <- ((\hsc_ptr -> peekByteOff hsc_ptr 24)) ptr
{-# LINE 317 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        return $ (Tuple7 a1' a2' a3' a4' a5' a6' a7')

instance (Storable a, Storable b, Storable c, Storable d, Storable e, Storable f, Storable g, Storable h) => Storable (Tuple8 a b c d e f g h) where
    sizeOf    _ = (32)
{-# LINE 321 "WinDll/Lib/Tuples_Debug.xpphs" #-}
    alignment _ = 4
{-# LINE 322 "WinDll/Lib/Tuples_Debug.xpphs" #-}
    
    poke ptr (Tuple8 a1 a2 a3 a4 a5 a6 a7 a8) = do
        ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) ptr a1
{-# LINE 325 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 4)) ptr a2
{-# LINE 326 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 8)) ptr a3
{-# LINE 327 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 12)) ptr a4
{-# LINE 328 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 16)) ptr a5
{-# LINE 329 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 20)) ptr a6
{-# LINE 330 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 24)) ptr a7
{-# LINE 331 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 28)) ptr a8
{-# LINE 332 "WinDll/Lib/Tuples_Debug.xpphs" #-}
    peek ptr = do
        a1' <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) ptr
{-# LINE 334 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        a2' <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) ptr
{-# LINE 335 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        a3' <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) ptr
{-# LINE 336 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        a4' <- ((\hsc_ptr -> peekByteOff hsc_ptr 12)) ptr
{-# LINE 337 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        a5' <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) ptr
{-# LINE 338 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        a6' <- ((\hsc_ptr -> peekByteOff hsc_ptr 20)) ptr
{-# LINE 339 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        a7' <- ((\hsc_ptr -> peekByteOff hsc_ptr 24)) ptr
{-# LINE 340 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        a8' <- ((\hsc_ptr -> peekByteOff hsc_ptr 28)) ptr
{-# LINE 341 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        return $ (Tuple8 a1' a2' a3' a4' a5' a6' a7' a8')
        
instance (Storable a, Storable b) => Storable (a, b) where
    sizeOf    _ = (8)
{-# LINE 345 "WinDll/Lib/Tuples_Debug.xpphs" #-}
    alignment _ = 4
{-# LINE 346 "WinDll/Lib/Tuples_Debug.xpphs" #-}
    
    poke ptr (a1, a2) = do
        ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) ptr a1
{-# LINE 349 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 4)) ptr a2
{-# LINE 350 "WinDll/Lib/Tuples_Debug.xpphs" #-}
    peek ptr = do
        a1' <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) ptr
{-# LINE 352 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        a2' <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) ptr
{-# LINE 353 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        return $ (a1', a2')
        
instance (Storable a, Storable b, Storable c) => Storable (a, b, c) where
    sizeOf    _ = (12)
{-# LINE 357 "WinDll/Lib/Tuples_Debug.xpphs" #-}
    alignment _ = 4
{-# LINE 358 "WinDll/Lib/Tuples_Debug.xpphs" #-}
    
    poke ptr (a1, a2, a3) = do
        ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) ptr a1
{-# LINE 361 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 4)) ptr a2
{-# LINE 362 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 8)) ptr a3
{-# LINE 363 "WinDll/Lib/Tuples_Debug.xpphs" #-}
    peek ptr = do
        a1' <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) ptr
{-# LINE 365 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        a2' <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) ptr
{-# LINE 366 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        a3' <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) ptr
{-# LINE 367 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        return $ (a1', a2', a3')

instance (Storable a, Storable b, Storable c, Storable d) => Storable (a, b, c, d) where
    sizeOf    _ = (16)
{-# LINE 371 "WinDll/Lib/Tuples_Debug.xpphs" #-}
    alignment _ = 4
{-# LINE 372 "WinDll/Lib/Tuples_Debug.xpphs" #-}
    
    poke ptr (a1, a2, a3, a4) = do
        ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) ptr a1
{-# LINE 375 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 4)) ptr a2
{-# LINE 376 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 8)) ptr a3
{-# LINE 377 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 12)) ptr a4
{-# LINE 378 "WinDll/Lib/Tuples_Debug.xpphs" #-}
    peek ptr = do
        a1' <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) ptr
{-# LINE 380 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        a2' <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) ptr
{-# LINE 381 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        a3' <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) ptr
{-# LINE 382 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        a4' <- ((\hsc_ptr -> peekByteOff hsc_ptr 12)) ptr
{-# LINE 383 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        return $ (a1', a2', a3', a4')

instance (Storable a, Storable b, Storable c, Storable d, Storable e) => Storable (a, b, c, d, e) where
    sizeOf    _ = (20)
{-# LINE 387 "WinDll/Lib/Tuples_Debug.xpphs" #-}
    alignment _ = 4
{-# LINE 388 "WinDll/Lib/Tuples_Debug.xpphs" #-}
    
    poke ptr (a1, a2, a3, a4, a5) = do
        ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) ptr a1
{-# LINE 391 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 4)) ptr a2
{-# LINE 392 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 8)) ptr a3
{-# LINE 393 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 12)) ptr a4
{-# LINE 394 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 16)) ptr a5
{-# LINE 395 "WinDll/Lib/Tuples_Debug.xpphs" #-}
    peek ptr = do
        a1' <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) ptr
{-# LINE 397 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        a2' <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) ptr
{-# LINE 398 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        a3' <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) ptr
{-# LINE 399 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        a4' <- ((\hsc_ptr -> peekByteOff hsc_ptr 12)) ptr
{-# LINE 400 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        a5' <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) ptr
{-# LINE 401 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        return $ (a1', a2', a3', a4', a5')

instance (Storable a, Storable b, Storable c, Storable d, Storable e, Storable f) => Storable (a, b, c, d, e, f) where
    sizeOf    _ = (24)
{-# LINE 405 "WinDll/Lib/Tuples_Debug.xpphs" #-}
    alignment _ = 4
{-# LINE 406 "WinDll/Lib/Tuples_Debug.xpphs" #-}
    
    poke ptr (a1, a2, a3, a4, a5, a6) = do
        ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) ptr a1
{-# LINE 409 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 4)) ptr a2
{-# LINE 410 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 8)) ptr a3
{-# LINE 411 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 12)) ptr a4
{-# LINE 412 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 16)) ptr a5
{-# LINE 413 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 20)) ptr a6
{-# LINE 414 "WinDll/Lib/Tuples_Debug.xpphs" #-}
    peek ptr = do
        a1' <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) ptr
{-# LINE 416 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        a2' <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) ptr
{-# LINE 417 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        a3' <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) ptr
{-# LINE 418 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        a4' <- ((\hsc_ptr -> peekByteOff hsc_ptr 12)) ptr
{-# LINE 419 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        a5' <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) ptr
{-# LINE 420 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        a6' <- ((\hsc_ptr -> peekByteOff hsc_ptr 20)) ptr
{-# LINE 421 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        return $ (a1', a2', a3', a4', a5', a6')

instance (Storable a, Storable b, Storable c, Storable d, Storable e, Storable f, Storable g) => Storable (a, b, c, d, e, f, g) where
    sizeOf    _ = (28)
{-# LINE 425 "WinDll/Lib/Tuples_Debug.xpphs" #-}
    alignment _ = 4
{-# LINE 426 "WinDll/Lib/Tuples_Debug.xpphs" #-}
    
    poke ptr (a1, a2, a3, a4, a5, a6, a7) = do
        ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) ptr a1
{-# LINE 429 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 4)) ptr a2
{-# LINE 430 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 8)) ptr a3
{-# LINE 431 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 12)) ptr a4
{-# LINE 432 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 16)) ptr a5
{-# LINE 433 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 20)) ptr a6
{-# LINE 434 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 24)) ptr a7
{-# LINE 435 "WinDll/Lib/Tuples_Debug.xpphs" #-}
    peek ptr = do
        a1' <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) ptr
{-# LINE 437 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        a2' <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) ptr
{-# LINE 438 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        a3' <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) ptr
{-# LINE 439 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        a4' <- ((\hsc_ptr -> peekByteOff hsc_ptr 12)) ptr
{-# LINE 440 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        a5' <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) ptr
{-# LINE 441 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        a6' <- ((\hsc_ptr -> peekByteOff hsc_ptr 20)) ptr
{-# LINE 442 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        a7' <- ((\hsc_ptr -> peekByteOff hsc_ptr 24)) ptr
{-# LINE 443 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        return $ (a1', a2', a3', a4', a5', a6', a7')

instance (Storable a, Storable b, Storable c, Storable d, Storable e, Storable f, Storable g, Storable h) => Storable (a, b, c, d, e, f, g, h) where
    sizeOf    _ = (32)
{-# LINE 447 "WinDll/Lib/Tuples_Debug.xpphs" #-}
    alignment _ = 4
{-# LINE 448 "WinDll/Lib/Tuples_Debug.xpphs" #-}
    
    poke ptr (a1, a2, a3, a4, a5, a6, a7, a8) = do
        ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) ptr a1
{-# LINE 451 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 4)) ptr a2
{-# LINE 452 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 8)) ptr a3
{-# LINE 453 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 12)) ptr a4
{-# LINE 454 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 16)) ptr a5
{-# LINE 455 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 20)) ptr a6
{-# LINE 456 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 24)) ptr a7
{-# LINE 457 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 28)) ptr a8
{-# LINE 458 "WinDll/Lib/Tuples_Debug.xpphs" #-}
    peek ptr = do
        a1' <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) ptr
{-# LINE 460 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        a2' <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) ptr
{-# LINE 461 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        a3' <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) ptr
{-# LINE 462 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        a4' <- ((\hsc_ptr -> peekByteOff hsc_ptr 12)) ptr
{-# LINE 463 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        a5' <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) ptr
{-# LINE 464 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        a6' <- ((\hsc_ptr -> peekByteOff hsc_ptr 20)) ptr
{-# LINE 465 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        a7' <- ((\hsc_ptr -> peekByteOff hsc_ptr 24)) ptr
{-# LINE 466 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        a8' <- ((\hsc_ptr -> peekByteOff hsc_ptr 28)) ptr
{-# LINE 467 "WinDll/Lib/Tuples_Debug.xpphs" #-}
        return $ (a1', a2', a3', a4', a5', a6', a7', a8')