copilot-c99 4.1 → 4.2
raw patch · 5 files changed
+129/−44 lines, 5 filesdep ~copilot-coredep ~filepathPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: copilot-core, filepath
API changes (from Hackage documentation)
Files
- CHANGELOG +6/−0
- copilot-c99.cabal +4/−3
- src/Copilot/Compile/C99/CodeGen.hs +22/−17
- src/Copilot/Compile/C99/Compile.hs +76/−24
- src/Copilot/Compile/C99/Representation.hs +21/−0
CHANGELOG view
@@ -1,3 +1,9 @@+2025-01-07+ * Version bump (4.2). (#577)+ * Remove uses of Copilot.Core.Expr.UExpr.uExprType. (#565)+ * Allow using same trigger name in multiple declarations. (#296)+ * Bump upper version constraint on filepath. (#570)+ 2024-11-07 * Version bump (4.1). (#561) * Standardize changelog format. (#550)
copilot-c99.cabal view
@@ -1,6 +1,6 @@ cabal-version : >= 1.10 name : copilot-c99-version : 4.1+version : 4.2 synopsis : A compiler for Copilot targeting C99. description : This package is a back-end from Copilot to C.@@ -41,11 +41,11 @@ ghc-options : -Wall build-depends : base >= 4.9 && < 5 , directory >= 1.3 && < 1.4- , filepath >= 1.4 && < 1.5+ , filepath >= 1.4 && < 1.6 , mtl >= 2.2 && < 2.4 , pretty >= 1.1 && < 1.2 - , copilot-core >= 4.1 && < 4.2+ , copilot-core >= 4.2 && < 4.3 , language-c99 >= 0.2.0 && < 0.3 , language-c99-simple >= 0.3 && < 0.4 @@ -59,6 +59,7 @@ , Copilot.Compile.C99.External , Copilot.Compile.C99.Compile , Copilot.Compile.C99.Settings+ , Copilot.Compile.C99.Representation test-suite unit-tests type:
src/Copilot/Compile/C99/CodeGen.hs view
@@ -36,14 +36,17 @@ Type (..), UExpr (..), Value (..), fieldName, typeSize ) -- Internal imports-import Copilot.Compile.C99.Error ( impossible )-import Copilot.Compile.C99.Expr ( constArray, transExpr )-import Copilot.Compile.C99.External ( External (..) )-import Copilot.Compile.C99.Name ( argNames, argTempNames, generatorName,- guardName, indexName, streamAccessorName,- streamName )-import Copilot.Compile.C99.Settings ( CSettings, cSettingsStepFunctionName )-import Copilot.Compile.C99.Type ( transType )+import Copilot.Compile.C99.Error ( impossible )+import Copilot.Compile.C99.Expr ( constArray, transExpr )+import Copilot.Compile.C99.External ( External (..) )+import Copilot.Compile.C99.Name ( argNames, argTempNames,+ generatorName, guardName,+ indexName, streamAccessorName,+ streamName )+import Copilot.Compile.C99.Settings ( CSettings,+ cSettingsStepFunctionName )+import Copilot.Compile.C99.Type ( transType )+import Copilot.Compile.C99.Representation ( UniqueTrigger (..) ) -- * Externs @@ -162,7 +165,7 @@ -- * Monitor processing -- | Define the step function that updates all streams.-mkStep :: CSettings -> [Stream] -> [Trigger] -> [External] -> C.FunDef+mkStep :: CSettings -> [Stream] -> [UniqueTrigger] -> [External] -> C.FunDef mkStep cSettings streams triggers exts = C.FunDef Nothing void (cSettingsStepFunctionName cSettings) [] declns stmts where@@ -271,26 +274,28 @@ -- 2. Assigning a struct to a temporary variable defensively ensures that -- any modifications that the handler called makes to the struct argument -- will not affect the internals of the monitoring code.- mkTriggerCheck :: Trigger -> ([C.Decln], C.Stmt)- mkTriggerCheck (Trigger name _guard args) =+ mkTriggerCheck :: UniqueTrigger -> ([C.Decln], C.Stmt)+ mkTriggerCheck (UniqueTrigger uniqueName (Trigger name _guard args)) = (aTmpDeclns, triggerCheckStmt) where aTmpDeclns :: [C.Decln] aTmpDeclns = zipWith declare args aTempNames where declare :: UExpr -> C.Ident -> C.Decln- declare (UExpr { uExprType = ty }) tmpVar =+ declare (UExpr ty _) tmpVar = C.VarDecln Nothing (transType ty) tmpVar Nothing triggerCheckStmt :: C.Stmt triggerCheckStmt = C.If guard' fireTrigger where- guard' = C.Funcall (C.Ident $ guardName name) []+ guard' = C.Funcall (C.Ident $ guardName uniqueName) [] -- The body of the if-statement. This consists of statements that -- assign the values of the temporary variables, following by a -- final statement that passes the temporary variables to the -- handler function.+ -- Note that we call 'name' here instead of 'uniqueName', as 'name'+ -- is the name of the actual external function. fireTrigger = map C.Expr argAssigns ++ [C.Expr $ C.Funcall (C.Ident name)@@ -301,11 +306,11 @@ argAssigns = zipWith3 assign aTempNames aArgNames args assign :: C.Ident -> C.Ident -> UExpr -> C.Expr- assign aTempName aArgName (UExpr { uExprType = ty }) =+ assign aTempName aArgName (UExpr ty _) = updateVar aTempName aArgName ty aArgNames :: [C.Ident]- aArgNames = take (length args) (argNames name)+ aArgNames = take (length args) (argNames uniqueName) -- Build an expression to pass a temporary variable as argument -- to a trigger handler.@@ -314,7 +319,7 @@ -- so we also need the type of the expression, which is enclosed -- in the second argument, an UExpr. passArg :: String -> UExpr -> C.Expr- passArg aTempName (UExpr { uExprType = ty }) =+ passArg aTempName (UExpr ty _) = case ty of -- Special case for Struct to pass reference to temporary -- struct variable to handler. (See the comments for@@ -323,7 +328,7 @@ _ -> C.Ident aTempName aTempNames :: [String]- aTempNames = take (length args) (argTempNames name)+ aTempNames = take (length args) (argTempNames uniqueName) -- * Auxiliary functions
src/Copilot/Compile/C99/Compile.hs view
@@ -6,8 +6,9 @@ ) where -- External imports-import Data.List ( nub, union )+import Data.List ( nub, nubBy, union ) import Data.Maybe ( mapMaybe )+import Data.Type.Equality ( testEquality, (:~:)(Refl) ) import Data.Typeable ( Typeable ) import Language.C99.Pretty ( pretty ) import qualified Language.C99.Simple as C@@ -23,17 +24,21 @@ Value (..) ) -- Internal imports-import Copilot.Compile.C99.CodeGen ( mkAccessDecln, mkBuffDecln, mkExtCpyDecln,- mkExtDecln, mkGenFun, mkGenFunArray,- mkIndexDecln, mkStep, mkStructDecln,- mkStructForwDecln )-import Copilot.Compile.C99.External ( External, gatherExts )-import Copilot.Compile.C99.Name ( argNames, generatorName,- generatorOutputArgName, guardName )-import Copilot.Compile.C99.Settings ( CSettings, cSettingsOutputDirectory,- cSettingsStepFunctionName,- mkDefaultCSettings )-import Copilot.Compile.C99.Type ( transType )+import Copilot.Compile.C99.CodeGen ( mkAccessDecln, mkBuffDecln,+ mkExtCpyDecln, mkExtDecln,+ mkGenFun, mkGenFunArray,+ mkIndexDecln, mkStep,+ mkStructDecln, mkStructForwDecln )+import Copilot.Compile.C99.External ( External, gatherExts )+import Copilot.Compile.C99.Name ( argNames, generatorName,+ generatorOutputArgName, guardName )+import Copilot.Compile.C99.Settings ( CSettings,+ cSettingsOutputDirectory,+ cSettingsStepFunctionName,+ mkDefaultCSettings )+import Copilot.Compile.C99.Type ( transType )+import Copilot.Compile.C99.Representation ( UniqueTrigger (..),+ mkUniqueTriggers ) -- | Compile a specification to a .h and a .c file. --@@ -42,12 +47,20 @@ -- The second argument is used as prefix for the .h and .c files generated. compileWith :: CSettings -> String -> Spec -> IO () compileWith cSettings prefix spec- | null (specTriggers spec)+ | null triggers = do hPutStrLn stderr $ "Copilot error: attempt at compiling empty specification.\n" ++ "You must define at least one trigger to generate C monitors." exitFailure + | incompatibleTriggers triggers+ = do hPutStrLn stderr $+ "Copilot error: attempt at compiling specification with conflicting "+ ++ "trigger definitions.\n"+ ++ "Multiple triggers have the same name, but different argument "+ ++ "types.\n"+ exitFailure+ | otherwise = do let cFile = render $ pretty $ C.translate $ compileC cSettings spec hFile = render $ pretty $ C.translate $ compileH cSettings spec@@ -69,7 +82,25 @@ writeFile (dir </> prefix ++ ".c") $ cMacros ++ cFile writeFile (dir </> prefix ++ ".h") hFile writeFile (dir </> prefix ++ "_types.h") typeDeclnsFile+ where+ triggers = specTriggers spec + -- Check that two triggers do no conflict, that is: if their names are+ -- equal, the types of their arguments should be equal as well.+ incompatibleTriggers :: [Trigger] -> Bool+ incompatibleTriggers = pairwiseAny conflict+ where+ conflict :: Trigger -> Trigger -> Bool+ conflict t1@(Trigger name1 _ _) t2@(Trigger name2 _ _) =+ name1 == name2 && not (compareTrigger t1 t2)++ -- True if the function holds for any pair of elements. We assume that+ -- the function is commutative.+ pairwiseAny :: (a -> a -> Bool) -> [a] -> Bool+ pairwiseAny _ [] = False+ pairwiseAny _ (_:[]) = False+ pairwiseAny f (x:xs) = any (f x) xs || pairwiseAny f xs+ -- | Compile a specification to a .h and a .c file. -- -- The first argument is used as prefix for the .h and .c files generated.@@ -90,12 +121,13 @@ declns = mkExts exts ++ mkGlobals streams - funs = mkGenFuns streams triggers- ++ [mkStep cSettings streams triggers exts]+ funs = mkGenFuns streams uniqueTriggers+ ++ [mkStep cSettings streams uniqueTriggers exts] - streams = specStreams spec- triggers = specTriggers spec- exts = gatherExts streams triggers+ streams = specStreams spec+ triggers = specTriggers spec+ uniqueTriggers = mkUniqueTriggers triggers+ exts = gatherExts streams triggers -- Make declarations for copies of external variables. mkExts :: [External] -> [C.Decln]@@ -110,7 +142,7 @@ indexDecln (Stream sId _ _ _ ) = mkIndexDecln sId -- Make generator functions, including trigger arguments.- mkGenFuns :: [Stream] -> [Trigger] -> [C.FunDef]+ mkGenFuns :: [Stream] -> [UniqueTrigger] -> [C.FunDef] mkGenFuns streamList triggerList = map accessDecln streamList ++ map streamGen streamList ++ concatMap triggerGen triggerList@@ -122,11 +154,11 @@ streamGen (Stream sId _ expr ty) = exprGen (generatorName sId) (generatorOutputArgName sId) expr ty - triggerGen :: Trigger -> [C.FunDef]- triggerGen (Trigger name guard args) = guardDef : argDefs+ triggerGen :: UniqueTrigger -> [C.FunDef]+ triggerGen (UniqueTrigger uniqueName (Trigger _name guard args)) = guardDef : argDefs where- guardDef = mkGenFun (guardName name) guard Bool- argDefs = zipWith argGen (argNames name) args+ guardDef = mkGenFun (guardName uniqueName) guard Bool+ argDefs = zipWith argGen (argNames uniqueName) args argGen :: String -> UExpr -> C.FunDef argGen argName (UExpr ty expr) =@@ -155,8 +187,10 @@ exprs = gatherExprs streams triggers exts = gatherExts streams triggers streams = specStreams spec- triggers = specTriggers spec + -- Remove duplicates due to multiple guards for the same trigger.+ triggers = nubBy compareTrigger (specTriggers spec)+ mkStructForwDeclns :: [UExpr] -> [C.Decln] mkStructForwDeclns es = mapMaybe mkDecln uTypes where@@ -256,3 +290,21 @@ where streamUExpr (Stream _ _ expr ty) = UExpr ty expr triggerUExpr (Trigger _ guard args) = UExpr Bool guard : args++-- | We consider triggers to be equal, if their names match and the number and+-- types of arguments.+compareTrigger :: Trigger -> Trigger -> Bool+compareTrigger (Trigger name1 _ args1) (Trigger name2 _ args2)+ = name1 == name2 && compareArguments args1 args2++ where+ compareArguments :: [UExpr] -> [UExpr] -> Bool+ compareArguments [] [] = True+ compareArguments [] _ = False+ compareArguments _ [] = False+ compareArguments (x:xs) (y:ys) = compareUExpr x y && compareArguments xs ys++ compareUExpr :: UExpr -> UExpr -> Bool+ compareUExpr (UExpr ty1 _) (UExpr ty2 _)+ | Just Refl <- testEquality ty1 ty2 = True+ | otherwise = False
+ src/Copilot/Compile/C99/Representation.hs view
@@ -0,0 +1,21 @@+-- | C99 backend specific versions of selected `Copilot.Core` datatypes.+module Copilot.Compile.C99.Representation+ ( UniqueTrigger (..)+ , UniqueTriggerId+ , mkUniqueTriggers+ )+ where++import Copilot.Core ( Trigger (..) )++-- | Internal unique name for a trigger.+type UniqueTriggerId = String++-- | A `Copilot.Core.Trigger` with an unique name.+data UniqueTrigger = UniqueTrigger UniqueTriggerId Trigger++-- | Given a list of triggers, make their names unique.+mkUniqueTriggers :: [Trigger] -> [UniqueTrigger]+mkUniqueTriggers ts = zipWith mkUnique ts [0..]+ where+ mkUnique t@(Trigger name _ _) n = UniqueTrigger (name ++ "_" ++ show n) t