{-# LANGUAGE TypeFamilies #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Synthesizer.LLVM.Complex ( Complex.T(Complex.real, Complex.imag), Struct, (+:), Complex.cis, Complex.scale, constOf, unfold, ) where import qualified Synthesizer.LLVM.Value as Value import qualified LLVM.Extra.Multi.Value.Marshal as Marshal import qualified LLVM.Extra.Multi.Value as MultiValue import qualified LLVM.Extra.Memory as Memory import qualified LLVM.Extra.Tuple as Tuple import qualified LLVM.Core as LLVM import LLVM.Core (Value, ConstValue, IsConst) import qualified Type.Data.Num.Decimal as TypeNum import Control.Applicative (liftA2) import qualified Number.Complex as Complex import Number.Complex ((+:)) type Struct a = LLVM.Struct (a, (a, ())) constOf :: IsConst a => Complex.T a -> ConstValue (Struct a) constOf :: forall a. IsConst a => T a -> ConstValue (Struct a) constOf T a x = (ConstValue a, (ConstValue a, ())) -> ConstValue (Struct (ConstStructOf (ConstValue a, (ConstValue a, ())))) forall c. IsConstStruct c => c -> ConstValue (Struct (ConstStructOf c)) LLVM.constStruct (a -> ConstValue a forall a. IsConst a => a -> ConstValue a LLVM.constOf (a -> ConstValue a) -> a -> ConstValue a forall a b. (a -> b) -> a -> b $ T a -> a forall a. T a -> a Complex.real T a x, (a -> ConstValue a forall a. IsConst a => a -> ConstValue a LLVM.constOf (a -> ConstValue a) -> a -> ConstValue a forall a b. (a -> b) -> a -> b $ T a -> a forall a. T a -> a Complex.imag T a x, ())) unfold :: Value (Struct a) -> Complex.T (Value.T (Value a)) unfold :: forall a. Value (Struct a) -> T (T (Value a)) unfold Value (Struct a) x = (forall r. CodeGenFunction r (Value a)) -> T (Value a) forall a. (forall r. CodeGenFunction r a) -> T a Value.lift0 (Value (Struct a) -> Proxy D0 -> CodeGenFunction r (Value (ValueType (Struct a) (Proxy D0))) forall r agg i. GetValue agg i => Value agg -> i -> CodeGenFunction r (Value (ValueType agg i)) LLVM.extractvalue Value (Struct a) x Proxy D0 TypeNum.d0) T (Value a) -> T (Value a) -> T (T (Value a)) forall a. a -> a -> T a +: (forall r. CodeGenFunction r (Value a)) -> T (Value a) forall a. (forall r. CodeGenFunction r a) -> T a Value.lift0 (Value (Struct a) -> Proxy D1 -> CodeGenFunction r (Value (ValueType (Struct a) (Proxy D1))) forall r agg i. GetValue agg i => Value agg -> i -> CodeGenFunction r (Value (ValueType agg i)) LLVM.extractvalue Value (Struct a) x Proxy D1 TypeNum.d1) instance (Tuple.Undefined a) => Tuple.Undefined (Complex.T a) where undef :: T a undef = a forall a. Undefined a => a Tuple.undef a -> a -> T a forall a. a -> a -> T a +: a forall a. Undefined a => a Tuple.undef instance (Tuple.Phi a) => Tuple.Phi (Complex.T a) where phi :: forall r. BasicBlock -> T a -> CodeGenFunction r (T a) phi BasicBlock bb T a v = (a -> a -> T a) -> CodeGenFunction r a -> CodeGenFunction r a -> CodeGenFunction r (T a) forall a b c. (a -> b -> c) -> CodeGenFunction r a -> CodeGenFunction r b -> CodeGenFunction r c forall (f :: * -> *) a b c. Applicative f => (a -> b -> c) -> f a -> f b -> f c liftA2 a -> a -> T a forall a. a -> a -> T a (+:) (BasicBlock -> a -> CodeGenFunction r a forall a r. Phi a => BasicBlock -> a -> CodeGenFunction r a forall r. BasicBlock -> a -> CodeGenFunction r a Tuple.phi BasicBlock bb (T a -> a forall a. T a -> a Complex.real T a v)) (BasicBlock -> a -> CodeGenFunction r a forall a r. Phi a => BasicBlock -> a -> CodeGenFunction r a forall r. BasicBlock -> a -> CodeGenFunction r a Tuple.phi BasicBlock bb (T a -> a forall a. T a -> a Complex.imag T a v)) addPhi :: forall r. BasicBlock -> T a -> T a -> CodeGenFunction r () addPhi BasicBlock bb T a x T a y = do BasicBlock -> a -> a -> CodeGenFunction r () forall a r. Phi a => BasicBlock -> a -> a -> CodeGenFunction r () forall r. BasicBlock -> a -> a -> CodeGenFunction r () Tuple.addPhi BasicBlock bb (T a -> a forall a. T a -> a Complex.real T a x) (T a -> a forall a. T a -> a Complex.real T a y) BasicBlock -> a -> a -> CodeGenFunction r () forall a r. Phi a => BasicBlock -> a -> a -> CodeGenFunction r () forall r. BasicBlock -> a -> a -> CodeGenFunction r () Tuple.addPhi BasicBlock bb (T a -> a forall a. T a -> a Complex.imag T a x) (T a -> a forall a. T a -> a Complex.imag T a y) memory :: (Memory.C l) => Memory.Record r (Struct (Memory.Struct l)) (Complex.T l) memory :: forall l r. C l => Record r (Struct (Struct l)) (T l) memory = (l -> l -> T l) -> Element r (Struct (Struct l)) (T l) l -> Element r (Struct (Struct l)) (T l) l -> Element r (Struct (Struct l)) (T l) (T l) forall a b c. (a -> b -> c) -> Element r (Struct (Struct l)) (T l) a -> Element r (Struct (Struct l)) (T l) b -> Element r (Struct (Struct l)) (T l) c forall (f :: * -> *) a b c. Applicative f => (a -> b -> c) -> f a -> f b -> f c liftA2 l -> l -> T l forall a. a -> a -> T a (+:) ((T l -> l) -> Proxy D0 -> Element r (Struct (Struct l)) (T l) l forall x o n v r. (C x, GetValue o n, ValueType o n ~ Struct x, GetElementPtr o (n, ()), ElementPtrType o (n, ()) ~ Struct x) => (v -> x) -> n -> Element r o v x Memory.element T l -> l forall a. T a -> a Complex.real Proxy D0 TypeNum.d0) ((T l -> l) -> Proxy D1 -> Element r (Struct (Struct l)) (T l) l forall x o n v r. (C x, GetValue o n, ValueType o n ~ Struct x, GetElementPtr o (n, ()), ElementPtrType o (n, ()) ~ Struct x) => (v -> x) -> n -> Element r o v x Memory.element T l -> l forall a. T a -> a Complex.imag Proxy D1 TypeNum.d1) instance (Memory.C l) => Memory.C (Complex.T l) where type Struct (Complex.T l) = Struct (Memory.Struct l) load :: forall r. Value (Ptr (Struct (T l))) -> CodeGenFunction r (T l) load = Record r (Struct (Struct l)) (T l) -> Value (Ptr (Struct (Struct l))) -> CodeGenFunction r (T l) forall r o llvmValue. Record r o llvmValue -> Value (Ptr o) -> CodeGenFunction r llvmValue Memory.loadRecord Record r (Struct (Struct l)) (T l) forall l r. C l => Record r (Struct (Struct l)) (T l) memory store :: forall r. T l -> Value (Ptr (Struct (T l))) -> CodeGenFunction r () store = Record r (Struct (Struct l)) (T l) -> T l -> Value (Ptr (Struct (Struct l))) -> CodeGenFunction r () forall r o llvmValue. Record r o llvmValue -> llvmValue -> Value (Ptr o) -> CodeGenFunction r () Memory.storeRecord Record r (Struct (Struct l)) (T l) forall l r. C l => Record r (Struct (Struct l)) (T l) memory decompose :: forall r. Value (Struct (T l)) -> CodeGenFunction r (T l) decompose = Record r (Struct (Struct l)) (T l) -> Value (Struct (Struct l)) -> CodeGenFunction r (T l) forall r o llvmValue. Record r o llvmValue -> Value o -> CodeGenFunction r llvmValue Memory.decomposeRecord Record r (Struct (Struct l)) (T l) forall l r. C l => Record r (Struct (Struct l)) (T l) memory compose :: forall r. T l -> CodeGenFunction r (Value (Struct (T l))) compose = Record r (Struct (Struct l)) (T l) -> T l -> CodeGenFunction r (Value (Struct (Struct l))) forall o r llvmValue. IsType o => Record r o llvmValue -> llvmValue -> CodeGenFunction r (Value o) Memory.composeRecord Record r (Struct (Struct l)) (T l) forall l r. C l => Record r (Struct (Struct l)) (T l) memory instance (MultiValue.C a) => MultiValue.C (Complex.T a) where type Repr (Complex.T a) = Complex.T (MultiValue.Repr a) cons :: T a -> T (T a) cons T a x = T a -> T a -> T (T a) forall a. T a -> T a -> T (T a) consMV (a -> T a forall a. C a => a -> T a MultiValue.cons (a -> T a) -> a -> T a forall a b. (a -> b) -> a -> b $ T a -> a forall a. T a -> a Complex.real T a x) (a -> T a forall a. C a => a -> T a MultiValue.cons (a -> T a) -> a -> T a forall a b. (a -> b) -> a -> b $ T a -> a forall a. T a -> a Complex.imag T a x) undef :: T (T a) undef = T a -> T a -> T (T a) forall a. T a -> T a -> T (T a) consMV T a forall a. C a => T a MultiValue.undef T a forall a. C a => T a MultiValue.undef zero :: T (T a) zero = T a -> T a -> T (T a) forall a. T a -> T a -> T (T a) consMV T a forall a. C a => T a MultiValue.zero T a forall a. C a => T a MultiValue.zero phi :: forall r. BasicBlock -> T (T a) -> CodeGenFunction r (T (T a)) phi BasicBlock bb T (T a) a = case T (T a) -> (T a, T a) forall a. T (T a) -> (T a, T a) deconsMV T (T a) a of (T a a0,T a a1) -> (T a -> T a -> T (T a)) -> CodeGenFunction r (T a) -> CodeGenFunction r (T a) -> CodeGenFunction r (T (T a)) forall a b c. (a -> b -> c) -> CodeGenFunction r a -> CodeGenFunction r b -> CodeGenFunction r c forall (f :: * -> *) a b c. Applicative f => (a -> b -> c) -> f a -> f b -> f c liftA2 T a -> T a -> T (T a) forall a. T a -> T a -> T (T a) consMV (BasicBlock -> T a -> CodeGenFunction r (T a) forall a r. C a => BasicBlock -> T a -> CodeGenFunction r (T a) forall r. BasicBlock -> T a -> CodeGenFunction r (T a) MultiValue.phi BasicBlock bb T a a0) (BasicBlock -> T a -> CodeGenFunction r (T a) forall a r. C a => BasicBlock -> T a -> CodeGenFunction r (T a) forall r. BasicBlock -> T a -> CodeGenFunction r (T a) MultiValue.phi BasicBlock bb T a a1) addPhi :: forall r. BasicBlock -> T (T a) -> T (T a) -> CodeGenFunction r () addPhi BasicBlock bb T (T a) a T (T a) b = case (T (T a) -> (T a, T a) forall a. T (T a) -> (T a, T a) deconsMV T (T a) a, T (T a) -> (T a, T a) forall a. T (T a) -> (T a, T a) deconsMV T (T a) b) of ((T a a0,T a a1), (T a b0,T a b1)) -> BasicBlock -> T a -> T a -> CodeGenFunction r () forall a r. C a => BasicBlock -> T a -> T a -> CodeGenFunction r () forall r. BasicBlock -> T a -> T a -> CodeGenFunction r () MultiValue.addPhi BasicBlock bb T a a0 T a b0 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 -> T a -> T a -> CodeGenFunction r () forall a r. C a => BasicBlock -> T a -> T a -> CodeGenFunction r () forall r. BasicBlock -> T a -> T a -> CodeGenFunction r () MultiValue.addPhi BasicBlock bb T a a1 T a b1 consMV :: MultiValue.T a -> MultiValue.T a -> MultiValue.T (Complex.T a) consMV :: forall a. T a -> T a -> T (T a) consMV (MultiValue.Cons Repr a a) (MultiValue.Cons Repr a b) = Repr (T a) -> T (T a) forall a. Repr a -> T a MultiValue.Cons (Repr a aRepr a -> Repr a -> T (Repr a) forall a. a -> a -> T a +:Repr a b) deconsMV :: MultiValue.T (Complex.T a) -> (MultiValue.T a, MultiValue.T a) deconsMV :: forall a. T (T a) -> (T a, T a) deconsMV (MultiValue.Cons Repr (T a) x) = (Repr a -> T a forall a. Repr a -> T a MultiValue.Cons (Repr a -> T a) -> Repr a -> T a forall a b. (a -> b) -> a -> b $ T (Repr a) -> Repr a forall a. T a -> a Complex.real Repr (T a) T (Repr a) x, Repr a -> T a forall a. Repr a -> T a MultiValue.Cons (Repr a -> T a) -> Repr a -> T a forall a b. (a -> b) -> a -> b $ T (Repr a) -> Repr a forall a. T a -> a Complex.imag Repr (T a) T (Repr a) x) instance (Marshal.C a) => Marshal.C (Complex.T a) where pack :: T a -> Struct (T a) pack T a x = Struct (Repr a) -> Struct (Repr a) -> Struct (Struct (Repr a)) forall f. (ConsStruct f, ConsResult f ~ PartialStruct f) => f LLVM.consStruct (a -> Struct (Repr a) forall a. C a => a -> Struct a Marshal.pack (a -> Struct (Repr a)) -> a -> Struct (Repr a) forall a b. (a -> b) -> a -> b $ T a -> a forall a. T a -> a Complex.real T a x) (a -> Struct (Repr a) forall a. C a => a -> Struct a Marshal.pack (a -> Struct (Repr a)) -> a -> Struct (Repr a) forall a b. (a -> b) -> a -> b $ T a -> a forall a. T a -> a Complex.imag T a x) unpack :: Struct (T a) -> T a unpack = Curried (Struct (Repr a), (Struct (Repr a), ())) (T a) -> Struct (Struct (Repr a)) -> T a forall a b. CurryStruct a => Curried a b -> Struct a -> b LLVM.uncurryStruct (Curried (Struct (Repr a), (Struct (Repr a), ())) (T a) -> Struct (Struct (Repr a)) -> T a) -> Curried (Struct (Repr a), (Struct (Repr a), ())) (T a) -> Struct (Struct (Repr a)) -> T a forall a b. (a -> b) -> a -> b $ \Struct (Repr a) a Struct (Repr a) b -> Struct (Repr a) -> a forall a. C a => Struct a -> a Marshal.unpack Struct (Repr a) a a -> a -> T a forall a. a -> a -> T a +: Struct (Repr a) -> a forall a. C a => Struct a -> a Marshal.unpack Struct (Repr a) b