{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
module LLVM.Extra.Multi.Value.Private where

import qualified LLVM.Extra.ScalarOrVector as SoV
import qualified LLVM.Extra.Arithmetic as A
import qualified LLVM.Extra.Control as C
import qualified LLVM.Extra.Tuple as Tuple
import qualified LLVM.Extra.MaybePrivate as Maybe

import qualified LLVM.Core as LLVM
import LLVM.Core (WordN, IntN, )

import qualified Type.Data.Num.Decimal.Number as Dec

import qualified Foreign.Storable.Record.Tuple as StoreTuple
import Foreign.StablePtr (StablePtr, )
import Foreign.Ptr (Ptr, FunPtr, )

import qualified Control.Monad.HT as Monad
import qualified Control.Functor.HT as FuncHT
import Control.Monad (Monad, return, fmap, (>>), )
import Data.Functor (Functor, )

import qualified Data.Tuple.HT as TupleHT
import qualified Data.Tuple as Tup
import qualified Data.EnumBitSet as EnumBitSet
import qualified Data.Enum.Storable as Enum
import qualified Data.Bool8 as Bool8
import Data.Complex (Complex((:+)))
import Data.Tagged (Tagged(Tagged, unTagged))
import Data.Function (id, (.), ($), )
import Data.Tuple.HT (uncurry3, )
import Data.Maybe (Maybe(Nothing,Just), )
import Data.Bool (Bool(False,True), )
import Data.Word (Word8, Word16, Word32, Word64, Word)
import Data.Int (Int8, Int16, Int32, Int64, Int)
import Data.Bool8 (Bool8)

import qualified Prelude as P
import Prelude (Float, Double, Integer, Rational, )


newtype T a = Cons (Tuple.ValueOf a)


class C a where
   cons :: a -> T a
   undef :: T a
   zero :: T a
   phi :: LLVM.BasicBlock -> T a -> LLVM.CodeGenFunction r (T a)
   addPhi :: LLVM.BasicBlock -> T a -> T a -> LLVM.CodeGenFunction r ()

instance C Bool where
   cons = consPrimitive
   undef = undefPrimitive
   zero = zeroPrimitive
   phi = phiPrimitive
   addPhi = addPhiPrimitive

instance C Float where
   cons = consPrimitive
   undef = undefPrimitive
   zero = zeroPrimitive
   phi = phiPrimitive
   addPhi = addPhiPrimitive

instance C Double where
   cons = consPrimitive
   undef = undefPrimitive
   zero = zeroPrimitive
   phi = phiPrimitive
   addPhi = addPhiPrimitive

instance C Word where
   cons = consPrimitive
   undef = undefPrimitive
   zero = zeroPrimitive
   phi = phiPrimitive
   addPhi = addPhiPrimitive

instance C Word8 where
   cons = consPrimitive
   undef = undefPrimitive
   zero = zeroPrimitive
   phi = phiPrimitive
   addPhi = addPhiPrimitive

instance C Word16 where
   cons = consPrimitive
   undef = undefPrimitive
   zero = zeroPrimitive
   phi = phiPrimitive
   addPhi = addPhiPrimitive

instance C Word32 where
   cons = consPrimitive
   undef = undefPrimitive
   zero = zeroPrimitive
   phi = phiPrimitive
   addPhi = addPhiPrimitive

instance C Word64 where
   cons = consPrimitive
   undef = undefPrimitive
   zero = zeroPrimitive
   phi = phiPrimitive
   addPhi = addPhiPrimitive

instance (Dec.Positive n) => C (LLVM.WordN n) where
   cons = consPrimitive
   undef = undefPrimitive
   zero = zeroPrimitive
   phi = phiPrimitive
   addPhi = addPhiPrimitive

instance C Int where
   cons = consPrimitive
   undef = undefPrimitive
   zero = zeroPrimitive
   phi = phiPrimitive
   addPhi = addPhiPrimitive

instance C Int8 where
   cons = consPrimitive
   undef = undefPrimitive
   zero = zeroPrimitive
   phi = phiPrimitive
   addPhi = addPhiPrimitive

instance C Int16 where
   cons = consPrimitive
   undef = undefPrimitive
   zero = zeroPrimitive
   phi = phiPrimitive
   addPhi = addPhiPrimitive

instance C Int32 where
   cons = consPrimitive
   undef = undefPrimitive
   zero = zeroPrimitive
   phi = phiPrimitive
   addPhi = addPhiPrimitive

instance C Int64 where
   cons = consPrimitive
   undef = undefPrimitive
   zero = zeroPrimitive
   phi = phiPrimitive
   addPhi = addPhiPrimitive

instance (Dec.Positive n) => C (LLVM.IntN n) where
   cons = consPrimitive
   undef = undefPrimitive
   zero = zeroPrimitive
   phi = phiPrimitive
   addPhi = addPhiPrimitive

instance (LLVM.IsType a) => C (LLVM.Ptr a) where
   cons = consPrimitive
   undef = undefPrimitive
   zero = zeroPrimitive
   phi = phiPrimitive
   addPhi = addPhiPrimitive

instance C (Ptr a) where
   cons = consPrimitive
   undef = undefPrimitive
   zero = zeroPrimitive
   phi = phiPrimitive
   addPhi = addPhiPrimitive

instance (LLVM.IsFunction a) => C (FunPtr a) where
   cons = consPrimitive
   undef = undefPrimitive
   zero = zeroPrimitive
   phi = phiPrimitive
   addPhi = addPhiPrimitive

instance C (StablePtr a) where
   cons = consPrimitive
   undef = undefPrimitive
   zero = zeroPrimitive
   phi = phiPrimitive
   addPhi = addPhiPrimitive


consPrimitive ::
   (LLVM.IsConst al, LLVM.Value al ~ Tuple.ValueOf a) =>
   al -> T a
consPrimitive = Cons . LLVM.valueOf

undefPrimitive, zeroPrimitive ::
   (LLVM.IsType al, LLVM.Value al ~ Tuple.ValueOf a) =>
   T a
undefPrimitive = Cons $ LLVM.value LLVM.undef
zeroPrimitive = Cons $ LLVM.value LLVM.zero

phiPrimitive ::
   (LLVM.IsFirstClass al, LLVM.Value al ~ Tuple.ValueOf a) =>
   LLVM.BasicBlock -> T a -> LLVM.CodeGenFunction r (T a)
phiPrimitive bb (Cons a) = fmap Cons $ Tuple.phi bb a

addPhiPrimitive ::
   (LLVM.IsFirstClass al, LLVM.Value al ~ Tuple.ValueOf a) =>
   LLVM.BasicBlock -> T a -> T a -> LLVM.CodeGenFunction r ()
addPhiPrimitive bb (Cons a) (Cons b) = Tuple.addPhi bb a b


consTuple ::
   (Tuple.Value a) =>
   a -> T a
consTuple = Cons . Tuple.valueOf

undefTuple ::
   (Tuple.Value a, Tuple.ValueOf a ~ al, Tuple.Undefined al) =>
   T a
undefTuple = Cons Tuple.undef

zeroTuple ::
   (Tuple.Value a, Tuple.ValueOf a ~ al, Tuple.Zero al) =>
   T a
zeroTuple = Cons Tuple.zero

phiTuple ::
   (Tuple.Value a, Tuple.ValueOf a ~ al, Tuple.Phi al) =>
   LLVM.BasicBlock -> T a -> LLVM.CodeGenFunction r (T a)
phiTuple bb (Cons a) = fmap Cons $ Tuple.phi bb a

addPhiTuple ::
   (Tuple.Value a, Tuple.ValueOf a ~ al, Tuple.Phi al) =>
   LLVM.BasicBlock -> T a -> T a -> LLVM.CodeGenFunction r ()
addPhiTuple bb (Cons a) (Cons b) = Tuple.addPhi bb a b


instance C () where
   cons = consUnit
   undef = undefUnit
   zero = zeroUnit
   phi = phiUnit
   addPhi = addPhiUnit

consUnit :: (Tuple.ValueOf a ~ ()) => a -> T a
consUnit _ = Cons ()

undefUnit :: (Tuple.ValueOf a ~ ()) => T a
undefUnit = Cons ()

zeroUnit :: (Tuple.ValueOf a ~ ()) => T a
zeroUnit = Cons ()

phiUnit ::
   (Tuple.ValueOf a ~ ()) =>
   LLVM.BasicBlock -> T a -> LLVM.CodeGenFunction r (T a)
phiUnit _bb (Cons ()) = return $ Cons ()

addPhiUnit ::
   (Tuple.ValueOf a ~ ()) =>
   LLVM.BasicBlock -> T a -> T a -> LLVM.CodeGenFunction r ()
addPhiUnit _bb (Cons ()) (Cons ()) = return ()


instance C Bool8 where
   cons = consPrimitive . Bool8.toBool
   undef = undefPrimitive
   zero = zeroPrimitive
   phi = phiPrimitive
   addPhi = addPhiPrimitive

boolPFrom8 :: T Bool8 -> T Bool
boolPFrom8 (Cons b) = Cons b

bool8FromP :: T Bool -> T Bool8
bool8FromP (Cons b) = Cons b

intFromBool8 :: (NativeInteger i ir) => T Bool8 -> LLVM.CodeGenFunction r (T i)
intFromBool8 = liftM LLVM.zadapt

floatFromBool8 ::
   (NativeFloating a ar) => T Bool8 -> LLVM.CodeGenFunction r (T a)
floatFromBool8 = liftM LLVM.uitofp


instance
   (LLVM.IsInteger w, LLVM.IsConst w, P.Num w, P.Enum e) =>
      C (Enum.T w e) where
   cons = consPrimitive . P.fromIntegral . P.fromEnum . Enum.toPlain
   undef = undefPrimitive
   zero = zeroPrimitive
   phi = phiPrimitive
   addPhi = addPhiPrimitive

toEnum ::
   (Tuple.ValueOf w ~ LLVM.Value w) =>
   T w -> T (Enum.T w e)
toEnum (Cons w) = Cons w

fromEnum ::
   (Tuple.ValueOf w ~ LLVM.Value w) =>
   T (Enum.T w e) -> T w
fromEnum (Cons w) = Cons w

succ, pred ::
   (LLVM.IsArithmetic w, SoV.IntegerConstant w) =>
   T (Enum.T w e) -> LLVM.CodeGenFunction r (T (Enum.T w e))
succ = liftM $ \w -> A.add w A.one
pred = liftM $ \w -> A.sub w A.one

-- cannot be an instance of 'Comparison' because there is no 'Real' instance
cmpEnum ::
   (LLVM.CmpRet w, LLVM.IsPrimitive w) =>
   LLVM.CmpPredicate -> T (Enum.T w a) -> T (Enum.T w a) ->
   LLVM.CodeGenFunction r (T Bool)
cmpEnum = liftM2 . LLVM.cmp


class (C a) => Bounded a where
   minBound, maxBound :: T a

instance
   (LLVM.IsInteger w, LLVM.IsConst w, P.Num w, P.Enum e, P.Bounded e) =>
      Bounded (Enum.T w e) where
   minBound = cons P.minBound
   maxBound = cons P.maxBound


instance (LLVM.IsInteger w, LLVM.IsConst w) => C (EnumBitSet.T w i) where
   cons = consPrimitive . EnumBitSet.decons
   undef = undefPrimitive
   zero = zeroPrimitive
   phi = phiPrimitive
   addPhi = addPhiPrimitive


instance (C a) => C (Maybe a) where
   cons Nothing = nothing
   cons (Just a) = just $ cons a
   undef = toMaybe undef undef
   zero = toMaybe (cons False) zero
   phi bb ma =
      case splitMaybe ma of
         (b,a) -> Monad.lift2 toMaybe (phi bb b) (phi bb a)
   addPhi bb x y =
      case (splitMaybe x, splitMaybe y) of
         ((xb,xa), (yb,ya)) ->
            addPhi bb xb yb >>
            addPhi bb xa ya

splitMaybe :: T (Maybe a) -> (T Bool, T a)
splitMaybe (Cons (Maybe.Cons b a)) = (Cons b, Cons a)

toMaybe :: T Bool -> T a -> T (Maybe a)
toMaybe (Cons b) (Cons a) = Cons (Maybe.Cons b a)

nothing :: (C a) => T (Maybe a)
nothing = toMaybe (cons False) undef

just :: T a -> T (Maybe a)
just = toMaybe (cons True)


instance (C a, C b) => C (a,b) where
   cons (a,b) = zip (cons a) (cons b)
   undef = zip undef undef
   zero = zip zero zero
   phi bb a =
      case unzip a of
         (a0,a1) ->
            Monad.lift2 zip (phi bb a0) (phi bb a1)
   addPhi bb a b =
      case (unzip a, unzip b) of
         ((a0,a1), (b0,b1)) ->
            addPhi bb a0 b0 >>
            addPhi bb a1 b1

instance (C a, C b, C c) => C (a,b,c) where
   cons (a,b,c) = zip3 (cons a) (cons b) (cons c)
   undef = zip3 undef undef undef
   zero = zip3 zero zero zero
   phi bb a =
      case unzip3 a of
         (a0,a1,a2) ->
            Monad.lift3 zip3 (phi bb a0) (phi bb a1) (phi bb a2)
   addPhi bb a b =
      case (unzip3 a, unzip3 b) of
         ((a0,a1,a2), (b0,b1,b2)) ->
            addPhi bb a0 b0 >>
            addPhi bb a1 b1 >>
            addPhi bb a2 b2

instance (C a, C b, C c, C d) => C (a,b,c,d) where
   cons (a,b,c,d) = zip4 (cons a) (cons b) (cons c) (cons d)
   undef = zip4 undef undef undef undef
   zero = zip4 zero zero zero zero
   phi bb a =
      case unzip4 a of
         (a0,a1,a2,a3) ->
            Monad.lift4 zip4 (phi bb a0) (phi bb a1) (phi bb a2) (phi bb a3)
   addPhi bb a b =
      case (unzip4 a, unzip4 b) of
         ((a0,a1,a2,a3), (b0,b1,b2,b3)) ->
            addPhi bb a0 b0 >>
            addPhi bb a1 b1 >>
            addPhi bb a2 b2 >>
            addPhi bb a3 b3


fst :: T (a,b) -> T a
fst (Cons (a,_b)) = Cons a

snd :: T (a,b) -> T b
snd (Cons (_a,b)) = Cons b

curry :: (T (a,b) -> c) -> (T a -> T b -> c)
curry f a b = f $ zip a b

uncurry :: (T a -> T b -> c) -> (T (a,b) -> c)
uncurry f = Tup.uncurry f . unzip


mapFst :: (T a0 -> T a1) -> T (a0,b) -> T (a1,b)
mapFst f = Tup.uncurry zip . TupleHT.mapFst f . unzip

mapSnd :: (T b0 -> T b1) -> T (a,b0) -> T (a,b1)
mapSnd f = Tup.uncurry zip . TupleHT.mapSnd f . unzip

mapFstF :: (Functor f) => (T a0 -> f (T a1)) -> T (a0,b) -> f (T (a1,b))
mapFstF f = fmap (Tup.uncurry zip) . FuncHT.mapFst f . unzip

mapSndF :: (Functor f) => (T b0 -> f (T b1)) -> T (a,b0) -> f (T (a,b1))
mapSndF f = fmap (Tup.uncurry zip) . FuncHT.mapSnd f . unzip

swap :: T (a,b) -> T (b,a)
swap = Tup.uncurry zip . TupleHT.swap . unzip


fst3 :: T (a,b,c) -> T a
fst3 (Cons (a,_b,_c)) = Cons a

snd3 :: T (a,b,c) -> T b
snd3 (Cons (_a,b,_c)) = Cons b

thd3 :: T (a,b,c) -> T c
thd3 (Cons (_a,_b,c)) = Cons c


mapFst3 :: (T a0 -> T a1) -> T (a0,b,c) -> T (a1,b,c)
mapFst3 f = uncurry3 zip3 . TupleHT.mapFst3 f . unzip3

mapSnd3 :: (T b0 -> T b1) -> T (a,b0,c) -> T (a,b1,c)
mapSnd3 f = uncurry3 zip3 . TupleHT.mapSnd3 f . unzip3

mapThd3 :: (T c0 -> T c1) -> T (a,b,c0) -> T (a,b,c1)
mapThd3 f = uncurry3 zip3 . TupleHT.mapThd3 f . unzip3

mapFst3F :: (Functor f) => (T a0 -> f (T a1)) -> T (a0,b,c) -> f (T (a1,b,c))
mapFst3F f = fmap (uncurry3 zip3) . FuncHT.mapFst3 f . unzip3

mapSnd3F :: (Functor f) => (T b0 -> f (T b1)) -> T (a,b0,c) -> f (T (a,b1,c))
mapSnd3F f = fmap (uncurry3 zip3) . FuncHT.mapSnd3 f . unzip3

mapThd3F :: (Functor f) => (T c0 -> f (T c1)) -> T (a,b,c0) -> f (T (a,b,c1))
mapThd3F f = fmap (uncurry3 zip3) . FuncHT.mapThd3 f . unzip3


zip :: T a -> T b -> T (a,b)
zip (Cons a) (Cons b) = Cons (a,b)

zip3 :: T a -> T b -> T c -> T (a,b,c)
zip3 (Cons a) (Cons b) (Cons c) = Cons (a,b,c)

zip4 :: T a -> T b -> T c -> T d -> T (a,b,c,d)
zip4 (Cons a) (Cons b) (Cons c) (Cons d) = Cons (a,b,c,d)

unzip :: T (a,b) -> (T a, T b)
unzip (Cons (a,b)) = (Cons a, Cons b)

unzip3 :: T (a,b,c) -> (T a, T b, T c)
unzip3 (Cons (a,b,c)) = (Cons a, Cons b, Cons c)

unzip4 :: T (a,b,c,d) -> (T a, T b, T c, T d)
unzip4 (Cons (a,b,c,d)) = (Cons a, Cons b, Cons c, Cons d)


instance (C tuple) => C (StoreTuple.Tuple tuple) where
   cons = tuple . cons . StoreTuple.getTuple
   undef = tuple undef
   zero = tuple zero
   phi bb = fmap tuple . phi bb . untuple
   addPhi bb a b = addPhi bb (untuple a) (untuple b)

tuple :: T tuple -> T (StoreTuple.Tuple tuple)
tuple (Cons a) = Cons a

untuple :: T (StoreTuple.Tuple tuple) -> T tuple
untuple (Cons a) = Cons a


instance C a => C (Tagged tag a) where
   cons = tag . cons . unTagged
   undef = tag undef
   zero = tag zero
   phi bb = fmap tag . phi bb . untag
   addPhi bb a b = addPhi bb (untag a) (untag b)

tag :: T a -> T (Tagged tag a)
tag (Cons a) = Cons a

untag :: T (Tagged tag a) -> T a
untag (Cons a) = Cons a

liftTaggedM ::
   (Monad m) => (T a -> m (T b)) -> T (Tagged tag a) -> m (T (Tagged tag b))
liftTaggedM f = Monad.lift tag . f . untag

liftTaggedM2 ::
   (Monad m) =>
   (T a -> T b -> m (T c)) ->
   T (Tagged tag a) -> T (Tagged tag b) -> m (T (Tagged tag c))
liftTaggedM2 f a b = Monad.lift tag $ f (untag a) (untag b)


instance (C a) => C (Complex a) where
   cons (a:+b) = consComplex (cons a) (cons b)
   undef = consComplex undef undef
   zero = consComplex zero zero
   phi bb a =
      case deconsComplex a of
         (a0,a1) ->
            Monad.lift2 consComplex (phi bb a0) (phi bb a1)
   addPhi bb a b =
      case (deconsComplex a, deconsComplex b) of
         ((a0,a1), (b0,b1)) ->
            addPhi bb a0 b0 >>
            addPhi bb a1 b1

consComplex :: T a -> T a -> T (Complex a)
consComplex (Cons a) (Cons b) = Cons (a:+b)

deconsComplex :: T (Complex a) -> (T a, T a)
deconsComplex (Cons (a:+b)) = (Cons a, Cons b)



class Compose multituple where
   type Composed multituple
   {- |
   A nested 'zip'.
   -}
   compose :: multituple -> T (Composed multituple)

class
   (Composed (Decomposed T pattern) ~ PatternTuple pattern) =>
      Decompose pattern where
   {- |
   A nested 'unzip'.
   Since it is not obvious how deep to decompose nested tuples,
   you must provide a pattern of the decomposed tuple.
   E.g.

   > f :: MultiValue ((a,b),(c,d)) ->
   >      ((MultiValue a, MultiValue b), MultiValue (c,d))
   > f = decompose ((atom,atom),atom)
   -}
   decompose :: pattern -> T (PatternTuple pattern) -> Decomposed T pattern

type family Decomposed (f :: * -> *) pattern
type family PatternTuple pattern


{- |
A combination of 'compose' and 'decompose'
that let you operate on tuple multivalues as Haskell tuples.
-}
modify ::
   (Compose a, Decompose pattern) =>
   pattern ->
   (Decomposed T pattern -> a) ->
   T (PatternTuple pattern) -> T (Composed a)
modify p f = compose . f . decompose p

modify2 ::
   (Compose a, Decompose patternA, Decompose patternB) =>
   patternA ->
   patternB ->
   (Decomposed T patternA -> Decomposed T patternB -> a) ->
   T (PatternTuple patternA) -> T (PatternTuple patternB) -> T (Composed a)
modify2 pa pb f a b = compose $ f (decompose pa a) (decompose pb b)

modifyF ::
   (Compose a, Decompose pattern, Functor f) =>
   pattern ->
   (Decomposed T pattern -> f a) ->
   T (PatternTuple pattern) -> f (T (Composed a))
modifyF p f = fmap compose . f . decompose p

modifyF2 ::
   (Compose a, Decompose patternA, Decompose patternB,
    Functor f) =>
   patternA ->
   patternB ->
   (Decomposed T patternA -> Decomposed T patternB -> f a) ->
   T (PatternTuple patternA) -> T (PatternTuple patternB) -> f (T (Composed a))
modifyF2 pa pb f a b = fmap compose $ f (decompose pa a) (decompose pb b)



instance Compose (T a) where
   type Composed (T a) = a
   compose = id

instance Decompose (Atom a) where
   decompose _ = id

type instance Decomposed f (Atom a) = f a
type instance PatternTuple (Atom a) = a

data Atom a = Atom

atom :: Atom a
atom = Atom


instance Compose () where
   type Composed () = ()
   compose = cons

instance Decompose () where
   decompose () _ = ()

type instance Decomposed f () = ()
type instance PatternTuple () = ()


instance (Compose a, Compose b) => Compose (a,b) where
   type Composed (a,b) = (Composed a, Composed b)
   compose = Tup.uncurry zip . TupleHT.mapPair (compose, compose)

instance (Decompose pa, Decompose pb) => Decompose (pa,pb) where
   decompose (pa,pb) =
      TupleHT.mapPair (decompose pa, decompose pb) . unzip

type instance Decomposed f (pa,pb) = (Decomposed f pa, Decomposed f pb)
type instance PatternTuple (pa,pb) = (PatternTuple pa, PatternTuple pb)


instance (Compose a, Compose b, Compose c) => Compose (a,b,c) where
   type Composed (a,b,c) = (Composed a, Composed b, Composed c)
   compose = uncurry3 zip3 . TupleHT.mapTriple (compose, compose, compose)

instance
   (Decompose pa, Decompose pb, Decompose pc) =>
      Decompose (pa,pb,pc) where
   decompose (pa,pb,pc) =
      TupleHT.mapTriple (decompose pa, decompose pb, decompose pc) . unzip3

type instance Decomposed f (pa,pb,pc) =
        (Decomposed f pa, Decomposed f pb, Decomposed f pc)
type instance PatternTuple (pa,pb,pc) =
        (PatternTuple pa, PatternTuple pb, PatternTuple pc)


instance (Compose a, Compose b, Compose c, Compose d) => Compose (a,b,c,d) where
   type Composed (a,b,c,d) = (Composed a, Composed b, Composed c, Composed d)
   compose (a,b,c,d) = zip4 (compose a) (compose b) (compose c) (compose d)

instance
   (Decompose pa, Decompose pb, Decompose pc, Decompose pd) =>
      Decompose (pa,pb,pc,pd) where
   decompose (pa,pb,pc,pd) x =
      case unzip4 x of
         (a,b,c,d) ->
            (decompose pa a, decompose pb b, decompose pc c, decompose pd d)
type instance Decomposed f (pa,pb,pc,pd) =
        (Decomposed f pa, Decomposed f pb, Decomposed f pc, Decomposed f pd)
type instance PatternTuple (pa,pb,pc,pd) =
        (PatternTuple pa, PatternTuple pb, PatternTuple pc, PatternTuple pd)


instance (Compose tuple) => Compose (StoreTuple.Tuple tuple) where
   type Composed (StoreTuple.Tuple tuple) = StoreTuple.Tuple (Composed tuple)
   compose = tuple . compose . StoreTuple.getTuple

instance (Decompose p) => Decompose (StoreTuple.Tuple p) where
   decompose (StoreTuple.Tuple p) = StoreTuple.Tuple . decompose p . untuple

type instance Decomposed f (StoreTuple.Tuple p) =
                  StoreTuple.Tuple (Decomposed f p)
type instance PatternTuple (StoreTuple.Tuple p) =
                  StoreTuple.Tuple (PatternTuple p)


instance (Compose a) => Compose (Tagged tag a) where
   type Composed (Tagged tag a) = Tagged tag (Composed a)
   compose = tag . compose . unTagged

instance (Decompose pa) => Decompose (Tagged tag pa) where
   decompose (Tagged p) = Tagged . decompose p . untag

type instance Decomposed f (Tagged tag pa) = Tagged tag (Decomposed f pa)
type instance PatternTuple (Tagged tag pa) = Tagged tag (PatternTuple pa)


instance (Compose a) => Compose (Complex a) where
   type Composed (Complex a) = Complex (Composed a)
   compose (a:+b) = consComplex (compose a) (compose b)

instance (Decompose pa) => Decompose (Complex pa) where
   decompose (pa:+pb) =
      Tup.uncurry (:+) .
      TupleHT.mapPair (decompose pa, decompose pb) . deconsComplex

type instance Decomposed f (Complex pa) = Complex (Decomposed f pa)
type instance PatternTuple (Complex pa) = Complex (PatternTuple pa)

realPart, imagPart :: T (Complex a) -> T a
realPart (Cons (a:+_)) = Cons a
imagPart (Cons (_:+b)) = Cons b



lift1 :: (Tuple.ValueOf a -> Tuple.ValueOf b) -> T a -> T b
lift1 f (Cons a) = Cons $ f a

liftM0 ::
   (Monad m) =>
   m (Tuple.ValueOf a) ->
   m (T a)
liftM0 f = Monad.lift Cons f

liftM ::
   (Monad m) =>
   (Tuple.ValueOf a -> m (Tuple.ValueOf b)) ->
   T a -> m (T b)
liftM f (Cons a) = Monad.lift Cons $ f a

liftM2 ::
   (Monad m) =>
   (Tuple.ValueOf a -> Tuple.ValueOf b -> m (Tuple.ValueOf c)) ->
   T a -> T b -> m (T c)
liftM2 f (Cons a) (Cons b) = Monad.lift Cons $ f a b

liftM3 ::
   (Monad m) =>
   (Tuple.ValueOf a -> Tuple.ValueOf b -> Tuple.ValueOf c ->
    m (Tuple.ValueOf d)) ->
   T a -> T b -> T c -> m (T d)
liftM3 f (Cons a) (Cons b) (Cons c) = Monad.lift Cons $ f a b c


instance (C a) => Tuple.Zero (T a) where
   zero = zero

instance (C a) => Tuple.Undefined (T a) where
   undef = undef

instance (C a) => Tuple.Phi (T a) where
   phi = phi
   addPhi = addPhi


class (C a) => IntegerConstant a where
   fromInteger' :: Integer -> T a

class (IntegerConstant a) => RationalConstant a where
   fromRational' :: Rational -> T a

instance IntegerConstant Float  where fromInteger' = Cons . LLVM.value . SoV.constFromInteger
instance IntegerConstant Double where fromInteger' = Cons . LLVM.value . SoV.constFromInteger

instance IntegerConstant Word where fromInteger' = Cons . LLVM.value . SoV.constFromInteger
instance IntegerConstant Word8 where fromInteger' = Cons . LLVM.value . SoV.constFromInteger
instance IntegerConstant Word16 where fromInteger' = Cons . LLVM.value . SoV.constFromInteger
instance IntegerConstant Word32 where fromInteger' = Cons . LLVM.value . SoV.constFromInteger
instance IntegerConstant Word64 where fromInteger' = Cons . LLVM.value . SoV.constFromInteger

instance IntegerConstant Int where fromInteger' = Cons . LLVM.value . SoV.constFromInteger
instance IntegerConstant Int8 where fromInteger' = Cons . LLVM.value . SoV.constFromInteger
instance IntegerConstant Int16 where fromInteger' = Cons . LLVM.value . SoV.constFromInteger
instance IntegerConstant Int32 where fromInteger' = Cons . LLVM.value . SoV.constFromInteger
instance IntegerConstant Int64 where fromInteger' = Cons . LLVM.value . SoV.constFromInteger

instance (Dec.Positive n) => IntegerConstant (WordN n) where fromInteger' = Cons . LLVM.value . SoV.constFromInteger
instance (Dec.Positive n) => IntegerConstant (IntN n) where fromInteger' = Cons . LLVM.value . SoV.constFromInteger

instance IntegerConstant a => IntegerConstant (Tagged tag a) where
   fromInteger' = tag . fromInteger'

instance RationalConstant Float  where fromRational' = Cons . LLVM.value . SoV.constFromRational
instance RationalConstant Double where fromRational' = Cons . LLVM.value . SoV.constFromRational

instance RationalConstant a => RationalConstant (Tagged tag a) where
   fromRational' = tag . fromRational'


instance (IntegerConstant a) => A.IntegerConstant (T a) where
   fromInteger' = fromInteger'

instance (RationalConstant a) => A.RationalConstant (T a) where
   fromRational' = fromRational'


class (C a) => Additive a where
   add :: T a -> T a -> LLVM.CodeGenFunction r (T a)
   sub :: T a -> T a -> LLVM.CodeGenFunction r (T a)
   neg :: T a -> LLVM.CodeGenFunction r (T a)

instance Additive Float where
   add = liftM2 LLVM.add
   sub = liftM2 LLVM.sub
   neg = liftM LLVM.neg

instance Additive Double where
   add = liftM2 LLVM.add
   sub = liftM2 LLVM.sub
   neg = liftM LLVM.neg

instance Additive Word where
   add = liftM2 LLVM.add
   sub = liftM2 LLVM.sub
   neg = liftM LLVM.neg

instance Additive Word8 where
   add = liftM2 LLVM.add
   sub = liftM2 LLVM.sub
   neg = liftM LLVM.neg

instance Additive Word16 where
   add = liftM2 LLVM.add
   sub = liftM2 LLVM.sub
   neg = liftM LLVM.neg

instance Additive Word32 where
   add = liftM2 LLVM.add
   sub = liftM2 LLVM.sub
   neg = liftM LLVM.neg

instance Additive Word64 where
   add = liftM2 LLVM.add
   sub = liftM2 LLVM.sub
   neg = liftM LLVM.neg

instance Additive Int where
   add = liftM2 LLVM.add
   sub = liftM2 LLVM.sub
   neg = liftM LLVM.neg

instance Additive Int8 where
   add = liftM2 LLVM.add
   sub = liftM2 LLVM.sub
   neg = liftM LLVM.neg

instance Additive Int16 where
   add = liftM2 LLVM.add
   sub = liftM2 LLVM.sub
   neg = liftM LLVM.neg

instance Additive Int32 where
   add = liftM2 LLVM.add
   sub = liftM2 LLVM.sub
   neg = liftM LLVM.neg

instance Additive Int64 where
   add = liftM2 LLVM.add
   sub = liftM2 LLVM.sub
   neg = liftM LLVM.neg

instance (Dec.Positive n) => Additive (WordN n) where
   add = liftM2 LLVM.add
   sub = liftM2 LLVM.sub
   neg = liftM LLVM.neg

instance (Dec.Positive n) => Additive (IntN n) where
   add = liftM2 LLVM.add
   sub = liftM2 LLVM.sub
   neg = liftM LLVM.neg

instance Additive a => Additive (Tagged tag a) where
   add = liftTaggedM2 add
   sub = liftTaggedM2 sub
   neg = liftTaggedM neg

instance (Additive a) => A.Additive (T a) where
   zero = zero
   add = add
   sub = sub
   neg = neg

inc, dec ::
   (Additive i, IntegerConstant i) => T i -> LLVM.CodeGenFunction r (T i)
inc x = add x A.one
dec x = sub x A.one


class (Additive a) => PseudoRing a where
   mul :: T a -> T a -> LLVM.CodeGenFunction r (T a)

instance PseudoRing Float where mul = liftM2 LLVM.mul
instance PseudoRing Double where mul = liftM2 LLVM.mul
instance PseudoRing Word where mul = liftM2 LLVM.mul
instance PseudoRing Word8 where mul = liftM2 LLVM.mul
instance PseudoRing Word16 where mul = liftM2 LLVM.mul
instance PseudoRing Word32 where mul = liftM2 LLVM.mul
instance PseudoRing Word64 where mul = liftM2 LLVM.mul
instance PseudoRing Int where mul = liftM2 LLVM.mul
instance PseudoRing Int8 where mul = liftM2 LLVM.mul
instance PseudoRing Int16 where mul = liftM2 LLVM.mul
instance PseudoRing Int32 where mul = liftM2 LLVM.mul
instance PseudoRing Int64 where mul = liftM2 LLVM.mul

instance (PseudoRing a) => PseudoRing (Tagged tag a) where
   mul = liftTaggedM2 mul

instance (PseudoRing a) => A.PseudoRing (T a) where
   mul = mul


class (PseudoRing a) => Field a where
   fdiv :: T a -> T a -> LLVM.CodeGenFunction r (T a)

instance Field Float where
   fdiv = liftM2 LLVM.fdiv

instance Field Double where
   fdiv = liftM2 LLVM.fdiv

instance (Field a) => Field (Tagged tag a) where
   fdiv = liftTaggedM2 fdiv

instance (Field a) => A.Field (T a) where
   fdiv = fdiv


type family Scalar vector :: *
type instance Scalar Float = Float
type instance Scalar Double = Double
type instance Scalar (Tagged tag a) = Tagged tag (Scalar a)
type instance A.Scalar (T a) = T (Scalar a)

class (PseudoRing (Scalar v), Additive v) => PseudoModule v where
   scale :: T (Scalar v) -> T v -> LLVM.CodeGenFunction r (T v)

instance PseudoModule Float where
   scale = liftM2 A.mul

instance PseudoModule Double where
   scale = liftM2 A.mul

instance (PseudoModule a) => PseudoModule (Tagged tag a) where
   scale = liftTaggedM2 scale

instance (PseudoModule a) => A.PseudoModule (T a) where
   scale = scale


class (Additive a) => Real a where
   min :: T a -> T a -> LLVM.CodeGenFunction r (T a)
   max :: T a -> T a -> LLVM.CodeGenFunction r (T a)
   abs :: T a -> LLVM.CodeGenFunction r (T a)
   signum :: T a -> LLVM.CodeGenFunction r (T a)

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

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

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

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

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

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

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

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

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

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

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

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

instance (Dec.Positive n) => Real (WordN n) where
   min = liftM2 A.min
   max = liftM2 A.max
   abs = liftM A.abs
   signum = liftM A.signum

instance (Dec.Positive n) => Real (IntN n) where
   min = liftM2 A.min
   max = liftM2 A.max
   abs = liftM A.abs
   signum = liftM A.signum

instance (Real a) => Real (Tagged tag a) where
   min = liftTaggedM2 min
   max = liftTaggedM2 max
   abs = liftTaggedM abs
   signum = liftTaggedM signum

instance (Real a) => A.Real (T a) where
   min = min
   max = max
   abs = abs
   signum = signum


class (Real a) => Fraction a where
   truncate :: T a -> LLVM.CodeGenFunction r (T a)
   fraction :: T a -> LLVM.CodeGenFunction r (T a)

instance Fraction Float where
   truncate = liftM A.truncate
   fraction = liftM A.fraction

instance Fraction Double where
   truncate = liftM A.truncate
   fraction = liftM A.fraction

instance (Fraction a) => Fraction (Tagged tag a) where
   truncate = liftTaggedM truncate
   fraction = liftTaggedM fraction

instance (Fraction a) => A.Fraction (T a) where
   truncate = truncate
   fraction = fraction


class
   (Tuple.ValueOf i ~ LLVM.Value ir,
    LLVM.IsInteger ir, SoV.IntegerConstant ir,
    LLVM.CmpRet ir, LLVM.IsPrimitive ir) =>
      NativeInteger i ir where

instance NativeInteger Word   Word   where
instance NativeInteger Word8  Word8  where
instance NativeInteger Word16 Word16 where
instance NativeInteger Word32 Word32 where
instance NativeInteger Word64 Word64 where

instance NativeInteger Int   Int   where
instance NativeInteger Int8  Int8  where
instance NativeInteger Int16 Int16 where
instance NativeInteger Int32 Int32 where
instance NativeInteger Int64 Int64 where

instance NativeInteger a a => NativeInteger (Tagged tag a) a where


class
   (Tuple.ValueOf a ~ LLVM.Value ar,
    LLVM.IsFloating ar, SoV.RationalConstant ar,
    LLVM.CmpRet ar, LLVM.IsPrimitive ar) =>
      NativeFloating a ar where

instance NativeFloating Float  Float where
instance NativeFloating Double Double where


truncateToInt, floorToInt, ceilingToInt, roundToIntFast ::
   (NativeInteger i ir, NativeFloating a ar) =>
   T a -> LLVM.CodeGenFunction r (T i)
truncateToInt  = liftM SoV.truncateToInt
floorToInt     = liftM SoV.floorToInt
ceilingToInt   = liftM SoV.ceilingToInt
roundToIntFast = liftM SoV.roundToIntFast

splitFractionToInt ::
   (NativeInteger i ir, NativeFloating a ar) =>
   T a -> LLVM.CodeGenFunction r (T (i,a))
splitFractionToInt = liftM SoV.splitFractionToInt


class Field a => Algebraic a where
   sqrt :: T a -> LLVM.CodeGenFunction r (T a)

instance Algebraic Float where
   sqrt = liftM A.sqrt

instance Algebraic Double where
   sqrt = liftM A.sqrt

instance (Algebraic a) => Algebraic (Tagged tag a) where
   sqrt = liftTaggedM sqrt

instance (Algebraic a) => A.Algebraic (T a) where
   sqrt = sqrt


class Algebraic a => Transcendental a where
   pi :: LLVM.CodeGenFunction r (T a)
   sin, cos, exp, log :: T a -> LLVM.CodeGenFunction r (T a)
   pow :: T a -> T a -> LLVM.CodeGenFunction r (T a)

instance Transcendental Float where
   pi = liftM0 A.pi
   sin = liftM A.sin
   cos = liftM A.cos
   exp = liftM A.exp
   log = liftM A.log
   pow = liftM2 A.pow

instance Transcendental Double where
   pi = liftM0 A.pi
   sin = liftM A.sin
   cos = liftM A.cos
   exp = liftM A.exp
   log = liftM A.log
   pow = liftM2 A.pow

instance (Transcendental a) => Transcendental (Tagged tag a) where
   pi = fmap tag pi
   sin = liftTaggedM sin
   cos = liftTaggedM cos
   exp = liftTaggedM exp
   log = liftTaggedM log
   pow = liftTaggedM2 pow

instance (Transcendental a) => A.Transcendental (T a) where
   pi = pi
   sin = sin
   cos = cos
   exp = exp
   log = log
   pow = pow



class (C a) => Select a where
   select ::
      T Bool -> T a -> T a ->
      LLVM.CodeGenFunction r (T a)

instance Select Bool where select = liftM3 LLVM.select
instance Select Bool8 where select = liftM3 LLVM.select
instance Select Float where select = liftM3 LLVM.select
instance Select Double where select = liftM3 LLVM.select
instance Select Word where select = liftM3 LLVM.select
instance Select Word8 where select = liftM3 LLVM.select
instance Select Word16 where select = liftM3 LLVM.select
instance Select Word32 where select = liftM3 LLVM.select
instance Select Word64 where select = liftM3 LLVM.select
instance Select Int where select = liftM3 LLVM.select
instance Select Int8 where select = liftM3 LLVM.select
instance Select Int16 where select = liftM3 LLVM.select
instance Select Int32 where select = liftM3 LLVM.select
instance Select Int64 where select = liftM3 LLVM.select

instance (Select a, Select b) => Select (a,b) where
   select b =
      modifyF2 (atom,atom) (atom,atom) $
      \(a0,b0) (a1,b1) ->
         Monad.lift2 (,)
            (select b a0 a1)
            (select b b0 b1)

instance (Select a, Select b, Select c) => Select (a,b,c) where
   select b =
      modifyF2 (atom,atom,atom) (atom,atom,atom) $
      \(a0,b0,c0) (a1,b1,c1) ->
         Monad.lift3 (,,)
            (select b a0 a1)
            (select b b0 b1)
            (select b c0 c1)

instance (Select a) => Select (Tagged tag a) where
   select = liftTaggedM2 . select

instance (Select a) => C.Select (T a) where
   select b = select (Cons b)



class (Real a) => Comparison a where
   {- |
   It must hold

   > max x y  ==  do gt <- cmp CmpGT x y; select gt x y
   -}
   cmp ::
      LLVM.CmpPredicate -> T a -> T a ->
      LLVM.CodeGenFunction r (T Bool)

instance Comparison Float where cmp = liftM2 . LLVM.cmp
instance Comparison Double where cmp = liftM2 . LLVM.cmp

instance Comparison Int where cmp = liftM2 . LLVM.cmp
instance Comparison Int8 where cmp = liftM2 . LLVM.cmp
instance Comparison Int16 where cmp = liftM2 . LLVM.cmp
instance Comparison Int32 where cmp = liftM2 . LLVM.cmp
instance Comparison Int64 where cmp = liftM2 . LLVM.cmp

instance Comparison Word where cmp = liftM2 . LLVM.cmp
instance Comparison Word8 where cmp = liftM2 . LLVM.cmp
instance Comparison Word16 where cmp = liftM2 . LLVM.cmp
instance Comparison Word32 where cmp = liftM2 . LLVM.cmp
instance Comparison Word64 where cmp = liftM2 . LLVM.cmp

instance (Dec.Positive n) => Comparison (IntN n) where cmp = liftM2 . LLVM.cmp
instance (Dec.Positive n) => Comparison (WordN n) where cmp = liftM2 . LLVM.cmp

instance (Comparison a) => Comparison (Tagged tag a) where
   cmp p a b = cmp p (untag a) (untag b)

instance (Comparison a) => A.Comparison (T a) where
   type CmpResult (T a) = T Bool
   cmp = cmp



class (Comparison a) => FloatingComparison a where
   fcmp ::
      LLVM.FPPredicate -> T a -> T a ->
      LLVM.CodeGenFunction r (T Bool)

instance FloatingComparison Float where
   fcmp = liftM2 . LLVM.fcmp

instance (FloatingComparison a) => FloatingComparison (Tagged tag a) where
   fcmp p a b = fcmp p (untag a) (untag b)

instance (FloatingComparison a) => A.FloatingComparison (T a) where
   fcmp = fcmp



class (C a) => Logic a where
   and :: T a -> T a -> LLVM.CodeGenFunction r (T a)
   or :: T a -> T a -> LLVM.CodeGenFunction r (T a)
   xor :: T a -> T a -> LLVM.CodeGenFunction r (T a)
   inv :: T a -> LLVM.CodeGenFunction r (T a)

instance Logic Bool where
   and = liftM2 LLVM.and; or = liftM2 LLVM.or
   xor = liftM2 LLVM.xor; inv = liftM LLVM.inv

instance Logic Bool8 where
   and = liftM2 LLVM.and; or = liftM2 LLVM.or
   xor = liftM2 LLVM.xor; inv = liftM LLVM.inv

instance Logic Word8 where
   and = liftM2 LLVM.and; or = liftM2 LLVM.or
   xor = liftM2 LLVM.xor; inv = liftM LLVM.inv

instance Logic Word16 where
   and = liftM2 LLVM.and; or = liftM2 LLVM.or
   xor = liftM2 LLVM.xor; inv = liftM LLVM.inv

instance Logic Word32 where
   and = liftM2 LLVM.and; or = liftM2 LLVM.or
   xor = liftM2 LLVM.xor; inv = liftM LLVM.inv

instance Logic Word64 where
   and = liftM2 LLVM.and; or = liftM2 LLVM.or
   xor = liftM2 LLVM.xor; inv = liftM LLVM.inv

instance (Dec.Positive n) => Logic (WordN n) where
   and = liftM2 LLVM.and; or = liftM2 LLVM.or
   xor = liftM2 LLVM.xor; inv = liftM LLVM.inv

instance (LLVM.IsInteger w, LLVM.IsConst w) => Logic (EnumBitSet.T w i) where
   and = liftM2 LLVM.and; or = liftM2 LLVM.or
   xor = liftM2 LLVM.xor; inv = liftM LLVM.inv

instance Logic a => Logic (Tagged tag a) where
   and = liftTaggedM2 and; or = liftTaggedM2 or
   xor = liftTaggedM2 xor; inv = liftTaggedM inv


instance Logic a => A.Logic (T a) where
   and = and
   or = or
   xor = xor
   inv = inv



class BitShift a where
   shl :: T a -> T a -> LLVM.CodeGenFunction r (T a)
   shr :: T a -> T a -> LLVM.CodeGenFunction r (T a)

instance BitShift Word where
   shl = liftM2 LLVM.shl; shr = liftM2 LLVM.lshr

instance BitShift Word8 where
   shl = liftM2 LLVM.shl; shr = liftM2 LLVM.lshr

instance BitShift Word16 where
   shl = liftM2 LLVM.shl; shr = liftM2 LLVM.lshr

instance BitShift Word32 where
   shl = liftM2 LLVM.shl; shr = liftM2 LLVM.lshr

instance BitShift Word64 where
   shl = liftM2 LLVM.shl; shr = liftM2 LLVM.lshr

instance BitShift Int where
   shl = liftM2 LLVM.shl; shr = liftM2 LLVM.ashr

instance BitShift Int8 where
   shl = liftM2 LLVM.shl; shr = liftM2 LLVM.ashr

instance BitShift Int16 where
   shl = liftM2 LLVM.shl; shr = liftM2 LLVM.ashr

instance BitShift Int32 where
   shl = liftM2 LLVM.shl; shr = liftM2 LLVM.ashr

instance BitShift Int64 where
   shl = liftM2 LLVM.shl; shr = liftM2 LLVM.ashr



class (PseudoRing a) => Integral a where
   idiv :: T a -> T a -> LLVM.CodeGenFunction r (T a)
   irem :: T a -> T a -> LLVM.CodeGenFunction r (T a)

instance Integral Word where
   idiv = liftM2 LLVM.idiv
   irem = liftM2 LLVM.irem

instance Integral Word32 where
   idiv = liftM2 LLVM.idiv
   irem = liftM2 LLVM.irem

instance Integral Word64 where
   idiv = liftM2 LLVM.idiv
   irem = liftM2 LLVM.irem

instance Integral Int where
   idiv = liftM2 LLVM.idiv
   irem = liftM2 LLVM.irem

instance Integral Int32 where
   idiv = liftM2 LLVM.idiv
   irem = liftM2 LLVM.irem

instance Integral Int64 where
   idiv = liftM2 LLVM.idiv
   irem = liftM2 LLVM.irem

instance (Integral a) => Integral (Tagged tag a) where
   idiv = liftTaggedM2 idiv
   irem = liftTaggedM2 irem


fromIntegral ::
   (NativeInteger i ir, NativeFloating a ar) =>
   T i -> LLVM.CodeGenFunction r (T a)
fromIntegral = liftM LLVM.inttofp