-- GENERATED by C->Haskell Compiler, version 0.16.0 Crystal Seed, 24 Jan 2009 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "src/Sound/ALSA/PCM/Core.chs" #-}{-# LANGUAGE ForeignFunctionInterface #-}
module Sound.ALSA.PCM.Core where

import Sound.ALSA.PCM.C2HS
import Sound.ALSA.Exception (checkResult, checkResult_, )



-- HACK for 32-bit machines.
-- This is only used to be able to parse alsa/pcm.h,
-- since snd_pcm_format_silence_64 use u_int64_t which is not
-- defined on 32-bit machines, AFAICT



{-# LINE 19 "src/Sound/ALSA/PCM/Core.chs" #-}

newtype Pcm = Pcm (Ptr (Pcm))
{-# LINE 21 "src/Sound/ALSA/PCM/Core.chs" #-}

instance Storable Pcm where
    sizeOf (Pcm r) = sizeOf r
    alignment (Pcm r) = alignment r
    peek p = fmap Pcm (peek (castPtr p))
    poke p (Pcm r) = poke (castPtr p) r

newtype PcmHwParams = PcmHwParams (Ptr (PcmHwParams))
{-# LINE 29 "src/Sound/ALSA/PCM/Core.chs" #-}

instance Storable PcmHwParams where
    sizeOf (PcmHwParams r) = sizeOf r
    alignment (PcmHwParams r) = alignment r
    peek p = fmap PcmHwParams (peek (castPtr p))
    poke p (PcmHwParams r) = poke (castPtr p) r

newtype PcmSwParams = PcmSwParams (Ptr (PcmSwParams))
{-# LINE 37 "src/Sound/ALSA/PCM/Core.chs" #-}

instance Storable PcmSwParams where
    sizeOf (PcmSwParams r) = sizeOf r
    alignment (PcmSwParams r) = alignment r
    peek p = fmap PcmSwParams (peek (castPtr p))
    poke p (PcmSwParams r) = poke (castPtr p) r

data PcmStream = PcmStreamPlayback
               | PcmStreamCapture
               | PcmStreamLast
               deriving (Eq,Show)
instance Enum PcmStream where
  fromEnum PcmStreamPlayback = 0
  fromEnum PcmStreamCapture = 1
  fromEnum PcmStreamLast = 1

  toEnum 0 = PcmStreamPlayback
  toEnum 1 = PcmStreamCapture
  toEnum 1 = PcmStreamLast
  toEnum unmatched = error ("PcmStream.toEnum: Cannot match " ++ show unmatched)

{-# LINE 45 "src/Sound/ALSA/PCM/Core.chs" #-}

data PcmAccess = PcmAccessMmapInterleaved
               | PcmAccessMmapNoninterleaved
               | PcmAccessMmapComplex
               | PcmAccessRwInterleaved
               | PcmAccessRwNoninterleaved
               | PcmAccessLast
               deriving (Eq,Show)
instance Enum PcmAccess where
  fromEnum PcmAccessMmapInterleaved = 0
  fromEnum PcmAccessMmapNoninterleaved = 1
  fromEnum PcmAccessMmapComplex = 2
  fromEnum PcmAccessRwInterleaved = 3
  fromEnum PcmAccessRwNoninterleaved = 4
  fromEnum PcmAccessLast = 4

  toEnum 0 = PcmAccessMmapInterleaved
  toEnum 1 = PcmAccessMmapNoninterleaved
  toEnum 2 = PcmAccessMmapComplex
  toEnum 3 = PcmAccessRwInterleaved
  toEnum 4 = PcmAccessRwNoninterleaved
  toEnum 4 = PcmAccessLast
  toEnum unmatched = error ("PcmAccess.toEnum: Cannot match " ++ show unmatched)

{-# LINE 47 "src/Sound/ALSA/PCM/Core.chs" #-}

data PcmFormat = PcmFormatUnknown
               | PcmFormatS8
               | PcmFormatU8
               | PcmFormatS16Le
               | PcmFormatS16Be
               | PcmFormatU16Le
               | PcmFormatU16Be
               | PcmFormatS24Le
               | PcmFormatS24Be
               | PcmFormatU24Le
               | PcmFormatU24Be
               | PcmFormatS32Le
               | PcmFormatS32Be
               | PcmFormatU32Le
               | PcmFormatU32Be
               | PcmFormatFloatLe
               | PcmFormatFloatBe
               | PcmFormatFloat64Le
               | PcmFormatFloat64Be
               | PcmFormatIec958SubframeLe
               | PcmFormatIec958SubframeBe
               | PcmFormatMuLaw
               | PcmFormatALaw
               | PcmFormatImaAdpcm
               | PcmFormatMpeg
               | PcmFormatGsm
               | PcmFormatSpecial
               | PcmFormatS243le
               | PcmFormatS243be
               | PcmFormatU243le
               | PcmFormatU243be
               | PcmFormatS203le
               | PcmFormatS203be
               | PcmFormatU203le
               | PcmFormatU203be
               | PcmFormatS183le
               | PcmFormatS183be
               | PcmFormatU183le
               | PcmFormatU183be
               | PcmFormatLast
               | PcmFormatS16
               | PcmFormatU16
               | PcmFormatS24
               | PcmFormatU24
               | PcmFormatS32
               | PcmFormatU32
               | PcmFormatFloat
               | PcmFormatFloat64
               | PcmFormatIec958Subframe
               deriving (Eq,Show)
instance Enum PcmFormat where
  fromEnum PcmFormatUnknown = (-1)
  fromEnum PcmFormatS8 = 0
  fromEnum PcmFormatU8 = 1
  fromEnum PcmFormatS16Le = 2
  fromEnum PcmFormatS16Be = 3
  fromEnum PcmFormatU16Le = 4
  fromEnum PcmFormatU16Be = 5
  fromEnum PcmFormatS24Le = 6
  fromEnum PcmFormatS24Be = 7
  fromEnum PcmFormatU24Le = 8
  fromEnum PcmFormatU24Be = 9
  fromEnum PcmFormatS32Le = 10
  fromEnum PcmFormatS32Be = 11
  fromEnum PcmFormatU32Le = 12
  fromEnum PcmFormatU32Be = 13
  fromEnum PcmFormatFloatLe = 14
  fromEnum PcmFormatFloatBe = 15
  fromEnum PcmFormatFloat64Le = 16
  fromEnum PcmFormatFloat64Be = 17
  fromEnum PcmFormatIec958SubframeLe = 18
  fromEnum PcmFormatIec958SubframeBe = 19
  fromEnum PcmFormatMuLaw = 20
  fromEnum PcmFormatALaw = 21
  fromEnum PcmFormatImaAdpcm = 22
  fromEnum PcmFormatMpeg = 23
  fromEnum PcmFormatGsm = 24
  fromEnum PcmFormatSpecial = 31
  fromEnum PcmFormatS243le = 32
  fromEnum PcmFormatS243be = 33
  fromEnum PcmFormatU243le = 34
  fromEnum PcmFormatU243be = 35
  fromEnum PcmFormatS203le = 36
  fromEnum PcmFormatS203be = 37
  fromEnum PcmFormatU203le = 38
  fromEnum PcmFormatU203be = 39
  fromEnum PcmFormatS183le = 40
  fromEnum PcmFormatS183be = 41
  fromEnum PcmFormatU183le = 42
  fromEnum PcmFormatU183be = 43
  fromEnum PcmFormatLast = 43
  fromEnum PcmFormatS16 = 2
  fromEnum PcmFormatU16 = 4
  fromEnum PcmFormatS24 = 6
  fromEnum PcmFormatU24 = 8
  fromEnum PcmFormatS32 = 10
  fromEnum PcmFormatU32 = 12
  fromEnum PcmFormatFloat = 14
  fromEnum PcmFormatFloat64 = 16
  fromEnum PcmFormatIec958Subframe = 18

  toEnum (-1) = PcmFormatUnknown
  toEnum 0 = PcmFormatS8
  toEnum 1 = PcmFormatU8
  toEnum 2 = PcmFormatS16Le
  toEnum 3 = PcmFormatS16Be
  toEnum 4 = PcmFormatU16Le
  toEnum 5 = PcmFormatU16Be
  toEnum 6 = PcmFormatS24Le
  toEnum 7 = PcmFormatS24Be
  toEnum 8 = PcmFormatU24Le
  toEnum 9 = PcmFormatU24Be
  toEnum 10 = PcmFormatS32Le
  toEnum 11 = PcmFormatS32Be
  toEnum 12 = PcmFormatU32Le
  toEnum 13 = PcmFormatU32Be
  toEnum 14 = PcmFormatFloatLe
  toEnum 15 = PcmFormatFloatBe
  toEnum 16 = PcmFormatFloat64Le
  toEnum 17 = PcmFormatFloat64Be
  toEnum 18 = PcmFormatIec958SubframeLe
  toEnum 19 = PcmFormatIec958SubframeBe
  toEnum 20 = PcmFormatMuLaw
  toEnum 21 = PcmFormatALaw
  toEnum 22 = PcmFormatImaAdpcm
  toEnum 23 = PcmFormatMpeg
  toEnum 24 = PcmFormatGsm
  toEnum 31 = PcmFormatSpecial
  toEnum 32 = PcmFormatS243le
  toEnum 33 = PcmFormatS243be
  toEnum 34 = PcmFormatU243le
  toEnum 35 = PcmFormatU243be
  toEnum 36 = PcmFormatS203le
  toEnum 37 = PcmFormatS203be
  toEnum 38 = PcmFormatU203le
  toEnum 39 = PcmFormatU203be
  toEnum 40 = PcmFormatS183le
  toEnum 41 = PcmFormatS183be
  toEnum 42 = PcmFormatU183le
  toEnum 43 = PcmFormatU183be
  toEnum 43 = PcmFormatLast
  toEnum 2 = PcmFormatS16
  toEnum 4 = PcmFormatU16
  toEnum 6 = PcmFormatS24
  toEnum 8 = PcmFormatU24
  toEnum 10 = PcmFormatS32
  toEnum 12 = PcmFormatU32
  toEnum 14 = PcmFormatFloat
  toEnum 16 = PcmFormatFloat64
  toEnum 18 = PcmFormatIec958Subframe
  toEnum unmatched = error ("PcmFormat.toEnum: Cannot match " ++ show unmatched)

{-# LINE 49 "src/Sound/ALSA/PCM/Core.chs" #-}

pcm_open :: String -> PcmStream -> Int -> IO (Pcm)
pcm_open a2 a3 a4 =
  alloca $ \a1' -> 
  withCString a2 $ \a2' -> 
  let {a3' = cFromEnum a3} in 
  let {a4' = cIntConv a4} in 
  pcm_open'_ a1' a2' a3' a4' >>= \res ->
  peek a1'>>= \a1'' -> 
  result res >> 
  return (a1'')
{-# LINE 56 "src/Sound/ALSA/PCM/Core.chs" #-}
  where result = checkResult_ "pcm_open"

pcm_close :: Pcm -> IO ()
pcm_close a1 =
  let {a1' = id a1} in 
  pcm_close'_ a1' >>= \res ->
  result res >> 
  return ()
{-# LINE 61 "src/Sound/ALSA/PCM/Core.chs" #-}
  where result = checkResult_ "pcm_close"

pcm_prepare :: Pcm -> IO ()
pcm_prepare a1 =
  let {a1' = id a1} in 
  pcm_prepare'_ a1' >>= \res ->
  result res >> 
  return ()
{-# LINE 66 "src/Sound/ALSA/PCM/Core.chs" #-}
  where result = checkResult_ "pcm_prepare"

pcm_start :: Pcm -> IO ()
pcm_start a1 =
  let {a1' = id a1} in 
  pcm_start'_ a1' >>= \res ->
  result res >> 
  return ()
{-# LINE 71 "src/Sound/ALSA/PCM/Core.chs" #-}
  where result = checkResult_ "pcm_start"

pcm_drop :: Pcm -> IO ()
pcm_drop a1 =
  let {a1' = id a1} in 
  pcm_drop'_ a1' >>= \res ->
  result res >> 
  return ()
{-# LINE 76 "src/Sound/ALSA/PCM/Core.chs" #-}
  where result = checkResult_ "pcm_drop"

pcm_drain :: Pcm -> IO ()
pcm_drain a1 =
  let {a1' = id a1} in 
  pcm_drain'_ a1' >>= \res ->
  result res >> 
  return ()
{-# LINE 81 "src/Sound/ALSA/PCM/Core.chs" #-}
  where result = checkResult_ "pcm_drain"

{-
-- Only available in 1.0.11rc3 and later
{#fun pcm_set_params
  { id `Pcm',
    cFromEnum `PcmFormat',
    cFromEnum `PcmAccess',
    `Int',
    `Int',
    `Bool',
    `Int' }
 -> `()' result*- #}
  where result = checkResult_ "pcm_set_params"
-}

pcm_hw_params :: Pcm -> PcmHwParams -> IO ()
pcm_hw_params a1 a2 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  pcm_hw_params'_ a1' a2' >>= \res ->
  result res >> 
  return ()
{-# LINE 101 "src/Sound/ALSA/PCM/Core.chs" #-}
  where result = checkResult_ "pcm_hw_params"

pcm_hw_params_any :: Pcm -> PcmHwParams -> IO ()
pcm_hw_params_any a1 a2 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  pcm_hw_params_any'_ a1' a2' >>= \res ->
  result res >> 
  return ()
{-# LINE 107 "src/Sound/ALSA/PCM/Core.chs" #-}
  where result = checkResult_ "pcm_hw_params_any"

pcm_hw_params_set_access :: Pcm -> PcmHwParams -> PcmAccess -> IO ()
pcm_hw_params_set_access a1 a2 a3 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  let {a3' = cFromEnum a3} in 
  pcm_hw_params_set_access'_ a1' a2' a3' >>= \res ->
  result res >> 
  return ()
{-# LINE 115 "src/Sound/ALSA/PCM/Core.chs" #-}
  where result = checkResult_ "pcm_hw_params_set_access"

pcm_hw_params_set_format :: Pcm -> PcmHwParams -> PcmFormat -> IO ()
pcm_hw_params_set_format a1 a2 a3 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  let {a3' = cFromEnum a3} in 
  pcm_hw_params_set_format'_ a1' a2' a3' >>= \res ->
  result res >> 
  return ()
{-# LINE 123 "src/Sound/ALSA/PCM/Core.chs" #-}
  where result = checkResult_ "pcm_hw_params_set_format"

pcm_hw_params_set_rate :: Pcm -> PcmHwParams -> Int -> Ordering -> IO ()
pcm_hw_params_set_rate a1 a2 a3 a4 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  let {a3' = cIntConv a3} in 
  let {a4' = orderingToInt a4} in 
  pcm_hw_params_set_rate'_ a1' a2' a3' a4' >>= \res ->
  result res >> 
  return ()
{-# LINE 132 "src/Sound/ALSA/PCM/Core.chs" #-}
  where result = checkResult_ "pcm_hw_params_set_rate"

{-
-- Available in 1.0.9rc2 and later
{#fun pcm_hw_params_set_rate_resample
  { id `Pcm',
    id `PcmHwParams',
    `Bool'
 }
 -> `()' result*- #}
  where result = checkResult_ "pcm_hw_params_set_rate_resample"
-}

pcm_hw_params_set_channels :: Pcm -> PcmHwParams -> Int -> IO ()
pcm_hw_params_set_channels a1 a2 a3 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  let {a3' = cIntConv a3} in 
  pcm_hw_params_set_channels'_ a1' a2' a3' >>= \res ->
  result res >> 
  return ()
{-# LINE 151 "src/Sound/ALSA/PCM/Core.chs" #-}
  where result = checkResult_ "pcm_hw_params_set_channels"

pcm_hw_params_set_buffer_size :: Pcm -> PcmHwParams -> Int -> IO ()
pcm_hw_params_set_buffer_size a1 a2 a3 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  let {a3' = cIntConv a3} in 
  pcm_hw_params_set_buffer_size'_ a1' a2' a3' >>= \res ->
  result res >> 
  return ()
{-# LINE 159 "src/Sound/ALSA/PCM/Core.chs" #-}
  where result = checkResult_ "pcm_hw_params_set_buffer_size"

pcm_hw_params_get_buffer_size :: PcmHwParams -> IO (Int)
pcm_hw_params_get_buffer_size a1 =
  let {a1' = id a1} in 
  alloca $ \a2' -> 
  pcm_hw_params_get_buffer_size'_ a1' a2' >>= \res ->
  peekIntConv a2'>>= \a2'' -> 
  result res >> 
  return (a2'')
{-# LINE 166 "src/Sound/ALSA/PCM/Core.chs" #-}
  where result = checkResult_ "pcm_hw_params_get_buffer_size"

pcm_hw_params_get_period_size :: PcmHwParams -> IO (Int, Ordering)
pcm_hw_params_get_period_size a1 =
  let {a1' = id a1} in 
  alloca $ \a2' -> 
  alloca $ \a3' -> 
  pcm_hw_params_get_period_size'_ a1' a2' a3' >>= \res ->
  peekIntConv a2'>>= \a2'' -> 
  peekOrdering a3'>>= \a3'' -> 
  result res >> 
  return (a2'', a3'')
{-# LINE 174 "src/Sound/ALSA/PCM/Core.chs" #-}
  where result = checkResult_ "pcm_hw_params_get_period_size"

pcm_hw_params_set_period_time_near :: Pcm -> PcmHwParams -> Int -> Ordering -> IO (Int, Ordering)
pcm_hw_params_set_period_time_near a1 a2 a3 a4 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  withIntConv a3 $ \a3' -> 
  withOrdering a4 $ \a4' -> 
  pcm_hw_params_set_period_time_near'_ a1' a2' a3' a4' >>= \res ->
  peekIntConv a3'>>= \a3'' -> 
  peekOrdering a4'>>= \a4'' -> 
  result res >> 
  return (a3'', a4'')
{-# LINE 183 "src/Sound/ALSA/PCM/Core.chs" #-}
  where result = checkResult_ "pcm_hw_params_set_period_time_near"

pcm_hw_params_set_periods :: Pcm -> PcmHwParams -> Int -> Ordering -> IO ()
pcm_hw_params_set_periods a1 a2 a3 a4 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  let {a3' = cIntConv a3} in 
  let {a4' = orderingToInt a4} in 
  pcm_hw_params_set_periods'_ a1' a2' a3' a4' >>= \res ->
  result res >> 
  return ()
{-# LINE 192 "src/Sound/ALSA/PCM/Core.chs" #-}
  where result = checkResult_ "pcm_hw_params_set_periods"

pcm_hw_params_set_buffer_time_near :: Pcm -> PcmHwParams -> Int -> Ordering -> IO (Int, Ordering)
pcm_hw_params_set_buffer_time_near a1 a2 a3 a4 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  withIntConv a3 $ \a3' -> 
  withOrdering a4 $ \a4' -> 
  pcm_hw_params_set_buffer_time_near'_ a1' a2' a3' a4' >>= \res ->
  peekIntConv a3'>>= \a3'' -> 
  peekOrdering a4'>>= \a4'' -> 
  result res >> 
  return (a3'', a4'')
{-# LINE 201 "src/Sound/ALSA/PCM/Core.chs" #-}
  where result = checkResult_ "pcm_hw_params_set_buffer_time_near"

pcm_hw_params_get_buffer_time :: PcmHwParams -> IO (Int, Ordering)
pcm_hw_params_get_buffer_time a1 =
  let {a1' = id a1} in 
  alloca $ \a2' -> 
  alloca $ \a3' -> 
  pcm_hw_params_get_buffer_time'_ a1' a2' a3' >>= \res ->
  peekIntConv a2'>>= \a2'' -> 
  peekOrdering a3'>>= \a3'' -> 
  result res >> 
  return (a2'', a3'')
{-# LINE 209 "src/Sound/ALSA/PCM/Core.chs" #-}
  where result = checkResult_ "pcm_hw_params_get_buffer_time"

pcm_sw_params_set_start_threshold :: Pcm -> PcmSwParams -> Int -> IO ()
pcm_sw_params_set_start_threshold a1 a2 a3 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  let {a3' = cIntConv a3} in 
  pcm_sw_params_set_start_threshold'_ a1' a2' a3' >>= \res ->
  result res >> 
  return ()
{-# LINE 217 "src/Sound/ALSA/PCM/Core.chs" #-}
  where result = checkResult_ "pcm_sw_params_set_start_threshold"

pcm_sw_params_set_avail_min :: Pcm -> PcmSwParams -> Int -> IO ()
pcm_sw_params_set_avail_min a1 a2 a3 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  let {a3' = cIntConv a3} in 
  pcm_sw_params_set_avail_min'_ a1' a2' a3' >>= \res ->
  result res >> 
  return ()
{-# LINE 225 "src/Sound/ALSA/PCM/Core.chs" #-}
  where result = checkResult_ "pcm_sw_params_set_avail_min"

pcm_sw_params_set_xfer_align :: Pcm -> PcmSwParams -> Int -> IO ()
pcm_sw_params_set_xfer_align a1 a2 a3 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  let {a3' = cIntConv a3} in 
  pcm_sw_params_set_xfer_align'_ a1' a2' a3' >>= \res ->
  result res >> 
  return ()
{-# LINE 232 "src/Sound/ALSA/PCM/Core.chs" #-}
  where result = checkResult_ "pcm_sw_params_set_xfer_align"

pcm_sw_params_set_silence_threshold :: Pcm -> PcmSwParams -> Int -> IO ()
pcm_sw_params_set_silence_threshold a1 a2 a3 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  let {a3' = cIntConv a3} in 
  pcm_sw_params_set_silence_threshold'_ a1' a2' a3' >>= \res ->
  result res >> 
  return ()
{-# LINE 239 "src/Sound/ALSA/PCM/Core.chs" #-}
  where result = checkResult_ "pcm_sw_params_set_silence_threshold"

pcm_sw_params_set_silence_size :: Pcm -> PcmSwParams -> Int -> IO ()
pcm_sw_params_set_silence_size a1 a2 a3 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  let {a3' = cIntConv a3} in 
  pcm_sw_params_set_silence_size'_ a1' a2' a3' >>= \res ->
  result res >> 
  return ()
{-# LINE 246 "src/Sound/ALSA/PCM/Core.chs" #-}
  where result = checkResult_ "pcm_sw_params_set_silence_size"

pcm_readi :: Pcm -> Ptr a -> Int -> IO (Int)
pcm_readi a1 a2 a3 =
  let {a1' = id a1} in 
  let {a2' = castPtr a2} in 
  let {a3' = cIntConv a3} in 
  pcm_readi'_ a1' a2' a3' >>= \res ->
  result res >>= \res' ->
  return (res')
{-# LINE 254 "src/Sound/ALSA/PCM/Core.chs" #-}
  where result = fmap fromIntegral . checkResult "pcm_readi"

pcm_writei :: Pcm -> Ptr a -> Int -> IO (Int)
pcm_writei a1 a2 a3 =
  let {a1' = id a1} in 
  let {a2' = castPtr a2} in 
  let {a3' = cIntConv a3} in 
  pcm_writei'_ a1' a2' a3' >>= \res ->
  result res >>= \res' ->
  return (res')
{-# LINE 262 "src/Sound/ALSA/PCM/Core.chs" #-}
  where result = fmap fromIntegral . checkResult "pcm_writei"

pcm_hw_params_malloc :: IO (PcmHwParams)
pcm_hw_params_malloc =
  alloca $ \a1' -> 
  pcm_hw_params_malloc'_ a1' >>= \res ->
  peek a1'>>= \a1'' -> 
  result res >> 
  return (a1'')
{-# LINE 267 "src/Sound/ALSA/PCM/Core.chs" #-}
  where result = checkResult_ "pcm_hw_params_malloc"

pcm_hw_params_free :: PcmHwParams -> IO ()
pcm_hw_params_free a1 =
  let {a1' = id a1} in 
  pcm_hw_params_free'_ a1' >>= \res ->
  return ()
{-# LINE 272 "src/Sound/ALSA/PCM/Core.chs" #-}

pcm_sw_params_malloc :: IO (PcmSwParams)
pcm_sw_params_malloc =
  alloca $ \a1' -> 
  pcm_sw_params_malloc'_ a1' >>= \res ->
  peek a1'>>= \a1'' -> 
  result res >> 
  return (a1'')
{-# LINE 276 "src/Sound/ALSA/PCM/Core.chs" #-}
  where result = checkResult_ "pcm_sw_params_malloc"

pcm_sw_params_free :: PcmSwParams -> IO ()
pcm_sw_params_free a1 =
  let {a1' = id a1} in 
  pcm_sw_params_free'_ a1' >>= \res ->
  return ()
{-# LINE 281 "src/Sound/ALSA/PCM/Core.chs" #-}

pcm_sw_params :: Pcm -> PcmSwParams -> IO ()
pcm_sw_params a1 a2 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  pcm_sw_params'_ a1' a2' >>= \res ->
  result res >> 
  return ()
{-# LINE 286 "src/Sound/ALSA/PCM/Core.chs" #-}
  where result = checkResult_ "pcm_sw_params"

pcm_sw_params_current :: Pcm -> PcmSwParams -> IO ()
pcm_sw_params_current a1 a2 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  pcm_sw_params_current'_ a1' a2' >>= \res ->
  result res >> 
  return ()
{-# LINE 292 "src/Sound/ALSA/PCM/Core.chs" #-}
  where result = checkResult_ "pcm_sw_params_current"

--
-- * Marshalling utilities
--

orderingToInt :: Ordering -> CInt
orderingToInt o = fromIntegral (fromEnum o - 1)

intToOrdering :: CInt -> Ordering
intToOrdering i = toEnum (fromIntegral i + 1)

peekOrdering :: Ptr CInt -> IO Ordering
peekOrdering = fmap intToOrdering . peek

withOrdering :: Ordering -> (Ptr CInt -> IO a) -> IO a
withOrdering o = with (orderingToInt o)

foreign import ccall safe "Sound/ALSA/PCM/Core.chs.h snd_pcm_open"
  pcm_open'_ :: ((Ptr (Pcm)) -> ((Ptr CChar) -> (CInt -> (CInt -> (IO CInt)))))

foreign import ccall safe "Sound/ALSA/PCM/Core.chs.h snd_pcm_close"
  pcm_close'_ :: ((Pcm) -> (IO CInt))

foreign import ccall safe "Sound/ALSA/PCM/Core.chs.h snd_pcm_prepare"
  pcm_prepare'_ :: ((Pcm) -> (IO CInt))

foreign import ccall safe "Sound/ALSA/PCM/Core.chs.h snd_pcm_start"
  pcm_start'_ :: ((Pcm) -> (IO CInt))

foreign import ccall safe "Sound/ALSA/PCM/Core.chs.h snd_pcm_drop"
  pcm_drop'_ :: ((Pcm) -> (IO CInt))

foreign import ccall safe "Sound/ALSA/PCM/Core.chs.h snd_pcm_drain"
  pcm_drain'_ :: ((Pcm) -> (IO CInt))

foreign import ccall safe "Sound/ALSA/PCM/Core.chs.h snd_pcm_hw_params"
  pcm_hw_params'_ :: ((Pcm) -> ((PcmHwParams) -> (IO CInt)))

foreign import ccall safe "Sound/ALSA/PCM/Core.chs.h snd_pcm_hw_params_any"
  pcm_hw_params_any'_ :: ((Pcm) -> ((PcmHwParams) -> (IO CInt)))

foreign import ccall safe "Sound/ALSA/PCM/Core.chs.h snd_pcm_hw_params_set_access"
  pcm_hw_params_set_access'_ :: ((Pcm) -> ((PcmHwParams) -> (CInt -> (IO CInt))))

foreign import ccall safe "Sound/ALSA/PCM/Core.chs.h snd_pcm_hw_params_set_format"
  pcm_hw_params_set_format'_ :: ((Pcm) -> ((PcmHwParams) -> (CInt -> (IO CInt))))

foreign import ccall safe "Sound/ALSA/PCM/Core.chs.h snd_pcm_hw_params_set_rate"
  pcm_hw_params_set_rate'_ :: ((Pcm) -> ((PcmHwParams) -> (CUInt -> (CInt -> (IO CInt)))))

foreign import ccall safe "Sound/ALSA/PCM/Core.chs.h snd_pcm_hw_params_set_channels"
  pcm_hw_params_set_channels'_ :: ((Pcm) -> ((PcmHwParams) -> (CUInt -> (IO CInt))))

foreign import ccall safe "Sound/ALSA/PCM/Core.chs.h snd_pcm_hw_params_set_buffer_size"
  pcm_hw_params_set_buffer_size'_ :: ((Pcm) -> ((PcmHwParams) -> (CULong -> (IO CInt))))

foreign import ccall safe "Sound/ALSA/PCM/Core.chs.h snd_pcm_hw_params_get_buffer_size"
  pcm_hw_params_get_buffer_size'_ :: ((PcmHwParams) -> ((Ptr CULong) -> (IO CInt)))

foreign import ccall safe "Sound/ALSA/PCM/Core.chs.h snd_pcm_hw_params_get_period_size"
  pcm_hw_params_get_period_size'_ :: ((PcmHwParams) -> ((Ptr CULong) -> ((Ptr CInt) -> (IO CInt))))

foreign import ccall safe "Sound/ALSA/PCM/Core.chs.h snd_pcm_hw_params_set_period_time_near"
  pcm_hw_params_set_period_time_near'_ :: ((Pcm) -> ((PcmHwParams) -> ((Ptr CUInt) -> ((Ptr CInt) -> (IO CInt)))))

foreign import ccall safe "Sound/ALSA/PCM/Core.chs.h snd_pcm_hw_params_set_periods"
  pcm_hw_params_set_periods'_ :: ((Pcm) -> ((PcmHwParams) -> (CUInt -> (CInt -> (IO CInt)))))

foreign import ccall safe "Sound/ALSA/PCM/Core.chs.h snd_pcm_hw_params_set_buffer_time_near"
  pcm_hw_params_set_buffer_time_near'_ :: ((Pcm) -> ((PcmHwParams) -> ((Ptr CUInt) -> ((Ptr CInt) -> (IO CInt)))))

foreign import ccall safe "Sound/ALSA/PCM/Core.chs.h snd_pcm_hw_params_get_buffer_time"
  pcm_hw_params_get_buffer_time'_ :: ((PcmHwParams) -> ((Ptr CUInt) -> ((Ptr CInt) -> (IO CInt))))

foreign import ccall safe "Sound/ALSA/PCM/Core.chs.h snd_pcm_sw_params_set_start_threshold"
  pcm_sw_params_set_start_threshold'_ :: ((Pcm) -> ((PcmSwParams) -> (CULong -> (IO CInt))))

foreign import ccall safe "Sound/ALSA/PCM/Core.chs.h snd_pcm_sw_params_set_avail_min"
  pcm_sw_params_set_avail_min'_ :: ((Pcm) -> ((PcmSwParams) -> (CULong -> (IO CInt))))

foreign import ccall safe "Sound/ALSA/PCM/Core.chs.h snd_pcm_sw_params_set_xfer_align"
  pcm_sw_params_set_xfer_align'_ :: ((Pcm) -> ((PcmSwParams) -> (CULong -> (IO CInt))))

foreign import ccall safe "Sound/ALSA/PCM/Core.chs.h snd_pcm_sw_params_set_silence_threshold"
  pcm_sw_params_set_silence_threshold'_ :: ((Pcm) -> ((PcmSwParams) -> (CULong -> (IO CInt))))

foreign import ccall safe "Sound/ALSA/PCM/Core.chs.h snd_pcm_sw_params_set_silence_size"
  pcm_sw_params_set_silence_size'_ :: ((Pcm) -> ((PcmSwParams) -> (CULong -> (IO CInt))))

foreign import ccall safe "Sound/ALSA/PCM/Core.chs.h snd_pcm_readi"
  pcm_readi'_ :: ((Pcm) -> ((Ptr ()) -> (CULong -> (IO CLong))))

foreign import ccall safe "Sound/ALSA/PCM/Core.chs.h snd_pcm_writei"
  pcm_writei'_ :: ((Pcm) -> ((Ptr ()) -> (CULong -> (IO CLong))))

foreign import ccall safe "Sound/ALSA/PCM/Core.chs.h snd_pcm_hw_params_malloc"
  pcm_hw_params_malloc'_ :: ((Ptr (PcmHwParams)) -> (IO CInt))

foreign import ccall safe "Sound/ALSA/PCM/Core.chs.h snd_pcm_hw_params_free"
  pcm_hw_params_free'_ :: ((PcmHwParams) -> (IO ()))

foreign import ccall safe "Sound/ALSA/PCM/Core.chs.h snd_pcm_sw_params_malloc"
  pcm_sw_params_malloc'_ :: ((Ptr (PcmSwParams)) -> (IO CInt))

foreign import ccall safe "Sound/ALSA/PCM/Core.chs.h snd_pcm_sw_params_free"
  pcm_sw_params_free'_ :: ((PcmSwParams) -> (IO ()))

foreign import ccall safe "Sound/ALSA/PCM/Core.chs.h snd_pcm_sw_params"
  pcm_sw_params'_ :: ((Pcm) -> ((PcmSwParams) -> (IO CInt)))

foreign import ccall safe "Sound/ALSA/PCM/Core.chs.h snd_pcm_sw_params_current"
  pcm_sw_params_current'_ :: ((Pcm) -> ((PcmSwParams) -> (IO CInt)))