module Kempe.CGen ( cGen
                  ) where

import           Data.Maybe     (mapMaybe)
import           Kempe.AST
import           Kempe.Name
import           Language.C.AST

cGen :: Declarations a c (StackType ()) -> [CFunc]
cGen :: Declarations a c (StackType ()) -> [CFunc]
cGen = (KempeDecl a c (StackType ()) -> Maybe CFunc)
-> Declarations a c (StackType ()) -> [CFunc]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe KempeDecl a c (StackType ()) -> Maybe CFunc
forall a c. KempeDecl a c (StackType ()) -> Maybe CFunc
cDecl

cDecl :: KempeDecl a c (StackType ()) -> Maybe CFunc
cDecl :: KempeDecl a c (StackType ()) -> Maybe CFunc
cDecl ExtFnDecl{}                                        = Maybe CFunc
forall a. Maybe a
Nothing
cDecl TyDecl{}                                           = Maybe CFunc
forall a. Maybe a
Nothing
cDecl FunDecl{}                                          = Maybe CFunc
forall a. Maybe a
Nothing
cDecl (Export StackType ()
_ ABI
Cabi (Name Text
n Unique
_ (StackType Set (Name ())
_ [] [])))     = CFunc -> Maybe CFunc
forall a. a -> Maybe a
Just (Text -> [CType] -> CType -> CFunc
CFunc Text
n [CType
CVoid] CType
CVoid)
cDecl (Export StackType ()
_ ABI
Cabi (Name Text
n Unique
_ (StackType Set (Name ())
_ [] [KempeTy ()
o])))    = CFunc -> Maybe CFunc
forall a. a -> Maybe a
Just (Text -> [CType] -> CType -> CFunc
CFunc Text
n [CType
CVoid] (KempeTy () -> CType
forall a. KempeTy a -> CType
kempeTyToCType KempeTy ()
o))
cDecl (Export StackType ()
_ ABI
Cabi (Name Text
n Unique
_ (StackType Set (Name ())
_ [KempeTy ()]
ins [])))    = CFunc -> Maybe CFunc
forall a. a -> Maybe a
Just (Text -> [CType] -> CType -> CFunc
CFunc Text
n (KempeTy () -> CType
forall a. KempeTy a -> CType
kempeTyToCType (KempeTy () -> CType) -> [KempeTy ()] -> [CType]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [KempeTy ()]
ins) CType
CVoid)
cDecl (Export StackType ()
_ ABI
Cabi (Name Text
n Unique
_ (StackType Set (Name ())
_ [KempeTy ()]
ins [KempeTy ()
o])))   = CFunc -> Maybe CFunc
forall a. a -> Maybe a
Just (Text -> [CType] -> CType -> CFunc
CFunc Text
n (KempeTy () -> CType
forall a. KempeTy a -> CType
kempeTyToCType (KempeTy () -> CType) -> [KempeTy ()] -> [CType]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [KempeTy ()]
ins) (KempeTy () -> CType
forall a. KempeTy a -> CType
kempeTyToCType KempeTy ()
o))
cDecl (Export StackType ()
_ ABI
Cabi Name (StackType ())
_)                                  = [Char] -> Maybe CFunc
forall a. HasCallStack => [Char] -> a
error [Char]
"Multiple return not suppported :("
cDecl (Export StackType ()
_ ABI
ArmAbi (Name Text
n Unique
_ (StackType Set (Name ())
_ [] [])))   = CFunc -> Maybe CFunc
forall a. a -> Maybe a
Just (Text -> [CType] -> CType -> CFunc
CFunc Text
n [CType
CVoidPtr] CType
CVoid)
cDecl (Export StackType ()
_ ABI
ArmAbi (Name Text
n Unique
_ (StackType Set (Name ())
_ [] [KempeTy ()
o])))  = CFunc -> Maybe CFunc
forall a. a -> Maybe a
Just (Text -> [CType] -> CType -> CFunc
CFunc Text
n [CType
CVoidPtr] (KempeTy () -> CType
forall a. KempeTy a -> CType
kempeTyToCType KempeTy ()
o))
cDecl (Export StackType ()
_ ABI
ArmAbi (Name Text
n Unique
_ (StackType Set (Name ())
_ [KempeTy ()]
ins [])))  = CFunc -> Maybe CFunc
forall a. a -> Maybe a
Just (Text -> [CType] -> CType -> CFunc
CFunc Text
n (CType
CVoidPtr CType -> [CType] -> [CType]
forall a. a -> [a] -> [a]
: (KempeTy () -> CType) -> [KempeTy ()] -> [CType]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap KempeTy () -> CType
forall a. KempeTy a -> CType
kempeTyToCType [KempeTy ()]
ins) CType
CVoid)
cDecl (Export StackType ()
_ ABI
ArmAbi (Name Text
n Unique
_ (StackType Set (Name ())
_ [KempeTy ()]
ins [KempeTy ()
o]))) = CFunc -> Maybe CFunc
forall a. a -> Maybe a
Just (Text -> [CType] -> CType -> CFunc
CFunc Text
n (CType
CVoidPtr CType -> [CType] -> [CType]
forall a. a -> [a] -> [a]
: (KempeTy () -> CType) -> [KempeTy ()] -> [CType]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap KempeTy () -> CType
forall a. KempeTy a -> CType
kempeTyToCType [KempeTy ()]
ins) (KempeTy () -> CType
forall a. KempeTy a -> CType
kempeTyToCType KempeTy ()
o))
cDecl (Export StackType ()
_ ABI
ArmAbi Name (StackType ())
_)                                = [Char] -> Maybe CFunc
forall a. HasCallStack => [Char] -> a
error [Char]
"Multiple return not suppported :("
cDecl (Export StackType ()
_ ABI
Hooked (Name Text
n Unique
_ StackType ()
_))                     = CFunc -> Maybe CFunc
forall a. a -> Maybe a
Just (Text -> [CType] -> CType -> CFunc
CFunc Text
n [CType
CVoidPtr] CType
CVoid)
cDecl (Export StackType ()
_ ABI
Kabi Name (StackType ())
_)                                  = [Char] -> Maybe CFunc
forall a. HasCallStack => [Char] -> a
error [Char]
"You probably don't want to do this."

kempeTyToCType :: KempeTy a -> CType
kempeTyToCType :: KempeTy a -> CType
kempeTyToCType (TyBuiltin a
_ BuiltinTy
TyInt)  = CType
CInt
kempeTyToCType (TyBuiltin a
_ BuiltinTy
TyBool) = CType
CBool
kempeTyToCType (TyBuiltin a
_ BuiltinTy
TyWord) = CType
CUInt64
kempeTyToCType (TyBuiltin a
_ BuiltinTy
TyInt8) = CType
CInt8
kempeTyToCType TyVar{}              = [Char] -> CType
forall a. HasCallStack => [Char] -> a
error [Char]
"Don't do that"
kempeTyToCType TyApp{}              = [Char] -> CType
forall a. HasCallStack => [Char] -> a
error [Char]
"User-defined types cannot be exported :("
kempeTyToCType TyNamed{}            = [Char] -> CType
forall a. HasCallStack => [Char] -> a
error [Char]
"User-defined types cannot be exported :("