Unboxed.hs

{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS -fno-warn-orphans #-}
module Data.Fixed.Binary.Unboxed () where

import Control.Monad
import Data.Function
import Unsafe.Coerce

import qualified Data.Vector.Generic as VG
import qualified Data.Vector.Generic.Mutable as VGM
import qualified Data.Vector.Unboxed as VU

import Data.Fixed.Binary

fixed :: a -> Fixed r a
fixed = unsafeCoerce

unFixed :: Fixed r a -> a
unFixed = unsafeCoerce

newtype instance VU.MVector s (Fixed r a) = MVFixed { unMVFixed :: VU.MVector s a }
newtype instance VU.Vector    (Fixed r a) = VFixed  { unVFixed  :: VU.Vector    a }

instance VGM.MVector VU.MVector a => VGM.MVector VU.MVector (Fixed r a) where
  {-# INLINE basicLength #-}
  basicLength                     = VGM.basicLength . unMVFixed
  {-# INLINE basicUnsafeSlice #-}
  basicUnsafeSlice i n            = MVFixed . VGM.basicUnsafeSlice i n . unMVFixed
  {-# INLINE basicOverlaps #-}
  basicOverlaps                   = VGM.basicOverlaps `on` unMVFixed
  {-# INLINE basicUnsafeNew #-}
  basicUnsafeNew                  = liftM MVFixed . VGM.basicUnsafeNew
  {-# INLINE basicUnsafeReplicate #-}
  basicUnsafeReplicate n          = liftM MVFixed . VGM.basicUnsafeReplicate n . unFixed
  {-# INLINE basicUnsafeRead #-}
  basicUnsafeRead (MVFixed mv)    = liftM fixed . VGM.basicUnsafeRead mv
  {-# INLINE basicUnsafeWrite #-}
  basicUnsafeWrite (MVFixed mv) i = VGM.basicUnsafeWrite mv i . unFixed
  {-# INLINE basicClear #-}
  basicClear                      = VGM.basicClear . unMVFixed
  {-# INLINE basicSet #-}
  basicSet (MVFixed mv)           = VGM.basicSet mv . unFixed
  {-# INLINE basicUnsafeCopy #-}
  basicUnsafeCopy                 = VGM.basicUnsafeCopy `on` unMVFixed
  {-# INLINE basicUnsafeGrow #-}
  basicUnsafeGrow (MVFixed mv)    = liftM MVFixed . VGM.basicUnsafeGrow mv

instance VG.Vector VU.Vector a => VG.Vector VU.Vector (Fixed r a) where
  {-# INLINE basicUnsafeFreeze #-}
  basicUnsafeFreeze            = liftM VFixed . VG.basicUnsafeFreeze . unMVFixed
  {-# INLINE basicUnsafeThaw #-}
  basicUnsafeThaw              = liftM MVFixed . VG.basicUnsafeThaw . unVFixed
  {-# INLINE basicLength #-}
  basicLength                  = VG.basicLength . unVFixed
  {-# INLINE basicUnsafeSlice #-}
  basicUnsafeSlice i n         = VFixed . VG.basicUnsafeSlice i n . unVFixed
  {-# INLINE basicUnsafeIndexM #-}
  basicUnsafeIndexM (VFixed v) = liftM fixed . VG.basicUnsafeIndexM v
  {-# INLINE basicUnsafeCopy #-}
  basicUnsafeCopy (MVFixed mv) = VG.basicUnsafeCopy mv . unVFixed
  {-# INLINE elemseq #-}
  elemseq (VFixed v)           = VG.elemseq v . unFixed

instance VU.Unbox a => VU.Unbox (Fixed r a)