module Feldspar.Compiler.Imperative.Plugin.Naming where
import Data.Char
import Feldspar.Transformation
import Feldspar.Core.Types
import qualified Feldspar.NameExtractor as Precompiler
import Feldspar.Compiler.Error
import Feldspar.Compiler.Backend.C.Library
import System.IO.Unsafe
data SignatureInformation = SignatureInformation {
originalFunctionName :: String,
generatedImperativeParameterNames :: [String],
originalParameterNames :: Maybe [Maybe String]
} deriving (Show, Eq)
instance Default SignatureInformation where def = precompilationError InternalError "Default value should not be used"
precompilationError = handleError "PluginArch/Naming"
data Precompilation = Precompilation
instance Transformation Precompilation where
type From Precompilation = ()
type To Precompilation = ()
type Down Precompilation = SignatureInformation
type Up Precompilation = ()
type State Precompilation = ()
instance Transformable Precompilation Definition where
transform t s d x@(Procedure n i _ _ _ _) | n == "PLACEHOLDER" = tr { result = (result tr){ procName = n' } } where
d' = d { generatedImperativeParameterNames = map varName i }
tr = defaultTransform t s d' x
n' = originalFunctionName d
transform t s d x = defaultTransform t s d x
instance Transformable Precompilation Variable where
transform t s d v = Result newVar s def where
newVar = v
{ varName = (maybeStr2Str $ getVariableName d (varName v)) ++ varName v
, varLabel = ()
}
getVariableName :: SignatureInformation -> String -> Maybe String
getVariableName signatureInformation origname = case (originalParameterNames signatureInformation) of
Just originalParameterNameList ->
if length (generatedImperativeParameterNames signatureInformation) == length originalParameterNameList then
case searchResults of
[] -> Nothing
otherwise -> snd $ head $ searchResults
else
precompilationError InternalError $ "parameter name list length mismatch:" ++
show (generatedImperativeParameterNames signatureInformation) ++ " " ++ show originalParameterNameList
where
searchResults = filter (((==) origname).fst)
(zip (generatedImperativeParameterNames signatureInformation) originalParameterNameList)
Nothing -> Nothing
maybeStr2Str :: Maybe String -> String
maybeStr2Str (Just s) = s ++ "_"
maybeStr2Str Nothing = ""
data PrecompilationExternalInfo = PrecompilationExternalInfo {
originalFunctionSignature :: Precompiler.OriginalFunctionSignature,
inputParametersDescriptor :: [Int],
numberOfFunctionArguments :: Int,
compilationMode :: CompilationMode
}
addPostfixNumberToMaybeString :: (Maybe String, Int) -> Maybe String
addPostfixNumberToMaybeString (ms, num) = case ms of
Just s -> Just $ s ++ (show num)
Nothing -> Nothing
inflate :: Int -> [Maybe String] -> [Maybe String]
inflate target list | length list < target = inflate target (list++[Nothing])
| length list == target = list
| otherwise = precompilationError InternalError "Unexpected situation in 'inflate'"
parameterNameListConsolidator :: PrecompilationExternalInfo -> [Maybe String]
parameterNameListConsolidator externalInfo =
if (numberOfFunctionArguments externalInfo == (length $ inputParametersDescriptor externalInfo))
then
concat $ map (\(cnt,name)->replicate cnt name)
(zip (inputParametersDescriptor externalInfo)
(Precompiler.originalParameterNames $ originalFunctionSignature externalInfo))
else
precompilationError InternalError "numArgs should be equal to the length of the input parameters' descriptor"
instance Plugin Precompilation where
type ExternalInfo Precompilation = PrecompilationExternalInfo
executePlugin Precompilation externalInfo procedure = result
$ transform Precompilation () (SignatureInformation {
originalFunctionName = Precompiler.originalFunctionName $ originalFunctionSignature externalInfo,
generatedImperativeParameterNames = precompilationError InternalError "GIPN should have been overwritten",
originalParameterNames = case compilationMode externalInfo of
Standalone ->
if
numberOfFunctionArguments externalInfo ==
length (Precompiler.originalParameterNames $ originalFunctionSignature externalInfo)
then
Just $ parameterNameListConsolidator externalInfo
else
(unsafePerformIO $ do
withColor Yellow $ putStrLn $ "[WARNING @ PluginArch/Naming]:"++
" not enough named parameters in function " ++
(Precompiler.originalFunctionName $ originalFunctionSignature externalInfo)
withColor Yellow $ putStrLn $ "numArgs: " ++ show (numberOfFunctionArguments externalInfo) ++
", parameter list: " ++ show (Precompiler.originalParameterNames $
originalFunctionSignature externalInfo)
return $ Just $ parameterNameListConsolidator (externalInfo {
originalFunctionSignature = (originalFunctionSignature externalInfo) {
Precompiler.originalParameterNames =
inflate (numberOfFunctionArguments externalInfo) $
Precompiler.originalParameterNames $
originalFunctionSignature externalInfo
}
})
)
Interactive -> Nothing
}) procedure