{-# LANGUAGE TypeFamilies #-}
module Data.Array.Knead.Index.Linear.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.Arithmetic as A

import Data.Word (Word32, )

import Prelude hiding (Int, head, tail, )


newtype Int = Int Word32

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

decons :: (Expr.Value val) => val Int -> val Word32
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 MultiValue.C Int where
   type Repr f Int = f Word32
   cons (Int x) = MultiValue.consPrimitive x
   undef = MultiValue.undefPrimitive
   zero = MultiValue.zeroPrimitive
   phis = MultiValue.phisPrimitive
   addPhis = MultiValue.addPhisPrimitive

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