copilot-c99 0.2 → 0.2.1

raw patch · 4 files changed

+128/−44 lines, 4 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• copilot-c99.cabal +1/−1
• src/Copilot/Compile/C99/Test/CheckSpec.hs +27/−17
• src/Copilot/Compile/C99/Test/Driver.hs +84/−18
• test/CopilotC99Test.hs +16/−8

@@ -1,6 +1,6 @@ cabal-version             : >= 1.10 name                      : copilot-c99-version                   : 0.2+version                   : 0.2.1 synopsis                  : A compiler for Copilot targeting C99. description               : This is a back-end from Copilot to the Atom DSL. Please see README.mk for more details. license                   : BSD3

@@ -4,7 +4,7 @@  module Copilot.Compile.C99.Test.CheckSpec (checkSpec) where -import Copilot.Core (Spec)+import Copilot.Core ( Spec (..)) import Copilot.Core.Interpret.Eval (eval, ExtEnv(..)) import Copilot.Compile.C99 (compile) import Copilot.Compile.C99.Params (Params (..), defaultParams)@@ -15,7 +15,6 @@  import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as B-import qualified Data.Map as M import qualified Data.Text.IO as TIO import System.Directory (removeFile) import System.Process (system, readProcess)@@ -24,22 +23,20 @@  -------------------------------------------------------------------------------- -checkSpec :: Int -> Spec -> IO Bool-checkSpec numIterations spec = do-  genCFiles numIterations spec+checkSpec :: Int -> ExtEnv -> Spec -> IO Bool+checkSpec numIterations env spec = do+  genCFiles numIterations env spec   compileCFiles   csv <- execute numIterations   let is1 = iterationsFromCSV csv     -  let is2 = interp numIterations spec-  -- print is1-  -- print "..."-  -- print is2+  let is2 = interp numIterations env spec   let eq = is1 == is2   unless eq (putStrLn $ showCompare is1 is2)-  -- Keep things around if there's a failure-  when eq cleanUp+  when eq cleanUp -- Keep things around if there's a failure   return eq +--------------------------------------------------------------------------------+ showCompare :: [Iteration] -> [Iteration] -> String showCompare s1 s2 =   render $ text "From C:" <+> text "---" <+> text "From Interpreter:" $$ @@ -48,25 +45,35 @@   zipped  = zip (toDoc s1) (toDoc s2)   toDoc   = map (text . show)  -genCFiles :: Int -> Spec -> IO ()-genCFiles numIterations spec = do+--------------------------------------------------------------------------------++genCFiles :: Int -> ExtEnv -> Spec -> IO ()+genCFiles numIterations env spec = do   compile (defaultParams { prefix = Nothing, verbose = False }) spec-  TIO.writeFile "driver.c" (driver M.empty numIterations spec)+  TIO.writeFile "driver.c" (driver numIterations env spec)   return () +--------------------------------------------------------------------------------+ compileCFiles :: IO () compileCFiles = do   _ <- system $ "gcc copilot.c driver.c -o _test"   return () +--------------------------------------------------------------------------------+ execute :: Int -> IO ByteString execute _ = do   fmap B.pack (readProcess "./_test" [] "") -interp :: Int -> Spec -> [Iteration]-interp numIterations = -  execTraceToIterations . eval C numIterations (ExtEnv [] [] [])+-------------------------------------------------------------------------------- +interp :: Int -> ExtEnv -> Spec -> [Iteration]+interp numIterations env = +  execTraceToIterations . eval C numIterations env ++--------------------------------------------------------------------------------+ cleanUp :: IO () cleanUp = do   removeFile "copilot.c"@@ -74,3 +81,6 @@   removeFile "driver.c"   removeFile "_test"   return ()++--------------------------------------------------------------------------------+

@@ -9,23 +9,31 @@   ) where  import Copilot.Core-  (Spec (..), Trigger (..), UExpr (..), Type (..), UType (..))+  ( Spec (..), Trigger (..), UExpr (..), Type (..), UType (..), Name+  )+import Copilot.Core.Type.Dynamic (DynamicF (..))+import Copilot.Core.Type.Show (showWithType, ShowType (..))+import Copilot.Core.Interpret.Eval (ExtEnv(..)) import Data.List (intersperse)-import Data.Map (Map) import Data.Text (Text) import Data.Text (pack) import Text.PrettyPrint-  (Doc, ($$), (<>), (<+>), nest, text, empty, render, vcat, hcat)+  ( Doc, ($$), (<>), (<+>), nest, text, empty, render, vcat+  , hcat, space, equals, semi, lbrack, rbrack, comma+  , punctuate, hsep, lbrace, rbrace) -type ExternalEnv = Map String (UType, [Int])+-------------------------------------------------------------------------------- -driver :: ExternalEnv -> Int -> Spec -> Text-driver _ numIterations Spec { specTriggers = trigs } =+driver :: Int -> ExtEnv -> Spec -> Text+driver numIterations env Spec { specTriggers = trigs } =   pack $ render $     ppHeader $$-    ppMain numIterations $$+    ppEnvDecls numIterations env $$+    ppMain numIterations env $$     ppTriggers trigs +--------------------------------------------------------------------------------+ ppHeader :: Doc ppHeader =   vcat $@@ -35,24 +43,70 @@     , text "#include \"copilot.h\""     ] -ppMain :: Int -> Doc-ppMain numIterations =+--------------------------------------------------------------------------------++ppEnvDecls :: Int -> ExtEnv -> Doc+ppEnvDecls numIterations ExtEnv { varEnv = vars } = +  vcat $  +    [ space  +    , text "// External variables" +    , vcat $ map ppEnvDecl vars+    , space+    , text "// External values" +    , vcat $ map ppVals vars+    , space+    , space+    ]++  where+  ppEnvDecl :: (Name, DynamicF [] Type) -> Doc+  ppEnvDecl (name, DynamicF _ t) = +    cType <+> text name <> semi+    where+    cType = ppUType UType { uTypeType = t }++  ppVals :: (Name, DynamicF [] Type) -> Doc+  ppVals (name, DynamicF vals t) = +    cType <+> valsName name +      <> lbrack <> (text . show) numIterations <> rbrack +      <+> equals <+> lbrace <+> arrVals <+> rbrace <> semi+    where+    cType = ppUType UType { uTypeType = t }+    arrVals = hsep $ punctuate comma $ map text showVals+    showVals = map (showWithType C t) vals++--------------------------------------------------------------------------------++valsName :: Name -> Doc+valsName name = text name <> text "_vals" ++--------------------------------------------------------------------------------++ppMain :: Int -> ExtEnv -> Doc+ppMain numIterations ExtEnv { varEnv = vars } =   vcat $     [ text "int main(int argc, char const *argv[]) {"-    , text "  int i, k;"-    , text "  k = " <> text (show $ numIterations + 1) <> text ";"-    , text "  for (i = 1; i < k; i++) {"-    , text "    " <> it -    , text "    if (i < k-1) printf(\"#\\n\");"+    , text "  int i;"+    , text "  for (i = 0; i < " <> rnds <> text "; i++) {"+    , space+    , vcat $ map (nest 3) $ map assignVals vars+    , space+    , text "    if (i > 0) printf(\"#\\n\");"+    , text "    " <> text "step();"     , text "  }"     , text "  return 0;"     , text "}"+    , space     ]    where+  rnds = text $ show numIterations+  assignVals :: (Name, DynamicF [] Type) -> Doc+  assignVals (name, _) = +    text name <+> equals <+> +      valsName name <> lbrack <> text "i" <> rbrack <> semi -    it :: Doc-    it = text "step();"+--------------------------------------------------------------------------------  ppTriggers :: [Trigger] -> Doc ppTriggers = foldr ($$) empty . map ppTrigger@@ -75,6 +129,8 @@     , text "}"     ] +--------------------------------------------------------------------------------+ ppPrintf :: String -> [UExpr] -> Doc ppPrintf name args =   text "printf(\"" <>@@ -85,6 +141,8 @@   ppArgs args <>   text ")" +--------------------------------------------------------------------------------+ ppFormats :: [UExpr] -> Doc ppFormats   = vcat@@ -92,6 +150,8 @@   . map (text "%\"" <>)   . map ppFormat +--------------------------------------------------------------------------------+ ppPars :: [UExpr] -> Doc ppPars   = vcat@@ -107,6 +167,8 @@       { uExprType = t } ->           ppUType (UType t) <+> text ("t" ++ show k) +--------------------------------------------------------------------------------+ ppArgs :: [UExpr] -> Doc ppArgs args   = vcat@@ -119,6 +181,8 @@   ppArg :: Int -> Doc   ppArg k = text ("t" ++ show k) +--------------------------------------------------------------------------------+ ppUType :: UType -> Doc ppUType UType { uTypeType = t } = text $ typeSpec' t @@ -136,6 +200,8 @@   typeSpec' Float  = "float"   typeSpec' Double = "double" +--------------------------------------------------------------------------------+ ppFormat :: UExpr -> Doc ppFormat   UExpr { uExprType = t } =@@ -152,5 +218,5 @@     Float  -> "\"f\""     Double -> "\"lf\"" ---ppExterns :: ---ppExterns = undefined+--------------------------------------------------------------------------------+

@@ -7,11 +7,13 @@ module Main (main) where  import Copilot.Core.PrettyPrint (prettyPrint)-import Copilot.Core.Random (randomSpec)+import Copilot.Core.Random (randomSpec, randomExtVals) import Copilot.Core.Random.Weights (Weights (..), simpleWeights) import Copilot.Compile.C99.Test.CheckSpec (checkSpec)+ import Prelude import System.Random+import Control.Monad (when, unless)  myWeights :: Weights myWeights =@@ -27,24 +29,30 @@     , divModFreq   = False     } +-- XXX we'll make this a parameter at some point+numIterations :: Int+numIterations = 10+ testRandomSpec :: IO Bool testRandomSpec = do   g <- newStdGen   let spec = randomSpec myWeights g+  let env = randomExtVals numIterations spec myWeights g   putStrLn "------------------------------------------"   putStrLn "Specification to test:"   putStrLn $ prettyPrint spec-  checkSpec 10 spec+  checkSpec numIterations env spec  main :: IO () main = do   putStrLn "Enter the number of random specifications to test:"   i <- readLn :: IO Int   go i-  where go 0 = putStrLn "No failures found."-        go i = do b <- testRandomSpec-                  if b then do putStrLn "" -                               go (i-1)-                    else do putStrLn "Inconsistency found!" -                            return ()+  where +  go 0 = putStrLn "No failures found."+  go i = do +    b <- testRandomSpec+    when b   $ putStrLn "" >> go (i-1)+    unless b $ putStrLn "Inconsistency found!" >> return ()+