Complex.hs

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

import qualified Synthesizer.LLVM.Simple.Value as Value

import qualified LLVM.Extra.Memory as Memory
import LLVM.Extra.Class (Undefined, undefTuple, )

import qualified LLVM.Core as LLVM
import LLVM.Core (Value, ConstValue, Struct, IsConst, )
import LLVM.Util.Loop (Phi, phis, addPhis, )

import qualified Data.TypeLevel.Num      as TypeNum

import Control.Applicative (liftA2, )

import qualified Number.Complex as Complex

{-
import NumericPrelude.Numeric
import NumericPrelude.Base
-}

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

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


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

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


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

instance
      (Memory.C l s, LLVM.IsSized s ss) =>
      Memory.C (Complex.T l) (LLVM.Struct (s, (s, ()))) where
   load = Memory.loadRecord memory
   store = Memory.storeRecord memory
   decompose = Memory.decomposeRecord memory
   compose = Memory.composeRecord memory