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

import qualified LLVM.Extra.Multi.Vector as Vector
import qualified LLVM.Extra.Multi.Value.Private as MultiValue
import LLVM.Extra.Multi.Value.Private (Repr, )

import qualified LLVM.Core as LLVM

import qualified Type.Data.Num.Decimal as TypeNum

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

import Prelude2010
import Prelude ()


type MVVector n a = MultiValue.T (LLVM.Vector n a)

toMultiValue :: Vector.T n a -> MVVector n a
toMultiValue (Vector.Cons x) = MultiValue.Cons x

fromMultiValue :: MVVector n a -> Vector.T n a
fromMultiValue (MultiValue.Cons x) = Vector.Cons x

liftMultiValueM ::
   (Functor f) =>
   (Vector.T n a -> f (Vector.T m b)) ->
   (MVVector n a -> f (MVVector m b))
liftMultiValueM f a =
   toMultiValue <$> f (fromMultiValue a)

liftMultiValueM2 ::
   (Functor f) =>
   (Vector.T n a -> Vector.T m b -> f (Vector.T k c)) ->
   (MVVector n a -> MVVector m b -> f (MVVector k c))
liftMultiValueM2 f a b =
   toMultiValue <$> f (fromMultiValue a) (fromMultiValue b)

liftMultiValueM3 ::
   (Functor f) =>
   (Vector.T n a -> Vector.T m b -> Vector.T m c -> f (Vector.T k d)) ->
   (MVVector n a -> MVVector m b -> MVVector m c -> f (MVVector k d))
liftMultiValueM3 f a b c =
   toMultiValue <$> f (fromMultiValue a) (fromMultiValue b) (fromMultiValue c)

instance
   (TypeNum.Positive n, Vector.C a) =>
      MultiValue.C (LLVM.Vector n a) where
   type Repr f (LLVM.Vector n a) = Repr (Compose f (LLVM.Vector n)) a
   cons = toMultiValue . Vector.cons
   undef = toMultiValue Vector.undef
   zero = toMultiValue Vector.zero
   phis = liftMultiValueM . Vector.phis
   addPhis bb x y = Vector.addPhis bb (fromMultiValue x) (fromMultiValue y)

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

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

instance
   (TypeNum.Positive n, Vector.Additive a) =>
      MultiValue.Additive (LLVM.Vector n a) where
   add = liftMultiValueM2 Vector.add
   sub = liftMultiValueM2 Vector.sub
   neg = liftMultiValueM Vector.neg

instance
   (TypeNum.Positive n, Vector.Logic a) =>
      MultiValue.Logic (LLVM.Vector n a) where
   and = liftMultiValueM2 Vector.and
   or = liftMultiValueM2 Vector.or
   xor = liftMultiValueM2 Vector.xor
   inv = liftMultiValueM Vector.inv

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