-- | Auxiliary helper functions to generate C99 code.
module Copilot.Compile.C99.Util where

import Control.Monad.State

import Copilot.Core  (Id)
import qualified Language.C99.Simple.AST as C

-- | Auxiliary type used to collect all the declarations of all the variables
-- used in a function to be generated, since variable declarations are always
-- listed first at the top of the function body.
type FunEnv = [C.Decln]

-- | `tell` equivalent for `State`.
statetell :: Monoid m => m -> State m ()
statetell :: forall m. Monoid m => m -> State m ()
statetell m
m = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Monoid a => a -> a -> a
mappend) m
m)

-- | Generate fresh variable name based on a given one.
fresh :: String -> [String] -> String
fresh :: String -> [String] -> String
fresh String
name [String]
used = forall a. [a] -> a
head forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem [String]
used) (String
nameforall a. a -> [a] -> [a]
:[String]
freshnames)
  where
    freshnames :: [String]
freshnames = (String
name forall a. [a] -> [a] -> [a]
++)forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a. Show a => a -> String
show forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Integer
0..]

-- | Collect all the names from a list of C99 declarations.
names :: [C.Decln] -> [String]
names :: [Decln] -> [String]
names [Decln]
ds = forall a b. (a -> b) -> [a] -> [b]
map Decln -> String
match [Decln]
ds
  where
    match :: Decln -> String
match (C.VarDecln Maybe StorageSpec
_ Type
_ String
name Maybe Init
_) = String
name

-- | Turn a stream id into a suitable C variable name.
streamname :: Id -> String
streamname :: Int -> String
streamname Int
sid = String
"s" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
sid

-- | Turn a stream id into the global varname for indices.
indexname :: Id -> String
indexname :: Int -> String
indexname Int
sid = Int -> String
streamname Int
sid forall a. [a] -> [a] -> [a]
++ String
"_idx"

-- | Turn a stream id into the name of its accessor function
streamaccessorname :: Id -> String
streamaccessorname :: Int -> String
streamaccessorname Int
sid = Int -> String
streamname Int
sid forall a. [a] -> [a] -> [a]
++ String
"_get"

-- | Add a postfix for copies of external variables the name.
excpyname :: String -> String
excpyname :: String -> String
excpyname String
name = String
name forall a. [a] -> [a] -> [a]
++ String
"_cpy"

-- | Turn stream id into name of its generator function.
generatorname :: Id -> String
generatorname :: Int -> String
generatorname Int
sid = Int -> String
streamname Int
sid forall a. [a] -> [a] -> [a]
++ String
"_gen"

-- | Turn stream id into name of its output argument array.
generatorOutputArgName :: Id -> String
generatorOutputArgName :: Int -> String
generatorOutputArgName Int
sid = Int -> String
streamname Int
sid forall a. [a] -> [a] -> [a]
++ String
"_output"

-- | Turn the name of a trigger into a guard generator.
guardname :: String -> String
guardname :: String -> String
guardname String
name = String
name forall a. [a] -> [a] -> [a]
++ String
"_guard"

-- | Turn a trigger name into a an trigger argument name.
argname :: String -> Int -> String
argname :: String -> Int -> String
argname String
name Int
n = String
name forall a. [a] -> [a] -> [a]
++ String
"_arg" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
n

-- | Turn a handler function name into a name for a temporary variable for a
-- handler argument.
argTempName :: String -> Int -> String
argTempName :: String -> Int -> String
argTempName String
name Int
n = String
name forall a. [a] -> [a] -> [a]
++ String
"_arg_temp" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
n

-- | Enumerate all argument names based on trigger name.
argnames :: String -> [String]
argnames :: String -> [String]
argnames String
base = [String
aname | Int
n <- [Int
0..], let aname :: String
aname = String -> Int -> String
argname String
base Int
n]

-- | Enumerate all temporary variable names based on handler function name.
argTempNames :: String -> [String]
argTempNames :: String -> [String]
argTempNames String
base = forall a b. (a -> b) -> [a] -> [b]
map (String -> Int -> String
argTempName String
base) [Int
0..]

-- | Define a C expression that calls a function with arguments.
funcall :: C.Ident -> [C.Expr] -> C.Expr
funcall :: String -> [Expr] -> Expr
funcall String
name [Expr]
args = Expr -> [Expr] -> Expr
C.Funcall (String -> Expr
C.Ident String
name) [Expr]
args