{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
module LLVM.Extra.Class where

import qualified LLVM.Core as LLVM
import LLVM.Core
   (Undefined, undefTuple,
    IsTuple, tupleDesc, TypeDesc,
    MakeValueTuple, valueTupleOf,
    Value,
    CodeGenFunction, BasicBlock, )
import LLVM.Util.Loop (Phi, phis, addPhis, )

import Control.Applicative (pure, liftA2, )
import qualified Control.Applicative as App
import qualified Data.Foldable as Fold
import qualified Data.Traversable as Trav

import Prelude hiding (and, iterate, map, zipWith, writeFile, )


-- * class for tuples of zero values

class Zero a where
   zeroTuple :: a

instance Zero () where
   zeroTuple = ()

instance (LLVM.IsFirstClass a) => Zero (Value a) where
   zeroTuple = LLVM.value LLVM.zero

instance (Zero a, Zero b) => Zero (a, b) where
   zeroTuple = (zeroTuple, zeroTuple)

instance (Zero a, Zero b, Zero c) => Zero (a, b, c) where
   zeroTuple = (zeroTuple, zeroTuple, zeroTuple)

zeroTuplePointed ::
   (Zero a, App.Applicative f) =>
   f a
zeroTuplePointed =
   pure zeroTuple


-- * default methods for LLVM classes

{-
buildTupleTraversable ::
   (Undefined a, Trav.Traversable f, App.Applicative f) =>
   FunctionRef -> State Int (f a)
buildTupleTraversable f =
   Trav.sequence (pure (buildTuple f))
-}
{-
buildTupleTraversable ::
   (Trav.Traversable f, App.Applicative f) =>
   State Int a ->
   State Int (f a)
buildTupleTraversable build =
   Trav.sequence (pure build)
-}
buildTupleTraversable ::
   (Monad m, Trav.Traversable f, App.Applicative f) =>
   m a ->
   m (f a)
buildTupleTraversable build =
   Trav.sequence (pure build)

undefTuplePointed ::
   (Undefined a, App.Applicative f) =>
   f a
undefTuplePointed =
   pure undefTuple

valueTupleOfFunctor ::
   (MakeValueTuple h l, Functor f) =>
   f h -> f l
valueTupleOfFunctor =
   fmap valueTupleOf

tupleDescFoldable ::
   (IsTuple a, Fold.Foldable f) =>
   f a -> [TypeDesc]
tupleDescFoldable =
   Fold.foldMap tupleDesc

phisTraversable ::
   (Phi a, Trav.Traversable f) =>
   BasicBlock -> f a -> CodeGenFunction r (f a)
phisTraversable bb x =
   Trav.mapM (phis bb) x

addPhisFoldable ::
   (Phi a, Fold.Foldable f, App.Applicative f) =>
   BasicBlock -> f a -> f a -> CodeGenFunction r ()
addPhisFoldable bb x y =
   Fold.sequence_ (liftA2 (addPhis bb) x y)