Int.hs

{-# LANGUAGE TypeFamilies #-}
module Data.Array.Knead.Shape.Cubic.Int (
   Single(..),
   Int(Int), cons, decons,
   ) where

import qualified Data.Array.Knead.Expression as Expr

import qualified LLVM.Extra.Nice.Value.Marshal as Marshal
import qualified LLVM.Extra.Nice.Value as NiceValue
import qualified LLVM.Extra.Arithmetic as A

import qualified LLVM.Core as LLVM

import Data.Word (Word)

import Prelude hiding (Int, head, tail, )


newtype Int = Int Word

cons :: (Expr.Value val) => val Word -> val Int
cons = Expr.lift1 $ \(NiceValue.Cons x) -> NiceValue.Cons x

decons :: (Expr.Value val) => val Int -> val Word
decons = Expr.lift1 $ \(NiceValue.Cons x) -> NiceValue.Cons x


class Single ix where
   switchSingle :: f Int -> f ix

instance Single Int where
   switchSingle x = x


instance NiceValue.C Int where
   type Repr Int = LLVM.Value Word
   cons (Int x) = NiceValue.consPrimitive x
   undef = NiceValue.undefPrimitive
   zero = NiceValue.zeroPrimitive
   phi = NiceValue.phiPrimitive
   addPhi = NiceValue.addPhiPrimitive

instance NiceValue.Additive Int where
   add = NiceValue.liftM2 A.add
   sub = NiceValue.liftM2 A.sub
   neg = NiceValue.liftM A.neg

instance NiceValue.PseudoRing Int where
   mul = NiceValue.liftM2 A.mul

instance NiceValue.Real Int where
   min = NiceValue.liftM2 A.min
   max = NiceValue.liftM2 A.max
   abs = NiceValue.liftM A.abs
   signum = NiceValue.liftM A.signum

instance NiceValue.IntegerConstant Int where
   fromInteger' = cons . A.fromInteger'

instance NiceValue.Comparison Int where
   cmp mode = NiceValue.liftM2 $ A.cmp mode


instance Marshal.C Int where
   pack (Int i) = i
   unpack = Int