Data.hs

{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE ScopedTypeVariables #-}
module LLVM.Core.Data (
    IntN(..), WordN(..), FP128(..),
    Array(..), Vector(..), Label, Struct(..), PackedStruct(..),
    FixedList,
    ) where

import qualified LLVM.Core.UnaryVector as UnaryVector
import LLVM.Core.UnaryVector (FixedList)

import qualified Type.Data.Num.Decimal.Proof as DecProof
import qualified Type.Data.Num.Decimal.Number as Dec
import Type.Base.Proxy (Proxy(Proxy))

import qualified Data.Foldable as Fold
import qualified Data.Bits as Bits

import Data.Typeable (Typeable)


-- TODO:
-- Make instances IntN, WordN to actually do the right thing.
-- Make FP128 do the right thing
-- Make Array functions.

-- |Variable sized signed integer.
-- The /n/ parameter should belong to @PosI@.
newtype IntN n = IntN Integer
    deriving (Show, Eq, Ord, Typeable)

instance (Dec.Positive n) => Bounded (IntN n) where
    minBound =
        withBitSize $
        IntN . negate . Bits.shiftL 1 . subtract 1 . Dec.integralFromProxy
    maxBound =
        withBitSize $
        IntN . subtract 1 . Bits.shiftL 1 . subtract 1 . Dec.integralFromProxy

-- |Variable sized unsigned integer.
-- The /n/ parameter should belong to @PosI@.
newtype WordN n = WordN Integer
    deriving (Show, Eq, Ord, Typeable)

instance (Dec.Positive n) => Bounded (WordN n) where
    minBound = WordN 0
    maxBound =
        withBitSize $ WordN . subtract 1 . Bits.shiftL 1 . Dec.integralFromProxy

withBitSize :: (Proxy n -> f n) -> f n
withBitSize f = f Proxy

-- |128 bit floating point.
newtype FP128 = FP128 Rational
    deriving (Show, Typeable)


-- |Fixed sized arrays, the array size is encoded in the /n/ parameter.
newtype Array n a = Array [a]
    deriving (Show, Typeable)

-- |Fixed sized vector, the array size is encoded in the /n/ parameter.
newtype Vector n a = Vector (FixedList (Dec.ToUnary n) a)

instance (Dec.Natural n, Show a) => Show (Vector n a) where
    showsPrec p (Vector xs) =
        case DecProof.unaryNat :: DecProof.UnaryNat n of
            DecProof.UnaryNat ->
                showParen (p>10) $
                    showString "Vector " .
                    showList (Fold.toList
                        (UnaryVector.fromFixedList xs
                            :: UnaryVector.T (Dec.ToUnary n) a))

-- |Label type, produced by a basic block.
data Label
    deriving (Typeable)

-- |Struct types; a list (nested tuple) of component types.
newtype Struct a = Struct a
    deriving (Show, Typeable)
newtype PackedStruct a = PackedStruct a
    deriving (Show, Typeable)