module Feldspar.Core.Constructs.Complex
where
import Language.Syntactic
import Language.Syntactic.Constructs.Binding
import Data.Complex
import Feldspar.Core.Types
import Feldspar.Core.Interpretation
data COMPLEX a
where
MkComplex :: (Type a, RealFloat a) => COMPLEX (a :-> a :-> Full (Complex a))
RealPart :: (Type a, RealFloat a) => COMPLEX (Complex a :-> Full a)
ImagPart :: (Type a, RealFloat a) => COMPLEX (Complex a :-> Full a)
Conjugate :: (Type a, RealFloat a) => COMPLEX (Complex a :-> Full (Complex a))
MkPolar :: (Type a, RealFloat a) => COMPLEX (a :-> a :-> Full (Complex a))
Magnitude :: (Type a, RealFloat a) => COMPLEX (Complex a :-> Full a)
Phase :: (Type a, RealFloat a) => COMPLEX (Complex a :-> Full a)
Cis :: (Type a, RealFloat a) => COMPLEX (a :-> Full (Complex a))
instance Semantic COMPLEX
where
semantics MkComplex = Sem "complex" (:+)
semantics RealPart = Sem "creal" realPart
semantics ImagPart = Sem "cimag" imagPart
semantics Conjugate = Sem "conjugate" conjugate
semantics MkPolar = Sem "mkPolar" mkPolar
semantics Magnitude = Sem "magnitude" magnitude
semantics Phase = Sem "phase" phase
semantics Cis = Sem "cis" cis
instance Equality COMPLEX where equal = equalDefault; exprHash = exprHashDefault
instance Render COMPLEX where renderArgs = renderArgsDefault
instance ToTree COMPLEX
instance Eval COMPLEX where evaluate = evaluateDefault
instance EvalBind COMPLEX where evalBindSym = evalBindSymDefault
instance Sharable COMPLEX
instance SizeProp (COMPLEX :|| Type)
where
sizeProp (C' s) = sizePropDefault s
instance AlphaEq dom dom dom env => AlphaEq COMPLEX COMPLEX dom env
where
alphaEqSym = alphaEqSymDefault
instance ( (COMPLEX :|| Type) :<: dom
, OptimizeSuper dom)
=> Optimize (COMPLEX :|| Type) dom
where
constructFeatOpt (C' MkComplex) ((rp :$ a) :* (ip :$ b) :* Nil)
| Just (C' RealPart) <- prjF rp
, Just (C' ImagPart) <- prjF ip
, alphaEq a b
= return a
constructFeatOpt (C' RealPart) ((mkc :$ r :$ _) :* Nil)
| Just (C' MkComplex) <- prjF mkc
= return r
constructFeatOpt (C' ImagPart) ((mkc :$ _ :$ i) :* Nil)
| Just (C' MkComplex) <- prjF mkc
= return i
constructFeatOpt (C' MkPolar) ((mag :$ a) :* (ph :$ b) :* Nil)
| Just (C' Magnitude) <- prjF mag
, Just (C' Phase) <- prjF ph
, alphaEq a b
= return a
constructFeatOpt (C' Magnitude) ((mkp :$ m :$ _) :* Nil)
| Just (C' MkPolar) <- prjF mkp
= return m
constructFeatOpt (C' Phase) ((mkp :$ _ :$ p) :* Nil)
| Just (C' MkPolar) <- prjF mkp
= return p
constructFeatOpt (C' Conjugate) ((conj :$ a) :* Nil)
| Just (C' Conjugate) <- prjF conj
= return a
constructFeatOpt sym args = constructFeatUnOpt sym args
constructFeatUnOpt x@(C' _) = constructFeatUnOptDefault x