{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}
{- |
In contrast to 'LLVM.Struct' it allows to store high-level values
and thus allows to implement arbitrary-sized tuples of MultiValue's.
-}
module LLVM.Extra.Struct where

import qualified LLVM.Extra.Tuple as Tuple

import qualified LLVM.Core as LLVM

import qualified Control.Applicative.HT as App
import Control.Applicative ((<$>))


newtype T struct = Cons struct


class Undefined struct where
   undef :: struct

instance (Undefined struct) => Tuple.Undefined (T struct) where
   undef = Cons undef

instance
   (Tuple.Undefined a, Undefined as) =>
      Undefined (a,as) where
   undef = (Tuple.undef, undef)

instance Undefined () where
   undef = ()


class Zero struct where
   zero :: struct

instance (Zero struct) => Tuple.Zero (T struct) where
   zero = Cons zero

instance (Tuple.Zero a, Zero as) => Zero (a,as) where
   zero = (Tuple.zero, zero)

instance Zero () where
   zero = ()


class Phi struct where
   phi :: LLVM.BasicBlock -> struct -> LLVM.CodeGenFunction r struct
   addPhi :: LLVM.BasicBlock -> struct -> struct -> LLVM.CodeGenFunction r ()

instance (Phi struct) => Tuple.Phi (T struct) where
   phi bb (Cons s) = Cons <$> phi bb s
   addPhi bb (Cons a) (Cons b) = addPhi bb a b

instance (Tuple.Phi a, Phi as) => Phi (a,as) where
   phi bb (a,as) = App.lift2 (,) (Tuple.phi bb a) (phi bb as)
   addPhi bb (a,as) (b,bs) = Tuple.addPhi bb a b >> addPhi bb as bs

instance Phi () where
   phi _bb = return
   addPhi _bb () () = return ()


class (Undefined (ValueOf struct)) => Value struct where
   type ValueOf struct
   valueOf :: struct -> ValueOf struct

instance (Value struct) => Tuple.Value (T struct) where
   type ValueOf (T struct) = T (ValueOf struct)
   valueOf (Cons struct) = Cons $ valueOf struct

instance (Tuple.Value a, Value as) => Value (a,as) where
   type ValueOf (a,as) = (Tuple.ValueOf a, ValueOf as)
   valueOf (a,as) = (Tuple.valueOf a, valueOf as)

instance Value () where
   type ValueOf () = ()
   valueOf () = ()