-- | Naming of variables and functions in Bluespec.
module Copilot.Compile.Bluespec.Name
  ( argNames
  , generatorName
  , guardName
  , ifcArgName
  , indexName
  , lowercaseName
  , specIfcName
  , specIfcPkgName
  , specTypesPkgName
  , streamAccessorName
  , streamElemName
  , streamName
  , uppercaseName
  ) where

-- External imports
import Data.Char (isLower, isUpper)

-- External imports: Copilot
import Copilot.Core (Id)

-- | Turn a specification name into the name of its module interface.
specIfcName :: String -> String
specIfcName :: String -> String
specIfcName String
prefix = String -> String
uppercaseName (String -> String
specIfcPkgName String
prefix)

-- | Turn a specification name into the name of the package that declares its
-- module interface. Note that 'specIfcPkgName' is not necessarily the same name
-- as 'specIfcName', as the former does not need to begin with an uppercase
-- letter, but the latter does.
specIfcPkgName :: String -> String
specIfcPkgName :: String -> String
specIfcPkgName String
prefix = String
prefix String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"Ifc"

-- | Turn a specification name into the name of the package that declares its
-- struct types.
specTypesPkgName :: String -> String
specTypesPkgName :: String -> String
specTypesPkgName String
prefix = String
prefix String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"Types"

-- | Turn a stream id into a stream element name.
streamElemName :: Id -> Int -> String
streamElemName :: Id -> Id -> String
streamElemName Id
sId Id
n = Id -> String
streamName Id
sId String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Id -> String
forall a. Show a => a -> String
show Id
n

-- | The name of the variable of type @<prefix>Ifc@. This is used to select
-- trigger functions and external variables.
ifcArgName :: String
ifcArgName :: String
ifcArgName = String
"ifc"

-- | Create a Bluespec name that must start with an uppercase letter (e.g., a
-- struct or interface name). If the supplied name already begins with an
-- uppercase letter, this function returns the name unchanged. Otherwise, this
-- function prepends a @BS_@ prefix (short for \"Bluespec\") at the front.
uppercaseName :: String -> String
uppercaseName :: String -> String
uppercaseName [] = []
uppercaseName n :: String
n@(Char
c:String
_)
  | Char -> Bool
isUpper Char
c = String
n
  | Bool
otherwise = String
"BS_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
n

-- | Create a Bluespec name that must start with a lowercase letter (e.g., a
-- function or method name). If the supplied name already begins with a
-- lowercase letter, this function returns the name unchanged. Otherwise, this
-- function prepends a @bs_@ prefix (short for \"Bluespec\") at the front.
lowercaseName :: String -> String
lowercaseName :: String -> String
lowercaseName [] = []
lowercaseName n :: String
n@(Char
c:String
_)
  | Char -> Bool
isLower Char
c = String
n
  | Bool
otherwise = String
"bs_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
n

-- | Turn a stream id into a suitable Bluespec variable name.
streamName :: Id -> String
streamName :: Id -> String
streamName Id
sId = String
"s" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Id -> String
forall a. Show a => a -> String
show Id
sId

-- | Turn a stream id into the global varname for indices.
indexName :: Id -> String
indexName :: Id -> String
indexName Id
sId = Id -> String
streamName Id
sId String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"_idx"

-- | Turn a stream id into the name of its accessor function
streamAccessorName :: Id -> String
streamAccessorName :: Id -> String
streamAccessorName Id
sId = Id -> String
streamName Id
sId String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"_get"

-- | Turn stream id into name of its generator function.
generatorName :: Id -> String
generatorName :: Id -> String
generatorName Id
sId = Id -> String
streamName Id
sId String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"_gen"

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

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

-- | Enumerate all argument names based on trigger name.
argNames :: String -> [String]
argNames :: String -> [String]
argNames String
base = (Id -> String) -> [Id] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Id -> String
argName String
base) [Id
0..]