{-# LANGUAGE GADTs #-}

module Copilot.Compile.C99.Translate where

import Control.Monad.State

import Copilot.Core
import Copilot.Compile.C99.Util

import qualified Language.C99.Simple as C

-- | Translates a Copilot expression into a C99 expression.
transexpr :: Expr a -> State FunEnv C.Expr
transexpr :: Expr a -> State FunEnv Expr
transexpr (Const Type a
ty a
x) = Expr -> State FunEnv Expr
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
transtype Type a1
ty1
      init :: Maybe Init
init = 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 -> State FunEnv ()
forall m. Monoid m => m -> State m ()
statetell ([Maybe StorageSpec -> Type -> Name -> Maybe Init -> Decln
C.VarDecln Maybe StorageSpec
forall a. Maybe a
Nothing Type
cty1 Name
name Maybe Init
init], [])

  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 (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 var :: Name
var    = Id -> Name
streamname Id
sid
      indexvar :: Name
indexvar = Id -> Name
indexname Id
sid
      index :: Expr
index  = case DropIdx
amount of
        DropIdx
0 -> Name -> Expr
C.Ident Name
indexvar
        DropIdx
n -> Name -> Expr
C.Ident Name
indexvar Expr -> Expr -> Expr
C..+ Integer -> Expr
C.LitInt (DropIdx -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral DropIdx
n)
  Expr -> State FunEnv Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> State FunEnv Expr) -> Expr -> State FunEnv Expr
forall a b. (a -> b) -> a -> b
$ Expr -> Expr -> Expr
C.Index (Name -> Expr
C.Ident Name
var) Expr
index

transexpr (ExternVar Type a
_ Name
name Maybe [a]
_) = Expr -> State FunEnv Expr
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 -- ignore label

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 (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 (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 (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'


-- | Translates a Copilot unary operator and arguments into a C99 expression.
transop1 :: Op1 a b -> C.Expr -> C.Expr
transop1 :: 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
_      -> Name -> [Expr] -> Expr
funcall Name
"abs"      [Expr
e]
  Sign     Type a
_      -> Name -> [Expr] -> Expr
funcall Name
"copysign" [Double -> Expr
C.LitDouble Double
1.0, Expr
e]
  Recip    Type a
_      -> Double -> Expr
C.LitDouble Double
1.0 Expr -> Expr -> Expr
C../ Expr
e
  Exp      Type a
_      -> Name -> [Expr] -> Expr
funcall Name
"exp"   [Expr
e]
  Sqrt     Type a
_      -> Name -> [Expr] -> Expr
funcall Name
"sqrt"  [Expr
e]
  Log      Type a
_      -> Name -> [Expr] -> Expr
funcall Name
"log"   [Expr
e]
  Sin      Type a
_      -> Name -> [Expr] -> Expr
funcall Name
"sin"   [Expr
e]
  Tan      Type a
_      -> Name -> [Expr] -> Expr
funcall Name
"tan"   [Expr
e]
  Cos      Type a
_      -> Name -> [Expr] -> Expr
funcall Name
"cos"   [Expr
e]
  Asin     Type a
_      -> Name -> [Expr] -> Expr
funcall Name
"asin"  [Expr
e]
  Atan     Type a
_      -> Name -> [Expr] -> Expr
funcall Name
"atan"  [Expr
e]
  Acos     Type a
_      -> Name -> [Expr] -> Expr
funcall Name
"acos"  [Expr
e]
  Sinh     Type a
_      -> Name -> [Expr] -> Expr
funcall Name
"sinh"  [Expr
e]
  Tanh     Type a
_      -> Name -> [Expr] -> Expr
funcall Name
"tanh"  [Expr
e]
  Cosh     Type a
_      -> Name -> [Expr] -> Expr
funcall Name
"cosh"  [Expr
e]
  Asinh    Type a
_      -> Name -> [Expr] -> Expr
funcall Name
"asinh" [Expr
e]
  Atanh    Type a
_      -> Name -> [Expr] -> Expr
funcall Name
"atanh" [Expr
e]
  Acosh    Type a
_      -> Name -> [Expr] -> Expr
funcall Name
"acosh" [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)

-- | Translates a Copilot binary operator and arguments into a C99 expression.
transop2 :: Op2 a b c -> C.Expr -> C.Expr -> C.Expr
transop2 :: 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
_   -> Name -> [Expr] -> Expr
funcall Name
"pow" [Expr
e1, Expr
e2]
  Logb     Type a
_   -> Name -> [Expr] -> Expr
funcall Name
"log" [Expr
e2] Expr -> Expr -> Expr
C../ Name -> [Expr] -> Expr
funcall Name
"log" [Expr
e1]
  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

-- | Translates a Copilot ternaty operator and arguments into a C99 expression.
transop3 :: Op3 a b c d -> C.Expr -> C.Expr -> C.Expr -> C.Expr
transop3 :: 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

-- | Give a C99 literal expression based on a value and a type.
constty :: Type a -> a -> C.Expr
constty :: 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) -> (Float -> Expr) -> Float -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Expr
C.LitFloat
  Type a
Double -> Type a -> Expr -> Expr
forall a. Type a -> Expr -> Expr
explicitty Type a
ty (Expr -> Expr) -> (Double -> Expr) -> Double -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Expr
C.LitDouble
  Struct a
_ -> \a
v -> TypeName -> [Init] -> Expr
C.InitVal (Type a -> TypeName
forall a. Type a -> TypeName
transtypename Type a
ty) ((Value a -> Init) -> [Value a] -> [Init]
forall a b. (a -> b) -> [a] -> [b]
map Value a -> Init
forall a. Value a -> Init
fieldinit (a -> [Value a]
forall a. Struct a => a -> [Value a]
toValues a
v))
    where
      fieldinit :: Value a -> Init
fieldinit (Value Type t
ty (Field t
val)) = Expr -> Init
C.InitExpr (Expr -> Init) -> Expr -> Init
forall a b. (a -> b) -> a -> b
$ Type t -> t -> Expr
forall a. Type a -> a -> Expr
constty Type t
ty t
val
  Array Type t
ty' -> \a
v -> TypeName -> [Init] -> Expr
C.InitVal (Type a -> TypeName
forall a. Type a -> TypeName
transtypename Type a
ty) (Array n t -> [Init]
vals a
Array n t
v)
    where
      vals :: Array n t -> [Init]
vals Array n t
v = Type t -> [t] -> [Init]
forall a. Type a -> [a] -> [Init]
constarray Type t
ty' (Array n t -> [t]
forall (n :: Nat) a. Array n a -> [a]
arrayelems Array n t
v)

      constarray :: Type a -> [a] -> [C.Init]
      constarray :: Type a -> [a] -> [Init]
constarray Type a
ty [a]
xs = case Type a
ty of
        Array Type t
ty' -> Type t -> [t] -> [Init]
forall a. Type a -> [a] -> [Init]
constarray Type t
ty' ((Array n t -> [t]) -> [Array n t] -> [t]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Array n t -> [t]
forall (n :: Nat) a. Array n a -> [a]
arrayelems [a]
[Array n t]
xs)
        Type a
_         -> (a -> Init) -> [a] -> [Init]
forall a b. (a -> b) -> [a] -> [b]
map (Expr -> Init
C.InitExpr (Expr -> Init) -> (a -> Expr) -> a -> Init
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type a -> a -> Expr
forall a. Type a -> a -> Expr
constty Type a
ty) [a]
xs


explicitty :: Type a -> C.Expr -> C.Expr
explicitty :: 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)

-- | Translate a Copilot type to a C99 type.
transtype :: Type a -> C.Type
transtype :: Type a -> Type
transtype Type a
ty = case Type a
ty of
  Type a
Bool      -> TypeSpec -> Type
C.TypeSpec (TypeSpec -> Type) -> TypeSpec -> Type
forall a b. (a -> b) -> a -> b
$ Name -> TypeSpec
C.TypedefName Name
"bool"
  Type a
Int8      -> TypeSpec -> Type
C.TypeSpec (TypeSpec -> Type) -> TypeSpec -> Type
forall a b. (a -> b) -> a -> b
$ Name -> TypeSpec
C.TypedefName Name
"int8_t"
  Type a
Int16     -> TypeSpec -> Type
C.TypeSpec (TypeSpec -> Type) -> TypeSpec -> Type
forall a b. (a -> b) -> a -> b
$ Name -> TypeSpec
C.TypedefName Name
"int16_t"
  Type a
Int32     -> TypeSpec -> Type
C.TypeSpec (TypeSpec -> Type) -> TypeSpec -> Type
forall a b. (a -> b) -> a -> b
$ Name -> TypeSpec
C.TypedefName Name
"int32_t"
  Type a
Int64     -> TypeSpec -> Type
C.TypeSpec (TypeSpec -> Type) -> TypeSpec -> Type
forall a b. (a -> b) -> a -> b
$ Name -> TypeSpec
C.TypedefName Name
"int64_t"
  Type a
Word8     -> TypeSpec -> Type
C.TypeSpec (TypeSpec -> Type) -> TypeSpec -> Type
forall a b. (a -> b) -> a -> b
$ Name -> TypeSpec
C.TypedefName Name
"uint8_t"
  Type a
Word16    -> TypeSpec -> Type
C.TypeSpec (TypeSpec -> Type) -> TypeSpec -> Type
forall a b. (a -> b) -> a -> b
$ Name -> TypeSpec
C.TypedefName Name
"uint16_t"
  Type a
Word32    -> TypeSpec -> Type
C.TypeSpec (TypeSpec -> Type) -> TypeSpec -> Type
forall a b. (a -> b) -> a -> b
$ Name -> TypeSpec
C.TypedefName Name
"uint32_t"
  Type a
Word64    -> TypeSpec -> Type
C.TypeSpec (TypeSpec -> Type) -> TypeSpec -> Type
forall a b. (a -> b) -> a -> b
$ Name -> TypeSpec
C.TypedefName Name
"uint64_t"
  Type a
Float     -> TypeSpec -> Type
C.TypeSpec TypeSpec
C.Float
  Type a
Double    -> TypeSpec -> Type
C.TypeSpec TypeSpec
C.Double
  Array Type t
ty' -> Type -> Maybe Expr -> Type
C.Array (Type t -> Type
forall a. Type a -> Type
transtype Type t
ty') Maybe Expr
length where
    length :: Maybe Expr
length = Expr -> Maybe Expr
forall a. a -> Maybe a
Just (Expr -> Maybe Expr) -> Expr -> Maybe Expr
forall a b. (a -> b) -> a -> b
$ Integer -> Expr
C.LitInt (Integer -> Expr) -> Integer -> Expr
forall a b. (a -> b) -> a -> b
$ Id -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Id -> Integer) -> Id -> Integer
forall a b. (a -> b) -> a -> b
$ Type (Array n t) -> Id
forall (n :: Nat) t. KnownNat n => Type (Array n t) -> Id
tylength Type a
Type (Array n t)
ty
  Struct a
s  -> TypeSpec -> Type
C.TypeSpec (TypeSpec -> Type) -> TypeSpec -> Type
forall a b. (a -> b) -> a -> b
$ Name -> TypeSpec
C.Struct (a -> Name
forall a. Struct a => a -> Name
typename a
s)

-- | Translate a Copilot type intro a C typename
transtypename :: Type a -> C.TypeName
transtypename :: Type a -> TypeName
transtypename Type a
ty = Type -> TypeName
C.TypeName (Type -> TypeName) -> Type -> TypeName
forall a b. (a -> b) -> a -> b
$ Type a -> Type
forall a. Type a -> Type
transtype Type a
ty