{-# 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 :: T struct
undef = struct -> T struct
forall struct. struct -> T struct
Cons struct
forall struct. Undefined struct => struct
undef

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

instance Undefined () where
   undef :: ()
undef = ()


class Zero struct where
   zero :: struct

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

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

instance Zero () where
   zero :: ()
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 :: forall r. BasicBlock -> T struct -> CodeGenFunction r (T struct)
phi BasicBlock
bb (Cons struct
s) = struct -> T struct
forall struct. struct -> T struct
Cons (struct -> T struct)
-> CodeGenFunction r struct -> CodeGenFunction r (T struct)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BasicBlock -> struct -> CodeGenFunction r struct
forall r. BasicBlock -> struct -> CodeGenFunction r struct
forall struct r.
Phi struct =>
BasicBlock -> struct -> CodeGenFunction r struct
phi BasicBlock
bb struct
s
   addPhi :: forall r.
BasicBlock -> T struct -> T struct -> CodeGenFunction r ()
addPhi BasicBlock
bb (Cons struct
a) (Cons struct
b) = BasicBlock -> struct -> struct -> CodeGenFunction r ()
forall r. BasicBlock -> struct -> struct -> CodeGenFunction r ()
forall struct r.
Phi struct =>
BasicBlock -> struct -> struct -> CodeGenFunction r ()
addPhi BasicBlock
bb struct
a struct
b

instance (Tuple.Phi a, Phi as) => Phi (a,as) where
   phi :: forall r. BasicBlock -> (a, as) -> CodeGenFunction r (a, as)
phi BasicBlock
bb (a
a,as
as) = (a -> as -> (a, as))
-> CodeGenFunction r a
-> CodeGenFunction r as
-> CodeGenFunction r (a, as)
forall (m :: * -> *) a b r.
Applicative m =>
(a -> b -> r) -> m a -> m b -> m r
App.lift2 (,) (BasicBlock -> a -> CodeGenFunction r a
forall r. BasicBlock -> a -> CodeGenFunction r a
forall a r. Phi a => BasicBlock -> a -> CodeGenFunction r a
Tuple.phi BasicBlock
bb a
a) (BasicBlock -> as -> CodeGenFunction r as
forall r. BasicBlock -> as -> CodeGenFunction r as
forall struct r.
Phi struct =>
BasicBlock -> struct -> CodeGenFunction r struct
phi BasicBlock
bb as
as)
   addPhi :: forall r. BasicBlock -> (a, as) -> (a, as) -> CodeGenFunction r ()
addPhi BasicBlock
bb (a
a,as
as) (a
b,as
bs) = BasicBlock -> a -> a -> CodeGenFunction r ()
forall r. BasicBlock -> a -> a -> CodeGenFunction r ()
forall a r. Phi a => BasicBlock -> a -> a -> CodeGenFunction r ()
Tuple.addPhi BasicBlock
bb a
a a
b CodeGenFunction r ()
-> CodeGenFunction r () -> CodeGenFunction r ()
forall a b.
CodeGenFunction r a -> CodeGenFunction r b -> CodeGenFunction r b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BasicBlock -> as -> as -> CodeGenFunction r ()
forall r. BasicBlock -> as -> as -> CodeGenFunction r ()
forall struct r.
Phi struct =>
BasicBlock -> struct -> struct -> CodeGenFunction r ()
addPhi BasicBlock
bb as
as as
bs

instance Phi () where
   phi :: forall r. BasicBlock -> () -> CodeGenFunction r ()
phi BasicBlock
_bb = () -> CodeGenFunction r ()
forall a. a -> CodeGenFunction r a
forall (m :: * -> *) a. Monad m => a -> m a
return
   addPhi :: forall r. BasicBlock -> () -> () -> CodeGenFunction r ()
addPhi BasicBlock
_bb () () = () -> CodeGenFunction r ()
forall a. a -> CodeGenFunction r a
forall (m :: * -> *) a. Monad m => a -> m a
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 :: T struct -> ValueOf (T struct)
valueOf (Cons struct
struct) = ValueOf struct -> T (ValueOf struct)
forall struct. struct -> T struct
Cons (ValueOf struct -> T (ValueOf struct))
-> ValueOf struct -> T (ValueOf struct)
forall a b. (a -> b) -> a -> b
$ struct -> ValueOf struct
forall struct. Value struct => struct -> ValueOf struct
valueOf struct
struct

instance (Tuple.Value a, Value as) => Value (a,as) where
   type ValueOf (a,as) = (Tuple.ValueOf a, ValueOf as)
   valueOf :: (a, as) -> ValueOf (a, as)
valueOf (a
a,as
as) = (a -> ValueOf a
forall a. Value a => a -> ValueOf a
Tuple.valueOf a
a, as -> ValueOf as
forall struct. Value struct => struct -> ValueOf struct
valueOf as
as)

instance Value () where
   type ValueOf () = ()
   valueOf :: () -> ValueOf ()
valueOf () = ()