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

…ment
leepike · Jun 7, 2011 · 98504da · 98504da
2 parents ef88edc + edff052
commit 98504da
Show file tree

Hide file tree

Showing 17 changed files with 686 additions and 505 deletions.
diff --git a/Language/Copilot/AdHocC.hs b/Language/Copilot/AdHocC.hs
@@ -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

diff --git a/Language/Copilot/Analyser.hs b/Language/Copilot/Analyser.hs
@@ -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

diff --git a/Language/Copilot/AtomToC.hs b/Language/Copilot/AtomToC.hs
@@ -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