Instance.hs

{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module LLVM.Extra.Nice.Vector.Instance where

import qualified LLVM.Extra.Nice.Vector as Vector
import qualified LLVM.Extra.Nice.Value.Private as NiceValue
import LLVM.Extra.Nice.Value.Private (Repr, )

import qualified LLVM.Core as LLVM

import qualified Type.Data.Num.Decimal as TypeNum

import Data.Functor ((<$>), )

import Prelude2010
import Prelude ()


type NVVector n a = NiceValue.T (LLVM.Vector n a)

toNiceValue :: Vector.T n a -> NVVector n a
toNiceValue (Vector.Cons x) = NiceValue.Cons x

fromNiceValue :: NVVector n a -> Vector.T n a
fromNiceValue (NiceValue.Cons x) = Vector.Cons x

liftNiceValueM ::
   (Functor f) =>
   (Vector.T n a -> f (Vector.T m b)) ->
   (NVVector n a -> f (NVVector m b))
liftNiceValueM f a =
   toNiceValue <$> f (fromNiceValue a)

liftNiceValueM2 ::
   (Functor f) =>
   (Vector.T n a -> Vector.T m b -> f (Vector.T k c)) ->
   (NVVector n a -> NVVector m b -> f (NVVector k c))
liftNiceValueM2 f a b =
   toNiceValue <$> f (fromNiceValue a) (fromNiceValue b)

liftNiceValueM3 ::
   (Functor f) =>
   (Vector.T n a -> Vector.T m b -> Vector.T m c -> f (Vector.T k d)) ->
   (NVVector n a -> NVVector m b -> NVVector m c -> f (NVVector k d))
liftNiceValueM3 f a b c =
   toNiceValue <$> f (fromNiceValue a) (fromNiceValue b) (fromNiceValue c)

instance
   (TypeNum.Positive n, Vector.C a) =>
      NiceValue.C (LLVM.Vector n a) where
   type Repr (LLVM.Vector n a) = Vector.Repr n a
   cons = toNiceValue . Vector.cons
   undef = toNiceValue Vector.undef
   zero = toNiceValue Vector.zero
   phi = liftNiceValueM . Vector.phi
   addPhi bb x y = Vector.addPhi bb (fromNiceValue x) (fromNiceValue y)

instance
   (TypeNum.Positive n, Vector.IntegerConstant a) =>
      NiceValue.IntegerConstant (LLVM.Vector n a) where
   fromInteger' = toNiceValue . Vector.fromInteger'

instance
   (TypeNum.Positive n, Vector.RationalConstant a) =>
      NiceValue.RationalConstant (LLVM.Vector n a) where
   fromRational' = toNiceValue . Vector.fromRational'

instance
   (TypeNum.Positive n, Vector.Additive a) =>
      NiceValue.Additive (LLVM.Vector n a) where
   add = liftNiceValueM2 Vector.add
   sub = liftNiceValueM2 Vector.sub
   neg = liftNiceValueM Vector.neg

instance
   (TypeNum.Positive n, Vector.PseudoRing a) =>
      NiceValue.PseudoRing (LLVM.Vector n a) where
   mul = liftNiceValueM2 Vector.mul

instance
   (TypeNum.Positive n, Vector.Real a) =>
      NiceValue.Real (LLVM.Vector n a) where
   min = liftNiceValueM2 Vector.min
   max = liftNiceValueM2 Vector.max
   abs = liftNiceValueM Vector.abs
   signum = liftNiceValueM Vector.signum

instance
   (TypeNum.Positive n, Vector.Fraction a) =>
      NiceValue.Fraction (LLVM.Vector n a) where
   truncate = liftNiceValueM Vector.truncate
   fraction = liftNiceValueM Vector.fraction

instance
   (TypeNum.Positive n, Vector.Logic a) =>
      NiceValue.Logic (LLVM.Vector n a) where
   and = liftNiceValueM2 Vector.and
   or = liftNiceValueM2 Vector.or
   xor = liftNiceValueM2 Vector.xor
   inv = liftNiceValueM Vector.inv

instance
   (TypeNum.Positive n, Vector.BitShift a) =>
      NiceValue.BitShift (LLVM.Vector n a) where
   shl = liftNiceValueM2 Vector.shl
   shr = liftNiceValueM2 Vector.shr