{-# 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.Multi.Value as MultiValue
import qualified LLVM.Extra.Marshal as Marshal
import qualified LLVM.Extra.Tuple as Tuple
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 $ \(MultiValue.Cons x) -> MultiValue.Cons x

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


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

instance Single Int where
   switchSingle x = x


instance Tuple.Value Int where
   type ValueOf Int = LLVM.Value Word
   valueOf (Int x) = LLVM.valueOf x

instance MultiValue.C Int where
   cons (Int x) = MultiValue.consPrimitive x
   undef = MultiValue.undefPrimitive
   zero = MultiValue.zeroPrimitive
   phi = MultiValue.phiPrimitive
   addPhi = MultiValue.addPhiPrimitive

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

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

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

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

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


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

instance Marshal.MV Int where