{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}
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 () = ()