{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Synthesizer.LLVM.Complex (
   Complex.T(Complex.real, Complex.imag),
   Struct,
   (Complex.+:),
   Complex.cis,
   Complex.scale,
   constOf, unfold,
   ) where

import qualified Synthesizer.LLVM.Simple.Value as Value

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


type Struct a = LLVM.Struct (a, (a, ()))

constOf :: IsConst a =>
   Complex.T a -> ConstValue (Struct a)
constOf x =
   LLVM.constStruct
      (LLVM.constOf $ Complex.real x,
        (LLVM.constOf $ Complex.imag x,
          ()))

unfold ::
   Value (Struct a) -> Complex.T (Value.T (Value a))
unfold x =
   Value.lift0 (LLVM.extractvalue x TypeNum.d0)
   Complex.+:
   Value.lift0 (LLVM.extractvalue x TypeNum.d1)


instance (Tuple.Undefined a) => Tuple.Undefined (Complex.T a) where
   undef = (Complex.+:) Tuple.undef Tuple.undef

instance (Tuple.Phi a) => Tuple.Phi (Complex.T a) where
   phi bb v =
      liftA2 (Complex.+:)
         (Tuple.phi bb (Complex.real v))
         (Tuple.phi bb (Complex.imag v))
   addPhi bb x y = do
      Tuple.addPhi bb (Complex.real x) (Complex.real y)
      Tuple.addPhi bb (Complex.imag x) (Complex.imag y)


memory ::
   (Memory.C l) =>
   Memory.Record r (Struct (Memory.Struct l)) (Complex.T l)
memory =
   liftA2 (Complex.+:)
      (Memory.element Complex.real TypeNum.d0)
      (Memory.element Complex.imag TypeNum.d1)

instance (Memory.C l) => Memory.C (Complex.T l) where
   type Struct (Complex.T l) = Struct (Memory.Struct l)
   load = Memory.loadRecord memory
   store = Memory.storeRecord memory
   decompose = Memory.decomposeRecord memory
   compose = Memory.composeRecord memory