module Language.Copilot.AtomToC(getPrePostCode) where
import Language.Copilot.Compiler (tmpSampleStr)
import Language.Copilot.AdHocC
import Language.Copilot.Core
import Language.Copilot.Analyser (ExtVars(..))
import qualified Language.Atom as A
import Data.List
getPrePostCode :: Name -> StreamableMaps Spec -> [(A.Type, Var, ExtVars)]
-> [(String,Int)] -> Vars -> Period -> (String, String)
getPrePostCode cName streams allExts arrDecs inputExts p =
(preCode $ extDecls allExts arrDecs, postCode cName streams allExts inputExts p)
extDecls :: [(A.Type, Var, ExtVars)] -> [(String,Int)] -> [String]
extDecls allExtVars arrDecs =
let uniqueExtVars = nubBy (\ (x, y, _) (x', y', _) -> x == x' && y == y') allExtVars
getDec (t, v, ExtV _) = varDecl t [v]
getDec (t, arr, ExtA _ _) =
case getIdx arr of
Nothing -> error $ "Please use the setArrs option to provide a list of " ++
"pairs (a,idx) where a is the name of an external array and idx " ++
"is its static size to declare. There is no size for array " ++
arr ++ "."
Just idx -> arrDecl t [(arr, idx)]
getIdx arr = lookup arr arrDecs
in
map getDec uniqueExtVars
preCode :: [String] -> String
preCode extDeclarations = unlines $
[ includeBracket "stdio.h"
, includeBracket "stdlib.h"
, includeBracket "string.h"
, includeBracket "inttypes.h"
, ""
, "unsigned long long rnd;"
]
++ extDeclarations
vPre :: Name -> String
vPre cName = "copilotState" ++ cName ++ "." ++ cName ++ "."
postCode :: Name -> StreamableMaps Spec -> [(A.Type, Var, ExtVars)] -> Vars -> Period -> String
postCode cName streams allExts inputExts p =
unlines $
(if isEmptySM inputExts
then []
else cleanString)
++
[ "// #pragma GCC diagnostic ignored \"-Wformat\""
, "int main(int argc, char *argv[]) {"
, " if (argc != 2) {"
, " " ++ printfNewline
"Please pass a single argument to the simulator containing the number of rounds to execute it."
[]
, " return 1;"
, " }"
, " rnd = atoi(argv[1]);"
]
++
inputExtVars inputExts " "
++
sampleExtVars allExts cName
++
[ " int i = 0;"
, " for(; i < rnd ; i++) {"
]
++
inputExtVars inputExts " "
++
[ " int j = 0;"
, " for (; j < " ++ show p ++ " ; j++) {"
, " " ++ cName ++ "();"
, " }"
, " " ++ printf "period: %i " ["i"]
]
++
outputVars cName streams
++
[ " " ++ printfNewline "" []
, " fflush(stdout);"
, " }"
, " return EXIT_SUCCESS;"
, "}"
]
where
cleanString =
[ "void clean(const char *buffer, FILE *fp) {"
, " char *p = strchr(buffer,'\\n');"
, " if (p != NULL)"
, " *p = 0;"
, " else {"
, " int c;"
, " while ((c = fgetc(fp)) != '\\n' && c != EOF);"
, " }"
, "}"
, ""
]
inputExtVars :: Vars -> String -> [String]
inputExtVars exts indent =
foldStreamableMaps decl exts []
where
decl :: Streamable a => Var -> [a] -> [String] -> [String]
decl v l ls =
let string = "string_" ++ v in
(indent ++ "char " ++ string ++ " [50] = \"\";") :
(indent ++ "fgets (" ++ string ++ ", sizeof(" ++ string
++ "), stdin);") :
(indent ++ "sscanf (" ++ string ++ ", \""
++ typeId (head l) ++ "\", &" ++ v ++ ");") :
(indent ++ "clean (" ++ string ++ ", stdin);") : ls
sampleExtVars :: [(A.Type, Var, ExtVars)] -> Name -> [String]
sampleExtVars allExts cName =
map (\ext -> let (v,e) = sample ext in
" " ++ vPre cName ++ tmpSampleStr ++ e
++ " = " ++ v ++ ";")
allExts
where
sample :: (A.Type, Var, ExtVars) -> (Var, String)
sample (_, v, ExtV ph) = (v, tmpVarName v ph)
sample (_, v, ExtA ph idx) = (v ++ "[0]", tmpArrName v ph idx)
outputVars :: Name -> StreamableMaps Spec -> [String]
outputVars cName streams =
foldStreamableMaps decl streams []
where
decl :: forall a. Streamable a
=> Var -> Spec a -> [String] -> [String]
decl v _ ls =
(" " ++ printf (v ++ ": " ++ typeIdPrec (unit::a) ++ " ")
[vPre cName ++ "outputVal__" ++ v]) : ls