{-# LANGUAGE QuasiQuotes #-}
{-# OPTIONS_GHC -fwarn-incomplete-patterns #-}
module Feldspar.Primitive.Backend.C where
import Data.Complex
import Data.Constraint (Dict (..))
import Data.Proxy
import Language.C.Quote.C
import qualified Language.C.Syntax as C
import Language.C.Monad
import Language.Embedded.Backend.C
import Language.Syntactic
import Feldspar.Primitive.Representation
viewLitPrim :: ASTF (Primitive :&: PrimTypeRep) a -> Maybe a
viewLitPrim :: ASTF (Primitive :&: PrimTypeRep) a -> Maybe a
viewLitPrim (Sym (Lit a
a :&: PrimTypeRep (DenResult (Full a))
_)) = a -> Maybe a
forall a. a -> Maybe a
Just a
a
viewLitPrim (Sym (Primitive (Full a)
Pi :&: PrimTypeRep (DenResult (Full a))
_)) = a -> Maybe a
forall a. a -> Maybe a
Just a
forall a. Floating a => a
pi
viewLitPrim ASTF (Primitive :&: PrimTypeRep) a
_ = Maybe a
forall a. Maybe a
Nothing
instance CompTypeClass PrimType'
where
compType :: proxy1 PrimType' -> proxy2 a -> m Type
compType proxy1 PrimType'
_ (proxy2 a
_ :: proxy a) = case PrimTypeRep a
forall a. PrimType' a => PrimTypeRep a
primTypeRep :: PrimTypeRep a of
PrimTypeRep a
BoolT -> String -> m ()
forall (m :: * -> *). MonadC m => String -> m ()
addInclude String
"<stdbool.h>" m () -> m Type -> m Type
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Type -> m Type
forall (m :: * -> *) a. Monad m => a -> m a
return [cty| typename bool |]
PrimTypeRep a
Int8T -> String -> m ()
forall (m :: * -> *). MonadC m => String -> m ()
addInclude String
"<stdint.h>" m () -> m Type -> m Type
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Type -> m Type
forall (m :: * -> *) a. Monad m => a -> m a
return [cty| typename int8_t |]
PrimTypeRep a
Int16T -> String -> m ()
forall (m :: * -> *). MonadC m => String -> m ()
addInclude String
"<stdint.h>" m () -> m Type -> m Type
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Type -> m Type
forall (m :: * -> *) a. Monad m => a -> m a
return [cty| typename int16_t |]
PrimTypeRep a
Int32T -> String -> m ()
forall (m :: * -> *). MonadC m => String -> m ()
addInclude String
"<stdint.h>" m () -> m Type -> m Type
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Type -> m Type
forall (m :: * -> *) a. Monad m => a -> m a
return [cty| typename int32_t |]
PrimTypeRep a
Int64T -> String -> m ()
forall (m :: * -> *). MonadC m => String -> m ()
addInclude String
"<stdint.h>" m () -> m Type -> m Type
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Type -> m Type
forall (m :: * -> *) a. Monad m => a -> m a
return [cty| typename int64_t |]
PrimTypeRep a
Word8T -> String -> m ()
forall (m :: * -> *). MonadC m => String -> m ()
addInclude String
"<stdint.h>" m () -> m Type -> m Type
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Type -> m Type
forall (m :: * -> *) a. Monad m => a -> m a
return [cty| typename uint8_t |]
PrimTypeRep a
Word16T -> String -> m ()
forall (m :: * -> *). MonadC m => String -> m ()
addInclude String
"<stdint.h>" m () -> m Type -> m Type
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Type -> m Type
forall (m :: * -> *) a. Monad m => a -> m a
return [cty| typename uint16_t |]
PrimTypeRep a
Word32T -> String -> m ()
forall (m :: * -> *). MonadC m => String -> m ()
addInclude String
"<stdint.h>" m () -> m Type -> m Type
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Type -> m Type
forall (m :: * -> *) a. Monad m => a -> m a
return [cty| typename uint32_t |]
PrimTypeRep a
Word64T -> String -> m ()
forall (m :: * -> *). MonadC m => String -> m ()
addInclude String
"<stdint.h>" m () -> m Type -> m Type
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Type -> m Type
forall (m :: * -> *) a. Monad m => a -> m a
return [cty| typename uint64_t |]
PrimTypeRep a
FloatT -> Type -> m Type
forall (m :: * -> *) a. Monad m => a -> m a
return [cty| float |]
PrimTypeRep a
DoubleT -> Type -> m Type
forall (m :: * -> *) a. Monad m => a -> m a
return [cty| double |]
PrimTypeRep a
ComplexFloatT -> String -> m ()
forall (m :: * -> *). MonadC m => String -> m ()
addInclude String
"<tgmath.h>" m () -> m Type -> m Type
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Type -> m Type
forall (m :: * -> *) a. Monad m => a -> m a
return [cty| float _Complex |]
PrimTypeRep a
ComplexDoubleT -> String -> m ()
forall (m :: * -> *). MonadC m => String -> m ()
addInclude String
"<tgmath.h>" m () -> m Type -> m Type
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Type -> m Type
forall (m :: * -> *) a. Monad m => a -> m a
return [cty| double _Complex |]
compLit :: proxy PrimType' -> a -> m Exp
compLit proxy PrimType'
_ a
a = case a -> PrimTypeRep a
forall a. PrimType' a => a -> PrimTypeRep a
primTypeOf a
a of
PrimTypeRep a
BoolT -> do String -> m ()
forall (m :: * -> *). MonadC m => String -> m ()
addInclude String
"<stdbool.h>"
Exp -> m Exp
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp -> m Exp) -> Exp -> m Exp
forall a b. (a -> b) -> a -> b
$ if a
Bool
a then [cexp| true |] else [cexp| false |]
PrimTypeRep a
Int8T -> Exp -> m Exp
forall (m :: * -> *) a. Monad m => a -> m a
return [cexp| $a |]
PrimTypeRep a
Int16T -> Exp -> m Exp
forall (m :: * -> *) a. Monad m => a -> m a
return [cexp| $a |]
PrimTypeRep a
Int32T -> Exp -> m Exp
forall (m :: * -> *) a. Monad m => a -> m a
return [cexp| $a |]
PrimTypeRep a
Int64T -> Exp -> m Exp
forall (m :: * -> *) a. Monad m => a -> m a
return [cexp| $a |]
PrimTypeRep a
Word8T -> Exp -> m Exp
forall (m :: * -> *) a. Monad m => a -> m a
return [cexp| $a |]
PrimTypeRep a
Word16T -> Exp -> m Exp
forall (m :: * -> *) a. Monad m => a -> m a
return [cexp| $a |]
PrimTypeRep a
Word32T -> Exp -> m Exp
forall (m :: * -> *) a. Monad m => a -> m a
return [cexp| $a |]
PrimTypeRep a
Word64T -> Exp -> m Exp
forall (m :: * -> *) a. Monad m => a -> m a
return [cexp| $a |]
PrimTypeRep a
FloatT -> Exp -> m Exp
forall (m :: * -> *) a. Monad m => a -> m a
return [cexp| $a |]
PrimTypeRep a
DoubleT -> Exp -> m Exp
forall (m :: * -> *) a. Monad m => a -> m a
return [cexp| $a |]
PrimTypeRep a
ComplexFloatT -> Exp -> m Exp
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp -> m Exp) -> Exp -> m Exp
forall a b. (a -> b) -> a -> b
$ Complex Float -> Exp
forall a. (Eq a, Num a, ToExp a) => Complex a -> Exp
compComplexLit a
Complex Float
a
PrimTypeRep a
ComplexDoubleT -> Exp -> m Exp
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp -> m Exp) -> Exp -> m Exp
forall a b. (a -> b) -> a -> b
$ Complex Double -> Exp
forall a. (Eq a, Num a, ToExp a) => Complex a -> Exp
compComplexLit a
Complex Double
a
compComplexLit :: (Eq a, Num a, ToExp a) => Complex a -> C.Exp
compComplexLit :: Complex a -> Exp
compComplexLit (a
r :+ a
0) = [cexp| $r |]
compComplexLit (a
0 :+ a
i) = [cexp| $i * I |]
compComplexLit (a
r :+ a
i) = [cexp| $r + $i * I |]
addTagMacro :: MonadC m => m ()
addTagMacro :: m ()
addTagMacro = Definition -> m ()
forall (m :: * -> *). MonadC m => Definition -> m ()
addGlobal [cedecl|$esc:("#define TAG(tag,exp) (exp)")|]
compUnOp :: MonadC m => C.UnOp -> ASTF PrimDomain a -> m C.Exp
compUnOp :: UnOp -> ASTF (Primitive :&: PrimTypeRep) a -> m Exp
compUnOp UnOp
op ASTF (Primitive :&: PrimTypeRep) a
a = do
Exp
a' <- Prim a -> m Exp
forall (m :: * -> *) a. MonadC m => Prim a -> m Exp
compPrim (Prim a -> m Exp) -> Prim a -> m Exp
forall a b. (a -> b) -> a -> b
$ ASTF (Primitive :&: PrimTypeRep) a -> Prim a
forall a. ASTF (Primitive :&: PrimTypeRep) a -> Prim a
Prim ASTF (Primitive :&: PrimTypeRep) a
a
Exp -> m Exp
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp -> m Exp) -> Exp -> m Exp
forall a b. (a -> b) -> a -> b
$ UnOp -> Exp -> SrcLoc -> Exp
C.UnOp UnOp
op Exp
a' SrcLoc
forall a. Monoid a => a
mempty
compBinOp :: MonadC m =>
C.BinOp -> ASTF PrimDomain a -> ASTF PrimDomain b -> m C.Exp
compBinOp :: BinOp
-> ASTF (Primitive :&: PrimTypeRep) a
-> ASTF (Primitive :&: PrimTypeRep) b
-> m Exp
compBinOp BinOp
op ASTF (Primitive :&: PrimTypeRep) a
a ASTF (Primitive :&: PrimTypeRep) b
b = do
Exp
a' <- Prim a -> m Exp
forall (m :: * -> *) a. MonadC m => Prim a -> m Exp
compPrim (Prim a -> m Exp) -> Prim a -> m Exp
forall a b. (a -> b) -> a -> b
$ ASTF (Primitive :&: PrimTypeRep) a -> Prim a
forall a. ASTF (Primitive :&: PrimTypeRep) a -> Prim a
Prim ASTF (Primitive :&: PrimTypeRep) a
a
Exp
b' <- Prim b -> m Exp
forall (m :: * -> *) a. MonadC m => Prim a -> m Exp
compPrim (Prim b -> m Exp) -> Prim b -> m Exp
forall a b. (a -> b) -> a -> b
$ ASTF (Primitive :&: PrimTypeRep) b -> Prim b
forall a. ASTF (Primitive :&: PrimTypeRep) a -> Prim a
Prim ASTF (Primitive :&: PrimTypeRep) b
b
Exp -> m Exp
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp -> m Exp) -> Exp -> m Exp
forall a b. (a -> b) -> a -> b
$ BinOp -> Exp -> Exp -> SrcLoc -> Exp
C.BinOp BinOp
op Exp
a' Exp
b' SrcLoc
forall a. Monoid a => a
mempty
compFun :: MonadC m => String -> Args (AST PrimDomain) sig -> m C.Exp
compFun :: String -> Args (AST (Primitive :&: PrimTypeRep)) sig -> m Exp
compFun String
fun Args (AST (Primitive :&: PrimTypeRep)) sig
args = do
[Exp]
as <- [m Exp] -> m [Exp]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([m Exp] -> m [Exp]) -> [m Exp] -> m [Exp]
forall a b. (a -> b) -> a -> b
$ (forall a. AST (Primitive :&: PrimTypeRep) (Full a) -> m Exp)
-> Args (AST (Primitive :&: PrimTypeRep)) sig -> [m Exp]
forall (c :: * -> *) b sig.
(forall a. c (Full a) -> b) -> Args c sig -> [b]
listArgs (Prim a -> m Exp
forall (m :: * -> *) a. MonadC m => Prim a -> m Exp
compPrim (Prim a -> m Exp)
-> (ASTF (Primitive :&: PrimTypeRep) a -> Prim a)
-> ASTF (Primitive :&: PrimTypeRep) a
-> m Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASTF (Primitive :&: PrimTypeRep) a -> Prim a
forall a. ASTF (Primitive :&: PrimTypeRep) a -> Prim a
Prim) Args (AST (Primitive :&: PrimTypeRep)) sig
args
Exp -> m Exp
forall (m :: * -> *) a. Monad m => a -> m a
return [cexp| $id:fun($args:as) |]
compAbs :: MonadC m => PrimTypeRep a -> ASTF PrimDomain a -> m C.Exp
compAbs :: PrimTypeRep a -> ASTF (Primitive :&: PrimTypeRep) a -> m Exp
compAbs PrimTypeRep a
t ASTF (Primitive :&: PrimTypeRep) a
a = case PrimTypeRep a -> PrimTypeView a
forall a. PrimTypeRep a -> PrimTypeView a
viewPrimTypeRep PrimTypeRep a
t of
PrimTypeView a
PrimTypeBool -> String -> m Exp
forall a. HasCallStack => String -> a
error String
"compAbs: type BoolT not supported"
PrimTypeIntWord (IntType IntTypeRep a
_) -> String -> m ()
forall (m :: * -> *). MonadC m => String -> m ()
addInclude String
"<stdlib.h>" m () -> m Exp -> m Exp
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String
-> Args (AST (Primitive :&: PrimTypeRep)) (a :-> Full Any) -> m Exp
forall (m :: * -> *) sig.
MonadC m =>
String -> Args (AST (Primitive :&: PrimTypeRep)) sig -> m Exp
compFun String
"abs" (ASTF (Primitive :&: PrimTypeRep) a
a ASTF (Primitive :&: PrimTypeRep) a
-> Args (AST (Primitive :&: PrimTypeRep)) (Full Any)
-> Args (AST (Primitive :&: PrimTypeRep)) (a :-> Full Any)
forall (c :: * -> *) a sig1.
c (Full a) -> Args c sig1 -> Args c (a :-> sig1)
:* Args (AST (Primitive :&: PrimTypeRep)) (Full Any)
forall (c :: * -> *) a. Args c (Full a)
Nil)
PrimTypeIntWord (WordType WordTypeRep a
_) -> Prim a -> m Exp
forall (m :: * -> *) a. MonadC m => Prim a -> m Exp
compPrim (Prim a -> m Exp) -> Prim a -> m Exp
forall a b. (a -> b) -> a -> b
$ ASTF (Primitive :&: PrimTypeRep) a -> Prim a
forall a. ASTF (Primitive :&: PrimTypeRep) a -> Prim a
Prim ASTF (Primitive :&: PrimTypeRep) a
a
PrimTypeView a
_ -> String -> m ()
forall (m :: * -> *). MonadC m => String -> m ()
addInclude String
"<tgmath.h>" m () -> m Exp -> m Exp
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String
-> Args (AST (Primitive :&: PrimTypeRep)) (a :-> Full Any) -> m Exp
forall (m :: * -> *) sig.
MonadC m =>
String -> Args (AST (Primitive :&: PrimTypeRep)) sig -> m Exp
compFun String
"fabs" (ASTF (Primitive :&: PrimTypeRep) a
a ASTF (Primitive :&: PrimTypeRep) a
-> Args (AST (Primitive :&: PrimTypeRep)) (Full Any)
-> Args (AST (Primitive :&: PrimTypeRep)) (a :-> Full Any)
forall (c :: * -> *) a sig1.
c (Full a) -> Args c sig1 -> Args c (a :-> sig1)
:* Args (AST (Primitive :&: PrimTypeRep)) (Full Any)
forall (c :: * -> *) a. Args c (Full a)
Nil)
complexSign_def :: Definition
complexSign_def = [cedecl|
double _Complex feld_complexSign(double _Complex c) {
double z = cabs(c);
if (z == 0) {
return 0;
} else {
return (creal(c)/z + I*(cimag(c)/z));
}
}
|]
complexSignf_def :: Definition
complexSignf_def = [cedecl|
float _Complex feld_complexSignf(float _Complex c) {
float z = cabsf(c);
if (z == 0) {
return 0;
} else {
return (crealf(c)/z + I*(cimagf(c)/z));
}
}
|]
compSign :: MonadC m => PrimTypeRep a -> ASTF PrimDomain a -> m C.Exp
compSign :: PrimTypeRep a -> ASTF (Primitive :&: PrimTypeRep) a -> m Exp
compSign PrimTypeRep a
t ASTF (Primitive :&: PrimTypeRep) a
a = case PrimTypeRep a -> PrimTypeView a
forall a. PrimTypeRep a -> PrimTypeView a
viewPrimTypeRep PrimTypeRep a
t of
PrimTypeView a
PrimTypeBool -> String -> m Exp
forall a. HasCallStack => String -> a
error String
"compSign: type BoolT not supported"
PrimTypeIntWord (WordType WordTypeRep a
_) -> do
m ()
forall (m :: * -> *). MonadC m => m ()
addTagMacro
Exp
a' <- Prim a -> m Exp
forall (m :: * -> *) a. MonadC m => Prim a -> m Exp
compPrim (Prim a -> m Exp) -> Prim a -> m Exp
forall a b. (a -> b) -> a -> b
$ ASTF (Primitive :&: PrimTypeRep) a -> Prim a
forall a. ASTF (Primitive :&: PrimTypeRep) a -> Prim a
Prim ASTF (Primitive :&: PrimTypeRep) a
a
Exp -> m Exp
forall (m :: * -> *) a. Monad m => a -> m a
return [cexp| TAG("signum", $a' > 0) |]
PrimTypeIntWord (IntType IntTypeRep a
_) -> do
m ()
forall (m :: * -> *). MonadC m => m ()
addTagMacro
Exp
a' <- Prim a -> m Exp
forall (m :: * -> *) a. MonadC m => Prim a -> m Exp
compPrim (Prim a -> m Exp) -> Prim a -> m Exp
forall a b. (a -> b) -> a -> b
$ ASTF (Primitive :&: PrimTypeRep) a -> Prim a
forall a. ASTF (Primitive :&: PrimTypeRep) a -> Prim a
Prim ASTF (Primitive :&: PrimTypeRep) a
a
Exp -> m Exp
forall (m :: * -> *) a. Monad m => a -> m a
return [cexp| TAG("signum", ($a' > 0) - ($a' < 0)) |]
PrimTypeFloating FloatingTypeRep a
FloatType -> do
m ()
forall (m :: * -> *). MonadC m => m ()
addTagMacro
Exp
a' <- Prim a -> m Exp
forall (m :: * -> *) a. MonadC m => Prim a -> m Exp
compPrim (Prim a -> m Exp) -> Prim a -> m Exp
forall a b. (a -> b) -> a -> b
$ ASTF (Primitive :&: PrimTypeRep) a -> Prim a
forall a. ASTF (Primitive :&: PrimTypeRep) a -> Prim a
Prim ASTF (Primitive :&: PrimTypeRep) a
a
Exp -> m Exp
forall (m :: * -> *) a. Monad m => a -> m a
return [cexp| TAG("signum", (float) (($a' > 0) - ($a' < 0))) |]
PrimTypeFloating FloatingTypeRep a
DoubleType -> do
m ()
forall (m :: * -> *). MonadC m => m ()
addTagMacro
Exp
a' <- Prim a -> m Exp
forall (m :: * -> *) a. MonadC m => Prim a -> m Exp
compPrim (Prim a -> m Exp) -> Prim a -> m Exp
forall a b. (a -> b) -> a -> b
$ ASTF (Primitive :&: PrimTypeRep) a -> Prim a
forall a. ASTF (Primitive :&: PrimTypeRep) a -> Prim a
Prim ASTF (Primitive :&: PrimTypeRep) a
a
Exp -> m Exp
forall (m :: * -> *) a. Monad m => a -> m a
return [cexp| TAG("signum", (double) (($a' > 0) - ($a' < 0))) |]
PrimTypeComplex ComplexTypeRep a
ComplexDoubleType -> do
String -> m ()
forall (m :: * -> *). MonadC m => String -> m ()
addInclude String
"<tgmath.h>"
Definition -> m ()
forall (m :: * -> *). MonadC m => Definition -> m ()
addGlobal Definition
complexSign_def
Exp
a' <- Prim a -> m Exp
forall (m :: * -> *) a. MonadC m => Prim a -> m Exp
compPrim (Prim a -> m Exp) -> Prim a -> m Exp
forall a b. (a -> b) -> a -> b
$ ASTF (Primitive :&: PrimTypeRep) a -> Prim a
forall a. ASTF (Primitive :&: PrimTypeRep) a -> Prim a
Prim ASTF (Primitive :&: PrimTypeRep) a
a
Exp -> m Exp
forall (m :: * -> *) a. Monad m => a -> m a
return [cexp| feld_complexSign($a') |]
PrimTypeComplex ComplexTypeRep a
ComplexFloatType -> do
String -> m ()
forall (m :: * -> *). MonadC m => String -> m ()
addInclude String
"<complex.h>"
Definition -> m ()
forall (m :: * -> *). MonadC m => Definition -> m ()
addGlobal Definition
complexSignf_def
Exp
a' <- Prim a -> m Exp
forall (m :: * -> *) a. MonadC m => Prim a -> m Exp
compPrim (Prim a -> m Exp) -> Prim a -> m Exp
forall a b. (a -> b) -> a -> b
$ ASTF (Primitive :&: PrimTypeRep) a -> Prim a
forall a. ASTF (Primitive :&: PrimTypeRep) a -> Prim a
Prim ASTF (Primitive :&: PrimTypeRep) a
a
Exp -> m Exp
forall (m :: * -> *) a. Monad m => a -> m a
return [cexp| feld_complexSignf($a') |]
compCast :: MonadC m => PrimTypeRep a -> ASTF PrimDomain b -> m C.Exp
compCast :: PrimTypeRep a -> ASTF (Primitive :&: PrimTypeRep) b -> m Exp
compCast PrimTypeRep a
t ASTF (Primitive :&: PrimTypeRep) b
a = Prim b -> m Exp
forall (m :: * -> *) a. MonadC m => Prim a -> m Exp
compPrim (ASTF (Primitive :&: PrimTypeRep) b -> Prim b
forall a. ASTF (Primitive :&: PrimTypeRep) a -> Prim a
Prim ASTF (Primitive :&: PrimTypeRep) b
a) m Exp -> (Exp -> m Exp) -> m Exp
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= PrimTypeRep a -> Exp -> m Exp
forall (m :: * -> *) a. MonadC m => PrimTypeRep a -> Exp -> m Exp
compCastExp PrimTypeRep a
t
compCastExp :: MonadC m => PrimTypeRep a -> C.Exp -> m C.Exp
compCastExp :: PrimTypeRep a -> Exp -> m Exp
compCastExp PrimTypeRep a
t Exp
a
| Dict (PrimType' a)
Dict <- PrimTypeRep a -> Dict (PrimType' a)
forall a. PrimTypeRep a -> Dict (PrimType' a)
witPrimType PrimTypeRep a
t = do
Type
t' <- Proxy PrimType' -> PrimTypeRep a -> m Type
forall (ct :: * -> Constraint) a (m :: * -> *)
(proxy1 :: (* -> Constraint) -> *) (proxy2 :: * -> *).
(CompTypeClass ct, ct a, MonadC m) =>
proxy1 ct -> proxy2 a -> m Type
compType (Proxy PrimType'
forall k (t :: k). Proxy t
Proxy :: Proxy PrimType') PrimTypeRep a
t
Exp -> m Exp
forall (m :: * -> *) a. Monad m => a -> m a
return [cexp|($ty:t') $a|]
compRound :: (PrimType' a, Num a, RealFrac b, MonadC m) =>
PrimTypeRep a -> ASTF PrimDomain b -> m C.Exp
compRound :: PrimTypeRep a -> ASTF (Primitive :&: PrimTypeRep) b -> m Exp
compRound PrimTypeRep a
t ASTF (Primitive :&: PrimTypeRep) b
a = do
String -> m ()
forall (m :: * -> *). MonadC m => String -> m ()
addInclude String
"<tgmath.h>"
Exp
rounded <- case PrimTypeRep a -> PrimTypeView a
forall a. PrimTypeRep a -> PrimTypeView a
viewPrimTypeRep PrimTypeRep a
t of
PrimTypeIntWord IntWordTypeRep a
_ -> String
-> Args (AST (Primitive :&: PrimTypeRep)) (b :-> Full Any) -> m Exp
forall (m :: * -> *) sig.
MonadC m =>
String -> Args (AST (Primitive :&: PrimTypeRep)) sig -> m Exp
compFun String
"lround" (ASTF (Primitive :&: PrimTypeRep) b
a ASTF (Primitive :&: PrimTypeRep) b
-> Args (AST (Primitive :&: PrimTypeRep)) (Full Any)
-> Args (AST (Primitive :&: PrimTypeRep)) (b :-> Full Any)
forall (c :: * -> *) a sig1.
c (Full a) -> Args c sig1 -> Args c (a :-> sig1)
:* Args (AST (Primitive :&: PrimTypeRep)) (Full Any)
forall (c :: * -> *) a. Args c (Full a)
Nil)
PrimTypeFloating FloatingTypeRep a
_ -> String
-> Args (AST (Primitive :&: PrimTypeRep)) (b :-> Full Any) -> m Exp
forall (m :: * -> *) sig.
MonadC m =>
String -> Args (AST (Primitive :&: PrimTypeRep)) sig -> m Exp
compFun String
"round" (ASTF (Primitive :&: PrimTypeRep) b
a ASTF (Primitive :&: PrimTypeRep) b
-> Args (AST (Primitive :&: PrimTypeRep)) (Full Any)
-> Args (AST (Primitive :&: PrimTypeRep)) (b :-> Full Any)
forall (c :: * -> *) a sig1.
c (Full a) -> Args c sig1 -> Args c (a :-> sig1)
:* Args (AST (Primitive :&: PrimTypeRep)) (Full Any)
forall (c :: * -> *) a. Args c (Full a)
Nil)
PrimTypeComplex ComplexTypeRep a
_ -> String
-> Args (AST (Primitive :&: PrimTypeRep)) (b :-> Full Any) -> m Exp
forall (m :: * -> *) sig.
MonadC m =>
String -> Args (AST (Primitive :&: PrimTypeRep)) sig -> m Exp
compFun String
"round" (ASTF (Primitive :&: PrimTypeRep) b
a ASTF (Primitive :&: PrimTypeRep) b
-> Args (AST (Primitive :&: PrimTypeRep)) (Full Any)
-> Args (AST (Primitive :&: PrimTypeRep)) (b :-> Full Any)
forall (c :: * -> *) a sig1.
c (Full a) -> Args c sig1 -> Args c (a :-> sig1)
:* Args (AST (Primitive :&: PrimTypeRep)) (Full Any)
forall (c :: * -> *) a. Args c (Full a)
Nil)
PrimTypeView a
_ -> String -> m Exp
forall a. HasCallStack => String -> a
error (String -> m Exp) -> String -> m Exp
forall a b. (a -> b) -> a -> b
$ String
"compRound: type " String -> String -> String
forall a. [a] -> [a] -> [a]
++ PrimTypeRep a -> String
forall a. Show a => a -> String
show PrimTypeRep a
t String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" not supported"
PrimTypeRep a -> Exp -> m Exp
forall (m :: * -> *) a. MonadC m => PrimTypeRep a -> Exp -> m Exp
compCastExp PrimTypeRep a
t Exp
rounded
div_def :: Definition
div_def = [cedecl|
int feld_div(int x, int y) {
int q = x/y;
int r = x%y;
if ((r!=0) && ((r<0) != (y<0))) --q;
return q;
}
|]
ldiv_def :: Definition
ldiv_def = [cedecl|
long int feld_ldiv(long int x, long int y) {
int q = x/y;
int r = x%y;
if ((r!=0) && ((r<0) != (y<0))) --q;
return q;
}
|]
mod_def :: Definition
mod_def = [cedecl|
int feld_mod(int x, int y) {
int r = x%y;
if ((r!=0) && ((r<0) != (y<0))) { r += y; }
return r;
}
|]
lmod_def :: Definition
lmod_def = [cedecl|
long int feld_lmod(long int x, long int y) {
int r = x%y;
if ((r!=0) && ((r<0) != (y<0))) { r += y; }
return r;
}
|]
compDiv :: MonadC m =>
PrimTypeRep a -> ASTF PrimDomain a -> ASTF PrimDomain b -> m C.Exp
compDiv :: PrimTypeRep a
-> ASTF (Primitive :&: PrimTypeRep) a
-> ASTF (Primitive :&: PrimTypeRep) b
-> m Exp
compDiv PrimTypeRep a
t ASTF (Primitive :&: PrimTypeRep) a
a ASTF (Primitive :&: PrimTypeRep) b
b = case PrimTypeRep a -> PrimTypeView a
forall a. PrimTypeRep a -> PrimTypeView a
viewPrimTypeRep PrimTypeRep a
t of
PrimTypeIntWord (WordType WordTypeRep a
_) -> BinOp
-> ASTF (Primitive :&: PrimTypeRep) a
-> ASTF (Primitive :&: PrimTypeRep) b
-> m Exp
forall (m :: * -> *) a b.
MonadC m =>
BinOp
-> ASTF (Primitive :&: PrimTypeRep) a
-> ASTF (Primitive :&: PrimTypeRep) b
-> m Exp
compBinOp BinOp
C.Div ASTF (Primitive :&: PrimTypeRep) a
a ASTF (Primitive :&: PrimTypeRep) b
b
PrimTypeIntWord (IntType IntTypeRep a
Int64Type) -> do
Definition -> m ()
forall (m :: * -> *). MonadC m => Definition -> m ()
addGlobal Definition
ldiv_def
String
-> Args (AST (Primitive :&: PrimTypeRep)) (a :-> (b :-> Full Any))
-> m Exp
forall (m :: * -> *) sig.
MonadC m =>
String -> Args (AST (Primitive :&: PrimTypeRep)) sig -> m Exp
compFun String
"feld_ldiv" (ASTF (Primitive :&: PrimTypeRep) a
a ASTF (Primitive :&: PrimTypeRep) a
-> Args (AST (Primitive :&: PrimTypeRep)) (b :-> Full Any)
-> Args (AST (Primitive :&: PrimTypeRep)) (a :-> (b :-> Full Any))
forall (c :: * -> *) a sig1.
c (Full a) -> Args c sig1 -> Args c (a :-> sig1)
:* ASTF (Primitive :&: PrimTypeRep) b
b ASTF (Primitive :&: PrimTypeRep) b
-> Args (AST (Primitive :&: PrimTypeRep)) (Full Any)
-> Args (AST (Primitive :&: PrimTypeRep)) (b :-> Full Any)
forall (c :: * -> *) a sig1.
c (Full a) -> Args c sig1 -> Args c (a :-> sig1)
:* Args (AST (Primitive :&: PrimTypeRep)) (Full Any)
forall (c :: * -> *) a. Args c (Full a)
Nil)
PrimTypeIntWord IntWordTypeRep a
_ -> do
Definition -> m ()
forall (m :: * -> *). MonadC m => Definition -> m ()
addGlobal Definition
div_def
String
-> Args (AST (Primitive :&: PrimTypeRep)) (a :-> (b :-> Full Any))
-> m Exp
forall (m :: * -> *) sig.
MonadC m =>
String -> Args (AST (Primitive :&: PrimTypeRep)) sig -> m Exp
compFun String
"feld_div" (ASTF (Primitive :&: PrimTypeRep) a
a ASTF (Primitive :&: PrimTypeRep) a
-> Args (AST (Primitive :&: PrimTypeRep)) (b :-> Full Any)
-> Args (AST (Primitive :&: PrimTypeRep)) (a :-> (b :-> Full Any))
forall (c :: * -> *) a sig1.
c (Full a) -> Args c sig1 -> Args c (a :-> sig1)
:* ASTF (Primitive :&: PrimTypeRep) b
b ASTF (Primitive :&: PrimTypeRep) b
-> Args (AST (Primitive :&: PrimTypeRep)) (Full Any)
-> Args (AST (Primitive :&: PrimTypeRep)) (b :-> Full Any)
forall (c :: * -> *) a sig1.
c (Full a) -> Args c sig1 -> Args c (a :-> sig1)
:* Args (AST (Primitive :&: PrimTypeRep)) (Full Any)
forall (c :: * -> *) a. Args c (Full a)
Nil)
PrimTypeView a
_ -> String -> m Exp
forall a. HasCallStack => String -> a
error (String -> m Exp) -> String -> m Exp
forall a b. (a -> b) -> a -> b
$ String
"compDiv: type " String -> String -> String
forall a. [a] -> [a] -> [a]
++ PrimTypeRep a -> String
forall a. Show a => a -> String
show PrimTypeRep a
t String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" not supported"
compMod :: MonadC m =>
PrimTypeRep a -> ASTF PrimDomain a -> ASTF PrimDomain b -> m C.Exp
compMod :: PrimTypeRep a
-> ASTF (Primitive :&: PrimTypeRep) a
-> ASTF (Primitive :&: PrimTypeRep) b
-> m Exp
compMod PrimTypeRep a
t ASTF (Primitive :&: PrimTypeRep) a
a ASTF (Primitive :&: PrimTypeRep) b
b = case PrimTypeRep a -> PrimTypeView a
forall a. PrimTypeRep a -> PrimTypeView a
viewPrimTypeRep PrimTypeRep a
t of
PrimTypeIntWord (WordType WordTypeRep a
_) -> BinOp
-> ASTF (Primitive :&: PrimTypeRep) a
-> ASTF (Primitive :&: PrimTypeRep) b
-> m Exp
forall (m :: * -> *) a b.
MonadC m =>
BinOp
-> ASTF (Primitive :&: PrimTypeRep) a
-> ASTF (Primitive :&: PrimTypeRep) b
-> m Exp
compBinOp BinOp
C.Mod ASTF (Primitive :&: PrimTypeRep) a
a ASTF (Primitive :&: PrimTypeRep) b
b
PrimTypeIntWord (IntType IntTypeRep a
Int64Type) -> do
Definition -> m ()
forall (m :: * -> *). MonadC m => Definition -> m ()
addGlobal Definition
lmod_def
String
-> Args (AST (Primitive :&: PrimTypeRep)) (a :-> (b :-> Full Any))
-> m Exp
forall (m :: * -> *) sig.
MonadC m =>
String -> Args (AST (Primitive :&: PrimTypeRep)) sig -> m Exp
compFun String
"feld_lmod" (ASTF (Primitive :&: PrimTypeRep) a
a ASTF (Primitive :&: PrimTypeRep) a
-> Args (AST (Primitive :&: PrimTypeRep)) (b :-> Full Any)
-> Args (AST (Primitive :&: PrimTypeRep)) (a :-> (b :-> Full Any))
forall (c :: * -> *) a sig1.
c (Full a) -> Args c sig1 -> Args c (a :-> sig1)
:* ASTF (Primitive :&: PrimTypeRep) b
b ASTF (Primitive :&: PrimTypeRep) b
-> Args (AST (Primitive :&: PrimTypeRep)) (Full Any)
-> Args (AST (Primitive :&: PrimTypeRep)) (b :-> Full Any)
forall (c :: * -> *) a sig1.
c (Full a) -> Args c sig1 -> Args c (a :-> sig1)
:* Args (AST (Primitive :&: PrimTypeRep)) (Full Any)
forall (c :: * -> *) a. Args c (Full a)
Nil)
PrimTypeIntWord IntWordTypeRep a
_ -> do
Definition -> m ()
forall (m :: * -> *). MonadC m => Definition -> m ()
addGlobal Definition
mod_def
String
-> Args (AST (Primitive :&: PrimTypeRep)) (a :-> (b :-> Full Any))
-> m Exp
forall (m :: * -> *) sig.
MonadC m =>
String -> Args (AST (Primitive :&: PrimTypeRep)) sig -> m Exp
compFun String
"feld_mod" (ASTF (Primitive :&: PrimTypeRep) a
a ASTF (Primitive :&: PrimTypeRep) a
-> Args (AST (Primitive :&: PrimTypeRep)) (b :-> Full Any)
-> Args (AST (Primitive :&: PrimTypeRep)) (a :-> (b :-> Full Any))
forall (c :: * -> *) a sig1.
c (Full a) -> Args c sig1 -> Args c (a :-> sig1)
:* ASTF (Primitive :&: PrimTypeRep) b
b ASTF (Primitive :&: PrimTypeRep) b
-> Args (AST (Primitive :&: PrimTypeRep)) (Full Any)
-> Args (AST (Primitive :&: PrimTypeRep)) (b :-> Full Any)
forall (c :: * -> *) a sig1.
c (Full a) -> Args c sig1 -> Args c (a :-> sig1)
:* Args (AST (Primitive :&: PrimTypeRep)) (Full Any)
forall (c :: * -> *) a. Args c (Full a)
Nil)
PrimTypeView a
_ -> String -> m Exp
forall a. HasCallStack => String -> a
error (String -> m Exp) -> String -> m Exp
forall a b. (a -> b) -> a -> b
$ String
"compMod: type " String -> String -> String
forall a. [a] -> [a] -> [a]
++ PrimTypeRep a -> String
forall a. Show a => a -> String
show PrimTypeRep a
t String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" not supported"
compPrim :: MonadC m => Prim a -> m C.Exp
compPrim :: Prim a -> m Exp
compPrim = (forall sig.
(a ~ DenResult sig) =>
PrimDomain sig
-> Args (AST (Primitive :&: PrimTypeRep)) sig -> m Exp)
-> ASTF (Primitive :&: PrimTypeRep) a -> m Exp
forall (sym :: * -> *) a b.
(forall sig.
(a ~ DenResult sig) =>
sym sig -> Args (AST sym) sig -> b)
-> ASTF sym a -> b
simpleMatch (\(s :&: t) -> PrimTypeRep (DenResult sig)
-> Primitive sig
-> Args (AST (Primitive :&: PrimTypeRep)) sig
-> m Exp
forall (m :: * -> *) sig.
MonadC m =>
PrimTypeRep (DenResult sig)
-> Primitive sig
-> Args (AST (Primitive :&: PrimTypeRep)) sig
-> m Exp
go PrimTypeRep (DenResult sig)
t Primitive sig
s) (ASTF (Primitive :&: PrimTypeRep) a -> m Exp)
-> (Prim a -> ASTF (Primitive :&: PrimTypeRep) a)
-> Prim a
-> m Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Prim a -> ASTF (Primitive :&: PrimTypeRep) a
forall a. Prim a -> ASTF (Primitive :&: PrimTypeRep) a
unPrim
where
go :: forall m sig . MonadC m
=> PrimTypeRep (DenResult sig)
-> Primitive sig
-> Args (AST PrimDomain) sig
-> m C.Exp
go :: PrimTypeRep (DenResult sig)
-> Primitive sig
-> Args (AST (Primitive :&: PrimTypeRep)) sig
-> m Exp
go PrimTypeRep (DenResult sig)
_ (FreeVar String
v) Args (AST (Primitive :&: PrimTypeRep)) sig
Nil = String -> m ()
forall (m :: * -> *) v. (MonadC m, ToIdent v) => v -> m ()
touchVar String
v m () -> m Exp -> m Exp
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Exp -> m Exp
forall (m :: * -> *) a. Monad m => a -> m a
return [cexp| $id:v |]
go PrimTypeRep (DenResult sig)
t (Lit a
a) Args (AST (Primitive :&: PrimTypeRep)) sig
Nil
| Dict (PrimType' a)
Dict <- PrimTypeRep a -> Dict (PrimType' a)
forall a. PrimTypeRep a -> Dict (PrimType' a)
witPrimType PrimTypeRep a
PrimTypeRep (DenResult sig)
t
= Proxy PrimType' -> a -> m Exp
forall (ct :: * -> Constraint) a (m :: * -> *)
(proxy :: (* -> Constraint) -> *).
(CompTypeClass ct, ct a, MonadC m) =>
proxy ct -> a -> m Exp
compLit (Proxy PrimType'
forall k (t :: k). Proxy t
Proxy :: Proxy PrimType') a
a
go PrimTypeRep (DenResult sig)
_ Primitive sig
Add (AST (Primitive :&: PrimTypeRep) (Full a)
a :* AST (Primitive :&: PrimTypeRep) (Full a)
b :* Args (AST (Primitive :&: PrimTypeRep)) sig1
Nil) = BinOp
-> AST (Primitive :&: PrimTypeRep) (Full a)
-> AST (Primitive :&: PrimTypeRep) (Full a)
-> m Exp
forall (m :: * -> *) a b.
MonadC m =>
BinOp
-> ASTF (Primitive :&: PrimTypeRep) a
-> ASTF (Primitive :&: PrimTypeRep) b
-> m Exp
compBinOp BinOp
C.Add AST (Primitive :&: PrimTypeRep) (Full a)
a AST (Primitive :&: PrimTypeRep) (Full a)
b
go PrimTypeRep (DenResult sig)
_ Primitive sig
Sub (AST (Primitive :&: PrimTypeRep) (Full a)
a :* AST (Primitive :&: PrimTypeRep) (Full a)
b :* Args (AST (Primitive :&: PrimTypeRep)) sig1
Nil) = BinOp
-> AST (Primitive :&: PrimTypeRep) (Full a)
-> AST (Primitive :&: PrimTypeRep) (Full a)
-> m Exp
forall (m :: * -> *) a b.
MonadC m =>
BinOp
-> ASTF (Primitive :&: PrimTypeRep) a
-> ASTF (Primitive :&: PrimTypeRep) b
-> m Exp
compBinOp BinOp
C.Sub AST (Primitive :&: PrimTypeRep) (Full a)
a AST (Primitive :&: PrimTypeRep) (Full a)
b
go PrimTypeRep (DenResult sig)
_ Primitive sig
Mul (AST (Primitive :&: PrimTypeRep) (Full a)
a :* AST (Primitive :&: PrimTypeRep) (Full a)
b :* Args (AST (Primitive :&: PrimTypeRep)) sig1
Nil) = BinOp
-> AST (Primitive :&: PrimTypeRep) (Full a)
-> AST (Primitive :&: PrimTypeRep) (Full a)
-> m Exp
forall (m :: * -> *) a b.
MonadC m =>
BinOp
-> ASTF (Primitive :&: PrimTypeRep) a
-> ASTF (Primitive :&: PrimTypeRep) b
-> m Exp
compBinOp BinOp
C.Mul AST (Primitive :&: PrimTypeRep) (Full a)
a AST (Primitive :&: PrimTypeRep) (Full a)
b
go PrimTypeRep (DenResult sig)
_ Primitive sig
Neg (AST (Primitive :&: PrimTypeRep) (Full a)
a :* Args (AST (Primitive :&: PrimTypeRep)) sig1
Nil) = UnOp -> AST (Primitive :&: PrimTypeRep) (Full a) -> m Exp
forall (m :: * -> *) a.
MonadC m =>
UnOp -> ASTF (Primitive :&: PrimTypeRep) a -> m Exp
compUnOp UnOp
C.Negate AST (Primitive :&: PrimTypeRep) (Full a)
a
go PrimTypeRep (DenResult sig)
t Primitive sig
Abs (AST (Primitive :&: PrimTypeRep) (Full a)
a :* Args (AST (Primitive :&: PrimTypeRep)) sig1
Nil) = PrimTypeRep a -> AST (Primitive :&: PrimTypeRep) (Full a) -> m Exp
forall (m :: * -> *) a.
MonadC m =>
PrimTypeRep a -> ASTF (Primitive :&: PrimTypeRep) a -> m Exp
compAbs PrimTypeRep a
PrimTypeRep (DenResult sig)
t AST (Primitive :&: PrimTypeRep) (Full a)
a
go PrimTypeRep (DenResult sig)
t Primitive sig
Sign (AST (Primitive :&: PrimTypeRep) (Full a)
a :* Args (AST (Primitive :&: PrimTypeRep)) sig1
Nil) = PrimTypeRep a -> AST (Primitive :&: PrimTypeRep) (Full a) -> m Exp
forall (m :: * -> *) a.
MonadC m =>
PrimTypeRep a -> ASTF (Primitive :&: PrimTypeRep) a -> m Exp
compSign PrimTypeRep a
PrimTypeRep (DenResult sig)
t AST (Primitive :&: PrimTypeRep) (Full a)
a
go PrimTypeRep (DenResult sig)
_ Primitive sig
Quot (AST (Primitive :&: PrimTypeRep) (Full a)
a :* AST (Primitive :&: PrimTypeRep) (Full a)
b :* Args (AST (Primitive :&: PrimTypeRep)) sig1
Nil) = BinOp
-> AST (Primitive :&: PrimTypeRep) (Full a)
-> AST (Primitive :&: PrimTypeRep) (Full a)
-> m Exp
forall (m :: * -> *) a b.
MonadC m =>
BinOp
-> ASTF (Primitive :&: PrimTypeRep) a
-> ASTF (Primitive :&: PrimTypeRep) b
-> m Exp
compBinOp BinOp
C.Div AST (Primitive :&: PrimTypeRep) (Full a)
a AST (Primitive :&: PrimTypeRep) (Full a)
b
go PrimTypeRep (DenResult sig)
_ Primitive sig
Rem (AST (Primitive :&: PrimTypeRep) (Full a)
a :* AST (Primitive :&: PrimTypeRep) (Full a)
b :* Args (AST (Primitive :&: PrimTypeRep)) sig1
Nil) = BinOp
-> AST (Primitive :&: PrimTypeRep) (Full a)
-> AST (Primitive :&: PrimTypeRep) (Full a)
-> m Exp
forall (m :: * -> *) a b.
MonadC m =>
BinOp
-> ASTF (Primitive :&: PrimTypeRep) a
-> ASTF (Primitive :&: PrimTypeRep) b
-> m Exp
compBinOp BinOp
C.Mod AST (Primitive :&: PrimTypeRep) (Full a)
a AST (Primitive :&: PrimTypeRep) (Full a)
b
go PrimTypeRep (DenResult sig)
t Primitive sig
Div (AST (Primitive :&: PrimTypeRep) (Full a)
a :* AST (Primitive :&: PrimTypeRep) (Full a)
b :* Args (AST (Primitive :&: PrimTypeRep)) sig1
Nil) = PrimTypeRep a
-> AST (Primitive :&: PrimTypeRep) (Full a)
-> AST (Primitive :&: PrimTypeRep) (Full a)
-> m Exp
forall (m :: * -> *) a b.
MonadC m =>
PrimTypeRep a
-> ASTF (Primitive :&: PrimTypeRep) a
-> ASTF (Primitive :&: PrimTypeRep) b
-> m Exp
compDiv PrimTypeRep a
PrimTypeRep (DenResult sig)
t AST (Primitive :&: PrimTypeRep) (Full a)
a AST (Primitive :&: PrimTypeRep) (Full a)
b
go PrimTypeRep (DenResult sig)
t Primitive sig
Mod (AST (Primitive :&: PrimTypeRep) (Full a)
a :* AST (Primitive :&: PrimTypeRep) (Full a)
b :* Args (AST (Primitive :&: PrimTypeRep)) sig1
Nil) = PrimTypeRep a
-> AST (Primitive :&: PrimTypeRep) (Full a)
-> AST (Primitive :&: PrimTypeRep) (Full a)
-> m Exp
forall (m :: * -> *) a b.
MonadC m =>
PrimTypeRep a
-> ASTF (Primitive :&: PrimTypeRep) a
-> ASTF (Primitive :&: PrimTypeRep) b
-> m Exp
compMod PrimTypeRep a
PrimTypeRep (DenResult sig)
t AST (Primitive :&: PrimTypeRep) (Full a)
a AST (Primitive :&: PrimTypeRep) (Full a)
b
go PrimTypeRep (DenResult sig)
_ Primitive sig
FDiv (AST (Primitive :&: PrimTypeRep) (Full a)
a :* AST (Primitive :&: PrimTypeRep) (Full a)
b :* Args (AST (Primitive :&: PrimTypeRep)) sig1
Nil) = BinOp
-> AST (Primitive :&: PrimTypeRep) (Full a)
-> AST (Primitive :&: PrimTypeRep) (Full a)
-> m Exp
forall (m :: * -> *) a b.
MonadC m =>
BinOp
-> ASTF (Primitive :&: PrimTypeRep) a
-> ASTF (Primitive :&: PrimTypeRep) b
-> m Exp
compBinOp BinOp
C.Div AST (Primitive :&: PrimTypeRep) (Full a)
a AST (Primitive :&: PrimTypeRep) (Full a)
b
go PrimTypeRep (DenResult sig)
_ Primitive sig
Pi Args (AST (Primitive :&: PrimTypeRep)) sig
Nil = Definition -> m ()
forall (m :: * -> *). MonadC m => Definition -> m ()
addGlobal Definition
pi_def m () -> m Exp -> m Exp
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Exp -> m Exp
forall (m :: * -> *) a. Monad m => a -> m a
return [cexp| FELD_PI |]
where pi_def :: Definition
pi_def = [cedecl|$esc:("#define FELD_PI 3.141592653589793")|]
go PrimTypeRep (DenResult sig)
_ Primitive sig
Exp Args (AST (Primitive :&: PrimTypeRep)) sig
args = String -> m ()
forall (m :: * -> *). MonadC m => String -> m ()
addInclude String
"<tgmath.h>" m () -> m Exp -> m Exp
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Args (AST (Primitive :&: PrimTypeRep)) sig -> m Exp
forall (m :: * -> *) sig.
MonadC m =>
String -> Args (AST (Primitive :&: PrimTypeRep)) sig -> m Exp
compFun String
"exp" Args (AST (Primitive :&: PrimTypeRep)) sig
args
go PrimTypeRep (DenResult sig)
_ Primitive sig
Log Args (AST (Primitive :&: PrimTypeRep)) sig
args = String -> m ()
forall (m :: * -> *). MonadC m => String -> m ()
addInclude String
"<tgmath.h>" m () -> m Exp -> m Exp
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Args (AST (Primitive :&: PrimTypeRep)) sig -> m Exp
forall (m :: * -> *) sig.
MonadC m =>
String -> Args (AST (Primitive :&: PrimTypeRep)) sig -> m Exp
compFun String
"log" Args (AST (Primitive :&: PrimTypeRep)) sig
args
go PrimTypeRep (DenResult sig)
_ Primitive sig
Sqrt Args (AST (Primitive :&: PrimTypeRep)) sig
args = String -> m ()
forall (m :: * -> *). MonadC m => String -> m ()
addInclude String
"<tgmath.h>" m () -> m Exp -> m Exp
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Args (AST (Primitive :&: PrimTypeRep)) sig -> m Exp
forall (m :: * -> *) sig.
MonadC m =>
String -> Args (AST (Primitive :&: PrimTypeRep)) sig -> m Exp
compFun String
"sqrt" Args (AST (Primitive :&: PrimTypeRep)) sig
args
go PrimTypeRep (DenResult sig)
_ Primitive sig
Pow Args (AST (Primitive :&: PrimTypeRep)) sig
args = String -> m ()
forall (m :: * -> *). MonadC m => String -> m ()
addInclude String
"<tgmath.h>" m () -> m Exp -> m Exp
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Args (AST (Primitive :&: PrimTypeRep)) sig -> m Exp
forall (m :: * -> *) sig.
MonadC m =>
String -> Args (AST (Primitive :&: PrimTypeRep)) sig -> m Exp
compFun String
"pow" Args (AST (Primitive :&: PrimTypeRep)) sig
args
go PrimTypeRep (DenResult sig)
_ Primitive sig
Sin Args (AST (Primitive :&: PrimTypeRep)) sig
args = String -> m ()
forall (m :: * -> *). MonadC m => String -> m ()
addInclude String
"<tgmath.h>" m () -> m Exp -> m Exp
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Args (AST (Primitive :&: PrimTypeRep)) sig -> m Exp
forall (m :: * -> *) sig.
MonadC m =>
String -> Args (AST (Primitive :&: PrimTypeRep)) sig -> m Exp
compFun String
"sin" Args (AST (Primitive :&: PrimTypeRep)) sig
args
go PrimTypeRep (DenResult sig)
_ Primitive sig
Cos Args (AST (Primitive :&: PrimTypeRep)) sig
args = String -> m ()
forall (m :: * -> *). MonadC m => String -> m ()
addInclude String
"<tgmath.h>" m () -> m Exp -> m Exp
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Args (AST (Primitive :&: PrimTypeRep)) sig -> m Exp
forall (m :: * -> *) sig.
MonadC m =>
String -> Args (AST (Primitive :&: PrimTypeRep)) sig -> m Exp
compFun String
"cos" Args (AST (Primitive :&: PrimTypeRep)) sig
args
go PrimTypeRep (DenResult sig)
_ Primitive sig
Tan Args (AST (Primitive :&: PrimTypeRep)) sig
args = String -> m ()
forall (m :: * -> *). MonadC m => String -> m ()
addInclude String
"<tgmath.h>" m () -> m Exp -> m Exp
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Args (AST (Primitive :&: PrimTypeRep)) sig -> m Exp
forall (m :: * -> *) sig.
MonadC m =>
String -> Args (AST (Primitive :&: PrimTypeRep)) sig -> m Exp
compFun String
"tan" Args (AST (Primitive :&: PrimTypeRep)) sig
args
go PrimTypeRep (DenResult sig)
_ Primitive sig
Asin Args (AST (Primitive :&: PrimTypeRep)) sig
args = String -> m ()
forall (m :: * -> *). MonadC m => String -> m ()
addInclude String
"<tgmath.h>" m () -> m Exp -> m Exp
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Args (AST (Primitive :&: PrimTypeRep)) sig -> m Exp
forall (m :: * -> *) sig.
MonadC m =>
String -> Args (AST (Primitive :&: PrimTypeRep)) sig -> m Exp
compFun String
"asin" Args (AST (Primitive :&: PrimTypeRep)) sig
args
go PrimTypeRep (DenResult sig)
_ Primitive sig
Acos Args (AST (Primitive :&: PrimTypeRep)) sig
args = String -> m ()
forall (m :: * -> *). MonadC m => String -> m ()
addInclude String
"<tgmath.h>" m () -> m Exp -> m Exp
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Args (AST (Primitive :&: PrimTypeRep)) sig -> m Exp
forall (m :: * -> *) sig.
MonadC m =>
String -> Args (AST (Primitive :&: PrimTypeRep)) sig -> m Exp
compFun String
"acos" Args (AST (Primitive :&: PrimTypeRep)) sig
args
go PrimTypeRep (DenResult sig)
_ Primitive sig
Atan Args (AST (Primitive :&: PrimTypeRep)) sig
args = String -> m ()
forall (m :: * -> *). MonadC m => String -> m ()
addInclude String
"<tgmath.h>" m () -> m Exp -> m Exp
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Args (AST (Primitive :&: PrimTypeRep)) sig -> m Exp
forall (m :: * -> *) sig.
MonadC m =>
String -> Args (AST (Primitive :&: PrimTypeRep)) sig -> m Exp
compFun String
"atan" Args (AST (Primitive :&: PrimTypeRep)) sig
args
go PrimTypeRep (DenResult sig)
_ Primitive sig
Sinh Args (AST (Primitive :&: PrimTypeRep)) sig
args = String -> m ()
forall (m :: * -> *). MonadC m => String -> m ()
addInclude String
"<tgmath.h>" m () -> m Exp -> m Exp
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Args (AST (Primitive :&: PrimTypeRep)) sig -> m Exp
forall (m :: * -> *) sig.
MonadC m =>
String -> Args (AST (Primitive :&: PrimTypeRep)) sig -> m Exp
compFun String
"sinh" Args (AST (Primitive :&: PrimTypeRep)) sig
args
go PrimTypeRep (DenResult sig)
_ Primitive sig
Cosh Args (AST (Primitive :&: PrimTypeRep)) sig
args = String -> m ()
forall (m :: * -> *). MonadC m => String -> m ()
addInclude String
"<tgmath.h>" m () -> m Exp -> m Exp
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Args (AST (Primitive :&: PrimTypeRep)) sig -> m Exp
forall (m :: * -> *) sig.
MonadC m =>
String -> Args (AST (Primitive :&: PrimTypeRep)) sig -> m Exp
compFun String
"cosh" Args (AST (Primitive :&: PrimTypeRep)) sig
args
go PrimTypeRep (DenResult sig)
_ Primitive sig
Tanh Args (AST (Primitive :&: PrimTypeRep)) sig
args = String -> m ()
forall (m :: * -> *). MonadC m => String -> m ()
addInclude String
"<tgmath.h>" m () -> m Exp -> m Exp
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Args (AST (Primitive :&: PrimTypeRep)) sig -> m Exp
forall (m :: * -> *) sig.
MonadC m =>
String -> Args (AST (Primitive :&: PrimTypeRep)) sig -> m Exp
compFun String
"tanh" Args (AST (Primitive :&: PrimTypeRep)) sig
args
go PrimTypeRep (DenResult sig)
_ Primitive sig
Asinh Args (AST (Primitive :&: PrimTypeRep)) sig
args = String -> m ()
forall (m :: * -> *). MonadC m => String -> m ()
addInclude String
"<tgmath.h>" m () -> m Exp -> m Exp
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Args (AST (Primitive :&: PrimTypeRep)) sig -> m Exp
forall (m :: * -> *) sig.
MonadC m =>
String -> Args (AST (Primitive :&: PrimTypeRep)) sig -> m Exp
compFun String
"asinh" Args (AST (Primitive :&: PrimTypeRep)) sig
args
go PrimTypeRep (DenResult sig)
_ Primitive sig
Acosh Args (AST (Primitive :&: PrimTypeRep)) sig
args = String -> m ()
forall (m :: * -> *). MonadC m => String -> m ()
addInclude String
"<tgmath.h>" m () -> m Exp -> m Exp
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Args (AST (Primitive :&: PrimTypeRep)) sig -> m Exp
forall (m :: * -> *) sig.
MonadC m =>
String -> Args (AST (Primitive :&: PrimTypeRep)) sig -> m Exp
compFun String
"acosh" Args (AST (Primitive :&: PrimTypeRep)) sig
args
go PrimTypeRep (DenResult sig)
_ Primitive sig
Atanh Args (AST (Primitive :&: PrimTypeRep)) sig
args = String -> m ()
forall (m :: * -> *). MonadC m => String -> m ()
addInclude String
"<tgmath.h>" m () -> m Exp -> m Exp
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Args (AST (Primitive :&: PrimTypeRep)) sig -> m Exp
forall (m :: * -> *) sig.
MonadC m =>
String -> Args (AST (Primitive :&: PrimTypeRep)) sig -> m Exp
compFun String
"atanh" Args (AST (Primitive :&: PrimTypeRep)) sig
args
go PrimTypeRep (DenResult sig)
_ Primitive sig
Complex (AST (Primitive :&: PrimTypeRep) (Full a)
a :* AST (Primitive :&: PrimTypeRep) (Full a)
b :* Args (AST (Primitive :&: PrimTypeRep)) sig1
Nil) = do
String -> m ()
forall (m :: * -> *). MonadC m => String -> m ()
addInclude String
"<tgmath.h>"
Exp
a' <- Prim a -> m Exp
forall (m :: * -> *) a. MonadC m => Prim a -> m Exp
compPrim (Prim a -> m Exp) -> Prim a -> m Exp
forall a b. (a -> b) -> a -> b
$ AST (Primitive :&: PrimTypeRep) (Full a) -> Prim a
forall a. ASTF (Primitive :&: PrimTypeRep) a -> Prim a
Prim AST (Primitive :&: PrimTypeRep) (Full a)
a
Exp
b' <- Prim a -> m Exp
forall (m :: * -> *) a. MonadC m => Prim a -> m Exp
compPrim (Prim a -> m Exp) -> Prim a -> m Exp
forall a b. (a -> b) -> a -> b
$ AST (Primitive :&: PrimTypeRep) (Full a) -> Prim a
forall a. ASTF (Primitive :&: PrimTypeRep) a -> Prim a
Prim AST (Primitive :&: PrimTypeRep) (Full a)
b
Exp -> m Exp
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp -> m Exp) -> Exp -> m Exp
forall a b. (a -> b) -> a -> b
$ case (AST (Primitive :&: PrimTypeRep) (Full a) -> Maybe a
forall a. ASTF (Primitive :&: PrimTypeRep) a -> Maybe a
viewLitPrim AST (Primitive :&: PrimTypeRep) (Full a)
a, AST (Primitive :&: PrimTypeRep) (Full a) -> Maybe a
forall a. ASTF (Primitive :&: PrimTypeRep) a -> Maybe a
viewLitPrim AST (Primitive :&: PrimTypeRep) (Full a)
b) of
(Just a
0, Maybe a
_) -> [cexp| I*$b' |]
(Maybe a
_, Just a
0) -> [cexp| $a' |]
(Maybe a, Maybe a)
_ -> [cexp| $a' + I*$b' |]
go PrimTypeRep (DenResult sig)
_ Primitive sig
Polar (AST (Primitive :&: PrimTypeRep) (Full a)
m :* AST (Primitive :&: PrimTypeRep) (Full a)
p :* Args (AST (Primitive :&: PrimTypeRep)) sig1
Nil)
| Just a
0 <- AST (Primitive :&: PrimTypeRep) (Full a) -> Maybe a
forall a. ASTF (Primitive :&: PrimTypeRep) a -> Maybe a
viewLitPrim AST (Primitive :&: PrimTypeRep) (Full a)
m = Exp -> m Exp
forall (m :: * -> *) a. Monad m => a -> m a
return [cexp| 0 |]
| Just a
0 <- AST (Primitive :&: PrimTypeRep) (Full a) -> Maybe a
forall a. ASTF (Primitive :&: PrimTypeRep) a -> Maybe a
viewLitPrim AST (Primitive :&: PrimTypeRep) (Full a)
p = do
Exp
m' <- Prim a -> m Exp
forall (m :: * -> *) a. MonadC m => Prim a -> m Exp
compPrim (Prim a -> m Exp) -> Prim a -> m Exp
forall a b. (a -> b) -> a -> b
$ AST (Primitive :&: PrimTypeRep) (Full a) -> Prim a
forall a. ASTF (Primitive :&: PrimTypeRep) a -> Prim a
Prim AST (Primitive :&: PrimTypeRep) (Full a)
m
Exp -> m Exp
forall (m :: * -> *) a. Monad m => a -> m a
return [cexp| $m' |]
| Just a
1 <- AST (Primitive :&: PrimTypeRep) (Full a) -> Maybe a
forall a. ASTF (Primitive :&: PrimTypeRep) a -> Maybe a
viewLitPrim AST (Primitive :&: PrimTypeRep) (Full a)
m = do
Exp
p' <- Prim a -> m Exp
forall (m :: * -> *) a. MonadC m => Prim a -> m Exp
compPrim (Prim a -> m Exp) -> Prim a -> m Exp
forall a b. (a -> b) -> a -> b
$ AST (Primitive :&: PrimTypeRep) (Full a) -> Prim a
forall a. ASTF (Primitive :&: PrimTypeRep) a -> Prim a
Prim AST (Primitive :&: PrimTypeRep) (Full a)
p
Exp -> m Exp
forall (m :: * -> *) a. Monad m => a -> m a
return [cexp| exp(I*$p') |]
| Bool
otherwise = do
Exp
m' <- Prim a -> m Exp
forall (m :: * -> *) a. MonadC m => Prim a -> m Exp
compPrim (Prim a -> m Exp) -> Prim a -> m Exp
forall a b. (a -> b) -> a -> b
$ AST (Primitive :&: PrimTypeRep) (Full a) -> Prim a
forall a. ASTF (Primitive :&: PrimTypeRep) a -> Prim a
Prim AST (Primitive :&: PrimTypeRep) (Full a)
m
Exp
p' <- Prim a -> m Exp
forall (m :: * -> *) a. MonadC m => Prim a -> m Exp
compPrim (Prim a -> m Exp) -> Prim a -> m Exp
forall a b. (a -> b) -> a -> b
$ AST (Primitive :&: PrimTypeRep) (Full a) -> Prim a
forall a. ASTF (Primitive :&: PrimTypeRep) a -> Prim a
Prim AST (Primitive :&: PrimTypeRep) (Full a)
p
Exp -> m Exp
forall (m :: * -> *) a. Monad m => a -> m a
return [cexp| $m' * exp(I*$p') |]
go PrimTypeRep (DenResult sig)
_ Primitive sig
Real Args (AST (Primitive :&: PrimTypeRep)) sig
args = String -> m ()
forall (m :: * -> *). MonadC m => String -> m ()
addInclude String
"<tgmath.h>" m () -> m Exp -> m Exp
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Args (AST (Primitive :&: PrimTypeRep)) sig -> m Exp
forall (m :: * -> *) sig.
MonadC m =>
String -> Args (AST (Primitive :&: PrimTypeRep)) sig -> m Exp
compFun String
"creal" Args (AST (Primitive :&: PrimTypeRep)) sig
args
go PrimTypeRep (DenResult sig)
_ Primitive sig
Imag Args (AST (Primitive :&: PrimTypeRep)) sig
args = String -> m ()
forall (m :: * -> *). MonadC m => String -> m ()
addInclude String
"<tgmath.h>" m () -> m Exp -> m Exp
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Args (AST (Primitive :&: PrimTypeRep)) sig -> m Exp
forall (m :: * -> *) sig.
MonadC m =>
String -> Args (AST (Primitive :&: PrimTypeRep)) sig -> m Exp
compFun String
"cimag" Args (AST (Primitive :&: PrimTypeRep)) sig
args
go PrimTypeRep (DenResult sig)
_ Primitive sig
Magnitude Args (AST (Primitive :&: PrimTypeRep)) sig
args = String -> m ()
forall (m :: * -> *). MonadC m => String -> m ()
addInclude String
"<tgmath.h>" m () -> m Exp -> m Exp
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Args (AST (Primitive :&: PrimTypeRep)) sig -> m Exp
forall (m :: * -> *) sig.
MonadC m =>
String -> Args (AST (Primitive :&: PrimTypeRep)) sig -> m Exp
compFun String
"cabs" Args (AST (Primitive :&: PrimTypeRep)) sig
args
go PrimTypeRep (DenResult sig)
_ Primitive sig
Phase Args (AST (Primitive :&: PrimTypeRep)) sig
args = String -> m ()
forall (m :: * -> *). MonadC m => String -> m ()
addInclude String
"<tgmath.h>" m () -> m Exp -> m Exp
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Args (AST (Primitive :&: PrimTypeRep)) sig -> m Exp
forall (m :: * -> *) sig.
MonadC m =>
String -> Args (AST (Primitive :&: PrimTypeRep)) sig -> m Exp
compFun String
"carg" Args (AST (Primitive :&: PrimTypeRep)) sig
args
go PrimTypeRep (DenResult sig)
_ Primitive sig
Conjugate Args (AST (Primitive :&: PrimTypeRep)) sig
args = String -> m ()
forall (m :: * -> *). MonadC m => String -> m ()
addInclude String
"<tgmath.h>" m () -> m Exp -> m Exp
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Args (AST (Primitive :&: PrimTypeRep)) sig -> m Exp
forall (m :: * -> *) sig.
MonadC m =>
String -> Args (AST (Primitive :&: PrimTypeRep)) sig -> m Exp
compFun String
"conj" Args (AST (Primitive :&: PrimTypeRep)) sig
args
go PrimTypeRep (DenResult sig)
t Primitive sig
I2N (AST (Primitive :&: PrimTypeRep) (Full a)
a :* Args (AST (Primitive :&: PrimTypeRep)) sig1
Nil) = PrimTypeRep b -> AST (Primitive :&: PrimTypeRep) (Full a) -> m Exp
forall (m :: * -> *) a b.
MonadC m =>
PrimTypeRep a -> ASTF (Primitive :&: PrimTypeRep) b -> m Exp
compCast PrimTypeRep b
PrimTypeRep (DenResult sig)
t AST (Primitive :&: PrimTypeRep) (Full a)
a
go PrimTypeRep (DenResult sig)
t Primitive sig
I2B (AST (Primitive :&: PrimTypeRep) (Full a)
a :* Args (AST (Primitive :&: PrimTypeRep)) sig1
Nil) = PrimTypeRep Bool
-> AST (Primitive :&: PrimTypeRep) (Full a) -> m Exp
forall (m :: * -> *) a b.
MonadC m =>
PrimTypeRep a -> ASTF (Primitive :&: PrimTypeRep) b -> m Exp
compCast PrimTypeRep Bool
PrimTypeRep (DenResult sig)
t AST (Primitive :&: PrimTypeRep) (Full a)
a
go PrimTypeRep (DenResult sig)
t Primitive sig
B2I (AST (Primitive :&: PrimTypeRep) (Full a)
a :* Args (AST (Primitive :&: PrimTypeRep)) sig1
Nil) = PrimTypeRep a -> AST (Primitive :&: PrimTypeRep) (Full a) -> m Exp
forall (m :: * -> *) a b.
MonadC m =>
PrimTypeRep a -> ASTF (Primitive :&: PrimTypeRep) b -> m Exp
compCast PrimTypeRep a
PrimTypeRep (DenResult sig)
t AST (Primitive :&: PrimTypeRep) (Full a)
a
go PrimTypeRep (DenResult sig)
t Primitive sig
Round (AST (Primitive :&: PrimTypeRep) (Full a)
a :* Args (AST (Primitive :&: PrimTypeRep)) sig1
Nil) = PrimTypeRep b -> AST (Primitive :&: PrimTypeRep) (Full a) -> m Exp
forall a b (m :: * -> *).
(PrimType' a, Num a, RealFrac b, MonadC m) =>
PrimTypeRep a -> ASTF (Primitive :&: PrimTypeRep) b -> m Exp
compRound PrimTypeRep b
PrimTypeRep (DenResult sig)
t AST (Primitive :&: PrimTypeRep) (Full a)
a
go PrimTypeRep (DenResult sig)
_ Primitive sig
Not (AST (Primitive :&: PrimTypeRep) (Full a)
a :* Args (AST (Primitive :&: PrimTypeRep)) sig1
Nil) = UnOp -> AST (Primitive :&: PrimTypeRep) (Full a) -> m Exp
forall (m :: * -> *) a.
MonadC m =>
UnOp -> ASTF (Primitive :&: PrimTypeRep) a -> m Exp
compUnOp UnOp
C.Lnot AST (Primitive :&: PrimTypeRep) (Full a)
a
go PrimTypeRep (DenResult sig)
_ Primitive sig
And (AST (Primitive :&: PrimTypeRep) (Full a)
a :* AST (Primitive :&: PrimTypeRep) (Full a)
b :* Args (AST (Primitive :&: PrimTypeRep)) sig1
Nil) = BinOp
-> AST (Primitive :&: PrimTypeRep) (Full a)
-> AST (Primitive :&: PrimTypeRep) (Full a)
-> m Exp
forall (m :: * -> *) a b.
MonadC m =>
BinOp
-> ASTF (Primitive :&: PrimTypeRep) a
-> ASTF (Primitive :&: PrimTypeRep) b
-> m Exp
compBinOp BinOp
C.Land AST (Primitive :&: PrimTypeRep) (Full a)
a AST (Primitive :&: PrimTypeRep) (Full a)
b
go PrimTypeRep (DenResult sig)
_ Primitive sig
Or (AST (Primitive :&: PrimTypeRep) (Full a)
a :* AST (Primitive :&: PrimTypeRep) (Full a)
b :* Args (AST (Primitive :&: PrimTypeRep)) sig1
Nil) = BinOp
-> AST (Primitive :&: PrimTypeRep) (Full a)
-> AST (Primitive :&: PrimTypeRep) (Full a)
-> m Exp
forall (m :: * -> *) a b.
MonadC m =>
BinOp
-> ASTF (Primitive :&: PrimTypeRep) a
-> ASTF (Primitive :&: PrimTypeRep) b
-> m Exp
compBinOp BinOp
C.Lor AST (Primitive :&: PrimTypeRep) (Full a)
a AST (Primitive :&: PrimTypeRep) (Full a)
b
go PrimTypeRep (DenResult sig)
_ Primitive sig
Eq (AST (Primitive :&: PrimTypeRep) (Full a)
a :* AST (Primitive :&: PrimTypeRep) (Full a)
b :* Args (AST (Primitive :&: PrimTypeRep)) sig1
Nil) = BinOp
-> AST (Primitive :&: PrimTypeRep) (Full a)
-> AST (Primitive :&: PrimTypeRep) (Full a)
-> m Exp
forall (m :: * -> *) a b.
MonadC m =>
BinOp
-> ASTF (Primitive :&: PrimTypeRep) a
-> ASTF (Primitive :&: PrimTypeRep) b
-> m Exp
compBinOp BinOp
C.Eq AST (Primitive :&: PrimTypeRep) (Full a)
a AST (Primitive :&: PrimTypeRep) (Full a)
b
go PrimTypeRep (DenResult sig)
_ Primitive sig
NEq (AST (Primitive :&: PrimTypeRep) (Full a)
a :* AST (Primitive :&: PrimTypeRep) (Full a)
b :* Args (AST (Primitive :&: PrimTypeRep)) sig1
Nil) = BinOp
-> AST (Primitive :&: PrimTypeRep) (Full a)
-> AST (Primitive :&: PrimTypeRep) (Full a)
-> m Exp
forall (m :: * -> *) a b.
MonadC m =>
BinOp
-> ASTF (Primitive :&: PrimTypeRep) a
-> ASTF (Primitive :&: PrimTypeRep) b
-> m Exp
compBinOp BinOp
C.Ne AST (Primitive :&: PrimTypeRep) (Full a)
a AST (Primitive :&: PrimTypeRep) (Full a)
b
go PrimTypeRep (DenResult sig)
_ Primitive sig
Lt (AST (Primitive :&: PrimTypeRep) (Full a)
a :* AST (Primitive :&: PrimTypeRep) (Full a)
b :* Args (AST (Primitive :&: PrimTypeRep)) sig1
Nil) = BinOp
-> AST (Primitive :&: PrimTypeRep) (Full a)
-> AST (Primitive :&: PrimTypeRep) (Full a)
-> m Exp
forall (m :: * -> *) a b.
MonadC m =>
BinOp
-> ASTF (Primitive :&: PrimTypeRep) a
-> ASTF (Primitive :&: PrimTypeRep) b
-> m Exp
compBinOp BinOp
C.Lt AST (Primitive :&: PrimTypeRep) (Full a)
a AST (Primitive :&: PrimTypeRep) (Full a)
b
go PrimTypeRep (DenResult sig)
_ Primitive sig
Gt (AST (Primitive :&: PrimTypeRep) (Full a)
a :* AST (Primitive :&: PrimTypeRep) (Full a)
b :* Args (AST (Primitive :&: PrimTypeRep)) sig1
Nil) = BinOp
-> AST (Primitive :&: PrimTypeRep) (Full a)
-> AST (Primitive :&: PrimTypeRep) (Full a)
-> m Exp
forall (m :: * -> *) a b.
MonadC m =>
BinOp
-> ASTF (Primitive :&: PrimTypeRep) a
-> ASTF (Primitive :&: PrimTypeRep) b
-> m Exp
compBinOp BinOp
C.Gt AST (Primitive :&: PrimTypeRep) (Full a)
a AST (Primitive :&: PrimTypeRep) (Full a)
b
go PrimTypeRep (DenResult sig)
_ Primitive sig
Le (AST (Primitive :&: PrimTypeRep) (Full a)
a :* AST (Primitive :&: PrimTypeRep) (Full a)
b :* Args (AST (Primitive :&: PrimTypeRep)) sig1
Nil) = BinOp
-> AST (Primitive :&: PrimTypeRep) (Full a)
-> AST (Primitive :&: PrimTypeRep) (Full a)
-> m Exp
forall (m :: * -> *) a b.
MonadC m =>
BinOp
-> ASTF (Primitive :&: PrimTypeRep) a
-> ASTF (Primitive :&: PrimTypeRep) b
-> m Exp
compBinOp BinOp
C.Le AST (Primitive :&: PrimTypeRep) (Full a)
a AST (Primitive :&: PrimTypeRep) (Full a)
b
go PrimTypeRep (DenResult sig)
_ Primitive sig
Ge (AST (Primitive :&: PrimTypeRep) (Full a)
a :* AST (Primitive :&: PrimTypeRep) (Full a)
b :* Args (AST (Primitive :&: PrimTypeRep)) sig1
Nil) = BinOp
-> AST (Primitive :&: PrimTypeRep) (Full a)
-> AST (Primitive :&: PrimTypeRep) (Full a)
-> m Exp
forall (m :: * -> *) a b.
MonadC m =>
BinOp
-> ASTF (Primitive :&: PrimTypeRep) a
-> ASTF (Primitive :&: PrimTypeRep) b
-> m Exp
compBinOp BinOp
C.Ge AST (Primitive :&: PrimTypeRep) (Full a)
a AST (Primitive :&: PrimTypeRep) (Full a)
b
go PrimTypeRep (DenResult sig)
_ Primitive sig
BitAnd (AST (Primitive :&: PrimTypeRep) (Full a)
a :* AST (Primitive :&: PrimTypeRep) (Full a)
b :* Args (AST (Primitive :&: PrimTypeRep)) sig1
Nil) = BinOp
-> AST (Primitive :&: PrimTypeRep) (Full a)
-> AST (Primitive :&: PrimTypeRep) (Full a)
-> m Exp
forall (m :: * -> *) a b.
MonadC m =>
BinOp
-> ASTF (Primitive :&: PrimTypeRep) a
-> ASTF (Primitive :&: PrimTypeRep) b
-> m Exp
compBinOp BinOp
C.And AST (Primitive :&: PrimTypeRep) (Full a)
a AST (Primitive :&: PrimTypeRep) (Full a)
b
go PrimTypeRep (DenResult sig)
_ Primitive sig
BitOr (AST (Primitive :&: PrimTypeRep) (Full a)
a :* AST (Primitive :&: PrimTypeRep) (Full a)
b :* Args (AST (Primitive :&: PrimTypeRep)) sig1
Nil) = BinOp
-> AST (Primitive :&: PrimTypeRep) (Full a)
-> AST (Primitive :&: PrimTypeRep) (Full a)
-> m Exp
forall (m :: * -> *) a b.
MonadC m =>
BinOp
-> ASTF (Primitive :&: PrimTypeRep) a
-> ASTF (Primitive :&: PrimTypeRep) b
-> m Exp
compBinOp BinOp
C.Or AST (Primitive :&: PrimTypeRep) (Full a)
a AST (Primitive :&: PrimTypeRep) (Full a)
b
go PrimTypeRep (DenResult sig)
_ Primitive sig
BitXor (AST (Primitive :&: PrimTypeRep) (Full a)
a :* AST (Primitive :&: PrimTypeRep) (Full a)
b :* Args (AST (Primitive :&: PrimTypeRep)) sig1
Nil) = BinOp
-> AST (Primitive :&: PrimTypeRep) (Full a)
-> AST (Primitive :&: PrimTypeRep) (Full a)
-> m Exp
forall (m :: * -> *) a b.
MonadC m =>
BinOp
-> ASTF (Primitive :&: PrimTypeRep) a
-> ASTF (Primitive :&: PrimTypeRep) b
-> m Exp
compBinOp BinOp
C.Xor AST (Primitive :&: PrimTypeRep) (Full a)
a AST (Primitive :&: PrimTypeRep) (Full a)
b
go PrimTypeRep (DenResult sig)
_ Primitive sig
BitCompl (AST (Primitive :&: PrimTypeRep) (Full a)
a :* Args (AST (Primitive :&: PrimTypeRep)) sig1
Nil) = UnOp -> AST (Primitive :&: PrimTypeRep) (Full a) -> m Exp
forall (m :: * -> *) a.
MonadC m =>
UnOp -> ASTF (Primitive :&: PrimTypeRep) a -> m Exp
compUnOp UnOp
C.Not AST (Primitive :&: PrimTypeRep) (Full a)
a
go PrimTypeRep (DenResult sig)
_ Primitive sig
ShiftL (AST (Primitive :&: PrimTypeRep) (Full a)
a :* AST (Primitive :&: PrimTypeRep) (Full a)
b :* Args (AST (Primitive :&: PrimTypeRep)) sig1
Nil) = BinOp
-> AST (Primitive :&: PrimTypeRep) (Full a)
-> AST (Primitive :&: PrimTypeRep) (Full a)
-> m Exp
forall (m :: * -> *) a b.
MonadC m =>
BinOp
-> ASTF (Primitive :&: PrimTypeRep) a
-> ASTF (Primitive :&: PrimTypeRep) b
-> m Exp
compBinOp BinOp
C.Lsh AST (Primitive :&: PrimTypeRep) (Full a)
a AST (Primitive :&: PrimTypeRep) (Full a)
b
go PrimTypeRep (DenResult sig)
_ Primitive sig
ShiftR (AST (Primitive :&: PrimTypeRep) (Full a)
a :* AST (Primitive :&: PrimTypeRep) (Full a)
b :* Args (AST (Primitive :&: PrimTypeRep)) sig1
Nil) = BinOp
-> AST (Primitive :&: PrimTypeRep) (Full a)
-> AST (Primitive :&: PrimTypeRep) (Full a)
-> m Exp
forall (m :: * -> *) a b.
MonadC m =>
BinOp
-> ASTF (Primitive :&: PrimTypeRep) a
-> ASTF (Primitive :&: PrimTypeRep) b
-> m Exp
compBinOp BinOp
C.Rsh AST (Primitive :&: PrimTypeRep) (Full a)
a AST (Primitive :&: PrimTypeRep) (Full a)
b
go PrimTypeRep (DenResult sig)
_ (ArrIx IArr Index a
arr) (AST (Primitive :&: PrimTypeRep) (Full a)
i :* Args (AST (Primitive :&: PrimTypeRep)) sig1
Nil) = do
Exp
i' <- Prim a -> m Exp
forall (m :: * -> *) a. MonadC m => Prim a -> m Exp
compPrim (Prim a -> m Exp) -> Prim a -> m Exp
forall a b. (a -> b) -> a -> b
$ AST (Primitive :&: PrimTypeRep) (Full a) -> Prim a
forall a. ASTF (Primitive :&: PrimTypeRep) a -> Prim a
Prim AST (Primitive :&: PrimTypeRep) (Full a)
i
IArr Index a -> m ()
forall (m :: * -> *) v. (MonadC m, ToIdent v) => v -> m ()
touchVar IArr Index a
arr
Exp -> m Exp
forall (m :: * -> *) a. Monad m => a -> m a
return [cexp| $id:arr[$i'] |]
go PrimTypeRep (DenResult sig)
_ Primitive sig
Cond (AST (Primitive :&: PrimTypeRep) (Full a)
c :* AST (Primitive :&: PrimTypeRep) (Full a)
t :* AST (Primitive :&: PrimTypeRep) (Full a)
f :* Args (AST (Primitive :&: PrimTypeRep)) sig1
Nil) = do
Exp
c' <- Prim a -> m Exp
forall (m :: * -> *) a. MonadC m => Prim a -> m Exp
compPrim (Prim a -> m Exp) -> Prim a -> m Exp
forall a b. (a -> b) -> a -> b
$ AST (Primitive :&: PrimTypeRep) (Full a) -> Prim a
forall a. ASTF (Primitive :&: PrimTypeRep) a -> Prim a
Prim AST (Primitive :&: PrimTypeRep) (Full a)
c
Exp
t' <- Prim a -> m Exp
forall (m :: * -> *) a. MonadC m => Prim a -> m Exp
compPrim (Prim a -> m Exp) -> Prim a -> m Exp
forall a b. (a -> b) -> a -> b
$ AST (Primitive :&: PrimTypeRep) (Full a) -> Prim a
forall a. ASTF (Primitive :&: PrimTypeRep) a -> Prim a
Prim AST (Primitive :&: PrimTypeRep) (Full a)
t
Exp
f' <- Prim a -> m Exp
forall (m :: * -> *) a. MonadC m => Prim a -> m Exp
compPrim (Prim a -> m Exp) -> Prim a -> m Exp
forall a b. (a -> b) -> a -> b
$ AST (Primitive :&: PrimTypeRep) (Full a) -> Prim a
forall a. ASTF (Primitive :&: PrimTypeRep) a -> Prim a
Prim AST (Primitive :&: PrimTypeRep) (Full a)
f
Exp -> m Exp
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp -> m Exp) -> Exp -> m Exp
forall a b. (a -> b) -> a -> b
$ Exp -> Exp -> Exp -> SrcLoc -> Exp
C.Cond Exp
c' Exp
t' Exp
f' SrcLoc
forall a. Monoid a => a
mempty
instance CompExp Prim where compExp :: Prim a -> m Exp
compExp = Prim a -> m Exp
forall (m :: * -> *) a. MonadC m => Prim a -> m Exp
compPrim