{-# LANGUAGE GADTs #-}
module Copilot.Compile.C99.Expr
( transExpr
, constArray
)
where
import Control.Monad.State ( State, modify )
import qualified Data.List.NonEmpty as NonEmpty
import qualified Language.C99.Simple as C
import Copilot.Core ( Expr (..), Field (..), Op1 (..), Op2 (..), Op3 (..),
Type (..), Value (..), accessorName, arrayElems,
toValues )
import Copilot.Compile.C99.Error ( impossible )
import Copilot.Compile.C99.Name ( exCpyName, streamAccessorName )
import Copilot.Compile.C99.Type ( transLocalVarDeclType, transTypeName )
transExpr :: Expr a -> State FunEnv C.Expr
transExpr :: forall a. Expr a -> State FunEnv Expr
transExpr (Const Type a
ty a
x) = Expr -> State FunEnv Expr
forall a. a -> StateT FunEnv Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> State FunEnv Expr) -> Expr -> State FunEnv Expr
forall a b. (a -> b) -> a -> b
$ Type a -> a -> Expr
forall a. Type a -> a -> Expr
constTy Type a
ty a
x
transExpr (Local Type a1
ty1 Type a
_ Name
name Expr a1
e1 Expr a
e2) = do
Expr
e1' <- Expr a1 -> State FunEnv Expr
forall a. Expr a -> State FunEnv Expr
transExpr Expr a1
e1
let cTy1 :: Type
cTy1 = Type a1 -> Type
forall a. Type a -> Type
transLocalVarDeclType Type a1
ty1
initExpr :: Maybe Init
initExpr = Init -> Maybe Init
forall a. a -> Maybe a
Just (Init -> Maybe Init) -> Init -> Maybe Init
forall a b. (a -> b) -> a -> b
$ Expr -> Init
C.InitExpr Expr
e1'
(FunEnv -> FunEnv) -> StateT FunEnv Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (FunEnv -> FunEnv -> FunEnv
forall a. [a] -> [a] -> [a]
++ [Maybe StorageSpec -> Type -> Name -> Maybe Init -> Decln
C.VarDecln Maybe StorageSpec
forall a. Maybe a
Nothing Type
cTy1 Name
name Maybe Init
initExpr])
Expr a -> State FunEnv Expr
forall a. Expr a -> State FunEnv Expr
transExpr Expr a
e2
transExpr (Var Type a
_ Name
n) = Expr -> State FunEnv Expr
forall a. a -> StateT FunEnv Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> State FunEnv Expr) -> Expr -> State FunEnv Expr
forall a b. (a -> b) -> a -> b
$ Name -> Expr
C.Ident Name
n
transExpr (Drop Type a
_ DropIdx
amount Id
sId) = do
let accessVar :: Name
accessVar = Id -> Name
streamAccessorName Id
sId
index :: Expr
index = Integer -> Expr
C.LitInt (DropIdx -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral DropIdx
amount)
Expr -> State FunEnv Expr
forall a. a -> StateT FunEnv Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> State FunEnv Expr) -> Expr -> State FunEnv Expr
forall a b. (a -> b) -> a -> b
$ Name -> [Expr] -> Expr
funCall Name
accessVar [Expr
index]
transExpr (ExternVar Type a
_ Name
name Maybe [a]
_) = Expr -> State FunEnv Expr
forall a. a -> StateT FunEnv Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> State FunEnv Expr) -> Expr -> State FunEnv Expr
forall a b. (a -> b) -> a -> b
$ Name -> Expr
C.Ident (Name -> Name
exCpyName Name
name)
transExpr (Label Type a
_ Name
_ Expr a
e) = Expr a -> State FunEnv Expr
forall a. Expr a -> State FunEnv Expr
transExpr Expr a
e
transExpr (Op1 Op1 a1 a
op Expr a1
e) = do
Expr
e' <- Expr a1 -> State FunEnv Expr
forall a. Expr a -> State FunEnv Expr
transExpr Expr a1
e
Expr -> State FunEnv Expr
forall a. a -> StateT FunEnv Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> State FunEnv Expr) -> Expr -> State FunEnv Expr
forall a b. (a -> b) -> a -> b
$ Op1 a1 a -> Expr -> Expr
forall a b. Op1 a b -> Expr -> Expr
transOp1 Op1 a1 a
op Expr
e'
transExpr (Op2 Op2 a1 b a
op Expr a1
e1 Expr b
e2) = do
Expr
e1' <- Expr a1 -> State FunEnv Expr
forall a. Expr a -> State FunEnv Expr
transExpr Expr a1
e1
Expr
e2' <- Expr b -> State FunEnv Expr
forall a. Expr a -> State FunEnv Expr
transExpr Expr b
e2
Expr -> State FunEnv Expr
forall a. a -> StateT FunEnv Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> State FunEnv Expr) -> Expr -> State FunEnv Expr
forall a b. (a -> b) -> a -> b
$ Op2 a1 b a -> Expr -> Expr -> Expr
forall a b c. Op2 a b c -> Expr -> Expr -> Expr
transOp2 Op2 a1 b a
op Expr
e1' Expr
e2'
transExpr (Op3 Op3 a1 b c a
op Expr a1
e1 Expr b
e2 Expr c
e3) = do
Expr
e1' <- Expr a1 -> State FunEnv Expr
forall a. Expr a -> State FunEnv Expr
transExpr Expr a1
e1
Expr
e2' <- Expr b -> State FunEnv Expr
forall a. Expr a -> State FunEnv Expr
transExpr Expr b
e2
Expr
e3' <- Expr c -> State FunEnv Expr
forall a. Expr a -> State FunEnv Expr
transExpr Expr c
e3
Expr -> State FunEnv Expr
forall a. a -> StateT FunEnv Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> State FunEnv Expr) -> Expr -> State FunEnv Expr
forall a b. (a -> b) -> a -> b
$ Op3 a1 b c a -> Expr -> Expr -> Expr -> Expr
forall a b c d. Op3 a b c d -> Expr -> Expr -> Expr -> Expr
transOp3 Op3 a1 b c a
op Expr
e1' Expr
e2' Expr
e3'
transOp1 :: Op1 a b -> C.Expr -> C.Expr
transOp1 :: forall a b. Op1 a b -> Expr -> Expr
transOp1 Op1 a b
op Expr
e =
case Op1 a b
op of
Op1 a b
Not -> Expr -> Expr
(C..!) Expr
e
Abs Type a
ty -> Type a -> Expr -> Expr
forall a. Type a -> Expr -> Expr
transAbs Type a
ty Expr
e
Sign Type a
ty -> Type a -> Expr -> Expr
forall a. Type a -> Expr -> Expr
transSign Type a
ty Expr
e
Recip Type a
ty -> Type a -> Integer -> Expr
forall a. Type a -> Integer -> Expr
constNumTy Type a
ty Integer
1 Expr -> Expr -> Expr
C../ Expr
e
Acos Type a
ty -> Name -> [Expr] -> Expr
funCall (Type a -> Name -> Name
forall a. Type a -> Name -> Name
specializeMathFunName Type a
ty Name
"acos") [Expr
e]
Asin Type a
ty -> Name -> [Expr] -> Expr
funCall (Type a -> Name -> Name
forall a. Type a -> Name -> Name
specializeMathFunName Type a
ty Name
"asin") [Expr
e]
Atan Type a
ty -> Name -> [Expr] -> Expr
funCall (Type a -> Name -> Name
forall a. Type a -> Name -> Name
specializeMathFunName Type a
ty Name
"atan") [Expr
e]
Cos Type a
ty -> Name -> [Expr] -> Expr
funCall (Type a -> Name -> Name
forall a. Type a -> Name -> Name
specializeMathFunName Type a
ty Name
"cos") [Expr
e]
Sin Type a
ty -> Name -> [Expr] -> Expr
funCall (Type a -> Name -> Name
forall a. Type a -> Name -> Name
specializeMathFunName Type a
ty Name
"sin") [Expr
e]
Tan Type a
ty -> Name -> [Expr] -> Expr
funCall (Type a -> Name -> Name
forall a. Type a -> Name -> Name
specializeMathFunName Type a
ty Name
"tan") [Expr
e]
Acosh Type a
ty -> Name -> [Expr] -> Expr
funCall (Type a -> Name -> Name
forall a. Type a -> Name -> Name
specializeMathFunName Type a
ty Name
"acosh") [Expr
e]
Asinh Type a
ty -> Name -> [Expr] -> Expr
funCall (Type a -> Name -> Name
forall a. Type a -> Name -> Name
specializeMathFunName Type a
ty Name
"asinh") [Expr
e]
Atanh Type a
ty -> Name -> [Expr] -> Expr
funCall (Type a -> Name -> Name
forall a. Type a -> Name -> Name
specializeMathFunName Type a
ty Name
"atanh") [Expr
e]
Cosh Type a
ty -> Name -> [Expr] -> Expr
funCall (Type a -> Name -> Name
forall a. Type a -> Name -> Name
specializeMathFunName Type a
ty Name
"cosh") [Expr
e]
Sinh Type a
ty -> Name -> [Expr] -> Expr
funCall (Type a -> Name -> Name
forall a. Type a -> Name -> Name
specializeMathFunName Type a
ty Name
"sinh") [Expr
e]
Tanh Type a
ty -> Name -> [Expr] -> Expr
funCall (Type a -> Name -> Name
forall a. Type a -> Name -> Name
specializeMathFunName Type a
ty Name
"tanh") [Expr
e]
Exp Type a
ty -> Name -> [Expr] -> Expr
funCall (Type a -> Name -> Name
forall a. Type a -> Name -> Name
specializeMathFunName Type a
ty Name
"exp") [Expr
e]
Log Type a
ty -> Name -> [Expr] -> Expr
funCall (Type a -> Name -> Name
forall a. Type a -> Name -> Name
specializeMathFunName Type a
ty Name
"log") [Expr
e]
Sqrt Type a
ty -> Name -> [Expr] -> Expr
funCall (Type a -> Name -> Name
forall a. Type a -> Name -> Name
specializeMathFunName Type a
ty Name
"sqrt") [Expr
e]
Ceiling Type a
ty -> Name -> [Expr] -> Expr
funCall (Type a -> Name -> Name
forall a. Type a -> Name -> Name
specializeMathFunName Type a
ty Name
"ceil") [Expr
e]
Floor Type a
ty -> Name -> [Expr] -> Expr
funCall (Type a -> Name -> Name
forall a. Type a -> Name -> Name
specializeMathFunName Type a
ty Name
"floor") [Expr
e]
BwNot Type a
_ -> Expr -> Expr
(C..~) Expr
e
Cast Type a
_ Type b
ty -> TypeName -> Expr -> Expr
C.Cast (Type b -> TypeName
forall a. Type a -> TypeName
transTypeName Type b
ty) Expr
e
GetField (Struct a
_) Type b
_ a -> Field s b
f -> Expr -> Name -> Expr
C.Dot Expr
e ((a -> Field s b) -> Name
forall a (s :: Symbol) t.
(Struct a, KnownSymbol s) =>
(a -> Field s t) -> Name
accessorName a -> Field s b
f)
transOp2 :: Op2 a b c -> C.Expr -> C.Expr -> C.Expr
transOp2 :: forall a b c. Op2 a b c -> Expr -> Expr -> Expr
transOp2 Op2 a b c
op Expr
e1 Expr
e2 = case Op2 a b c
op of
Op2 a b c
And -> Expr
e1 Expr -> Expr -> Expr
C..&& Expr
e2
Op2 a b c
Or -> Expr
e1 Expr -> Expr -> Expr
C..|| Expr
e2
Add Type a
_ -> Expr
e1 Expr -> Expr -> Expr
C..+ Expr
e2
Sub Type a
_ -> Expr
e1 Expr -> Expr -> Expr
C..- Expr
e2
Mul Type a
_ -> Expr
e1 Expr -> Expr -> Expr
C..* Expr
e2
Mod Type a
_ -> Expr
e1 Expr -> Expr -> Expr
C..% Expr
e2
Div Type a
_ -> Expr
e1 Expr -> Expr -> Expr
C../ Expr
e2
Fdiv Type a
_ -> Expr
e1 Expr -> Expr -> Expr
C../ Expr
e2
Pow Type a
ty -> Name -> [Expr] -> Expr
funCall (Type a -> Name -> Name
forall a. Type a -> Name -> Name
specializeMathFunName Type a
ty Name
"pow") [Expr
e1, Expr
e2]
Logb Type a
ty -> Name -> [Expr] -> Expr
funCall (Type a -> Name -> Name
forall a. Type a -> Name -> Name
specializeMathFunName Type a
ty Name
"log") [Expr
e2] Expr -> Expr -> Expr
C../
Name -> [Expr] -> Expr
funCall (Type a -> Name -> Name
forall a. Type a -> Name -> Name
specializeMathFunName Type a
ty Name
"log") [Expr
e1]
Atan2 Type a
ty -> Name -> [Expr] -> Expr
funCall (Type a -> Name -> Name
forall a. Type a -> Name -> Name
specializeMathFunName Type a
ty Name
"atan2") [Expr
e1, Expr
e2]
Eq Type a
_ -> Expr
e1 Expr -> Expr -> Expr
C..== Expr
e2
Ne Type a
_ -> Expr
e1 Expr -> Expr -> Expr
C..!= Expr
e2
Le Type a
_ -> Expr
e1 Expr -> Expr -> Expr
C..<= Expr
e2
Ge Type a
_ -> Expr
e1 Expr -> Expr -> Expr
C..>= Expr
e2
Lt Type a
_ -> Expr
e1 Expr -> Expr -> Expr
C..< Expr
e2
Gt Type a
_ -> Expr
e1 Expr -> Expr -> Expr
C..> Expr
e2
BwAnd Type a
_ -> Expr
e1 Expr -> Expr -> Expr
C..& Expr
e2
BwOr Type a
_ -> Expr
e1 Expr -> Expr -> Expr
C..| Expr
e2
BwXor Type a
_ -> Expr
e1 Expr -> Expr -> Expr
C..^ Expr
e2
BwShiftL Type a
_ Type b
_ -> Expr
e1 Expr -> Expr -> Expr
C..<< Expr
e2
BwShiftR Type a
_ Type b
_ -> Expr
e1 Expr -> Expr -> Expr
C..>> Expr
e2
Index Type (Array n c)
_ -> Expr -> Expr -> Expr
C.Index Expr
e1 Expr
e2
transOp3 :: Op3 a b c d -> C.Expr -> C.Expr -> C.Expr -> C.Expr
transOp3 :: forall a b c d. Op3 a b c d -> Expr -> Expr -> Expr -> Expr
transOp3 Op3 a b c d
op Expr
e1 Expr
e2 Expr
e3 = case Op3 a b c d
op of
Mux Type b
_ -> Expr -> Expr -> Expr -> Expr
C.Cond Expr
e1 Expr
e2 Expr
e3
transAbs :: Type a -> C.Expr -> C.Expr
transAbs :: forall a. Type a -> Expr -> Expr
transAbs Type a
ty Expr
e
| Type a -> Bool
forall a. Type a -> Bool
typeIsFloating Type a
ty
= Name -> [Expr] -> Expr
funCall (Type a -> Name -> Name
forall a. Type a -> Name -> Name
specializeMathFunName Type a
ty Name
"fabs") [Expr
e]
| Bool
otherwise
= (Expr
e Expr -> Expr -> Expr
C..+ (Expr
e Expr -> Expr -> Expr
C..>> Expr
tyBitSizeMinus1)) Expr -> Expr -> Expr
C..^ (Expr
e Expr -> Expr -> Expr
C..>> Expr
tyBitSizeMinus1)
where
tyBitSizeMinus1 :: C.Expr
tyBitSizeMinus1 :: Expr
tyBitSizeMinus1 = case Type a
ty of
Type a
Int8 -> Integer -> Expr
C.LitInt Integer
7
Type a
Int16 -> Integer -> Expr
C.LitInt Integer
15
Type a
Int32 -> Integer -> Expr
C.LitInt Integer
31
Type a
Int64 -> Integer -> Expr
C.LitInt Integer
63
Type a
Word8 -> Integer -> Expr
C.LitInt Integer
7
Type a
Word16 -> Integer -> Expr
C.LitInt Integer
15
Type a
Word32 -> Integer -> Expr
C.LitInt Integer
31
Type a
Word64 -> Integer -> Expr
C.LitInt Integer
63
Type a
_ -> Name -> Name -> Name -> Expr
forall a. Name -> Name -> a
impossible
Name
"transAbs"
Name
"copilot-c99"
Name
"Abs applied to unexpected types."
transSign :: Type a -> C.Expr -> C.Expr
transSign :: forall a. Type a -> Expr -> Expr
transSign Type a
ty Expr
e = Expr -> Expr
positiveCase (Expr -> Expr) -> Expr -> Expr
forall a b. (a -> b) -> a -> b
$ Expr -> Expr
negativeCase Expr
e
where
positiveCase :: C.Expr
-> C.Expr
positiveCase :: Expr -> Expr
positiveCase =
Expr -> Expr -> Expr -> Expr
C.Cond (BinaryOp -> Expr -> Expr -> Expr
C.BinaryOp BinaryOp
C.GT Expr
e (Type a -> Integer -> Expr
forall a. Type a -> Integer -> Expr
constNumTy Type a
ty Integer
0)) (Type a -> Integer -> Expr
forall a. Type a -> Integer -> Expr
constNumTy Type a
ty Integer
1)
negativeCase :: C.Expr
-> C.Expr
negativeCase :: Expr -> Expr
negativeCase =
Expr -> Expr -> Expr -> Expr
C.Cond (BinaryOp -> Expr -> Expr -> Expr
C.BinaryOp BinaryOp
C.LT Expr
e (Type a -> Integer -> Expr
forall a. Type a -> Integer -> Expr
constNumTy Type a
ty Integer
0)) (Type a -> Integer -> Expr
forall a. Type a -> Integer -> Expr
constNumTy Type a
ty (-Integer
1))
constTy :: Type a -> a -> C.Expr
constTy :: forall a. Type a -> a -> Expr
constTy Type a
ty = case Type a
ty of
Type a
Bool -> a -> Expr
Bool -> Expr
C.LitBool
Type a
Int8 -> Type a -> Expr -> Expr
forall a. Type a -> Expr -> Expr
explicitTy Type a
ty (Expr -> Expr) -> (a -> Expr) -> a -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Expr
C.LitInt (Integer -> Expr) -> (a -> Integer) -> a -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral
Type a
Int16 -> Type a -> Expr -> Expr
forall a. Type a -> Expr -> Expr
explicitTy Type a
ty (Expr -> Expr) -> (a -> Expr) -> a -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Expr
C.LitInt (Integer -> Expr) -> (a -> Integer) -> a -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral
Type a
Int32 -> Type a -> Expr -> Expr
forall a. Type a -> Expr -> Expr
explicitTy Type a
ty (Expr -> Expr) -> (a -> Expr) -> a -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Expr
C.LitInt (Integer -> Expr) -> (a -> Integer) -> a -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral
Type a
Int64 -> Type a -> Expr -> Expr
forall a. Type a -> Expr -> Expr
explicitTy Type a
ty (Expr -> Expr) -> (a -> Expr) -> a -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Expr
C.LitInt (Integer -> Expr) -> (a -> Integer) -> a -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral
Type a
Word8 -> Type a -> Expr -> Expr
forall a. Type a -> Expr -> Expr
explicitTy Type a
ty (Expr -> Expr) -> (a -> Expr) -> a -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Expr
C.LitInt (Integer -> Expr) -> (a -> Integer) -> a -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral
Type a
Word16 -> Type a -> Expr -> Expr
forall a. Type a -> Expr -> Expr
explicitTy Type a
ty (Expr -> Expr) -> (a -> Expr) -> a -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Expr
C.LitInt (Integer -> Expr) -> (a -> Integer) -> a -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral
Type a
Word32 -> Type a -> Expr -> Expr
forall a. Type a -> Expr -> Expr
explicitTy Type a
ty (Expr -> Expr) -> (a -> Expr) -> a -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Expr
C.LitInt (Integer -> Expr) -> (a -> Integer) -> a -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral
Type a
Word64 -> Type a -> Expr -> Expr
forall a. Type a -> Expr -> Expr
explicitTy Type a
ty (Expr -> Expr) -> (a -> Expr) -> a -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Expr
C.LitInt (Integer -> Expr) -> (a -> Integer) -> a -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral
Type a
Float -> Type a -> Expr -> Expr
forall a. Type a -> Expr -> Expr
explicitTy Type a
ty (Expr -> Expr) -> (a -> Expr) -> a -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Expr
Float -> Expr
C.LitFloat
Type a
Double -> Type a -> Expr -> Expr
forall a. Type a -> Expr -> Expr
explicitTy Type a
ty (Expr -> Expr) -> (a -> Expr) -> a -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Expr
Double -> Expr
C.LitDouble
Struct a
_ -> TypeName -> NonEmpty InitItem -> Expr
C.InitVal (Type a -> TypeName
forall a. Type a -> TypeName
transTypeName Type a
ty) (NonEmpty InitItem -> Expr)
-> (a -> NonEmpty InitItem) -> a -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Value a] -> NonEmpty InitItem
forall a. [Value a] -> NonEmpty InitItem
constStruct ([Value a] -> NonEmpty InitItem)
-> (a -> [Value a]) -> a -> NonEmpty InitItem
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [Value a]
forall a. Struct a => a -> [Value a]
toValues
Array Type t
ty' -> TypeName -> NonEmpty InitItem -> Expr
C.InitVal (Type a -> TypeName
forall a. Type a -> TypeName
transTypeName Type a
ty) (NonEmpty InitItem -> Expr)
-> (a -> NonEmpty InitItem) -> a -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type t -> [t] -> NonEmpty InitItem
forall a. Type a -> [a] -> NonEmpty InitItem
constArray Type t
ty' ([t] -> NonEmpty InitItem) -> (a -> [t]) -> a -> NonEmpty InitItem
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [t]
Array n t -> [t]
forall (n :: Nat) a. Array n a -> [a]
arrayElems
constInit :: Type a -> a -> C.Init
constInit :: forall a. Type a -> a -> Init
constInit Type a
ty a
val = case Type a
ty of
Array Type t
ty' -> NonEmpty InitItem -> Init
C.InitList (NonEmpty InitItem -> Init) -> NonEmpty InitItem -> Init
forall a b. (a -> b) -> a -> b
$ Type t -> [t] -> NonEmpty InitItem
forall a. Type a -> [a] -> NonEmpty InitItem
constArray Type t
ty' ([t] -> NonEmpty InitItem) -> [t] -> NonEmpty InitItem
forall a b. (a -> b) -> a -> b
$ Array n t -> [t]
forall (n :: Nat) a. Array n a -> [a]
arrayElems a
Array n t
val
Struct a
_ -> NonEmpty InitItem -> Init
C.InitList (NonEmpty InitItem -> Init) -> NonEmpty InitItem -> Init
forall a b. (a -> b) -> a -> b
$ [Value a] -> NonEmpty InitItem
forall a. [Value a] -> NonEmpty InitItem
constStruct (a -> [Value a]
forall a. Struct a => a -> [Value a]
toValues a
val)
Type a
_ -> Expr -> Init
C.InitExpr (Expr -> Init) -> Expr -> Init
forall a b. (a -> b) -> a -> b
$ Type a -> a -> Expr
forall a. Type a -> a -> Expr
constTy Type a
ty a
val
constFieldInit :: Value a -> C.InitItem
constFieldInit :: forall a. Value a -> InitItem
constFieldInit (Value Type t
ty (Field t
val)) = Maybe Name -> Init -> InitItem
C.InitItem Maybe Name
forall a. Maybe a
Nothing (Init -> InitItem) -> Init -> InitItem
forall a b. (a -> b) -> a -> b
$ Type t -> t -> Init
forall a. Type a -> a -> Init
constInit Type t
ty t
val
constStruct :: [Value a] -> NonEmpty.NonEmpty C.InitItem
constStruct :: forall a. [Value a] -> NonEmpty InitItem
constStruct [Value a]
val = [InitItem] -> NonEmpty InitItem
forall a. HasCallStack => [a] -> NonEmpty a
NonEmpty.fromList ([InitItem] -> NonEmpty InitItem)
-> [InitItem] -> NonEmpty InitItem
forall a b. (a -> b) -> a -> b
$ (Value a -> InitItem) -> [Value a] -> [InitItem]
forall a b. (a -> b) -> [a] -> [b]
map Value a -> InitItem
forall a. Value a -> InitItem
constFieldInit [Value a]
val
constArray :: Type a -> [a] -> NonEmpty.NonEmpty C.InitItem
constArray :: forall a. Type a -> [a] -> NonEmpty InitItem
constArray Type a
ty =
[InitItem] -> NonEmpty InitItem
forall a. HasCallStack => [a] -> NonEmpty a
NonEmpty.fromList ([InitItem] -> NonEmpty InitItem)
-> ([a] -> [InitItem]) -> [a] -> NonEmpty InitItem
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> InitItem) -> [a] -> [InitItem]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe Name -> Init -> InitItem
C.InitItem Maybe Name
forall a. Maybe a
Nothing (Init -> InitItem) -> (a -> Init) -> a -> InitItem
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type a -> a -> Init
forall a. Type a -> a -> Init
constInit Type a
ty)
explicitTy :: Type a -> C.Expr -> C.Expr
explicitTy :: forall a. Type a -> Expr -> Expr
explicitTy Type a
ty = TypeName -> Expr -> Expr
C.Cast (Type a -> TypeName
forall a. Type a -> TypeName
transTypeName Type a
ty)
constNumTy :: Type a -> Integer -> C.Expr
constNumTy :: forall a. Type a -> Integer -> Expr
constNumTy Type a
ty =
case Type a
ty of
Type a
Float -> Float -> Expr
C.LitFloat (Float -> Expr) -> (Integer -> Float) -> Integer -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Float
forall a. Num a => Integer -> a
fromInteger
Type a
Double -> Double -> Expr
C.LitDouble (Double -> Expr) -> (Integer -> Double) -> Integer -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Double
forall a. Num a => Integer -> a
fromInteger
Type a
_ -> Integer -> Expr
C.LitInt
specializeMathFunName :: Type a -> String -> String
specializeMathFunName :: forall a. Type a -> Name -> Name
specializeMathFunName Type a
ty Name
s
| Name -> Bool
isMathFPArgs Name
s
, Type a
Float <- Type a
ty
= Name
s Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Name
"f"
| Bool
otherwise
= Name
s
where
isMathFPArgs :: String -> Bool
isMathFPArgs :: Name -> Bool
isMathFPArgs = (Name -> [Name] -> Bool) -> [Name] -> Name -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Name -> [Name] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem
[ Name
"acos", Name
"asin", Name
"atan", Name
"atan2", Name
"cos", Name
"sin"
, Name
"tan", Name
"acosh", Name
"asinh", Name
"atanh", Name
"cosh", Name
"sinh"
, Name
"tanh", Name
"exp", Name
"exp2", Name
"expm1", Name
"frexp", Name
"ilogb"
, Name
"ldexp", Name
"log", Name
"log10", Name
"log1p", Name
"log2", Name
"logb"
, Name
"modf", Name
"scalbn", Name
"scalbln", Name
"cbrt", Name
"fabs", Name
"hypot"
, Name
"pow", Name
"sqrt", Name
"erf", Name
"erfc", Name
"lgamma", Name
"tgamma"
, Name
"ceil", Name
"floor", Name
"nearbyint", Name
"rint", Name
"lrint", Name
"llrint"
, Name
"round", Name
"lround", Name
"llround", Name
"trunc", Name
"fmod", Name
"remainder"
, Name
"remquo", Name
"copysign", Name
"nextafter", Name
"nexttoward", Name
"fdim"
, Name
"fmax", Name
"fmin", Name
"fma"
]
typeIsFloating :: Type a -> Bool
typeIsFloating :: forall a. Type a -> Bool
typeIsFloating Type a
Float = Bool
True
typeIsFloating Type a
Double = Bool
True
typeIsFloating Type a
_ = Bool
False
type FunEnv = [C.Decln]
funCall :: C.Ident
-> [C.Expr]
-> C.Expr
funCall :: Name -> [Expr] -> Expr
funCall Name
name = Expr -> [Expr] -> Expr
C.Funcall (Name -> Expr
C.Ident Name
name)