Permalink
Browse files

Merge branch 'development' of github.com:leepike/Copilot into develop…

…ment
  • Loading branch information...
2 parents ef88edc + edff052 commit 98504dac976b7098c06034b3b583acc635037ec0 @leepike committed Jun 7, 2011
View
@@ -6,18 +6,18 @@ module Language.Copilot.AdHocC (
, includeBracket, includeQuote, printf, printfNewline
) where
-import Data.List (intersperse)
+import Data.List (intersperse)
import Language.Atom (Type(..))
import Language.Atom.Code (cType) -- C99
-- | Takes a type and a list of variable names and declares them.
varDecl :: Type -> [String] -> String
-varDecl t vars =
+varDecl t vars =
cType t ++ " " ++ unwords (intersperse "," vars) ++ ";"
-- | Takes a type and a list of array names and their sizes declares them.
arrDecl :: Type -> [(String, Int)] -> String
-arrDecl t arrs =
+arrDecl t arrs =
cType t ++ " " ++ unwords (intersperse "," mkArrs) ++ ";"
where mkArrs = map (\(a,size) -> a ++ "[" ++ show size ++ "]") arrs
@@ -29,10 +29,10 @@ varInit t var val = cType t ++ " " ++ var ++ " = " ++ show val ++ ";"
-- | Takes a type and an array and initializes it. It is YOUR responsibility to
-- ensure that @vals@ is of type @t@.
arrayInit :: Show a => Type -> String -> [a] -> String
-arrayInit t var vals =
+arrayInit t var vals =
cType t ++ " " ++ var ++ "[" ++ show (length vals)
++ "] = " ++ bracesListShow ++ ";"
- where
+ where
-- Show a list with braces {} rather than brackets [].
bracesListShow :: String
bracesListShow =
@@ -59,8 +59,8 @@ printfPre :: String -> String
printfPre = ("printf(\"" ++)
printfPost :: [String] -> String
-printfPost vars =
- let sep = if null vars then " " else ", "
+printfPost vars =
+ let sep = if null vars then " " else ", "
in "\"" ++ sep ++ unwords (intersperse "," vars) ++ ");"
newline :: String
@@ -310,8 +310,9 @@ checkInitsArgs streams =
(_, Fun _ args, _) ->
mapMaybe (\arg ->
case arg of
- C _ -> Nothing
V v0 -> Just v0
+ C _ -> Nothing
+ S _ -> Nothing
) args
(_, ExtV _, _) -> [])
(getExternalVars streams)
@@ -320,7 +321,9 @@ checkInitsArgs streams =
(_,_,ExtRetA idx) ->
case idx of
V v' -> Just v'
- C _ -> Nothing)
+ C _ -> Nothing
+ S _ -> Nothing
+ )
(getExternalVars streams)
in foldStreamableMaps checkInits streams Nothing
@@ -412,7 +415,6 @@ checkVarName varName =
let checkVarName' = nondigit
>> many ( nondigit <|> digit )
>> eof
- >> return ()
nondigit = char '_' <|> letter
in
case parse checkVarName' varName varName of
@@ -1,49 +1,70 @@
{-# LANGUAGE ScopedTypeVariables #-}
-- | Defines a main() and print statements to easily execute generated Copilot specs.
-module Language.Copilot.AtomToC(getPrePostCode) where
+module Language.Copilot.AtomToC(getPrePostCode, preHCode, AtomToC(..)) where
import Language.Copilot.AdHocC
import Language.Copilot.Core
-import Language.Atom (Type(Bool))
+import Language.Atom (Type(Bool), Clock)
import Data.Maybe (fromMaybe)
import Data.List
+-- | Datatype corresponding to the 'Options' datatype in 'Interface.hs', but
+-- only including the compilation-relevant fields.
+data AtomToC = AtomToC
+ { cName :: Name -- ^ Name of the C file to generate
+ , gccOpts :: String -- ^ Options to pass to the compiler
+ , getPeriod :: Maybe Period -- ^ The optional period
+ , outputDir :: String -- ^ Where to put the executable
+ , compiler :: String -- ^ Which compiler to use
+ , randomProg :: Bool -- ^ Was the program randomly generated?
+ , sim :: Bool -- ^ Are we running a C simulator?
+ , prePostCode :: (Maybe String, Maybe String) -- ^ Code to replace the default
+ -- initialization and main
+ , arrDecs :: [(String, Int)] -- ^ When generating C programs to test, we
+ -- don't know how large external arrays are, so
+ -- we cannot declare them. Passing in pairs
+ -- containing the name of the array and it's
+ -- size allows them to be declared.
+ , clock :: Maybe Clock -- ^ Use the hardware clock to drive the timing
+ -- of the program.
+ }
+
-- allExts represents all the variables to monitor (used for declaring them)
-- inputExts represents the monitored variables which are to be fed to the
-- standard input of the C program. only used for the testing with random
-- streams and values.
-getPrePostCode :: Bool -> (Maybe String, Maybe String) -> Name
- -> StreamableMaps Spec -> [Exs] -> [(Ext,Int)] -> SimValues
+getPrePostCode :: Bool -> (Maybe String, Maybe String) -> Name
+ -> StreamableMaps Spec -> [Exs] -> [(Ext,Int)] -> SimValues
-> Period -> (String, String)
-getPrePostCode simulatation (pre, post) cName streams allExts
- arrDecs inputExts p =
- ( (if simulatation then preCode (extDecls allExts arrDecs)
+getPrePostCode simulatation (pre, post) cname streams allExts
+ arrdecs inputExts p =
+ ( (if simulatation then preCode (extDecls allExts arrdecs)
else "") ++ fromMaybe "" pre
- , fromMaybe "" post ++ periodLoop cName p
- ++ if simulatation then (postCode cName streams inputExts)
+ , fromMaybe "" post ++ periodLoop cname p
+ ++ if simulatation then (postCode cname streams inputExts)
else ""
)
-- Make the declarations for external vars
extDecls :: [Exs] -> [(Ext,Int)] -> [String]
-extDecls allExtVars arrDecs =
- let uniqueExtVars = nubBy (\ (x, y, _) (x', y', _) -> x == x' && y == y')
- allExtVars
+extDecls allExtVars arrdecs =
+ let uniqueExtVars = nubBy (\ (x, y, _) (x', y', _) -> x == x' && y == y')
+ allExtVars
getDec :: Exs -> String
getDec (t, (ExtV v), ExtRetV) = varDecl t [v]
getDec (_, (Fun _ _), ExtRetV) = ""
- getDec (t, arr, ExtRetA _) =
- case getIdx arr of
+ getDec (t, arr, ExtRetA _) =
+ 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 " ++
show arr ++ "."
- Just idx -> arrDecl t [(show arr, idx)]
- getIdx arr = lookup arr arrDecs
- in
+ Just idx -> arrDecl t [(show arr, idx)]
+ getIdx arr = lookup arr arrdecs
+ in
map getDec uniqueExtVars
preCode :: [String] -> String
@@ -57,23 +78,28 @@ preCode extDeclarations = unlines $
]
++ extDeclarations
--- | Generate a temporary C file name.
+-- | Export the period loop function in the header file
+preHCode :: String -> String
+preHCode cname =
+ "void " ++ tmpCFileName cname ++ " ();\n"
+
+-- | Generate a temporary C file name.
tmpCFileName :: String -> String
tmpCFileName name = "__" ++ name
periodLoop :: Name -> Period -> String
-periodLoop cName p = unlines
+periodLoop cname p = unlines
[ "\n"
- , "void " ++ tmpCFileName cName ++ "(void) {"
+ , "void " ++ tmpCFileName cname ++ "(void) {"
, " int i;"
, " for(i = 0; i < " ++ show p ++ "; i++) {"
- , " " ++ cName ++ "();"
+ , " " ++ cname ++ "();"
, " }"
, "}"
]
postCode :: Name -> StreamableMaps Spec -> SimValues -> String
-postCode cName streams inputExts =
+postCode cname streams inputExts =
unlines $
[""] ++
-- (if isEmptySM inputExts
@@ -82,7 +108,7 @@ postCode cName streams inputExts =
-- make a loop to complete a period of computation.
[ "int main(int argc, char *argv[]) {"
, " if (argc != 2) {"
- , " " ++ printfNewline
+ , " " ++ printfNewline
( "Please pass a single argument to the simulator"
++ " containing the number of rounds to execute it.")
[]
@@ -95,9 +121,9 @@ postCode cName streams inputExts =
, " " ++ printf "period: %i " ["i"]
]
++ inputExtVars inputExts " "
- ++ [" " ++ tmpCFileName cName ++ "();"]
- ++ outputVars cName streams
- ++
+ ++ [" " ++ tmpCFileName cname ++ "();"]
+ ++ outputVars cname streams
+ ++
[ " }"
, " //Important to let the Haskell program know we're done with stdout."
, " " ++ printfNewline "" []
@@ -112,30 +138,30 @@ inputExtVars exts indent =
where
decl :: Streamable a => Var -> [a] -> [String] -> [String]
decl v l ls =
- let spec = if null l then error "Impossible error in inputExtVars"
+ let spec = if null l then error "Impossible error in inputExtVars"
else head l
- (frmt, mMacro) = scnId spec
+ (frmt, mMacro) = scnId spec
aBool = atomType spec == Bool
mTmp = if aBool then "__tmpCopilotBool_" ++ v else v
- scan = indent ++ "scanf(" ++ "\"" ++ frmt ++ "\"" ++ mMacro
+ scan = indent ++ "scanf(" ++ "\"" ++ frmt ++ "\"" ++ mMacro
++ ", " ++ "&" ++ mTmp ++ ");" in
- (if aBool
+ (if aBool
then indent ++"//We can't scanf directly into a Bool, "
- ++ "so we get an int then cast.\n"
+ ++ "so we get an int then cast.\n"
++ (indent ++ "int " ++ mTmp ++ ";\n")
++ scan ++ "\n"
++ indent ++ v ++ " = (bool) " ++ mTmp ++ ";"
-
+
else scan) : ls
-- | Print the Copilot stream values to standard out.
outputVars :: Name -> StreamableMaps Spec -> [String]
-outputVars cName streams =
+outputVars cname streams =
foldStreamableMaps decl streams []
where
decl :: forall a. Streamable a => Var -> Spec a -> [String] -> [String]
decl v _ ls =
- let (frmt, mMacro) = prtIdPrec (unit::a)
- prtf = printf (v ++ ": " ++ frmt ++ "\" " ++ mMacro ++ "\" ")
- [vPre cName ++ v] in
+ let (frmt, mMacro) = prtIdPrec (unit::a)
+ prtf = printf (v ++ ": " ++ frmt ++ "\" " ++ mMacro ++ "\" ")
+ [vPre cname ++ v] in
(" " ++ prtf) : ls
Oops, something went wrong.

0 comments on commit 98504da

Please sign in to comment.