{-# 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