From 44ec96f48f57c8bc87560449035f7853f36e9a33 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 5 Nov 2021 16:36:20 -0400 Subject: [PATCH 0001/1222] Use local Error reporting module in copilot-language. Refs #267. The module Copilot.Core.Error is mainly used to report errors from within the copilot-core library itself. The module is also used, directly or indirectly, by: - copilot-language:Copilot.Language.Operators.Integral - copilot-language:Copilot.Language.Reify - copilot-language:Copilot.Language.Stream - copilot-language:System.Mem.StableName.Map However, the library copilot-language also defines its own Error module. This commit substitutes imports of copilot-core's Error module from copilot-language, to facilitate the deprecation of the export of both of these modules. --- .../src/Copilot/Language/Operators/Integral.hs | 7 ++++--- copilot-language/src/Copilot/Language/Reify.hs | 3 ++- copilot-language/src/Copilot/Language/Stream.hs | 2 +- copilot-language/src/System/Mem/StableName/Map.hs | 2 +- 4 files changed, 8 insertions(+), 6 deletions(-) diff --git a/copilot-language/src/Copilot/Language/Operators/Integral.hs b/copilot-language/src/Copilot/Language/Operators/Integral.hs index 8ffcc29cc..d4b479b34 100644 --- a/copilot-language/src/Copilot/Language/Operators/Integral.hs +++ b/copilot-language/src/Copilot/Language/Operators/Integral.hs @@ -14,6 +14,7 @@ module Copilot.Language.Operators.Integral import Copilot.Core (Typed, typeOf) import qualified Copilot.Core as Core +import qualified Copilot.Language.Error as Err import Copilot.Language.Operators.BitWise ((.<<.)) import Copilot.Language.Stream @@ -26,13 +27,13 @@ import Data.List (foldl', replicate) -- | Apply the 'Prelude.div' operation to two streams, point-wise. div :: (Typed a, P.Integral a) => Stream a -> Stream a -> Stream a (Const 0) `div` _ = Const 0 -_ `div` (Const 0) = Core.badUsage "in div: division by zero." +_ `div` (Const 0) = Err.badUsage "in div: division by zero." x `div` (Const 1) = x x `div` y = Op2 (Core.Div typeOf) x y -- | Apply the 'Prelude.mod' operation to two streams, point-wise. mod :: (Typed a, P.Integral a) => Stream a -> Stream a -> Stream a -_ `mod` (Const 0) = Core.badUsage "in mod: division by zero." +_ `mod` (Const 0) = Err.badUsage "in mod: division by zero." (Const 0) `mod` _ = (Const 0) (Const x) `mod` (Const y) = Const (x `P.mod` y) x `mod` y = Op2 (Core.Mod typeOf) x y @@ -49,6 +50,6 @@ x `mod` y = Op2 (Core.Mod typeOf) x y (Const x) ^ (Const y) = Const (x P.^ y) (Const 2) ^ y = (Const 1) .<<. y x ^ (Const y) = foldl' ((P.*)) (Const 1) (replicate (P.fromIntegral y) x) -_ ^ _ = Core.badUsage "in ^: in x ^ y, either x must be the constant 2, or y must be a constant. (Do not confuse ^ with bitwise XOR (.^.) or with ** for exponentation of floats/doubles.)" +_ ^ _ = Err.badUsage "in ^: in x ^ y, either x must be the constant 2, or y must be a constant. (Do not confuse ^ with bitwise XOR (.^.) or with ** for exponentation of floats/doubles.)" -------------------------------------------------------------------------------- diff --git a/copilot-language/src/Copilot/Language/Reify.hs b/copilot-language/src/Copilot/Language/Reify.hs index 8fa697afc..ed45e4637 100644 --- a/copilot-language/src/Copilot/Language/Reify.hs +++ b/copilot-language/src/Copilot/Language/Reify.hs @@ -13,9 +13,10 @@ module Copilot.Language.Reify ) where import qualified Copilot.Core as Core -import Copilot.Core (Typed, Id, typeOf, impossible) +import Copilot.Core (Typed, Id, typeOf) import Copilot.Language.Analyze (analyze) +import Copilot.Language.Error (impossible) import Copilot.Language.Spec import Copilot.Language.Stream (Stream (..), Arg (..)) diff --git a/copilot-language/src/Copilot/Language/Stream.hs b/copilot-language/src/Copilot/Language/Stream.hs index d88a98ee9..568055d38 100644 --- a/copilot-language/src/Copilot/Language/Stream.hs +++ b/copilot-language/src/Copilot/Language/Stream.hs @@ -19,8 +19,8 @@ module Copilot.Language.Stream ) where import Copilot.Core (Typed, typeOf) -import Copilot.Core.Error import qualified Copilot.Core as Core +import Copilot.Language.Error import Copilot.Language.Prelude import qualified Prelude as P diff --git a/copilot-language/src/System/Mem/StableName/Map.hs b/copilot-language/src/System/Mem/StableName/Map.hs index 320a284ba..9e96e5d48 100644 --- a/copilot-language/src/System/Mem/StableName/Map.hs +++ b/copilot-language/src/System/Mem/StableName/Map.hs @@ -25,7 +25,7 @@ import System.Mem.StableName.Dynamic import qualified Data.IntMap as IntMap import Data.IntMap (IntMap) -import Copilot.Core.Error (impossible) +import Copilot.Language.Error (impossible) data Map a = Map { getMap :: IntMap [(DynStableName, a)] , getSize :: Int } From 39b0c451d416308831162b2ff6a1d6df400c7be8 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 5 Nov 2021 17:02:22 -0400 Subject: [PATCH 0002/1222] Deprecate the export of Copilot.Core.Error. Refs #267. This commit deprecates the functions in copilot-core:Copilot.Core.Error. It introduces an internal replacement module that implements the same features and subsitutes all uses of the aforementioned module to point to the internal implementation, so that the one currently exported can be DEPRECATED without giving rise to unintended compilation warnings. --- copilot-core/copilot-core.cabal | 4 +++ copilot-core/src/Copilot/Core/Error.hs | 13 +++++----- .../src/Copilot/Core/ErrorInternal.hs | 26 +++++++++++++++++++ .../src/Copilot/Core/Interpret/Eval.hs | 3 ++- copilot-core/src/Copilot/Core/PrettyPrint.hs | 3 ++- copilot-core/src/Copilot/Core/Type/Eq.hs | 2 +- copilot-core/src/Copilot/Core/Type/Read.hs | 2 +- 7 files changed, 42 insertions(+), 11 deletions(-) create mode 100644 copilot-core/src/Copilot/Core/ErrorInternal.hs diff --git a/copilot-core/copilot-core.cabal b/copilot-core/copilot-core.cabal index 067d17b59..5799d6706 100644 --- a/copilot-core/copilot-core.cabal +++ b/copilot-core/copilot-core.cabal @@ -69,6 +69,10 @@ library Copilot.Core.PrettyPrint Copilot.Core.PrettyDot + other-modules: + + Copilot.Core.ErrorInternal + test-suite unit-tests type: exitcode-stdio-1.0 diff --git a/copilot-core/src/Copilot/Core/Error.hs b/copilot-core/src/Copilot/Core/Error.hs index 0debccdf9..1aa94ee24 100644 --- a/copilot-core/src/Copilot/Core/Error.hs +++ b/copilot-core/src/Copilot/Core/Error.hs @@ -9,18 +9,17 @@ module Copilot.Core.Error ( impossible , badUsage ) where +import qualified Copilot.Core.ErrorInternal as Err + -- | Report an error due to a bug in Copilot. +{-# DEPRECATED impossible "This function is deprecated in Copilot 3.6." #-} impossible :: String -- ^ Name of the function in which the error was detected. -> String -- ^ Name of the package in which the function is located. -> a -impossible function package = - error $ "\"Impossible\" error in function " - ++ function ++ ", in package " ++ package - ++ ". Please file an issue at " - ++ "https://github.com/Copilot-Language/copilot/issues" - ++ "or email the maintainers at " +impossible = Err.impossible -- | Report an error due to an error detected by Copilot (e.g., user error). +{-# DEPRECATED badUsage "This function is deprecated in Copilot 3.6." #-} badUsage :: String -- ^ Description of the error. -> a -badUsage msg = error $ "Copilot error: " ++ msg +badUsage = Err.badUsage diff --git a/copilot-core/src/Copilot/Core/ErrorInternal.hs b/copilot-core/src/Copilot/Core/ErrorInternal.hs new file mode 100644 index 000000000..2e0eff226 --- /dev/null +++ b/copilot-core/src/Copilot/Core/ErrorInternal.hs @@ -0,0 +1,26 @@ +-------------------------------------------------------------------------------- +-- Copyright © 2011 National Institute of Aerospace / Galois, Inc. +-------------------------------------------------------------------------------- + +{-# LANGUAGE Safe #-} + +-- | Custom functions to report error messages to users. +module Copilot.Core.ErrorInternal + ( impossible + , badUsage ) where + +-- | Report an error due to a bug in Copilot. +impossible :: String -- ^ Name of the function in which the error was detected. + -> String -- ^ Name of the package in which the function is located. + -> a +impossible function package = + error $ "\"Impossible\" error in function " + ++ function ++ ", in package " ++ package + ++ ". Please file an issue at " + ++ "https://github.com/Copilot-Language/copilot/issues" + ++ "or email the maintainers at " + +-- | Report an error due to an error detected by Copilot (e.g., user error). +badUsage :: String -- ^ Description of the error. + -> a +badUsage msg = error $ "Copilot error: " ++ msg diff --git a/copilot-core/src/Copilot/Core/Interpret/Eval.hs b/copilot-core/src/Copilot/Core/Interpret/Eval.hs index af86b7ae1..c7ea0c5e9 100644 --- a/copilot-core/src/Copilot/Core/Interpret/Eval.hs +++ b/copilot-core/src/Copilot/Core/Interpret/Eval.hs @@ -14,7 +14,8 @@ module Copilot.Core.Interpret.Eval , eval ) where -import Copilot.Core +import Copilot.Core hiding (badUsage) +import Copilot.Core.ErrorInternal (badUsage) import Copilot.Core.Type.Show (showWithType, ShowType) import Prelude hiding (id) diff --git a/copilot-core/src/Copilot/Core/PrettyPrint.hs b/copilot-core/src/Copilot/Core/PrettyPrint.hs index dcd82ac3c..2a07bee9d 100644 --- a/copilot-core/src/Copilot/Core/PrettyPrint.hs +++ b/copilot-core/src/Copilot/Core/PrettyPrint.hs @@ -12,7 +12,8 @@ module Copilot.Core.PrettyPrint , ppExpr ) where -import Copilot.Core +import Copilot.Core hiding (impossible) +import Copilot.Core.ErrorInternal (impossible) import Copilot.Core.Type.Show (showWithType, ShowType(..), showType) import Prelude hiding (id, (<>)) import Text.PrettyPrint.HughesPJ diff --git a/copilot-core/src/Copilot/Core/Type/Eq.hs b/copilot-core/src/Copilot/Core/Type/Eq.hs index b6984d98d..015c65fdd 100644 --- a/copilot-core/src/Copilot/Core/Type/Eq.hs +++ b/copilot-core/src/Copilot/Core/Type/Eq.hs @@ -12,7 +12,7 @@ module Copilot.Core.Type.Eq , UVal (..) ) where -import Copilot.Core.Error (impossible) +import Copilot.Core.ErrorInternal (impossible) import Copilot.Core.Type import Copilot.Core.Type.Dynamic (fromDyn, toDyn) diff --git a/copilot-core/src/Copilot/Core/Type/Read.hs b/copilot-core/src/Copilot/Core/Type/Read.hs index f33044f86..44b24438f 100644 --- a/copilot-core/src/Copilot/Core/Type/Read.hs +++ b/copilot-core/src/Copilot/Core/Type/Read.hs @@ -13,7 +13,7 @@ module Copilot.Core.Type.Read ) where import Copilot.Core.Type -import Copilot.Core.Error (badUsage) +import Copilot.Core.ErrorInternal (badUsage) -------------------------------------------------------------------------------- From c26a37babe2fef9e9f7a3973a7f642df9f9884fe Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 5 Nov 2021 17:06:33 -0400 Subject: [PATCH 0003/1222] Document changes. Refs #267. [ci skip] --- copilot-core/CHANGELOG | 3 ++- copilot-language/CHANGELOG | 3 ++- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/copilot-core/CHANGELOG b/copilot-core/CHANGELOG index 558a247b3..2550ada0d 100644 --- a/copilot-core/CHANGELOG +++ b/copilot-core/CHANGELOG @@ -1,4 +1,5 @@ -2021-10-19 +2021-11-05 + * Replace uses of copilot-core's error reporting functions. (#267) * Introduce new ops atan2, ceiling, floor. (#246) * Add initial support for unit testing. (#256) * Deprecate unused type. (#260) diff --git a/copilot-language/CHANGELOG b/copilot-language/CHANGELOG index 3fc253913..c7e91b1d8 100644 --- a/copilot-language/CHANGELOG +++ b/copilot-language/CHANGELOG @@ -1,4 +1,5 @@ -2021-10-19 +2021-11-05 + * Replace uses of copilot-core's error reporting functions. (#267) * Introduce new ops atan2, ceiling, floor. (#246) * Remove deprecated function. (#250) * Fix outdated/broken links. (#252) From 5876d5ce166dd2dbcbda8b98f208e7e13e4d96f4 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 5 Nov 2021 17:31:10 -0400 Subject: [PATCH 0004/1222] Deprecate export of module copilot-core:Copilot.Core.Interpret.Render. Refs #268. The module Copilot.Core.Interpret.Render defines two auxiliary functions that are meant to be used via Copilot.Core.Interpret. There is no reason to export that module, so it's export is exported. A temporary module keeping the features implemented is included until the module is hidden from the public interface. --- copilot-core/copilot-core.cabal | 1 + copilot-core/src/Copilot/Core/Interpret.hs | 2 +- .../src/Copilot/Core/Interpret/Render.hs | 119 +--------------- .../Copilot/Core/Interpret/RenderInternal.hs | 130 ++++++++++++++++++ 4 files changed, 134 insertions(+), 118 deletions(-) create mode 100644 copilot-core/src/Copilot/Core/Interpret/RenderInternal.hs diff --git a/copilot-core/copilot-core.cabal b/copilot-core/copilot-core.cabal index 5799d6706..f250675ca 100644 --- a/copilot-core/copilot-core.cabal +++ b/copilot-core/copilot-core.cabal @@ -72,6 +72,7 @@ library other-modules: Copilot.Core.ErrorInternal + Copilot.Core.Interpret.RenderInternal test-suite unit-tests type: diff --git a/copilot-core/src/Copilot/Core/Interpret.hs b/copilot-core/src/Copilot/Core/Interpret.hs index 0b8c3ffb1..7080a6a2c 100644 --- a/copilot-core/src/Copilot/Core/Interpret.hs +++ b/copilot-core/src/Copilot/Core/Interpret.hs @@ -13,7 +13,7 @@ module Copilot.Core.Interpret import Copilot.Core import Copilot.Core.Interpret.Eval -import Copilot.Core.Interpret.Render +import Copilot.Core.Interpret.RenderInternal import Copilot.Core.Type.Show (ShowType(..)) -- | Output format for the results of a Copilot spec interpretation. diff --git a/copilot-core/src/Copilot/Core/Interpret/Render.hs b/copilot-core/src/Copilot/Core/Interpret/Render.hs index 23b3a4fc5..b5b49eb62 100644 --- a/copilot-core/src/Copilot/Core/Interpret/Render.hs +++ b/copilot-core/src/Copilot/Core/Interpret/Render.hs @@ -7,124 +7,9 @@ {-# LANGUAGE Safe #-} module Copilot.Core.Interpret.Render + {-# DEPRECATED "This module is deprecated in Copilot 3.6." #-} ( renderAsTable , renderAsCSV ) where -import Data.List (intersperse, transpose, foldl') -import Data.Maybe (catMaybes) -import Copilot.Core.Interpret.Eval (Output, ExecTrace (..)) -import Text.PrettyPrint - -import Prelude hiding ((<>)) - --------------------------------------------------------------------------------- - --- | Render an execution trace as a table, formatted to faciliate readability. -renderAsTable :: ExecTrace -> String -renderAsTable - ExecTrace - { interpTriggers = trigs - , interpObservers = obsvs } = ( render - . asColumns - . transpose - . (:) (ppTriggerNames ++ ppObserverNames) - . transpose - ) (ppTriggerOutputs ++ ppObserverOutputs) - where - - ppTriggerNames :: [Doc] - ppTriggerNames = map (text . (++ ":")) (map fst trigs) - - ppObserverNames :: [Doc] - ppObserverNames = map (text . (++ ":")) (map fst obsvs) - - ppTriggerOutputs :: [[Doc]] - ppTriggerOutputs = map (map ppTriggerOutput) (map snd trigs) - - ppTriggerOutput :: Maybe [Output] -> Doc - ppTriggerOutput (Just vs) = text $ "(" ++ concat (intersperse "," vs) ++ ")" - ppTriggerOutput Nothing = text "--" - - ppObserverOutputs :: [[Doc]] - ppObserverOutputs = map (map text) (map snd obsvs) - --------------------------------------------------------------------------------- - --- | Render an execution trace as using comma-separate value (CSV) format. -renderAsCSV :: ExecTrace -> String -renderAsCSV = render . unfold - --- | Pretty print all the steps of the execution trace and concatenate the --- results. -unfold :: ExecTrace -> Doc -unfold r = - case step r of - (cs, Nothing) -> cs - (cs, Just r') -> cs $$ unfold r' - --- | Pretty print the state of the triggers, and provide a continuation --- for the execution trace at the next point in time. -step :: ExecTrace -> (Doc, Maybe ExecTrace) -step ExecTrace - { interpTriggers = trigs - } = - if null trigs then (empty, Nothing) - else (foldl' ($$) empty (text "#" : ppTriggerOutputs), tails) - - where - - ppTriggerOutputs :: [Doc] - ppTriggerOutputs = - catMaybes - . fmap ppTriggerOutput - . map (fmap head) - $ trigs - - ppTriggerOutput :: (String, Maybe [Output]) -> Maybe Doc - ppTriggerOutput (_, Nothing) = Nothing - ppTriggerOutput (cs, Just xs) = Just $ - text cs <> text "," <> - (foldr (<>) empty . map text . intersperse ",") xs - - tails :: Maybe ExecTrace - tails = - if any null (fmap (tail.snd) trigs) - then Nothing - else Just - ExecTrace - { interpTriggers = map (fmap tail) trigs - , interpObservers = [] - } - --------------------------------------------------------------------------------- - - - --- Copied from pretty-ncols because of incompatibility with newer GHC versions. -asColumns :: [[Doc]] -> Doc -asColumns = flip asColumnsWithBuff $ 1 - -asColumnsWithBuff :: [[Doc]] -> Int -> Doc -asColumnsWithBuff lls q = normalize - where normalize = vcat $ map hsep - $ map (\x -> pad (length x) longColumnLen empty x) - $ pad' longEntryLen q - $ transpose lls -- normalize column height - longColumnLen = maximum (map length lls) - longEntryLen = maximum $ map docLen (concat lls) - -docLen d = length $ render d - --- | Pad a string on the right to reach an expected length. -pad :: Int -> Int -> a -> [a] -> [a] -pad lx max b ls = ls ++ replicate (max - lx) b - --- | Pad a list of strings on the right with spaces. -pad' :: Int -- ^ Mininum number of spaces to add - -> Int -- ^ Maximum number of spaces to add - -> [[Doc]] -- ^ List of documents to pad - -> [[Doc]] -pad' _ _ [] = [] -pad' mx q (ls:xs) = map buf ls : pad' mx q xs - where buf x = x <> (hcat $ replicate q space) <> (hcat $ replicate (mx - (docLen x)) space) +import Copilot.Core.Interpret.RenderInternal diff --git a/copilot-core/src/Copilot/Core/Interpret/RenderInternal.hs b/copilot-core/src/Copilot/Core/Interpret/RenderInternal.hs new file mode 100644 index 000000000..73d9a85c4 --- /dev/null +++ b/copilot-core/src/Copilot/Core/Interpret/RenderInternal.hs @@ -0,0 +1,130 @@ +-------------------------------------------------------------------------------- +-- Copyright © 2011 National Institute of Aerospace / Galois, Inc. +-------------------------------------------------------------------------------- + +-- | Pretty-print the results of a simulation. + +{-# LANGUAGE Safe #-} + +module Copilot.Core.Interpret.RenderInternal + ( renderAsTable + , renderAsCSV + ) where + +import Data.List (intersperse, transpose, foldl') +import Data.Maybe (catMaybes) +import Copilot.Core.Interpret.Eval (Output, ExecTrace (..)) +import Text.PrettyPrint + +import Prelude hiding ((<>)) + +-------------------------------------------------------------------------------- + +-- | Render an execution trace as a table, formatted to faciliate readability. +renderAsTable :: ExecTrace -> String +renderAsTable + ExecTrace + { interpTriggers = trigs + , interpObservers = obsvs } = ( render + . asColumns + . transpose + . (:) (ppTriggerNames ++ ppObserverNames) + . transpose + ) (ppTriggerOutputs ++ ppObserverOutputs) + where + + ppTriggerNames :: [Doc] + ppTriggerNames = map (text . (++ ":")) (map fst trigs) + + ppObserverNames :: [Doc] + ppObserverNames = map (text . (++ ":")) (map fst obsvs) + + ppTriggerOutputs :: [[Doc]] + ppTriggerOutputs = map (map ppTriggerOutput) (map snd trigs) + + ppTriggerOutput :: Maybe [Output] -> Doc + ppTriggerOutput (Just vs) = text $ "(" ++ concat (intersperse "," vs) ++ ")" + ppTriggerOutput Nothing = text "--" + + ppObserverOutputs :: [[Doc]] + ppObserverOutputs = map (map text) (map snd obsvs) + +-------------------------------------------------------------------------------- + +-- | Render an execution trace as using comma-separate value (CSV) format. +renderAsCSV :: ExecTrace -> String +renderAsCSV = render . unfold + +-- | Pretty print all the steps of the execution trace and concatenate the +-- results. +unfold :: ExecTrace -> Doc +unfold r = + case step r of + (cs, Nothing) -> cs + (cs, Just r') -> cs $$ unfold r' + +-- | Pretty print the state of the triggers, and provide a continuation +-- for the execution trace at the next point in time. +step :: ExecTrace -> (Doc, Maybe ExecTrace) +step ExecTrace + { interpTriggers = trigs + } = + if null trigs then (empty, Nothing) + else (foldl' ($$) empty (text "#" : ppTriggerOutputs), tails) + + where + + ppTriggerOutputs :: [Doc] + ppTriggerOutputs = + catMaybes + . fmap ppTriggerOutput + . map (fmap head) + $ trigs + + ppTriggerOutput :: (String, Maybe [Output]) -> Maybe Doc + ppTriggerOutput (_, Nothing) = Nothing + ppTriggerOutput (cs, Just xs) = Just $ + text cs <> text "," <> + (foldr (<>) empty . map text . intersperse ",") xs + + tails :: Maybe ExecTrace + tails = + if any null (fmap (tail.snd) trigs) + then Nothing + else Just + ExecTrace + { interpTriggers = map (fmap tail) trigs + , interpObservers = [] + } + +-------------------------------------------------------------------------------- + + + +-- Copied from pretty-ncols because of incompatibility with newer GHC versions. +asColumns :: [[Doc]] -> Doc +asColumns = flip asColumnsWithBuff $ 1 + +asColumnsWithBuff :: [[Doc]] -> Int -> Doc +asColumnsWithBuff lls q = normalize + where normalize = vcat $ map hsep + $ map (\x -> pad (length x) longColumnLen empty x) + $ pad' longEntryLen q + $ transpose lls -- normalize column height + longColumnLen = maximum (map length lls) + longEntryLen = maximum $ map docLen (concat lls) + +docLen d = length $ render d + +-- | Pad a string on the right to reach an expected length. +pad :: Int -> Int -> a -> [a] -> [a] +pad lx max b ls = ls ++ replicate (max - lx) b + +-- | Pad a list of strings on the right with spaces. +pad' :: Int -- ^ Mininum number of spaces to add + -> Int -- ^ Maximum number of spaces to add + -> [[Doc]] -- ^ List of documents to pad + -> [[Doc]] +pad' _ _ [] = [] +pad' mx q (ls:xs) = map buf ls : pad' mx q xs + where buf x = x <> (hcat $ replicate q space) <> (hcat $ replicate (mx - (docLen x)) space) From 0c4ad136b8b41fc2a01af980396b829920ae5fe7 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 5 Nov 2021 17:33:29 -0400 Subject: [PATCH 0005/1222] Document changes. Refs #268. [ci skip] --- copilot-core/CHANGELOG | 1 + 1 file changed, 1 insertion(+) diff --git a/copilot-core/CHANGELOG b/copilot-core/CHANGELOG index 2550ada0d..8857b2401 100644 --- a/copilot-core/CHANGELOG +++ b/copilot-core/CHANGELOG @@ -1,4 +1,5 @@ 2021-11-05 + * Deprecate export of copilot-core:Copilot.Core.Interpret.Render. (#268) * Replace uses of copilot-core's error reporting functions. (#267) * Introduce new ops atan2, ceiling, floor. (#246) * Add initial support for unit testing. (#256) From a72543dbdf198c2d51d2aa1b3d937cd7d58f8fff Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 5 Nov 2021 18:00:52 -0400 Subject: [PATCH 0006/1222] Deprecate copilot-core:Copilot.Core.Type.Uninitialized.uninitialized. Refs #270. The module copilot-core:Copilot.Core.Type.Uninitialized is only ever used in one example, which currently does not compile due to needing Z3. The current implementation is not complete either (#138), so its use by users is limited. As we do not have a use case that requires supporting this function, it's best to remove it, and copy the code that needs it to the example that actually needs this code. --- .../src/Copilot/Core/Type/Uninitialized.hs | 1 + copilot-theorem/examples/BoyerMoore.hs | 20 ++++++++++++++++++- 2 files changed, 20 insertions(+), 1 deletion(-) diff --git a/copilot-core/src/Copilot/Core/Type/Uninitialized.hs b/copilot-core/src/Copilot/Core/Type/Uninitialized.hs index d9d618eb9..a889f9b2c 100644 --- a/copilot-core/src/Copilot/Core/Type/Uninitialized.hs +++ b/copilot-core/src/Copilot/Core/Type/Uninitialized.hs @@ -18,6 +18,7 @@ import Copilot.Core.Type -- | Initial value for a given type. -- -- Does not support structs or arrays. +{-# DEPRECATED uninitialized "This function is deprecated in Copilot 3.6" #-} uninitialized :: Type a -> a uninitialized t = case t of diff --git a/copilot-theorem/examples/BoyerMoore.hs b/copilot-theorem/examples/BoyerMoore.hs index 5c213a2ba..67d975135 100644 --- a/copilot-theorem/examples/BoyerMoore.hs +++ b/copilot-theorem/examples/BoyerMoore.hs @@ -9,7 +9,6 @@ import Copilot.Theorem import Copilot.Theorem.Prover.Z3 import Copilot.Core.Type -import Copilot.Core.Type.Uninitialized import Prelude () import Control.Monad (forM_) @@ -84,3 +83,22 @@ spec = do induct :: Proof Universal induct = induction def { nraNLSat = False, debug = False } +-------------------------------------------------------------------------------- + +-- | Initial value for a given type. +-- +-- Does not support structs or arrays. +uninitialized :: Type a -> a +uninitialized t = + case t of + Bool -> False + Int8 -> 0 + Int16 -> 0 + Int32 -> 0 + Int64 -> 0 + Word8 -> 0 + Word16 -> 0 + Word32 -> 0 + Word64 -> 0 + Float -> 0 + Double -> 0 From f1b567e26f2797a823f4bbdf3c7e332862ddf9b0 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 5 Nov 2021 18:02:36 -0400 Subject: [PATCH 0007/1222] Document changes. Refs #270. [ci skip] --- copilot-core/CHANGELOG | 1 + 1 file changed, 1 insertion(+) diff --git a/copilot-core/CHANGELOG b/copilot-core/CHANGELOG index 8857b2401..654105778 100644 --- a/copilot-core/CHANGELOG +++ b/copilot-core/CHANGELOG @@ -1,4 +1,5 @@ 2021-11-05 + * Deprecate copilot-core:Copilot.Core.Type.Uninitialized. (#270) * Deprecate export of copilot-core:Copilot.Core.Interpret.Render. (#268) * Replace uses of copilot-core's error reporting functions. (#267) * Introduce new ops atan2, ceiling, floor. (#246) From a2f365c3956a0fb8235f61a467f7f2a54634e86a Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 5 Nov 2021 18:23:57 -0400 Subject: [PATCH 0008/1222] Deprecate copilot-core:Copilot.Core.Type.Dynamic.toDynF and fromDynF. Refs #269. The functions copilot-core:Copilot.Core.Type.Dynamic.toDynF and copilot-core:Copilot.Core.Type.Dynamic.fromDynF are exported by the module but never used internally or externally. This commit deprecates both functions. --- copilot-core/src/Copilot/Core/Type/Dynamic.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/copilot-core/src/Copilot/Core/Type/Dynamic.hs b/copilot-core/src/Copilot/Core/Type/Dynamic.hs index e68b8d6f5..4f828a6db 100644 --- a/copilot-core/src/Copilot/Core/Type/Dynamic.hs +++ b/copilot-core/src/Copilot/Core/Type/Dynamic.hs @@ -49,11 +49,13 @@ fromDyn t1 (Dynamic x t2) = Nothing -> Nothing -- | Enclose a function and its type in a container. +{-# DEPRECATED toDynF "This function is deprecated in Copilot 3.6." #-} toDynF :: t a -> f a -> DynamicF f t toDynF t fx = DynamicF fx t -- | Extract a value from a dynamic function container. Return 'Nothing' if -- the value is not of the given type. +{-# DEPRECATED fromDynF "This function is deprecated in Copilot 3.6." #-} fromDynF :: EqualType t => t a -> DynamicF f t -> Maybe (f a) fromDynF t1 (DynamicF fx t2) = case t1 =~= t2 of From e8bad20e1d3de6e0b68690c30141f5a5d3ad1502 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 5 Nov 2021 18:26:03 -0400 Subject: [PATCH 0009/1222] Document changes. Refs #269. [ci skip] --- copilot-core/CHANGELOG | 1 + 1 file changed, 1 insertion(+) diff --git a/copilot-core/CHANGELOG b/copilot-core/CHANGELOG index 654105778..144b36b81 100644 --- a/copilot-core/CHANGELOG +++ b/copilot-core/CHANGELOG @@ -1,4 +1,5 @@ 2021-11-05 + * Deprecate Copilot.Core.Type.Dynamic.toDynF and fromDynF. (#269) * Deprecate copilot-core:Copilot.Core.Type.Uninitialized. (#270) * Deprecate export of copilot-core:Copilot.Core.Interpret.Render. (#268) * Replace uses of copilot-core's error reporting functions. (#267) From 83ad03e67cb6e8991a62058e818f6bd36a10fab8 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 7 Nov 2021 19:28:53 -0500 Subject: [PATCH 0010/1222] Bump versions and constraints (3.6). Refs #264. --- copilot-c99/copilot-c99.cabal | 4 ++-- copilot-core/copilot-core.cabal | 2 +- copilot-language/copilot-language.cabal | 6 +++--- copilot-libraries/copilot-libraries.cabal | 4 ++-- copilot-theorem/copilot-theorem.cabal | 4 ++-- copilot/copilot.cabal | 12 ++++++------ 6 files changed, 16 insertions(+), 16 deletions(-) diff --git a/copilot-c99/copilot-c99.cabal b/copilot-c99/copilot-c99.cabal index 67bfc7b6b..1d65d3d8f 100644 --- a/copilot-c99/copilot-c99.cabal +++ b/copilot-c99/copilot-c99.cabal @@ -1,6 +1,6 @@ cabal-version : >= 1.10 name : copilot-c99 -version : 3.5 +version : 3.6 synopsis : A compiler for Copilot targeting C99. description : This package is a back-end from Copilot to C. @@ -48,7 +48,7 @@ library , mtl >= 2.2 && < 2.3 , pretty >= 1.1 && < 1.2 - , copilot-core >= 3.5 && < 3.6 + , copilot-core >= 3.6 && < 3.7 , language-c99 >= 0.1.1 && < 0.2 , language-c99-util >= 0.1.1 && < 0.2 , language-c99-simple >= 0.1.1 && < 0.2 diff --git a/copilot-core/copilot-core.cabal b/copilot-core/copilot-core.cabal index f250675ca..206e7eae8 100644 --- a/copilot-core/copilot-core.cabal +++ b/copilot-core/copilot-core.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-core -version: 3.5 +version: 3.6 synopsis: An intermediate representation for Copilot. description: Intermediate representation for Copilot. diff --git a/copilot-language/copilot-language.cabal b/copilot-language/copilot-language.cabal index 32997f470..cca48670a 100644 --- a/copilot-language/copilot-language.cabal +++ b/copilot-language/copilot-language.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-language -version: 3.5 +version: 3.6 synopsis: A Haskell-embedded DSL for monitoring hard real-time distributed systems. description: @@ -40,8 +40,8 @@ library , data-reify >= 0.6 && < 0.7 , mtl >= 2.0 && < 3 - , copilot-core >= 3.5 && < 3.6 - , copilot-theorem >= 3.5 && < 3.6 + , copilot-core >= 3.6 && < 3.7 + , copilot-theorem >= 3.6 && < 3.7 exposed-modules: Copilot , Copilot.Language diff --git a/copilot-libraries/copilot-libraries.cabal b/copilot-libraries/copilot-libraries.cabal index 8a0f652d0..ca2703893 100644 --- a/copilot-libraries/copilot-libraries.cabal +++ b/copilot-libraries/copilot-libraries.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-libraries -version: 3.5 +version: 3.6 synopsis: Libraries for the Copilot language. description: Libraries for the Copilot language. @@ -41,7 +41,7 @@ library , data-reify >= 0.6 && < 0.7 , mtl >= 2.0 && < 2.3 , parsec >= 2.0 && < 3.2 - , copilot-language >= 3.5 && < 3.6 + , copilot-language >= 3.6 && < 3.7 exposed-modules: Copilot.Library.Libraries diff --git a/copilot-theorem/copilot-theorem.cabal b/copilot-theorem/copilot-theorem.cabal index 69d68b80e..158ee5996 100644 --- a/copilot-theorem/copilot-theorem.cabal +++ b/copilot-theorem/copilot-theorem.cabal @@ -14,7 +14,7 @@ description: . -version : 3.5 +version : 3.6 license : BSD3 license-file : LICENSE maintainer : Ivan Perez @@ -72,7 +72,7 @@ library , xml >= 1.3 && < 1.4 , what4 >= 1.1 && < 1.2 - , copilot-core >= 3.5 && < 3.6 + , copilot-core >= 3.6 && < 3.7 exposed-modules : Copilot.Theorem , Copilot.Theorem.Prove diff --git a/copilot/copilot.cabal b/copilot/copilot.cabal index dec9b1be2..52fb000b9 100644 --- a/copilot/copilot.cabal +++ b/copilot/copilot.cabal @@ -1,5 +1,5 @@ name: copilot -version: 3.5 +version: 3.6 cabal-version: >= 1.10 license: BSD3 license-file: LICENSE @@ -50,11 +50,11 @@ library , directory >= 1.3 && < 1.4 , filepath >= 1.4 && < 1.5 - , copilot-core >= 3.5 && < 3.6 - , copilot-theorem >= 3.5 && < 3.6 - , copilot-language >= 3.5 && < 3.6 - , copilot-libraries >= 3.5 && < 3.6 - , copilot-c99 >= 3.5 && < 3.6 + , copilot-core >= 3.6 && < 3.7 + , copilot-theorem >= 3.6 && < 3.7 + , copilot-language >= 3.6 && < 3.7 + , copilot-libraries >= 3.6 && < 3.7 + , copilot-c99 >= 3.6 && < 3.7 exposed-modules: Language.Copilot, Language.Copilot.Main From 2abe06000b05dc9455781227477c99d2b80d22d7 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 7 Nov 2021 19:31:21 -0500 Subject: [PATCH 0011/1222] Document version bump change. Refs #264. --- copilot-c99/CHANGELOG | 3 ++- copilot-core/CHANGELOG | 5 +++-- copilot-language/CHANGELOG | 3 ++- copilot-libraries/CHANGELOG | 3 ++- copilot-theorem/CHANGELOG | 3 ++- copilot/CHANGELOG | 5 +++-- 6 files changed, 14 insertions(+), 8 deletions(-) diff --git a/copilot-c99/CHANGELOG b/copilot-c99/CHANGELOG index 88dd603b5..3f489f622 100644 --- a/copilot-c99/CHANGELOG +++ b/copilot-c99/CHANGELOG @@ -1,4 +1,5 @@ -2021-10-19 +2021-11-07 + * Version bump (3.6). (#264) * Introduce new ops atan2, ceiling, floor. (#246) * Allow customizing output directory. (#255) * Fix outdated/broken links. (#252) diff --git a/copilot-core/CHANGELOG b/copilot-core/CHANGELOG index 144b36b81..3febb1761 100644 --- a/copilot-core/CHANGELOG +++ b/copilot-core/CHANGELOG @@ -1,5 +1,6 @@ -2021-11-05 - * Deprecate Copilot.Core.Type.Dynamic.toDynF and fromDynF. (#269) +2021-11-07 + * Version bump (3.6). (#264) + * Deprecate Copilot.Core.Type.Dynamic.toDynF and fromDynF. (#269) * Deprecate copilot-core:Copilot.Core.Type.Uninitialized. (#270) * Deprecate export of copilot-core:Copilot.Core.Interpret.Render. (#268) * Replace uses of copilot-core's error reporting functions. (#267) diff --git a/copilot-language/CHANGELOG b/copilot-language/CHANGELOG index c7e91b1d8..4e70a8b59 100644 --- a/copilot-language/CHANGELOG +++ b/copilot-language/CHANGELOG @@ -1,4 +1,5 @@ -2021-11-05 +2021-11-07 + * Version bump (3.6). (#264) * Replace uses of copilot-core's error reporting functions. (#267) * Introduce new ops atan2, ceiling, floor. (#246) * Remove deprecated function. (#250) diff --git a/copilot-libraries/CHANGELOG b/copilot-libraries/CHANGELOG index 8d86bb440..fc00b26c7 100644 --- a/copilot-libraries/CHANGELOG +++ b/copilot-libraries/CHANGELOG @@ -1,4 +1,5 @@ -2021-10-19 +2021-11-07 + * Version bump (3.6). (#264) * Improve documentation of LTL module. (#131) * Fix outdated/broken links. (#252) diff --git a/copilot-theorem/CHANGELOG b/copilot-theorem/CHANGELOG index bf4c54f52..2d97293a7 100644 --- a/copilot-theorem/CHANGELOG +++ b/copilot-theorem/CHANGELOG @@ -1,4 +1,5 @@ -2021-09-16 +2021-11-07 + * Version bump (3.6). (#264) * Fix outdated/broken links. (#252) 2021-08-19 diff --git a/copilot/CHANGELOG b/copilot/CHANGELOG index b1293dca1..bb564afc1 100644 --- a/copilot/CHANGELOG +++ b/copilot/CHANGELOG @@ -1,8 +1,9 @@ -2021-09-16 +2021-11-07 + * Version bump (3.6). (#264) * Fix missing dependency in example executable. (#252) * Fix outdated/broken links. (#252) * Update installation instructions in README to - match new repo structure. (#248) + match new repo structure. (#248) 2021-08-19 * Version bump (3.5). (#247) From 02a39685caa8e6b5db2d59c4b96552cdf50104d0 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 7 Jan 2022 01:56:11 +0100 Subject: [PATCH 0012/1222] Remove deprecated function Copilot.Core.Type.Show.showWit. Refs #282. The function Copilot.Core.Type.Show.showWit was marked as deprecated in Copilot 3.4, so it is ready to be hidden from the interface (it is still needed by a function that is exported). As a consequence, the type ShowWit can now be deprecated, since there is no (public) way to use it. --- copilot-core/src/Copilot/Core/Type/Show.hs | 2 -- 1 file changed, 2 deletions(-) diff --git a/copilot-core/src/Copilot/Core/Type/Show.hs b/copilot-core/src/Copilot/Core/Type/Show.hs index 95930bb7b..35af067cc 100644 --- a/copilot-core/src/Copilot/Core/Type/Show.hs +++ b/copilot-core/src/Copilot/Core/Type/Show.hs @@ -8,7 +8,6 @@ -- | Show Copilot Core types and typed values. module Copilot.Core.Type.Show ( ShowWit (..) - , showWit , showWithType , ShowType(..) , showType @@ -24,7 +23,6 @@ data ShowWit a = Show a => ShowWit -------------------------------------------------------------------------------- -- | Turn a type into a show witness. -{-# DEPRECATED showWit "This function is deprecated in Copilot 3.4." #-} showWit :: Type a -> ShowWit a showWit t = case t of From 40d03748bd0fd244111d1ed5070ccf89cb532cad Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 7 Jan 2022 14:36:38 +0100 Subject: [PATCH 0013/1222] Document changes. Refs #282. [ci skip] --- copilot-core/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-core/CHANGELOG b/copilot-core/CHANGELOG index 3febb1761..ab4cabd57 100644 --- a/copilot-core/CHANGELOG +++ b/copilot-core/CHANGELOG @@ -1,3 +1,6 @@ +2022-01-07 + * Remove Copilot.Core.Type.Show.showWit. (#282) + 2021-11-07 * Version bump (3.6). (#264) * Deprecate Copilot.Core.Type.Dynamic.toDynF and fromDynF. (#269) From 2ec155735ca811ac1e5e3613c3b7b09bc2261500 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 7 Jan 2022 01:56:20 +0100 Subject: [PATCH 0014/1222] Deprecate copilot-core:Copilot.Core.Type.Show.ShowWit. Refs #283. With the removal of copilot-core:Copilot.Core.Type.Show.showWit from the API, the type ShowWit from the same module is no longer needed and can also be deprecated and, in the future, removed/hidden. --- copilot-core/src/Copilot/Core/Type/Show.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/copilot-core/src/Copilot/Core/Type/Show.hs b/copilot-core/src/Copilot/Core/Type/Show.hs index 35af067cc..91bcfbd3d 100644 --- a/copilot-core/src/Copilot/Core/Type/Show.hs +++ b/copilot-core/src/Copilot/Core/Type/Show.hs @@ -18,6 +18,7 @@ import Copilot.Core.Type -------------------------------------------------------------------------------- -- | Witness datatype for showing a value, used by 'showWithType'. +{-# DEPRECATED ShowWit "This type is deprecated in Copilot 3.7." #-} data ShowWit a = Show a => ShowWit -------------------------------------------------------------------------------- From 73a556777cdf69c1de2fb8d140b58b18ad1969c8 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 7 Jan 2022 14:42:31 +0100 Subject: [PATCH 0015/1222] Document changes. Refs #283. [ci skip] --- copilot-core/CHANGELOG | 1 + 1 file changed, 1 insertion(+) diff --git a/copilot-core/CHANGELOG b/copilot-core/CHANGELOG index ab4cabd57..5989dc7c2 100644 --- a/copilot-core/CHANGELOG +++ b/copilot-core/CHANGELOG @@ -1,4 +1,5 @@ 2022-01-07 + * Deprecate Copilot.Core.Type.Show.ShowWit. (#283) * Remove Copilot.Core.Type.Show.showWit. (#282) 2021-11-07 From 3e508fdbff80a73c741d9e81a1374b5c9a051168 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 7 Jan 2022 01:58:54 +0100 Subject: [PATCH 0016/1222] Remove deprecated module copilot-core:Copilot.Core.Locals. Refs #284. The module copilot-core:Copilot.Core.Locals was deprecated in Copilot 3.4. As per our policy, this module can now be removed completely. --- copilot-core/copilot-core.cabal | 1 - copilot-core/src/Copilot/Core/Locals.hs | 99 ------------------------- 2 files changed, 100 deletions(-) delete mode 100644 copilot-core/src/Copilot/Core/Locals.hs diff --git a/copilot-core/copilot-core.cabal b/copilot-core/copilot-core.cabal index 206e7eae8..44a8834f2 100644 --- a/copilot-core/copilot-core.cabal +++ b/copilot-core/copilot-core.cabal @@ -57,7 +57,6 @@ library Copilot.Core.Interpret.Render Copilot.Core.Operators Copilot.Core.Spec - Copilot.Core.Locals Copilot.Core.Type Copilot.Core.Type.Array Copilot.Core.Type.Dynamic diff --git a/copilot-core/src/Copilot/Core/Locals.hs b/copilot-core/src/Copilot/Core/Locals.hs deleted file mode 100644 index 5b096444d..000000000 --- a/copilot-core/src/Copilot/Core/Locals.hs +++ /dev/null @@ -1,99 +0,0 @@ --------------------------------------------------------------------------------- --- Copyright © 2011 National Institute of Aerospace / Galois, Inc. --------------------------------------------------------------------------------- - --- | Let expressions. --- --- Although Copilot is a DSL embedded in Haskell and Haskell does support let --- expressions, we want Copilot to be able to implement explicit sharing, to --- detect when the same stream is being used in multiple places in a --- specification and avoid recomputing it unnecessarily. - -{-# LANGUAGE Trustworthy #-} -{-# LANGUAGE ExistentialQuantification #-} - -module Copilot.Core.Locals - {-# DEPRECATED "This module is deprecated." #-} - ( Loc (..) - , locals - ) where - -import Copilot.Core hiding (toList) -import Data.DList (DList, empty, singleton, append, concat, toList) -import Data.List (nubBy) -import Prelude hiding (concat, foldr) - --------------------------------------------------------------------------------- - --- | A local definition, with a given stream name and stream type. -data Loc = forall a . Loc - { localName :: Name - , localType :: Type a } - --- | Show the underlying stream name. -instance Show Loc where - show Loc { localName = name } = name - --------------------------------------------------------------------------------- - --- | Obtain all the local definitions in a specification. -locals :: Spec -> [Loc] -locals - Spec - { specStreams = streams - , specTriggers = triggers - , specObservers = observers - } = nubBy eqLoc . toList $ - concat (fmap locsStream streams) `append` - concat (fmap locsTrigger triggers) `append` - concat (fmap locsObserver observers) - - where - - eqLoc :: Loc -> Loc -> Bool - eqLoc Loc { localName = name1 } Loc { localName = name2 } = - name1 == name2 - --------------------------------------------------------------------------------- - --- | Obtain all the local definitions in a stream. -locsStream :: Stream -> DList Loc -locsStream Stream { streamExpr = e } = locsExpr e - --------------------------------------------------------------------------------- - --- | Obtain all the local definitions in a trigger. -locsTrigger :: Trigger -> DList Loc -locsTrigger Trigger { triggerGuard = e, triggerArgs = args } = - locsExpr e `append` concat (fmap locsUExpr args) - - where - - locsUExpr :: UExpr -> DList Loc - locsUExpr (UExpr _ e1) = locsExpr e1 - --------------------------------------------------------------------------------- - --- | Obtain all the local definitions in an observer. -locsObserver :: Observer -> DList Loc -locsObserver Observer { observerExpr = e } = locsExpr e - --------------------------------------------------------------------------------- - --- | Obtain all the local definitions in an expression. -locsExpr :: Expr a -> DList Loc -locsExpr e0 = case e0 of - Const _ _ -> empty - Drop _ _ _ -> empty - Local t _ name e1 e2 -> singleton (Loc name t) - `append` locsExpr e1 - `append` locsExpr e2 - Var _ _ -> empty - ExternVar _ _ _ -> empty - Op1 _ e -> locsExpr e - Op2 _ e1 e2 -> locsExpr e1 `append` locsExpr e2 - Op3 _ e1 e2 e3 -> locsExpr e1 `append` locsExpr e2 - `append` locsExpr e3 - Label _ _ e -> locsExpr e - --------------------------------------------------------------------------------- From 0caf8eb3e5c40e853a36a3d4979b2265030192a4 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 7 Jan 2022 14:47:19 +0100 Subject: [PATCH 0017/1222] Document changes. Refs #284. [ci skip] --- copilot-core/CHANGELOG | 1 + 1 file changed, 1 insertion(+) diff --git a/copilot-core/CHANGELOG b/copilot-core/CHANGELOG index 5989dc7c2..96f5b1197 100644 --- a/copilot-core/CHANGELOG +++ b/copilot-core/CHANGELOG @@ -1,4 +1,5 @@ 2022-01-07 + * Remove Copilot.Core.Locals. (#284) * Deprecate Copilot.Core.Type.Show.ShowWit. (#283) * Remove Copilot.Core.Type.Show.showWit. (#282) From f15e116c2e356d5cc6119d60b60438b66bacbc15 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 7 Jan 2022 02:11:47 +0100 Subject: [PATCH 0018/1222] Remove deprecated module copilot-core:Copilot.Core.Type.Eq. Refs #285. The module copilot-core:Copilot.Core.Type.Eq was deprecated in Copilot 3.4. As per our policy, this module can now be removed completely. --- copilot-core/copilot-core.cabal | 1 - copilot-core/src/Copilot/Core/Type/Eq.hs | 79 ------------------------ 2 files changed, 80 deletions(-) delete mode 100644 copilot-core/src/Copilot/Core/Type/Eq.hs diff --git a/copilot-core/copilot-core.cabal b/copilot-core/copilot-core.cabal index 44a8834f2..365f7fd98 100644 --- a/copilot-core/copilot-core.cabal +++ b/copilot-core/copilot-core.cabal @@ -61,7 +61,6 @@ library Copilot.Core.Type.Array Copilot.Core.Type.Dynamic Copilot.Core.Type.Equality - Copilot.Core.Type.Eq Copilot.Core.Type.Show Copilot.Core.Type.Read Copilot.Core.Type.Uninitialized diff --git a/copilot-core/src/Copilot/Core/Type/Eq.hs b/copilot-core/src/Copilot/Core/Type/Eq.hs deleted file mode 100644 index 015c65fdd..000000000 --- a/copilot-core/src/Copilot/Core/Type/Eq.hs +++ /dev/null @@ -1,79 +0,0 @@ --------------------------------------------------------------------------------- --- Copyright © 2011 National Institute of Aerospace / Galois, Inc. --------------------------------------------------------------------------------- - -{-# LANGUAGE Safe #-} -{-# LANGUAGE ExistentialQuantification, GADTs #-} - -module Copilot.Core.Type.Eq - {-# DEPRECATED "This module is deprecated." #-} - ( EqWit (..) - , eqWit - , UVal (..) - ) where - -import Copilot.Core.ErrorInternal (impossible) -import Copilot.Core.Type -import Copilot.Core.Type.Dynamic (fromDyn, toDyn) - --------------------------------------------------------------------------------- - -data EqWit a = Eq a => EqWit - --------------------------------------------------------------------------------- - -eqWit :: Type a -> EqWit a -eqWit t = - case t of - Bool -> EqWit - Int8 -> EqWit - Int16 -> EqWit - Int32 -> EqWit - Int64 -> EqWit - Word8 -> EqWit - Word16 -> EqWit - Word32 -> EqWit - Word64 -> EqWit - Float -> EqWit - Double -> EqWit - --------------------------------------------------------------------------------- - -data UVal = forall a. UVal - { uType :: Type a - , uVal :: a - } - --------------------------------------------------------------------------------- - -instance Eq UVal where - (==) UVal { uType = t1 - , uVal = a } - UVal { uType = t2 - , uVal = b } - = case eqWit t1 of - EqWit -> - case eqWit t2 of - EqWit -> - let dyn1 = toDyn t1 a in - case fromDyn t2 dyn1 of - Nothing -> False - Just x -> - case t1 of - -- Hacks for QuickChecking between C and Haskell - Float -> case t2 of - Float -> approx floatErr x b - _ -> impossible "instance Eq UVal" - "copilot-core" - Double -> case t2 of - Double -> approx doubleErr x b - _ -> impossible "instance Eq UVal" - "copilot-core" - _ -> x == b - where - approx :: (Num a, Ord a) => a -> a -> a -> Bool - approx err x y = x - y < err && y - x < err - floatErr = 0.0001 :: Float - doubleErr = 0.0001 :: Double - --------------------------------------------------------------------------------- From 0bd25aa4c37cdb3341f145402225d2957f55db22 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 7 Jan 2022 14:50:22 +0100 Subject: [PATCH 0019/1222] Document changes. Refs #285. [ci skip] --- copilot-core/CHANGELOG | 1 + 1 file changed, 1 insertion(+) diff --git a/copilot-core/CHANGELOG b/copilot-core/CHANGELOG index 96f5b1197..39005a37e 100644 --- a/copilot-core/CHANGELOG +++ b/copilot-core/CHANGELOG @@ -1,4 +1,5 @@ 2022-01-07 + * Remove Copilot.Core.Type.Eq. (#285) * Remove Copilot.Core.Locals. (#284) * Deprecate Copilot.Core.Type.Show.ShowWit. (#283) * Remove Copilot.Core.Type.Show.showWit. (#282) From 439b2c5004a99353c1cd2c4f9412a21dd2c6e590 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 7 Jan 2022 02:13:10 +0100 Subject: [PATCH 0020/1222] Remove deprecated module copilot-core:Copilot.Core.Type.Read. Refs #286. The module copilot-core:Copilot.Core.Type.Read was deprecated in Copilot 3.4. As per our policy, this module can now be removed completely. --- copilot-core/copilot-core.cabal | 1 - copilot-core/src/Copilot/Core/Type/Read.hs | 53 ---------------------- 2 files changed, 54 deletions(-) delete mode 100644 copilot-core/src/Copilot/Core/Type/Read.hs diff --git a/copilot-core/copilot-core.cabal b/copilot-core/copilot-core.cabal index 365f7fd98..8802e5f2c 100644 --- a/copilot-core/copilot-core.cabal +++ b/copilot-core/copilot-core.cabal @@ -62,7 +62,6 @@ library Copilot.Core.Type.Dynamic Copilot.Core.Type.Equality Copilot.Core.Type.Show - Copilot.Core.Type.Read Copilot.Core.Type.Uninitialized Copilot.Core.PrettyPrint Copilot.Core.PrettyDot diff --git a/copilot-core/src/Copilot/Core/Type/Read.hs b/copilot-core/src/Copilot/Core/Type/Read.hs deleted file mode 100644 index 44b24438f..000000000 --- a/copilot-core/src/Copilot/Core/Type/Read.hs +++ /dev/null @@ -1,53 +0,0 @@ --------------------------------------------------------------------------------- --- Copyright © 2011 National Institute of Aerospace / Galois, Inc. --------------------------------------------------------------------------------- - -{-# LANGUAGE Safe #-} -{-# LANGUAGE ExistentialQuantification, GADTs #-} - -module Copilot.Core.Type.Read - {-# DEPRECATED "This module is deprecated." #-} - ( ReadWit (..) - , readWit - , readWithType - ) where - -import Copilot.Core.Type -import Copilot.Core.ErrorInternal (badUsage) - --------------------------------------------------------------------------------- - -data ReadWit a = Read a => ReadWit - --------------------------------------------------------------------------------- - -readWit :: Type a -> ReadWit a -readWit t = - case t of - Bool -> ReadWit - Int8 -> ReadWit - Int16 -> ReadWit - Int32 -> ReadWit - Int64 -> ReadWit - Word8 -> ReadWit - Word16 -> ReadWit - Word32 -> ReadWit - Word64 -> ReadWit - Float -> ReadWit - Double -> ReadWit - --------------------------------------------------------------------------------- - -readWithType :: Type a -> String -> a -readWithType t str = - case t of - Bool -> case str of - "0" -> False - "1" -> True - x -> badUsage $ "in readWithType in copilot-core: expecting a \"0\" or \"1\" when reading a Boolean value " ++ show x ++ "." - _ -> rd - where - rd = case readWit t of - ReadWit -> read str - --------------------------------------------------------------------------------- From 059cba02f965ce10199602d9cb3f1b0428fbcaf8 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 7 Jan 2022 14:52:49 +0100 Subject: [PATCH 0021/1222] Document changes. Refs #286. [ci skip] --- copilot-core/CHANGELOG | 1 + 1 file changed, 1 insertion(+) diff --git a/copilot-core/CHANGELOG b/copilot-core/CHANGELOG index 39005a37e..be538ae70 100644 --- a/copilot-core/CHANGELOG +++ b/copilot-core/CHANGELOG @@ -1,4 +1,5 @@ 2022-01-07 + * Remove Copilot.Core.Type.Read. (#286) * Remove Copilot.Core.Type.Eq. (#285) * Remove Copilot.Core.Locals. (#284) * Deprecate Copilot.Core.Type.Show.ShowWit. (#283) From af0751bf568f259a941e67f0575f0b1afdd8ce93 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 7 Jan 2022 03:35:59 +0100 Subject: [PATCH 0022/1222] Bring back externF. Refs #261. Currently, copilot-language offers an externD function for defining external streams of Doubles, but not one for Floats. This function was removed, possibly by mistake, when externFun was removed. This commit brings back that implementation. --- copilot-language/src/Copilot/Language/Operators/Extern.hs | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/copilot-language/src/Copilot/Language/Operators/Extern.hs b/copilot-language/src/Copilot/Language/Operators/Extern.hs index 1794a5024..550ca1ee0 100644 --- a/copilot-language/src/Copilot/Language/Operators/Extern.hs +++ b/copilot-language/src/Copilot/Language/Operators/Extern.hs @@ -17,6 +17,7 @@ module Copilot.Language.Operators.Extern , externI16 , externI32 , externI64 + , externF , externD ) where @@ -111,6 +112,13 @@ externI64 :: String -- ^ Name of the global variable to make accessible. -> Stream Int64 externI64 = extern +-- | Create a stream carrying values of type Float, populated by an external +-- global variable. +externF :: String -- ^ Name of the global variable to make accessible. + -> Maybe [Float] -- ^ Values to be used exclusively for testing/simulation. + -> Stream Float +externF = extern + -- | Create a stream carrying values of type Double, populated by an external -- global variable. externD :: String -- ^ Name of the global variable to make accessible. From a8025d985ed09954e3509a03a0d41cd0b063234e Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 7 Jan 2022 14:57:16 +0100 Subject: [PATCH 0023/1222] Document changes. Refs #261. [ci skip] --- copilot-language/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-language/CHANGELOG b/copilot-language/CHANGELOG index 4e70a8b59..a04007388 100644 --- a/copilot-language/CHANGELOG +++ b/copilot-language/CHANGELOG @@ -1,3 +1,6 @@ +2022-01-07 + * Bring back externF. (#261) + 2021-11-07 * Version bump (3.6). (#264) * Replace uses of copilot-core's error reporting functions. (#267) From dc5f9bbd3234c417717d6082c0f0f9b2045ab632 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 7 Jan 2022 02:55:45 +0100 Subject: [PATCH 0024/1222] Make imports explicit. Reorganize imports. Refs #277. Copilot currently fails to compile with newer versions of GHC because there are new definitions in base that clash with definitions in Copilot. This commit re-organizes imports in the copilot-core:Copilot.Core.Interpret.Eval module, and makes imports explicit, to prevent future additions in base to clash with definitions in Copilot. --- .../src/Copilot/Core/Interpret/Eval.hs | 21 +++++++++++-------- 1 file changed, 12 insertions(+), 9 deletions(-) diff --git a/copilot-core/src/Copilot/Core/Interpret/Eval.hs b/copilot-core/src/Copilot/Core/Interpret/Eval.hs index c7ea0c5e9..81d3bd6ed 100644 --- a/copilot-core/src/Copilot/Core/Interpret/Eval.hs +++ b/copilot-core/src/Copilot/Core/Interpret/Eval.hs @@ -14,20 +14,23 @@ module Copilot.Core.Interpret.Eval , eval ) where -import Copilot.Core hiding (badUsage) +import Copilot.Core (Expr (..), Field (..), Id, Name, + Observer (..), Op1 (..), Op2 (..), Op3 (..), + Spec, Stream (..), Trigger (..), + Type (Struct), UExpr (..), arrayelems, + specObservers, specStreams, specTriggers) import Copilot.Core.ErrorInternal (badUsage) -import Copilot.Core.Type.Show (showWithType, ShowType) +import Copilot.Core.Type.Show (ShowType, showWithType) -import Prelude hiding (id) +import Prelude hiding (id) import qualified Prelude as P -import Data.List (transpose) -import Data.Maybe (fromJust) -import Data.Bits import Control.Exception (Exception, throw) - -import Data.Dynamic (Dynamic, fromDynamic, toDyn) -import Data.Typeable (Typeable) +import Data.Bits (complement, shiftL, shiftR, xor, (.&.), (.|.)) +import Data.Dynamic (Dynamic, fromDynamic, toDyn) +import Data.List (transpose) +import Data.Maybe (fromJust) +import Data.Typeable (Typeable) -------------------------------------------------------------------------------- From 779e0857efd60f89c6bc48c0a77b1c2389b1cb8b Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 7 Jan 2022 15:12:41 +0100 Subject: [PATCH 0025/1222] Document changes. Refs #277. [ci skip] --- copilot-core/CHANGELOG | 1 + 1 file changed, 1 insertion(+) diff --git a/copilot-core/CHANGELOG b/copilot-core/CHANGELOG index be538ae70..7cb185d02 100644 --- a/copilot-core/CHANGELOG +++ b/copilot-core/CHANGELOG @@ -1,4 +1,5 @@ 2022-01-07 + * Make imports explicit, reorganize imports. (#277) * Remove Copilot.Core.Type.Read. (#286) * Remove Copilot.Core.Type.Eq. (#285) * Remove Copilot.Core.Locals. (#284) From 0176239536b392a67d946a488b62c39297864cef Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 7 Jan 2022 03:30:03 +0100 Subject: [PATCH 0026/1222] Relax version constraints on what4. Refs #277. Copilot-theorem fails to install with GHC 9 because it depends on an older version of what4. This commit relaxes the version contraints on what4 to allow installation of newer versions. --- copilot-theorem/copilot-theorem.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot-theorem/copilot-theorem.cabal b/copilot-theorem/copilot-theorem.cabal index 158ee5996..42a906d47 100644 --- a/copilot-theorem/copilot-theorem.cabal +++ b/copilot-theorem/copilot-theorem.cabal @@ -70,7 +70,7 @@ library , random >= 1.1 && < 1.2 , transformers >= 0.5 && < 0.6 , xml >= 1.3 && < 1.4 - , what4 >= 1.1 && < 1.2 + , what4 >= 1.1 && < 1.3 , copilot-core >= 3.6 && < 3.7 From 2c06e1e4ed8547b2b9dc7893e475302400fc1da5 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 7 Jan 2022 15:12:52 +0100 Subject: [PATCH 0027/1222] Document changes. Refs #277. [ci skip] --- copilot-theorem/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-theorem/CHANGELOG b/copilot-theorem/CHANGELOG index 2d97293a7..f765d69b3 100644 --- a/copilot-theorem/CHANGELOG +++ b/copilot-theorem/CHANGELOG @@ -1,3 +1,6 @@ +2022-01-07 + * Relax version contraints on what4. (#277) + 2021-11-07 * Version bump (3.6). (#264) * Fix outdated/broken links. (#252) From c60f3fc8a339c9ad571f83aa615b05385e84234d Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 7 Jan 2022 03:59:37 +0100 Subject: [PATCH 0028/1222] Guard against compilation to C of specs without triggers. Refs #274. Presently, copilot crashes when trying to compile an empty spec (one without triggers) to C99. The error message emerges from a use of fromList on an empty list in language-c99-simple, which does not help Copilot users understand what failed, or how to fix it. This commit checks for specs without triggers when trying to compile to C99, and produces a more meaningful error message. --- .../Copilot/Compile/C99/Compile/Internal.hs | 51 +++++++++++-------- 1 file changed, 30 insertions(+), 21 deletions(-) diff --git a/copilot-c99/src/Copilot/Compile/C99/Compile/Internal.hs b/copilot-c99/src/Copilot/Compile/C99/Compile/Internal.hs index e2e0d6f41..a12b0e205 100644 --- a/copilot-c99/src/Copilot/Compile/C99/Compile/Internal.hs +++ b/copilot-c99/src/Copilot/Compile/C99/Compile/Internal.hs @@ -8,7 +8,9 @@ import Text.PrettyPrint (render) import Data.List (nub) import Data.Maybe (catMaybes) import System.Directory (createDirectoryIfMissing) +import System.Exit (exitFailure) import System.FilePath (()) +import System.IO (hPutStrLn, stderr) import Language.C99.Pretty (pretty) import qualified Language.C99.Simple as C @@ -26,27 +28,34 @@ import Copilot.Compile.C99.CodeGen -- -- The second argument is used as prefix for the .h and .c files generated. compileWith :: CSettings -> String -> Spec -> IO () -compileWith cSettings prefix spec = do - let cfile = render $ pretty $ C.translate $ compilec cSettings spec - hfile = render $ pretty $ C.translate $ compileh cSettings spec - - -- TODO: find a nicer solution using annotated AST's - -- Should figure out exactly which headers are needed, based on what - -- is used. - cmacros = unlines [ "#include " - , "#include " - , "#include " - , "#include " - , "#include " - , "" - , "#include \"" ++ prefix ++ ".h\"" - , "" - ] - - let dir = cSettingsOutputDirectory cSettings - createDirectoryIfMissing True dir - writeFile (dir prefix ++ ".c") $ cmacros ++ cfile - writeFile (dir prefix ++ ".h") hfile +compileWith cSettings prefix spec + | null (specTriggers spec) + = do hPutStrLn stderr $ + "Copilot error: attempt at compiling empty specification.\n" + ++ "You must define at least one trigger to generate C monitors." + exitFailure + + | otherwise + = do let cfile = render $ pretty $ C.translate $ compilec cSettings spec + hfile = render $ pretty $ C.translate $ compileh cSettings spec + + -- TODO: find a nicer solution using annotated AST's + -- Should figure out exactly which headers are needed, based on what + -- is used. + cmacros = unlines [ "#include " + , "#include " + , "#include " + , "#include " + , "#include " + , "" + , "#include \"" ++ prefix ++ ".h\"" + , "" + ] + + let dir = cSettingsOutputDirectory cSettings + createDirectoryIfMissing True dir + writeFile (dir prefix ++ ".c") $ cmacros ++ cfile + writeFile (dir prefix ++ ".h") hfile -- | Compile a specification to a .h and a .c file. -- From c24a0cbf6c6a0aa56e56d29216dc3d77981a5dba Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 7 Jan 2022 15:19:22 +0100 Subject: [PATCH 0029/1222] Document changes. Refs #274. [ci skip] --- copilot-c99/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-c99/CHANGELOG b/copilot-c99/CHANGELOG index 3f489f622..d186bc80a 100644 --- a/copilot-c99/CHANGELOG +++ b/copilot-c99/CHANGELOG @@ -1,3 +1,6 @@ +2022-01-07 + * Guard against empty specs. (#274) + 2021-11-07 * Version bump (3.6). (#264) * Introduce new ops atan2, ceiling, floor. (#246) From 6f1ef0c175939d99ef19a6150bbd760e01b6eabd Mon Sep 17 00:00:00 2001 From: Ryan Scott Date: Fri, 12 Nov 2021 09:20:08 -0500 Subject: [PATCH 0030/1222] copilot-c99: Make typetypes respect dependency order. Refs #275. The function that generates C99 is not generating struct definitions for all nested structs in a specification. The issue stems from the way in which the function `copilot-c99:Copilot.Compile.C99.CodeGen.typetypes`, computes all of the types mentioned in a type. Issue #275 revealed two issues with the way `typetypes` was handling its `Struct` case: 1. It was not recursively computing the types mentioned in the fields of a struct. This means that if a struct type had a field whose type transitively used a struct type, the latter struct type would not have a struct declaration generated at all. As a consequence, the generated C code would fail to compile. 2. Moreover, even in cases where `typetypes` _did_ compute all of the struct types mentioned in a program, it would sometimes generate the corresponding struct declarations in the wrong order. This is because `typetypes` would return the overall type of a struct _before_ any of the types mentioned in its fields. As a result, some generated C programs would have a struct field whose type mentions a struct that had not been declared yet (since that declaration would appear later in the file), also causing the program to fail to compile. This patch fixes both issues: 1. `typetypes` now recursively invokes itself on the result of calling `toValues` on a `Struct` type. 2. `typetypes` now returns the overall type of a `Struct` _after_ the types that are transitively mentioned in the fields of the struct. I also applied the fix for (2) to the `Array` case as well for uniformity. Commit message edited by Ivan Perez. --- copilot-c99/src/Copilot/Compile/C99/CodeGen.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs b/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs index 61bb68ca9..9d8c6ed20 100644 --- a/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs +++ b/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs @@ -165,8 +165,8 @@ exprtypes e = case e of -- | List all types of a type, returns items uniquely. typetypes :: Typeable a => Type a -> [UType] typetypes ty = case ty of - Array ty' -> [UType ty] `union` typetypes ty' - Struct x -> [UType ty] `union` map (\(Value ty' _) -> UType ty') (toValues x) + Array ty' -> typetypes ty' `union` [UType ty] + Struct x -> concatMap (\(Value ty' _) -> typetypes ty') (toValues x) `union` [UType ty] _ -> [UType ty] -- | Collect all expression of a list of streams and triggers and wrap them From 692fa3512c448878e0f0d0a5666c65af760176d0 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 7 Jan 2022 18:20:14 +0100 Subject: [PATCH 0031/1222] Document changes. Refs #275. [ci skip] --- copilot-c99/CHANGELOG | 1 + 1 file changed, 1 insertion(+) diff --git a/copilot-c99/CHANGELOG b/copilot-c99/CHANGELOG index d186bc80a..42bf19d27 100644 --- a/copilot-c99/CHANGELOG +++ b/copilot-c99/CHANGELOG @@ -1,5 +1,6 @@ 2022-01-07 * Guard against empty specs. (#274) + * Make typetypes respect dependency order. (#275) 2021-11-07 * Version bump (3.6). (#264) From 7f7b9d7fcd3c3b46c170054a3a4389e12b087a94 Mon Sep 17 00:00:00 2001 From: Ryan Scott Date: Wed, 8 Dec 2021 09:27:27 -0500 Subject: [PATCH 0032/1222] Add example with nested structs. Refs #275. This commit adds a new example that contains nested structs. It is similar to the `what4-structs` example, except that this example replaces the What4 properties with triggers, and instead of verifying properties, this example compiles the specification to C code using `copilot-c99`. This example can be used to check for the fix to #275, since the code generated by Copilot will be incomplete (the struct definition for 'volts' will be missing without the fix). Comment partly edited by Ivan Perez. --- copilot/copilot.cabal | 12 ++++++ copilot/examples/Structs.hs | 75 +++++++++++++++++++++++++++++++++++++ 2 files changed, 87 insertions(+) create mode 100644 copilot/examples/Structs.hs diff --git a/copilot/copilot.cabal b/copilot/copilot.cabal index 52fb000b9..a2d57fb4f 100644 --- a/copilot/copilot.cabal +++ b/copilot/copilot.cabal @@ -192,6 +192,18 @@ executable heater else buildable: False +executable structs + main-is: Structs.hs + hs-source-dirs: examples + build-depends: base >= 4.9 && < 5 + , copilot + , copilot-c99 + default-language: Haskell2010 + if flag(examples) + buildable: True + else + buildable: False + executable voting main-is: Voting.hs hs-source-dirs: examples diff --git a/copilot/examples/Structs.hs b/copilot/examples/Structs.hs new file mode 100644 index 000000000..9d345ccc3 --- /dev/null +++ b/copilot/examples/Structs.hs @@ -0,0 +1,75 @@ +-- | An example showing how specifications involving structs (in particular, +-- nested structs) are compiled to C using copilot-c99. + +{-# LANGUAGE DataKinds #-} + +module Main where + +import qualified Prelude as P +import Control.Monad (void, forM_) + +import Language.Copilot +import Copilot.Compile.C99 + + +-- | Definition for `Volts`. +data Volts = Volts + { numVolts :: Field "numVolts" Word16 + , flag :: Field "flag" Bool + } + +-- | `Struct` instance for `Volts`. +instance Struct Volts where + typename _ = "volts" + toValues volts = [ Value Word16 (numVolts volts) + , Value Bool (flag volts) + ] + +-- | `Volts` instance for `Typed`. +instance Typed Volts where + typeOf = Struct (Volts (Field 0) (Field False)) + +data Battery = Battery + { temp :: Field "temp" Word16 + , volts :: Field "volts" (Array 10 Volts) + , other :: Field "other" (Array 10 (Array 5 Word32)) + } + +-- | `Battery` instance for `Struct`. +instance Struct Battery where + typename _ = "battery" + toValues battery = [ Value typeOf (temp battery) + , Value typeOf (volts battery) + , Value typeOf (other battery) + ] + +-- | `Battery` instance for `Typed`. Note that `undefined` is used as an +-- argument to `Field`. This argument is never used, so `undefined` will never +-- throw an error. +instance Typed Battery where + typeOf = Struct (Battery (Field 0) (Field undefined) (Field undefined)) + +spec :: Spec +spec = do + let battery :: Stream Battery + battery = extern "battery" Nothing + + -- Check equality, indexing into nested structs and arrays. Note that this is + -- trivial by equality. + trigger "equalitySameIndex" + ((((battery#volts) .!! 0)#numVolts) == (((battery#volts) .!! 0)#numVolts)) + [arg battery] + + -- Same as previous example, but get a different array index (so should be + -- false). + trigger "equalityDifferentIndices" + ((((battery#other) .!! 2) .!! 3) == (((battery#other) .!! 2) .!! 4)) + [arg battery] + + +main :: IO () +main = do + spec' <- reify spec + + -- Compile the specific to C. + compile "structs" spec' From 89551417ccb72b9b2b9cdf2e81a66cbf9cbd914a Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 7 Jan 2022 18:19:27 +0100 Subject: [PATCH 0033/1222] Document changes. Refs #275. [ci skip] --- copilot/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot/CHANGELOG b/copilot/CHANGELOG index bb564afc1..2591b1d94 100644 --- a/copilot/CHANGELOG +++ b/copilot/CHANGELOG @@ -1,3 +1,6 @@ +2022-01-07 + * Add example with nested structs. (#275) + 2021-11-07 * Version bump (3.6). (#264) * Fix missing dependency in example executable. (#252) From 883162badb3276fcd5f15c3c2883ad3c30bf8c6e Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 7 Jan 2022 23:57:59 +0100 Subject: [PATCH 0034/1222] Bump versions and constraints (3.7). Refs #287. --- copilot-c99/copilot-c99.cabal | 4 ++-- copilot-core/copilot-core.cabal | 2 +- copilot-language/copilot-language.cabal | 6 +++--- copilot-libraries/copilot-libraries.cabal | 4 ++-- copilot-theorem/copilot-theorem.cabal | 4 ++-- copilot/copilot.cabal | 12 ++++++------ 6 files changed, 16 insertions(+), 16 deletions(-) diff --git a/copilot-c99/copilot-c99.cabal b/copilot-c99/copilot-c99.cabal index 1d65d3d8f..5a5ecab24 100644 --- a/copilot-c99/copilot-c99.cabal +++ b/copilot-c99/copilot-c99.cabal @@ -1,6 +1,6 @@ cabal-version : >= 1.10 name : copilot-c99 -version : 3.6 +version : 3.7 synopsis : A compiler for Copilot targeting C99. description : This package is a back-end from Copilot to C. @@ -48,7 +48,7 @@ library , mtl >= 2.2 && < 2.3 , pretty >= 1.1 && < 1.2 - , copilot-core >= 3.6 && < 3.7 + , copilot-core >= 3.7 && < 3.8 , language-c99 >= 0.1.1 && < 0.2 , language-c99-util >= 0.1.1 && < 0.2 , language-c99-simple >= 0.1.1 && < 0.2 diff --git a/copilot-core/copilot-core.cabal b/copilot-core/copilot-core.cabal index 8802e5f2c..0575c59da 100644 --- a/copilot-core/copilot-core.cabal +++ b/copilot-core/copilot-core.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-core -version: 3.6 +version: 3.7 synopsis: An intermediate representation for Copilot. description: Intermediate representation for Copilot. diff --git a/copilot-language/copilot-language.cabal b/copilot-language/copilot-language.cabal index cca48670a..f235686ba 100644 --- a/copilot-language/copilot-language.cabal +++ b/copilot-language/copilot-language.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-language -version: 3.6 +version: 3.7 synopsis: A Haskell-embedded DSL for monitoring hard real-time distributed systems. description: @@ -40,8 +40,8 @@ library , data-reify >= 0.6 && < 0.7 , mtl >= 2.0 && < 3 - , copilot-core >= 3.6 && < 3.7 - , copilot-theorem >= 3.6 && < 3.7 + , copilot-core >= 3.7 && < 3.8 + , copilot-theorem >= 3.7 && < 3.8 exposed-modules: Copilot , Copilot.Language diff --git a/copilot-libraries/copilot-libraries.cabal b/copilot-libraries/copilot-libraries.cabal index ca2703893..a2752713a 100644 --- a/copilot-libraries/copilot-libraries.cabal +++ b/copilot-libraries/copilot-libraries.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-libraries -version: 3.6 +version: 3.7 synopsis: Libraries for the Copilot language. description: Libraries for the Copilot language. @@ -41,7 +41,7 @@ library , data-reify >= 0.6 && < 0.7 , mtl >= 2.0 && < 2.3 , parsec >= 2.0 && < 3.2 - , copilot-language >= 3.6 && < 3.7 + , copilot-language >= 3.7 && < 3.8 exposed-modules: Copilot.Library.Libraries diff --git a/copilot-theorem/copilot-theorem.cabal b/copilot-theorem/copilot-theorem.cabal index 42a906d47..e17efc1e3 100644 --- a/copilot-theorem/copilot-theorem.cabal +++ b/copilot-theorem/copilot-theorem.cabal @@ -14,7 +14,7 @@ description: . -version : 3.6 +version : 3.7 license : BSD3 license-file : LICENSE maintainer : Ivan Perez @@ -72,7 +72,7 @@ library , xml >= 1.3 && < 1.4 , what4 >= 1.1 && < 1.3 - , copilot-core >= 3.6 && < 3.7 + , copilot-core >= 3.7 && < 3.8 exposed-modules : Copilot.Theorem , Copilot.Theorem.Prove diff --git a/copilot/copilot.cabal b/copilot/copilot.cabal index a2d57fb4f..82235f082 100644 --- a/copilot/copilot.cabal +++ b/copilot/copilot.cabal @@ -1,5 +1,5 @@ name: copilot -version: 3.6 +version: 3.7 cabal-version: >= 1.10 license: BSD3 license-file: LICENSE @@ -50,11 +50,11 @@ library , directory >= 1.3 && < 1.4 , filepath >= 1.4 && < 1.5 - , copilot-core >= 3.6 && < 3.7 - , copilot-theorem >= 3.6 && < 3.7 - , copilot-language >= 3.6 && < 3.7 - , copilot-libraries >= 3.6 && < 3.7 - , copilot-c99 >= 3.6 && < 3.7 + , copilot-core >= 3.7 && < 3.8 + , copilot-theorem >= 3.7 && < 3.8 + , copilot-language >= 3.7 && < 3.8 + , copilot-libraries >= 3.7 && < 3.8 + , copilot-c99 >= 3.7 && < 3.8 exposed-modules: Language.Copilot, Language.Copilot.Main From 19961fbd9d2c3dadbc8dbcb86a32e9fa0166aa6e Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 7 Jan 2022 23:59:35 +0100 Subject: [PATCH 0035/1222] Document version bump change. Refs #287. --- copilot-c99/CHANGELOG | 1 + copilot-core/CHANGELOG | 1 + copilot-language/CHANGELOG | 1 + copilot-libraries/CHANGELOG | 3 +++ copilot-theorem/CHANGELOG | 1 + copilot/CHANGELOG | 1 + 6 files changed, 8 insertions(+) diff --git a/copilot-c99/CHANGELOG b/copilot-c99/CHANGELOG index 42bf19d27..952e50f94 100644 --- a/copilot-c99/CHANGELOG +++ b/copilot-c99/CHANGELOG @@ -1,4 +1,5 @@ 2022-01-07 + * Version bump (3.7). (#287) * Guard against empty specs. (#274) * Make typetypes respect dependency order. (#275) diff --git a/copilot-core/CHANGELOG b/copilot-core/CHANGELOG index 7cb185d02..b426f8e3e 100644 --- a/copilot-core/CHANGELOG +++ b/copilot-core/CHANGELOG @@ -1,4 +1,5 @@ 2022-01-07 + * Version bump (3.7). (#287) * Make imports explicit, reorganize imports. (#277) * Remove Copilot.Core.Type.Read. (#286) * Remove Copilot.Core.Type.Eq. (#285) diff --git a/copilot-language/CHANGELOG b/copilot-language/CHANGELOG index a04007388..0ba2a14e2 100644 --- a/copilot-language/CHANGELOG +++ b/copilot-language/CHANGELOG @@ -1,4 +1,5 @@ 2022-01-07 + * Version bump (3.7). (#287) * Bring back externF. (#261) 2021-11-07 diff --git a/copilot-libraries/CHANGELOG b/copilot-libraries/CHANGELOG index fc00b26c7..04d189dc0 100644 --- a/copilot-libraries/CHANGELOG +++ b/copilot-libraries/CHANGELOG @@ -1,3 +1,6 @@ +2022-01-07 + * Version bump (3.7). (#287) + 2021-11-07 * Version bump (3.6). (#264) * Improve documentation of LTL module. (#131) diff --git a/copilot-theorem/CHANGELOG b/copilot-theorem/CHANGELOG index f765d69b3..6d331fb49 100644 --- a/copilot-theorem/CHANGELOG +++ b/copilot-theorem/CHANGELOG @@ -1,4 +1,5 @@ 2022-01-07 + * Version bump (3.7). (#287) * Relax version contraints on what4. (#277) 2021-11-07 diff --git a/copilot/CHANGELOG b/copilot/CHANGELOG index 2591b1d94..a3ffb4ec8 100644 --- a/copilot/CHANGELOG +++ b/copilot/CHANGELOG @@ -1,4 +1,5 @@ 2022-01-07 + * Version bump (3.7). (#287) * Add example with nested structs. (#275) 2021-11-07 From 6052c64d56382df66c3db357a489e43fd9844fe2 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Wed, 12 Jan 2022 18:21:58 +0100 Subject: [PATCH 0036/1222] Mark packages as uncurated. Refs #288. Packages should be published exactly as we have, without further modifications, and nobody outside our project should make any changes without our explicit authorization. As of currently, the Hackage "policy" (whatever that means) implies that Hackage maintainers should be able to correct issues with the cabal files. This is against our own policies. This commit sets the field `x-curation` to `uncurated` in the cabal files of all libraries in the Copilot project, to indicate to Hackage maintainers that our packages are to be left untouched. --- copilot-c99/copilot-c99.cabal | 2 ++ copilot-core/copilot-core.cabal | 2 ++ copilot-language/copilot-language.cabal | 2 ++ copilot-libraries/copilot-libraries.cabal | 2 ++ copilot-theorem/copilot-theorem.cabal | 2 ++ copilot/copilot.cabal | 2 ++ 6 files changed, 12 insertions(+) diff --git a/copilot-c99/copilot-c99.cabal b/copilot-c99/copilot-c99.cabal index 5a5ecab24..e02ae4ad7 100644 --- a/copilot-c99/copilot-c99.cabal +++ b/copilot-c99/copilot-c99.cabal @@ -27,6 +27,8 @@ author : Frank Dedden , Alwyn Goodloe , Ivan Perez +x-curation: uncurated + source-repository head type: git location: git://github.com/Copilot-Language/copilot.git diff --git a/copilot-core/copilot-core.cabal b/copilot-core/copilot-core.cabal index 0575c59da..c9d40fb56 100644 --- a/copilot-core/copilot-core.cabal +++ b/copilot-core/copilot-core.cabal @@ -24,6 +24,8 @@ category: Language, Embedded build-type: Simple extra-source-files: README.md, CHANGELOG +x-curation: uncurated + source-repository head type: git location: https://github.com/Copilot-Language/copilot.git diff --git a/copilot-language/copilot-language.cabal b/copilot-language/copilot-language.cabal index f235686ba..d92b276f0 100644 --- a/copilot-language/copilot-language.cabal +++ b/copilot-language/copilot-language.cabal @@ -25,6 +25,8 @@ category: Language, Embedded build-type: Simple extra-source-files: README.md, CHANGELOG +x-curation: uncurated + source-repository head type: git location: https://github.com/Copilot-Language/copilot.git diff --git a/copilot-libraries/copilot-libraries.cabal b/copilot-libraries/copilot-libraries.cabal index a2752713a..143a70b87 100644 --- a/copilot-libraries/copilot-libraries.cabal +++ b/copilot-libraries/copilot-libraries.cabal @@ -24,6 +24,8 @@ category: Language, Embedded build-type: Simple extra-source-files: README.md, CHANGELOG +x-curation: uncurated + source-repository head type: git location: git://github.com/Copilot-Language/copilot.git diff --git a/copilot-theorem/copilot-theorem.cabal b/copilot-theorem/copilot-theorem.cabal index e17efc1e3..2cb4110d9 100644 --- a/copilot-theorem/copilot-theorem.cabal +++ b/copilot-theorem/copilot-theorem.cabal @@ -28,6 +28,8 @@ extra-source-files : README.md author : Jonathan Laurent +x-curation: uncurated + library default-language : Haskell2010 hs-source-dirs : src diff --git a/copilot/copilot.cabal b/copilot/copilot.cabal index 82235f082..5a38e3e65 100644 --- a/copilot/copilot.cabal +++ b/copilot/copilot.cabal @@ -24,6 +24,8 @@ description: A tutorial, examples, and other information are available at . +x-curation: uncurated + extra-source-files: README.md CHANGELOG From f4f2c2a4edf93f3f374253841aad2853fa0bef22 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Wed, 12 Jan 2022 18:51:04 +0100 Subject: [PATCH 0037/1222] Hide internal modules in copilot-c99. Refs #289. The internal modules in copilot-c99 were deprecated in Copilot 3.5, and can now be hidden. This commit modifies the cabal file so that the modules are no longer exposed directly. --- copilot-c99/copilot-c99.cabal | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/copilot-c99/copilot-c99.cabal b/copilot-c99/copilot-c99.cabal index e02ae4ad7..dd755fb39 100644 --- a/copilot-c99/copilot-c99.cabal +++ b/copilot-c99/copilot-c99.cabal @@ -56,12 +56,12 @@ library , language-c99-simple >= 0.1.1 && < 0.2 exposed-modules : Copilot.Compile.C99 - , Copilot.Compile.C99.Translate - , Copilot.Compile.C99.Util - , Copilot.Compile.C99.CodeGen - , Copilot.Compile.C99.External - , Copilot.Compile.C99.Compile - , Copilot.Compile.C99.Settings - other-modules : Copilot.Compile.C99.Compile.Internal + other-modules : Copilot.Compile.C99.Translate + , Copilot.Compile.C99.Util + , Copilot.Compile.C99.CodeGen + , Copilot.Compile.C99.External + , Copilot.Compile.C99.Compile + , Copilot.Compile.C99.Settings + , Copilot.Compile.C99.Compile.Internal , Copilot.Compile.C99.Settings.Internal From 17cd3f2efa48523ca9b22e9f71c0f22dc0947687 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Wed, 12 Jan 2022 18:56:05 +0100 Subject: [PATCH 0038/1222] Replace exposed modules with old internal implementations. Refs #289. In a prior commit, internal implementations had been moved to a separate module so that modules that were not going to be exposed directly could be deprecated safely without triggering warnings when compiling copilot-c99. With the concealment of the library's implementation, those additional internal modules can return to where they were. This commit renames the modules to have their original names, adjusts imports, and the cabal file so that the modules removed are no longer listed in the library. --- copilot-c99/copilot-c99.cabal | 2 - copilot-c99/src/Copilot/Compile/C99.hs | 4 +- .../src/Copilot/Compile/C99/Compile.hs | 158 ++++++++++++++++- .../Copilot/Compile/C99/Compile/Internal.hs | 159 ------------------ .../src/Copilot/Compile/C99/Settings.hs | 14 +- .../Copilot/Compile/C99/Settings/Internal.hs | 12 -- 6 files changed, 164 insertions(+), 185 deletions(-) delete mode 100644 copilot-c99/src/Copilot/Compile/C99/Compile/Internal.hs delete mode 100644 copilot-c99/src/Copilot/Compile/C99/Settings/Internal.hs diff --git a/copilot-c99/copilot-c99.cabal b/copilot-c99/copilot-c99.cabal index dd755fb39..d30f219a7 100644 --- a/copilot-c99/copilot-c99.cabal +++ b/copilot-c99/copilot-c99.cabal @@ -63,5 +63,3 @@ library , Copilot.Compile.C99.External , Copilot.Compile.C99.Compile , Copilot.Compile.C99.Settings - , Copilot.Compile.C99.Compile.Internal - , Copilot.Compile.C99.Settings.Internal diff --git a/copilot-c99/src/Copilot/Compile/C99.hs b/copilot-c99/src/Copilot/Compile/C99.hs index 41b64c71c..3602fa6f1 100644 --- a/copilot-c99/src/Copilot/Compile/C99.hs +++ b/copilot-c99/src/Copilot/Compile/C99.hs @@ -6,5 +6,5 @@ module Copilot.Compile.C99 , mkDefaultCSettings ) where -import Copilot.Compile.C99.Compile.Internal -import Copilot.Compile.C99.Settings.Internal +import Copilot.Compile.C99.Compile +import Copilot.Compile.C99.Settings diff --git a/copilot-c99/src/Copilot/Compile/C99/Compile.hs b/copilot-c99/src/Copilot/Compile/C99/Compile.hs index 2a06ee385..244e60d12 100644 --- a/copilot-c99/src/Copilot/Compile/C99/Compile.hs +++ b/copilot-c99/src/Copilot/Compile/C99/Compile.hs @@ -1,11 +1,159 @@ -- | Compile Copilot specifications to C99 code. module Copilot.Compile.C99.Compile - {-# DEPRECATED "This module will be hidden in future versions." #-} ( compile , compileWith - , CSettings(..) - , mkDefaultCSettings ) where -import Copilot.Compile.C99.Compile.Internal -import Copilot.Compile.C99.Settings.Internal +import Text.PrettyPrint (render) +import Data.List (nub) +import Data.Maybe (catMaybes) +import System.Directory (createDirectoryIfMissing) +import System.Exit (exitFailure) +import System.FilePath (()) +import System.IO (hPutStrLn, stderr) + +import Language.C99.Pretty (pretty) +import qualified Language.C99.Simple as C + +import Copilot.Core +import Copilot.Compile.C99.Util +import Copilot.Compile.C99.External +import Copilot.Compile.C99.Settings +import Copilot.Compile.C99.Translate +import Copilot.Compile.C99.CodeGen + +-- | Compile a specification to a .h and a .c file. +-- +-- The first argument is the settings for the C code generated. +-- +-- 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) + = do hPutStrLn stderr $ + "Copilot error: attempt at compiling empty specification.\n" + ++ "You must define at least one trigger to generate C monitors." + exitFailure + + | otherwise + = do let cfile = render $ pretty $ C.translate $ compilec cSettings spec + hfile = render $ pretty $ C.translate $ compileh cSettings spec + + -- TODO: find a nicer solution using annotated AST's + -- Should figure out exactly which headers are needed, based on what + -- is used. + cmacros = unlines [ "#include " + , "#include " + , "#include " + , "#include " + , "#include " + , "" + , "#include \"" ++ prefix ++ ".h\"" + , "" + ] + + let dir = cSettingsOutputDirectory cSettings + createDirectoryIfMissing True dir + writeFile (dir prefix ++ ".c") $ cmacros ++ cfile + writeFile (dir prefix ++ ".h") hfile + +-- | Compile a specification to a .h and a .c file. +-- +-- The first argument is used as prefix for the .h and .c files generated. +compile :: String -> Spec -> IO () +compile = compileWith mkDefaultCSettings + +-- | Generate the .c file from a 'Spec'. +-- +-- The generated C file has the following structure: +-- +-- * Include .h file. +-- * Declarations of global buffers and indices. +-- * Generator functions for streams, guards and trigger arguments. +-- * Declaration of the @step()@ function. +compilec :: CSettings -> Spec -> C.TransUnit +compilec cSettings spec = C.TransUnit declns funs where + streams = specStreams spec + triggers = specTriggers spec + exts = gatherexts streams triggers + exprs = gatherexprs streams triggers + + declns = mkstructdeclns exprs ++ mkexts exts ++ mkglobals streams + funs = genfuns streams triggers ++ [mkstep cSettings streams triggers exts] + + -- Write struct datatypes + mkstructdeclns :: [UExpr] -> [C.Decln] + mkstructdeclns es = catMaybes $ map mkdecln utypes where + mkdecln (UType ty) = case ty of + Struct x -> Just $ mkstructdecln ty + _ -> Nothing + + utypes = nub $ concatMap (\(UExpr _ e) -> exprtypes e) es + + -- Make declarations for copies of external variables. + mkexts :: [External] -> [C.Decln] + mkexts exts = map mkextcpydecln exts + + -- Make buffer and index declarations for streams. + mkglobals :: [Stream] -> [C.Decln] + mkglobals streams = map buffdecln streams ++ map indexdecln streams where + buffdecln (Stream sid buff _ ty) = mkbuffdecln sid ty buff + indexdecln (Stream sid _ _ _ ) = mkindexdecln sid + + -- Make generator functions, including trigger arguments. + genfuns :: [Stream] -> [Trigger] -> [C.FunDef] + genfuns streams triggers = map accessdecln streams + ++ map streamgen streams + ++ concatMap triggergen triggers where + + accessdecln :: Stream -> C.FunDef + accessdecln (Stream sid buff _ ty) = mkaccessdecln sid ty buff + + streamgen :: Stream -> C.FunDef + streamgen (Stream sid _ expr ty) = genfun (generatorname sid) expr ty + + triggergen :: Trigger -> [C.FunDef] + triggergen (Trigger name guard args) = guarddef : argdefs where + guarddef = genfun (guardname name) guard Bool + argdefs = map arggen (zip (argnames name) args) + + arggen :: (String, UExpr) -> C.FunDef + arggen (argname, UExpr ty expr) = genfun argname expr ty + +-- | Generate the .h file from a 'Spec'. +compileh :: CSettings -> Spec -> C.TransUnit +compileh cSettings spec = C.TransUnit declns [] where + streams = specStreams spec + triggers = specTriggers spec + exts = gatherexts streams triggers + exprs = gatherexprs streams triggers + + declns = mkstructforwdeclns exprs + ++ mkexts exts + ++ extfundeclns triggers + ++ [stepdecln] + + mkstructforwdeclns :: [UExpr] -> [C.Decln] + mkstructforwdeclns es = catMaybes $ map mkdecln utypes where + mkdecln (UType ty) = case ty of + Struct x -> Just $ mkstructforwdecln ty + _ -> Nothing + + utypes = nub $ concatMap (\(UExpr _ e) -> exprtypes e) es + + -- Make declarations for external variables. + mkexts :: [External] -> [C.Decln] + mkexts = map mkextdecln + + extfundeclns :: [Trigger] -> [C.Decln] + extfundeclns triggers = map extfundecln triggers where + extfundecln :: Trigger -> C.Decln + extfundecln (Trigger name _ args) = C.FunDecln Nothing cty name params where + cty = C.TypeSpec C.Void + params = map mkparam $ zip (argnames name) args + mkparam (name, UExpr ty _) = C.Param (transtype ty) name + + -- Declaration for the step function. + stepdecln :: C.Decln + stepdecln = C.FunDecln Nothing (C.TypeSpec C.Void) + (cSettingsStepFunctionName cSettings) [] diff --git a/copilot-c99/src/Copilot/Compile/C99/Compile/Internal.hs b/copilot-c99/src/Copilot/Compile/C99/Compile/Internal.hs deleted file mode 100644 index a12b0e205..000000000 --- a/copilot-c99/src/Copilot/Compile/C99/Compile/Internal.hs +++ /dev/null @@ -1,159 +0,0 @@ --- | Compile Copilot specifications to C99 code. -module Copilot.Compile.C99.Compile.Internal - ( compile - , compileWith - ) where - -import Text.PrettyPrint (render) -import Data.List (nub) -import Data.Maybe (catMaybes) -import System.Directory (createDirectoryIfMissing) -import System.Exit (exitFailure) -import System.FilePath (()) -import System.IO (hPutStrLn, stderr) - -import Language.C99.Pretty (pretty) -import qualified Language.C99.Simple as C - -import Copilot.Core -import Copilot.Compile.C99.Util -import Copilot.Compile.C99.External -import Copilot.Compile.C99.Settings.Internal -import Copilot.Compile.C99.Translate -import Copilot.Compile.C99.CodeGen - --- | Compile a specification to a .h and a .c file. --- --- The first argument is the settings for the C code generated. --- --- 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) - = do hPutStrLn stderr $ - "Copilot error: attempt at compiling empty specification.\n" - ++ "You must define at least one trigger to generate C monitors." - exitFailure - - | otherwise - = do let cfile = render $ pretty $ C.translate $ compilec cSettings spec - hfile = render $ pretty $ C.translate $ compileh cSettings spec - - -- TODO: find a nicer solution using annotated AST's - -- Should figure out exactly which headers are needed, based on what - -- is used. - cmacros = unlines [ "#include " - , "#include " - , "#include " - , "#include " - , "#include " - , "" - , "#include \"" ++ prefix ++ ".h\"" - , "" - ] - - let dir = cSettingsOutputDirectory cSettings - createDirectoryIfMissing True dir - writeFile (dir prefix ++ ".c") $ cmacros ++ cfile - writeFile (dir prefix ++ ".h") hfile - --- | Compile a specification to a .h and a .c file. --- --- The first argument is used as prefix for the .h and .c files generated. -compile :: String -> Spec -> IO () -compile = compileWith mkDefaultCSettings - --- | Generate the .c file from a 'Spec'. --- --- The generated C file has the following structure: --- --- * Include .h file. --- * Declarations of global buffers and indices. --- * Generator functions for streams, guards and trigger arguments. --- * Declaration of the @step()@ function. -compilec :: CSettings -> Spec -> C.TransUnit -compilec cSettings spec = C.TransUnit declns funs where - streams = specStreams spec - triggers = specTriggers spec - exts = gatherexts streams triggers - exprs = gatherexprs streams triggers - - declns = mkstructdeclns exprs ++ mkexts exts ++ mkglobals streams - funs = genfuns streams triggers ++ [mkstep cSettings streams triggers exts] - - -- Write struct datatypes - mkstructdeclns :: [UExpr] -> [C.Decln] - mkstructdeclns es = catMaybes $ map mkdecln utypes where - mkdecln (UType ty) = case ty of - Struct x -> Just $ mkstructdecln ty - _ -> Nothing - - utypes = nub $ concatMap (\(UExpr _ e) -> exprtypes e) es - - -- Make declarations for copies of external variables. - mkexts :: [External] -> [C.Decln] - mkexts exts = map mkextcpydecln exts - - -- Make buffer and index declarations for streams. - mkglobals :: [Stream] -> [C.Decln] - mkglobals streams = map buffdecln streams ++ map indexdecln streams where - buffdecln (Stream sid buff _ ty) = mkbuffdecln sid ty buff - indexdecln (Stream sid _ _ _ ) = mkindexdecln sid - - -- Make generator functions, including trigger arguments. - genfuns :: [Stream] -> [Trigger] -> [C.FunDef] - genfuns streams triggers = map accessdecln streams - ++ map streamgen streams - ++ concatMap triggergen triggers where - - accessdecln :: Stream -> C.FunDef - accessdecln (Stream sid buff _ ty) = mkaccessdecln sid ty buff - - streamgen :: Stream -> C.FunDef - streamgen (Stream sid _ expr ty) = genfun (generatorname sid) expr ty - - triggergen :: Trigger -> [C.FunDef] - triggergen (Trigger name guard args) = guarddef : argdefs where - guarddef = genfun (guardname name) guard Bool - argdefs = map arggen (zip (argnames name) args) - - arggen :: (String, UExpr) -> C.FunDef - arggen (argname, UExpr ty expr) = genfun argname expr ty - --- | Generate the .h file from a 'Spec'. -compileh :: CSettings -> Spec -> C.TransUnit -compileh cSettings spec = C.TransUnit declns [] where - streams = specStreams spec - triggers = specTriggers spec - exts = gatherexts streams triggers - exprs = gatherexprs streams triggers - - declns = mkstructforwdeclns exprs - ++ mkexts exts - ++ extfundeclns triggers - ++ [stepdecln] - - mkstructforwdeclns :: [UExpr] -> [C.Decln] - mkstructforwdeclns es = catMaybes $ map mkdecln utypes where - mkdecln (UType ty) = case ty of - Struct x -> Just $ mkstructforwdecln ty - _ -> Nothing - - utypes = nub $ concatMap (\(UExpr _ e) -> exprtypes e) es - - -- Make declarations for external variables. - mkexts :: [External] -> [C.Decln] - mkexts = map mkextdecln - - extfundeclns :: [Trigger] -> [C.Decln] - extfundeclns triggers = map extfundecln triggers where - extfundecln :: Trigger -> C.Decln - extfundecln (Trigger name _ args) = C.FunDecln Nothing cty name params where - cty = C.TypeSpec C.Void - params = map mkparam $ zip (argnames name) args - mkparam (name, UExpr ty _) = C.Param (transtype ty) name - - -- Declaration for the step function. - stepdecln :: C.Decln - stepdecln = C.FunDecln Nothing (C.TypeSpec C.Void) - (cSettingsStepFunctionName cSettings) [] diff --git a/copilot-c99/src/Copilot/Compile/C99/Settings.hs b/copilot-c99/src/Copilot/Compile/C99/Settings.hs index 265885e92..782096e57 100644 --- a/copilot-c99/src/Copilot/Compile/C99/Settings.hs +++ b/copilot-c99/src/Copilot/Compile/C99/Settings.hs @@ -1,8 +1,12 @@ -- | Settings used by the code generator to customize the code. -module Copilot.Compile.C99.Settings - {-# DEPRECATED "This module will be hidden in future versions." #-} - (module Copilot.Compile.C99.Settings.Internal) - where +module Copilot.Compile.C99.Settings where -import Copilot.Compile.C99.Settings.Internal +-- | Settings used to customize the code generated. +data CSettings = CSettings + { cSettingsStepFunctionName :: String + , cSettingsOutputDirectory :: FilePath + } +-- | Default settings with a step function called @step@. +mkDefaultCSettings :: CSettings +mkDefaultCSettings = CSettings "step" "." diff --git a/copilot-c99/src/Copilot/Compile/C99/Settings/Internal.hs b/copilot-c99/src/Copilot/Compile/C99/Settings/Internal.hs deleted file mode 100644 index 4e936acc2..000000000 --- a/copilot-c99/src/Copilot/Compile/C99/Settings/Internal.hs +++ /dev/null @@ -1,12 +0,0 @@ --- | Settings used by the code generator to customize the code. -module Copilot.Compile.C99.Settings.Internal where - --- | Settings used to customize the code generated. -data CSettings = CSettings - { cSettingsStepFunctionName :: String - , cSettingsOutputDirectory :: FilePath - } - --- | Default settings with a step function called @step@. -mkDefaultCSettings :: CSettings -mkDefaultCSettings = CSettings "step" "." From a341b2aa2a4385224f9c0f6d0d7ee68480a3e168 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Wed, 12 Jan 2022 18:59:30 +0100 Subject: [PATCH 0039/1222] Remove depracation notices. Refs #289. Several internal modules had deprecation notices to warn users that they were going to be removed. This commit removes those notices, since the modules have now been hidden and the only possible way those warnings could be triggered is internally during compilation of this copilot-c99 library, which is not desirable. --- copilot-c99/src/Copilot/Compile/C99/CodeGen.hs | 4 +--- copilot-c99/src/Copilot/Compile/C99/External.hs | 4 +--- copilot-c99/src/Copilot/Compile/C99/Translate.hs | 4 +--- copilot-c99/src/Copilot/Compile/C99/Util.hs | 4 +--- 4 files changed, 4 insertions(+), 12 deletions(-) diff --git a/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs b/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs index 9d8c6ed20..9b9ea8dbf 100644 --- a/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs +++ b/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs @@ -2,9 +2,7 @@ {-# LANGUAGE ScopedTypeVariables #-} -- | High-level translation of Copilot Core into C99. -module Copilot.Compile.C99.CodeGen - {-# DEPRECATED "This module will be hidden in future versions." #-} - where +module Copilot.Compile.C99.CodeGen where import Control.Monad.State (runState) import Data.List (union, unzip4) diff --git a/copilot-c99/src/Copilot/Compile/C99/External.hs b/copilot-c99/src/Copilot/Compile/C99/External.hs index 9ef023d08..1b9c253d2 100644 --- a/copilot-c99/src/Copilot/Compile/C99/External.hs +++ b/copilot-c99/src/Copilot/Compile/C99/External.hs @@ -2,9 +2,7 @@ -- | Represent information about externs needed in the generation of C99 code -- for stream declarations and triggers. -module Copilot.Compile.C99.External - {-# DEPRECATED "This module will be hidden in future versions." #-} - where +module Copilot.Compile.C99.External where import Data.List (unionBy) diff --git a/copilot-c99/src/Copilot/Compile/C99/Translate.hs b/copilot-c99/src/Copilot/Compile/C99/Translate.hs index 3d2fd0e66..2cbeefb51 100644 --- a/copilot-c99/src/Copilot/Compile/C99/Translate.hs +++ b/copilot-c99/src/Copilot/Compile/C99/Translate.hs @@ -1,9 +1,7 @@ {-# LANGUAGE GADTs #-} -- | Translate Copilot Core expressions and operators to C99. -module Copilot.Compile.C99.Translate - {-# DEPRECATED "This module will be hidden in future versions." #-} - where +module Copilot.Compile.C99.Translate where import Control.Monad.State diff --git a/copilot-c99/src/Copilot/Compile/C99/Util.hs b/copilot-c99/src/Copilot/Compile/C99/Util.hs index ec62ad2b7..ae902f525 100644 --- a/copilot-c99/src/Copilot/Compile/C99/Util.hs +++ b/copilot-c99/src/Copilot/Compile/C99/Util.hs @@ -1,7 +1,5 @@ -- | Auxiliary helper functions to generate C99 code. -module Copilot.Compile.C99.Util - {-# DEPRECATED "This module will be hidden in future versions." #-} - where +module Copilot.Compile.C99.Util where import Control.Monad.State From d5a90d17b7bf2aa692f1acbb986717349620419d Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Wed, 12 Jan 2022 19:25:38 +0100 Subject: [PATCH 0040/1222] Remove deprecated type StructArg. Refs #290. The type copilot-language:Copilot.Language.Stream.StructArg was deprecated in Copilot 3.5 and can now safely be removed. --- copilot-language/src/Copilot/Language/Stream.hs | 4 ---- 1 file changed, 4 deletions(-) diff --git a/copilot-language/src/Copilot/Language/Stream.hs b/copilot-language/src/Copilot/Language/Stream.hs index 568055d38..fe4a0bc21 100644 --- a/copilot-language/src/Copilot/Language/Stream.hs +++ b/copilot-language/src/Copilot/Language/Stream.hs @@ -12,7 +12,6 @@ module Copilot.Language.Stream ( Stream (..) , Arg (..) - , StructArg (..) , Copilot.Language.Stream.ceiling , Copilot.Language.Stream.floor , Copilot.Language.Stream.atan2 @@ -59,9 +58,6 @@ data Stream :: * -> * where data Arg where Arg :: Typed a => Stream a -> Arg -data StructArg = StructArg { name_ :: String, arg' :: Arg } -{-# DEPRECATED StructArg "StructArg is deprecated" #-} - -------------------------------------------------------------------------------- -- | Dummy instance in order to make 'Stream' an instance of 'Num'. From af8d9c27ee16dafe6b36d1c2e8b9f94303109852 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Wed, 12 Jan 2022 19:58:14 +0100 Subject: [PATCH 0041/1222] Remove deprecated module copilot-language:Copilot. Refs #291. The module copilot-language:Copilot was deprecated in Copilot 3.5 and can now be safely removed. --- copilot-language/copilot-language.cabal | 3 +-- copilot-language/src/Copilot.hs | 14 -------------- 2 files changed, 1 insertion(+), 16 deletions(-) delete mode 100644 copilot-language/src/Copilot.hs diff --git a/copilot-language/copilot-language.cabal b/copilot-language/copilot-language.cabal index d92b276f0..05f4ea37c 100644 --- a/copilot-language/copilot-language.cabal +++ b/copilot-language/copilot-language.cabal @@ -45,8 +45,7 @@ library , copilot-core >= 3.7 && < 3.8 , copilot-theorem >= 3.7 && < 3.8 - exposed-modules: Copilot - , Copilot.Language + exposed-modules: Copilot.Language , Copilot.Language.Operators.BitWise , Copilot.Language.Operators.Boolean , Copilot.Language.Operators.Propositional diff --git a/copilot-language/src/Copilot.hs b/copilot-language/src/Copilot.hs deleted file mode 100644 index d0b5095f2..000000000 --- a/copilot-language/src/Copilot.hs +++ /dev/null @@ -1,14 +0,0 @@ --------------------------------------------------------------------------------- --- Copyright © 2011 National Institute of Aerospace / Galois, Inc. --------------------------------------------------------------------------------- - -{-# LANGUAGE Safe #-} - -module Copilot - {-# DEPRECATED "This module is deprecated." #-} - ( module Copilot.Language - ) where - -import Copilot.Language - --------------------------------------------------------------------------------- From 5fcb19ea990242a380fa958f5a512e7bf2521313 Mon Sep 17 00:00:00 2001 From: Ryan Scott Date: Wed, 12 Jan 2022 21:24:33 +0100 Subject: [PATCH 0042/1222] Replace use of Copilot's Dynamic types with Data.Dynamic. Refs #266. Copilot core offers an implementation of Dynamic types. However, the copilot evaluator uses base:Data.Dynamic instead, which appears to offer a similar interface. At present, only copilot-theorem uses Copilot's own definition of dynamic types. This commit replaces uses of Copilot's internal Dynamic types with the standard one in base. --- .../src/Copilot/Theorem/TransSys/Cast.hs | 39 +++++++++---------- .../src/Copilot/Theorem/TransSys/Translate.hs | 4 +- 2 files changed, 21 insertions(+), 22 deletions(-) diff --git a/copilot-theorem/src/Copilot/Theorem/TransSys/Cast.hs b/copilot-theorem/src/Copilot/Theorem/TransSys/Cast.hs index ac37f333e..a5c298773 100644 --- a/copilot-theorem/src/Copilot/Theorem/TransSys/Cast.hs +++ b/copilot-theorem/src/Copilot/Theorem/TransSys/Cast.hs @@ -17,9 +17,8 @@ module Copilot.Theorem.TransSys.Cast -------------------------------------------------------------------------------- import Copilot.Core as C -import Copilot.Core.Type.Equality -import Copilot.Core.Type.Dynamic +import Data.Dynamic (Dynamic(..), fromDynamic, toDyn) import GHC.Float import qualified Copilot.Theorem.TransSys.Type as K @@ -27,7 +26,7 @@ import qualified Copilot.Theorem.TransSys.Type as K -------------------------------------------------------------------------------- -- | Synonym for a dynamic type in Copilot core. -type Dyn = Dynamic Type +type Dyn = Dynamic -- | Translation of a Copilot type into Copilot theorem's internal -- representation. @@ -67,26 +66,26 @@ class Casted b where _cast :: Dyn -> Maybe b instance Casted Integer where - _cast (Dynamic v tv) - | Just Refl <- tv =~= Int8 = Just $ toInteger v - | Just Refl <- tv =~= Int16 = Just $ toInteger v - | Just Refl <- tv =~= Int32 = Just $ toInteger v - | Just Refl <- tv =~= Int64 = Just $ toInteger v - | Just Refl <- tv =~= Word16 = Just $ toInteger v - | Just Refl <- tv =~= Word8 = Just $ toInteger v - | Just Refl <- tv =~= Word32 = Just $ toInteger v - | Just Refl <- tv =~= Word64 = Just $ toInteger v - | otherwise = Nothing + _cast d + | Just (v :: Int8) <- fromDynamic d = Just $ toInteger v + | Just (v :: Int16) <- fromDynamic d = Just $ toInteger v + | Just (v :: Int32) <- fromDynamic d = Just $ toInteger v + | Just (v :: Int64) <- fromDynamic d = Just $ toInteger v + | Just (v :: Word8) <- fromDynamic d = Just $ toInteger v + | Just (v :: Word16) <- fromDynamic d = Just $ toInteger v + | Just (v :: Word32) <- fromDynamic d = Just $ toInteger v + | Just (v :: Word64) <- fromDynamic d = Just $ toInteger v + | otherwise = Nothing instance Casted Bool where - _cast (Dynamic v tv) - | Just Refl <- tv =~= Bool = Just v - | otherwise = Nothing + _cast d + | Just (v :: Bool) <- fromDynamic d = Just v + | otherwise = Nothing instance Casted Double where - _cast (Dynamic v tv) - | Just Refl <- tv =~= Float = Just $ float2Double v - | Just Refl <- tv =~= Double = Just v - | otherwise = Nothing + _cast d + | Just (v :: Float) <- fromDynamic d = Just $ float2Double v + | Just (v :: Double) <- fromDynamic d = Just v + | otherwise = Nothing -------------------------------------------------------------------------------- diff --git a/copilot-theorem/src/Copilot/Theorem/TransSys/Translate.hs b/copilot-theorem/src/Copilot/Theorem/TransSys/Translate.hs index 819bc38ac..62716c24c 100644 --- a/copilot-theorem/src/Copilot/Theorem/TransSys/Translate.hs +++ b/copilot-theorem/src/Copilot/Theorem/TransSys/Translate.hs @@ -161,7 +161,7 @@ stream (C.Stream { C.streamId let nodeId = ncNode streamId outvar i = Var (ncMain `ncTimeAnnot` i) - buf = map (cast t . toDyn streamExprType) streamBuffer + buf = map (cast t . toDyn) streamBuffer (e, nodeAuxVars, nodeImportedVars, nodeDependencies) <- runExprTrans t nodeId streamExpr @@ -184,7 +184,7 @@ stream (C.Stream { C.streamId expr :: Type t -> C.Expr t' -> Trans (Expr t) -expr t (C.Const t' v) = return $ Const t (cast t $ toDyn t' v) +expr t (C.Const _ v) = return $ Const t (cast t $ toDyn v) expr t (C.Drop _ (fromIntegral -> k :: Int) id) = do let node = ncNode id From bcbfee2744f2f527f44ee7e8af3aef3424ac9499 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Wed, 12 Jan 2022 21:28:34 +0100 Subject: [PATCH 0043/1222] Deprecate module copilot-core:Copilot.Core.Type.Dynamic. Refs #266. Copilot core offers an implementation of Dynamic types. No part of Copilot (other than the tests) presently uses this implementation; instead, Copilot relies on the standard implementation in base:Data.Dynamic. This commit deprecates the module copilot-core:Copilot.Core.Type.Dynamic completely. --- copilot-core/src/Copilot/Core/Type/Dynamic.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/copilot-core/src/Copilot/Core/Type/Dynamic.hs b/copilot-core/src/Copilot/Core/Type/Dynamic.hs index 4f828a6db..055457d10 100644 --- a/copilot-core/src/Copilot/Core/Type/Dynamic.hs +++ b/copilot-core/src/Copilot/Core/Type/Dynamic.hs @@ -16,6 +16,7 @@ {-# LANGUAGE GADTs, KindSignatures, ScopedTypeVariables #-} module Copilot.Core.Type.Dynamic + {-# DEPRECATED "This module is deprecated in Copilot 3.8." #-} ( Dynamic (..) , DynamicF (..) , toDyn From 37c50852c13e9531fdf031f7e94e74a61a430990 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 7 Mar 2022 09:06:48 -0500 Subject: [PATCH 0044/1222] Empty test placeholder in compilot language. Refs #271. This commit introduces an empty test file and makes it available as a test in the cabal file. The file does not actually test anything (it always succeeds). --- copilot-language/copilot-language.cabal | 27 +++++++++++++++++++++++++ copilot-language/tests/Main.hs | 14 +++++++++++++ 2 files changed, 41 insertions(+) create mode 100644 copilot-language/tests/Main.hs diff --git a/copilot-language/copilot-language.cabal b/copilot-language/copilot-language.cabal index 05f4ea37c..4b4460761 100644 --- a/copilot-language/copilot-language.cabal +++ b/copilot-language/copilot-language.cabal @@ -73,3 +73,30 @@ library ghc-options: -fwarn-tabs -Wall + +test-suite unit-tests + type: + exitcode-stdio-1.0 + + main-is: + Main.hs + + build-depends: + base + , HUnit + , QuickCheck + , pretty + , test-framework + , test-framework-hunit + , test-framework-quickcheck2 + + , copilot-language + + hs-source-dirs: + tests + + default-language: + Haskell2010 + + ghc-options: + -Wall diff --git a/copilot-language/tests/Main.hs b/copilot-language/tests/Main.hs new file mode 100644 index 000000000..bb5f37614 --- /dev/null +++ b/copilot-language/tests/Main.hs @@ -0,0 +1,14 @@ +-- | Test copilot-language. +module Main where + +-- External imports +import Data.Monoid (mempty) +import Test.Framework (Test, defaultMainWithOpts) + +-- | Run all unit tests on copilot-language. +main :: IO () +main = defaultMainWithOpts tests mempty + +-- | All unit tests in copilot-language. +tests :: [Test.Framework.Test] +tests = [] From bfa1c2a1b8cb6c8325487ce5becffa7f1c38d2f6 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 7 Mar 2022 11:52:22 -0500 Subject: [PATCH 0045/1222] Test reification of boolean streams. Refs #271. This commit implements tests to reify boolean streams, and compare them against their ideal meaning. The meaning is given as a list of elements. The implementation mirrors copilot-core's, except that there is now an intermediate step of reification, which happens in the IO monad, and it is not necessary to use typeOf to obtain the types of expressions. Another difference wrt. the tests in copilot-core is that streams do not implement a way to be shown. --- copilot-language/copilot-language.cabal | 5 + copilot-language/tests/Main.hs | 7 +- .../tests/Test/Copilot/Language/Reify.hs | 236 ++++++++++++++++++ copilot-language/tests/Test/Extra.hs | 31 +++ 4 files changed, 278 insertions(+), 1 deletion(-) create mode 100644 copilot-language/tests/Test/Copilot/Language/Reify.hs create mode 100644 copilot-language/tests/Test/Extra.hs diff --git a/copilot-language/copilot-language.cabal b/copilot-language/copilot-language.cabal index 4b4460761..1449487f1 100644 --- a/copilot-language/copilot-language.cabal +++ b/copilot-language/copilot-language.cabal @@ -81,6 +81,10 @@ test-suite unit-tests main-is: Main.hs + other-modules: + Test.Copilot.Language.Reify + Test.Extra + build-depends: base , HUnit @@ -90,6 +94,7 @@ test-suite unit-tests , test-framework-hunit , test-framework-quickcheck2 + , copilot-core , copilot-language hs-source-dirs: diff --git a/copilot-language/tests/Main.hs b/copilot-language/tests/Main.hs index bb5f37614..2c196ab1c 100644 --- a/copilot-language/tests/Main.hs +++ b/copilot-language/tests/Main.hs @@ -5,10 +5,15 @@ module Main where import Data.Monoid (mempty) import Test.Framework (Test, defaultMainWithOpts) +-- Internal imports +import qualified Test.Copilot.Language.Reify + -- | Run all unit tests on copilot-language. main :: IO () main = defaultMainWithOpts tests mempty -- | All unit tests in copilot-language. tests :: [Test.Framework.Test] -tests = [] +tests = + [ Test.Copilot.Language.Reify.tests + ] diff --git a/copilot-language/tests/Test/Copilot/Language/Reify.hs b/copilot-language/tests/Test/Copilot/Language/Reify.hs new file mode 100644 index 000000000..98e75a30f --- /dev/null +++ b/copilot-language/tests/Test/Copilot/Language/Reify.hs @@ -0,0 +1,236 @@ +{-# LANGUAGE ExistentialQuantification #-} +-- | Test copilot-language:Copilot.Language.Reify. +-- +-- The gist of this evaluation is in 'SemanticsP' and 'checkSemanticsP' which +-- evaluates an expression using Copilot's evaluator and compares it against +-- its expected meaning. +module Test.Copilot.Language.Reify where + +-- External imports +import Data.Maybe (fromMaybe) +import Data.Typeable (Typeable) +import Test.Framework (Test, testGroup) +import Test.Framework.Providers.QuickCheck2 (testProperty) +import Test.QuickCheck (Arbitrary, Gen, Property, + arbitrary, chooseInt, elements, + forAll, forAllShow, frequency, + oneof) +import Test.QuickCheck.Monadic (monadicIO, run) + +-- Internal imports: library modules being tested +import Copilot.Language (Typed) +import qualified Copilot.Language.Operators.Boolean as Copilot +import qualified Copilot.Language.Operators.Constant as Copilot +import qualified Copilot.Language.Operators.Eq as Copilot +import qualified Copilot.Language.Operators.Mux as Copilot +import Copilot.Language.Reify (reify) +import Copilot.Language.Spec (observer) +import Copilot.Language.Stream (Stream) + +-- Internal imports: functions needed to test after reification +import Copilot.Core.Type.Show (ShowType (Haskell)) +import Copilot.Core.Interpret.Eval (ExecTrace (interpObservers), eval) + +-- Internal imports: auxiliary functions +import Test.Extra (apply1, apply2, apply3) + +-- * Constants + +-- | Max length of the traces being tested. +maxTraceLength :: Int +maxTraceLength = 200 + +-- | All unit tests for copilot-language:Copilot.Language.Reify. +tests :: Test.Framework.Test +tests = + testGroup "Copilot.Language.Reify" + [ testProperty "eval Stream" testEvalExpr ] + +-- * Individual tests + +-- | Test for expression evaluation. +testEvalExpr :: Property +testEvalExpr = + forAll (chooseInt (0, maxTraceLength)) $ \steps -> + forAllShow arbitrarySemanticsP (semanticsShowK steps) $ \pair -> + monadicIO $ run (checkSemanticsP steps [] pair) + +-- * Random generators + +-- ** Random SemanticsP generators + +-- | An arbitrary expression, paired with its expected meaning. +-- +-- See the function 'checkSemanticsP' to evaluate the pair. +arbitrarySemanticsP :: Gen SemanticsP +arbitrarySemanticsP = oneof + [ SemanticsP <$> (arbitraryBoolExpr :: Gen (Semantics Bool)) + ] + +-- | An arbitrary boolean expression, paired with its expected meaning. +arbitraryBoolExpr :: Gen (Stream Bool, [Bool]) +arbitraryBoolExpr = + -- We use frequency instead of oneof because the random expression generator + -- seems to generate expressions that are too large and the test fails due + -- to running out of memory. + frequency + [ (10, arbitraryConst) + + , (5, arbitraryBoolOp0) + + , (5, apply1 <$> arbitraryBoolOp1 <*> arbitraryBoolExpr) + + , (1, apply2 <$> arbitraryBoolOp2 + <*> arbitraryBoolExpr + <*> arbitraryBoolExpr) + + , (1, apply2 <$> arbitraryEqOp2 + <*> arbitraryBoolExpr + <*> arbitraryBoolExpr) + + , (1, apply3 <$> arbitraryITEOp3 + <*> arbitraryBoolExpr + <*> arbitraryBoolExpr + <*> arbitraryBoolExpr) + ] + +-- *** Primitives + +-- | An arbitrary constant expression of any type, paired with its expected +-- meaning. +arbitraryConst :: (Arbitrary t, Typed t) + => Gen (Stream t, [t]) +arbitraryConst = (\v -> (Copilot.constant v, repeat v)) <$> arbitrary + +-- | Generator for constant boolean streams, paired with their expected +-- meaning. +arbitraryBoolOp0 :: Gen (Stream Bool, [Bool]) +arbitraryBoolOp0 = elements + [ (Copilot.false, repeat False) + , (Copilot.true, repeat True) + ] + +-- *** Op 1 + +-- | Generator for arbitrary boolean operators with arity 1, paired with their +-- expected meaning. +arbitraryBoolOp1 :: Gen (Stream Bool -> Stream Bool, [Bool] -> [Bool]) +arbitraryBoolOp1 = elements + [ (Copilot.not, fmap not) + ] + +-- *** Op 2 + +-- | Generator for arbitrary boolean operators with arity 2, paired with their +-- expected meaning. +arbitraryBoolOp2 :: Gen ( Stream Bool -> Stream Bool -> Stream Bool + , [Bool] -> [Bool] -> [Bool] + ) +arbitraryBoolOp2 = elements + [ ((Copilot.&&), zipWith (&&)) + , ((Copilot.||), zipWith (||)) + , ((Copilot.==>), zipWith (\x y -> not x || y)) + , ((Copilot.xor), zipWith (\x y -> (x || y) && not (x && y))) + ] + +-- | Generator for arbitrary equality operators with arity 2, paired with their +-- expected meaning. +arbitraryEqOp2 :: (Typed t, Eq t) + => Gen ( Stream t -> Stream t -> Stream Bool + , [t] -> [t] -> [Bool] + ) +arbitraryEqOp2 = elements + [ ((Copilot.==), zipWith (==)) + , ((Copilot./=), zipWith (/=)) + ] + +-- *** Op 3 + +-- | Generator for if-then-else operator (with arity 3), paired with its +-- expected meaning. +-- +-- Although this is constant and there is nothing arbitrary, we use the same +-- structure and naming convention as with others for simplicity. +arbitraryITEOp3 :: (Arbitrary t, Typed t) + => Gen ( Stream Bool -> Stream t -> Stream t -> Stream t + , [Bool] -> [t] -> [t] -> [t] + ) +arbitraryITEOp3 = return + (Copilot.mux, zipWith3 (\x y z -> if x then y else z)) + +-- * Semantics + +-- | Type that pairs an expression with its meaning as an infinite stream. +type Semantics t = (Stream t, [t]) + +-- | A phantom semantics pair is an existential type that encloses an +-- expression and its expected meaning as an infinite list of values. +-- +-- It is needed by the arbitrary expression generator, to create a +-- heterogeneous list. +data SemanticsP = forall t + . (Typeable t, Read t, Eq t, Show t, Typed t, Arbitrary t) + => SemanticsP + { semanticsPair :: (Stream t, [t]) + } + +-- | Show function for test triplets that limits the accompanying list +-- to a certain length. +semanticsShowK :: Int -> SemanticsP -> String +semanticsShowK steps (SemanticsP (expr, exprList)) = + show ("Cannot show stream", take steps exprList) + +-- | Check that the expression in the semantics pair is evaluated to the given +-- list, up to a number of steps. +-- +-- Some operations will overflow and return NaN. Because comparing any NaN +-- will, as per IEEE 754, always fail (i.e., return False), we handle that +-- specific case by stating that the test succeeds if any expected values +-- is NaN. +checkSemanticsP :: Int -> [a] -> SemanticsP -> IO Bool +checkSemanticsP steps _streams (SemanticsP (expr, exprList)) = do + -- Spec with just one observer of one expression. + let spec = observer testObserverName expr + + -- Reified stream (low-level) + llSpec <- reify spec + + let trace = eval Haskell steps llSpec + + -- Limit expectation to the number of evaluation steps. + let expectation = take steps exprList + + -- Obtain the results by looking up the observer in the spec + -- and parsing the results into Haskell values. + let resultValues = fmap readResult results + results = lookupWithDefault testObserverName [] + $ interpObservers trace + + return $ any isNaN' expectation || resultValues == expectation + + where + + -- Fixed name for the observer. Used to obtain the result from the + -- trace. It should be the only observer in the trace. + testObserverName :: String + testObserverName = "res" + + -- | Is NaN with Eq requirement only. + isNaN' :: Eq a => a -> Bool + isNaN' x = x /= x + +-- * Auxiliary + +-- | Read a Haskell value from the output of the evaluator. +readResult :: Read a => String -> a +readResult = read . readResult' + where + readResult' :: String -> String + readResult' "false" = "False" + readResult' "true" = "True" + readResult' s = s + +-- | Variant of 'lookup' with an additional default value returned when the key +-- provided is not found in the map. +lookupWithDefault :: Ord k => k -> v -> [(k, v)] -> v +lookupWithDefault k def = fromMaybe def . lookup k diff --git a/copilot-language/tests/Test/Extra.hs b/copilot-language/tests/Test/Extra.hs new file mode 100644 index 000000000..f10d784c4 --- /dev/null +++ b/copilot-language/tests/Test/Extra.hs @@ -0,0 +1,31 @@ +-- | Auxiliary testing helper functions. +module Test.Extra where + +-- External imports +import Control.Arrow ((***)) + +-- * Function application + +-- | Apply a tuple with two functions to a tuple of arguments. +apply1 :: (a1 -> b1, a2 -> b2) -- ^ Pair with functions + -> (a1, a2) -- ^ Pair with arguments + -> (b1, b2) -- ^ Pair with results +apply1 = uncurry (***) + +-- | Apply a tuple with two functions on two arguments to their tupled +-- arguments. +apply2 :: (a1 -> b1 -> c1, a2 -> b2 -> c2) -- ^ Pair with functions + -> (a1, a2) -- ^ Pair with first arguments + -> (b1, b2) -- ^ Pair with second arguments + -> (c1, c2) -- ^ Pair with results +apply2 fs = apply1 . apply1 fs + +-- | Apply a tuple with two functions on three arguments to their tupled +-- arguments. +apply3 :: (a1 -> b1 -> c1 -> d1, a2 -> b2 -> c2 -> d2) + -- ^ Pair with functions + -> (a1, a2) -- ^ Pair with first arguments + -> (b1, b2) -- ^ Pair with second arguments + -> (c1, c2) -- ^ Pair with third arguments + -> (d1, d2) -- ^ Pair with results +apply3 fs = apply2 . apply1 fs From 7dd86ce89b72222b3e0a6f126a67a11f4833bf16 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 7 Mar 2022 18:10:37 -0500 Subject: [PATCH 0046/1222] Test reification of bit expressions. Refs #271. This commit implements tests to reify bit manipulation on streams, and compare them against their ideal meaning. The meaning is given as a list of elements. --- .../tests/Test/Copilot/Language/Reify.hs | 84 +++++++++++++++++++ 1 file changed, 84 insertions(+) diff --git a/copilot-language/tests/Test/Copilot/Language/Reify.hs b/copilot-language/tests/Test/Copilot/Language/Reify.hs index 98e75a30f..3589d8a6c 100644 --- a/copilot-language/tests/Test/Copilot/Language/Reify.hs +++ b/copilot-language/tests/Test/Copilot/Language/Reify.hs @@ -7,8 +7,11 @@ module Test.Copilot.Language.Reify where -- External imports +import Data.Bits (Bits, complement, xor, (.&.), (.|.)) +import Data.Int (Int16, Int32, Int64, Int8) import Data.Maybe (fromMaybe) import Data.Typeable (Typeable) +import Data.Word (Word16, Word32, Word64, Word8) import Test.Framework (Test, testGroup) import Test.Framework.Providers.QuickCheck2 (testProperty) import Test.QuickCheck (Arbitrary, Gen, Property, @@ -65,6 +68,15 @@ testEvalExpr = arbitrarySemanticsP :: Gen SemanticsP arbitrarySemanticsP = oneof [ SemanticsP <$> (arbitraryBoolExpr :: Gen (Semantics Bool)) + , SemanticsP <$> (arbitraryBitsExpr :: Gen (Semantics Bool)) + , SemanticsP <$> (arbitraryBitsExpr :: Gen (Semantics Int8)) + , SemanticsP <$> (arbitraryBitsExpr :: Gen (Semantics Int16)) + , SemanticsP <$> (arbitraryBitsExpr :: Gen (Semantics Int32)) + , SemanticsP <$> (arbitraryBitsExpr :: Gen (Semantics Int64)) + , SemanticsP <$> (arbitraryBitsExpr :: Gen (Semantics Word8)) + , SemanticsP <$> (arbitraryBitsExpr :: Gen (Semantics Word16)) + , SemanticsP <$> (arbitraryBitsExpr :: Gen (Semantics Word32)) + , SemanticsP <$> (arbitraryBitsExpr :: Gen (Semantics Word64)) ] -- | An arbitrary boolean expression, paired with its expected meaning. @@ -88,6 +100,38 @@ arbitraryBoolExpr = <*> arbitraryBoolExpr <*> arbitraryBoolExpr) + , (1, apply2 <$> arbitraryEqOp2 + <*> arbitraryBitsExpr + <*> (arbitraryBitsExpr :: Gen (Stream Int8, [Int8]))) + + , (1, apply2 <$> arbitraryEqOp2 + <*> arbitraryBitsExpr + <*> (arbitraryBitsExpr :: Gen (Stream Int16, [Int16]))) + + , (1, apply2 <$> arbitraryEqOp2 + <*> arbitraryBitsExpr + <*> (arbitraryBitsExpr :: Gen (Stream Int32, [Int32]))) + + , (1, apply2 <$> arbitraryEqOp2 + <*> arbitraryBitsExpr + <*> (arbitraryBitsExpr :: Gen (Stream Int64, [Int64]))) + + , (1, apply2 <$> arbitraryEqOp2 + <*> arbitraryBitsExpr + <*> (arbitraryBitsExpr :: Gen (Stream Word8, [Word8]))) + + , (1, apply2 <$> arbitraryEqOp2 + <*> arbitraryBitsExpr + <*> (arbitraryBitsExpr :: Gen (Stream Word16, [Word16]))) + + , (1, apply2 <$> arbitraryEqOp2 + <*> arbitraryBitsExpr + <*> (arbitraryBitsExpr :: Gen (Stream Word32, [Word32]))) + + , (1, apply2 <$> arbitraryEqOp2 + <*> arbitraryBitsExpr + <*> (arbitraryBitsExpr :: Gen (Stream Word64, [Word64]))) + , (1, apply3 <$> arbitraryITEOp3 <*> arbitraryBoolExpr <*> arbitraryBoolExpr @@ -110,6 +154,28 @@ arbitraryBoolOp0 = elements , (Copilot.true, repeat True) ] +-- | An arbitrary Bits expression, paired with its expected meaning. +arbitraryBitsExpr :: (Arbitrary t, Typed t, Bits t) + => Gen (Stream t, [t]) +arbitraryBitsExpr = + -- We use frequency instead of oneof because the random expression generator + -- seems to generate expressions that are too large and the test fails due + -- to running out of memory. + frequency + [ (10, arbitraryConst) + + , (5, apply1 <$> arbitraryBitsOp1 <*> arbitraryBitsExpr) + + , (2, apply2 <$> arbitraryBitsOp2 + <*> arbitraryBitsExpr + <*> arbitraryBitsExpr) + + , (2, apply3 <$> arbitraryITEOp3 + <*> arbitraryBoolExpr + <*> arbitraryBitsExpr <*> arbitraryBitsExpr) + ] + + -- *** Op 1 -- | Generator for arbitrary boolean operators with arity 1, paired with their @@ -119,6 +185,14 @@ arbitraryBoolOp1 = elements [ (Copilot.not, fmap not) ] +-- | Generator for arbitrary bitwise operators with arity 1, paired with their +-- expected meaning. +arbitraryBitsOp1 :: (Typed t, Bits t) + => Gen (Stream t -> Stream t, [t] -> [t]) +arbitraryBitsOp1 = elements + [ (complement, fmap complement) + ] + -- *** Op 2 -- | Generator for arbitrary boolean operators with arity 2, paired with their @@ -144,6 +218,16 @@ arbitraryEqOp2 = elements , ((Copilot./=), zipWith (/=)) ] +-- | Generator for arbitrary bitwise operators with arity 2, paired with their +-- expected meaning. +arbitraryBitsOp2 :: (Typed t, Bits t) + => Gen (Stream t -> Stream t -> Stream t, [t] -> [t] -> [t]) +arbitraryBitsOp2 = elements + [ ((.&.), zipWith (.&.)) + , ((.|.), zipWith (.|.)) + , (xor, zipWith xor) + ] + -- *** Op 3 -- | Generator for if-then-else operator (with arity 3), paired with its From 1e3da4a6cad3554e2a8200cdb1dfe48a2313376b Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 7 Mar 2022 18:18:18 -0500 Subject: [PATCH 0047/1222] Test reification of numeric expressions. Refs #271. This commit implements tests to reify numeric operators applied to streams, and compare them against their ideal meaning. The meaning is given as a list of elements. --- .../tests/Test/Copilot/Language/Reify.hs | 79 +++++++++++++++++++ 1 file changed, 79 insertions(+) diff --git a/copilot-language/tests/Test/Copilot/Language/Reify.hs b/copilot-language/tests/Test/Copilot/Language/Reify.hs index 3589d8a6c..c7ec2ec6b 100644 --- a/copilot-language/tests/Test/Copilot/Language/Reify.hs +++ b/copilot-language/tests/Test/Copilot/Language/Reify.hs @@ -68,6 +68,14 @@ testEvalExpr = arbitrarySemanticsP :: Gen SemanticsP arbitrarySemanticsP = oneof [ SemanticsP <$> (arbitraryBoolExpr :: Gen (Semantics Bool)) + , SemanticsP <$> (arbitraryNumExpr :: Gen (Semantics Int8)) + , SemanticsP <$> (arbitraryNumExpr :: Gen (Semantics Int16)) + , SemanticsP <$> (arbitraryNumExpr :: Gen (Semantics Int32)) + , SemanticsP <$> (arbitraryNumExpr :: Gen (Semantics Int64)) + , SemanticsP <$> (arbitraryNumExpr :: Gen (Semantics Word8)) + , SemanticsP <$> (arbitraryNumExpr :: Gen (Semantics Word16)) + , SemanticsP <$> (arbitraryNumExpr :: Gen (Semantics Word32)) + , SemanticsP <$> (arbitraryNumExpr :: Gen (Semantics Word64)) , SemanticsP <$> (arbitraryBitsExpr :: Gen (Semantics Bool)) , SemanticsP <$> (arbitraryBitsExpr :: Gen (Semantics Int8)) , SemanticsP <$> (arbitraryBitsExpr :: Gen (Semantics Int16)) @@ -132,12 +140,64 @@ arbitraryBoolExpr = <*> arbitraryBitsExpr <*> (arbitraryBitsExpr :: Gen (Stream Word64, [Word64]))) + , (1, apply2 <$> arbitraryEqOp2 + <*> arbitraryNumExpr + <*> (arbitraryNumExpr :: Gen (Stream Int8, [Int8]))) + + , (1, apply2 <$> arbitraryEqOp2 + <*> arbitraryNumExpr + <*> (arbitraryNumExpr :: Gen (Stream Int16, [Int16]))) + + , (1, apply2 <$> arbitraryEqOp2 + <*> arbitraryNumExpr + <*> (arbitraryNumExpr :: Gen (Stream Int32, [Int32]))) + + , (1, apply2 <$> arbitraryEqOp2 + <*> arbitraryNumExpr + <*> (arbitraryNumExpr :: Gen (Stream Int64, [Int64]))) + + , (1, apply2 <$> arbitraryEqOp2 + <*> arbitraryNumExpr + <*> (arbitraryNumExpr :: Gen (Stream Word8, [Word8]))) + + , (1, apply2 <$> arbitraryEqOp2 + <*> arbitraryNumExpr + <*> (arbitraryNumExpr :: Gen (Stream Word16, [Word16]))) + + , (1, apply2 <$> arbitraryEqOp2 + <*> arbitraryNumExpr + <*> (arbitraryNumExpr :: Gen (Stream Word32, [Word32]))) + + , (1, apply2 <$> arbitraryEqOp2 + <*> arbitraryNumExpr + <*> (arbitraryNumExpr :: Gen (Stream Word64, [Word64]))) + , (1, apply3 <$> arbitraryITEOp3 <*> arbitraryBoolExpr <*> arbitraryBoolExpr <*> arbitraryBoolExpr) ] +-- | An arbitrary numeric expression, paired with its expected meaning. +arbitraryNumExpr :: (Arbitrary t, Typed t, Num t, Eq t) + => Gen (Stream t, [t]) +arbitraryNumExpr = + -- We use frequency instead of oneof because the random expression generator + -- seems to generate expressions that are too large and the test fails due + -- to running out of memory. + frequency + [ (10, arbitraryConst) + + , (5, apply1 <$> arbitraryNumOp1 <*> arbitraryNumExpr) + + , (2, apply2 <$> arbitraryNumOp2 <*> arbitraryNumExpr <*> arbitraryNumExpr) + + , (2, apply3 <$> arbitraryITEOp3 + <*> arbitraryBoolExpr + <*> arbitraryNumExpr + <*> arbitraryNumExpr) + ] + -- *** Primitives -- | An arbitrary constant expression of any type, paired with its expected @@ -185,6 +245,15 @@ arbitraryBoolOp1 = elements [ (Copilot.not, fmap not) ] +-- | Generator for arbitrary numeric operators with arity 1, paired with their +-- expected meaning. +arbitraryNumOp1 :: (Typed t, Num t, Eq t) + => Gen (Stream t -> Stream t, [t] -> [t]) +arbitraryNumOp1 = elements + [ (abs, fmap abs) + , (signum, fmap signum) + ] + -- | Generator for arbitrary bitwise operators with arity 1, paired with their -- expected meaning. arbitraryBitsOp1 :: (Typed t, Bits t) @@ -207,6 +276,16 @@ arbitraryBoolOp2 = elements , ((Copilot.xor), zipWith (\x y -> (x || y) && not (x && y))) ] +-- | Generator for arbitrary numeric operators with arity 2, paired with their +-- expected meaning. +arbitraryNumOp2 :: (Typed t, Num t, Eq t) + => Gen (Stream t -> Stream t -> Stream t, [t] -> [t] -> [t]) +arbitraryNumOp2 = elements + [ ((+), zipWith (+)) + , ((-), zipWith (-)) + , ((*), zipWith (*)) + ] + -- | Generator for arbitrary equality operators with arity 2, paired with their -- expected meaning. arbitraryEqOp2 :: (Typed t, Eq t) From c530db15ce7dd13870d42917a52bd98b2060fd89 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 7 Mar 2022 18:26:13 -0500 Subject: [PATCH 0048/1222] Test reification of integral bit expressions. Refs #271. This commit implements tests to reify bit stream expressions carrying integral numbers, and compare them against their ideal meaning. The meaning is given as a list of elements. --- .../tests/Test/Copilot/Language/Reify.hs | 55 ++++++++++++++++++- 1 file changed, 54 insertions(+), 1 deletion(-) diff --git a/copilot-language/tests/Test/Copilot/Language/Reify.hs b/copilot-language/tests/Test/Copilot/Language/Reify.hs index c7ec2ec6b..7dda1c4ea 100644 --- a/copilot-language/tests/Test/Copilot/Language/Reify.hs +++ b/copilot-language/tests/Test/Copilot/Language/Reify.hs @@ -7,7 +7,8 @@ module Test.Copilot.Language.Reify where -- External imports -import Data.Bits (Bits, complement, xor, (.&.), (.|.)) +import Data.Bits (Bits, complement, shiftL, shiftR, + xor, (.&.), (.|.)) import Data.Int (Int16, Int32, Int64, Int8) import Data.Maybe (fromMaybe) import Data.Typeable (Typeable) @@ -22,6 +23,7 @@ import Test.QuickCheck.Monadic (monadicIO, run) -- Internal imports: library modules being tested import Copilot.Language (Typed) +import qualified Copilot.Language.Operators.BitWise as Copilot import qualified Copilot.Language.Operators.Boolean as Copilot import qualified Copilot.Language.Operators.Constant as Copilot import qualified Copilot.Language.Operators.Eq as Copilot @@ -85,6 +87,14 @@ arbitrarySemanticsP = oneof , SemanticsP <$> (arbitraryBitsExpr :: Gen (Semantics Word16)) , SemanticsP <$> (arbitraryBitsExpr :: Gen (Semantics Word32)) , SemanticsP <$> (arbitraryBitsExpr :: Gen (Semantics Word64)) + , SemanticsP <$> (arbitraryBitsIntegralExpr :: Gen (Semantics Int8)) + , SemanticsP <$> (arbitraryBitsIntegralExpr :: Gen (Semantics Int16)) + , SemanticsP <$> (arbitraryBitsIntegralExpr :: Gen (Semantics Int32)) + , SemanticsP <$> (arbitraryBitsIntegralExpr :: Gen (Semantics Int64)) + , SemanticsP <$> (arbitraryBitsIntegralExpr :: Gen (Semantics Word8)) + , SemanticsP <$> (arbitraryBitsIntegralExpr :: Gen (Semantics Word16)) + , SemanticsP <$> (arbitraryBitsIntegralExpr :: Gen (Semantics Word32)) + , SemanticsP <$> (arbitraryBitsIntegralExpr :: Gen (Semantics Word64)) ] -- | An arbitrary boolean expression, paired with its expected meaning. @@ -235,6 +245,33 @@ arbitraryBitsExpr = <*> arbitraryBitsExpr <*> arbitraryBitsExpr) ] +-- | An arbitrary expression for types that are instances of Bits and Integral, +-- paired with its expected meaning. +arbitraryBitsIntegralExpr :: (Arbitrary t, Typed t, Bits t, Integral t) + => Gen (Stream t, [t]) +arbitraryBitsIntegralExpr = + -- We use frequency instead of oneof because the random expression generator + -- seems to generate expressions that are too large and the test fails due + -- to running out of memory. + frequency + [ (10, arbitraryConst) + + , (2, apply1 <$> arbitraryNumOp1 <*> arbitraryBitsIntegralExpr) + + , (1, apply2 <$> arbitraryNumOp2 + <*> arbitraryBitsIntegralExpr + <*> arbitraryBitsIntegralExpr) + + , (5, apply2 <$> arbitraryBitsIntegralOp2 + <*> arbitraryBitsIntegralExpr + <*> arbitraryBitsIntegralExpr) + + , (1, apply3 <$> arbitraryITEOp3 + <*> arbitraryBoolExpr + <*> arbitraryBitsIntegralExpr + <*> arbitraryBitsIntegralExpr) + ] + -- *** Op 1 @@ -307,6 +344,22 @@ arbitraryBitsOp2 = elements , (xor, zipWith xor) ] +-- | Generator for arbitrary bit shifting operators with arity 2, paired with +-- their expected meaning. +-- +-- This generator is a bit more strict in its type signature than the +-- underlying bit-shifting operators being tested, since it enforces both the +-- value being manipulated and the value that indicates how much to shift by to +-- have the same type. +arbitraryBitsIntegralOp2 :: (Typed t, Bits t, Integral t) + => Gen ( Stream t -> Stream t -> Stream t + , [t] -> [t] -> [t] + ) +arbitraryBitsIntegralOp2 = elements + [ ((Copilot..<<.), zipWith (\x y -> shiftL x (fromIntegral y))) + , ((Copilot..>>.), zipWith (\x y -> shiftR x (fromIntegral y))) + ] + -- *** Op 3 -- | Generator for if-then-else operator (with arity 3), paired with its From 12c9b5c4312329b1fb0234795ab902884f6b7ecd Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 7 Mar 2022 18:35:38 -0500 Subject: [PATCH 0049/1222] Test reification of floating point expressions. Refs #271. This commit implements tests to reify floating point operators applied to streams, and compare them against their ideal meaning. The meaning is given as a list of elements. --- .../tests/Test/Copilot/Language/Reify.hs | 63 +++++++++++++++++++ 1 file changed, 63 insertions(+) diff --git a/copilot-language/tests/Test/Copilot/Language/Reify.hs b/copilot-language/tests/Test/Copilot/Language/Reify.hs index 7dda1c4ea..58222d348 100644 --- a/copilot-language/tests/Test/Copilot/Language/Reify.hs +++ b/copilot-language/tests/Test/Copilot/Language/Reify.hs @@ -78,6 +78,8 @@ arbitrarySemanticsP = oneof , SemanticsP <$> (arbitraryNumExpr :: Gen (Semantics Word16)) , SemanticsP <$> (arbitraryNumExpr :: Gen (Semantics Word32)) , SemanticsP <$> (arbitraryNumExpr :: Gen (Semantics Word64)) + , SemanticsP <$> (arbitraryFloatingExpr :: Gen (Semantics Float)) + , SemanticsP <$> (arbitraryFloatingExpr :: Gen (Semantics Double)) , SemanticsP <$> (arbitraryBitsExpr :: Gen (Semantics Bool)) , SemanticsP <$> (arbitraryBitsExpr :: Gen (Semantics Int8)) , SemanticsP <$> (arbitraryBitsExpr :: Gen (Semantics Int16)) @@ -208,6 +210,34 @@ arbitraryNumExpr = <*> arbitraryNumExpr) ] +-- | An arbitrary floating point expression, paired with its expected meaning. +arbitraryFloatingExpr :: (Arbitrary t, Typed t, Floating t, Eq t) + => Gen (Stream t, [t]) +arbitraryFloatingExpr = + -- We use frequency instead of oneof because the random expression generator + -- seems to generate expressions that are too large and the test fails due + -- to running out of memory. + frequency + [ (10, arbitraryConst) + + , (5, apply1 <$> arbitraryFloatingOp1 <*> arbitraryFloatingExpr) + + , (5, apply1 <$> arbitraryNumOp1 <*> arbitraryFloatingExpr) + + , (2, apply2 <$> arbitraryFloatingOp2 + <*> arbitraryFloatingExpr + <*> arbitraryFloatingExpr) + + , (2, apply2 <$> arbitraryNumOp2 + <*> arbitraryFloatingExpr + <*> arbitraryFloatingExpr) + + , (1, apply3 <$> arbitraryITEOp3 + <*> arbitraryBoolExpr + <*> arbitraryFloatingExpr + <*> arbitraryFloatingExpr) + ] + -- *** Primitives -- | An arbitrary constant expression of any type, paired with its expected @@ -291,6 +321,28 @@ arbitraryNumOp1 = elements , (signum, fmap signum) ] +-- | Generator for arbitrary floating point operators with arity 1, paired with +-- their expected meaning. +arbitraryFloatingOp1 :: (Typed t, Floating t, Eq t) + => Gen (Stream t -> Stream t, [t] -> [t]) +arbitraryFloatingOp1 = elements + [ (exp, fmap exp) + , (sqrt, fmap sqrt) + , (log, fmap log) + , (sin, fmap sin) + , (tan, fmap tan) + , (cos, fmap cos) + , (asin, fmap asin) + , (atan, fmap atan) + , (acos, fmap acos) + , (sinh, fmap sinh) + , (tanh, fmap tanh) + , (cosh, fmap cosh) + , (asinh, fmap asinh) + , (atanh, fmap atanh) + , (acosh, fmap acosh) + ] + -- | Generator for arbitrary bitwise operators with arity 1, paired with their -- expected meaning. arbitraryBitsOp1 :: (Typed t, Bits t) @@ -323,6 +375,17 @@ arbitraryNumOp2 = elements , ((*), zipWith (*)) ] +-- | Generator for arbitrary floating point operators with arity 2, paired with +-- their expected meaning. +arbitraryFloatingOp2 :: (Typed t, Floating t, Eq t) + => Gen ( Stream t -> Stream t -> Stream t + , [t] -> [t] -> [t] + ) +arbitraryFloatingOp2 = elements + [ ((**), zipWith (**)) + , (logBase, zipWith logBase) + ] + -- | Generator for arbitrary equality operators with arity 2, paired with their -- expected meaning. arbitraryEqOp2 :: (Typed t, Eq t) From 90f3449e0f72b10fad0c58428ab465ac82bf9180 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 7 Mar 2022 18:40:00 -0500 Subject: [PATCH 0050/1222] Test reification of real fractional expressions. Refs #271. This commit implements tests to reify operators applied to RealFrac-number carrying streams, and compare them against their ideal meaning. The meaning is given as a list of elements. --- .../tests/Test/Copilot/Language/Reify.hs | 43 +++++++++++++++++++ 1 file changed, 43 insertions(+) diff --git a/copilot-language/tests/Test/Copilot/Language/Reify.hs b/copilot-language/tests/Test/Copilot/Language/Reify.hs index 58222d348..29c525ee9 100644 --- a/copilot-language/tests/Test/Copilot/Language/Reify.hs +++ b/copilot-language/tests/Test/Copilot/Language/Reify.hs @@ -31,6 +31,7 @@ import qualified Copilot.Language.Operators.Mux as Copilot import Copilot.Language.Reify (reify) import Copilot.Language.Spec (observer) import Copilot.Language.Stream (Stream) +import qualified Copilot.Language.Stream as Copilot -- Internal imports: functions needed to test after reification import Copilot.Core.Type.Show (ShowType (Haskell)) @@ -80,6 +81,8 @@ arbitrarySemanticsP = oneof , SemanticsP <$> (arbitraryNumExpr :: Gen (Semantics Word64)) , SemanticsP <$> (arbitraryFloatingExpr :: Gen (Semantics Float)) , SemanticsP <$> (arbitraryFloatingExpr :: Gen (Semantics Double)) + , SemanticsP <$> (arbitraryRealFracExpr :: Gen (Semantics Float)) + , SemanticsP <$> (arbitraryRealFracExpr :: Gen (Semantics Double)) , SemanticsP <$> (arbitraryBitsExpr :: Gen (Semantics Bool)) , SemanticsP <$> (arbitraryBitsExpr :: Gen (Semantics Int8)) , SemanticsP <$> (arbitraryBitsExpr :: Gen (Semantics Int16)) @@ -238,6 +241,30 @@ arbitraryFloatingExpr = <*> arbitraryFloatingExpr) ] +-- | An arbitrary realfrac expression, paired with its expected meaning. +arbitraryRealFracExpr :: (Arbitrary t, Typed t, RealFrac t) + => Gen (Stream t, [t]) +arbitraryRealFracExpr = + -- We use frequency instead of oneof because the random expression generator + -- seems to generate expressions that are too large and the test fails due + -- to running out of memory. + frequency + [ (10, arbitraryConst) + + , (2, apply1 <$> arbitraryRealFracOp1 <*> arbitraryRealFracExpr) + + , (5, apply1 <$> arbitraryNumOp1 <*> arbitraryRealFracExpr) + + , (1, apply2 <$> arbitraryNumOp2 + <*> arbitraryRealFracExpr + <*> arbitraryRealFracExpr) + + , (1, apply3 <$> arbitraryITEOp3 + <*> arbitraryBoolExpr + <*> arbitraryRealFracExpr + <*> arbitraryRealFracExpr) + ] + -- *** Primitives -- | An arbitrary constant expression of any type, paired with its expected @@ -343,6 +370,22 @@ arbitraryFloatingOp1 = elements , (acosh, fmap acosh) ] +-- | Generator for arbitrary realfrac operators with arity 1, paired with their +-- expected meaning. +arbitraryRealFracOp1 :: (Typed t, RealFrac t) + => Gen (Stream t -> Stream t, [t] -> [t]) +arbitraryRealFracOp1 = elements + [ (Copilot.ceiling, fmap (fromIntegral . idI . ceiling)) + , (Copilot.floor, fmap (fromIntegral . idI . floor)) + ] + where + -- Auxiliary function to help the compiler determine which integral type + -- the result of ceiling must be converted to. An Integer ensures that the + -- result fits and there is no loss of precision due to the intermediate + -- casting. + idI :: Integer -> Integer + idI = id + -- | Generator for arbitrary bitwise operators with arity 1, paired with their -- expected meaning. arbitraryBitsOp1 :: (Typed t, Bits t) From 698315f293ad6e2825e3188fa8acf83db61e5f8f Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 7 Mar 2022 18:42:34 -0500 Subject: [PATCH 0051/1222] Test reification of real floating point expressions. Refs #271. This commit implements tests to reify operators applied to RealFloat-number carrying streams, and compare them against their ideal meaning. The meaning is given as a list of elements. --- .../tests/Test/Copilot/Language/Reify.hs | 38 +++++++++++++++++++ 1 file changed, 38 insertions(+) diff --git a/copilot-language/tests/Test/Copilot/Language/Reify.hs b/copilot-language/tests/Test/Copilot/Language/Reify.hs index 29c525ee9..e6a8ecf5e 100644 --- a/copilot-language/tests/Test/Copilot/Language/Reify.hs +++ b/copilot-language/tests/Test/Copilot/Language/Reify.hs @@ -83,6 +83,8 @@ arbitrarySemanticsP = oneof , SemanticsP <$> (arbitraryFloatingExpr :: Gen (Semantics Double)) , SemanticsP <$> (arbitraryRealFracExpr :: Gen (Semantics Float)) , SemanticsP <$> (arbitraryRealFracExpr :: Gen (Semantics Double)) + , SemanticsP <$> (arbitraryRealFloatExpr :: Gen (Semantics Float)) + , SemanticsP <$> (arbitraryRealFloatExpr :: Gen (Semantics Double)) , SemanticsP <$> (arbitraryBitsExpr :: Gen (Semantics Bool)) , SemanticsP <$> (arbitraryBitsExpr :: Gen (Semantics Int8)) , SemanticsP <$> (arbitraryBitsExpr :: Gen (Semantics Int16)) @@ -265,6 +267,32 @@ arbitraryRealFracExpr = <*> arbitraryRealFracExpr) ] +-- | An arbitrary realfloat expression, paired with its expected meaning. +arbitraryRealFloatExpr :: (Arbitrary t, Typed t, RealFloat t) + => Gen (Stream t, [t]) +arbitraryRealFloatExpr = + -- We use frequency instead of oneof because the random expression generator + -- seems to generate expressions that are too large and the test fails due + -- to running out of memory. + frequency + [ (10, arbitraryConst) + + , (2, apply1 <$> arbitraryNumOp1 <*> arbitraryRealFloatExpr) + + , (5, apply2 <$> arbitraryRealFloatOp2 + <*> arbitraryRealFloatExpr + <*> arbitraryRealFloatExpr) + + , (1, apply2 <$> arbitraryNumOp2 + <*> arbitraryRealFloatExpr + <*> arbitraryRealFloatExpr) + + , (1, apply3 <$> arbitraryITEOp3 + <*> arbitraryBoolExpr + <*> arbitraryRealFloatExpr + <*> arbitraryRealFloatExpr) + ] + -- *** Primitives -- | An arbitrary constant expression of any type, paired with its expected @@ -429,6 +457,16 @@ arbitraryFloatingOp2 = elements , (logBase, zipWith logBase) ] +-- | Generator for arbitrary floating point operators with arity 2, paired with +-- their expected meaning. +arbitraryRealFloatOp2 :: (Typed t, RealFloat t) + => Gen ( Stream t -> Stream t -> Stream t + , [t] -> [t] -> [t] + ) +arbitraryRealFloatOp2 = elements + [ (Copilot.atan2, zipWith atan2) + ] + -- | Generator for arbitrary equality operators with arity 2, paired with their -- expected meaning. arbitraryEqOp2 :: (Typed t, Eq t) From 25b68fe03a80519dc5e60bece35206c8db7fec58 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 7 Mar 2022 18:47:32 -0500 Subject: [PATCH 0052/1222] Test reification of fractional expressions. Refs #271. This commit implements tests to reify operators applied to fractional number carrying streams, and compare them against their ideal meaning. The meaning is given as a list of elements. --- .../tests/Test/Copilot/Language/Reify.hs | 57 ++++++++++++++++++- 1 file changed, 56 insertions(+), 1 deletion(-) diff --git a/copilot-language/tests/Test/Copilot/Language/Reify.hs b/copilot-language/tests/Test/Copilot/Language/Reify.hs index e6a8ecf5e..97e3ee25b 100644 --- a/copilot-language/tests/Test/Copilot/Language/Reify.hs +++ b/copilot-language/tests/Test/Copilot/Language/Reify.hs @@ -18,7 +18,7 @@ import Test.Framework.Providers.QuickCheck2 (testProperty) import Test.QuickCheck (Arbitrary, Gen, Property, arbitrary, chooseInt, elements, forAll, forAllShow, frequency, - oneof) + oneof, suchThat) import Test.QuickCheck.Monadic (monadicIO, run) -- Internal imports: library modules being tested @@ -85,6 +85,8 @@ arbitrarySemanticsP = oneof , SemanticsP <$> (arbitraryRealFracExpr :: Gen (Semantics Double)) , SemanticsP <$> (arbitraryRealFloatExpr :: Gen (Semantics Float)) , SemanticsP <$> (arbitraryRealFloatExpr :: Gen (Semantics Double)) + , SemanticsP <$> (arbitraryFractionalExpr :: Gen (Semantics Float)) + , SemanticsP <$> (arbitraryFractionalExpr :: Gen (Semantics Double)) , SemanticsP <$> (arbitraryBitsExpr :: Gen (Semantics Bool)) , SemanticsP <$> (arbitraryBitsExpr :: Gen (Semantics Int8)) , SemanticsP <$> (arbitraryBitsExpr :: Gen (Semantics Int16)) @@ -293,6 +295,41 @@ arbitraryRealFloatExpr = <*> arbitraryRealFloatExpr) ] +-- | An arbitrary fractional expression, paired with its expected meaning. +-- +-- We add the constraint Eq because we sometimes need to make sure numbers are +-- not zero. +arbitraryFractionalExpr :: (Arbitrary t, Typed t, Fractional t, Eq t) + => Gen (Stream t, [t]) +arbitraryFractionalExpr = + -- We use frequency instead of oneof because the random expression generator + -- seems to generate expressions that are too large and the test fails due + -- to running out of memory. + frequency + [ (10, arbitraryConst) + + , (5, apply1 <$> arbitraryFractionalOp1 <*> arbitraryFractionalExpr) + + , (5, apply1 <$> arbitraryNumOp1 <*> arbitraryFractionalExpr) + + , (2, apply2 <$> arbitraryFractionalOp2 + <*> arbitraryFractionalExpr + <*> arbitraryFractionalExprNonZero) + + , (1, apply3 <$> arbitraryITEOp3 + <*> arbitraryBoolExpr + <*> arbitraryFractionalExpr + <*> arbitraryFractionalExpr) + ] + where + + -- Generator for fractional expressions that are never zero. + -- + -- The list is infinite, so this generator checks up to maxTraceLength + -- elements. + arbitraryFractionalExprNonZero = arbitraryFractionalExpr + `suchThat` (notElem 0 . take maxTraceLength . snd) + -- *** Primitives -- | An arbitrary constant expression of any type, paired with its expected @@ -414,6 +451,14 @@ arbitraryRealFracOp1 = elements idI :: Integer -> Integer idI = id +-- | Generator for arbitrary fractional operators with arity 1, paired with +-- their expected meaning. +arbitraryFractionalOp1 :: (Typed t, Fractional t, Eq t) + => Gen (Stream t -> Stream t, [t] -> [t]) +arbitraryFractionalOp1 = elements + [ (recip, fmap recip) + ] + -- | Generator for arbitrary bitwise operators with arity 1, paired with their -- expected meaning. arbitraryBitsOp1 :: (Typed t, Bits t) @@ -446,6 +491,16 @@ arbitraryNumOp2 = elements , ((*), zipWith (*)) ] +-- | Generator for arbitrary fractional operators with arity 2, paired with +-- their expected meaning. +arbitraryFractionalOp2 :: (Typed t, Fractional t, Eq t) + => Gen ( Stream t -> Stream t -> Stream t + , [t] -> [t] -> [t] + ) +arbitraryFractionalOp2 = elements + [ ((/), zipWith (/)) + ] + -- | Generator for arbitrary floating point operators with arity 2, paired with -- their expected meaning. arbitraryFloatingOp2 :: (Typed t, Floating t, Eq t) From 5d6dd75445098eb90a2deb33023c05f474295347 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 7 Mar 2022 18:50:05 -0500 Subject: [PATCH 0053/1222] Test reification of integral expressions. Refs #271. This commit implements tests to reify operators applied to intergral number carrying streams, and compare them against their ideal meaning. The meaning is given as a list of elements. --- .../tests/Test/Copilot/Language/Reify.hs | 57 +++++++++++++++++++ 1 file changed, 57 insertions(+) diff --git a/copilot-language/tests/Test/Copilot/Language/Reify.hs b/copilot-language/tests/Test/Copilot/Language/Reify.hs index 97e3ee25b..6e8c56db0 100644 --- a/copilot-language/tests/Test/Copilot/Language/Reify.hs +++ b/copilot-language/tests/Test/Copilot/Language/Reify.hs @@ -27,6 +27,7 @@ import qualified Copilot.Language.Operators.BitWise as Copilot import qualified Copilot.Language.Operators.Boolean as Copilot import qualified Copilot.Language.Operators.Constant as Copilot import qualified Copilot.Language.Operators.Eq as Copilot +import qualified Copilot.Language.Operators.Integral as Copilot import qualified Copilot.Language.Operators.Mux as Copilot import Copilot.Language.Reify (reify) import Copilot.Language.Spec (observer) @@ -87,6 +88,14 @@ arbitrarySemanticsP = oneof , SemanticsP <$> (arbitraryRealFloatExpr :: Gen (Semantics Double)) , SemanticsP <$> (arbitraryFractionalExpr :: Gen (Semantics Float)) , SemanticsP <$> (arbitraryFractionalExpr :: Gen (Semantics Double)) + , SemanticsP <$> (arbitraryIntegralExpr :: Gen (Semantics Int8)) + , SemanticsP <$> (arbitraryIntegralExpr :: Gen (Semantics Int16)) + , SemanticsP <$> (arbitraryIntegralExpr :: Gen (Semantics Int32)) + , SemanticsP <$> (arbitraryIntegralExpr :: Gen (Semantics Int64)) + , SemanticsP <$> (arbitraryIntegralExpr :: Gen (Semantics Word8)) + , SemanticsP <$> (arbitraryIntegralExpr :: Gen (Semantics Word16)) + , SemanticsP <$> (arbitraryIntegralExpr :: Gen (Semantics Word32)) + , SemanticsP <$> (arbitraryIntegralExpr :: Gen (Semantics Word64)) , SemanticsP <$> (arbitraryBitsExpr :: Gen (Semantics Bool)) , SemanticsP <$> (arbitraryBitsExpr :: Gen (Semantics Int8)) , SemanticsP <$> (arbitraryBitsExpr :: Gen (Semantics Int16)) @@ -330,6 +339,43 @@ arbitraryFractionalExpr = arbitraryFractionalExprNonZero = arbitraryFractionalExpr `suchThat` (notElem 0 . take maxTraceLength . snd) +-- | An arbitrary integral expression, paired with its expected meaning. +-- +-- We add the constraint Eq because we sometimes need to make sure numbers are +-- not zero. +arbitraryIntegralExpr :: (Arbitrary t, Typed t, Integral t, Eq t) + => Gen (Stream t, [t]) +arbitraryIntegralExpr = + -- We use frequency instead of oneof because the random expression generator + -- seems to generate expressions that are too large and the test fails due + -- to running out of memory. + frequency + [ (10, arbitraryConst) + + , (5, apply1 <$> arbitraryNumOp1 <*> arbitraryIntegralExpr) + + , (2, apply2 <$> arbitraryNumOp2 + <*> arbitraryIntegralExpr + <*> arbitraryIntegralExpr) + + , (2, apply2 <$> arbitraryIntegralOp2 + <*> arbitraryIntegralExpr + <*> arbitraryIntegralExprNonZero) + + , (1, apply3 <$> arbitraryITEOp3 + <*> arbitraryBoolExpr + <*> arbitraryIntegralExpr + <*> arbitraryIntegralExpr) + ] + where + + -- Generator for integral expressions that are never zero. + -- + -- The list is infinite, so this generator checks up to maxTraceLength + -- elements. + arbitraryIntegralExprNonZero = arbitraryIntegralExpr + `suchThat` (notElem 0 . take maxTraceLength . snd) + -- *** Primitives -- | An arbitrary constant expression of any type, paired with its expected @@ -491,6 +537,17 @@ arbitraryNumOp2 = elements , ((*), zipWith (*)) ] +-- | Generator for arbitrary integral operators with arity 2, paired with their +-- expected meaning. +arbitraryIntegralOp2 :: (Typed t, Integral t) + => Gen ( Stream t -> Stream t -> Stream t + , [t] -> [t] -> [t] + ) +arbitraryIntegralOp2 = elements + [ (Copilot.mod, zipWith mod) + , (Copilot.div, zipWith quot) + ] + -- | Generator for arbitrary fractional operators with arity 2, paired with -- their expected meaning. arbitraryFractionalOp2 :: (Typed t, Fractional t, Eq t) From 191d3413d0dfa76b7c6f2892a1aed0dcb1b54c8d Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 7 Mar 2022 18:52:39 -0500 Subject: [PATCH 0054/1222] Test reification of ord expressions. Refs #271. This commit implements tests to reify comparison (i.e., Ord) operators applied to streams, and compare them against their ideal meaning. The meaning is given as a list of elements. --- .../tests/Test/Copilot/Language/Reify.hs | 54 +++++++++++++++++++ 1 file changed, 54 insertions(+) diff --git a/copilot-language/tests/Test/Copilot/Language/Reify.hs b/copilot-language/tests/Test/Copilot/Language/Reify.hs index 6e8c56db0..203b17a7b 100644 --- a/copilot-language/tests/Test/Copilot/Language/Reify.hs +++ b/copilot-language/tests/Test/Copilot/Language/Reify.hs @@ -29,6 +29,7 @@ import qualified Copilot.Language.Operators.Constant as Copilot import qualified Copilot.Language.Operators.Eq as Copilot import qualified Copilot.Language.Operators.Integral as Copilot import qualified Copilot.Language.Operators.Mux as Copilot +import qualified Copilot.Language.Operators.Ord as Copilot import Copilot.Language.Reify (reify) import Copilot.Language.Spec (observer) import Copilot.Language.Stream (Stream) @@ -200,6 +201,46 @@ arbitraryBoolExpr = <*> arbitraryNumExpr <*> (arbitraryNumExpr :: Gen (Stream Word64, [Word64]))) + , (1, apply2 <$> arbitraryOrdOp2 + <*> arbitraryNumExpr + <*> (arbitraryNumExpr :: Gen (Stream Int8, [Int8]))) + + , (1, apply2 <$> arbitraryOrdOp2 + <*> arbitraryNumExpr + <*> (arbitraryNumExpr :: Gen (Stream Int16, [Int16]))) + + , (1, apply2 <$> arbitraryOrdOp2 + <*> arbitraryNumExpr + <*> (arbitraryNumExpr :: Gen (Stream Int32, [Int32]))) + + , (1, apply2 <$> arbitraryOrdOp2 + <*> arbitraryNumExpr + <*> (arbitraryNumExpr :: Gen (Stream Int64, [Int64]))) + + , (1, apply2 <$> arbitraryOrdOp2 + <*> arbitraryNumExpr + <*> (arbitraryNumExpr :: Gen (Stream Word8, [Word8]))) + + , (1, apply2 <$> arbitraryOrdOp2 + <*> arbitraryNumExpr + <*> (arbitraryNumExpr :: Gen (Stream Word16, [Word16]))) + + , (1, apply2 <$> arbitraryOrdOp2 + <*> arbitraryNumExpr + <*> (arbitraryNumExpr :: Gen (Stream Word32, [Word32]))) + + , (1, apply2 <$> arbitraryOrdOp2 + <*> arbitraryNumExpr + <*> (arbitraryNumExpr :: Gen (Stream Word64, [Word64]))) + + , (1, apply2 <$> arbitraryOrdOp2 + <*> arbitraryFloatingExpr + <*> (arbitraryFloatingExpr :: Gen (Stream Float, [Float]))) + + , (1, apply2 <$> arbitraryOrdOp2 + <*> arbitraryFloatingExpr + <*> (arbitraryFloatingExpr :: Gen (Stream Double, [Double]))) + , (1, apply3 <$> arbitraryITEOp3 <*> arbitraryBoolExpr <*> arbitraryBoolExpr @@ -590,6 +631,19 @@ arbitraryEqOp2 = elements , ((Copilot./=), zipWith (/=)) ] +-- | Generator for arbitrary ordering operators with arity 2, paired with their +-- expected meaning. +arbitraryOrdOp2 :: (Typed t, Ord t) + => Gen ( Stream t -> Stream t -> Stream Bool + , [t] -> [t] -> [Bool] + ) +arbitraryOrdOp2 = elements + [ ((Copilot.<=), zipWith (<=)) + , ((Copilot.<), zipWith (<)) + , ((Copilot.>=), zipWith (>=)) + , ((Copilot.>), zipWith (>)) + ] + -- | Generator for arbitrary bitwise operators with arity 2, paired with their -- expected meaning. arbitraryBitsOp2 :: (Typed t, Bits t) From 5fe5f23f09086354e2e9270dd91f2e3b35154630 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 7 Mar 2022 18:54:06 -0500 Subject: [PATCH 0055/1222] Reorganize file to match Copilot.Core's tests. Refs #271. This commit does not change behavior. It simply moves functions around to make definitions match the order in the copilot-core library, so that it's easier to detect mistakes and maintain the file. --- .../tests/Test/Copilot/Language/Reify.hs | 34 ++++++++++--------- 1 file changed, 18 insertions(+), 16 deletions(-) diff --git a/copilot-language/tests/Test/Copilot/Language/Reify.hs b/copilot-language/tests/Test/Copilot/Language/Reify.hs index 203b17a7b..92d001ee7 100644 --- a/copilot-language/tests/Test/Copilot/Language/Reify.hs +++ b/copilot-language/tests/Test/Copilot/Language/Reify.hs @@ -116,6 +116,24 @@ arbitrarySemanticsP = oneof , SemanticsP <$> (arbitraryBitsIntegralExpr :: Gen (Semantics Word64)) ] + +-- ** Random Stream generators + + +-- | An arbitrary constant expression of any type, paired with its expected +-- meaning. +arbitraryConst :: (Arbitrary t, Typed t) + => Gen (Stream t, [t]) +arbitraryConst = (\v -> (Copilot.constant v, repeat v)) <$> arbitrary + +-- | Generator for constant boolean streams, paired with their expected +-- meaning. +arbitraryBoolOp0 :: Gen (Stream Bool, [Bool]) +arbitraryBoolOp0 = elements + [ (Copilot.false, repeat False) + , (Copilot.true, repeat True) + ] + -- | An arbitrary boolean expression, paired with its expected meaning. arbitraryBoolExpr :: Gen (Stream Bool, [Bool]) arbitraryBoolExpr = @@ -417,22 +435,6 @@ arbitraryIntegralExpr = arbitraryIntegralExprNonZero = arbitraryIntegralExpr `suchThat` (notElem 0 . take maxTraceLength . snd) --- *** Primitives - --- | An arbitrary constant expression of any type, paired with its expected --- meaning. -arbitraryConst :: (Arbitrary t, Typed t) - => Gen (Stream t, [t]) -arbitraryConst = (\v -> (Copilot.constant v, repeat v)) <$> arbitrary - --- | Generator for constant boolean streams, paired with their expected --- meaning. -arbitraryBoolOp0 :: Gen (Stream Bool, [Bool]) -arbitraryBoolOp0 = elements - [ (Copilot.false, repeat False) - , (Copilot.true, repeat True) - ] - -- | An arbitrary Bits expression, paired with its expected meaning. arbitraryBitsExpr :: (Arbitrary t, Typed t, Bits t) => Gen (Stream t, [t]) From 31cffa32f273c43b15f507f149add1110e44693c Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 7 Mar 2022 18:55:42 -0500 Subject: [PATCH 0056/1222] Section separator. Refs #271. This commit does not change behavior. It simply adds a missing haddock separator to make the tests in this library and copilot-core match, so that it's easier to detect mistakes and maintain the file. --- copilot-language/tests/Test/Copilot/Language/Reify.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/copilot-language/tests/Test/Copilot/Language/Reify.hs b/copilot-language/tests/Test/Copilot/Language/Reify.hs index 92d001ee7..062a9d778 100644 --- a/copilot-language/tests/Test/Copilot/Language/Reify.hs +++ b/copilot-language/tests/Test/Copilot/Language/Reify.hs @@ -483,6 +483,7 @@ arbitraryBitsIntegralExpr = <*> arbitraryBitsIntegralExpr) ] +-- ** Operators -- *** Op 1 From 0dd0f7465d4d3029801546ca6fa7235d85132707 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 7 Mar 2022 19:41:27 -0500 Subject: [PATCH 0057/1222] Document changes. Refs #271. [ci skip] --- copilot-language/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-language/CHANGELOG b/copilot-language/CHANGELOG index 0ba2a14e2..1c584adc1 100644 --- a/copilot-language/CHANGELOG +++ b/copilot-language/CHANGELOG @@ -1,3 +1,6 @@ +2022-03-07 + * Introduce testing infrastructure. (#271) + 2022-01-07 * Version bump (3.7). (#287) * Bring back externF. (#261) From 6d94d273f53f4c62ec3f1c121a671cfcfb8f4ab1 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 7 Mar 2022 19:48:21 -0500 Subject: [PATCH 0058/1222] Bump versions and constraints (3.8). Refs #298. --- copilot-c99/copilot-c99.cabal | 4 ++-- copilot-core/copilot-core.cabal | 2 +- copilot-language/copilot-language.cabal | 6 +++--- copilot-libraries/copilot-libraries.cabal | 4 ++-- copilot-theorem/copilot-theorem.cabal | 4 ++-- copilot/copilot.cabal | 12 ++++++------ 6 files changed, 16 insertions(+), 16 deletions(-) diff --git a/copilot-c99/copilot-c99.cabal b/copilot-c99/copilot-c99.cabal index d30f219a7..ebc097789 100644 --- a/copilot-c99/copilot-c99.cabal +++ b/copilot-c99/copilot-c99.cabal @@ -1,6 +1,6 @@ cabal-version : >= 1.10 name : copilot-c99 -version : 3.7 +version : 3.8 synopsis : A compiler for Copilot targeting C99. description : This package is a back-end from Copilot to C. @@ -50,7 +50,7 @@ library , mtl >= 2.2 && < 2.3 , pretty >= 1.1 && < 1.2 - , copilot-core >= 3.7 && < 3.8 + , copilot-core >= 3.8 && < 3.9 , language-c99 >= 0.1.1 && < 0.2 , language-c99-util >= 0.1.1 && < 0.2 , language-c99-simple >= 0.1.1 && < 0.2 diff --git a/copilot-core/copilot-core.cabal b/copilot-core/copilot-core.cabal index c9d40fb56..1e68cd15c 100644 --- a/copilot-core/copilot-core.cabal +++ b/copilot-core/copilot-core.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-core -version: 3.7 +version: 3.8 synopsis: An intermediate representation for Copilot. description: Intermediate representation for Copilot. diff --git a/copilot-language/copilot-language.cabal b/copilot-language/copilot-language.cabal index 1449487f1..ece3004d3 100644 --- a/copilot-language/copilot-language.cabal +++ b/copilot-language/copilot-language.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-language -version: 3.7 +version: 3.8 synopsis: A Haskell-embedded DSL for monitoring hard real-time distributed systems. description: @@ -42,8 +42,8 @@ library , data-reify >= 0.6 && < 0.7 , mtl >= 2.0 && < 3 - , copilot-core >= 3.7 && < 3.8 - , copilot-theorem >= 3.7 && < 3.8 + , copilot-core >= 3.8 && < 3.9 + , copilot-theorem >= 3.8 && < 3.9 exposed-modules: Copilot.Language , Copilot.Language.Operators.BitWise diff --git a/copilot-libraries/copilot-libraries.cabal b/copilot-libraries/copilot-libraries.cabal index 143a70b87..65ace050f 100644 --- a/copilot-libraries/copilot-libraries.cabal +++ b/copilot-libraries/copilot-libraries.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-libraries -version: 3.7 +version: 3.8 synopsis: Libraries for the Copilot language. description: Libraries for the Copilot language. @@ -43,7 +43,7 @@ library , data-reify >= 0.6 && < 0.7 , mtl >= 2.0 && < 2.3 , parsec >= 2.0 && < 3.2 - , copilot-language >= 3.7 && < 3.8 + , copilot-language >= 3.8 && < 3.9 exposed-modules: Copilot.Library.Libraries diff --git a/copilot-theorem/copilot-theorem.cabal b/copilot-theorem/copilot-theorem.cabal index 2cb4110d9..8b08737ef 100644 --- a/copilot-theorem/copilot-theorem.cabal +++ b/copilot-theorem/copilot-theorem.cabal @@ -14,7 +14,7 @@ description: . -version : 3.7 +version : 3.8 license : BSD3 license-file : LICENSE maintainer : Ivan Perez @@ -74,7 +74,7 @@ library , xml >= 1.3 && < 1.4 , what4 >= 1.1 && < 1.3 - , copilot-core >= 3.7 && < 3.8 + , copilot-core >= 3.8 && < 3.9 exposed-modules : Copilot.Theorem , Copilot.Theorem.Prove diff --git a/copilot/copilot.cabal b/copilot/copilot.cabal index 5a38e3e65..19d9d47d0 100644 --- a/copilot/copilot.cabal +++ b/copilot/copilot.cabal @@ -1,5 +1,5 @@ name: copilot -version: 3.7 +version: 3.8 cabal-version: >= 1.10 license: BSD3 license-file: LICENSE @@ -52,11 +52,11 @@ library , directory >= 1.3 && < 1.4 , filepath >= 1.4 && < 1.5 - , copilot-core >= 3.7 && < 3.8 - , copilot-theorem >= 3.7 && < 3.8 - , copilot-language >= 3.7 && < 3.8 - , copilot-libraries >= 3.7 && < 3.8 - , copilot-c99 >= 3.7 && < 3.8 + , copilot-core >= 3.8 && < 3.9 + , copilot-theorem >= 3.8 && < 3.9 + , copilot-language >= 3.8 && < 3.9 + , copilot-libraries >= 3.8 && < 3.9 + , copilot-c99 >= 3.8 && < 3.9 exposed-modules: Language.Copilot, Language.Copilot.Main From ef56d50a5efbe70914bab15d4674179cf5e11650 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 7 Mar 2022 19:51:12 -0500 Subject: [PATCH 0059/1222] Document version bump. Refs #298. [ci skip] --- copilot-c99/CHANGELOG | 3 +++ copilot-core/CHANGELOG | 3 +++ copilot-language/CHANGELOG | 1 + copilot-libraries/CHANGELOG | 3 +++ copilot-theorem/CHANGELOG | 3 +++ copilot/CHANGELOG | 3 +++ 6 files changed, 16 insertions(+) diff --git a/copilot-c99/CHANGELOG b/copilot-c99/CHANGELOG index 952e50f94..280b4a090 100644 --- a/copilot-c99/CHANGELOG +++ b/copilot-c99/CHANGELOG @@ -1,3 +1,6 @@ +2022-03-07 + * Version bump (3.8). (#298) + 2022-01-07 * Version bump (3.7). (#287) * Guard against empty specs. (#274) diff --git a/copilot-core/CHANGELOG b/copilot-core/CHANGELOG index b426f8e3e..36b895e89 100644 --- a/copilot-core/CHANGELOG +++ b/copilot-core/CHANGELOG @@ -1,3 +1,6 @@ +2022-03-07 + * Version bump (3.8). (#298) + 2022-01-07 * Version bump (3.7). (#287) * Make imports explicit, reorganize imports. (#277) diff --git a/copilot-language/CHANGELOG b/copilot-language/CHANGELOG index 1c584adc1..e86e3bd8c 100644 --- a/copilot-language/CHANGELOG +++ b/copilot-language/CHANGELOG @@ -1,4 +1,5 @@ 2022-03-07 + * Version bump (3.8). (#298) * Introduce testing infrastructure. (#271) 2022-01-07 diff --git a/copilot-libraries/CHANGELOG b/copilot-libraries/CHANGELOG index 04d189dc0..a45261e1b 100644 --- a/copilot-libraries/CHANGELOG +++ b/copilot-libraries/CHANGELOG @@ -1,3 +1,6 @@ +2022-01-07 + * Version bump (3.8). (#298) + 2022-01-07 * Version bump (3.7). (#287) diff --git a/copilot-theorem/CHANGELOG b/copilot-theorem/CHANGELOG index 6d331fb49..d3b72a27d 100644 --- a/copilot-theorem/CHANGELOG +++ b/copilot-theorem/CHANGELOG @@ -1,3 +1,6 @@ +2022-03-07 + * Version bump (3.8). (#298) + 2022-01-07 * Version bump (3.7). (#287) * Relax version contraints on what4. (#277) diff --git a/copilot/CHANGELOG b/copilot/CHANGELOG index a3ffb4ec8..f3de7dd2c 100644 --- a/copilot/CHANGELOG +++ b/copilot/CHANGELOG @@ -1,3 +1,6 @@ +2022-03-07 + * Version bump (3.8). (#298) + 2022-01-07 * Version bump (3.7). (#287) * Add example with nested structs. (#275) From a491f89e806ab9049145f5414a04217d80166159 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 7 Mar 2022 19:55:13 -0500 Subject: [PATCH 0060/1222] Document missing changes. Refs #298. [ci skip] --- copilot-c99/CHANGELOG | 2 ++ copilot-core/CHANGELOG | 2 ++ copilot-language/CHANGELOG | 3 +++ copilot-libraries/CHANGELOG | 1 + copilot-theorem/CHANGELOG | 1 + copilot/CHANGELOG | 1 + 6 files changed, 10 insertions(+) diff --git a/copilot-c99/CHANGELOG b/copilot-c99/CHANGELOG index 280b4a090..7760d8986 100644 --- a/copilot-c99/CHANGELOG +++ b/copilot-c99/CHANGELOG @@ -1,5 +1,7 @@ 2022-03-07 * Version bump (3.8). (#298) + * Hide internal modules deprecated in Copilot 3.5. (#289) + * Mark package as uncurated to avoid modification. (#288) 2022-01-07 * Version bump (3.7). (#287) diff --git a/copilot-core/CHANGELOG b/copilot-core/CHANGELOG index 36b895e89..c9d7cfc53 100644 --- a/copilot-core/CHANGELOG +++ b/copilot-core/CHANGELOG @@ -1,5 +1,7 @@ 2022-03-07 * Version bump (3.8). (#298) + * Replaces uses of the internal Dynamic with base:Data.Dynamic. (#266) + * Mark package as uncurated to avoid modification. (#288) 2022-01-07 * Version bump (3.7). (#287) diff --git a/copilot-language/CHANGELOG b/copilot-language/CHANGELOG index e86e3bd8c..ec32a7bdf 100644 --- a/copilot-language/CHANGELOG +++ b/copilot-language/CHANGELOG @@ -1,6 +1,9 @@ 2022-03-07 * Version bump (3.8). (#298) * Introduce testing infrastructure. (#271) + * Remove deprecated module Copilot. (#291) + * Remove deprecated type StructArg. (#290) + * Mark package as uncurated to avoid modification. (#288) 2022-01-07 * Version bump (3.7). (#287) diff --git a/copilot-libraries/CHANGELOG b/copilot-libraries/CHANGELOG index a45261e1b..f50469d9f 100644 --- a/copilot-libraries/CHANGELOG +++ b/copilot-libraries/CHANGELOG @@ -1,5 +1,6 @@ 2022-01-07 * Version bump (3.8). (#298) + * Mark package as uncurated to avoid modification. (#288) 2022-01-07 * Version bump (3.7). (#287) diff --git a/copilot-theorem/CHANGELOG b/copilot-theorem/CHANGELOG index d3b72a27d..412a25702 100644 --- a/copilot-theorem/CHANGELOG +++ b/copilot-theorem/CHANGELOG @@ -1,5 +1,6 @@ 2022-03-07 * Version bump (3.8). (#298) + * Mark package as uncurated to avoid modification. (#288) 2022-01-07 * Version bump (3.7). (#287) diff --git a/copilot/CHANGELOG b/copilot/CHANGELOG index f3de7dd2c..6ed417243 100644 --- a/copilot/CHANGELOG +++ b/copilot/CHANGELOG @@ -1,5 +1,6 @@ 2022-03-07 * Version bump (3.8). (#298) + * Mark package as uncurated to avoid modification. (#288) 2022-01-07 * Version bump (3.7). (#287) From 6c4d0d0ee182c72d42e2bc669af1d34e5b801386 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 7 Apr 2022 12:28:49 -0400 Subject: [PATCH 0061/1222] Remove unused type Copilot.Core.Expr.Tag. Refs #304. The type Copilot.Core.Expr.Tag was deprecated in Copilot 3.6 because it was not used and therefore did not belong in the program (see #260). As per our internal policy of waiting 3 versions from deprecation until a public interface declaration can be removed, this type can now be removed completely. The following demonstrates that the type is unused within Copilot: ``` $ grep -nHre '\' --include='*.hs' | grep -ve '^{-#' | grep -ve '--.*Tag' | grep -ve '"[^"]*Tag[^"]*"' copilot-core/src/Copilot/Core/Expr.hs:15: , Tag copilot-core/src/Copilot/Core/Expr.hs:43:type Tag = Int ``` Only the declaration in the module Copilot.Core.Expr is shown. This commit removes the declaration. Using the method above shows no results. --- copilot-core/src/Copilot/Core/Expr.hs | 7 ------- 1 file changed, 7 deletions(-) diff --git a/copilot-core/src/Copilot/Core/Expr.hs b/copilot-core/src/Copilot/Core/Expr.hs index 99ed57dc3..d8467b806 100644 --- a/copilot-core/src/Copilot/Core/Expr.hs +++ b/copilot-core/src/Copilot/Core/Expr.hs @@ -12,7 +12,6 @@ module Copilot.Core.Expr , Expr (..) , UExpr (..) , DropIdx - , Tag ) where import Copilot.Core.Operators (Op1, Op2, Op3) @@ -38,12 +37,6 @@ type DropIdx = Word32 -------------------------------------------------------------------------------- --- | A unique tag for external arrays/function calls. -{-# DEPRECATED Tag "The type Tag is deprecated in Copilot 3.6." #-} -type Tag = Int - --------------------------------------------------------------------------------- - -- | Internal representation of Copilot stream expressions. -- -- The Core representation mimics the high-level Copilot stream, but the Core From c8f86d5be2ad4ec7f808b1f09efd7226596a4152 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 7 Apr 2022 12:32:01 -0400 Subject: [PATCH 0062/1222] Document changes in CHANGELOG. Refs #304. --- copilot-core/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-core/CHANGELOG b/copilot-core/CHANGELOG index c9d7cfc53..41f04e90e 100644 --- a/copilot-core/CHANGELOG +++ b/copilot-core/CHANGELOG @@ -1,3 +1,6 @@ +2022-04-07 + * Remove Copilot.Core.Expr.Tag. (#304) + 2022-03-07 * Version bump (3.8). (#298) * Replaces uses of the internal Dynamic with base:Data.Dynamic. (#266) From 3317bccfaf33488f029f2ee2888df0205b448439 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 8 Apr 2022 08:34:13 -0400 Subject: [PATCH 0063/1222] Remove module Copilot.Core.Type.Uninitialized. Refs #302. The function Copilot.Core.Type.Uninitialized.uninitialized was deprecated in Copilot 3.6. The function was incomplete, and it was only used in one example, so what was needed from it was moved directly there. As per our internal policy of waiting 3 versions from deprecation until a public interface declaration can be removed, this type can now be removed completely. Since it is the only definition in the module Copilot.Core.Type.Uninitialized, the whole module can be removed. The following demonstrates that the module is unused within Copilot: ``` $ grep -nHre 'Uninitialized' --include='*.hs' | grep -ve '^{-#' | grep -ve '--.*Uninitialized' | grep -ve '"[^"]*Uninitialized[^"]*"' copilot-core/src/Copilot/Core/Type/Uninitialized.hs:10:module Copilot.Core.Type.Uninitialized copilot-core/src/Copilot/Core.hs:33: , module Copilot.Core.Type.Uninitialized copilot-core/src/Copilot/Core.hs:45:import Copilot.Core.Type.Uninitialized ``` We use the module and not the function because a function with the same name is used in an example. The result obtained are three lines: the module, its re-import from Copilot.Core, and it being exported. The function uninitialized is not required by Copilot's requirements, and therefore should not be published. This commit removes the module, and removes its declaration as a re-exported module both in Copilot.Core and directly in the cabal package. Using the method above shows no results. --- copilot-core/copilot-core.cabal | 1 - copilot-core/src/Copilot/Core.hs | 2 -- .../src/Copilot/Core/Type/Uninitialized.hs | 35 ------------------- 3 files changed, 38 deletions(-) delete mode 100644 copilot-core/src/Copilot/Core/Type/Uninitialized.hs diff --git a/copilot-core/copilot-core.cabal b/copilot-core/copilot-core.cabal index 1e68cd15c..6f83abe54 100644 --- a/copilot-core/copilot-core.cabal +++ b/copilot-core/copilot-core.cabal @@ -64,7 +64,6 @@ library Copilot.Core.Type.Dynamic Copilot.Core.Type.Equality Copilot.Core.Type.Show - Copilot.Core.Type.Uninitialized Copilot.Core.PrettyPrint Copilot.Core.PrettyDot diff --git a/copilot-core/src/Copilot/Core.hs b/copilot-core/src/Copilot/Core.hs index 704cf670b..9429e17b1 100644 --- a/copilot-core/src/Copilot/Core.hs +++ b/copilot-core/src/Copilot/Core.hs @@ -30,7 +30,6 @@ module Copilot.Core , module Copilot.Core.Spec , module Copilot.Core.Type , module Copilot.Core.Type.Array - , module Copilot.Core.Type.Uninitialized , module Data.Int , module Data.Word ) where @@ -42,6 +41,5 @@ import Copilot.Core.Operators import Copilot.Core.Spec import Copilot.Core.Type import Copilot.Core.Type.Array -import Copilot.Core.Type.Uninitialized import Data.Int import Data.Word diff --git a/copilot-core/src/Copilot/Core/Type/Uninitialized.hs b/copilot-core/src/Copilot/Core/Type/Uninitialized.hs deleted file mode 100644 index a889f9b2c..000000000 --- a/copilot-core/src/Copilot/Core/Type/Uninitialized.hs +++ /dev/null @@ -1,35 +0,0 @@ --------------------------------------------------------------------------------- --- Copyright © 2011 National Institute of Aerospace / Galois, Inc. --------------------------------------------------------------------------------- - --- | Initial values for a given type. - -{-# LANGUAGE Safe #-} -{-# LANGUAGE GADTs #-} - -module Copilot.Core.Type.Uninitialized - ( uninitialized - ) where - -import Copilot.Core.Type - --------------------------------------------------------------------------------- - --- | Initial value for a given type. --- --- Does not support structs or arrays. -{-# DEPRECATED uninitialized "This function is deprecated in Copilot 3.6" #-} -uninitialized :: Type a -> a -uninitialized t = - case t of - Bool -> False - Int8 -> 0 - Int16 -> 0 - Int32 -> 0 - Int64 -> 0 - Word8 -> 0 - Word16 -> 0 - Word32 -> 0 - Word64 -> 0 - Float -> 0 - Double -> 0 From 1952c621d56262e99c9e38b9f8df64c620db0f8b Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 8 Apr 2022 08:38:52 -0400 Subject: [PATCH 0064/1222] Document changes in CHANGELOG. Refs #302. --- copilot-core/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot-core/CHANGELOG b/copilot-core/CHANGELOG index 41f04e90e..cb4561e07 100644 --- a/copilot-core/CHANGELOG +++ b/copilot-core/CHANGELOG @@ -1,4 +1,5 @@ -2022-04-07 +2022-04-08 + * Remove Copilot.Core.Type.Uninitialized. (#302) * Remove Copilot.Core.Expr.Tag. (#304) 2022-03-07 From 957407edcbab4f74254cc7122ef9525f4e55e1a3 Mon Sep 17 00:00:00 2001 From: Ryan Scott Date: Wed, 8 Dec 2021 09:56:37 -0500 Subject: [PATCH 0065/1222] copilot-c99: Fix issue in C99 implementation of signum. Refs #278. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit copilot-c99's translation of the function signum to C99 differs from the meaning of the same function in the interpreter. The C99 backend uses the function copysign, whose meaning differs from Haskell's signum. For example, as evaluated by the interpreter, signum 0 returns 0, but the C99 code generated for it (which executes copysign(1.0, 0)), returns 1. Moreover, when dealing with floating-point numbers, signum (-0) and signum NaN return -0 and NaN, respectively, in the interpreter, but the C99-based implementation returns -1.0 and ±1.0 (depending on the sign bit of the NaN), respectively. The meaning of all Copilot constructs should be consistent between the interpreter and all backends. This commit replaces the `copysign`-based implementation such that `signum e` now returns `e > 0 ? 1 : (e < 0 ? -1 : e)`. This new implementation follows the definition of signum in Haskell's base, including for cases where `e` is `±0` or `NaN`. It is possible to reproduce the error, and check the fix, by comparing the output of the compiled code and the interpreter for a stream with signum. For example, given the following specification: ``` {-# LANGUAGE CPP #-} {-# LANGUAGE NoImplicitPrelude #-} -- | An example of a specification using the 'signum' function. module Main where import Data.List (genericLength) import Copilot.Compile.C99 import Language.Copilot nums :: [Int32] nums = [-2, -1, 0, 1, 2] stream :: Stream Int32 stream = extern "stream" (Just nums) spec :: Spec spec = trigger "func" true [arg (signum stream)] main :: IO () main = do spec' <- reify spec #ifdef INTERPRET csv (genericLength nums) spec #else compile "signum" spec' #endif ``` with -DINTERPRET, the program will print: ``` $ cabal v1-exec -- runhaskell -DINTERPRET Signum.hs Note: CSV format does not output observers. # func,-1 # func,-1 # func,0 # func,1 # func,1 ``` The generated C99 can be executed with the following main: ``` #include #include #include "signum.h" int32_t nums[5] = { -2, -1, 0, 1, 2 }; int32_t stream; void func (int32_t sign) { printf ("%d\n", sign); } int main () { int i = 0; for (i=0; i<5; i++) { stream = nums[i]; step(); } return 0; } ``` And it will print: ``` -1 -1 1 1 1 ``` so long as the bug is present. The new implementation corrects that behavior to print, instead, the same values produced by the interpreter. Co-authored-by: Ivan Perez --- .../src/Copilot/Compile/C99/Translate.hs | 54 ++++++++++++++++++- 1 file changed, 53 insertions(+), 1 deletion(-) diff --git a/copilot-c99/src/Copilot/Compile/C99/Translate.hs b/copilot-c99/src/Copilot/Compile/C99/Translate.hs index 2cbeefb51..1d6fc3912 100644 --- a/copilot-c99/src/Copilot/Compile/C99/Translate.hs +++ b/copilot-c99/src/Copilot/Compile/C99/Translate.hs @@ -55,7 +55,7 @@ transop1 :: Op1 a b -> C.Expr -> C.Expr transop1 op e = case op of Not -> (C..!) e Abs _ -> funcall "abs" [e] - Sign _ -> funcall "copysign" [C.LitDouble 1.0, e] + Sign ty -> transSign ty e Recip _ -> C.LitDouble 1.0 C../ e Exp _ -> funcall "exp" [e] Sqrt _ -> funcall "sqrt" [e] @@ -112,6 +112,58 @@ transop3 :: Op3 a b c d -> C.Expr -> C.Expr -> C.Expr -> C.Expr transop3 op e1 e2 e3 = case op of Mux _ -> C.Cond e1 e2 e3 +-- | Translate @'Sign' e@ in Copilot Core into a C99 expression. +-- +-- Sign is is translated as @e > 0 ? 1 : (e < 0 ? -1 : e)@, that is: +-- +-- 1. If @e@ is positive, return @1@. +-- +-- 2. If @e@ is negative, return @-1@. +-- +-- 3. Otherwise, return @e@. This handles the case where @e@ is @0@ when the +-- type is an integral type. If the type is a floating-point type, it also +-- handles the cases where @e@ is @-0@ or @NaN@. +-- +-- This implementation is modeled after how GHC implements 'signum' +-- . +transSign :: Type a -> C.Expr -> C.Expr +transSign ty e = positiveCase $ negativeCase e + where + -- If @e@ is positive, return @1@, otherwise fall back to argument. + -- + -- Produces the following code, where @@ is the argument to this + -- function: + -- @ + -- e > 0 ? 1 : + -- @ + positiveCase :: C.Expr -- ^ Value returned if @e@ is not positive. + -> C.Expr + positiveCase = + C.Cond (C.BinaryOp C.GT e (constNumTy ty 0)) (constNumTy ty 1) + + -- If @e@ is negative, return @1@, otherwise fall back to argument. + -- + -- Produces the following code, where @@ is the argument to this + -- function: + -- @ + -- e < 0 ? -1 : + -- @ + negativeCase :: C.Expr -- ^ Value returned if @e@ is not negative. + -> C.Expr + negativeCase = + C.Cond (C.BinaryOp C.LT e (constNumTy ty 0)) (constNumTy ty (-1)) + + -- Translate a literal number of type @ty@ into a C99 literal. + -- + -- PRE: The type of PRE is numeric (integer or floating-point), that + -- is, not boolean, struct or array. + constNumTy :: Type a -> Integer -> C.Expr + constNumTy ty = + case ty of + Float -> C.LitFloat . fromInteger + Double -> C.LitDouble . fromInteger + _ -> C.LitInt + -- | Transform a Copilot Core literal, based on its value and type, into a C99 -- literal. constty :: Type a -> a -> C.Expr From 9528d9c303043d3857d9f5b4e3557b67e6f81ead Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 14 Apr 2022 13:28:16 -0400 Subject: [PATCH 0066/1222] Document changes in CHANGELOG. Refs #278. --- copilot-c99/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-c99/CHANGELOG b/copilot-c99/CHANGELOG index 7760d8986..57d554d1d 100644 --- a/copilot-c99/CHANGELOG +++ b/copilot-c99/CHANGELOG @@ -1,3 +1,6 @@ +2022-04-14 + * Fix issue in C99 implementation of signum. (#278) + 2022-03-07 * Version bump (3.8). (#298) * Hide internal modules deprecated in Copilot 3.5. (#289) From ef559642f6952b00298f24cae4a4303962bf281d Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 18 Apr 2022 16:05:27 -0400 Subject: [PATCH 0067/1222] Remove test for copilot-core:Copilot.Core.Error. Refs #300. The module copilot-core:Copilot.Core.Error only contains functions that were deprecated in Copilot 3.6. Those functions should not be exposed, since they serve no purpose outside of the internals of the implementation. As per our internal policy of waiting 3 versions from deprecation until a public interface declaration can be removed, the complete module can now be hidden. Once the module is hidden, the tests that apply to that part of the public interface of that module are no longer needed. This commit removes those tests as a preliminary step for removing the module itself. It also removes auxiliary operations that were only being used by those tests. --- copilot-core/copilot-core.cabal | 1 - copilot-core/tests/Main.hs | 4 +-- copilot-core/tests/Test/Copilot/Core/Error.hs | 35 ------------------- copilot-core/tests/Test/Extra.hs | 15 +------- 4 files changed, 2 insertions(+), 53 deletions(-) delete mode 100644 copilot-core/tests/Test/Copilot/Core/Error.hs diff --git a/copilot-core/copilot-core.cabal b/copilot-core/copilot-core.cabal index 6f83abe54..bf5090f5f 100644 --- a/copilot-core/copilot-core.cabal +++ b/copilot-core/copilot-core.cabal @@ -81,7 +81,6 @@ test-suite unit-tests other-modules: Test.Extra - Test.Copilot.Core.Error Test.Copilot.Core.External Test.Copilot.Core.Interpret.Eval Test.Copilot.Core.Type diff --git a/copilot-core/tests/Main.hs b/copilot-core/tests/Main.hs index cc9491cc8..c0fcc8b3f 100644 --- a/copilot-core/tests/Main.hs +++ b/copilot-core/tests/Main.hs @@ -6,7 +6,6 @@ import Data.Monoid (mempty) import Test.Framework (Test, defaultMainWithOpts) -- Internal library modules being tested -import qualified Test.Copilot.Core.Error import qualified Test.Copilot.Core.External import qualified Test.Copilot.Core.Interpret.Eval import qualified Test.Copilot.Core.Type @@ -21,8 +20,7 @@ main = defaultMainWithOpts tests mempty -- | All unit tests in copilot-core. tests :: [Test.Framework.Test] tests = - [ Test.Copilot.Core.Error.tests - , Test.Copilot.Core.External.tests + [ Test.Copilot.Core.External.tests , Test.Copilot.Core.Interpret.Eval.tests , Test.Copilot.Core.Type.tests , Test.Copilot.Core.Type.Array.tests diff --git a/copilot-core/tests/Test/Copilot/Core/Error.hs b/copilot-core/tests/Test/Copilot/Core/Error.hs deleted file mode 100644 index 31ee285f7..000000000 --- a/copilot-core/tests/Test/Copilot/Core/Error.hs +++ /dev/null @@ -1,35 +0,0 @@ --- | Test copilot-core:Copilot.Core.Error. -module Test.Copilot.Core.Error where - --- External imports -import Test.Framework (Test, testGroup) -import Test.Framework.Providers.HUnit (testCase) -import Test.HUnit (assertBool) - --- Internal imports: auxiliary testing facilities -import Test.Extra (withoutException) - --- Internal imports: library modules being tested -import Copilot.Core.Error (badUsage, impossible) - --- | All unit tests for copilot-core:Copilot.Core.Error. -tests :: Test.Framework.Test -tests = - testGroup "Copilot.Core.Error" - [ testCase "impossible" testErrorImpossible - , testCase "badUsage" testErrorBadUsage - ] - --- * Individual tests - --- | Test that 'Error.impossible' always throws an exception of some kind. -testErrorImpossible :: IO () -testErrorImpossible = do - res <- not <$> withoutException (impossible "func1" "pkg1") - assertBool "The function impossible should fail with an exception" res - --- | Test that 'Error.badUsage' always throws an exception of some kind. -testErrorBadUsage :: IO () -testErrorBadUsage = do - res <- not <$> withoutException (badUsage "func1") - assertBool "The function badUsage should fail with an exception" res diff --git a/copilot-core/tests/Test/Extra.hs b/copilot-core/tests/Test/Extra.hs index 363adcbde..f10d784c4 100644 --- a/copilot-core/tests/Test/Extra.hs +++ b/copilot-core/tests/Test/Extra.hs @@ -1,21 +1,8 @@ -{-# LANGUAGE ScopedTypeVariables #-} -- | Auxiliary testing helper functions. module Test.Extra where -- External imports -import Control.Arrow ((***)) -import Control.Exception (SomeException, catch) - --- * Detecting exceptions - --- | Test that a computation terminates without throwing an exception. --- --- Returns 'True' if the computation can be completed without an exception, --- and 'False' otherwise. -withoutException :: IO a -> IO Bool -withoutException e = - catch (e >> return True) - (\(_ :: SomeException) -> return False) +import Control.Arrow ((***)) -- * Function application From e6e86ab8b13d9f54c48d9e1ec64f3e16a3cab7ee Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 18 Apr 2022 16:06:41 -0400 Subject: [PATCH 0068/1222] Hide the module copilot-core:Copilot.Core.Error. Refs #300. The module copilot-core:Copilot.Core.Error only contains functions that were deprecated in Copilot 3.6. Those functions should not be exposed, since they serve no purpose outside of the internals of the implementation. As per our internal policy of waiting 3 versions from deprecation until a public interface declaration can be removed, the complete module can now be hidden. This commit modifies the cabal file so that the module is no longer exposed, and modify Copilot.Core so that the module is also not exposed indirectly (i.e., re-exported). --- copilot-core/copilot-core.cabal | 2 +- copilot-core/src/Copilot/Core.hs | 4 +--- 2 files changed, 2 insertions(+), 4 deletions(-) diff --git a/copilot-core/copilot-core.cabal b/copilot-core/copilot-core.cabal index bf5090f5f..88fff97dc 100644 --- a/copilot-core/copilot-core.cabal +++ b/copilot-core/copilot-core.cabal @@ -51,7 +51,6 @@ library exposed-modules: Copilot.Core - Copilot.Core.Error Copilot.Core.Expr Copilot.Core.External Copilot.Core.Interpret @@ -69,6 +68,7 @@ library other-modules: + Copilot.Core.Error Copilot.Core.ErrorInternal Copilot.Core.Interpret.RenderInternal diff --git a/copilot-core/src/Copilot/Core.hs b/copilot-core/src/Copilot/Core.hs index 9429e17b1..0ea0158f4 100644 --- a/copilot-core/src/Copilot/Core.hs +++ b/copilot-core/src/Copilot/Core.hs @@ -23,8 +23,7 @@ {-# LANGUAGE Safe #-} module Copilot.Core - ( module Copilot.Core.Error - , module Copilot.Core.Expr + ( module Copilot.Core.Expr , module Copilot.Core.External , module Copilot.Core.Operators , module Copilot.Core.Spec @@ -34,7 +33,6 @@ module Copilot.Core , module Data.Word ) where -import Copilot.Core.Error import Copilot.Core.Expr import Copilot.Core.External import Copilot.Core.Operators From 07ce77bf39fbd00d74aedff8b704d8b83b0c86e8 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 18 Apr 2022 16:09:17 -0400 Subject: [PATCH 0069/1222] Move definitions from internal module back to copilot-core:Copilot.Core.Error. Refs #300. The module copilot-core:Copilot.Core.Error only contains functions that were deprecated in Copilot 3.6. Those functions should not be exposed, since they serve no purpose outside of the internals of the implementation. As per our internal policy of waiting 3 versions from deprecation until a public interface declaration can be removed. In order to follow that policy, an intermediate, internal module containing the actual original implementations was created and used in copilot-core, and the functions published in Copilot.Core were annotated with warnings to let external users know they were deprecated. Since the module Copilot.Core.Error is now internal to copilot-core, there is no need for having a separate internal module for the implementations, and they can be returned to their original location. This commit moves the definitions in Copilot.Core.ErrorInternal back to Copilot.Core.Error, and adjusts imports throughout the library as needed. --- copilot-core/src/Copilot/Core/Error.hs | 13 +++++++------ copilot-core/src/Copilot/Core/Interpret/Eval.hs | 14 +++++++------- copilot-core/src/Copilot/Core/PrettyPrint.hs | 4 ++-- 3 files changed, 16 insertions(+), 15 deletions(-) diff --git a/copilot-core/src/Copilot/Core/Error.hs b/copilot-core/src/Copilot/Core/Error.hs index 1aa94ee24..0debccdf9 100644 --- a/copilot-core/src/Copilot/Core/Error.hs +++ b/copilot-core/src/Copilot/Core/Error.hs @@ -9,17 +9,18 @@ module Copilot.Core.Error ( impossible , badUsage ) where -import qualified Copilot.Core.ErrorInternal as Err - -- | Report an error due to a bug in Copilot. -{-# DEPRECATED impossible "This function is deprecated in Copilot 3.6." #-} impossible :: String -- ^ Name of the function in which the error was detected. -> String -- ^ Name of the package in which the function is located. -> a -impossible = Err.impossible +impossible function package = + error $ "\"Impossible\" error in function " + ++ function ++ ", in package " ++ package + ++ ". Please file an issue at " + ++ "https://github.com/Copilot-Language/copilot/issues" + ++ "or email the maintainers at " -- | Report an error due to an error detected by Copilot (e.g., user error). -{-# DEPRECATED badUsage "This function is deprecated in Copilot 3.6." #-} badUsage :: String -- ^ Description of the error. -> a -badUsage = Err.badUsage +badUsage msg = error $ "Copilot error: " ++ msg diff --git a/copilot-core/src/Copilot/Core/Interpret/Eval.hs b/copilot-core/src/Copilot/Core/Interpret/Eval.hs index 81d3bd6ed..dc571639c 100644 --- a/copilot-core/src/Copilot/Core/Interpret/Eval.hs +++ b/copilot-core/src/Copilot/Core/Interpret/Eval.hs @@ -14,13 +14,13 @@ module Copilot.Core.Interpret.Eval , eval ) where -import Copilot.Core (Expr (..), Field (..), Id, Name, - Observer (..), Op1 (..), Op2 (..), Op3 (..), - Spec, Stream (..), Trigger (..), - Type (Struct), UExpr (..), arrayelems, - specObservers, specStreams, specTriggers) -import Copilot.Core.ErrorInternal (badUsage) -import Copilot.Core.Type.Show (ShowType, showWithType) +import Copilot.Core (Expr (..), Field (..), Id, Name, Observer (..), + Op1 (..), Op2 (..), Op3 (..), Spec, Stream (..), + Trigger (..), Type (Struct), UExpr (..), + arrayelems, specObservers, specStreams, + specTriggers) +import Copilot.Core.Error (badUsage) +import Copilot.Core.Type.Show (ShowType, showWithType) import Prelude hiding (id) import qualified Prelude as P diff --git a/copilot-core/src/Copilot/Core/PrettyPrint.hs b/copilot-core/src/Copilot/Core/PrettyPrint.hs index 2a07bee9d..f9e392793 100644 --- a/copilot-core/src/Copilot/Core/PrettyPrint.hs +++ b/copilot-core/src/Copilot/Core/PrettyPrint.hs @@ -12,8 +12,8 @@ module Copilot.Core.PrettyPrint , ppExpr ) where -import Copilot.Core hiding (impossible) -import Copilot.Core.ErrorInternal (impossible) +import Copilot.Core +import Copilot.Core.Error (impossible) import Copilot.Core.Type.Show (showWithType, ShowType(..), showType) import Prelude hiding (id, (<>)) import Text.PrettyPrint.HughesPJ From 4c6a84d7c0399d9ed8da59f308f402e1f38d08b9 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 18 Apr 2022 16:09:59 -0400 Subject: [PATCH 0070/1222] Remove unnecessary module copilot-core:Copilot.Core.ErrorInternal. Refs #300. The module copilot-core:Copilot.Core.Error only contains functions that were deprecated in Copilot 3.6. Those functions should not be exposed, since they serve no purpose outside of the internals of the implementation. As per our internal policy of waiting 3 versions from deprecation until a public interface declaration can be removed, the complete module can now be hidden. The actual definitions were moved to an auxiliary module in a prior commit so we could signal deprecations accordingly, but they have now been returned to Copilot.Core.Error, where they should reside. The module Copilot.Core.ErrorInternal is now redundant. This commit removes that module entirely from the library. --- copilot-core/copilot-core.cabal | 1 - .../src/Copilot/Core/ErrorInternal.hs | 26 ------------------- 2 files changed, 27 deletions(-) delete mode 100644 copilot-core/src/Copilot/Core/ErrorInternal.hs diff --git a/copilot-core/copilot-core.cabal b/copilot-core/copilot-core.cabal index 88fff97dc..a929dd659 100644 --- a/copilot-core/copilot-core.cabal +++ b/copilot-core/copilot-core.cabal @@ -69,7 +69,6 @@ library other-modules: Copilot.Core.Error - Copilot.Core.ErrorInternal Copilot.Core.Interpret.RenderInternal test-suite unit-tests diff --git a/copilot-core/src/Copilot/Core/ErrorInternal.hs b/copilot-core/src/Copilot/Core/ErrorInternal.hs deleted file mode 100644 index 2e0eff226..000000000 --- a/copilot-core/src/Copilot/Core/ErrorInternal.hs +++ /dev/null @@ -1,26 +0,0 @@ --------------------------------------------------------------------------------- --- Copyright © 2011 National Institute of Aerospace / Galois, Inc. --------------------------------------------------------------------------------- - -{-# LANGUAGE Safe #-} - --- | Custom functions to report error messages to users. -module Copilot.Core.ErrorInternal - ( impossible - , badUsage ) where - --- | Report an error due to a bug in Copilot. -impossible :: String -- ^ Name of the function in which the error was detected. - -> String -- ^ Name of the package in which the function is located. - -> a -impossible function package = - error $ "\"Impossible\" error in function " - ++ function ++ ", in package " ++ package - ++ ". Please file an issue at " - ++ "https://github.com/Copilot-Language/copilot/issues" - ++ "or email the maintainers at " - --- | Report an error due to an error detected by Copilot (e.g., user error). -badUsage :: String -- ^ Description of the error. - -> a -badUsage msg = error $ "Copilot error: " ++ msg From 8d30e6d592073087e342a2e4bf49fc5fdb94df42 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 18 Apr 2022 16:44:51 -0400 Subject: [PATCH 0071/1222] Document changes in CHANGELOG. Refs #300. --- copilot-core/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot-core/CHANGELOG b/copilot-core/CHANGELOG index cb4561e07..2c63adc57 100644 --- a/copilot-core/CHANGELOG +++ b/copilot-core/CHANGELOG @@ -1,4 +1,5 @@ -2022-04-08 +2022-04-18 + * Hide module Copilot.Core.Error. (#300) * Remove Copilot.Core.Type.Uninitialized. (#302) * Remove Copilot.Core.Expr.Tag. (#304) From a70137659c9897aa8c784d30ef6ac9a596626bbe Mon Sep 17 00:00:00 2001 From: Ryan Scott Date: Fri, 15 Apr 2022 17:55:43 -0400 Subject: [PATCH 0072/1222] copilot-c99: Initialize arrays and structs without explcit casts. Refs #276. Previously, C99 translation would produce initializers for array and struct that were explicitly cast. Explicit casts of arrays and structs are considered non-constant expressions in C, and thus not allowed as the initialization value for a global variable. This causes the generated code to produce warnings when compiled with `gcc -Wpedantic` due to the placement of the casts in the initializer expressions, and errors with Clang. In the worst case, these arrays could even cause C compilers to perform unwanted type conversions. To fix the issue, we now include special cases for `Array` and `Struct` such that they are translated using `InitArray`, which does not contain the type of the array and thus is pretty printed without explicit casts. For example, this means that a nested array will be translated as `{{0, 1}, {2, 3}, {4, 5}}` instead of `{ (int32_t[2]){0, 1}, (int32_t[2]){2, 3}, (int32_t[2]){4, 5} }`. The same approach is used for structs, as the initialization syntax is compatible in C and language-c99 does not provide specific construct for struct initializer, but that is an artifact of how `language-c99-simple`'s API works. Notes from Ivan Perez: work done by Ryan Scott; I have modified comments and style. Co-authored-by: Ivan Perez --- .../src/Copilot/Compile/C99/CodeGen.hs | 2 +- .../src/Copilot/Compile/C99/Translate.hs | 82 ++++++++++++++----- 2 files changed, 61 insertions(+), 23 deletions(-) diff --git a/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs b/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs index 9b9ea8dbf..103d0b0ea 100644 --- a/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs +++ b/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs @@ -45,7 +45,7 @@ mkbuffdecln sid ty xs = C.VarDecln (Just C.Static) cty name initvals where name = streamname sid cty = C.Array (transtype ty) (Just $ C.LitInt $ fromIntegral buffsize) buffsize = length xs - initvals = Just $ C.InitArray $ map (C.InitExpr . constty ty) xs + initvals = Just $ C.InitArray $ constarray ty xs -- | Make a C index variable and initialise it to 0. mkindexdecln :: Id -> C.Decln diff --git a/copilot-c99/src/Copilot/Compile/C99/Translate.hs b/copilot-c99/src/Copilot/Compile/C99/Translate.hs index 1d6fc3912..6ce0c4aa8 100644 --- a/copilot-c99/src/Copilot/Compile/C99/Translate.hs +++ b/copilot-c99/src/Copilot/Compile/C99/Translate.hs @@ -168,28 +168,66 @@ transSign ty e = positiveCase $ negativeCase e -- literal. constty :: Type a -> a -> C.Expr constty ty = case ty of - Bool -> C.LitBool - Int8 -> explicitty ty . C.LitInt . fromIntegral - Int16 -> explicitty ty . C.LitInt . fromIntegral - Int32 -> explicitty ty . C.LitInt . fromIntegral - Int64 -> explicitty ty . C.LitInt . fromIntegral - Word8 -> explicitty ty . C.LitInt . fromIntegral - Word16 -> explicitty ty . C.LitInt . fromIntegral - Word32 -> explicitty ty . C.LitInt . fromIntegral - Word64 -> explicitty ty . C.LitInt . fromIntegral - Float -> explicitty ty . C.LitFloat - Double -> explicitty ty . C.LitDouble - Struct _ -> \v -> C.InitVal (transtypename ty) (map fieldinit (toValues v)) - where - fieldinit (Value ty (Field val)) = C.InitExpr $ constty ty val - Array ty' -> \v -> C.InitVal (transtypename ty) (vals v) - where - vals v = constarray ty' (arrayelems v) - - constarray :: Type a -> [a] -> [C.Init] - constarray ty xs = case ty of - Array ty' -> constarray ty' (concatMap arrayelems xs) - _ -> map (C.InitExpr . constty ty) xs + Bool -> C.LitBool + Int8 -> explicitty ty . C.LitInt . fromIntegral + Int16 -> explicitty ty . C.LitInt . fromIntegral + Int32 -> explicitty ty . C.LitInt . fromIntegral + Int64 -> explicitty ty . C.LitInt . fromIntegral + Word8 -> explicitty ty . C.LitInt . fromIntegral + Word16 -> explicitty ty . C.LitInt . fromIntegral + Word32 -> explicitty ty . C.LitInt . fromIntegral + Word64 -> explicitty ty . C.LitInt . fromIntegral + Float -> explicitty ty . C.LitFloat + Double -> explicitty ty . C.LitDouble + Struct _ -> \v -> + C.InitVal (transtypename ty) (map constfieldinit (toValues v)) + Array ty' -> \v -> + C.InitVal (transtypename ty) (constarray ty' (arrayelems v)) + +-- | Transform a Copilot Core literal, based on its value and type, into a C99 +-- initializer. +constinit :: Type a -> a -> C.Init +constinit ty val = case ty of + -- We include two special cases for Struct and Array to avoid using constty + -- on them. + -- + -- In the default case (i.e., InitExpr (constty ty val)), constant + -- initializations are explicitly cast. However, doing so 1) may result in + -- incorrect values for arrays, and 2) will be considered a non-constant + -- expression in the case of arrays and structs, and thus not allowed as the + -- initialization value for a global variable. + -- + -- In particular, wrt. (1), for example, the nested array: + -- [[0, 1], [2, 3]] :: Array 2 (Array 2 Int32) + -- + -- with explicit casts, will be initialized in C as: + -- { (int32_t[2]){(int32_t)(0), (int32_t)(1)}, + -- (int32_t[2]){(int32_t)(2), (int32_t)(3)} } + -- + -- Due to the additional (int32_t[2]) casts, a C compiler will interpret the + -- whole expression as an array of two int32_t's (as opposed to a nested + -- array). This can either lead to compile-time errors (if you're lucky) or + -- incorrect runtime semantics (if you're unlucky). + Array ty' -> C.InitArray $ constarray ty' $ arrayelems val + + -- We use InitArray to initialize a struct because the syntax used for + -- initializing arrays and structs is compatible. For instance, {1, 2} works + -- both for initializing an int array of length 2 as well as a struct with + -- two int fields, although the two expressions are conceptually different + -- (structs can also be initialized as { .a = 1, .b = 2}, but language-c99 + -- does not support such syntax and does not provide a specialized + -- initialization construct for structs). + Struct _ -> C.InitArray $ map constfieldinit $ toValues val + _ -> C.InitExpr $ constty ty val + +-- | Transform a Copilot Core struct field into a C99 initializer. +constfieldinit :: Value a -> C.Init +constfieldinit (Value ty (Field val)) = constinit ty val + +-- | Transform a Copilot Array, based on the element values and their type, +-- into a list of C99 initializer values. +constarray :: Type a -> [a] -> [C.Init] +constarray ty = map (constinit ty) -- | Explicitly cast a C99 value to a type. From 716089e9368566ec94c8504a91778331728b3845 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Wed, 20 Apr 2022 09:27:52 -0400 Subject: [PATCH 0073/1222] Document changes in CHANGELOG. Refs #276. --- copilot-c99/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot-c99/CHANGELOG b/copilot-c99/CHANGELOG index 57d554d1d..84a10d211 100644 --- a/copilot-c99/CHANGELOG +++ b/copilot-c99/CHANGELOG @@ -1,4 +1,5 @@ -2022-04-14 +2022-04-20 + * Fix issue with delays of streams of structs or arrays. (#276) * Fix issue in C99 implementation of signum. (#278) 2022-03-07 From cbbae149afad3da30f8f1f1b76531176e4216e3f Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 22 Apr 2022 17:51:14 -0400 Subject: [PATCH 0074/1222] Remove copilot-core:toDynF,fromDynF. Refs #301. The functions Copilot.Core.Type.Dynamic.toDynF and fromDynF were deprecated in Copilot 3.6 because they were not used and therefore did not belong in the project. As per our internal policy of waiting 3 versions from deprecation until a public interface declaration can be removed, these two functions can now be removed completely. The following demonstrates that the functions are unused within Copilot: ``` $ grep -nHre '\<\(toDynF\|fromDynF\)\>' --include='*.hs' | grep -ve '{-#' | grep -ve '--.*\(toDynF\|fromDynF\)' | grep -ve '"[^"]*\(toDynF\|fromDynF\)[^"]*"' copilot-core/src/Copilot/Core/Type/Dynamic.hs:24: , toDynF copilot-core/src/Copilot/Core/Type/Dynamic.hs:25: , fromDynF copilot-core/src/Copilot/Core/Type/Dynamic.hs:54:toDynF :: t a -> f a -> DynamicF f t copilot-core/src/Copilot/Core/Type/Dynamic.hs:55:toDynF t fx = DynamicF fx t copilot-core/src/Copilot/Core/Type/Dynamic.hs:60:fromDynF :: EqualType t => t a -> DynamicF f t -> Maybe (f a) copilot-core/src/Copilot/Core/Type/Dynamic.hs:61:fromDynF t1 (DynamicF fx t2) = ``` The result obtained are two definitions, and the two exports. Neither of these functions is required by Copilot's requirements, and therefore should be removed. This commit removes the declaration. Using the method above shows no results. --- copilot-core/src/Copilot/Core/Type/Dynamic.hs | 16 ---------------- 1 file changed, 16 deletions(-) diff --git a/copilot-core/src/Copilot/Core/Type/Dynamic.hs b/copilot-core/src/Copilot/Core/Type/Dynamic.hs index 055457d10..37248435c 100644 --- a/copilot-core/src/Copilot/Core/Type/Dynamic.hs +++ b/copilot-core/src/Copilot/Core/Type/Dynamic.hs @@ -21,8 +21,6 @@ module Copilot.Core.Type.Dynamic , DynamicF (..) , toDyn , fromDyn - , toDynF - , fromDynF ) where import Copilot.Core.Type.Equality @@ -48,17 +46,3 @@ fromDyn t1 (Dynamic x t2) = case t1 =~= t2 of Just Refl -> return x Nothing -> Nothing - --- | Enclose a function and its type in a container. -{-# DEPRECATED toDynF "This function is deprecated in Copilot 3.6." #-} -toDynF :: t a -> f a -> DynamicF f t -toDynF t fx = DynamicF fx t - --- | Extract a value from a dynamic function container. Return 'Nothing' if --- the value is not of the given type. -{-# DEPRECATED fromDynF "This function is deprecated in Copilot 3.6." #-} -fromDynF :: EqualType t => t a -> DynamicF f t -> Maybe (f a) -fromDynF t1 (DynamicF fx t2) = - case t1 =~= t2 of - Just Refl -> return fx - Nothing -> Nothing From caf4f2e447e30ee45614caa163057d6db1614e75 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 22 Apr 2022 18:08:31 -0400 Subject: [PATCH 0075/1222] Document changes in CHANGELOG. Refs #301. --- copilot-core/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot-core/CHANGELOG b/copilot-core/CHANGELOG index 2c63adc57..64c722610 100644 --- a/copilot-core/CHANGELOG +++ b/copilot-core/CHANGELOG @@ -1,4 +1,5 @@ -2022-04-18 +2022-04-22 + * Remove Copilot.Core.Type.Dynamic.fromDynF,toDynF. (#301) * Hide module Copilot.Core.Error. (#300) * Remove Copilot.Core.Type.Uninitialized. (#302) * Remove Copilot.Core.Expr.Tag. (#304) From 862fb64a1419a2dac1be3fb22262594641636d40 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 09:41:32 -0400 Subject: [PATCH 0076/1222] Hide the module copilot-core:Copilot.Core.Interpret.Render. Refs #303. The module copilot-core:Copilot.Core.Interpret.Render only contains functions that were deprecated in Copilot 3.6. Those functions should not be exposed, since they serve no purpose outside of the internals of the implementation. As per our internal policy of waiting 3 versions from deprecation until a public interface declaration can be removed, the complete module can now be hidden. This commit modifies the cabal file so that the module is no longer exposed. --- copilot-core/copilot-core.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot-core/copilot-core.cabal b/copilot-core/copilot-core.cabal index a929dd659..a59fbefa1 100644 --- a/copilot-core/copilot-core.cabal +++ b/copilot-core/copilot-core.cabal @@ -55,7 +55,6 @@ library Copilot.Core.External Copilot.Core.Interpret Copilot.Core.Interpret.Eval - Copilot.Core.Interpret.Render Copilot.Core.Operators Copilot.Core.Spec Copilot.Core.Type @@ -69,6 +68,7 @@ library other-modules: Copilot.Core.Error + Copilot.Core.Interpret.Render Copilot.Core.Interpret.RenderInternal test-suite unit-tests From 86db9600b69b58c9338b7e035664771bc6f6e02a Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 09:43:08 -0400 Subject: [PATCH 0077/1222] Move definitions from internal module back to copilot-core:Copilot.Core.Interpret.Render. Refs #303. The module copilot-core:Copilot.Core.Interpret.Render only contains functions that were deprecated in Copilot 3.6. Those functions should not be exposed, since they serve no purpose outside of the internals of the implementation. As per our internal policy of waiting 3 versions from deprecation until a public interface declaration can be removed. In order to follow that policy, an intermediate, internal module containing the actual original implementations was created and used in copilot-core, and the functions published in Copilot.Core.Interpret.Render were annotated with warnings to let external users know they were deprecated. Since the module Copilot.Core.Interpret.Render is now internal to copilot-core, there is no need for having a separate internal module for the implementations, and they can be returned to their original location. This commit moves the definitions in Copilot.Core.Interpret.RenderInternal back to Copilot.Core.Interpret.Render, and adjusts imports throughout the library as needed. --- copilot-core/src/Copilot/Core/Interpret.hs | 2 +- .../src/Copilot/Core/Interpret/Render.hs | 119 +++++++++++++++++- 2 files changed, 118 insertions(+), 3 deletions(-) diff --git a/copilot-core/src/Copilot/Core/Interpret.hs b/copilot-core/src/Copilot/Core/Interpret.hs index 7080a6a2c..0b8c3ffb1 100644 --- a/copilot-core/src/Copilot/Core/Interpret.hs +++ b/copilot-core/src/Copilot/Core/Interpret.hs @@ -13,7 +13,7 @@ module Copilot.Core.Interpret import Copilot.Core import Copilot.Core.Interpret.Eval -import Copilot.Core.Interpret.RenderInternal +import Copilot.Core.Interpret.Render import Copilot.Core.Type.Show (ShowType(..)) -- | Output format for the results of a Copilot spec interpretation. diff --git a/copilot-core/src/Copilot/Core/Interpret/Render.hs b/copilot-core/src/Copilot/Core/Interpret/Render.hs index b5b49eb62..23b3a4fc5 100644 --- a/copilot-core/src/Copilot/Core/Interpret/Render.hs +++ b/copilot-core/src/Copilot/Core/Interpret/Render.hs @@ -7,9 +7,124 @@ {-# LANGUAGE Safe #-} module Copilot.Core.Interpret.Render - {-# DEPRECATED "This module is deprecated in Copilot 3.6." #-} ( renderAsTable , renderAsCSV ) where -import Copilot.Core.Interpret.RenderInternal +import Data.List (intersperse, transpose, foldl') +import Data.Maybe (catMaybes) +import Copilot.Core.Interpret.Eval (Output, ExecTrace (..)) +import Text.PrettyPrint + +import Prelude hiding ((<>)) + +-------------------------------------------------------------------------------- + +-- | Render an execution trace as a table, formatted to faciliate readability. +renderAsTable :: ExecTrace -> String +renderAsTable + ExecTrace + { interpTriggers = trigs + , interpObservers = obsvs } = ( render + . asColumns + . transpose + . (:) (ppTriggerNames ++ ppObserverNames) + . transpose + ) (ppTriggerOutputs ++ ppObserverOutputs) + where + + ppTriggerNames :: [Doc] + ppTriggerNames = map (text . (++ ":")) (map fst trigs) + + ppObserverNames :: [Doc] + ppObserverNames = map (text . (++ ":")) (map fst obsvs) + + ppTriggerOutputs :: [[Doc]] + ppTriggerOutputs = map (map ppTriggerOutput) (map snd trigs) + + ppTriggerOutput :: Maybe [Output] -> Doc + ppTriggerOutput (Just vs) = text $ "(" ++ concat (intersperse "," vs) ++ ")" + ppTriggerOutput Nothing = text "--" + + ppObserverOutputs :: [[Doc]] + ppObserverOutputs = map (map text) (map snd obsvs) + +-------------------------------------------------------------------------------- + +-- | Render an execution trace as using comma-separate value (CSV) format. +renderAsCSV :: ExecTrace -> String +renderAsCSV = render . unfold + +-- | Pretty print all the steps of the execution trace and concatenate the +-- results. +unfold :: ExecTrace -> Doc +unfold r = + case step r of + (cs, Nothing) -> cs + (cs, Just r') -> cs $$ unfold r' + +-- | Pretty print the state of the triggers, and provide a continuation +-- for the execution trace at the next point in time. +step :: ExecTrace -> (Doc, Maybe ExecTrace) +step ExecTrace + { interpTriggers = trigs + } = + if null trigs then (empty, Nothing) + else (foldl' ($$) empty (text "#" : ppTriggerOutputs), tails) + + where + + ppTriggerOutputs :: [Doc] + ppTriggerOutputs = + catMaybes + . fmap ppTriggerOutput + . map (fmap head) + $ trigs + + ppTriggerOutput :: (String, Maybe [Output]) -> Maybe Doc + ppTriggerOutput (_, Nothing) = Nothing + ppTriggerOutput (cs, Just xs) = Just $ + text cs <> text "," <> + (foldr (<>) empty . map text . intersperse ",") xs + + tails :: Maybe ExecTrace + tails = + if any null (fmap (tail.snd) trigs) + then Nothing + else Just + ExecTrace + { interpTriggers = map (fmap tail) trigs + , interpObservers = [] + } + +-------------------------------------------------------------------------------- + + + +-- Copied from pretty-ncols because of incompatibility with newer GHC versions. +asColumns :: [[Doc]] -> Doc +asColumns = flip asColumnsWithBuff $ 1 + +asColumnsWithBuff :: [[Doc]] -> Int -> Doc +asColumnsWithBuff lls q = normalize + where normalize = vcat $ map hsep + $ map (\x -> pad (length x) longColumnLen empty x) + $ pad' longEntryLen q + $ transpose lls -- normalize column height + longColumnLen = maximum (map length lls) + longEntryLen = maximum $ map docLen (concat lls) + +docLen d = length $ render d + +-- | Pad a string on the right to reach an expected length. +pad :: Int -> Int -> a -> [a] -> [a] +pad lx max b ls = ls ++ replicate (max - lx) b + +-- | Pad a list of strings on the right with spaces. +pad' :: Int -- ^ Mininum number of spaces to add + -> Int -- ^ Maximum number of spaces to add + -> [[Doc]] -- ^ List of documents to pad + -> [[Doc]] +pad' _ _ [] = [] +pad' mx q (ls:xs) = map buf ls : pad' mx q xs + where buf x = x <> (hcat $ replicate q space) <> (hcat $ replicate (mx - (docLen x)) space) From e440c3cf0028e5d90b0ff843d8a5128856f2da13 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 09:48:44 -0400 Subject: [PATCH 0078/1222] Remove unnecessary module copilot-core:Copilot.Core.Interpret.RenderInternal. Refs #303. The module copilot-core:Copilot.Core.Interpret.Render only contains functions that were deprecated in Copilot 3.6. Those functions should not be exposed, since they serve no purpose outside of the internals of the implementation. As per our internal policy of waiting 3 versions from deprecation until a public interface declaration can be removed, the complete module can now be hidden. The actual definitions were moved to an auxiliary module in a prior commit so we could signal deprecations accordingly, but they have now been returned to Copilot.Core.Interpret.Render, where they should reside. The module Copilot.Core.Interpret.RenderInternal is now redundant. This commit removes that module entirely from the library. --- copilot-core/copilot-core.cabal | 1 - .../Copilot/Core/Interpret/RenderInternal.hs | 130 ------------------ 2 files changed, 131 deletions(-) delete mode 100644 copilot-core/src/Copilot/Core/Interpret/RenderInternal.hs diff --git a/copilot-core/copilot-core.cabal b/copilot-core/copilot-core.cabal index a59fbefa1..020aeef57 100644 --- a/copilot-core/copilot-core.cabal +++ b/copilot-core/copilot-core.cabal @@ -69,7 +69,6 @@ library Copilot.Core.Error Copilot.Core.Interpret.Render - Copilot.Core.Interpret.RenderInternal test-suite unit-tests type: diff --git a/copilot-core/src/Copilot/Core/Interpret/RenderInternal.hs b/copilot-core/src/Copilot/Core/Interpret/RenderInternal.hs deleted file mode 100644 index 73d9a85c4..000000000 --- a/copilot-core/src/Copilot/Core/Interpret/RenderInternal.hs +++ /dev/null @@ -1,130 +0,0 @@ --------------------------------------------------------------------------------- --- Copyright © 2011 National Institute of Aerospace / Galois, Inc. --------------------------------------------------------------------------------- - --- | Pretty-print the results of a simulation. - -{-# LANGUAGE Safe #-} - -module Copilot.Core.Interpret.RenderInternal - ( renderAsTable - , renderAsCSV - ) where - -import Data.List (intersperse, transpose, foldl') -import Data.Maybe (catMaybes) -import Copilot.Core.Interpret.Eval (Output, ExecTrace (..)) -import Text.PrettyPrint - -import Prelude hiding ((<>)) - --------------------------------------------------------------------------------- - --- | Render an execution trace as a table, formatted to faciliate readability. -renderAsTable :: ExecTrace -> String -renderAsTable - ExecTrace - { interpTriggers = trigs - , interpObservers = obsvs } = ( render - . asColumns - . transpose - . (:) (ppTriggerNames ++ ppObserverNames) - . transpose - ) (ppTriggerOutputs ++ ppObserverOutputs) - where - - ppTriggerNames :: [Doc] - ppTriggerNames = map (text . (++ ":")) (map fst trigs) - - ppObserverNames :: [Doc] - ppObserverNames = map (text . (++ ":")) (map fst obsvs) - - ppTriggerOutputs :: [[Doc]] - ppTriggerOutputs = map (map ppTriggerOutput) (map snd trigs) - - ppTriggerOutput :: Maybe [Output] -> Doc - ppTriggerOutput (Just vs) = text $ "(" ++ concat (intersperse "," vs) ++ ")" - ppTriggerOutput Nothing = text "--" - - ppObserverOutputs :: [[Doc]] - ppObserverOutputs = map (map text) (map snd obsvs) - --------------------------------------------------------------------------------- - --- | Render an execution trace as using comma-separate value (CSV) format. -renderAsCSV :: ExecTrace -> String -renderAsCSV = render . unfold - --- | Pretty print all the steps of the execution trace and concatenate the --- results. -unfold :: ExecTrace -> Doc -unfold r = - case step r of - (cs, Nothing) -> cs - (cs, Just r') -> cs $$ unfold r' - --- | Pretty print the state of the triggers, and provide a continuation --- for the execution trace at the next point in time. -step :: ExecTrace -> (Doc, Maybe ExecTrace) -step ExecTrace - { interpTriggers = trigs - } = - if null trigs then (empty, Nothing) - else (foldl' ($$) empty (text "#" : ppTriggerOutputs), tails) - - where - - ppTriggerOutputs :: [Doc] - ppTriggerOutputs = - catMaybes - . fmap ppTriggerOutput - . map (fmap head) - $ trigs - - ppTriggerOutput :: (String, Maybe [Output]) -> Maybe Doc - ppTriggerOutput (_, Nothing) = Nothing - ppTriggerOutput (cs, Just xs) = Just $ - text cs <> text "," <> - (foldr (<>) empty . map text . intersperse ",") xs - - tails :: Maybe ExecTrace - tails = - if any null (fmap (tail.snd) trigs) - then Nothing - else Just - ExecTrace - { interpTriggers = map (fmap tail) trigs - , interpObservers = [] - } - --------------------------------------------------------------------------------- - - - --- Copied from pretty-ncols because of incompatibility with newer GHC versions. -asColumns :: [[Doc]] -> Doc -asColumns = flip asColumnsWithBuff $ 1 - -asColumnsWithBuff :: [[Doc]] -> Int -> Doc -asColumnsWithBuff lls q = normalize - where normalize = vcat $ map hsep - $ map (\x -> pad (length x) longColumnLen empty x) - $ pad' longEntryLen q - $ transpose lls -- normalize column height - longColumnLen = maximum (map length lls) - longEntryLen = maximum $ map docLen (concat lls) - -docLen d = length $ render d - --- | Pad a string on the right to reach an expected length. -pad :: Int -> Int -> a -> [a] -> [a] -pad lx max b ls = ls ++ replicate (max - lx) b - --- | Pad a list of strings on the right with spaces. -pad' :: Int -- ^ Mininum number of spaces to add - -> Int -- ^ Maximum number of spaces to add - -> [[Doc]] -- ^ List of documents to pad - -> [[Doc]] -pad' _ _ [] = [] -pad' mx q (ls:xs) = map buf ls : pad' mx q xs - where buf x = x <> (hcat $ replicate q space) <> (hcat $ replicate (mx - (docLen x)) space) From 15ab162549bad81cf0f0ec0923693acadcdb355b Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 09:46:14 -0400 Subject: [PATCH 0079/1222] Document changes in CHANGELOG. Refs #303. --- copilot-core/CHANGELOG | 1 + 1 file changed, 1 insertion(+) diff --git a/copilot-core/CHANGELOG b/copilot-core/CHANGELOG index 64c722610..3a008e53c 100644 --- a/copilot-core/CHANGELOG +++ b/copilot-core/CHANGELOG @@ -1,4 +1,5 @@ 2022-04-22 + * Hide module Copilot.Core.Interpret.Render. (#303) * Remove Copilot.Core.Type.Dynamic.fromDynF,toDynF. (#301) * Hide module Copilot.Core.Error. (#300) * Remove Copilot.Core.Type.Uninitialized. (#302) From 745536d36fed57bd4c6e0ef2f2f11d86de2e7f0d Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 15:39:23 -0400 Subject: [PATCH 0080/1222] Style: turn block comment into line comments. Refs #316. According to our style guide, all comments should be line comments except for compiler options, language pragmas, and annotations / warnings / deprecations. --- copilot/examples/Engine.hs | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/copilot/examples/Engine.hs b/copilot/examples/Engine.hs index 27d2b540b..de3c5f4fb 100644 --- a/copilot/examples/Engine.hs +++ b/copilot/examples/Engine.hs @@ -11,11 +11,10 @@ module Main where import Language.Copilot import qualified Prelude as P -{- If the majority of the engine temperature probes exeeds 250 degrees, then - - the cooler is engaged and remains engaged until the majority of the engine - - temperature probes drop to 250 or below. Otherwise, trigger an immediate - - shutdown of the engine. --} +-- If the majority of the engine temperature probes exeeds 250 degrees, then +-- the cooler is engaged and remains engaged until the majority of the engine +-- temperature probes drop to 250 or below. Otherwise, trigger an immediate +-- shutdown of the engine. engineMonitor :: Spec engineMonitor = do From c304f544969a9865f1d4e85a7ec62ce034917353 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 15:42:01 -0400 Subject: [PATCH 0081/1222] Style: turn block comment into line comments. Refs #316. According to our style guide, all comments should be line comments except for compiler options, language pragmas, and annotations / warnings / deprecations. --- copilot-language/src/Copilot/Language/Interpret.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot-language/src/Copilot/Language/Interpret.hs b/copilot-language/src/Copilot/Language/Interpret.hs index 5b2d1b9f2..731449c9f 100644 --- a/copilot-language/src/Copilot/Language/Interpret.hs +++ b/copilot-language/src/Copilot/Language/Interpret.hs @@ -1,4 +1,4 @@ -{- Copyright (c) 2011 National Institute of Aerospace / Galois, Inc. -} +-- Copyright (c) 2011 National Institute of Aerospace / Galois, Inc. -- | This module implements two interpreters, which may be used to simulated or -- executed Copilot specifications on a computer to understand their behavior From 32d11059d217c0c1a79765debac5271776dac431 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 15:45:41 -0400 Subject: [PATCH 0082/1222] Style: turn block comment into line comments. Refs #316. According to our style guide, all comments should be line comments except for compiler options, language pragmas, and annotations / warnings / deprecations. --- copilot-core/src/Copilot/Core/Type.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot-core/src/Copilot/Core/Type.hs b/copilot-core/src/Copilot/Core/Type.hs index d0e75ecea..0d80f38e2 100644 --- a/copilot-core/src/Copilot/Core/Type.hs +++ b/copilot-core/src/Copilot/Core/Type.hs @@ -154,7 +154,7 @@ data SimpleType where -- | Type equality, used to help type inference. -{- This instance is necessary, otherwise the type of SArray can't be inferred -} +-- This instance is necessary, otherwise the type of SArray can't be inferred. instance Eq SimpleType where SBool == SBool = True From dc303c769101ebeb66c7e08ed68455fa019484e7 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 15:46:15 -0400 Subject: [PATCH 0083/1222] Style: turn block comment into line comments. Refs #316. According to our style guide, all comments should be line comments except for compiler options, language pragmas, and annotations / warnings / deprecations. --- .../src/Copilot/Theorem/Kind2/Translate.hs | 13 ++++++------- 1 file changed, 6 insertions(+), 7 deletions(-) diff --git a/copilot-theorem/src/Copilot/Theorem/Kind2/Translate.hs b/copilot-theorem/src/Copilot/Theorem/Kind2/Translate.hs index 26223eee5..9944e7991 100644 --- a/copilot-theorem/src/Copilot/Theorem/Kind2/Translate.hs +++ b/copilot-theorem/src/Copilot/Theorem/Kind2/Translate.hs @@ -108,13 +108,12 @@ addAssumptions spec assumptions (K.File {K.filePreds, K.fileProps}) = -------------------------------------------------------------------------------- -{- The ordering really matters here because the variables - have to be given in this order in a pred call - Our convention : - * First the local variables, sorted by alphabetical order - * Then the imported variables, by alphabetical order on - the father node then by alphabetical order on the variable name --} +-- The ordering really matters here because the variables +-- have to be given in this order in a pred call +-- Our convention : +-- * First the local variables, sorted by alphabetical order +-- * Then the imported variables, by alphabetical order on +-- the father node then by alphabetical order on the variable name gatherPredStateVars :: TransSys -> Node -> [K.StateVarDef] gatherPredStateVars spec node = locals ++ imported From f9a5c62d679c0fc0ec138ff45e60b807708e3cf1 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 15:51:21 -0400 Subject: [PATCH 0084/1222] Style: PRAGMAs are listed one per line. Refs #316. According to our style guide, contiguous block comments must be listed one per line. --- copilot-language/src/Copilot/Language/Reify.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot-language/src/Copilot/Language/Reify.hs b/copilot-language/src/Copilot/Language/Reify.hs index ed45e4637..0d3a24a29 100644 --- a/copilot-language/src/Copilot/Language/Reify.hs +++ b/copilot-language/src/Copilot/Language/Reify.hs @@ -6,7 +6,8 @@ -- specification. {-# LANGUAGE Safe #-} -{-# LANGUAGE ExistentialQuantification, Rank2Types #-} +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE Rank2Types #-} module Copilot.Language.Reify ( reify From feea3e431b8bb8cfa3e1520bf438193643a028e7 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 15:52:26 -0400 Subject: [PATCH 0085/1222] Style: PRAGMAs are listed one per line. Refs #316. According to our style guide, contiguous block comments must be listed one per line. --- copilot-language/src/Copilot/Language/Interpret.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot-language/src/Copilot/Language/Interpret.hs b/copilot-language/src/Copilot/Language/Interpret.hs index 731449c9f..e6d9b91f2 100644 --- a/copilot-language/src/Copilot/Language/Interpret.hs +++ b/copilot-language/src/Copilot/Language/Interpret.hs @@ -9,7 +9,8 @@ -- other uses a format that may be easier for humans to read. {-# LANGUAGE Safe #-} -{-# LANGUAGE GADTs, FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE FlexibleInstances #-} module Copilot.Language.Interpret ( csv From 5842ff16815c6e241b6ee53976280476dbe7cf1f Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 15:53:06 -0400 Subject: [PATCH 0086/1222] Style: PRAGMAs are listed one per line. Refs #316. According to our style guide, contiguous block comments must be listed one per line. --- .../src/Copilot/Language/Operators/Propositional.hs | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/copilot-language/src/Copilot/Language/Operators/Propositional.hs b/copilot-language/src/Copilot/Language/Operators/Propositional.hs index 1641669ce..963339d8b 100644 --- a/copilot-language/src/Copilot/Language/Operators/Propositional.hs +++ b/copilot-language/src/Copilot/Language/Operators/Propositional.hs @@ -2,7 +2,10 @@ -- Copyright © 2011 National Institute of Aerospace / Galois, Inc. -------------------------------------------------------------------------------- -{-# LANGUAGE Safe, FlexibleInstances, GADTs, MultiParamTypeClasses #-} +{-# LANGUAGE Safe #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE MultiParamTypeClasses #-} -- | Implement negation over quantified extensions of boolean streams. -- From aae26ddca7d67663c6024a1545bdc98daea19e95 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 15:53:41 -0400 Subject: [PATCH 0087/1222] Style: PRAGMAs are listed one per line. Refs #316. According to our style guide, contiguous block comments must be listed one per line. --- copilot-core/src/Copilot/Core/Operators.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot-core/src/Copilot/Core/Operators.hs b/copilot-core/src/Copilot/Core/Operators.hs index a8acc17af..d10d8fe62 100644 --- a/copilot-core/src/Copilot/Core/Operators.hs +++ b/copilot-core/src/Copilot/Core/Operators.hs @@ -3,7 +3,8 @@ -------------------------------------------------------------------------------- {-# LANGUAGE Safe #-} -{-# LANGUAGE GADTs, Rank2Types #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE Rank2Types #-} -- | Internal representation of Copilot operators. module Copilot.Core.Operators From 364a1ee6adae85fe7c6c2ce4501a835efe264e2d Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 15:54:15 -0400 Subject: [PATCH 0088/1222] Style: PRAGMAs are listed one per line. Refs #316. According to our style guide, contiguous block comments must be listed one per line. --- copilot-core/src/Copilot/Core/Type/Equality.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot-core/src/Copilot/Core/Type/Equality.hs b/copilot-core/src/Copilot/Core/Type/Equality.hs index be4b11236..e668dfda7 100644 --- a/copilot-core/src/Copilot/Core/Type/Equality.hs +++ b/copilot-core/src/Copilot/Core/Type/Equality.hs @@ -3,7 +3,8 @@ -------------------------------------------------------------------------------- {-# LANGUAGE Safe #-} -{-# LANGUAGE GADTs, KindSignatures #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE KindSignatures #-} -- | Propositional equality and type equality. module Copilot.Core.Type.Equality From f07069d1a03a28de2885d461b97afee40d0cafba Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 15:55:48 -0400 Subject: [PATCH 0089/1222] Style: PRAGMAs are listed one per line. Refs #316. According to our style guide, contiguous block comments must be listed one per line. --- copilot-core/src/Copilot/Core/Type/Dynamic.hs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/copilot-core/src/Copilot/Core/Type/Dynamic.hs b/copilot-core/src/Copilot/Core/Type/Dynamic.hs index 37248435c..5a87c5b0e 100644 --- a/copilot-core/src/Copilot/Core/Type/Dynamic.hs +++ b/copilot-core/src/Copilot/Core/Type/Dynamic.hs @@ -5,6 +5,9 @@ {-# LANGUAGE Safe #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE Rank2Types #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE ScopedTypeVariables #-} -- | An implementation of dynamic types using "Copilot.Core.Type.Equality". -- The theory behind this technique is described the following paper: @@ -13,8 +16,6 @@ -- \"/Typing dynamic typing/\", -- ACM SIGPLAN Notices vol. 37, p. 157-166, 2002 -{-# LANGUAGE GADTs, KindSignatures, ScopedTypeVariables #-} - module Copilot.Core.Type.Dynamic {-# DEPRECATED "This module is deprecated in Copilot 3.8." #-} ( Dynamic (..) From 55e632468f8ce6ac0d24427e7e8acab5a66a017a Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 15:56:19 -0400 Subject: [PATCH 0090/1222] Style: PRAGMAs are listed one per line. Refs #316. According to our style guide, contiguous block comments must be listed one per line. --- copilot-core/src/Copilot/Core/Type/Show.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot-core/src/Copilot/Core/Type/Show.hs b/copilot-core/src/Copilot/Core/Type/Show.hs index 91bcfbd3d..99f04e298 100644 --- a/copilot-core/src/Copilot/Core/Type/Show.hs +++ b/copilot-core/src/Copilot/Core/Type/Show.hs @@ -3,7 +3,8 @@ -------------------------------------------------------------------------------- {-# LANGUAGE Safe #-} -{-# LANGUAGE ExistentialQuantification, GADTs #-} +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE GADTs #-} -- | Show Copilot Core types and typed values. module Copilot.Core.Type.Show From 8c68f41fa5b915658d5076d5199140d8bf201e60 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 15:56:47 -0400 Subject: [PATCH 0091/1222] Style: PRAGMAs are listed one per line. Refs #316. According to our style guide, contiguous block comments must be listed one per line. --- copilot-core/src/Copilot/Core/Spec.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot-core/src/Copilot/Core/Spec.hs b/copilot-core/src/Copilot/Core/Spec.hs index ba6edeba9..6f06e1a74 100644 --- a/copilot-core/src/Copilot/Core/Spec.hs +++ b/copilot-core/src/Copilot/Core/Spec.hs @@ -3,7 +3,8 @@ -------------------------------------------------------------------------------- {-# LANGUAGE Safe #-} -{-# LANGUAGE ExistentialQuantification, GADTs #-} +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE GADTs #-} -- | Copilot specifications constitute the main declaration of Copilot modules. -- From cb1a08d5e5b3bb5c131be2e6c97cdaec581763f2 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 15:57:27 -0400 Subject: [PATCH 0092/1222] Style: PRAGMAs are listed one per line. Refs #316. According to our style guide, contiguous block comments must be listed one per line. --- copilot-core/src/Copilot/Core/Interpret/Eval.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/copilot-core/src/Copilot/Core/Interpret/Eval.hs b/copilot-core/src/Copilot/Core/Interpret/Eval.hs index dc571639c..909254a6c 100644 --- a/copilot-core/src/Copilot/Core/Interpret/Eval.hs +++ b/copilot-core/src/Copilot/Core/Interpret/Eval.hs @@ -5,7 +5,9 @@ -- | A tagless interpreter for Copilot specifications. {-# LANGUAGE Safe #-} -{-# LANGUAGE GADTs, BangPatterns, DeriveDataTypeable #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE DeriveDataTypeable #-} module Copilot.Core.Interpret.Eval ( Env From 205e1c3d8a8c5cf727c13a22f3ad5c96d5ce71c5 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 15:57:48 -0400 Subject: [PATCH 0093/1222] Style: PRAGMAs are listed one per line. Refs #316. According to our style guide, contiguous block comments must be listed one per line. --- copilot-core/src/Copilot/Core/Expr.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot-core/src/Copilot/Core/Expr.hs b/copilot-core/src/Copilot/Core/Expr.hs index d8467b806..f49063303 100644 --- a/copilot-core/src/Copilot/Core/Expr.hs +++ b/copilot-core/src/Copilot/Core/Expr.hs @@ -3,7 +3,8 @@ -------------------------------------------------------------------------------- {-# LANGUAGE Safe #-} -{-# LANGUAGE GADTs, ExistentialQuantification #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE ExistentialQuantification #-} -- | Internal representation of Copilot stream expressions. module Copilot.Core.Expr From 5eadd290a3e0ff52a49fc9df814812bcc8085612 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 15:58:15 -0400 Subject: [PATCH 0094/1222] Style: PRAGMAs are listed one per line. Refs #316. According to our style guide, contiguous block comments must be listed one per line. --- copilot-theorem/examples/BoyerMoore.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot-theorem/examples/BoyerMoore.hs b/copilot-theorem/examples/BoyerMoore.hs index 67d975135..80bacfa7c 100644 --- a/copilot-theorem/examples/BoyerMoore.hs +++ b/copilot-theorem/examples/BoyerMoore.hs @@ -1,6 +1,7 @@ -------------------------------------------------------------------------------- -{-# LANGUAGE RebindableSyntax, ScopedTypeVariables #-} +{-# LANGUAGE RebindableSyntax #-} +{-# LANGUAGE ScopedTypeVariables #-} module BoyerMoore where From e3bed1555755f29be5556a3a43a4289dbf117ca4 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 15:58:42 -0400 Subject: [PATCH 0095/1222] Style: PRAGMAs are listed one per line. Refs #316. According to our style guide, contiguous block comments must be listed one per line. --- copilot-theorem/src/Copilot/Theorem/TransSys/PrettyPrint.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot-theorem/src/Copilot/Theorem/TransSys/PrettyPrint.hs b/copilot-theorem/src/Copilot/Theorem/TransSys/PrettyPrint.hs index a90c27621..d890b2605 100644 --- a/copilot-theorem/src/Copilot/Theorem/TransSys/PrettyPrint.hs +++ b/copilot-theorem/src/Copilot/Theorem/TransSys/PrettyPrint.hs @@ -1,6 +1,7 @@ -------------------------------------------------------------------------------- -{-# LANGUAGE NamedFieldPuns, GADTs #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE GADTs #-} {-# LANGUAGE Safe #-} -- | Pretty print a TransSys specification as a Kind2/Lustre specification. From ac4105c9dfffaabfd33a02d49c5ecb3677f23341 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 15:59:30 -0400 Subject: [PATCH 0096/1222] Style: PRAGMAs are listed one per line. Refs #316. According to our style guide, contiguous block comments must be listed one per line. --- copilot-theorem/src/Copilot/Theorem/TransSys/Translate.hs | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/copilot-theorem/src/Copilot/Theorem/TransSys/Translate.hs b/copilot-theorem/src/Copilot/Theorem/TransSys/Translate.hs index 62716c24c..6aeb5af18 100644 --- a/copilot-theorem/src/Copilot/Theorem/TransSys/Translate.hs +++ b/copilot-theorem/src/Copilot/Theorem/TransSys/Translate.hs @@ -1,7 +1,11 @@ -------------------------------------------------------------------------------- -{-# LANGUAGE RankNTypes, NamedFieldPuns, ViewPatterns, - ScopedTypeVariables, GADTs, FlexibleContexts #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE Safe #-} -- | Translate Copilot specifications into a modular transition system. From 683d76aa1123db29da1f402f1b16c3393e6aa7cf Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:00:36 -0400 Subject: [PATCH 0097/1222] Style: PRAGMAs are listed one per line. Refs #316. According to our style guide, contiguous block comments must be listed one per line. --- copilot-theorem/src/Copilot/Theorem/TransSys/Operators.hs | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/copilot-theorem/src/Copilot/Theorem/TransSys/Operators.hs b/copilot-theorem/src/Copilot/Theorem/TransSys/Operators.hs index 20a66156e..df7f86921 100644 --- a/copilot-theorem/src/Copilot/Theorem/TransSys/Operators.hs +++ b/copilot-theorem/src/Copilot/Theorem/TransSys/Operators.hs @@ -1,7 +1,10 @@ -------------------------------------------------------------------------------- -{-# LANGUAGE GADTs, ExistentialQuantification, LambdaCase, ScopedTypeVariables, - RankNTypes #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE RankNTypes #-} {-# LANGUAGE Safe #-} -- | Operators in modular transition systems and their translation. From ed8a882188f8085ea38d16c815efb7080ea4523e Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:01:13 -0400 Subject: [PATCH 0098/1222] Style: PRAGMAs are listed one per line. Refs #316. According to our style guide, contiguous block comments must be listed one per line. --- copilot-theorem/src/Copilot/Theorem/TransSys/Type.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot-theorem/src/Copilot/Theorem/TransSys/Type.hs b/copilot-theorem/src/Copilot/Theorem/TransSys/Type.hs index f1b3007e7..e0121ebb0 100644 --- a/copilot-theorem/src/Copilot/Theorem/TransSys/Type.hs +++ b/copilot-theorem/src/Copilot/Theorem/TransSys/Type.hs @@ -1,6 +1,7 @@ -------------------------------------------------------------------------------- -{-# LANGUAGE ExistentialQuantification, GADTs #-} +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE GADTs #-} {-# LANGUAGE Safe #-} -- | Types suported by the modular transition systems. From c0af7aaf58f0b7ebc8ade00f24b0ae1a4a733520 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:04:34 -0400 Subject: [PATCH 0099/1222] Style: PRAGMAs are listed one per line. Refs #316. According to our style guide, contiguous block comments must be listed one per line. --- copilot-theorem/src/Copilot/Theorem/TransSys/Cast.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/copilot-theorem/src/Copilot/Theorem/TransSys/Cast.hs b/copilot-theorem/src/Copilot/Theorem/TransSys/Cast.hs index a5c298773..4ad66a1ad 100644 --- a/copilot-theorem/src/Copilot/Theorem/TransSys/Cast.hs +++ b/copilot-theorem/src/Copilot/Theorem/TransSys/Cast.hs @@ -1,6 +1,8 @@ -------------------------------------------------------------------------------- -{-# LANGUAGE RankNTypes, ScopedTypeVariables, GADTs #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE GADTs #-} {-# LANGUAGE Safe #-} -- | Casting of values with dynamic types and translating from Copilot core From d6fb2d68d632c0b781cd5f6be0d708148c97a693 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:05:02 -0400 Subject: [PATCH 0100/1222] Style: PRAGMAs are listed one per line. Refs #316. According to our style guide, contiguous block comments must be listed one per line. --- copilot-theorem/src/Copilot/Theorem/TransSys/Spec.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/copilot-theorem/src/Copilot/Theorem/TransSys/Spec.hs b/copilot-theorem/src/Copilot/Theorem/TransSys/Spec.hs index a7f36c1a1..13534b740 100644 --- a/copilot-theorem/src/Copilot/Theorem/TransSys/Spec.hs +++ b/copilot-theorem/src/Copilot/Theorem/TransSys/Spec.hs @@ -1,6 +1,8 @@ -------------------------------------------------------------------------------- -{-# LANGUAGE ExistentialQuantification, GADTs, RankNTypes #-} +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE RankNTypes #-} {-# LANGUAGE Safe #-} -- | Specification of Copilot streams as modular transition systems. From 0eb8416379e07ee098f737b3fc3e2f79d78e348f Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:05:42 -0400 Subject: [PATCH 0101/1222] Style: PRAGMAs are listed one per line. Refs #316. According to our style guide, contiguous block comments must be listed one per line. --- copilot-theorem/src/Copilot/Theorem/Prove.hs | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/copilot-theorem/src/Copilot/Theorem/Prove.hs b/copilot-theorem/src/Copilot/Theorem/Prove.hs index 59213adb2..2f460a51c 100644 --- a/copilot-theorem/src/Copilot/Theorem/Prove.hs +++ b/copilot-theorem/src/Copilot/Theorem/Prove.hs @@ -1,6 +1,9 @@ -------------------------------------------------------------------------------- -{-# LANGUAGE NamedFieldPuns, ViewPatterns, ExistentialQuantification, GADTs #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE GADTs #-} {-# LANGUAGE Safe #-} -- | Connection to theorem provers. From 2950d0e94a9fb3573a12c965717bf667f9c06760 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:06:25 -0400 Subject: [PATCH 0102/1222] Style: PRAGMAs are listed one per line. Refs #316. According to our style guide, contiguous block comments must be listed one per line. --- copilot-theorem/src/Copilot/Theorem/Kind2/Translate.hs | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/copilot-theorem/src/Copilot/Theorem/Kind2/Translate.hs b/copilot-theorem/src/Copilot/Theorem/Kind2/Translate.hs index 9944e7991..866121500 100644 --- a/copilot-theorem/src/Copilot/Theorem/Kind2/Translate.hs +++ b/copilot-theorem/src/Copilot/Theorem/Kind2/Translate.hs @@ -1,6 +1,9 @@ -------------------------------------------------------------------------------- -{-# LANGUAGE RankNTypes, ViewPatterns, NamedFieldPuns, GADTs #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE GADTs #-} {-# LANGUAGE Safe #-} -- | Convert modular transition systems ('TransSys') into Kind2 file From 24fb711c218055365056e3c08278c75aba8b2810 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:07:16 -0400 Subject: [PATCH 0103/1222] Style: PRAGMAs are listed one per line. Refs #316. According to our style guide, contiguous block comments must be listed one per line. --- copilot-theorem/src/Copilot/Theorem/Prover/SMT.hs | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/copilot-theorem/src/Copilot/Theorem/Prover/SMT.hs b/copilot-theorem/src/Copilot/Theorem/Prover/SMT.hs index 488e131df..72a92f30f 100644 --- a/copilot-theorem/src/Copilot/Theorem/Prover/SMT.hs +++ b/copilot-theorem/src/Copilot/Theorem/Prover/SMT.hs @@ -1,6 +1,10 @@ -------------------------------------------------------------------------------- -{-# LANGUAGE LambdaCase, NamedFieldPuns, FlexibleInstances, RankNTypes, GADTs #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE GADTs #-} {-# LANGUAGE Trustworthy #-} -- | Connections to various SMT solvers and theorem provers. From a88d3d8a4159a5933f2ba564b6fc6480b2f64cf4 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:07:44 -0400 Subject: [PATCH 0104/1222] Style: PRAGMAs are listed one per line. Refs #316. According to our style guide, contiguous block comments must be listed one per line. --- copilot-theorem/src/Copilot/Theorem/Prover/SMTLib.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot-theorem/src/Copilot/Theorem/Prover/SMTLib.hs b/copilot-theorem/src/Copilot/Theorem/Prover/SMTLib.hs index 9ceeb2ffc..6dbc6c716 100644 --- a/copilot-theorem/src/Copilot/Theorem/Prover/SMTLib.hs +++ b/copilot-theorem/src/Copilot/Theorem/Prover/SMTLib.hs @@ -1,6 +1,7 @@ -------------------------------------------------------------------------------- -{-# LANGUAGE GADTs, FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE Safe #-} -- | A backend to the SMT-Lib format, enabling to produce commands for SMT-Lib From 50b78b85de4eb0e8674f64198d1d23551d59f3fb Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:08:40 -0400 Subject: [PATCH 0105/1222] Style: PRAGMAs are listed one per line. Refs #316. According to our style guide, contiguous block comments must be listed one per line. --- copilot-theorem/src/Copilot/Theorem/Prover/SMTIO.hs | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/copilot-theorem/src/Copilot/Theorem/Prover/SMTIO.hs b/copilot-theorem/src/Copilot/Theorem/Prover/SMTIO.hs index fa127e9c9..8cb394d66 100644 --- a/copilot-theorem/src/Copilot/Theorem/Prover/SMTIO.hs +++ b/copilot-theorem/src/Copilot/Theorem/Prover/SMTIO.hs @@ -1,6 +1,9 @@ -------------------------------------------------------------------------------- -{-# LANGUAGE LambdaCase, NamedFieldPuns, RankNTypes, ViewPatterns #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ViewPatterns #-} {-# LANGUAGE Safe #-} -- | Communication with SMT solvers or theorem provers. From 439ddcfc515040b097c735e64cb15bbded7ab880 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:09:04 -0400 Subject: [PATCH 0106/1222] Style: PRAGMAs are listed one per line. Refs #316. According to our style guide, contiguous block comments must be listed one per line. --- copilot-theorem/src/Copilot/Theorem/Prover/TPTP.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot-theorem/src/Copilot/Theorem/Prover/TPTP.hs b/copilot-theorem/src/Copilot/Theorem/Prover/TPTP.hs index 59b16a714..2e751629e 100644 --- a/copilot-theorem/src/Copilot/Theorem/Prover/TPTP.hs +++ b/copilot-theorem/src/Copilot/Theorem/Prover/TPTP.hs @@ -1,6 +1,7 @@ -------------------------------------------------------------------------------- -{-# LANGUAGE GADTs, LambdaCase #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE Safe #-} -- | A backend to , enabling to produce assertions From cd9bd2a5654fc825a7b3c550e33a3d40f1657c07 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:10:07 -0400 Subject: [PATCH 0107/1222] Style: PRAGMAs are listed one per line. Refs #316. According to our style guide, contiguous block comments must be listed one per line. --- copilot-theorem/src/Copilot/Theorem/Prover/Z3.hs | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/copilot-theorem/src/Copilot/Theorem/Prover/Z3.hs b/copilot-theorem/src/Copilot/Theorem/Prover/Z3.hs index df0e3e7cc..7225fd94c 100644 --- a/copilot-theorem/src/Copilot/Theorem/Prover/Z3.hs +++ b/copilot-theorem/src/Copilot/Theorem/Prover/Z3.hs @@ -1,7 +1,12 @@ -------------------------------------------------------------------------------- -{-# LANGUAGE LambdaCase, NamedFieldPuns, FlexibleInstances, RankNTypes, GADTs, - MultiParamTypeClasses, FlexibleContexts #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE Trustworthy #-} module Copilot.Theorem.Prover.Z3 From 5cb148cff0fa65938d6411ee5d8c85dedc2344b7 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:10:28 -0400 Subject: [PATCH 0108/1222] Style: PRAGMAs are listed one per line. Refs #316. According to our style guide, contiguous block comments must be listed one per line. --- copilot-theorem/src/Copilot/Theorem/IL/PrettyPrint.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot-theorem/src/Copilot/Theorem/IL/PrettyPrint.hs b/copilot-theorem/src/Copilot/Theorem/IL/PrettyPrint.hs index 37d36a262..8fd52b92f 100644 --- a/copilot-theorem/src/Copilot/Theorem/IL/PrettyPrint.hs +++ b/copilot-theorem/src/Copilot/Theorem/IL/PrettyPrint.hs @@ -1,6 +1,7 @@ --------------------------------------------------------------------------------- -{-# LANGUAGE NamedFieldPuns, GADTs #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE GADTs #-} {-# LANGUAGE Safe #-} -- | This module implements a pretty printer for the IL format, an intermediate From bd3e48dc5aceb7e17a22a37dd0709cfc31388429 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:11:12 -0400 Subject: [PATCH 0109/1222] Style: PRAGMAs are listed one per line. Refs #316. According to our style guide, contiguous block comments must be listed one per line. --- copilot-theorem/src/Copilot/Theorem/IL/Translate.hs | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/copilot-theorem/src/Copilot/Theorem/IL/Translate.hs b/copilot-theorem/src/Copilot/Theorem/IL/Translate.hs index bdff2dc3b..89beea48b 100644 --- a/copilot-theorem/src/Copilot/Theorem/IL/Translate.hs +++ b/copilot-theorem/src/Copilot/Theorem/IL/Translate.hs @@ -1,7 +1,10 @@ -------------------------------------------------------------------------------- -{-# LANGUAGE RankNTypes, NamedFieldPuns, ScopedTypeVariables, GADTs, - LambdaCase #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE Safe #-} -- | Translate Copilot specifications into IL specifications. From 49955e48df6e15c9634428de31bbd3196eef4bae Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:11:39 -0400 Subject: [PATCH 0110/1222] Style: PRAGMAs are listed one per line. Refs #316. According to our style guide, contiguous block comments must be listed one per line. --- copilot-theorem/src/Copilot/Theorem/IL/Spec.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/copilot-theorem/src/Copilot/Theorem/IL/Spec.hs b/copilot-theorem/src/Copilot/Theorem/IL/Spec.hs index 19773b4fd..113b20ef9 100644 --- a/copilot-theorem/src/Copilot/Theorem/IL/Spec.hs +++ b/copilot-theorem/src/Copilot/Theorem/IL/Spec.hs @@ -1,6 +1,8 @@ -------------------------------------------------------------------------------- -{-# LANGUAGE ExistentialQuantification, GADTs, LambdaCase #-} +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE Safe #-} -- | This module implements the specification language for the IL format, an From 4a9427e6f308a04e4652fea6c65bb3d1192472c5 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:15:29 -0400 Subject: [PATCH 0111/1222] Style: PRAGMAs are listed one per line. Refs #316. According to our style guide, contiguous block comments must be listed one per line. --- copilot-core/src/Copilot/Core/Type.hs | 17 ++++++++--------- 1 file changed, 8 insertions(+), 9 deletions(-) diff --git a/copilot-core/src/Copilot/Core/Type.hs b/copilot-core/src/Copilot/Core/Type.hs index 0d80f38e2..ccfa6ecff 100644 --- a/copilot-core/src/Copilot/Core/Type.hs +++ b/copilot-core/src/Copilot/Core/Type.hs @@ -11,15 +11,14 @@ -- the target languages. {-# LANGUAGE Safe #-} -{-# LANGUAGE ExistentialQuantification - , GADTs - , KindSignatures - , ScopedTypeVariables - , UndecidableInstances - , FlexibleContexts - , DataKinds - , FlexibleInstances -#-} +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleInstances #-} module Copilot.Core.Type ( Type (..) From 8ab5960cda3d649f51cb8c38f27da009b2b3efb4 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:23:14 -0400 Subject: [PATCH 0112/1222] Style: list PRAGMAs in alphabetical order. Refs #316. According to our style guide, contiguous block comments of the same type must be listed in alphabetical order. --- copilot-core/src/Copilot/Core/Expr.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/copilot-core/src/Copilot/Core/Expr.hs b/copilot-core/src/Copilot/Core/Expr.hs index f49063303..0226a3e88 100644 --- a/copilot-core/src/Copilot/Core/Expr.hs +++ b/copilot-core/src/Copilot/Core/Expr.hs @@ -2,9 +2,9 @@ -- Copyright © 2011 National Institute of Aerospace / Galois, Inc. -------------------------------------------------------------------------------- -{-# LANGUAGE Safe #-} -{-# LANGUAGE GADTs #-} {-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE Safe #-} -- | Internal representation of Copilot stream expressions. module Copilot.Core.Expr From 945d0b3d31b40c1b00c6f4f57108934a6b04dda3 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:23:28 -0400 Subject: [PATCH 0113/1222] Style: list PRAGMAs in alphabetical order. Refs #316. According to our style guide, contiguous block comments of the same type must be listed in alphabetical order. --- copilot-core/src/Copilot/Core/External.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot-core/src/Copilot/Core/External.hs b/copilot-core/src/Copilot/Core/External.hs index ffa78188f..458f39d96 100644 --- a/copilot-core/src/Copilot/Core/External.hs +++ b/copilot-core/src/Copilot/Core/External.hs @@ -2,9 +2,9 @@ -- Copyright © 2011 National Institute of Aerospace / Galois, Inc. -------------------------------------------------------------------------------- -{-# LANGUAGE Trustworthy #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE Rank2Types #-} +{-# LANGUAGE Trustworthy #-} -- | Internal Copilot Core representation of Copilot externs. module Copilot.Core.External From 405cdae9aecb064c4e50cb019c95e1b1d3e50ebd Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:23:34 -0400 Subject: [PATCH 0114/1222] Style: list PRAGMAs in alphabetical order. Refs #316. According to our style guide, contiguous block comments of the same type must be listed in alphabetical order. --- copilot-core/src/Copilot/Core/Interpret/Eval.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/copilot-core/src/Copilot/Core/Interpret/Eval.hs b/copilot-core/src/Copilot/Core/Interpret/Eval.hs index 909254a6c..74030a4dc 100644 --- a/copilot-core/src/Copilot/Core/Interpret/Eval.hs +++ b/copilot-core/src/Copilot/Core/Interpret/Eval.hs @@ -4,10 +4,10 @@ -- | A tagless interpreter for Copilot specifications. -{-# LANGUAGE Safe #-} -{-# LANGUAGE GADTs #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE Safe #-} module Copilot.Core.Interpret.Eval ( Env From a926c73b41bde1e7078153a4c8ec8286a23f0554 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:23:40 -0400 Subject: [PATCH 0115/1222] Style: list PRAGMAs in alphabetical order. Refs #316. According to our style guide, contiguous block comments of the same type must be listed in alphabetical order. --- copilot-core/src/Copilot/Core/Operators.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot-core/src/Copilot/Core/Operators.hs b/copilot-core/src/Copilot/Core/Operators.hs index d10d8fe62..14a4b406b 100644 --- a/copilot-core/src/Copilot/Core/Operators.hs +++ b/copilot-core/src/Copilot/Core/Operators.hs @@ -2,9 +2,9 @@ -- Copyright © 2011 National Institute of Aerospace / Galois, Inc. -------------------------------------------------------------------------------- -{-# LANGUAGE Safe #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE Rank2Types #-} +{-# LANGUAGE Safe #-} -- | Internal representation of Copilot operators. module Copilot.Core.Operators From 3b5cfdec6ef1628fffe313c1f596da099e68e1fa Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:23:45 -0400 Subject: [PATCH 0116/1222] Style: list PRAGMAs in alphabetical order. Refs #316. According to our style guide, contiguous block comments of the same type must be listed in alphabetical order. --- copilot-core/src/Copilot/Core/PrettyDot.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot-core/src/Copilot/Core/PrettyDot.hs b/copilot-core/src/Copilot/Core/PrettyDot.hs index 1b5f6e73d..fad51ae66 100644 --- a/copilot-core/src/Copilot/Core/PrettyDot.hs +++ b/copilot-core/src/Copilot/Core/PrettyDot.hs @@ -4,8 +4,8 @@ -- | A pretty printer for Copilot specifications as GraphViz/dot graphs. -{-# LANGUAGE Safe #-} {-# LANGUAGE GADTs #-} +{-# LANGUAGE Safe #-} module Copilot.Core.PrettyDot ( prettyPrintDot From b8e203007b8feeae16761667d1c486e9614e9939 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:23:49 -0400 Subject: [PATCH 0117/1222] Style: list PRAGMAs in alphabetical order. Refs #316. According to our style guide, contiguous block comments of the same type must be listed in alphabetical order. --- copilot-core/src/Copilot/Core/PrettyPrint.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot-core/src/Copilot/Core/PrettyPrint.hs b/copilot-core/src/Copilot/Core/PrettyPrint.hs index f9e392793..fa0a2fcad 100644 --- a/copilot-core/src/Copilot/Core/PrettyPrint.hs +++ b/copilot-core/src/Copilot/Core/PrettyPrint.hs @@ -4,8 +4,8 @@ -- | A pretty printer for Copilot specifications. -{-# LANGUAGE Safe #-} {-# LANGUAGE GADTs #-} +{-# LANGUAGE Safe #-} module Copilot.Core.PrettyPrint ( prettyPrint From 64e03c8c623a6cd906f5451b6cc3d6f1ed1ef37e Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:23:54 -0400 Subject: [PATCH 0118/1222] Style: list PRAGMAs in alphabetical order. Refs #316. According to our style guide, contiguous block comments of the same type must be listed in alphabetical order. --- copilot-core/src/Copilot/Core/Spec.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot-core/src/Copilot/Core/Spec.hs b/copilot-core/src/Copilot/Core/Spec.hs index 6f06e1a74..606b43e35 100644 --- a/copilot-core/src/Copilot/Core/Spec.hs +++ b/copilot-core/src/Copilot/Core/Spec.hs @@ -2,9 +2,9 @@ -- Copyright © 2011 National Institute of Aerospace / Galois, Inc. -------------------------------------------------------------------------------- -{-# LANGUAGE Safe #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE GADTs #-} +{-# LANGUAGE Safe #-} -- | Copilot specifications constitute the main declaration of Copilot modules. -- From 58dd4e3383eb32f8fdb83cd6932bdd8497c83935 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:24:17 -0400 Subject: [PATCH 0119/1222] Style: list PRAGMAs in alphabetical order. Refs #316. According to our style guide, contiguous block comments of the same type must be listed in alphabetical order. --- copilot-core/src/Copilot/Core/Type.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/copilot-core/src/Copilot/Core/Type.hs b/copilot-core/src/Copilot/Core/Type.hs index ccfa6ecff..c7ccd61b9 100644 --- a/copilot-core/src/Copilot/Core/Type.hs +++ b/copilot-core/src/Copilot/Core/Type.hs @@ -10,15 +10,15 @@ -- initialize variables and equivalent representations for those types in -- the target languages. -{-# LANGUAGE Safe #-} +{-# LANGUAGE DataKinds #-} {-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE KindSignatures #-} +{-# LANGUAGE Safe #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE UndecidableInstances #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE FlexibleInstances #-} module Copilot.Core.Type ( Type (..) From d250f878ba44c15890654a840e612d6f161b7af2 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:24:22 -0400 Subject: [PATCH 0120/1222] Style: list PRAGMAs in alphabetical order. Refs #316. According to our style guide, contiguous block comments of the same type must be listed in alphabetical order. --- copilot-core/src/Copilot/Core/Type/Array.hs | 17 ++++++++--------- 1 file changed, 8 insertions(+), 9 deletions(-) diff --git a/copilot-core/src/Copilot/Core/Type/Array.hs b/copilot-core/src/Copilot/Core/Type/Array.hs index 49043ae3a..07f8d5b01 100644 --- a/copilot-core/src/Copilot/Core/Type/Array.hs +++ b/copilot-core/src/Copilot/Core/Type/Array.hs @@ -2,21 +2,20 @@ -- Copyright © 2011 National Institute of Aerospace / Galois, Inc. -------------------------------------------------------------------------------- +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE Safe #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} -- | Implementation of an array that uses type literals to store length. No -- explicit indexing is used for the input data. Supports arbitrary nesting of -- arrays. -{-# LANGUAGE GADTs #-} -{-# LANGUAGE KindSignatures #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE TypeFamilies #-} - module Copilot.Core.Type.Array ( Array , array From fc0234f4104957c42cbb3e1f1ad644967125ecde Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:24:27 -0400 Subject: [PATCH 0121/1222] Style: list PRAGMAs in alphabetical order. Refs #316. According to our style guide, contiguous block comments of the same type must be listed in alphabetical order. --- copilot-core/src/Copilot/Core/Type/Dynamic.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/copilot-core/src/Copilot/Core/Type/Dynamic.hs b/copilot-core/src/Copilot/Core/Type/Dynamic.hs index 5a87c5b0e..ddb23303f 100644 --- a/copilot-core/src/Copilot/Core/Type/Dynamic.hs +++ b/copilot-core/src/Copilot/Core/Type/Dynamic.hs @@ -2,11 +2,11 @@ -- Copyright © 2011 National Institute of Aerospace / Galois, Inc. -------------------------------------------------------------------------------- -{-# LANGUAGE Safe #-} {-# LANGUAGE ExistentialQuantification #-} -{-# LANGUAGE Rank2Types #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE KindSignatures #-} +{-# LANGUAGE Rank2Types #-} +{-# LANGUAGE Safe #-} {-# LANGUAGE ScopedTypeVariables #-} -- | An implementation of dynamic types using "Copilot.Core.Type.Equality". From 3efd375eed39ceabd5a2bf29dc7b86b8a466a260 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:24:31 -0400 Subject: [PATCH 0122/1222] Style: list PRAGMAs in alphabetical order. Refs #316. According to our style guide, contiguous block comments of the same type must be listed in alphabetical order. --- copilot-core/src/Copilot/Core/Type/Equality.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot-core/src/Copilot/Core/Type/Equality.hs b/copilot-core/src/Copilot/Core/Type/Equality.hs index e668dfda7..5e52fe7b8 100644 --- a/copilot-core/src/Copilot/Core/Type/Equality.hs +++ b/copilot-core/src/Copilot/Core/Type/Equality.hs @@ -2,9 +2,9 @@ -- Copyright © 2011 National Institute of Aerospace / Galois, Inc. -------------------------------------------------------------------------------- -{-# LANGUAGE Safe #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE KindSignatures #-} +{-# LANGUAGE Safe #-} -- | Propositional equality and type equality. module Copilot.Core.Type.Equality From 1746a9b5b3eb7aa9681fbc0a444a79d1e0a3b94b Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:24:35 -0400 Subject: [PATCH 0123/1222] Style: list PRAGMAs in alphabetical order. Refs #316. According to our style guide, contiguous block comments of the same type must be listed in alphabetical order. --- copilot-core/src/Copilot/Core/Type/Show.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot-core/src/Copilot/Core/Type/Show.hs b/copilot-core/src/Copilot/Core/Type/Show.hs index 99f04e298..d51544a7c 100644 --- a/copilot-core/src/Copilot/Core/Type/Show.hs +++ b/copilot-core/src/Copilot/Core/Type/Show.hs @@ -2,9 +2,9 @@ -- Copyright © 2011 National Institute of Aerospace / Galois, Inc. -------------------------------------------------------------------------------- -{-# LANGUAGE Safe #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE GADTs #-} +{-# LANGUAGE Safe #-} -- | Show Copilot Core types and typed values. module Copilot.Core.Type.Show From 2d8236305d3407cc691a6decc74606992c0b77ba Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:24:40 -0400 Subject: [PATCH 0124/1222] Style: list PRAGMAs in alphabetical order. Refs #316. According to our style guide, contiguous block comments of the same type must be listed in alphabetical order. --- copilot-language/src/Copilot/Language/Analyze.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot-language/src/Copilot/Language/Analyze.hs b/copilot-language/src/Copilot/Language/Analyze.hs index f37ff077f..bcee29fa8 100644 --- a/copilot-language/src/Copilot/Language/Analyze.hs +++ b/copilot-language/src/Copilot/Language/Analyze.hs @@ -2,9 +2,9 @@ -- Copyright © 2011 National Institute of Aerospace / Galois, Inc. -------------------------------------------------------------------------------- -{-# LANGUAGE Safe #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE GADTs #-} +{-# LANGUAGE Safe #-} {-# LANGUAGE ScopedTypeVariables #-} -- | Copilot specification sanity check. From 0fb0884c5db346206de148bf0bfec7d40b229f07 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:24:44 -0400 Subject: [PATCH 0125/1222] Style: list PRAGMAs in alphabetical order. Refs #316. According to our style guide, contiguous block comments of the same type must be listed in alphabetical order. --- copilot-language/src/Copilot/Language/Interpret.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/copilot-language/src/Copilot/Language/Interpret.hs b/copilot-language/src/Copilot/Language/Interpret.hs index e6d9b91f2..ec96b5000 100644 --- a/copilot-language/src/Copilot/Language/Interpret.hs +++ b/copilot-language/src/Copilot/Language/Interpret.hs @@ -8,9 +8,9 @@ -- One of them uses a format (csv) that may be more machine-readable, while the -- other uses a format that may be easier for humans to read. -{-# LANGUAGE Safe #-} -{-# LANGUAGE GADTs #-} {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE Safe #-} module Copilot.Language.Interpret ( csv From 89d037c0e86e272d84082bed404d744b1cf3b52d Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:24:49 -0400 Subject: [PATCH 0126/1222] Style: list PRAGMAs in alphabetical order. Refs #316. According to our style guide, contiguous block comments of the same type must be listed in alphabetical order. --- copilot-language/src/Copilot/Language/Operators/Cast.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot-language/src/Copilot/Language/Operators/Cast.hs b/copilot-language/src/Copilot/Language/Operators/Cast.hs index fddf8774c..11a3f328f 100644 --- a/copilot-language/src/Copilot/Language/Operators/Cast.hs +++ b/copilot-language/src/Copilot/Language/Operators/Cast.hs @@ -2,8 +2,8 @@ -- Copyright © 2011 National Institute of Aerospace / Galois, Inc. -------------------------------------------------------------------------------- -{-# LANGUAGE Safe #-} {-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE Safe #-} -- | Type-safe casting operators. module Copilot.Language.Operators.Cast From 503e2d9cbcee35f30167a5553d25bb58d0abcee3 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:24:53 -0400 Subject: [PATCH 0127/1222] Style: list PRAGMAs in alphabetical order. Refs #316. According to our style guide, contiguous block comments of the same type must be listed in alphabetical order. --- .../src/Copilot/Language/Operators/Propositional.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot-language/src/Copilot/Language/Operators/Propositional.hs b/copilot-language/src/Copilot/Language/Operators/Propositional.hs index 963339d8b..d04b1b9f4 100644 --- a/copilot-language/src/Copilot/Language/Operators/Propositional.hs +++ b/copilot-language/src/Copilot/Language/Operators/Propositional.hs @@ -2,10 +2,10 @@ -- Copyright © 2011 National Institute of Aerospace / Galois, Inc. -------------------------------------------------------------------------------- -{-# LANGUAGE Safe #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE Safe #-} -- | Implement negation over quantified extensions of boolean streams. -- From e4d8e0d93f24301a7be9783b86a065b41a815a80 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:24:57 -0400 Subject: [PATCH 0128/1222] Style: list PRAGMAs in alphabetical order. Refs #316. According to our style guide, contiguous block comments of the same type must be listed in alphabetical order. --- copilot-language/src/Copilot/Language/Reify.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot-language/src/Copilot/Language/Reify.hs b/copilot-language/src/Copilot/Language/Reify.hs index 0d3a24a29..a8c214d87 100644 --- a/copilot-language/src/Copilot/Language/Reify.hs +++ b/copilot-language/src/Copilot/Language/Reify.hs @@ -5,9 +5,9 @@ -- | Transform a Copilot Language specification into a Copilot Core -- specification. -{-# LANGUAGE Safe #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE Rank2Types #-} +{-# LANGUAGE Safe #-} module Copilot.Language.Reify ( reify From 31fdb4982eff2046ed71d224ac918fb8a6e12441 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:25:00 -0400 Subject: [PATCH 0129/1222] Style: list PRAGMAs in alphabetical order. Refs #316. According to our style guide, contiguous block comments of the same type must be listed in alphabetical order. --- copilot-language/src/Copilot/Language/Spec.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot-language/src/Copilot/Language/Spec.hs b/copilot-language/src/Copilot/Language/Spec.hs index f6a3def0c..626e58e68 100644 --- a/copilot-language/src/Copilot/Language/Spec.hs +++ b/copilot-language/src/Copilot/Language/Spec.hs @@ -2,10 +2,10 @@ -- Copyright © 2011 National Institute of Aerospace / Galois, Inc. -------------------------------------------------------------------------------- -{-# LANGUAGE Safe #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE RankNTypes #-} +{-# LANGUAGE Safe #-} -- | Copilot specifications consistute the main declaration of Copilot modules. -- From b5a40cb91b2269ebe58faaa3e6c43a39a5dc4e87 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:25:06 -0400 Subject: [PATCH 0130/1222] Style: list PRAGMAs in alphabetical order. Refs #316. According to our style guide, contiguous block comments of the same type must be listed in alphabetical order. --- copilot-language/src/Copilot/Language/Stream.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot-language/src/Copilot/Language/Stream.hs b/copilot-language/src/Copilot/Language/Stream.hs index fe4a0bc21..b719c37a3 100644 --- a/copilot-language/src/Copilot/Language/Stream.hs +++ b/copilot-language/src/Copilot/Language/Stream.hs @@ -4,10 +4,10 @@ -- | Abstract syntax for streams and operators. -{-# LANGUAGE Safe #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE Rank2Types #-} +{-# LANGUAGE Safe #-} module Copilot.Language.Stream ( Stream (..) From c68baf3ba2e6be386cbc0a82c4e42e3079030e9a Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:25:12 -0400 Subject: [PATCH 0131/1222] Style: Remove duplicated PRAGMA. Refs #316. According to our style guide, contiguous block comments of the same type must be listed in alphabetical order. Joining pragmas just results in the same pragma being listed twice in succession, which is unnecessary and can be removed. --- copilot-libraries/src/Copilot/Library/RegExp.hs | 2 -- 1 file changed, 2 deletions(-) diff --git a/copilot-libraries/src/Copilot/Library/RegExp.hs b/copilot-libraries/src/Copilot/Library/RegExp.hs index 375a0e3e2..712d44726 100644 --- a/copilot-libraries/src/Copilot/Library/RegExp.hs +++ b/copilot-libraries/src/Copilot/Library/RegExp.hs @@ -9,8 +9,6 @@ -- For an example, see -- -{-# LANGUAGE FlexibleContexts #-} - module Copilot.Library.RegExp ( copilotRegexp, copilotRegexpB ) where import Text.ParserCombinators.Parsec From 8361e2ab335ee277d34e5967b37349e7947733dc Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:26:51 -0400 Subject: [PATCH 0132/1222] Style: list PRAGMAs in alphabetical order. Refs #316. According to our style guide, contiguous block comments of the same type must be listed in alphabetical order. --- copilot-theorem/src/Copilot/Theorem/IL/PrettyPrint.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot-theorem/src/Copilot/Theorem/IL/PrettyPrint.hs b/copilot-theorem/src/Copilot/Theorem/IL/PrettyPrint.hs index 8fd52b92f..2ca3edb60 100644 --- a/copilot-theorem/src/Copilot/Theorem/IL/PrettyPrint.hs +++ b/copilot-theorem/src/Copilot/Theorem/IL/PrettyPrint.hs @@ -1,7 +1,7 @@ --------------------------------------------------------------------------------- -{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE GADTs #-} +{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE Safe #-} -- | This module implements a pretty printer for the IL format, an intermediate From 758f740ac0ed88715a976d4fad9d7fde1fbfbca6 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:26:55 -0400 Subject: [PATCH 0133/1222] Style: list PRAGMAs in alphabetical order. Refs #316. According to our style guide, contiguous block comments of the same type must be listed in alphabetical order. --- copilot-theorem/src/Copilot/Theorem/IL/Translate.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/copilot-theorem/src/Copilot/Theorem/IL/Translate.hs b/copilot-theorem/src/Copilot/Theorem/IL/Translate.hs index 89beea48b..a5b07d0ce 100644 --- a/copilot-theorem/src/Copilot/Theorem/IL/Translate.hs +++ b/copilot-theorem/src/Copilot/Theorem/IL/Translate.hs @@ -1,11 +1,11 @@ -------------------------------------------------------------------------------- -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE RankNTypes #-} {-# LANGUAGE Safe #-} +{-# LANGUAGE ScopedTypeVariables #-} -- | Translate Copilot specifications into IL specifications. module Copilot.Theorem.IL.Translate ( translate, translateWithBounds ) where From 084a470e8943f52da9122c7a65a2926aba50cbef Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:26:58 -0400 Subject: [PATCH 0134/1222] Style: list PRAGMAs in alphabetical order. Refs #316. According to our style guide, contiguous block comments of the same type must be listed in alphabetical order. --- copilot-theorem/src/Copilot/Theorem/Kind2/Translate.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/copilot-theorem/src/Copilot/Theorem/Kind2/Translate.hs b/copilot-theorem/src/Copilot/Theorem/Kind2/Translate.hs index 866121500..61c4445d3 100644 --- a/copilot-theorem/src/Copilot/Theorem/Kind2/Translate.hs +++ b/copilot-theorem/src/Copilot/Theorem/Kind2/Translate.hs @@ -1,10 +1,10 @@ -------------------------------------------------------------------------------- -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE ViewPatterns #-} -{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE GADTs #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE RankNTypes #-} {-# LANGUAGE Safe #-} +{-# LANGUAGE ViewPatterns #-} -- | Convert modular transition systems ('TransSys') into Kind2 file -- specifications. From d6077c00cc905b105fe01e14a873883da1de8bb7 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:27:01 -0400 Subject: [PATCH 0135/1222] Style: list PRAGMAs in alphabetical order. Refs #316. According to our style guide, contiguous block comments of the same type must be listed in alphabetical order. --- copilot-theorem/src/Copilot/Theorem/Prove.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/copilot-theorem/src/Copilot/Theorem/Prove.hs b/copilot-theorem/src/Copilot/Theorem/Prove.hs index 2f460a51c..fb1905ef9 100644 --- a/copilot-theorem/src/Copilot/Theorem/Prove.hs +++ b/copilot-theorem/src/Copilot/Theorem/Prove.hs @@ -1,10 +1,10 @@ -------------------------------------------------------------------------------- -{-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE ViewPatterns #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE GADTs #-} +{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE Safe #-} +{-# LANGUAGE ViewPatterns #-} -- | Connection to theorem provers. module Copilot.Theorem.Prove From 67f79273ed3440955da8b6df3795e40256213759 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:27:04 -0400 Subject: [PATCH 0136/1222] Style: list PRAGMAs in alphabetical order. Refs #316. According to our style guide, contiguous block comments of the same type must be listed in alphabetical order. --- copilot-theorem/src/Copilot/Theorem/Prover/SMT.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/copilot-theorem/src/Copilot/Theorem/Prover/SMT.hs b/copilot-theorem/src/Copilot/Theorem/Prover/SMT.hs index 72a92f30f..3bfbbafd2 100644 --- a/copilot-theorem/src/Copilot/Theorem/Prover/SMT.hs +++ b/copilot-theorem/src/Copilot/Theorem/Prover/SMT.hs @@ -1,10 +1,10 @@ -------------------------------------------------------------------------------- +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE RankNTypes #-} -{-# LANGUAGE GADTs #-} {-# LANGUAGE Trustworthy #-} -- | Connections to various SMT solvers and theorem provers. From 83d1083cd64cb81c3d08739dc9bef8dc06aeec50 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:27:07 -0400 Subject: [PATCH 0137/1222] Style: list PRAGMAs in alphabetical order. Refs #316. According to our style guide, contiguous block comments of the same type must be listed in alphabetical order. --- copilot-theorem/src/Copilot/Theorem/Prover/SMTIO.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot-theorem/src/Copilot/Theorem/Prover/SMTIO.hs b/copilot-theorem/src/Copilot/Theorem/Prover/SMTIO.hs index 8cb394d66..eec61f9a8 100644 --- a/copilot-theorem/src/Copilot/Theorem/Prover/SMTIO.hs +++ b/copilot-theorem/src/Copilot/Theorem/Prover/SMTIO.hs @@ -3,8 +3,8 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RankNTypes #-} -{-# LANGUAGE ViewPatterns #-} {-# LANGUAGE Safe #-} +{-# LANGUAGE ViewPatterns #-} -- | Communication with SMT solvers or theorem provers. -- From 53b50715369cc36ee0abb360670dc2ea30b66944 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:27:11 -0400 Subject: [PATCH 0138/1222] Style: list PRAGMAs in alphabetical order. Refs #316. According to our style guide, contiguous block comments of the same type must be listed in alphabetical order. --- copilot-theorem/src/Copilot/Theorem/Prover/SMTLib.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot-theorem/src/Copilot/Theorem/Prover/SMTLib.hs b/copilot-theorem/src/Copilot/Theorem/Prover/SMTLib.hs index 6dbc6c716..c81db73ed 100644 --- a/copilot-theorem/src/Copilot/Theorem/Prover/SMTLib.hs +++ b/copilot-theorem/src/Copilot/Theorem/Prover/SMTLib.hs @@ -1,7 +1,7 @@ -------------------------------------------------------------------------------- -{-# LANGUAGE GADTs #-} {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} {-# LANGUAGE Safe #-} -- | A backend to the SMT-Lib format, enabling to produce commands for SMT-Lib From 1ea2890a22253b149032fa9e4925918e386dcd2a Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:27:14 -0400 Subject: [PATCH 0139/1222] Style: list PRAGMAs in alphabetical order. Refs #316. According to our style guide, contiguous block comments of the same type must be listed in alphabetical order. --- copilot-theorem/src/Copilot/Theorem/Prover/Z3.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/copilot-theorem/src/Copilot/Theorem/Prover/Z3.hs b/copilot-theorem/src/Copilot/Theorem/Prover/Z3.hs index 7225fd94c..33eca2a7a 100644 --- a/copilot-theorem/src/Copilot/Theorem/Prover/Z3.hs +++ b/copilot-theorem/src/Copilot/Theorem/Prover/Z3.hs @@ -1,12 +1,12 @@ -------------------------------------------------------------------------------- -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE RankNTypes #-} {-# LANGUAGE GADTs #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE RankNTypes #-} {-# LANGUAGE Trustworthy #-} module Copilot.Theorem.Prover.Z3 From e67253dcb4d9d6c8e485093399bf689f295b8157 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:27:18 -0400 Subject: [PATCH 0140/1222] Style: list PRAGMAs in alphabetical order. Refs #316. According to our style guide, contiguous block comments of the same type must be listed in alphabetical order. --- copilot-theorem/src/Copilot/Theorem/TransSys/Cast.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/copilot-theorem/src/Copilot/Theorem/TransSys/Cast.hs b/copilot-theorem/src/Copilot/Theorem/TransSys/Cast.hs index 4ad66a1ad..71aa4614b 100644 --- a/copilot-theorem/src/Copilot/Theorem/TransSys/Cast.hs +++ b/copilot-theorem/src/Copilot/Theorem/TransSys/Cast.hs @@ -1,9 +1,9 @@ -------------------------------------------------------------------------------- -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE GADTs #-} +{-# LANGUAGE RankNTypes #-} {-# LANGUAGE Safe #-} +{-# LANGUAGE ScopedTypeVariables #-} -- | Casting of values with dynamic types and translating from Copilot core -- types to Copilot theorem types. From 352231ae940aa258a16e559397afa5e08a9eaf10 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:27:21 -0400 Subject: [PATCH 0141/1222] Style: list PRAGMAs in alphabetical order. Refs #316. According to our style guide, contiguous block comments of the same type must be listed in alphabetical order. --- copilot-theorem/src/Copilot/Theorem/TransSys/Operators.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/copilot-theorem/src/Copilot/Theorem/TransSys/Operators.hs b/copilot-theorem/src/Copilot/Theorem/TransSys/Operators.hs index df7f86921..456388887 100644 --- a/copilot-theorem/src/Copilot/Theorem/TransSys/Operators.hs +++ b/copilot-theorem/src/Copilot/Theorem/TransSys/Operators.hs @@ -1,11 +1,11 @@ -------------------------------------------------------------------------------- -{-# LANGUAGE GADTs #-} {-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} -{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE Safe #-} +{-# LANGUAGE ScopedTypeVariables #-} -- | Operators in modular transition systems and their translation. module Copilot.Theorem.TransSys.Operators where From b84e22a3fdd5faa2aafd23abc9d9e0c3e8f4f9a2 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:27:25 -0400 Subject: [PATCH 0142/1222] Style: list PRAGMAs in alphabetical order. Refs #316. According to our style guide, contiguous block comments of the same type must be listed in alphabetical order. --- copilot-theorem/src/Copilot/Theorem/TransSys/PrettyPrint.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot-theorem/src/Copilot/Theorem/TransSys/PrettyPrint.hs b/copilot-theorem/src/Copilot/Theorem/TransSys/PrettyPrint.hs index d890b2605..90865bd4e 100644 --- a/copilot-theorem/src/Copilot/Theorem/TransSys/PrettyPrint.hs +++ b/copilot-theorem/src/Copilot/Theorem/TransSys/PrettyPrint.hs @@ -1,7 +1,7 @@ -------------------------------------------------------------------------------- -{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE GADTs #-} +{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE Safe #-} -- | Pretty print a TransSys specification as a Kind2/Lustre specification. From 2f2d771d3a6b396f026e5afd1caccbce960b87f6 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:27:29 -0400 Subject: [PATCH 0143/1222] Style: list PRAGMAs in alphabetical order. Refs #316. According to our style guide, contiguous block comments of the same type must be listed in alphabetical order. --- .../src/Copilot/Theorem/TransSys/Translate.hs | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/copilot-theorem/src/Copilot/Theorem/TransSys/Translate.hs b/copilot-theorem/src/Copilot/Theorem/TransSys/Translate.hs index 6aeb5af18..400c4f447 100644 --- a/copilot-theorem/src/Copilot/Theorem/TransSys/Translate.hs +++ b/copilot-theorem/src/Copilot/Theorem/TransSys/Translate.hs @@ -1,12 +1,12 @@ -------------------------------------------------------------------------------- -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE ViewPatterns #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE GADTs #-} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE RankNTypes #-} {-# LANGUAGE Safe #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE ViewPatterns #-} -- | Translate Copilot specifications into a modular transition system. -- From eaef590a06befa835a1919cef18cea90510aaef8 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:27:39 -0400 Subject: [PATCH 0144/1222] Style: list PRAGMAs in alphabetical order. Refs #316. According to our style guide, contiguous block comments of the same type must be listed in alphabetical order. --- copilot/examples/Array.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot/examples/Array.hs b/copilot/examples/Array.hs index d0e4a4dc1..5122ecd43 100644 --- a/copilot/examples/Array.hs +++ b/copilot/examples/Array.hs @@ -8,8 +8,8 @@ -- | Enable compiler extension for type-level data, necesary for the array -- length. -{-# LANGUAGE RebindableSyntax #-} {-# LANGUAGE DataKinds #-} +{-# LANGUAGE RebindableSyntax #-} module Main where From 7d1c654128d2db271e28025506908956f3319373 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:43:09 -0400 Subject: [PATCH 0145/1222] Style: align PRAGMA comment brackets horizontally. Refs #316. According to our style guide, contiguous block comments of the same type must be horizontally aligned. --- copilot-c99/src/Copilot/Compile/C99/CodeGen.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs b/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs index 103d0b0ea..09ee82282 100644 --- a/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs +++ b/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE GADTs #-} +{-# LANGUAGE GADTs #-} {-# LANGUAGE ScopedTypeVariables #-} -- | High-level translation of Copilot Core into C99. From 607ff2e4ae7689298ede47607c74974ed28d8220 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:43:09 -0400 Subject: [PATCH 0146/1222] Style: align PRAGMA comment brackets horizontally. Refs #316. According to our style guide, contiguous block comments of the same type must be horizontally aligned. --- copilot-core/src/Copilot/Core/Expr.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/copilot-core/src/Copilot/Core/Expr.hs b/copilot-core/src/Copilot/Core/Expr.hs index 0226a3e88..a964933aa 100644 --- a/copilot-core/src/Copilot/Core/Expr.hs +++ b/copilot-core/src/Copilot/Core/Expr.hs @@ -3,8 +3,8 @@ -------------------------------------------------------------------------------- {-# LANGUAGE ExistentialQuantification #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE Safe #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE Safe #-} -- | Internal representation of Copilot stream expressions. module Copilot.Core.Expr From 6175ca6f381d43c6670179aa176d0f6d02f63b8b Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:43:09 -0400 Subject: [PATCH 0147/1222] Style: align PRAGMA comment brackets horizontally. Refs #316. According to our style guide, contiguous block comments of the same type must be horizontally aligned. --- copilot-core/src/Copilot/Core/External.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/copilot-core/src/Copilot/Core/External.hs b/copilot-core/src/Copilot/Core/External.hs index 458f39d96..bc429ef29 100644 --- a/copilot-core/src/Copilot/Core/External.hs +++ b/copilot-core/src/Copilot/Core/External.hs @@ -3,8 +3,8 @@ -------------------------------------------------------------------------------- {-# LANGUAGE ExistentialQuantification #-} -{-# LANGUAGE Rank2Types #-} -{-# LANGUAGE Trustworthy #-} +{-# LANGUAGE Rank2Types #-} +{-# LANGUAGE Trustworthy #-} -- | Internal Copilot Core representation of Copilot externs. module Copilot.Core.External From ece81fd08c7926f7ba474354dc0958f6ff1bec40 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:43:09 -0400 Subject: [PATCH 0148/1222] Style: align PRAGMA comment brackets horizontally. Refs #316. According to our style guide, contiguous block comments of the same type must be horizontally aligned. --- copilot-core/src/Copilot/Core/Interpret/Eval.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/copilot-core/src/Copilot/Core/Interpret/Eval.hs b/copilot-core/src/Copilot/Core/Interpret/Eval.hs index 74030a4dc..683177503 100644 --- a/copilot-core/src/Copilot/Core/Interpret/Eval.hs +++ b/copilot-core/src/Copilot/Core/Interpret/Eval.hs @@ -4,10 +4,10 @@ -- | A tagless interpreter for Copilot specifications. -{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE BangPatterns #-} {-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE Safe #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE Safe #-} module Copilot.Core.Interpret.Eval ( Env From 0eba14cda0ddb440e4deb4e2057ee8bf1a0568ac Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:43:09 -0400 Subject: [PATCH 0149/1222] Style: align PRAGMA comment brackets horizontally. Refs #316. According to our style guide, contiguous block comments of the same type must be horizontally aligned. --- copilot-core/src/Copilot/Core/Operators.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/copilot-core/src/Copilot/Core/Operators.hs b/copilot-core/src/Copilot/Core/Operators.hs index 14a4b406b..618812b6a 100644 --- a/copilot-core/src/Copilot/Core/Operators.hs +++ b/copilot-core/src/Copilot/Core/Operators.hs @@ -2,9 +2,9 @@ -- Copyright © 2011 National Institute of Aerospace / Galois, Inc. -------------------------------------------------------------------------------- -{-# LANGUAGE GADTs #-} +{-# LANGUAGE GADTs #-} {-# LANGUAGE Rank2Types #-} -{-# LANGUAGE Safe #-} +{-# LANGUAGE Safe #-} -- | Internal representation of Copilot operators. module Copilot.Core.Operators From 04cbdf99183865bbbd6347bb732141a7a637113e Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:43:09 -0400 Subject: [PATCH 0150/1222] Style: align PRAGMA comment brackets horizontally. Refs #316. According to our style guide, contiguous block comments of the same type must be horizontally aligned. --- copilot-core/src/Copilot/Core/PrettyDot.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot-core/src/Copilot/Core/PrettyDot.hs b/copilot-core/src/Copilot/Core/PrettyDot.hs index fad51ae66..eecebe2bb 100644 --- a/copilot-core/src/Copilot/Core/PrettyDot.hs +++ b/copilot-core/src/Copilot/Core/PrettyDot.hs @@ -5,7 +5,7 @@ -- | A pretty printer for Copilot specifications as GraphViz/dot graphs. {-# LANGUAGE GADTs #-} -{-# LANGUAGE Safe #-} +{-# LANGUAGE Safe #-} module Copilot.Core.PrettyDot ( prettyPrintDot From de742c9790f78e460282caca5a717fc58798e1b0 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:43:09 -0400 Subject: [PATCH 0151/1222] Style: align PRAGMA comment brackets horizontally. Refs #316. According to our style guide, contiguous block comments of the same type must be horizontally aligned. --- copilot-core/src/Copilot/Core/PrettyPrint.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot-core/src/Copilot/Core/PrettyPrint.hs b/copilot-core/src/Copilot/Core/PrettyPrint.hs index fa0a2fcad..e60eeffd5 100644 --- a/copilot-core/src/Copilot/Core/PrettyPrint.hs +++ b/copilot-core/src/Copilot/Core/PrettyPrint.hs @@ -5,7 +5,7 @@ -- | A pretty printer for Copilot specifications. {-# LANGUAGE GADTs #-} -{-# LANGUAGE Safe #-} +{-# LANGUAGE Safe #-} module Copilot.Core.PrettyPrint ( prettyPrint From 19148d9653ecd15320548b227a65876bbc3b64fe Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:43:09 -0400 Subject: [PATCH 0152/1222] Style: align PRAGMA comment brackets horizontally. Refs #316. According to our style guide, contiguous block comments of the same type must be horizontally aligned. --- copilot-core/src/Copilot/Core/Spec.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/copilot-core/src/Copilot/Core/Spec.hs b/copilot-core/src/Copilot/Core/Spec.hs index 606b43e35..a448dd7ea 100644 --- a/copilot-core/src/Copilot/Core/Spec.hs +++ b/copilot-core/src/Copilot/Core/Spec.hs @@ -3,8 +3,8 @@ -------------------------------------------------------------------------------- {-# LANGUAGE ExistentialQuantification #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE Safe #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE Safe #-} -- | Copilot specifications constitute the main declaration of Copilot modules. -- From 3c656680bba82b976636d093557b7e82ff8315e0 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:43:09 -0400 Subject: [PATCH 0153/1222] Style: align PRAGMA comment brackets horizontally. Refs #316. According to our style guide, contiguous block comments of the same type must be horizontally aligned. --- copilot-core/src/Copilot/Core/Type.hs | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/copilot-core/src/Copilot/Core/Type.hs b/copilot-core/src/Copilot/Core/Type.hs index c7ccd61b9..da34392c3 100644 --- a/copilot-core/src/Copilot/Core/Type.hs +++ b/copilot-core/src/Copilot/Core/Type.hs @@ -10,15 +10,15 @@ -- initialize variables and equivalent representations for those types in -- the target languages. -{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DataKinds #-} {-# LANGUAGE ExistentialQuantification #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE KindSignatures #-} -{-# LANGUAGE Safe #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE Safe #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE UndecidableInstances #-} module Copilot.Core.Type ( Type (..) From a020a487b8f91e64fb5f1eef64330fe2e9abf156 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:43:09 -0400 Subject: [PATCH 0154/1222] Style: align PRAGMA comment brackets horizontally. Refs #316. According to our style guide, contiguous block comments of the same type must be horizontally aligned. --- copilot-core/src/Copilot/Core/Type/Array.hs | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/copilot-core/src/Copilot/Core/Type/Array.hs b/copilot-core/src/Copilot/Core/Type/Array.hs index 07f8d5b01..91ae0adad 100644 --- a/copilot-core/src/Copilot/Core/Type/Array.hs +++ b/copilot-core/src/Copilot/Core/Type/Array.hs @@ -2,15 +2,15 @@ -- Copyright © 2011 National Institute of Aerospace / Galois, Inc. -------------------------------------------------------------------------------- -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE KindSignatures #-} {-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE Safe #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE Safe #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} -- | Implementation of an array that uses type literals to store length. No -- explicit indexing is used for the input data. Supports arbitrary nesting of From adf73bb5ff9f8b4814ad4f5aa80f45653c69d885 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:43:09 -0400 Subject: [PATCH 0155/1222] Style: align PRAGMA comment brackets horizontally. Refs #316. According to our style guide, contiguous block comments of the same type must be horizontally aligned. --- copilot-core/src/Copilot/Core/Type/Dynamic.hs | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/copilot-core/src/Copilot/Core/Type/Dynamic.hs b/copilot-core/src/Copilot/Core/Type/Dynamic.hs index ddb23303f..b6a4e6741 100644 --- a/copilot-core/src/Copilot/Core/Type/Dynamic.hs +++ b/copilot-core/src/Copilot/Core/Type/Dynamic.hs @@ -3,11 +3,11 @@ -------------------------------------------------------------------------------- {-# LANGUAGE ExistentialQuantification #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE KindSignatures #-} -{-# LANGUAGE Rank2Types #-} -{-# LANGUAGE Safe #-} -{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE Rank2Types #-} +{-# LANGUAGE Safe #-} +{-# LANGUAGE ScopedTypeVariables #-} -- | An implementation of dynamic types using "Copilot.Core.Type.Equality". -- The theory behind this technique is described the following paper: From b616bf24e78a7cfa22814bb40149e0d23440d7f7 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:43:09 -0400 Subject: [PATCH 0156/1222] Style: align PRAGMA comment brackets horizontally. Refs #316. According to our style guide, contiguous block comments of the same type must be horizontally aligned. --- copilot-core/src/Copilot/Core/Type/Equality.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/copilot-core/src/Copilot/Core/Type/Equality.hs b/copilot-core/src/Copilot/Core/Type/Equality.hs index 5e52fe7b8..74b38bd1a 100644 --- a/copilot-core/src/Copilot/Core/Type/Equality.hs +++ b/copilot-core/src/Copilot/Core/Type/Equality.hs @@ -2,9 +2,9 @@ -- Copyright © 2011 National Institute of Aerospace / Galois, Inc. -------------------------------------------------------------------------------- -{-# LANGUAGE GADTs #-} +{-# LANGUAGE GADTs #-} {-# LANGUAGE KindSignatures #-} -{-# LANGUAGE Safe #-} +{-# LANGUAGE Safe #-} -- | Propositional equality and type equality. module Copilot.Core.Type.Equality From 33c5dd851d4fcb33110fe6aab034442b97d7a447 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:43:09 -0400 Subject: [PATCH 0157/1222] Style: align PRAGMA comment brackets horizontally. Refs #316. According to our style guide, contiguous block comments of the same type must be horizontally aligned. --- copilot-core/src/Copilot/Core/Type/Show.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/copilot-core/src/Copilot/Core/Type/Show.hs b/copilot-core/src/Copilot/Core/Type/Show.hs index d51544a7c..292a4350c 100644 --- a/copilot-core/src/Copilot/Core/Type/Show.hs +++ b/copilot-core/src/Copilot/Core/Type/Show.hs @@ -3,8 +3,8 @@ -------------------------------------------------------------------------------- {-# LANGUAGE ExistentialQuantification #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE Safe #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE Safe #-} -- | Show Copilot Core types and typed values. module Copilot.Core.Type.Show From ad5ccfec401404ec22769e15cd54a945af510b8b Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:43:09 -0400 Subject: [PATCH 0158/1222] Style: align PRAGMA comment brackets horizontally. Refs #316. According to our style guide, contiguous block comments of the same type must be horizontally aligned. --- copilot-language/src/Copilot/Language/Analyze.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/copilot-language/src/Copilot/Language/Analyze.hs b/copilot-language/src/Copilot/Language/Analyze.hs index bcee29fa8..f267cfa1f 100644 --- a/copilot-language/src/Copilot/Language/Analyze.hs +++ b/copilot-language/src/Copilot/Language/Analyze.hs @@ -2,9 +2,9 @@ -- Copyright © 2011 National Institute of Aerospace / Galois, Inc. -------------------------------------------------------------------------------- -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE Safe #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE Safe #-} {-# LANGUAGE ScopedTypeVariables #-} -- | Copilot specification sanity check. From 5f26699984c0b8dcf4f447b7f0e5bb95d7701318 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:43:09 -0400 Subject: [PATCH 0159/1222] Style: align PRAGMA comment brackets horizontally. Refs #316. According to our style guide, contiguous block comments of the same type must be horizontally aligned. --- copilot-language/src/Copilot/Language/Interpret.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/copilot-language/src/Copilot/Language/Interpret.hs b/copilot-language/src/Copilot/Language/Interpret.hs index ec96b5000..441fe2591 100644 --- a/copilot-language/src/Copilot/Language/Interpret.hs +++ b/copilot-language/src/Copilot/Language/Interpret.hs @@ -9,8 +9,8 @@ -- other uses a format that may be easier for humans to read. {-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE Safe #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE Safe #-} module Copilot.Language.Interpret ( csv From d51b418d1776442a461590406cefced754c3dede Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:43:09 -0400 Subject: [PATCH 0160/1222] Style: align PRAGMA comment brackets horizontally. Refs #316. According to our style guide, contiguous block comments of the same type must be horizontally aligned. --- copilot-language/src/Copilot/Language/Operators/Array.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot-language/src/Copilot/Language/Operators/Array.hs b/copilot-language/src/Copilot/Language/Operators/Array.hs index 0aecb7b64..b51253ddb 100644 --- a/copilot-language/src/Copilot/Language/Operators/Array.hs +++ b/copilot-language/src/Copilot/Language/Operators/Array.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE Safe #-} +{-# LANGUAGE Safe #-} {-# LANGUAGE TypeFamilies #-} From 699f66ff6452946b4638326da7408722f24a3ef5 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:43:10 -0400 Subject: [PATCH 0161/1222] Style: align PRAGMA comment brackets horizontally. Refs #316. According to our style guide, contiguous block comments of the same type must be horizontally aligned. --- copilot-language/src/Copilot/Language/Operators/Cast.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot-language/src/Copilot/Language/Operators/Cast.hs b/copilot-language/src/Copilot/Language/Operators/Cast.hs index 11a3f328f..a733e064a 100644 --- a/copilot-language/src/Copilot/Language/Operators/Cast.hs +++ b/copilot-language/src/Copilot/Language/Operators/Cast.hs @@ -3,7 +3,7 @@ -------------------------------------------------------------------------------- {-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE Safe #-} +{-# LANGUAGE Safe #-} -- | Type-safe casting operators. module Copilot.Language.Operators.Cast From 9d73c121053f814c59a1a45fcd5748c0fbebb582 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:43:10 -0400 Subject: [PATCH 0162/1222] Style: align PRAGMA comment brackets horizontally. Refs #316. According to our style guide, contiguous block comments of the same type must be horizontally aligned. --- .../src/Copilot/Language/Operators/Propositional.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/copilot-language/src/Copilot/Language/Operators/Propositional.hs b/copilot-language/src/Copilot/Language/Operators/Propositional.hs index d04b1b9f4..bb121000e 100644 --- a/copilot-language/src/Copilot/Language/Operators/Propositional.hs +++ b/copilot-language/src/Copilot/Language/Operators/Propositional.hs @@ -2,10 +2,10 @@ -- Copyright © 2011 National Institute of Aerospace / Galois, Inc. -------------------------------------------------------------------------------- -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE GADTs #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} {-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE Safe #-} +{-# LANGUAGE Safe #-} -- | Implement negation over quantified extensions of boolean streams. -- From 5df56c0a1a85f8b1283d510b39359f2502359f21 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:43:10 -0400 Subject: [PATCH 0163/1222] Style: align PRAGMA comment brackets horizontally. Refs #316. According to our style guide, contiguous block comments of the same type must be horizontally aligned. --- copilot-language/src/Copilot/Language/Reify.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/copilot-language/src/Copilot/Language/Reify.hs b/copilot-language/src/Copilot/Language/Reify.hs index a8c214d87..96cc690f1 100644 --- a/copilot-language/src/Copilot/Language/Reify.hs +++ b/copilot-language/src/Copilot/Language/Reify.hs @@ -6,8 +6,8 @@ -- specification. {-# LANGUAGE ExistentialQuantification #-} -{-# LANGUAGE Rank2Types #-} -{-# LANGUAGE Safe #-} +{-# LANGUAGE Rank2Types #-} +{-# LANGUAGE Safe #-} module Copilot.Language.Reify ( reify From 1a2038eea8c39e8ddbfd5c8263e23435e6f61ca0 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:43:10 -0400 Subject: [PATCH 0164/1222] Style: align PRAGMA comment brackets horizontally. Refs #316. According to our style guide, contiguous block comments of the same type must be horizontally aligned. --- copilot-language/src/Copilot/Language/Spec.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/copilot-language/src/Copilot/Language/Spec.hs b/copilot-language/src/Copilot/Language/Spec.hs index 626e58e68..08659b27c 100644 --- a/copilot-language/src/Copilot/Language/Spec.hs +++ b/copilot-language/src/Copilot/Language/Spec.hs @@ -2,10 +2,10 @@ -- Copyright © 2011 National Institute of Aerospace / Galois, Inc. -------------------------------------------------------------------------------- -{-# LANGUAGE GADTs #-} +{-# LANGUAGE GADTs #-} {-# LANGUAGE KindSignatures #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE Safe #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE Safe #-} -- | Copilot specifications consistute the main declaration of Copilot modules. -- From 0511dccf1106606c2fd48566796773107504ca8e Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:43:10 -0400 Subject: [PATCH 0165/1222] Style: align PRAGMA comment brackets horizontally. Refs #316. According to our style guide, contiguous block comments of the same type must be horizontally aligned. --- copilot-language/src/Copilot/Language/Stream.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/copilot-language/src/Copilot/Language/Stream.hs b/copilot-language/src/Copilot/Language/Stream.hs index b719c37a3..43478c48f 100644 --- a/copilot-language/src/Copilot/Language/Stream.hs +++ b/copilot-language/src/Copilot/Language/Stream.hs @@ -4,10 +4,10 @@ -- | Abstract syntax for streams and operators. -{-# LANGUAGE GADTs #-} +{-# LANGUAGE GADTs #-} {-# LANGUAGE KindSignatures #-} -{-# LANGUAGE Rank2Types #-} -{-# LANGUAGE Safe #-} +{-# LANGUAGE Rank2Types #-} +{-# LANGUAGE Safe #-} module Copilot.Language.Stream ( Stream (..) From 07dfffa98e0b1ed53cee96790af3ff577ad35824 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:43:10 -0400 Subject: [PATCH 0166/1222] Style: align PRAGMA comment brackets horizontally. Refs #316. According to our style guide, contiguous block comments of the same type must be horizontally aligned. --- copilot-theorem/examples/BoyerMoore.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot-theorem/examples/BoyerMoore.hs b/copilot-theorem/examples/BoyerMoore.hs index 80bacfa7c..29032fadb 100644 --- a/copilot-theorem/examples/BoyerMoore.hs +++ b/copilot-theorem/examples/BoyerMoore.hs @@ -1,6 +1,6 @@ -------------------------------------------------------------------------------- -{-# LANGUAGE RebindableSyntax #-} +{-# LANGUAGE RebindableSyntax #-} {-# LANGUAGE ScopedTypeVariables #-} module BoyerMoore where From 5a73b050633efe29c9b7218b32cbe794f3e61a37 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:43:10 -0400 Subject: [PATCH 0167/1222] Style: align PRAGMA comment brackets horizontally. Refs #316. According to our style guide, contiguous block comments of the same type must be horizontally aligned. --- copilot-theorem/src/Copilot/Theorem/IL/PrettyPrint.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/copilot-theorem/src/Copilot/Theorem/IL/PrettyPrint.hs b/copilot-theorem/src/Copilot/Theorem/IL/PrettyPrint.hs index 2ca3edb60..ed2cc4fba 100644 --- a/copilot-theorem/src/Copilot/Theorem/IL/PrettyPrint.hs +++ b/copilot-theorem/src/Copilot/Theorem/IL/PrettyPrint.hs @@ -1,8 +1,8 @@ --------------------------------------------------------------------------------- -{-# LANGUAGE GADTs #-} +{-# LANGUAGE GADTs #-} {-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE Safe #-} +{-# LANGUAGE Safe #-} -- | This module implements a pretty printer for the IL format, an intermediate -- representation used in copilot-theorem to facilitate model checking. From 66eebb9ca42f53223b0c1a837d0453e10651a06e Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:43:10 -0400 Subject: [PATCH 0168/1222] Style: align PRAGMA comment brackets horizontally. Refs #316. According to our style guide, contiguous block comments of the same type must be horizontally aligned. --- copilot-theorem/src/Copilot/Theorem/IL/Spec.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/copilot-theorem/src/Copilot/Theorem/IL/Spec.hs b/copilot-theorem/src/Copilot/Theorem/IL/Spec.hs index 113b20ef9..8659724d2 100644 --- a/copilot-theorem/src/Copilot/Theorem/IL/Spec.hs +++ b/copilot-theorem/src/Copilot/Theorem/IL/Spec.hs @@ -1,9 +1,9 @@ -------------------------------------------------------------------------------- {-# LANGUAGE ExistentialQuantification #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE Safe #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE Safe #-} -- | This module implements the specification language for the IL format, an -- intermediate representation used in copilot-theorem to facilitate model From a63cea8e664ee23b1289cac136b969fe71cced1b Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:43:10 -0400 Subject: [PATCH 0169/1222] Style: align PRAGMA comment brackets horizontally. Refs #316. According to our style guide, contiguous block comments of the same type must be horizontally aligned. --- copilot-theorem/src/Copilot/Theorem/IL/Transform.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot-theorem/src/Copilot/Theorem/IL/Transform.hs b/copilot-theorem/src/Copilot/Theorem/IL/Transform.hs index 481835a8e..493c02259 100644 --- a/copilot-theorem/src/Copilot/Theorem/IL/Transform.hs +++ b/copilot-theorem/src/Copilot/Theorem/IL/Transform.hs @@ -1,5 +1,5 @@ {-# LANGUAGE LambdaCase #-} -{-# LANGUAGE Safe #-} +{-# LANGUAGE Safe #-} -- | Simplify IL expressions by partly evaluating operations on booleans. module Copilot.Theorem.IL.Transform ( bsimpl ) where From d64ad8a6e944119fe9a0d9be0c23bbd9fd405e33 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:43:10 -0400 Subject: [PATCH 0170/1222] Style: align PRAGMA comment brackets horizontally. Refs #316. According to our style guide, contiguous block comments of the same type must be horizontally aligned. --- copilot-theorem/src/Copilot/Theorem/IL/Translate.hs | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/copilot-theorem/src/Copilot/Theorem/IL/Translate.hs b/copilot-theorem/src/Copilot/Theorem/IL/Translate.hs index a5b07d0ce..15495d8bf 100644 --- a/copilot-theorem/src/Copilot/Theorem/IL/Translate.hs +++ b/copilot-theorem/src/Copilot/Theorem/IL/Translate.hs @@ -1,10 +1,10 @@ -------------------------------------------------------------------------------- -{-# LANGUAGE GADTs #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE Safe #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE Safe #-} {-# LANGUAGE ScopedTypeVariables #-} -- | Translate Copilot specifications into IL specifications. From 1f9b77cbcbd63b6bac78796dfa2d433300f554cc Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:43:10 -0400 Subject: [PATCH 0171/1222] Style: align PRAGMA comment brackets horizontally. Refs #316. According to our style guide, contiguous block comments of the same type must be horizontally aligned. --- copilot-theorem/src/Copilot/Theorem/Kind2/Output.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot-theorem/src/Copilot/Theorem/Kind2/Output.hs b/copilot-theorem/src/Copilot/Theorem/Kind2/Output.hs index 05621dafb..85633b7b7 100644 --- a/copilot-theorem/src/Copilot/Theorem/Kind2/Output.hs +++ b/copilot-theorem/src/Copilot/Theorem/Kind2/Output.hs @@ -1,7 +1,7 @@ -------------------------------------------------------------------------------- {-# LANGUAGE RankNTypes #-} -{-# LANGUAGE Safe #-} +{-# LANGUAGE Safe #-} -- | Parse output of Kind2. module Copilot.Theorem.Kind2.Output (parseOutput) where From aaab0416454031c7a7db2febc1adb1665b64bd15 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:43:10 -0400 Subject: [PATCH 0172/1222] Style: align PRAGMA comment brackets horizontally. Refs #316. According to our style guide, contiguous block comments of the same type must be horizontally aligned. --- copilot-theorem/src/Copilot/Theorem/Kind2/Prover.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot-theorem/src/Copilot/Theorem/Kind2/Prover.hs b/copilot-theorem/src/Copilot/Theorem/Kind2/Prover.hs index f94e01071..54c164a09 100644 --- a/copilot-theorem/src/Copilot/Theorem/Kind2/Prover.hs +++ b/copilot-theorem/src/Copilot/Theorem/Kind2/Prover.hs @@ -1,6 +1,6 @@ -------------------------------------------------------------------------------- -{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE Trustworthy #-} -- | A prover backend based on Kind2. From d6a8e7b45b2bd64531164a7146bdf18896d30e46 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:43:10 -0400 Subject: [PATCH 0173/1222] Style: align PRAGMA comment brackets horizontally. Refs #316. According to our style guide, contiguous block comments of the same type must be horizontally aligned. --- copilot-theorem/src/Copilot/Theorem/Kind2/Translate.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/copilot-theorem/src/Copilot/Theorem/Kind2/Translate.hs b/copilot-theorem/src/Copilot/Theorem/Kind2/Translate.hs index 61c4445d3..2960777a7 100644 --- a/copilot-theorem/src/Copilot/Theorem/Kind2/Translate.hs +++ b/copilot-theorem/src/Copilot/Theorem/Kind2/Translate.hs @@ -1,10 +1,10 @@ -------------------------------------------------------------------------------- -{-# LANGUAGE GADTs #-} +{-# LANGUAGE GADTs #-} {-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE Safe #-} -{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE Safe #-} +{-# LANGUAGE ViewPatterns #-} -- | Convert modular transition systems ('TransSys') into Kind2 file -- specifications. From d21142fd8c3936991ff05a3e1eb9576254e088ba Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:43:10 -0400 Subject: [PATCH 0174/1222] Style: align PRAGMA comment brackets horizontally. Refs #316. According to our style guide, contiguous block comments of the same type must be horizontally aligned. --- copilot-theorem/src/Copilot/Theorem/Misc/SExpr.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot-theorem/src/Copilot/Theorem/Misc/SExpr.hs b/copilot-theorem/src/Copilot/Theorem/Misc/SExpr.hs index 389f4a011..db5991f8b 100644 --- a/copilot-theorem/src/Copilot/Theorem/Misc/SExpr.hs +++ b/copilot-theorem/src/Copilot/Theorem/Misc/SExpr.hs @@ -1,7 +1,7 @@ -------------------------------------------------------------------------------- {-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE Safe #-} +{-# LANGUAGE Safe #-} -- | A representation for structured expression trees, with support for pretty -- printing and for parsing. From b64ae1d7bc72849a4439c2f1424b40948dc85fbb Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:43:10 -0400 Subject: [PATCH 0175/1222] Style: align PRAGMA comment brackets horizontally. Refs #316. According to our style guide, contiguous block comments of the same type must be horizontally aligned. --- copilot-theorem/src/Copilot/Theorem/Prove.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/copilot-theorem/src/Copilot/Theorem/Prove.hs b/copilot-theorem/src/Copilot/Theorem/Prove.hs index fb1905ef9..4a58b5334 100644 --- a/copilot-theorem/src/Copilot/Theorem/Prove.hs +++ b/copilot-theorem/src/Copilot/Theorem/Prove.hs @@ -1,10 +1,10 @@ -------------------------------------------------------------------------------- {-# LANGUAGE ExistentialQuantification #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE Safe #-} -{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE Safe #-} +{-# LANGUAGE ViewPatterns #-} -- | Connection to theorem provers. module Copilot.Theorem.Prove From f86855c4f560a9a33dd9a2c2788f7e8178301e61 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:43:10 -0400 Subject: [PATCH 0176/1222] Style: align PRAGMA comment brackets horizontally. Refs #316. According to our style guide, contiguous block comments of the same type must be horizontally aligned. --- copilot-theorem/src/Copilot/Theorem/Prover/Backend.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot-theorem/src/Copilot/Theorem/Prover/Backend.hs b/copilot-theorem/src/Copilot/Theorem/Prover/Backend.hs index 1fb9009c8..373486a7c 100644 --- a/copilot-theorem/src/Copilot/Theorem/Prover/Backend.hs +++ b/copilot-theorem/src/Copilot/Theorem/Prover/Backend.hs @@ -1,5 +1,5 @@ {-# LANGUAGE RankNTypes #-} -{-# LANGUAGE Safe #-} +{-# LANGUAGE Safe #-} -- | Backend to SMT solvers and theorem provers. -- From 557d270f016c729fa50dafa60f0076bd4ddc0133 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:43:10 -0400 Subject: [PATCH 0177/1222] Style: align PRAGMA comment brackets horizontally. Refs #316. According to our style guide, contiguous block comments of the same type must be horizontally aligned. --- copilot-theorem/src/Copilot/Theorem/Prover/SMT.hs | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/copilot-theorem/src/Copilot/Theorem/Prover/SMT.hs b/copilot-theorem/src/Copilot/Theorem/Prover/SMT.hs index 3bfbbafd2..7aea30f4c 100644 --- a/copilot-theorem/src/Copilot/Theorem/Prover/SMT.hs +++ b/copilot-theorem/src/Copilot/Theorem/Prover/SMT.hs @@ -1,11 +1,11 @@ -------------------------------------------------------------------------------- {-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE Trustworthy #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE Trustworthy #-} -- | Connections to various SMT solvers and theorem provers. module Copilot.Theorem.Prover.SMT From 78bac58847c39e4ade7d615071c00d155cc8ab01 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:43:10 -0400 Subject: [PATCH 0178/1222] Style: align PRAGMA comment brackets horizontally. Refs #316. According to our style guide, contiguous block comments of the same type must be horizontally aligned. --- copilot-theorem/src/Copilot/Theorem/Prover/SMTIO.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/copilot-theorem/src/Copilot/Theorem/Prover/SMTIO.hs b/copilot-theorem/src/Copilot/Theorem/Prover/SMTIO.hs index eec61f9a8..ee7c92cc0 100644 --- a/copilot-theorem/src/Copilot/Theorem/Prover/SMTIO.hs +++ b/copilot-theorem/src/Copilot/Theorem/Prover/SMTIO.hs @@ -1,10 +1,10 @@ -------------------------------------------------------------------------------- -{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE Safe #-} -{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE Safe #-} +{-# LANGUAGE ViewPatterns #-} -- | Communication with SMT solvers or theorem provers. -- From 03b9fcefbdac90809304ec6f0629a283345d4e62 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:43:10 -0400 Subject: [PATCH 0179/1222] Style: align PRAGMA comment brackets horizontally. Refs #316. According to our style guide, contiguous block comments of the same type must be horizontally aligned. --- copilot-theorem/src/Copilot/Theorem/Prover/SMTLib.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/copilot-theorem/src/Copilot/Theorem/Prover/SMTLib.hs b/copilot-theorem/src/Copilot/Theorem/Prover/SMTLib.hs index c81db73ed..218492b7b 100644 --- a/copilot-theorem/src/Copilot/Theorem/Prover/SMTLib.hs +++ b/copilot-theorem/src/Copilot/Theorem/Prover/SMTLib.hs @@ -1,8 +1,8 @@ -------------------------------------------------------------------------------- {-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE Safe #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE Safe #-} -- | A backend to the SMT-Lib format, enabling to produce commands for SMT-Lib -- implementing solvers, and parse results. From 117381a50554a7d654a07de2b0a2d284c6ff6c13 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:43:10 -0400 Subject: [PATCH 0180/1222] Style: align PRAGMA comment brackets horizontally. Refs #316. According to our style guide, contiguous block comments of the same type must be horizontally aligned. --- copilot-theorem/src/Copilot/Theorem/Prover/TPTP.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/copilot-theorem/src/Copilot/Theorem/Prover/TPTP.hs b/copilot-theorem/src/Copilot/Theorem/Prover/TPTP.hs index 2e751629e..cfceb133e 100644 --- a/copilot-theorem/src/Copilot/Theorem/Prover/TPTP.hs +++ b/copilot-theorem/src/Copilot/Theorem/Prover/TPTP.hs @@ -1,8 +1,8 @@ -------------------------------------------------------------------------------- -{-# LANGUAGE GADTs #-} +{-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} -{-# LANGUAGE Safe #-} +{-# LANGUAGE Safe #-} -- | A backend to , enabling to produce assertions -- and to parse the results from TPTP. From 7e603019a73ad5f8a933693df778a381655c7241 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:43:10 -0400 Subject: [PATCH 0181/1222] Style: align PRAGMA comment brackets horizontally. Refs #316. According to our style guide, contiguous block comments of the same type must be horizontally aligned. --- copilot-theorem/src/Copilot/Theorem/Prover/Z3.hs | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/copilot-theorem/src/Copilot/Theorem/Prover/Z3.hs b/copilot-theorem/src/Copilot/Theorem/Prover/Z3.hs index 33eca2a7a..4a0f0dddd 100644 --- a/copilot-theorem/src/Copilot/Theorem/Prover/Z3.hs +++ b/copilot-theorem/src/Copilot/Theorem/Prover/Z3.hs @@ -1,13 +1,13 @@ -------------------------------------------------------------------------------- -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE Trustworthy #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE Trustworthy #-} module Copilot.Theorem.Prover.Z3 ( module Data.Default From ae2fb4c0b0ee006f719f6af6c4c5acdd94e39c6f Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:43:10 -0400 Subject: [PATCH 0182/1222] Style: align PRAGMA comment brackets horizontally. Refs #316. According to our style guide, contiguous block comments of the same type must be horizontally aligned. --- copilot-theorem/src/Copilot/Theorem/TransSys/Cast.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/copilot-theorem/src/Copilot/Theorem/TransSys/Cast.hs b/copilot-theorem/src/Copilot/Theorem/TransSys/Cast.hs index 71aa4614b..bbb0ea311 100644 --- a/copilot-theorem/src/Copilot/Theorem/TransSys/Cast.hs +++ b/copilot-theorem/src/Copilot/Theorem/TransSys/Cast.hs @@ -1,8 +1,8 @@ -------------------------------------------------------------------------------- -{-# LANGUAGE GADTs #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE Safe #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE Safe #-} {-# LANGUAGE ScopedTypeVariables #-} -- | Casting of values with dynamic types and translating from Copilot core From fa30a9821a8a0c5645966641380b85cccce5f031 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:43:10 -0400 Subject: [PATCH 0183/1222] Style: align PRAGMA comment brackets horizontally. Refs #316. According to our style guide, contiguous block comments of the same type must be horizontally aligned. --- .../src/Copilot/Theorem/TransSys/Operators.hs | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/copilot-theorem/src/Copilot/Theorem/TransSys/Operators.hs b/copilot-theorem/src/Copilot/Theorem/TransSys/Operators.hs index 456388887..026761d00 100644 --- a/copilot-theorem/src/Copilot/Theorem/TransSys/Operators.hs +++ b/copilot-theorem/src/Copilot/Theorem/TransSys/Operators.hs @@ -1,11 +1,11 @@ -------------------------------------------------------------------------------- {-# LANGUAGE ExistentialQuantification #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE Safe #-} -{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE Safe #-} +{-# LANGUAGE ScopedTypeVariables #-} -- | Operators in modular transition systems and their translation. module Copilot.Theorem.TransSys.Operators where From f9834237443cc720228f80cbdaf72a7be2395b02 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:43:10 -0400 Subject: [PATCH 0184/1222] Style: align PRAGMA comment brackets horizontally. Refs #316. According to our style guide, contiguous block comments of the same type must be horizontally aligned. --- copilot-theorem/src/Copilot/Theorem/TransSys/PrettyPrint.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/copilot-theorem/src/Copilot/Theorem/TransSys/PrettyPrint.hs b/copilot-theorem/src/Copilot/Theorem/TransSys/PrettyPrint.hs index 90865bd4e..11de48ec7 100644 --- a/copilot-theorem/src/Copilot/Theorem/TransSys/PrettyPrint.hs +++ b/copilot-theorem/src/Copilot/Theorem/TransSys/PrettyPrint.hs @@ -1,8 +1,8 @@ -------------------------------------------------------------------------------- -{-# LANGUAGE GADTs #-} +{-# LANGUAGE GADTs #-} {-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE Safe #-} +{-# LANGUAGE Safe #-} -- | Pretty print a TransSys specification as a Kind2/Lustre specification. module Copilot.Theorem.TransSys.PrettyPrint ( prettyPrint ) where From 8b567c9bce9973719c996b0b50bcf0cf0bab1c45 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:43:10 -0400 Subject: [PATCH 0185/1222] Style: align PRAGMA comment brackets horizontally. Refs #316. According to our style guide, contiguous block comments of the same type must be horizontally aligned. --- copilot-theorem/src/Copilot/Theorem/TransSys/Spec.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/copilot-theorem/src/Copilot/Theorem/TransSys/Spec.hs b/copilot-theorem/src/Copilot/Theorem/TransSys/Spec.hs index 13534b740..01270814e 100644 --- a/copilot-theorem/src/Copilot/Theorem/TransSys/Spec.hs +++ b/copilot-theorem/src/Copilot/Theorem/TransSys/Spec.hs @@ -1,9 +1,9 @@ -------------------------------------------------------------------------------- {-# LANGUAGE ExistentialQuantification #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE Safe #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE Safe #-} -- | Specification of Copilot streams as modular transition systems. module Copilot.Theorem.TransSys.Spec From d7ee75c8e842ffb8599b55fba4363f1d1f46da98 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:43:10 -0400 Subject: [PATCH 0186/1222] Style: align PRAGMA comment brackets horizontally. Refs #316. According to our style guide, contiguous block comments of the same type must be horizontally aligned. --- copilot-theorem/src/Copilot/Theorem/TransSys/Transform.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot-theorem/src/Copilot/Theorem/TransSys/Transform.hs b/copilot-theorem/src/Copilot/Theorem/TransSys/Transform.hs index 51759ea13..cc7106d5a 100644 --- a/copilot-theorem/src/Copilot/Theorem/TransSys/Transform.hs +++ b/copilot-theorem/src/Copilot/Theorem/TransSys/Transform.hs @@ -1,7 +1,7 @@ -------------------------------------------------------------------------------- {-# LANGUAGE RankNTypes #-} -{-# LANGUAGE Safe #-} +{-# LANGUAGE Safe #-} -- | Helper module to manipulate and simplify TransSys graphs. module Copilot.Theorem.TransSys.Transform From c1ac7296a9e54cf548202adaf3b82c833822615a Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:43:10 -0400 Subject: [PATCH 0187/1222] Style: align PRAGMA comment brackets horizontally. Refs #316. According to our style guide, contiguous block comments of the same type must be horizontally aligned. --- .../src/Copilot/Theorem/TransSys/Translate.hs | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/copilot-theorem/src/Copilot/Theorem/TransSys/Translate.hs b/copilot-theorem/src/Copilot/Theorem/TransSys/Translate.hs index 400c4f447..98adc3f60 100644 --- a/copilot-theorem/src/Copilot/Theorem/TransSys/Translate.hs +++ b/copilot-theorem/src/Copilot/Theorem/TransSys/Translate.hs @@ -1,12 +1,12 @@ -------------------------------------------------------------------------------- -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE Safe #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE Safe #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE ViewPatterns #-} -- | Translate Copilot specifications into a modular transition system. -- From ad8468b40428af3c4aba2191d677c380b232db05 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:43:10 -0400 Subject: [PATCH 0188/1222] Style: align PRAGMA comment brackets horizontally. Refs #316. According to our style guide, contiguous block comments of the same type must be horizontally aligned. --- copilot-theorem/src/Copilot/Theorem/TransSys/Type.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/copilot-theorem/src/Copilot/Theorem/TransSys/Type.hs b/copilot-theorem/src/Copilot/Theorem/TransSys/Type.hs index e0121ebb0..7bab4481d 100644 --- a/copilot-theorem/src/Copilot/Theorem/TransSys/Type.hs +++ b/copilot-theorem/src/Copilot/Theorem/TransSys/Type.hs @@ -1,8 +1,8 @@ -------------------------------------------------------------------------------- {-# LANGUAGE ExistentialQuantification #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE Safe #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE Safe #-} -- | Types suported by the modular transition systems. module Copilot.Theorem.TransSys.Type From 74f397ec6fa2c62de6ded0955dea79a6638f8fba Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:43:10 -0400 Subject: [PATCH 0189/1222] Style: align PRAGMA comment brackets horizontally. Refs #316. According to our style guide, contiguous block comments of the same type must be horizontally aligned. --- copilot-theorem/src/Copilot/Theorem/What4.hs | 28 ++++++++++---------- 1 file changed, 14 insertions(+), 14 deletions(-) diff --git a/copilot-theorem/src/Copilot/Theorem/What4.hs b/copilot-theorem/src/Copilot/Theorem/What4.hs index 7607d2438..7be5bc4a2 100644 --- a/copilot-theorem/src/Copilot/Theorem/What4.hs +++ b/copilot-theorem/src/Copilot/Theorem/What4.hs @@ -1,18 +1,18 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE GADTs #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GADTs #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE KindSignatures #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE MultiWayIf #-} -{-# LANGUAGE PatternSynonyms #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TupleSections #-} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeOperators #-} -- | -- Module : Copilot.Theorem.What4 From 1dedbd86807e6954ba798605724110d08e13c346 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:43:10 -0400 Subject: [PATCH 0190/1222] Style: align PRAGMA comment brackets horizontally. Refs #316. According to our style guide, contiguous block comments of the same type must be horizontally aligned. --- copilot/examples/WCV.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot/examples/WCV.hs b/copilot/examples/WCV.hs index 80ab4af26..fe5ff8555 100644 --- a/copilot/examples/WCV.hs +++ b/copilot/examples/WCV.hs @@ -3,7 +3,7 @@ -- Well-Clear Bounday Models for the Integration of UAS in the NAS', -- https://ntrs.nasa.gov/citations/20140010078. -{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DataKinds #-} {-# LANGUAGE RebindableSyntax #-} module Main where From 74589196f286f0ab623bcb781d914525deade8eb Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:44:02 -0400 Subject: [PATCH 0191/1222] Style: Remove space before comma. Refs #316. According to our style guide, there should not be horizontal white space between a value and a comma that follows it. --- copilot-core/src/Copilot/Core/PrettyDot.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/copilot-core/src/Copilot/Core/PrettyDot.hs b/copilot-core/src/Copilot/Core/PrettyDot.hs index eecebe2bb..68dca32e2 100644 --- a/copilot-core/src/Copilot/Core/PrettyDot.hs +++ b/copilot-core/src/Copilot/Core/PrettyDot.hs @@ -52,7 +52,7 @@ ppExprDot ii pere bb e0 = case e0 of <> text (printf "%s [label=\"def: %s\",color=blue, style=filled]\n" ((show $ ii+1)::String) (name::String) ) <> text (printf "%s -> %s\n" (show ii::String) (show $ ii+1::String)) <> r1 - <> r2 ,i2) + <> r2, i2) Var _ name -> (text (printf "%s [label=\"var: %s\",color=blue, style=filled]\n" (show ii::String) (name::String) ) <> text (printf "%s -> %s\n" (show pere::String) (show ii::String)),ii+1) @@ -67,7 +67,7 @@ ppExprDot ii pere bb e0 = case e0 of in (text (printf "%s [label=\"op2: %s\",color=green4, style=filled]\n" (show ii::String) (ppOp2 op::String)) <> text (printf "%s -> %s\n" (show pere::String) (show ii::String)) <> r1 - <> r2 ,i2) + <> r2, i2) Op3 op e1 e2 e3 -> let (r1,i1) = ppExprDot (ii+1) ii bb e1 in let (r2,i2) = ppExprDot i1 ii bb e2 in let (r3,i3) = ppExprDot i2 ii bb e3 @@ -75,7 +75,7 @@ ppExprDot ii pere bb e0 = case e0 of <> text (printf "%s -> %s\n" (show pere::String) (show ii::String)) <> r1 <> r2 - <> r3 ,i3) + <> r3, i3) Label _ s e -> let (r1,i1) = ppExprDot (ii+1) ii bb e in (text (printf "%s [label=\"label: %s\",color=plum, style=filled]\n" (show ii::String) (s::String)) From 8dbeee695e40e3813a562d54216b79812c27f93c Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:45:15 -0400 Subject: [PATCH 0192/1222] Style: Remove space before comma. Refs #316. According to our style guide, there should not be horizontal white space between a value and a comma that follows it. --- copilot-theorem/src/Copilot/Theorem/Prover/Z3.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot-theorem/src/Copilot/Theorem/Prover/Z3.hs b/copilot-theorem/src/Copilot/Theorem/Prover/Z3.hs index 4a0f0dddd..b0da8121f 100644 --- a/copilot-theorem/src/Copilot/Theorem/Prover/Z3.hs +++ b/copilot-theorem/src/Copilot/Theorem/Prover/Z3.hs @@ -546,6 +546,6 @@ instance (SMTBackend b m,MonadIO m) => SMTBackend (DebugBackend b) m where when (debugUseColor b) $ liftIO $ hSetSGR (debugHandle b) [Reset,SetColor Foreground Dull Blue] liftIO $ unless (mute b) $ hPutStrLn (debugHandle b) str when (debugUseColor b) $ liftIO $ hSetSGR (debugHandle b) [Reset] - return (resp,b { debugBackend = b2 , debugLines = nline }) + return (resp,b { debugBackend = b2, debugLines = nline }) From e05d6903429f13c6729331d0c7e3daac5f713924 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:45:54 -0400 Subject: [PATCH 0193/1222] Style: Remove TODO note. Refs #316. According to our style guide, there should be no TODO notes in the code. --- copilot-c99/src/Copilot/Compile/C99/Compile.hs | 3 --- 1 file changed, 3 deletions(-) diff --git a/copilot-c99/src/Copilot/Compile/C99/Compile.hs b/copilot-c99/src/Copilot/Compile/C99/Compile.hs index 244e60d12..e1038e65d 100644 --- a/copilot-c99/src/Copilot/Compile/C99/Compile.hs +++ b/copilot-c99/src/Copilot/Compile/C99/Compile.hs @@ -39,9 +39,6 @@ compileWith cSettings prefix spec = do let cfile = render $ pretty $ C.translate $ compilec cSettings spec hfile = render $ pretty $ C.translate $ compileh cSettings spec - -- TODO: find a nicer solution using annotated AST's - -- Should figure out exactly which headers are needed, based on what - -- is used. cmacros = unlines [ "#include " , "#include " , "#include " From 730fcdde0903156ae8f0c2d7afea76253179e30f Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:47:29 -0400 Subject: [PATCH 0194/1222] Style: Remove TODO note. Refs #316. According to our style guide, there should be no TODO notes in the code. --- copilot-theorem/src/Copilot/Theorem/TransSys/Translate.hs | 6 ------ 1 file changed, 6 deletions(-) diff --git a/copilot-theorem/src/Copilot/Theorem/TransSys/Translate.hs b/copilot-theorem/src/Copilot/Theorem/TransSys/Translate.hs index 98adc3f60..e807ce8b0 100644 --- a/copilot-theorem/src/Copilot/Theorem/TransSys/Translate.hs +++ b/copilot-theorem/src/Copilot/Theorem/TransSys/Translate.hs @@ -223,12 +223,6 @@ expr t (C.ExternVar _ name _) = do newImportedVar localAlias (ExtVar nodeName (Var ncMain)) return $ VarE t localAlias --- TODO : Use uninterpreted functions to handle --- * Unhandled operators --- * Extern functions --- * Extern arrays --- For now, the result of these operations is a new unconstrained variable - expr t (C.Op1 op e) = handleOp1 t (op, e) expr notHandled Op1 where From 791f64c340cf02853e6845e2be52d6bb3009459f Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:48:08 -0400 Subject: [PATCH 0195/1222] Style: Remove TODO note. Refs #316. According to our style guide, there should be no TODO notes in the code. --- copilot-theorem/src/Copilot/Theorem/Kind2/Prover.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot-theorem/src/Copilot/Theorem/Kind2/Prover.hs b/copilot-theorem/src/Copilot/Theorem/Kind2/Prover.hs index 54c164a09..0f4d2068c 100644 --- a/copilot-theorem/src/Copilot/Theorem/Kind2/Prover.hs +++ b/copilot-theorem/src/Copilot/Theorem/Kind2/Prover.hs @@ -76,6 +76,6 @@ askKind2 (ProverST opts spec) assumptions toCheck = do putStrLn kind2Input removeFile tempName - return $ parseOutput (head toCheck) output -- TODO support multiple toCheck props + return $ parseOutput (head toCheck) output -------------------------------------------------------------------------------- From 6f92e0aa4e3e58decf2453a19f53c905819e2662 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:48:24 -0400 Subject: [PATCH 0196/1222] Style: Remove TODO note. Refs #316. According to our style guide, there should be no TODO notes in the code. --- copilot-theorem/src/Copilot/Theorem/Prover/Z3.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/copilot-theorem/src/Copilot/Theorem/Prover/Z3.hs b/copilot-theorem/src/Copilot/Theorem/Prover/Z3.hs index b0da8121f..9ceb6d9b7 100644 --- a/copilot-theorem/src/Copilot/Theorem/Prover/Z3.hs +++ b/copilot-theorem/src/Copilot/Theorem/Prover/Z3.hs @@ -439,7 +439,6 @@ transR = \case SVal _ s i -> getRatVar $ ncVar s i e -> error $ "Encountered unhandled expression (Rat): " ++ show e --- TODO(chathhorn): bleghh transBV8 :: Expr -> Trans (SMTExpr BV8) transBV8 = \case ConstI _ n -> return $ constant $ BitVector n From 0bfd74f21a84871dd8102d4a07e9e4d1dfbebe13 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:48:47 -0400 Subject: [PATCH 0197/1222] Style: Remove TODO note. Refs #316. According to our style guide, there should be no TODO notes in the code. --- copilot-theorem/src/Copilot/Theorem/IL/Translate.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/copilot-theorem/src/Copilot/Theorem/IL/Translate.hs b/copilot-theorem/src/Copilot/Theorem/IL/Translate.hs index 15495d8bf..53e6676d7 100644 --- a/copilot-theorem/src/Copilot/Theorem/IL/Translate.hs +++ b/copilot-theorem/src/Copilot/Theorem/IL/Translate.hs @@ -228,7 +228,7 @@ trOp1 = \case C.Acosh t -> (Acosh, trType t) -- C.BwNot t -> -- C.Cast t -> - _ -> error "Unsupported unary operator in input." -- TODO(chathhorn) + _ -> error "Unsupported unary operator in input." trOp2 :: C.Op2 a b c -> (Op2, Type) trOp2 = \case @@ -261,7 +261,7 @@ trOp2 = \case -- C.BwShiftL t _ -> -- C.BwShiftR t _ -> - _ -> error "Unsupported binary operator in input." -- TODO(chathhorn) + _ -> error "Unsupported binary operator in input." trType :: C.Type a -> Type trType = \case From b9ec45b27b4c10373284065d02c2a1bf13f3786c Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:51:02 -0400 Subject: [PATCH 0198/1222] Style: remove trailing spaces. Refs #316. According to our style guide, trailing spaces at the end of lines are not allowed. --- copilot-libraries/src/Copilot/Library/Clocks.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/copilot-libraries/src/Copilot/Library/Clocks.hs b/copilot-libraries/src/Copilot/Library/Clocks.hs index f888ec6db..b9388c8e8 100644 --- a/copilot-libraries/src/Copilot/Library/Clocks.hs +++ b/copilot-libraries/src/Copilot/Library/Clocks.hs @@ -1,4 +1,4 @@ --- | +-- | -- Module: Clocks -- Description: Clocks based on a base period and phase -- Copyright: (c) 2011 National Institute of Aerospace / Galois, Inc. @@ -85,7 +85,7 @@ clk1 ( Period period' ) ( Phase phase' ) = badUsage ( "clk1: clock phase must be less than period") else let counter = [ P.fromInteger 0 ] - ++ mux ( counter /= ( constant $ + ++ mux ( counter /= ( constant $ period' P.- 1 ) ) ( counter P.+ 1 ) ( 0 ) From 35828198bf3f7a2bf32a49e977442bf29fae3bbb Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:51:02 -0400 Subject: [PATCH 0199/1222] Style: remove trailing spaces. Refs #316. According to our style guide, trailing spaces at the end of lines are not allowed. --- copilot-libraries/src/Copilot/Library/LTL.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot-libraries/src/Copilot/Library/LTL.hs b/copilot-libraries/src/Copilot/Library/LTL.hs index 1b4c2a18a..5d2bedc2d 100644 --- a/copilot-libraries/src/Copilot/Library/LTL.hs +++ b/copilot-libraries/src/Copilot/Library/LTL.hs @@ -1,4 +1,4 @@ --- | +-- | -- Module: LTL -- Description: Bounded Linear Temporal Logic (LTL) operators -- Copyright: (c) 2011 National Institute of Aerospace / Galois, Inc. From 1cb37ec0c967793ed4db9062d031bc9f6b22a902 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:51:02 -0400 Subject: [PATCH 0200/1222] Style: remove trailing spaces. Refs #316. According to our style guide, trailing spaces at the end of lines are not allowed. --- copilot-libraries/src/Copilot/Library/PTLTL.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot-libraries/src/Copilot/Library/PTLTL.hs b/copilot-libraries/src/Copilot/Library/PTLTL.hs index 1fae57473..ce697677e 100644 --- a/copilot-libraries/src/Copilot/Library/PTLTL.hs +++ b/copilot-libraries/src/Copilot/Library/PTLTL.hs @@ -1,4 +1,4 @@ --- | +-- | -- Module: PTLTL -- Description: Past-Time Linear-Temporal Logic -- Copyright: (c) 2011 National Institute of Aerospace / Galois, Inc. From 6bae9e7b34c6a58b1e322957a336f00fe0b5a351 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:51:02 -0400 Subject: [PATCH 0201/1222] Style: remove trailing spaces. Refs #316. According to our style guide, trailing spaces at the end of lines are not allowed. --- .../src/Copilot/Library/Stacks.hs | 26 +++++++++---------- 1 file changed, 13 insertions(+), 13 deletions(-) diff --git a/copilot-libraries/src/Copilot/Library/Stacks.hs b/copilot-libraries/src/Copilot/Library/Stacks.hs index 3dd33b0b7..29c77cf09 100644 --- a/copilot-libraries/src/Copilot/Library/Stacks.hs +++ b/copilot-libraries/src/Copilot/Library/Stacks.hs @@ -1,8 +1,8 @@ --- | +-- | -- Module: Stacks -- Description: Stream for a stack machine -- Copyright: (c) 2011 National Institute of Aerospace / Galois, Inc. --- +-- -- This is a stream for a stack machine. -- -- The stack is created from a specified depth, a specified start value, and @@ -15,21 +15,21 @@ -- -- In 'stack' the push signal takes priority over the pop signal in the event -- that both are true in the same tick. This priority is reversed in 'stack''. --- +-- -- Here is an example sequence with one stack of each type, both depth 3 and -- starting value 0: -- --- @ --- popSignal: pushSignal: pushValue: stack: stack': --- false true 100 0 0 --- false true 101 100 100 --- true true 102 101 101 --- true false 103 100 102 --- true false 104 0 101 --- true false 105 0 100 --- true false 106 0 0 -- @ --- +-- popSignal: pushSignal: pushValue: stack: stack': +-- false true 100 0 0 +-- false true 101 100 100 +-- true true 102 101 101 +-- true false 103 100 102 +-- true false 104 0 101 +-- true false 105 0 100 +-- true false 106 0 0 +-- @ +-- -- Note the difference at the 4th tick after /popSignal/ and /pushSignal/ were -- both true. Note also that one cannot pop the start value off the stack - -- that is, the stack is never empty. From e99fa2a1cb458fe13cfb0728ae0a8b245a408a2b Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:51:02 -0400 Subject: [PATCH 0202/1222] Style: remove trailing spaces. Refs #316. According to our style guide, trailing spaces at the end of lines are not allowed. --- copilot-libraries/src/Copilot/Library/Statistics.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/copilot-libraries/src/Copilot/Library/Statistics.hs b/copilot-libraries/src/Copilot/Library/Statistics.hs index 7a1a57ffb..c2f2a9151 100644 --- a/copilot-libraries/src/Copilot/Library/Statistics.hs +++ b/copilot-libraries/src/Copilot/Library/Statistics.hs @@ -1,4 +1,4 @@ --- | +-- | -- Module: Statistics -- Description: Basic bounded statistics -- Copyright: (c) 2011 National Institute of Aerospace / Galois, Inc. @@ -36,6 +36,6 @@ mean n s = ( sum n s ) / ( fromIntegral n ) -- | Mean value over the current set of streams passed in. meanNow :: ( Typed a, Integral a ) => [ Stream a ] -> Stream a -meanNow [] = +meanNow [] = badUsage "list of arguments to meanNow must be nonempty" meanNow ls = ( foldl1 (+) ls ) `div` ( fromIntegral $ length ls ) From 6108a76b7f0edb375ebedaafe251909bbe5f40a5 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:51:02 -0400 Subject: [PATCH 0203/1222] Style: remove trailing spaces. Refs #316. According to our style guide, trailing spaces at the end of lines are not allowed. --- copilot-libraries/src/Copilot/Library/Voting.hs | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/copilot-libraries/src/Copilot/Library/Voting.hs b/copilot-libraries/src/Copilot/Library/Voting.hs index fb940b077..84ebec194 100644 --- a/copilot-libraries/src/Copilot/Library/Voting.hs +++ b/copilot-libraries/src/Copilot/Library/Voting.hs @@ -1,4 +1,4 @@ --- | +-- | -- Module: Voting -- Description: Implementation of the Boyer-Moore Majority Vote Algorithm -- Copyright: (c) 2011 National Institute of Aerospace / Galois, Inc. @@ -34,7 +34,7 @@ {-# LANGUAGE RebindableSyntax #-} -module Copilot.Library.Voting +module Copilot.Library.Voting ( majority, aMajority ) where import Copilot.Language @@ -53,11 +53,11 @@ majority' :: (P.Eq a, Typed a) majority' [] can _ = can majority' (x:xs) can cnt = local (cnt == 0) inZero - where + where inZero zero = local (if zero then x else can) inCan - where + where inCan can' = local (if zero || x == can then cnt+1 else cnt-1) inCnt - where + where inCnt cnt' = majority' xs can' cnt' -- | Majority vote second pass: checking that a candidate indeed has more than From 4b92dd3b039813d16160cc2587d6f4845364f224 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:51:02 -0400 Subject: [PATCH 0204/1222] Style: remove trailing spaces. Refs #316. According to our style guide, trailing spaces at the end of lines are not allowed. --- copilot/examples/Engine.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot/examples/Engine.hs b/copilot/examples/Engine.hs index de3c5f4fb..e3211ec6b 100644 --- a/copilot/examples/Engine.hs +++ b/copilot/examples/Engine.hs @@ -27,7 +27,7 @@ engineMonitor = do exceed = map (> 250) vals maj = majority exceed checkMaj = aMajority exceed maj - ok = alwaysBeen ((maj && checkMaj) ==> extern "cooler" cooler) + ok = alwaysBeen ((maj && checkMaj) ==> extern "cooler" cooler) two51 = Just $ [251, 251] P.++ repeat (250 :: Word8) zero = Just $ repeat (0 :: Word8) From 01a7a73bd1dcaeaac87127b5568708917669f569 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:55:01 -0400 Subject: [PATCH 0205/1222] Style: remove trailing empty lines. Refs #316. According to our style guide, trailing spaces at the end of the file are not allowed. --- copilot-c99/src/Copilot/Compile/C99/CodeGen.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs b/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs index 09ee82282..e1dca4c87 100644 --- a/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs +++ b/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs @@ -174,4 +174,3 @@ gatherexprs streams triggers = map streamexpr streams ++ concatMap triggerexpr triggers where streamexpr (Stream _ _ expr ty) = UExpr ty expr triggerexpr (Trigger _ guard args) = UExpr Bool guard : args - From 7701620697dea458491ee9ad3b3bc0dec0b519ff Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:55:01 -0400 Subject: [PATCH 0206/1222] Style: remove trailing empty lines. Refs #316. According to our style guide, trailing spaces at the end of the file are not allowed. --- copilot-libraries/src/Copilot/Library/Libraries.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/copilot-libraries/src/Copilot/Library/Libraries.hs b/copilot-libraries/src/Copilot/Library/Libraries.hs index f6cd58a62..f378063bb 100644 --- a/copilot-libraries/src/Copilot/Library/Libraries.hs +++ b/copilot-libraries/src/Copilot/Library/Libraries.hs @@ -26,4 +26,3 @@ import Copilot.Library.RegExp import Copilot.Library.Utils import Copilot.Library.Voting import Copilot.Library.Stacks - From 83457172385d6003e908cce904eb88a28f4227e6 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:55:01 -0400 Subject: [PATCH 0207/1222] Style: remove trailing empty lines. Refs #316. According to our style guide, trailing spaces at the end of the file are not allowed. --- copilot-theorem/examples/Trig.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/copilot-theorem/examples/Trig.hs b/copilot-theorem/examples/Trig.hs index d18e68bac..3b09cb89f 100644 --- a/copilot-theorem/examples/Trig.hs +++ b/copilot-theorem/examples/Trig.hs @@ -77,4 +77,3 @@ spec = do d1 = acos ((sin lat1) * (sin lat2) + (cos lat1) * (cos lat2) * (cos (lon1 - lon2))) d2 = 2 * asin (sqrt ( (sin ((lat1 - lat2)/2)) ** 2 + (cos lat1) * (cos lat2) * ((sin ((lon1 - lon2)/2)) ** 2))) - From 75130f33c9bbdf21c2353326e6a263e962cb379e Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:55:01 -0400 Subject: [PATCH 0208/1222] Style: remove trailing empty lines. Refs #316. According to our style guide, trailing spaces at the end of the file are not allowed. --- copilot-theorem/examples/WCV.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/copilot-theorem/examples/WCV.hs b/copilot-theorem/examples/WCV.hs index 8eb2a493c..f72fae409 100644 --- a/copilot-theorem/examples/WCV.hs +++ b/copilot-theorem/examples/WCV.hs @@ -193,4 +193,3 @@ arith = onlyValidity def { nraNLSat = True, debug = False } arithSat :: Proof Existential arithSat = onlySat def { nraNLSat = True, debug = False } - From a7a435f2719292995141c14d8b61bdb64a68e195 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:55:01 -0400 Subject: [PATCH 0209/1222] Style: remove trailing empty lines. Refs #316. According to our style guide, trailing spaces at the end of the file are not allowed. --- copilot-theorem/src/Copilot/Theorem/IL/Transform.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/copilot-theorem/src/Copilot/Theorem/IL/Transform.hs b/copilot-theorem/src/Copilot/Theorem/IL/Transform.hs index 493c02259..4bdaa47f3 100644 --- a/copilot-theorem/src/Copilot/Theorem/IL/Transform.hs +++ b/copilot-theorem/src/Copilot/Theorem/IL/Transform.hs @@ -45,4 +45,3 @@ bsimpl = until (\x -> bsimpl' x == x) bsimpl' FunApp t f args -> FunApp t f (map bsimpl' args) e -> e - From a608e28d5fff1845c340209a2223711523db8cca Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:55:01 -0400 Subject: [PATCH 0210/1222] Style: remove trailing empty lines. Refs #316. According to our style guide, trailing spaces at the end of the file are not allowed. --- copilot-theorem/src/Copilot/Theorem/IL/Translate.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/copilot-theorem/src/Copilot/Theorem/IL/Translate.hs b/copilot-theorem/src/Copilot/Theorem/IL/Translate.hs index 53e6676d7..b3a4f73f6 100644 --- a/copilot-theorem/src/Copilot/Theorem/IL/Translate.hs +++ b/copilot-theorem/src/Copilot/Theorem/IL/Translate.hs @@ -326,4 +326,3 @@ runTrans :: Bool -> Trans a -> a runTrans b m = evalState m $ TransST [] [] 0 b -------------------------------------------------------------------------------- - From 62994686e6d7577f754bd51d3c6d61e202bdb031 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:55:01 -0400 Subject: [PATCH 0211/1222] Style: remove trailing empty lines. Refs #316. According to our style guide, trailing spaces at the end of the file are not allowed. --- copilot-theorem/src/Copilot/Theorem/Prover/SMTIO.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/copilot-theorem/src/Copilot/Theorem/Prover/SMTIO.hs b/copilot-theorem/src/Copilot/Theorem/Prover/SMTIO.hs index ee7c92cc0..08a4acb4f 100644 --- a/copilot-theorem/src/Copilot/Theorem/Prover/SMTIO.hs +++ b/copilot-theorem/src/Copilot/Theorem/Prover/SMTIO.hs @@ -124,4 +124,3 @@ declVars s@(Solver { vars }) decls = do return s { vars = vars `union` fromList newVars } -------------------------------------------------------------------------------- - From 89aa09c950338e2dc1a53ab0a7290391de7719a6 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 16:55:01 -0400 Subject: [PATCH 0212/1222] Style: remove trailing empty lines. Refs #316. According to our style guide, trailing spaces at the end of the file are not allowed. --- copilot-theorem/src/Copilot/Theorem/Prover/Z3.hs | 2 -- 1 file changed, 2 deletions(-) diff --git a/copilot-theorem/src/Copilot/Theorem/Prover/Z3.hs b/copilot-theorem/src/Copilot/Theorem/Prover/Z3.hs index 9ceb6d9b7..7c78b28ec 100644 --- a/copilot-theorem/src/Copilot/Theorem/Prover/Z3.hs +++ b/copilot-theorem/src/Copilot/Theorem/Prover/Z3.hs @@ -546,5 +546,3 @@ instance (SMTBackend b m,MonadIO m) => SMTBackend (DebugBackend b) m where liftIO $ unless (mute b) $ hPutStrLn (debugHandle b) str when (debugUseColor b) $ liftIO $ hSetSGR (debugHandle b) [Reset] return (resp,b { debugBackend = b2, debugLines = nline }) - - From 9a5a930c9b671f6aaa7ef1aad3af3f68b498891a Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:03:30 -0400 Subject: [PATCH 0213/1222] Style: squash multiple consecutive empty lines. Refs #316. According to our style guide, there should only be one empty line (at most) between two lines of code.. --- copilot-c99/src/Copilot/Compile/C99/CodeGen.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs b/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs index e1dca4c87..8b3fee912 100644 --- a/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs +++ b/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs @@ -131,7 +131,6 @@ mkstep cSettings streams triggers exts = memcpy :: C.Expr -> C.Expr -> C.Expr -> C.Expr memcpy dest src size = C.Funcall (C.Ident "memcpy") [dest, src, size] - -- | Write a struct declaration based on its definition. mkstructdecln :: Struct a => Type a -> C.Decln mkstructdecln (Struct x) = C.TypeDecln struct where From 1541045a451c35b948bdc82a928240f84015c7a4 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:03:30 -0400 Subject: [PATCH 0214/1222] Style: squash multiple consecutive empty lines. Refs #316. According to our style guide, there should only be one empty line (at most) between two lines of code.. --- copilot-c99/src/Copilot/Compile/C99/Translate.hs | 2 -- 1 file changed, 2 deletions(-) diff --git a/copilot-c99/src/Copilot/Compile/C99/Translate.hs b/copilot-c99/src/Copilot/Compile/C99/Translate.hs index 6ce0c4aa8..4e9c0804b 100644 --- a/copilot-c99/src/Copilot/Compile/C99/Translate.hs +++ b/copilot-c99/src/Copilot/Compile/C99/Translate.hs @@ -48,7 +48,6 @@ transexpr (Op3 op e1 e2 e3) = do e3' <- transexpr e3 return $ transop3 op e1' e2' e3' - -- | Translates a Copilot unary operator and its argument into a C99 -- expression. transop1 :: Op1 a b -> C.Expr -> C.Expr @@ -229,7 +228,6 @@ constfieldinit (Value ty (Field val)) = constinit ty val constarray :: Type a -> [a] -> [C.Init] constarray ty = map (constinit ty) - -- | Explicitly cast a C99 value to a type. explicitty :: Type a -> C.Expr -> C.Expr explicitty ty = C.Cast (transtypename ty) From 8658d88ed96abdebf017f16ec572a3163956c22a Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:03:30 -0400 Subject: [PATCH 0215/1222] Style: squash multiple consecutive empty lines. Refs #316. According to our style guide, there should only be one empty line (at most) between two lines of code.. --- copilot-core/src/Copilot/Core/Interpret/Render.hs | 2 -- 1 file changed, 2 deletions(-) diff --git a/copilot-core/src/Copilot/Core/Interpret/Render.hs b/copilot-core/src/Copilot/Core/Interpret/Render.hs index 23b3a4fc5..2c73313ea 100644 --- a/copilot-core/src/Copilot/Core/Interpret/Render.hs +++ b/copilot-core/src/Copilot/Core/Interpret/Render.hs @@ -99,8 +99,6 @@ step ExecTrace -------------------------------------------------------------------------------- - - -- Copied from pretty-ncols because of incompatibility with newer GHC versions. asColumns :: [[Doc]] -> Doc asColumns = flip asColumnsWithBuff $ 1 From 47983c84d63c53aa35da0a8da92a4ade79bff64c Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:03:30 -0400 Subject: [PATCH 0216/1222] Style: squash multiple consecutive empty lines. Refs #316. According to our style guide, there should only be one empty line (at most) between two lines of code.. --- copilot-core/src/Copilot/Core/PrettyDot.hs | 2 -- 1 file changed, 2 deletions(-) diff --git a/copilot-core/src/Copilot/Core/PrettyDot.hs b/copilot-core/src/Copilot/Core/PrettyDot.hs index 68dca32e2..9d00154e5 100644 --- a/copilot-core/src/Copilot/Core/PrettyDot.hs +++ b/copilot-core/src/Copilot/Core/PrettyDot.hs @@ -240,7 +240,6 @@ ppProperty i -------------------------------------------------------------------------------- - -------------------------------------------------------------------------------- -- | Pretty print a list of streams as a GraphViz graph part. @@ -280,7 +279,6 @@ ppObserverL i (a:b) = ((s1$$s2),(i2)) (s1,i1) = ppObserver i a (s2,i2) = ppObserverL i1 b - -------------------------------------------------------------------------------- -- | Pretty print a list of properties as a GraphViz graph part. From fd5993c48635d4fd5617083df199e6dd2a7a3784 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:03:30 -0400 Subject: [PATCH 0217/1222] Style: squash multiple consecutive empty lines. Refs #316. According to our style guide, there should only be one empty line (at most) between two lines of code.. --- copilot-core/src/Copilot/Core/Type/Array.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/copilot-core/src/Copilot/Core/Type/Array.hs b/copilot-core/src/Copilot/Core/Type/Array.hs index 91ae0adad..bfb3f2b3f 100644 --- a/copilot-core/src/Copilot/Core/Type/Array.hs +++ b/copilot-core/src/Copilot/Core/Type/Array.hs @@ -46,7 +46,6 @@ array xs | datalen == typelen = Array xs errmsg = "Length of data (" ++ show datalen ++ ") does not match length of type (" ++ show typelen ++ ")." - -- | Association between an array and the type of the elements it contains. type family InnerType x where InnerType (Array _ x) = InnerType x From e3b80c0828b16867ad856699ebd5c9b55af0bf13 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:03:30 -0400 Subject: [PATCH 0218/1222] Style: squash multiple consecutive empty lines. Refs #316. According to our style guide, there should only be one empty line (at most) between two lines of code.. --- copilot-language/src/Copilot/Language/Analyze.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/copilot-language/src/Copilot/Language/Analyze.hs b/copilot-language/src/Copilot/Language/Analyze.hs index f267cfa1f..fe93ab741 100644 --- a/copilot-language/src/Copilot/Language/Analyze.hs +++ b/copilot-language/src/Copilot/Language/Analyze.hs @@ -214,7 +214,6 @@ analyzeDrop k (Append xs _ _) | otherwise = return () analyzeDrop _ _ = throw DropAppliedToNonAppend - -------------------------------------------------------------------------------- -- Analyzing external variables. We check that every reference to an external -- variable has the same type, and for external functions, they have the same From cc8410b6b1361be01a89c7fd3d5367036cfd3c19 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:03:30 -0400 Subject: [PATCH 0219/1222] Style: squash multiple consecutive empty lines. Refs #316. According to our style guide, there should only be one empty line (at most) between two lines of code.. --- copilot-language/src/Copilot/Language/Operators/Constant.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/copilot-language/src/Copilot/Language/Operators/Constant.hs b/copilot-language/src/Copilot/Language/Operators/Constant.hs index 4c8c97c95..060477e86 100644 --- a/copilot-language/src/Copilot/Language/Operators/Constant.hs +++ b/copilot-language/src/Copilot/Language/Operators/Constant.hs @@ -4,7 +4,6 @@ {-# LANGUAGE Safe #-} - -- | Primitives to build constant streams. module Copilot.Language.Operators.Constant ( constant From 0725ee14213e237dcf6f2cd3993b43a0b0d4022a Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:03:30 -0400 Subject: [PATCH 0220/1222] Style: squash multiple consecutive empty lines. Refs #316. According to our style guide, there should only be one empty line (at most) between two lines of code.. --- copilot-language/src/Copilot/Language/Operators/Temporal.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/copilot-language/src/Copilot/Language/Operators/Temporal.hs b/copilot-language/src/Copilot/Language/Operators/Temporal.hs index 852473985..1295fc19f 100644 --- a/copilot-language/src/Copilot/Language/Operators/Temporal.hs +++ b/copilot-language/src/Copilot/Language/Operators/Temporal.hs @@ -2,7 +2,6 @@ -- Copyright © 2011 National Institute of Aerospace / Galois, Inc. -------------------------------------------------------------------------------- - {-# LANGUAGE Safe #-} -- | Temporal stream transformations. From 799df7cd08751f209a2efa8436a35b0688d737e6 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:03:30 -0400 Subject: [PATCH 0221/1222] Style: squash multiple consecutive empty lines. Refs #316. According to our style guide, there should only be one empty line (at most) between two lines of code.. --- copilot-language/src/Copilot/Language/Stream.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/copilot-language/src/Copilot/Language/Stream.hs b/copilot-language/src/Copilot/Language/Stream.hs index 43478c48f..4cf042588 100644 --- a/copilot-language/src/Copilot/Language/Stream.hs +++ b/copilot-language/src/Copilot/Language/Stream.hs @@ -176,7 +176,6 @@ ceiling = Op1 (Core.Ceiling typeOf) floor :: (Typed a, RealFrac a) => Stream a -> Stream a floor = Op1 (Core.Floor typeOf) - -------------------------------------------------------------------------------- -- | Point-wise application of @atan2@ to the values of two streams. From 89ab41ed43a911b3c1893b9b79f16a3b930a5205 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:03:30 -0400 Subject: [PATCH 0222/1222] Style: squash multiple consecutive empty lines. Refs #316. According to our style guide, there should only be one empty line (at most) between two lines of code.. --- copilot-language/tests/Test/Copilot/Language/Reify.hs | 2 -- 1 file changed, 2 deletions(-) diff --git a/copilot-language/tests/Test/Copilot/Language/Reify.hs b/copilot-language/tests/Test/Copilot/Language/Reify.hs index 062a9d778..eb0791cc2 100644 --- a/copilot-language/tests/Test/Copilot/Language/Reify.hs +++ b/copilot-language/tests/Test/Copilot/Language/Reify.hs @@ -116,10 +116,8 @@ arbitrarySemanticsP = oneof , SemanticsP <$> (arbitraryBitsIntegralExpr :: Gen (Semantics Word64)) ] - -- ** Random Stream generators - -- | An arbitrary constant expression of any type, paired with its expected -- meaning. arbitraryConst :: (Arbitrary t, Typed t) From ac5d0e927a54082d229af2d23058b0ed24c19801 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:03:30 -0400 Subject: [PATCH 0223/1222] Style: squash multiple consecutive empty lines. Refs #316. According to our style guide, there should only be one empty line (at most) between two lines of code.. --- copilot-libraries/src/Copilot/Library/Clocks.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/copilot-libraries/src/Copilot/Library/Clocks.hs b/copilot-libraries/src/Copilot/Library/Clocks.hs index b9388c8e8..694c631f3 100644 --- a/copilot-libraries/src/Copilot/Library/Clocks.hs +++ b/copilot-libraries/src/Copilot/Library/Clocks.hs @@ -69,7 +69,6 @@ clk ( Period period' ) ( Phase phase' ) = clk' $ period' P.- phase' P.- 1 ) False ++ clk' - -- | This follows the same convention as 'clk', but uses a counter variable of -- integral type /a/ rather than an array. clk1 :: ( Integral a, Typed a ) => From 536ee5a67d1f4c3956b19aeef4500e7f786be1d2 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:03:30 -0400 Subject: [PATCH 0224/1222] Style: squash multiple consecutive empty lines. Refs #316. According to our style guide, there should only be one empty line (at most) between two lines of code.. --- copilot-libraries/src/Copilot/Library/LTL.hs | 5 ----- 1 file changed, 5 deletions(-) diff --git a/copilot-libraries/src/Copilot/Library/LTL.hs b/copilot-libraries/src/Copilot/Library/LTL.hs index 5d2bedc2d..40caab2b6 100644 --- a/copilot-libraries/src/Copilot/Library/LTL.hs +++ b/copilot-libraries/src/Copilot/Library/LTL.hs @@ -45,7 +45,6 @@ module Copilot.Library.LTL import Copilot.Language import Copilot.Library.Utils - -- | Property @s@ holds at the next period. For example: -- -- @ @@ -57,7 +56,6 @@ import Copilot.Library.Utils next :: Stream Bool -> Stream Bool next = drop ( 1 :: Int ) - -- | Property @s@ holds for the next @n@ periods. We require @n >= 0@. If @n == -- 0@, then @s@ holds in the current period, e.g., if @p = always 2 s@, then we -- have the following relationship between the streams generated: @@ -72,7 +70,6 @@ next = drop ( 1 :: Int ) always :: ( Integral a ) => a -> Stream Bool -> Stream Bool always n = nfoldl1 ( fromIntegral n + 1 ) (&&) - -- | Property @s@ holds at some period in the next @n@ periods. If @n == 0@, -- then @s@ holds in the current period. We require @n >= 0@. E.g., if @p = -- eventually 2 s@, then we have the following relationship between the streams @@ -90,7 +87,6 @@ eventually :: ( Integral a ) => -> Stream Bool eventually n = nfoldl1 ( fromIntegral n + 1 ) (||) - -- | @until n s0 s1@ means that @eventually n s1@, and up until at least the -- period before @s1@ holds, @s0@ continuously holds. -- @@ -104,7 +100,6 @@ until n s0 s1 = foldl (||) s1 v0 | i <- [ 0 .. n' - 1 ] ] - -- | @release n s0 s1@ means that either @always n s1@, or @s1@ holds up to and -- including the period at which @s0@ becomes true. -- From d41a6f1f47d509b0a5d707810bf7bdbff22748b5 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:03:30 -0400 Subject: [PATCH 0225/1222] Style: squash multiple consecutive empty lines. Refs #316. According to our style guide, there should only be one empty line (at most) between two lines of code.. --- copilot-libraries/src/Copilot/Library/PTLTL.hs | 3 --- 1 file changed, 3 deletions(-) diff --git a/copilot-libraries/src/Copilot/Library/PTLTL.hs b/copilot-libraries/src/Copilot/Library/PTLTL.hs index ce697677e..4783f2919 100644 --- a/copilot-libraries/src/Copilot/Library/PTLTL.hs +++ b/copilot-libraries/src/Copilot/Library/PTLTL.hs @@ -27,19 +27,16 @@ import Copilot.Language previous :: Stream Bool -> Stream Bool previous s = [ False ] ++ s - -- | Has @s@ always held (up to and including the current state)? alwaysBeen :: Stream Bool -> Stream Bool alwaysBeen s = s && tmp where tmp = [ True ] ++ s && tmp - -- | Did @s@ hold at some time in the past (including the current state)? eventuallyPrev :: Stream Bool -> Stream Bool eventuallyPrev s = s || tmp where tmp = [ False ] ++ s || tmp - -- | Once @s2@ holds, in the following state (period), does @s1@ continuously hold? since :: Stream Bool -> Stream Bool -> Stream Bool since s1 s2 = alwaysBeen ( tmp ==> s1 ) From 858c692aecabd5e5e10ef8c07bc1251743641c01 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:03:30 -0400 Subject: [PATCH 0226/1222] Style: squash multiple consecutive empty lines. Refs #316. According to our style guide, there should only be one empty line (at most) between two lines of code.. --- .../src/Copilot/Library/RegExp.hs | 23 ------------------- 1 file changed, 23 deletions(-) diff --git a/copilot-libraries/src/Copilot/Library/RegExp.hs b/copilot-libraries/src/Copilot/Library/RegExp.hs index 712d44726..174bfb9b9 100644 --- a/copilot-libraries/src/Copilot/Library/RegExp.hs +++ b/copilot-libraries/src/Copilot/Library/RegExp.hs @@ -52,7 +52,6 @@ data RegExp t = REpsilon | RStar ( RegExp t ) deriving Show - -- | Parsers for single characters. lquote, rquote, lparen, rparen, star, plus, qmark, point, minus, @@ -76,7 +75,6 @@ followedBy :: GenParser tok () a -> GenParser tok () a followedBy p p' = p >>= \ r -> p' >> return r - -- | Parsing a string p' with prefix p, returning both in order. cPrefix, optCPrefix :: GenParser tok () Char -> GenParser tok () String @@ -96,7 +94,6 @@ optCPrefix p p' = optionMaybe p ci :: String -> GenParser Char () String ci = mapM ( \ c -> ( char . toLower ) c <|> ( char . toUpper ) c ) - -- | Parser for regular expressions regexp :: ( SymbolParser t ) => GenParser Char () ( RegExp t ) regexp = chainr1 term opOr @@ -116,11 +113,9 @@ factor' = between lparen rparen regexp anySym :: ( SymbolParser t ) => GenParser Char () ( RegExp t ) anySym = point >> ( return . RSymbol ) ( NumSym Nothing Any ) - class SymbolParser t where parseSym :: GenParser Char () ( RegExp t ) - instance SymbolParser Bool where parseSym = do { truth <- ( ci "t" >> optional ( ci "rue" ) >> return True ) @@ -131,7 +126,6 @@ instance SymbolParser Bool where ; return $ RSymbol ( NumSym Nothing $ Sym truth ) } - parseWordSym :: ( Integral t ) => GenParser Char () ( RegExp t ) parseWordSym = do { num <- between lquote rquote $ many1 digit @@ -147,12 +141,10 @@ parseIntSym = do { num <- between lquote rquote $ $ fromIntegral ( read num :: Integer ) } - type StreamName = String newtype P = P { getName :: StreamName } deriving Eq - parsePSym :: GenParser Char () ( RegExp P ) parsePSym = do { pStream <- between lquote rquote $ cPrefix nondigit ( many $ nondigit <|> digit ) @@ -160,7 +152,6 @@ parsePSym = do { pStream <- between lquote rquote $ $ P pStream } - instance SymbolParser Word8 where parseSym = parseWordSym @@ -188,7 +179,6 @@ instance SymbolParser Int64 where instance SymbolParser P where parseSym = parsePSym - opOr :: GenParser Char () ( RegExp t -> RegExp t -> RegExp t ) opOr = char '|' >> return ROr @@ -213,7 +203,6 @@ parser :: ( SymbolParser t ) => GenParser Char () ( RegExp t ) parser = regexp `followedBy` eof - hasEpsilon :: RegExp t -> Bool hasEpsilon REpsilon = True hasEpsilon ( RSymbol _ ) = False @@ -221,7 +210,6 @@ hasEpsilon ( ROr r1 r2 ) = hasEpsilon r1 || hasEpsilon r2 hasEpsilon ( RConcat r1 r2 ) = hasEpsilon r1 && hasEpsilon r2 hasEpsilon ( RStar _ ) = True - first :: RegExp t -> [ NumSym t ] first REpsilon = [] first ( RSymbol s ) = [ s ] @@ -230,18 +218,15 @@ first ( RConcat r1 r2 ) = first r1 ++ if hasEpsilon r1 then first r2 else [] first ( RStar r ) = first r - reverse' :: RegExp t -> RegExp t reverse' ( ROr r1 r2 ) = ROr ( reverse' r1 ) ( reverse' r2 ) reverse' ( RConcat r1 r2 ) = RConcat ( reverse' r2 ) ( reverse' r1 ) reverse' ( RStar r ) = RStar ( reverse' r ) reverse' e = e - last' :: RegExp t -> [ NumSym t ] last' = first . reverse' - follow :: ( Eq t ) => RegExp t -> NumSym t -> [ NumSym t ] follow REpsilon _ = [] @@ -254,18 +239,15 @@ follow ( RStar r ) sNr = follow r sNr `union` if sNr `elem` last' r then first r else [] - preceding :: ( Eq t ) => RegExp t -> NumSym t -> [ NumSym t ] preceding = follow . reverse' - hasFinitePath :: RegExp t -> Bool hasFinitePath ( ROr r1 r2 ) = hasFinitePath r1 || hasFinitePath r2 hasFinitePath ( RConcat _ r2 ) = hasFinitePath r2 hasFinitePath ( RStar _ ) = False hasFinitePath _ = True - getSymbols :: RegExp t -> [ NumSym t ] getSymbols ( RSymbol s ) = [ s ] getSymbols ( ROr r1 r2 ) = getSymbols r1 ++ getSymbols r2 @@ -273,7 +255,6 @@ getSymbols ( RConcat r1 r2 ) = getSymbols r1 ++ getSymbols r2 getSymbols ( RStar r ) = getSymbols r getSymbols _ = [] - -- assign each symbol in the regular expression a -- unique number, counting up from 0 enumSyms :: RegExp t -> RegExp t @@ -297,7 +278,6 @@ enumSyms rexp = evalState ( enumSyms' rexp ) 0 enumSyms' other = return other - regexp2CopilotNFA :: ( C.Typed t, Eq t ) => C.Stream t -> RegExp t -> C.Stream Bool -> C.Stream Bool regexp2CopilotNFA inStream rexp reset = @@ -330,7 +310,6 @@ regexp2CopilotNFA inStream rexp reset = in outStream - -- | Regular expression matching over an arbitrary stream copilotRegexp :: ( C.Typed t, SymbolParser t, Eq t ) => C.Stream t -- ^ The stream to monitor. @@ -356,7 +335,6 @@ copilotRegexp inStream rexp reset = , "a distinct end-of-input symbol." ] else regexp2CopilotNFA inStream nrexp reset - regexp2CopilotNFAB :: RegExp P -> [ ( StreamName, C.Stream Bool ) ] -> C.Stream Bool -> C.Stream Bool regexp2CopilotNFAB rexp propositions reset = @@ -395,7 +373,6 @@ regexp2CopilotNFAB rexp propositions reset = in outStream - -- | Regular expression matching over a collection of boolean streams. -- -- Regular expressions can contain symbols, which are expanded to match From 712223e4240eb9f4dea780efcc8e304949b07181 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:03:30 -0400 Subject: [PATCH 0227/1222] Style: squash multiple consecutive empty lines. Refs #316. According to our style guide, there should only be one empty line (at most) between two lines of code.. --- copilot-libraries/src/Copilot/Library/Utils.hs | 2 -- 1 file changed, 2 deletions(-) diff --git a/copilot-libraries/src/Copilot/Library/Utils.hs b/copilot-libraries/src/Copilot/Library/Utils.hs index 1e31b71b3..58d601386 100644 --- a/copilot-libraries/src/Copilot/Library/Utils.hs +++ b/copilot-libraries/src/Copilot/Library/Utils.hs @@ -27,7 +27,6 @@ tails :: ( Typed a ) => Stream a -> [ Stream a ] tails s = [ drop x s | x <- [ 0 .. ] ] - -- | Given a stream and a number, produce a finite list of streams dropping an -- increasing number of elements of the given stream, up to that number. For -- example, for a given stream @s@, the expression @take 2 s@ is equal to @@ -118,7 +117,6 @@ nscanr1 :: ( Typed a ) -> Stream a -> [ Stream a ] nscanr1 n f s = scanr1 f $ take n s - -- | Case-like function: The index of the first predicate that is true -- in the predicate list selects the stream result. If no predicate -- is true, the last element is chosen (default element) From 1e41c1083195dba26332bd2abd3fea0725eb3cfb Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:03:30 -0400 Subject: [PATCH 0228/1222] Style: squash multiple consecutive empty lines. Refs #316. According to our style guide, there should only be one empty line (at most) between two lines of code.. --- copilot-theorem/examples/BoyerMoore.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/copilot-theorem/examples/BoyerMoore.hs b/copilot-theorem/examples/BoyerMoore.hs index 29032fadb..bf4d144d0 100644 --- a/copilot-theorem/examples/BoyerMoore.hs +++ b/copilot-theorem/examples/BoyerMoore.hs @@ -45,7 +45,6 @@ majorityVote (x : xs) = aux x 1 xs local (if s == 0 || l == p then s + 1 else s - 1) $ \s' -> aux p' s' ls - okWith :: forall a . (Typed a, Eq a) => Stream a -> [Stream a] -> Stream a -> Stream Bool From 1dbd641bd45d87a7f0482d402dc6104532830d9e Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:03:30 -0400 Subject: [PATCH 0229/1222] Style: squash multiple consecutive empty lines. Refs #316. According to our style guide, there should only be one empty line (at most) between two lines of code.. --- copilot-theorem/examples/Grey.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/copilot-theorem/examples/Grey.hs b/copilot-theorem/examples/Grey.hs index 184ce4c90..eb67b4046 100644 --- a/copilot-theorem/examples/Grey.hs +++ b/copilot-theorem/examples/Grey.hs @@ -15,7 +15,6 @@ intCounter reset = time time = if reset then 0 else [0] ++ if time == 3 then 0 else time + 1 - greyTick :: Stream Bool -> Stream Bool greyTick reset = a && b where From c616cfa4a6cc1cae3cf42ae33bd70f4456898e3d Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:03:30 -0400 Subject: [PATCH 0230/1222] Style: squash multiple consecutive empty lines. Refs #316. According to our style guide, there should only be one empty line (at most) between two lines of code.. --- copilot-theorem/examples/SerialBoyerMoore.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/copilot-theorem/examples/SerialBoyerMoore.hs b/copilot-theorem/examples/SerialBoyerMoore.hs index f8a2e69c3..050dde4b1 100644 --- a/copilot-theorem/examples/SerialBoyerMoore.hs +++ b/copilot-theorem/examples/SerialBoyerMoore.hs @@ -57,7 +57,6 @@ spec = do input = externW64 "in" (Just [1, 1, 2, 1, 2, 2, 1, 2, 2, 1, 2, 1]) (p, s, j) = majority input - -------------------------------------------------------------------------------- induct :: Proof Universal From 1be78bb81d575ab5155b338e00bd2cdecccfdf66 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:03:30 -0400 Subject: [PATCH 0231/1222] Style: squash multiple consecutive empty lines. Refs #316. According to our style guide, there should only be one empty line (at most) between two lines of code.. --- copilot-theorem/src/Copilot/Theorem/Kind2/Translate.hs | 2 -- 1 file changed, 2 deletions(-) diff --git a/copilot-theorem/src/Copilot/Theorem/Kind2/Translate.hs b/copilot-theorem/src/Copilot/Theorem/Kind2/Translate.hs index 2960777a7..01b9a0de7 100644 --- a/copilot-theorem/src/Copilot/Theorem/Kind2/Translate.hs +++ b/copilot-theorem/src/Copilot/Theorem/Kind2/Translate.hs @@ -89,7 +89,6 @@ trNode spec predCallsGraph node = ++ map (trExpr True) (nodeConstrs node) ++ predCalls False spec predCallsGraph node - addAssumptions :: TransSys -> [PropId] -> K.File -> K.File addAssumptions spec assumptions (K.File {K.filePreds, K.fileProps}) = K.File (changeTail aux filePreds) fileProps @@ -172,7 +171,6 @@ initLocals node = Expr e -> [mkEquality (trVar v) (trExpr False e)] Constrs cs -> map (trExpr False) cs - transLocals :: Node -> [K.Term] transLocals node = concatMap f (Map.toList $ nodeLocalVars node) From bdb3d260a67d95a15a9cf6804a6b93c48cf96a24 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:03:30 -0400 Subject: [PATCH 0232/1222] Style: squash multiple consecutive empty lines. Refs #316. According to our style guide, there should only be one empty line (at most) between two lines of code.. --- copilot-theorem/src/Copilot/Theorem/Misc/SExpr.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/copilot-theorem/src/Copilot/Theorem/Misc/SExpr.hs b/copilot-theorem/src/Copilot/Theorem/Misc/SExpr.hs index db5991f8b..5f95e01a4 100644 --- a/copilot-theorem/src/Copilot/Theorem/Misc/SExpr.hs +++ b/copilot-theorem/src/Copilot/Theorem/Misc/SExpr.hs @@ -48,7 +48,6 @@ instance Show (SExpr String) where show' (Atom s) = text s show' (List ts) = parens . hsep . map show' $ ts - -- More advanced printing with some basic indentation -- | Indent by a given number. From d244cddbf29b2c80386c3b4a0f01a703226ef57c Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:03:30 -0400 Subject: [PATCH 0233/1222] Style: squash multiple consecutive empty lines. Refs #316. According to our style guide, there should only be one empty line (at most) between two lines of code.. --- copilot-theorem/src/Copilot/Theorem/Prover/SMT.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/copilot-theorem/src/Copilot/Theorem/Prover/SMT.hs b/copilot-theorem/src/Copilot/Theorem/Prover/SMT.hs index 7aea30f4c..a1051d084 100644 --- a/copilot-theorem/src/Copilot/Theorem/Prover/SMT.hs +++ b/copilot-theorem/src/Copilot/Theorem/Prover/SMT.hs @@ -387,7 +387,6 @@ kInduction' startK maxK s as ps = (fromMaybe (Output P.Unknown ["proof by k-indu Unknown -> unknown Unsat -> valid $ "proved with " ++ proofKind k - onlySat' :: SmtFormat b => ProofState b -> [PropId] -> [PropId] -> IO Output onlySat' s as ps = (fromJust . fst) <$> runPS (script <* stopSolvers) s where From f4b710cbb66c7337bffad0754490c47c015490a3 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:03:30 -0400 Subject: [PATCH 0234/1222] Style: squash multiple consecutive empty lines. Refs #316. According to our style guide, there should only be one empty line (at most) between two lines of code.. --- copilot-theorem/src/Copilot/Theorem/TransSys/Operators.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/copilot-theorem/src/Copilot/Theorem/TransSys/Operators.hs b/copilot-theorem/src/Copilot/Theorem/TransSys/Operators.hs index 026761d00..5b6edbfd2 100644 --- a/copilot-theorem/src/Copilot/Theorem/TransSys/Operators.hs +++ b/copilot-theorem/src/Copilot/Theorem/TransSys/Operators.hs @@ -231,7 +231,6 @@ handleOp2 :: -> m (expr resT) - handleOp2 resT (op, e1, e2) handleExpr notHandledF mkOp notOp = case op of C.And -> boolConnector And From fffdc05b35a98209cd8fa849cc9dfa1bb70b3da4 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:03:30 -0400 Subject: [PATCH 0235/1222] Style: squash multiple consecutive empty lines. Refs #316. According to our style guide, there should only be one empty line (at most) between two lines of code.. --- copilot-theorem/src/Copilot/Theorem/TransSys/PrettyPrint.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/copilot-theorem/src/Copilot/Theorem/TransSys/PrettyPrint.hs b/copilot-theorem/src/Copilot/Theorem/TransSys/PrettyPrint.hs index 11de48ec7..f1f8a585c 100644 --- a/copilot-theorem/src/Copilot/Theorem/TransSys/PrettyPrint.hs +++ b/copilot-theorem/src/Copilot/Theorem/TransSys/PrettyPrint.hs @@ -101,7 +101,6 @@ pLVar l (VarDescr {varType, varDef}) = header $$ indent body <+> (hsep . punctuate (space <> text ";" <> space)) (map pExpr cs) <+> text "}" - pExpr :: Expr t -> Doc pExpr (Const t v) = pConst t v From dcec3732587d8a2f4d53c07c0a5ff9d9009d247a Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:03:30 -0400 Subject: [PATCH 0236/1222] Style: squash multiple consecutive empty lines. Refs #316. According to our style guide, there should only be one empty line (at most) between two lines of code.. --- copilot-theorem/src/Copilot/Theorem/TransSys/Spec.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/copilot-theorem/src/Copilot/Theorem/TransSys/Spec.hs b/copilot-theorem/src/Copilot/Theorem/TransSys/Spec.hs index 01270814e..2bc45b34e 100644 --- a/copilot-theorem/src/Copilot/Theorem/TransSys/Spec.hs +++ b/copilot-theorem/src/Copilot/Theorem/TransSys/Spec.hs @@ -78,7 +78,6 @@ data Node = Node -- its local name. , nodeConstrs :: [Expr Bool] } - -- | Identifer of a variable in the local (within one node) namespace. data Var = Var {varName :: String} deriving (Eq, Show, Ord) From aefc388ed448ccbf9f53c87735e55a005fc90e5d Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:03:30 -0400 Subject: [PATCH 0237/1222] Style: squash multiple consecutive empty lines. Refs #316. According to our style guide, there should only be one empty line (at most) between two lines of code.. --- copilot-theorem/src/Copilot/Theorem/TransSys/Transform.hs | 6 ------ 1 file changed, 6 deletions(-) diff --git a/copilot-theorem/src/Copilot/Theorem/TransSys/Transform.hs b/copilot-theorem/src/Copilot/Theorem/TransSys/Transform.hs index cc7106d5a..54d580521 100644 --- a/copilot-theorem/src/Copilot/Theorem/TransSys/Transform.hs +++ b/copilot-theorem/src/Copilot/Theorem/TransSys/Transform.hs @@ -92,7 +92,6 @@ mergeNodes toMergeIds spec = constrs = mergeConstrs toMerge renamingF - updateOtherNode :: NodeId -> [NodeId] -> (ExtVar -> ExtVar) -> Node -> Node updateOtherNode newNodeId mergedNodesIds renamingF n = n { nodeDependencies = @@ -105,8 +104,6 @@ updateOtherNode newNodeId mergedNodesIds renamingF n = n | (lv, gv) <- Bimap.toList $ nodeImportedVars n ] } - - updateExpr :: NodeId -> (ExtVar -> Var) -> Expr t -> Expr t updateExpr nId renamingF = transformExpr aux where @@ -114,7 +111,6 @@ updateExpr nId renamingF = transformExpr aux aux (VarE t v) = VarE t (renamingF (ExtVar nId v)) aux e = e - mergeVarsDescrs :: [Node] -> (ExtVar -> Var) -> Map Var VarDescr mergeVarsDescrs toMerge renamingF = Map.fromList $ do n <- toMerge @@ -169,8 +165,6 @@ selectImportedVars toMerge otherNodes dependencies = then Bimap.insert v' (ExtVar nId v) acc else acc - - redirectLocalImports :: [Node] -> Renaming () redirectLocalImports toMerge = do renamingF <- getRenamingF From 885623fb2b60da1d937944ad9be3fd011bf5f442 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:03:30 -0400 Subject: [PATCH 0238/1222] Style: squash multiple consecutive empty lines. Refs #316. According to our style guide, there should only be one empty line (at most) between two lines of code.. --- copilot-theorem/src/Copilot/Theorem/TransSys/Translate.hs | 5 ----- 1 file changed, 5 deletions(-) diff --git a/copilot-theorem/src/Copilot/Theorem/TransSys/Translate.hs b/copilot-theorem/src/Copilot/Theorem/TransSys/Translate.hs index e807ce8b0..f3ffcd672 100644 --- a/copilot-theorem/src/Copilot/Theorem/TransSys/Translate.hs +++ b/copilot-theorem/src/Copilot/Theorem/TransSys/Translate.hs @@ -114,7 +114,6 @@ translate cspec = -------------------------------------------------------------------------------- - mkTopNode :: String -> [NodeId] -> [C.Property] -> Node mkTopNode topNodeId dependencies cprops = Node { nodeId = topNodeId @@ -127,8 +126,6 @@ mkTopNode topNodeId dependencies cprops = [ (Var cp, mkExtVar (ncPropNode cp) ncMain) | cp <- C.propertyName <$> cprops ] - - mkExtVarNode (name, U t) = Node { nodeId = name , nodeDependencies = [] @@ -136,7 +133,6 @@ mkExtVarNode (name, U t) = , nodeImportedVars = Bimap.empty , nodeConstrs = []} - mkPropNodes :: [C.Property] -> Trans [Node] mkPropNodes = mapM propNode where @@ -291,7 +287,6 @@ popLocalInfos = do , _dependencies = [] } return (lvs, ivs, nub' dps) - getUid :: Trans Int getUid = do uid <- _nextUid <$> get From 3853a1ae0b6b3ba67e2c107dd0976599fc50dde9 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:03:30 -0400 Subject: [PATCH 0239/1222] Style: squash multiple consecutive empty lines. Refs #316. According to our style guide, there should only be one empty line (at most) between two lines of code.. --- copilot-theorem/src/Copilot/Theorem/What4.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/copilot-theorem/src/Copilot/Theorem/What4.hs b/copilot-theorem/src/Copilot/Theorem/What4.hs index 7be5bc4a2..98bd4f3cb 100644 --- a/copilot-theorem/src/Copilot/Theorem/What4.hs +++ b/copilot-theorem/src/Copilot/Theorem/What4.hs @@ -922,7 +922,6 @@ translateOp2 sym powFn logbFn op xe1 xe2 = case (op, xe1, xe2) of Nothing -> panic _ -> panic - translateOp3 :: forall t st fs a b c d . WB.ExprBuilder t st fs -> CE.Op3 a b c d From 2af3f26f10f739e8c10ba653fd5676890d016e2a Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:03:30 -0400 Subject: [PATCH 0240/1222] Style: squash multiple consecutive empty lines. Refs #316. According to our style guide, there should only be one empty line (at most) between two lines of code.. --- copilot/examples/Structs.hs | 2 -- 1 file changed, 2 deletions(-) diff --git a/copilot/examples/Structs.hs b/copilot/examples/Structs.hs index 9d345ccc3..f826585a4 100644 --- a/copilot/examples/Structs.hs +++ b/copilot/examples/Structs.hs @@ -11,7 +11,6 @@ import Control.Monad (void, forM_) import Language.Copilot import Copilot.Compile.C99 - -- | Definition for `Volts`. data Volts = Volts { numVolts :: Field "numVolts" Word16 @@ -66,7 +65,6 @@ spec = do ((((battery#other) .!! 2) .!! 3) == (((battery#other) .!! 2) .!! 4)) [arg battery] - main :: IO () main = do spec' <- reify spec From ecd66d3b8d9951e4ff3713981d0e346f91dd8116 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:03:30 -0400 Subject: [PATCH 0241/1222] Style: squash multiple consecutive empty lines. Refs #316. According to our style guide, there should only be one empty line (at most) between two lines of code.. --- copilot/examples/WCV.hs | 8 -------- 1 file changed, 8 deletions(-) diff --git a/copilot/examples/WCV.hs b/copilot/examples/WCV.hs index fe5ff8555..db3ea8183 100644 --- a/copilot/examples/WCV.hs +++ b/copilot/examples/WCV.hs @@ -14,7 +14,6 @@ import qualified Prelude as P import Data.Foldable (forM_) import qualified Control.Monad as Monad - -- | `dthr` is the horizontal distance threshold. dthr :: Stream Double dthr = extern "dthr" Nothing @@ -33,7 +32,6 @@ tcoathr = extern "tcoathr" Nothing type Vect2 = (Stream Double, Stream Double) - -------------------------------- -- External streams for relative position and velocity. -------------------------------- @@ -54,7 +52,6 @@ vz = extern "relative_velocity_z" Nothing v :: (Stream Double, Stream Double) v = (vx, vy) - -- | The relative x position between ownship and the intruder. sx :: Stream Double sx = extern "relative_position_x" Nothing @@ -71,7 +68,6 @@ sz = extern "relative_position_z" Nothing s :: (Stream Double, Stream Double) s = (sx, sy) - ------------------ -- The following section contains basic libraries for working with vectors. ------------------ @@ -101,7 +97,6 @@ a ~= b = (abs (a - b)) < 0.001 neg :: Vect2 -> Vect2 neg (x, y) = (negate x, negate y) - -------------------- -- From here on the algorithm, as described by the paper mentioned on the top -- of this file, is implemented. Please refer to the paper for details. @@ -134,7 +129,6 @@ delta s v d = (d*d) * (sq v) - ((det s v)*(det s v)) theta :: Vect2 -> Vect2 -> Stream Double -> Stream Double -> Stream Double theta s v d e = (-(s |*| v) + e * (sqrt $ delta s v d)) / (sq v) - tcoa :: Stream Double -> Stream Double -> Stream Double tcoa sz vz = if (sz * vz) < 0 then (-sz) / vz @@ -143,7 +137,6 @@ tcoa sz vz = if (sz * vz) < 0 dcpa :: Vect2 -> Vect2 -> Stream Double dcpa s@(sx, sy) v@(vx, vy) = norm (sx + (tcpa s v) * vx, sy + (tcpa s v) * vy) - -------------------------- -- Well clear Violation -- -------------------------- @@ -169,7 +162,6 @@ spec = do Monad.void $ prop "1a" (forall $ (tau s v) ~= (tau (neg s) (neg v))) -- Monad.void $ prop "3d" (forall $ (wcv tep s sz v vz) == (wcv tep (neg s) (-sz) (neg v) (-vz))) - main :: IO () main = do spec' <- reify spec From c8ff99552390c6b42ad3f8ffe9c0edccc72ca7b5 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:03:30 -0400 Subject: [PATCH 0242/1222] Style: squash multiple consecutive empty lines. Refs #316. According to our style guide, there should only be one empty line (at most) between two lines of code.. --- copilot/examples/what4/Arithmetic.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/copilot/examples/what4/Arithmetic.hs b/copilot/examples/what4/Arithmetic.hs index f9a4aec1a..d3fd284a2 100644 --- a/copilot/examples/what4/Arithmetic.hs +++ b/copilot/examples/what4/Arithmetic.hs @@ -38,7 +38,6 @@ spec = do -- Another example with floats. This fails, because it isn't true. void $ prop "Example 6" (forall ((efloat + 1) /= efloat)) - main :: IO () main = do spec' <- reify spec From e3601e832e167303f289a22af08cf59253eb58e3 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:03:30 -0400 Subject: [PATCH 0243/1222] Style: squash multiple consecutive empty lines. Refs #316. According to our style guide, there should only be one empty line (at most) between two lines of code.. --- copilot/examples/what4/Propositional.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/copilot/examples/what4/Propositional.hs b/copilot/examples/what4/Propositional.hs index f27e027ad..5dc62431c 100644 --- a/copilot/examples/what4/Propositional.hs +++ b/copilot/examples/what4/Propositional.hs @@ -46,7 +46,6 @@ spec = do let a = extern "a" Nothing void $ prop "Example 7" (forall (a || not a)) - main :: IO () main = do spec' <- reify spec From 69273532328a5a4bff82a145129e9b61ce4be76f Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:03:30 -0400 Subject: [PATCH 0244/1222] Style: squash multiple consecutive empty lines. Refs #316. According to our style guide, there should only be one empty line (at most) between two lines of code.. --- copilot/examples/what4/Structs.hs | 2 -- 1 file changed, 2 deletions(-) diff --git a/copilot/examples/what4/Structs.hs b/copilot/examples/what4/Structs.hs index 2fc1b254a..413bc454f 100644 --- a/copilot/examples/what4/Structs.hs +++ b/copilot/examples/what4/Structs.hs @@ -12,7 +12,6 @@ import Control.Monad (void, forM_) import Language.Copilot import Copilot.Theorem.What4 - -- | Definition for `Volts`. data Volts = Volts { numVolts :: Field "numVolts" Word16 @@ -65,7 +64,6 @@ spec = do void $ prop "Example 2" $ forall $ (((battery#other) .!! 2) .!! 3) == (((battery#other) .!! 2) .!! 4) - main :: IO () main = do spec' <- reify spec From 298a7bc0fa5422945c867545b7eaa92be1c3a76a Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:03:30 -0400 Subject: [PATCH 0245/1222] Style: squash multiple consecutive empty lines. Refs #316. According to our style guide, there should only be one empty line (at most) between two lines of code.. --- copilot/src/Language/Copilot/Main.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/copilot/src/Language/Copilot/Main.hs b/copilot/src/Language/Copilot/Main.hs index d243b4782..756fdaf70 100644 --- a/copilot/src/Language/Copilot/Main.hs +++ b/copilot/src/Language/Copilot/Main.hs @@ -44,7 +44,6 @@ cmdargs = CmdArgs <> metavar "INT" <> showDefault <> help "Interpret specification and write result to output") - -- | Create a main to either compile or interpret a copilot specification. -- -- This function must be provided an auxiliary function capable of compiling From af23aee137d72cf44b11f1679032caf3b510410e Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:06:35 -0400 Subject: [PATCH 0246/1222] Style: remove separating line in comment. Refs #316. According to our style guide, the code should not use lines with multiple consecutive hyphens, stars, or other symbols, to separate sections of code. --- copilot-core/src/Copilot/Core.hs | 2 -- 1 file changed, 2 deletions(-) diff --git a/copilot-core/src/Copilot/Core.hs b/copilot-core/src/Copilot/Core.hs index 0ea0158f4..c24539410 100644 --- a/copilot-core/src/Copilot/Core.hs +++ b/copilot-core/src/Copilot/Core.hs @@ -1,6 +1,4 @@ --------------------------------------------------------------------------------- -- Copyright © 2011 National Institute of Aerospace / Galois, Inc. --------------------------------------------------------------------------------- -- | Intermediate representation for Copilot specifications. -- The following articles might also be useful: From e10b827af2c3130c2238a819736caeb59f7ee064 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:06:35 -0400 Subject: [PATCH 0247/1222] Style: remove separating line in comment. Refs #316. According to our style guide, the code should not use lines with multiple consecutive hyphens, stars, or other symbols, to separate sections of code. --- copilot-core/src/Copilot/Core/Error.hs | 2 -- 1 file changed, 2 deletions(-) diff --git a/copilot-core/src/Copilot/Core/Error.hs b/copilot-core/src/Copilot/Core/Error.hs index 0debccdf9..0495bf29e 100644 --- a/copilot-core/src/Copilot/Core/Error.hs +++ b/copilot-core/src/Copilot/Core/Error.hs @@ -1,6 +1,4 @@ --------------------------------------------------------------------------------- -- Copyright © 2011 National Institute of Aerospace / Galois, Inc. --------------------------------------------------------------------------------- {-# LANGUAGE Safe #-} From f19916d01ced602c1a7ebb0c0abec54c5c7a2153 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:06:35 -0400 Subject: [PATCH 0248/1222] Style: remove separating line in comment. Refs #316. According to our style guide, the code should not use lines with multiple consecutive hyphens, stars, or other symbols, to separate sections of code. --- copilot-core/src/Copilot/Core/Expr.hs | 12 ------------ 1 file changed, 12 deletions(-) diff --git a/copilot-core/src/Copilot/Core/Expr.hs b/copilot-core/src/Copilot/Core/Expr.hs index a964933aa..5be6703b4 100644 --- a/copilot-core/src/Copilot/Core/Expr.hs +++ b/copilot-core/src/Copilot/Core/Expr.hs @@ -1,6 +1,4 @@ --------------------------------------------------------------------------------- -- Copyright © 2011 National Institute of Aerospace / Galois, Inc. --------------------------------------------------------------------------------- {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE GADTs #-} @@ -21,23 +19,15 @@ import Data.Word (Word32) import Data.Typeable (Typeable) --------------------------------------------------------------------------------- - -- | A stream identifier. type Id = Int --------------------------------------------------------------------------------- - -- | A name of a trigger, an external variable, or an external function. type Name = String --------------------------------------------------------------------------------- - -- | An index for the drop operator. type DropIdx = Word32 --------------------------------------------------------------------------------- - -- | Internal representation of Copilot stream expressions. -- -- The Core representation mimics the high-level Copilot stream, but the Core @@ -54,8 +44,6 @@ data Expr a where Op3 :: (Typeable a, Typeable b, Typeable c) => Op3 a b c d -> Expr a -> Expr b -> Expr c -> Expr d Label :: Typeable a => Type a -> String -> Expr a -> Expr a --------------------------------------------------------------------------------- - -- | A untyped expression that carries the information about the type of the -- expression as a value, as opposed to exposing it at type level (using an -- existential). From 37289ef191847e2b4d51e7f7181ebb2046968b8e Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:06:35 -0400 Subject: [PATCH 0249/1222] Style: remove separating line in comment. Refs #316. According to our style guide, the code should not use lines with multiple consecutive hyphens, stars, or other symbols, to separate sections of code. --- copilot-core/src/Copilot/Core/External.hs | 8 -------- 1 file changed, 8 deletions(-) diff --git a/copilot-core/src/Copilot/Core/External.hs b/copilot-core/src/Copilot/Core/External.hs index bc429ef29..512bbcbbb 100644 --- a/copilot-core/src/Copilot/Core/External.hs +++ b/copilot-core/src/Copilot/Core/External.hs @@ -1,6 +1,4 @@ --------------------------------------------------------------------------------- -- Copyright © 2011 National Institute of Aerospace / Galois, Inc. --------------------------------------------------------------------------------- {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE Rank2Types #-} @@ -21,16 +19,12 @@ import Prelude hiding (all, concat, foldr) import Data.Typeable (Typeable) --------------------------------------------------------------------------------- - -- | An extern variable declaration, together with the type of the underlying -- extern. data ExtVar = ExtVar { externVarName :: Name , externVarType :: UType } --------------------------------------------------------------------------------- - -- | List of all externs used in a specification. externVars :: Spec -> [ExtVar] externVars = nubBy eqExt . toList . all externVarsExpr @@ -58,8 +52,6 @@ externVarsExpr e0 = case e0 of externVarsUExpr :: UExpr -> DList ExtVar externVarsUExpr UExpr { uExprExpr = e } = externVarsExpr e --------------------------------------------------------------------------------- - -- | Apply a function to all expressions in a specification, concatenating the -- results. all :: (forall a . Expr a -> DList b) -> Spec -> DList b From 63572dc5edff38ab83c884ffe22fc2d21e3803a9 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:06:35 -0400 Subject: [PATCH 0250/1222] Style: remove separating line in comment. Refs #316. According to our style guide, the code should not use lines with multiple consecutive hyphens, stars, or other symbols, to separate sections of code. --- copilot-core/src/Copilot/Core/Interpret.hs | 2 -- 1 file changed, 2 deletions(-) diff --git a/copilot-core/src/Copilot/Core/Interpret.hs b/copilot-core/src/Copilot/Core/Interpret.hs index 0b8c3ffb1..1701bfd79 100644 --- a/copilot-core/src/Copilot/Core/Interpret.hs +++ b/copilot-core/src/Copilot/Core/Interpret.hs @@ -1,6 +1,4 @@ --------------------------------------------------------------------------------- -- Copyright © 2011 National Institute of Aerospace / Galois, Inc. --------------------------------------------------------------------------------- -- | An interpreter for Copilot specifications. From 86d3ad6def591a39c1ce87f38f3ff3eb52824517 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:06:35 -0400 Subject: [PATCH 0251/1222] Style: remove separating line in comment. Refs #316. According to our style guide, the code should not use lines with multiple consecutive hyphens, stars, or other symbols, to separate sections of code. --- .../src/Copilot/Core/Interpret/Eval.hs | 34 ------------------- 1 file changed, 34 deletions(-) diff --git a/copilot-core/src/Copilot/Core/Interpret/Eval.hs b/copilot-core/src/Copilot/Core/Interpret/Eval.hs index 683177503..f7f050766 100644 --- a/copilot-core/src/Copilot/Core/Interpret/Eval.hs +++ b/copilot-core/src/Copilot/Core/Interpret/Eval.hs @@ -1,6 +1,4 @@ --------------------------------------------------------------------------------- -- Copyright © 2011 National Institute of Aerospace / Galois, Inc. --------------------------------------------------------------------------------- -- | A tagless interpreter for Copilot specifications. @@ -34,8 +32,6 @@ import Data.List (transpose) import Data.Maybe (fromJust) import Data.Typeable (Typeable) --------------------------------------------------------------------------------- - -- | Exceptions that may be thrown during interpretation of a Copilot -- specification. data InterpException @@ -83,14 +79,10 @@ instance Show InterpException where -- exception mechanisms. instance Exception InterpException --------------------------------------------------------------------------------- - -- | An environment that contains an association between (stream or extern) -- names and their values. type Env nm = [(nm, Dynamic)] --------------------------------------------------------------------------------- - -- | The simulation output is defined as a string. Different backends may -- choose to format their results differently. type Output = String @@ -110,8 +102,6 @@ data ExecTrace = ExecTrace } deriving Show --------------------------------------------------------------------------------- - -- We could write this in a beautiful lazy style like above, but that creates a -- space leak in the interpreter that is hard to fix while maintaining laziness. -- We take a more brute-force appraoch below. @@ -141,8 +131,6 @@ eval showType k spec = zip (map observerName (specObservers spec)) obsvs } --------------------------------------------------------------------------------- - -- | An environment that contains an association between (stream or extern) -- names and their values. type LocalEnv = [(Name, Dynamic)] @@ -180,8 +168,6 @@ evalExpr_ k e0 locs strms = case e0 of let ev1 = evalExpr_ k e1 locs strms in ev1 --------------------------------------------------------------------------------- - -- | Evaluate an extern stream for a number of steps, obtaining the value of -- the sample at that time. evalExternVar :: Int -> Name -> Maybe [a] -> a @@ -193,10 +179,6 @@ evalExternVar k name exts = Nothing -> throw (NotEnoughValues name k) Just x -> x --------------------------------------------------------------------------------- - --------------------------------------------------------------------------------- - -- | Evaluate an 'Copilot.Core.Operators.Op1' by producing an equivalent -- Haskell function operating on the same types as the -- 'Copilot.Core.Operators.Op1'. @@ -234,8 +216,6 @@ evalOp1 op = case op of -- Extract value from field unfield (Field v) = v --------------------------------------------------------------------------------- - -- | Evaluate an 'Copilot.Core.Operators.Op2' by producing an equivalent -- Haskell function operating on the same types as the -- 'Copilot.Core.Operators.Op2'. @@ -274,16 +254,12 @@ catchZero :: Integral a => (a -> a -> a) -> (a -> a -> a) catchZero _ _ 0 = throw DivideByZero catchZero f x y = f x y --------------------------------------------------------------------------------- - -- | Evaluate an 'Copilot.Core.Operators.Op3' by producing an equivalent -- Haskell function operating on the same types as the -- 'Copilot.Core.Operators.Op3'. evalOp3 :: Op3 a b c d -> (a -> b -> c -> d) evalOp3 (Mux _) = \ !v !x !y -> if v then x else y --------------------------------------------------------------------------------- - -- | Turn a stream into a key-value pair that can be added to an 'Env' for -- simulation. initStrm :: Stream -> (Id, Dynamic) @@ -314,8 +290,6 @@ evalStreams top specStrms initStrms = let ls = x `seq` (x:xs) in (id, toDyn ls) --------------------------------------------------------------------------------- - -- | Evaluate a trigger for a number of steps. evalTrigger :: ShowType -- ^ Show booleans as @0@/@1@ (C) or -- @True@/@False@ (Haskell). @@ -348,8 +322,6 @@ evalTrigger showType k strms evalUExpr (UExpr t e1) = map (showWithType showType t) (evalExprs_ k e1 strms) --------------------------------------------------------------------------------- - -- | Evaluate an observer for a number of steps. evalObserver :: ShowType -- ^ Show booleans as @0@/@1@ (C) or @True@/@False@ -- (Haskell). @@ -364,21 +336,15 @@ evalObserver showType k strms , observerExprType = t } = map (showWithType showType t) (evalExprs_ k e strms) --------------------------------------------------------------------------------- - -- | Evaluate an expression for a number of steps, producing a list with the -- changing value of the expression until that time. evalExprs_ :: Typeable a => Int -> Expr a -> Env Id -> [a] evalExprs_ k e strms = map (\i -> evalExpr_ i e [] strms) [0..(k-1)] --------------------------------------------------------------------------------- - -- | Safe indexing (!!) on possibly infininite lists. safeIndex :: Int -> [a] -> Maybe a safeIndex i ls = let ls' = take (i+1) ls in if length ls' > i then Just (ls' !! i) else Nothing - -------------------------------------------------------------------------------- From 6691eb5f848baca58bf6a3045ede5d159b662c1b Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:06:35 -0400 Subject: [PATCH 0252/1222] Style: remove separating line in comment. Refs #316. According to our style guide, the code should not use lines with multiple consecutive hyphens, stars, or other symbols, to separate sections of code. --- copilot-core/src/Copilot/Core/Interpret/Render.hs | 8 -------- 1 file changed, 8 deletions(-) diff --git a/copilot-core/src/Copilot/Core/Interpret/Render.hs b/copilot-core/src/Copilot/Core/Interpret/Render.hs index 2c73313ea..ed2bdbfe1 100644 --- a/copilot-core/src/Copilot/Core/Interpret/Render.hs +++ b/copilot-core/src/Copilot/Core/Interpret/Render.hs @@ -1,6 +1,4 @@ --------------------------------------------------------------------------------- -- Copyright © 2011 National Institute of Aerospace / Galois, Inc. --------------------------------------------------------------------------------- -- | Pretty-print the results of a simulation. @@ -18,8 +16,6 @@ import Text.PrettyPrint import Prelude hiding ((<>)) --------------------------------------------------------------------------------- - -- | Render an execution trace as a table, formatted to faciliate readability. renderAsTable :: ExecTrace -> String renderAsTable @@ -49,8 +45,6 @@ renderAsTable ppObserverOutputs :: [[Doc]] ppObserverOutputs = map (map text) (map snd obsvs) --------------------------------------------------------------------------------- - -- | Render an execution trace as using comma-separate value (CSV) format. renderAsCSV :: ExecTrace -> String renderAsCSV = render . unfold @@ -97,8 +91,6 @@ step ExecTrace , interpObservers = [] } --------------------------------------------------------------------------------- - -- Copied from pretty-ncols because of incompatibility with newer GHC versions. asColumns :: [[Doc]] -> Doc asColumns = flip asColumnsWithBuff $ 1 From cdf1bfe1af4bff58bde22c168d2228dda3437777 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:06:35 -0400 Subject: [PATCH 0253/1222] Style: remove separating line in comment. Refs #316. According to our style guide, the code should not use lines with multiple consecutive hyphens, stars, or other symbols, to separate sections of code. --- copilot-core/src/Copilot/Core/Operators.hs | 4 ---- 1 file changed, 4 deletions(-) diff --git a/copilot-core/src/Copilot/Core/Operators.hs b/copilot-core/src/Copilot/Core/Operators.hs index 618812b6a..7055e5fe5 100644 --- a/copilot-core/src/Copilot/Core/Operators.hs +++ b/copilot-core/src/Copilot/Core/Operators.hs @@ -1,6 +1,4 @@ --------------------------------------------------------------------------------- -- Copyright © 2011 National Institute of Aerospace / Galois, Inc. --------------------------------------------------------------------------------- {-# LANGUAGE GADTs #-} {-# LANGUAGE Rank2Types #-} @@ -20,8 +18,6 @@ import Copilot.Core.Type.Array (Array) import Data.Bits import Data.Word (Word32) --------------------------------------------------------------------------------- - -- | Unary operators. data Op1 a b where -- Boolean operators. From 39a6b337dca5dc44dc5fe70d15690425055726a1 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:06:35 -0400 Subject: [PATCH 0254/1222] Style: remove separating line in comment. Refs #316. According to our style guide, the code should not use lines with multiple consecutive hyphens, stars, or other symbols, to separate sections of code. --- copilot-core/src/Copilot/Core/PrettyDot.hs | 26 ---------------------- 1 file changed, 26 deletions(-) diff --git a/copilot-core/src/Copilot/Core/PrettyDot.hs b/copilot-core/src/Copilot/Core/PrettyDot.hs index 9d00154e5..607e15fc9 100644 --- a/copilot-core/src/Copilot/Core/PrettyDot.hs +++ b/copilot-core/src/Copilot/Core/PrettyDot.hs @@ -1,6 +1,4 @@ --------------------------------------------------------------------------------- -- Copyright © 2011 National Institute of Aerospace / Galois, Inc. --------------------------------------------------------------------------------- -- | A pretty printer for Copilot specifications as GraphViz/dot graphs. @@ -23,8 +21,6 @@ import Text.Printf mkExtTmpVar :: String -> String mkExtTmpVar = ("ext_" ++) --------------------------------------------------------------------------------- - -- | Pretty print a Copilot Expression as a GraphViz graph part. -- -- See the @@ -151,8 +147,6 @@ ppOp3 :: Op3 a b c d -> String ppOp3 op = case op of Mux _ -> "mux" --------------------------------------------------------------------------------- - -- | Pretty print a stream as a GraphViz graph part. ppStream :: Int -- ^ Index or ID of the next node in the graph. -> Stream -- ^ Stream to pretty print @@ -172,7 +166,6 @@ ppStream i <> text (printf "%s -> %s\n" (show (i+1)::String) ((show $ i+2)::String)) <> r1, i1) where (r1, i1) = ppExprDot (i+3) (i+1) True e --------------------------------------------------------------------------------- -- | Pretty print a trigger as a GraphViz graph part. ppTrigger :: Int -- ^ Index or ID of the next node in the graph. @@ -209,8 +202,6 @@ ppUExprL i pere bb (a:b) = ((r1:r2), i2) (r1, i1) = ppUExpr i pere bb a (r2, i2) = ppUExprL i1 pere bb b --------------------------------------------------------------------------------- - -- | Pretty print an observer as a GraphViz graph part. ppObserver :: Int -- ^ Index or ID of the next node in the graph. -> Observer -- ^ Observer to pretty print @@ -223,7 +214,6 @@ ppObserver i (text (printf "%s [label=\"observer: \n%s\",color=mediumblue, style=filled]\n" (show i::String) name::String) <> r1, i1) where (r1, i1) = ppExprDot (i+1) i True e --------------------------------------------------------------------------------- -- | Pretty print a property as a GraphViz graph part. ppProperty :: Int -- ^ Index or ID of the next node in the graph. @@ -238,10 +228,6 @@ ppProperty i <> r1, i1) where (r1, i1) = ppExprDot (i+1) i True e --------------------------------------------------------------------------------- - --------------------------------------------------------------------------------- - -- | Pretty print a list of streams as a GraphViz graph part. ppStreamL :: Int -- ^ Index or ID of the next node in the graph. -> [Stream] -- ^ List of streams to pretty print @@ -253,8 +239,6 @@ ppStreamL i (a:b) = ((s1$$s2),(i2)) (s1,i1) = ppStream i a (s2,i2) = ppStreamL i1 b --------------------------------------------------------------------------------- - -- | Pretty print a list of triggers as a GraphViz graph part. ppTriggerL :: Int -- ^ Index or ID of the next node in the graph. -> [Trigger] -- ^ List of triggers to pretty print @@ -266,8 +250,6 @@ ppTriggerL i (a:b) = ((s1$$s2),(i2)) (s1,i1) = ppTrigger i a (s2,i2) = ppTriggerL i1 b --------------------------------------------------------------------------------- - -- | Pretty print a list of observers as a GraphViz graph part. ppObserverL :: Int -- ^ Index or ID of the next node in the graph. -> [Observer] -- ^ List of observers to pretty print @@ -279,8 +261,6 @@ ppObserverL i (a:b) = ((s1$$s2),(i2)) (s1,i1) = ppObserver i a (s2,i2) = ppObserverL i1 b --------------------------------------------------------------------------------- - -- | Pretty print a list of properties as a GraphViz graph part. ppPropertyL :: Int -- ^ Index or ID of the next node in the graph. -> [Property] -- ^ List of properties to pretty print @@ -292,8 +272,6 @@ ppPropertyL i (a:b) = ((s1$$s2),(i2)) (s1,i1) = ppProperty i a (s2,i2) = ppPropertyL i1 b --------------------------------------------------------------------------------- - -- | Pretty-print a Copilot specification as a GraphViz/dot graph. ppSpecDot :: Int -- ^ Index or ID of the next node in the graph. -> Spec -- ^ Spec to pretty print. @@ -308,8 +286,6 @@ ppSpecDot i spec = (fs, i4) = ppPropertyL i3 (specProperties spec) bb = text "\n}\n" --------------------------------------------------------------------------------- - -- | Pretty-print a Copilot expression as a GraphViz/dot graph. prettyPrintExprDot :: Bool -- ^ Mark externs with the prefix @externV:@. -> Expr a -- ^ The expression to pretty print. @@ -323,5 +299,3 @@ prettyPrintExprDot bb s = render rr prettyPrintDot :: Spec -> String prettyPrintDot s = render r1 where (r1, _) = ppSpecDot 0 s - --------------------------------------------------------------------------------- From 7a8614d13607ed7d57d73ebe0d6ff925137939d8 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:06:35 -0400 Subject: [PATCH 0255/1222] Style: remove separating line in comment. Refs #316. According to our style guide, the code should not use lines with multiple consecutive hyphens, stars, or other symbols, to separate sections of code. --- copilot-core/src/Copilot/Core/PrettyPrint.hs | 22 -------------------- 1 file changed, 22 deletions(-) diff --git a/copilot-core/src/Copilot/Core/PrettyPrint.hs b/copilot-core/src/Copilot/Core/PrettyPrint.hs index e60eeffd5..75827a6f5 100644 --- a/copilot-core/src/Copilot/Core/PrettyPrint.hs +++ b/copilot-core/src/Copilot/Core/PrettyPrint.hs @@ -1,6 +1,4 @@ --------------------------------------------------------------------------------- -- Copyright © 2011 National Institute of Aerospace / Galois, Inc. --------------------------------------------------------------------------------- -- | A pretty printer for Copilot specifications. @@ -19,15 +17,11 @@ import Prelude hiding (id, (<>)) import Text.PrettyPrint.HughesPJ import Data.List (intersperse) --------------------------------------------------------------------------------- - -- | Create a unique stream name by prefixing the given ID by a lowercase -- letter @"s"@. strmName :: Int -> Doc strmName id = text "s" <> int id --------------------------------------------------------------------------------- - -- | Pretty-print a Copilot expression. -- -- The type is ignored, and only the expression is pretty-printed. @@ -115,8 +109,6 @@ ppOp3 op = case op of text "then" <+> doc2 <+> text "else" <+> doc3 <> text ")" --------------------------------------------------------------------------------- - -- | Parenthesize two 'Doc's, separated by an infix 'String'. ppInfix :: String -> Doc -> Doc -> Doc ppInfix cs doc1 doc2 = parens $ doc1 <+> text cs <+> doc2 @@ -125,8 +117,6 @@ ppInfix cs doc1 doc2 = parens $ doc1 <+> text cs <+> doc2 ppPrefix :: String -> Doc -> Doc ppPrefix cs = (text cs <+>) --------------------------------------------------------------------------------- - -- | Pretty-print a Copilot stream as a case of a top-level function for -- streams of that type, by pattern matching on the stream name. ppStream :: Stream -> Doc @@ -147,8 +137,6 @@ ppStream <+> text "++" <+> ppExpr e --------------------------------------------------------------------------------- - -- | Pretty-print a Copilot trigger as a case of a top-level @trigger@ -- function, by pattern matching on the trigger name. ppTrigger :: Trigger -> Doc @@ -165,8 +153,6 @@ ppTrigger map (\a -> text "arg" <+> ppUExpr a) args)) $$ nest 2 rbrack --------------------------------------------------------------------------------- - -- | Pretty-print a Copilot observer as a case of a top-level @observer@ -- function, by pattern matching on the observer name. ppObserver :: Observer -> Doc @@ -178,8 +164,6 @@ ppObserver <+> text "=" <+> ppExpr e --------------------------------------------------------------------------------- - -- | Pretty-print a Copilot property as a case of a top-level @property@ -- function, by pattern matching on the property name. ppProperty :: Property -> Doc @@ -191,8 +175,6 @@ ppProperty <+> text "=" <+> ppExpr e --------------------------------------------------------------------------------- - -- | Pretty-print a Copilot specification, in the following order: -- -- - Streams definitions @@ -207,10 +189,6 @@ ppSpec spec = cs $$ ds $$ es $$ fs es = foldr (($$) . ppObserver) empty (specObservers spec) fs = foldr (($$) . ppProperty) empty (specProperties spec) --------------------------------------------------------------------------------- - -- | Pretty-print a Copilot specification. prettyPrint :: Spec -> String prettyPrint = render . ppSpec - --------------------------------------------------------------------------------- From 84d243c980d3f0e59119ce1aaada0a3f8cb12a40 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:06:35 -0400 Subject: [PATCH 0256/1222] Style: remove separating line in comment. Refs #316. According to our style guide, the code should not use lines with multiple consecutive hyphens, stars, or other symbols, to separate sections of code. --- copilot-core/src/Copilot/Core/Spec.hs | 14 -------------- 1 file changed, 14 deletions(-) diff --git a/copilot-core/src/Copilot/Core/Spec.hs b/copilot-core/src/Copilot/Core/Spec.hs index a448dd7ea..962a57b47 100644 --- a/copilot-core/src/Copilot/Core/Spec.hs +++ b/copilot-core/src/Copilot/Core/Spec.hs @@ -1,6 +1,4 @@ --------------------------------------------------------------------------------- -- Copyright © 2011 National Institute of Aerospace / Galois, Inc. --------------------------------------------------------------------------------- {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE GADTs #-} @@ -27,8 +25,6 @@ import Copilot.Core.Expr (Name, Id, Expr, UExpr) import Copilot.Core.Type (Type, Typed) import Data.Typeable (Typeable) --------------------------------------------------------------------------------- - -- | A stream in an infinite succession of values of the same type. -- -- Stream can carry different types of data. Boolean streams play a special @@ -40,8 +36,6 @@ data Stream = forall a. (Typeable a, Typed a) => Stream , streamExpr :: Expr a , streamExprType :: Type a } --------------------------------------------------------------------------------- - -- | An observer, representing a stream that we observe during interpretation -- at every sample. data Observer = forall a. Typeable a => Observer @@ -49,8 +43,6 @@ data Observer = forall a. Typeable a => Observer , observerExpr :: Expr a , observerExprType :: Type a } --------------------------------------------------------------------------------- - -- | A trigger, representing a function we execute when a boolean stream becomes -- true at a sample. data Trigger = Trigger @@ -58,16 +50,12 @@ data Trigger = Trigger , triggerGuard :: Expr Bool , triggerArgs :: [UExpr] } --------------------------------------------------------------------------------- - -- | A property, representing a boolean stream that is existentially or -- universally quantified over time. data Property = Property { propertyName :: Name , propertyExpr :: Expr Bool } --------------------------------------------------------------------------------- - -- | A Copilot specification is a list of streams, together with monitors on -- these streams implemented as observers, triggers or properties. data Spec = Spec @@ -75,5 +63,3 @@ data Spec = Spec , specObservers :: [Observer] , specTriggers :: [Trigger] , specProperties :: [Property] } - --------------------------------------------------------------------------------- From 59df07db5c54d7af44f11b148c400d43988ff1a4 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:06:35 -0400 Subject: [PATCH 0257/1222] Style: remove separating line in comment. Refs #316. According to our style guide, the code should not use lines with multiple consecutive hyphens, stars, or other symbols, to separate sections of code. --- copilot-core/src/Copilot/Core/Type.hs | 12 ------------ 1 file changed, 12 deletions(-) diff --git a/copilot-core/src/Copilot/Core/Type.hs b/copilot-core/src/Copilot/Core/Type.hs index da34392c3..dc983ec22 100644 --- a/copilot-core/src/Copilot/Core/Type.hs +++ b/copilot-core/src/Copilot/Core/Type.hs @@ -1,6 +1,4 @@ --------------------------------------------------------------------------------- -- Copyright © 2011 National Institute of Aerospace / Galois, Inc. --------------------------------------------------------------------------------- -- | Typing for Core. -- @@ -131,8 +129,6 @@ instance EqualType Type where (=~=) Double Double = Just Refl (=~=) _ _ = Nothing --------------------------------------------------------------------------------- - -- | A simple, monomorphic representation of types that facilitates putting -- variables in heterogeneous lists and environments in spite of their types -- being different. @@ -172,8 +168,6 @@ instance Eq SimpleType where SStruct == SStruct = True _ == _ = False --------------------------------------------------------------------------------- - -- | A typed expression, from which we can obtain the two type representations -- used by Copilot: 'Type' and 'SimpleType'. class (Show a, Typeable a) => Typed a where @@ -181,8 +175,6 @@ class (Show a, Typeable a) => Typed a where simpleType :: Type a -> SimpleType simpleType _ = SStruct --------------------------------------------------------------------------------- - instance Typed Bool where typeOf = Bool simpleType _ = SBool @@ -220,12 +212,8 @@ instance (Typeable t, Typed t, KnownNat n, Flatten t (InnerType t), Typed (Inner typeOf = Array typeOf simpleType (Array t) = SArray t --------------------------------------------------------------------------------- - -- | A untyped type (no phantom type). data UType = forall a . Typeable a => UType { uTypeType :: Type a } instance Eq UType where UType ty1 == UType ty2 = typeRep ty1 == typeRep ty2 - --------------------------------------------------------------------------------- From 648aaf0815bab2b5323557fb3133204054ccb32c Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:06:35 -0400 Subject: [PATCH 0258/1222] Style: remove separating line in comment. Refs #316. According to our style guide, the code should not use lines with multiple consecutive hyphens, stars, or other symbols, to separate sections of code. --- copilot-core/src/Copilot/Core/Type/Array.hs | 2 -- 1 file changed, 2 deletions(-) diff --git a/copilot-core/src/Copilot/Core/Type/Array.hs b/copilot-core/src/Copilot/Core/Type/Array.hs index bfb3f2b3f..a1a10a132 100644 --- a/copilot-core/src/Copilot/Core/Type/Array.hs +++ b/copilot-core/src/Copilot/Core/Type/Array.hs @@ -1,6 +1,4 @@ --------------------------------------------------------------------------------- -- Copyright © 2011 National Institute of Aerospace / Galois, Inc. --------------------------------------------------------------------------------- {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleInstances #-} From 3bd5a74acecef9b8ec62fb28a6fd3196a7f89f19 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:06:35 -0400 Subject: [PATCH 0259/1222] Style: remove separating line in comment. Refs #316. According to our style guide, the code should not use lines with multiple consecutive hyphens, stars, or other symbols, to separate sections of code. --- copilot-core/src/Copilot/Core/Type/Dynamic.hs | 4 ---- 1 file changed, 4 deletions(-) diff --git a/copilot-core/src/Copilot/Core/Type/Dynamic.hs b/copilot-core/src/Copilot/Core/Type/Dynamic.hs index b6a4e6741..fe0278857 100644 --- a/copilot-core/src/Copilot/Core/Type/Dynamic.hs +++ b/copilot-core/src/Copilot/Core/Type/Dynamic.hs @@ -1,6 +1,4 @@ --------------------------------------------------------------------------------- -- Copyright © 2011 National Institute of Aerospace / Galois, Inc. --------------------------------------------------------------------------------- {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE GADTs #-} @@ -26,8 +24,6 @@ module Copilot.Core.Type.Dynamic import Copilot.Core.Type.Equality --------------------------------------------------------------------------------- - -- | Representation of a value accompanied by its type. data Dynamic :: (* -> *) -> * where Dynamic :: a -> t a -> Dynamic t From c996c3c41eda9f7b4097b02ce65f33b74b4d6be6 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:06:35 -0400 Subject: [PATCH 0260/1222] Style: remove separating line in comment. Refs #316. According to our style guide, the code should not use lines with multiple consecutive hyphens, stars, or other symbols, to separate sections of code. --- copilot-core/src/Copilot/Core/Type/Equality.hs | 2 -- 1 file changed, 2 deletions(-) diff --git a/copilot-core/src/Copilot/Core/Type/Equality.hs b/copilot-core/src/Copilot/Core/Type/Equality.hs index 74b38bd1a..5b81951d6 100644 --- a/copilot-core/src/Copilot/Core/Type/Equality.hs +++ b/copilot-core/src/Copilot/Core/Type/Equality.hs @@ -1,6 +1,4 @@ --------------------------------------------------------------------------------- -- Copyright © 2011 National Institute of Aerospace / Galois, Inc. --------------------------------------------------------------------------------- {-# LANGUAGE GADTs #-} {-# LANGUAGE KindSignatures #-} From 4fe08a3666ce26c3e38c9763cd244aa596814443 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:06:35 -0400 Subject: [PATCH 0261/1222] Style: remove separating line in comment. Refs #316. According to our style guide, the code should not use lines with multiple consecutive hyphens, stars, or other symbols, to separate sections of code. --- copilot-core/src/Copilot/Core/Type/Show.hs | 14 -------------- 1 file changed, 14 deletions(-) diff --git a/copilot-core/src/Copilot/Core/Type/Show.hs b/copilot-core/src/Copilot/Core/Type/Show.hs index 292a4350c..e0adc97ce 100644 --- a/copilot-core/src/Copilot/Core/Type/Show.hs +++ b/copilot-core/src/Copilot/Core/Type/Show.hs @@ -1,6 +1,4 @@ --------------------------------------------------------------------------------- -- Copyright © 2011 National Institute of Aerospace / Galois, Inc. --------------------------------------------------------------------------------- {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE GADTs #-} @@ -16,14 +14,10 @@ module Copilot.Core.Type.Show import Copilot.Core.Type --------------------------------------------------------------------------------- - -- | Witness datatype for showing a value, used by 'showWithType'. {-# DEPRECATED ShowWit "This type is deprecated in Copilot 3.7." #-} data ShowWit a = Show a => ShowWit --------------------------------------------------------------------------------- - -- | Turn a type into a show witness. showWit :: Type a -> ShowWit a showWit t = @@ -42,8 +36,6 @@ showWit t = Array t -> ShowWit Struct t -> ShowWit --------------------------------------------------------------------------------- - -- | Show Copilot Core type. showType :: Type a -> String showType t = @@ -62,8 +54,6 @@ showType t = Array t -> "Array " ++ showType t Struct t -> "Struct" --------------------------------------------------------------------------------- - -- Are we proving equivalence with a C backend, in which case we want to show -- Booleans as '0' and '1'. @@ -71,8 +61,6 @@ showType t = -- representation of booleans. data ShowType = C | Haskell --------------------------------------------------------------------------------- - -- | Show a value. The representation depends on the type and the target -- language. Booleans are represented differently depending on the backend. showWithType :: ShowType -> Type a -> a -> String @@ -87,5 +75,3 @@ showWithType showT t x = where sw = case showWit t of ShowWit -> show x - --------------------------------------------------------------------------------- From d0658c4cfc780ddf0f991db0950f4d5a93600191 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:06:35 -0400 Subject: [PATCH 0262/1222] Style: remove separating line in comment. Refs #316. According to our style guide, the code should not use lines with multiple consecutive hyphens, stars, or other symbols, to separate sections of code. --- copilot-language/src/Copilot/Language.hs | 6 ------ 1 file changed, 6 deletions(-) diff --git a/copilot-language/src/Copilot/Language.hs b/copilot-language/src/Copilot/Language.hs index 62d7369a7..eff4b4d9c 100644 --- a/copilot-language/src/Copilot/Language.hs +++ b/copilot-language/src/Copilot/Language.hs @@ -1,6 +1,4 @@ --------------------------------------------------------------------------------- -- Copyright © 2011 National Institute of Aerospace / Galois, Inc. --------------------------------------------------------------------------------- -- | Main Copilot language export file. -- @@ -71,11 +69,7 @@ import Copilot.Language.Prelude import Copilot.Language.Spec import Copilot.Language.Stream (Stream) --------------------------------------------------------------------------------- - -- | Transform a high-level Copilot Language specification into a low-level -- Copilot Core specification and pretty-print it to stdout. prettyPrint :: Spec -> IO () prettyPrint e = fmap PP.prettyPrint (reify e) >>= putStr - --------------------------------------------------------------------------------- From d0928e5488c7e898663823024a632a5764601597 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:06:35 -0400 Subject: [PATCH 0263/1222] Style: remove separating line in comment. Refs #316. According to our style guide, the code should not use lines with multiple consecutive hyphens, stars, or other symbols, to separate sections of code. --- .../src/Copilot/Language/Analyze.hs | 36 ------------------- 1 file changed, 36 deletions(-) diff --git a/copilot-language/src/Copilot/Language/Analyze.hs b/copilot-language/src/Copilot/Language/Analyze.hs index fe93ab741..00d7afe84 100644 --- a/copilot-language/src/Copilot/Language/Analyze.hs +++ b/copilot-language/src/Copilot/Language/Analyze.hs @@ -1,6 +1,4 @@ --------------------------------------------------------------------------------- -- Copyright © 2011 National Institute of Aerospace / Galois, Inc. --------------------------------------------------------------------------------- {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE GADTs #-} @@ -29,8 +27,6 @@ import qualified System.Mem.StableName.Map as M import Control.Monad (when, foldM_, foldM) import Control.Exception (Exception, throw) --------------------------------------------------------------------------------- - -- | Exceptions or kinds of errors in Copilot specifications that the analysis -- implemented is able to detect. data AnalyzeException @@ -77,13 +73,9 @@ instance Exception AnalyzeException maxRecursion :: Int maxRecursion = 100000 --------------------------------------------------------------------------------- - -- | An environment that contains the nodes visited. type Env = Map () --------------------------------------------------------------------------------- - -- | Analyze a Copilot specification and report any errors detected. -- -- This function can fail with one of the exceptions in 'AnalyzeException'. @@ -96,8 +88,6 @@ analyze spec = do mapM_ (analyzeProperty refStreams) (map fst $ theorems $ runSpec spec) specExts refStreams spec >>= analyzeExts --------------------------------------------------------------------------------- - -- | Analyze a Copilot trigger and report any errors detected. -- -- This function can fail with one of the exceptions in 'AnalyzeException'. @@ -109,31 +99,23 @@ analyzeTrigger refStreams (Trigger _ e0 args) = analyzeTriggerArg :: Arg -> IO () analyzeTriggerArg (Arg e) = analyzeExpr refStreams e --------------------------------------------------------------------------------- - -- | Analyze a Copilot observer and report any errors detected. -- -- This function can fail with one of the exceptions in 'AnalyzeException'. analyzeObserver :: IORef Env -> Observer -> IO () analyzeObserver refStreams (Observer _ e) = analyzeExpr refStreams e --------------------------------------------------------------------------------- - -- | Analyze a Copilot property and report any errors detected. -- -- This function can fail with one of the exceptions in 'AnalyzeException'. analyzeProperty :: IORef Env -> Property -> IO () analyzeProperty refStreams (Property _ e) = analyzeExpr refStreams e --------------------------------------------------------------------------------- - data SeenExtern = NoExtern | SeenFun | SeenArr | SeenStruct --------------------------------------------------------------------------------- - -- | Analyze a Copilot stream and report any errors detected. -- -- This function can fail with one of the exceptions in 'AnalyzeException'. @@ -165,8 +147,6 @@ analyzeExpr refStreams s = do go seenExt nodes' e3 Label _ e -> go seenExt nodes' e --------------------------------------------------------------------------------- - -- | Detect whether the given stream name has already been visited. -- -- This function throws a 'ReferentialCycle' exception if the second argument @@ -178,16 +158,12 @@ assertNotVisited _ dstn nodes = Just () -> throw ReferentialCycle Nothing -> return () --------------------------------------------------------------------------------- - -- | Check that the level of recursion is not above the max recursion allowed. mapCheck :: IORef Env -> IO Bool mapCheck refStreams = do ref <- readIORef refStreams return $ getSize ref > maxRecursion --------------------------------------------------------------------------------- - -- | Analyze a Copilot stream append and report any errors detected. analyzeAppend :: IORef Env -> DynStableName -> Stream a -> b @@ -200,8 +176,6 @@ analyzeAppend refStreams dstn e b f = do modifyIORef refStreams $ M.insert dstn () f refStreams e --------------------------------------------------------------------------------- - -- | Analyze a Copilot stream drop and report any errors detected. -- -- This function can fail if the drop is exercised over a stream that is not an @@ -214,11 +188,9 @@ analyzeDrop k (Append xs _ _) | otherwise = return () analyzeDrop _ _ = throw DropAppliedToNonAppend --------------------------------------------------------------------------------- -- Analyzing external variables. We check that every reference to an external -- variable has the same type, and for external functions, they have the same -- typed arguments. --------------------------------------------------------------------------------- -- | An environment to store external variables, arrays, functions and structs, -- so that we can check types in the expression---e.g., if we declare the same @@ -230,8 +202,6 @@ data ExternEnv = ExternEnv , externStructArgs :: [(String, [C.SimpleType])] } --------------------------------------------------------------------------------- - -- | Make sure external variables, functions, arrays, and structs are correctly -- typed. analyzeExts :: ExternEnv -> IO () @@ -295,8 +265,6 @@ analyzeExts ExternEnv { externVarEnv = vars (head grp) -- should be typesafe, since this is from groupBy grp --------------------------------------------------------------------------------- - -- | Obtain all the externs in a specification. specExts :: IORef Env -> Spec' a -> IO ExternEnv specExts refStreams spec = do @@ -347,11 +315,7 @@ collectExts refStreams stream_ env_ = do go nodes env'' e3 Label _ e -> go nodes env e --------------------------------------------------------------------------------- - -- | Return the simple C type representation of the type of the values carried -- by a stream. getSimpleType :: forall a. C.Typed a => Stream a -> C.SimpleType getSimpleType _ = C.simpleType (C.typeOf :: C.Type a) - --------------------------------------------------------------------------------- From f9feab6bd88097a33854766997dd062b117f3f7c Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:06:35 -0400 Subject: [PATCH 0264/1222] Style: remove separating line in comment. Refs #316. According to our style guide, the code should not use lines with multiple consecutive hyphens, stars, or other symbols, to separate sections of code. --- copilot-language/src/Copilot/Language/Error.hs | 2 -- 1 file changed, 2 deletions(-) diff --git a/copilot-language/src/Copilot/Language/Error.hs b/copilot-language/src/Copilot/Language/Error.hs index e44c29156..54833c445 100644 --- a/copilot-language/src/Copilot/Language/Error.hs +++ b/copilot-language/src/Copilot/Language/Error.hs @@ -1,6 +1,4 @@ --------------------------------------------------------------------------------- -- Copyright © 2011 National Institute of Aerospace / Galois, Inc. --------------------------------------------------------------------------------- {-# LANGUAGE Safe #-} From 906749945d5e2a9903aa0c56a6c8bc532682a288 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:06:35 -0400 Subject: [PATCH 0265/1222] Style: remove separating line in comment. Refs #316. According to our style guide, the code should not use lines with multiple consecutive hyphens, stars, or other symbols, to separate sections of code. --- copilot-language/src/Copilot/Language/Interpret.hs | 6 ------ 1 file changed, 6 deletions(-) diff --git a/copilot-language/src/Copilot/Language/Interpret.hs b/copilot-language/src/Copilot/Language/Interpret.hs index 441fe2591..bf17e5e1f 100644 --- a/copilot-language/src/Copilot/Language/Interpret.hs +++ b/copilot-language/src/Copilot/Language/Interpret.hs @@ -22,8 +22,6 @@ import qualified Copilot.Core.Interpret as I import Copilot.Language.Spec (Spec) import Copilot.Language.Reify --------------------------------------------------------------------------------- - -- | Simulate a number of steps of a given specification, printing the results -- in a table in comma-separated value (CSV) format. csv :: Integer -> Spec -> IO () @@ -31,8 +29,6 @@ csv i spec = do putStrLn "Note: CSV format does not output observers." interpret' I.CSV i spec --------------------------------------------------------------------------------- - -- | Simulate a number of steps of a given specification, printing the results -- in a table in readable format. -- @@ -47,5 +43,3 @@ interpret' :: I.Format -> Integer -> Spec -> IO () interpret' format i spec = do coreSpec <- reify spec putStrLn $ I.interpret format (fromIntegral i) coreSpec - --------------------------------------------------------------------------------- From 12da330c4d0b4f3025d3eaaa271257ab6f79e695 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:06:35 -0400 Subject: [PATCH 0266/1222] Style: remove separating line in comment. Refs #316. According to our style guide, the code should not use lines with multiple consecutive hyphens, stars, or other symbols, to separate sections of code. --- copilot-language/src/Copilot/Language/Operators/Array.hs | 4 ---- 1 file changed, 4 deletions(-) diff --git a/copilot-language/src/Copilot/Language/Operators/Array.hs b/copilot-language/src/Copilot/Language/Operators/Array.hs index b51253ddb..70b9ce41e 100644 --- a/copilot-language/src/Copilot/Language/Operators/Array.hs +++ b/copilot-language/src/Copilot/Language/Operators/Array.hs @@ -18,8 +18,6 @@ import Copilot.Language.Stream (Stream (..)) import Data.Word (Word32) import GHC.TypeLits (KnownNat) --------------------------------------------------------------------------------- - -- | Create a stream that carries an element of an array in another stream. -- -- This function implements a projection of the element of an array at a given @@ -33,5 +31,3 @@ import GHC.TypeLits (KnownNat) , Typed t' ) => Stream (Array n t) -> Stream Word32 -> Stream t arr .!! n = Op2 (Index typeOf) arr n - --------------------------------------------------------------------------------- From 2eb907d4d8d61ec84fd25774bb71ad5f4272aa50 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:06:35 -0400 Subject: [PATCH 0267/1222] Style: remove separating line in comment. Refs #316. According to our style guide, the code should not use lines with multiple consecutive hyphens, stars, or other symbols, to separate sections of code. --- copilot-language/src/Copilot/Language/Operators/BitWise.hs | 2 -- 1 file changed, 2 deletions(-) diff --git a/copilot-language/src/Copilot/Language/Operators/BitWise.hs b/copilot-language/src/Copilot/Language/Operators/BitWise.hs index 376c876ee..8fc12e350 100644 --- a/copilot-language/src/Copilot/Language/Operators/BitWise.hs +++ b/copilot-language/src/Copilot/Language/Operators/BitWise.hs @@ -1,6 +1,4 @@ --------------------------------------------------------------------------------- -- Copyright © 2011 National Institute of Aerospace / Galois, Inc. --------------------------------------------------------------------------------- {-# LANGUAGE Safe #-} From e4dec2de5c25a15325a0043f617ff0676cf6041d Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:06:35 -0400 Subject: [PATCH 0268/1222] Style: remove separating line in comment. Refs #316. According to our style guide, the code should not use lines with multiple consecutive hyphens, stars, or other symbols, to separate sections of code. --- copilot-language/src/Copilot/Language/Operators/Boolean.hs | 6 ------ 1 file changed, 6 deletions(-) diff --git a/copilot-language/src/Copilot/Language/Operators/Boolean.hs b/copilot-language/src/Copilot/Language/Operators/Boolean.hs index bc60dc412..c6aa05f60 100644 --- a/copilot-language/src/Copilot/Language/Operators/Boolean.hs +++ b/copilot-language/src/Copilot/Language/Operators/Boolean.hs @@ -1,6 +1,4 @@ --------------------------------------------------------------------------------- -- Copyright © 2011 National Institute of Aerospace / Galois, Inc. --------------------------------------------------------------------------------- {-# LANGUAGE Safe #-} @@ -21,8 +19,6 @@ import Copilot.Language.Operators.Constant (constant) import Copilot.Language.Stream import qualified Prelude as P --------------------------------------------------------------------------------- - -- | A stream that contains the constant value 'True'. true :: Stream Bool true = constant True @@ -64,5 +60,3 @@ xor x y = ( not x && y ) || ( x && not y ) -- | Apply the implication ('==>') operator to two boolean streams, point-wise. (==>) :: Stream Bool -> Stream Bool -> Stream Bool x ==> y = not x || y - --------------------------------------------------------------------------------- From 353a4e5e085752f168c28cb52a8406acf2ab32cb Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:06:35 -0400 Subject: [PATCH 0269/1222] Style: remove separating line in comment. Refs #316. According to our style guide, the code should not use lines with multiple consecutive hyphens, stars, or other symbols, to separate sections of code. --- .../src/Copilot/Language/Operators/Cast.hs | 26 ------------------- 1 file changed, 26 deletions(-) diff --git a/copilot-language/src/Copilot/Language/Operators/Cast.hs b/copilot-language/src/Copilot/Language/Operators/Cast.hs index a733e064a..aad498c02 100644 --- a/copilot-language/src/Copilot/Language/Operators/Cast.hs +++ b/copilot-language/src/Copilot/Language/Operators/Cast.hs @@ -1,6 +1,4 @@ --------------------------------------------------------------------------------- -- Copyright © 2011 National Institute of Aerospace / Galois, Inc. --------------------------------------------------------------------------------- {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE Safe #-} @@ -16,8 +14,6 @@ import Copilot.Language.Stream import Data.Int import Data.Word --------------------------------------------------------------------------------- - -- | Class to capture casting between types for which it can be performed -- safely. class Cast a b where @@ -30,16 +26,12 @@ class UnsafeCast a b where -- | Perform an unsafe cast from @Stream a@ to @Stream b@. unsafeCast :: (Typed a, Typed b) => Stream a -> Stream b --------------------------------------------------------------------------------- - -- | Cast a boolean stream to a stream of numbers, producing 1 if the -- value at a point in time is 'True', and 0 otherwise. castBool :: (Eq a, Num a, Typed a) => Stream Bool -> Stream a castBool (Const bool) = Const $ if bool then 1 else 0 castBool x = Op3 (C.Mux typeOf) x 1 0 --------------------------------------------------------------------------------- - -- | Identity casting. instance Cast Bool Bool where cast = id @@ -84,15 +76,11 @@ instance Cast Bool Int32 where instance Cast Bool Int64 where cast = castBool --------------------------------------------------------------------------------- - -- | Cast a stream carrying numbers to an integral using 'fromIntegral'. castIntegral :: (Integral a, Typed a, Num b, Typed b) => Stream a -> Stream b castIntegral (Const x) = Const (fromIntegral x) castIntegral x = Op1 (C.Cast typeOf typeOf) x --------------------------------------------------------------------------------- - -- | Identity casting. instance Cast Word8 Word8 where cast = castIntegral @@ -121,8 +109,6 @@ instance Cast Word8 Int32 where instance Cast Word8 Int64 where cast = castIntegral --------------------------------------------------------------------------------- - -- | Identity casting. instance Cast Word16 Word16 where cast = castIntegral @@ -143,8 +129,6 @@ instance Cast Word16 Int32 where instance Cast Word16 Int64 where cast = castIntegral --------------------------------------------------------------------------------- - -- | Identity casting. instance Cast Word32 Word32 where cast = castIntegral @@ -157,14 +141,10 @@ instance Cast Word32 Word64 where instance Cast Word32 Int64 where cast = castIntegral --------------------------------------------------------------------------------- - -- | Identity casting. instance Cast Word64 Word64 where cast = castIntegral --------------------------------------------------------------------------------- - -- | Identity casting. instance Cast Int8 Int8 where cast = castIntegral @@ -181,8 +161,6 @@ instance Cast Int8 Int32 where instance Cast Int8 Int64 where cast = castIntegral --------------------------------------------------------------------------------- - -- | Identity casting. instance Cast Int16 Int16 where cast = castIntegral @@ -195,8 +173,6 @@ instance Cast Int16 Int32 where instance Cast Int16 Int64 where cast = castIntegral --------------------------------------------------------------------------------- - -- | Identity casting. instance Cast Int32 Int32 where cast = castIntegral @@ -205,8 +181,6 @@ instance Cast Int32 Int32 where instance Cast Int32 Int64 where cast = castIntegral --------------------------------------------------------------------------------- - -- | Identity casting. instance Cast Int64 Int64 where cast = castIntegral From 78d54afe5587865487ab4d69779fa72da3912579 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:06:35 -0400 Subject: [PATCH 0270/1222] Style: remove separating line in comment. Refs #316. According to our style guide, the code should not use lines with multiple consecutive hyphens, stars, or other symbols, to separate sections of code. --- copilot-language/src/Copilot/Language/Operators/Constant.hs | 6 ------ 1 file changed, 6 deletions(-) diff --git a/copilot-language/src/Copilot/Language/Operators/Constant.hs b/copilot-language/src/Copilot/Language/Operators/Constant.hs index 060477e86..38bab6209 100644 --- a/copilot-language/src/Copilot/Language/Operators/Constant.hs +++ b/copilot-language/src/Copilot/Language/Operators/Constant.hs @@ -1,6 +1,4 @@ --------------------------------------------------------------------------------- -- Copyright © 2011 National Institute of Aerospace / Galois, Inc. --------------------------------------------------------------------------------- {-# LANGUAGE Safe #-} @@ -26,15 +24,11 @@ import Copilot.Language.Stream import Data.Word import Data.Int --------------------------------------------------------------------------------- - -- | Create a constant stream that is equal to the given argument, at any -- point in time. constant :: Typed a => a -> Stream a constant = Const --------------------------------------------------------------------------------- - -- | Create a constant stream carrying values of type 'Bool' that is equal to -- the given argument, at any point in time. constB :: Bool -> Stream Bool From 789d603b15db95f9304a6a2c44f3aa18b6365676 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:06:35 -0400 Subject: [PATCH 0271/1222] Style: remove separating line in comment. Refs #316. According to our style guide, the code should not use lines with multiple consecutive hyphens, stars, or other symbols, to separate sections of code. --- copilot-language/src/Copilot/Language/Operators/Eq.hs | 6 ------ 1 file changed, 6 deletions(-) diff --git a/copilot-language/src/Copilot/Language/Operators/Eq.hs b/copilot-language/src/Copilot/Language/Operators/Eq.hs index 1699c06b4..27df11dfb 100644 --- a/copilot-language/src/Copilot/Language/Operators/Eq.hs +++ b/copilot-language/src/Copilot/Language/Operators/Eq.hs @@ -1,6 +1,4 @@ --------------------------------------------------------------------------------- -- Copyright © 2011 National Institute of Aerospace / Galois, Inc. --------------------------------------------------------------------------------- {-# LANGUAGE Safe #-} @@ -16,8 +14,6 @@ import Copilot.Language.Prelude import Copilot.Language.Stream import qualified Prelude as P --------------------------------------------------------------------------------- - -- | Compare two streams point-wise for equality. -- -- The output stream contains the value True at a point in time if both @@ -33,5 +29,3 @@ x == y = Op2 (Core.Eq typeOf) x y (/=) :: (P.Eq a, Typed a) => Stream a -> Stream a -> Stream Bool (Const x) /= (Const y) = Const (x P./= y) x /= y = Op2 (Core.Ne typeOf) x y - --------------------------------------------------------------------------------- From e2095c33c48b124681bda1953198e2e548bdccc0 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:06:35 -0400 Subject: [PATCH 0272/1222] Style: remove separating line in comment. Refs #316. According to our style guide, the code should not use lines with multiple consecutive hyphens, stars, or other symbols, to separate sections of code. --- copilot-language/src/Copilot/Language/Operators/Extern.hs | 6 ------ 1 file changed, 6 deletions(-) diff --git a/copilot-language/src/Copilot/Language/Operators/Extern.hs b/copilot-language/src/Copilot/Language/Operators/Extern.hs index 550ca1ee0..b6ea32533 100644 --- a/copilot-language/src/Copilot/Language/Operators/Extern.hs +++ b/copilot-language/src/Copilot/Language/Operators/Extern.hs @@ -1,6 +1,4 @@ --------------------------------------------------------------------------------- -- Copyright © 2011 National Institute of Aerospace / Galois, Inc. --------------------------------------------------------------------------------- -- | Primitives to build streams connected to external variables. @@ -26,8 +24,6 @@ import Copilot.Language.Stream import Data.Word import Data.Int --------------------------------------------------------------------------------- - -- | Create a stream populated by an external global variable. -- -- The Copilot compiler does not check that the type is correct. If the list @@ -42,8 +38,6 @@ extern :: Typed a -> Stream a extern = Extern --------------------------------------------------------------------------------- - -- | Create a stream carrying values of type Bool, populated by an external -- global variable. externB :: String -- ^ Name of the global variable to make accessible. From ba6ef2c3f2cba4689ef16e29acef17fef5be18bc Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:06:35 -0400 Subject: [PATCH 0273/1222] Style: remove separating line in comment. Refs #316. According to our style guide, the code should not use lines with multiple consecutive hyphens, stars, or other symbols, to separate sections of code. --- copilot-language/src/Copilot/Language/Operators/Integral.hs | 6 ------ 1 file changed, 6 deletions(-) diff --git a/copilot-language/src/Copilot/Language/Operators/Integral.hs b/copilot-language/src/Copilot/Language/Operators/Integral.hs index d4b479b34..e4d052490 100644 --- a/copilot-language/src/Copilot/Language/Operators/Integral.hs +++ b/copilot-language/src/Copilot/Language/Operators/Integral.hs @@ -1,6 +1,4 @@ --------------------------------------------------------------------------------- -- Copyright © 2011 National Institute of Aerospace / Galois, Inc. --------------------------------------------------------------------------------- -- | Integral class operators applied point-wise on streams. @@ -22,8 +20,6 @@ import qualified Data.Bits as B import qualified Prelude as P import Data.List (foldl', replicate) --------------------------------------------------------------------------------- - -- | Apply the 'Prelude.div' operation to two streams, point-wise. div :: (Typed a, P.Integral a) => Stream a -> Stream a -> Stream a (Const 0) `div` _ = Const 0 @@ -51,5 +47,3 @@ x `mod` y = Op2 (Core.Mod typeOf) x y (Const 2) ^ y = (Const 1) .<<. y x ^ (Const y) = foldl' ((P.*)) (Const 1) (replicate (P.fromIntegral y) x) _ ^ _ = Err.badUsage "in ^: in x ^ y, either x must be the constant 2, or y must be a constant. (Do not confuse ^ with bitwise XOR (.^.) or with ** for exponentation of floats/doubles.)" - --------------------------------------------------------------------------------- From b2e769ae34001b8dd6ce586df2c51d41d5aa57a7 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:06:35 -0400 Subject: [PATCH 0274/1222] Style: remove separating line in comment. Refs #316. According to our style guide, the code should not use lines with multiple consecutive hyphens, stars, or other symbols, to separate sections of code. --- copilot-language/src/Copilot/Language/Operators/Label.hs | 6 ------ 1 file changed, 6 deletions(-) diff --git a/copilot-language/src/Copilot/Language/Operators/Label.hs b/copilot-language/src/Copilot/Language/Operators/Label.hs index 7d4e65a82..f5c2b3359 100644 --- a/copilot-language/src/Copilot/Language/Operators/Label.hs +++ b/copilot-language/src/Copilot/Language/Operators/Label.hs @@ -1,6 +1,4 @@ --------------------------------------------------------------------------------- -- Copyright © 2011 National Institute of Aerospace / Galois, Inc. --------------------------------------------------------------------------------- -- | Label a stream with additional information. @@ -13,8 +11,6 @@ module Copilot.Language.Operators.Label import Copilot.Core (Typed) import Copilot.Language.Stream (Stream (..)) --------------------------------------------------------------------------------- - -- | This function allows you to label a stream with a tag, which can be used -- by different backends to provide additional information either in error -- messages or in the generated code (e.g., for traceability purposes). @@ -24,5 +20,3 @@ import Copilot.Language.Stream (Stream (..)) -- is used in the code generated is a decision specific to each backend. label :: (Typed a) => String -> Stream a -> Stream a label = Label - --------------------------------------------------------------------------------- From 080915f504d72d828473a1e1eab94abad46c2600 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:06:36 -0400 Subject: [PATCH 0275/1222] Style: remove separating line in comment. Refs #316. According to our style guide, the code should not use lines with multiple consecutive hyphens, stars, or other symbols, to separate sections of code. --- copilot-language/src/Copilot/Language/Operators/Local.hs | 6 ------ 1 file changed, 6 deletions(-) diff --git a/copilot-language/src/Copilot/Language/Operators/Local.hs b/copilot-language/src/Copilot/Language/Operators/Local.hs index 8c95e6b5f..c80eb4f06 100644 --- a/copilot-language/src/Copilot/Language/Operators/Local.hs +++ b/copilot-language/src/Copilot/Language/Operators/Local.hs @@ -1,6 +1,4 @@ --------------------------------------------------------------------------------- -- Copyright © 2011 National Institute of Aerospace / Galois, Inc. --------------------------------------------------------------------------------- -- | Let expressions. -- @@ -18,8 +16,6 @@ module Copilot.Language.Operators.Local import Copilot.Core (Typed) import Copilot.Language.Stream (Stream (..)) --------------------------------------------------------------------------------- - -- | Let expressions. -- -- Create a stream that results from applying a stream to a function on @@ -33,5 +29,3 @@ import Copilot.Language.Stream (Stream (..)) -- @ local :: (Typed a, Typed b) => Stream a -> (Stream a -> Stream b) -> Stream b local = Local - --------------------------------------------------------------------------------- From f5628821bf753c7cbff010596f5a5045ea32954d Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:06:36 -0400 Subject: [PATCH 0276/1222] Style: remove separating line in comment. Refs #316. According to our style guide, the code should not use lines with multiple consecutive hyphens, stars, or other symbols, to separate sections of code. --- copilot-language/src/Copilot/Language/Operators/Mux.hs | 8 -------- 1 file changed, 8 deletions(-) diff --git a/copilot-language/src/Copilot/Language/Operators/Mux.hs b/copilot-language/src/Copilot/Language/Operators/Mux.hs index a4b804b0a..d462817b8 100644 --- a/copilot-language/src/Copilot/Language/Operators/Mux.hs +++ b/copilot-language/src/Copilot/Language/Operators/Mux.hs @@ -1,6 +1,4 @@ --------------------------------------------------------------------------------- -- Copyright © 2011 National Institute of Aerospace / Galois, Inc. --------------------------------------------------------------------------------- {-# LANGUAGE Safe #-} @@ -17,16 +15,12 @@ import Copilot.Language.Prelude import Copilot.Language.Stream import Prelude () --------------------------------------------------------------------------------- - -- | Convenient synonym for 'ifThenElse'. mux :: Typed a => Stream Bool -> Stream a -> Stream a -> Stream a mux (Const True) t _ = t mux (Const False) _ f = f mux b t f = Op3 (Core.Mux typeOf) b t f --------------------------------------------------------------------------------- - -- | If-then-else applied point-wise to three streams (a condition stream, a -- then-branch stream, and an else-branch stream). -- @@ -35,5 +29,3 @@ mux b t f = Op3 (Core.Mux typeOf) b t f -- that time, otherwise it contains the value in the third stream. ifThenElse :: Typed a => Stream Bool -> Stream a -> Stream a -> Stream a ifThenElse = mux - --------------------------------------------------------------------------------- From 25431881997ce376b0d03495380251e9767d4b08 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:06:36 -0400 Subject: [PATCH 0277/1222] Style: remove separating line in comment. Refs #316. According to our style guide, the code should not use lines with multiple consecutive hyphens, stars, or other symbols, to separate sections of code. --- copilot-language/src/Copilot/Language/Operators/Ord.hs | 6 ------ 1 file changed, 6 deletions(-) diff --git a/copilot-language/src/Copilot/Language/Operators/Ord.hs b/copilot-language/src/Copilot/Language/Operators/Ord.hs index cc9c5811b..36a1a4ecc 100644 --- a/copilot-language/src/Copilot/Language/Operators/Ord.hs +++ b/copilot-language/src/Copilot/Language/Operators/Ord.hs @@ -1,6 +1,4 @@ --------------------------------------------------------------------------------- -- Copyright © 2011 National Institute of Aerospace / Galois, Inc. --------------------------------------------------------------------------------- {-# LANGUAGE Safe #-} @@ -18,8 +16,6 @@ import Copilot.Language.Prelude import Copilot.Language.Stream import qualified Prelude as P --------------------------------------------------------------------------------- - -- | Compare two streams point-wise for order. -- -- The output stream contains the value True at a point in time if the @@ -55,5 +51,3 @@ x < y = Op2 (Core.Lt typeOf) x y (>) :: (P.Ord a, Typed a) => Stream a -> Stream a -> Stream Bool (Const x) > (Const y) = Const (x P.> y) x > y = Op2 (Core.Gt typeOf) x y - --------------------------------------------------------------------------------- From 31791e7e5e3ada4b6bbefb7f527ca2aa1d38af53 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:06:36 -0400 Subject: [PATCH 0278/1222] Style: remove separating line in comment. Refs #316. According to our style guide, the code should not use lines with multiple consecutive hyphens, stars, or other symbols, to separate sections of code. --- .../src/Copilot/Language/Operators/Propositional.hs | 6 ------ 1 file changed, 6 deletions(-) diff --git a/copilot-language/src/Copilot/Language/Operators/Propositional.hs b/copilot-language/src/Copilot/Language/Operators/Propositional.hs index bb121000e..abef3b2b0 100644 --- a/copilot-language/src/Copilot/Language/Operators/Propositional.hs +++ b/copilot-language/src/Copilot/Language/Operators/Propositional.hs @@ -1,6 +1,4 @@ --------------------------------------------------------------------------------- -- Copyright © 2011 National Institute of Aerospace / Galois, Inc. --------------------------------------------------------------------------------- {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} @@ -19,8 +17,6 @@ import qualified Copilot.Language.Operators.Boolean as B import Copilot.Theorem --------------------------------------------------------------------------------- - -- | A proposition that can be negated. class Negatable a b where -- | Negate a proposition. @@ -33,5 +29,3 @@ instance Negatable (Prop Existential) (Prop Universal) where -- | Negation of a universally quantified proposition. instance Negatable (Prop Universal) (Prop Existential) where not (Forall p) = Exists $ B.not p - --------------------------------------------------------------------------------- From b35e21dda27866f3187b62982c5f388c68292995 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:06:36 -0400 Subject: [PATCH 0279/1222] Style: remove separating line in comment. Refs #316. According to our style guide, the code should not use lines with multiple consecutive hyphens, stars, or other symbols, to separate sections of code. --- copilot-language/src/Copilot/Language/Operators/Struct.hs | 4 ---- 1 file changed, 4 deletions(-) diff --git a/copilot-language/src/Copilot/Language/Operators/Struct.hs b/copilot-language/src/Copilot/Language/Operators/Struct.hs index e604ad864..78f4d037d 100644 --- a/copilot-language/src/Copilot/Language/Operators/Struct.hs +++ b/copilot-language/src/Copilot/Language/Operators/Struct.hs @@ -11,8 +11,6 @@ import Copilot.Language.Stream (Stream (..)) import GHC.TypeLits (KnownSymbol) --------------------------------------------------------------------------------- - -- | Create a stream that carries a field of a struct in another stream. -- -- This function implements a projection of a field of a struct over time. For @@ -23,5 +21,3 @@ import GHC.TypeLits (KnownSymbol) (#) :: (KnownSymbol s, Typed t, Typed a, Struct a) => Stream a -> (a -> Field s t) -> Stream t (#) s f = Op1 (GetField typeOf typeOf f) s - --------------------------------------------------------------------------------- From df00d400a366432a6132c907c8f130566bd84206 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:06:36 -0400 Subject: [PATCH 0280/1222] Style: remove separating line in comment. Refs #316. According to our style guide, the code should not use lines with multiple consecutive hyphens, stars, or other symbols, to separate sections of code. --- copilot-language/src/Copilot/Language/Operators/Temporal.hs | 4 ---- 1 file changed, 4 deletions(-) diff --git a/copilot-language/src/Copilot/Language/Operators/Temporal.hs b/copilot-language/src/Copilot/Language/Operators/Temporal.hs index 1295fc19f..37b0d9a22 100644 --- a/copilot-language/src/Copilot/Language/Operators/Temporal.hs +++ b/copilot-language/src/Copilot/Language/Operators/Temporal.hs @@ -1,6 +1,4 @@ --------------------------------------------------------------------------------- -- Copyright © 2011 National Institute of Aerospace / Galois, Inc. --------------------------------------------------------------------------------- {-# LANGUAGE Safe #-} @@ -15,8 +13,6 @@ import Copilot.Language.Prelude import Copilot.Language.Stream import Prelude () --------------------------------------------------------------------------------- - infixr 1 ++ -- | Prepend a fixed number of samples to a stream. From 5af6707ade915cb65cc30e074ec5e044ef0543ff Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:06:36 -0400 Subject: [PATCH 0281/1222] Style: remove separating line in comment. Refs #316. According to our style guide, the code should not use lines with multiple consecutive hyphens, stars, or other symbols, to separate sections of code. --- copilot-language/src/Copilot/Language/Prelude.hs | 4 ---- 1 file changed, 4 deletions(-) diff --git a/copilot-language/src/Copilot/Language/Prelude.hs b/copilot-language/src/Copilot/Language/Prelude.hs index 70596c2af..aa7ebf51e 100644 --- a/copilot-language/src/Copilot/Language/Prelude.hs +++ b/copilot-language/src/Copilot/Language/Prelude.hs @@ -1,6 +1,4 @@ --------------------------------------------------------------------------------- -- Copyright © 2011 National Institute of Aerospace / Galois, Inc. --------------------------------------------------------------------------------- -- | Reexports 'Prelude' from package "base" hiding identifiers redefined by -- Copilot. @@ -31,5 +29,3 @@ import Prelude hiding , cycle , take ) - --------------------------------------------------------------------------------- From 2f0fd47359c1193eb36fdb24b855a3346287b594 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:06:36 -0400 Subject: [PATCH 0282/1222] Style: remove separating line in comment. Refs #316. According to our style guide, the code should not use lines with multiple consecutive hyphens, stars, or other symbols, to separate sections of code. --- copilot-language/src/Copilot/Language/Reify.hs | 15 --------------- 1 file changed, 15 deletions(-) diff --git a/copilot-language/src/Copilot/Language/Reify.hs b/copilot-language/src/Copilot/Language/Reify.hs index 96cc690f1..2202698d6 100644 --- a/copilot-language/src/Copilot/Language/Reify.hs +++ b/copilot-language/src/Copilot/Language/Reify.hs @@ -1,6 +1,4 @@ --------------------------------------------------------------------------------- -- Copyright © 2011 National Institute of Aerospace / Galois, Inc. --------------------------------------------------------------------------------- -- | Transform a Copilot Language specification into a Copilot Core -- specification. @@ -29,7 +27,6 @@ import System.Mem.StableName.Dynamic import System.Mem.StableName.Map (Map) import qualified System.Mem.StableName.Map as M import Control.Monad (liftM, unless) --------------------------------------------------------------------------------- -- | Transform a Copilot Language specification into a Copilot Core -- specification. @@ -59,8 +56,6 @@ reify spec = do return cspec --------------------------------------------------------------------------------- - -- | Transform a Copilot observer specification into a Copilot Core -- observer specification. {-# INLINE mkObserver #-} @@ -77,8 +72,6 @@ mkObserver refMkId refStreams refMap (Observer name e) = do , Core.observerExpr = w , Core.observerExprType = typeOf } --------------------------------------------------------------------------------- - -- | Transform a Copilot trigger specification into a Copilot Core -- trigger specification. {-# INLINE mkTrigger #-} @@ -103,8 +96,6 @@ mkTrigger refMkId refStreams refMap (Trigger name guard args) = do w <- mkExpr refMkId refStreams refMap e return $ Core.UExpr typeOf w --------------------------------------------------------------------------------- - -- | Transform a Copilot property specification into a Copilot Core -- property specification. {-# INLINE mkProperty #-} @@ -120,8 +111,6 @@ mkProperty refMkId refStreams refMap (Property name guard) = do { Core.propertyName = name , Core.propertyExpr = w1 } --------------------------------------------------------------------------------- - -- | Transform a Copilot stream expression into a Copilot Core expression. {-# INLINE mkExpr #-} mkExpr @@ -211,8 +200,6 @@ mkExpr refMkId refStreams refMap = go w <- mkExpr refMkId refStreams refMap e return $ (name, Core.UExpr typeOf w) --------------------------------------------------------------------------------- - -- | Transform a Copilot stream expression into a Copilot Core stream -- expression. {-# INLINE mkStream #-} @@ -258,8 +245,6 @@ mkStream refMkId refStreams refMap e0 = do , Core.streamExprType = typeOf } return id --------------------------------------------------------------------------------- - -- | Create a fresh, unused 'Id'. mkId :: IORef Int -> IO Id mkId refMkId = atomicModifyIORef refMkId $ \ n -> (succ n, n) From bfe795d6857cb61c184cd53f7278269336fbff32 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:06:36 -0400 Subject: [PATCH 0283/1222] Style: remove separating line in comment. Refs #316. According to our style guide, the code should not use lines with multiple consecutive hyphens, stars, or other symbols, to separate sections of code. --- copilot-language/src/Copilot/Language/Spec.hs | 30 ------------------- 1 file changed, 30 deletions(-) diff --git a/copilot-language/src/Copilot/Language/Spec.hs b/copilot-language/src/Copilot/Language/Spec.hs index 08659b27c..c6ec11caf 100644 --- a/copilot-language/src/Copilot/Language/Spec.hs +++ b/copilot-language/src/Copilot/Language/Spec.hs @@ -1,6 +1,4 @@ --------------------------------------------------------------------------------- -- Copyright © 2011 National Institute of Aerospace / Galois, Inc. --------------------------------------------------------------------------------- {-# LANGUAGE GADTs #-} {-# LANGUAGE KindSignatures #-} @@ -43,8 +41,6 @@ import Copilot.Language.Stream import Copilot.Theorem.Prove --------------------------------------------------------------------------------- - -- | A specification is a list of declarations of triggers, observers, -- properties and theorems. -- @@ -68,8 +64,6 @@ type Spec = Writer [SpecItem] () -- can be used in subsequent actions. type Spec' a = Writer [SpecItem] a --------------------------------------------------------------------------------- - -- | Return the complete list of declarations inside a 'Spec' or 'Spec''. -- -- The word run in this function is unrelated to running the underlying @@ -78,8 +72,6 @@ type Spec' a = Writer [SpecItem] a runSpec :: Spec' a -> [SpecItem] runSpec = execWriter --------------------------------------------------------------------------------- - -- | Filter a list of spec items to keep only the observers. observers :: [SpecItem] -> [Observer] observers = @@ -120,8 +112,6 @@ theorems = TheoremItem p -> p : ls _ -> ls --------------------------------------------------------------------------------- - -- | An item of a Copilot specification. data SpecItem = ObserverItem Observer @@ -129,15 +119,11 @@ data SpecItem | PropertyItem Property | TheoremItem (Property, UProof) --------------------------------------------------------------------------------- - -- | An observer, representing a stream that we observe during execution at -- every sample. data Observer where Observer :: Typed a => String -> Stream a -> Observer --------------------------------------------------------------------------------- - -- | Define a new observer as part of a specification. This allows someone to -- print the value at every iteration during interpretation. Observers do not -- have any functionality outside the interpreter. @@ -148,15 +134,11 @@ observer :: Typed a -> Spec observer name e = tell [ObserverItem $ Observer name e] --------------------------------------------------------------------------------- - -- | A trigger, representing a function we execute when a boolean stream becomes -- true at a sample. data Trigger where Trigger :: Core.Name -> Stream Bool -> [Arg] -> Trigger --------------------------------------------------------------------------------- - -- | Define a new trigger as part of a specification. A trigger declares which -- external function, or handler, will be called when a guard defined by a -- boolean stream becomes true. @@ -166,15 +148,11 @@ trigger :: String -- ^ Name of the handler to be called. -> Spec trigger name e args = tell [TriggerItem $ Trigger name e args] --------------------------------------------------------------------------------- - -- | A property, representing a boolean stream that is existentially or -- universally quantified over time. data Property where Property :: String -> Stream Bool -> Property --------------------------------------------------------------------------------- - -- | A proposition, representing the quantification of a boolean streams over -- time. data Prop a where @@ -194,8 +172,6 @@ extractProp :: Prop a -> Stream Bool extractProp (Forall p) = p extractProp (Exists p) = p --------------------------------------------------------------------------------- - -- | A proposition, representing a boolean stream that is existentially or -- universally quantified over time, as part of a specification. -- @@ -205,8 +181,6 @@ prop :: String -> Prop a -> Writer [SpecItem] (PropRef a) prop name e = tell [PropertyItem $ Property name (extractProp e)] >> return (PropRef name) --------------------------------------------------------------------------------- - -- | A theorem, or proposition together with a proof. -- -- This function returns, in the monadic context, a reference to the @@ -215,8 +189,6 @@ theorem :: String -> Prop a -> Proof a -> Writer [SpecItem] (PropRef a) theorem name e (Proof p) = tell [TheoremItem (Property name (extractProp e), p)] >> return (PropRef name) --------------------------------------------------------------------------------- - -- | Construct a function argument from a stream. -- -- 'Arg's can be used to pass arguments to handlers or trigger functions, to @@ -226,5 +198,3 @@ theorem name e (Proof p) = tell [TheoremItem (Property name (extractProp e), p)] -- the current samples of the given streams. arg :: Typed a => Stream a -> Arg arg = Arg - --------------------------------------------------------------------------------- From 5d0f1581f69e1da19aa65431840b28bbe353fb7b Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:06:36 -0400 Subject: [PATCH 0284/1222] Style: remove separating line in comment. Refs #316. According to our style guide, the code should not use lines with multiple consecutive hyphens, stars, or other symbols, to separate sections of code. --- .../src/Copilot/Language/Stream.hs | 20 ------------------- 1 file changed, 20 deletions(-) diff --git a/copilot-language/src/Copilot/Language/Stream.hs b/copilot-language/src/Copilot/Language/Stream.hs index 4cf042588..d8689a4a5 100644 --- a/copilot-language/src/Copilot/Language/Stream.hs +++ b/copilot-language/src/Copilot/Language/Stream.hs @@ -1,6 +1,4 @@ --------------------------------------------------------------------------------- -- Copyright © 2011 National Institute of Aerospace / Galois, Inc. --------------------------------------------------------------------------------- -- | Abstract syntax for streams and operators. @@ -23,8 +21,6 @@ import Copilot.Language.Error import Copilot.Language.Prelude import qualified Prelude as P --------------------------------------------------------------------------------- - -- | A stream in Copilot is an infinite succession of values of the same type. -- -- Streams can be built using simple primities (e.g., 'Const'), by applying @@ -52,27 +48,19 @@ data Stream :: * -> * where => Core.Op3 a b c d -> Stream a -> Stream b -> Stream c -> Stream d Label :: Typed a => String -> Stream a -> Stream a --------------------------------------------------------------------------------- - -- | Wrapper to use 'Stream's as arguments to triggers. data Arg where Arg :: Typed a => Stream a -> Arg --------------------------------------------------------------------------------- - -- | Dummy instance in order to make 'Stream' an instance of 'Num'. instance Show (Stream a) where show _ = "Stream" --------------------------------------------------------------------------------- - -- | Dummy instance in order to make 'Stream' an instance of 'Num'. instance P.Eq (Stream a) where (==) = badUsage "'Prelude.(==)' isn't implemented for streams!" (/=) = badUsage "'Prelude.(/=)' isn't implemented for streams!" --------------------------------------------------------------------------------- - -- | Streams carrying numbers are instances of 'Num', and you can apply to them -- the 'Num' functions, point-wise. instance (Typed a, P.Eq a, Num a) => Num (Stream a) where @@ -100,8 +88,6 @@ instance (Typed a, P.Eq a, Num a) => Num (Stream a) where fromInteger = Const . fromInteger --------------------------------------------------------------------------------- - -- | Streams carrying fractional numbers are instances of 'Fractional', and you can -- apply to them the 'Fractional' functions, point-wise. @@ -115,8 +101,6 @@ instance (Typed a, P.Eq a, Fractional a) => Fractional (Stream a) where fromRational = Const . fromRational --------------------------------------------------------------------------------- - -- | Streams carrying floating point numbers are instances of 'Floating', and -- you can apply to them the 'Floating' functions, point-wise. @@ -142,8 +126,6 @@ instance (Typed a, Eq a, Floating a) => Floating (Stream a) where atanh = Op1 (Core.Atanh typeOf) acosh = Op1 (Core.Acosh typeOf) --------------------------------------------------------------------------------- - -- | Point-wise application of @ceiling@ to a stream. -- -- Unlike the Haskell variant of this function, this variant takes and returns @@ -176,8 +158,6 @@ ceiling = Op1 (Core.Ceiling typeOf) floor :: (Typed a, RealFrac a) => Stream a -> Stream a floor = Op1 (Core.Floor typeOf) --------------------------------------------------------------------------------- - -- | Point-wise application of @atan2@ to the values of two streams. -- -- For each pair of real floating-point samples @x@ and @y@, one from each From 33560652680f6b3f71d9a959f5d86fd1b05ce8f5 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:06:36 -0400 Subject: [PATCH 0285/1222] Style: remove separating line in comment. Refs #316. According to our style guide, the code should not use lines with multiple consecutive hyphens, stars, or other symbols, to separate sections of code. --- copilot-language/src/System/Mem/StableName/Dynamic.hs | 2 -- 1 file changed, 2 deletions(-) diff --git a/copilot-language/src/System/Mem/StableName/Dynamic.hs b/copilot-language/src/System/Mem/StableName/Dynamic.hs index fdea7036b..0d281d206 100644 --- a/copilot-language/src/System/Mem/StableName/Dynamic.hs +++ b/copilot-language/src/System/Mem/StableName/Dynamic.hs @@ -1,6 +1,4 @@ --------------------------------------------------------------------------------- -- Copyright © 2011 National Institute of Aerospace / Galois, Inc. --------------------------------------------------------------------------------- {-# LANGUAGE Trustworthy #-} From f964c1bc31aeefbd99e16ac0201f7fcc6ceea2cf Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:06:36 -0400 Subject: [PATCH 0286/1222] Style: remove separating line in comment. Refs #316. According to our style guide, the code should not use lines with multiple consecutive hyphens, stars, or other symbols, to separate sections of code. --- copilot-language/src/System/Mem/StableName/Map.hs | 2 -- 1 file changed, 2 deletions(-) diff --git a/copilot-language/src/System/Mem/StableName/Map.hs b/copilot-language/src/System/Mem/StableName/Map.hs index 9e96e5d48..5577385dc 100644 --- a/copilot-language/src/System/Mem/StableName/Map.hs +++ b/copilot-language/src/System/Mem/StableName/Map.hs @@ -1,6 +1,4 @@ --------------------------------------------------------------------------------- -- Most of this code is taken from 'http://github.com/ekmett/stable-maps'. --------------------------------------------------------------------------------- {-# LANGUAGE Safe #-} From d067f794311298d2af368c13d4a959e73d49a31e Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:06:36 -0400 Subject: [PATCH 0287/1222] Style: remove separating line in comment. Refs #316. According to our style guide, the code should not use lines with multiple consecutive hyphens, stars, or other symbols, to separate sections of code. --- copilot-theorem/examples/BoyerMoore.hs | 12 ------------ 1 file changed, 12 deletions(-) diff --git a/copilot-theorem/examples/BoyerMoore.hs b/copilot-theorem/examples/BoyerMoore.hs index bf4d144d0..f32c5a30a 100644 --- a/copilot-theorem/examples/BoyerMoore.hs +++ b/copilot-theorem/examples/BoyerMoore.hs @@ -1,5 +1,3 @@ --------------------------------------------------------------------------------- - {-# LANGUAGE RebindableSyntax #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -18,8 +16,6 @@ import Data.String (fromString) import qualified Prelude as P import qualified Data.List as L --------------------------------------------------------------------------------- - length :: [a] -> Stream Word8 length l = constant (fromInteger $ L.genericLength l) @@ -32,8 +28,6 @@ arbitraryCst s = c i = extern s Nothing c = if t == 0 then i else [uninitialized (typeOf :: Type a)] ++ c --------------------------------------------------------------------------------- - majorityVote :: forall a . (Typed a, Eq a) => [Stream a] -> Stream a majorityVote [] = error "empty list" majorityVote (x : xs) = aux x 1 xs @@ -55,8 +49,6 @@ okWith a l maj = (a /= maj) ==> ((2 * count a l) <= length l) count _e [] = 0 count e (x : xs) = (if x == e then 1 else 0) + count e xs --------------------------------------------------------------------------------- - spec = do forM_ (zip [1..] ss) $ \(k :: Int, s) -> observer ((P.++) "s" (show k)) s @@ -78,13 +70,9 @@ spec = do maj = majorityVote ss --------------------------------------------------------------------------------- - induct :: Proof Universal induct = induction def { nraNLSat = False, debug = False } --------------------------------------------------------------------------------- - -- | Initial value for a given type. -- -- Does not support structs or arrays. From 5a0aa5c405573bc743c2ff078219d09e3675928f Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:06:36 -0400 Subject: [PATCH 0288/1222] Style: remove separating line in comment. Refs #316. According to our style guide, the code should not use lines with multiple consecutive hyphens, stars, or other symbols, to separate sections of code. --- copilot-theorem/examples/SerialBoyerMoore.hs | 5 ----- 1 file changed, 5 deletions(-) diff --git a/copilot-theorem/examples/SerialBoyerMoore.hs b/copilot-theorem/examples/SerialBoyerMoore.hs index 050dde4b1..f34c0fa1f 100644 --- a/copilot-theorem/examples/SerialBoyerMoore.hs +++ b/copilot-theorem/examples/SerialBoyerMoore.hs @@ -1,4 +1,3 @@ --------------------------------------------------------------------------------- {-# LANGUAGE RebindableSyntax #-} module SerialBoyerMoore where @@ -10,8 +9,6 @@ import Copilot.Theorem.Prover.Z3 import Prelude () import Data.String (fromString) --------------------------------------------------------------------------------- - conj :: [Stream Bool] -> Stream Bool conj = foldl (&&) true @@ -57,8 +54,6 @@ spec = do input = externW64 "in" (Just [1, 1, 2, 1, 2, 2, 1, 2, 2, 1, 2, 1]) (p, s, j) = majority input --------------------------------------------------------------------------------- - induct :: Proof Universal induct = induction def { nraNLSat = False, debug = False } From 5e447933600aa124f9af1e7ef3ea5b2397ea6675 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:06:36 -0400 Subject: [PATCH 0289/1222] Style: remove separating line in comment. Refs #316. According to our style guide, the code should not use lines with multiple consecutive hyphens, stars, or other symbols, to separate sections of code. --- copilot-theorem/examples/SphericalWCV.hs | 24 ------------------------ 1 file changed, 24 deletions(-) diff --git a/copilot-theorem/examples/SphericalWCV.hs b/copilot-theorem/examples/SphericalWCV.hs index f690c46f8..1454db220 100644 --- a/copilot-theorem/examples/SphericalWCV.hs +++ b/copilot-theorem/examples/SphericalWCV.hs @@ -97,9 +97,7 @@ vOx, vOy, vOz :: Stream Double vIx, vIy, vIz :: Stream Double (vIx, vIy, vIz) = (gsI * sin trkI, gsI * cos trkI, vsI) --------------------------------- -- latI velocity/position -- --------------------------------- vx, vy, vz :: Stream Double (vx, vy, vz) = (vOx - vIx, vOy - vIy, vOz - vIz) @@ -113,9 +111,7 @@ sx, sy, sz :: Stream Double s :: Vect2 s = (sx, sy) ------------------- -- Vector stuff -- ------------------- (|*|) :: Vect2 -> Vect2 -> Stream Double (|*|) (x1, y1) (x2, y2) = (x1 * x2) + (y1 * y2) @@ -135,9 +131,7 @@ a ~= b = abs (a - b) < 0.001 neg :: Vect2 -> Vect2 neg (x, y) = (negate x, negate y) --------------------- -- Time variables -- --------------------- tau :: Vect2 -> Vect2 -> Stream Double tau s v = mux (s |*| v < 0) ((-(sq s)) / (s |*| v)) (-1) @@ -160,9 +154,7 @@ delta s v d = d * d * sq v - (det s v * det s v) theta :: Vect2 -> Vect2 -> Stream Double -> Stream Double -> Stream Double theta s v d e = (-(s |*| v) + e * sqrt (delta s v d)) / sq v --------------------------- -- Some tools for times -- --------------------------- tcoa :: Stream Double -> Stream Double -> Stream Double tcoa sz vz = mux ((sz * vz) < 0) ((-sz) / vz) (-1) @@ -170,9 +162,7 @@ tcoa sz vz = mux ((sz * vz) < 0) ((-sz) / vz) (-1) dcpa :: Vect2 -> Vect2 -> Stream Double dcpa s@(sx, sy) v@(vx, vy) = norm (sx + tcpa s v * vx, sy + tcpa s v * vy) --------------------------- -- Well clear Violation -- --------------------------- wcv :: (Vect2 -> Vect2 -> Stream Double) -> Vect2 -> Stream Double -> @@ -186,22 +176,16 @@ verticalWCV sz vz = (abs sz <= zthr) || (0 <= tcoa sz vz && tcoa sz vz <= tcoath horizontalWCV :: (Vect2 -> Vect2 -> Stream Double) -> Vect2 -> Vect2 -> Stream Bool horizontalWCV tvar s v = (norm s <= dthr) || ((dcpa s v <= dthr) && (0 <= tvar s v) && (tvar s v <= tthr)) --------------- -- Theorems -- --------------- -------------------------- -- Horizontal symmetry -- -------------------------- horizSymmetry = do theorem "1a" (forall $ tau s v ~= tau (neg s) (neg v)) arith theorem "1b" (forall $ tcpa s v ~= tcpa (neg s) (neg v)) arith theorem "1c" (forall $ taumod s v ~= taumod (neg s) (neg v)) arith theorem "1d" (forall $ tep s v ~= tep (neg s) (neg v)) arith -------------------------- -- Horizontal ordering -- -------------------------- horizOrdering = do theorem "2a" (forall $ ((s |*| v) < 0 && norm s > dthr && dcpa s v <= dthr) ==> (tep s v <= taumod s v)) @@ -213,9 +197,7 @@ horizOrdering = do ==> (tcpa s v <= tau s v)) arith --------------- -- Symmetry -- --------------- symmetry = do theorem "3a" (forall $ wcv tau s sz v vz == wcv tau (neg s) (-sz) (neg v) (-vz)) arith @@ -226,9 +208,7 @@ symmetry = do theorem "3d" (forall $ wcv tep s sz v vz == wcv tep (neg s) (-sz) (neg v) (-vz)) arith ---------------- -- Inclusion -- ---------------- inclusion = do theorem "4i" (forall $ wcv tau s sz v vz ==> wcv tcpa s sz v vz) arith @@ -237,9 +217,7 @@ inclusion = do theorem "4iii" (forall $ wcv taumod s sz v vz ==> wcv tep s sz v vz) arith ---------------------- -- Local convexity -- ---------------------- t1, t2, t3 :: Stream Double t1 = extern "t1" Nothing @@ -258,8 +236,6 @@ localConvexity = do theorem "5c" (forall $ locallyConvex tep) arith theorem "6" (P.not (forall $ locallyConvex tau)) arithSat --------------------------------------------------------------------------------- - arith :: Proof Universal arith = onlyValidity def { nraNLSat = True, debug = False } From 2244b5b29b0e728c5bb52a1efdebfa8565f83749 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:06:36 -0400 Subject: [PATCH 0290/1222] Style: remove separating line in comment. Refs #316. According to our style guide, the code should not use lines with multiple consecutive hyphens, stars, or other symbols, to separate sections of code. --- copilot-theorem/examples/WCV.hs | 24 ------------------------ 1 file changed, 24 deletions(-) diff --git a/copilot-theorem/examples/WCV.hs b/copilot-theorem/examples/WCV.hs index f72fae409..f184d4860 100644 --- a/copilot-theorem/examples/WCV.hs +++ b/copilot-theorem/examples/WCV.hs @@ -17,9 +17,7 @@ tcoathr = extern "tcoathr" Nothing type Vect2 = (Stream Double, Stream Double) --------------------------------- -- Relative velocity/position -- --------------------------------- vx, vy, vz :: Stream Double vx = extern "relative_velocity_x" Nothing @@ -37,9 +35,7 @@ sz = extern "relative_position_z" Nothing s :: (Stream Double, Stream Double) s = (sx, sy) ------------------- -- Vector stuff -- ------------------- (|*|) :: Vect2 -> Vect2 -> Stream Double (|*|) (x1, y1) (x2, y2) = (x1 * x2) + (y1 * y2) @@ -59,9 +55,7 @@ a ~= b = (abs (a - b)) < 0.001 neg :: Vect2 -> Vect2 neg (x, y) = (negate x, negate y) --------------------- -- Time variables -- --------------------- tau :: Vect2 -> Vect2 -> Stream Double tau s v = mux (s |*| v < 0) ((-(sq s)) / (s |*| v)) (-1) @@ -84,9 +78,7 @@ delta s v d = (d*d) * (sq v) - ((det s v)*(det s v)) theta :: Vect2 -> Vect2 -> Stream Double -> Stream Double -> Stream Double theta s v d e = (-(s |*| v) + e * (sqrt $ delta s v d)) / (sq v) --------------------------- -- Some tools for times -- --------------------------- tcoa :: Stream Double -> Stream Double -> Stream Double tcoa sz vz = mux ((sz * vz) < 0) ((-sz) / vz) (-1) @@ -94,9 +86,7 @@ tcoa sz vz = mux ((sz * vz) < 0) ((-sz) / vz) (-1) dcpa :: Vect2 -> Vect2 -> Stream Double dcpa s@(sx, sy) v@(vx, vy) = norm (sx + (tcpa s v) * vx, sy + (tcpa s v) * vy) --------------------------- -- Well clear Violation -- --------------------------- wcv :: (Vect2 -> Vect2 -> Stream Double) -> Vect2 -> Stream Double -> @@ -114,22 +104,16 @@ horizontalWCV tvar s v = (norm s <= dthr) || (((dcpa s v) <= dthr) && (0 <= (tvar s v)) && ((tvar s v) <= tthr)) --------------- -- Theorems -- --------------- -------------------------- -- Horizontal symmetry -- -------------------------- horizSymmetry = do theorem "1a" (forall $ (tau s v) ~= (tau (neg s) (neg v))) arith theorem "1b" (forall $ (tcpa s v) ~= (tcpa (neg s) (neg v))) arith theorem "1c" (forall $ (taumod s v) ~= (taumod (neg s) (neg v))) arith theorem "1d" (forall $ (tep s v) ~= (tep (neg s) (neg v))) arith -------------------------- -- Horizontal ordering -- -------------------------- horizOrdering = do theorem "2a" (forall $ ((s |*| v) < 0 && (norm s) > dthr && (dcpa s v) <= dthr) ==> ((tep s v) <= (taumod s v))) @@ -141,9 +125,7 @@ horizOrdering = do ==> ((tcpa s v) <= (tau s v))) arith --------------- -- Symmetry -- --------------- symmetry = do theorem "3a" (forall $ (wcv tau s sz v vz) == (wcv tau (neg s) (-sz) (neg v) (-vz))) arith @@ -154,9 +136,7 @@ symmetry = do theorem "3d" (forall $ (wcv tep s sz v vz) == (wcv tep (neg s) (-sz) (neg v) (-vz))) arith ---------------- -- Inclusion -- ---------------- inclusion = do theorem "4i" (forall $ (wcv tau s sz v vz) ==> (wcv tcpa s sz v vz)) arith @@ -165,9 +145,7 @@ inclusion = do theorem "4iii" (forall $ (wcv taumod s sz v vz) ==> (wcv tep s sz v vz)) arith ---------------------- -- Local convexity -- ---------------------- t1, t2, t3 :: Stream Double t1 = extern "t1" Nothing @@ -186,8 +164,6 @@ localConvexity = do theorem "5c" (forall $ locallyConvex tep) arith theorem "6" (P.not (forall $ locallyConvex tau)) arithSat --------------------------------------------------------------------------------- - arith :: Proof Universal arith = onlyValidity def { nraNLSat = True, debug = False } From f2e682e37c6bc11ded60260b6d6c157f5ec725a2 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:06:36 -0400 Subject: [PATCH 0291/1222] Style: remove separating line in comment. Refs #316. According to our style guide, the code should not use lines with multiple consecutive hyphens, stars, or other symbols, to separate sections of code. --- copilot-theorem/src/Copilot/Theorem.hs | 4 ---- 1 file changed, 4 deletions(-) diff --git a/copilot-theorem/src/Copilot/Theorem.hs b/copilot-theorem/src/Copilot/Theorem.hs index ea7098bb8..510d5d6fc 100644 --- a/copilot-theorem/src/Copilot/Theorem.hs +++ b/copilot-theorem/src/Copilot/Theorem.hs @@ -1,5 +1,3 @@ --------------------------------------------------------------------------------- - {-# LANGUAGE Safe #-} -- | Highly automated proof techniques are a necessary step for the widespread @@ -22,5 +20,3 @@ module Copilot.Theorem import Copilot.Theorem.Tactics as X import Copilot.Theorem.Prove - --------------------------------------------------------------------------------- From fb088b203bd71433edbb293a487e4e1d9f70a6c2 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:06:36 -0400 Subject: [PATCH 0292/1222] Style: remove separating line in comment. Refs #316. According to our style guide, the code should not use lines with multiple consecutive hyphens, stars, or other symbols, to separate sections of code. --- copilot-theorem/src/Copilot/Theorem/IL.hs | 4 ---- 1 file changed, 4 deletions(-) diff --git a/copilot-theorem/src/Copilot/Theorem/IL.hs b/copilot-theorem/src/Copilot/Theorem/IL.hs index dde596c6e..acd4064ba 100644 --- a/copilot-theorem/src/Copilot/Theorem/IL.hs +++ b/copilot-theorem/src/Copilot/Theorem/IL.hs @@ -1,5 +1,3 @@ --------------------------------------------------------------------------------- - {-# LANGUAGE Safe #-} -- | Each prover first translates the Copilot specification into an @@ -16,5 +14,3 @@ import Copilot.Theorem.IL.Spec as X import Copilot.Theorem.IL.Translate as X import Copilot.Theorem.IL.Transform as X import Copilot.Theorem.IL.PrettyPrint as X - --------------------------------------------------------------------------------- From fab21038ad15c2d3b1cd42e9142828243d9172ae Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:06:36 -0400 Subject: [PATCH 0293/1222] Style: remove separating line in comment. Refs #316. According to our style guide, the code should not use lines with multiple consecutive hyphens, stars, or other symbols, to separate sections of code. --- copilot-theorem/src/Copilot/Theorem/IL/PrettyPrint.hs | 6 ------ 1 file changed, 6 deletions(-) diff --git a/copilot-theorem/src/Copilot/Theorem/IL/PrettyPrint.hs b/copilot-theorem/src/Copilot/Theorem/IL/PrettyPrint.hs index ed2cc4fba..196873060 100644 --- a/copilot-theorem/src/Copilot/Theorem/IL/PrettyPrint.hs +++ b/copilot-theorem/src/Copilot/Theorem/IL/PrettyPrint.hs @@ -1,5 +1,3 @@ ---------------------------------------------------------------------------------- - {-# LANGUAGE GADTs #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE Safe #-} @@ -14,8 +12,6 @@ import qualified Data.Map as Map import Prelude hiding ((<>)) --------------------------------------------------------------------------------- - -- | Pretty print an IL specification. prettyPrint :: IL -> String prettyPrint = render . ppSpec @@ -88,5 +84,3 @@ ppOp1 = text . show ppOp2 :: Op2 -> Doc ppOp2 = text . show - --------------------------------------------------------------------------------- From bdf425ded45e5941b4fbd8fadbb3d659a46fd202 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:06:36 -0400 Subject: [PATCH 0294/1222] Style: remove separating line in comment. Refs #316. According to our style guide, the code should not use lines with multiple consecutive hyphens, stars, or other symbols, to separate sections of code. --- copilot-theorem/src/Copilot/Theorem/IL/Spec.hs | 16 ---------------- 1 file changed, 16 deletions(-) diff --git a/copilot-theorem/src/Copilot/Theorem/IL/Spec.hs b/copilot-theorem/src/Copilot/Theorem/IL/Spec.hs index 8659724d2..62ed692bd 100644 --- a/copilot-theorem/src/Copilot/Theorem/IL/Spec.hs +++ b/copilot-theorem/src/Copilot/Theorem/IL/Spec.hs @@ -1,5 +1,3 @@ --------------------------------------------------------------------------------- - {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} @@ -37,8 +35,6 @@ module Copilot.Theorem.IL.Spec import Data.Map (Map) import Data.Function (on) --------------------------------------------------------------------------------- - -- | Identifier of a sequence. type SeqId = String @@ -79,8 +75,6 @@ data Expr | FunApp Type String [Expr] -- ^ Function application. deriving (Eq, Ord, Show) --------------------------------------------------------------------------------- - -- | A description of a variable (or function) together with its type. data VarDescr = VarDescr { varName :: String @@ -94,8 +88,6 @@ instance Eq VarDescr where instance Ord VarDescr where compare = compare `on` varName --------------------------------------------------------------------------------- - -- | Identifier for a property. type PropId = String @@ -113,8 +105,6 @@ data IL = IL , inductive :: Bool } --------------------------------------------------------------------------------- - -- | Unary operators. data Op1 = Not | Neg | Abs | Exp | Sqrt | Log | Sin | Tan | Cos | Asin | Atan | Acos | Sinh | Tanh | Cosh | Asinh | Atanh | Acosh @@ -124,8 +114,6 @@ data Op1 = Not | Neg | Abs | Exp | Sqrt | Log | Sin | Tan | Cos | Asin | Atan data Op2 = Eq | And | Or | Le | Lt | Ge | Gt | Add | Sub | Mul | Mod | Fdiv | Pow deriving (Eq, Ord) -------------------------------------------------------------------------------- - instance Show Op1 where show op = case op of Neg -> "-" @@ -169,8 +157,6 @@ instance Show Op2 where Lt -> "<" Gt -> ">" -------------------------------------------------------------------------------- - -- | Return the type of an expression. typeOf :: Expr -> Type typeOf e = case e of @@ -204,5 +190,3 @@ evalAt i (FunApp t name args) = FunApp t name $ map (\e -> evalAt i e) args evalAt _ e@(SVal _ _ (Fixed _)) = e evalAt (Fixed n) (SVal t s (Var d)) = SVal t s (Fixed $ n + d) evalAt (Var k) (SVal t s (Var d)) = SVal t s (Var $ k + d) - --------------------------------------------------------------------------------- From 4beb52e1d61566ccfedb6f4cf5c310e002e519ff Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:06:36 -0400 Subject: [PATCH 0295/1222] Style: remove separating line in comment. Refs #316. According to our style guide, the code should not use lines with multiple consecutive hyphens, stars, or other symbols, to separate sections of code. --- copilot-theorem/src/Copilot/Theorem/IL/Translate.hs | 12 ------------ 1 file changed, 12 deletions(-) diff --git a/copilot-theorem/src/Copilot/Theorem/IL/Translate.hs b/copilot-theorem/src/Copilot/Theorem/IL/Translate.hs index b3a4f73f6..3bc2ee239 100644 --- a/copilot-theorem/src/Copilot/Theorem/IL/Translate.hs +++ b/copilot-theorem/src/Copilot/Theorem/IL/Translate.hs @@ -1,5 +1,3 @@ --------------------------------------------------------------------------------- - {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} @@ -27,8 +25,6 @@ import GHC.Float (float2Double) import Data.Typeable (Typeable) --------------------------------------------------------------------------------- - -- 'nc' stands for naming convention. ncSeq :: C.Id -> SeqId ncSeq = printf "s%d" @@ -46,8 +42,6 @@ ncUnhandledOp = id ncMux :: Integer -> SeqId ncMux n = "mux" ++ show n --------------------------------------------------------------------------------- - -- | Translate a Copilot specification to an IL specification. translate :: C.Spec -> IL translate = translate' False @@ -119,8 +113,6 @@ streamRec (C.Stream { C.streamId = id e' <- expr e return $ Op2 Bool Eq s e' --------------------------------------------------------------------------------- - expr :: Typeable a => C.Expr a -> Trans Expr expr (C.Const t v) = return $ trConst t v @@ -277,8 +269,6 @@ trType = \case C.Float -> Real C.Double -> Real --------------------------------------------------------------------------------- - -- | Translation state. data TransST = TransST { localConstraints :: [Expr] @@ -324,5 +314,3 @@ popLocalConstraints = liftM2 (++) (localConstraints <$> get) getMuxes runTrans :: Bool -> Trans a -> a runTrans b m = evalState m $ TransST [] [] 0 b - --------------------------------------------------------------------------------- From 2988b377dfd9449ea8a40982dbdf28419d278eec Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:06:36 -0400 Subject: [PATCH 0296/1222] Style: remove separating line in comment. Refs #316. According to our style guide, the code should not use lines with multiple consecutive hyphens, stars, or other symbols, to separate sections of code. --- copilot-theorem/src/Copilot/Theorem/Kind2.hs | 4 ---- 1 file changed, 4 deletions(-) diff --git a/copilot-theorem/src/Copilot/Theorem/Kind2.hs b/copilot-theorem/src/Copilot/Theorem/Kind2.hs index 5002d749a..09edd94b3 100644 --- a/copilot-theorem/src/Copilot/Theorem/Kind2.hs +++ b/copilot-theorem/src/Copilot/Theorem/Kind2.hs @@ -1,5 +1,3 @@ --------------------------------------------------------------------------------- - {-# LANGUAGE Safe #-} -- | Copilot backend for the SMT @@ -11,5 +9,3 @@ import Copilot.Theorem.Kind2.AST as X import Copilot.Theorem.Kind2.Translate as X import Copilot.Theorem.Kind2.PrettyPrint as X import Copilot.Theorem.Kind2.Prover as X - --------------------------------------------------------------------------------- From d759784b78230b40f8a6af5d4f4e247df70a672d Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:06:36 -0400 Subject: [PATCH 0297/1222] Style: remove separating line in comment. Refs #316. According to our style guide, the code should not use lines with multiple consecutive hyphens, stars, or other symbols, to separate sections of code. --- copilot-theorem/src/Copilot/Theorem/Kind2/AST.hs | 6 ------ 1 file changed, 6 deletions(-) diff --git a/copilot-theorem/src/Copilot/Theorem/Kind2/AST.hs b/copilot-theorem/src/Copilot/Theorem/Kind2/AST.hs index a8cf7e0bf..e69cda8d0 100644 --- a/copilot-theorem/src/Copilot/Theorem/Kind2/AST.hs +++ b/copilot-theorem/src/Copilot/Theorem/Kind2/AST.hs @@ -1,12 +1,8 @@ --------------------------------------------------------------------------------- - {-# LANGUAGE Safe #-} -- | Abstract syntax tree of Kind2 files. module Copilot.Theorem.Kind2.AST where --------------------------------------------------------------------------------- - -- | A file is a sequence of predicates and propositions. data File = File { filePreds :: [PredDef] @@ -54,5 +50,3 @@ data Term = | StateVar String | FunApp String [Term] | PredApp String PredType [Term] - --------------------------------------------------------------------------------- From b9864edf1efba10c18d06effeb00a3d3bfa7605f Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:06:36 -0400 Subject: [PATCH 0298/1222] Style: remove separating line in comment. Refs #316. According to our style guide, the code should not use lines with multiple consecutive hyphens, stars, or other symbols, to separate sections of code. --- copilot-theorem/src/Copilot/Theorem/Kind2/Output.hs | 6 ------ 1 file changed, 6 deletions(-) diff --git a/copilot-theorem/src/Copilot/Theorem/Kind2/Output.hs b/copilot-theorem/src/Copilot/Theorem/Kind2/Output.hs index 85633b7b7..49da4790f 100644 --- a/copilot-theorem/src/Copilot/Theorem/Kind2/Output.hs +++ b/copilot-theorem/src/Copilot/Theorem/Kind2/Output.hs @@ -1,5 +1,3 @@ --------------------------------------------------------------------------------- - {-# LANGUAGE RankNTypes #-} {-# LANGUAGE Safe #-} @@ -12,8 +10,6 @@ import Data.Maybe (fromJust) import qualified Copilot.Theorem.Misc.Error as Err --------------------------------------------------------------------------------- - simpleName s = QName s Nothing Nothing -- | Parse output of Kind2. @@ -52,5 +48,3 @@ parseOutput prop xml = fromJust $ do err msg = Err.fatal $ "Parse error while reading the Kind2 XML output : \n" ++ msg ++ "\n\n" ++ xml - --------------------------------------------------------------------------------- From c55d5c1084ed32e00c21deaf29c02fc6a86a1fa5 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:06:36 -0400 Subject: [PATCH 0299/1222] Style: remove separating line in comment. Refs #316. According to our style guide, the code should not use lines with multiple consecutive hyphens, stars, or other symbols, to separate sections of code. --- .../src/Copilot/Theorem/Kind2/PrettyPrint.hs | 10 ---------- 1 file changed, 10 deletions(-) diff --git a/copilot-theorem/src/Copilot/Theorem/Kind2/PrettyPrint.hs b/copilot-theorem/src/Copilot/Theorem/Kind2/PrettyPrint.hs index 9a74bbdd2..9e38c6d27 100644 --- a/copilot-theorem/src/Copilot/Theorem/Kind2/PrettyPrint.hs +++ b/copilot-theorem/src/Copilot/Theorem/Kind2/PrettyPrint.hs @@ -1,5 +1,3 @@ --------------------------------------------------------------------------------- - {-# LANGUAGE Safe #-} -- | Pretty print a Kind2 file defining predicates and propositions. @@ -11,16 +9,12 @@ import Copilot.Theorem.Kind2.AST import Data.List (intercalate) --------------------------------------------------------------------------------- - -- | A tree of expressions, in which the leafs are strings. type SSExpr = SExpr String -- | Reserved keyword prime. kwPrime = "prime" --------------------------------------------------------------------------------- - -- | Pretty print a Kind2 file. prettyPrint :: File -> String prettyPrint = @@ -34,8 +28,6 @@ shouldIndent (Atom _) = False shouldIndent (List [Atom a, Atom _]) = a `notElem` [kwPrime] shouldIndent _ = True --------------------------------------------------------------------------------- - -- | Convert a file into a sequence of expressions. ppFile :: File -> [SSExpr] ppFile (File preds props) = map ppPredDef preds ++ ppProps props @@ -78,5 +70,3 @@ ppTerm (PredApp p t args) = node (p ++ "." ++ ext) $ map ppTerm args where ext = case t of Init -> "init" Trans -> "trans" - --------------------------------------------------------------------------------- From 93616db1a499fef311869f03509ed6985e21b8d9 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:06:36 -0400 Subject: [PATCH 0300/1222] Style: remove separating line in comment. Refs #316. According to our style guide, the code should not use lines with multiple consecutive hyphens, stars, or other symbols, to separate sections of code. --- copilot-theorem/src/Copilot/Theorem/Kind2/Prover.hs | 10 ---------- 1 file changed, 10 deletions(-) diff --git a/copilot-theorem/src/Copilot/Theorem/Kind2/Prover.hs b/copilot-theorem/src/Copilot/Theorem/Kind2/Prover.hs index 0f4d2068c..3931c615b 100644 --- a/copilot-theorem/src/Copilot/Theorem/Kind2/Prover.hs +++ b/copilot-theorem/src/Copilot/Theorem/Kind2/Prover.hs @@ -1,5 +1,3 @@ --------------------------------------------------------------------------------- - {-# LANGUAGE LambdaCase #-} {-# LANGUAGE Trustworthy #-} @@ -26,8 +24,6 @@ import Data.Default import qualified Copilot.Theorem.TransSys as TS --------------------------------------------------------------------------------- - -- | Options for Kind2 data Options = Options { bmcMax :: Int -- ^ Upper bound on the number of unrolling that base and @@ -52,13 +48,9 @@ kind2Prover opts = Prover , askProver = askKind2 , closeProver = const $ return () } --------------------------------------------------------------------------------- - kind2Prog = "kind2" kind2BaseOptions = ["--input-format", "native", "-xml"] --------------------------------------------------------------------------------- - askKind2 :: ProverST -> [PropId] -> [PropId] -> IO Output askKind2 (ProverST opts spec) assumptions toCheck = do @@ -77,5 +69,3 @@ askKind2 (ProverST opts spec) assumptions toCheck = do removeFile tempName return $ parseOutput (head toCheck) output - --------------------------------------------------------------------------------- From 31eb874a2b7d0a95252ad2272817a7a1c3450ab8 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:06:36 -0400 Subject: [PATCH 0301/1222] Style: remove separating line in comment. Refs #316. According to our style guide, the code should not use lines with multiple consecutive hyphens, stars, or other symbols, to separate sections of code. --- .../src/Copilot/Theorem/Kind2/Translate.hs | 18 ------------------ 1 file changed, 18 deletions(-) diff --git a/copilot-theorem/src/Copilot/Theorem/Kind2/Translate.hs b/copilot-theorem/src/Copilot/Theorem/Kind2/Translate.hs index 01b9a0de7..edd5d3543 100644 --- a/copilot-theorem/src/Copilot/Theorem/Kind2/Translate.hs +++ b/copilot-theorem/src/Copilot/Theorem/Kind2/Translate.hs @@ -1,5 +1,3 @@ --------------------------------------------------------------------------------- - {-# LANGUAGE GADTs #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RankNTypes #-} @@ -27,20 +25,14 @@ import Data.Map (Map, (!)) import qualified Data.Map as Map import qualified Data.Bimap as Bimap --------------------------------------------------------------------------------- - -- The following properties MUST hold for the given transition system : -- * Nodes are sorted by topological order -- * Nodes are `completed`, which means the dependency graph is transitive -- and each node imports all the local variables of its dependencies -- --------------------------------------------------------------------------------- - type DepGraph = Map NodeId [NodeId] --------------------------------------------------------------------------------- - -- | Style of the Kind2 files produced: modular (with multiple separate nodes), -- or all inlined (with only one node). -- @@ -108,8 +100,6 @@ addAssumptions spec assumptions (K.File {K.filePreds, K.fileProps}) = toTopVar (ExtVar nId v) = assert (nId == specTopNodeId spec) v in map (varName . toTopVar . toExtVar) assumptions --------------------------------------------------------------------------------- - -- The ordering really matters here because the variables -- have to be given in this order in a pred call -- Our convention : @@ -137,8 +127,6 @@ gatherPredStateVars spec node = locals ++ imported map (\(v, ev) -> K.StateVarDef (varName v) (extVarType ev) []) . sortBy (compare `on` snd) . Bimap.toList $ nodeImportedVars node --------------------------------------------------------------------------------- - mkConj :: [K.Term] -> K.Term mkConj [] = trConst Bool True mkConj [x] = x @@ -159,8 +147,6 @@ trConst Real v = K.ValueLiteral (show v) trConst Bool True = K.ValueLiteral "true" trConst Bool False = K.ValueLiteral "false" --------------------------------------------------------------------------------- - initLocals :: Node -> [K.Term] initLocals node = concatMap f (Map.toList $ nodeLocalVars node) @@ -214,8 +200,6 @@ predCalls isInitCall spec predCallsGraph node = argsSeq trVarF = map (localAlias trVarF) (calleeLocals ++ calleeImported) --------------------------------------------------------------------------------- - trExpr :: Bool -> Expr t -> K.Term trExpr primed = tr where @@ -225,5 +209,3 @@ trExpr primed = tr tr (Op1 _ op e) = K.FunApp (show op) [tr e] tr (Op2 _ op e1 e2) = K.FunApp (show op) [tr e1, tr e2] tr (VarE _ v) = if primed then trPrimedVar v else trVar v - --------------------------------------------------------------------------------- From 7170b1916d20a0a339bcd7121751dea25049fbff Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:06:36 -0400 Subject: [PATCH 0302/1222] Style: remove separating line in comment. Refs #316. According to our style guide, the code should not use lines with multiple consecutive hyphens, stars, or other symbols, to separate sections of code. --- copilot-theorem/src/Copilot/Theorem/Misc/Error.hs | 6 ------ 1 file changed, 6 deletions(-) diff --git a/copilot-theorem/src/Copilot/Theorem/Misc/Error.hs b/copilot-theorem/src/Copilot/Theorem/Misc/Error.hs index 4b1d5e9ca..b583400f2 100644 --- a/copilot-theorem/src/Copilot/Theorem/Misc/Error.hs +++ b/copilot-theorem/src/Copilot/Theorem/Misc/Error.hs @@ -1,5 +1,3 @@ --------------------------------------------------------------------------------- - {-# LANGUAGE Safe #-} -- | Custom functions to report error messages to users. @@ -10,8 +8,6 @@ module Copilot.Theorem.Misc.Error , fatal ) where --------------------------------------------------------------------------------- - -- | Tag used with error messages to help users locate the component that -- failed or reports the error. errorHeader :: String @@ -34,5 +30,3 @@ impossible_ = error $ errorHeader ++ "Unexpected internal error" -- | Report an unrecoverable error (e.g., incorrect format). fatal :: String -> a fatal = error - --------------------------------------------------------------------------------- From 1420bbe61ac93dcc0bba8011681c2ea0dbdbfc64 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:06:36 -0400 Subject: [PATCH 0303/1222] Style: remove separating line in comment. Refs #316. According to our style guide, the code should not use lines with multiple consecutive hyphens, stars, or other symbols, to separate sections of code. --- copilot-theorem/src/Copilot/Theorem/Misc/SExpr.hs | 10 ---------- 1 file changed, 10 deletions(-) diff --git a/copilot-theorem/src/Copilot/Theorem/Misc/SExpr.hs b/copilot-theorem/src/Copilot/Theorem/Misc/SExpr.hs index 5f95e01a4..dad07af2b 100644 --- a/copilot-theorem/src/Copilot/Theorem/Misc/SExpr.hs +++ b/copilot-theorem/src/Copilot/Theorem/Misc/SExpr.hs @@ -1,5 +1,3 @@ --------------------------------------------------------------------------------- - {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE Safe #-} @@ -12,8 +10,6 @@ import Text.PrettyPrint.HughesPJ as PP hiding (char, Str) import Control.Monad --------------------------------------------------------------------------------- - -- | A structured expression is either an atom, or a sequence of expressions, -- where the first in the sequence denotes the tag or label of the tree. data SExpr a = Atom a @@ -38,8 +34,6 @@ list = List -- (ss) -- additional expressions or arguments.. node a l = List (Atom a : l) -- (s ss) --------------------------------------------------------------------------------- - -- A straightforward string representation for 'SExpr's of Strings that -- parenthesizes lists of expressions. instance Show (SExpr String) where @@ -76,8 +70,6 @@ toDoc shouldIndent printAtom expr = case expr of | otherwise = doc <+> toDoc shouldIndent printAtom s --------------------------------------------------------------------------------- - -- | Parser for strings of characters separated by spaces into a structured -- tree. -- @@ -110,5 +102,3 @@ parseSExpr :: String -> Maybe (SExpr String) parseSExpr str = case parse parser "" str of Left s -> error (show s) -- Nothing Right t -> Just t - --------------------------------------------------------------------------------- From 7318100346c75ae6375931f88ae55798214ead29 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:06:36 -0400 Subject: [PATCH 0304/1222] Style: remove separating line in comment. Refs #316. According to our style guide, the code should not use lines with multiple consecutive hyphens, stars, or other symbols, to separate sections of code. --- copilot-theorem/src/Copilot/Theorem/Misc/Utils.hs | 10 ---------- 1 file changed, 10 deletions(-) diff --git a/copilot-theorem/src/Copilot/Theorem/Misc/Utils.hs b/copilot-theorem/src/Copilot/Theorem/Misc/Utils.hs index c717c42a4..9f15a0fa3 100644 --- a/copilot-theorem/src/Copilot/Theorem/Misc/Utils.hs +++ b/copilot-theorem/src/Copilot/Theorem/Misc/Utils.hs @@ -1,5 +1,3 @@ --------------------------------------------------------------------------------- - {-# LANGUAGE Safe #-} -- | Utility / auxiliary functions. @@ -8,8 +6,6 @@ module Copilot.Theorem.Misc.Utils , openTempFile ) where --------------------------------------------------------------------------------- - import Data.Function (on) import Data.List (groupBy, sortBy, group, sort) @@ -22,8 +18,6 @@ import System.IO hiding (openTempFile) import System.Random import System.Directory --------------------------------------------------------------------------------- - -- | True if the given list is a subset of the second list, when both are -- considered as sets. isSublistOf :: Ord a => [a] -> [a] -> Bool @@ -46,8 +40,6 @@ nub' = map head . group . sort nubBy' :: (a -> a -> Ordering) -> [a] -> [a] nubBy' f = map head . groupBy (\x y -> f x y == EQ) . sortBy f --------------------------------------------------------------------------------- - -- | Create a temporary file and open it for writing. openTempFile :: String -- ^ Directory where the file should be created. -> String -- ^ Base name for the file (prefix). @@ -72,5 +64,3 @@ openTempFile loc baseName extension = do pathFromSuff :: String -> FilePath pathFromSuff suf = loc ++ "/" ++ baseName ++ suf ++ "." ++ extension - --------------------------------------------------------------------------------- From 7977fc7d96251656990bc1cd78faa83a6605b29e Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:06:36 -0400 Subject: [PATCH 0305/1222] Style: remove separating line in comment. Refs #316. According to our style guide, the code should not use lines with multiple consecutive hyphens, stars, or other symbols, to separate sections of code. --- copilot-theorem/src/Copilot/Theorem/Prove.hs | 8 -------- 1 file changed, 8 deletions(-) diff --git a/copilot-theorem/src/Copilot/Theorem/Prove.hs b/copilot-theorem/src/Copilot/Theorem/Prove.hs index 4a58b5334..f1a3d3297 100644 --- a/copilot-theorem/src/Copilot/Theorem/Prove.hs +++ b/copilot-theorem/src/Copilot/Theorem/Prove.hs @@ -1,5 +1,3 @@ --------------------------------------------------------------------------------- - {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE NamedFieldPuns #-} @@ -26,8 +24,6 @@ import Data.List (intercalate) import Control.Applicative (liftA2) import Control.Monad.Writer --------------------------------------------------------------------------------- - -- | Output produced by a prover, containing the 'Status' of the proof and -- additional information. data Output = Output Status [String] @@ -95,8 +91,6 @@ data Action where Assume :: PropId -> Action Admit :: Action --------------------------------------------------------------------------------- - -- | Record a requirement for satisfiability checking. check :: Prover -> Proof a check prover = Proof $ tell [Check prover] @@ -217,5 +211,3 @@ combineOutputs nameL nameR (Output stL msgL) (Output stR msgR) = ++ msgL ++ [decoName nameR] ++ msgR - --------------------------------------------------------------------------------- From 03eefcfe9719bead6321bc259450aa3bf5477251 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:06:36 -0400 Subject: [PATCH 0306/1222] Style: remove separating line in comment. Refs #316. According to our style guide, the code should not use lines with multiple consecutive hyphens, stars, or other symbols, to separate sections of code. --- copilot-theorem/src/Copilot/Theorem/Prover/SMT.hs | 10 ---------- 1 file changed, 10 deletions(-) diff --git a/copilot-theorem/src/Copilot/Theorem/Prover/SMT.hs b/copilot-theorem/src/Copilot/Theorem/Prover/SMT.hs index a1051d084..175763cd4 100644 --- a/copilot-theorem/src/Copilot/Theorem/Prover/SMT.hs +++ b/copilot-theorem/src/Copilot/Theorem/Prover/SMT.hs @@ -1,5 +1,3 @@ --------------------------------------------------------------------------------- - {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} @@ -54,8 +52,6 @@ import Copilot.Theorem.Misc.Utils import System.IO (hClose) --------------------------------------------------------------------------------- - -- * Tactics -- | Options to configure the provers. @@ -119,8 +115,6 @@ kInduction opts backend = check P.Prover , P.closeProver = const $ return () } -------------------------------------------------------------------------------- - -- * Backends -- | Backend to the Yices 2 SMT solver. @@ -242,8 +236,6 @@ metit installDir = Backend , interpret = TPTP.interpret } -------------------------------------------------------------------------------- - -- | Checks the Copilot specification with k-induction type ProofScript b = MaybeT (StateT (ProofState b) IO) @@ -423,5 +415,3 @@ selectProps :: [PropId] -> Map PropId ([Expr], Expr) -> ([Expr], [Expr]) selectProps propIds properties = (squash . unzip) [(as, p) | (id, (as, p)) <- Map.toList properties, id `elem` propIds] where squash (a, b) = (concat a, b) - --------------------------------------------------------------------------------- From d5e5dbbad944500796f2a80793ce971237ffe211 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:06:36 -0400 Subject: [PATCH 0307/1222] Style: remove separating line in comment. Refs #316. According to our style guide, the code should not use lines with multiple consecutive hyphens, stars, or other symbols, to separate sections of code. --- copilot-theorem/src/Copilot/Theorem/Prover/SMTIO.hs | 12 ------------ 1 file changed, 12 deletions(-) diff --git a/copilot-theorem/src/Copilot/Theorem/Prover/SMTIO.hs b/copilot-theorem/src/Copilot/Theorem/Prover/SMTIO.hs index 08a4acb4f..2ce606b31 100644 --- a/copilot-theorem/src/Copilot/Theorem/Prover/SMTIO.hs +++ b/copilot-theorem/src/Copilot/Theorem/Prover/SMTIO.hs @@ -1,5 +1,3 @@ --------------------------------------------------------------------------------- - {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RankNTypes #-} @@ -26,8 +24,6 @@ import Control.Monad.Trans.Maybe import Data.Maybe import Data.Set ((\\), fromList, Set, union, empty, elems) --------------------------------------------------------------------------------- - -- | A connection with a running SMT solver or theorem prover. data Solver a = Solver { solverName :: String @@ -40,8 +36,6 @@ data Solver a = Solver , backend :: Backend a } --------------------------------------------------------------------------------- - -- | Output a debugging message if debugging is enabled for the solver. debug :: Bool -> Solver a -> String -> IO () debug printName s str = when (debugMode s) $ @@ -67,8 +61,6 @@ receive s = fromJust <$> runMaybeT (msum $ repeat line) liftIO $ debug True s $ "[received: " ++ ln ++ "]" MaybeT $ return $ (interpret $ backend s) ln --------------------------------------------------------------------------------- - -- | Create a new solver implemented by the backend specified. -- -- The error handle from the backend handle is immediately closed/discarded, @@ -89,8 +81,6 @@ stop s = do hClose $ outh s terminateProcess $ process s --------------------------------------------------------------------------------- - -- | Register the given expressions as assumptions or axioms with the solver. assume :: SmtFormat a => Solver a -> [Expr] -> IO (Solver a) assume s@(Solver { model }) cs = do @@ -122,5 +112,3 @@ declVars s@(Solver { vars }) decls = do forM_ newVars $ \(VarDescr {varName, varType, args}) -> send s $ declFun varName varType args return s { vars = vars `union` fromList newVars } - --------------------------------------------------------------------------------- From fd5d322f5bb6cc92c4d8cbf3537b6c1cadd5a22c Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:06:36 -0400 Subject: [PATCH 0308/1222] Style: remove separating line in comment. Refs #316. According to our style guide, the code should not use lines with multiple consecutive hyphens, stars, or other symbols, to separate sections of code. --- copilot-theorem/src/Copilot/Theorem/Prover/SMTLib.hs | 10 ---------- 1 file changed, 10 deletions(-) diff --git a/copilot-theorem/src/Copilot/Theorem/Prover/SMTLib.hs b/copilot-theorem/src/Copilot/Theorem/Prover/SMTLib.hs index 218492b7b..0f2b1e0c6 100644 --- a/copilot-theorem/src/Copilot/Theorem/Prover/SMTLib.hs +++ b/copilot-theorem/src/Copilot/Theorem/Prover/SMTLib.hs @@ -1,5 +1,3 @@ --------------------------------------------------------------------------------- - {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE Safe #-} @@ -15,8 +13,6 @@ import Copilot.Theorem.Misc.SExpr import Text.Printf --------------------------------------------------------------------------------- - -- | Type used to represent SMT-lib commands. -- -- Use the interface in 'SmtFormat' to create such commands. @@ -30,8 +26,6 @@ smtTy Bool = "Bool" smtTy Real = "Real" smtTy _ = "Int" --------------------------------------------------------------------------------- - -- | Interface for SMT-Lib conforming backends. instance SmtFormat SmtLib where push = SmtLib $ node "push" [atom "1"] @@ -49,8 +43,6 @@ interpret "sat" = Just Sat interpret "unsat" = Just Unsat interpret _ = Just Unknown --------------------------------------------------------------------------------- - expr :: Expr -> SExpr String expr (ConstB v) = atom $ if v then "true" else "false" @@ -105,5 +97,3 @@ expr (Op2 _ op e1 e2) = expr (SVal _ f ix) = atom $ case ix of Fixed i -> f ++ "_" ++ show i Var off -> f ++ "_n" ++ show off - --------------------------------------------------------------------------------- From 788aba2bd5563d459ec76de19c256bed02dfe967 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:06:36 -0400 Subject: [PATCH 0309/1222] Style: remove separating line in comment. Refs #316. According to our style guide, the code should not use lines with multiple consecutive hyphens, stars, or other symbols, to separate sections of code. --- copilot-theorem/src/Copilot/Theorem/Prover/TPTP.hs | 10 ---------- 1 file changed, 10 deletions(-) diff --git a/copilot-theorem/src/Copilot/Theorem/Prover/TPTP.hs b/copilot-theorem/src/Copilot/Theorem/Prover/TPTP.hs index cfceb133e..e179409e8 100644 --- a/copilot-theorem/src/Copilot/Theorem/Prover/TPTP.hs +++ b/copilot-theorem/src/Copilot/Theorem/Prover/TPTP.hs @@ -1,5 +1,3 @@ --------------------------------------------------------------------------------- - {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE Safe #-} @@ -13,8 +11,6 @@ import Copilot.Theorem.IL import Data.List --------------------------------------------------------------------------------- - -- | Type used to represent TPTP expressions. -- -- Although this type implements the 'SmtFormat' interface, only 'assert' is @@ -34,8 +30,6 @@ instance Show TptpExpr where show (Atom atom) = atom show (Fun name args) = name ++ "(" ++ intercalate ", " (map show args) ++ ")" --------------------------------------------------------------------------------- - instance SmtFormat Tptp where push = Null pop = Null @@ -51,8 +45,6 @@ interpret str | "SZS status" `isPrefixOf` str = Just Unknown | otherwise = Nothing --------------------------------------------------------------------------------- - expr :: Expr -> TptpExpr expr = \case ConstB v -> Atom $ if v then "$true" else "$false" @@ -110,5 +102,3 @@ showOp2 = \case Mod -> "mod" Fdiv -> "/" Pow -> "^" - --------------------------------------------------------------------------------- From 80e8a30b5c4a74297e7b87c881538886110d197a Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:06:36 -0400 Subject: [PATCH 0310/1222] Style: remove separating line in comment. Refs #316. According to our style guide, the code should not use lines with multiple consecutive hyphens, stars, or other symbols, to separate sections of code. --- copilot-theorem/src/Copilot/Theorem/Prover/Z3.hs | 10 ---------- 1 file changed, 10 deletions(-) diff --git a/copilot-theorem/src/Copilot/Theorem/Prover/Z3.hs b/copilot-theorem/src/Copilot/Theorem/Prover/Z3.hs index 7c78b28ec..4bce3df56 100644 --- a/copilot-theorem/src/Copilot/Theorem/Prover/Z3.hs +++ b/copilot-theorem/src/Copilot/Theorem/Prover/Z3.hs @@ -1,5 +1,3 @@ --------------------------------------------------------------------------------- - {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} @@ -47,8 +45,6 @@ import System.Console.ANSI import System.IO import Control.Monad.Trans --------------------------------------------------------------------------------- - -- | Tactics data Options = Options @@ -103,8 +99,6 @@ kInduction opts = check P.Prover , P.closeProver = const $ return () } -------------------------------------------------------------------------------- - -- | Checks the Copilot specification with k-induction type Solver = SMTConnection (DebugBackend SMTPipe) @@ -304,8 +298,6 @@ selectProps propIds properties = (squash . unzip) [(as, p) | (id, (as, p)) <- Map.toList properties, id `elem` propIds] where squash (a, b) = (concat a, b) --------------------------------------------------------------------------------- - -- | This is all very ugly. It might make better sense to go straight from Core to SMTExpr, or maybe use SBV instead. type Trans = StateT TransState SMT @@ -487,9 +479,7 @@ transBV64 = \case SVal _ s i -> getBV64Var $ ncVar s i e -> error $ "Encountered unhandled expression (BV64): " ++ show e ------------------------------------------------------ -- Debug stuff from the the smtlib2 library github -- ------------------------------------------------------ namedDebugBackend :: String -> Bool -> b -> DebugBackend b namedDebugBackend name mute b = DebugBackend b stderr (Just 0) (Just name) True mute From 7138f23129323a08b7a12e531234e40c6e02ce6c Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:06:36 -0400 Subject: [PATCH 0311/1222] Style: remove separating line in comment. Refs #316. According to our style guide, the code should not use lines with multiple consecutive hyphens, stars, or other symbols, to separate sections of code. --- copilot-theorem/src/Copilot/Theorem/TransSys.hs | 4 ---- 1 file changed, 4 deletions(-) diff --git a/copilot-theorem/src/Copilot/Theorem/TransSys.hs b/copilot-theorem/src/Copilot/Theorem/TransSys.hs index c5d3fb760..1ad01e532 100644 --- a/copilot-theorem/src/Copilot/Theorem/TransSys.hs +++ b/copilot-theorem/src/Copilot/Theorem/TransSys.hs @@ -1,5 +1,3 @@ --------------------------------------------------------------------------------- - {-# LANGUAGE Safe #-} -- | Each prover first translates the Copilot specification into an @@ -17,5 +15,3 @@ import Copilot.Theorem.TransSys.Spec as X import Copilot.Theorem.TransSys.PrettyPrint as X import Copilot.Theorem.TransSys.Translate as X import Copilot.Theorem.TransSys.Transform as X - --------------------------------------------------------------------------------- From aaea7471725353b8edd4b3b1ef674f60ba59cb9c Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:06:36 -0400 Subject: [PATCH 0312/1222] Style: remove separating line in comment. Refs #316. According to our style guide, the code should not use lines with multiple consecutive hyphens, stars, or other symbols, to separate sections of code. --- copilot-theorem/src/Copilot/Theorem/TransSys/Cast.hs | 10 ---------- 1 file changed, 10 deletions(-) diff --git a/copilot-theorem/src/Copilot/Theorem/TransSys/Cast.hs b/copilot-theorem/src/Copilot/Theorem/TransSys/Cast.hs index bbb0ea311..8d7cc7c52 100644 --- a/copilot-theorem/src/Copilot/Theorem/TransSys/Cast.hs +++ b/copilot-theorem/src/Copilot/Theorem/TransSys/Cast.hs @@ -1,5 +1,3 @@ --------------------------------------------------------------------------------- - {-# LANGUAGE GADTs #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE Safe #-} @@ -16,8 +14,6 @@ module Copilot.Theorem.TransSys.Cast , casting ) where --------------------------------------------------------------------------------- - import Copilot.Core as C import Data.Dynamic (Dynamic(..), fromDynamic, toDyn) @@ -25,8 +21,6 @@ import GHC.Float import qualified Copilot.Theorem.TransSys.Type as K --------------------------------------------------------------------------------- - -- | Synonym for a dynamic type in Copilot core. type Dyn = Dynamic @@ -62,8 +56,6 @@ casting t f = case castedType t of K.U K.Integer -> f K.Integer K.U K.Real -> f K.Real --------------------------------------------------------------------------------- - class Casted b where _cast :: Dyn -> Maybe b @@ -89,5 +81,3 @@ instance Casted Double where | Just (v :: Float) <- fromDynamic d = Just $ float2Double v | Just (v :: Double) <- fromDynamic d = Just v | otherwise = Nothing - --------------------------------------------------------------------------------- From 987db31deb385bae62686a32caac63bb9ff52ccd Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:06:36 -0400 Subject: [PATCH 0313/1222] Style: remove separating line in comment. Refs #316. According to our style guide, the code should not use lines with multiple consecutive hyphens, stars, or other symbols, to separate sections of code. --- .../src/Copilot/Theorem/TransSys/Operators.hs | 14 -------------- 1 file changed, 14 deletions(-) diff --git a/copilot-theorem/src/Copilot/Theorem/TransSys/Operators.hs b/copilot-theorem/src/Copilot/Theorem/TransSys/Operators.hs index 5b6edbfd2..dd95d45db 100644 --- a/copilot-theorem/src/Copilot/Theorem/TransSys/Operators.hs +++ b/copilot-theorem/src/Copilot/Theorem/TransSys/Operators.hs @@ -1,5 +1,3 @@ --------------------------------------------------------------------------------- - {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} @@ -16,8 +14,6 @@ import Copilot.Theorem.TransSys.Type import Copilot.Theorem.Misc.Error as Err --------------------------------------------------------------------------------- - -- | Unary operators. data Op1 a where Not :: Op1 Bool @@ -58,8 +54,6 @@ data Op2 a b where Pow :: (Num a) => Op2 a a -------------------------------------------------------------------------------- - instance Show (Op1 a) where show op = case op of Neg -> "-" @@ -97,8 +91,6 @@ instance Show (Op2 a b) where Fdiv -> "/" Pow -> "^" -------------------------------------------------------------------------------- - -- | Unhandled unary operator. -- -- Unhandled operators are monomorphic, and their names are labeled so that @@ -198,8 +190,6 @@ handleOp1 resT (op, e) handleExpr notHandledF mkOp = case op of notHandled ta s = casting ta $ \ta' -> notHandledF $ UnhandledOp1 s ta' resT --------------------------------------------------------------------------------- - -- | Translate an Op2. -- -- This function is parameterized so that it can be used to translate @@ -330,10 +320,6 @@ handleOp2 resT (op, e1, e2) handleExpr notHandledF mkOp notOp = case op of notHandled ta s = casting ta $ \ta' -> notHandledF (UnhandledOp2 s ta' ta' ta') --------------------------------------------------------------------------------- - -- | Error message for unexpected behavior / internal errors. typeErrMsg :: String typeErrMsg = "Unexpected type error in 'Misc.CoreOperators'" - --------------------------------------------------------------------------------- From dad6491354101c63e54833f17f8a6afd639e2622 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:06:36 -0400 Subject: [PATCH 0314/1222] Style: remove separating line in comment. Refs #316. According to our style guide, the code should not use lines with multiple consecutive hyphens, stars, or other symbols, to separate sections of code. --- copilot-theorem/src/Copilot/Theorem/TransSys/PrettyPrint.hs | 6 ------ 1 file changed, 6 deletions(-) diff --git a/copilot-theorem/src/Copilot/Theorem/TransSys/PrettyPrint.hs b/copilot-theorem/src/Copilot/Theorem/TransSys/PrettyPrint.hs index f1f8a585c..b4f4c6926 100644 --- a/copilot-theorem/src/Copilot/Theorem/TransSys/PrettyPrint.hs +++ b/copilot-theorem/src/Copilot/Theorem/TransSys/PrettyPrint.hs @@ -1,5 +1,3 @@ --------------------------------------------------------------------------------- - {-# LANGUAGE GADTs #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE Safe #-} @@ -16,8 +14,6 @@ import qualified Data.Bimap as Bimap import Prelude hiding ((<>)) --------------------------------------------------------------------------------- - indent = nest 4 emptyLine = text "" @@ -122,5 +118,3 @@ pOp1 = text . show pOp2 :: Op2 a b -> Doc pOp2 = text . show - --------------------------------------------------------------------------------- From b0327d74f3e06b11467326ba06b384f132d812c4 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:06:36 -0400 Subject: [PATCH 0315/1222] Style: remove separating line in comment. Refs #316. According to our style guide, the code should not use lines with multiple consecutive hyphens, stars, or other symbols, to separate sections of code. --- copilot-theorem/src/Copilot/Theorem/TransSys/Renaming.hs | 8 -------- 1 file changed, 8 deletions(-) diff --git a/copilot-theorem/src/Copilot/Theorem/TransSys/Renaming.hs b/copilot-theorem/src/Copilot/Theorem/TransSys/Renaming.hs index d3cea4e26..76c7ba099 100644 --- a/copilot-theorem/src/Copilot/Theorem/TransSys/Renaming.hs +++ b/copilot-theorem/src/Copilot/Theorem/TransSys/Renaming.hs @@ -1,5 +1,3 @@ --------------------------------------------------------------------------------- - {-# LANGUAGE Safe #-} -- | A monad capable of keeping track of variable renames and of providing @@ -25,8 +23,6 @@ import qualified Data.Map as Map import qualified Data.Set as Set import qualified Data.List as List --------------------------------------------------------------------------------- - -- | A monad capable of keeping track of variable renames and of providing -- fresh names for variables. type Renaming = State RenamingST @@ -36,8 +32,6 @@ data RenamingST = RenamingST { _reservedNames :: Set Var , _renaming :: Map ExtVar Var } --------------------------------------------------------------------------------- - -- | Register a name as reserved or used. addReservedName :: Var -> Renaming () addReservedName v = modify $ \st -> @@ -86,5 +80,3 @@ runRenaming m = r <- m f <- getRenamingF return (r, f) - --------------------------------------------------------------------------------- From f372fa3cf185c0597b8fded3ef8724c8a38e0ba5 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:06:36 -0400 Subject: [PATCH 0316/1222] Style: remove separating line in comment. Refs #316. According to our style guide, the code should not use lines with multiple consecutive hyphens, stars, or other symbols, to separate sections of code. --- .../src/Copilot/Theorem/TransSys/Spec.hs | 18 ------------------ 1 file changed, 18 deletions(-) diff --git a/copilot-theorem/src/Copilot/Theorem/TransSys/Spec.hs b/copilot-theorem/src/Copilot/Theorem/TransSys/Spec.hs index 2bc45b34e..e24564abb 100644 --- a/copilot-theorem/src/Copilot/Theorem/TransSys/Spec.hs +++ b/copilot-theorem/src/Copilot/Theorem/TransSys/Spec.hs @@ -1,5 +1,3 @@ --------------------------------------------------------------------------------- - {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE RankNTypes #-} @@ -46,8 +44,6 @@ import qualified Data.Map as Map import qualified Data.Set as Set import qualified Data.Bimap as Bimap --------------------------------------------------------------------------------- - -- | Unique name that identifies a node. type NodeId = String @@ -104,8 +100,6 @@ data Expr t where Op2 :: Type t -> Op2 a t -> Expr a -> Expr a -> Expr t VarE :: Type t -> Var -> Expr t --------------------------------------------------------------------------------- - -- | Constructor for variables identifiers in the global namespace. mkExtVar node name = ExtVar node (Var name) @@ -131,8 +125,6 @@ transformExpr f = tre tre (Op2 t op e1 e2) = f (Op2 t op (tre e1) (tre e2)) tre e = f e --------------------------------------------------------------------------------- - -- | The set of variables related to a node (union of the local variables and -- the imported variables after deferencing them). nodeVarsSet :: Node -> Set Var @@ -161,8 +153,6 @@ nodeImportedExtVarsSet = Map.keysSet . Bimap.toMapR . nodeImportedVars nodeExportedExtVarsSet :: Node -> Set ExtVar nodeExportedExtVarsSet n = Set.map (ExtVar $ nodeId n) (nodeLocalVarsSet n) --------------------------------------------------------------------------------- - instance HasInvariants Node where invariants n = @@ -179,8 +169,6 @@ instance HasInvariants Node where in preVars `isSubsetOf` nodeLocalVarsSet n ] --------------------------------------------------------------------------------- - specNodesIds :: TransSys -> Set NodeId specNodesIds s = Set.fromList . map nodeId $ specNodes s @@ -196,8 +184,6 @@ specTopNode spec = fromJust $ List.find ((== specTopNodeId spec) . nodeId) (specNodes spec) --------------------------------------------------------------------------------- - instance HasInvariants TransSys where invariants s = @@ -223,10 +209,6 @@ isTopologicallySorted spec = guard $ Set.fromList (nodeDependencies n) `isSubsetOf` acc return . Set.insert (nodeId n) $ acc --------------------------------------------------------------------------------- - -- For debugging purposes instance Show ExtVar where show (ExtVar n v) = "(" ++ n ++ " : " ++ show v ++ ")" - --------------------------------------------------------------------------------- From a002d0cbcb25f3585b678e49d7a60e1b56ffb7c0 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:06:36 -0400 Subject: [PATCH 0317/1222] Style: remove separating line in comment. Refs #316. According to our style guide, the code should not use lines with multiple consecutive hyphens, stars, or other symbols, to separate sections of code. --- .../src/Copilot/Theorem/TransSys/Transform.hs | 12 ------------ 1 file changed, 12 deletions(-) diff --git a/copilot-theorem/src/Copilot/Theorem/TransSys/Transform.hs b/copilot-theorem/src/Copilot/Theorem/TransSys/Transform.hs index 54d580521..79edd2828 100644 --- a/copilot-theorem/src/Copilot/Theorem/TransSys/Transform.hs +++ b/copilot-theorem/src/Copilot/Theorem/TransSys/Transform.hs @@ -1,5 +1,3 @@ --------------------------------------------------------------------------------- - {-# LANGUAGE RankNTypes #-} {-# LANGUAGE Safe #-} @@ -31,15 +29,11 @@ import qualified Data.Set as Set import qualified Data.Graph as Graph import qualified Data.Bimap as Bimap --------------------------------------------------------------------------------- - prefix :: String -> Var -> Var prefix s1 (Var s2) = Var $ s1 ++ "." ++ s2 ncNodeIdSep = "-" --------------------------------------------------------------------------------- - -- | Merge all the given nodes, replacing all references to the given node Ids -- with a reference to a fresh node id (unless the nodes given as argument -- contain the top node), in which case its ID is chosen instead. @@ -180,8 +174,6 @@ redirectLocalImports toMerge = do guard $ n' `member` mergedNodesSet return (nId, alias, n', v) --------------------------------------------------------------------------------- - -- | Discard all the structure of a /modular transition system/ and turn it -- into a /non-modular transition system/ with only one node. inline :: TransSys -> TransSys @@ -218,8 +210,6 @@ removeCycles spec = topoSort s = s { specNodes = map (\(Graph.AcyclicSCC n) -> n) $ buildScc id (specNodes s) } --------------------------------------------------------------------------------- - -- | Completes each node of a specification with imported variables such that -- each node contains a copy of all its dependencies. -- @@ -283,5 +273,3 @@ complete spec = return $ Bimap.tryInsert alias ev acc foldM tryImport (nodeImportedVars n) toImportVars - --------------------------------------------------------------------------------- From 0aa48e4e92aa8b1a7659bed101d6207a7fbed61a Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:06:36 -0400 Subject: [PATCH 0318/1222] Style: remove separating line in comment. Refs #316. According to our style guide, the code should not use lines with multiple consecutive hyphens, stars, or other symbols, to separate sections of code. --- .../src/Copilot/Theorem/TransSys/Translate.hs | 16 ---------------- 1 file changed, 16 deletions(-) diff --git a/copilot-theorem/src/Copilot/Theorem/TransSys/Translate.hs b/copilot-theorem/src/Copilot/Theorem/TransSys/Translate.hs index f3ffcd672..5dbab52be 100644 --- a/copilot-theorem/src/Copilot/Theorem/TransSys/Translate.hs +++ b/copilot-theorem/src/Copilot/Theorem/TransSys/Translate.hs @@ -1,5 +1,3 @@ --------------------------------------------------------------------------------- - {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE NamedFieldPuns #-} @@ -61,8 +59,6 @@ import qualified Copilot.Core as C import qualified Data.Map as Map import qualified Data.Bimap as Bimap --------------------------------------------------------------------------------- - -- Naming conventions -- These are important in order to avoid name conflicts @@ -84,8 +80,6 @@ ncTimeAnnot s d | d == 0 = s | otherwise = s ++ ncSep ++ show d --------------------------------------------------------------------------------- - -- | Translate Copilot specifications into a modular transition system. translate :: C.Spec -> TransSys translate cspec = @@ -112,8 +106,6 @@ translate cspec = topNode = mkTopNode topNodeId (map nodeId propNodes) cprops extVarNodes = map mkExtVarNode extvarNodesNames --------------------------------------------------------------------------------- - mkTopNode :: String -> [NodeId] -> [C.Property] -> Node mkTopNode topNodeId dependencies cprops = Node { nodeId = topNodeId @@ -149,8 +141,6 @@ streamOfProp prop = , C.streamExpr = C.propertyExpr prop , C.streamExprType = C.Bool } --------------------------------------------------------------------------------- - stream :: C.Stream -> Trans Node stream (C.Stream { C.streamId , C.streamBuffer @@ -180,8 +170,6 @@ stream (C.Stream { C.streamId { nodeId, nodeDependencies, nodeLocalVars , nodeImportedVars, nodeConstrs = [] } --------------------------------------------------------------------------------- - expr :: Type t -> C.Expr t' -> Trans (Expr t) expr t (C.Const _ v) = return $ Const t (cast t $ toDyn v) @@ -238,8 +226,6 @@ newUnconstrainedVar t = do newDep newNode return $ VarE t (Var newNode) --------------------------------------------------------------------------------- - runTrans :: Trans a -> (a, [(NodeId, U Type)]) runTrans mx = (x, nubBy' (compare `on` fst) $ _extVarsNodes st) @@ -305,5 +291,3 @@ curNode = _curNode <$> get newExtVarNode id t = modify $ \st -> st { _extVarsNodes = (id, t) : _extVarsNodes st } - --------------------------------------------------------------------------------- From febc19e0507194a273c772b1849b8cda12445d22 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:06:36 -0400 Subject: [PATCH 0319/1222] Style: remove separating line in comment. Refs #316. According to our style guide, the code should not use lines with multiple consecutive hyphens, stars, or other symbols, to separate sections of code. --- copilot-theorem/src/Copilot/Theorem/TransSys/Type.hs | 10 ---------- 1 file changed, 10 deletions(-) diff --git a/copilot-theorem/src/Copilot/Theorem/TransSys/Type.hs b/copilot-theorem/src/Copilot/Theorem/TransSys/Type.hs index 7bab4481d..4a3359d39 100644 --- a/copilot-theorem/src/Copilot/Theorem/TransSys/Type.hs +++ b/copilot-theorem/src/Copilot/Theorem/TransSys/Type.hs @@ -1,5 +1,3 @@ --------------------------------------------------------------------------------- - {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE Safe #-} @@ -12,8 +10,6 @@ module Copilot.Theorem.TransSys.Type import Copilot.Core.Type.Equality --------------------------------------------------------------------------------- - -- | A type at both value and type level. -- -- Real numbers are mapped to 'Double's. @@ -29,18 +25,12 @@ instance EqualType Type where Real =~= Real = Just Refl _ =~= _ = Nothing --------------------------------------------------------------------------------- - -- | Unknown types. -- -- For instance, 'U Expr' is the type of an expression of unknown type data U f = forall t . U (f t) --------------------------------------------------------------------------------- - instance Show (Type t) where show Integer = "Int" show Bool = "Bool" show Real = "Real" - --------------------------------------------------------------------------------- From f811c46ce1c3ef46ac5f444f04d1a853bac295d4 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:06:36 -0400 Subject: [PATCH 0320/1222] Style: remove separating line in comment. Refs #316. According to our style guide, the code should not use lines with multiple consecutive hyphens, stars, or other symbols, to separate sections of code. --- copilot-theorem/src/Copilot/Theorem/What4.hs | 2 -- 1 file changed, 2 deletions(-) diff --git a/copilot-theorem/src/Copilot/Theorem/What4.hs b/copilot-theorem/src/Copilot/Theorem/What4.hs index 98bd4f3cb..94899631b 100644 --- a/copilot-theorem/src/Copilot/Theorem/What4.hs +++ b/copilot-theorem/src/Copilot/Theorem/What4.hs @@ -98,7 +98,6 @@ import LibBF ( bfToDouble import GHC.TypeNats (KnownNat) import qualified Panic as Panic --------------------------------------------------------------------------------- -- 'prove' function -- -- To prove properties of a spec, we translate them into What4 using the TransM @@ -185,7 +184,6 @@ prove solver spec = do (res, _) <- runStateT (unTransM proveProperties) st return res --------------------------------------------------------------------------------- -- What4 translation -- | the state for translating Copilot expressions into What4 expressions. As we From ec333c2646d833dcf9557f0d6e0b30d6eee3364c Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:06:36 -0400 Subject: [PATCH 0321/1222] Style: remove separating line in comment. Refs #316. According to our style guide, the code should not use lines with multiple consecutive hyphens, stars, or other symbols, to separate sections of code. --- copilot/examples/AddMult.hs | 2 -- 1 file changed, 2 deletions(-) diff --git a/copilot/examples/AddMult.hs b/copilot/examples/AddMult.hs index af9acfec4..679b77a7b 100644 --- a/copilot/examples/AddMult.hs +++ b/copilot/examples/AddMult.hs @@ -1,6 +1,4 @@ --------------------------------------------------------------------------------- -- Copyright © 2019 National Institute of Aerospace / Galois, Inc. --------------------------------------------------------------------------------- -- | Another small example that calculates a constant value using a recursive -- function. From 45b3d4f7b9943fd533313d8142942c7d70af4086 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:06:36 -0400 Subject: [PATCH 0322/1222] Style: remove separating line in comment. Refs #316. According to our style guide, the code should not use lines with multiple consecutive hyphens, stars, or other symbols, to separate sections of code. --- copilot/examples/Array.hs | 2 -- 1 file changed, 2 deletions(-) diff --git a/copilot/examples/Array.hs b/copilot/examples/Array.hs index 5122ecd43..c83387f53 100644 --- a/copilot/examples/Array.hs +++ b/copilot/examples/Array.hs @@ -1,6 +1,4 @@ --------------------------------------------------------------------------------- -- Copyright © 2019 National Institute of Aerospace / Galois, Inc. --------------------------------------------------------------------------------- -- | This is a simple example for arrays. As a program, it does not make much -- sense, however it shows of the features of arrays nicely. From ac63fde1477591e0a02f6da203d95515079ee9c7 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:06:36 -0400 Subject: [PATCH 0323/1222] Style: remove separating line in comment. Refs #316. According to our style guide, the code should not use lines with multiple consecutive hyphens, stars, or other symbols, to separate sections of code. --- copilot/examples/Cast.hs | 2 -- 1 file changed, 2 deletions(-) diff --git a/copilot/examples/Cast.hs b/copilot/examples/Cast.hs index f2cdaf3dd..67e597a18 100644 --- a/copilot/examples/Cast.hs +++ b/copilot/examples/Cast.hs @@ -1,6 +1,4 @@ --------------------------------------------------------------------------------- -- Copyright © 2019 National Institute of Aerospace / Galois, Inc. --------------------------------------------------------------------------------- -- | Examples of casting types. From b3ec7d34fc1fdc653c5b9cb587623265141f47b6 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:06:36 -0400 Subject: [PATCH 0324/1222] Style: remove separating line in comment. Refs #316. According to our style guide, the code should not use lines with multiple consecutive hyphens, stars, or other symbols, to separate sections of code. --- copilot/examples/Clock.hs | 2 -- 1 file changed, 2 deletions(-) diff --git a/copilot/examples/Clock.hs b/copilot/examples/Clock.hs index f8dbc196b..e4845283d 100644 --- a/copilot/examples/Clock.hs +++ b/copilot/examples/Clock.hs @@ -1,6 +1,4 @@ --------------------------------------------------------------------------------- -- Copyright © 2019 National Institute of Aerospace / Galois, Inc. --------------------------------------------------------------------------------- -- | Example showing usage of clocks to generate periodically recurring truth -- values. From a23949afa3c5ccfb67bbff3da937d8ad1d4468e5 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:06:36 -0400 Subject: [PATCH 0325/1222] Style: remove separating line in comment. Refs #316. According to our style guide, the code should not use lines with multiple consecutive hyphens, stars, or other symbols, to separate sections of code. --- copilot/examples/Counter.hs | 2 -- 1 file changed, 2 deletions(-) diff --git a/copilot/examples/Counter.hs b/copilot/examples/Counter.hs index 5a0fe6d51..8d659631f 100644 --- a/copilot/examples/Counter.hs +++ b/copilot/examples/Counter.hs @@ -1,6 +1,4 @@ -------------------------------------------------------------------------------- -- Copyright © 2019 National Institute of Aerospace / Galois, Inc. --------------------------------------------------------------------------------- -- | Example showing an implementation of a resettable counter. From f009acb9771594fde43f2b30c38b4839a637c2e8 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:06:36 -0400 Subject: [PATCH 0326/1222] Style: remove separating line in comment. Refs #316. According to our style guide, the code should not use lines with multiple consecutive hyphens, stars, or other symbols, to separate sections of code. --- copilot/examples/Engine.hs | 2 -- 1 file changed, 2 deletions(-) diff --git a/copilot/examples/Engine.hs b/copilot/examples/Engine.hs index e3211ec6b..1200170f9 100644 --- a/copilot/examples/Engine.hs +++ b/copilot/examples/Engine.hs @@ -1,6 +1,4 @@ --------------------------------------------------------------------------------- -- Copyright © 2011 National Institute of Aerospace / Galois, Inc. --------------------------------------------------------------------------------- -- | Example implementing an engine cooling control system. From 6825293430a9483cd804044bfbfc2275e067514b Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:06:36 -0400 Subject: [PATCH 0327/1222] Style: remove separating line in comment. Refs #316. According to our style guide, the code should not use lines with multiple consecutive hyphens, stars, or other symbols, to separate sections of code. --- copilot/examples/Heater.hs | 2 -- 1 file changed, 2 deletions(-) diff --git a/copilot/examples/Heater.hs b/copilot/examples/Heater.hs index 6204aa126..d71143ee1 100644 --- a/copilot/examples/Heater.hs +++ b/copilot/examples/Heater.hs @@ -1,6 +1,4 @@ --------------------------------------------------------------------------------- -- Copyright 2019 National Institute of Aerospace / Galois, Inc. --------------------------------------------------------------------------------- -- This is a simple example with basic usage. It implements a simple home -- heating system: It heats when temp gets too low, and stops when it is high From 85ac42fc6e2f84fff23390ad2ea95ab673a265d2 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:06:36 -0400 Subject: [PATCH 0328/1222] Style: remove separating line in comment. Refs #316. According to our style guide, the code should not use lines with multiple consecutive hyphens, stars, or other symbols, to separate sections of code. --- copilot/examples/Voting.hs | 2 -- 1 file changed, 2 deletions(-) diff --git a/copilot/examples/Voting.hs b/copilot/examples/Voting.hs index 14a3341b3..d534fe2c7 100644 --- a/copilot/examples/Voting.hs +++ b/copilot/examples/Voting.hs @@ -1,6 +1,4 @@ --------------------------------------------------------------------------------- -- Copyright © 2019 National Institute of Aerospace / Galois, Inc. --------------------------------------------------------------------------------- -- | Fault-tolerant voting examples. From 0d7abe9bf2c1139c249637071aafa929b72fe64e Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:06:36 -0400 Subject: [PATCH 0329/1222] Style: remove separating line in comment. Refs #316. According to our style guide, the code should not use lines with multiple consecutive hyphens, stars, or other symbols, to separate sections of code. --- copilot/examples/WCV.hs | 8 -------- 1 file changed, 8 deletions(-) diff --git a/copilot/examples/WCV.hs b/copilot/examples/WCV.hs index db3ea8183..0fa67094a 100644 --- a/copilot/examples/WCV.hs +++ b/copilot/examples/WCV.hs @@ -32,9 +32,7 @@ tcoathr = extern "tcoathr" Nothing type Vect2 = (Stream Double, Stream Double) --------------------------------- -- External streams for relative position and velocity. --------------------------------- -- | The relative x velocity between ownship and the intruder. vx :: Stream Double @@ -68,9 +66,7 @@ sz = extern "relative_position_z" Nothing s :: (Stream Double, Stream Double) s = (sx, sy) ------------------- -- The following section contains basic libraries for working with vectors. ------------------- -- | Multiply two Vectors. (|*|) :: Vect2 -> Vect2 -> Stream Double @@ -97,10 +93,8 @@ a ~= b = (abs (a - b)) < 0.001 neg :: Vect2 -> Vect2 neg (x, y) = (negate x, negate y) --------------------- -- From here on the algorithm, as described by the paper mentioned on the top -- of this file, is implemented. Please refer to the paper for details. --------------------- tau :: Vect2 -> Vect2 -> Stream Double tau s v = if s |*| v < 0 @@ -137,9 +131,7 @@ tcoa sz vz = if (sz * vz) < 0 dcpa :: Vect2 -> Vect2 -> Stream Double dcpa s@(sx, sy) v@(vx, vy) = norm (sx + (tcpa s v) * vx, sy + (tcpa s v) * vy) --------------------------- -- Well clear Violation -- --------------------------- -- | Determines if the well clear property is violated or not. wcv :: (Vect2 -> Vect2 -> Stream Double) -> From 78945008ccd7ea6d7ee63a03b8b21f2dcc356d96 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:21:25 -0400 Subject: [PATCH 0330/1222] Style: make where keyword stand alone on one line. Refs #316. According to our style guide, the where keyword should be alone on one line (that is, neither following an expression nor with a definition following it), except in data/type class/instance/module/type family declarations. --- .../src/Copilot/Compile/C99/CodeGen.hs | 193 ++++++++++-------- 1 file changed, 104 insertions(+), 89 deletions(-) diff --git a/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs b/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs index 8b3fee912..6e00c4bb8 100644 --- a/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs +++ b/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs @@ -18,41 +18,47 @@ import Copilot.Compile.C99.Translate -- | Write a declaration for a generator function. gendecln :: String -> Type a -> C.Decln -gendecln name ty = C.FunDecln Nothing cty name [] where - cty = C.decay $ transtype ty +gendecln name ty = C.FunDecln Nothing cty name [] + where + cty = C.decay $ transtype ty -- | Write a generator function for a stream. genfun :: String -> Expr a -> Type a -> C.FunDef -genfun name expr ty = C.FunDef cty name [] cvars [C.Return $ Just cexpr] where - cty = C.decay $ transtype ty - (cexpr, cvars) = runState (transexpr expr) mempty +genfun name expr ty = C.FunDef cty name [] cvars [C.Return $ Just cexpr] + where + cty = C.decay $ transtype ty + (cexpr, cvars) = runState (transexpr expr) mempty -- | Make a extern declaration of a variable. mkextdecln :: External -> C.Decln -mkextdecln (External name _ ty) = decln where - decln = C.VarDecln (Just C.Extern) cty name Nothing - cty = transtype ty +mkextdecln (External name _ ty) = decln + where + decln = C.VarDecln (Just C.Extern) cty name Nothing + cty = transtype ty -- | Make a declaration for a copy of an external variable. mkextcpydecln :: External -> C.Decln -mkextcpydecln (External name cpyname ty) = decln where - cty = transtype ty - decln = C.VarDecln (Just C.Static) cty cpyname Nothing +mkextcpydecln (External name cpyname ty) = decln + where + cty = transtype ty + decln = C.VarDecln (Just C.Static) cty cpyname Nothing -- | Make a C buffer variable and initialise it with the stream buffer. mkbuffdecln :: Id -> Type a -> [a] -> C.Decln -mkbuffdecln sid ty xs = C.VarDecln (Just C.Static) cty name initvals where - name = streamname sid - cty = C.Array (transtype ty) (Just $ C.LitInt $ fromIntegral buffsize) - buffsize = length xs - initvals = Just $ C.InitArray $ constarray ty xs +mkbuffdecln sid ty xs = C.VarDecln (Just C.Static) cty name initvals + where + name = streamname sid + cty = C.Array (transtype ty) (Just $ C.LitInt $ fromIntegral buffsize) + buffsize = length xs + initvals = Just $ C.InitArray $ constarray ty xs -- | Make a C index variable and initialise it to 0. mkindexdecln :: Id -> C.Decln -mkindexdecln sid = C.VarDecln (Just C.Static) cty name initval where - name = indexname sid - cty = C.TypeSpec $ C.TypedefName "size_t" - initval = Just $ C.InitExpr $ C.LitInt 0 +mkindexdecln sid = C.VarDecln (Just C.Static) cty name initval + where + name = indexname sid + cty = C.TypeSpec $ C.TypedefName "size_t" + initval = Just $ C.InitExpr $ C.LitInt 0 -- | Define an accessor functions for the ring buffer associated with a stream mkaccessdecln :: Id -> Type a -> [a] -> C.FunDef @@ -68,82 +74,90 @@ mkaccessdecln sid ty xs = C.FunDef cty name params [] [C.Return (Just expr)] -- | Writes the step function, that updates all streams. mkstep :: CSettings -> [Stream] -> [Trigger] -> [External] -> C.FunDef mkstep cSettings streams triggers exts = - C.FunDef void (cSettingsStepFunctionName cSettings) [] declns stmts where - - void = C.TypeSpec C.Void - stmts = map mkexcopy exts - ++ map mktriggercheck triggers - ++ tmpassigns - ++ bufferupdates - ++ indexupdates - (declns, tmpassigns, bufferupdates, indexupdates) = - unzip4 $ map mkupdateglobals streams - - -- Write code to update global stream buffers and index. - mkupdateglobals :: Stream -> (C.Decln, C.Stmt, C.Stmt, C.Stmt) - mkupdateglobals (Stream sid buff expr ty) = - (tmpdecln, tmpassign, bufferupdate, indexupdate) - where - tmpdecln = C.VarDecln Nothing cty tmp_var Nothing - - tmpassign = case ty of - Array _ -> C.Expr $ memcpy (C.Ident tmp_var) val size - where - size = C.LitInt $ fromIntegral $ tysize ty - _ -> C.Expr $ C.Ident tmp_var C..= val + C.FunDef void (cSettingsStepFunctionName cSettings) [] declns stmts + where - bufferupdate = case ty of - Array _ -> C.Expr $ memcpy dest (C.Ident tmp_var) size + void = C.TypeSpec C.Void + stmts = map mkexcopy exts + ++ map mktriggercheck triggers + ++ tmpassigns + ++ bufferupdates + ++ indexupdates + (declns, tmpassigns, bufferupdates, indexupdates) = + unzip4 $ map mkupdateglobals streams + + -- Write code to update global stream buffers and index. + mkupdateglobals :: Stream -> (C.Decln, C.Stmt, C.Stmt, C.Stmt) + mkupdateglobals (Stream sid buff expr ty) = + (tmpdecln, tmpassign, bufferupdate, indexupdate) + where + tmpdecln = C.VarDecln Nothing cty tmp_var Nothing + + tmpassign = case ty of + Array _ -> C.Expr $ memcpy (C.Ident tmp_var) val size + where + size = C.LitInt $ fromIntegral $ tysize ty + _ -> C.Expr $ C.Ident tmp_var C..= val + + bufferupdate = case ty of + Array _ -> C.Expr $ memcpy dest (C.Ident tmp_var) size + where + dest = C.Index buff_var index_var + size = C.LitInt $ fromIntegral $ tysize ty + _ -> C.Expr $ + C.Index buff_var index_var C..= (C.Ident tmp_var) + + indexupdate = C.Expr $ index_var C..= (incindex C..% bufflength) where - dest = C.Index buff_var index_var - size = C.LitInt $ fromIntegral $ tysize ty - _ -> C.Expr $ C.Index buff_var index_var C..= (C.Ident tmp_var) - - indexupdate = C.Expr $ index_var C..= (incindex C..% bufflength) + bufflength = C.LitInt $ fromIntegral $ length buff + incindex = index_var C..+ C.LitInt 1 + + tmp_var = streamname sid ++ "_tmp" + buff_var = C.Ident $ streamname sid + index_var = C.Ident $ indexname sid + val = C.Funcall (C.Ident $ generatorname sid) [] + cty = transtype ty + + -- Make code that copies an external variable to its local one. + mkexcopy :: External -> C.Stmt + mkexcopy (External name cpyname ty) = C.Expr $ case ty of + Array _ -> memcpy exvar locvar size + where + exvar = C.Ident cpyname + locvar = C.Ident name + size = C.LitInt $ fromIntegral $ tysize ty + + _ -> C.Ident cpyname C..= C.Ident name + + -- Make if-statement to check the guard, call the trigger if necessary. + mktriggercheck :: Trigger -> C.Stmt + mktriggercheck (Trigger name guard args) = C.If guard' firetrigger + where + guard' = C.Funcall (C.Ident $ guardname name) [] + firetrigger = [C.Expr $ C.Funcall (C.Ident name) args'] where - bufflength = C.LitInt $ fromIntegral $ length buff - incindex = index_var C..+ C.LitInt 1 - - tmp_var = streamname sid ++ "_tmp" - buff_var = C.Ident $ streamname sid - index_var = C.Ident $ indexname sid - val = C.Funcall (C.Ident $ generatorname sid) [] - cty = transtype ty - - -- Make code that copies an external variable to its local one. - mkexcopy :: External -> C.Stmt - mkexcopy (External name cpyname ty) = C.Expr $ case ty of - Array _ -> memcpy exvar locvar size where - exvar = C.Ident cpyname - locvar = C.Ident name - size = C.LitInt $ fromIntegral $ tysize ty - _ -> C.Ident cpyname C..= C.Ident name - - -- Make if-statement to check the guard, call the trigger if necessary. - mktriggercheck :: Trigger -> C.Stmt - mktriggercheck (Trigger name guard args) = C.If guard' firetrigger where - guard' = C.Funcall (C.Ident $ guardname name) [] - firetrigger = [C.Expr $ C.Funcall (C.Ident name) args'] where - args' = take (length args) (map argcall (argnames name)) - argcall name = C.Funcall (C.Ident name) [] - - -- Write a call to the memcpy function. - memcpy :: C.Expr -> C.Expr -> C.Expr -> C.Expr - memcpy dest src size = C.Funcall (C.Ident "memcpy") [dest, src, size] + args' = take (length args) (map argcall (argnames name)) + argcall name = C.Funcall (C.Ident name) [] + + -- Write a call to the memcpy function. + memcpy :: C.Expr -> C.Expr -> C.Expr -> C.Expr + memcpy dest src size = C.Funcall (C.Ident "memcpy") [dest, src, size] -- | Write a struct declaration based on its definition. mkstructdecln :: Struct a => Type a -> C.Decln -mkstructdecln (Struct x) = C.TypeDecln struct where - struct = C.TypeSpec $ C.StructDecln (Just $ typename x) fields - fields = map mkfield (toValues x) +mkstructdecln (Struct x) = C.TypeDecln struct + where + struct = C.TypeSpec $ C.StructDecln (Just $ typename x) fields + fields = map mkfield (toValues x) - mkfield :: Value a -> C.FieldDecln - mkfield (Value ty field) = C.FieldDecln (transtype ty) (fieldname field) + mkfield :: Value a -> C.FieldDecln + mkfield (Value ty field) = C.FieldDecln (transtype ty) (fieldname field) -- | Write a forward struct declaration. mkstructforwdecln :: Struct a => Type a -> C.Decln -mkstructforwdecln (Struct x) = C.TypeDecln struct where - struct = C.TypeSpec $ C.Struct (typename x) +mkstructforwdecln (Struct x) = C.TypeDecln struct + where + struct = C.TypeSpec $ C.Struct (typename x) -- | List all types of an expression, returns items uniquely. exprtypes :: Typeable a => Expr a -> [UType] @@ -170,6 +184,7 @@ typetypes ty = case ty of -- into an UEXpr. gatherexprs :: [Stream] -> [Trigger] -> [UExpr] gatherexprs streams triggers = map streamexpr streams - ++ concatMap triggerexpr triggers where - streamexpr (Stream _ _ expr ty) = UExpr ty expr - triggerexpr (Trigger _ guard args) = UExpr Bool guard : args + ++ concatMap triggerexpr triggers + where + streamexpr (Stream _ _ expr ty) = UExpr ty expr + triggerexpr (Trigger _ guard args) = UExpr Bool guard : args From d2ac2ab8ded16f42396db1716631f7a4ad4bbc39 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:21:25 -0400 Subject: [PATCH 0331/1222] Style: make where keyword stand alone on one line. Refs #316. According to our style guide, the where keyword should be alone on one line (that is, neither following an expression nor with a definition following it), except in data/type class/instance/module/type family declarations. --- .../src/Copilot/Compile/C99/Compile.hs | 173 +++++++++--------- 1 file changed, 91 insertions(+), 82 deletions(-) diff --git a/copilot-c99/src/Copilot/Compile/C99/Compile.hs b/copilot-c99/src/Copilot/Compile/C99/Compile.hs index e1038e65d..42ac9bc6c 100644 --- a/copilot-c99/src/Copilot/Compile/C99/Compile.hs +++ b/copilot-c99/src/Copilot/Compile/C99/Compile.hs @@ -69,88 +69,97 @@ compile = compileWith mkDefaultCSettings -- * Generator functions for streams, guards and trigger arguments. -- * Declaration of the @step()@ function. compilec :: CSettings -> Spec -> C.TransUnit -compilec cSettings spec = C.TransUnit declns funs where - streams = specStreams spec - triggers = specTriggers spec - exts = gatherexts streams triggers - exprs = gatherexprs streams triggers - - declns = mkstructdeclns exprs ++ mkexts exts ++ mkglobals streams - funs = genfuns streams triggers ++ [mkstep cSettings streams triggers exts] - - -- Write struct datatypes - mkstructdeclns :: [UExpr] -> [C.Decln] - mkstructdeclns es = catMaybes $ map mkdecln utypes where - mkdecln (UType ty) = case ty of - Struct x -> Just $ mkstructdecln ty - _ -> Nothing - - utypes = nub $ concatMap (\(UExpr _ e) -> exprtypes e) es - - -- Make declarations for copies of external variables. - mkexts :: [External] -> [C.Decln] - mkexts exts = map mkextcpydecln exts - - -- Make buffer and index declarations for streams. - mkglobals :: [Stream] -> [C.Decln] - mkglobals streams = map buffdecln streams ++ map indexdecln streams where - buffdecln (Stream sid buff _ ty) = mkbuffdecln sid ty buff - indexdecln (Stream sid _ _ _ ) = mkindexdecln sid - - -- Make generator functions, including trigger arguments. - genfuns :: [Stream] -> [Trigger] -> [C.FunDef] - genfuns streams triggers = map accessdecln streams - ++ map streamgen streams - ++ concatMap triggergen triggers where - - accessdecln :: Stream -> C.FunDef - accessdecln (Stream sid buff _ ty) = mkaccessdecln sid ty buff - - streamgen :: Stream -> C.FunDef - streamgen (Stream sid _ expr ty) = genfun (generatorname sid) expr ty - - triggergen :: Trigger -> [C.FunDef] - triggergen (Trigger name guard args) = guarddef : argdefs where - guarddef = genfun (guardname name) guard Bool - argdefs = map arggen (zip (argnames name) args) - - arggen :: (String, UExpr) -> C.FunDef - arggen (argname, UExpr ty expr) = genfun argname expr ty +compilec cSettings spec = C.TransUnit declns funs + where + streams = specStreams spec + triggers = specTriggers spec + exts = gatherexts streams triggers + exprs = gatherexprs streams triggers + + declns = mkstructdeclns exprs ++ mkexts exts ++ mkglobals streams + funs = genfuns streams triggers ++ [mkstep cSettings streams triggers exts] + + -- Write struct datatypes + mkstructdeclns :: [UExpr] -> [C.Decln] + mkstructdeclns es = catMaybes $ map mkdecln utypes + where + mkdecln (UType ty) = case ty of + Struct x -> Just $ mkstructdecln ty + _ -> Nothing + + utypes = nub $ concatMap (\(UExpr _ e) -> exprtypes e) es + + -- Make declarations for copies of external variables. + mkexts :: [External] -> [C.Decln] + mkexts exts = map mkextcpydecln exts + + -- Make buffer and index declarations for streams. + mkglobals :: [Stream] -> [C.Decln] + mkglobals streams = map buffdecln streams ++ map indexdecln streams + where + buffdecln (Stream sid buff _ ty) = mkbuffdecln sid ty buff + indexdecln (Stream sid _ _ _ ) = mkindexdecln sid + + -- Make generator functions, including trigger arguments. + genfuns :: [Stream] -> [Trigger] -> [C.FunDef] + genfuns streams triggers = map accessdecln streams + ++ map streamgen streams + ++ concatMap triggergen triggers + where + + accessdecln :: Stream -> C.FunDef + accessdecln (Stream sid buff _ ty) = mkaccessdecln sid ty buff + + streamgen :: Stream -> C.FunDef + streamgen (Stream sid _ expr ty) = genfun (generatorname sid) expr ty + + triggergen :: Trigger -> [C.FunDef] + triggergen (Trigger name guard args) = guarddef : argdefs + where + guarddef = genfun (guardname name) guard Bool + argdefs = map arggen (zip (argnames name) args) + + arggen :: (String, UExpr) -> C.FunDef + arggen (argname, UExpr ty expr) = genfun argname expr ty -- | Generate the .h file from a 'Spec'. compileh :: CSettings -> Spec -> C.TransUnit -compileh cSettings spec = C.TransUnit declns [] where - streams = specStreams spec - triggers = specTriggers spec - exts = gatherexts streams triggers - exprs = gatherexprs streams triggers - - declns = mkstructforwdeclns exprs - ++ mkexts exts - ++ extfundeclns triggers - ++ [stepdecln] - - mkstructforwdeclns :: [UExpr] -> [C.Decln] - mkstructforwdeclns es = catMaybes $ map mkdecln utypes where - mkdecln (UType ty) = case ty of - Struct x -> Just $ mkstructforwdecln ty - _ -> Nothing - - utypes = nub $ concatMap (\(UExpr _ e) -> exprtypes e) es - - -- Make declarations for external variables. - mkexts :: [External] -> [C.Decln] - mkexts = map mkextdecln - - extfundeclns :: [Trigger] -> [C.Decln] - extfundeclns triggers = map extfundecln triggers where - extfundecln :: Trigger -> C.Decln - extfundecln (Trigger name _ args) = C.FunDecln Nothing cty name params where - cty = C.TypeSpec C.Void - params = map mkparam $ zip (argnames name) args - mkparam (name, UExpr ty _) = C.Param (transtype ty) name - - -- Declaration for the step function. - stepdecln :: C.Decln - stepdecln = C.FunDecln Nothing (C.TypeSpec C.Void) - (cSettingsStepFunctionName cSettings) [] +compileh cSettings spec = C.TransUnit declns [] + where + streams = specStreams spec + triggers = specTriggers spec + exts = gatherexts streams triggers + exprs = gatherexprs streams triggers + + declns = mkstructforwdeclns exprs + ++ mkexts exts + ++ extfundeclns triggers + ++ [stepdecln] + + mkstructforwdeclns :: [UExpr] -> [C.Decln] + mkstructforwdeclns es = catMaybes $ map mkdecln utypes + where + mkdecln (UType ty) = case ty of + Struct x -> Just $ mkstructforwdecln ty + _ -> Nothing + + utypes = nub $ concatMap (\(UExpr _ e) -> exprtypes e) es + + -- Make declarations for external variables. + mkexts :: [External] -> [C.Decln] + mkexts = map mkextdecln + + extfundeclns :: [Trigger] -> [C.Decln] + extfundeclns triggers = map extfundecln triggers + where + extfundecln :: Trigger -> C.Decln + extfundecln (Trigger name _ args) = C.FunDecln Nothing cty name params + where + cty = C.TypeSpec C.Void + params = map mkparam $ zip (argnames name) args + mkparam (name, UExpr ty _) = C.Param (transtype ty) name + + -- Declaration for the step function. + stepdecln :: C.Decln + stepdecln = C.FunDecln Nothing (C.TypeSpec C.Void) + (cSettingsStepFunctionName cSettings) [] From f6c8b02247207b6cb3c68f291a3cf1bd802bd3ce Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:21:25 -0400 Subject: [PATCH 0332/1222] Style: make where keyword stand alone on one line. Refs #316. According to our style guide, the where keyword should be alone on one line (that is, neither following an expression nor with a definition following it), except in data/type class/instance/module/type family declarations. --- .../src/Copilot/Compile/C99/External.hs | 50 ++++++++++--------- 1 file changed, 26 insertions(+), 24 deletions(-) diff --git a/copilot-c99/src/Copilot/Compile/C99/External.hs b/copilot-c99/src/Copilot/Compile/C99/External.hs index 1b9c253d2..0d75fafd7 100644 --- a/copilot-c99/src/Copilot/Compile/C99/External.hs +++ b/copilot-c99/src/Copilot/Compile/C99/External.hs @@ -26,27 +26,29 @@ extunion = unionBy (\a b -> extname a == extname b) -- Although Copilot specifications can contain also properties and theorems, -- the C99 backend currently only generates code for streams and triggers. gatherexts :: [Stream] -> [Trigger] -> [External] -gatherexts streams triggers = streamsexts `extunion` triggersexts where - streamsexts = foldr extunion mempty $ map streamexts streams - triggersexts = foldr extunion mempty $ map triggerexts triggers - - streamexts :: Stream -> [External] - streamexts (Stream _ _ expr _) = exprexts expr - - triggerexts :: Trigger -> [External] - triggerexts (Trigger _ guard args) = guardexts `extunion` argexts where - guardexts = exprexts guard - argexts = concat $ map uexprexts args - - uexprexts :: UExpr -> [External] - uexprexts (UExpr _ expr) = exprexts expr - - exprexts :: Expr a -> [External] - exprexts expr = let rec = exprexts in case expr of - Local _ _ _ e1 e2 -> rec e1 `extunion` rec e2 - ExternVar ty name _ -> [External name (excpyname name) ty] - Op1 _ e -> rec e - Op2 _ e1 e2 -> rec e1 `extunion` rec e2 - Op3 _ e1 e2 e3 -> rec e1 `extunion` rec e2 `extunion` rec e3 - Label _ _ e -> rec e - _ -> [] +gatherexts streams triggers = streamsexts `extunion` triggersexts + where + streamsexts = foldr extunion mempty $ map streamexts streams + triggersexts = foldr extunion mempty $ map triggerexts triggers + + streamexts :: Stream -> [External] + streamexts (Stream _ _ expr _) = exprexts expr + + triggerexts :: Trigger -> [External] + triggerexts (Trigger _ guard args) = guardexts `extunion` argexts + where + guardexts = exprexts guard + argexts = concat $ map uexprexts args + + uexprexts :: UExpr -> [External] + uexprexts (UExpr _ expr) = exprexts expr + + exprexts :: Expr a -> [External] + exprexts expr = let rec = exprexts in case expr of + Local _ _ _ e1 e2 -> rec e1 `extunion` rec e2 + ExternVar ty name _ -> [External name (excpyname name) ty] + Op1 _ e -> rec e + Op2 _ e1 e2 -> rec e1 `extunion` rec e2 + Op3 _ e1 e2 e3 -> rec e1 `extunion` rec e2 `extunion` rec e3 + Label _ _ e -> rec e + _ -> [] From bc46068a1fc6b3a61d27f710260034d8fe466441 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:21:25 -0400 Subject: [PATCH 0333/1222] Style: make where keyword stand alone on one line. Refs #316. According to our style guide, the where keyword should be alone on one line (that is, neither following an expression nor with a definition following it), except in data/type class/instance/module/type family declarations. --- copilot-c99/src/Copilot/Compile/C99/Translate.hs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/copilot-c99/src/Copilot/Compile/C99/Translate.hs b/copilot-c99/src/Copilot/Compile/C99/Translate.hs index 4e9c0804b..202168e3d 100644 --- a/copilot-c99/src/Copilot/Compile/C99/Translate.hs +++ b/copilot-c99/src/Copilot/Compile/C99/Translate.hs @@ -246,8 +246,9 @@ transtype ty = case ty of Word64 -> C.TypeSpec $ C.TypedefName "uint64_t" Float -> C.TypeSpec C.Float Double -> C.TypeSpec C.Double - Array ty' -> C.Array (transtype ty') length where - length = Just $ C.LitInt $ fromIntegral $ tylength ty + Array ty' -> C.Array (transtype ty') length + where + length = Just $ C.LitInt $ fromIntegral $ tylength ty Struct s -> C.TypeSpec $ C.Struct (typename s) -- | Translate a Copilot type intro a C typename From 6082502228c934fe2b4c36a6ba974ed1f508d28d Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:21:25 -0400 Subject: [PATCH 0334/1222] Style: make where keyword stand alone on one line. Refs #316. According to our style guide, the where keyword should be alone on one line (that is, neither following an expression nor with a definition following it), except in data/type class/instance/module/type family declarations. --- copilot-c99/src/Copilot/Compile/C99/Util.hs | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/copilot-c99/src/Copilot/Compile/C99/Util.hs b/copilot-c99/src/Copilot/Compile/C99/Util.hs index ae902f525..92758032e 100644 --- a/copilot-c99/src/Copilot/Compile/C99/Util.hs +++ b/copilot-c99/src/Copilot/Compile/C99/Util.hs @@ -17,13 +17,15 @@ statetell m = modify ((flip mappend) m) -- | Generate fresh variable name based on a given one. fresh :: String -> [String] -> String -fresh name used = head $ dropWhile (flip elem used) (name:freshnames) where - freshnames = (name ++).show <$> [0..] +fresh name used = head $ dropWhile (flip elem used) (name:freshnames) + where + freshnames = (name ++).show <$> [0..] -- | Collect all the names from a list of C99 declarations. names :: [C.Decln] -> [String] -names ds = map match ds where - match (C.VarDecln _ _ name _) = name +names ds = map match ds + where + match (C.VarDecln _ _ name _) = name -- | Turn a stream id into a suitable C variable name. streamname :: Id -> String From 20d6e6c6df374cd4af9d7a714da86ae61223bf61 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:21:25 -0400 Subject: [PATCH 0335/1222] Style: make where keyword stand alone on one line. Refs #316. According to our style guide, the where keyword should be alone on one line (that is, neither following an expression nor with a definition following it), except in data/type class/instance/module/type family declarations. --- copilot-core/src/Copilot/Core/Type.hs | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/copilot-core/src/Copilot/Core/Type.hs b/copilot-core/src/Copilot/Core/Type.hs index dc983ec22..82bddce80 100644 --- a/copilot-core/src/Copilot/Core/Type.hs +++ b/copilot-core/src/Copilot/Core/Type.hs @@ -77,9 +77,10 @@ instance (KnownSymbol s, Show t) => Show (Field s t) where show f@(Field v) = fieldname f ++ ":" ++ show v instance {-# OVERLAPPABLE #-} (Typed t, Struct t) => Show t where - show t = "<" ++ fields ++ ">" where - fields = intercalate "," $ map showfield (toValues t) - showfield (Value _ field) = show field + show t = "<" ++ fields ++ ">" + where + fields = intercalate "," $ map showfield (toValues t) + showfield (Value _ field) = show field -- | A Type representing the types of expressions or values handled by -- Copilot Core. From 6128b58d7560a84ded154d1cf9946b299194c3c9 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:21:25 -0400 Subject: [PATCH 0336/1222] Style: make where keyword stand alone on one line. Refs #316. According to our style guide, the where keyword should be alone on one line (that is, neither following an expression nor with a definition following it), except in data/type class/instance/module/type family declarations. --- copilot-core/src/Copilot/Core/Type/Array.hs | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/copilot-core/src/Copilot/Core/Type/Array.hs b/copilot-core/src/Copilot/Core/Type/Array.hs index a1a10a132..f468d2a24 100644 --- a/copilot-core/src/Copilot/Core/Type/Array.hs +++ b/copilot-core/src/Copilot/Core/Type/Array.hs @@ -38,11 +38,12 @@ instance Show t => Show (Array n t) where -- list matches the length of the array at type level. array :: forall n t. KnownNat n => [t] -> Array n t array xs | datalen == typelen = Array xs - | otherwise = error errmsg where - datalen = length xs - typelen = fromIntegral $ natVal (Proxy :: Proxy n) - errmsg = "Length of data (" ++ show datalen ++ - ") does not match length of type (" ++ show typelen ++ ")." + | otherwise = error errmsg + where + datalen = length xs + typelen = fromIntegral $ natVal (Proxy :: Proxy n) + errmsg = "Length of data (" ++ show datalen ++ + ") does not match length of type (" ++ show typelen ++ ")." -- | Association between an array and the type of the elements it contains. type family InnerType x where From 5bdb02304d8c4142a0848971179e6685e04e3380 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:21:25 -0400 Subject: [PATCH 0337/1222] Style: make where keyword stand alone on one line. Refs #316. According to our style guide, the where keyword should be alone on one line (that is, neither following an expression nor with a definition following it), except in data/type class/instance/module/type family declarations. --- copilot-language/src/Copilot/Language/Analyze.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot-language/src/Copilot/Language/Analyze.hs b/copilot-language/src/Copilot/Language/Analyze.hs index 00d7afe84..99e1604db 100644 --- a/copilot-language/src/Copilot/Language/Analyze.hs +++ b/copilot-language/src/Copilot/Language/Analyze.hs @@ -53,7 +53,7 @@ instance Show AnalyzeException where show NestedArray = badUsage $ "An external function cannot take another external function or external array as an argument. Try defining a stream, and using the stream values in the other definition." show TooMuchRecursion = badUsage $ - "You have exceeded the limit of " ++ show maxRecursion ++ " recursive calls in a stream definition. Likely, you have accidently defined a circular stream, such as 'x = x'. Another possibility is you have defined a a polymorphic function with type constraints that references other streams. For example,\n\n nats :: (Typed a, Num a) => Stream a\n nats = [0] ++ nats + 1\n\nis not allowed. Make the definition monomorphic, or add a level of indirection, like \n\n nats :: (Typed a, Num a) => Stream a\n nats = n\n where n = [0] ++ n + 1\n\nFinally, you may have intended to generate a very large expression. You can try shrinking the expression by using local variables. It all else fails, you can increase the maximum size of ecursive calls by modifying 'maxRecursion' in copilot-language." + "You have exceeded the limit of " ++ show maxRecursion ++ " recursive calls in a stream definition. Likely, you have accidently defined a circular stream, such as 'x = x'. Another possibility is you have defined a a polymorphic function with type constraints that references other streams. For example,\n\n nats :: (Typed a, Num a) => Stream a\n nats = [0] ++ nats + 1\n\nis not allowed. Make the definition monomorphic, or add a level of indirection, like \n\n nats :: (Typed a, Num a) => Stream a\n nats = n\n where\n n = [0] ++ n + 1\n\nFinally, you may have intended to generate a very large expression. You can try shrinking the expression by using local variables. It all else fails, you can increase the maximum size of ecursive calls by modifying 'maxRecursion' in copilot-language." show InvalidField = badUsage $ "A struct can only take external variables, arrays, or other structs as fields." show (DifferentTypes name) = badUsage $ From 9b43a26ce436cc14eb68b885c039c8cc89e41751 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:21:25 -0400 Subject: [PATCH 0338/1222] Style: make where keyword stand alone on one line. Refs #316. According to our style guide, the where keyword should be alone on one line (that is, neither following an expression nor with a definition following it), except in data/type class/instance/module/type family declarations. --- copilot/examples/Counter.hs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/copilot/examples/Counter.hs b/copilot/examples/Counter.hs index 8d659631f..8d7104193 100644 --- a/copilot/examples/Counter.hs +++ b/copilot/examples/Counter.hs @@ -20,8 +20,9 @@ counter inc reset = cnt -- Counter that resets when it reaches 256 bytecounter :: Stream Int32 -bytecounter = counter true reset where - reset = counter true false `mod` 256 == 0 +bytecounter = counter true reset + where + reset = counter true false `mod` 256 == 0 spec :: Spec spec = trigger "counter" true [arg $ bytecounter] From 42fecf4cffcdf8d83694467c01d21775e8047832 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:21:25 -0400 Subject: [PATCH 0339/1222] Style: make where keyword stand alone on one line. Refs #316. According to our style guide, the where keyword should be alone on one line (that is, neither following an expression nor with a definition following it), except in data/type class/instance/module/type family declarations. --- copilot/src/Language/Copilot/Main.hs | 21 +++++++++++---------- 1 file changed, 11 insertions(+), 10 deletions(-) diff --git a/copilot/src/Language/Copilot/Main.hs b/copilot/src/Language/Copilot/Main.hs index 756fdaf70..3b42b23ff 100644 --- a/copilot/src/Language/Copilot/Main.hs +++ b/copilot/src/Language/Copilot/Main.hs @@ -62,18 +62,19 @@ cmdargs = CmdArgs -- * @--interpret/-i NUM@: interpret the specification for a given number -- of steps. copilotMain :: Interpreter -> Printer -> Compiler -> Spec -> IO () -copilotMain interp pretty comp spec = main =<< execParser opts where - opts = info (cmdargs <**> helper) fullDesc +copilotMain interp pretty comp spec = main =<< execParser opts + where + opts = info (cmdargs <**> helper) fullDesc - main :: CmdArgs -> IO () - main args = do - let iters = ainterpret args - when (apretty args) $ pretty spec - when (iters Prelude.> 0) $ interp (fromIntegral iters) spec + main :: CmdArgs -> IO () + main args = do + let iters = ainterpret args + when (apretty args) $ pretty spec + when (iters Prelude.> 0) $ interp (fromIntegral iters) spec - when (not $ acompile args) $ do - spec' <- reify spec - comp (aoutput args) spec' + when (not $ acompile args) $ do + spec' <- reify spec + comp (aoutput args) spec' -- | Create a main function with a default interpreter and pretty printer. -- From 01fa61dfd9df162126f64af9bb41dc0d7e8fbf2b Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:31:40 -0400 Subject: [PATCH 0340/1222] Style: make where keyword stand alone on one line. Refs #316. According to our style guide, the where keyword should be alone on one line (that is, neither following an expression nor with a definition following it), except in data/type class/instance/module/type family declarations. --- copilot-core/src/Copilot/Core/Interpret.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot-core/src/Copilot/Core/Interpret.hs b/copilot-core/src/Copilot/Core/Interpret.hs index 1701bfd79..9a86efc5b 100644 --- a/copilot-core/src/Copilot/Core/Interpret.hs +++ b/copilot-core/src/Copilot/Core/Interpret.hs @@ -26,4 +26,5 @@ interpret format k spec = case format of Table -> renderAsTable e CSV -> renderAsCSV e - where e = eval Haskell k spec + where + e = eval Haskell k spec From 12da74b5300166b0e8f5da57439a10e2cab4f9b7 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:33:34 -0400 Subject: [PATCH 0341/1222] Style: make where keyword stand alone on one line. Refs #316. According to our style guide, the where keyword should be alone on one line (that is, neither following an expression nor with a definition following it), except in data/type class/instance/module/type family declarations. --- .../src/Copilot/Core/Interpret/Render.hs | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) diff --git a/copilot-core/src/Copilot/Core/Interpret/Render.hs b/copilot-core/src/Copilot/Core/Interpret/Render.hs index ed2bdbfe1..5b42bb79e 100644 --- a/copilot-core/src/Copilot/Core/Interpret/Render.hs +++ b/copilot-core/src/Copilot/Core/Interpret/Render.hs @@ -97,12 +97,13 @@ asColumns = flip asColumnsWithBuff $ 1 asColumnsWithBuff :: [[Doc]] -> Int -> Doc asColumnsWithBuff lls q = normalize - where normalize = vcat $ map hsep - $ map (\x -> pad (length x) longColumnLen empty x) - $ pad' longEntryLen q - $ transpose lls -- normalize column height - longColumnLen = maximum (map length lls) - longEntryLen = maximum $ map docLen (concat lls) + where + normalize = vcat $ map hsep + $ map (\x -> pad (length x) longColumnLen empty x) + $ pad' longEntryLen q + $ transpose lls -- normalize column height + longColumnLen = maximum (map length lls) + longEntryLen = maximum $ map docLen (concat lls) docLen d = length $ render d @@ -117,4 +118,5 @@ pad' :: Int -- ^ Mininum number of spaces to add -> [[Doc]] pad' _ _ [] = [] pad' mx q (ls:xs) = map buf ls : pad' mx q xs - where buf x = x <> (hcat $ replicate q space) <> (hcat $ replicate (mx - (docLen x)) space) + where + buf x = x <> (hcat $ replicate q space) <> (hcat $ replicate (mx - (docLen x)) space) From 320374e080d9b78c7315d523b07d71bc619a39df Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:34:56 -0400 Subject: [PATCH 0342/1222] Style: make where keyword stand alone on one line. Refs #316. According to our style guide, the where keyword should be alone on one line (that is, neither following an expression nor with a definition following it), except in data/type class/instance/module/type family declarations. --- copilot-core/src/Copilot/Core/PrettyDot.hs | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/copilot-core/src/Copilot/Core/PrettyDot.hs b/copilot-core/src/Copilot/Core/PrettyDot.hs index 607e15fc9..cabbdd7da 100644 --- a/copilot-core/src/Copilot/Core/PrettyDot.hs +++ b/copilot-core/src/Copilot/Core/PrettyDot.hs @@ -165,7 +165,8 @@ ppStream i <> text (printf "%s [label=\"[%s]\",color=green, style=filled]\n" ((show $ i+2)::String) ((concat $ intersperse "," $ map (showWithType Haskell t) buffer )) ::String) <> text (printf "%s -> %s\n" (show (i+1)::String) ((show $ i+2)::String)) <> r1, i1) - where (r1, i1) = ppExprDot (i+3) (i+1) True e + where + (r1, i1) = ppExprDot (i+3) (i+1) True e -- | Pretty print a trigger as a GraphViz graph part. ppTrigger :: Int -- ^ Index or ID of the next node in the graph. @@ -213,7 +214,8 @@ ppObserver i = (text (printf "%s [label=\"observer: \n%s\",color=mediumblue, style=filled]\n" (show i::String) name::String) <> r1, i1) - where (r1, i1) = ppExprDot (i+1) i True e + where + (r1, i1) = ppExprDot (i+1) i True e -- | Pretty print a property as a GraphViz graph part. ppProperty :: Int -- ^ Index or ID of the next node in the graph. @@ -226,7 +228,8 @@ ppProperty i = (text (printf "%s [label=\"property: \n%s\",color=mediumblue, style=filled]\n" (show i::String) name::String) <> r1, i1) - where (r1, i1) = ppExprDot (i+1) i True e + where + (r1, i1) = ppExprDot (i+1) i True e -- | Pretty print a list of streams as a GraphViz graph part. ppStreamL :: Int -- ^ Index or ID of the next node in the graph. @@ -298,4 +301,5 @@ prettyPrintExprDot bb s = render rr -- | Pretty-print a Copilot specification as a GraphViz/dot graph. prettyPrintDot :: Spec -> String prettyPrintDot s = render r1 - where (r1, _) = ppSpecDot 0 s + where + (r1, _) = ppSpecDot 0 s From 68c38f64c023e368d90b58561d1c0084b302fead Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:35:39 -0400 Subject: [PATCH 0343/1222] Style: make where keyword stand alone on one line. Refs #316. According to our style guide, the where keyword should be alone on one line (that is, neither following an expression nor with a definition following it), except in data/type class/instance/module/type family declarations. --- copilot-libraries/src/Copilot/Library/LTL.hs | 18 ++++++++++-------- 1 file changed, 10 insertions(+), 8 deletions(-) diff --git a/copilot-libraries/src/Copilot/Library/LTL.hs b/copilot-libraries/src/Copilot/Library/LTL.hs index 40caab2b6..c8e613103 100644 --- a/copilot-libraries/src/Copilot/Library/LTL.hs +++ b/copilot-libraries/src/Copilot/Library/LTL.hs @@ -95,10 +95,11 @@ eventually n = nfoldl1 ( fromIntegral n + 1 ) (||) until :: ( Integral a ) => a -> Stream Bool -> Stream Bool -> Stream Bool until 0 _ s1 = s1 until n s0 s1 = foldl (||) s1 v0 - where n' = fromIntegral n - v0 = [ always ( i :: Int ) s0 && drop ( i + 1 ) s1 - | i <- [ 0 .. n' - 1 ] - ] + where + n' = fromIntegral n + v0 = [ always ( i :: Int ) s0 && drop ( i + 1 ) s1 + | i <- [ 0 .. n' - 1 ] + ] -- | @release n s0 s1@ means that either @always n s1@, or @s1@ holds up to and -- including the period at which @s0@ becomes true. @@ -108,7 +109,8 @@ until n s0 s1 = foldl (||) s1 v0 release :: ( Integral a ) => a -> Stream Bool -> Stream Bool -> Stream Bool release 0 _ s1 = s1 release n s0 s1 = always n s1 || foldl1 (||) v0 - where n' = fromIntegral n - v0 = [ always ( i :: Int ) s1 && drop i s0 - | i <- [ 0 .. n' - 1 ] - ] + where + n' = fromIntegral n + v0 = [ always ( i :: Int ) s1 && drop i s0 + | i <- [ 0 .. n' - 1 ] + ] From 497518b93a9423e473e7e8c14740c07de3bc5343 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:36:22 -0400 Subject: [PATCH 0344/1222] Style: make where keyword stand alone on one line. Refs #316. According to our style guide, the where keyword should be alone on one line (that is, neither following an expression nor with a definition following it), except in data/type class/instance/module/type family declarations. --- copilot-libraries/src/Copilot/Library/Utils.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot-libraries/src/Copilot/Library/Utils.hs b/copilot-libraries/src/Copilot/Library/Utils.hs index 58d601386..c3001076a 100644 --- a/copilot-libraries/src/Copilot/Library/Utils.hs +++ b/copilot-libraries/src/Copilot/Library/Utils.hs @@ -154,4 +154,5 @@ ls !! n = let indices = map -- | Cycle a list to form an infinite stream. cycle :: ( Typed a ) => [ a ] -> Stream a cycle ls = cycle' - where cycle' = ls ++ cycle' + where + cycle' = ls ++ cycle' From 5debfa16a9f8a1b51aa74c77a2fcf08ce801029e Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:37:19 -0400 Subject: [PATCH 0345/1222] Style: make where keyword stand alone on one line. Refs #316. According to our style guide, the where keyword should be alone on one line (that is, neither following an expression nor with a definition following it), except in data/type class/instance/module/type family declarations. --- .../src/Copilot/Library/Clocks.hs | 23 ++++++++++--------- 1 file changed, 12 insertions(+), 11 deletions(-) diff --git a/copilot-libraries/src/Copilot/Library/Clocks.hs b/copilot-libraries/src/Copilot/Library/Clocks.hs index 694c631f3..337e311ef 100644 --- a/copilot-libraries/src/Copilot/Library/Clocks.hs +++ b/copilot-libraries/src/Copilot/Library/Clocks.hs @@ -57,17 +57,18 @@ clk :: ( Integral a ) => -> Phase a -- ^ Phase @m@ of clock -> Stream Bool -- ^ Clock signal - 'True' on clock ticks, 'False' otherwise clk ( Period period' ) ( Phase phase' ) = clk' - where clk' = if period' P.< 1 then - badUsage ( "clk: clock period must be 1 or greater" ) - else if phase' P.< 0 then - badUsage ( "clk: clock phase must be 0 or greater" ) - else if phase' P.>= period' then - badUsage ( "clk: clock phase must be less than period") - else replicate ( fromIntegral phase' ) False - P.++ True : replicate - ( fromIntegral - $ period' P.- phase' P.- 1 ) False - ++ clk' + where + clk' = if period' P.< 1 then + badUsage ( "clk: clock period must be 1 or greater" ) + else if phase' P.< 0 then + badUsage ( "clk: clock phase must be 0 or greater" ) + else if phase' P.>= period' then + badUsage ( "clk: clock phase must be less than period") + else replicate ( fromIntegral phase' ) False + P.++ True : replicate + ( fromIntegral + $ period' P.- phase' P.- 1 ) False + ++ clk' -- | This follows the same convention as 'clk', but uses a counter variable of -- integral type /a/ rather than an array. From f29e48a8a9aaabf6ae3b6eb78d2dad370aa822c2 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:37:51 -0400 Subject: [PATCH 0346/1222] Style: make where keyword stand alone on one line. Refs #316. According to our style guide, the where keyword should be alone on one line (that is, neither following an expression nor with a definition following it), except in data/type class/instance/module/type family declarations. --- copilot-libraries/src/Copilot/Library/PTLTL.hs | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/copilot-libraries/src/Copilot/Library/PTLTL.hs b/copilot-libraries/src/Copilot/Library/PTLTL.hs index 4783f2919..f3ee5cd92 100644 --- a/copilot-libraries/src/Copilot/Library/PTLTL.hs +++ b/copilot-libraries/src/Copilot/Library/PTLTL.hs @@ -30,14 +30,17 @@ previous s = [ False ] ++ s -- | Has @s@ always held (up to and including the current state)? alwaysBeen :: Stream Bool -> Stream Bool alwaysBeen s = s && tmp - where tmp = [ True ] ++ s && tmp + where + tmp = [ True ] ++ s && tmp -- | Did @s@ hold at some time in the past (including the current state)? eventuallyPrev :: Stream Bool -> Stream Bool eventuallyPrev s = s || tmp - where tmp = [ False ] ++ s || tmp + where + tmp = [ False ] ++ s || tmp -- | Once @s2@ holds, in the following state (period), does @s1@ continuously hold? since :: Stream Bool -> Stream Bool -> Stream Bool since s1 s2 = alwaysBeen ( tmp ==> s1 ) - where tmp = eventuallyPrev $ [ False ] ++ s2 + where + tmp = eventuallyPrev $ [ False ] ++ s2 From 8a7eb13c85f8b27858cbdf6c5b579db9b4789f0f Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:38:38 -0400 Subject: [PATCH 0347/1222] Style: make where keyword stand alone on one line. Refs #316. According to our style guide, the where keyword should be alone on one line (that is, neither following an expression nor with a definition following it), except in data/type class/instance/module/type family declarations. --- copilot-libraries/src/Copilot/Library/Statistics.hs | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/copilot-libraries/src/Copilot/Library/Statistics.hs b/copilot-libraries/src/Copilot/Library/Statistics.hs index c2f2a9151..d6e0330b9 100644 --- a/copilot-libraries/src/Copilot/Library/Statistics.hs +++ b/copilot-libraries/src/Copilot/Library/Statistics.hs @@ -22,12 +22,14 @@ sum n s = nfoldl1 n (+) s -- | Maximum value. max :: ( Typed a, Ord a ) => Int -> Stream a -> Stream a max n s = nfoldl1 n largest s - where largest = \ x y -> mux ( x >= y ) x y + where + largest = \ x y -> mux ( x >= y ) x y -- | Minimum value. min :: ( Typed a, Ord a ) => Int -> Stream a -> Stream a min n s = nfoldl1 n smallest s - where smallest = \ x y -> mux ( x <= y ) x y + where + smallest = \ x y -> mux ( x <= y ) x y -- | Mean value. @n@ must not overflow -- for word size @a@ for streams over which computation is peformed. From 7e3281ec2ce4c97ae2edde7eb3631c442341e896 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:39:10 -0400 Subject: [PATCH 0348/1222] Style: make where keyword stand alone on one line. Refs #316. According to our style guide, the where keyword should be alone on one line (that is, neither following an expression nor with a definition following it), except in data/type class/instance/module/type family declarations. --- copilot-theorem/examples/SerialBoyerMoore.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot-theorem/examples/SerialBoyerMoore.hs b/copilot-theorem/examples/SerialBoyerMoore.hs index f34c0fa1f..e4de00989 100644 --- a/copilot-theorem/examples/SerialBoyerMoore.hs +++ b/copilot-theorem/examples/SerialBoyerMoore.hs @@ -33,7 +33,8 @@ majority l = (p, s, j) k = [0] ++ (1 + k) count m = cnt - where cnt = [0] ++ if l == m then cnt + 1 else cnt + where + cnt = [0] ++ if l == m then cnt + 1 else cnt j = forAllCst allowed $ \m -> local (count m) $ \cnt -> From 24872ebee1e0bf881c2e9760a7d0c8c6686f5210 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:40:04 -0400 Subject: [PATCH 0349/1222] Style: make where keyword stand alone on one line. Refs #316. According to our style guide, the where keyword should be alone on one line (that is, neither following an expression nor with a definition following it), except in data/type class/instance/module/type family declarations. --- copilot-theorem/examples/SphericalWCV.hs | 24 ++++++++++++++---------- 1 file changed, 14 insertions(+), 10 deletions(-) diff --git a/copilot-theorem/examples/SphericalWCV.hs b/copilot-theorem/examples/SphericalWCV.hs index 1454db220..25d566527 100644 --- a/copilot-theorem/examples/SphericalWCV.hs +++ b/copilot-theorem/examples/SphericalWCV.hs @@ -41,12 +41,13 @@ tcoathr = extern "tcoathr" Nothing spherical2xyz :: Stream Double -> Stream Double -> Vect3 spherical2xyz lat lon = (x, y, z) - where r = 6371000 -- Radius of the earth in meters - theta = pi / 2 - lat - phi = pi - lon - x = r * sin theta * cos phi - y = r * sin theta * sin phi - z = r * cos theta + where + r = 6371000 -- Radius of the earth in meters + theta = pi / 2 - lat + phi = pi - lon + x = r * sin theta * cos phi + y = r * sin theta * sin phi + z = r * cos theta dot3 :: Vect3 -> Vect3 -> Stream Double dot3 (x1, y1, z1) (x2, y2, z2) = x1 * x2 + y1 * y2 + z1 * z2 @@ -65,7 +66,8 @@ vect3_orthog_toz v = v `cross3` vect3_orthog_toy v unit :: Vect3 -> Vect3 unit (x, y, z) = (x / n, y / n, z / n) - where n = norm3 (x, y, z) + where + n = norm3 (x, y, z) vect3_orthonorm_toy :: Vect3 -> Vect3 vect3_orthonorm_toy = unit . vect3_orthog_toy @@ -75,8 +77,9 @@ vect3_orthonorm_toz = unit . vect3_orthog_toz sphere_to_2D_plane :: Vect3 -> Vect3 -> Vect2 sphere_to_2D_plane nzv w = (ymult `dot3` w, zmult `dot3` w) - where ymult = vect3_orthonorm_toy nzv - zmult = vect3_orthonorm_toz nzv + where + ymult = vect3_orthonorm_toy nzv + zmult = vect3_orthonorm_toz nzv pO :: Vect3 pO = spherical2xyz latO lonO @@ -89,7 +92,8 @@ sOx, sOy, sOz :: Stream Double sIx, sIy, sIz :: Stream Double (sIx, sIy, sIz) = (sI2x, sI2y, altI) - where (sI2x, sI2y) = sphere_to_2D_plane pO pI + where + (sI2x, sI2y) = sphere_to_2D_plane pO pI vOx, vOy, vOz :: Stream Double (vOx, vOy, vOz) = (gsO * sin trkO, gsO * cos trkO, vsO) From 7e00f711d23f4069801e366971cbc689e49c26e3 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:40:46 -0400 Subject: [PATCH 0350/1222] Style: make where keyword stand alone on one line. Refs #316. According to our style guide, the where keyword should be alone on one line (that is, neither following an expression nor with a definition following it), except in data/type class/instance/module/type family declarations. --- .../Copilot/Theorem/TransSys/PrettyPrint.hs | 35 ++++++++++--------- 1 file changed, 18 insertions(+), 17 deletions(-) diff --git a/copilot-theorem/src/Copilot/Theorem/TransSys/PrettyPrint.hs b/copilot-theorem/src/Copilot/Theorem/TransSys/PrettyPrint.hs index b4f4c6926..89fdc5787 100644 --- a/copilot-theorem/src/Copilot/Theorem/TransSys/PrettyPrint.hs +++ b/copilot-theorem/src/Copilot/Theorem/TransSys/PrettyPrint.hs @@ -79,23 +79,24 @@ pIVar v ev = pLVar :: Var -> VarDescr -> Doc pLVar l (VarDescr {varType, varDef}) = header $$ indent body - where header = - text (varName l) - <+> text ":" - <+> pType varType - <+> text "=" - - body = case varDef of - Pre val var -> - pConst varType val - <+> text "->" <+> text "pre" - <+> text (varName var) - Expr e -> pExpr e - - Constrs cs -> - text "{" - <+> (hsep . punctuate (space <> text ";" <> space)) (map pExpr cs) - <+> text "}" + where + header = + text (varName l) + <+> text ":" + <+> pType varType + <+> text "=" + + body = case varDef of + Pre val var -> + pConst varType val + <+> text "->" <+> text "pre" + <+> text (varName var) + Expr e -> pExpr e + + Constrs cs -> + text "{" + <+> (hsep . punctuate (space <> text ";" <> space)) (map pExpr cs) + <+> text "}" pExpr :: Expr t -> Doc From 71ba4f8a5264dbd34109a1615cdc99fbb51929c6 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:43:24 -0400 Subject: [PATCH 0351/1222] Style: make where keyword stand alone on one line. Refs #316. According to our style guide, the where keyword should be alone on one line (that is, neither following an expression nor with a definition following it), except in data/type class/instance/module/type family declarations. --- copilot-theorem/src/Copilot/Theorem/What4.hs | 437 ++++++++++--------- 1 file changed, 224 insertions(+), 213 deletions(-) diff --git a/copilot-theorem/src/Copilot/Theorem/What4.hs b/copilot-theorem/src/Copilot/Theorem/What4.hs index 94899631b..33d1a1c39 100644 --- a/copilot-theorem/src/Copilot/Theorem/What4.hs +++ b/copilot-theorem/src/Copilot/Theorem/What4.hs @@ -301,8 +301,9 @@ valFromExpr ge xe = case xe of XDouble e -> Some . CopilotValue CT.Double . fst . bfToDouble NearEven <$> WG.groundEval ge e _ -> error "valFromExpr unhandled case" - where fromBV :: forall a w . Num a => BV.BV w -> a - fromBV = fromInteger . BV.asUnsigned + where + fromBV :: forall a w . Num a => BV.BV w -> a + fromBV = fromInteger . BV.asUnsigned -- | A view of an XExpr as a bitvector expression, a natrepr for its width, its -- signed/unsigned status, and the constructor used to reconstruct an XExpr from @@ -517,7 +518,8 @@ translateExprAt sym k e = do if k' < length buf then liftIO $ translateConstExpr sym tp (buf !! k') else translateExprAt sym (k' - length buf) e - where k' = k + fromIntegral ix + where + k' = k + fromIntegral ix CE.Local _ _ _ _ _ -> error "translateExpr: Local unimplemented" CE.Var _ _ -> error "translateExpr: Var unimplemented" CE.ExternVar tp nm _prefix -> getExternConstantAt sym tp nm k @@ -556,37 +558,40 @@ translateOp1 sym op xe = case (op, xe) of (CE.Not, XBool e) -> XBool <$> WI.notPred sym e (CE.Not, _) -> panic (CE.Abs _, xe) -> numOp bvAbs fpAbs xe - where bvAbs :: BVOp1 w t - bvAbs e = do zero <- WI.bvLit sym knownNat (BV.zero knownNat) - e_neg <- WI.bvSlt sym e zero - neg_e <- WI.bvSub sym zero e - WI.bvIte sym e_neg neg_e e - fpAbs :: FPOp1 fpp t - fpAbs e = do zero <- WI.floatLit sym knownRepr bfPosZero - e_neg <- WI.floatLt sym e zero - neg_e <- WI.floatSub sym fpRM zero e - WI.floatIte sym e_neg neg_e e + where + bvAbs :: BVOp1 w t + bvAbs e = do zero <- WI.bvLit sym knownNat (BV.zero knownNat) + e_neg <- WI.bvSlt sym e zero + neg_e <- WI.bvSub sym zero e + WI.bvIte sym e_neg neg_e e + fpAbs :: FPOp1 fpp t + fpAbs e = do zero <- WI.floatLit sym knownRepr bfPosZero + e_neg <- WI.floatLt sym e zero + neg_e <- WI.floatSub sym fpRM zero e + WI.floatIte sym e_neg neg_e e (CE.Sign _, xe) -> numOp bvSign fpSign xe - where bvSign :: BVOp1 w t - bvSign e = do zero <- WI.bvLit sym knownRepr (BV.zero knownNat) - neg_one <- WI.bvLit sym knownNat (BV.mkBV knownNat (-1)) - pos_one <- WI.bvLit sym knownNat (BV.mkBV knownNat 1) - e_zero <- WI.bvEq sym e zero - e_neg <- WI.bvSlt sym e zero - t <- WI.bvIte sym e_neg neg_one pos_one - WI.bvIte sym e_zero zero t - fpSign :: FPOp1 fpp t - fpSign e = do zero <- WI.floatLit sym knownRepr bfPosZero - neg_one <- WI.floatLit sym knownRepr (bfFromDouble (-1.0)) - pos_one <- WI.floatLit sym knownRepr (bfFromDouble 1.0) - e_zero <- WI.floatEq sym e zero - e_neg <- WI.floatLt sym e zero - t <- WI.floatIte sym e_neg neg_one pos_one - WI.floatIte sym e_zero zero t + where + bvSign :: BVOp1 w t + bvSign e = do zero <- WI.bvLit sym knownRepr (BV.zero knownNat) + neg_one <- WI.bvLit sym knownNat (BV.mkBV knownNat (-1)) + pos_one <- WI.bvLit sym knownNat (BV.mkBV knownNat 1) + e_zero <- WI.bvEq sym e zero + e_neg <- WI.bvSlt sym e zero + t <- WI.bvIte sym e_neg neg_one pos_one + WI.bvIte sym e_zero zero t + fpSign :: FPOp1 fpp t + fpSign e = do zero <- WI.floatLit sym knownRepr bfPosZero + neg_one <- WI.floatLit sym knownRepr (bfFromDouble (-1.0)) + pos_one <- WI.floatLit sym knownRepr (bfFromDouble 1.0) + e_zero <- WI.floatEq sym e zero + e_neg <- WI.floatLt sym e zero + t <- WI.floatIte sym e_neg neg_one pos_one + WI.floatIte sym e_zero zero t (CE.Recip _, xe) -> fpOp recip xe - where recip :: FPOp1 fpp t - recip e = do one <- WI.floatLit sym knownRepr (bfFromDouble 1.0) - WI.floatDiv sym fpRM one e + where + recip :: FPOp1 fpp t + recip e = do one <- WI.floatLit sym knownRepr (bfFromDouble 1.0) + WI.floatDiv sym fpRM one e (CE.Exp _, xe) -> realOp (WI.realExp sym) xe (CE.Sqrt _, xe) -> fpOp (WI.floatSqrt sym fpRM) xe (CE.Log _, xe) -> realOp (WI.realLog sym) xe @@ -650,51 +655,53 @@ translateOp1 sym op xe = case (op, xe) of Just ix -> return $ xes !! ix Nothing -> panic _ -> panic - where numOp :: (forall w . BVOp1 w t) - -> (forall fpp . FPOp1 fpp t) - -> XExpr t - -> IO (XExpr t) - numOp bvOp fpOp xe = case xe of - XInt8 e -> XInt8 <$> bvOp e - XInt16 e -> XInt16 <$> bvOp e - XInt32 e -> XInt32 <$> bvOp e - XInt64 e -> XInt64 <$> bvOp e - XWord8 e -> XWord8 <$> bvOp e - XWord16 e -> XWord16 <$> bvOp e - XWord32 e -> XWord32 <$> bvOp e - XWord64 e -> XWord64 <$> bvOp e - XFloat e -> XFloat <$> fpOp e - XDouble e -> XDouble <$> fpOp e - _ -> panic + where + numOp :: (forall w . BVOp1 w t) + -> (forall fpp . FPOp1 fpp t) + -> XExpr t + -> IO (XExpr t) + numOp bvOp fpOp xe = case xe of + XInt8 e -> XInt8 <$> bvOp e + XInt16 e -> XInt16 <$> bvOp e + XInt32 e -> XInt32 <$> bvOp e + XInt64 e -> XInt64 <$> bvOp e + XWord8 e -> XWord8 <$> bvOp e + XWord16 e -> XWord16 <$> bvOp e + XWord32 e -> XWord32 <$> bvOp e + XWord64 e -> XWord64 <$> bvOp e + XFloat e -> XFloat <$> fpOp e + XDouble e -> XDouble <$> fpOp e + _ -> panic - bvOp :: (forall w . BVOp1 w t) -> XExpr t -> IO (XExpr t) - bvOp f xe = case xe of - XInt8 e -> XInt8 <$> f e - XInt16 e -> XInt16 <$> f e - XInt32 e -> XInt32 <$> f e - XInt64 e -> XInt64 <$> f e - XWord8 e -> XWord8 <$> f e - XWord16 e -> XWord16 <$> f e - XWord32 e -> XWord32 <$> f e - XWord64 e -> XWord64 <$> f e - _ -> panic + bvOp :: (forall w . BVOp1 w t) -> XExpr t -> IO (XExpr t) + bvOp f xe = case xe of + XInt8 e -> XInt8 <$> f e + XInt16 e -> XInt16 <$> f e + XInt32 e -> XInt32 <$> f e + XInt64 e -> XInt64 <$> f e + XWord8 e -> XWord8 <$> f e + XWord16 e -> XWord16 <$> f e + XWord32 e -> XWord32 <$> f e + XWord64 e -> XWord64 <$> f e + _ -> panic - fpOp :: (forall fpp . FPOp1 fpp t) -> XExpr t -> IO (XExpr t) - fpOp g xe = case xe of - XFloat e -> XFloat <$> g e - XDouble e -> XDouble <$> g e - _ -> panic + fpOp :: (forall fpp . FPOp1 fpp t) -> XExpr t -> IO (XExpr t) + fpOp g xe = case xe of + XFloat e -> XFloat <$> g e + XDouble e -> XDouble <$> g e + _ -> panic - realOp :: RealOp1 t -> XExpr t -> IO (XExpr t) - realOp h xe = fpOp hf xe - where hf :: (forall fpp . FPOp1 fpp t) - hf e = do re <- WI.floatToReal sym e - hre <- h re - WI.realToFloat sym knownRepr fpRM hre + realOp :: RealOp1 t -> XExpr t -> IO (XExpr t) + realOp h xe = fpOp hf xe + where + hf :: (forall fpp . FPOp1 fpp t) + hf e = do re <- WI.floatToReal sym e + hre <- h re + WI.realToFloat sym knownRepr fpRM hre - realRecip :: RealOp1 t - realRecip e = do one <- WI.realLit sym 1 - WI.realDiv sym one e + realRecip :: RealOp1 t + realRecip e = do one <- WI.realLit sym 1 + WI.realDiv sym one e type BVOp2 w t = (KnownNat w, 1 <= w) => WB.BVExpr t w -> WB.BVExpr t w -> IO (WB.BVExpr t w) @@ -732,30 +739,33 @@ translateOp2 sym powFn logbFn op xe1 xe2 = case (op, xe1, xe2) of (CE.Div _, xe1, xe2) -> bvOp (WI.bvSdiv sym) (WI.bvUdiv sym) xe1 xe2 (CE.Fdiv _, xe1, xe2) -> fpOp (WI.floatDiv sym fpRM) xe1 xe2 (CE.Pow _, xe1, xe2) -> fpOp powFn' xe1 xe2 - where powFn' :: FPOp2 fpp t - powFn' e1 e2 = do re1 <- WI.floatToReal sym e1 - re2 <- WI.floatToReal sym e2 - let args = (Empty :> re1 :> re2) - rpow <- WI.applySymFn sym powFn args - WI.realToFloat sym knownRepr fpRM rpow + where + powFn' :: FPOp2 fpp t + powFn' e1 e2 = do re1 <- WI.floatToReal sym e1 + re2 <- WI.floatToReal sym e2 + let args = (Empty :> re1 :> re2) + rpow <- WI.applySymFn sym powFn args + WI.realToFloat sym knownRepr fpRM rpow (CE.Logb _, xe1, xe2) -> fpOp logbFn' xe1 xe2 - where logbFn' :: FPOp2 fpp t - logbFn' e1 e2 = do re1 <- WI.floatToReal sym e1 - re2 <- WI.floatToReal sym e2 - let args = (Empty :> re1 :> re2) - rpow <- WI.applySymFn sym logbFn args - WI.realToFloat sym knownRepr fpRM rpow + where + logbFn' :: FPOp2 fpp t + logbFn' e1 e2 = do re1 <- WI.floatToReal sym e1 + re2 <- WI.floatToReal sym e2 + let args = (Empty :> re1 :> re2) + rpow <- WI.applySymFn sym logbFn args + WI.realToFloat sym knownRepr fpRM rpow (CE.Eq _, xe1, xe2) -> cmp (WI.eqPred sym) (WI.bvEq sym) (WI.floatEq sym) xe1 xe2 (CE.Ne _, xe1, xe2) -> cmp neqPred bvNeq fpNeq xe1 xe2 - where neqPred :: BoolCmp2 t - neqPred e1 e2 = do e <- WI.eqPred sym e1 e2 - WI.notPred sym e - bvNeq :: forall w . BVCmp2 w t - bvNeq e1 e2 = do e <- WI.bvEq sym e1 e2 - WI.notPred sym e - fpNeq :: forall fpp . FPCmp2 fpp t - fpNeq e1 e2 = do e <- WI.floatEq sym e1 e2 - WI.notPred sym e + where + neqPred :: BoolCmp2 t + neqPred e1 e2 = do e <- WI.eqPred sym e1 e2 + WI.notPred sym e + bvNeq :: forall w . BVCmp2 w t + bvNeq e1 e2 = do e <- WI.bvEq sym e1 e2 + WI.notPred sym e + fpNeq :: forall fpp . FPCmp2 fpp t + fpNeq e1 e2 = do e <- WI.floatEq sym e1 e2 + WI.notPred sym e (CE.Le _, xe1, xe2) -> numCmp (WI.bvSle sym) (WI.bvUle sym) (WI.floatLe sym) xe1 xe2 (CE.Ge _, xe1, xe2) -> numCmp (WI.bvSge sym) (WI.bvUge sym) (WI.floatGe sym) xe1 xe2 (CE.Lt _, xe1, xe2) -> numCmp (WI.bvSlt sym) (WI.bvUlt sym) (WI.floatLt sym) xe1 xe2 @@ -795,130 +805,131 @@ translateOp2 sym powFn logbFn op xe1 xe2 = case (op, xe1, xe2) of (XArray xes, XWord32 ix) -> buildIndexExpr sym 0 ix xes _ -> panic _ -> panic - where numOp :: (forall w . BVOp2 w t) - -> (forall fpp . FPOp2 fpp t) - -> XExpr t - -> XExpr t - -> IO (XExpr t) - numOp bvOp fpOp xe1 xe2 = case (xe1, xe2) of - (XInt8 e1, XInt8 e2) -> XInt8 <$> bvOp e1 e2 - (XInt16 e1, XInt16 e2) -> XInt16 <$> bvOp e1 e2 - (XInt32 e1, XInt32 e2)-> XInt32 <$> bvOp e1 e2 - (XInt64 e1, XInt64 e2)-> XInt64 <$> bvOp e1 e2 - (XWord8 e1, XWord8 e2)-> XWord8 <$> bvOp e1 e2 - (XWord16 e1, XWord16 e2)-> XWord16 <$> bvOp e1 e2 - (XWord32 e1, XWord32 e2)-> XWord32 <$> bvOp e1 e2 - (XWord64 e1, XWord64 e2)-> XWord64 <$> bvOp e1 e2 - (XFloat e1, XFloat e2)-> XFloat <$> fpOp e1 e2 - (XDouble e1, XDouble e2)-> XDouble <$> fpOp e1 e2 - _ -> panic + where + numOp :: (forall w . BVOp2 w t) + -> (forall fpp . FPOp2 fpp t) + -> XExpr t + -> XExpr t + -> IO (XExpr t) + numOp bvOp fpOp xe1 xe2 = case (xe1, xe2) of + (XInt8 e1, XInt8 e2) -> XInt8 <$> bvOp e1 e2 + (XInt16 e1, XInt16 e2) -> XInt16 <$> bvOp e1 e2 + (XInt32 e1, XInt32 e2)-> XInt32 <$> bvOp e1 e2 + (XInt64 e1, XInt64 e2)-> XInt64 <$> bvOp e1 e2 + (XWord8 e1, XWord8 e2)-> XWord8 <$> bvOp e1 e2 + (XWord16 e1, XWord16 e2)-> XWord16 <$> bvOp e1 e2 + (XWord32 e1, XWord32 e2)-> XWord32 <$> bvOp e1 e2 + (XWord64 e1, XWord64 e2)-> XWord64 <$> bvOp e1 e2 + (XFloat e1, XFloat e2)-> XFloat <$> fpOp e1 e2 + (XDouble e1, XDouble e2)-> XDouble <$> fpOp e1 e2 + _ -> panic - bvOp :: (forall w . BVOp2 w t) - -> (forall w . BVOp2 w t) - -> XExpr t - -> XExpr t - -> IO (XExpr t) - bvOp opS opU xe1 xe2 = case (xe1, xe2) of - (XInt8 e1, XInt8 e2) -> XInt8 <$> opS e1 e2 - (XInt16 e1, XInt16 e2) -> XInt16 <$> opS e1 e2 - (XInt32 e1, XInt32 e2) -> XInt32 <$> opS e1 e2 - (XInt64 e1, XInt64 e2) -> XInt64 <$> opS e1 e2 - (XWord8 e1, XWord8 e2) -> XWord8 <$> opU e1 e2 - (XWord16 e1, XWord16 e2) -> XWord16 <$> opU e1 e2 - (XWord32 e1, XWord32 e2) -> XWord32 <$> opU e1 e2 - (XWord64 e1, XWord64 e2) -> XWord64 <$> opU e1 e2 - _ -> panic + bvOp :: (forall w . BVOp2 w t) + -> (forall w . BVOp2 w t) + -> XExpr t + -> XExpr t + -> IO (XExpr t) + bvOp opS opU xe1 xe2 = case (xe1, xe2) of + (XInt8 e1, XInt8 e2) -> XInt8 <$> opS e1 e2 + (XInt16 e1, XInt16 e2) -> XInt16 <$> opS e1 e2 + (XInt32 e1, XInt32 e2) -> XInt32 <$> opS e1 e2 + (XInt64 e1, XInt64 e2) -> XInt64 <$> opS e1 e2 + (XWord8 e1, XWord8 e2) -> XWord8 <$> opU e1 e2 + (XWord16 e1, XWord16 e2) -> XWord16 <$> opU e1 e2 + (XWord32 e1, XWord32 e2) -> XWord32 <$> opU e1 e2 + (XWord64 e1, XWord64 e2) -> XWord64 <$> opU e1 e2 + _ -> panic - fpOp :: (forall fpp . FPOp2 fpp t) - -> XExpr t - -> XExpr t - -> IO (XExpr t) - fpOp op xe1 xe2 = case (xe1, xe2) of - (XFloat e1, XFloat e2) -> XFloat <$> op e1 e2 - (XDouble e1, XDouble e2) -> XDouble <$> op e1 e2 - _ -> panic + fpOp :: (forall fpp . FPOp2 fpp t) + -> XExpr t + -> XExpr t + -> IO (XExpr t) + fpOp op xe1 xe2 = case (xe1, xe2) of + (XFloat e1, XFloat e2) -> XFloat <$> op e1 e2 + (XDouble e1, XDouble e2) -> XDouble <$> op e1 e2 + _ -> panic - cmp :: BoolCmp2 t - -> (forall w . BVCmp2 w t) - -> (forall fpp . FPCmp2 fpp t) - -> XExpr t - -> XExpr t - -> IO (XExpr t) - cmp boolOp bvOp fpOp xe1 xe2 = case (xe1, xe2) of - (XBool e1, XBool e2) -> XBool <$> boolOp e1 e2 - (XInt8 e1, XInt8 e2) -> XBool <$> bvOp e1 e2 - (XInt16 e1, XInt16 e2) -> XBool <$> bvOp e1 e2 - (XInt32 e1, XInt32 e2)-> XBool <$> bvOp e1 e2 - (XInt64 e1, XInt64 e2)-> XBool <$> bvOp e1 e2 - (XWord8 e1, XWord8 e2)-> XBool <$> bvOp e1 e2 - (XWord16 e1, XWord16 e2)-> XBool <$> bvOp e1 e2 - (XWord32 e1, XWord32 e2)-> XBool <$> bvOp e1 e2 - (XWord64 e1, XWord64 e2)-> XBool <$> bvOp e1 e2 - (XFloat e1, XFloat e2)-> XBool <$> fpOp e1 e2 - (XDouble e1, XDouble e2)-> XBool <$> fpOp e1 e2 - _ -> panic + cmp :: BoolCmp2 t + -> (forall w . BVCmp2 w t) + -> (forall fpp . FPCmp2 fpp t) + -> XExpr t + -> XExpr t + -> IO (XExpr t) + cmp boolOp bvOp fpOp xe1 xe2 = case (xe1, xe2) of + (XBool e1, XBool e2) -> XBool <$> boolOp e1 e2 + (XInt8 e1, XInt8 e2) -> XBool <$> bvOp e1 e2 + (XInt16 e1, XInt16 e2) -> XBool <$> bvOp e1 e2 + (XInt32 e1, XInt32 e2)-> XBool <$> bvOp e1 e2 + (XInt64 e1, XInt64 e2)-> XBool <$> bvOp e1 e2 + (XWord8 e1, XWord8 e2)-> XBool <$> bvOp e1 e2 + (XWord16 e1, XWord16 e2)-> XBool <$> bvOp e1 e2 + (XWord32 e1, XWord32 e2)-> XBool <$> bvOp e1 e2 + (XWord64 e1, XWord64 e2)-> XBool <$> bvOp e1 e2 + (XFloat e1, XFloat e2)-> XBool <$> fpOp e1 e2 + (XDouble e1, XDouble e2)-> XBool <$> fpOp e1 e2 + _ -> panic - numCmp :: (forall w . BVCmp2 w t) - -> (forall w . BVCmp2 w t) - -> (forall fpp . FPCmp2 fpp t) - -> XExpr t - -> XExpr t - -> IO (XExpr t) - numCmp bvSOp bvUOp fpOp xe1 xe2 = case (xe1, xe2) of - (XInt8 e1, XInt8 e2) -> XBool <$> bvSOp e1 e2 - (XInt16 e1, XInt16 e2) -> XBool <$> bvSOp e1 e2 - (XInt32 e1, XInt32 e2)-> XBool <$> bvSOp e1 e2 - (XInt64 e1, XInt64 e2)-> XBool <$> bvSOp e1 e2 - (XWord8 e1, XWord8 e2)-> XBool <$> bvUOp e1 e2 - (XWord16 e1, XWord16 e2)-> XBool <$> bvUOp e1 e2 - (XWord32 e1, XWord32 e2)-> XBool <$> bvUOp e1 e2 - (XWord64 e1, XWord64 e2)-> XBool <$> bvUOp e1 e2 - (XFloat e1, XFloat e2)-> XBool <$> fpOp e1 e2 - (XDouble e1, XDouble e2)-> XBool <$> fpOp e1 e2 - _ -> panic + numCmp :: (forall w . BVCmp2 w t) + -> (forall w . BVCmp2 w t) + -> (forall fpp . FPCmp2 fpp t) + -> XExpr t + -> XExpr t + -> IO (XExpr t) + numCmp bvSOp bvUOp fpOp xe1 xe2 = case (xe1, xe2) of + (XInt8 e1, XInt8 e2) -> XBool <$> bvSOp e1 e2 + (XInt16 e1, XInt16 e2) -> XBool <$> bvSOp e1 e2 + (XInt32 e1, XInt32 e2)-> XBool <$> bvSOp e1 e2 + (XInt64 e1, XInt64 e2)-> XBool <$> bvSOp e1 e2 + (XWord8 e1, XWord8 e2)-> XBool <$> bvUOp e1 e2 + (XWord16 e1, XWord16 e2)-> XBool <$> bvUOp e1 e2 + (XWord32 e1, XWord32 e2)-> XBool <$> bvUOp e1 e2 + (XWord64 e1, XWord64 e2)-> XBool <$> bvUOp e1 e2 + (XFloat e1, XFloat e2)-> XBool <$> fpOp e1 e2 + (XDouble e1, XDouble e2)-> XBool <$> fpOp e1 e2 + _ -> panic - buildIndexExpr :: 1 <= n - => WB.ExprBuilder t st fs - -> Word32 - -- ^ Index - -> WB.Expr t (WT.BaseBVType 32) - -- ^ Index - -> V.Vector n (XExpr t) - -- ^ Elements - -> IO (XExpr t) - buildIndexExpr sym curIx ix xelts = case V.uncons xelts of - (xe, Left Refl) -> return xe - (xe, Right xelts') -> do - LeqProof <- return $ V.nonEmpty xelts' - rstExpr <- buildIndexExpr sym (curIx+1) ix xelts' - curIxExpr <- WI.bvLit sym knownNat (BV.word32 curIx) - ixEq <- WI.bvEq sym curIxExpr ix - mkIte sym ixEq xe rstExpr - - mkIte :: WB.ExprBuilder t st fs - -> WB.Expr t WT.BaseBoolType - -> XExpr t - -> XExpr t - -> IO (XExpr t) - mkIte sym pred xe1 xe2 = case (xe1, xe2) of - (XBool e1, XBool e2) -> XBool <$> WI.itePred sym pred e1 e2 - (XInt8 e1, XInt8 e2) -> XInt8 <$> WI.bvIte sym pred e1 e2 - (XInt16 e1, XInt16 e2) -> XInt16 <$> WI.bvIte sym pred e1 e2 - (XInt32 e1, XInt32 e2) -> XInt32 <$> WI.bvIte sym pred e1 e2 - (XInt64 e1, XInt64 e2) -> XInt64 <$> WI.bvIte sym pred e1 e2 - (XWord8 e1, XWord8 e2) -> XWord8 <$> WI.bvIte sym pred e1 e2 - (XWord16 e1, XWord16 e2) -> XWord16 <$> WI.bvIte sym pred e1 e2 - (XWord32 e1, XWord32 e2) -> XWord32 <$> WI.bvIte sym pred e1 e2 - (XWord64 e1, XWord64 e2) -> XWord64 <$> WI.bvIte sym pred e1 e2 - (XFloat e1, XFloat e2) -> XFloat <$> WI.floatIte sym pred e1 e2 - (XDouble e1, XDouble e2) -> XDouble <$> WI.floatIte sym pred e1 e2 - (XStruct xes1, XStruct xes2) -> - XStruct <$> zipWithM (mkIte sym pred) xes1 xes2 - (XArray xes1, XArray xes2) -> - case V.length xes1 `testEquality` V.length xes2 of - Just Refl -> XArray <$> V.zipWithM (mkIte sym pred) xes1 xes2 - Nothing -> panic - _ -> panic + buildIndexExpr :: 1 <= n + => WB.ExprBuilder t st fs + -> Word32 + -- ^ Index + -> WB.Expr t (WT.BaseBVType 32) + -- ^ Index + -> V.Vector n (XExpr t) + -- ^ Elements + -> IO (XExpr t) + buildIndexExpr sym curIx ix xelts = case V.uncons xelts of + (xe, Left Refl) -> return xe + (xe, Right xelts') -> do + LeqProof <- return $ V.nonEmpty xelts' + rstExpr <- buildIndexExpr sym (curIx+1) ix xelts' + curIxExpr <- WI.bvLit sym knownNat (BV.word32 curIx) + ixEq <- WI.bvEq sym curIxExpr ix + mkIte sym ixEq xe rstExpr + + mkIte :: WB.ExprBuilder t st fs + -> WB.Expr t WT.BaseBoolType + -> XExpr t + -> XExpr t + -> IO (XExpr t) + mkIte sym pred xe1 xe2 = case (xe1, xe2) of + (XBool e1, XBool e2) -> XBool <$> WI.itePred sym pred e1 e2 + (XInt8 e1, XInt8 e2) -> XInt8 <$> WI.bvIte sym pred e1 e2 + (XInt16 e1, XInt16 e2) -> XInt16 <$> WI.bvIte sym pred e1 e2 + (XInt32 e1, XInt32 e2) -> XInt32 <$> WI.bvIte sym pred e1 e2 + (XInt64 e1, XInt64 e2) -> XInt64 <$> WI.bvIte sym pred e1 e2 + (XWord8 e1, XWord8 e2) -> XWord8 <$> WI.bvIte sym pred e1 e2 + (XWord16 e1, XWord16 e2) -> XWord16 <$> WI.bvIte sym pred e1 e2 + (XWord32 e1, XWord32 e2) -> XWord32 <$> WI.bvIte sym pred e1 e2 + (XWord64 e1, XWord64 e2) -> XWord64 <$> WI.bvIte sym pred e1 e2 + (XFloat e1, XFloat e2) -> XFloat <$> WI.floatIte sym pred e1 e2 + (XDouble e1, XDouble e2) -> XDouble <$> WI.floatIte sym pred e1 e2 + (XStruct xes1, XStruct xes2) -> + XStruct <$> zipWithM (mkIte sym pred) xes1 xes2 + (XArray xes1, XArray xes2) -> + case V.length xes1 `testEquality` V.length xes2 of + Just Refl -> XArray <$> V.zipWithM (mkIte sym pred) xes1 xes2 + Nothing -> panic + _ -> panic translateOp3 :: forall t st fs a b c d . WB.ExprBuilder t st fs From 3560ee5b253b47714d5858521a494e3b1a0fd6a8 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:44:19 -0400 Subject: [PATCH 0352/1222] Style: make where keyword stand alone on one line. Refs #316. According to our style guide, the where keyword should be alone on one line (that is, neither following an expression nor with a definition following it), except in data/type class/instance/module/type family declarations. --- copilot-theorem/src/Copilot/Theorem/TransSys/Spec.hs | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/copilot-theorem/src/Copilot/Theorem/TransSys/Spec.hs b/copilot-theorem/src/Copilot/Theorem/TransSys/Spec.hs index e24564abb..d2a953387 100644 --- a/copilot-theorem/src/Copilot/Theorem/TransSys/Spec.hs +++ b/copilot-theorem/src/Copilot/Theorem/TransSys/Spec.hs @@ -205,9 +205,10 @@ instance HasInvariants TransSys where isTopologicallySorted :: TransSys -> Bool isTopologicallySorted spec = isJust $ foldM inspect Set.empty (specNodes spec) - where inspect acc n = do - guard $ Set.fromList (nodeDependencies n) `isSubsetOf` acc - return . Set.insert (nodeId n) $ acc + where + inspect acc n = do + guard $ Set.fromList (nodeDependencies n) `isSubsetOf` acc + return . Set.insert (nodeId n) $ acc -- For debugging purposes instance Show ExtVar where From d81cd3ef949e27d600bcf725f313f923ade2fb32 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:44:54 -0400 Subject: [PATCH 0353/1222] Style: make where keyword stand alone on one line. Refs #316. According to our style guide, the where keyword should be alone on one line (that is, neither following an expression nor with a definition following it), except in data/type class/instance/module/type family declarations. --- copilot-theorem/src/Copilot/Theorem/Kind2/PrettyPrint.hs | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/copilot-theorem/src/Copilot/Theorem/Kind2/PrettyPrint.hs b/copilot-theorem/src/Copilot/Theorem/Kind2/PrettyPrint.hs index 9e38c6d27..6851d46fa 100644 --- a/copilot-theorem/src/Copilot/Theorem/Kind2/PrettyPrint.hs +++ b/copilot-theorem/src/Copilot/Theorem/Kind2/PrettyPrint.hs @@ -67,6 +67,7 @@ ppTerm (PrimedStateVar v) = list [atom kwPrime, atom v] ppTerm (StateVar v) = atom v ppTerm (FunApp f args) = node f $ map ppTerm args ppTerm (PredApp p t args) = node (p ++ "." ++ ext) $ map ppTerm args - where ext = case t of - Init -> "init" - Trans -> "trans" + where + ext = case t of + Init -> "init" + Trans -> "trans" From 0b765e8a276638d236cbacdd635c8729c176385d Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:45:37 -0400 Subject: [PATCH 0354/1222] Style: make where keyword stand alone on one line. Refs #316. According to our style guide, the where keyword should be alone on one line (that is, neither following an expression nor with a definition following it), except in data/type class/instance/module/type family declarations. --- .../src/Copilot/Theorem/Misc/SExpr.hs | 21 ++++++++++--------- 1 file changed, 11 insertions(+), 10 deletions(-) diff --git a/copilot-theorem/src/Copilot/Theorem/Misc/SExpr.hs b/copilot-theorem/src/Copilot/Theorem/Misc/SExpr.hs index dad07af2b..12a7e7e60 100644 --- a/copilot-theorem/src/Copilot/Theorem/Misc/SExpr.hs +++ b/copilot-theorem/src/Copilot/Theorem/Misc/SExpr.hs @@ -79,19 +79,20 @@ parser :: GenParser Char st (SExpr String) parser = choice [try unitP, nodeP, leafP] - where symbol = oneOf "!#$%&|*+-/:<=>?@^_~." - lonelyStr = many1 (alphaNum <|> symbol) + where + symbol = oneOf "!#$%&|*+-/:<=>?@^_~." + lonelyStr = many1 (alphaNum <|> symbol) - unitP = string "()" >> return unit + unitP = string "()" >> return unit - leafP = atom <$> lonelyStr + leafP = atom <$> lonelyStr - nodeP = do void $ char '(' - spaces - st <- sepBy parser spaces - spaces - void $ char ')' - return $ List st + nodeP = do void $ char '(' + spaces + st <- sepBy parser spaces + spaces + void $ char ')' + return $ List st -- | Parser for strings of characters separated by spaces into a structured -- tree. From 31b43b419977577ab912066b42dd68c50cde491d Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:46:38 -0400 Subject: [PATCH 0355/1222] Style: make where keyword stand alone on one line. Refs #316. According to our style guide, the where keyword should be alone on one line (that is, neither following an expression nor with a definition following it), except in data/type class/instance/module/type family declarations. --- .../src/Copilot/Theorem/Kind2/Translate.hs | 18 ++++++++++-------- 1 file changed, 10 insertions(+), 8 deletions(-) diff --git a/copilot-theorem/src/Copilot/Theorem/Kind2/Translate.hs b/copilot-theorem/src/Copilot/Theorem/Kind2/Translate.hs index edd5d3543..d8115e893 100644 --- a/copilot-theorem/src/Copilot/Theorem/Kind2/Translate.hs +++ b/copilot-theorem/src/Copilot/Theorem/Kind2/Translate.hs @@ -53,17 +53,19 @@ toKind2 :: Style -- ^ Style of the file (modular or inlined). toKind2 style assumptions checkedProps spec = addAssumptions spec assumptions $ trSpec (complete spec') predCallsGraph assumptions checkedProps - where predCallsGraph = specDependenciesGraph spec' - spec' = case style of - Inlined -> inline spec - Modular -> removeCycles spec + where + predCallsGraph = specDependenciesGraph spec' + spec' = case style of + Inlined -> inline spec + Modular -> removeCycles spec trSpec :: TransSys -> DepGraph -> [PropId] -> [PropId] -> K.File trSpec spec predCallsGraph _assumptions checkedProps = K.File preds props - where preds = map (trNode spec predCallsGraph) (specNodes spec) - props = map trProp $ - filter ((`elem` checkedProps) . fst) $ - Map.toList (specProps spec) + where + preds = map (trNode spec predCallsGraph) (specNodes spec) + props = map trProp $ + filter ((`elem` checkedProps) . fst) $ + Map.toList (specProps spec) trProp :: (PropId, ExtVar) -> K.Prop trProp (pId, var) = K.Prop pId (trVar . extVarLocalPart $ var) From b027442b0264626aaea9653df203a9b3cb89bfa7 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:47:10 -0400 Subject: [PATCH 0356/1222] Style: make where keyword stand alone on one line. Refs #316. According to our style guide, the where keyword should be alone on one line (that is, neither following an expression nor with a definition following it), except in data/type class/instance/module/type family declarations. --- copilot-theorem/src/Copilot/Theorem/Misc/SExpr.hs | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/copilot-theorem/src/Copilot/Theorem/Misc/SExpr.hs b/copilot-theorem/src/Copilot/Theorem/Misc/SExpr.hs index 12a7e7e60..102ff6221 100644 --- a/copilot-theorem/src/Copilot/Theorem/Misc/SExpr.hs +++ b/copilot-theorem/src/Copilot/Theorem/Misc/SExpr.hs @@ -64,11 +64,12 @@ toDoc shouldIndent printAtom expr = case expr of Atom a -> text (printAtom a) List l -> parens (foldl renderItem empty l) - where renderItem doc s - | shouldIndent s = - doc $$ indent (toDoc shouldIndent printAtom s) - | otherwise = - doc <+> toDoc shouldIndent printAtom s + where + renderItem doc s + | shouldIndent s = + doc $$ indent (toDoc shouldIndent printAtom s) + | otherwise = + doc <+> toDoc shouldIndent printAtom s -- | Parser for strings of characters separated by spaces into a structured -- tree. From ba96bad93bcd658c674847450335810b5297f292 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:47:41 -0400 Subject: [PATCH 0357/1222] Style: make where keyword stand alone on one line. Refs #316. According to our style guide, the where keyword should be alone on one line (that is, neither following an expression nor with a definition following it), except in data/type class/instance/module/type family declarations. --- .../src/Copilot/Theorem/Prover/SMT.hs | 28 ++++++++++--------- 1 file changed, 15 insertions(+), 13 deletions(-) diff --git a/copilot-theorem/src/Copilot/Theorem/Prover/SMT.hs b/copilot-theorem/src/Copilot/Theorem/Prover/SMT.hs index 175763cd4..e5661a748 100644 --- a/copilot-theorem/src/Copilot/Theorem/Prover/SMT.hs +++ b/copilot-theorem/src/Copilot/Theorem/Prover/SMT.hs @@ -327,18 +327,19 @@ entailment sid assumptions props = do getVars :: [Expr] -> [VarDescr] getVars = nubBy' (compare `on` varName) . concatMap getVars' - where getVars' :: Expr -> [VarDescr] - getVars' = \case - ConstB _ -> [] - ConstI _ _ -> [] - ConstR _ -> [] - Ite _ e1 e2 e3 -> getVars' e1 ++ getVars' e2 ++ getVars' e3 - Op1 _ _ e -> getVars' e - Op2 _ _ e1 e2 -> getVars' e1 ++ getVars' e2 - SVal t seq (Fixed i) -> [VarDescr (seq ++ "_" ++ show i) t []] - SVal t seq (Var i) -> [VarDescr (seq ++ "_n" ++ show i) t []] - FunApp t name args -> [VarDescr name t (map typeOf args)] - ++ concatMap getVars' args + where + getVars' :: Expr -> [VarDescr] + getVars' = \case + ConstB _ -> [] + ConstI _ _ -> [] + ConstR _ -> [] + Ite _ e1 e2 e3 -> getVars' e1 ++ getVars' e2 ++ getVars' e3 + Op1 _ _ e -> getVars' e + Op2 _ _ e1 e2 -> getVars' e1 ++ getVars' e2 + SVal t seq (Fixed i) -> [VarDescr (seq ++ "_" ++ show i) t []] + SVal t seq (Var i) -> [VarDescr (seq ++ "_n" ++ show i) t []] + FunApp t name args -> [VarDescr name t (map typeOf args)] + ++ concatMap getVars' args unknown :: ProofScript b a unknown = mzero @@ -414,4 +415,5 @@ onlyValidity' s as ps = (fromJust . fst) <$> runPS (script <* stopSolvers) s selectProps :: [PropId] -> Map PropId ([Expr], Expr) -> ([Expr], [Expr]) selectProps propIds properties = (squash . unzip) [(as, p) | (id, (as, p)) <- Map.toList properties, id `elem` propIds] - where squash (a, b) = (concat a, b) + where + squash (a, b) = (concat a, b) From 6c5e41527d5b11ed8a99732fa02506f419a91ad8 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:48:00 -0400 Subject: [PATCH 0358/1222] Style: make where keyword stand alone on one line. Refs #316. According to our style guide, the where keyword should be alone on one line (that is, neither following an expression nor with a definition following it), except in data/type class/instance/module/type family declarations. --- copilot-theorem/src/Copilot/Theorem/Prover/Z3.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot-theorem/src/Copilot/Theorem/Prover/Z3.hs b/copilot-theorem/src/Copilot/Theorem/Prover/Z3.hs index 4bce3df56..d5b005284 100644 --- a/copilot-theorem/src/Copilot/Theorem/Prover/Z3.hs +++ b/copilot-theorem/src/Copilot/Theorem/Prover/Z3.hs @@ -296,7 +296,8 @@ onlyValidity' s as ps = (fromJust . fst) <$> runPS (script <* stopSolvers) s selectProps :: [PropId] -> Map PropId ([Expr], Expr) -> ([Expr], [Expr]) selectProps propIds properties = (squash . unzip) [(as, p) | (id, (as, p)) <- Map.toList properties, id `elem` propIds] - where squash (a, b) = (concat a, b) + where + squash (a, b) = (concat a, b) -- | This is all very ugly. It might make better sense to go straight from Core to SMTExpr, or maybe use SBV instead. From c1e0817880447c539b60101de4ef6913b1cec7e8 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Apr 2022 17:49:20 -0400 Subject: [PATCH 0359/1222] Style: make where keyword stand alone on one line. Refs #316. According to our style guide, the where keyword should be alone on one line (that is, neither following an expression nor with a definition following it), except in data/type class/instance/module/type family declarations. --- .../src/Copilot/Theorem/IL/Translate.hs | 82 +++++++++++-------- 1 file changed, 46 insertions(+), 36 deletions(-) diff --git a/copilot-theorem/src/Copilot/Theorem/IL/Translate.hs b/copilot-theorem/src/Copilot/Theorem/IL/Translate.hs index 3bc2ee239..cf2e06ee2 100644 --- a/copilot-theorem/src/Copilot/Theorem/IL/Translate.hs +++ b/copilot-theorem/src/Copilot/Theorem/IL/Translate.hs @@ -85,22 +85,24 @@ bound s t = case t of C.Word32 -> bound' C.Word32 C.Word64 -> bound' C.Word64 _ -> return () - where bound' :: (Bounded a, Integral a) => C.Type a -> Trans () - bound' t = do - b <- addBounds <$> get - when b $ localConstraint (Op2 Bool And - (Op2 Bool Le (trConst t minBound) s) - (Op2 Bool Ge (trConst t maxBound) s)) + where + bound' :: (Bounded a, Integral a) => C.Type a -> Trans () + bound' t = do + b <- addBounds <$> get + when b $ localConstraint (Op2 Bool And + (Op2 Bool Le (trConst t minBound) s) + (Op2 Bool Ge (trConst t maxBound) s)) streamInit :: C.Stream -> [Expr] streamInit (C.Stream { C.streamId = id , C.streamBuffer = b :: [val] , C.streamExprType = t }) = zipWith initConstraint [0..] b - where initConstraint :: Integer -> val -> Expr - initConstraint p v = Op2 Bool Eq - (SVal (trType t) (ncSeq id) (Fixed p)) - $ trConst t v + where + initConstraint :: Integer -> val -> Expr + initConstraint p v = Op2 Bool Eq + (SVal (trType t) (ncSeq id) (Fixed p)) + $ trConst t v streamRec :: C.Stream -> Trans Expr streamRec (C.Stream { C.streamId = id @@ -129,7 +131,8 @@ expr (C.Local ta _ name ea eb) = do expr (C.Var t name) = return $ SVal (trType t) (ncLocal name) _n_ expr (C.ExternVar t name _) = bound s t >> return s - where s = SVal (trType t) (ncExternVar name) _n_ + where + s = SVal (trType t) (ncExternVar name) _n_ expr (C.Op1 (C.Sign ta) e) = case ta of C.Int8 -> trSign ta e @@ -139,15 +142,16 @@ expr (C.Op1 (C.Sign ta) e) = case ta of C.Float -> trSign ta e C.Double -> trSign ta e _ -> expr $ C.Const ta 1 - where trSign :: (Typeable a, Ord a, Num a) => C.Type a -> C.Expr a -> Trans Expr - trSign ta e = - expr (C.Op3 (C.Mux ta) - (C.Op2 (C.Lt ta) e (C.Const ta 0)) - (C.Const ta (-1)) - (C.Op3 (C.Mux ta) - (C.Op2 (C.Gt ta) e (C.Const ta 0)) - (C.Const ta 1) - (C.Const ta 0))) + where + trSign :: (Typeable a, Ord a, Num a) => C.Type a -> C.Expr a -> Trans Expr + trSign ta e = + expr (C.Op3 (C.Mux ta) + (C.Op2 (C.Lt ta) e (C.Const ta 0)) + (C.Const ta (-1)) + (C.Op3 (C.Mux ta) + (C.Op2 (C.Gt ta) e (C.Const ta 0)) + (C.Const ta 1) + (C.Const ta 0))) expr (C.Op1 (C.Sqrt _) e) = do e' <- expr e return $ Op2 Real Pow e' (ConstR 0.5) @@ -155,19 +159,22 @@ expr (C.Op1 (C.Cast _ _) e) = expr e expr (C.Op1 op e) = do e' <- expr e return $ Op1 t' op' e' - where (op', t') = trOp1 op + where + (op', t') = trOp1 op expr (C.Op2 (C.Ne t) e1 e2) = do e1' <- expr e1 e2' <- expr e2 return $ Op1 Bool Not (Op2 t' Eq e1' e2') - where t' = trType t + where + t' = trType t expr (C.Op2 op e1 e2) = do e1' <- expr e1 e2' <- expr e2 return $ Op2 t' op' e1' e2' - where (op', t') = trOp2 op + where + (op', t') = trOp2 op expr (C.Op3 (C.Mux t) cond e1 e2) = do cond' <- expr cond @@ -188,14 +195,15 @@ trConst t v = case t of t@C.Word16 -> negifyI v (trType t) t@C.Word32 -> negifyI v (trType t) t@C.Word64 -> negifyI v (trType t) - where negifyR :: Double -> Expr - negifyR v - | v >= 0 = ConstR v - | otherwise = Op1 Real Neg $ ConstR $ negate $ v - negifyI :: Integral a => a -> Type -> Expr - negifyI v t - | v >= 0 = ConstI t $ toInteger v - | otherwise = Op1 t Neg $ ConstI t $ negate $ toInteger v + where + negifyR :: Double -> Expr + negifyR v + | v >= 0 = ConstR v + | otherwise = Op1 Real Neg $ ConstR $ negate $ v + negifyI :: Integral a => a -> Type -> Expr + negifyI v t + | v >= 0 = ConstI t $ toInteger v + | otherwise = Op1 t Neg $ ConstI t $ negate $ toInteger v trOp1 :: C.Op1 a b -> (Op1, Type) trOp1 = \case @@ -287,14 +295,16 @@ newMux c t e1 e2 = do modify $ \st -> st { muxes = (v, mux) : ms } return v Just (v, _) -> return v - where mux = (c, t, e1, e2) + where + mux = (c, t, e1, e2) getMuxes :: Trans [Expr] getMuxes = muxes <$> get >>= return . concat . (map toConstraints) - where toConstraints (v, (c, _, e1, e2)) = - [ Op2 Bool Or (Op1 Bool Not c) (Op2 Bool Eq v e1) - , Op2 Bool Or c (Op2 Bool Eq v e2) - ] + where + toConstraints (v, (c, _, e1, e2)) = + [ Op2 Bool Or (Op1 Bool Not c) (Op2 Bool Eq v e1) + , Op2 Bool Or c (Op2 Bool Eq v e2) + ] -- | A state monad over the translation state ('TransST'). type Trans = State TransST From 46ce47e0b121a120b76094df90905735544308a8 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 21 Apr 2022 18:07:26 -0400 Subject: [PATCH 0360/1222] copilot-c99: Use type information to translate Recip. Refs #263. The code generated for Recip (reciprocal fraction) currently does not depend on the type of the arguments passed. That means that the C sentence generated assumes that the type is double, although Recip also supports Float. The code generated is the same, because it is not cast explicitly and Recip imposes a requirement that the arguments be Fractional, the code is semantically incorrect. This commit modifies the translation of that Op1 into C99 so that the type of the variables is taken into account. It makes the function constNumTy top-level in the module so that it can be used in the implementation of the translation for Recip. Co-authored-by: Ryan Scott --- .../src/Copilot/Compile/C99/Translate.hs | 24 +++++++++---------- 1 file changed, 12 insertions(+), 12 deletions(-) diff --git a/copilot-c99/src/Copilot/Compile/C99/Translate.hs b/copilot-c99/src/Copilot/Compile/C99/Translate.hs index 202168e3d..8e65bd3a7 100644 --- a/copilot-c99/src/Copilot/Compile/C99/Translate.hs +++ b/copilot-c99/src/Copilot/Compile/C99/Translate.hs @@ -55,7 +55,7 @@ transop1 op e = case op of Not -> (C..!) e Abs _ -> funcall "abs" [e] Sign ty -> transSign ty e - Recip _ -> C.LitDouble 1.0 C../ e + Recip ty -> (constNumTy ty 1) C../ e Exp _ -> funcall "exp" [e] Sqrt _ -> funcall "sqrt" [e] Log _ -> funcall "log" [e] @@ -152,17 +152,6 @@ transSign ty e = positiveCase $ negativeCase e negativeCase = C.Cond (C.BinaryOp C.LT e (constNumTy ty 0)) (constNumTy ty (-1)) - -- Translate a literal number of type @ty@ into a C99 literal. - -- - -- PRE: The type of PRE is numeric (integer or floating-point), that - -- is, not boolean, struct or array. - constNumTy :: Type a -> Integer -> C.Expr - constNumTy ty = - case ty of - Float -> C.LitFloat . fromInteger - Double -> C.LitDouble . fromInteger - _ -> C.LitInt - -- | Transform a Copilot Core literal, based on its value and type, into a C99 -- literal. constty :: Type a -> a -> C.Expr @@ -254,3 +243,14 @@ transtype ty = case ty of -- | Translate a Copilot type intro a C typename transtypename :: Type a -> C.TypeName transtypename ty = C.TypeName $ transtype ty + +-- Translate a literal number of type @ty@ into a C99 literal. +-- +-- PRE: The type of PRE is numeric (integer or floating-point), that +-- is, not boolean, struct or array. +constNumTy :: Type a -> Integer -> C.Expr +constNumTy ty = + case ty of + Float -> C.LitFloat . fromInteger + Double -> C.LitDouble . fromInteger + _ -> C.LitInt From 8d4eb68a36752111acfd16f39f38dee7766a3273 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 29 Apr 2022 17:34:39 -0400 Subject: [PATCH 0361/1222] copilot-c99: Use type information to translate functions from math.h. Refs #263. At present, the C99 backend produces C code that executes mathematical functions without taking into account the types of the variables it is operating on. This has the undesired effect of producing casts between single- and double-precision floating-point numbers, which can lead to unexpected results. This commit modifies the C code generation so that the types of variables is taken into account in all translations involving floating-point functions in math.h, when that C module provides specialized variants for single- and double-precision floating-point numbers. Co-authored-by: Ryan Scott --- .../src/Copilot/Compile/C99/Translate.hs | 116 +++++++++++++----- 1 file changed, 88 insertions(+), 28 deletions(-) diff --git a/copilot-c99/src/Copilot/Compile/C99/Translate.hs b/copilot-c99/src/Copilot/Compile/C99/Translate.hs index 8e65bd3a7..50230e683 100644 --- a/copilot-c99/src/Copilot/Compile/C99/Translate.hs +++ b/copilot-c99/src/Copilot/Compile/C99/Translate.hs @@ -51,31 +51,38 @@ transexpr (Op3 op e1 e2 e3) = do -- | Translates a Copilot unary operator and its argument into a C99 -- expression. transop1 :: Op1 a b -> C.Expr -> C.Expr -transop1 op e = case op of - Not -> (C..!) e - Abs _ -> funcall "abs" [e] - Sign ty -> transSign ty e - Recip ty -> (constNumTy ty 1) C../ e - Exp _ -> funcall "exp" [e] - Sqrt _ -> funcall "sqrt" [e] - Log _ -> funcall "log" [e] - Sin _ -> funcall "sin" [e] - Tan _ -> funcall "tan" [e] - Cos _ -> funcall "cos" [e] - Asin _ -> funcall "asin" [e] - Atan _ -> funcall "atan" [e] - Acos _ -> funcall "acos" [e] - Sinh _ -> funcall "sinh" [e] - Tanh _ -> funcall "tanh" [e] - Cosh _ -> funcall "cosh" [e] - Asinh _ -> funcall "asinh" [e] - Atanh _ -> funcall "atanh" [e] - Acosh _ -> funcall "acosh" [e] - Ceiling _ -> funcall "ceil" [e] - Floor _ -> funcall "floor" [e] - BwNot _ -> (C..~) e - Cast _ ty -> C.Cast (transtypename ty) e - GetField (Struct _) _ f -> C.Dot e (accessorname f) +transop1 op e = + -- There are three types of ways in which a function in Copilot Core can be + -- translated into C: + -- + -- 1) Direct translation (perfect 1-to-1 mapping) + -- 2) Type-directed translation (1-to-many mapping, choice based on type) + -- 3) Desugaring/complex (expands to complex expression) + case op of + Not -> (C..!) e + Abs ty -> funcall (specializeMathFunName ty "abs") [e] + Sign ty -> transSign ty e + Recip ty -> (constNumTy ty 1) C../ e + Acos ty -> funcall (specializeMathFunName ty "acos") [e] + Asin ty -> funcall (specializeMathFunName ty "asin") [e] + Atan ty -> funcall (specializeMathFunName ty "atan") [e] + Cos ty -> funcall (specializeMathFunName ty "cos") [e] + Sin ty -> funcall (specializeMathFunName ty "sin") [e] + Tan ty -> funcall (specializeMathFunName ty "tan") [e] + Acosh ty -> funcall (specializeMathFunName ty "acosh") [e] + Asinh ty -> funcall (specializeMathFunName ty "asinh") [e] + Atanh ty -> funcall (specializeMathFunName ty "atanh") [e] + Cosh ty -> funcall (specializeMathFunName ty "cosh") [e] + Sinh ty -> funcall (specializeMathFunName ty "sinh") [e] + Tanh ty -> funcall (specializeMathFunName ty "tanh") [e] + Exp ty -> funcall (specializeMathFunName ty "exp") [e] + Log ty -> funcall (specializeMathFunName ty "log") [e] + Sqrt ty -> funcall (specializeMathFunName ty "sqrt") [e] + Ceiling ty -> funcall (specializeMathFunName ty "ceil") [e] + Floor ty -> funcall (specializeMathFunName ty "floor") [e] + BwNot _ -> (C..~) e + Cast _ ty -> C.Cast (transtypename ty) e + GetField (Struct _) _ f -> C.Dot e (accessorname f) -- | Translates a Copilot binary operator and its arguments into a C99 -- expression. @@ -89,9 +96,10 @@ transop2 op e1 e2 = case op of Mod _ -> e1 C..% e2 Div _ -> e1 C../ e2 Fdiv _ -> e1 C../ e2 - Pow _ -> funcall "pow" [e1, e2] - Logb _ -> funcall "log" [e2] C../ funcall "log" [e1] - Atan2 _ -> funcall "atan2" [e1, e2] + Pow ty -> funcall (specializeMathFunName ty "pow") [e1, e2] + Logb ty -> funcall (specializeMathFunName ty "log") [e2] C../ + funcall (specializeMathFunName ty "log") [e1] + Atan2 ty -> funcall (specializeMathFunName ty "atan2") [e1, e2] Eq _ -> e1 C..== e2 Ne _ -> e1 C..!= e2 Le _ -> e1 C..<= e2 @@ -254,3 +262,55 @@ constNumTy ty = Float -> C.LitFloat . fromInteger Double -> C.LitDouble . fromInteger _ -> C.LitInt + +-- | Provide a specialized function name in C99 for a function given the type +-- of its arguments, and its "family" name. +-- +-- C99 provides multiple variants of the same conceptual function, based on the +-- types. Depending on the function, common variants exist for signed/unsigned +-- arguments, long or short types, float or double. The C99 standard uses the +-- same mechanism to name most such functions: the default variant works for +-- double, and there are additional variants for float and long double. For +-- example, the sin function operates on double, while sinf operates on float, +-- and sinl operates on long double. +-- +-- This function only knows how to provide specialized names for functions in +-- math.h that provide a default version for a double argument and vary for +-- floats. It won't change the function name given if the variation is based on +-- the return type, if the function is defined elsewhere, or for other types. +specializeMathFunName :: Type a -> String -> String +specializeMathFunName ty s + -- The following function pattern matches based on the variants available + -- for a specific function. + -- + -- Do not assume that a function you need implemented follows the same + -- standard as others: check whether it is present in the standard. + | isMathFPArgs s + , Float <- ty + = s ++ "f" + + | otherwise + = s + where + -- True if the function family name is part of math.h and follows the + -- standard rule of providing multiple variants for floating point numbers + -- based on the type of their arguments. + -- + -- Note: nan is not in this list because the names of its variants are + -- determined by the return type. + -- + -- For details, see: + -- "B.11 Mathematics " in the C99 standard + isMathFPArgs :: String -> Bool + isMathFPArgs = flip elem + [ "acos", "asin", "atan", "atan2", "cos", "sin" + , "tan", "acosh", "asinh", "atanh", "cosh", "sinh" + , "tanh", "exp", "exp2", "expm1", "frexp", "ilogb" + , "ldexp", "log", "log10", "log1p", "log2", "logb" + , "modf", "scalbn", "scalbln", "cbrt", "fabs", "hypot" + , "pow", "sqrt", "erf", "erfc", "lgamma", "tgamma" + , "ceil", "floor", "nearbyint", "rint", "lrint", "llrint" + , "round", "lround", "llround", "trunc", "fmod", "remainder" + , "remquo", "copysign", "nextafter", "nexttoward", "fdim" + , "fmax", "fmin", "fma" + ] From b8ec41699d18720bdb74f1e4deff4cc2f54f9875 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 29 Apr 2022 17:33:10 -0400 Subject: [PATCH 0362/1222] copilot-c99: Use type information to translate abs. Refs #263. At present, the C99 backend produces C code that translates the absolute value function as abs, without taking into account the types of the variables it is operating on. This has the undesired effect of producing casts between integers, and single- and double-precision floating-point numbers, which can lead to unexpected results. This commit introduces a function that handles the translation of the absolute value function (abs) by picking the right variant to use based on the type of the operands. Co-authored-by: Ryan Scott --- copilot-c99/copilot-c99.cabal | 1 + copilot-c99/src/Copilot/Compile/C99/Error.hs | 20 +++++++ .../src/Copilot/Compile/C99/Translate.hs | 60 ++++++++++++++++++- 3 files changed, 80 insertions(+), 1 deletion(-) create mode 100644 copilot-c99/src/Copilot/Compile/C99/Error.hs diff --git a/copilot-c99/copilot-c99.cabal b/copilot-c99/copilot-c99.cabal index ebc097789..97fb55f4b 100644 --- a/copilot-c99/copilot-c99.cabal +++ b/copilot-c99/copilot-c99.cabal @@ -58,6 +58,7 @@ library exposed-modules : Copilot.Compile.C99 other-modules : Copilot.Compile.C99.Translate + , Copilot.Compile.C99.Error , Copilot.Compile.C99.Util , Copilot.Compile.C99.CodeGen , Copilot.Compile.C99.External diff --git a/copilot-c99/src/Copilot/Compile/C99/Error.hs b/copilot-c99/src/Copilot/Compile/C99/Error.hs new file mode 100644 index 000000000..8534b6dcc --- /dev/null +++ b/copilot-c99/src/Copilot/Compile/C99/Error.hs @@ -0,0 +1,20 @@ +-------------------------------------------------------------------------------- +-- Copyright © 2011 National Institute of Aerospace / Galois, Inc. +-------------------------------------------------------------------------------- +{-# LANGUAGE Safe #-} + +-- | Custom functions to report error messages to users. +module Copilot.Compile.C99.Error + ( impossible ) + where + +-- | Report an error due to a bug in Copilot. +impossible :: String -- ^ Name of the function in which the error was detected. + -> String -- ^ Name of the package in which the function is located. + -> a +impossible function package = + error $ "Impossible error in function " + ++ function ++ ", in package " ++ package + ++ ". Please file an issue at " + ++ "https://github.com/Copilot-Language/copilot/issues" + ++ " or email the maintainers at " diff --git a/copilot-c99/src/Copilot/Compile/C99/Translate.hs b/copilot-c99/src/Copilot/Compile/C99/Translate.hs index 50230e683..222fe2760 100644 --- a/copilot-c99/src/Copilot/Compile/C99/Translate.hs +++ b/copilot-c99/src/Copilot/Compile/C99/Translate.hs @@ -6,6 +6,7 @@ module Copilot.Compile.C99.Translate where import Control.Monad.State import Copilot.Core +import Copilot.Compile.C99.Error (impossible) import Copilot.Compile.C99.Util import qualified Language.C99.Simple as C @@ -60,7 +61,7 @@ transop1 op e = -- 3) Desugaring/complex (expands to complex expression) case op of Not -> (C..!) e - Abs ty -> funcall (specializeMathFunName ty "abs") [e] + Abs ty -> transAbs ty e Sign ty -> transSign ty e Recip ty -> (constNumTy ty 1) C../ e Acos ty -> funcall (specializeMathFunName ty "acos") [e] @@ -119,6 +120,55 @@ transop3 :: Op3 a b c d -> C.Expr -> C.Expr -> C.Expr -> C.Expr transop3 op e1 e2 e3 = case op of Mux _ -> C.Cond e1 e2 e3 +-- | Translate @'Abs' e@ in Copilot Core into a C99 expression. +-- +-- This function produces a portable implementation of abs in C99 that works +-- for the type given, provided that the output fits in a variable of the same +-- type (which may not be true, for example, for signed integers in the lower +-- end of their type range). If the absolute value is out of range, the +-- behavior is undefined. +-- +-- PRE: The type given is a Num type (floating-point number, or a +-- signed/unsigned integer of fixed size). +transAbs :: Type a -> C.Expr -> C.Expr +transAbs ty e + -- Abs for floats/doubles is called fabs in C99's math.h. + | typeIsFloating ty + = funcall (specializeMathFunName ty "fabs") [e] + + -- C99 provides multiple implementations of abs, depending on the type of + -- the arguments. For integers, it provides C99 abs, labs, and llabs, which + -- take, respectively, an int, a long int, and a long long int. + -- + -- However, the code produced by Copilot uses types with fixed width (e.g., + -- int16_t), and there is no guarantee that, for example, 32-bit int or + -- 64-bit int will fit in a C int (only guaranteed to be 16 bits). + -- Consequently, this function provides a portable version of abs for signed + -- and unsigned ints implemented using shift and xor. For example, for a + -- value x of type int32_t, the absolute value is: + -- (x + (x >> sizeof(int32_t)-1)) ^ (x >> sizeof(int32_t)-1)) + | otherwise + = (e C..+ (e C..>> tyBitSizeMinus1)) C..^ (e C..>> tyBitSizeMinus1) + where + -- Size of an integer type in bits, minus one. It's easier to hard-code + -- them than to try and generate the right expressions in C using sizeof. + -- + -- PRE: the type 'ty' is a signed or unsigned integer type. + tyBitSizeMinus1 :: C.Expr + tyBitSizeMinus1 = case ty of + Int8 -> C.LitInt 7 + Int16 -> C.LitInt 15 + Int32 -> C.LitInt 31 + Int64 -> C.LitInt 63 + Word8 -> C.LitInt 7 + Word16 -> C.LitInt 15 + Word32 -> C.LitInt 31 + Word64 -> C.LitInt 63 + _ -> impossible + "transAbs" + "copilot-c99" + "Abs applied to unexpected types." + -- | Translate @'Sign' e@ in Copilot Core into a C99 expression. -- -- Sign is is translated as @e > 0 ? 1 : (e < 0 ? -1 : e)@, that is: @@ -314,3 +364,11 @@ specializeMathFunName ty s , "remquo", "copysign", "nextafter", "nexttoward", "fdim" , "fmax", "fmin", "fma" ] + +-- * Auxiliary functions + +-- | True if the type given is a floating point number. +typeIsFloating :: Type a -> Bool +typeIsFloating Float = True +typeIsFloating Double = True +typeIsFloating _ = False From 170f5282fe7d3a5204b187354503cf27cb7e6866 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 29 Apr 2022 18:01:59 -0400 Subject: [PATCH 0363/1222] Document changes in CHANGELOG. Refs #263. --- copilot-c99/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot-c99/CHANGELOG b/copilot-c99/CHANGELOG index 84a10d211..633d30a2a 100644 --- a/copilot-c99/CHANGELOG +++ b/copilot-c99/CHANGELOG @@ -1,4 +1,5 @@ -2022-04-20 +2022-04-29 + * Translate math operations taking type into account. (#263) * Fix issue with delays of streams of structs or arrays. (#276) * Fix issue in C99 implementation of signum. (#278) From cd2a3d46e54a0ee7bde7d1eb22613b82e4f87e69 Mon Sep 17 00:00:00 2001 From: Frank Dedden Date: Tue, 8 Feb 2022 20:32:47 +0100 Subject: [PATCH 0364/1222] Add GHC 9.0.1 to CI setup. Refs #294. This commit modifies the CI setup in .travis.yml so that installation is attempted with GHC 9. We pick GHC 9.0.1 as it is the latest version available in HVR's PPA, and cabal 3.4 as a suitable cabal version to go with it. --- .travis.yml | 1 + 1 file changed, 1 insertion(+) diff --git a/.travis.yml b/.travis.yml index d5255aeae..40a77fd91 100644 --- a/.travis.yml +++ b/.travis.yml @@ -7,6 +7,7 @@ env: - CABALVER=2.4 GHCVER=8.6.5 - CABALVER=3.2 GHCVER=8.8.4 - CABALVER=3.2 GHCVER=8.10.4 + - CABALVER=3.4 GHCVER=9.0.1 # - CABALVER=head GHCVER=head # see section about GHC HEAD snapshots # Note: the distinction between `before_install` and `install` is not important. From dbe1e3858ef68fcfdd266870f3024fc05f8fd9d1 Mon Sep 17 00:00:00 2001 From: Frank Dedden Date: Wed, 9 Feb 2022 09:21:02 +0100 Subject: [PATCH 0365/1222] Document changes in CHANGELOG. Refs #294. --- copilot/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot/CHANGELOG b/copilot/CHANGELOG index 6ed417243..c4e7df5ce 100644 --- a/copilot/CHANGELOG +++ b/copilot/CHANGELOG @@ -1,3 +1,6 @@ +2022-05-02 + * Add support for GHC 9.0. (#294) + 2022-03-07 * Version bump (3.8). (#298) * Mark package as uncurated to avoid modification. (#288) From 62bcded13885f27f1d90df6cad89fe51fe717bbb Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 6 May 2022 22:43:41 -0400 Subject: [PATCH 0366/1222] Bump versions and constraints (3.9). Refs #320. --- copilot-c99/copilot-c99.cabal | 4 ++-- copilot-core/copilot-core.cabal | 2 +- copilot-language/copilot-language.cabal | 6 +++--- copilot-libraries/copilot-libraries.cabal | 4 ++-- copilot-theorem/copilot-theorem.cabal | 4 ++-- copilot/copilot.cabal | 12 ++++++------ 6 files changed, 16 insertions(+), 16 deletions(-) diff --git a/copilot-c99/copilot-c99.cabal b/copilot-c99/copilot-c99.cabal index 97fb55f4b..e7eda6dc4 100644 --- a/copilot-c99/copilot-c99.cabal +++ b/copilot-c99/copilot-c99.cabal @@ -1,6 +1,6 @@ cabal-version : >= 1.10 name : copilot-c99 -version : 3.8 +version : 3.9 synopsis : A compiler for Copilot targeting C99. description : This package is a back-end from Copilot to C. @@ -50,7 +50,7 @@ library , mtl >= 2.2 && < 2.3 , pretty >= 1.1 && < 1.2 - , copilot-core >= 3.8 && < 3.9 + , copilot-core >= 3.9 && < 3.10 , language-c99 >= 0.1.1 && < 0.2 , language-c99-util >= 0.1.1 && < 0.2 , language-c99-simple >= 0.1.1 && < 0.2 diff --git a/copilot-core/copilot-core.cabal b/copilot-core/copilot-core.cabal index 020aeef57..ffe9450ff 100644 --- a/copilot-core/copilot-core.cabal +++ b/copilot-core/copilot-core.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-core -version: 3.8 +version: 3.9 synopsis: An intermediate representation for Copilot. description: Intermediate representation for Copilot. diff --git a/copilot-language/copilot-language.cabal b/copilot-language/copilot-language.cabal index ece3004d3..0c2b86d2f 100644 --- a/copilot-language/copilot-language.cabal +++ b/copilot-language/copilot-language.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-language -version: 3.8 +version: 3.9 synopsis: A Haskell-embedded DSL for monitoring hard real-time distributed systems. description: @@ -42,8 +42,8 @@ library , data-reify >= 0.6 && < 0.7 , mtl >= 2.0 && < 3 - , copilot-core >= 3.8 && < 3.9 - , copilot-theorem >= 3.8 && < 3.9 + , copilot-core >= 3.9 && < 3.10 + , copilot-theorem >= 3.9 && < 3.10 exposed-modules: Copilot.Language , Copilot.Language.Operators.BitWise diff --git a/copilot-libraries/copilot-libraries.cabal b/copilot-libraries/copilot-libraries.cabal index 65ace050f..76fc76849 100644 --- a/copilot-libraries/copilot-libraries.cabal +++ b/copilot-libraries/copilot-libraries.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-libraries -version: 3.8 +version: 3.9 synopsis: Libraries for the Copilot language. description: Libraries for the Copilot language. @@ -43,7 +43,7 @@ library , data-reify >= 0.6 && < 0.7 , mtl >= 2.0 && < 2.3 , parsec >= 2.0 && < 3.2 - , copilot-language >= 3.8 && < 3.9 + , copilot-language >= 3.9 && < 3.10 exposed-modules: Copilot.Library.Libraries diff --git a/copilot-theorem/copilot-theorem.cabal b/copilot-theorem/copilot-theorem.cabal index 8b08737ef..4779f7ddb 100644 --- a/copilot-theorem/copilot-theorem.cabal +++ b/copilot-theorem/copilot-theorem.cabal @@ -14,7 +14,7 @@ description: . -version : 3.8 +version : 3.9 license : BSD3 license-file : LICENSE maintainer : Ivan Perez @@ -74,7 +74,7 @@ library , xml >= 1.3 && < 1.4 , what4 >= 1.1 && < 1.3 - , copilot-core >= 3.8 && < 3.9 + , copilot-core >= 3.9 && < 3.10 exposed-modules : Copilot.Theorem , Copilot.Theorem.Prove diff --git a/copilot/copilot.cabal b/copilot/copilot.cabal index 19d9d47d0..27d39764c 100644 --- a/copilot/copilot.cabal +++ b/copilot/copilot.cabal @@ -1,5 +1,5 @@ name: copilot -version: 3.8 +version: 3.9 cabal-version: >= 1.10 license: BSD3 license-file: LICENSE @@ -52,11 +52,11 @@ library , directory >= 1.3 && < 1.4 , filepath >= 1.4 && < 1.5 - , copilot-core >= 3.8 && < 3.9 - , copilot-theorem >= 3.8 && < 3.9 - , copilot-language >= 3.8 && < 3.9 - , copilot-libraries >= 3.8 && < 3.9 - , copilot-c99 >= 3.8 && < 3.9 + , copilot-core >= 3.9 && < 3.10 + , copilot-theorem >= 3.9 && < 3.10 + , copilot-language >= 3.9 && < 3.10 + , copilot-libraries >= 3.9 && < 3.10 + , copilot-c99 >= 3.9 && < 3.10 exposed-modules: Language.Copilot, Language.Copilot.Main From e76fd9849be2503cfd3fb7e8068e0e645f5bfa2a Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 6 May 2022 22:46:38 -0400 Subject: [PATCH 0367/1222] Document changes in CHANGELOG. Refs #320. Document version bump in changelog. Ammend past date of copilot-libraries (3.8). --- copilot-c99/CHANGELOG | 3 ++- copilot-core/CHANGELOG | 3 ++- copilot-language/CHANGELOG | 3 +++ copilot-libraries/CHANGELOG | 5 ++++- copilot-theorem/CHANGELOG | 3 +++ copilot/CHANGELOG | 3 ++- 6 files changed, 16 insertions(+), 4 deletions(-) diff --git a/copilot-c99/CHANGELOG b/copilot-c99/CHANGELOG index 633d30a2a..ded9f7137 100644 --- a/copilot-c99/CHANGELOG +++ b/copilot-c99/CHANGELOG @@ -1,4 +1,5 @@ -2022-04-29 +2022-05-06 + * Version bump (3.9). (#320) * Translate math operations taking type into account. (#263) * Fix issue with delays of streams of structs or arrays. (#276) * Fix issue in C99 implementation of signum. (#278) diff --git a/copilot-core/CHANGELOG b/copilot-core/CHANGELOG index 3a008e53c..5d423a1b3 100644 --- a/copilot-core/CHANGELOG +++ b/copilot-core/CHANGELOG @@ -1,4 +1,5 @@ -2022-04-22 +2022-05-06 + * Version bump (3.9). (#320) * Hide module Copilot.Core.Interpret.Render. (#303) * Remove Copilot.Core.Type.Dynamic.fromDynF,toDynF. (#301) * Hide module Copilot.Core.Error. (#300) diff --git a/copilot-language/CHANGELOG b/copilot-language/CHANGELOG index ec32a7bdf..18afe2995 100644 --- a/copilot-language/CHANGELOG +++ b/copilot-language/CHANGELOG @@ -1,3 +1,6 @@ +2022-05-06 + * Version bump (3.9). (#320) + 2022-03-07 * Version bump (3.8). (#298) * Introduce testing infrastructure. (#271) diff --git a/copilot-libraries/CHANGELOG b/copilot-libraries/CHANGELOG index f50469d9f..f9dd9a8ae 100644 --- a/copilot-libraries/CHANGELOG +++ b/copilot-libraries/CHANGELOG @@ -1,4 +1,7 @@ -2022-01-07 +2022-05-06 + * Version bump (3.9). (#320) + +2022-03-07 * Version bump (3.8). (#298) * Mark package as uncurated to avoid modification. (#288) diff --git a/copilot-theorem/CHANGELOG b/copilot-theorem/CHANGELOG index 412a25702..361d8faa1 100644 --- a/copilot-theorem/CHANGELOG +++ b/copilot-theorem/CHANGELOG @@ -1,3 +1,6 @@ +2022-05-06 + * Version bump (3.9). (#320) + 2022-03-07 * Version bump (3.8). (#298) * Mark package as uncurated to avoid modification. (#288) diff --git a/copilot/CHANGELOG b/copilot/CHANGELOG index c4e7df5ce..2ba65a4a9 100644 --- a/copilot/CHANGELOG +++ b/copilot/CHANGELOG @@ -1,4 +1,5 @@ -2022-05-02 +2022-05-06 + * Version bump (3.9). (#320) * Add support for GHC 9.0. (#294) 2022-03-07 From ffdbfa4b3497994d7a6b004763951d55a428f598 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 6 May 2022 22:49:00 -0400 Subject: [PATCH 0368/1222] Document changes in CHANGELOG. Refs #320. Document missing changes from issue #316, which was merged without proper entries in the CHANGELOGs. --- copilot-c99/CHANGELOG | 1 + copilot-core/CHANGELOG | 1 + copilot-language/CHANGELOG | 1 + copilot-libraries/CHANGELOG | 1 + copilot-theorem/CHANGELOG | 1 + copilot/CHANGELOG | 1 + 6 files changed, 6 insertions(+) diff --git a/copilot-c99/CHANGELOG b/copilot-c99/CHANGELOG index ded9f7137..f7c738dda 100644 --- a/copilot-c99/CHANGELOG +++ b/copilot-c99/CHANGELOG @@ -1,5 +1,6 @@ 2022-05-06 * Version bump (3.9). (#320) + * Compliance with style guide (partial). (#316) * Translate math operations taking type into account. (#263) * Fix issue with delays of streams of structs or arrays. (#276) * Fix issue in C99 implementation of signum. (#278) diff --git a/copilot-core/CHANGELOG b/copilot-core/CHANGELOG index 5d423a1b3..3ee116b3d 100644 --- a/copilot-core/CHANGELOG +++ b/copilot-core/CHANGELOG @@ -1,5 +1,6 @@ 2022-05-06 * Version bump (3.9). (#320) + * Compliance with style guide (partial). (#316) * Hide module Copilot.Core.Interpret.Render. (#303) * Remove Copilot.Core.Type.Dynamic.fromDynF,toDynF. (#301) * Hide module Copilot.Core.Error. (#300) diff --git a/copilot-language/CHANGELOG b/copilot-language/CHANGELOG index 18afe2995..3380e847a 100644 --- a/copilot-language/CHANGELOG +++ b/copilot-language/CHANGELOG @@ -1,5 +1,6 @@ 2022-05-06 * Version bump (3.9). (#320) + * Compliance with style guide (partial). (#316) 2022-03-07 * Version bump (3.8). (#298) diff --git a/copilot-libraries/CHANGELOG b/copilot-libraries/CHANGELOG index f9dd9a8ae..fe5c8d3ce 100644 --- a/copilot-libraries/CHANGELOG +++ b/copilot-libraries/CHANGELOG @@ -1,5 +1,6 @@ 2022-05-06 * Version bump (3.9). (#320) + * Compliance with style guide (partial). (#316) 2022-03-07 * Version bump (3.8). (#298) diff --git a/copilot-theorem/CHANGELOG b/copilot-theorem/CHANGELOG index 361d8faa1..b8c22e147 100644 --- a/copilot-theorem/CHANGELOG +++ b/copilot-theorem/CHANGELOG @@ -1,5 +1,6 @@ 2022-05-06 * Version bump (3.9). (#320) + * Compliance with style guide (partial). (#316) 2022-03-07 * Version bump (3.8). (#298) diff --git a/copilot/CHANGELOG b/copilot/CHANGELOG index 2ba65a4a9..e402532c4 100644 --- a/copilot/CHANGELOG +++ b/copilot/CHANGELOG @@ -1,5 +1,6 @@ 2022-05-06 * Version bump (3.9). (#320) + * Compliance with style guide (partial). (#316) * Add support for GHC 9.0. (#294) 2022-03-07 From 438eb4a6ac369db25599bbe26c4acf079fe60098 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 31 May 2022 14:26:25 -0400 Subject: [PATCH 0369/1222] copilot-core: enable CLI args in tests. Refs #337. This commit modifies the implementation of the test executable in copilot-core so that the test seed can be passed as argument. The change allows tests to be reproduced locally (e.g., with docker), by feeding the same seed for random number generation to the test executable, which is necessary to reproduce some errors. --- copilot-core/tests/Main.hs | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/copilot-core/tests/Main.hs b/copilot-core/tests/Main.hs index c0fcc8b3f..69136edb9 100644 --- a/copilot-core/tests/Main.hs +++ b/copilot-core/tests/Main.hs @@ -2,8 +2,7 @@ module Main where -- External imports -import Data.Monoid (mempty) -import Test.Framework (Test, defaultMainWithOpts) +import Test.Framework (Test, defaultMain) -- Internal library modules being tested import qualified Test.Copilot.Core.External @@ -15,7 +14,7 @@ import qualified Test.Copilot.Core.Type.Show -- | Run all unit tests on copilot-core. main :: IO () -main = defaultMainWithOpts tests mempty +main = defaultMain tests -- | All unit tests in copilot-core. tests :: [Test.Framework.Test] From 83a4af9f19e6a0b3c6e49a700ef5d771e41ac4ac Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 31 May 2022 11:31:33 -0400 Subject: [PATCH 0370/1222] copilot-language: enable CLI args in tests. Refs #337. This commit modifies the implementation of the test executable in copilot-language so that the test seed can be passed as argument. The change allows tests to be reproduced locally (e.g., with docker), by feeding the same seed for random number generation to the test executable, which is necessary to reproduce some errors. --- copilot-language/tests/Main.hs | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/copilot-language/tests/Main.hs b/copilot-language/tests/Main.hs index 2c196ab1c..790b2c9b3 100644 --- a/copilot-language/tests/Main.hs +++ b/copilot-language/tests/Main.hs @@ -2,15 +2,14 @@ module Main where -- External imports -import Data.Monoid (mempty) -import Test.Framework (Test, defaultMainWithOpts) +import Test.Framework (Test, defaultMain) -- Internal imports import qualified Test.Copilot.Language.Reify -- | Run all unit tests on copilot-language. main :: IO () -main = defaultMainWithOpts tests mempty +main = defaultMain tests -- | All unit tests in copilot-language. tests :: [Test.Framework.Test] From 2d9f98184622fa3f5248b6124cfa88333f4f98d9 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 31 May 2022 13:56:30 -0400 Subject: [PATCH 0371/1222] copilot-core: Fix error in test case generation. Refs #337. The tests generated for integral-carrying streams with bit functions applied to them produce streams that cannot be evaluated. In particular, when using one of the shifting operations, the second argument applied to shift (the magnitude of the shift) may be negative, or be an integer that becomes a negative number when cast to the necessary type, which results in an exception. This commit modifies the generation of bit-shifted streams by using constant positive numbers for the magnitude of shifting. --- .../tests/Test/Copilot/Core/Interpret/Eval.hs | 55 ++++++++++++------- 1 file changed, 35 insertions(+), 20 deletions(-) diff --git a/copilot-core/tests/Test/Copilot/Core/Interpret/Eval.hs b/copilot-core/tests/Test/Copilot/Core/Interpret/Eval.hs index 3832ea6b2..2e2c24b93 100644 --- a/copilot-core/tests/Test/Copilot/Core/Interpret/Eval.hs +++ b/copilot-core/tests/Test/Copilot/Core/Interpret/Eval.hs @@ -476,27 +476,42 @@ arbitraryBitsExpr = arbitraryBitsIntegralExpr :: (Arbitrary t, Typed t, Bits t, Integral t) => Gen (Expr t, [t]) arbitraryBitsIntegralExpr = - -- We use frequency instead of oneof because the random expression generator - -- seems to generate expressions that are too large and the test fails due - -- to running out of memory. - frequency - [ (10, arbitraryConst) - - , (2, apply1 <$> arbitraryNumOp1 <*> arbitraryBitsIntegralExpr) - - , (1, apply2 <$> arbitraryNumOp2 - <*> arbitraryBitsIntegralExpr - <*> arbitraryBitsIntegralExpr) - - , (5, apply2 <$> arbitraryBitsIntegralOp2 - <*> arbitraryBitsIntegralExpr - <*> arbitraryBitsIntegralExpr) + -- We use frequency instead of oneof because the random expression + -- generator seems to generate expressions that are too large and the + -- test fails due to running out of memory. + frequency + [ (10, arbitraryConst) + + , (2, apply1 <$> arbitraryNumOp1 <*> arbitraryBitsIntegralExpr) + + , (1, apply2 <$> arbitraryNumOp2 + <*> arbitraryBitsIntegralExpr + <*> arbitraryBitsIntegralExpr) + + , (5, apply2 <$> arbitraryBitsIntegralOp2 + <*> arbitraryBitsIntegralExpr + <*> arbitraryBitsIntegralExprConstPos) + + , (1, apply3 <$> arbitraryITEOp3 + <*> arbitraryBoolExpr + <*> arbitraryBitsIntegralExpr + <*> arbitraryBitsIntegralExpr) + ] + where - , (1, apply3 <$> arbitraryITEOp3 - <*> arbitraryBoolExpr - <*> arbitraryBitsIntegralExpr - <*> arbitraryBitsIntegralExpr) - ] + -- Generator for constant bit integral expressions that, when converted to + -- type 't', result in a positive number. We use a constant generator, as + -- opposed to a generator based on the more comprehensive + -- arbitraryBitsIntegralExpr, because the latter runs out of memory easily + -- when nested and filtered with suchThat. + arbitraryBitsIntegralExprConstPos = + (\v -> (Const typeOf v, repeat v)) <$> intThatFits + where + -- In this context: + -- + -- intThatFits :: Gen t + intThatFits = + suchThat arbitrary ((> 0) . (\x -> (fromIntegral x) :: Int)) -- ** Operators From 375aebfac5a71035d77c2565ad4921a16935e138 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 31 May 2022 13:33:44 -0400 Subject: [PATCH 0372/1222] copilot-language: Fix error in test case generation. Refs #337. The tests generated for integral-carrying streams with bit functions applied to them produce streams that cannot be evaluated. In particular, when using one of the shifting operations, the second argument applied to shift (the magnitude of the shift) may be negative, or be an integer that becomes a negative number when cast to the necessary type, which results in an exception. This commit modifies the generation of bit-shifted streams by using constant positive numbers for the magnitude of shifting. --- .../tests/Test/Copilot/Language/Reify.hs | 55 ++++++++++++------- 1 file changed, 35 insertions(+), 20 deletions(-) diff --git a/copilot-language/tests/Test/Copilot/Language/Reify.hs b/copilot-language/tests/Test/Copilot/Language/Reify.hs index eb0791cc2..44e9100a1 100644 --- a/copilot-language/tests/Test/Copilot/Language/Reify.hs +++ b/copilot-language/tests/Test/Copilot/Language/Reify.hs @@ -459,27 +459,42 @@ arbitraryBitsExpr = arbitraryBitsIntegralExpr :: (Arbitrary t, Typed t, Bits t, Integral t) => Gen (Stream t, [t]) arbitraryBitsIntegralExpr = - -- We use frequency instead of oneof because the random expression generator - -- seems to generate expressions that are too large and the test fails due - -- to running out of memory. - frequency - [ (10, arbitraryConst) - - , (2, apply1 <$> arbitraryNumOp1 <*> arbitraryBitsIntegralExpr) - - , (1, apply2 <$> arbitraryNumOp2 - <*> arbitraryBitsIntegralExpr - <*> arbitraryBitsIntegralExpr) - - , (5, apply2 <$> arbitraryBitsIntegralOp2 - <*> arbitraryBitsIntegralExpr - <*> arbitraryBitsIntegralExpr) + -- We use frequency instead of oneof because the random expression + -- generator seems to generate expressions that are too large and the + -- test fails due to running out of memory. + frequency + [ (10, arbitraryConst) + + , (2, apply1 <$> arbitraryNumOp1 <*> arbitraryBitsIntegralExpr) + + , (1, apply2 <$> arbitraryNumOp2 + <*> arbitraryBitsIntegralExpr + <*> arbitraryBitsIntegralExpr) + + , (5, apply2 <$> arbitraryBitsIntegralOp2 + <*> arbitraryBitsIntegralExpr + <*> arbitraryBitsIntegralExprConstPos) + + , (1, apply3 <$> arbitraryITEOp3 + <*> arbitraryBoolExpr + <*> arbitraryBitsIntegralExpr + <*> arbitraryBitsIntegralExpr) + ] + where - , (1, apply3 <$> arbitraryITEOp3 - <*> arbitraryBoolExpr - <*> arbitraryBitsIntegralExpr - <*> arbitraryBitsIntegralExpr) - ] + -- Generator for constant bit integral expressions that, when converted to + -- type 't', result in a positive number. We use a constant generator, as + -- opposed to a generator based on the more comprehensive + -- arbitraryBitsIntegralExpr, because the latter runs out of memory easily + -- when nested and filtered with suchThat. + arbitraryBitsIntegralExprConstPos = + (\v -> (Copilot.constant v, repeat v)) <$> intThatFits + where + -- In this context: + -- + -- intThatFits :: Gen t + intThatFits = + suchThat arbitrary ((> 0) . (\x -> (fromIntegral x) :: Int)) -- ** Operators From a02c534050bcb798e8da6c105226a8e80a49dae1 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 31 May 2022 14:27:17 -0400 Subject: [PATCH 0373/1222] Document changes in copilot-core:CHANGELOG. Refs #337. --- copilot-core/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-core/CHANGELOG b/copilot-core/CHANGELOG index 3ee116b3d..11658da70 100644 --- a/copilot-core/CHANGELOG +++ b/copilot-core/CHANGELOG @@ -1,3 +1,6 @@ +2022-05-31 + * Fix error in test case generation; enable CLI args in tests. (#337) + 2022-05-06 * Version bump (3.9). (#320) * Compliance with style guide (partial). (#316) From 939de25f33ed63d51bc42005b7caecb3b3bda66b Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 31 May 2022 14:27:27 -0400 Subject: [PATCH 0374/1222] Document changes in copilot-language:CHANGELOG. Refs #337. --- copilot-language/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-language/CHANGELOG b/copilot-language/CHANGELOG index 3380e847a..1f28dabfc 100644 --- a/copilot-language/CHANGELOG +++ b/copilot-language/CHANGELOG @@ -1,3 +1,6 @@ +2022-05-31 + * Fix error in test case generation; enable CLI args in tests. (#337) + 2022-05-06 * Version bump (3.9). (#320) * Compliance with style guide (partial). (#316) From 627eb18d84404e25448b72b65292bb721f236c94 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 31 May 2022 08:15:03 -0400 Subject: [PATCH 0375/1222] Enable tests in CI. Refs #329. This commit enables running the tests in the CI server, with details enabled (-j1), when running with a specific version of the compiler. We hardcode the version to make sure tests are not executed with every job, to limit the amount of time, and resources, that they require. --- .travis.yml | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/.travis.yml b/.travis.yml index 40a77fd91..2c3b33611 100644 --- a/.travis.yml +++ b/.travis.yml @@ -23,3 +23,8 @@ before_install: script: - cabal v2-install --lib copilot + + # Run tests only on GHC 8.10.4 + # + # Only libraries with tests are listed below or the v2-test command fails. + - if [ "${GHCVER}" == "8.10.4" ]; then cabal v2-test -j1 copilot-core copilot-language; fi From 8a2126e891a001948d68df4007040b680d53e70a Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 31 May 2022 14:20:03 -0400 Subject: [PATCH 0376/1222] Document changes in copilot:CHANGELOG. Refs #329. --- copilot/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot/CHANGELOG b/copilot/CHANGELOG index e402532c4..7deac086c 100644 --- a/copilot/CHANGELOG +++ b/copilot/CHANGELOG @@ -1,3 +1,6 @@ +2022-05-31 + * Run tests in CI. (#329) + 2022-05-06 * Version bump (3.9). (#320) * Compliance with style guide (partial). (#316) From 7b2f8f6bf6659f124a9f9fbd20adf55a064e21ed Mon Sep 17 00:00:00 2001 From: Will Pogge Date: Wed, 1 Jun 2022 12:09:37 -0400 Subject: [PATCH 0377/1222] copilot-theorem: Remove commented out sections of the cabal file. Ref #325. In order to comply with our style guidelines, remove commented out sections from the cabal file. --- copilot-theorem/copilot-theorem.cabal | 14 -------------- 1 file changed, 14 deletions(-) diff --git a/copilot-theorem/copilot-theorem.cabal b/copilot-theorem/copilot-theorem.cabal index 4779f7ddb..341fb9a7a 100644 --- a/copilot-theorem/copilot-theorem.cabal +++ b/copilot-theorem/copilot-theorem.cabal @@ -40,20 +40,6 @@ library -fno-warn-missing-signatures -fcontext-stack=100 - -- -fpackage-trust - -- -trust=array - -- -trust=base - -- -trust=containers - -- -- -trust=copilot-core - -- -trust=directory - -- -- -trust=exceptions - -- -trust=process - -- -- -trust=random - -- -trust=unix - -- -- -trust=parsec - -- -trust=bytestring - -- -- -trust=text - build-depends : base >= 4.9 && < 5 , ansi-terminal >= 0.8 && < 0.10 , bimap >= 0.3 && < 0.4 From 5fc9fcbe6e86d1e45c0827d3745c5f3106130722 Mon Sep 17 00:00:00 2001 From: Will Pogge Date: Wed, 1 Jun 2022 12:14:37 -0400 Subject: [PATCH 0378/1222] Document changes in CHANGELOG. Refs #325. --- copilot-theorem/CHANGELOG | 2 ++ 1 file changed, 2 insertions(+) diff --git a/copilot-theorem/CHANGELOG b/copilot-theorem/CHANGELOG index b8c22e147..f51a882b3 100644 --- a/copilot-theorem/CHANGELOG +++ b/copilot-theorem/CHANGELOG @@ -1,3 +1,5 @@ +2022-06-01 + * Remove comment from cabal file. (#325) 2022-05-06 * Version bump (3.9). (#320) * Compliance with style guide (partial). (#316) From 3a2df6276a1caa699492ecd2d68e66ad87dd4db8 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 2 Jun 2022 19:46:07 -0400 Subject: [PATCH 0379/1222] copilot-libraries: Remove unnecessary dependencies. Refs #327. The package copilot-libraries depends on the libraries data-reify and array, but those libraries are not needed. This commit removes those dependencies from the Cabal file. --- copilot-libraries/copilot-libraries.cabal | 2 -- 1 file changed, 2 deletions(-) diff --git a/copilot-libraries/copilot-libraries.cabal b/copilot-libraries/copilot-libraries.cabal index 76fc76849..69bc73143 100644 --- a/copilot-libraries/copilot-libraries.cabal +++ b/copilot-libraries/copilot-libraries.cabal @@ -38,9 +38,7 @@ library build-depends: base >= 4.9 && < 5 - , array >= 0.5 && < 0.6 , containers >= 0.4 && < 0.7 - , data-reify >= 0.6 && < 0.7 , mtl >= 2.0 && < 2.3 , parsec >= 2.0 && < 3.2 , copilot-language >= 3.9 && < 3.10 From 5c6968fae72b15e57d8e9e7e79b5c4b45f8a0ef2 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 2 Jun 2022 19:47:42 -0400 Subject: [PATCH 0380/1222] Document changes in copilot-libraries:CHANGELOG. Refs #327. --- copilot-libraries/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-libraries/CHANGELOG b/copilot-libraries/CHANGELOG index fe5c8d3ce..4192f2408 100644 --- a/copilot-libraries/CHANGELOG +++ b/copilot-libraries/CHANGELOG @@ -1,3 +1,6 @@ +2022-06-02 + * Remove unnecessary dependencies from Cabal package. (#327) + 2022-05-06 * Version bump (3.9). (#320) * Compliance with style guide (partial). (#316) From 59caf2bb8d4a786be33a190f4237e86d1be438ae Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 9 Jun 2022 13:41:03 -0400 Subject: [PATCH 0381/1222] copilot-theorem: Remove unnecessary dependencies. Refs #326. The package copilot-theorem depends on the libraries ansi-terminal and filepath, but those libraries are not needed. This commit removes those dependencies from the Cabal file. --- copilot-theorem/copilot-theorem.cabal | 2 -- 1 file changed, 2 deletions(-) diff --git a/copilot-theorem/copilot-theorem.cabal b/copilot-theorem/copilot-theorem.cabal index 341fb9a7a..8d5351e95 100644 --- a/copilot-theorem/copilot-theorem.cabal +++ b/copilot-theorem/copilot-theorem.cabal @@ -41,13 +41,11 @@ library -fcontext-stack=100 build-depends : base >= 4.9 && < 5 - , ansi-terminal >= 0.8 && < 0.10 , bimap >= 0.3 && < 0.4 , bv-sized >= 1.0.2 && < 1.1 , containers >= 0.4 && < 0.7 , data-default >= 0.7 && < 0.8 , directory >= 1.3 && < 1.4 - , filepath >= 1.4.2 && < 1.5 , libBF >= 0.6.2 && < 0.7 , mtl >= 2.0 && < 2.3 , panic >= 0.4.0 && < 0.5 From 65c781b7d8117ebc3134323f24010b82c95aa4de Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 9 Jun 2022 13:42:36 -0400 Subject: [PATCH 0382/1222] Document changes in copilot-theorem:CHANGELOG. Refs #326. --- copilot-theorem/CHANGELOG | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/copilot-theorem/CHANGELOG b/copilot-theorem/CHANGELOG index f51a882b3..e1a58c73d 100644 --- a/copilot-theorem/CHANGELOG +++ b/copilot-theorem/CHANGELOG @@ -1,5 +1,7 @@ -2022-06-01 +2022-06-09 * Remove comment from cabal file. (#325) + * Remove unnecessary dependencies from Cabal package. (#326) + 2022-05-06 * Version bump (3.9). (#320) * Compliance with style guide (partial). (#316) From ba423cf27cbda45e266d6acd561ec2bc987d7e44 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 10 Jun 2022 20:07:06 -0400 Subject: [PATCH 0383/1222] copilot-c99: Remove unnecessary dependencies. Refs #323. The package copilot-c99 depends on the libraries containers and language-c99-util, but those libraries are not needed. This commit removes those dependencies from the Cabal file. --- copilot-c99/copilot-c99.cabal | 2 -- 1 file changed, 2 deletions(-) diff --git a/copilot-c99/copilot-c99.cabal b/copilot-c99/copilot-c99.cabal index e7eda6dc4..4a8499a10 100644 --- a/copilot-c99/copilot-c99.cabal +++ b/copilot-c99/copilot-c99.cabal @@ -44,7 +44,6 @@ library -- internal modules. ghc-options : -Wall -fwarn-tabs -Wno-deprecations build-depends : base >= 4.9 && < 5 - , containers >= 0.4 && < 0.7 , directory >= 1.3 && < 1.4 , filepath >= 1.4 && < 1.5 , mtl >= 2.2 && < 2.3 @@ -52,7 +51,6 @@ library , copilot-core >= 3.9 && < 3.10 , language-c99 >= 0.1.1 && < 0.2 - , language-c99-util >= 0.1.1 && < 0.2 , language-c99-simple >= 0.1.1 && < 0.2 exposed-modules : Copilot.Compile.C99 From 7747ee667f291225bd8bbc1ad15bf6be5b04380c Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 10 Jun 2022 20:08:56 -0400 Subject: [PATCH 0384/1222] Document changes in copilot-c99:CHANGELOG. Refs #323. --- copilot-c99/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-c99/CHANGELOG b/copilot-c99/CHANGELOG index f7c738dda..9052edf39 100644 --- a/copilot-c99/CHANGELOG +++ b/copilot-c99/CHANGELOG @@ -1,3 +1,6 @@ +2022-06-10 + * Remove unnecessary dependencies from Cabal package. (#323) + 2022-05-06 * Version bump (3.9). (#320) * Compliance with style guide (partial). (#316) From 148fbfe630f41a83c0c8db7b2f6f05ee4efad65d Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 10 Jun 2022 21:08:55 -0400 Subject: [PATCH 0385/1222] copilot-core: Remove unnecessary dependencies. Refs #324. The package copilot-core depends on the library mtl, but that library is not needed. This commit removes that dependency from the Cabal file. --- copilot-core/copilot-core.cabal | 1 - 1 file changed, 1 deletion(-) diff --git a/copilot-core/copilot-core.cabal b/copilot-core/copilot-core.cabal index ffe9450ff..2e58a951d 100644 --- a/copilot-core/copilot-core.cabal +++ b/copilot-core/copilot-core.cabal @@ -45,7 +45,6 @@ library build-depends: base >= 4.9 && < 5, pretty >= 1.0 && < 1.2, - mtl >= 2.0 && < 2.3, dlist exposed-modules: From 069c2f63deff5cc9e51720b8c256dd426d5739b3 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 10 Jun 2022 21:10:10 -0400 Subject: [PATCH 0386/1222] Document changes in copilot-core:CHANGELOG. Refs #324. --- copilot-core/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot-core/CHANGELOG b/copilot-core/CHANGELOG index 11658da70..ef3799152 100644 --- a/copilot-core/CHANGELOG +++ b/copilot-core/CHANGELOG @@ -1,5 +1,6 @@ -2022-05-31 +2022-06-10 * Fix error in test case generation; enable CLI args in tests. (#337) + * Remove unnecessary dependencies from Cabal package. (#324) 2022-05-06 * Version bump (3.9). (#320) From f5684fc328770d2f1dc3dac50d3036821dbdd77b Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 10 Jun 2022 21:58:31 -0400 Subject: [PATCH 0387/1222] copilot-core: Deprecate module Copilot.Core.External. Refs #322. The module copilot-core:Copilot.Core.External is not being used by any other part of Copilot. It is not a necessary part of the interface to use Copilot, and not required by Copilot's requirements. Following our policy of waiting 3 versions from deprecation until a public interface declaration can be removed, this module is now deprecated so that users who may need such features can report it, and/or adapt their code as needed. --- copilot-core/src/Copilot/Core/External.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/copilot-core/src/Copilot/Core/External.hs b/copilot-core/src/Copilot/Core/External.hs index 512bbcbbb..4af789a20 100644 --- a/copilot-core/src/Copilot/Core/External.hs +++ b/copilot-core/src/Copilot/Core/External.hs @@ -6,6 +6,7 @@ -- | Internal Copilot Core representation of Copilot externs. module Copilot.Core.External + {-# DEPRECATED "This module is deprecated in Copilot 3.10." #-} ( ExtVar (..) , externVars ) where From 5b0ce505d455fcb6287543ace5fc92c1c6da349c Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 10 Jun 2022 22:04:00 -0400 Subject: [PATCH 0388/1222] copilot-core: Disable warning due to deprecation. Refs #322. This commit disables a warning in a module that imports and re-exports Copilot.Core.External. It is included so that users do not see that message during the compilation of Copilot, and they only see it if they import that module directly themselves. --- copilot-core/src/Copilot/Core.hs | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/copilot-core/src/Copilot/Core.hs b/copilot-core/src/Copilot/Core.hs index c24539410..642ea3793 100644 --- a/copilot-core/src/Copilot/Core.hs +++ b/copilot-core/src/Copilot/Core.hs @@ -19,6 +19,10 @@ -- ("Copilot.Core.PrettyPrint"). {-# LANGUAGE Safe #-} +-- The following warning is enabled in this module so that the import of +-- Copilot.Core.External does not give rise to a warning. It can be removed +-- when that module is removed from the implementation. +{-# OPTIONS_GHC -fno-warn-deprecations #-} module Copilot.Core ( module Copilot.Core.Expr @@ -32,7 +36,7 @@ module Copilot.Core ) where import Copilot.Core.Expr -import Copilot.Core.External +import Copilot.Core.External -- See GHC flag enabled above import Copilot.Core.Operators import Copilot.Core.Spec import Copilot.Core.Type From 7bc39536b5f6c02c86ad697198c7f9de470bdde9 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 10 Jun 2022 22:06:58 -0400 Subject: [PATCH 0389/1222] copilot-core: Disable warning due to deprecation. Refs #322. This commit disables a warning in a test that imports Copilot.Core.External. It is included so that users do not see that message during the compilation of Copilot, and they only see it if they import that module directly themselves. --- copilot-core/tests/Test/Copilot/Core/External.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/copilot-core/tests/Test/Copilot/Core/External.hs b/copilot-core/tests/Test/Copilot/Core/External.hs index 361c613a3..4e9001942 100644 --- a/copilot-core/tests/Test/Copilot/Core/External.hs +++ b/copilot-core/tests/Test/Copilot/Core/External.hs @@ -1,3 +1,7 @@ +-- The following warning is enabled in this module so that the import of +-- Copilot.Core.External does not give rise to a warning. +{-# OPTIONS_GHC -fno-warn-deprecations #-} + -- | Test copilot-core:Copilot.Core.External. module Test.Copilot.Core.External where From 197a08c1a5e624ddcab3943440fc85cf631cbec5 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 10 Jun 2022 22:07:46 -0400 Subject: [PATCH 0390/1222] Document changes in copilot-core:CHANGELOG. Refs #322. --- copilot-core/CHANGELOG | 1 + 1 file changed, 1 insertion(+) diff --git a/copilot-core/CHANGELOG b/copilot-core/CHANGELOG index ef3799152..f81907550 100644 --- a/copilot-core/CHANGELOG +++ b/copilot-core/CHANGELOG @@ -1,6 +1,7 @@ 2022-06-10 * Fix error in test case generation; enable CLI args in tests. (#337) * Remove unnecessary dependencies from Cabal package. (#324) + * Deprecate Copilot.Core.External. (#322) 2022-05-06 * Version bump (3.9). (#320) From bdd0cc6bbdbd2050685ae4709ff74aaf854531dd Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 10 Jun 2022 23:59:42 -0400 Subject: [PATCH 0391/1222] copilot: Remove duplicated compiler option. Refs #328. The cabal files of all packages are adding the flag -fwarn-tabs, but that warning is implied by -Wall, which they all enable. It is therefore unnecessary code. This commit removes that flag from the compilation options of copilot. --- copilot/copilot.cabal | 1 - 1 file changed, 1 deletion(-) diff --git a/copilot/copilot.cabal b/copilot/copilot.cabal index 27d39764c..e16952bbc 100644 --- a/copilot/copilot.cabal +++ b/copilot/copilot.cabal @@ -44,7 +44,6 @@ library default-language: Haskell2010 ghc-options: -Wall - -fwarn-tabs -fno-warn-orphans build-depends: base >= 4.9 && < 5 From 1f2e74f6535b4dfa4dd1c041ecd9f96a252856ac Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 10 Jun 2022 23:57:30 -0400 Subject: [PATCH 0392/1222] copilot-c99: Remove duplicated compiler option. Refs #328. The cabal files of all packages are adding the flag -fwarn-tabs, but that warning is implied by -Wall, which they all enable. It is therefore unnecessary code. This commit removes that flag from the compilation options of copilot-c99. --- copilot-c99/copilot-c99.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot-c99/copilot-c99.cabal b/copilot-c99/copilot-c99.cabal index 4a8499a10..ebf92be64 100644 --- a/copilot-c99/copilot-c99.cabal +++ b/copilot-c99/copilot-c99.cabal @@ -42,7 +42,7 @@ library -- https://github.com/Copilot-Language/copilot/issues/237 -- It should be removed in a future version, when this library hides -- internal modules. - ghc-options : -Wall -fwarn-tabs -Wno-deprecations + ghc-options : -Wall -Wno-deprecations build-depends : base >= 4.9 && < 5 , directory >= 1.3 && < 1.4 , filepath >= 1.4 && < 1.5 From 7659b4bbb5fe2be4a6db84ce21e6d2c1c70c667a Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 10 Jun 2022 23:58:21 -0400 Subject: [PATCH 0393/1222] copilot-core: Remove duplicated compiler option. Refs #328. The cabal files of all packages are adding the flag -fwarn-tabs, but that warning is implied by -Wall, which they all enable. It is therefore unnecessary code. This commit removes that flag from the compilation options of copilot-core. --- copilot-core/copilot-core.cabal | 1 - 1 file changed, 1 deletion(-) diff --git a/copilot-core/copilot-core.cabal b/copilot-core/copilot-core.cabal index 2e58a951d..07363cff7 100644 --- a/copilot-core/copilot-core.cabal +++ b/copilot-core/copilot-core.cabal @@ -39,7 +39,6 @@ library ghc-options: -Wall - -fwarn-tabs -fno-warn-orphans build-depends: From 14c57aaf6381afeea2e34152e4950c30b44b031d Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 10 Jun 2022 23:58:38 -0400 Subject: [PATCH 0394/1222] copilot-language: Remove duplicated compiler option. Refs #328. The cabal files of all packages are adding the flag -fwarn-tabs, but that warning is implied by -Wall, which they all enable. It is therefore unnecessary code. This commit removes that flag from the compilation options of copilot-language. --- copilot-language/copilot-language.cabal | 1 - 1 file changed, 1 deletion(-) diff --git a/copilot-language/copilot-language.cabal b/copilot-language/copilot-language.cabal index 0c2b86d2f..0ae2d42b3 100644 --- a/copilot-language/copilot-language.cabal +++ b/copilot-language/copilot-language.cabal @@ -71,7 +71,6 @@ library , System.Mem.StableName.Map , Copilot.Language.Error ghc-options: - -fwarn-tabs -Wall test-suite unit-tests From ecb569cad261ce1a3c0cc6c022c4459429e52cd5 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 10 Jun 2022 23:58:56 -0400 Subject: [PATCH 0395/1222] copilot-libraries: Remove duplicated compiler option. Refs #328. The cabal files of all packages are adding the flag -fwarn-tabs, but that warning is implied by -Wall, which they all enable. It is therefore unnecessary code. This commit removes that flag from the compilation options of copilot-libraries. --- copilot-libraries/copilot-libraries.cabal | 1 - 1 file changed, 1 deletion(-) diff --git a/copilot-libraries/copilot-libraries.cabal b/copilot-libraries/copilot-libraries.cabal index 69bc73143..960f0110e 100644 --- a/copilot-libraries/copilot-libraries.cabal +++ b/copilot-libraries/copilot-libraries.cabal @@ -56,5 +56,4 @@ library , Copilot.Library.MTL ghc-options: - -fwarn-tabs -Wall From 9ecaa1e5f206f79973c6ee9dedb6de315815e964 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 10 Jun 2022 23:59:14 -0400 Subject: [PATCH 0396/1222] copilot-theorem: Remove duplicated compiler option. Refs #328. The cabal files of all packages are adding the flag -fwarn-tabs, but that warning is implied by -Wall, which they all enable. It is therefore unnecessary code. This commit removes that flag from the compilation options of copilot-theorem. --- copilot-theorem/copilot-theorem.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot-theorem/copilot-theorem.cabal b/copilot-theorem/copilot-theorem.cabal index 8d5351e95..b1d9b4920 100644 --- a/copilot-theorem/copilot-theorem.cabal +++ b/copilot-theorem/copilot-theorem.cabal @@ -34,7 +34,7 @@ library default-language : Haskell2010 hs-source-dirs : src - ghc-options : -Wall -fwarn-tabs + ghc-options : -Wall -fno-warn-name-shadowing -fno-warn-unused-binds -fno-warn-missing-signatures From ef3235d8b976585832858b4f4a460742fba95b0a Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 11 Jun 2022 00:01:08 -0400 Subject: [PATCH 0397/1222] Document changes in copilot:CHANGELOG. Refs #328. --- copilot/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot/CHANGELOG b/copilot/CHANGELOG index 7deac086c..b0d34a8e1 100644 --- a/copilot/CHANGELOG +++ b/copilot/CHANGELOG @@ -1,5 +1,6 @@ -2022-05-31 +2022-06-11 * Run tests in CI. (#329) + * Remove duplicated compiler option. (#328) 2022-05-06 * Version bump (3.9). (#320) From d4f5b71b95bdfe8bfab66c797ec7b2fc12d2ee8d Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 11 Jun 2022 00:01:41 -0400 Subject: [PATCH 0398/1222] Document changes in copilot-c99:CHANGELOG. Refs #328. --- copilot-c99/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot-c99/CHANGELOG b/copilot-c99/CHANGELOG index 9052edf39..5ff7fe723 100644 --- a/copilot-c99/CHANGELOG +++ b/copilot-c99/CHANGELOG @@ -1,5 +1,6 @@ -2022-06-10 +2022-06-11 * Remove unnecessary dependencies from Cabal package. (#323) + * Remove duplicated compiler option. (#328) 2022-05-06 * Version bump (3.9). (#320) From e124610dd4c4ce634ec1f57a5ac63266ed430569 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 11 Jun 2022 00:02:16 -0400 Subject: [PATCH 0399/1222] Document changes in copilot-core:CHANGELOG. Refs #328. --- copilot-core/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot-core/CHANGELOG b/copilot-core/CHANGELOG index f81907550..56fee1b4b 100644 --- a/copilot-core/CHANGELOG +++ b/copilot-core/CHANGELOG @@ -1,7 +1,8 @@ -2022-06-10 +2022-06-11 * Fix error in test case generation; enable CLI args in tests. (#337) * Remove unnecessary dependencies from Cabal package. (#324) * Deprecate Copilot.Core.External. (#322) + * Remove duplicated compiler option. (#328) 2022-05-06 * Version bump (3.9). (#320) From e1fbf2012f85a6ce8a731b33d42ed262bef24773 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 11 Jun 2022 00:02:35 -0400 Subject: [PATCH 0400/1222] Document changes in copilot-language:CHANGELOG. Refs #328. --- copilot-language/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot-language/CHANGELOG b/copilot-language/CHANGELOG index 1f28dabfc..ec27f038d 100644 --- a/copilot-language/CHANGELOG +++ b/copilot-language/CHANGELOG @@ -1,5 +1,6 @@ -2022-05-31 +2022-06-11 * Fix error in test case generation; enable CLI args in tests. (#337) + * Remove duplicated compiler option. (#328) 2022-05-06 * Version bump (3.9). (#320) From 928b081050aafa38076a8b1b3dd80187482ccacb Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 11 Jun 2022 00:02:54 -0400 Subject: [PATCH 0401/1222] Document changes in copilot-libraries:CHANGELOG. Refs #328. --- copilot-libraries/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot-libraries/CHANGELOG b/copilot-libraries/CHANGELOG index 4192f2408..8ba051e3b 100644 --- a/copilot-libraries/CHANGELOG +++ b/copilot-libraries/CHANGELOG @@ -1,5 +1,6 @@ -2022-06-02 +2022-06-11 * Remove unnecessary dependencies from Cabal package. (#327) + * Remove duplicated compiler option. (#328) 2022-05-06 * Version bump (3.9). (#320) From e8add7852d9517ae9ced0bb599c57990a3aecb9d Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 11 Jun 2022 00:03:13 -0400 Subject: [PATCH 0402/1222] Document changes in copilot-theorem:CHANGELOG. Refs #328. --- copilot-theorem/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot-theorem/CHANGELOG b/copilot-theorem/CHANGELOG index e1a58c73d..8c177c02f 100644 --- a/copilot-theorem/CHANGELOG +++ b/copilot-theorem/CHANGELOG @@ -1,6 +1,7 @@ -2022-06-09 +2022-06-11 * Remove comment from cabal file. (#325) * Remove unnecessary dependencies from Cabal package. (#326) + * Remove duplicated compiler option. (#328) 2022-05-06 * Version bump (3.9). (#320) From d760329185c00080e6f7d1dc478b88679540f21e Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 11 Jun 2022 08:53:44 -0400 Subject: [PATCH 0403/1222] copilot-core: Hide deprecated type. Refs #348. The type Copilot.Core.Type.Show.ShowWit was deprecated in Copilot 3.7 because it was not used externally and therefore did not belong as part of the public API. As per our internal policy of waiting 3 versions from deprecation until a public interface declaration can be removed, this type can now be hidden. --- copilot-core/src/Copilot/Core/Type/Show.hs | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/copilot-core/src/Copilot/Core/Type/Show.hs b/copilot-core/src/Copilot/Core/Type/Show.hs index e0adc97ce..1b14a683d 100644 --- a/copilot-core/src/Copilot/Core/Type/Show.hs +++ b/copilot-core/src/Copilot/Core/Type/Show.hs @@ -6,8 +6,7 @@ -- | Show Copilot Core types and typed values. module Copilot.Core.Type.Show - ( ShowWit (..) - , showWithType + ( showWithType , ShowType(..) , showType ) where @@ -15,7 +14,6 @@ module Copilot.Core.Type.Show import Copilot.Core.Type -- | Witness datatype for showing a value, used by 'showWithType'. -{-# DEPRECATED ShowWit "This type is deprecated in Copilot 3.7." #-} data ShowWit a = Show a => ShowWit -- | Turn a type into a show witness. From 1babbbbf4fae551666b9d594d9fa22286639bc35 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 11 Jun 2022 08:59:17 -0400 Subject: [PATCH 0404/1222] copilot-core: Reorganize module making definitions auxiliary. Refs #348. As the type ShowWit is now completely hidden from the interface and only used locally in this module, it has become auxiliary. This fact is best reflected by moving the definitions to a location in the file where their nature is made clear. This commit moves the type definition, and the only function that can be used to operate with it, to the bottom of the file, into an auxiliary section. The decision to place them there (as opposed to e.g., in a where clause) is made because the type cannot be defined in a where clause. --- copilot-core/src/Copilot/Core/Type/Show.hs | 78 +++++++++++----------- 1 file changed, 40 insertions(+), 38 deletions(-) diff --git a/copilot-core/src/Copilot/Core/Type/Show.hs b/copilot-core/src/Copilot/Core/Type/Show.hs index 1b14a683d..1be0f33f6 100644 --- a/copilot-core/src/Copilot/Core/Type/Show.hs +++ b/copilot-core/src/Copilot/Core/Type/Show.hs @@ -13,26 +13,27 @@ module Copilot.Core.Type.Show import Copilot.Core.Type --- | Witness datatype for showing a value, used by 'showWithType'. -data ShowWit a = Show a => ShowWit +-- Are we proving equivalence with a C backend, in which case we want to show +-- Booleans as '0' and '1'. --- | Turn a type into a show witness. -showWit :: Type a -> ShowWit a -showWit t = - case t of - Bool -> ShowWit - Int8 -> ShowWit - Int16 -> ShowWit - Int32 -> ShowWit - Int64 -> ShowWit - Word8 -> ShowWit - Word16 -> ShowWit - Word32 -> ShowWit - Word64 -> ShowWit - Float -> ShowWit - Double -> ShowWit - Array t -> ShowWit - Struct t -> ShowWit +-- | Target language for showing a typed value. Used to adapt the +-- representation of booleans. +data ShowType = C | Haskell + +-- | Show a value. The representation depends on the type and the target +-- language. Booleans are represented differently depending on the backend. +showWithType :: ShowType -> Type a -> a -> String +showWithType showT t x = + case showT of + C -> case t of + Bool -> if x then "1" else "0" + _ -> sw + Haskell -> case t of + Bool -> if x then "true" else "false" + _ -> sw + where + sw = case showWit t of + ShowWit -> show x -- | Show Copilot Core type. showType :: Type a -> String @@ -52,24 +53,25 @@ showType t = Array t -> "Array " ++ showType t Struct t -> "Struct" --- Are we proving equivalence with a C backend, in which case we want to show --- Booleans as '0' and '1'. +-- * Auxiliary show instance --- | Target language for showing a typed value. Used to adapt the --- representation of booleans. -data ShowType = C | Haskell +-- | Witness datatype for showing a value, used by 'showWithType'. +data ShowWit a = Show a => ShowWit --- | Show a value. The representation depends on the type and the target --- language. Booleans are represented differently depending on the backend. -showWithType :: ShowType -> Type a -> a -> String -showWithType showT t x = - case showT of - C -> case t of - Bool -> if x then "1" else "0" - _ -> sw - Haskell -> case t of - Bool -> if x then "true" else "false" - _ -> sw - where - sw = case showWit t of - ShowWit -> show x +-- | Turn a type into a show witness. +showWit :: Type a -> ShowWit a +showWit t = + case t of + Bool -> ShowWit + Int8 -> ShowWit + Int16 -> ShowWit + Int32 -> ShowWit + Int64 -> ShowWit + Word8 -> ShowWit + Word16 -> ShowWit + Word32 -> ShowWit + Word64 -> ShowWit + Float -> ShowWit + Double -> ShowWit + Array t -> ShowWit + Struct t -> ShowWit From 49c23d3a963eb604e129361df66ac16304d00473 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 11 Jun 2022 09:02:36 -0400 Subject: [PATCH 0405/1222] Document changes in copilot-core:CHANGELOG. Refs #348. --- copilot-core/CHANGELOG | 1 + 1 file changed, 1 insertion(+) diff --git a/copilot-core/CHANGELOG b/copilot-core/CHANGELOG index 56fee1b4b..6c76daf97 100644 --- a/copilot-core/CHANGELOG +++ b/copilot-core/CHANGELOG @@ -3,6 +3,7 @@ * Remove unnecessary dependencies from Cabal package. (#324) * Deprecate Copilot.Core.External. (#322) * Remove duplicated compiler option. (#328) + * Hide type Copilot.Core.Type.Show.ShowWit. (#348) 2022-05-06 * Version bump (3.9). (#320) From bb0dc01f249c22afa54c9576af55bfb0152df3d5 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 12 Jun 2022 21:10:41 -0400 Subject: [PATCH 0406/1222] copilot-core: Introduce internal module to deprecate Show. Refs #330. The module Copilot.Core.Type.Show must be deprecated with a type re-exported from a different module. The module itself will remain in the implementation, but not be exposed to users. In order to deprecate the module without triggering a warning while compiling this library, this commit introduces a new module that implements the content of Copilot.Core.Type.Show, and can be used during the transition to compile and re-export entities without producing warnings. --- copilot-core/copilot-core.cabal | 1 + copilot-core/src/Copilot/Core/Type/Show.hs | 69 +---------------- .../src/Copilot/Core/Type/ShowInternal.hs | 77 +++++++++++++++++++ 3 files changed, 79 insertions(+), 68 deletions(-) create mode 100644 copilot-core/src/Copilot/Core/Type/ShowInternal.hs diff --git a/copilot-core/copilot-core.cabal b/copilot-core/copilot-core.cabal index 07363cff7..f58d6e7f5 100644 --- a/copilot-core/copilot-core.cabal +++ b/copilot-core/copilot-core.cabal @@ -67,6 +67,7 @@ library Copilot.Core.Error Copilot.Core.Interpret.Render + Copilot.Core.Type.ShowInternal test-suite unit-tests type: diff --git a/copilot-core/src/Copilot/Core/Type/Show.hs b/copilot-core/src/Copilot/Core/Type/Show.hs index 1be0f33f6..5fdfcf60c 100644 --- a/copilot-core/src/Copilot/Core/Type/Show.hs +++ b/copilot-core/src/Copilot/Core/Type/Show.hs @@ -1,9 +1,5 @@ -- Copyright © 2011 National Institute of Aerospace / Galois, Inc. -{-# LANGUAGE ExistentialQuantification #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE Safe #-} - -- | Show Copilot Core types and typed values. module Copilot.Core.Type.Show ( showWithType @@ -11,67 +7,4 @@ module Copilot.Core.Type.Show , showType ) where -import Copilot.Core.Type - --- Are we proving equivalence with a C backend, in which case we want to show --- Booleans as '0' and '1'. - --- | Target language for showing a typed value. Used to adapt the --- representation of booleans. -data ShowType = C | Haskell - --- | Show a value. The representation depends on the type and the target --- language. Booleans are represented differently depending on the backend. -showWithType :: ShowType -> Type a -> a -> String -showWithType showT t x = - case showT of - C -> case t of - Bool -> if x then "1" else "0" - _ -> sw - Haskell -> case t of - Bool -> if x then "true" else "false" - _ -> sw - where - sw = case showWit t of - ShowWit -> show x - --- | Show Copilot Core type. -showType :: Type a -> String -showType t = - case t of - Bool -> "Bool" - Int8 -> "Int8" - Int16 -> "Int16" - Int32 -> "Int32" - Int64 -> "Int64" - Word8 -> "Word8" - Word16 -> "Word16" - Word32 -> "Word32" - Word64 -> "Word64" - Float -> "Float" - Double -> "Double" - Array t -> "Array " ++ showType t - Struct t -> "Struct" - --- * Auxiliary show instance - --- | Witness datatype for showing a value, used by 'showWithType'. -data ShowWit a = Show a => ShowWit - --- | Turn a type into a show witness. -showWit :: Type a -> ShowWit a -showWit t = - case t of - Bool -> ShowWit - Int8 -> ShowWit - Int16 -> ShowWit - Int32 -> ShowWit - Int64 -> ShowWit - Word8 -> ShowWit - Word16 -> ShowWit - Word32 -> ShowWit - Word64 -> ShowWit - Float -> ShowWit - Double -> ShowWit - Array t -> ShowWit - Struct t -> ShowWit +import Copilot.Core.Type.ShowInternal (ShowType (..), showType, showWithType) diff --git a/copilot-core/src/Copilot/Core/Type/ShowInternal.hs b/copilot-core/src/Copilot/Core/Type/ShowInternal.hs new file mode 100644 index 000000000..a27a2fd0b --- /dev/null +++ b/copilot-core/src/Copilot/Core/Type/ShowInternal.hs @@ -0,0 +1,77 @@ +-- Copyright © 2011 National Institute of Aerospace / Galois, Inc. + +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE Safe #-} + +-- | Show Copilot Core types and typed values. +module Copilot.Core.Type.ShowInternal + ( showWithType + , ShowType(..) + , showType + ) where + +import Copilot.Core.Type + +-- Are we proving equivalence with a C backend, in which case we want to show +-- Booleans as '0' and '1'. + +-- | Target language for showing a typed value. Used to adapt the +-- representation of booleans. +data ShowType = C | Haskell + +-- | Show a value. The representation depends on the type and the target +-- language. Booleans are represented differently depending on the backend. +showWithType :: ShowType -> Type a -> a -> String +showWithType showT t x = + case showT of + C -> case t of + Bool -> if x then "1" else "0" + _ -> sw + Haskell -> case t of + Bool -> if x then "true" else "false" + _ -> sw + where + sw = case showWit t of + ShowWit -> show x + +-- | Show Copilot Core type. +showType :: Type a -> String +showType t = + case t of + Bool -> "Bool" + Int8 -> "Int8" + Int16 -> "Int16" + Int32 -> "Int32" + Int64 -> "Int64" + Word8 -> "Word8" + Word16 -> "Word16" + Word32 -> "Word32" + Word64 -> "Word64" + Float -> "Float" + Double -> "Double" + Array t -> "Array " ++ showType t + Struct t -> "Struct" + +-- * Auxiliary show instance + +-- | Witness datatype for showing a value, used by 'showWithType'. +data ShowWit a = Show a => ShowWit + +-- | Turn a type into a show witness. +showWit :: Type a -> ShowWit a +showWit t = + case t of + Bool -> ShowWit + Int8 -> ShowWit + Int16 -> ShowWit + Int32 -> ShowWit + Int64 -> ShowWit + Word8 -> ShowWit + Word16 -> ShowWit + Word32 -> ShowWit + Word64 -> ShowWit + Float -> ShowWit + Double -> ShowWit + Array t -> ShowWit + Struct t -> ShowWit From c8fad2c2350852b9631441bba2a6c3613d7dcc0f Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 12 Jun 2022 21:15:44 -0400 Subject: [PATCH 0407/1222] copilot-core: Deprecate module Copilot.Core.Type.Show. Refs #330. The module Copilot.Core.Type.Show is deprecated. The module itself will remain in the implementation, but not be exposed to users. --- copilot-core/src/Copilot/Core/Type/Show.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/copilot-core/src/Copilot/Core/Type/Show.hs b/copilot-core/src/Copilot/Core/Type/Show.hs index 5fdfcf60c..fbf23cd71 100644 --- a/copilot-core/src/Copilot/Core/Type/Show.hs +++ b/copilot-core/src/Copilot/Core/Type/Show.hs @@ -2,6 +2,7 @@ -- | Show Copilot Core types and typed values. module Copilot.Core.Type.Show + {-# DEPRECATED "This module is deprecated in Copilot 3.10." #-} ( showWithType , ShowType(..) , showType From d99e924406c915ca4df46a9c14890c66d228cb9e Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 12 Jun 2022 21:23:26 -0400 Subject: [PATCH 0408/1222] copilot-core: Adjust imports, options to avoid warnings. Refs #330. The module Copilot.Core.Type.Show has been deprecated so that it can be hidden from users. During this transition period, the module Copilot.Core.Type.ShowInternal can be used instead. This commit adjusts imports in the copilot-core package so that they use Copilot.Core.Type.ShowInternal instead of the deprecated module. Where that is not possible (i.e., in the tests), the commit uses compiler options to disable warnings temporarily. --- copilot-core/src/Copilot/Core/Interpret.hs | 2 +- copilot-core/src/Copilot/Core/Interpret/Eval.hs | 15 ++++++++------- copilot-core/src/Copilot/Core/PrettyDot.hs | 2 +- copilot-core/src/Copilot/Core/PrettyPrint.hs | 2 +- .../tests/Test/Copilot/Core/Interpret/Eval.hs | 4 ++++ copilot-core/tests/Test/Copilot/Core/Type/Show.hs | 4 ++++ 6 files changed, 19 insertions(+), 10 deletions(-) diff --git a/copilot-core/src/Copilot/Core/Interpret.hs b/copilot-core/src/Copilot/Core/Interpret.hs index 9a86efc5b..d6ccfb971 100644 --- a/copilot-core/src/Copilot/Core/Interpret.hs +++ b/copilot-core/src/Copilot/Core/Interpret.hs @@ -12,7 +12,7 @@ module Copilot.Core.Interpret import Copilot.Core import Copilot.Core.Interpret.Eval import Copilot.Core.Interpret.Render -import Copilot.Core.Type.Show (ShowType(..)) +import Copilot.Core.Type.ShowInternal (ShowType(..)) -- | Output format for the results of a Copilot spec interpretation. data Format = Table | CSV diff --git a/copilot-core/src/Copilot/Core/Interpret/Eval.hs b/copilot-core/src/Copilot/Core/Interpret/Eval.hs index f7f050766..5a2ced2af 100644 --- a/copilot-core/src/Copilot/Core/Interpret/Eval.hs +++ b/copilot-core/src/Copilot/Core/Interpret/Eval.hs @@ -14,13 +14,14 @@ module Copilot.Core.Interpret.Eval , eval ) where -import Copilot.Core (Expr (..), Field (..), Id, Name, Observer (..), - Op1 (..), Op2 (..), Op3 (..), Spec, Stream (..), - Trigger (..), Type (Struct), UExpr (..), - arrayelems, specObservers, specStreams, - specTriggers) -import Copilot.Core.Error (badUsage) -import Copilot.Core.Type.Show (ShowType, showWithType) +import Copilot.Core (Expr (..), Field (..), Id, Name, + Observer (..), Op1 (..), Op2 (..), + Op3 (..), Spec, Stream (..), + Trigger (..), Type (Struct), UExpr (..), + arrayelems, specObservers, specStreams, + specTriggers) +import Copilot.Core.Error (badUsage) +import Copilot.Core.Type.ShowInternal (ShowType (..), showWithType) import Prelude hiding (id) import qualified Prelude as P diff --git a/copilot-core/src/Copilot/Core/PrettyDot.hs b/copilot-core/src/Copilot/Core/PrettyDot.hs index cabbdd7da..af868aca4 100644 --- a/copilot-core/src/Copilot/Core/PrettyDot.hs +++ b/copilot-core/src/Copilot/Core/PrettyDot.hs @@ -11,7 +11,7 @@ module Copilot.Core.PrettyDot ) where import Copilot.Core -import Copilot.Core.Type.Show (showWithType, ShowType(..), showType) +import Copilot.Core.Type.ShowInternal (showWithType, ShowType(..), showType) import Prelude hiding (id, (<>)) import Text.PrettyPrint.HughesPJ import Data.List (intersperse) diff --git a/copilot-core/src/Copilot/Core/PrettyPrint.hs b/copilot-core/src/Copilot/Core/PrettyPrint.hs index 75827a6f5..c9e37e425 100644 --- a/copilot-core/src/Copilot/Core/PrettyPrint.hs +++ b/copilot-core/src/Copilot/Core/PrettyPrint.hs @@ -12,7 +12,7 @@ module Copilot.Core.PrettyPrint import Copilot.Core import Copilot.Core.Error (impossible) -import Copilot.Core.Type.Show (showWithType, ShowType(..), showType) +import Copilot.Core.Type.ShowInternal (showWithType, ShowType(..), showType) import Prelude hiding (id, (<>)) import Text.PrettyPrint.HughesPJ import Data.List (intersperse) diff --git a/copilot-core/tests/Test/Copilot/Core/Interpret/Eval.hs b/copilot-core/tests/Test/Copilot/Core/Interpret/Eval.hs index 2e2c24b93..9d6f250bd 100644 --- a/copilot-core/tests/Test/Copilot/Core/Interpret/Eval.hs +++ b/copilot-core/tests/Test/Copilot/Core/Interpret/Eval.hs @@ -1,4 +1,8 @@ {-# LANGUAGE ExistentialQuantification #-} +-- The following warning is disabled in this module so that the import of +-- Copilot.Core.Type.Show does not give rise to a warning. +{-# OPTIONS_GHC -fno-warn-deprecations #-} + -- | Test copilot-core:Copilot.Core.Interpret.Eval. -- -- The gist of this evaluation is in 'SemanticsP' and 'checkSemanticsP' which diff --git a/copilot-core/tests/Test/Copilot/Core/Type/Show.hs b/copilot-core/tests/Test/Copilot/Core/Type/Show.hs index b13ba293c..3bd350b05 100644 --- a/copilot-core/tests/Test/Copilot/Core/Type/Show.hs +++ b/copilot-core/tests/Test/Copilot/Core/Type/Show.hs @@ -1,3 +1,7 @@ +-- The following warning is disnabled in this module so that the import of +-- Copilot.Core.Type.Show does not give rise to a warning. +{-# OPTIONS_GHC -fno-warn-deprecations #-} + -- | Test copilot-core:Copilot.Core.Type.Show. module Test.Copilot.Core.Type.Show where From 8ca2340d6177f7e449e606cd2b7afd8620f474da Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 12 Jun 2022 21:23:05 -0400 Subject: [PATCH 0409/1222] copilot-core: Re-export ShowType from Eval module. Refs #330. The module Copilot.Core.Type.Show has been deprecated so that it can be hidden from users. This commit re-exports the type ShowType from the only module that uses that type and that will remain part of the public API. --- copilot-core/src/Copilot/Core/Interpret/Eval.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/copilot-core/src/Copilot/Core/Interpret/Eval.hs b/copilot-core/src/Copilot/Core/Interpret/Eval.hs index 5a2ced2af..7f2eb20b4 100644 --- a/copilot-core/src/Copilot/Core/Interpret/Eval.hs +++ b/copilot-core/src/Copilot/Core/Interpret/Eval.hs @@ -12,6 +12,7 @@ module Copilot.Core.Interpret.Eval , Output , ExecTrace (..) , eval + , ShowType (..) ) where import Copilot.Core (Expr (..), Field (..), Id, Name, From c61d78ab50829e0da2473a73e9adc3fd41f26631 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 12 Jun 2022 21:19:38 -0400 Subject: [PATCH 0410/1222] copilot-language: Adjust imports to new interface. Refs #330. The module Copilot.Core.Type.Show has been deprecated. The entity ShowType, which copilot-language needs, is now being re-exported from the only module that exposes a related function. This commit adjusts imports in the copilot-language package so that they use the necessary imports from their new locations. --- copilot-language/tests/Test/Copilot/Language/Reify.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/copilot-language/tests/Test/Copilot/Language/Reify.hs b/copilot-language/tests/Test/Copilot/Language/Reify.hs index 44e9100a1..aced9a1b6 100644 --- a/copilot-language/tests/Test/Copilot/Language/Reify.hs +++ b/copilot-language/tests/Test/Copilot/Language/Reify.hs @@ -36,8 +36,8 @@ import Copilot.Language.Stream (Stream) import qualified Copilot.Language.Stream as Copilot -- Internal imports: functions needed to test after reification -import Copilot.Core.Type.Show (ShowType (Haskell)) -import Copilot.Core.Interpret.Eval (ExecTrace (interpObservers), eval) +import Copilot.Core.Interpret.Eval (ExecTrace (interpObservers), + ShowType (Haskell), eval) -- Internal imports: auxiliary functions import Test.Extra (apply1, apply2, apply3) From d7d88f46c9e8d99b06961df55fb336931dcdb05d Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 12 Jun 2022 21:26:03 -0400 Subject: [PATCH 0411/1222] Document changes in copilot-core:CHANGELOG. Refs #330. --- copilot-core/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot-core/CHANGELOG b/copilot-core/CHANGELOG index 6c76daf97..1bc3126cf 100644 --- a/copilot-core/CHANGELOG +++ b/copilot-core/CHANGELOG @@ -1,9 +1,10 @@ -2022-06-11 +2022-06-12 * Fix error in test case generation; enable CLI args in tests. (#337) * Remove unnecessary dependencies from Cabal package. (#324) * Deprecate Copilot.Core.External. (#322) * Remove duplicated compiler option. (#328) * Hide type Copilot.Core.Type.Show.ShowWit. (#348) + * Deprecate Copilot.Core.Type.Show. (#330) 2022-05-06 * Version bump (3.9). (#320) From e953adc26d89777c5afae618d9ad451482475a8c Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 12 Jun 2022 21:26:29 -0400 Subject: [PATCH 0412/1222] Document changes in copilot-language:CHANGELOG. Refs #330. --- copilot-language/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot-language/CHANGELOG b/copilot-language/CHANGELOG index ec27f038d..62f3d23af 100644 --- a/copilot-language/CHANGELOG +++ b/copilot-language/CHANGELOG @@ -1,6 +1,7 @@ -2022-06-11 +2022-06-12 * Fix error in test case generation; enable CLI args in tests. (#337) * Remove duplicated compiler option. (#328) + * Adjust imports due to deprecation. (#330) 2022-05-06 * Version bump (3.9). (#320) From 360fbc1cb35bfcad7cc789cc3efe6d32c0eaeead Mon Sep 17 00:00:00 2001 From: Will Pogge Date: Mon, 13 Jun 2022 09:41:12 -0400 Subject: [PATCH 0413/1222] copilot-language: Fix typos in Copilot.Language.Interpret. Refs #331. Fix two typos in the module documentation comment of Copilot.Language.Interpret: simulated -> simulate, executed -> execute. --- copilot-language/src/Copilot/Language/Interpret.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/copilot-language/src/Copilot/Language/Interpret.hs b/copilot-language/src/Copilot/Language/Interpret.hs index bf17e5e1f..ae6d25c75 100644 --- a/copilot-language/src/Copilot/Language/Interpret.hs +++ b/copilot-language/src/Copilot/Language/Interpret.hs @@ -1,8 +1,8 @@ -- Copyright (c) 2011 National Institute of Aerospace / Galois, Inc. --- | This module implements two interpreters, which may be used to simulated or --- executed Copilot specifications on a computer to understand their behavior --- to debug possible errors. +-- | This module implements two interpreters, which may be used to simulate or +-- execute Copilot specifications on a computer to understand their behavior to +-- debug possible errors. -- -- The interpreters included vary in how the present the results to the user. -- One of them uses a format (csv) that may be more machine-readable, while the From d48f2998c061199bcb9a0f8ec5db4156f38449e6 Mon Sep 17 00:00:00 2001 From: Will Pogge Date: Mon, 13 Jun 2022 10:16:29 -0400 Subject: [PATCH 0414/1222] Document changes in copilot-language:CHANGELOG. Refs #331. --- copilot-language/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot-language/CHANGELOG b/copilot-language/CHANGELOG index 62f3d23af..dd60c4ea3 100644 --- a/copilot-language/CHANGELOG +++ b/copilot-language/CHANGELOG @@ -1,7 +1,8 @@ -2022-06-12 +2022-06-13 * Fix error in test case generation; enable CLI args in tests. (#337) * Remove duplicated compiler option. (#328) * Adjust imports due to deprecation. (#330) + * Fix typos in Copilot.Language.Interpret. (#331) 2022-05-06 * Version bump (3.9). (#320) From a69543df7cce969b21422f44957cad242a530335 Mon Sep 17 00:00:00 2001 From: Ryan Scott Date: Sat, 21 May 2022 18:35:44 -0400 Subject: [PATCH 0415/1222] copilot-c99: Pass structs by reference, not by value. Refs #305. Previously, handlers with struct arguments would always pass the structs by value. For example, you might have a handler like this: ```c void handle_ex(struct s ss) { ... } ``` This patch changes `copilot-c99`'s treatment of struct arguments so that they are also passed by reference. The example above will now look like this: ```c void handle_ex(struct s *ss) { ... } ``` Making this happen requires changing code in two key places: * In `Copilot.Compile.C99.Compile.compileh`, there is now a special case for `Struct`-typed arguments that adds a pointer to the argument type. * In `Copilot.Compile.C99.CodeGen.mkstep`, there is now some pipe-fitting code to ensure that when the handler is invoked, it is given references to structs rather than raw struct values. This is accomplished by generating temporary variables for each of the handler's arguments, assigning them as appropriate, and then passing the temporary variables as arguments to the handler. In the particular case of a struct-typed temporary variable, C's `&` operator is used to obtain a reference to the variable. For example, the `handler_ex` function above would be invoked from the `step()` function in roughly the following fashion: ```c void step() { if (handler_guard()) { struct s handler_arg_temp = handler_arg(); handler_ex(&handler_arg_temp); } } ``` Assigning the result of `handler_arg()` to a temporary variable ensures that the struct value is defensively copied before being passed to the handler. This is done to minimize the likelihood that handlers may modify the values of struct arguments locally and affect "old values" of structs that must be kept in buffers for future iterations. --- .../src/Copilot/Compile/C99/CodeGen.hs | 90 +++++++++++++++++-- .../src/Copilot/Compile/C99/Compile.hs | 10 ++- copilot-c99/src/Copilot/Compile/C99/Util.hs | 9 ++ 3 files changed, 101 insertions(+), 8 deletions(-) diff --git a/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs b/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs index 6e00c4bb8..5b6cd9d77 100644 --- a/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs +++ b/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs @@ -79,12 +79,16 @@ mkstep cSettings streams triggers exts = void = C.TypeSpec C.Void stmts = map mkexcopy exts - ++ map mktriggercheck triggers + ++ triggerStmts ++ tmpassigns ++ bufferupdates ++ indexupdates - (declns, tmpassigns, bufferupdates, indexupdates) = + declns = streamDeclns + ++ concat triggerDeclns + (streamDeclns, tmpassigns, bufferupdates, indexupdates) = unzip4 $ map mkupdateglobals streams + (triggerDeclns, triggerStmts) = + unzip $ map mktriggercheck triggers -- Write code to update global stream buffers and index. mkupdateglobals :: Stream -> (C.Decln, C.Stmt, C.Stmt, C.Stmt) @@ -129,13 +133,85 @@ mkstep cSettings streams triggers exts = _ -> C.Ident cpyname C..= C.Ident name - -- Make if-statement to check the guard, call the trigger if necessary. - mktriggercheck :: Trigger -> C.Stmt - mktriggercheck (Trigger name guard args) = C.If guard' firetrigger + -- Make if-statement to check the guard, call the handler if necessary. + -- This returns two things: + -- + -- * A list of Declns for temporary variables, one for each argument that + -- the handler function accepts. For example, if a handler function takes + -- three arguments, the list of Declns might look something like this: + -- + -- @ + -- int8_t handler_arg_temp0; + -- int16_t handler_arg_temp1; + -- struct s handler_arg_temp2; + -- @ + -- + -- * A Stmt representing the if-statement. Continuing the example above, + -- the if-statement would look something like this: + -- + -- @ + -- if (handler_guard()) { + -- handler_arg_temp0 = handler_arg0(); + -- handler_arg_temp1 = handler_arg1(); + -- handler_arg_temp2 = handler_arg2(); + -- handler(handler_arg_temp0, handler_arg_temp1, &handler_arg_temp2); + -- } + -- @ + -- + -- We create temporary variables because: + -- + -- 1. We want to pass structs by reference intead of by value. To this end, + -- we use C's & operator to obtain a reference to a temporary variable + -- of a struct type and pass that to the handler function. + -- + -- 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) = + (aTmpDeclns, ifStmt) where - guard' = C.Funcall (C.Ident $ guardname name) [] - firetrigger = [C.Expr $ C.Funcall (C.Ident name) args'] + aTmpDeclns = zipWith (\tmpVar arg -> + C.VarDecln Nothing (tempType arg) tmpVar Nothing) + aTempNames + args where + tempType (UExpr { uExprType = ty }) = + case ty of + -- If a temporary variable is being used to store an array, + -- declare the type of the temporary variable as a pointer, not + -- an array. The problem with declaring it as an array is that + -- the `arg` function will return a pointer, not an array, and + -- C doesn't make it easy to cast directly from an array to a + -- pointer. + Array ty' -> C.Ptr $ transtype ty' + _ -> transtype ty + + aTempNames = take (length args) (argTempNames name) + + ifStmt = C.If guard' firetrigger + + guard' = C.Funcall (C.Ident $ guardname name) [] + + -- 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. + firetrigger = map C.Expr argAssigns ++ + [C.Expr $ C.Funcall (C.Ident name) + (zipWith passArg aTempNames args)] + where + passArg aTempName (UExpr { uExprType = ty }) = + case ty of + -- Special case for Struct to pass reference to temporary + -- struct variable to handler. (See the comments for + -- mktriggercheck for details.) + Struct _ -> C.UnaryOp C.Ref $ C.Ident aTempName + _ -> C.Ident aTempName + + argAssigns = zipWith (\aTempName arg -> + C.AssignOp C.Assign (C.Ident aTempName) arg) + aTempNames + args' args' = take (length args) (map argcall (argnames name)) argcall name = C.Funcall (C.Ident name) [] diff --git a/copilot-c99/src/Copilot/Compile/C99/Compile.hs b/copilot-c99/src/Copilot/Compile/C99/Compile.hs index 42ac9bc6c..3614f881b 100644 --- a/copilot-c99/src/Copilot/Compile/C99/Compile.hs +++ b/copilot-c99/src/Copilot/Compile/C99/Compile.hs @@ -157,7 +157,15 @@ compileh cSettings spec = C.TransUnit declns [] where cty = C.TypeSpec C.Void params = map mkparam $ zip (argnames name) args - mkparam (name, UExpr ty _) = C.Param (transtype ty) name + mkparam (name, UExpr ty _) = C.Param (mkParamTy ty) name + + -- Special case for Struct, to pass struct arguments by reference. + -- Arrays are also passed by reference, but using C's array type + -- does that automatically. + mkParamTy ty = + case ty of + Struct _ -> C.Ptr (transtype ty) + _ -> transtype ty -- Declaration for the step function. stepdecln :: C.Decln diff --git a/copilot-c99/src/Copilot/Compile/C99/Util.hs b/copilot-c99/src/Copilot/Compile/C99/Util.hs index 92758032e..8240ddcbc 100644 --- a/copilot-c99/src/Copilot/Compile/C99/Util.hs +++ b/copilot-c99/src/Copilot/Compile/C99/Util.hs @@ -55,10 +55,19 @@ guardname name = name ++ "_guard" argname :: String -> Int -> String argname name n = name ++ "_arg" ++ show n +-- | Turn a handler function name into a name for a temporary variable for a +-- handler argument. +argTempName :: String -> Int -> String +argTempName name n = name ++ "_arg_temp" ++ show n + -- | Enumerate all argument names based on trigger name. argnames :: String -> [String] argnames base = [aname | n <- [0..], let aname = argname base n] +-- | Enumerate all temporary variable names based on handler function name. +argTempNames :: String -> [String] +argTempNames base = map (argTempName base) [0..] + -- | Define a C expression that calls a function with arguments. funcall :: C.Ident -> [C.Expr] -> C.Expr funcall name args = C.Funcall (C.Ident name) args From 4c29ea5915a7d91f6c103e891e3c99e73cf15e50 Mon Sep 17 00:00:00 2001 From: Ryan Scott Date: Sat, 4 Jun 2022 08:39:41 -0400 Subject: [PATCH 0416/1222] Document changes in copilot-c99:CHANGELOG. Refs #305. --- copilot-c99/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot-c99/CHANGELOG b/copilot-c99/CHANGELOG index 5ff7fe723..7695268c4 100644 --- a/copilot-c99/CHANGELOG +++ b/copilot-c99/CHANGELOG @@ -1,6 +1,7 @@ -2022-06-11 +2022-06-15 * Remove unnecessary dependencies from Cabal package. (#323) * Remove duplicated compiler option. (#328) + * Pass structs by reference, not value, in handlers. (#305) 2022-05-06 * Version bump (3.9). (#320) From 281994445f84eaa0e0b4c3eeb04fb5b610fb20ce Mon Sep 17 00:00:00 2001 From: Will Pogge Date: Fri, 17 Jun 2022 10:33:21 -0400 Subject: [PATCH 0417/1222] copilot: Fix typos. Refs #352. Fix spelling of Celsius in README and Heater example. --- copilot/README.md | 4 ++-- copilot/examples/Heater.hs | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/copilot/README.md b/copilot/README.md index 3c829c34b..1ec02ad16 100644 --- a/copilot/README.md +++ b/copilot/README.md @@ -83,7 +83,7 @@ of the main repository. -- This is a simple example with basic usage. It implements a simple home -- heating system: It heats when temp gets too low, and stops when it is high -- enough. It read temperature as a byte (range -50C to 100C) and translates --- this to Celcius. +-- this to Celsius. module Heater where @@ -96,7 +96,7 @@ import Prelude hiding ((>), (<), div) temp :: Stream Word8 temp = extern "temperature" Nothing --- Calculate temperature in Celcius. +-- Calculate temperature in Celsius. -- We need to cast the Word8 to a Float. Note that it is an unsafeCast, as there -- is no direct relation between Word8 and Float. ctemp :: Stream Float diff --git a/copilot/examples/Heater.hs b/copilot/examples/Heater.hs index d71143ee1..59c88f992 100644 --- a/copilot/examples/Heater.hs +++ b/copilot/examples/Heater.hs @@ -3,7 +3,7 @@ -- This is a simple example with basic usage. It implements a simple home -- heating system: It heats when temp gets too low, and stops when it is high -- enough. It read temperature as a byte (range -50C to 100C) and translates --- this to Celcius. +-- this to Celsius. module Main where @@ -16,7 +16,7 @@ import Prelude hiding ((>), (<), div) temp :: Stream Word8 temp = extern "temperature" Nothing --- Calculate temperature in Celcius. +-- Calculate temperature in Celsius. -- We need to cast the Word8 to a Float. Note that it is an unsafeCast, as there -- is no direct relation between Word8 and Float. ctemp :: Stream Float From db8e77caf8a0cf96a7e59f4720dad1bbef3c0e89 Mon Sep 17 00:00:00 2001 From: Will Pogge Date: Fri, 17 Jun 2022 10:37:44 -0400 Subject: [PATCH 0418/1222] Document changes in copilot:CHANGELOG. Refs #352. --- copilot/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot/CHANGELOG b/copilot/CHANGELOG index b0d34a8e1..8d47cc6d3 100644 --- a/copilot/CHANGELOG +++ b/copilot/CHANGELOG @@ -1,6 +1,7 @@ -2022-06-11 +2022-06-17 * Run tests in CI. (#329) * Remove duplicated compiler option. (#328) + * Fix typos in README and Heater example. (#352) 2022-05-06 * Version bump (3.9). (#320) From d3c502982d6ed015520a0ee5683e86d876570b31 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 6 May 2022 07:50:16 -0400 Subject: [PATCH 0419/1222] copilot-theorem: Bump constraint on bimap. Refs #335. Version 0.5 of bimap is once again trustworthy, which is required by copilot-theorem so that all code can be considered safe. This commit updates the version constraint on bimap in copilot-theorem to allow installation of new versions, skipping intermediate versions that would make unsafe modules break compilation of copilot-theorem. --- copilot-theorem/copilot-theorem.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot-theorem/copilot-theorem.cabal b/copilot-theorem/copilot-theorem.cabal index b1d9b4920..cfd9a4b98 100644 --- a/copilot-theorem/copilot-theorem.cabal +++ b/copilot-theorem/copilot-theorem.cabal @@ -41,7 +41,7 @@ library -fcontext-stack=100 build-depends : base >= 4.9 && < 5 - , bimap >= 0.3 && < 0.4 + , bimap (>= 0.3 && < 0.4) || (>= 0.5 && < 0.6) , bv-sized >= 1.0.2 && < 1.1 , containers >= 0.4 && < 0.7 , data-default >= 0.7 && < 0.8 From b65a4c13e1ef79ee84f41b241662846a59b46078 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 6 May 2022 20:15:19 -0400 Subject: [PATCH 0420/1222] copilot-theorem: Bump constraint on what4. Refs #335. Bump version constraint on what4 in copilot-theorem to allow installation with what4-1.3. --- copilot-theorem/copilot-theorem.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot-theorem/copilot-theorem.cabal b/copilot-theorem/copilot-theorem.cabal index cfd9a4b98..fc863f34e 100644 --- a/copilot-theorem/copilot-theorem.cabal +++ b/copilot-theorem/copilot-theorem.cabal @@ -56,7 +56,7 @@ library , random >= 1.1 && < 1.2 , transformers >= 0.5 && < 0.6 , xml >= 1.3 && < 1.4 - , what4 >= 1.1 && < 1.3 + , what4 >= 1.1 && < 1.4 , copilot-core >= 3.9 && < 3.10 From 63fc200c5886634604e43436f177c9098cb4e945 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 21 May 2022 15:02:39 -0400 Subject: [PATCH 0421/1222] copilot-theorem: Bump constraint on random. Refs #335. Bump constraint on random to allow installation with random-1.2. --- copilot-theorem/copilot-theorem.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot-theorem/copilot-theorem.cabal b/copilot-theorem/copilot-theorem.cabal index fc863f34e..03ed9162d 100644 --- a/copilot-theorem/copilot-theorem.cabal +++ b/copilot-theorem/copilot-theorem.cabal @@ -53,7 +53,7 @@ library , parameterized-utils >= 2.1.1 && < 2.2 , pretty >= 1.0 && < 1.2 , process >= 1.6 && < 1.7 - , random >= 1.1 && < 1.2 + , random >= 1.1 && < 1.3 , transformers >= 0.5 && < 0.6 , xml >= 1.3 && < 1.4 , what4 >= 1.1 && < 1.4 From 3d56bbeb76d69b87764eac4ae49e08e6cdca49b8 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 4 Jul 2022 13:58:52 +0000 Subject: [PATCH 0422/1222] copilot-theorem: Bump constraint on transformers. Refs #335. Bump constraint on transformers to allow installation with transformers-0.6. --- copilot-theorem/copilot-theorem.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot-theorem/copilot-theorem.cabal b/copilot-theorem/copilot-theorem.cabal index 03ed9162d..a625427be 100644 --- a/copilot-theorem/copilot-theorem.cabal +++ b/copilot-theorem/copilot-theorem.cabal @@ -54,7 +54,7 @@ library , pretty >= 1.0 && < 1.2 , process >= 1.6 && < 1.7 , random >= 1.1 && < 1.3 - , transformers >= 0.5 && < 0.6 + , transformers >= 0.5 && < 0.7 , xml >= 1.3 && < 1.4 , what4 >= 1.1 && < 1.4 From fb49a6cce1c34184affe49117d44e1236fd50556 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 21 May 2022 15:01:50 -0400 Subject: [PATCH 0423/1222] copilot: Bump constraint on optparse-applicative. Refs #335. Bump constraint on optparse-applicative in copilot to allow installation with optparse-applicative-0.17. --- copilot/copilot.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot/copilot.cabal b/copilot/copilot.cabal index e16952bbc..6ee8ae762 100644 --- a/copilot/copilot.cabal +++ b/copilot/copilot.cabal @@ -47,7 +47,7 @@ library -fno-warn-orphans build-depends: base >= 4.9 && < 5 - , optparse-applicative >= 0.14 && < 0.16 + , optparse-applicative >= 0.14 && < 0.18 , directory >= 1.3 && < 1.4 , filepath >= 1.4 && < 1.5 From 56f4934b7415cc93d531d82262f411b7174d2288 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 4 Jul 2022 14:06:13 +0000 Subject: [PATCH 0424/1222] Bump constraint on mtl. Refs #335. Bump constraint on mtl to allow installation with mtl-2.3. Note that some current dependencies of copilot do not allow installation with mtl-2.3, but that is up to them to solve. Copilot itself is compatible with the API published by mtl-2.3. --- copilot-c99/copilot-c99.cabal | 2 +- copilot-libraries/copilot-libraries.cabal | 2 +- copilot-theorem/copilot-theorem.cabal | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/copilot-c99/copilot-c99.cabal b/copilot-c99/copilot-c99.cabal index ebf92be64..0d90e597c 100644 --- a/copilot-c99/copilot-c99.cabal +++ b/copilot-c99/copilot-c99.cabal @@ -46,7 +46,7 @@ library build-depends : base >= 4.9 && < 5 , directory >= 1.3 && < 1.4 , filepath >= 1.4 && < 1.5 - , mtl >= 2.2 && < 2.3 + , mtl >= 2.2 && < 2.4 , pretty >= 1.1 && < 1.2 , copilot-core >= 3.9 && < 3.10 diff --git a/copilot-libraries/copilot-libraries.cabal b/copilot-libraries/copilot-libraries.cabal index 960f0110e..ad639122f 100644 --- a/copilot-libraries/copilot-libraries.cabal +++ b/copilot-libraries/copilot-libraries.cabal @@ -39,7 +39,7 @@ library build-depends: base >= 4.9 && < 5 , containers >= 0.4 && < 0.7 - , mtl >= 2.0 && < 2.3 + , mtl >= 2.0 && < 2.4 , parsec >= 2.0 && < 3.2 , copilot-language >= 3.9 && < 3.10 diff --git a/copilot-theorem/copilot-theorem.cabal b/copilot-theorem/copilot-theorem.cabal index a625427be..22d4d7cf9 100644 --- a/copilot-theorem/copilot-theorem.cabal +++ b/copilot-theorem/copilot-theorem.cabal @@ -47,7 +47,7 @@ library , data-default >= 0.7 && < 0.8 , directory >= 1.3 && < 1.4 , libBF >= 0.6.2 && < 0.7 - , mtl >= 2.0 && < 2.3 + , mtl >= 2.0 && < 2.4 , panic >= 0.4.0 && < 0.5 , parsec >= 2.0 && < 3.2 , parameterized-utils >= 2.1.1 && < 2.2 From c4d80d3f05f1766af9a89960d40ac1d1acf2438d Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 7 Jul 2022 10:23:01 +0000 Subject: [PATCH 0425/1222] Configure travis to wait longer. Refs #335. Some of the new versions of dependencies take too long to compile. For example, what4 1.3 takes more than 10 minutes to compile with GHC 9, and Travis CI cancels the build. This commit prefixes the installation command with travis_wait to indicate to Travis CI that it should wait even if not output is produced for 10 minutes. --- .travis.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.travis.yml b/.travis.yml index 2c3b33611..cbdf9c065 100644 --- a/.travis.yml +++ b/.travis.yml @@ -22,7 +22,7 @@ before_install: - git submodule update --remote script: - - cabal v2-install --lib copilot + - travis_wait 30 cabal v2-install --lib copilot # Run tests only on GHC 8.10.4 # From 2a2f94c5129a3e034772e617c6283f1a15637fc6 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 4 Jul 2022 15:01:36 +0000 Subject: [PATCH 0426/1222] Document changes in copilot-theorem:CHANGELOG. Refs #335. --- copilot-theorem/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot-theorem/CHANGELOG b/copilot-theorem/CHANGELOG index 8c177c02f..2ba20e67b 100644 --- a/copilot-theorem/CHANGELOG +++ b/copilot-theorem/CHANGELOG @@ -1,7 +1,8 @@ -2022-06-11 +2022-07-04 * Remove comment from cabal file. (#325) * Remove unnecessary dependencies from Cabal package. (#326) * Remove duplicated compiler option. (#328) + * Relax version bounds of dependencies. (#335) 2022-05-06 * Version bump (3.9). (#320) From 561b67cccd5c0c901dc345e93eaf37ee457a3eec Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 4 Jul 2022 15:02:42 +0000 Subject: [PATCH 0427/1222] Document changes in copilot:CHANGELOG. Refs #335. --- copilot/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot/CHANGELOG b/copilot/CHANGELOG index 8d47cc6d3..b876e44dc 100644 --- a/copilot/CHANGELOG +++ b/copilot/CHANGELOG @@ -1,7 +1,8 @@ -2022-06-17 +2022-07-04 * Run tests in CI. (#329) * Remove duplicated compiler option. (#328) * Fix typos in README and Heater example. (#352) + * Relax version bounds of dependencies. (#335) 2022-05-06 * Version bump (3.9). (#320) From b998cd5ddb9f905d6d4ce3523ad52fdffecfc78d Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 4 Jul 2022 15:03:23 +0000 Subject: [PATCH 0428/1222] Document changes in copilot-c99:CHANGELOG. Refs #335. --- copilot-c99/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot-c99/CHANGELOG b/copilot-c99/CHANGELOG index 7695268c4..792bc3705 100644 --- a/copilot-c99/CHANGELOG +++ b/copilot-c99/CHANGELOG @@ -1,7 +1,8 @@ -2022-06-15 +2022-07-04 * Remove unnecessary dependencies from Cabal package. (#323) * Remove duplicated compiler option. (#328) * Pass structs by reference, not value, in handlers. (#305) + * Relax version bounds of dependencies. (#335) 2022-05-06 * Version bump (3.9). (#320) From e0a2de77e0717f815245ef69fc5c606043a35559 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 4 Jul 2022 15:03:57 +0000 Subject: [PATCH 0429/1222] Document changes in copilot-libraries:CHANGELOG. Refs #335. --- copilot-libraries/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot-libraries/CHANGELOG b/copilot-libraries/CHANGELOG index 8ba051e3b..70cda8b4e 100644 --- a/copilot-libraries/CHANGELOG +++ b/copilot-libraries/CHANGELOG @@ -1,6 +1,7 @@ -2022-06-11 +2022-07-04 * Remove unnecessary dependencies from Cabal package. (#327) * Remove duplicated compiler option. (#328) + * Relax version bounds of dependencies. (#335) 2022-05-06 * Version bump (3.9). (#320) From 8113b13613b2b4678a7599bbe29882c622eaf2de Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 7 Jul 2022 14:55:46 +0000 Subject: [PATCH 0430/1222] copilot: Correct repo subdir in cabal file. Refs #333. This commit modifies the subdir of the source-repository section of the cabal file to match the new organization of the copilot repo (each package in its own subdirectory). --- copilot/copilot.cabal | 1 + 1 file changed, 1 insertion(+) diff --git a/copilot/copilot.cabal b/copilot/copilot.cabal index 6ee8ae762..1cf52e722 100644 --- a/copilot/copilot.cabal +++ b/copilot/copilot.cabal @@ -33,6 +33,7 @@ extra-source-files: source-repository head type: git location: https://github.com/Copilot-Language/copilot.git + subdir: copilot flag examples description: Enable examples From 483be6539d5b240871f0297cd50dedb310468e33 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 7 Jul 2022 14:56:30 +0000 Subject: [PATCH 0431/1222] copilot-c99: Correct repo location, subdir in cabal file. Refs #333. This commit modifies the location and the subdir of the source-repository section of the cabal file. The location is adjusted to use https, since unauthenticated git protocol is no longer supported by git and authentication requires a user and key (which not all users may have). The subdir is modified to match the new organization of the copilot repo (all packages at top level without a lib subdirectory). --- copilot-c99/copilot-c99.cabal | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/copilot-c99/copilot-c99.cabal b/copilot-c99/copilot-c99.cabal index 0d90e597c..3bf9e35fa 100644 --- a/copilot-c99/copilot-c99.cabal +++ b/copilot-c99/copilot-c99.cabal @@ -31,8 +31,8 @@ x-curation: uncurated source-repository head type: git - location: git://github.com/Copilot-Language/copilot.git - subdir: lib/copilot-c99 + location: https://github.com/Copilot-Language/copilot.git + subdir: copilot-c99 library default-language : Haskell2010 From ba5e9ef799ecdd9bdefbab121a7f1cabdc135195 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 7 Jul 2022 14:56:23 +0000 Subject: [PATCH 0432/1222] copilot-core: Correct repo subdir in cabal file. Refs #333. This commit modifies the subdir of the source-repository section of the cabal file to match the new organization of the copilot repo (all packages at top level without a lib subdirectory). --- copilot-core/copilot-core.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot-core/copilot-core.cabal b/copilot-core/copilot-core.cabal index f58d6e7f5..4d496ab4c 100644 --- a/copilot-core/copilot-core.cabal +++ b/copilot-core/copilot-core.cabal @@ -29,7 +29,7 @@ x-curation: uncurated source-repository head type: git location: https://github.com/Copilot-Language/copilot.git - subdir: lib/copilot-core + subdir: copilot-core library From 439206d62e3e415980ff5be5d1c924690b173f54 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 7 Jul 2022 14:56:14 +0000 Subject: [PATCH 0433/1222] copilot-language: Correct repo subdir in cabal file. Refs #333. This commit modifies the subdir of the source-repository section of the cabal file to match the new organization of the copilot repo (all packages at top level without a lib subdirectory). --- copilot-language/copilot-language.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot-language/copilot-language.cabal b/copilot-language/copilot-language.cabal index 0ae2d42b3..4787a1c1f 100644 --- a/copilot-language/copilot-language.cabal +++ b/copilot-language/copilot-language.cabal @@ -30,7 +30,7 @@ x-curation: uncurated source-repository head type: git location: https://github.com/Copilot-Language/copilot.git - subdir: lib/copilot-language + subdir: copilot-language library default-language: Haskell2010 From ee859f742b1b76b149f81a60914a7420aa576ac0 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 7 Jul 2022 14:56:04 +0000 Subject: [PATCH 0434/1222] copilot-libraries: Correct repo location, subdir in cabal file. Refs #333. This commit modifies the location and the subdir of the source-repository section of the cabal file. The location is adjusted to use https, since unauthenticated git protocol is no longer supported by git and authentication requires a user and key (which not all users may have). The subdir is modified to match the new organization of the copilot repo (all packages at top level without a lib subdirectory). --- copilot-libraries/copilot-libraries.cabal | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/copilot-libraries/copilot-libraries.cabal b/copilot-libraries/copilot-libraries.cabal index ad639122f..acbc1609c 100644 --- a/copilot-libraries/copilot-libraries.cabal +++ b/copilot-libraries/copilot-libraries.cabal @@ -28,8 +28,8 @@ x-curation: uncurated source-repository head type: git - location: git://github.com/Copilot-Language/copilot.git - subdir: lib/copilot-libraries + location: https://github.com/Copilot-Language/copilot.git + subdir: copilot-libraries library default-language: Haskell2010 From 64f55b46c10b395c81d34bc3afc7c1142013e69b Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 7 Jul 2022 14:55:55 +0000 Subject: [PATCH 0435/1222] copilot-theorem: Add missing repo info to cabal file. Refs #333. copilot-theorem's cabal file does not contain repo information which is inconsistent with what other packages publish. This commit updates copilot-theorem's cabal file to include a source-repository section just like all other packages in the copilot project. --- copilot-theorem/copilot-theorem.cabal | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/copilot-theorem/copilot-theorem.cabal b/copilot-theorem/copilot-theorem.cabal index 22d4d7cf9..57bab146d 100644 --- a/copilot-theorem/copilot-theorem.cabal +++ b/copilot-theorem/copilot-theorem.cabal @@ -30,6 +30,11 @@ author : Jonathan Laurent x-curation: uncurated +source-repository head + type: git + location: https://github.com/Copilot-Language/copilot.git + subdir: copilot-theorem + library default-language : Haskell2010 hs-source-dirs : src From d2db2351c64663f1f4997f43607ed66c452524c1 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 7 Jul 2022 15:04:42 +0000 Subject: [PATCH 0436/1222] Document changes in copilot:CHANGELOG. Refs #333. --- copilot/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot/CHANGELOG b/copilot/CHANGELOG index b876e44dc..47b99b54c 100644 --- a/copilot/CHANGELOG +++ b/copilot/CHANGELOG @@ -1,8 +1,9 @@ -2022-07-04 +2022-07-07 * Run tests in CI. (#329) * Remove duplicated compiler option. (#328) * Fix typos in README and Heater example. (#352) * Relax version bounds of dependencies. (#335) + * Update repo info in cabal file. (#333) 2022-05-06 * Version bump (3.9). (#320) From cdcbc18fa7a35cf4e7e6daaf28aaffb152cee148 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 7 Jul 2022 15:04:59 +0000 Subject: [PATCH 0437/1222] Document changes in copilot-c99:CHANGELOG. Refs #333. --- copilot-c99/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot-c99/CHANGELOG b/copilot-c99/CHANGELOG index 792bc3705..3383ab4ee 100644 --- a/copilot-c99/CHANGELOG +++ b/copilot-c99/CHANGELOG @@ -1,8 +1,9 @@ -2022-07-04 +2022-07-07 * Remove unnecessary dependencies from Cabal package. (#323) * Remove duplicated compiler option. (#328) * Pass structs by reference, not value, in handlers. (#305) * Relax version bounds of dependencies. (#335) + * Update repo info in cabal file. (#333) 2022-05-06 * Version bump (3.9). (#320) From d4a6bdf6271ba1f72288383cf2b974fba93b0725 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 7 Jul 2022 15:05:31 +0000 Subject: [PATCH 0438/1222] Document changes in copilot-core:CHANGELOG. Refs #333. --- copilot-core/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot-core/CHANGELOG b/copilot-core/CHANGELOG index 1bc3126cf..98d596b72 100644 --- a/copilot-core/CHANGELOG +++ b/copilot-core/CHANGELOG @@ -1,10 +1,11 @@ -2022-06-12 +2022-07-07 * Fix error in test case generation; enable CLI args in tests. (#337) * Remove unnecessary dependencies from Cabal package. (#324) * Deprecate Copilot.Core.External. (#322) * Remove duplicated compiler option. (#328) * Hide type Copilot.Core.Type.Show.ShowWit. (#348) * Deprecate Copilot.Core.Type.Show. (#330) + * Update repo info in cabal file. (#333) 2022-05-06 * Version bump (3.9). (#320) From 5e020d495aac3ab17f7c39c72354445543b4e5fd Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 7 Jul 2022 15:05:55 +0000 Subject: [PATCH 0439/1222] Document changes in copilot-language:CHANGELOG. Refs #333. --- copilot-language/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot-language/CHANGELOG b/copilot-language/CHANGELOG index dd60c4ea3..f9d496346 100644 --- a/copilot-language/CHANGELOG +++ b/copilot-language/CHANGELOG @@ -1,8 +1,9 @@ -2022-06-13 +2022-07-07 * Fix error in test case generation; enable CLI args in tests. (#337) * Remove duplicated compiler option. (#328) * Adjust imports due to deprecation. (#330) * Fix typos in Copilot.Language.Interpret. (#331) + * Update repo info in cabal file. (#333) 2022-05-06 * Version bump (3.9). (#320) From 3b4906f0bbd53916b74648eeec28a2a187818e9c Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 7 Jul 2022 15:06:12 +0000 Subject: [PATCH 0440/1222] Document changes in copilot-libraries:CHANGELOG. Refs #333. --- copilot-libraries/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot-libraries/CHANGELOG b/copilot-libraries/CHANGELOG index 70cda8b4e..e3c1802a8 100644 --- a/copilot-libraries/CHANGELOG +++ b/copilot-libraries/CHANGELOG @@ -1,7 +1,8 @@ -2022-07-04 +2022-07-07 * Remove unnecessary dependencies from Cabal package. (#327) * Remove duplicated compiler option. (#328) * Relax version bounds of dependencies. (#335) + * Update repo info in cabal file. (#333) 2022-05-06 * Version bump (3.9). (#320) From ebe7e67e9e4e6b8ac28d4aeb40d1d1cb3aa2e60d Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 7 Jul 2022 15:06:32 +0000 Subject: [PATCH 0441/1222] Document changes in copilot-theorem:CHANGELOG. Refs #333. --- copilot-theorem/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot-theorem/CHANGELOG b/copilot-theorem/CHANGELOG index 2ba20e67b..b5abd01e0 100644 --- a/copilot-theorem/CHANGELOG +++ b/copilot-theorem/CHANGELOG @@ -1,8 +1,9 @@ -2022-07-04 +2022-07-07 * Remove comment from cabal file. (#325) * Remove unnecessary dependencies from Cabal package. (#326) * Remove duplicated compiler option. (#328) * Relax version bounds of dependencies. (#335) + * Include repo info in cabal file. (#333) 2022-05-06 * Version bump (3.9). (#320) From 86358235e3d8227cfade25db481850d6875b1b69 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 7 Jul 2022 16:08:48 +0000 Subject: [PATCH 0442/1222] Bump versions and constraints (3.10). Refs #356. --- copilot-c99/copilot-c99.cabal | 4 ++-- copilot-core/copilot-core.cabal | 2 +- copilot-language/copilot-language.cabal | 6 +++--- copilot-libraries/copilot-libraries.cabal | 4 ++-- copilot-theorem/copilot-theorem.cabal | 4 ++-- copilot/copilot.cabal | 12 ++++++------ 6 files changed, 16 insertions(+), 16 deletions(-) diff --git a/copilot-c99/copilot-c99.cabal b/copilot-c99/copilot-c99.cabal index 3bf9e35fa..4d772b332 100644 --- a/copilot-c99/copilot-c99.cabal +++ b/copilot-c99/copilot-c99.cabal @@ -1,6 +1,6 @@ cabal-version : >= 1.10 name : copilot-c99 -version : 3.9 +version : 3.10 synopsis : A compiler for Copilot targeting C99. description : This package is a back-end from Copilot to C. @@ -49,7 +49,7 @@ library , mtl >= 2.2 && < 2.4 , pretty >= 1.1 && < 1.2 - , copilot-core >= 3.9 && < 3.10 + , copilot-core >= 3.10 && < 3.11 , language-c99 >= 0.1.1 && < 0.2 , language-c99-simple >= 0.1.1 && < 0.2 diff --git a/copilot-core/copilot-core.cabal b/copilot-core/copilot-core.cabal index 4d496ab4c..afe95e342 100644 --- a/copilot-core/copilot-core.cabal +++ b/copilot-core/copilot-core.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-core -version: 3.9 +version: 3.10 synopsis: An intermediate representation for Copilot. description: Intermediate representation for Copilot. diff --git a/copilot-language/copilot-language.cabal b/copilot-language/copilot-language.cabal index 4787a1c1f..18f6e7152 100644 --- a/copilot-language/copilot-language.cabal +++ b/copilot-language/copilot-language.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-language -version: 3.9 +version: 3.10 synopsis: A Haskell-embedded DSL for monitoring hard real-time distributed systems. description: @@ -42,8 +42,8 @@ library , data-reify >= 0.6 && < 0.7 , mtl >= 2.0 && < 3 - , copilot-core >= 3.9 && < 3.10 - , copilot-theorem >= 3.9 && < 3.10 + , copilot-core >= 3.10 && < 3.11 + , copilot-theorem >= 3.10 && < 3.11 exposed-modules: Copilot.Language , Copilot.Language.Operators.BitWise diff --git a/copilot-libraries/copilot-libraries.cabal b/copilot-libraries/copilot-libraries.cabal index acbc1609c..c26d2a7d3 100644 --- a/copilot-libraries/copilot-libraries.cabal +++ b/copilot-libraries/copilot-libraries.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-libraries -version: 3.9 +version: 3.10 synopsis: Libraries for the Copilot language. description: Libraries for the Copilot language. @@ -41,7 +41,7 @@ library , containers >= 0.4 && < 0.7 , mtl >= 2.0 && < 2.4 , parsec >= 2.0 && < 3.2 - , copilot-language >= 3.9 && < 3.10 + , copilot-language >= 3.10 && < 3.11 exposed-modules: Copilot.Library.Libraries diff --git a/copilot-theorem/copilot-theorem.cabal b/copilot-theorem/copilot-theorem.cabal index 57bab146d..44a78c50f 100644 --- a/copilot-theorem/copilot-theorem.cabal +++ b/copilot-theorem/copilot-theorem.cabal @@ -14,7 +14,7 @@ description: . -version : 3.9 +version : 3.10 license : BSD3 license-file : LICENSE maintainer : Ivan Perez @@ -63,7 +63,7 @@ library , xml >= 1.3 && < 1.4 , what4 >= 1.1 && < 1.4 - , copilot-core >= 3.9 && < 3.10 + , copilot-core >= 3.10 && < 3.11 exposed-modules : Copilot.Theorem , Copilot.Theorem.Prove diff --git a/copilot/copilot.cabal b/copilot/copilot.cabal index 1cf52e722..acbf95052 100644 --- a/copilot/copilot.cabal +++ b/copilot/copilot.cabal @@ -1,5 +1,5 @@ name: copilot -version: 3.9 +version: 3.10 cabal-version: >= 1.10 license: BSD3 license-file: LICENSE @@ -52,11 +52,11 @@ library , directory >= 1.3 && < 1.4 , filepath >= 1.4 && < 1.5 - , copilot-core >= 3.9 && < 3.10 - , copilot-theorem >= 3.9 && < 3.10 - , copilot-language >= 3.9 && < 3.10 - , copilot-libraries >= 3.9 && < 3.10 - , copilot-c99 >= 3.9 && < 3.10 + , copilot-core >= 3.10 && < 3.11 + , copilot-theorem >= 3.10 && < 3.11 + , copilot-language >= 3.10 && < 3.11 + , copilot-libraries >= 3.10 && < 3.11 + , copilot-c99 >= 3.10 && < 3.11 exposed-modules: Language.Copilot, Language.Copilot.Main From 93aa0b5c85b9b753c2d3a2e129f4bd3ebfee834e Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 7 Jul 2022 16:10:39 +0000 Subject: [PATCH 0443/1222] Document changes in CHANGELOG. Refs #356. --- copilot-c99/CHANGELOG | 1 + copilot-core/CHANGELOG | 1 + copilot-language/CHANGELOG | 1 + copilot-libraries/CHANGELOG | 1 + copilot-theorem/CHANGELOG | 1 + copilot/CHANGELOG | 1 + 6 files changed, 6 insertions(+) diff --git a/copilot-c99/CHANGELOG b/copilot-c99/CHANGELOG index 3383ab4ee..a5fe22c4b 100644 --- a/copilot-c99/CHANGELOG +++ b/copilot-c99/CHANGELOG @@ -1,4 +1,5 @@ 2022-07-07 + * Version bump (3.10). (#356) * Remove unnecessary dependencies from Cabal package. (#323) * Remove duplicated compiler option. (#328) * Pass structs by reference, not value, in handlers. (#305) diff --git a/copilot-core/CHANGELOG b/copilot-core/CHANGELOG index 98d596b72..c3f4cced8 100644 --- a/copilot-core/CHANGELOG +++ b/copilot-core/CHANGELOG @@ -1,4 +1,5 @@ 2022-07-07 + * Version bump (3.10). (#356) * Fix error in test case generation; enable CLI args in tests. (#337) * Remove unnecessary dependencies from Cabal package. (#324) * Deprecate Copilot.Core.External. (#322) diff --git a/copilot-language/CHANGELOG b/copilot-language/CHANGELOG index f9d496346..98190070b 100644 --- a/copilot-language/CHANGELOG +++ b/copilot-language/CHANGELOG @@ -1,4 +1,5 @@ 2022-07-07 + * Version bump (3.10). (#356) * Fix error in test case generation; enable CLI args in tests. (#337) * Remove duplicated compiler option. (#328) * Adjust imports due to deprecation. (#330) diff --git a/copilot-libraries/CHANGELOG b/copilot-libraries/CHANGELOG index e3c1802a8..5fe06a723 100644 --- a/copilot-libraries/CHANGELOG +++ b/copilot-libraries/CHANGELOG @@ -1,4 +1,5 @@ 2022-07-07 + * Version bump (3.10). (#356) * Remove unnecessary dependencies from Cabal package. (#327) * Remove duplicated compiler option. (#328) * Relax version bounds of dependencies. (#335) diff --git a/copilot-theorem/CHANGELOG b/copilot-theorem/CHANGELOG index b5abd01e0..9a4b655f4 100644 --- a/copilot-theorem/CHANGELOG +++ b/copilot-theorem/CHANGELOG @@ -1,4 +1,5 @@ 2022-07-07 + * Version bump (3.10). (#356) * Remove comment from cabal file. (#325) * Remove unnecessary dependencies from Cabal package. (#326) * Remove duplicated compiler option. (#328) diff --git a/copilot/CHANGELOG b/copilot/CHANGELOG index 47b99b54c..3642a3686 100644 --- a/copilot/CHANGELOG +++ b/copilot/CHANGELOG @@ -1,4 +1,5 @@ 2022-07-07 + * Version bump (3.10). (#356) * Run tests in CI. (#329) * Remove duplicated compiler option. (#328) * Fix typos in README and Heater example. (#352) From 9ab7a076953aaf75c009d7dba96d498acd227f9a Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 8 Aug 2022 14:05:38 +0000 Subject: [PATCH 0444/1222] copilot-language: Deprecate prettyPrint. Refs #362. The function copilot-language:Copilot.Language.prettyPrint is an aid to reify a Spec and then pretty print the resulting Copilot Core representation. No part of Copilot needs this direct access. The module dependencies that result from this change do not match those in our proposed design. Consequently, it would be best to remove this function. This commit deprecates the function prettyPrint to warn users that it will be removed in the future. --- copilot-language/src/Copilot/Language.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/copilot-language/src/Copilot/Language.hs b/copilot-language/src/Copilot/Language.hs index eff4b4d9c..677d1dccf 100644 --- a/copilot-language/src/Copilot/Language.hs +++ b/copilot-language/src/Copilot/Language.hs @@ -71,5 +71,6 @@ import Copilot.Language.Stream (Stream) -- | Transform a high-level Copilot Language specification into a low-level -- Copilot Core specification and pretty-print it to stdout. +{-# DEPRECATED prettyPrint "This function is deprecated in Copilot 3.11." #-} prettyPrint :: Spec -> IO () prettyPrint e = fmap PP.prettyPrint (reify e) >>= putStr From aa328c554d340a3e70279abf550bab634f6b28b8 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 8 Aug 2022 14:07:36 +0000 Subject: [PATCH 0445/1222] Document changes in copilot-language:CHANGELOG. Refs #362. --- copilot-language/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-language/CHANGELOG b/copilot-language/CHANGELOG index 98190070b..b795649f2 100644 --- a/copilot-language/CHANGELOG +++ b/copilot-language/CHANGELOG @@ -1,3 +1,6 @@ +2022-08-08 + * Deprecate prettyPrint. (#362) + 2022-07-07 * Version bump (3.10). (#356) * Fix error in test case generation; enable CLI args in tests. (#337) From 198a010f029114e6f78ac4b2026f4a2db883158a Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 4 Aug 2022 15:10:10 +0000 Subject: [PATCH 0446/1222] copilot-core: deprecate module Copilot.Core.PrettyDot. Refs #359. The module Copilot.Core.PrettyDot is not being used by any other part of Copilot or, as far as we know, by any user of Copilot. It is not a necessary part of the interface to use Copilot, and not required by Copilot's requirements. Although the idea is good, there is consensus that it is not needed at this point. Therefore, it would be suitable to remove this module. This commit deprecates the module so that it can be removed in a future version. --- copilot-core/src/Copilot/Core/PrettyDot.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/copilot-core/src/Copilot/Core/PrettyDot.hs b/copilot-core/src/Copilot/Core/PrettyDot.hs index af868aca4..638e861a1 100644 --- a/copilot-core/src/Copilot/Core/PrettyDot.hs +++ b/copilot-core/src/Copilot/Core/PrettyDot.hs @@ -6,6 +6,7 @@ {-# LANGUAGE Safe #-} module Copilot.Core.PrettyDot + {-# DEPRECATED "This module is deprecated in Copilot 3.11." #-} ( prettyPrintDot , prettyPrintExprDot ) where From 30e794c691ebdacfa4850b8398487ab3087e95d9 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 8 Aug 2022 22:32:13 +0000 Subject: [PATCH 0447/1222] Document changes in copilot-core:CHANGELOG. Refs #359. --- copilot-core/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-core/CHANGELOG b/copilot-core/CHANGELOG index c3f4cced8..99b0801a1 100644 --- a/copilot-core/CHANGELOG +++ b/copilot-core/CHANGELOG @@ -1,3 +1,6 @@ +2022-08-04 + * Deprecate Copilot.Core.PrettyDot. (#359) + 2022-07-07 * Version bump (3.10). (#356) * Fix error in test case generation; enable CLI args in tests. (#337) From bebdb8e3e262bfd33354e8b1ad02de4889792851 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 9 Aug 2022 10:20:54 +0000 Subject: [PATCH 0448/1222] copilot-core: Remove tests of module Copilot.Core.Type.Dynamic. Refs #360. The module Copilot.Core.Type.Dynamic is not being used by any other part of Copilot. It was deprecated in Copilot 3.8 and, per our policy for removal of outdated features, is now being removed. This commit removes all tests pertaining to that module, as they will no longer be necessary. --- copilot-core/copilot-core.cabal | 1 - copilot-core/tests/Main.hs | 2 - .../tests/Test/Copilot/Core/Type/Dynamic.hs | 48 ------------------- 3 files changed, 51 deletions(-) delete mode 100644 copilot-core/tests/Test/Copilot/Core/Type/Dynamic.hs diff --git a/copilot-core/copilot-core.cabal b/copilot-core/copilot-core.cabal index afe95e342..e7ee3b7f7 100644 --- a/copilot-core/copilot-core.cabal +++ b/copilot-core/copilot-core.cabal @@ -82,7 +82,6 @@ test-suite unit-tests Test.Copilot.Core.Interpret.Eval Test.Copilot.Core.Type Test.Copilot.Core.Type.Array - Test.Copilot.Core.Type.Dynamic Test.Copilot.Core.Type.Show build-depends: diff --git a/copilot-core/tests/Main.hs b/copilot-core/tests/Main.hs index 69136edb9..6312cdf91 100644 --- a/copilot-core/tests/Main.hs +++ b/copilot-core/tests/Main.hs @@ -9,7 +9,6 @@ import qualified Test.Copilot.Core.External import qualified Test.Copilot.Core.Interpret.Eval import qualified Test.Copilot.Core.Type import qualified Test.Copilot.Core.Type.Array -import qualified Test.Copilot.Core.Type.Dynamic import qualified Test.Copilot.Core.Type.Show -- | Run all unit tests on copilot-core. @@ -23,6 +22,5 @@ tests = , Test.Copilot.Core.Interpret.Eval.tests , Test.Copilot.Core.Type.tests , Test.Copilot.Core.Type.Array.tests - , Test.Copilot.Core.Type.Dynamic.tests , Test.Copilot.Core.Type.Show.tests ] diff --git a/copilot-core/tests/Test/Copilot/Core/Type/Dynamic.hs b/copilot-core/tests/Test/Copilot/Core/Type/Dynamic.hs deleted file mode 100644 index cbead83b6..000000000 --- a/copilot-core/tests/Test/Copilot/Core/Type/Dynamic.hs +++ /dev/null @@ -1,48 +0,0 @@ -{-# LANGUAGE GADTs #-} --- | Test copilot-core:Copilot.Core.Type.Dynamic. -module Test.Copilot.Core.Type.Dynamic where - --- External imports -import Test.Framework (Test, testGroup) -import Test.Framework.Providers.QuickCheck2 (testProperty) -import Test.QuickCheck (Arbitrary, Property, property) - --- Internal imports: library modules being tested -import Copilot.Core.Type (Type (..)) -import Copilot.Core.Type.Dynamic (fromDyn, toDyn) -import Copilot.Core.Type.Equality (Equal (Refl), EqualType ((=~=))) - --- | All unit tests for copilot-core:Copilot.Core.Type.Dynamic. -tests :: Test.Framework.Test -tests = - testGroup "Copilot.Core.Type.Dynamic" - [ testProperty "fromDyn . toDyn == identity (Int64)" - (testDynamicIdentity Int64 Int64) - , testProperty "fromDyn . toDyn == identity (Bool)" - (testDynamicIdentity Bool Bool) - , testProperty "fromDyn . toDyn == identity (Float)" - (testDynamicIdentity Float Float) - , testProperty "fromDyn . toDyn == identity (Double)" - (testDynamicIdentity Double Double) - , testProperty "fromDyn . toDyn /= identity (Int64 vs Int32)" - (testDynamicIdentity Int64 Int32) - , testProperty "fromDyn . toDyn /= identity (Int64 vs Int16)" - (testDynamicIdentity Int64 Int16) - , testProperty "fromDyn . toDyn /= identity (Bool vs Int16)" - (testDynamicIdentity Bool Int16) - , testProperty "fromDyn . toDyn /= identity (Float vs Double)" - (testDynamicIdentity Float Double) - ] - --- | Test that wrapping in and unwrapping from a dynamic gets the original --- value if the types match, and Nothing otherwise. -testDynamicIdentity :: (Eq a, Arbitrary b) - => Type a -- ^ Type to unwrap to - -> Type b -- ^ Type to wrap to - -> b -- ^ Value to wrap - -> Property -testDynamicIdentity t1 t2 ls = property $ - let unwrapped = fromDyn t1 (toDyn t2 ls) - in case t1 =~= t2 of - Nothing -> Nothing == unwrapped - Just Refl -> Just ls == unwrapped From 34a193dc9402954b6e3a90d0d5deaf6786dd12c6 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 9 Aug 2022 10:22:41 +0000 Subject: [PATCH 0449/1222] copilot-core: Remove module Copilot.Core.Type.Dynamic. Refs #360. The module Copilot.Core.Type.Dynamic is not being used by any other part of Copilot. It was deprecated in Copilot 3.8 and, per our policy for removal of outdated features, is now being removed. This commit removes the module from copilot-core. --- copilot-core/copilot-core.cabal | 1 - copilot-core/src/Copilot/Core/Type/Dynamic.hs | 45 ------------------- 2 files changed, 46 deletions(-) delete mode 100644 copilot-core/src/Copilot/Core/Type/Dynamic.hs diff --git a/copilot-core/copilot-core.cabal b/copilot-core/copilot-core.cabal index e7ee3b7f7..dc6866e88 100644 --- a/copilot-core/copilot-core.cabal +++ b/copilot-core/copilot-core.cabal @@ -57,7 +57,6 @@ library Copilot.Core.Spec Copilot.Core.Type Copilot.Core.Type.Array - Copilot.Core.Type.Dynamic Copilot.Core.Type.Equality Copilot.Core.Type.Show Copilot.Core.PrettyPrint diff --git a/copilot-core/src/Copilot/Core/Type/Dynamic.hs b/copilot-core/src/Copilot/Core/Type/Dynamic.hs deleted file mode 100644 index fe0278857..000000000 --- a/copilot-core/src/Copilot/Core/Type/Dynamic.hs +++ /dev/null @@ -1,45 +0,0 @@ --- Copyright © 2011 National Institute of Aerospace / Galois, Inc. - -{-# LANGUAGE ExistentialQuantification #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE KindSignatures #-} -{-# LANGUAGE Rank2Types #-} -{-# LANGUAGE Safe #-} -{-# LANGUAGE ScopedTypeVariables #-} - --- | An implementation of dynamic types using "Copilot.Core.Type.Equality". --- The theory behind this technique is described the following paper: --- --- * Baars, Arthur I. and Swierstra, S. Doaitse, --- \"/Typing dynamic typing/\", --- ACM SIGPLAN Notices vol. 37, p. 157-166, 2002 - -module Copilot.Core.Type.Dynamic - {-# DEPRECATED "This module is deprecated in Copilot 3.8." #-} - ( Dynamic (..) - , DynamicF (..) - , toDyn - , fromDyn - ) where - -import Copilot.Core.Type.Equality - --- | Representation of a value accompanied by its type. -data Dynamic :: (* -> *) -> * where - Dynamic :: a -> t a -> Dynamic t - --- | Representation of a function accompanied by its type. -data DynamicF :: (* -> *) -> (* -> *) -> * where - DynamicF :: f a -> t a -> DynamicF f t - --- | Enclose a value and its type in a container. -toDyn :: t a -> a -> Dynamic t -toDyn t x = Dynamic x t - --- | Extract a value from a dynamic. Return 'Nothing' if the value is not of --- the given type. -fromDyn :: EqualType t => t a -> Dynamic t -> Maybe a -fromDyn t1 (Dynamic x t2) = - case t1 =~= t2 of - Just Refl -> return x - Nothing -> Nothing From ce70ef9c829a147cf59078e483a15f25b5640bd7 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 9 Aug 2022 10:23:30 +0000 Subject: [PATCH 0450/1222] Document changes in copilot-core:CHANGELOG. Refs #360. --- copilot-core/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot-core/CHANGELOG b/copilot-core/CHANGELOG index 99b0801a1..a9df1b23a 100644 --- a/copilot-core/CHANGELOG +++ b/copilot-core/CHANGELOG @@ -1,5 +1,6 @@ -2022-08-04 +2022-08-09 * Deprecate Copilot.Core.PrettyDot. (#359) + * Remove Copilot.Core.Type.Dynamic. (#360) 2022-07-07 * Version bump (3.10). (#356) From 5b9e98820d7ac05592ef3001bf8b98ab843a7e7e Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 12 Aug 2022 12:03:32 +0000 Subject: [PATCH 0451/1222] copilot-language: Reimplement DynStableName without unsafeCoerce. Refs #262. The library copilot-language uses unsafeCoerce. This use of unsafeCoerce can be avoided by changing the definition of System.Mem.StableName.Dynamic.DynStableName and introducing an existential type (akin to how the library data-reify defines DynStableName). In our effort to move Copilot to Class D, we have dictated that uses of unsafe code (including functions specifically marked as unsafe in Haskell) should be avoided unless strictly necessary. This commit modifies DynStableName to be an existential type, which eliminates the need for unsafeCoerce. The implementation of equality now uses eqStableName. The import of unsafeCoerce is removed, and the module is marked as Safe instead of just TrustWorthy. --- .../src/System/Mem/StableName/Dynamic.hs | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/copilot-language/src/System/Mem/StableName/Dynamic.hs b/copilot-language/src/System/Mem/StableName/Dynamic.hs index 0d281d206..01771285d 100644 --- a/copilot-language/src/System/Mem/StableName/Dynamic.hs +++ b/copilot-language/src/System/Mem/StableName/Dynamic.hs @@ -1,6 +1,7 @@ -- Copyright © 2011 National Institute of Aerospace / Galois, Inc. -{-# LANGUAGE Trustworthy #-} +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE Safe #-} module System.Mem.StableName.Dynamic ( DynStableName(..) @@ -8,19 +9,19 @@ module System.Mem.StableName.Dynamic , makeDynStableName ) where -import System.Mem.StableName (StableName, makeStableName, hashStableName) -import Unsafe.Coerce (unsafeCoerce) -- XXX Not safe! +import System.Mem.StableName (StableName, eqStableName, makeStableName, + hashStableName) -newtype DynStableName = DynStableName (StableName ()) +data DynStableName = forall a . DynStableName (StableName a) makeDynStableName :: a -> IO DynStableName makeDynStableName x = do stn <- makeStableName x - return (DynStableName (unsafeCoerce stn)) + return (DynStableName stn) hashDynStableName :: DynStableName -> Int hashDynStableName (DynStableName sn) = hashStableName sn instance Eq DynStableName where - DynStableName sn1 == DynStableName sn2 = sn1 == sn2 + DynStableName sn1 == DynStableName sn2 = eqStableName sn1 sn2 From 3505027438038806af8523d20a5aef59b520d823 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 12 Aug 2022 12:06:15 +0000 Subject: [PATCH 0452/1222] Document changes in copilot-language:CHANGELOG. Refs #262. --- copilot-language/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot-language/CHANGELOG b/copilot-language/CHANGELOG index b795649f2..c0759f065 100644 --- a/copilot-language/CHANGELOG +++ b/copilot-language/CHANGELOG @@ -1,5 +1,6 @@ -2022-08-08 +2022-08-12 * Deprecate prettyPrint. (#362) + * Reimplement DynStableName without unsafeCoerce. (#262) 2022-07-07 * Version bump (3.10). (#356) From ad3095c12baf0cedc850b49e9b277fc44d6bb886 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 23 Aug 2022 00:49:46 +0000 Subject: [PATCH 0453/1222] copilot-interpreter: Add new library copilot-interpreter. Refs #361. The architecture of the implementation of Copilot mixes backends with other libraries, which makes the design not uniform. For example, the interpreter is in copilot-core, while the C99 backend is in a separate library. The implementation does not match our desired architecture according to our design documents, and it makes the code partly harder to maintain. This commit introduces a new library copilot-interpreter that provides an interpreter backend for Copilot. The imports from the Show module, which will no longer be exported in copilot-core, are replicated as needed in the copilot-interpret package. A flag disabled in a GHC pragma has been removed from the original module brought over from copilot-core, as it is no longer removed. The new library is enabled on Travis so that the tests are executed by the CI server. --- .travis.yml | 2 +- copilot-interpreter/CHANGELOG | 0 copilot-interpreter/LICENSE | 29 + copilot-interpreter/README.md | 30 + copilot-interpreter/Setup.hs | 2 + copilot-interpreter/copilot-interpreter.cabal | 87 ++ copilot-interpreter/src/Copilot/Interpret.hs | 29 + .../src/Copilot/Interpret/Error.hs | 12 + .../src/Copilot/Interpret/Eval.hs | 396 +++++++++ .../src/Copilot/Interpret/Render.hs | 122 +++ copilot-interpreter/tests/Main.hs | 18 + .../tests/Test/Copilot/Interpret/Eval.hs | 804 ++++++++++++++++++ copilot-interpreter/tests/Test/Extra.hs | 31 + 13 files changed, 1561 insertions(+), 1 deletion(-) create mode 100644 copilot-interpreter/CHANGELOG create mode 100644 copilot-interpreter/LICENSE create mode 100644 copilot-interpreter/README.md create mode 100644 copilot-interpreter/Setup.hs create mode 100644 copilot-interpreter/copilot-interpreter.cabal create mode 100644 copilot-interpreter/src/Copilot/Interpret.hs create mode 100644 copilot-interpreter/src/Copilot/Interpret/Error.hs create mode 100644 copilot-interpreter/src/Copilot/Interpret/Eval.hs create mode 100644 copilot-interpreter/src/Copilot/Interpret/Render.hs create mode 100644 copilot-interpreter/tests/Main.hs create mode 100644 copilot-interpreter/tests/Test/Copilot/Interpret/Eval.hs create mode 100644 copilot-interpreter/tests/Test/Extra.hs diff --git a/.travis.yml b/.travis.yml index cbdf9c065..22b0431cc 100644 --- a/.travis.yml +++ b/.travis.yml @@ -27,4 +27,4 @@ script: # Run tests only on GHC 8.10.4 # # Only libraries with tests are listed below or the v2-test command fails. - - if [ "${GHCVER}" == "8.10.4" ]; then cabal v2-test -j1 copilot-core copilot-language; fi + - if [ "${GHCVER}" == "8.10.4" ]; then cabal v2-test -j1 copilot-core copilot-language copilot-interpreter; fi diff --git a/copilot-interpreter/CHANGELOG b/copilot-interpreter/CHANGELOG new file mode 100644 index 000000000..e69de29bb diff --git a/copilot-interpreter/LICENSE b/copilot-interpreter/LICENSE new file mode 100644 index 000000000..d4ed5bc4c --- /dev/null +++ b/copilot-interpreter/LICENSE @@ -0,0 +1,29 @@ +2009 +BSD3 License terms + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions +are met: + +Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. + +Redistributions in binary form must reproduce the above copyright +notice, this list of conditions and the following disclaimer in the +documentation and/or other materials provided with the distribution. + +Neither the name of the developers nor the names of its contributors +may be used to endorse or promote products derived from this software +without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR +CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, +EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, +PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR +PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF +LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING +NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/copilot-interpreter/README.md b/copilot-interpreter/README.md new file mode 100644 index 000000000..90bc428f5 --- /dev/null +++ b/copilot-interpreter/README.md @@ -0,0 +1,30 @@ +[![Build Status](https://travis-ci.com/Copilot-Language/copilot.svg?branch=master)](https://app.travis-ci.com/github/Copilot-Language/copilot) + +# Copilot: a stream DSL +The interpreter, which evaluates Copilot specifications and prints +their results over time. + +Copilot is a runtime verification framework written in Haskell. It allows the +user to write programs in a simple but powerful way using a stream-based +approach. + +Programs can be interpreted for testing (with the library copilot-interpreter), +or translated C99 code to be incorporated in a project, or as a standalone +application. The C99 backend ensures us that the output is constant in memory +and time, making it suitable for systems with hard realtime requirements. + +## Installation +Copilot-interpreter can be found on +[Hackage](https://hackage.haskell.org/package/copilot-interpreter). It is typically +only installed as part of the complete Copilot distribution. For installation +instructions, please refer to the [Copilot +website](https://copilot-language.github.io). + +## Further information +For further information, install instructions and documentation, please visit +the Copilot website: +[https://copilot-language.github.io](https://copilot-language.github.io) + +## License +Copilot is distributed under the BSD-3-Clause license, which can be found +[here](https://raw.githubusercontent.com/Copilot-Language/copilot/master/copilot-interpreter/LICENSE). diff --git a/copilot-interpreter/Setup.hs b/copilot-interpreter/Setup.hs new file mode 100644 index 000000000..9a994af67 --- /dev/null +++ b/copilot-interpreter/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/copilot-interpreter/copilot-interpreter.cabal b/copilot-interpreter/copilot-interpreter.cabal new file mode 100644 index 000000000..b71788d59 --- /dev/null +++ b/copilot-interpreter/copilot-interpreter.cabal @@ -0,0 +1,87 @@ +cabal-version: >=1.10 +name: copilot-interpreter +version: 3.10 +synopsis: Interpreter for Copilot. +description: + Interpreter for Copilot. + . + Copilot is a stream (i.e., infinite lists) domain-specific language (DSL) in + Haskell that compiles into embedded C. Copilot contains an interpreter, + multiple back-end compilers, and other verification tools. + . + A tutorial, examples, and other information are available at + . + +author: Frank Dedden, Lee Pike, Robin Morisset, Alwyn Goodloe, + Sebastian Niller, Nis Nordbyop Wegmann, Ivan Perez +license: BSD3 +license-file: LICENSE +maintainer: Ivan Perez +homepage: https://copilot-language.github.io +bug-reports: https://github.com/Copilot-Language/copilot/issues +stability: Experimental +category: Language, Embedded +build-type: Simple +extra-source-files: README.md, CHANGELOG + +x-curation: uncurated + +source-repository head + type: git + location: https://github.com/Copilot-Language/copilot.git + subdir: copilot-interpreter + +library + + default-language: Haskell2010 + + hs-source-dirs: src + + ghc-options: + -Wall + + build-depends: + base >= 4.9 && < 5, + pretty >= 1.0 && < 1.2, + + copilot-core + + exposed-modules: + + Copilot.Interpret + Copilot.Interpret.Eval + + other-modules: + + Copilot.Interpret.Error + Copilot.Interpret.Render + +test-suite unit-tests + type: + exitcode-stdio-1.0 + + main-is: + Main.hs + + other-modules: + Test.Extra + Test.Copilot.Interpret.Eval + + build-depends: + base + , QuickCheck + , pretty + , test-framework + , test-framework-quickcheck2 + + , copilot-core + , copilot-interpreter + + hs-source-dirs: + tests + + default-language: + Haskell2010 + + ghc-options: + -Wall diff --git a/copilot-interpreter/src/Copilot/Interpret.hs b/copilot-interpreter/src/Copilot/Interpret.hs new file mode 100644 index 000000000..7afaf1f6f --- /dev/null +++ b/copilot-interpreter/src/Copilot/Interpret.hs @@ -0,0 +1,29 @@ +-- Copyright © 2011 National Institute of Aerospace / Galois, Inc. + +-- | An interpreter for Copilot specifications. + +{-# LANGUAGE Safe #-} + +module Copilot.Interpret + ( Format (..) + , interpret + ) where + +import Copilot.Core +import Copilot.Interpret.Eval +import Copilot.Interpret.Render + +-- | Output format for the results of a Copilot spec interpretation. +data Format = Table | CSV + +-- | Interpret a Copilot specification. +interpret :: Format -- ^ Format to be used for the output. + -> Int -- ^ Number of steps to interpret. + -> Spec -- ^ Specification to interpret. + -> String +interpret format k spec = + case format of + Table -> renderAsTable e + CSV -> renderAsCSV e + where + e = eval Haskell k spec diff --git a/copilot-interpreter/src/Copilot/Interpret/Error.hs b/copilot-interpreter/src/Copilot/Interpret/Error.hs new file mode 100644 index 000000000..563162575 --- /dev/null +++ b/copilot-interpreter/src/Copilot/Interpret/Error.hs @@ -0,0 +1,12 @@ +-- Copyright © 2011 National Institute of Aerospace / Galois, Inc. + +{-# LANGUAGE Safe #-} + +-- | Custom functions to report error messages to users. +module Copilot.Interpret.Error + ( badUsage ) where + +-- | Report an error due to an error detected by Copilot (e.g., user error). +badUsage :: String -- ^ Description of the error. + -> a +badUsage msg = error $ "Copilot error: " ++ msg diff --git a/copilot-interpreter/src/Copilot/Interpret/Eval.hs b/copilot-interpreter/src/Copilot/Interpret/Eval.hs new file mode 100644 index 000000000..19d7e61d4 --- /dev/null +++ b/copilot-interpreter/src/Copilot/Interpret/Eval.hs @@ -0,0 +1,396 @@ +-- Copyright © 2011 National Institute of Aerospace / Galois, Inc. + +-- | A tagless interpreter for Copilot specifications. + +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE Safe #-} + +module Copilot.Interpret.Eval + ( Env + , Output + , ExecTrace (..) + , eval + , ShowType (..) + ) where + +import Copilot.Core (Expr (..), Field (..), Id, Name, Observer (..), + Op1 (..), Op2 (..), Op3 (..), Spec, Stream (..), + Trigger (..), Type (..), UExpr (..), arrayelems, + specObservers, specStreams, specTriggers) +import Copilot.Interpret.Error (badUsage) + +import Prelude hiding (id) +import qualified Prelude as P + +import Control.Exception (Exception, throw) +import Data.Bits (complement, shiftL, shiftR, xor, (.&.), (.|.)) +import Data.Dynamic (Dynamic, fromDynamic, toDyn) +import Data.List (transpose) +import Data.Maybe (fromJust) +import Data.Typeable (Typeable) + +-- | Exceptions that may be thrown during interpretation of a Copilot +-- specification. +data InterpException + = ArrayWrongSize Name Int -- ^ Extern array has incorrect size. + | ArrayIdxOutofBounds Name Int Int -- ^ Index out-of-bounds exception. + | DivideByZero -- ^ Division by zero. + | NotEnoughValues Name Int -- ^ For one or more streams, not enough + -- values are available to simulate the + -- number of steps requested. + | NoExtsInterp Name -- ^ One of the externs used by the + -- specification does not declare + -- sample values to be used during + -- simulation. + deriving Typeable + +-- | Show a descriptive message of the exception. +instance Show InterpException where + --------------------------------------- + show (ArrayWrongSize name expectedSize) = + badUsage $ "in the environment for external array " ++ name + ++ ", we expect a list of length " ++ show expectedSize + ++ ", but the length of the array you supplied is of a different length." + --------------------------------------- + show (ArrayIdxOutofBounds name index size) = + badUsage $ "in the environment for external array " ++ name + ++ ", you gave an index of " ++ show index + ++ " where the size of the array is " ++ show size ++ "; the size must " + ++ " be strictly greater than the index." + --------------------------------------- + show DivideByZero = + badUsage "divide by zero." + --------------------------------------- + show (NotEnoughValues name k) = + badUsage $ "on the " ++ show k ++ "th iteration, we ran out of " + ++ "values for simulating the external element " ++ name ++ "." + --------------------------------------- + show (NoExtsInterp name) = + badUsage $ "in a call of external symbol " ++ name ++ ", you did not " + ++ "provide an expression for interpretation. In your external " + ++ "declaration, you need to provide a 'Just strm', where 'strm' is " + ++ "some stream with which to simulate the function." + --------------------------------------- + +-- | Allow throwing and catching 'InterpException' using Haskell's standard +-- exception mechanisms. +instance Exception InterpException + +-- | An environment that contains an association between (stream or extern) +-- names and their values. +type Env nm = [(nm, Dynamic)] + +-- | The simulation output is defined as a string. Different backends may +-- choose to format their results differently. +type Output = String + +-- | An execution trace, containing the traces associated to each individual +-- monitor trigger and observer. +data ExecTrace = ExecTrace + { interpTriggers :: [(String, [Maybe [Output]])] + + -- ^ Map from trigger names to their optional output, which is a list of + -- strings representing their values. The output may be 'Nothing' if the + -- guard for the trigger was false. The order is important, since we + -- compare the arg lists between the interpreter and backends. + + , interpObservers :: [(String, [Output])] + -- ^ Map from observer names to their outputs. + } + deriving Show + +-- We could write this in a beautiful lazy style like above, but that creates a +-- space leak in the interpreter that is hard to fix while maintaining laziness. +-- We take a more brute-force appraoch below. + +-- | Evaluate a specification for a number of steps. +eval :: ShowType -- ^ Show booleans as @0@\/@1@ (C) or @True@\/@False@ + -- (Haskell). + -> Int -- ^ Number of steps to evaluate. + -> Spec -- ^ Specification to evaluate. + -> ExecTrace +eval showType k spec = + + let initStrms = map initStrm (specStreams spec) in + + let strms = evalStreams k (specStreams spec) initStrms in + + let trigs = map (evalTrigger showType k strms) + (specTriggers spec) in + + let obsvs = map (evalObserver showType k strms) + (specObservers spec) in + + strms `seq` ExecTrace + { interpTriggers = + zip (map triggerName (specTriggers spec)) trigs + , interpObservers = + zip (map observerName (specObservers spec)) obsvs + } + +-- | An environment that contains an association between (stream or extern) +-- names and their values. +type LocalEnv = [(Name, Dynamic)] + +-- | Evaluate an expression for a number of steps, obtaining the value +-- of the sample at that time. +evalExpr_ :: Typeable a => Int -> Expr a -> LocalEnv -> Env Id -> a +evalExpr_ k e0 locs strms = case e0 of + Const _ x -> x + Drop t i id -> + let Just buff = lookup id strms >>= fromDynamic in + reverse buff !! (fromIntegral i + k) + Local t1 _ name e1 e2 -> + let x = evalExpr_ k e1 locs strms in + let locs' = (name, toDyn x) : locs in + x `seq` locs' `seq` evalExpr_ k e2 locs' strms + Var t name -> fromJust $ lookup name locs >>= fromDynamic + ExternVar _ name xs -> evalExternVar k name xs + Op1 op e1 -> + let ev1 = evalExpr_ k e1 locs strms in + let op1 = evalOp1 op in + ev1 `seq` op1 `seq` op1 ev1 + Op2 op e1 e2 -> + let ev1 = evalExpr_ k e1 locs strms in + let ev2 = evalExpr_ k e2 locs strms in + let op2 = evalOp2 op in + ev1 `seq` ev2 `seq` op2 `seq` op2 ev1 ev2 + Op3 op e1 e2 e3 -> + let ev1 = evalExpr_ k e1 locs strms in + let ev2 = evalExpr_ k e2 locs strms in + let ev3 = evalExpr_ k e3 locs strms in + let op3 = evalOp3 op in + ev1 `seq` ev2 `seq` ev3 `seq` op3 `seq` op3 ev1 ev2 ev3 + Label _ _ e1 -> + let ev1 = evalExpr_ k e1 locs strms in + ev1 + +-- | Evaluate an extern stream for a number of steps, obtaining the value of +-- the sample at that time. +evalExternVar :: Int -> Name -> Maybe [a] -> a +evalExternVar k name exts = + case exts of + Nothing -> throw (NoExtsInterp name) + Just xs -> + case safeIndex k xs of + Nothing -> throw (NotEnoughValues name k) + Just x -> x + +-- | Evaluate an 'Copilot.Core.Operators.Op1' by producing an equivalent +-- Haskell function operating on the same types as the +-- 'Copilot.Core.Operators.Op1'. +evalOp1 :: Op1 a b -> (a -> b) +evalOp1 op = case op of + Not -> P.not + Abs _ -> P.abs + Sign _ -> P.signum + Recip _ -> P.recip + Exp _ -> P.exp + Sqrt _ -> P.sqrt + Log _ -> P.log + Sin _ -> P.sin + Tan _ -> P.tan + Cos _ -> P.cos + Asin _ -> P.asin + Atan _ -> P.atan + Acos _ -> P.acos + Sinh _ -> P.sinh + Tanh _ -> P.tanh + Cosh _ -> P.cosh + Asinh _ -> P.asinh + Atanh _ -> P.atanh + Acosh _ -> P.acosh + Ceiling _ -> P.fromIntegral . idI . P.ceiling + Floor _ -> P.fromIntegral . idI . P.floor + BwNot _ -> complement + Cast _ _ -> P.fromIntegral + GetField (Struct _) _ f -> unfield . f + where + -- Used to help GHC pick a return type for ceiling/floor + idI :: Integer -> Integer + idI = P.id + + -- Extract value from field + unfield (Field v) = v + +-- | Evaluate an 'Copilot.Core.Operators.Op2' by producing an equivalent +-- Haskell function operating on the same types as the +-- 'Copilot.Core.Operators.Op2'. +evalOp2 :: Op2 a b c -> (a -> b -> c) +evalOp2 op = case op of + And -> (&&) + Or -> (||) + Add _ -> (+) + Sub _ -> (-) + Mul _ -> (*) + Mod _ -> (catchZero P.mod) + Div _ -> (catchZero P.quot) + Fdiv _ -> (P./) + Pow _ -> (P.**) + Logb _ -> P.logBase + Atan2 _ -> P.atan2 + Eq _ -> (==) + Ne _ -> (/=) + Le _ -> (<=) + Ge _ -> (>=) + Lt _ -> (<) + Gt _ -> (>) + BwAnd _ -> (.&.) + BwOr _ -> (.|.) + BwXor _ -> (xor) + BwShiftL _ _ -> ( \ !a !b -> shiftL a $! fromIntegral b ) + BwShiftR _ _ -> ( \ !a !b -> shiftR a $! fromIntegral b ) + Index _ -> \xs n -> (arrayelems xs) !! (fromIntegral n) + +-- | Apply a function to two numbers, so long as the second one is +-- not zero. +-- +-- Used to detect attempts at dividing by zero and produce the appropriate +-- 'InterpException'. +catchZero :: Integral a => (a -> a -> a) -> (a -> a -> a) +catchZero _ _ 0 = throw DivideByZero +catchZero f x y = f x y + +-- | Evaluate an 'Copilot.Core.Operators.Op3' by producing an equivalent +-- Haskell function operating on the same types as the +-- 'Copilot.Core.Operators.Op3'. +evalOp3 :: Op3 a b c d -> (a -> b -> c -> d) +evalOp3 (Mux _) = \ !v !x !y -> if v then x else y + +-- | Turn a stream into a key-value pair that can be added to an 'Env' for +-- simulation. +initStrm :: Stream -> (Id, Dynamic) +initStrm Stream { streamId = id + , streamBuffer = buffer + , streamExprType = t } = + (id, toDyn (reverse buffer)) + +-- | Evaluate several streams for a number of steps, producing the environment +-- at the end of the evaluation. +evalStreams :: Int -> [Stream] -> Env Id -> Env Id +evalStreams top specStrms initStrms = + -- XXX actually only need to compute until shortest stream is of length k + -- XXX this should just be a foldl' over [0,1..k] + evalStreams_ 0 initStrms + where + evalStreams_ :: Int -> Env Id -> Env Id + evalStreams_ k strms | k == top = strms + evalStreams_ k strms | otherwise = + evalStreams_ (k+1) $! strms_ + where + strms_ = map evalStream specStrms + evalStream Stream { streamId = id + , streamExpr = e + , streamExprType = t } = + let xs = fromJust $ lookup id strms >>= fromDynamic in + let x = evalExpr_ k e [] strms in + let ls = x `seq` (x:xs) in + (id, toDyn ls) + +-- | Evaluate a trigger for a number of steps. +evalTrigger :: ShowType -- ^ Show booleans as @0@/@1@ (C) or + -- @True@/@False@ (Haskell). + -> Int -- ^ Number of steps to evaluate. + -> Env Id -- ^ Environment to use with known + -- stream-value associations. + -> Trigger -- ^ Trigger to evaluate. + -> [Maybe [Output]] +evalTrigger showType k strms + Trigger + { triggerGuard = e + , triggerArgs = args + } = map tag (zip bs vs) + + where + tag :: (Bool, a) -> Maybe a + tag (True, x) = Just x + tag (False, _) = Nothing + + -- Is the guard true? + bs :: [Bool] + bs = evalExprs_ k e strms + + -- The argument outputs. + vs :: [[Output]] + vs = if null args then replicate k [] -- might be 0 args. + else transpose $ map evalUExpr args + + evalUExpr :: UExpr -> [Output] + evalUExpr (UExpr t e1) = + map (showWithType showType t) (evalExprs_ k e1 strms) + +-- | Evaluate an observer for a number of steps. +evalObserver :: ShowType -- ^ Show booleans as @0@/@1@ (C) or @True@/@False@ + -- (Haskell). + -> Int -- ^ Number of steps to evaluate. + -> Env Id -- ^ Environment to use with known stream-value + -- associations. + -> Observer -- ^ Observer to evaluate. + -> [Output] +evalObserver showType k strms + Observer + { observerExpr = e + , observerExprType = t } + = map (showWithType showType t) (evalExprs_ k e strms) + +-- | Evaluate an expression for a number of steps, producing a list with the +-- changing value of the expression until that time. +evalExprs_ :: Typeable a => Int -> Expr a -> Env Id -> [a] +evalExprs_ k e strms = + map (\i -> evalExpr_ i e [] strms) [0..(k-1)] + +-- | Safe indexing (!!) on possibly infininite lists. +safeIndex :: Int -> [a] -> Maybe a +safeIndex i ls = + let ls' = take (i+1) ls in + if length ls' > i then Just (ls' !! i) + else Nothing + +-- * Auxiliary + +-- Are we proving equivalence with a C backend, in which case we want to show +-- Booleans as '0' and '1'. + +-- | Target language for showing a typed value. Used to adapt the +-- representation of booleans. +data ShowType = C | Haskell + +-- | Show a value. The representation depends on the type and the target +-- language. Booleans are represented differently depending on the backend. +showWithType :: ShowType -> Type a -> a -> String +showWithType showT t x = + case showT of + C -> case t of + Bool -> if x then "1" else "0" + _ -> sw + Haskell -> case t of + Bool -> if x then "true" else "false" + _ -> sw + where + sw = case showWit t of + ShowWit -> show x + +-- * Auxiliary show instance + +-- | Witness datatype for showing a value, used by 'showWithType'. +data ShowWit a = Show a => ShowWit + +-- | Turn a type into a show witness. +showWit :: Type a -> ShowWit a +showWit t = + case t of + Bool -> ShowWit + Int8 -> ShowWit + Int16 -> ShowWit + Int32 -> ShowWit + Int64 -> ShowWit + Word8 -> ShowWit + Word16 -> ShowWit + Word32 -> ShowWit + Word64 -> ShowWit + Float -> ShowWit + Double -> ShowWit + Array t -> ShowWit + Struct t -> ShowWit diff --git a/copilot-interpreter/src/Copilot/Interpret/Render.hs b/copilot-interpreter/src/Copilot/Interpret/Render.hs new file mode 100644 index 000000000..3b6241a8c --- /dev/null +++ b/copilot-interpreter/src/Copilot/Interpret/Render.hs @@ -0,0 +1,122 @@ +-- Copyright © 2011 National Institute of Aerospace / Galois, Inc. + +-- | Pretty-print the results of a simulation. + +{-# LANGUAGE Safe #-} + +module Copilot.Interpret.Render + ( renderAsTable + , renderAsCSV + ) where + +import Data.List (intersperse, transpose, foldl') +import Data.Maybe (catMaybes) +import Copilot.Interpret.Eval (Output, ExecTrace (..)) +import Text.PrettyPrint + +import Prelude hiding ((<>)) + +-- | Render an execution trace as a table, formatted to faciliate readability. +renderAsTable :: ExecTrace -> String +renderAsTable + ExecTrace + { interpTriggers = trigs + , interpObservers = obsvs } = ( render + . asColumns + . transpose + . (:) (ppTriggerNames ++ ppObserverNames) + . transpose + ) (ppTriggerOutputs ++ ppObserverOutputs) + where + + ppTriggerNames :: [Doc] + ppTriggerNames = map (text . (++ ":")) (map fst trigs) + + ppObserverNames :: [Doc] + ppObserverNames = map (text . (++ ":")) (map fst obsvs) + + ppTriggerOutputs :: [[Doc]] + ppTriggerOutputs = map (map ppTriggerOutput) (map snd trigs) + + ppTriggerOutput :: Maybe [Output] -> Doc + ppTriggerOutput (Just vs) = text $ "(" ++ concat (intersperse "," vs) ++ ")" + ppTriggerOutput Nothing = text "--" + + ppObserverOutputs :: [[Doc]] + ppObserverOutputs = map (map text) (map snd obsvs) + +-- | Render an execution trace as using comma-separate value (CSV) format. +renderAsCSV :: ExecTrace -> String +renderAsCSV = render . unfold + +-- | Pretty print all the steps of the execution trace and concatenate the +-- results. +unfold :: ExecTrace -> Doc +unfold r = + case step r of + (cs, Nothing) -> cs + (cs, Just r') -> cs $$ unfold r' + +-- | Pretty print the state of the triggers, and provide a continuation +-- for the execution trace at the next point in time. +step :: ExecTrace -> (Doc, Maybe ExecTrace) +step ExecTrace + { interpTriggers = trigs + } = + if null trigs then (empty, Nothing) + else (foldl' ($$) empty (text "#" : ppTriggerOutputs), tails) + + where + + ppTriggerOutputs :: [Doc] + ppTriggerOutputs = + catMaybes + . fmap ppTriggerOutput + . map (fmap head) + $ trigs + + ppTriggerOutput :: (String, Maybe [Output]) -> Maybe Doc + ppTriggerOutput (_, Nothing) = Nothing + ppTriggerOutput (cs, Just xs) = Just $ + text cs <> text "," <> + (foldr (<>) empty . map text . intersperse ",") xs + + tails :: Maybe ExecTrace + tails = + if any null (fmap (tail.snd) trigs) + then Nothing + else Just + ExecTrace + { interpTriggers = map (fmap tail) trigs + , interpObservers = [] + } + +-- Copied from pretty-ncols because of incompatibility with newer GHC versions. +asColumns :: [[Doc]] -> Doc +asColumns = flip asColumnsWithBuff $ 1 + +asColumnsWithBuff :: [[Doc]] -> Int -> Doc +asColumnsWithBuff lls q = normalize + where + normalize = vcat $ map hsep + $ map (\x -> pad (length x) longColumnLen empty x) + $ pad' longEntryLen q + $ transpose lls -- normalize column height + longColumnLen = maximum (map length lls) + longEntryLen = maximum $ map docLen (concat lls) + +docLen d = length $ render d + +-- | Pad a string on the right to reach an expected length. +pad :: Int -> Int -> a -> [a] -> [a] +pad lx max b ls = ls ++ replicate (max - lx) b + +-- | Pad a list of strings on the right with spaces. +pad' :: Int -- ^ Mininum number of spaces to add + -> Int -- ^ Maximum number of spaces to add + -> [[Doc]] -- ^ List of documents to pad + -> [[Doc]] +pad' _ _ [] = [] +pad' mx q (ls:xs) = map buf ls : pad' mx q xs + where + buf x = x <> (hcat $ replicate q space) <> (hcat $ replicate (mx - (docLen x)) space) diff --git a/copilot-interpreter/tests/Main.hs b/copilot-interpreter/tests/Main.hs new file mode 100644 index 000000000..608b41060 --- /dev/null +++ b/copilot-interpreter/tests/Main.hs @@ -0,0 +1,18 @@ +-- | Test copilot-core. +module Main where + +-- External imports +import Test.Framework (Test, defaultMain) + +-- Internal library modules being tested +import qualified Test.Copilot.Interpret.Eval + +-- | Run all unit tests on copilot-core. +main :: IO () +main = defaultMain tests + +-- | All unit tests in copilot-core. +tests :: [Test.Framework.Test] +tests = + [ Test.Copilot.Interpret.Eval.tests + ] diff --git a/copilot-interpreter/tests/Test/Copilot/Interpret/Eval.hs b/copilot-interpreter/tests/Test/Copilot/Interpret/Eval.hs new file mode 100644 index 000000000..608d0358a --- /dev/null +++ b/copilot-interpreter/tests/Test/Copilot/Interpret/Eval.hs @@ -0,0 +1,804 @@ +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE GADTs #-} +-- | Test copilot-core:Copilot.Core.Interpret.Eval. +-- +-- The gist of this evaluation is in 'SemanticsP' and 'checkSemanticsP' which +-- evaluates an expression using Copilot's evaluator and compares it against +-- its expected meaning. +module Test.Copilot.Interpret.Eval where + +-- External imports +import Data.Bits (Bits, complement, shiftL, shiftR, + xor, (.&.), (.|.)) +import Data.Int (Int16, Int32, Int64, Int8) +import Data.List (lookup) +import Data.Maybe (fromMaybe) +import Data.Typeable (Typeable) +import Data.Word (Word16, Word32, Word64, Word8) +import Test.Framework (Test, testGroup) +import Test.Framework.Providers.QuickCheck2 (testProperty) +import Test.QuickCheck (Arbitrary, Gen, Property, + arbitrary, chooseInt, elements, + forAll, forAllShow, frequency, + getPositive, oneof, suchThat, + vectorOf) +import Text.PrettyPrint.HughesPJ (render) + +-- Internal imports: library modules being tested +import Copilot.Core.Expr (Expr (Const, Drop, Op1, Op2, Op3), + UExpr (UExpr)) +import Copilot.Core.Operators (Op1 (..), Op2 (..), Op3 (..)) +import Copilot.Core.PrettyPrint (ppExpr) +import Copilot.Core.Spec (Observer (..), Spec (..), Stream (Stream)) +import Copilot.Core.Type (Type (..), Typed (typeOf)) +import Copilot.Interpret.Eval (ExecTrace (interpObservers), + ShowType (Haskell), eval) + +-- Internal imports: auxiliary functions +import Test.Extra (apply1, apply2, apply3) + +-- * Constants + +-- | Max length of the traces being tested. +maxTraceLength :: Int +maxTraceLength = 200 + +-- | All unit tests for copilot-core:Copilot.Core.Interpret.Eval. +tests :: Test.Framework.Test +tests = + testGroup "Copilot.Core.Interpret.Eval" + [ testProperty "eval Expr" testEvalExpr + , testProperty "eval Expr with Drop" testEvalExprWithDrop + ] + +-- * Individual tests + +-- | Test for expression evaluation. +testEvalExpr :: Property +testEvalExpr = + forAll (chooseInt (0, maxTraceLength)) $ \steps -> + forAllShow arbitrarySemanticsP (semanticsShowK steps) $ \pair -> + checkSemanticsP steps [] pair + +-- | Test for expression evaluation with a drop. +testEvalExprWithDrop :: Property +testEvalExprWithDrop = + forAll (chooseInt (0, maxTraceLength)) $ \steps -> + forAllShow arbitrarySemanticsP (semanticsShowK steps) $ \pair -> + forAllShow (arbitraryDrop pair) (semanticsShowK steps . snd) $ \(str, sem) -> + checkSemanticsP steps [str] sem + +-- * Random generators + +-- ** Random SemanticsP generators + +-- | An arbitrary expression, paired with its expected meaning. +-- +-- See the function 'checkSemanticsP' to evaluate the pair. +arbitrarySemanticsP :: Gen SemanticsP +arbitrarySemanticsP = oneof + [ SemanticsP <$> (arbitraryBoolExpr :: Gen (Semantics Bool)) + , SemanticsP <$> (arbitraryNumExpr :: Gen (Semantics Int8)) + , SemanticsP <$> (arbitraryNumExpr :: Gen (Semantics Int16)) + , SemanticsP <$> (arbitraryNumExpr :: Gen (Semantics Int32)) + , SemanticsP <$> (arbitraryNumExpr :: Gen (Semantics Int64)) + , SemanticsP <$> (arbitraryNumExpr :: Gen (Semantics Word8)) + , SemanticsP <$> (arbitraryNumExpr :: Gen (Semantics Word16)) + , SemanticsP <$> (arbitraryNumExpr :: Gen (Semantics Word32)) + , SemanticsP <$> (arbitraryNumExpr :: Gen (Semantics Word64)) + , SemanticsP <$> (arbitraryFloatingExpr :: Gen (Semantics Float)) + , SemanticsP <$> (arbitraryFloatingExpr :: Gen (Semantics Double)) + , SemanticsP <$> (arbitraryRealFracExpr :: Gen (Semantics Float)) + , SemanticsP <$> (arbitraryRealFracExpr :: Gen (Semantics Double)) + , SemanticsP <$> (arbitraryRealFloatExpr :: Gen (Semantics Float)) + , SemanticsP <$> (arbitraryRealFloatExpr :: Gen (Semantics Double)) + , SemanticsP <$> (arbitraryFractionalExpr :: Gen (Semantics Float)) + , SemanticsP <$> (arbitraryFractionalExpr :: Gen (Semantics Double)) + , SemanticsP <$> (arbitraryIntegralExpr :: Gen (Semantics Int8)) + , SemanticsP <$> (arbitraryIntegralExpr :: Gen (Semantics Int16)) + , SemanticsP <$> (arbitraryIntegralExpr :: Gen (Semantics Int32)) + , SemanticsP <$> (arbitraryIntegralExpr :: Gen (Semantics Int64)) + , SemanticsP <$> (arbitraryIntegralExpr :: Gen (Semantics Word8)) + , SemanticsP <$> (arbitraryIntegralExpr :: Gen (Semantics Word16)) + , SemanticsP <$> (arbitraryIntegralExpr :: Gen (Semantics Word32)) + , SemanticsP <$> (arbitraryIntegralExpr :: Gen (Semantics Word64)) + , SemanticsP <$> (arbitraryBitsExpr :: Gen (Semantics Bool)) + , SemanticsP <$> (arbitraryBitsExpr :: Gen (Semantics Int8)) + , SemanticsP <$> (arbitraryBitsExpr :: Gen (Semantics Int16)) + , SemanticsP <$> (arbitraryBitsExpr :: Gen (Semantics Int32)) + , SemanticsP <$> (arbitraryBitsExpr :: Gen (Semantics Int64)) + , SemanticsP <$> (arbitraryBitsExpr :: Gen (Semantics Word8)) + , SemanticsP <$> (arbitraryBitsExpr :: Gen (Semantics Word16)) + , SemanticsP <$> (arbitraryBitsExpr :: Gen (Semantics Word32)) + , SemanticsP <$> (arbitraryBitsExpr :: Gen (Semantics Word64)) + , SemanticsP <$> (arbitraryBitsIntegralExpr :: Gen (Semantics Int8)) + , SemanticsP <$> (arbitraryBitsIntegralExpr :: Gen (Semantics Int16)) + , SemanticsP <$> (arbitraryBitsIntegralExpr :: Gen (Semantics Int32)) + , SemanticsP <$> (arbitraryBitsIntegralExpr :: Gen (Semantics Int64)) + , SemanticsP <$> (arbitraryBitsIntegralExpr :: Gen (Semantics Word8)) + , SemanticsP <$> (arbitraryBitsIntegralExpr :: Gen (Semantics Word16)) + , SemanticsP <$> (arbitraryBitsIntegralExpr :: Gen (Semantics Word32)) + , SemanticsP <$> (arbitraryBitsIntegralExpr :: Gen (Semantics Word64)) + ] + +-- | Generate an arbitrary drop by taking an expression, adding a number of +-- elements to it, and then dropping some. +arbitraryDrop :: SemanticsP -> Gen (Stream, SemanticsP) +arbitraryDrop (SemanticsP (expr, meaning)) = do + -- Randomly generate a list of elements + prependLength <- getPositive <$> arbitrary + buffer <- vectorOf prependLength arbitrary + + -- Build the stream with the buffer + let streamId = 0 + stream = Stream streamId buffer expr typeOf + + -- Select how many elements to drop from the stream (up to the length of the + -- buffer) + dropLength <- chooseInt (0, prependLength) + + -- Build a drop expression that drops those many elements, paired with its + -- meaning. + let expr' = Drop typeOf (fromIntegral dropLength) streamId + meaning' = drop dropLength buffer ++ meaning + + return (stream, SemanticsP (expr', meaning')) + +-- ** Random Expr generators + +-- | An arbitrary constant expression of any type, paired with its expected +-- meaning. +arbitraryConst :: (Arbitrary t, Typed t) + => Gen (Expr t, [t]) +arbitraryConst = (\v -> (Const typeOf v, repeat v)) <$> arbitrary + +-- | An arbitrary boolean expression, paired with its expected meaning. +arbitraryBoolExpr :: Gen (Expr Bool, [Bool]) +arbitraryBoolExpr = + -- We use frequency instead of oneof because the random expression generator + -- seems to generate expressions that are too large and the test fails due + -- to running out of memory. + frequency + [ (10, arbitraryConst) + + , (5, apply1 <$> arbitraryBoolOp1 <*> arbitraryBoolExpr) + + , (1, apply2 <$> arbitraryBoolOp2 + <*> arbitraryBoolExpr + <*> arbitraryBoolExpr) + + , (1, apply2 <$> arbitraryEqOp2 + <*> arbitraryBoolExpr + <*> arbitraryBoolExpr) + + , (1, apply2 <$> arbitraryEqOp2 + <*> arbitraryBitsExpr + <*> (arbitraryBitsExpr :: Gen (Expr Int8, [Int8]))) + + , (1, apply2 <$> arbitraryEqOp2 + <*> arbitraryBitsExpr + <*> (arbitraryBitsExpr :: Gen (Expr Int16, [Int16]))) + + , (1, apply2 <$> arbitraryEqOp2 + <*> arbitraryBitsExpr + <*> (arbitraryBitsExpr :: Gen (Expr Int32, [Int32]))) + + , (1, apply2 <$> arbitraryEqOp2 + <*> arbitraryBitsExpr + <*> (arbitraryBitsExpr :: Gen (Expr Int64, [Int64]))) + + , (1, apply2 <$> arbitraryEqOp2 + <*> arbitraryBitsExpr + <*> (arbitraryBitsExpr :: Gen (Expr Word8, [Word8]))) + + , (1, apply2 <$> arbitraryEqOp2 + <*> arbitraryBitsExpr + <*> (arbitraryBitsExpr :: Gen (Expr Word16, [Word16]))) + + , (1, apply2 <$> arbitraryEqOp2 + <*> arbitraryBitsExpr + <*> (arbitraryBitsExpr :: Gen (Expr Word32, [Word32]))) + + , (1, apply2 <$> arbitraryEqOp2 + <*> arbitraryBitsExpr + <*> (arbitraryBitsExpr :: Gen (Expr Word64, [Word64]))) + + , (1, apply2 <$> arbitraryEqOp2 + <*> arbitraryNumExpr + <*> (arbitraryNumExpr :: Gen (Expr Int8, [Int8]))) + + , (1, apply2 <$> arbitraryEqOp2 + <*> arbitraryNumExpr + <*> (arbitraryNumExpr :: Gen (Expr Int16, [Int16]))) + + , (1, apply2 <$> arbitraryEqOp2 + <*> arbitraryNumExpr + <*> (arbitraryNumExpr :: Gen (Expr Int32, [Int32]))) + + , (1, apply2 <$> arbitraryEqOp2 + <*> arbitraryNumExpr + <*> (arbitraryNumExpr :: Gen (Expr Int64, [Int64]))) + + , (1, apply2 <$> arbitraryEqOp2 + <*> arbitraryNumExpr + <*> (arbitraryNumExpr :: Gen (Expr Word8, [Word8]))) + + , (1, apply2 <$> arbitraryEqOp2 + <*> arbitraryNumExpr + <*> (arbitraryNumExpr :: Gen (Expr Word16, [Word16]))) + + , (1, apply2 <$> arbitraryEqOp2 + <*> arbitraryNumExpr + <*> (arbitraryNumExpr :: Gen (Expr Word32, [Word32]))) + + , (1, apply2 <$> arbitraryEqOp2 + <*> arbitraryNumExpr + <*> (arbitraryNumExpr :: Gen (Expr Word64, [Word64]))) + + , (1, apply2 <$> arbitraryOrdOp2 + <*> arbitraryNumExpr + <*> (arbitraryNumExpr :: Gen (Expr Int8, [Int8]))) + + , (1, apply2 <$> arbitraryOrdOp2 + <*> arbitraryNumExpr + <*> (arbitraryNumExpr :: Gen (Expr Int16, [Int16]))) + + , (1, apply2 <$> arbitraryOrdOp2 + <*> arbitraryNumExpr + <*> (arbitraryNumExpr :: Gen (Expr Int32, [Int32]))) + + , (1, apply2 <$> arbitraryOrdOp2 + <*> arbitraryNumExpr + <*> (arbitraryNumExpr :: Gen (Expr Int64, [Int64]))) + + , (1, apply2 <$> arbitraryOrdOp2 + <*> arbitraryNumExpr + <*> (arbitraryNumExpr :: Gen (Expr Word8, [Word8]))) + + , (1, apply2 <$> arbitraryOrdOp2 + <*> arbitraryNumExpr + <*> (arbitraryNumExpr :: Gen (Expr Word16, [Word16]))) + + , (1, apply2 <$> arbitraryOrdOp2 + <*> arbitraryNumExpr + <*> (arbitraryNumExpr :: Gen (Expr Word32, [Word32]))) + + , (1, apply2 <$> arbitraryOrdOp2 + <*> arbitraryNumExpr + <*> (arbitraryNumExpr :: Gen (Expr Word64, [Word64]))) + + , (1, apply2 <$> arbitraryOrdOp2 + <*> arbitraryFloatingExpr + <*> (arbitraryFloatingExpr :: Gen (Expr Float, [Float]))) + + , (1, apply2 <$> arbitraryOrdOp2 + <*> arbitraryFloatingExpr + <*> (arbitraryFloatingExpr :: Gen (Expr Double, [Double]))) + + , (1, apply3 <$> arbitraryITEOp3 + <*> arbitraryBoolExpr + <*> arbitraryBoolExpr + <*> arbitraryBoolExpr) + ] + +-- | An arbitrary numeric expression, paired with its expected meaning. +arbitraryNumExpr :: (Arbitrary t, Typed t, Num t) + => Gen (Expr t, [t]) +arbitraryNumExpr = + -- We use frequency instead of oneof because the random expression generator + -- seems to generate expressions that are too large and the test fails due + -- to running out of memory. + frequency + [ (10, arbitraryConst) + + , (5, apply1 <$> arbitraryNumOp1 <*> arbitraryNumExpr) + + , (2, apply2 <$> arbitraryNumOp2 <*> arbitraryNumExpr <*> arbitraryNumExpr) + + , (2, apply3 <$> arbitraryITEOp3 + <*> arbitraryBoolExpr + <*> arbitraryNumExpr + <*> arbitraryNumExpr) + ] + +-- | An arbitrary floating point expression, paired with its expected meaning. +arbitraryFloatingExpr :: (Arbitrary t, Typed t, Floating t) + => Gen (Expr t, [t]) +arbitraryFloatingExpr = + -- We use frequency instead of oneof because the random expression generator + -- seems to generate expressions that are too large and the test fails due + -- to running out of memory. + frequency + [ (10, arbitraryConst) + + , (5, apply1 <$> arbitraryFloatingOp1 <*> arbitraryFloatingExpr) + + , (5, apply1 <$> arbitraryNumOp1 <*> arbitraryFloatingExpr) + + , (2, apply2 <$> arbitraryFloatingOp2 + <*> arbitraryFloatingExpr + <*> arbitraryFloatingExpr) + + , (2, apply2 <$> arbitraryNumOp2 + <*> arbitraryFloatingExpr + <*> arbitraryFloatingExpr) + + , (1, apply3 <$> arbitraryITEOp3 + <*> arbitraryBoolExpr + <*> arbitraryFloatingExpr + <*> arbitraryFloatingExpr) + ] + +-- | An arbitrary realfrac expression, paired with its expected meaning. +arbitraryRealFracExpr :: (Arbitrary t, Typed t, RealFrac t) + => Gen (Expr t, [t]) +arbitraryRealFracExpr = + -- We use frequency instead of oneof because the random expression generator + -- seems to generate expressions that are too large and the test fails due + -- to running out of memory. + frequency + [ (10, arbitraryConst) + + , (2, apply1 <$> arbitraryRealFracOp1 <*> arbitraryRealFracExpr) + + , (5, apply1 <$> arbitraryNumOp1 <*> arbitraryRealFracExpr) + + , (1, apply2 <$> arbitraryNumOp2 + <*> arbitraryRealFracExpr + <*> arbitraryRealFracExpr) + + , (1, apply3 <$> arbitraryITEOp3 + <*> arbitraryBoolExpr + <*> arbitraryRealFracExpr + <*> arbitraryRealFracExpr) + ] + +-- | An arbitrary realfloat expression, paired with its expected meaning. +arbitraryRealFloatExpr :: (Arbitrary t, Typed t, RealFloat t) + => Gen (Expr t, [t]) +arbitraryRealFloatExpr = + -- We use frequency instead of oneof because the random expression generator + -- seems to generate expressions that are too large and the test fails due + -- to running out of memory. + frequency + [ (10, arbitraryConst) + + , (2, apply1 <$> arbitraryNumOp1 <*> arbitraryRealFloatExpr) + + , (5, apply2 <$> arbitraryRealFloatOp2 + <*> arbitraryRealFloatExpr + <*> arbitraryRealFloatExpr) + + , (1, apply2 <$> arbitraryNumOp2 + <*> arbitraryRealFloatExpr + <*> arbitraryRealFloatExpr) + + , (1, apply3 <$> arbitraryITEOp3 + <*> arbitraryBoolExpr + <*> arbitraryRealFloatExpr + <*> arbitraryRealFloatExpr) + ] + +-- | An arbitrary fractional expression, paired with its expected meaning. +-- +-- We add the constraint Eq because we sometimes need to make sure numbers are +-- not zero. +arbitraryFractionalExpr :: (Arbitrary t, Typed t, Fractional t, Eq t) + => Gen (Expr t, [t]) +arbitraryFractionalExpr = + -- We use frequency instead of oneof because the random expression generator + -- seems to generate expressions that are too large and the test fails due + -- to running out of memory. + frequency + [ (10, arbitraryConst) + + , (5, apply1 <$> arbitraryFractionalOp1 <*> arbitraryFractionalExpr) + + , (5, apply1 <$> arbitraryNumOp1 <*> arbitraryFractionalExpr) + + , (2, apply2 <$> arbitraryFractionalOp2 + <*> arbitraryFractionalExpr + <*> arbitraryFractionalExprNonZero) + + , (1, apply3 <$> arbitraryITEOp3 + <*> arbitraryBoolExpr + <*> arbitraryFractionalExpr + <*> arbitraryFractionalExpr) + ] + where + + -- Generator for fractional expressions that are never zero. + -- + -- The list is infinite, so this generator checks up to maxTraceLength + -- elements. + arbitraryFractionalExprNonZero = arbitraryFractionalExpr + `suchThat` (notElem 0 . take maxTraceLength . snd) + +-- | An arbitrary integral expression, paired with its expected meaning. +-- +-- We add the constraint Eq because we sometimes need to make sure numbers are +-- not zero. +arbitraryIntegralExpr :: (Arbitrary t, Typed t, Integral t, Eq t) + => Gen (Expr t, [t]) +arbitraryIntegralExpr = + -- We use frequency instead of oneof because the random expression generator + -- seems to generate expressions that are too large and the test fails due + -- to running out of memory. + frequency + [ (10, arbitraryConst) + + , (5, apply1 <$> arbitraryNumOp1 <*> arbitraryIntegralExpr) + + , (2, apply2 <$> arbitraryNumOp2 + <*> arbitraryIntegralExpr + <*> arbitraryIntegralExpr) + + , (2, apply2 <$> arbitraryIntegralOp2 + <*> arbitraryIntegralExpr + <*> arbitraryIntegralExprNonZero) + + , (1, apply3 <$> arbitraryITEOp3 + <*> arbitraryBoolExpr + <*> arbitraryIntegralExpr + <*> arbitraryIntegralExpr) + ] + where + + -- Generator for integral expressions that are never zero. + -- + -- The list is infinite, so this generator checks up to maxTraceLength + -- elements. + arbitraryIntegralExprNonZero = arbitraryIntegralExpr + `suchThat` (notElem 0 . take maxTraceLength . snd) + +-- | An arbitrary Bits expression, paired with its expected meaning. +arbitraryBitsExpr :: (Arbitrary t, Typed t, Bits t) + => Gen (Expr t, [t]) +arbitraryBitsExpr = + -- We use frequency instead of oneof because the random expression generator + -- seems to generate expressions that are too large and the test fails due + -- to running out of memory. + frequency + [ (10, arbitraryConst) + + , (5, apply1 <$> arbitraryBitsOp1 <*> arbitraryBitsExpr) + + , (2, apply2 <$> arbitraryBitsOp2 + <*> arbitraryBitsExpr + <*> arbitraryBitsExpr) + + , (2, apply3 <$> arbitraryITEOp3 + <*> arbitraryBoolExpr + <*> arbitraryBitsExpr <*> arbitraryBitsExpr) + ] + +-- | An arbitrary expression for types that are instances of Bits and Integral, +-- paired with its expected meaning. +arbitraryBitsIntegralExpr :: (Arbitrary t, Typed t, Bits t, Integral t) + => Gen (Expr t, [t]) +arbitraryBitsIntegralExpr = + -- We use frequency instead of oneof because the random expression + -- generator seems to generate expressions that are too large and the + -- test fails due to running out of memory. + frequency + [ (10, arbitraryConst) + + , (2, apply1 <$> arbitraryNumOp1 <*> arbitraryBitsIntegralExpr) + + , (1, apply2 <$> arbitraryNumOp2 + <*> arbitraryBitsIntegralExpr + <*> arbitraryBitsIntegralExpr) + + , (5, apply2 <$> arbitraryBitsIntegralOp2 + <*> arbitraryBitsIntegralExpr + <*> arbitraryBitsIntegralExprConstPos) + + , (1, apply3 <$> arbitraryITEOp3 + <*> arbitraryBoolExpr + <*> arbitraryBitsIntegralExpr + <*> arbitraryBitsIntegralExpr) + ] + where + + -- Generator for constant bit integral expressions that, when converted to + -- type 't', result in a positive number. We use a constant generator, as + -- opposed to a generator based on the more comprehensive + -- arbitraryBitsIntegralExpr, because the latter runs out of memory easily + -- when nested and filtered with suchThat. + arbitraryBitsIntegralExprConstPos = + (\v -> (Const typeOf v, repeat v)) <$> intThatFits + where + -- In this context: + -- + -- intThatFits :: Gen t + intThatFits = + suchThat arbitrary ((> 0) . (\x -> (fromIntegral x) :: Int)) + +-- ** Operators + +-- *** Op 1 + +-- | Generator for arbitrary boolean operators with arity 1, paired with their +-- expected meaning. +arbitraryBoolOp1 :: Gen (Expr Bool -> Expr Bool, [Bool] -> [Bool]) +arbitraryBoolOp1 = elements + [ (Op1 Not, fmap not) + ] + +-- | Generator for arbitrary numeric operators with arity 1, paired with their +-- expected meaning. +arbitraryNumOp1 :: (Typed t, Num t) + => Gen (Expr t -> Expr t, [t] -> [t]) +arbitraryNumOp1 = elements + [ (Op1 (Abs typeOf), fmap abs) + , (Op1 (Sign typeOf), fmap signum) + ] + +-- | Generator for arbitrary floating point operators with arity 1, paired with +-- their expected meaning. +arbitraryFloatingOp1 :: (Typed t, Floating t) + => Gen (Expr t -> Expr t, [t] -> [t]) +arbitraryFloatingOp1 = elements + [ (Op1 (Exp typeOf), fmap exp) + , (Op1 (Sqrt typeOf), fmap sqrt) + , (Op1 (Log typeOf), fmap log) + , (Op1 (Sin typeOf), fmap sin) + , (Op1 (Tan typeOf), fmap tan) + , (Op1 (Cos typeOf), fmap cos) + , (Op1 (Asin typeOf), fmap asin) + , (Op1 (Atan typeOf), fmap atan) + , (Op1 (Acos typeOf), fmap acos) + , (Op1 (Sinh typeOf), fmap sinh) + , (Op1 (Tanh typeOf), fmap tanh) + , (Op1 (Cosh typeOf), fmap cosh) + , (Op1 (Asinh typeOf), fmap asinh) + , (Op1 (Atanh typeOf), fmap atanh) + , (Op1 (Acosh typeOf), fmap acosh) + ] + +-- | Generator for arbitrary realfrac operators with arity 1, paired with their +-- expected meaning. +arbitraryRealFracOp1 :: (Typed t, RealFrac t) + => Gen (Expr t -> Expr t, [t] -> [t]) +arbitraryRealFracOp1 = elements + [ (Op1 (Ceiling typeOf), fmap (fromIntegral . idI . ceiling)) + , (Op1 (Floor typeOf), fmap (fromIntegral . idI . floor)) + ] + where + -- Auxiliary function to help the compiler determine which integral type + -- the result of ceiling must be converted to. An Integer ensures that the + -- result fits and there is no loss of precision due to the intermediate + -- casting. + idI :: Integer -> Integer + idI = id + +-- | Generator for arbitrary fractional operators with arity 1, paired with +-- their expected meaning. +arbitraryFractionalOp1 :: (Typed t, Fractional t) + => Gen (Expr t -> Expr t, [t] -> [t]) +arbitraryFractionalOp1 = elements + [ (Op1 (Recip typeOf), fmap recip) + ] + +-- | Generator for arbitrary bitwise operators with arity 1, paired with their +-- expected meaning. +arbitraryBitsOp1 :: (Typed t, Bits t) + => Gen (Expr t -> Expr t, [t] -> [t]) +arbitraryBitsOp1 = elements + [ (Op1 (BwNot typeOf), fmap complement) + ] + +-- *** Op 2 + +-- | Generator for arbitrary boolean operators with arity 2, paired with their +-- expected meaning. +arbitraryBoolOp2 :: Gen ( Expr Bool -> Expr Bool -> Expr Bool + , [Bool] -> [Bool] -> [Bool] + ) +arbitraryBoolOp2 = elements + [ (Op2 And, zipWith (&&)) + , (Op2 Or, zipWith (||)) + ] + +-- | Generator for arbitrary numeric operators with arity 2, paired with their +-- expected meaning. +arbitraryNumOp2 :: (Typed t, Num t) + => Gen (Expr t -> Expr t -> Expr t, [t] -> [t] -> [t]) +arbitraryNumOp2 = elements + [ (Op2 (Add typeOf), zipWith (+)) + , (Op2 (Sub typeOf), zipWith (-)) + , (Op2 (Mul typeOf), zipWith (*)) + ] + +-- | Generator for arbitrary integral operators with arity 2, paired with their +-- expected meaning. +arbitraryIntegralOp2 :: (Typed t, Integral t) + => Gen (Expr t -> Expr t -> Expr t, [t] -> [t] -> [t]) +arbitraryIntegralOp2 = elements + [ (Op2 (Mod typeOf), zipWith mod) + , (Op2 (Div typeOf), zipWith quot) + ] + +-- | Generator for arbitrary fractional operators with arity 2, paired with +-- their expected meaning. +arbitraryFractionalOp2 :: (Typed t, Fractional t) + => Gen (Expr t -> Expr t -> Expr t, [t] -> [t] -> [t]) +arbitraryFractionalOp2 = elements + [ (Op2 (Fdiv typeOf), zipWith (/)) + ] + +-- | Generator for arbitrary floating point operators with arity 2, paired with +-- their expected meaning. +arbitraryFloatingOp2 :: (Typed t, Floating t) + => Gen (Expr t -> Expr t -> Expr t, [t] -> [t] -> [t]) +arbitraryFloatingOp2 = elements + [ (Op2 (Pow typeOf), zipWith (**)) + , (Op2 (Logb typeOf), zipWith logBase) + ] + +-- | Generator for arbitrary floating point operators with arity 2, paired with +-- their expected meaning. +arbitraryRealFloatOp2 :: (Typed t, RealFloat t) + => Gen (Expr t -> Expr t -> Expr t, [t] -> [t] -> [t]) +arbitraryRealFloatOp2 = elements + [ (Op2 (Atan2 typeOf), zipWith atan2) + ] + +-- | Generator for arbitrary equality operators with arity 2, paired with their +-- expected meaning. +arbitraryEqOp2 :: (Typed t, Eq t) + => Gen (Expr t -> Expr t -> Expr Bool, [t] -> [t] -> [Bool]) +arbitraryEqOp2 = elements + [ (Op2 (Eq typeOf), zipWith (==)) + , (Op2 (Ne typeOf), zipWith (/=)) + ] + +-- | Generator for arbitrary ordering operators with arity 2, paired with their +-- expected meaning. +arbitraryOrdOp2 :: (Typed t, Ord t) + => Gen (Expr t -> Expr t -> Expr Bool, [t] -> [t] -> [Bool]) +arbitraryOrdOp2 = elements + [ (Op2 (Le typeOf), zipWith (<=)) + , (Op2 (Lt typeOf), zipWith (<)) + , (Op2 (Ge typeOf), zipWith (>=)) + , (Op2 (Gt typeOf), zipWith (>)) + ] + +-- | Generator for arbitrary bitwise operators with arity 2, paired with their +-- expected meaning. +arbitraryBitsOp2 :: (Typed t, Bits t) + => Gen (Expr t -> Expr t -> Expr t, [t] -> [t] -> [t]) +arbitraryBitsOp2 = elements + [ (Op2 (BwAnd typeOf), zipWith (.&.)) + , (Op2 (BwOr typeOf), zipWith (.|.)) + , (Op2 (BwXor typeOf), zipWith xor) + ] + +-- | Generator for arbitrary bit shifting operators with arity 2, paired with +-- their expected meaning. +-- +-- This generator is a bit more strict in its type signature than the +-- underlying bit-shifting operators being tested, since it enforces both the +-- value being manipulated and the value that indicates how much to shift by to +-- have the same type. +arbitraryBitsIntegralOp2 :: (Typed t, Bits t, Integral t) + => Gen (Expr t -> Expr t -> Expr t, [t] -> [t] -> [t]) +arbitraryBitsIntegralOp2 = elements + [ (Op2 (BwShiftL typeOf typeOf), zipWith (\x y -> shiftL x (fromIntegral y))) + , (Op2 (BwShiftR typeOf typeOf), zipWith (\x y -> shiftR x (fromIntegral y))) + ] + +-- *** Op 3 + +-- | Generator for if-then-else operator (with arity 3), paired with its +-- expected meaning. +-- +-- Although this is constant and there is nothing arbitrary, we use the same +-- structure and naming convention as with others for simplicity. +arbitraryITEOp3 :: (Arbitrary t, Typed t) + => Gen ( Expr Bool -> Expr t -> Expr t -> Expr t + , [Bool] -> [t] -> [t] -> [t] + ) +arbitraryITEOp3 = return + (Op3 (Mux typeOf), zipWith3 (\x y z -> if x then y else z)) + +-- * Semantics + +-- | Type that pairs an expression with its meaning as an infinite stream. +type Semantics t = (Expr t, [t]) + +-- | A phantom semantics pair is an existential type that encloses an +-- expression and its expected meaning as an infinite list of values. +-- +-- It is needed by the arbitrary expression generator, to create a +-- heterogeneous list. +data SemanticsP = forall t + . (Typeable t, Read t, Eq t, Show t, Typed t, Arbitrary t) + => SemanticsP + { semanticsPair :: (Expr t, [t]) + } + +-- | Show function for test triplets that limits the accompanying list +-- to a certain length. +semanticsShowK :: Int -> SemanticsP -> String +semanticsShowK steps (SemanticsP (expr, exprList)) = + show (showType ty, render $ ppExpr expr, take steps exprList) + + where + + -- Type of the expression. The type is enforced by _u below. + ty = typeOf + + -- We want to show the type. To help GHC determine that the type t is the + -- same as the expression's (expr), we use an UExpr, which has an + -- additional constraint. This definition serves no other purpose than to + -- help enforce that constraint. + _u = UExpr ty expr + +-- | Check that the expression in the semantics pair is evaluated to the given +-- list, up to a number of steps. +-- +-- Some operations will overflow and return NaN. Because comparing any NaN +-- will, as per IEEE 754, always fail (i.e., return False), we handle that +-- specific case by stating that the test succeeds if any expected values +-- is NaN. +checkSemanticsP :: Int -> [Stream] -> SemanticsP -> Bool +checkSemanticsP steps streams (SemanticsP (expr, exprList)) = + any isNaN' expectation || resultValues == expectation + where + -- Limit expectation to the number of evaluation steps. + expectation = take steps exprList + + -- Obtain the results by looking up the observer in the spec + -- and parsing the results into Haskell values. + resultValues = fmap readResult results + results = lookupWithDefault testObserverName [] + $ interpObservers trace + + -- Spec with just one observer of one expression. + trace = eval Haskell steps spec + spec = Spec streams observers [] [] + observers = [Observer testObserverName expr typeOf] + + -- Fixed name for the observer. Used to obtain the result from the + -- trace. It should be the only observer in the trace. + testObserverName :: String + testObserverName = "res" + + -- | Is NaN with Eq requirement only. + isNaN' :: Eq a => a -> Bool + isNaN' x = x /= x + +-- * Auxiliary + +-- | Read a Haskell value from the output of the evaluator. +readResult :: Read a => String -> a +readResult = read . readResult' + where + readResult' :: String -> String + readResult' "false" = "False" + readResult' "true" = "True" + readResult' s = s + +-- | Variant of 'lookup' with an additional default value returned when the key +-- provided is not found in the map. +lookupWithDefault :: Ord k => k -> v -> [(k, v)] -> v +lookupWithDefault k def = fromMaybe def . lookup k + +-- | Show Copilot Core type. +showType :: Type a -> String +showType t = + case t of + Bool -> "Bool" + Int8 -> "Int8" + Int16 -> "Int16" + Int32 -> "Int32" + Int64 -> "Int64" + Word8 -> "Word8" + Word16 -> "Word16" + Word32 -> "Word32" + Word64 -> "Word64" + Float -> "Float" + Double -> "Double" + Array t -> "Array " ++ showType t + Struct t -> "Struct" diff --git a/copilot-interpreter/tests/Test/Extra.hs b/copilot-interpreter/tests/Test/Extra.hs new file mode 100644 index 000000000..f10d784c4 --- /dev/null +++ b/copilot-interpreter/tests/Test/Extra.hs @@ -0,0 +1,31 @@ +-- | Auxiliary testing helper functions. +module Test.Extra where + +-- External imports +import Control.Arrow ((***)) + +-- * Function application + +-- | Apply a tuple with two functions to a tuple of arguments. +apply1 :: (a1 -> b1, a2 -> b2) -- ^ Pair with functions + -> (a1, a2) -- ^ Pair with arguments + -> (b1, b2) -- ^ Pair with results +apply1 = uncurry (***) + +-- | Apply a tuple with two functions on two arguments to their tupled +-- arguments. +apply2 :: (a1 -> b1 -> c1, a2 -> b2 -> c2) -- ^ Pair with functions + -> (a1, a2) -- ^ Pair with first arguments + -> (b1, b2) -- ^ Pair with second arguments + -> (c1, c2) -- ^ Pair with results +apply2 fs = apply1 . apply1 fs + +-- | Apply a tuple with two functions on three arguments to their tupled +-- arguments. +apply3 :: (a1 -> b1 -> c1 -> d1, a2 -> b2 -> c2 -> d2) + -- ^ Pair with functions + -> (a1, a2) -- ^ Pair with first arguments + -> (b1, b2) -- ^ Pair with second arguments + -> (c1, c2) -- ^ Pair with third arguments + -> (d1, d2) -- ^ Pair with results +apply3 fs = apply2 . apply1 fs From ca423a4eaa0facbfa2bef2970209894f77aafbe4 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 18 Aug 2022 00:25:30 +0000 Subject: [PATCH 0454/1222] copilot-core: Deprecate interpreter in copilot-core. Refs #361. The architecture of Copilot mixes backends with other libraries, which makes the design not uniform. For example, the interpreter is part of copilot-core, while the C99 backend is in a separate library. A prior commit addresses this issue by introducing a separate library copilot-interpreter, and moving all interpretation definitions there. With that new library, it makes sense to remove all such definitions from copilot-core. In conformance with our deprecation policy, this commit deprecates all public definitions in copilot-core pertaining to interpretation of specifications. --- copilot-core/src/Copilot/Core/Interpret.hs | 5 +++++ copilot-core/src/Copilot/Core/Interpret/Eval.hs | 1 + copilot-core/src/Copilot/Core/Interpret/Render.hs | 5 +++++ 3 files changed, 11 insertions(+) diff --git a/copilot-core/src/Copilot/Core/Interpret.hs b/copilot-core/src/Copilot/Core/Interpret.hs index d6ccfb971..6ed2d604f 100644 --- a/copilot-core/src/Copilot/Core/Interpret.hs +++ b/copilot-core/src/Copilot/Core/Interpret.hs @@ -1,3 +1,7 @@ +-- The following warning is enabled in this module so that the import of +-- Copilot.Core.Interpret.Eval and Render do not give rise to warnings. +{-# OPTIONS_GHC -fno-warn-deprecations #-} + -- Copyright © 2011 National Institute of Aerospace / Galois, Inc. -- | An interpreter for Copilot specifications. @@ -5,6 +9,7 @@ {-# LANGUAGE Safe #-} module Copilot.Core.Interpret + {-# DEPRECATED "This module is deprecated in Copilot 3.11. Use copilot-interpreter instead." #-} ( Format (..) , interpret ) where diff --git a/copilot-core/src/Copilot/Core/Interpret/Eval.hs b/copilot-core/src/Copilot/Core/Interpret/Eval.hs index 7f2eb20b4..7fe7005f0 100644 --- a/copilot-core/src/Copilot/Core/Interpret/Eval.hs +++ b/copilot-core/src/Copilot/Core/Interpret/Eval.hs @@ -8,6 +8,7 @@ {-# LANGUAGE Safe #-} module Copilot.Core.Interpret.Eval + {-# DEPRECATED "This module is deprecated in Copilot 3.11. Use copilot-interpreter instead." #-} ( Env , Output , ExecTrace (..) diff --git a/copilot-core/src/Copilot/Core/Interpret/Render.hs b/copilot-core/src/Copilot/Core/Interpret/Render.hs index 5b42bb79e..b0762d43c 100644 --- a/copilot-core/src/Copilot/Core/Interpret/Render.hs +++ b/copilot-core/src/Copilot/Core/Interpret/Render.hs @@ -1,3 +1,7 @@ +-- The following warning is enabled in this module so that the import of +-- Copilot.Core.Interpret.Eval does not give rise to a warning. +{-# OPTIONS_GHC -fno-warn-deprecations #-} + -- Copyright © 2011 National Institute of Aerospace / Galois, Inc. -- | Pretty-print the results of a simulation. @@ -5,6 +9,7 @@ {-# LANGUAGE Safe #-} module Copilot.Core.Interpret.Render + {-# DEPRECATED "This module is deprecated in Copilot 3.11. Use copilot-interpreter instead." #-} ( renderAsTable , renderAsCSV ) where From c833b0a6550b70f33a39e3b71ac51b981dc5c1de Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 23 Aug 2022 09:00:49 -0700 Subject: [PATCH 0455/1222] copilot-language: Use interpreter from copilot-interpreter. Refs #361. The architecture of Copilot mixes backends with other libraries, which makes the design not uniform. To address this issue, the interpreter in copilot-core has been deprecated in favor of a new interpreter in copilot-interpreter. This commit uses the modules in copilot-interpreter in the implementation of copilot-language, as opposed to the ones from copilot-core. --- copilot-language/copilot-language.cabal | 16 +++++++++------- .../src/Copilot/Language/Interpret.hs | 2 +- .../tests/Test/Copilot/Language/Reify.hs | 4 ++-- 3 files changed, 12 insertions(+), 10 deletions(-) diff --git a/copilot-language/copilot-language.cabal b/copilot-language/copilot-language.cabal index 18f6e7152..19d90000d 100644 --- a/copilot-language/copilot-language.cabal +++ b/copilot-language/copilot-language.cabal @@ -35,15 +35,16 @@ source-repository head library default-language: Haskell2010 hs-source-dirs: src - build-depends: base >= 4.9 && < 5 + build-depends: base >= 4.9 && < 5 - , array >= 0.5 && < 0.6 - , containers >= 0.4 && < 0.7 - , data-reify >= 0.6 && < 0.7 - , mtl >= 2.0 && < 3 + , array >= 0.5 && < 0.6 + , containers >= 0.4 && < 0.7 + , data-reify >= 0.6 && < 0.7 + , mtl >= 2.0 && < 3 - , copilot-core >= 3.10 && < 3.11 - , copilot-theorem >= 3.10 && < 3.11 + , copilot-core >= 3.10 && < 3.11 + , copilot-interpreter >= 3.10 && < 3.11 + , copilot-theorem >= 3.10 && < 3.11 exposed-modules: Copilot.Language , Copilot.Language.Operators.BitWise @@ -94,6 +95,7 @@ test-suite unit-tests , test-framework-quickcheck2 , copilot-core + , copilot-interpreter , copilot-language hs-source-dirs: diff --git a/copilot-language/src/Copilot/Language/Interpret.hs b/copilot-language/src/Copilot/Language/Interpret.hs index ae6d25c75..78c1be014 100644 --- a/copilot-language/src/Copilot/Language/Interpret.hs +++ b/copilot-language/src/Copilot/Language/Interpret.hs @@ -17,7 +17,7 @@ module Copilot.Language.Interpret , interpret ) where -import qualified Copilot.Core.Interpret as I +import qualified Copilot.Interpret as I import Copilot.Language.Spec (Spec) import Copilot.Language.Reify diff --git a/copilot-language/tests/Test/Copilot/Language/Reify.hs b/copilot-language/tests/Test/Copilot/Language/Reify.hs index aced9a1b6..e056d946a 100644 --- a/copilot-language/tests/Test/Copilot/Language/Reify.hs +++ b/copilot-language/tests/Test/Copilot/Language/Reify.hs @@ -36,8 +36,8 @@ import Copilot.Language.Stream (Stream) import qualified Copilot.Language.Stream as Copilot -- Internal imports: functions needed to test after reification -import Copilot.Core.Interpret.Eval (ExecTrace (interpObservers), - ShowType (Haskell), eval) +import Copilot.Interpret.Eval (ExecTrace (interpObservers), ShowType (Haskell), + eval) -- Internal imports: auxiliary functions import Test.Extra (apply1, apply2, apply3) From 8e6bf37203099d569cd2061fc85ccfd7a530ee15 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 23 Aug 2022 00:50:16 +0000 Subject: [PATCH 0456/1222] copilot-interpreter: Document changes in CHANGELOG. Refs #361. --- copilot-interpreter/CHANGELOG | 2 ++ 1 file changed, 2 insertions(+) diff --git a/copilot-interpreter/CHANGELOG b/copilot-interpreter/CHANGELOG index e69de29bb..72121905a 100644 --- a/copilot-interpreter/CHANGELOG +++ b/copilot-interpreter/CHANGELOG @@ -0,0 +1,2 @@ +2022-08-22 + * Split copilot-interpreter into separate library. (#361) From ecf8dea332dd468a5d3cf04723e0351df661c66c Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 23 Aug 2022 00:48:02 +0000 Subject: [PATCH 0457/1222] copilot-core: Document changes in CHANGELOG. Refs #361. --- copilot-core/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot-core/CHANGELOG b/copilot-core/CHANGELOG index a9df1b23a..32d485333 100644 --- a/copilot-core/CHANGELOG +++ b/copilot-core/CHANGELOG @@ -1,6 +1,7 @@ -2022-08-09 +2022-08-22 * Deprecate Copilot.Core.PrettyDot. (#359) * Remove Copilot.Core.Type.Dynamic. (#360) + * Split copilot-interpreter into separate library. (#361) 2022-07-07 * Version bump (3.10). (#356) From 74bca924e5e1ab67cb720e4d126fd920dc42c567 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 23 Aug 2022 02:22:25 +0000 Subject: [PATCH 0458/1222] copilot-language: Document changes in CHANGELOG. Refs #361. --- copilot-language/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot-language/CHANGELOG b/copilot-language/CHANGELOG index c0759f065..963624d88 100644 --- a/copilot-language/CHANGELOG +++ b/copilot-language/CHANGELOG @@ -1,6 +1,7 @@ -2022-08-12 +2022-08-22 * Deprecate prettyPrint. (#362) * Reimplement DynStableName without unsafeCoerce. (#262) + * Use interpreter from copilot-interpreter. (#361) 2022-07-07 * Version bump (3.10). (#356) From 80fec5fb679ad4c131a2f89fef13bfec8b0c68bb Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 21 May 2022 14:26:08 -0400 Subject: [PATCH 0459/1222] copilot-c99: Update version bounds on language-c99*. Refs #371. Copilot only works with language-c99 < 0.2, but that limits installation with modern versions of GHC. This commit adjusts the cabal file so that installation with modern versions of language-c99, and consenquently GHC, is allowed. Note that the API has changed, so further adaptations are required for code to work with the new interface. --- copilot-c99/copilot-c99.cabal | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/copilot-c99/copilot-c99.cabal b/copilot-c99/copilot-c99.cabal index 4d772b332..0a91ce6ad 100644 --- a/copilot-c99/copilot-c99.cabal +++ b/copilot-c99/copilot-c99.cabal @@ -50,8 +50,8 @@ library , pretty >= 1.1 && < 1.2 , copilot-core >= 3.10 && < 3.11 - , language-c99 >= 0.1.1 && < 0.2 - , language-c99-simple >= 0.1.1 && < 0.2 + , language-c99 >= 0.2.0 && < 0.3 + , language-c99-simple >= 0.2.1 && < 0.3 exposed-modules : Copilot.Compile.C99 From 05868c8df2bc6eba7fb8684deb616d8588938d1c Mon Sep 17 00:00:00 2001 From: Frank Dedden Date: Sat, 14 May 2022 21:47:06 +0200 Subject: [PATCH 0460/1222] copilot-c99: Adapt to work with language-c99-simple >= 0.2. Refs #371. The new (0.2) version of the language-c99-simple library now requires constructing some non-empty list with a dedicated value constructor (NonEmpty) as opposed to using Haskell lists. This change was made to better fit the C99 standard. This makes the current copilot-c99 code not compile with the new version of the library. This commit adapts copilot-c99 so that the new value constructor NonEmpty is used where required. --- .../src/Copilot/Compile/C99/CodeGen.hs | 11 ++++---- .../src/Copilot/Compile/C99/Translate.hs | 27 +++++++++++-------- 2 files changed, 22 insertions(+), 16 deletions(-) diff --git a/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs b/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs index 5b6cd9d77..4282b6b78 100644 --- a/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs +++ b/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs @@ -4,9 +4,10 @@ -- | High-level translation of Copilot Core into C99. module Copilot.Compile.C99.CodeGen where -import Control.Monad.State (runState) -import Data.List (union, unzip4) -import Data.Typeable (Typeable) +import Control.Monad.State (runState) +import Data.List (union, unzip4) +import qualified Data.List.NonEmpty as NonEmpty +import Data.Typeable (Typeable) import qualified Language.C99.Simple as C @@ -50,7 +51,7 @@ mkbuffdecln sid ty xs = C.VarDecln (Just C.Static) cty name initvals name = streamname sid cty = C.Array (transtype ty) (Just $ C.LitInt $ fromIntegral buffsize) buffsize = length xs - initvals = Just $ C.InitArray $ constarray ty xs + initvals = Just $ C.InitList $ constarray ty xs -- | Make a C index variable and initialise it to 0. mkindexdecln :: Id -> C.Decln @@ -224,7 +225,7 @@ mkstructdecln :: Struct a => Type a -> C.Decln mkstructdecln (Struct x) = C.TypeDecln struct where struct = C.TypeSpec $ C.StructDecln (Just $ typename x) fields - fields = map mkfield (toValues x) + fields = NonEmpty.fromList $ map mkfield (toValues x) mkfield :: Value a -> C.FieldDecln mkfield (Value ty field) = C.FieldDecln (transtype ty) (fieldname field) diff --git a/copilot-c99/src/Copilot/Compile/C99/Translate.hs b/copilot-c99/src/Copilot/Compile/C99/Translate.hs index 222fe2760..6bb3a074c 100644 --- a/copilot-c99/src/Copilot/Compile/C99/Translate.hs +++ b/copilot-c99/src/Copilot/Compile/C99/Translate.hs @@ -3,7 +3,8 @@ -- | Translate Copilot Core expressions and operators to C99. module Copilot.Compile.C99.Translate where -import Control.Monad.State +import Control.Monad.State +import qualified Data.List.NonEmpty as NonEmpty import Copilot.Core import Copilot.Compile.C99.Error (impossible) @@ -226,7 +227,7 @@ constty ty = case ty of Float -> explicitty ty . C.LitFloat Double -> explicitty ty . C.LitDouble Struct _ -> \v -> - C.InitVal (transtypename ty) (map constfieldinit (toValues v)) + C.InitVal (transtypename ty) (constStruct (toValues v)) Array ty' -> \v -> C.InitVal (transtypename ty) (constarray ty' (arrayelems v)) @@ -254,26 +255,30 @@ constinit ty val = case ty of -- whole expression as an array of two int32_t's (as opposed to a nested -- array). This can either lead to compile-time errors (if you're lucky) or -- incorrect runtime semantics (if you're unlucky). - Array ty' -> C.InitArray $ constarray ty' $ arrayelems val + Array ty' -> C.InitList $ constarray ty' $ arrayelems val -- We use InitArray to initialize a struct because the syntax used for -- initializing arrays and structs is compatible. For instance, {1, 2} works -- both for initializing an int array of length 2 as well as a struct with -- two int fields, although the two expressions are conceptually different - -- (structs can also be initialized as { .a = 1, .b = 2}, but language-c99 - -- does not support such syntax and does not provide a specialized - -- initialization construct for structs). - Struct _ -> C.InitArray $ map constfieldinit $ toValues val + -- (structs can also be initialized as { .a = 1, .b = 2}. + Struct _ -> C.InitList $ constStruct (toValues val) _ -> C.InitExpr $ constty ty val -- | Transform a Copilot Core struct field into a C99 initializer. -constfieldinit :: Value a -> C.Init -constfieldinit (Value ty (Field val)) = constinit ty val +constfieldinit :: Value a -> C.InitItem +constfieldinit (Value ty (Field val)) = C.InitItem Nothing $ constinit ty val + +-- | Transform a Copilot Struct, based on the struct fields, into a list of C99 +-- initializer values. +constStruct :: [Value a] -> NonEmpty.NonEmpty C.InitItem +constStruct val = NonEmpty.fromList $ map constfieldinit val -- | Transform a Copilot Array, based on the element values and their type, -- into a list of C99 initializer values. -constarray :: Type a -> [a] -> [C.Init] -constarray ty = map (constinit ty) +constarray :: Type a -> [a] -> NonEmpty.NonEmpty C.InitItem +constarray ty = + NonEmpty.fromList . map (C.InitItem Nothing . constinit ty) -- | Explicitly cast a C99 value to a type. explicitty :: Type a -> C.Expr -> C.Expr From 18fe32480d49445e48b2c26983f8674768d9c32c Mon Sep 17 00:00:00 2001 From: Frank Dedden Date: Sun, 15 May 2022 22:33:24 +0200 Subject: [PATCH 0461/1222] copilot-c99: Document changes in CHANGELOG. Refs #371. --- copilot-c99/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-c99/CHANGELOG b/copilot-c99/CHANGELOG index a5fe22c4b..dc59d4f44 100644 --- a/copilot-c99/CHANGELOG +++ b/copilot-c99/CHANGELOG @@ -1,3 +1,6 @@ +2022-08-23 + * Update to support language-c99-0.2.0. (#371) + 2022-07-07 * Version bump (3.10). (#356) * Remove unnecessary dependencies from Cabal package. (#323) From a6e0370e8958be2f45904d98fb56b5816a7fc143 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 25 Aug 2022 18:24:52 +0000 Subject: [PATCH 0462/1222] copilot-core: Remove unnecessary type constraints. Refs #369. Multiple definitions in Copilot.Core.Type.Array are not being used by any other part of Copilot or, as far as we know, by any user of Copilot. These include the InnerType class, the Flatten class, the Foldable instance, and the size function. The classes InnerType and Flatten are being used as type constraints in other functions, but they are not really required: removing them has no effect in the code. This commit removes mentions of the aforementioned classes from modules in copilot-core where they are no longer needed. --- copilot-core/src/Copilot/Core/Type.hs | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/copilot-core/src/Copilot/Core/Type.hs b/copilot-core/src/Copilot/Core/Type.hs index 82bddce80..bfb651541 100644 --- a/copilot-core/src/Copilot/Core/Type.hs +++ b/copilot-core/src/Copilot/Core/Type.hs @@ -102,8 +102,6 @@ data Type :: * -> * where Double :: Type Double Array :: forall n t. ( KnownNat n , Typed t - , Typed (InnerType t) - , Flatten t (InnerType t) ) => Type t -> Type (Array n t) Struct :: (Typed a, Struct a) => a -> Type a @@ -209,7 +207,7 @@ instance Typed Float where instance Typed Double where typeOf = Double simpleType _ = SDouble -instance (Typeable t, Typed t, KnownNat n, Flatten t (InnerType t), Typed (InnerType t)) => Typed (Array n t) where +instance (Typeable t, Typed t, KnownNat n) => Typed (Array n t) where typeOf = Array typeOf simpleType (Array t) = SArray t From e951da69504975e2020236fada6853085c6f03e9 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 25 Aug 2022 18:25:26 +0000 Subject: [PATCH 0463/1222] copilot-language: Remove unnecessary type constraints. Refs #369. Multiple definitions in Copilot.Core.Type.Array are not being used by any other part of Copilot or, as far as we know, by any user of Copilot. These include the InnerType class, the Flatten class, the Foldable instance, and the size function. The classes InnerType and Flatten are being used as type constraints in other functions, but they are not really required: removing them has no effect in the code. This commit removes mentions of the aforementioned classes from modules in copilot-language where they are no longer needed. --- copilot-language/src/Copilot/Language/Operators/Array.hs | 6 +----- 1 file changed, 1 insertion(+), 5 deletions(-) diff --git a/copilot-language/src/Copilot/Language/Operators/Array.hs b/copilot-language/src/Copilot/Language/Operators/Array.hs index 70b9ce41e..6a9d17a35 100644 --- a/copilot-language/src/Copilot/Language/Operators/Array.hs +++ b/copilot-language/src/Copilot/Language/Operators/Array.hs @@ -11,8 +11,7 @@ import Copilot.Core ( Typed , Op2 (Index) , typeOf , Array - , InnerType - , Flatten) + ) import Copilot.Language.Stream (Stream (..)) import Data.Word (Word32) @@ -25,9 +24,6 @@ import GHC.TypeLits (KnownNat) -- '5 Word8)@, then @s .!! 3@ has type @Stream Word8@ and contains the 3rd -- element (starting from zero) of the arrays in @s@ at any point in time. (.!!) :: ( KnownNat n - , t' ~ InnerType t - , Flatten t t' , Typed t - , Typed t' ) => Stream (Array n t) -> Stream Word32 -> Stream t arr .!! n = Op2 (Index typeOf) arr n From fbc5e1120d4cdbd6015a4943f49076d74ae8cb0d Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 25 Aug 2022 17:46:52 +0000 Subject: [PATCH 0464/1222] copilot-core: Deprecate definitions in Array. Refs #369. Multiple definitions in Copilot.Core.Type.Array are not being used by any other part of Copilot or, as far as we know, by any user of Copilot. These include the InnerType class, the Flatten class, the Foldable instance, and the size function. These functions are now scheduled for removal. As per our internal policy of waiting 3 versions from deprecation until a public interface declaration can be removed, the following are now deprecated: - Copilot.Core.Type.Array.InnerType - Copilot.Core.Type.Array.Flatten - Copilot.Core.Type.Array.size - Instance of Data.Foldable for Arrays. For the case of the instance, there does not seem to exist a deprecation method that will make GHC warn users appropriately. For lack of a better way, we document the deprecation in the instance haddock documentation. --- copilot-core/src/Copilot/Core/Type/Array.hs | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/copilot-core/src/Copilot/Core/Type/Array.hs b/copilot-core/src/Copilot/Core/Type/Array.hs index f468d2a24..7a1775a3e 100644 --- a/copilot-core/src/Copilot/Core/Type/Array.hs +++ b/copilot-core/src/Copilot/Core/Type/Array.hs @@ -46,11 +46,14 @@ array xs | datalen == typelen = Array xs ") does not match length of type (" ++ show typelen ++ ")." -- | Association between an array and the type of the elements it contains. +{-# DEPRECATED InnerType "This type family is deprecated in Copilot 3.11." #-} type family InnerType x where InnerType (Array _ x) = InnerType x InnerType x = x -- | Flattening or conversion of arrays to lists. +{-# DEPRECATED Flatten "This class is deprecated in Copilot 3.11." #-} +{-# DEPRECATED flatten "This function is deprecated in Copilot 3.11." #-} class Flatten a b where -- | Flatten an array to a list. flatten :: Array n a -> [b] @@ -63,10 +66,12 @@ instance Flatten a a where instance Flatten a b => Flatten (Array n a) b where flatten (Array xss) = concat $ map flatten xss +-- | This instance is deprecated in Copilot 3.11. instance Foldable (Array n) where foldr f base (Array xs) = foldr f base xs -- | Total number of elements in a possibly nested array. +{-# DEPRECATED size "This function is deprecated in Copilot 3.11." #-} size :: forall a n b. (Flatten a b, b ~ InnerType a) => Array n a -> Int size xs = length $ (flatten xs :: [b]) From 5e2f49b819f720509ead9190596fab80bc38beab Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 25 Aug 2022 18:24:08 +0000 Subject: [PATCH 0465/1222] copilot-core: Document changes in CHANGELOG. Refs #369. --- copilot-core/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot-core/CHANGELOG b/copilot-core/CHANGELOG index 32d485333..ddd38d402 100644 --- a/copilot-core/CHANGELOG +++ b/copilot-core/CHANGELOG @@ -1,7 +1,8 @@ -2022-08-22 +2022-08-25 * Deprecate Copilot.Core.PrettyDot. (#359) * Remove Copilot.Core.Type.Dynamic. (#360) * Split copilot-interpreter into separate library. (#361) + * Deprecate unused classes, functions from Array module. (#369) 2022-07-07 * Version bump (3.10). (#356) From 300a522d762c077c417c336a117819d7e6a8f1b2 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 25 Aug 2022 18:23:48 +0000 Subject: [PATCH 0466/1222] copilot-language: Document changes in CHANGELOG. Refs #369. --- copilot-language/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot-language/CHANGELOG b/copilot-language/CHANGELOG index 963624d88..35b7abd71 100644 --- a/copilot-language/CHANGELOG +++ b/copilot-language/CHANGELOG @@ -1,7 +1,8 @@ -2022-08-22 +2022-08-25 * Deprecate prettyPrint. (#362) * Reimplement DynStableName without unsafeCoerce. (#262) * Use interpreter from copilot-interpreter. (#361) + * Remove unnecessary type constraints. (#369) 2022-07-07 * Version bump (3.10). (#356) From acd867d0c68121620d3fbddecf09133f4f709d1f Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 29 Aug 2022 13:37:26 +0000 Subject: [PATCH 0467/1222] copilot-c99: Require language-c99-simple-0.2.2. Refs #314. Appending values to a stream of arrays should delay the samples, but is currently producing incorrect code. To address that issue, we need to generate memcpy operations that take the size of the elements being copied into account, for which we need to use a special construct to produce a sizeof in C99 that is only available in version 0.2.2 of language-c99-simple. To make that solution possible, this commit modifies the cabal file so that copilot-c99 requires that specific version of language-c99-simple (or greater). --- copilot-c99/copilot-c99.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot-c99/copilot-c99.cabal b/copilot-c99/copilot-c99.cabal index 0a91ce6ad..c8d682730 100644 --- a/copilot-c99/copilot-c99.cabal +++ b/copilot-c99/copilot-c99.cabal @@ -51,7 +51,7 @@ library , copilot-core >= 3.10 && < 3.11 , language-c99 >= 0.2.0 && < 0.3 - , language-c99-simple >= 0.2.1 && < 0.3 + , language-c99-simple >= 0.2.2 && < 0.3 exposed-modules : Copilot.Compile.C99 From 8d17d2fc3a63d6feec1b736a8d03a3d4bf327d38 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 15 Aug 2022 23:53:27 +0000 Subject: [PATCH 0468/1222] copilot-c99: Fix error handling buffers in generated code for 'step'. Refs #314. Appending values to a stream of arrays should delay the samples, but is currently producing incorrect code. The issue is related to how elements are stored in the intermediate buffer associated to each stream, and how they are copied over. A part of the generated C code, one can find copying operations like: ```C (memcpy)((s0_tmp), ((s0_gen)()), (2)); (memcpy)(((s0)[s0_idx]), (s0_tmp), (2)); ``` However, these operations do not take the size of the element into account. For example, the code above was generated from a specification for which, s0_gen returns an array with two int16_t elements. Consequently, not all data is copied over. This commit modifies the code generator so that memcpy operations use sizeof to determine the amount of memory that must be copied. --- .../src/Copilot/Compile/C99/CodeGen.hs | 19 ++++++++++++++++--- 1 file changed, 16 insertions(+), 3 deletions(-) diff --git a/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs b/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs index 4282b6b78..73fec8c5e 100644 --- a/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs +++ b/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs @@ -101,14 +101,16 @@ mkstep cSettings streams triggers exts = tmpassign = case ty of Array _ -> C.Expr $ memcpy (C.Ident tmp_var) val size where - size = C.LitInt $ fromIntegral $ tysize ty + size = C.LitInt (fromIntegral $ tysize ty) + C..* C.SizeOfType (C.TypeName (tyElemName ty)) _ -> C.Expr $ C.Ident tmp_var C..= val bufferupdate = case ty of Array _ -> C.Expr $ memcpy dest (C.Ident tmp_var) size where dest = C.Index buff_var index_var - size = C.LitInt $ fromIntegral $ tysize ty + size = C.LitInt (fromIntegral $ tysize ty) + C..* C.SizeOfType (C.TypeName (tyElemName ty)) _ -> C.Expr $ C.Index buff_var index_var C..= (C.Ident tmp_var) @@ -130,7 +132,8 @@ mkstep cSettings streams triggers exts = where exvar = C.Ident cpyname locvar = C.Ident name - size = C.LitInt $ fromIntegral $ tysize ty + size = C.LitInt (fromIntegral $ tysize ty) + C..* C.SizeOfType (C.TypeName (tyElemName ty)) _ -> C.Ident cpyname C..= C.Ident name @@ -220,6 +223,16 @@ mkstep cSettings streams triggers exts = memcpy :: C.Expr -> C.Expr -> C.Expr -> C.Expr memcpy dest src size = C.Funcall (C.Ident "memcpy") [dest, src, size] + -- Translate a Copilot type to a C99 type, handling arrays especially. + -- + -- If the given type is an array (including multi-dimensional arrays), the + -- type is that of the elements in the array. Otherwise, it is just the + -- equivalent representation of the given type in C. + tyElemName :: Type a -> C.Type + tyElemName ty = case ty of + Array ty' -> tyElemName ty' + _ -> transtype ty + -- | Write a struct declaration based on its definition. mkstructdecln :: Struct a => Type a -> C.Decln mkstructdecln (Struct x) = C.TypeDecln struct From 4b8adac0f72bf527257008009ec62778a2ca3b83 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 29 Aug 2022 13:39:32 +0000 Subject: [PATCH 0469/1222] copilot-c99: Document changes in CHANGELOG. Refs #314. --- copilot-c99/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot-c99/CHANGELOG b/copilot-c99/CHANGELOG index dc59d4f44..60dd078df 100644 --- a/copilot-c99/CHANGELOG +++ b/copilot-c99/CHANGELOG @@ -1,5 +1,6 @@ -2022-08-23 +2022-08-29 * Update to support language-c99-0.2.0. (#371) + * Fix error handling buffers in generated code for 'step'. (#314) 2022-07-07 * Version bump (3.10). (#356) From 7579ac32180a66ae5431f88c4adffec3091badf8 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Wed, 7 Sep 2022 19:08:56 +0000 Subject: [PATCH 0470/1222] Bump versions and constraints (3.11). Refs #376. --- copilot-c99/copilot-c99.cabal | 4 ++-- copilot-core/copilot-core.cabal | 2 +- copilot-interpreter/copilot-interpreter.cabal | 2 +- copilot-language/copilot-language.cabal | 8 ++++---- copilot-libraries/copilot-libraries.cabal | 4 ++-- copilot-theorem/copilot-theorem.cabal | 4 ++-- copilot/copilot.cabal | 12 ++++++------ 7 files changed, 18 insertions(+), 18 deletions(-) diff --git a/copilot-c99/copilot-c99.cabal b/copilot-c99/copilot-c99.cabal index c8d682730..87ba9e74b 100644 --- a/copilot-c99/copilot-c99.cabal +++ b/copilot-c99/copilot-c99.cabal @@ -1,6 +1,6 @@ cabal-version : >= 1.10 name : copilot-c99 -version : 3.10 +version : 3.11 synopsis : A compiler for Copilot targeting C99. description : This package is a back-end from Copilot to C. @@ -49,7 +49,7 @@ library , mtl >= 2.2 && < 2.4 , pretty >= 1.1 && < 1.2 - , copilot-core >= 3.10 && < 3.11 + , copilot-core >= 3.11 && < 3.12 , language-c99 >= 0.2.0 && < 0.3 , language-c99-simple >= 0.2.2 && < 0.3 diff --git a/copilot-core/copilot-core.cabal b/copilot-core/copilot-core.cabal index dc6866e88..66e64f5ef 100644 --- a/copilot-core/copilot-core.cabal +++ b/copilot-core/copilot-core.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-core -version: 3.10 +version: 3.11 synopsis: An intermediate representation for Copilot. description: Intermediate representation for Copilot. diff --git a/copilot-interpreter/copilot-interpreter.cabal b/copilot-interpreter/copilot-interpreter.cabal index b71788d59..e1b2d0727 100644 --- a/copilot-interpreter/copilot-interpreter.cabal +++ b/copilot-interpreter/copilot-interpreter.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-interpreter -version: 3.10 +version: 3.11 synopsis: Interpreter for Copilot. description: Interpreter for Copilot. diff --git a/copilot-language/copilot-language.cabal b/copilot-language/copilot-language.cabal index 19d90000d..b4109f4e3 100644 --- a/copilot-language/copilot-language.cabal +++ b/copilot-language/copilot-language.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-language -version: 3.10 +version: 3.11 synopsis: A Haskell-embedded DSL for monitoring hard real-time distributed systems. description: @@ -42,9 +42,9 @@ library , data-reify >= 0.6 && < 0.7 , mtl >= 2.0 && < 3 - , copilot-core >= 3.10 && < 3.11 - , copilot-interpreter >= 3.10 && < 3.11 - , copilot-theorem >= 3.10 && < 3.11 + , copilot-core >= 3.11 && < 3.12 + , copilot-interpreter >= 3.11 && < 3.12 + , copilot-theorem >= 3.11 && < 3.12 exposed-modules: Copilot.Language , Copilot.Language.Operators.BitWise diff --git a/copilot-libraries/copilot-libraries.cabal b/copilot-libraries/copilot-libraries.cabal index c26d2a7d3..384af14b8 100644 --- a/copilot-libraries/copilot-libraries.cabal +++ b/copilot-libraries/copilot-libraries.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-libraries -version: 3.10 +version: 3.11 synopsis: Libraries for the Copilot language. description: Libraries for the Copilot language. @@ -41,7 +41,7 @@ library , containers >= 0.4 && < 0.7 , mtl >= 2.0 && < 2.4 , parsec >= 2.0 && < 3.2 - , copilot-language >= 3.10 && < 3.11 + , copilot-language >= 3.11 && < 3.12 exposed-modules: Copilot.Library.Libraries diff --git a/copilot-theorem/copilot-theorem.cabal b/copilot-theorem/copilot-theorem.cabal index 44a78c50f..e94e7d2ba 100644 --- a/copilot-theorem/copilot-theorem.cabal +++ b/copilot-theorem/copilot-theorem.cabal @@ -14,7 +14,7 @@ description: . -version : 3.10 +version : 3.11 license : BSD3 license-file : LICENSE maintainer : Ivan Perez @@ -63,7 +63,7 @@ library , xml >= 1.3 && < 1.4 , what4 >= 1.1 && < 1.4 - , copilot-core >= 3.10 && < 3.11 + , copilot-core >= 3.11 && < 3.12 exposed-modules : Copilot.Theorem , Copilot.Theorem.Prove diff --git a/copilot/copilot.cabal b/copilot/copilot.cabal index acbf95052..878a99729 100644 --- a/copilot/copilot.cabal +++ b/copilot/copilot.cabal @@ -1,5 +1,5 @@ name: copilot -version: 3.10 +version: 3.11 cabal-version: >= 1.10 license: BSD3 license-file: LICENSE @@ -52,11 +52,11 @@ library , directory >= 1.3 && < 1.4 , filepath >= 1.4 && < 1.5 - , copilot-core >= 3.10 && < 3.11 - , copilot-theorem >= 3.10 && < 3.11 - , copilot-language >= 3.10 && < 3.11 - , copilot-libraries >= 3.10 && < 3.11 - , copilot-c99 >= 3.10 && < 3.11 + , copilot-core >= 3.11 && < 3.12 + , copilot-theorem >= 3.11 && < 3.12 + , copilot-language >= 3.11 && < 3.12 + , copilot-libraries >= 3.11 && < 3.12 + , copilot-c99 >= 3.11 && < 3.12 exposed-modules: Language.Copilot, Language.Copilot.Main From e0d19d066a532f639b1b1d449832973f98823159 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Wed, 7 Sep 2022 19:10:49 +0000 Subject: [PATCH 0471/1222] Document changes in CHANGELOG. Refs #376. --- copilot-c99/CHANGELOG | 3 ++- copilot-core/CHANGELOG | 3 ++- copilot-interpreter/CHANGELOG | 3 ++- copilot-language/CHANGELOG | 3 ++- copilot-libraries/CHANGELOG | 3 +++ copilot-theorem/CHANGELOG | 3 +++ copilot/CHANGELOG | 3 +++ 7 files changed, 17 insertions(+), 4 deletions(-) diff --git a/copilot-c99/CHANGELOG b/copilot-c99/CHANGELOG index 60dd078df..e0c5a453a 100644 --- a/copilot-c99/CHANGELOG +++ b/copilot-c99/CHANGELOG @@ -1,4 +1,5 @@ -2022-08-29 +2022-09-07 + * Version bump (3.11). (#376) * Update to support language-c99-0.2.0. (#371) * Fix error handling buffers in generated code for 'step'. (#314) diff --git a/copilot-core/CHANGELOG b/copilot-core/CHANGELOG index ddd38d402..97c54d11f 100644 --- a/copilot-core/CHANGELOG +++ b/copilot-core/CHANGELOG @@ -1,4 +1,5 @@ -2022-08-25 +2022-09-07 + * Version bump (3.11). (#376) * Deprecate Copilot.Core.PrettyDot. (#359) * Remove Copilot.Core.Type.Dynamic. (#360) * Split copilot-interpreter into separate library. (#361) diff --git a/copilot-interpreter/CHANGELOG b/copilot-interpreter/CHANGELOG index 72121905a..3e3a5e71f 100644 --- a/copilot-interpreter/CHANGELOG +++ b/copilot-interpreter/CHANGELOG @@ -1,2 +1,3 @@ -2022-08-22 +2022-09-07 + * Version bump (3.11). (#376) * Split copilot-interpreter into separate library. (#361) diff --git a/copilot-language/CHANGELOG b/copilot-language/CHANGELOG index 35b7abd71..34addb223 100644 --- a/copilot-language/CHANGELOG +++ b/copilot-language/CHANGELOG @@ -1,4 +1,5 @@ -2022-08-25 +2022-09-07 + * Version bump (3.11). (#376) * Deprecate prettyPrint. (#362) * Reimplement DynStableName without unsafeCoerce. (#262) * Use interpreter from copilot-interpreter. (#361) diff --git a/copilot-libraries/CHANGELOG b/copilot-libraries/CHANGELOG index 5fe06a723..48ff3a2cc 100644 --- a/copilot-libraries/CHANGELOG +++ b/copilot-libraries/CHANGELOG @@ -1,3 +1,6 @@ +2022-09-07 + * Version bump (3.11). (#376) + 2022-07-07 * Version bump (3.10). (#356) * Remove unnecessary dependencies from Cabal package. (#327) diff --git a/copilot-theorem/CHANGELOG b/copilot-theorem/CHANGELOG index 9a4b655f4..16e12fc62 100644 --- a/copilot-theorem/CHANGELOG +++ b/copilot-theorem/CHANGELOG @@ -1,3 +1,6 @@ +2022-09-07 + * Version bump (3.11). (#376) + 2022-07-07 * Version bump (3.10). (#356) * Remove comment from cabal file. (#325) diff --git a/copilot/CHANGELOG b/copilot/CHANGELOG index 3642a3686..1677ec349 100644 --- a/copilot/CHANGELOG +++ b/copilot/CHANGELOG @@ -1,3 +1,6 @@ +2022-09-07 + * Version bump (3.11). (#376) + 2022-07-07 * Version bump (3.10). (#356) * Run tests in CI. (#329) From 4ae3f249fbf8c37c0909046150ff341d432bd042 Mon Sep 17 00:00:00 2001 From: Ryan Scott Date: Sat, 16 Jul 2022 10:58:10 -0400 Subject: [PATCH 0472/1222] copilot-theorem: Add functionality for bisimulation proofs. Refs #363. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit In pursuit of proving the correctness of `copilot-c99`–generated code, this patch introduces the `computeBisimulationProofBundle` function, which returns all of the symbolic states necessary to carry out a bisimulation proof. The `BisimulationProofBundle` that this returns facilitates performing k-induction on all the properties in a given specification, where k is chosen to be the maximum amount of delay on any of the involved streams. In order to make this possible, a fair bit of refactoring had to be made to the internals of `TransM` and the associated What4 translation machinery. While related, the bisimulation machinery is doing something separate from the bits that translate Copilot specifications directly to What4 formulas. For this reason, this patch moves all of the translation-related functions to a new `Copilot.Theorem.What4.Translate` module, which helps to keep this part of `copilot-theorem` more self-contained. --- copilot-theorem/copilot-theorem.cabal | 3 +- copilot-theorem/src/Copilot/Theorem/What4.hs | 1154 ++++---------- .../src/Copilot/Theorem/What4/Translate.hs | 1375 +++++++++++++++++ 3 files changed, 1700 insertions(+), 832 deletions(-) create mode 100644 copilot-theorem/src/Copilot/Theorem/What4/Translate.hs diff --git a/copilot-theorem/copilot-theorem.cabal b/copilot-theorem/copilot-theorem.cabal index e94e7d2ba..577ef96d8 100644 --- a/copilot-theorem/copilot-theorem.cabal +++ b/copilot-theorem/copilot-theorem.cabal @@ -61,7 +61,7 @@ library , random >= 1.1 && < 1.3 , transformers >= 0.5 && < 0.7 , xml >= 1.3 && < 1.4 - , what4 >= 1.1 && < 1.4 + , what4 >= 1.3 && < 1.4 , copilot-core >= 3.11 && < 3.12 @@ -106,3 +106,4 @@ library , Copilot.Theorem.TransSys.Operators , Copilot.Theorem.TransSys.Type + , Copilot.Theorem.What4.Translate diff --git a/copilot-theorem/src/Copilot/Theorem/What4.hs b/copilot-theorem/src/Copilot/Theorem/What4.hs index 33d1a1c39..48dc8047c 100644 --- a/copilot-theorem/src/Copilot/Theorem/What4.hs +++ b/copilot-theorem/src/Copilot/Theorem/What4.hs @@ -26,89 +26,57 @@ -- @What4@. A backend solver is then used to prove the property is true. The -- technique is sound, but incomplete. If a property is proved true by this -- technique, then it can be guaranteed to be true. However, if a property is --- not proved true, that does not mean it isn't true. Very simple specifications --- are unprovable by this technique, including: +-- not proved true, that does not mean it isn't true; the proof may fail because +-- the given property is not inductive. -- --- @ --- a = True : a --- @ --- --- The above specification will not be proved true. The reason is that this --- technique does not perform any sort of induction. When proving the inner @a@ --- expression, the technique merely allocates a fresh constant standing for --- "@a@, one timestep in the past." Nothing is asserted about the fresh --- constant. --- --- An example of a property that is provable by this approach is: --- --- @ --- a = True : b --- b = not a --- --- -- Property: a || b --- @ --- --- By allocating a fresh constant, @b_-1@, standing for "the value of @b@ one --- timestep in the past", the equation for @a || b@ at some arbitrary point in --- the future reduces to @b_-1 || not b_-1@, which is always true. --- --- In addition to proving that the stream expression is true at some arbitrary --- point in the future, we also prove it for the first @k@ timesteps, where @k@ --- is the maximum buffer length of all streams in the given spec. This amounts --- to simply interpreting the spec, although external variables are still --- represented as constants with unknown values. - +-- We perform @k@-induction on all the properties in a given specification where +-- @k@ is chosen to be the maximum amount of delay on any of the involved +-- streams. This is a heuristic choice, but often effective. module Copilot.Theorem.What4 - ( prove, Solver(..), SatResult(..) + ( -- * Proving properties about Copilot specifications + prove + , Solver(..) + , SatResult(..) + -- * Bisimulation proofs about @copilot-c99@ code + , computeBisimulationProofBundle + , BisimulationProofBundle(..) + , BisimulationProofState(..) + -- * What4 representations of Copilot expressions + , XExpr(..) ) where -import qualified Copilot.Core.Expr as CE -import qualified Copilot.Core.Operators as CE -import qualified Copilot.Core.Spec as CS -import qualified Copilot.Core.Type as CT -import qualified Copilot.Core.Type.Array as CT - -import qualified What4.Config as WC -import qualified What4.Expr.Builder as WB -import qualified What4.Expr.GroundEval as WG -import qualified What4.Interface as WI -import qualified What4.BaseTypes as WT -import qualified What4.Solver as WS -import qualified What4.Solver.DReal as WS - -import qualified Control.Monad.Fail as Fail +import qualified Copilot.Core.Expr as CE +import qualified Copilot.Core.Spec as CS +import qualified Copilot.Core.Type as CT + +import qualified What4.Config as WC +import qualified What4.Expr.Builder as WB +import qualified What4.Expr.GroundEval as WG +import qualified What4.Interface as WI +import qualified What4.InterpretedFloatingPoint as WFP +import qualified What4.Solver as WS +import qualified What4.Solver.DReal as WS + import Control.Monad.State import qualified Data.BitVector.Sized as BV import Data.Foldable (foldrM) -import Data.List (elemIndex) -import Data.Maybe (fromJust) +import Data.List (genericLength) import qualified Data.Map as Map -import Data.Parameterized.Classes -import Data.Parameterized.Context hiding (zipWithM) import Data.Parameterized.NatRepr import Data.Parameterized.Nonce import Data.Parameterized.Some -import Data.Parameterized.SymbolRepr -import qualified Data.Parameterized.Vector as V -import Data.Word -import LibBF ( bfToDouble - , bfFromDouble - , bfPosZero - , pattern NearEven ) -import GHC.TypeNats (KnownNat) +import GHC.Float (castWord32ToFloat, castWord64ToDouble) +import LibBF (BigFloat, bfToDouble, pattern NearEven) import qualified Panic as Panic +import Copilot.Theorem.What4.Translate + -- 'prove' function -- -- To prove properties of a spec, we translate them into What4 using the TransM -- monad (transformer on top of IO), then negate each property and ask a backend -- solver to produce a model for the negation. --- | We assume round-near-even throughout, but this variable can be changed if --- needed. -fpRM :: WI.RoundingMode -fpRM = WI.RNE - -- | No builder state needed. data BuilderState a = EmptyState @@ -142,26 +110,48 @@ prove solver spec = do Yices -> WC.extendConfig WS.yicesOptions (WI.getConfiguration sym) Z3 -> WC.extendConfig WS.z3Options (WI.getConfiguration sym) - -- Build up initial translation state - let streamMap = Map.fromList $ - (\stream -> (CS.streamId stream, stream)) <$> CS.specStreams spec - pow <- WI.freshTotalUninterpFn sym (WI.safeSymbol "pow") knownRepr knownRepr - logb <- WI.freshTotalUninterpFn sym (WI.safeSymbol "logb") knownRepr knownRepr - let st = TransState Map.empty Map.empty Map.empty streamMap pow logb + -- Compute the maximum amount of delay for any stream in this spec + let bufLen (CS.Stream _ buf _ _) = genericLength buf + maxBufLen = maximum (0 : (bufLen <$> CS.specStreams spec)) - -- Define TransM action for proving properties. Doing this in TransM rather - -- than IO allows us to reuse the state for each property. + -- This process performs k-induction where we use @k = maxBufLen@. + -- The choice for @k@ is heuristic, but often effective. let proveProperties = forM (CS.specProperties spec) $ \pr -> do - let bufLen (CS.Stream _ buf _ _) = length buf - maxBufLen = maximum (0 : (bufLen <$> CS.specStreams spec)) - prefix <- forM [0 .. maxBufLen - 1] $ \k -> do - XBool p <- translateExprAt sym k (CS.propertyExpr pr) - return p - XBool p <- translateExpr sym 0 (CS.propertyExpr pr) - p_and_prefix <- liftIO $ foldrM (WI.andPred sym) p prefix - not_p_and_prefix <- liftIO $ WI.notPred sym p_and_prefix - - let clauses = [not_p_and_prefix] + -- State the base cases for k induction. + base_cases <- forM [0 .. maxBufLen - 1] $ \i -> do + xe <- translateExpr sym mempty (CS.propertyExpr pr) (AbsoluteOffset i) + case xe of + XBool p -> return p + _ -> expectedBool "Property" xe + + -- Translate the induction hypothesis for all values up to maxBufLen in + -- the past + ind_hyps <- forM [0 .. maxBufLen-1] $ \i -> do + xe <- translateExpr sym mempty (CS.propertyExpr pr) (RelativeOffset i) + case xe of + XBool hyp -> return hyp + _ -> expectedBool "Property" xe + + -- Translate the predicate for the "current" value + ind_goal <- do + xe <- translateExpr sym + mempty + (CS.propertyExpr pr) + (RelativeOffset maxBufLen) + case xe of + XBool p -> return p + _ -> expectedBool "Property" xe + + -- Compute the predicate (ind_hyps ==> p) + ind_case <- liftIO $ foldrM (WI.impliesPred sym) ind_goal ind_hyps + + -- Compute the conjunction of the base and inductive cases + p <- liftIO $ foldrM (WI.andPred sym) ind_case base_cases + + -- Negate the goals for for SAT search + not_p <- liftIO $ WI.notPred sym p + let clauses = [not_p] + case solver of CVC4 -> liftIO $ WS.runCVC4InOverride sym WS.defaultLogData clauses $ \case WS.Sat (_ge, _) -> return (CS.propertyName pr, Invalid) @@ -181,111 +171,232 @@ prove solver spec = do WS.Unknown -> return (CS.propertyName pr, Unknown) -- Execute the action and return the results for each property - (res, _) <- runStateT (unTransM proveProperties) st - return res - --- What4 translation - --- | the state for translating Copilot expressions into What4 expressions. As we --- translate, we generate fresh symbolic constants for external variables and --- for stream variables. We need to only generate one constant per variable, so --- we allocate them in a map. When we need the constant for a particular --- variable, we check if it is already in the map, and return it if it is; if it --- isn't, we generate a fresh constant at that point, store it in the map, and --- return it. --- --- We also store three immutable fields in this state, rather than wrap them up --- in another monad transformer layer. These are initialized prior to --- translation and are never modified. They are the map from stream ids to the --- core stream definitions, a symbolic uninterpreted function for "pow", and a --- symbolic uninterpreted function for "logb". -data TransState t = TransState { - -- | Map of all external variables we encounter during translation. These are - -- just fresh constants. The offset indicates how many timesteps in the past - -- this constant represents for that stream. - externVars :: Map.Map (CE.Name, Int) (XExpr t), - -- | Map of external variables at specific indices (positive), rather than - -- offset into the past. This is for interpreting streams at specific offsets. - externVarsAt :: Map.Map (CE.Name, Int) (XExpr t), - -- | Map from (stream id, negative offset) to fresh constant. These are all - -- constants representing the values of a stream at some point in the past. - -- The offset (ALWAYS NEGATIVE) indicates how many timesteps in the past - -- this constant represents for that stream. - streamConstants :: Map.Map (CE.Id, Int) (XExpr t), - -- | Map from stream ids to the streams themselves. This value is never - -- modified, but I didn't want to make this an RWS, so it's represented as a - -- stateful value. - streams :: Map.Map CE.Id CS.Stream, - -- | Binary power operator, represented as an uninterpreted function. - pow :: WB.ExprSymFn t - (EmptyCtx ::> WT.BaseRealType ::> WT.BaseRealType) - WT.BaseRealType, - -- | Binary logarithm operator, represented as an uninterpreted function. - logb :: WB.ExprSymFn t - (EmptyCtx ::> WT.BaseRealType ::> WT.BaseRealType) - WT.BaseRealType - } - -newtype TransM t a = TransM { unTransM :: StateT (TransState t) IO a } - deriving ( Functor - , Applicative - , Monad - , MonadIO - , MonadState (TransState t) - ) - -instance Fail.MonadFail (TransM t) where - fail = error - -data CopilotWhat4 = CopilotWhat4 - -instance Panic.PanicComponent CopilotWhat4 where - panicComponentName _ = "Copilot/What4 translation" - panicComponentIssues _ = "https://github.com/Copilot-Language/copilot/issues" - - {-# NOINLINE Panic.panicComponentRevision #-} - panicComponentRevision = $(Panic.useGitRevision) - --- | Use this function rather than an error monad since it indicates that --- copilot-core's "reify" function did something incorrectly. -panic :: MonadIO m => m a -panic = Panic.panic CopilotWhat4 "Copilot.Theorem.What4" - [ "Ill-typed core expression" ] - --- | The What4 representation of a copilot expression. We do not attempt to --- track the type of the inner expression at the type level, but instead lump --- everything together into the 'XExpr t' type. The only reason this is a GADT --- is for the array case; we need to know that the array length is strictly --- positive. -data XExpr t where - XBool :: WB.Expr t WT.BaseBoolType -> XExpr t - XInt8 :: WB.Expr t (WT.BaseBVType 8) -> XExpr t - XInt16 :: WB.Expr t (WT.BaseBVType 16) -> XExpr t - XInt32 :: WB.Expr t (WT.BaseBVType 32) -> XExpr t - XInt64 :: WB.Expr t (WT.BaseBVType 64) -> XExpr t - XWord8 :: WB.Expr t (WT.BaseBVType 8) -> XExpr t - XWord16 :: WB.Expr t (WT.BaseBVType 16) -> XExpr t - XWord32 :: WB.Expr t (WT.BaseBVType 32) -> XExpr t - XWord64 :: WB.Expr t (WT.BaseBVType 64) -> XExpr t - XFloat :: WB.Expr t (WT.BaseFloatType WT.Prec32) -> XExpr t - XDouble :: WB.Expr t (WT.BaseFloatType WT.Prec64) -> XExpr t - XEmptyArray :: XExpr t - XArray :: 1 <= n => V.Vector n (XExpr t) -> XExpr t - XStruct :: [XExpr t] -> XExpr t - -- XArray :: NatRepr n - -- -> BaseTypeRepr tp - -- -> Some (WB.Expr t) - -- XStruct :: Assignment BaseTypeRepr tps - -- -> WB.Expr t (BaseStructType tps) - -- -> XExpr t - -deriving instance Show (XExpr t) + runTransM spec proveProperties + +-- Bisimulation proofs + +-- | Given a Copilot specification, compute all of the symbolic states necessary +-- to carry out a bisimulation proof that establishes a correspondence between +-- the states of the Copilot stream program and the C code that @copilot-c99@ +-- would generate for that Copilot program. +computeBisimulationProofBundle :: + WFP.IsInterpretedFloatSymExprBuilder sym + => sym + -> [String] + -- ^ Names of properties to assume during verification + -> CS.Spec + -- ^ The input Copilot specification + -> IO (BisimulationProofBundle sym) +computeBisimulationProofBundle sym properties spec = do + iss <- computeInitialStreamState sym spec + runTransM spec $ do + prestate <- computePrestate sym spec + poststate <- computePoststate sym spec + triggers <- computeTriggerState sym spec + assms <- computeAssumptions sym properties spec + externs <- computeExternalInputs sym + sideCnds <- gets sidePreds + return + BisimulationProofBundle + { initialStreamState = iss + , preStreamState = prestate + , postStreamState = poststate + , externalInputs = externs + , triggerState = triggers + , assumptions = assms + , sideConds = sideCnds + } + +-- | A collection of all of the symbolic states necessary to carry out a +-- bisimulation proof. +data BisimulationProofBundle sym = + BisimulationProofBundle + { initialStreamState :: BisimulationProofState sym + -- ^ The state of the global variables at program startup + , preStreamState :: BisimulationProofState sym + -- ^ The stream state prior to invoking the step function + , postStreamState :: BisimulationProofState sym + -- ^ The stream state after invoking the step function + , externalInputs :: [(CE.Name, Some CT.Type, XExpr sym)] + -- ^ A list of external streams, where each tuple contains: + -- + -- 1. The name of the stream + -- + -- 2. The type of the stream + -- + -- 3. The value of the stream represented as a fresh constant + , triggerState :: [(CE.Name, WI.Pred sym, [(Some CT.Type, XExpr sym)])] + -- ^ A list of trigger functions, where each tuple contains: + -- + -- 1. The name of the function + -- + -- 2. A formula representing the guarded condition + -- + -- 3. The arguments to the function, where each argument is represented as + -- a type-value pair + , assumptions :: [WI.Pred sym] + -- ^ User-provided property assumptions + , sideConds :: [WI.Pred sym] + -- ^ Side conditions related to partial operations + } + +-- | The state of a bisimulation proof at a particular step. +newtype BisimulationProofState sym = + BisimulationProofState + { streamState :: [(CE.Id, Some CT.Type, [XExpr sym])] + -- ^ A list of tuples containing: + -- + -- 1. The name of a stream + -- + -- 2. The type of the stream + -- + -- 3. The list of values in the stream description + } + +-- | Compute the initial state of the global variables at the start of a Copilot +-- program. +computeInitialStreamState :: + WFP.IsInterpretedFloatSymExprBuilder sym + => sym + -> CS.Spec + -- ^ The input Copilot specification + -> IO (BisimulationProofState sym) +computeInitialStreamState sym spec = do + xs <- forM (CS.specStreams spec) $ + \CS.Stream { CS.streamId = nm, CS.streamExprType = tp + , CS.streamBuffer = buf } -> + do vs <- mapM (translateConstExpr sym tp) buf + return (nm, Some tp, vs) + return (BisimulationProofState xs) + +-- | Compute the stream state of a Copilot program prior to invoking the step +-- function. +computePrestate :: + WFP.IsInterpretedFloatSymExprBuilder sym + => sym + -> CS.Spec + -- ^ The input Copilot specification + -> TransM sym (BisimulationProofState sym) +computePrestate sym spec = do + xs <- forM (CS.specStreams spec) $ + \CS.Stream { CS.streamId = nm, CS.streamExprType = tp + , CS.streamBuffer = buf } -> + do let buflen = genericLength buf + let idxes = RelativeOffset <$> [0 .. buflen-1] + vs <- mapM (getStreamValue sym nm) idxes + return (nm, Some tp, vs) + return (BisimulationProofState xs) + +-- | Compute ehe stream state of a Copilot program after invoking the step +-- function. +computePoststate :: + WFP.IsInterpretedFloatSymExprBuilder sym + => sym + -> CS.Spec + -- ^ The input Copilot specification + -> TransM sym (BisimulationProofState sym) +computePoststate sym spec = do + xs <- forM (CS.specStreams spec) $ + \CS.Stream { CS.streamId = nm, CS.streamExprType = tp + , CS.streamBuffer = buf } -> + do let buflen = genericLength buf + let idxes = RelativeOffset <$> [1 .. buflen] + vs <- mapM (getStreamValue sym nm) idxes + return (nm, Some tp, vs) + return (BisimulationProofState xs) + +-- | Compute the trigger functions in a Copilot program. +computeTriggerState :: + WFP.IsInterpretedFloatSymExprBuilder sym + => sym + -> CS.Spec + -- ^ The input Copilot specification + -> TransM sym [(CE.Name, WI.Pred sym, [(Some CT.Type, XExpr sym)])] +computeTriggerState sym spec = forM (CS.specTriggers spec) $ + \(CS.Trigger { CS.triggerName = nm, CS.triggerGuard = guard + , CS.triggerArgs = args }) -> + do xguard <- translateExpr sym mempty guard (RelativeOffset 0) + guard' <- + case xguard of + XBool guard' -> return guard' + _ -> expectedBool "Trigger guard" xguard + args' <- mapM computeArg args + return (nm, guard', args') + where + computeArg (CE.UExpr { CE.uExprType = tp, CE.uExprExpr = ex }) = do + v <- translateExpr sym mempty ex (RelativeOffset 0) + return (Some tp, v) + +-- | Compute the values of the external streams in a Copilot program, where each +-- external stream is represented as a fresh constant. +computeExternalInputs :: + WFP.IsInterpretedFloatSymExprBuilder sym + => sym + -> TransM sym [(CE.Name, Some CT.Type, XExpr sym)] +computeExternalInputs sym = do + exts <- Map.toList <$> gets mentionedExternals + forM exts $ \(nm, Some tp) -> do + v <- getExternConstant sym tp nm (RelativeOffset 0) + return (nm, Some tp, v) + +-- | Compute the user-provided property assumptions in a Copilot program. +computeAssumptions :: + forall sym. + WFP.IsInterpretedFloatSymExprBuilder sym + => sym + -> [String] + -- ^ Names of properties to assume during verification + -> CS.Spec + -- ^ The input Copilot specification + -> TransM sym [WI.Pred sym] +computeAssumptions sym properties spec = + concat <$> forM specPropertyExprs computeAssumption + where + bufLen (CS.Stream _ buf _ _) = genericLength buf + maxBufLen = maximum (0 : (bufLen <$> CS.specStreams spec)) + + -- Retrieve the boolean-values Copilot expressions corresponding to the + -- user-provided property assumptions. + specPropertyExprs :: [CE.Expr Bool] + specPropertyExprs = + [ CS.propertyExpr p + | p <- CS.specProperties spec + , elem (CS.propertyName p) properties + ] + + -- Compute all of the what4 predicates corresponding to each user-provided + -- property assumption. + computeAssumption :: CE.Expr Bool -> TransM sym [WI.Pred sym] + computeAssumption e = forM [0 .. maxBufLen] $ \i -> do + xe <- translateExpr sym mempty e (RelativeOffset i) + case xe of + XBool b -> return b + _ -> expectedBool "Property" xe + +-- * Auxiliary functions + +-- | A catch-all 'panic' to use when an 'XExpr' is is expected to uphold the +-- invariant that it is an 'XBool', but the invariant is violated. +expectedBool :: forall m sym a. + (Panic.HasCallStack, MonadIO m, WI.IsExprBuilder sym) + => String + -- ^ What the 'XExpr' represents + -> XExpr sym + -> m a +expectedBool what xe = + panic [what ++ " expected to have boolean result", show xe] data CopilotValue a = CopilotValue { cvType :: CT.Type a , cvVal :: a } -valFromExpr :: WG.GroundEvalFn t -> XExpr t -> IO (Some CopilotValue) +valFromExpr :: forall sym t st fm. + ( sym ~ WB.ExprBuilder t st (WB.Flags fm) + , WI.KnownRepr WB.FloatModeRepr fm + ) + => WG.GroundEvalFn t + -> XExpr sym + -> IO (Some CopilotValue) valFromExpr ge xe = case xe of XBool e -> Some . CopilotValue CT.Bool <$> WG.groundEval ge e XInt8 e -> Some . CopilotValue CT.Int8 . fromBV <$> WG.groundEval ge e @@ -297,658 +408,39 @@ valFromExpr ge xe = case xe of XWord32 e -> Some . CopilotValue CT.Word32 . fromBV <$> WG.groundEval ge e XWord64 e -> Some . CopilotValue CT.Word64 . fromBV <$> WG.groundEval ge e XFloat e -> - Some . CopilotValue CT.Float . realToFrac . fst . bfToDouble NearEven <$> WG.groundEval ge e + Some . CopilotValue CT.Float <$> + iFloatGroundEval WFP.SingleFloatRepr e + (realToFrac . fst . bfToDouble NearEven) + fromRational + (castWord32ToFloat . fromInteger . BV.asUnsigned) XDouble e -> - Some . CopilotValue CT.Double . fst . bfToDouble NearEven <$> WG.groundEval ge e + Some . CopilotValue CT.Double <$> + iFloatGroundEval WFP.DoubleFloatRepr e + (fst . bfToDouble NearEven) + fromRational + (castWord64ToDouble . fromInteger . BV.asUnsigned) _ -> error "valFromExpr unhandled case" where fromBV :: forall a w . Num a => BV.BV w -> a fromBV = fromInteger . BV.asUnsigned --- | A view of an XExpr as a bitvector expression, a natrepr for its width, its --- signed/unsigned status, and the constructor used to reconstruct an XExpr from --- it. This is a useful view for translation, as many of the operations can be --- grouped together for all words\/ints\/floats. -data SomeBVExpr t where - SomeBVExpr :: 1 <= w - => WB.BVExpr t w - -> NatRepr w - -> BVSign - -> (WB.BVExpr t w -> XExpr t) - -> SomeBVExpr t - --- | The sign of a bitvector -- this indicates whether it is to be interpreted --- as a signed 'Int' or an unsigned 'Word'. -data BVSign = Signed | Unsigned - --- | If the inner expression can be viewed as a bitvector, we project out a view --- of it as such. -asBVExpr :: XExpr t -> Maybe (SomeBVExpr t) -asBVExpr xe = case xe of - XInt8 e -> Just (SomeBVExpr e knownNat Signed XInt8) - XInt16 e -> Just (SomeBVExpr e knownNat Signed XInt16) - XInt32 e -> Just (SomeBVExpr e knownNat Signed XInt32) - XInt64 e -> Just (SomeBVExpr e knownNat Signed XInt64) - XWord8 e -> Just (SomeBVExpr e knownNat Unsigned XWord8) - XWord16 e -> Just (SomeBVExpr e knownNat Unsigned XWord16) - XWord32 e -> Just (SomeBVExpr e knownNat Unsigned XWord32) - XWord64 e -> Just (SomeBVExpr e knownNat Unsigned XWord64) - _ -> Nothing - --- | Translate a constant expression by creating a what4 literal and packaging --- it up into an 'XExpr'. -translateConstExpr :: forall a t st fs . - WB.ExprBuilder t st fs - -> CT.Type a - -> a - -> IO (XExpr t) -translateConstExpr sym tp a = case tp of - CT.Bool -> case a of - True -> return $ XBool (WI.truePred sym) - False -> return $ XBool (WI.falsePred sym) - CT.Int8 -> XInt8 <$> WI.bvLit sym knownNat (BV.int8 a) - CT.Int16 -> XInt16 <$> WI.bvLit sym knownNat (BV.int16 a) - CT.Int32 -> XInt32 <$> WI.bvLit sym knownNat (BV.int32 a) - CT.Int64 -> XInt64 <$> WI.bvLit sym knownNat (BV.int64 a) - CT.Word8 -> XWord8 <$> WI.bvLit sym knownNat (BV.word8 a) - CT.Word16 -> XWord16 <$> WI.bvLit sym knownNat (BV.word16 a) - CT.Word32 -> XWord32 <$> WI.bvLit sym knownNat (BV.word32 a) - CT.Word64 -> XWord64 <$> WI.bvLit sym knownNat (BV.word64 a) - CT.Float -> XFloat <$> WI.floatLit sym knownRepr (bfFromDouble (realToFrac a)) - CT.Double -> XDouble <$> WI.floatLit sym knownRepr (bfFromDouble a) - CT.Array tp -> do - elts <- traverse (translateConstExpr sym tp) (CT.arrayelems a) - Just (Some n) <- return $ someNat (length elts) - case isZeroOrGT1 n of - Left Refl -> return XEmptyArray - Right LeqProof -> do - let Just v = V.fromList n elts - return $ XArray v - CT.Struct _ -> do - elts <- forM (CT.toValues a) $ \(CT.Value tp (CT.Field a)) -> - translateConstExpr sym tp a - return $ XStruct elts - -arrayLen :: KnownNat n => CT.Type (CT.Array n t) -> NatRepr n -arrayLen _ = knownNat - --- | Generate a fresh constant for a given copilot type. This will be called --- whenever we attempt to get the constant for a given external variable or --- stream variable, but that variable has not been accessed yet and therefore --- has no constant allocated. -freshCPConstant :: forall t st fs a . - WB.ExprBuilder t st fs - -> String - -> CT.Type a - -> IO (XExpr t) -freshCPConstant sym nm tp = case tp of - CT.Bool -> XBool <$> WI.freshConstant sym (WI.safeSymbol nm) knownRepr - CT.Int8 -> XInt8 <$> WI.freshConstant sym (WI.safeSymbol nm) knownRepr - CT.Int16 -> XInt16 <$> WI.freshConstant sym (WI.safeSymbol nm) knownRepr - CT.Int32 -> XInt32 <$> WI.freshConstant sym (WI.safeSymbol nm) knownRepr - CT.Int64 -> XInt64 <$> WI.freshConstant sym (WI.safeSymbol nm) knownRepr - CT.Word8 -> XWord8 <$> WI.freshConstant sym (WI.safeSymbol nm) knownRepr - CT.Word16 -> XWord16 <$> WI.freshConstant sym (WI.safeSymbol nm) knownRepr - CT.Word32 -> XWord32 <$> WI.freshConstant sym (WI.safeSymbol nm) knownRepr - CT.Word64 -> XWord64 <$> WI.freshConstant sym (WI.safeSymbol nm) knownRepr - CT.Float -> XFloat <$> WI.freshConstant sym (WI.safeSymbol nm) knownRepr - CT.Double -> XDouble <$> WI.freshConstant sym (WI.safeSymbol nm) knownRepr - atp@(CT.Array itp) -> do - n <- return $ arrayLen atp - case isZeroOrGT1 n of - Left Refl -> return XEmptyArray - Right LeqProof -> do - Refl <- return $ minusPlusCancel n (knownNat @1) - elts :: V.Vector n (XExpr t) <- V.generateM (decNat n) (const (freshCPConstant sym "" itp)) - return $ XArray elts - CT.Struct stp -> do - elts <- forM (CT.toValues stp) $ \(CT.Value ftp _) -> freshCPConstant sym "" ftp - return $ XStruct elts - --- | Get the constant for a given stream id and some offset into the past. This --- should only be called with a strictly negative offset. When this function --- gets called for the first time for a given (streamId, offset) pair, it --- generates a fresh constant and stores it in an internal map. Thereafter, this --- function will just return that constant when called with the same pair. -getStreamConstant :: WB.ExprBuilder t st fs -> CE.Id -> Int -> TransM t (XExpr t) -getStreamConstant sym streamId offset = do - scs <- gets streamConstants - case Map.lookup (streamId, offset) scs of - Just xe -> return xe - Nothing -> do - CS.Stream _ _ _ tp <- getStreamDef streamId - let nm = show streamId ++ "_" ++ show offset - xe <- liftIO $ freshCPConstant sym nm tp - modify (\st -> st { streamConstants = Map.insert (streamId, offset) xe scs }) - return xe - --- | Get the constant for a given external variable and some offset into the --- past. This should only be called with a strictly negative offset. When this --- function gets called for the first time for a given (var, offset) pair, it --- generates a fresh constant and stores it in an internal map. Thereafter, this --- function will just return that constant when called with the same pair. -getExternConstant :: WB.ExprBuilder t st fs - -> CT.Type a - -> CE.Name - -> Int - -> TransM t (XExpr t) -getExternConstant sym tp var offset = do - es <- gets externVars - case Map.lookup (var, offset) es of - Just xe -> return xe - Nothing -> do - xe <- liftIO $ freshCPConstant sym var tp - modify (\st -> st { externVars = Map.insert (var, offset) xe es} ) - return xe - --- | Get the constant for a given external variable at some specific timestep. -getExternConstantAt :: WB.ExprBuilder t st fs - -> CT.Type a - -> CE.Name - -> Int - -> TransM t (XExpr t) -getExternConstantAt sym tp var ix = do - es <- gets externVarsAt - case Map.lookup (var, ix) es of - Just xe -> return xe - Nothing -> do - xe <- liftIO $ freshCPConstant sym var tp - modify (\st -> st { externVarsAt = Map.insert (var, ix) xe es} ) - return xe - --- | Retrieve a stream definition given its id. -getStreamDef :: CE.Id -> TransM t CS.Stream -getStreamDef streamId = fromJust <$> gets (Map.lookup streamId . streams) - --- | Translate an expression into a what4 representation. The int offset keeps --- track of how many timesteps into the past each variable is referring to. --- Initially the value should be zero, but when we translate a stream, the --- offset is recomputed based on the length of that stream's prefix (subtracted) --- and the drop index (added). -translateExpr :: WB.ExprBuilder t st fs - -> Int - -- ^ number of timesteps in the past we are currently looking - -- (must always be <= 0) - -> CE.Expr a - -> TransM t (XExpr t) -translateExpr sym offset e = case e of - CE.Const tp a -> liftIO $ translateConstExpr sym tp a - CE.Drop _tp ix streamId - -- If we are referencing a past value of this stream, just return an - -- unconstrained constant. - | offset + fromIntegral ix < 0 -> - getStreamConstant sym streamId (offset + fromIntegral ix) - -- If we are referencing a current or future value of this stream, we need - -- to translate the stream's expression, using an offset computed based on - -- the current offset (negative or 0), the drop index (positive or 0), and - -- the length of the stream's buffer (subtracted). - | otherwise -> do - CS.Stream _ buf e _ <- getStreamDef streamId - translateExpr sym (offset + fromIntegral ix - length buf) e - CE.Local _ _ _ _ _ -> error "translateExpr: Local unimplemented" - CE.Var _ _ -> error "translateExpr: Var unimplemented" - CE.ExternVar tp nm _prefix -> getExternConstant sym tp nm offset - CE.Op1 op e -> liftIO . translateOp1 sym op =<< translateExpr sym offset e - CE.Op2 op e1 e2 -> do - xe1 <- translateExpr sym offset e1 - xe2 <- translateExpr sym offset e2 - powFn <- gets pow - logbFn <- gets logb - liftIO $ translateOp2 sym powFn logbFn op xe1 xe2 - CE.Op3 op e1 e2 e3 -> do - xe1 <- translateExpr sym offset e1 - xe2 <- translateExpr sym offset e2 - xe3 <- translateExpr sym offset e3 - liftIO $ translateOp3 sym op xe1 xe2 xe3 - CE.Label _ _ _ -> error "translateExpr: Label unimplemented" - --- | Translate an expression into a what4 representation at a /specific/ --- timestep, rather than "at some indeterminate point in the future." -translateExprAt :: WB.ExprBuilder t st fs - -> Int - -- ^ Index of timestep - -> CE.Expr a - -- ^ stream expression - -> TransM t (XExpr t) -translateExprAt sym k e = do - case e of - CE.Const tp a -> liftIO $ translateConstExpr sym tp a - CE.Drop _tp ix streamId -> do - CS.Stream _ buf e tp <- getStreamDef streamId - if k' < length buf - then liftIO $ translateConstExpr sym tp (buf !! k') - else translateExprAt sym (k' - length buf) e - where - k' = k + fromIntegral ix - CE.Local _ _ _ _ _ -> error "translateExpr: Local unimplemented" - CE.Var _ _ -> error "translateExpr: Var unimplemented" - CE.ExternVar tp nm _prefix -> getExternConstantAt sym tp nm k - CE.Op1 op e -> liftIO . translateOp1 sym op =<< translateExprAt sym k e - CE.Op2 op e1 e2 -> do - xe1 <- translateExprAt sym k e1 - xe2 <- translateExprAt sym k e2 - powFn <- gets pow - logbFn <- gets logb - liftIO $ translateOp2 sym powFn logbFn op xe1 xe2 - CE.Op3 op e1 e2 e3 -> do - xe1 <- translateExprAt sym k e1 - xe2 <- translateExprAt sym k e2 - xe3 <- translateExprAt sym k e3 - liftIO $ translateOp3 sym op xe1 xe2 xe3 - CE.Label _ _ _ -> error "translateExpr: Label unimplemented" - -type BVOp1 w t = (KnownNat w, 1 <= w) => WB.BVExpr t w -> IO (WB.BVExpr t w) - -type FPOp1 fpp t = KnownRepr WT.FloatPrecisionRepr fpp => WB.Expr t (WT.BaseFloatType fpp) -> IO (WB.Expr t (WT.BaseFloatType fpp)) - -type RealOp1 t = WB.Expr t WT.BaseRealType -> IO (WB.Expr t WT.BaseRealType) - -fieldName :: KnownSymbol s => CT.Field s a -> SymbolRepr s -fieldName _ = knownSymbol - -valueName :: CT.Value a -> Some SymbolRepr -valueName (CT.Value _ f) = Some (fieldName f) - -translateOp1 :: forall t st fs a b . - WB.ExprBuilder t st fs - -> CE.Op1 a b - -> XExpr t - -> IO (XExpr t) -translateOp1 sym op xe = case (op, xe) of - (CE.Not, XBool e) -> XBool <$> WI.notPred sym e - (CE.Not, _) -> panic - (CE.Abs _, xe) -> numOp bvAbs fpAbs xe - where - bvAbs :: BVOp1 w t - bvAbs e = do zero <- WI.bvLit sym knownNat (BV.zero knownNat) - e_neg <- WI.bvSlt sym e zero - neg_e <- WI.bvSub sym zero e - WI.bvIte sym e_neg neg_e e - fpAbs :: FPOp1 fpp t - fpAbs e = do zero <- WI.floatLit sym knownRepr bfPosZero - e_neg <- WI.floatLt sym e zero - neg_e <- WI.floatSub sym fpRM zero e - WI.floatIte sym e_neg neg_e e - (CE.Sign _, xe) -> numOp bvSign fpSign xe - where - bvSign :: BVOp1 w t - bvSign e = do zero <- WI.bvLit sym knownRepr (BV.zero knownNat) - neg_one <- WI.bvLit sym knownNat (BV.mkBV knownNat (-1)) - pos_one <- WI.bvLit sym knownNat (BV.mkBV knownNat 1) - e_zero <- WI.bvEq sym e zero - e_neg <- WI.bvSlt sym e zero - t <- WI.bvIte sym e_neg neg_one pos_one - WI.bvIte sym e_zero zero t - fpSign :: FPOp1 fpp t - fpSign e = do zero <- WI.floatLit sym knownRepr bfPosZero - neg_one <- WI.floatLit sym knownRepr (bfFromDouble (-1.0)) - pos_one <- WI.floatLit sym knownRepr (bfFromDouble 1.0) - e_zero <- WI.floatEq sym e zero - e_neg <- WI.floatLt sym e zero - t <- WI.floatIte sym e_neg neg_one pos_one - WI.floatIte sym e_zero zero t - (CE.Recip _, xe) -> fpOp recip xe - where - recip :: FPOp1 fpp t - recip e = do one <- WI.floatLit sym knownRepr (bfFromDouble 1.0) - WI.floatDiv sym fpRM one e - (CE.Exp _, xe) -> realOp (WI.realExp sym) xe - (CE.Sqrt _, xe) -> fpOp (WI.floatSqrt sym fpRM) xe - (CE.Log _, xe) -> realOp (WI.realLog sym) xe - (CE.Sin _, xe) -> realOp (WI.realSin sym) xe - (CE.Cos _, xe) -> realOp (WI.realCos sym) xe - (CE.Tan _, xe) -> realOp (WI.realTan sym) xe - (CE.Asin _, xe) -> realOp (realRecip <=< WI.realSin sym) xe - (CE.Acos _, xe) -> realOp (realRecip <=< WI.realCos sym) xe - (CE.Atan _, xe) -> realOp (realRecip <=< WI.realTan sym) xe - (CE.Sinh _, xe) -> realOp (WI.realSinh sym) xe - (CE.Cosh _, xe) -> realOp (WI.realCosh sym) xe - (CE.Tanh _, xe) -> realOp (WI.realTanh sym) xe - (CE.Asinh _, xe) -> realOp (realRecip <=< WI.realSinh sym) xe - (CE.Acosh _, xe) -> realOp (realRecip <=< WI.realCosh sym) xe - (CE.Atanh _, xe) -> realOp (realRecip <=< WI.realTanh sym) xe - (CE.BwNot _, xe) -> case xe of - XBool e -> XBool <$> WI.notPred sym e - _ -> bvOp (WI.bvNotBits sym) xe - (CE.Cast _ tp, xe) -> case (xe, tp) of - (XBool e, CT.Bool) -> return $ XBool e - (XBool e, CT.Word8) -> XWord8 <$> WI.predToBV sym e knownNat - (XBool e, CT.Word16) -> XWord16 <$> WI.predToBV sym e knownNat - (XBool e, CT.Word32) -> XWord32 <$> WI.predToBV sym e knownNat - (XBool e, CT.Word64) -> XWord64 <$> WI.predToBV sym e knownNat - (XBool e, CT.Int8) -> XInt8 <$> WI.predToBV sym e knownNat - (XBool e, CT.Int16) -> XInt16 <$> WI.predToBV sym e knownNat - (XBool e, CT.Int32) -> XInt32 <$> WI.predToBV sym e knownNat - (XBool e, CT.Int64) -> XInt64 <$> WI.predToBV sym e knownNat - (XInt8 e, CT.Int8) -> return $ XInt8 e - (XInt8 e, CT.Int16) -> XInt16 <$> WI.bvSext sym knownNat e - (XInt8 e, CT.Int32) -> XInt32 <$> WI.bvSext sym knownNat e - (XInt8 e, CT.Int64) -> XInt64 <$> WI.bvSext sym knownNat e - (XInt16 e, CT.Int16) -> return $ XInt16 e - (XInt16 e, CT.Int32) -> XInt32 <$> WI.bvSext sym knownNat e - (XInt16 e, CT.Int64) -> XInt64 <$> WI.bvSext sym knownNat e - (XInt32 e, CT.Int32) -> return $ XInt32 e - (XInt32 e, CT.Int64) -> XInt64 <$> WI.bvSext sym knownNat e - (XInt64 e, CT.Int64) -> return $ XInt64 e - (XWord8 e, CT.Int16) -> XInt16 <$> WI.bvZext sym knownNat e - (XWord8 e, CT.Int32) -> XInt32 <$> WI.bvZext sym knownNat e - (XWord8 e, CT.Int64) -> XInt64 <$> WI.bvZext sym knownNat e - (XWord8 e, CT.Word8) -> return $ XWord8 e - (XWord8 e, CT.Word16) -> XWord16 <$> WI.bvZext sym knownNat e - (XWord8 e, CT.Word32) -> XWord32 <$> WI.bvZext sym knownNat e - (XWord8 e, CT.Word64) -> XWord64 <$> WI.bvZext sym knownNat e - (XWord16 e, CT.Int32) -> XInt32 <$> WI.bvZext sym knownNat e - (XWord16 e, CT.Int64) -> XInt64 <$> WI.bvZext sym knownNat e - (XWord16 e, CT.Word16) -> return $ XWord16 e - (XWord16 e, CT.Word32) -> XWord32 <$> WI.bvZext sym knownNat e - (XWord16 e, CT.Word64) -> XWord64 <$> WI.bvZext sym knownNat e - (XWord32 e, CT.Int64) -> XInt64 <$> WI.bvZext sym knownNat e - (XWord32 e, CT.Word32) -> return $ XWord32 e - (XWord32 e, CT.Word64) -> XWord64 <$> WI.bvZext sym knownNat e - (XWord64 e, CT.Word64) -> return $ XWord64 e - _ -> panic - (CE.GetField (CT.Struct s) _ftp extractor, XStruct xes) -> do - let fieldNameRepr = fieldName (extractor undefined) - let structFieldNameReprs = valueName <$> CT.toValues s - let mIx = elemIndex (Some fieldNameRepr) structFieldNameReprs - case mIx of - Just ix -> return $ xes !! ix - Nothing -> panic - _ -> panic - where - numOp :: (forall w . BVOp1 w t) - -> (forall fpp . FPOp1 fpp t) - -> XExpr t - -> IO (XExpr t) - numOp bvOp fpOp xe = case xe of - XInt8 e -> XInt8 <$> bvOp e - XInt16 e -> XInt16 <$> bvOp e - XInt32 e -> XInt32 <$> bvOp e - XInt64 e -> XInt64 <$> bvOp e - XWord8 e -> XWord8 <$> bvOp e - XWord16 e -> XWord16 <$> bvOp e - XWord32 e -> XWord32 <$> bvOp e - XWord64 e -> XWord64 <$> bvOp e - XFloat e -> XFloat <$> fpOp e - XDouble e -> XDouble <$> fpOp e - _ -> panic - - bvOp :: (forall w . BVOp1 w t) -> XExpr t -> IO (XExpr t) - bvOp f xe = case xe of - XInt8 e -> XInt8 <$> f e - XInt16 e -> XInt16 <$> f e - XInt32 e -> XInt32 <$> f e - XInt64 e -> XInt64 <$> f e - XWord8 e -> XWord8 <$> f e - XWord16 e -> XWord16 <$> f e - XWord32 e -> XWord32 <$> f e - XWord64 e -> XWord64 <$> f e - _ -> panic - - fpOp :: (forall fpp . FPOp1 fpp t) -> XExpr t -> IO (XExpr t) - fpOp g xe = case xe of - XFloat e -> XFloat <$> g e - XDouble e -> XDouble <$> g e - _ -> panic - - realOp :: RealOp1 t -> XExpr t -> IO (XExpr t) - realOp h xe = fpOp hf xe - where - hf :: (forall fpp . FPOp1 fpp t) - hf e = do re <- WI.floatToReal sym e - hre <- h re - WI.realToFloat sym knownRepr fpRM hre - - realRecip :: RealOp1 t - realRecip e = do one <- WI.realLit sym 1 - WI.realDiv sym one e - -type BVOp2 w t = (KnownNat w, 1 <= w) => WB.BVExpr t w -> WB.BVExpr t w -> IO (WB.BVExpr t w) - -type FPOp2 fpp t = KnownRepr WT.FloatPrecisionRepr fpp => WB.Expr t (WT.BaseFloatType fpp) -> WB.Expr t (WT.BaseFloatType fpp) -> IO (WB.Expr t (WT.BaseFloatType fpp)) - -type RealOp2 t = WB.Expr t WT.BaseRealType -> WB.Expr t WT.BaseRealType -> IO (WB.Expr t WT.BaseRealType) - -type BoolCmp2 t = WB.BoolExpr t -> WB.BoolExpr t -> IO (WB.BoolExpr t) - -type BVCmp2 w t = (KnownNat w, 1 <= w) => WB.BVExpr t w -> WB.BVExpr t w -> IO (WB.BoolExpr t) - -type FPCmp2 fpp t = KnownRepr WT.FloatPrecisionRepr fpp => WB.Expr t (WT.BaseFloatType fpp) -> WB.Expr t (WT.BaseFloatType fpp) -> IO (WB.BoolExpr t) - -translateOp2 :: forall t st fs a b c . - WB.ExprBuilder t st fs - -> (WB.ExprSymFn t - (EmptyCtx ::> WT.BaseRealType ::> WT.BaseRealType) - WT.BaseRealType) - -- ^ Pow function - -> (WB.ExprSymFn t - (EmptyCtx ::> WT.BaseRealType ::> WT.BaseRealType) - WT.BaseRealType) - -- ^ Logb function - -> CE.Op2 a b c - -> XExpr t - -> XExpr t - -> IO (XExpr t) -translateOp2 sym powFn logbFn op xe1 xe2 = case (op, xe1, xe2) of - (CE.And, XBool e1, XBool e2) -> XBool <$> WI.andPred sym e1 e2 - (CE.Or, XBool e1, XBool e2) -> XBool <$> WI.orPred sym e1 e2 - (CE.Add _, xe1, xe2) -> numOp (WI.bvAdd sym) (WI.floatAdd sym fpRM) xe1 xe2 - (CE.Sub _, xe1, xe2) -> numOp (WI.bvSub sym) (WI.floatSub sym fpRM) xe1 xe2 - (CE.Mul _, xe1, xe2) -> numOp (WI.bvMul sym) (WI.floatMul sym fpRM) xe1 xe2 - (CE.Mod _, xe1, xe2) -> bvOp (WI.bvSrem sym) (WI.bvUrem sym) xe1 xe2 - (CE.Div _, xe1, xe2) -> bvOp (WI.bvSdiv sym) (WI.bvUdiv sym) xe1 xe2 - (CE.Fdiv _, xe1, xe2) -> fpOp (WI.floatDiv sym fpRM) xe1 xe2 - (CE.Pow _, xe1, xe2) -> fpOp powFn' xe1 xe2 - where - powFn' :: FPOp2 fpp t - powFn' e1 e2 = do re1 <- WI.floatToReal sym e1 - re2 <- WI.floatToReal sym e2 - let args = (Empty :> re1 :> re2) - rpow <- WI.applySymFn sym powFn args - WI.realToFloat sym knownRepr fpRM rpow - (CE.Logb _, xe1, xe2) -> fpOp logbFn' xe1 xe2 - where - logbFn' :: FPOp2 fpp t - logbFn' e1 e2 = do re1 <- WI.floatToReal sym e1 - re2 <- WI.floatToReal sym e2 - let args = (Empty :> re1 :> re2) - rpow <- WI.applySymFn sym logbFn args - WI.realToFloat sym knownRepr fpRM rpow - (CE.Eq _, xe1, xe2) -> cmp (WI.eqPred sym) (WI.bvEq sym) (WI.floatEq sym) xe1 xe2 - (CE.Ne _, xe1, xe2) -> cmp neqPred bvNeq fpNeq xe1 xe2 - where - neqPred :: BoolCmp2 t - neqPred e1 e2 = do e <- WI.eqPred sym e1 e2 - WI.notPred sym e - bvNeq :: forall w . BVCmp2 w t - bvNeq e1 e2 = do e <- WI.bvEq sym e1 e2 - WI.notPred sym e - fpNeq :: forall fpp . FPCmp2 fpp t - fpNeq e1 e2 = do e <- WI.floatEq sym e1 e2 - WI.notPred sym e - (CE.Le _, xe1, xe2) -> numCmp (WI.bvSle sym) (WI.bvUle sym) (WI.floatLe sym) xe1 xe2 - (CE.Ge _, xe1, xe2) -> numCmp (WI.bvSge sym) (WI.bvUge sym) (WI.floatGe sym) xe1 xe2 - (CE.Lt _, xe1, xe2) -> numCmp (WI.bvSlt sym) (WI.bvUlt sym) (WI.floatLt sym) xe1 xe2 - (CE.Gt _, xe1, xe2) -> numCmp (WI.bvSgt sym) (WI.bvUgt sym) (WI.floatGt sym) xe1 xe2 - (CE.BwAnd _, xe1, xe2) -> bvOp (WI.bvAndBits sym) (WI.bvAndBits sym) xe1 xe2 - (CE.BwOr _, xe1, xe2) -> bvOp (WI.bvOrBits sym) (WI.bvOrBits sym) xe1 xe2 - (CE.BwXor _, xe1, xe2) -> bvOp (WI.bvXorBits sym) (WI.bvXorBits sym) xe1 xe2 - -- Note: For both shift operators, we are interpreting the shifter as an - -- unsigned bitvector regardless of whether it is a word or an int. - (CE.BwShiftL _ _, xe1, xe2) -> do - Just (SomeBVExpr e1 w1 _ ctor1) <- return $ asBVExpr xe1 - Just (SomeBVExpr e2 w2 _ _ ) <- return $ asBVExpr xe2 - e2' <- case testNatCases w1 w2 of - NatCaseLT LeqProof -> WI.bvTrunc sym w1 e2 - NatCaseEQ -> return e2 - NatCaseGT LeqProof -> WI.bvZext sym w1 e2 - ctor1 <$> WI.bvShl sym e1 e2' - (CE.BwShiftR _ _, xe1, xe2) -> do - Just (SomeBVExpr e1 w1 sgn1 ctor1) <- return $ asBVExpr xe1 - Just (SomeBVExpr e2 w2 _ _ ) <- return $ asBVExpr xe2 - e2' <- case testNatCases w1 w2 of - NatCaseLT LeqProof -> WI.bvTrunc sym w1 e2 - NatCaseEQ -> return e2 - NatCaseGT LeqProof -> WI.bvZext sym w1 e2 - ctor1 <$> case sgn1 of - Signed -> WI.bvAshr sym e1 e2' - Unsigned -> WI.bvLshr sym e1 e2' - -- Note: Currently, copilot does not check if array indices are out of bounds, - -- even for constant expressions. The method of translation we are using - -- simply creates a nest of if-then-else expression to check the index - -- expression against all possible indices. If the index expression is known - -- by the solver to be out of bounds (for instance, if it is a constant 5 for - -- an array of 5 elements), then the if-then-else will trivially resolve to - -- true. - (CE.Index _, xe1, xe2) -> do - case (xe1, xe2) of - (XArray xes, XWord32 ix) -> buildIndexExpr sym 0 ix xes - _ -> panic - _ -> panic - where - numOp :: (forall w . BVOp2 w t) - -> (forall fpp . FPOp2 fpp t) - -> XExpr t - -> XExpr t - -> IO (XExpr t) - numOp bvOp fpOp xe1 xe2 = case (xe1, xe2) of - (XInt8 e1, XInt8 e2) -> XInt8 <$> bvOp e1 e2 - (XInt16 e1, XInt16 e2) -> XInt16 <$> bvOp e1 e2 - (XInt32 e1, XInt32 e2)-> XInt32 <$> bvOp e1 e2 - (XInt64 e1, XInt64 e2)-> XInt64 <$> bvOp e1 e2 - (XWord8 e1, XWord8 e2)-> XWord8 <$> bvOp e1 e2 - (XWord16 e1, XWord16 e2)-> XWord16 <$> bvOp e1 e2 - (XWord32 e1, XWord32 e2)-> XWord32 <$> bvOp e1 e2 - (XWord64 e1, XWord64 e2)-> XWord64 <$> bvOp e1 e2 - (XFloat e1, XFloat e2)-> XFloat <$> fpOp e1 e2 - (XDouble e1, XDouble e2)-> XDouble <$> fpOp e1 e2 - _ -> panic - - bvOp :: (forall w . BVOp2 w t) - -> (forall w . BVOp2 w t) - -> XExpr t - -> XExpr t - -> IO (XExpr t) - bvOp opS opU xe1 xe2 = case (xe1, xe2) of - (XInt8 e1, XInt8 e2) -> XInt8 <$> opS e1 e2 - (XInt16 e1, XInt16 e2) -> XInt16 <$> opS e1 e2 - (XInt32 e1, XInt32 e2) -> XInt32 <$> opS e1 e2 - (XInt64 e1, XInt64 e2) -> XInt64 <$> opS e1 e2 - (XWord8 e1, XWord8 e2) -> XWord8 <$> opU e1 e2 - (XWord16 e1, XWord16 e2) -> XWord16 <$> opU e1 e2 - (XWord32 e1, XWord32 e2) -> XWord32 <$> opU e1 e2 - (XWord64 e1, XWord64 e2) -> XWord64 <$> opU e1 e2 - _ -> panic - - fpOp :: (forall fpp . FPOp2 fpp t) - -> XExpr t - -> XExpr t - -> IO (XExpr t) - fpOp op xe1 xe2 = case (xe1, xe2) of - (XFloat e1, XFloat e2) -> XFloat <$> op e1 e2 - (XDouble e1, XDouble e2) -> XDouble <$> op e1 e2 - _ -> panic - - cmp :: BoolCmp2 t - -> (forall w . BVCmp2 w t) - -> (forall fpp . FPCmp2 fpp t) - -> XExpr t - -> XExpr t - -> IO (XExpr t) - cmp boolOp bvOp fpOp xe1 xe2 = case (xe1, xe2) of - (XBool e1, XBool e2) -> XBool <$> boolOp e1 e2 - (XInt8 e1, XInt8 e2) -> XBool <$> bvOp e1 e2 - (XInt16 e1, XInt16 e2) -> XBool <$> bvOp e1 e2 - (XInt32 e1, XInt32 e2)-> XBool <$> bvOp e1 e2 - (XInt64 e1, XInt64 e2)-> XBool <$> bvOp e1 e2 - (XWord8 e1, XWord8 e2)-> XBool <$> bvOp e1 e2 - (XWord16 e1, XWord16 e2)-> XBool <$> bvOp e1 e2 - (XWord32 e1, XWord32 e2)-> XBool <$> bvOp e1 e2 - (XWord64 e1, XWord64 e2)-> XBool <$> bvOp e1 e2 - (XFloat e1, XFloat e2)-> XBool <$> fpOp e1 e2 - (XDouble e1, XDouble e2)-> XBool <$> fpOp e1 e2 - _ -> panic - - numCmp :: (forall w . BVCmp2 w t) - -> (forall w . BVCmp2 w t) - -> (forall fpp . FPCmp2 fpp t) - -> XExpr t - -> XExpr t - -> IO (XExpr t) - numCmp bvSOp bvUOp fpOp xe1 xe2 = case (xe1, xe2) of - (XInt8 e1, XInt8 e2) -> XBool <$> bvSOp e1 e2 - (XInt16 e1, XInt16 e2) -> XBool <$> bvSOp e1 e2 - (XInt32 e1, XInt32 e2)-> XBool <$> bvSOp e1 e2 - (XInt64 e1, XInt64 e2)-> XBool <$> bvSOp e1 e2 - (XWord8 e1, XWord8 e2)-> XBool <$> bvUOp e1 e2 - (XWord16 e1, XWord16 e2)-> XBool <$> bvUOp e1 e2 - (XWord32 e1, XWord32 e2)-> XBool <$> bvUOp e1 e2 - (XWord64 e1, XWord64 e2)-> XBool <$> bvUOp e1 e2 - (XFloat e1, XFloat e2)-> XBool <$> fpOp e1 e2 - (XDouble e1, XDouble e2)-> XBool <$> fpOp e1 e2 - _ -> panic - - buildIndexExpr :: 1 <= n - => WB.ExprBuilder t st fs - -> Word32 - -- ^ Index - -> WB.Expr t (WT.BaseBVType 32) - -- ^ Index - -> V.Vector n (XExpr t) - -- ^ Elements - -> IO (XExpr t) - buildIndexExpr sym curIx ix xelts = case V.uncons xelts of - (xe, Left Refl) -> return xe - (xe, Right xelts') -> do - LeqProof <- return $ V.nonEmpty xelts' - rstExpr <- buildIndexExpr sym (curIx+1) ix xelts' - curIxExpr <- WI.bvLit sym knownNat (BV.word32 curIx) - ixEq <- WI.bvEq sym curIxExpr ix - mkIte sym ixEq xe rstExpr - - mkIte :: WB.ExprBuilder t st fs - -> WB.Expr t WT.BaseBoolType - -> XExpr t - -> XExpr t - -> IO (XExpr t) - mkIte sym pred xe1 xe2 = case (xe1, xe2) of - (XBool e1, XBool e2) -> XBool <$> WI.itePred sym pred e1 e2 - (XInt8 e1, XInt8 e2) -> XInt8 <$> WI.bvIte sym pred e1 e2 - (XInt16 e1, XInt16 e2) -> XInt16 <$> WI.bvIte sym pred e1 e2 - (XInt32 e1, XInt32 e2) -> XInt32 <$> WI.bvIte sym pred e1 e2 - (XInt64 e1, XInt64 e2) -> XInt64 <$> WI.bvIte sym pred e1 e2 - (XWord8 e1, XWord8 e2) -> XWord8 <$> WI.bvIte sym pred e1 e2 - (XWord16 e1, XWord16 e2) -> XWord16 <$> WI.bvIte sym pred e1 e2 - (XWord32 e1, XWord32 e2) -> XWord32 <$> WI.bvIte sym pred e1 e2 - (XWord64 e1, XWord64 e2) -> XWord64 <$> WI.bvIte sym pred e1 e2 - (XFloat e1, XFloat e2) -> XFloat <$> WI.floatIte sym pred e1 e2 - (XDouble e1, XDouble e2) -> XDouble <$> WI.floatIte sym pred e1 e2 - (XStruct xes1, XStruct xes2) -> - XStruct <$> zipWithM (mkIte sym pred) xes1 xes2 - (XArray xes1, XArray xes2) -> - case V.length xes1 `testEquality` V.length xes2 of - Just Refl -> XArray <$> V.zipWithM (mkIte sym pred) xes1 xes2 - Nothing -> panic - _ -> panic - -translateOp3 :: forall t st fs a b c d . - WB.ExprBuilder t st fs - -> CE.Op3 a b c d - -> XExpr t - -> XExpr t - -> XExpr t - -> IO (XExpr t) -translateOp3 sym (CE.Mux _) (XBool te) xe1 xe2 = case (xe1, xe2) of - (XBool e1, XBool e2) -> XBool <$> WI.itePred sym te e1 e2 - (XInt8 e1, XInt8 e2) -> XInt8 <$> WI.bvIte sym te e1 e2 - (XInt16 e1, XInt16 e2) -> XInt16 <$> WI.bvIte sym te e1 e2 - (XInt32 e1, XInt32 e2) -> XInt32 <$> WI.bvIte sym te e1 e2 - (XInt64 e1, XInt64 e2) -> XInt64 <$> WI.bvIte sym te e1 e2 - (XWord8 e1, XWord8 e2) -> XWord8 <$> WI.bvIte sym te e1 e2 - (XWord16 e1, XWord16 e2) -> XWord16 <$> WI.bvIte sym te e1 e2 - (XWord32 e1, XWord32 e2) -> XWord32 <$> WI.bvIte sym te e1 e2 - (XWord64 e1, XWord64 e2) -> XWord64 <$> WI.bvIte sym te e1 e2 - (XFloat e1, XFloat e2) -> XFloat <$> WI.floatIte sym te e1 e2 - (XDouble e1, XDouble e2) -> XDouble <$> WI.floatIte sym te e1 e2 - _ -> panic -translateOp3 _ _ _ _ _ = panic + -- Evaluate a (possibly symbolic) floating-point value to a concrete result. + -- Depending on which @what4@ floating-point mode is in use, the result will + -- be passed to one of three different continuation arguments. + iFloatGroundEval :: + forall fi r. + WFP.FloatInfoRepr fi -> + WI.SymExpr sym (WFP.SymInterpretedFloatType sym fi) -> + (BigFloat -> r) -> + -- ^ Continuation to use if the IEEE floating-point mode is in use. + (Rational -> r) -> + -- ^ Continuation to use if the real floating-point mode is in use. + (forall w. BV.BV w -> r) -> + -- ^ Continuation to use if the uninterpreted floating-point mode is in + -- use. + IO r + iFloatGroundEval _ e ieeeK realK uninterpK = + case WI.knownRepr :: WB.FloatModeRepr fm of + WB.FloatIEEERepr -> ieeeK <$> WG.groundEval ge e + WB.FloatRealRepr -> realK <$> WG.groundEval ge e + WB.FloatUninterpretedRepr -> uninterpK <$> WG.groundEval ge e diff --git a/copilot-theorem/src/Copilot/Theorem/What4/Translate.hs b/copilot-theorem/src/Copilot/Theorem/What4/Translate.hs new file mode 100644 index 000000000..456234a64 --- /dev/null +++ b/copilot-theorem/src/Copilot/Theorem/What4/Translate.hs @@ -0,0 +1,1375 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeOperators #-} + +-- | +-- Module : Copilot.Theorem.What4.Translate +-- Description : Translate Copilot specifications into What4 +-- Copyright : (c) Galois Inc., 2021-2022 +-- Maintainer : robdockins@galois.com +-- Stability : experimental +-- Portability : POSIX +-- +-- Translate Copilot specifications to What4 formulas using the 'TransM' monad. +module Copilot.Theorem.What4.Translate + ( -- * Translation into What4 + TransState(..) + , TransM + , runTransM + , LocalEnv + , translateExpr + , translateConstExpr + , getStreamValue + , getExternConstant + -- * What4 representations of Copilot expressions + , XExpr(..) + -- * Stream offsets + , StreamOffset(..) + -- * Auxiliary functions + , panic + ) where + +import Control.Monad (forM, zipWithM) +import qualified Control.Monad.Fail as Fail +import Control.Monad.IO.Class (MonadIO (..)) +import Control.Monad.State (MonadState (..), StateT (..), + gets, modify) +import qualified Data.BitVector.Sized as BV +import Data.IORef (newIORef, modifyIORef, + readIORef) +import Data.List (elemIndex, genericIndex, + genericLength) +import qualified Data.Map as Map +import Data.Maybe (fromJust) +import Data.Parameterized.Classes (KnownRepr (..)) +import Data.Parameterized.Context (EmptyCtx, type (::>)) +import Data.Parameterized.NatRepr (LeqProof (..), NatCases (..), + NatRepr, decNat, isZeroOrGT1, + knownNat, minusPlusCancel, + mkNatRepr, testNatCases) +import Data.Parameterized.Some (Some (..)) +import Data.Parameterized.SymbolRepr (SymbolRepr, knownSymbol) +import qualified Data.Parameterized.Vector as V +import Data.Type.Equality (TestEquality (..), (:~:) (..)) +import Data.Word (Word32) +import GHC.TypeLits (KnownSymbol) +import GHC.TypeNats (KnownNat, type (<=)) +import qualified Panic as Panic + +import qualified What4.BaseTypes as WT +import qualified What4.Interface as WI +import qualified What4.InterpretedFloatingPoint as WFP +import qualified What4.SpecialFunctions as WSF + +import qualified Copilot.Core.Expr as CE +import qualified Copilot.Core.Operators as CE +import qualified Copilot.Core.PrettyPrint as CP +import qualified Copilot.Core.Spec as CS +import qualified Copilot.Core.Type as CT +import qualified Copilot.Core.Type.Array as CT + +-- Translation into What4 + +-- | The state for translating Copilot expressions into What4 expressions. As we +-- translate, we generate fresh symbolic constants for external variables and +-- for stream variables. We need to only generate one constant per variable, so +-- we allocate them in a map. When we need the constant for a particular +-- variable, we check if it is already in the map, and return it if it is; if it +-- isn't, we generate a fresh constant at that point, store it in the map, and +-- return it. +-- +-- We also store 'streams', an immutable field, in this state, rather than wrap +-- it up in another monad transformer layer. This is initialized prior to +-- translation and is never modified. This maps from stream ids to the +-- core stream definitions. +data TransState sym = TransState { + -- | Map keeping track of all external variables encountered during + -- translation. + mentionedExternals :: Map.Map CE.Name (Some CT.Type), + -- | Memo table for external variables, indexed by the external stream name + -- and a stream offset. + externVars :: Map.Map (CE.Name, StreamOffset) (XExpr sym), + -- | Memo table for stream values, indexed by the stream 'CE.Id' and offset. + streamValues :: Map.Map (CE.Id, StreamOffset) (XExpr sym), + -- | Map from stream ids to the streams themselves. This value is never + -- modified, but I didn't want to make this an RWS, so it's represented as a + -- stateful value. + streams :: Map.Map CE.Id CS.Stream, + -- | A list of side conditions that must be true in order for all applications + -- of partial functions (e.g., 'CE.Div') to be well defined. + sidePreds :: [WI.Pred sym] + } + +newtype TransM sym a = TransM { unTransM :: StateT (TransState sym) IO a } + deriving ( Functor + , Applicative + , Monad + , Fail.MonadFail + , MonadIO + , MonadState (TransState sym) + ) + +-- | Translate a Copilot specification using the given 'TransM' computation. +runTransM :: CS.Spec -> TransM sym a -> IO a +runTransM spec m = do + -- Build up initial translation state + let streamMap = Map.fromList $ + (\stream -> (CS.streamId stream, stream)) <$> CS.specStreams spec + st = TransState + { mentionedExternals = mempty + , externVars = mempty + , streamValues = mempty + , streams = streamMap + , sidePreds = [] + } + + (res, _) <- runStateT (unTransM m) st + return res + +-- | An environment used to translate local Copilot variables to What4. +type LocalEnv sym = Map.Map CE.Name (StreamOffset -> TransM sym (XExpr sym)) + +-- | Compute the value of a stream expression at the given offset in the given +-- local environment. +translateExpr :: forall sym a. + WFP.IsInterpretedFloatSymExprBuilder sym + => sym + -> LocalEnv sym + -- ^ Environment for local variables + -> CE.Expr a + -- ^ Expression to translate + -> StreamOffset + -- ^ Offset to compute + -> TransM sym (XExpr sym) +translateExpr sym localEnv e offset = case e of + CE.Const tp a -> liftIO $ translateConstExpr sym tp a + CE.Drop _tp ix streamId -> getStreamValue sym streamId (addOffset offset ix) + CE.Local _tpa _tpb nm e1 body -> do + ref <- liftIO (newIORef mempty) + + -- Look up a stream value by offset, using an IORef to cache values that + -- have already been looked up previously. Caching values in this way avoids + -- exponential blowup. + -- + -- Note that using a single IORef to store all local variables means that it + -- is possible for local variables to escape their lexical scope. See issue + -- #253 for more information. This is an issue that is shared in common with + -- `copilot-c99` and the Copilot interpreter. + let f :: StreamOffset -> TransM sym (XExpr sym) + f offset' = do + m <- liftIO (readIORef ref) + case Map.lookup offset' m of + -- If we have looked up this value before, return the cached value. + Just x -> return x + -- Otherwise, translate the expression and cache it for subsequent + -- lookups. + Nothing -> + do x <- translateExpr sym localEnv e1 offset' + liftIO (modifyIORef ref (Map.insert offset' x)) + return x + + let localEnv' = Map.insert nm f localEnv + translateExpr sym localEnv' body offset + CE.Var _tp nm -> + case Map.lookup nm localEnv of + Nothing -> panic ["translateExpr: unknown var " ++ show nm] + Just f -> f offset + CE.ExternVar tp nm _prefix -> getExternConstant sym tp nm offset + CE.Op1 op e1 -> do + xe1 <- translateExpr sym localEnv e1 offset + translateOp1 sym e op xe1 + CE.Op2 op e1 e2 -> do + xe1 <- translateExpr sym localEnv e1 offset + xe2 <- translateExpr sym localEnv e2 offset + translateOp2 sym e op xe1 xe2 + CE.Op3 op e1 e2 e3 -> do + xe1 <- translateExpr sym localEnv e1 offset + xe2 <- translateExpr sym localEnv e2 offset + xe3 <- translateExpr sym localEnv e3 offset + translateOp3 sym e op xe1 xe2 xe3 + CE.Label _ _ e1 -> + translateExpr sym localEnv e1 offset + +-- | Compute and cache the value of a stream with the given identifier at the +-- given offset. +getStreamValue :: WFP.IsInterpretedFloatSymExprBuilder sym + => sym + -> CE.Id + -> StreamOffset + -> TransM sym (XExpr sym) +getStreamValue sym streamId offset = do + svs <- gets streamValues + case Map.lookup (streamId, offset) svs of + Just xe -> return xe + Nothing -> do + streamDef <- getStreamDef streamId + xe <- computeStreamValue streamDef + modify $ \st -> + st { streamValues = + Map.insert (streamId, offset) xe (streamValues st) } + return xe + where + computeStreamValue + (CS.Stream + { CS.streamId = id, CS.streamBuffer = buf, + CS.streamExpr = ex, CS.streamExprType = tp }) = + let len = genericLength buf in + case offset of + AbsoluteOffset i + | i < 0 -> panic ["Invalid absolute offset " ++ show i ++ + " for stream " ++ show id] + | i < len -> liftIO (translateConstExpr sym tp (genericIndex buf i)) + | otherwise -> translateExpr sym mempty ex (AbsoluteOffset (i - len)) + RelativeOffset i + | i < 0 -> panic ["Invalid relative offset " ++ show i ++ + " for stream " ++ show id] + | i < len -> let nm = "s" ++ show id ++ "_r" ++ show i + in liftIO (freshCPConstant sym nm tp) + | otherwise -> translateExpr sym mempty ex (RelativeOffset (i - len)) + +-- | Compute and cache the value of an external stream with the given name at +-- the given offset. +getExternConstant :: WFP.IsInterpretedFloatSymExprBuilder sym + => sym + -> CT.Type a + -> CE.Name + -> StreamOffset + -> TransM sym (XExpr sym) +getExternConstant sym tp nm offset = do + es <- gets externVars + case Map.lookup (nm, offset) es of + Just xe -> return xe + Nothing -> do + xe <- computeExternConstant + modify $ \st -> + st { externVars = Map.insert (nm, offset) xe (externVars st) + , mentionedExternals = + Map.insert nm (Some tp) (mentionedExternals st) + } + return xe + where + computeExternConstant = + case offset of + AbsoluteOffset i + | i < 0 -> panic ["Invalid absolute offset " ++ show i ++ + " for external stream " ++ nm] + | otherwise -> let nm' = nm ++ "_a" ++ show i + in liftIO (freshCPConstant sym nm' tp) + RelativeOffset i + | i < 0 -> panic ["Invalid relative offset " ++ show i ++ + " for external stream " ++ nm] + | otherwise -> let nm' = nm ++ "_r" ++ show i + in liftIO (freshCPConstant sym nm' tp) + +-- | A view of an XExpr as a bitvector expression, a natrepr for its width, its +-- signed/unsigned status, and the constructor used to reconstruct an XExpr from +-- it. This is a useful view for translation, as many of the operations can be +-- grouped together for all words\/ints\/floats. +data SomeBVExpr sym where + SomeBVExpr :: 1 <= w + => WI.SymBV sym w + -> NatRepr w + -> BVSign + -> (WI.SymBV sym w -> XExpr sym) + -> SomeBVExpr sym + +-- | The sign of a bitvector -- this indicates whether it is to be interpreted +-- as a signed 'Int' or an unsigned 'Word'. +data BVSign = Signed | Unsigned + deriving Eq + +-- | If the inner expression can be viewed as a bitvector, we project out a view +-- of it as such. +asBVExpr :: XExpr sym -> Maybe (SomeBVExpr sym) +asBVExpr xe = case xe of + XInt8 e -> Just (SomeBVExpr e knownNat Signed XInt8) + XInt16 e -> Just (SomeBVExpr e knownNat Signed XInt16) + XInt32 e -> Just (SomeBVExpr e knownNat Signed XInt32) + XInt64 e -> Just (SomeBVExpr e knownNat Signed XInt64) + XWord8 e -> Just (SomeBVExpr e knownNat Unsigned XWord8) + XWord16 e -> Just (SomeBVExpr e knownNat Unsigned XWord16) + XWord32 e -> Just (SomeBVExpr e knownNat Unsigned XWord32) + XWord64 e -> Just (SomeBVExpr e knownNat Unsigned XWord64) + _ -> Nothing + +-- | If an 'XExpr' is a bitvector expression, use it to generate a side +-- condition involving an application of a partial function. Otherwise, do +-- nothing. +addBVSidePred1 :: WI.IsExprBuilder sym + => XExpr sym + -> (forall w. + 1 <= w + => WI.SymBV sym w + -> NatRepr w + -> BVSign + -> IO (WI.Pred sym)) + -> TransM sym () +addBVSidePred1 xe makeSidePred = + case asBVExpr xe of + Just (SomeBVExpr e w sgn _) -> do + sidePred <- liftIO $ makeSidePred e w sgn + addSidePred sidePred + Nothing -> pure () + +-- | If two 'XExpr's are both bitvector expressions of the same type and +-- signedness, use them to generate a side condition involving an application of +-- a partial function. Otherwise, do nothing. +addBVSidePred2 :: WI.IsExprBuilder sym + => XExpr sym + -> XExpr sym + -> (forall w. + 1 <= w + => WI.SymBV sym w + -> WI.SymBV sym w + -> NatRepr w + -> BVSign + -> IO (WI.Pred sym)) + -> TransM sym () +addBVSidePred2 xe1 xe2 makeSidePred = + case (asBVExpr xe1, asBVExpr xe2) of + (Just (SomeBVExpr e1 w1 sgn1 _), Just (SomeBVExpr e2 w2 sgn2 _)) + | Just Refl <- testEquality w1 w2 + , sgn1 == sgn2 + -> do sidePred <- liftIO $ makeSidePred e1 e2 w1 sgn1 + addSidePred sidePred + _ -> pure () + +-- | Translate a constant expression by creating a what4 literal and packaging +-- it up into an 'XExpr'. +translateConstExpr :: forall sym a. + WFP.IsInterpretedFloatExprBuilder sym + => sym + -> CT.Type a + -> a + -> IO (XExpr sym) +translateConstExpr sym tp a = case tp of + CT.Bool -> case a of + True -> return $ XBool (WI.truePred sym) + False -> return $ XBool (WI.falsePred sym) + CT.Int8 -> XInt8 <$> WI.bvLit sym knownNat (BV.int8 a) + CT.Int16 -> XInt16 <$> WI.bvLit sym knownNat (BV.int16 a) + CT.Int32 -> XInt32 <$> WI.bvLit sym knownNat (BV.int32 a) + CT.Int64 -> XInt64 <$> WI.bvLit sym knownNat (BV.int64 a) + CT.Word8 -> XWord8 <$> WI.bvLit sym knownNat (BV.word8 a) + CT.Word16 -> XWord16 <$> WI.bvLit sym knownNat (BV.word16 a) + CT.Word32 -> XWord32 <$> WI.bvLit sym knownNat (BV.word32 a) + CT.Word64 -> XWord64 <$> WI.bvLit sym knownNat (BV.word64 a) + CT.Float -> XFloat <$> WFP.iFloatLitSingle sym a + CT.Double -> XDouble <$> WFP.iFloatLitDouble sym a + CT.Array tp -> do + elts <- traverse (translateConstExpr sym tp) (CT.arrayelems a) + Some n <- return $ mkNatRepr (genericLength elts) + case isZeroOrGT1 n of + Left Refl -> return XEmptyArray + Right LeqProof -> do + let Just v = V.fromList n elts + return $ XArray v + CT.Struct _ -> do + elts <- forM (CT.toValues a) $ \(CT.Value tp (CT.Field a)) -> + translateConstExpr sym tp a + return $ XStruct elts + +arrayLen :: KnownNat n => CT.Type (CT.Array n t) -> NatRepr n +arrayLen _ = knownNat + +-- | Generate a fresh constant for a given copilot type. This will be called +-- whenever we attempt to get the constant for a given external variable or +-- stream variable, but that variable has not been accessed yet and therefore +-- has no constant allocated. +freshCPConstant :: forall sym a . + WFP.IsInterpretedFloatSymExprBuilder sym + => sym + -> String + -> CT.Type a + -> IO (XExpr sym) +freshCPConstant sym nm tp = case tp of + CT.Bool -> XBool <$> WI.freshConstant sym (WI.safeSymbol nm) knownRepr + CT.Int8 -> XInt8 <$> WI.freshConstant sym (WI.safeSymbol nm) knownRepr + CT.Int16 -> XInt16 <$> WI.freshConstant sym (WI.safeSymbol nm) knownRepr + CT.Int32 -> XInt32 <$> WI.freshConstant sym (WI.safeSymbol nm) knownRepr + CT.Int64 -> XInt64 <$> WI.freshConstant sym (WI.safeSymbol nm) knownRepr + CT.Word8 -> XWord8 <$> WI.freshConstant sym (WI.safeSymbol nm) knownRepr + CT.Word16 -> XWord16 <$> WI.freshConstant sym (WI.safeSymbol nm) knownRepr + CT.Word32 -> XWord32 <$> WI.freshConstant sym (WI.safeSymbol nm) knownRepr + CT.Word64 -> XWord64 <$> WI.freshConstant sym (WI.safeSymbol nm) knownRepr + CT.Float -> XFloat <$> + WFP.freshFloatConstant sym (WI.safeSymbol nm) WFP.SingleFloatRepr + CT.Double -> XDouble <$> + WFP.freshFloatConstant sym (WI.safeSymbol nm) WFP.DoubleFloatRepr + atp@(CT.Array itp) -> do + let n = arrayLen atp + case isZeroOrGT1 n of + Left Refl -> return XEmptyArray + Right LeqProof -> do + Refl <- return $ minusPlusCancel n (knownNat @1) + elts :: V.Vector n (XExpr t) <- + V.generateM (decNat n) (const (freshCPConstant sym "" itp)) + return $ XArray elts + CT.Struct stp -> do + elts <- forM (CT.toValues stp) $ \(CT.Value ftp _) -> + freshCPConstant sym "" ftp + return $ XStruct elts + +-- | Retrieve a stream definition given its id. +getStreamDef :: CE.Id -> TransM sym CS.Stream +getStreamDef streamId = fromJust <$> gets (Map.lookup streamId . streams) + +-- | Add a side condition originating from an application of a partial function. +addSidePred :: WI.Pred sym -> TransM sym () +addSidePred newPred = modify (\st -> st { sidePreds = newPred : sidePreds st }) + +-- * Translate Ops + +-- Note [Side conditions for floating-point operations] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- We do not currently track side conditions for floating-point operations, as +-- they are unlikely to matter. A typical client of copilot-theorem will likely +-- treat floating-point operations as uninterpreted functions, and side +-- conditions involving uninterpreted functions are very unlikely to be helpful +-- except in very specific circumstances. In case we revisit this decision +-- later, we make a note of which floating-point operations could potentially +-- track side conditions as comments (but without implementing them). + +type BVOp1 sym w = (KnownNat w, 1 <= w) => WI.SymBV sym w -> IO (WI.SymBV sym w) + +type FPOp1 sym fi = + WFP.FloatInfoRepr fi + -> WI.SymExpr sym (WFP.SymInterpretedFloatType sym fi) + -> IO (WI.SymExpr sym (WFP.SymInterpretedFloatType sym fi)) + +fieldName :: KnownSymbol s => CT.Field s a -> SymbolRepr s +fieldName _ = knownSymbol + +valueName :: CT.Value a -> Some SymbolRepr +valueName (CT.Value _ f) = Some (fieldName f) + +translateOp1 :: forall sym a b . + WFP.IsInterpretedFloatExprBuilder sym + => sym + -> CE.Expr b + -- ^ Original value we are translating (only used for error + -- messages) + -> CE.Op1 a b + -> XExpr sym + -> TransM sym (XExpr sym) +translateOp1 sym origExpr op xe = case (op, xe) of + (CE.Not, XBool e) -> liftIO $ fmap XBool $ WI.notPred sym e + (CE.Not, _) -> panic ["Expected bool", show xe] + (CE.Abs _, xe) -> translateAbs xe + (CE.Sign _, xe) -> translateSign xe + + -- We do not track any side conditions for floating-point operations + -- (see Note [Side conditions for floating-point operations]), but we will + -- make a note of which operations have partial inputs. + + -- The argument should not be zero + (CE.Recip _, xe) -> liftIO $ fpOp recip xe + where + recip :: forall fi . FPOp1 sym fi + recip fiRepr e = do + one <- fpLit fiRepr 1.0 + WFP.iFloatDiv @_ @fi sym fpRM one e + -- The argument should not cause the result to overflow or underlow + (CE.Exp _, xe) -> liftIO $ fpSpecialOp WSF.Exp xe + -- The argument should not be less than -0 + (CE.Sqrt _, xe) -> + liftIO $ + fpOp (\(_ :: WFP.FloatInfoRepr fi) -> WFP.iFloatSqrt @_ @fi sym fpRM) xe + -- The argument should not be negative or zero + (CE.Log _, xe) -> liftIO $ fpSpecialOp WSF.Log xe + -- The argument should not be infinite + (CE.Sin _, xe) -> liftIO $ fpSpecialOp WSF.Sin xe + -- The argument should not be infinite + (CE.Cos _, xe) -> liftIO $ fpSpecialOp WSF.Cos xe + -- The argument should not be infinite, nor should it cause the result to + -- overflow + (CE.Tan _, xe) -> liftIO $ fpSpecialOp WSF.Tan xe + -- The argument should not cause the result to overflow + (CE.Sinh _, xe) -> liftIO $ fpSpecialOp WSF.Sinh xe + -- The argument should not cause the result to overflow + (CE.Cosh _, xe) -> liftIO $ fpSpecialOp WSF.Cosh xe + (CE.Tanh _, xe) -> liftIO $ fpSpecialOp WSF.Tanh xe + -- The argument should not be outside the range [-1, 1] + (CE.Asin _, xe) -> liftIO $ fpSpecialOp WSF.Arcsin xe + -- The argument should not be outside the range [-1, 1] + (CE.Acos _, xe) -> liftIO $ fpSpecialOp WSF.Arccos xe + (CE.Atan _, xe) -> liftIO $ fpSpecialOp WSF.Arctan xe + (CE.Asinh _, xe) -> liftIO $ fpSpecialOp WSF.Arcsinh xe + -- The argument should not be less than 1 + (CE.Acosh _, xe) -> liftIO $ fpSpecialOp WSF.Arccosh xe + -- The argument should not be less than or equal to -1, + -- nor should it be greater than or equal to +1 + (CE.Atanh _, xe) -> liftIO $ fpSpecialOp WSF.Arctanh xe + -- The argument should not cause the result to overflow + (CE.Ceiling _, xe) -> + liftIO $ + fpOp (\(_ :: WFP.FloatInfoRepr fi) -> WFP.iFloatRound @_ @fi sym WI.RTP) xe + -- The argument should not cause the result to overflow + (CE.Floor _, xe) -> + liftIO $ + fpOp (\(_ :: WFP.FloatInfoRepr fi) -> WFP.iFloatRound @_ @fi sym WI.RTN) xe + (CE.BwNot _, xe) -> liftIO $ case xe of + XBool e -> XBool <$> WI.notPred sym e + _ -> bvOp (WI.bvNotBits sym) xe + (CE.Cast _ tp, xe) -> liftIO $ castOp sym origExpr tp xe + (CE.GetField atp _ftp extractor, xe) -> translateGetField atp extractor xe + where + -- Translate an 'CE.Abs' operation and its argument into a what4 + -- representation of the appropriate type. + translateAbs :: XExpr sym -> TransM sym (XExpr sym) + translateAbs xe = do + addBVSidePred1 xe $ \e w _ -> do + -- The argument should not be INT_MIN + bvIntMin <- liftIO $ WI.bvLit sym w (BV.minSigned w) + eqIntMin <- liftIO $ WI.bvEq sym e bvIntMin + WI.notPred sym eqIntMin + liftIO $ numOp bvAbs fpAbs xe + where + bvAbs :: BVOp1 sym w + bvAbs e = do + zero <- WI.bvLit sym knownNat (BV.zero knownNat) + e_neg <- WI.bvSlt sym e zero + neg_e <- WI.bvSub sym zero e + WI.bvIte sym e_neg neg_e e + + fpAbs :: forall fi . FPOp1 sym fi + fpAbs _ e = WFP.iFloatAbs @_ @fi sym e + + -- Translate a 'CE.GetField' operation and its argument into a what4 + -- representation. If the argument is not a struct, panic. + translateGetField :: forall struct s. + KnownSymbol s + => CT.Type struct + -- ^ The type of the argument + -> (struct -> CT.Field s b) + -- ^ Extract a struct field + -> XExpr sym + -- ^ The argument value (should be a struct) + -> TransM sym (XExpr sym) + translateGetField tp extractor xe = case (tp, xe) of + (CT.Struct s, XStruct xes) -> + case mIx s of + Just ix -> return $ xes !! ix + Nothing -> panic [ "Could not find field " ++ show fieldNameRepr + , show s + ] + _ -> unexpectedValue "get-field operation" + where + fieldNameRepr :: SymbolRepr s + fieldNameRepr = fieldName (extractor undefined) + + structFieldNameReprs :: CT.Struct struct => struct -> [Some SymbolRepr] + structFieldNameReprs s = valueName <$> CT.toValues s + + mIx :: CT.Struct struct => struct -> Maybe Int + mIx s = elemIndex (Some fieldNameRepr) (structFieldNameReprs s) + + -- Translate a 'CE.Sign' operation (i.e, 'signum') and its argument into a + -- what4 representation of the appropriate type. We translate @signum x@ as + -- @x > 0 ? 1 : (x < 0 ? -1 : x)@. This matches how copilot-c99 translates + -- 'CE.Sign' to C code. + translateSign :: XExpr sym -> TransM sym (XExpr sym) + translateSign xe = liftIO $ numOp bvSign fpSign xe + where + bvSign :: BVOp1 sym w + bvSign e = do + zero <- WI.bvLit sym knownRepr (BV.zero knownNat) + neg_one <- WI.bvLit sym knownNat (BV.mkBV knownNat (-1)) + pos_one <- WI.bvLit sym knownNat (BV.mkBV knownNat 1) + e_neg <- WI.bvSlt sym e zero + e_pos <- WI.bvSgt sym e zero + t <- WI.bvIte sym e_neg neg_one e + WI.bvIte sym e_pos pos_one t + + fpSign :: forall fi . FPOp1 sym fi + fpSign fiRepr e = do + zero <- fpLit fiRepr 0.0 + neg_one <- fpLit fiRepr (-1.0) + pos_one <- fpLit fiRepr 1.0 + e_neg <- WFP.iFloatLt @_ @fi sym e zero + e_pos <- WFP.iFloatGt @_ @fi sym e zero + t <- WFP.iFloatIte @_ @fi sym e_neg neg_one e + WFP.iFloatIte @_ @fi sym e_pos pos_one t + + -- Check the type of the argument. If the argument is a bitvector value, + -- apply the 'BVOp1'. If the argument is a floating-point value, apply the + -- 'FPOp1'. Otherwise, 'panic'. + numOp :: (forall w . BVOp1 sym w) + -> (forall fpp . FPOp1 sym fpp) + -> XExpr sym + -> IO (XExpr sym) + numOp bvOp fpOp xe = case xe of + XInt8 e -> XInt8 <$> bvOp e + XInt16 e -> XInt16 <$> bvOp e + XInt32 e -> XInt32 <$> bvOp e + XInt64 e -> XInt64 <$> bvOp e + XWord8 e -> XWord8 <$> bvOp e + XWord16 e -> XWord16 <$> bvOp e + XWord32 e -> XWord32 <$> bvOp e + XWord64 e -> XWord64 <$> bvOp e + XFloat e -> XFloat <$> fpOp WFP.SingleFloatRepr e + XDouble e -> XDouble <$> fpOp WFP.DoubleFloatRepr e + _ -> unexpectedValue "numOp" + + bvOp :: (forall w . BVOp1 sym w) -> XExpr sym -> IO (XExpr sym) + bvOp f xe = case xe of + XInt8 e -> XInt8 <$> f e + XInt16 e -> XInt16 <$> f e + XInt32 e -> XInt32 <$> f e + XInt64 e -> XInt64 <$> f e + XWord8 e -> XWord8 <$> f e + XWord16 e -> XWord16 <$> f e + XWord32 e -> XWord32 <$> f e + XWord64 e -> XWord64 <$> f e + _ -> unexpectedValue "bvOp" + + fpOp :: (forall fi . FPOp1 sym fi) -> XExpr sym -> IO (XExpr sym) + fpOp g xe = case xe of + XFloat e -> XFloat <$> g WFP.SingleFloatRepr e + XDouble e -> XDouble <$> g WFP.DoubleFloatRepr e + _ -> unexpectedValue "fpOp" + + -- Translate a special-floating operation to the corresponding what4 + -- operation. These operations will be treated as uninterpreted functions in + -- the solver. + fpSpecialOp :: WSF.SpecialFunction (EmptyCtx ::> WSF.R) + -> XExpr sym -> IO (XExpr sym) + fpSpecialOp fn = fpOp (\fiRepr -> WFP.iFloatSpecialFunction1 sym fiRepr fn) + + -- Construct a floating-point literal value of the appropriate type. + fpLit :: forall fi. + WFP.FloatInfoRepr fi + -> (forall frac. Fractional frac => frac) + -> IO (WI.SymExpr sym (WFP.SymInterpretedFloatType sym fi)) + fpLit fiRepr fracLit = + case fiRepr of + WFP.SingleFloatRepr -> WFP.iFloatLitSingle sym fracLit + WFP.DoubleFloatRepr -> WFP.iFloatLitDouble sym fracLit + _ -> panic ["Expected single- or double-precision float", show fiRepr] + + -- A catch-all error message to use when translation cannot proceed. + unexpectedValue :: forall m x. + (Panic.HasCallStack, MonadIO m) + => String + -> m x + unexpectedValue op = + panic [ "Unexpected value in " ++ op ++ ": " ++ show (CP.ppExpr origExpr) + , show xe + ] + +type BVOp2 sym w = + (KnownNat w, 1 <= w) + => WI.SymBV sym w + -> WI.SymBV sym w + -> IO (WI.SymBV sym w) + +type FPOp2 sym fi = + WFP.FloatInfoRepr fi + -> WI.SymExpr sym (WFP.SymInterpretedFloatType sym fi) + -> WI.SymExpr sym (WFP.SymInterpretedFloatType sym fi) + -> IO (WI.SymExpr sym (WFP.SymInterpretedFloatType sym fi)) + +type BoolCmp2 sym = + WI.Pred sym + -> WI.Pred sym + -> IO (WI.Pred sym) + +type BVCmp2 sym w = + (KnownNat w, 1 <= w) + => WI.SymBV sym w + -> WI.SymBV sym w + -> IO (WI.Pred sym) + +type FPCmp2 sym fi = + WFP.FloatInfoRepr fi + -> WI.SymExpr sym (WFP.SymInterpretedFloatType sym fi) + -> WI.SymExpr sym (WFP.SymInterpretedFloatType sym fi) + -> IO (WI.Pred sym) + +translateOp2 :: forall sym a b c . + WFP.IsInterpretedFloatExprBuilder sym + => sym + -> CE.Expr c + -- ^ Original value we are translating (only used for error + -- messages) + -> CE.Op2 a b c + -> XExpr sym + -> XExpr sym + -> TransM sym (XExpr sym) +translateOp2 sym origExpr op xe1 xe2 = case (op, xe1, xe2) of + (CE.And, XBool e1, XBool e2) -> liftIO $ fmap XBool $ WI.andPred sym e1 e2 + (CE.And, _, _) -> unexpectedValues "and operation" + (CE.Or, XBool e1, XBool e2) -> liftIO $ fmap XBool $ WI.orPred sym e1 e2 + (CE.Or, _, _) -> unexpectedValues "or operation" + (CE.Add _, xe1, xe2) -> translateAdd xe1 xe2 + (CE.Sub _, xe1, xe2) -> translateSub xe1 xe2 + (CE.Mul _, xe1, xe2) -> translateMul xe1 xe2 + (CE.Mod _, xe1, xe2) -> do + -- The second argument should not be zero + addBVSidePred1 xe2 $ \e2 _ _ -> WI.bvIsNonzero sym e2 + liftIO $ bvOp (WI.bvSrem sym) (WI.bvUrem sym) xe1 xe2 + (CE.Div _, xe1, xe2) -> do + -- The second argument should not be zero + addBVSidePred1 xe2 $ \e2 _ _ -> WI.bvIsNonzero sym e2 + liftIO $ bvOp (WI.bvSdiv sym) (WI.bvUdiv sym) xe1 xe2 + + -- We do not track any side conditions for floating-point operations + -- (see Note [Side conditions for floating-point operations]), but we will + -- make a note of which operations have partial inputs. + + -- The second argument should not be zero + (CE.Fdiv _, xe1, xe2) -> + liftIO $ + fpOp (\(_ :: WFP.FloatInfoRepr fi) -> WFP.iFloatDiv @_ @fi sym fpRM) + xe1 + xe2 + + -- None of the following should happen: + -- + -- * The first argument is negative, and the second argument is a finite + -- noninteger + -- + -- * The first argument is zero, and the second argument is negative + -- + -- * The arguments cause the result to overflow + -- + -- * The arguments cause the result to underflow + (CE.Pow _, xe1, xe2) -> liftIO $ fpSpecialOp WSF.Pow xe1 xe2 + -- The second argument should not be negative or zero + (CE.Logb _, xe1, xe2) -> liftIO $ fpOp logbFn xe1 xe2 + where + logbFn :: forall fi . FPOp2 sym fi + -- Implement logb(e1,e2) as log(e2)/log(e1). This matches how copilot-c99 + -- translates Logb to C code. + logbFn fiRepr e1 e2 = do + re1 <- WFP.iFloatSpecialFunction1 sym fiRepr WSF.Log e1 + re2 <- WFP.iFloatSpecialFunction1 sym fiRepr WSF.Log e2 + WFP.iFloatDiv @_ @fi sym fpRM re2 re1 + (CE.Atan2 _, xe1, xe2) -> liftIO $ fpSpecialOp WSF.Arctan2 xe1 xe2 + (CE.Eq _, xe1, xe2) -> + liftIO $ + cmp (WI.eqPred sym) + (WI.bvEq sym) + (\(_ :: WFP.FloatInfoRepr fi) -> WFP.iFloatEq @_ @fi sym) + xe1 + xe2 + (CE.Ne _, xe1, xe2) -> translateNe xe1 xe2 + (CE.Le _, xe1, xe2) -> + liftIO $ + numCmp (WI.bvSle sym) + (WI.bvUle sym) + (\(_ :: WFP.FloatInfoRepr fi) -> WFP.iFloatLe @_ @fi sym) + xe1 + xe2 + (CE.Ge _, xe1, xe2) -> + liftIO $ + numCmp (WI.bvSge sym) + (WI.bvUge sym) + (\(_ :: WFP.FloatInfoRepr fi) -> WFP.iFloatGe @_ @fi sym) + xe1 + xe2 + (CE.Lt _, xe1, xe2) -> + liftIO $ + numCmp (WI.bvSlt sym) + (WI.bvUlt sym) + (\(_ :: WFP.FloatInfoRepr fi) -> WFP.iFloatLt @_ @fi sym) + xe1 + xe2 + (CE.Gt _, xe1, xe2) -> + liftIO $ + numCmp (WI.bvSgt sym) + (WI.bvUgt sym) + (\(_ :: WFP.FloatInfoRepr fi) -> WFP.iFloatGt @_ @fi sym) + xe1 + xe2 + (CE.BwAnd _, xe1, xe2) -> + liftIO $ bvOp (WI.bvAndBits sym) (WI.bvAndBits sym) xe1 xe2 + (CE.BwOr _, xe1, xe2) -> + liftIO $ bvOp (WI.bvOrBits sym) (WI.bvOrBits sym) xe1 xe2 + (CE.BwXor _, xe1, xe2) -> + liftIO $ bvOp (WI.bvXorBits sym) (WI.bvXorBits sym) xe1 xe2 + (CE.BwShiftL _ _, xe1, xe2) -> translateBwShiftL xe1 xe2 + (CE.BwShiftR _ _, xe1, xe2) -> translateBwShiftR xe1 xe2 + (CE.Index _, xe1, xe2) -> translateIndex xe1 xe2 + where + -- Translate an 'CE.Add' operation and its arguments into a what4 + -- representation of the appropriate type. + translateAdd :: XExpr sym -> XExpr sym -> TransM sym (XExpr sym) + translateAdd xe1 xe2 = do + addBVSidePred2 xe1 xe2 $ \e1 e2 _ sgn -> + -- The arguments should not result in signed overflow or underflow + case sgn of + Signed -> do + (wrap, _) <- WI.addSignedOF sym e1 e2 + WI.notPred sym wrap + Unsigned -> pure $ WI.truePred sym + + liftIO $ + numOp (WI.bvAdd sym) + (\(_ :: WFP.FloatInfoRepr fi) -> WFP.iFloatAdd @_ @fi sym fpRM) + xe1 + xe2 + + -- Translate a 'CE.Sub' operation and its arguments into a what4 + -- representation of the appropriate type. + translateSub :: XExpr sym -> XExpr sym -> TransM sym (XExpr sym) + translateSub xe1 xe2 = do + addBVSidePred2 xe1 xe2 $ \e1 e2 _ sgn -> + -- The arguments should not result in signed overflow or underflow + case sgn of + Signed -> do + (wrap, _) <- WI.subSignedOF sym e1 e2 + WI.notPred sym wrap + Unsigned -> pure $ WI.truePred sym + + liftIO $ + numOp (WI.bvSub sym) + (\(_ :: WFP.FloatInfoRepr fi) -> WFP.iFloatSub @_ @fi sym fpRM) + xe1 + xe2 + + -- Translate a 'CE.Mul' operation and its arguments into a what4 + -- representation of the appropriate type. + translateMul :: XExpr sym -> XExpr sym -> TransM sym (XExpr sym) + translateMul xe1 xe2 = do + addBVSidePred2 xe1 xe2 $ \e1 e2 _ sgn -> + -- The arguments should not result in signed overflow or underflow + case sgn of + Signed -> do + (wrap, _) <- WI.mulSignedOF sym e1 e2 + WI.notPred sym wrap + Unsigned -> pure $ WI.truePred sym + + liftIO $ + numOp (WI.bvMul sym) + (\(_ :: WFP.FloatInfoRepr fi) -> WFP.iFloatMul @_ @fi sym fpRM) + xe1 + xe2 + + -- Translate an 'CE.Ne' operation and its arguments into a what4 + -- representation of the appropriate type. + translateNe :: XExpr sym -> XExpr sym -> TransM sym (XExpr sym) + translateNe xe1 xe2 = liftIO $ cmp neqPred bvNeq fpNeq xe1 xe2 + where + neqPred :: BoolCmp2 sym + neqPred e1 e2 = do + e <- WI.eqPred sym e1 e2 + WI.notPred sym e + + bvNeq :: forall w . BVCmp2 sym w + bvNeq e1 e2 = do + e <- WI.bvEq sym e1 e2 + WI.notPred sym e + + fpNeq :: forall fi . FPCmp2 sym fi + fpNeq _ e1 e2 = do + e <- WFP.iFloatEq @_ @fi sym e1 e2 + WI.notPred sym e + + -- Translate a 'CE.BwShiftL' operation and its arguments into a what4 + -- representation. + -- + -- Note: we are interpreting the shifter as an unsigned bitvector regardless + -- of whether it is a word or an int. + translateBwShiftL :: XExpr sym -> XExpr sym -> TransM sym (XExpr sym) + translateBwShiftL xe1 xe2 = do + -- These partial pattern matches on Just should always succeed because + -- BwShiftL should always have bitvectors as arguments. + Just (SomeBVExpr e1 w1 sgn1 ctor1) <- return $ asBVExpr xe1 + Just (SomeBVExpr e2 w2 _ _ ) <- return $ asBVExpr xe2 + + e2' <- liftIO $ case testNatCases w1 w2 of + NatCaseLT LeqProof -> WI.bvTrunc sym w1 e2 + NatCaseEQ -> return e2 + NatCaseGT LeqProof -> WI.bvZext sym w1 e2 + res <- liftIO $ WI.bvShl sym e1 e2' + + -- The second argument should not be greater than or equal to the bit + -- width + wBV <- liftIO $ WI.bvLit sym w1 $ BV.width w1 + notTooLarge <- liftIO $ WI.bvUlt sym e2' wBV + addSidePred notTooLarge + + case sgn1 of + Unsigned -> do + -- Non-zero bits should not be shifted out + otherDirection <- liftIO $ WI.bvLshr sym res e2' + noWrap <- liftIO $ WI.bvEq sym e1 otherDirection + addSidePred noWrap + Signed -> do + -- Bits that disagree with the sign bit should not be shifted out + otherDirection <- liftIO $ WI.bvAshr sym res e2' + noWrap <- liftIO $ WI.bvEq sym e1 otherDirection + addSidePred noWrap + + return $ ctor1 res + + -- Translate a 'CE.BwShiftL' operation and its arguments into a what4 + -- representation. + -- + -- Note: we are interpreting the shifter as an unsigned bitvector regardless + -- of whether it is a word or an int. + translateBwShiftR :: XExpr sym -> XExpr sym -> TransM sym (XExpr sym) + translateBwShiftR xe1 xe2 = do + -- These partial pattern matches on Just should always succeed because + -- BwShiftL should always have bitvectors as arguments. + Just (SomeBVExpr e1 w1 sgn1 ctor1) <- return $ asBVExpr xe1 + Just (SomeBVExpr e2 w2 _ _ ) <- return $ asBVExpr xe2 + + e2' <- liftIO $ case testNatCases w1 w2 of + NatCaseLT LeqProof -> WI.bvTrunc sym w1 e2 + NatCaseEQ -> return e2 + NatCaseGT LeqProof -> WI.bvZext sym w1 e2 + + -- The second argument should not be greater than or equal to the bit + -- width + wBV <- liftIO $ WI.bvLit sym w1 $ BV.width w1 + notTooLarge <- liftIO $ WI.bvUlt sym e2' wBV + addSidePred notTooLarge + + liftIO $ fmap ctor1 $ case sgn1 of + Signed -> WI.bvAshr sym e1 e2' + Unsigned -> WI.bvLshr sym e1 e2' + + -- Translate an 'CE.Index' operation and its arguments into a what4 + -- representation. This checks that the first argument is an 'XArray' and + -- the second argument is an 'XWord32', invoking 'panic' is this invariant + -- is not upheld. + -- + -- Note: Currently, copilot only checks if array indices are out of bounds + -- as a side condition. The method of translation we are using simply + -- creates a nest of if-then-else expression to check the index expression + -- against all possible indices. If the index expression is known by the + -- solver to be out of bounds (for instance, if it is a constant 5 for an + -- array of 5 elements), then the if-then-else will trivially resolve to + -- true. + translateIndex :: XExpr sym -> XExpr sym -> TransM sym (XExpr sym) + translateIndex xe1 xe2 = case (xe1, xe2) of + (XArray xes, XWord32 ix) -> do + -- The second argument should not be out of bounds (i.e., greater than + -- or equal to the length of the array) + xesLenBV <- liftIO $ WI.bvLit sym knownNat $ BV.mkBV knownNat + $ toInteger $ V.lengthInt xes + inRange <- liftIO $ WI.bvUlt sym ix xesLenBV + addSidePred inRange + + liftIO $ buildIndexExpr sym ix xes + _ -> unexpectedValues "index operation" + + -- Check the types of the arguments. If the arguments are bitvector values, + -- apply the 'BVOp2'. If the arguments are floating-point values, apply the + -- 'FPOp2'. Otherwise, 'panic'. + numOp :: (forall w . BVOp2 sym w) + -> (forall fi . FPOp2 sym fi) + -> XExpr sym + -> XExpr sym + -> IO (XExpr sym) + numOp bvOp fpOp xe1 xe2 = case (xe1, xe2) of + (XInt8 e1, XInt8 e2) -> XInt8 <$> bvOp e1 e2 + (XInt16 e1, XInt16 e2) -> XInt16 <$> bvOp e1 e2 + (XInt32 e1, XInt32 e2) -> XInt32 <$> bvOp e1 e2 + (XInt64 e1, XInt64 e2) -> XInt64 <$> bvOp e1 e2 + (XWord8 e1, XWord8 e2) -> XWord8 <$> bvOp e1 e2 + (XWord16 e1, XWord16 e2) -> XWord16 <$> bvOp e1 e2 + (XWord32 e1, XWord32 e2) -> XWord32 <$> bvOp e1 e2 + (XWord64 e1, XWord64 e2) -> XWord64 <$> bvOp e1 e2 + (XFloat e1, XFloat e2) -> XFloat <$> fpOp WFP.SingleFloatRepr e1 e2 + (XDouble e1, XDouble e2) -> XDouble <$> fpOp WFP.DoubleFloatRepr e1 e2 + _ -> unexpectedValues "numOp" + + -- Check the types of the arguments. If the arguments are signed bitvector + -- values, apply the first 'BVOp2'. If the arguments are unsigned bitvector + -- values, apply the second 'BVOp2'. Otherwise, 'panic'. + bvOp :: (forall w . BVOp2 sym w) + -> (forall w . BVOp2 sym w) + -> XExpr sym + -> XExpr sym + -> IO (XExpr sym) + bvOp opS opU xe1 xe2 = case (xe1, xe2) of + (XInt8 e1, XInt8 e2) -> XInt8 <$> opS e1 e2 + (XInt16 e1, XInt16 e2) -> XInt16 <$> opS e1 e2 + (XInt32 e1, XInt32 e2) -> XInt32 <$> opS e1 e2 + (XInt64 e1, XInt64 e2) -> XInt64 <$> opS e1 e2 + (XWord8 e1, XWord8 e2) -> XWord8 <$> opU e1 e2 + (XWord16 e1, XWord16 e2) -> XWord16 <$> opU e1 e2 + (XWord32 e1, XWord32 e2) -> XWord32 <$> opU e1 e2 + (XWord64 e1, XWord64 e2) -> XWord64 <$> opU e1 e2 + _ -> unexpectedValues "bvOp" + + fpOp :: (forall fi . FPOp2 sym fi) + -> XExpr sym + -> XExpr sym + -> IO (XExpr sym) + fpOp op xe1 xe2 = case (xe1, xe2) of + (XFloat e1, XFloat e2) -> XFloat <$> op WFP.SingleFloatRepr e1 e2 + (XDouble e1, XDouble e2) -> XDouble <$> op WFP.DoubleFloatRepr e1 e2 + _ -> unexpectedValues "fpOp" + + -- Translate a special-floating operation to the corresponding what4 + -- operation. These operations will be treated as uninterpreted functions in + -- the solver. + fpSpecialOp :: WSF.SpecialFunction (EmptyCtx ::> WSF.R ::> WSF.R) + -> XExpr sym -> XExpr sym -> IO (XExpr sym) + fpSpecialOp fn = fpOp (\fiRepr -> WFP.iFloatSpecialFunction2 sym fiRepr fn) + + -- Check the types of the arguments. If the arguments are bitvector values, + -- apply the 'BVCmp2'. If the arguments are floating-point values, apply the + -- 'FPCmp2'. Otherwise, 'panic'. + cmp :: BoolCmp2 sym + -> (forall w . BVCmp2 sym w) + -> (forall fi . FPCmp2 sym fi) + -> XExpr sym + -> XExpr sym + -> IO (XExpr sym) + cmp boolOp bvOp fpOp xe1 xe2 = case (xe1, xe2) of + (XBool e1, XBool e2) -> XBool <$> boolOp e1 e2 + (XInt8 e1, XInt8 e2) -> XBool <$> bvOp e1 e2 + (XInt16 e1, XInt16 e2) -> XBool <$> bvOp e1 e2 + (XInt32 e1, XInt32 e2) -> XBool <$> bvOp e1 e2 + (XInt64 e1, XInt64 e2) -> XBool <$> bvOp e1 e2 + (XWord8 e1, XWord8 e2) -> XBool <$> bvOp e1 e2 + (XWord16 e1, XWord16 e2) -> XBool <$> bvOp e1 e2 + (XWord32 e1, XWord32 e2) -> XBool <$> bvOp e1 e2 + (XWord64 e1, XWord64 e2) -> XBool <$> bvOp e1 e2 + (XFloat e1, XFloat e2) -> XBool <$> fpOp WFP.SingleFloatRepr e1 e2 + (XDouble e1, XDouble e2) -> XBool <$> fpOp WFP.DoubleFloatRepr e1 e2 + _ -> unexpectedValues "cmp" + + -- Check the types of the arguments. If the arguments are signed bitvector + -- values, apply the first 'BVCmp2'. If the arguments are unsigned bitvector + -- values, apply the second 'BVCmp2'. If the arguments are floating-point + -- values, apply the 'FPCmp2'. Otherwise, 'panic'. + numCmp :: (forall w . BVCmp2 sym w) + -> (forall w . BVCmp2 sym w) + -> (forall fi . FPCmp2 sym fi) + -> XExpr sym + -> XExpr sym + -> IO (XExpr sym) + numCmp bvSOp bvUOp fpOp xe1 xe2 = case (xe1, xe2) of + (XInt8 e1, XInt8 e2) -> XBool <$> bvSOp e1 e2 + (XInt16 e1, XInt16 e2) -> XBool <$> bvSOp e1 e2 + (XInt32 e1, XInt32 e2) -> XBool <$> bvSOp e1 e2 + (XInt64 e1, XInt64 e2) -> XBool <$> bvSOp e1 e2 + (XWord8 e1, XWord8 e2) -> XBool <$> bvUOp e1 e2 + (XWord16 e1, XWord16 e2) -> XBool <$> bvUOp e1 e2 + (XWord32 e1, XWord32 e2) -> XBool <$> bvUOp e1 e2 + (XWord64 e1, XWord64 e2) -> XBool <$> bvUOp e1 e2 + (XFloat e1, XFloat e2) -> XBool <$> fpOp WFP.SingleFloatRepr e1 e2 + (XDouble e1, XDouble e2) -> XBool <$> fpOp WFP.DoubleFloatRepr e1 e2 + _ -> unexpectedValues "numCmp" + + -- A catch-all error message to use when translation cannot proceed. + unexpectedValues :: forall m x. + (Panic.HasCallStack, MonadIO m) + => String + -> m x + unexpectedValues op = + panic [ "Unexpected values in " ++ op ++ ": " ++ show (CP.ppExpr origExpr) + , show xe1, show xe2 + ] + +translateOp3 :: forall sym a b c d . + WFP.IsInterpretedFloatExprBuilder sym + => sym + -> CE.Expr d + -- ^ Original value we are translating (only used for error + -- messages) + -> CE.Op3 a b c d + -> XExpr sym + -> XExpr sym + -> XExpr sym + -> TransM sym (XExpr sym) +translateOp3 sym origExpr op xe1 xe2 xe3 = case (op, xe1, xe2, xe3) of + (CE.Mux _, XBool te, xe1, xe2) -> liftIO $ mkIte sym te xe1 xe2 + (CE.Mux _, _, _, _) -> unexpectedValues "mux operation" + where + unexpectedValues :: forall m x . (Panic.HasCallStack, MonadIO m) + => String -> m x + unexpectedValues op = + panic [ "Unexpected values in " ++ op ++ ":" + , show (CP.ppExpr origExpr), show xe1, show xe2, show xe3 + ] + +-- | Construct an expression that indexes into an array by building a chain of +-- @if@ expressions, where each expression checks if the current index is equal +-- to a given index in the array. If the indices are equal, return the element +-- of the array at that index. Otherwise, proceed to the next @if@ expression, +-- which checks the next index in the array. +buildIndexExpr :: forall sym n. + (1 <= n, WFP.IsInterpretedFloatExprBuilder sym) + => sym + -> WI.SymBV sym 32 + -- ^ Index + -> V.Vector n (XExpr sym) + -- ^ Elements + -> IO (XExpr sym) +buildIndexExpr sym ix = loop 0 + where + loop :: forall n'. + (1 <= n') + => Word32 + -> V.Vector n' (XExpr sym) + -> IO (XExpr sym) + loop curIx xelts = case V.uncons xelts of + -- Base case, exactly one element left + (xe, Left Refl) -> return xe + -- Recursive case + (xe, Right xelts') -> do + LeqProof <- return $ V.nonEmpty xelts' + rstExpr <- loop (curIx+1) xelts' + curIxExpr <- WI.bvLit sym knownNat (BV.word32 curIx) + ixEq <- WI.bvEq sym curIxExpr ix + mkIte sym ixEq xe rstExpr + +-- | Construct an @if@ expression of the appropriate type. +mkIte :: WFP.IsInterpretedFloatExprBuilder sym + => sym + -> WI.Pred sym + -> XExpr sym + -> XExpr sym + -> IO (XExpr sym) +mkIte sym pred xe1 xe2 = case (xe1, xe2) of + (XBool e1, XBool e2) -> XBool <$> WI.itePred sym pred e1 e2 + (XInt8 e1, XInt8 e2) -> XInt8 <$> WI.bvIte sym pred e1 e2 + (XInt16 e1, XInt16 e2) -> XInt16 <$> WI.bvIte sym pred e1 e2 + (XInt32 e1, XInt32 e2) -> XInt32 <$> WI.bvIte sym pred e1 e2 + (XInt64 e1, XInt64 e2) -> XInt64 <$> WI.bvIte sym pred e1 e2 + (XWord8 e1, XWord8 e2) -> XWord8 <$> WI.bvIte sym pred e1 e2 + (XWord16 e1, XWord16 e2) -> XWord16 <$> WI.bvIte sym pred e1 e2 + (XWord32 e1, XWord32 e2) -> XWord32 <$> WI.bvIte sym pred e1 e2 + (XWord64 e1, XWord64 e2) -> XWord64 <$> WI.bvIte sym pred e1 e2 + (XFloat e1, XFloat e2) -> + XFloat <$> WFP.iFloatIte @_ @WFP.SingleFloat sym pred e1 e2 + (XDouble e1, XDouble e2) -> + XDouble <$> WFP.iFloatIte @_ @WFP.DoubleFloat sym pred e1 e2 + (XStruct xes1, XStruct xes2) -> + XStruct <$> zipWithM (mkIte sym pred) xes1 xes2 + (XEmptyArray, XEmptyArray) -> return XEmptyArray + (XArray xes1, XArray xes2) -> + case V.length xes1 `testEquality` V.length xes2 of + Just Refl -> XArray <$> V.zipWithM (mkIte sym pred) xes1 xes2 + Nothing -> panic [ "Array length mismatch in ite" + , show (V.length xes1) + , show (V.length xes2) + ] + _ -> panic ["Unexpected values in ite", show xe1, show xe2] + +-- | Cast an 'XExpr' to another 'XExpr' of a possibly differing type. +castOp :: WFP.IsInterpretedFloatExprBuilder sym + => sym + -> CE.Expr b + -- ^ Original value we are translating (only used for error + -- messages) + -> CT.Type a + -- ^ Type we are casting to + -> XExpr sym + -- ^ Value to cast + -> IO (XExpr sym) +castOp sym origExpr tp xe = case (xe, tp) of + -- "safe" casts that cannot lose information + (XBool _, CT.Bool) -> return xe + (XBool e, CT.Word8) -> XWord8 <$> WI.predToBV sym e knownNat + (XBool e, CT.Word16) -> XWord16 <$> WI.predToBV sym e knownNat + (XBool e, CT.Word32) -> XWord32 <$> WI.predToBV sym e knownNat + (XBool e, CT.Word64) -> XWord64 <$> WI.predToBV sym e knownNat + (XBool e, CT.Int8) -> XInt8 <$> WI.predToBV sym e knownNat + (XBool e, CT.Int16) -> XInt16 <$> WI.predToBV sym e knownNat + (XBool e, CT.Int32) -> XInt32 <$> WI.predToBV sym e knownNat + (XBool e, CT.Int64) -> XInt64 <$> WI.predToBV sym e knownNat + + (XInt8 _, CT.Int8) -> return xe + (XInt8 e, CT.Int16) -> XInt16 <$> WI.bvSext sym knownNat e + (XInt8 e, CT.Int32) -> XInt32 <$> WI.bvSext sym knownNat e + (XInt8 e, CT.Int64) -> XInt64 <$> WI.bvSext sym knownNat e + (XInt16 _, CT.Int16) -> return xe + (XInt16 e, CT.Int32) -> XInt32 <$> WI.bvSext sym knownNat e + (XInt16 e, CT.Int64) -> XInt64 <$> WI.bvSext sym knownNat e + (XInt32 _, CT.Int32) -> return xe + (XInt32 e, CT.Int64) -> XInt64 <$> WI.bvSext sym knownNat e + (XInt64 _, CT.Int64) -> return xe + + (XWord8 e, CT.Int16) -> XInt16 <$> WI.bvZext sym knownNat e + (XWord8 e, CT.Int32) -> XInt32 <$> WI.bvZext sym knownNat e + (XWord8 e, CT.Int64) -> XInt64 <$> WI.bvZext sym knownNat e + (XWord8 _, CT.Word8) -> return xe + (XWord8 e, CT.Word16) -> XWord16 <$> WI.bvZext sym knownNat e + (XWord8 e, CT.Word32) -> XWord32 <$> WI.bvZext sym knownNat e + (XWord8 e, CT.Word64) -> XWord64 <$> WI.bvZext sym knownNat e + (XWord16 e, CT.Int32) -> XInt32 <$> WI.bvZext sym knownNat e + (XWord16 e, CT.Int64) -> XInt64 <$> WI.bvZext sym knownNat e + (XWord16 _, CT.Word16) -> return xe + (XWord16 e, CT.Word32) -> XWord32 <$> WI.bvZext sym knownNat e + (XWord16 e, CT.Word64) -> XWord64 <$> WI.bvZext sym knownNat e + (XWord32 e, CT.Int64) -> XInt64 <$> WI.bvZext sym knownNat e + (XWord32 _, CT.Word32) -> return xe + (XWord32 e, CT.Word64) -> XWord64 <$> WI.bvZext sym knownNat e + (XWord64 _, CT.Word64) -> return xe + + -- "unsafe" casts, which may lose information + -- unsigned truncations + (XWord64 e, CT.Word32) -> XWord32 <$> WI.bvTrunc sym knownNat e + (XWord64 e, CT.Word16) -> XWord16 <$> WI.bvTrunc sym knownNat e + (XWord64 e, CT.Word8) -> XWord8 <$> WI.bvTrunc sym knownNat e + (XWord32 e, CT.Word16) -> XWord16 <$> WI.bvTrunc sym knownNat e + (XWord32 e, CT.Word8) -> XWord8 <$> WI.bvTrunc sym knownNat e + (XWord16 e, CT.Word8) -> XWord8 <$> WI.bvTrunc sym knownNat e + + -- signed truncations + (XInt64 e, CT.Int32) -> XInt32 <$> WI.bvTrunc sym knownNat e + (XInt64 e, CT.Int16) -> XInt16 <$> WI.bvTrunc sym knownNat e + (XInt64 e, CT.Int8) -> XInt8 <$> WI.bvTrunc sym knownNat e + (XInt32 e, CT.Int16) -> XInt16 <$> WI.bvTrunc sym knownNat e + (XInt32 e, CT.Int8) -> XInt8 <$> WI.bvTrunc sym knownNat e + (XInt16 e, CT.Int8) -> XInt8 <$> WI.bvTrunc sym knownNat e + + -- signed integer to float + (XInt64 e, CT.Float) -> + XFloat <$> WFP.iSBVToFloat sym WFP.SingleFloatRepr fpRM e + (XInt32 e, CT.Float) -> + XFloat <$> WFP.iSBVToFloat sym WFP.SingleFloatRepr fpRM e + (XInt16 e, CT.Float) -> + XFloat <$> WFP.iSBVToFloat sym WFP.SingleFloatRepr fpRM e + (XInt8 e, CT.Float) -> + XFloat <$> WFP.iSBVToFloat sym WFP.SingleFloatRepr fpRM e + + -- unsigned integer to float + (XWord64 e, CT.Float) -> + XFloat <$> WFP.iBVToFloat sym WFP.SingleFloatRepr fpRM e + (XWord32 e, CT.Float) -> + XFloat <$> WFP.iBVToFloat sym WFP.SingleFloatRepr fpRM e + (XWord16 e, CT.Float) -> + XFloat <$> WFP.iBVToFloat sym WFP.SingleFloatRepr fpRM e + (XWord8 e, CT.Float) -> + XFloat <$> WFP.iBVToFloat sym WFP.SingleFloatRepr fpRM e + + -- signed integer to double + (XInt64 e, CT.Double) -> + XDouble <$> WFP.iSBVToFloat sym WFP.DoubleFloatRepr fpRM e + (XInt32 e, CT.Double) -> + XDouble <$> WFP.iSBVToFloat sym WFP.DoubleFloatRepr fpRM e + (XInt16 e, CT.Double) -> + XDouble <$> WFP.iSBVToFloat sym WFP.DoubleFloatRepr fpRM e + (XInt8 e, CT.Double) -> + XDouble <$> WFP.iSBVToFloat sym WFP.DoubleFloatRepr fpRM e + + -- unsigned integer to double + (XWord64 e, CT.Double) -> + XDouble <$> WFP.iBVToFloat sym WFP.DoubleFloatRepr fpRM e + (XWord32 e, CT.Double) -> + XDouble <$> WFP.iBVToFloat sym WFP.DoubleFloatRepr fpRM e + (XWord16 e, CT.Double) -> + XDouble <$> WFP.iBVToFloat sym WFP.DoubleFloatRepr fpRM e + (XWord8 e, CT.Double) -> + XDouble <$> WFP.iBVToFloat sym WFP.DoubleFloatRepr fpRM e + + -- unsigned to signed conversion + (XWord64 e, CT.Int64) -> return $ XInt64 e + (XWord32 e, CT.Int32) -> return $ XInt32 e + (XWord16 e, CT.Int16) -> return $ XInt16 e + (XWord8 e, CT.Int8) -> return $ XInt8 e + + -- signed to unsigned conversion + (XInt64 e, CT.Word64) -> return $ XWord64 e + (XInt32 e, CT.Word32) -> return $ XWord32 e + (XInt16 e, CT.Word16) -> return $ XWord16 e + (XInt8 e, CT.Word8) -> return $ XWord8 e + + _ -> panic ["Could not compute cast", show (CP.ppExpr origExpr), show xe] + +-- * What4 representations of Copilot expressions + +-- | The What4 representation of a copilot expression. We do not attempt to +-- track the type of the inner expression at the type level, but instead lump +-- everything together into the @XExpr sym@ type. The only reason this is a GADT +-- is for the array case; we need to know that the array length is strictly +-- positive. +data XExpr sym where + XBool :: WI.SymExpr sym WT.BaseBoolType -> XExpr sym + XInt8 :: WI.SymExpr sym (WT.BaseBVType 8) -> XExpr sym + XInt16 :: WI.SymExpr sym (WT.BaseBVType 16) -> XExpr sym + XInt32 :: WI.SymExpr sym (WT.BaseBVType 32) -> XExpr sym + XInt64 :: WI.SymExpr sym (WT.BaseBVType 64) -> XExpr sym + XWord8 :: WI.SymExpr sym (WT.BaseBVType 8) -> XExpr sym + XWord16 :: WI.SymExpr sym (WT.BaseBVType 16) -> XExpr sym + XWord32 :: WI.SymExpr sym (WT.BaseBVType 32) -> XExpr sym + XWord64 :: WI.SymExpr sym (WT.BaseBVType 64) -> XExpr sym + XFloat :: WI.SymExpr + sym + (WFP.SymInterpretedFloatType sym WFP.SingleFloat) + -> XExpr sym + XDouble :: WI.SymExpr + sym + (WFP.SymInterpretedFloatType sym WFP.DoubleFloat) + -> XExpr sym + XEmptyArray :: XExpr sym + XArray :: 1 <= n => V.Vector n (XExpr sym) -> XExpr sym + XStruct :: [XExpr sym] -> XExpr sym + +instance WI.IsExprBuilder sym => Show (XExpr sym) where + show (XBool e) = "XBool " ++ show (WI.printSymExpr e) + show (XInt8 e) = "XInt8 " ++ show (WI.printSymExpr e) + show (XInt16 e) = "XInt16 " ++ show (WI.printSymExpr e) + show (XInt32 e) = "XInt32 " ++ show (WI.printSymExpr e) + show (XInt64 e) = "XInt64 " ++ show (WI.printSymExpr e) + show (XWord8 e) = "XWord8 " ++ show (WI.printSymExpr e) + show (XWord16 e) = "XWord16 " ++ show (WI.printSymExpr e) + show (XWord32 e) = "XWord32 " ++ show (WI.printSymExpr e) + show (XWord64 e) = "XWord64 " ++ show (WI.printSymExpr e) + show (XFloat e) = "XFloat " ++ show (WI.printSymExpr e) + show (XDouble e) = "XDouble " ++ show (WI.printSymExpr e) + show XEmptyArray = "[]" + show (XArray vs) = showList (V.toList vs) "" + show (XStruct xs) = "XStruct " ++ showList xs "" + +-- * Stream offsets + +-- | Streams expressions are evaluated in two possible modes. The \"absolute\" +-- mode computes the value of a stream expression relative to the beginning of +-- time @t=0@. The \"relative\" mode is useful for inductive proofs and the +-- offset values are conceptually relative to some arbitrary, but fixed, index +-- @j>=0@. In both cases, negative indexes are not allowed. +-- +-- The main difference between these modes is the interpretation of streams for +-- the first values, which are in the \"buffer\" range. For absolute indices, +-- the actual fixed values for the streams are returned; for relative indices, +-- uninterpreted values are generated for the values in the stream buffer. For +-- both modes, stream values after their buffer region are defined by their +-- recurrence expression. +data StreamOffset + = AbsoluteOffset !Integer + | RelativeOffset !Integer + deriving (Eq, Ord, Show) + +-- | Increment a stream offset by a drop amount. +addOffset :: StreamOffset -> CE.DropIdx -> StreamOffset +addOffset (AbsoluteOffset i) j = AbsoluteOffset (i + toInteger j) +addOffset (RelativeOffset i) j = RelativeOffset (i + toInteger j) + +-- * Auxiliary definitions + +-- | We assume round-near-even throughout, but this variable can be changed if +-- needed. +fpRM :: WI.RoundingMode +fpRM = WI.RNE + +data CopilotWhat4 = CopilotWhat4 + +instance Panic.PanicComponent CopilotWhat4 where + panicComponentName _ = "Copilot/What4 translation" + panicComponentIssues _ = "https://github.com/Copilot-Language/copilot/issues" + + {-# NOINLINE Panic.panicComponentRevision #-} + panicComponentRevision = $(Panic.useGitRevision) + +-- | Use this function rather than an error monad since it indicates that +-- something in the implementation of @copilot-theorem@ is incorrect. +panic :: (Panic.HasCallStack, MonadIO m) => [String] -> m a +panic msg = Panic.panic CopilotWhat4 "Copilot.Theorem.What4" msg From c23038874f473577857cdacb5c92b8320d87ee3d Mon Sep 17 00:00:00 2001 From: Ryan Scott Date: Tue, 11 Oct 2022 16:18:02 -0400 Subject: [PATCH 0473/1222] copilot-theorem: Document changes in CHANGELOG. Refs #363. --- copilot-theorem/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-theorem/CHANGELOG b/copilot-theorem/CHANGELOG index 16e12fc62..7bbaf2fe2 100644 --- a/copilot-theorem/CHANGELOG +++ b/copilot-theorem/CHANGELOG @@ -1,3 +1,6 @@ +2022-10-11 + * Add functionality for bisimulation proofs of Copilot specifications. (#363) + 2022-09-07 * Version bump (3.11). (#376) From 11555375f20748b090bf445443fb1eddf17581db Mon Sep 17 00:00:00 2001 From: Will Pogge Date: Tue, 18 Oct 2022 13:59:51 -0400 Subject: [PATCH 0474/1222] copilot-c99: Remove deprecated flag from cabal file. Refs #380. The cabal file of copilot-c99 specifies a compiler flag --no-deprecations that stopped being necessary when the internal modules were hidden from the public interface. This commit removes the flag and the comment that explains why it was needed. --- copilot-c99/copilot-c99.cabal | 6 +----- 1 file changed, 1 insertion(+), 5 deletions(-) diff --git a/copilot-c99/copilot-c99.cabal b/copilot-c99/copilot-c99.cabal index 87ba9e74b..c03507302 100644 --- a/copilot-c99/copilot-c99.cabal +++ b/copilot-c99/copilot-c99.cabal @@ -38,11 +38,7 @@ library default-language : Haskell2010 hs-source-dirs : src - -- The following -Wno-deprecations is temprary and related to issue - -- https://github.com/Copilot-Language/copilot/issues/237 - -- It should be removed in a future version, when this library hides - -- internal modules. - ghc-options : -Wall -Wno-deprecations + ghc-options : -Wall build-depends : base >= 4.9 && < 5 , directory >= 1.3 && < 1.4 , filepath >= 1.4 && < 1.5 From 33efae3dd8ee92798b01b08a4422a5f46becebbe Mon Sep 17 00:00:00 2001 From: Will Pogge Date: Tue, 18 Oct 2022 14:01:32 -0400 Subject: [PATCH 0475/1222] copilot-c99: Document changes in CHANGELOG. Refs #380. --- copilot-c99/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-c99/CHANGELOG b/copilot-c99/CHANGELOG index e0c5a453a..d9f5e6079 100644 --- a/copilot-c99/CHANGELOG +++ b/copilot-c99/CHANGELOG @@ -1,3 +1,6 @@ +2022-10-18 + * Removed deprecated flag from cabal file. (#380) + 2022-09-07 * Version bump (3.11). (#376) * Update to support language-c99-0.2.0. (#371) From 006393826c20f496a295c7d42ec7ba234e26a2a1 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 21 Oct 2022 20:25:12 +0000 Subject: [PATCH 0476/1222] copilot-prettyprinter: Create new library for pretty-printer. Refs #383. The architecture of Copilot mixes backends with other libraries, which makes the result not uniform. More specifically, the pretty-printer is part of copilot-core, while the C99 backend and the interpreter are in separate libraries. The implementation does not match our desired architecture according to our design documents, and it makes the code partly harder to maintain. This commit introduces a new library, copilot-prettyprinter, that publishes functions to pretty-print a Copilot Core expression. The modules are taken from copilot-core and published under a different namespace. --- copilot-prettyprinter/CHANGELOG | 0 copilot-prettyprinter/LICENSE | 29 +++ copilot-prettyprinter/README.md | 33 +++ copilot-prettyprinter/Setup.hs | 2 + .../copilot-prettyprinter.cabal | 57 +++++ .../src/Copilot/PrettyPrint.hs | 194 ++++++++++++++++++ .../src/Copilot/PrettyPrint/Error.hs | 24 +++ .../src/Copilot/PrettyPrint/Type.hs | 77 +++++++ 8 files changed, 416 insertions(+) create mode 100644 copilot-prettyprinter/CHANGELOG create mode 100644 copilot-prettyprinter/LICENSE create mode 100644 copilot-prettyprinter/README.md create mode 100644 copilot-prettyprinter/Setup.hs create mode 100644 copilot-prettyprinter/copilot-prettyprinter.cabal create mode 100644 copilot-prettyprinter/src/Copilot/PrettyPrint.hs create mode 100644 copilot-prettyprinter/src/Copilot/PrettyPrint/Error.hs create mode 100644 copilot-prettyprinter/src/Copilot/PrettyPrint/Type.hs diff --git a/copilot-prettyprinter/CHANGELOG b/copilot-prettyprinter/CHANGELOG new file mode 100644 index 000000000..e69de29bb diff --git a/copilot-prettyprinter/LICENSE b/copilot-prettyprinter/LICENSE new file mode 100644 index 000000000..d4ed5bc4c --- /dev/null +++ b/copilot-prettyprinter/LICENSE @@ -0,0 +1,29 @@ +2009 +BSD3 License terms + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions +are met: + +Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. + +Redistributions in binary form must reproduce the above copyright +notice, this list of conditions and the following disclaimer in the +documentation and/or other materials provided with the distribution. + +Neither the name of the developers nor the names of its contributors +may be used to endorse or promote products derived from this software +without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR +CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, +EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, +PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR +PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF +LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING +NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/copilot-prettyprinter/README.md b/copilot-prettyprinter/README.md new file mode 100644 index 000000000..a1ca540c4 --- /dev/null +++ b/copilot-prettyprinter/README.md @@ -0,0 +1,33 @@ +[![Build Status](https://travis-ci.com/Copilot-Language/copilot.svg?branch=master)](https://app.travis-ci.com/github/Copilot-Language/copilot) + +# Copilot: a stream DSL +Copilot-prettyprinter implements a pretty-printer of Copilot Core +specifications. + +Copilot is a runtime verification framework written in Haskell. It allows the +user to write programs in a simple but powerful way using a stream-based +approach. + +Programs can be interpreted for testing, or translated C99 code to be +incorporated in a project, or as a standalone application. The C99 backend +ensures us that the output is constant in memory and time, making it suitable +for systems with hard realtime requirements. + + +## Installation +Copilot-prettyprinter can be found on +[Hackage](https://hackage.haskell.org/package/copilot-prettyprinter). It is +typically only installed as part of the complete Copilot distribution. For +installation instructions, please refer to the [Copilot +website](https://copilot-language.github.io). + + +## Further information +For further information, install instructions and documentation, please visit +the Copilot website: +[https://copilot-language.github.io](https://copilot-language.github.io) + + +## License +Copilot is distributed under the BSD-3-Clause license, which can be found +[here](https://raw.githubusercontent.com/Copilot-Language/copilot/master/copilot-prettyprinter/LICENSE). diff --git a/copilot-prettyprinter/Setup.hs b/copilot-prettyprinter/Setup.hs new file mode 100644 index 000000000..9a994af67 --- /dev/null +++ b/copilot-prettyprinter/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/copilot-prettyprinter/copilot-prettyprinter.cabal b/copilot-prettyprinter/copilot-prettyprinter.cabal new file mode 100644 index 000000000..6e298d624 --- /dev/null +++ b/copilot-prettyprinter/copilot-prettyprinter.cabal @@ -0,0 +1,57 @@ +cabal-version: >=1.10 +name: copilot-prettyprinter +version: 3.11 +synopsis: A prettyprinter of Copilot Specifications. +description: + A prettyprinter of Copilot specifications. + . + Copilot is a stream (i.e., infinite lists) domain-specific language (DSL) in + Haskell that compiles into embedded C. Copilot contains an interpreter, + multiple back-end compilers, and other verification tools. + . + A tutorial, examples, and other information are available at + . + +author: Frank Dedden, Lee Pike, Robin Morisset, Alwyn Goodloe, + Sebastian Niller, Nis Nordbyop Wegmann, Ivan Perez +license: BSD3 +license-file: LICENSE +maintainer: Ivan Perez +homepage: https://copilot-language.github.io +bug-reports: https://github.com/Copilot-Language/copilot/issues +stability: Experimental +category: Language, Embedded +build-type: Simple +extra-source-files: README.md, CHANGELOG + +x-curation: uncurated + +source-repository head + type: git + location: https://github.com/Copilot-Language/copilot.git + subdir: copilot-prettyprinter + +library + + default-language: Haskell2010 + + hs-source-dirs: src + + ghc-options: + -Wall + -fno-warn-orphans + + build-depends: + base >= 4.9 && < 5, + pretty >= 1.0 && < 1.2, + + copilot-core + + exposed-modules: + + Copilot.PrettyPrint + + other-modules: + + Copilot.PrettyPrint.Error + Copilot.PrettyPrint.Type diff --git a/copilot-prettyprinter/src/Copilot/PrettyPrint.hs b/copilot-prettyprinter/src/Copilot/PrettyPrint.hs new file mode 100644 index 000000000..10100a88f --- /dev/null +++ b/copilot-prettyprinter/src/Copilot/PrettyPrint.hs @@ -0,0 +1,194 @@ +-- Copyright © 2011 National Institute of Aerospace / Galois, Inc. + +-- | A pretty printer for Copilot specifications. + +{-# LANGUAGE GADTs #-} +{-# LANGUAGE Safe #-} + +module Copilot.PrettyPrint + ( prettyPrint + , ppExpr + ) where + +import Copilot.Core +import Copilot.PrettyPrint.Error (impossible) +import Copilot.PrettyPrint.Type (showWithType, ShowType(..), showType) +import Prelude hiding (id, (<>)) +import Text.PrettyPrint.HughesPJ +import Data.List (intersperse) + +-- | Create a unique stream name by prefixing the given ID by a lowercase +-- letter @"s"@. +strmName :: Int -> Doc +strmName id = text "s" <> int id + +-- | Pretty-print a Copilot expression. +-- +-- The type is ignored, and only the expression is pretty-printed. +ppExpr :: Expr a -> Doc +ppExpr e0 = case e0 of + Const t x -> text (showWithType Haskell t x) + Drop _ 0 id -> strmName id + Drop _ i id -> text "drop" <+> text (show i) <+> strmName id + ExternVar _ name _ -> text "Ext_" <> (text name) + Local _ _ name e1 e2 -> text "local" <+> doubleQuotes (text name) <+> equals + <+> ppExpr e1 $$ text "in" <+> ppExpr e2 + Var _ name -> text "var" <+> doubleQuotes (text name) + Op1 op e -> ppOp1 op (ppExpr e) + Op2 op e1 e2 -> ppOp2 op (ppExpr e1) (ppExpr e2) + Op3 op e1 e2 e3 -> ppOp3 op (ppExpr e1) (ppExpr e2) (ppExpr e3) + Label _ s e -> text "label "<> doubleQuotes (text s) <+> (ppExpr e) + +-- | Pretty-print an untyped expression. +-- +-- The type is ignored, and only the expression is pretty-printed. +ppUExpr :: UExpr -> Doc +ppUExpr UExpr { uExprExpr = e0 } = ppExpr e0 + +-- | Pretty-print a unary operation. +ppOp1 :: Op1 a b -> Doc -> Doc +ppOp1 op = case op of + Not -> ppPrefix "not" + Abs _ -> ppPrefix "abs" + Sign _ -> ppPrefix "signum" + Recip _ -> ppPrefix "recip" + Exp _ -> ppPrefix "exp" + Sqrt _ -> ppPrefix "sqrt" + Log _ -> ppPrefix "log" + Sin _ -> ppPrefix "sin" + Tan _ -> ppPrefix "tan" + Cos _ -> ppPrefix "cos" + Asin _ -> ppPrefix "asin" + Atan _ -> ppPrefix "atan" + Acos _ -> ppPrefix "acos" + Sinh _ -> ppPrefix "sinh" + Tanh _ -> ppPrefix "tanh" + Cosh _ -> ppPrefix "cosh" + Asinh _ -> ppPrefix "asinh" + Atanh _ -> ppPrefix "atanh" + Acosh _ -> ppPrefix "acosh" + Ceiling _ -> ppPrefix "ceiling" + Floor _ -> ppPrefix "floor" + BwNot _ -> ppPrefix "~" + Cast _ _ -> ppPrefix "(cast)" + GetField (Struct _) _ f -> \e -> ppInfix "#" e (text $ accessorname f) + GetField _ _ _ -> impossible "ppOp1" "Copilot.PrettyPrint" + +-- | Pretty-print a binary operation. +ppOp2 :: Op2 a b c -> Doc -> Doc -> Doc +ppOp2 op = case op of + And -> ppInfix "&&" + Or -> ppInfix "||" + Add _ -> ppInfix "+" + Sub _ -> ppInfix "-" + Mul _ -> ppInfix "*" + Div _ -> ppInfix "div" + Mod _ -> ppInfix "mod" + Fdiv _ -> ppInfix "/" + Pow _ -> ppInfix "**" + Logb _ -> ppInfix "logBase" + Atan2 _ -> ppInfix "atan2" + Eq _ -> ppInfix "==" + Ne _ -> ppInfix "/=" + Le _ -> ppInfix "<=" + Ge _ -> ppInfix ">=" + Lt _ -> ppInfix "<" + Gt _ -> ppInfix ">" + BwAnd _ -> ppInfix "&" + BwOr _ -> ppInfix "|" + BwXor _ -> ppInfix "^" + BwShiftL _ _ -> ppInfix "<<" + BwShiftR _ _ -> ppInfix ">>" + Index _ -> ppInfix ".!!" + +-- | Pretty-print a ternary operation. +ppOp3 :: Op3 a b c d -> Doc -> Doc -> Doc -> Doc +ppOp3 op = case op of + Mux _ -> \ doc1 doc2 doc3 -> + text "(if" <+> doc1 <+> + text "then" <+> doc2 <+> + text "else" <+> doc3 <> text ")" + +-- | Parenthesize two 'Doc's, separated by an infix 'String'. +ppInfix :: String -> Doc -> Doc -> Doc +ppInfix cs doc1 doc2 = parens $ doc1 <+> text cs <+> doc2 + +-- | Prefix a 'Doc' by a 'String'. +ppPrefix :: String -> Doc -> Doc +ppPrefix cs = (text cs <+>) + +-- | Pretty-print a Copilot stream as a case of a top-level function for +-- streams of that type, by pattern matching on the stream name. +ppStream :: Stream -> Doc +ppStream + Stream + { streamId = id + , streamBuffer = buffer + , streamExpr = e + , streamExprType = t + } + = (parens . text . showType) t + <+> strmName id + <+> text "=" + <+> text ("[" + ++ ( concat $ intersperse "," + $ map (showWithType Haskell t) buffer ) + ++ "]") + <+> text "++" + <+> ppExpr e + +-- | Pretty-print a Copilot trigger as a case of a top-level @trigger@ +-- function, by pattern matching on the trigger name. +ppTrigger :: Trigger -> Doc +ppTrigger + Trigger + { triggerName = name + , triggerGuard = e + , triggerArgs = args } + = text "trigger" <+> text "\"" <> text name <> text "\"" + <+> text "=" + <+> ppExpr e + <+> lbrack + $$ (nest 2 $ vcat (punctuate comma $ + map (\a -> text "arg" <+> ppUExpr a) args)) + $$ nest 2 rbrack + +-- | Pretty-print a Copilot observer as a case of a top-level @observer@ +-- function, by pattern matching on the observer name. +ppObserver :: Observer -> Doc +ppObserver + Observer + { observerName = name + , observerExpr = e } + = text "observer \"" <> text name <> text "\"" + <+> text "=" + <+> ppExpr e + +-- | Pretty-print a Copilot property as a case of a top-level @property@ +-- function, by pattern matching on the property name. +ppProperty :: Property -> Doc +ppProperty + Property + { propertyName = name + , propertyExpr = e } + = text "property \"" <> text name <> text "\"" + <+> text "=" + <+> ppExpr e + +-- | Pretty-print a Copilot specification, in the following order: +-- +-- - Streams definitions +-- - Trigger definitions +-- - Observer definitions +-- - Property definitions +ppSpec :: Spec -> Doc +ppSpec spec = cs $$ ds $$ es $$ fs + where + cs = foldr (($$) . ppStream) empty (specStreams spec) + ds = foldr (($$) . ppTrigger) empty (specTriggers spec) + es = foldr (($$) . ppObserver) empty (specObservers spec) + fs = foldr (($$) . ppProperty) empty (specProperties spec) + +-- | Pretty-print a Copilot specification. +prettyPrint :: Spec -> String +prettyPrint = render . ppSpec diff --git a/copilot-prettyprinter/src/Copilot/PrettyPrint/Error.hs b/copilot-prettyprinter/src/Copilot/PrettyPrint/Error.hs new file mode 100644 index 000000000..1c1fce024 --- /dev/null +++ b/copilot-prettyprinter/src/Copilot/PrettyPrint/Error.hs @@ -0,0 +1,24 @@ +-- Copyright © 2011 National Institute of Aerospace / Galois, Inc. + +{-# LANGUAGE Safe #-} + +-- | Custom functions to report error messages to users. +module Copilot.PrettyPrint.Error + ( impossible + , badUsage ) where + +-- | Report an error due to a bug in Copilot. +impossible :: String -- ^ Name of the function in which the error was detected. + -> String -- ^ Name of the package in which the function is located. + -> a +impossible function package = + error $ "\"Impossible\" error in function " + ++ function ++ ", in package " ++ package + ++ ". Please file an issue at " + ++ "https://github.com/Copilot-Language/copilot/issues" + ++ "or email the maintainers at " + +-- | Report an error due to an error detected by Copilot (e.g., user error). +badUsage :: String -- ^ Description of the error. + -> a +badUsage msg = error $ "Copilot error: " ++ msg diff --git a/copilot-prettyprinter/src/Copilot/PrettyPrint/Type.hs b/copilot-prettyprinter/src/Copilot/PrettyPrint/Type.hs new file mode 100644 index 000000000..2f6f95f07 --- /dev/null +++ b/copilot-prettyprinter/src/Copilot/PrettyPrint/Type.hs @@ -0,0 +1,77 @@ +-- Copyright © 2011 National Institute of Aerospace / Galois, Inc. + +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE Safe #-} + +-- | Show Copilot Core types and typed values. +module Copilot.PrettyPrint.Type + ( showWithType + , ShowType(..) + , showType + ) where + +import Copilot.Core.Type + +-- Are we proving equivalence with a C backend, in which case we want to show +-- Booleans as '0' and '1'. + +-- | Target language for showing a typed value. Used to adapt the +-- representation of booleans. +data ShowType = C | Haskell + +-- | Show a value. The representation depends on the type and the target +-- language. Booleans are represented differently depending on the backend. +showWithType :: ShowType -> Type a -> a -> String +showWithType showT t x = + case showT of + C -> case t of + Bool -> if x then "1" else "0" + _ -> sw + Haskell -> case t of + Bool -> if x then "true" else "false" + _ -> sw + where + sw = case showWit t of + ShowWit -> show x + +-- | Show Copilot Core type. +showType :: Type a -> String +showType t = + case t of + Bool -> "Bool" + Int8 -> "Int8" + Int16 -> "Int16" + Int32 -> "Int32" + Int64 -> "Int64" + Word8 -> "Word8" + Word16 -> "Word16" + Word32 -> "Word32" + Word64 -> "Word64" + Float -> "Float" + Double -> "Double" + Array t -> "Array " ++ showType t + Struct t -> "Struct" + +-- * Auxiliary show instance + +-- | Witness datatype for showing a value, used by 'showWithType'. +data ShowWit a = Show a => ShowWit + +-- | Turn a type into a show witness. +showWit :: Type a -> ShowWit a +showWit t = + case t of + Bool -> ShowWit + Int8 -> ShowWit + Int16 -> ShowWit + Int32 -> ShowWit + Int64 -> ShowWit + Word8 -> ShowWit + Word16 -> ShowWit + Word32 -> ShowWit + Word64 -> ShowWit + Float -> ShowWit + Double -> ShowWit + Array t -> ShowWit + Struct t -> ShowWit From 52a9c6a69b91e7211cef456e668bace74e447d7a Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 21 Oct 2022 20:26:40 +0000 Subject: [PATCH 0477/1222] copilot-interpreter: Use pretty-printer from copilot-prettyprinter. Refs #383. This library uses the Copilot Core pretty-printer from copilot-core, but a new backend has been made available under copilot-prettyprinter. This commit adjusts both module imports and dependencies to match the new namespaces of the Copilot Core pretty-printer backend. --- copilot-interpreter/copilot-interpreter.cabal | 1 + copilot-interpreter/tests/Test/Copilot/Interpret/Eval.hs | 2 +- 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot-interpreter/copilot-interpreter.cabal b/copilot-interpreter/copilot-interpreter.cabal index e1b2d0727..26ddf5314 100644 --- a/copilot-interpreter/copilot-interpreter.cabal +++ b/copilot-interpreter/copilot-interpreter.cabal @@ -76,6 +76,7 @@ test-suite unit-tests , copilot-core , copilot-interpreter + , copilot-prettyprinter hs-source-dirs: tests diff --git a/copilot-interpreter/tests/Test/Copilot/Interpret/Eval.hs b/copilot-interpreter/tests/Test/Copilot/Interpret/Eval.hs index 608d0358a..bcabddc21 100644 --- a/copilot-interpreter/tests/Test/Copilot/Interpret/Eval.hs +++ b/copilot-interpreter/tests/Test/Copilot/Interpret/Eval.hs @@ -28,11 +28,11 @@ import Text.PrettyPrint.HughesPJ (render) import Copilot.Core.Expr (Expr (Const, Drop, Op1, Op2, Op3), UExpr (UExpr)) import Copilot.Core.Operators (Op1 (..), Op2 (..), Op3 (..)) -import Copilot.Core.PrettyPrint (ppExpr) import Copilot.Core.Spec (Observer (..), Spec (..), Stream (Stream)) import Copilot.Core.Type (Type (..), Typed (typeOf)) import Copilot.Interpret.Eval (ExecTrace (interpObservers), ShowType (Haskell), eval) +import Copilot.PrettyPrint (ppExpr) -- Internal imports: auxiliary functions import Test.Extra (apply1, apply2, apply3) From 8dd9d9b9a6e512c964b2eef2a65790207168451b Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 21 Oct 2022 20:28:37 +0000 Subject: [PATCH 0478/1222] copilot-language: Use pretty-printer from copilot-prettyprinter. Refs #383. This library uses the Copilot Core pretty-printer from copilot-core, but a new backend has been made available under copilot-prettyprinter. This commit adjusts both module imports and dependencies to match the new namespaces of the Copilot Core pretty-printer backend. --- copilot-language/copilot-language.cabal | 17 +++++++++-------- copilot-language/src/Copilot/Language.hs | 2 +- 2 files changed, 10 insertions(+), 9 deletions(-) diff --git a/copilot-language/copilot-language.cabal b/copilot-language/copilot-language.cabal index b4109f4e3..f0196778c 100644 --- a/copilot-language/copilot-language.cabal +++ b/copilot-language/copilot-language.cabal @@ -35,16 +35,17 @@ source-repository head library default-language: Haskell2010 hs-source-dirs: src - build-depends: base >= 4.9 && < 5 + build-depends: base >= 4.9 && < 5 - , array >= 0.5 && < 0.6 - , containers >= 0.4 && < 0.7 - , data-reify >= 0.6 && < 0.7 - , mtl >= 2.0 && < 3 + , array >= 0.5 && < 0.6 + , containers >= 0.4 && < 0.7 + , data-reify >= 0.6 && < 0.7 + , mtl >= 2.0 && < 3 - , copilot-core >= 3.11 && < 3.12 - , copilot-interpreter >= 3.11 && < 3.12 - , copilot-theorem >= 3.11 && < 3.12 + , copilot-core >= 3.11 && < 3.12 + , copilot-interpreter >= 3.11 && < 3.12 + , copilot-prettyprinter >= 3.11 && < 3.12 + , copilot-theorem >= 3.11 && < 3.12 exposed-modules: Copilot.Language , Copilot.Language.Operators.BitWise diff --git a/copilot-language/src/Copilot/Language.hs b/copilot-language/src/Copilot/Language.hs index 677d1dccf..5d950a28e 100644 --- a/copilot-language/src/Copilot/Language.hs +++ b/copilot-language/src/Copilot/Language.hs @@ -47,7 +47,6 @@ import Data.Word import Copilot.Core (Name, Typed) import Copilot.Core.Type import Copilot.Core.Type.Array -import qualified Copilot.Core.PrettyPrint as PP import Copilot.Language.Error import Copilot.Language.Interpret import Copilot.Language.Operators.Boolean @@ -68,6 +67,7 @@ import Copilot.Language.Reify import Copilot.Language.Prelude import Copilot.Language.Spec import Copilot.Language.Stream (Stream) +import qualified Copilot.PrettyPrint as PP -- | Transform a high-level Copilot Language specification into a low-level -- Copilot Core specification and pretty-print it to stdout. From 38b28ed19f7fba3c3b5e84e923490574c22747c9 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 21 Oct 2022 20:32:33 +0000 Subject: [PATCH 0479/1222] copilot-theorem: Use pretty-printer from copilot-prettyprinter. Refs #383. This library uses the Copilot Core pretty-printer from copilot-core, but a new backend has been made available under copilot-prettyprinter. This commit adjusts both module imports and dependencies to match the new namespaces of the Copilot Core pretty-printer backend. --- copilot-theorem/copilot-theorem.cabal | 39 ++++++++++--------- .../src/Copilot/Theorem/What4/Translate.hs | 2 +- 2 files changed, 21 insertions(+), 20 deletions(-) diff --git a/copilot-theorem/copilot-theorem.cabal b/copilot-theorem/copilot-theorem.cabal index 577ef96d8..5b6bbe87e 100644 --- a/copilot-theorem/copilot-theorem.cabal +++ b/copilot-theorem/copilot-theorem.cabal @@ -45,25 +45,26 @@ library -fno-warn-missing-signatures -fcontext-stack=100 - build-depends : base >= 4.9 && < 5 - , bimap (>= 0.3 && < 0.4) || (>= 0.5 && < 0.6) - , bv-sized >= 1.0.2 && < 1.1 - , containers >= 0.4 && < 0.7 - , data-default >= 0.7 && < 0.8 - , directory >= 1.3 && < 1.4 - , libBF >= 0.6.2 && < 0.7 - , mtl >= 2.0 && < 2.4 - , panic >= 0.4.0 && < 0.5 - , parsec >= 2.0 && < 3.2 - , parameterized-utils >= 2.1.1 && < 2.2 - , pretty >= 1.0 && < 1.2 - , process >= 1.6 && < 1.7 - , random >= 1.1 && < 1.3 - , transformers >= 0.5 && < 0.7 - , xml >= 1.3 && < 1.4 - , what4 >= 1.3 && < 1.4 - - , copilot-core >= 3.11 && < 3.12 + build-depends : base >= 4.9 && < 5 + , bimap (>= 0.3 && < 0.4) || (>= 0.5 && < 0.6) + , bv-sized >= 1.0.2 && < 1.1 + , containers >= 0.4 && < 0.7 + , data-default >= 0.7 && < 0.8 + , directory >= 1.3 && < 1.4 + , libBF >= 0.6.2 && < 0.7 + , mtl >= 2.0 && < 2.4 + , panic >= 0.4.0 && < 0.5 + , parsec >= 2.0 && < 3.2 + , parameterized-utils >= 2.1.1 && < 2.2 + , pretty >= 1.0 && < 1.2 + , process >= 1.6 && < 1.7 + , random >= 1.1 && < 1.3 + , transformers >= 0.5 && < 0.7 + , xml >= 1.3 && < 1.4 + , what4 >= 1.3 && < 1.4 + + , copilot-core >= 3.11 && < 3.12 + , copilot-prettyprinter >= 3.11 && < 3.12 exposed-modules : Copilot.Theorem , Copilot.Theorem.Prove diff --git a/copilot-theorem/src/Copilot/Theorem/What4/Translate.hs b/copilot-theorem/src/Copilot/Theorem/What4/Translate.hs index 456234a64..128033750 100644 --- a/copilot-theorem/src/Copilot/Theorem/What4/Translate.hs +++ b/copilot-theorem/src/Copilot/Theorem/What4/Translate.hs @@ -71,10 +71,10 @@ import qualified What4.SpecialFunctions as WSF import qualified Copilot.Core.Expr as CE import qualified Copilot.Core.Operators as CE -import qualified Copilot.Core.PrettyPrint as CP import qualified Copilot.Core.Spec as CS import qualified Copilot.Core.Type as CT import qualified Copilot.Core.Type.Array as CT +import qualified Copilot.PrettyPrint as CP -- Translation into What4 From 57d08f1c482be2e125baf34c4306c45a8e07b6cf Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 21 Oct 2022 20:33:42 +0000 Subject: [PATCH 0480/1222] copilot-core: Deprecate Copilot.Core.PrettyPrint. Refs #383. The architecture of Copilot mixes backends with other libraries, which makes the result not uniform. More specifically, this library publishes a pretty-printer under the Copilot.Core namespace, while the C99 backend and the interpreter are in separate libraries and under separate namespaces. The implementation does not match our desired architecture according to our design documents, and it makes the code partly harder to maintain. This commit deprecates the pretty-printer included in copilot-core, and directs users to the one published by the new library copilot-prettyprinter. --- copilot-core/src/Copilot/Core/PrettyPrint.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/copilot-core/src/Copilot/Core/PrettyPrint.hs b/copilot-core/src/Copilot/Core/PrettyPrint.hs index c9e37e425..e6ed6ab8b 100644 --- a/copilot-core/src/Copilot/Core/PrettyPrint.hs +++ b/copilot-core/src/Copilot/Core/PrettyPrint.hs @@ -6,6 +6,7 @@ {-# LANGUAGE Safe #-} module Copilot.Core.PrettyPrint + {-# DEPRECATED "This module is deprecated in Copilot 3.12. Use copilot-prettyprinter instead." #-} ( prettyPrint , ppExpr ) where From 955a409b821261485d73ffcb9d84c361d447d52a Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 21 Oct 2022 22:32:55 +0000 Subject: [PATCH 0481/1222] copilot-prettyprinter: Document changes in CHANGELOG. Refs #383. --- copilot-prettyprinter/CHANGELOG | 2 ++ 1 file changed, 2 insertions(+) diff --git a/copilot-prettyprinter/CHANGELOG b/copilot-prettyprinter/CHANGELOG index e69de29bb..2cb7160ac 100644 --- a/copilot-prettyprinter/CHANGELOG +++ b/copilot-prettyprinter/CHANGELOG @@ -0,0 +1,2 @@ +2022-10-21 + * Create new library for pretty-printer. (#383) From 7e9557405f807a960a612f901ffa435808b73a3f Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 21 Oct 2022 22:34:16 +0000 Subject: [PATCH 0482/1222] copilot-interpreter: Document changes in CHANGELOG. Refs #383. --- copilot-interpreter/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-interpreter/CHANGELOG b/copilot-interpreter/CHANGELOG index 3e3a5e71f..36b857c54 100644 --- a/copilot-interpreter/CHANGELOG +++ b/copilot-interpreter/CHANGELOG @@ -1,3 +1,6 @@ +2022-10-21 + * Use pretty-printer from copilot-prettyprinter. (#383) + 2022-09-07 * Version bump (3.11). (#376) * Split copilot-interpreter into separate library. (#361) From f13e573f48eb91644b32fbaf8bef6d5add98a642 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 21 Oct 2022 22:36:30 +0000 Subject: [PATCH 0483/1222] copilot-language: Document changes in CHANGELOG. Refs #383. --- copilot-language/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-language/CHANGELOG b/copilot-language/CHANGELOG index 34addb223..d0d810b06 100644 --- a/copilot-language/CHANGELOG +++ b/copilot-language/CHANGELOG @@ -1,3 +1,6 @@ +2022-10-21 + * Use pretty-printer from copilot-prettyprinter. (#383) + 2022-09-07 * Version bump (3.11). (#376) * Deprecate prettyPrint. (#362) From 5e4c8649d5d5857121c1490c1fea33239a17d18f Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 21 Oct 2022 22:34:52 +0000 Subject: [PATCH 0484/1222] copilot-theorem: Document changes in CHANGELOG. Refs #383. --- copilot-theorem/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot-theorem/CHANGELOG b/copilot-theorem/CHANGELOG index 7bbaf2fe2..31299d6b2 100644 --- a/copilot-theorem/CHANGELOG +++ b/copilot-theorem/CHANGELOG @@ -1,5 +1,6 @@ -2022-10-11 +2022-10-21 * Add functionality for bisimulation proofs of Copilot specifications. (#363) + * Use pretty-printer from copilot-prettyprinter. (#383) 2022-09-07 * Version bump (3.11). (#376) From 395217d6ec9ac73b35a231a5da731a50b2be1952 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 21 Oct 2022 22:33:38 +0000 Subject: [PATCH 0485/1222] copilot-core: Document changes in CHANGELOG. Refs #383. --- copilot-core/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-core/CHANGELOG b/copilot-core/CHANGELOG index 97c54d11f..5320941bb 100644 --- a/copilot-core/CHANGELOG +++ b/copilot-core/CHANGELOG @@ -1,3 +1,6 @@ +2022-10-21 + * Deprecate Copilot.Core.PrettyPrinter. (#383) + 2022-09-07 * Version bump (3.11). (#376) * Deprecate Copilot.Core.PrettyDot. (#359) From 6c5d49ecdcce96fca1999571d5bb56b2ffe1d7ba Mon Sep 17 00:00:00 2001 From: Frank Dedden Date: Mon, 31 Oct 2022 11:56:03 +0100 Subject: [PATCH 0486/1222] copilot-c99: Remove struct declarations from `.c` file. Refs #373. Copilot-generated C99 monitor implementation files import the corresponding generated headers before defining the necessary C structs. Part of those headers contain the declarations of the handlers, which may take structs as arguments. By using such forward declarations, the C compiler is not always able to figure out the size of the arguments to those handler functions, and the code cannot be compiled. This commit removes the struct declarations from the `.c` file, so that we can later move the declarations to an external header file and include them before the external handlers are declared. --- copilot-c99/src/Copilot/Compile/C99/Compile.hs | 13 +------------ 1 file changed, 1 insertion(+), 12 deletions(-) diff --git a/copilot-c99/src/Copilot/Compile/C99/Compile.hs b/copilot-c99/src/Copilot/Compile/C99/Compile.hs index 3614f881b..931bda5ec 100644 --- a/copilot-c99/src/Copilot/Compile/C99/Compile.hs +++ b/copilot-c99/src/Copilot/Compile/C99/Compile.hs @@ -74,21 +74,10 @@ compilec cSettings spec = C.TransUnit declns funs streams = specStreams spec triggers = specTriggers spec exts = gatherexts streams triggers - exprs = gatherexprs streams triggers - declns = mkstructdeclns exprs ++ mkexts exts ++ mkglobals streams + declns = mkexts exts ++ mkglobals streams funs = genfuns streams triggers ++ [mkstep cSettings streams triggers exts] - -- Write struct datatypes - mkstructdeclns :: [UExpr] -> [C.Decln] - mkstructdeclns es = catMaybes $ map mkdecln utypes - where - mkdecln (UType ty) = case ty of - Struct x -> Just $ mkstructdecln ty - _ -> Nothing - - utypes = nub $ concatMap (\(UExpr _ e) -> exprtypes e) es - -- Make declarations for copies of external variables. mkexts :: [External] -> [C.Decln] mkexts exts = map mkextcpydecln exts From 87c16d6f7172f4a3b05620fdd40ec1642bf20b89 Mon Sep 17 00:00:00 2001 From: Frank Dedden Date: Mon, 31 Oct 2022 12:03:10 +0100 Subject: [PATCH 0487/1222] copilot-c99: Add function to generate type declarations. Refs #373. Copilot-generated C99 monitor implementation files import the corresponding generated headers before defining the necessary C structs. Part of those headers contain the declarations of the handlers, which may take structs as arguments. By using such forward declarations, the C compiler is not always able to figure out the size of the arguments to those handler functions, and the code cannot be compiled. This commit defines an auxiliary function that generates a C translation unit with all the type declarations needed by a Copilot specification. --- .../src/Copilot/Compile/C99/Compile.hs | 21 +++++++++++++++++++ 1 file changed, 21 insertions(+) diff --git a/copilot-c99/src/Copilot/Compile/C99/Compile.hs b/copilot-c99/src/Copilot/Compile/C99/Compile.hs index 931bda5ec..60f41916b 100644 --- a/copilot-c99/src/Copilot/Compile/C99/Compile.hs +++ b/copilot-c99/src/Copilot/Compile/C99/Compile.hs @@ -160,3 +160,24 @@ compileh cSettings spec = C.TransUnit declns [] stepdecln :: C.Decln stepdecln = C.FunDecln Nothing (C.TypeSpec C.Void) (cSettingsStepFunctionName cSettings) [] + +-- | Generate a C translation unit that contains all type declarations needed +-- by the Copilot specification. +compileTypeDeclns :: CSettings -> Spec -> C.TransUnit +compileTypeDeclns _cSettings spec = C.TransUnit declns [] + where + declns = mkTypeDeclns exprs + + exprs = gatherexprs streams triggers + streams = specStreams spec + triggers = specTriggers spec + + -- Generate type declarations. + mkTypeDeclns :: [UExpr] -> [C.Decln] + mkTypeDeclns es = catMaybes $ map mkTypeDecln uTypes + where + uTypes = nub $ concatMap (\(UExpr _ e) -> exprtypes e) es + + mkTypeDecln (UType ty) = case ty of + Struct _ -> Just $ mkstructdecln ty + _ -> Nothing From 01e101674ce865a2711336b6c4370d8541a09542 Mon Sep 17 00:00:00 2001 From: Frank Dedden Date: Mon, 31 Oct 2022 11:59:55 +0100 Subject: [PATCH 0488/1222] copilot-c99: Write type declarations in separate header file. Refs #373. Copilot-generated C99 monitor implementation files import the corresponding generated headers before defining the necessary C structs. Part of those headers contain the declarations of the handlers, which may take structs as arguments. By using such forward declarations, the C compiler is not always able to figure out the size of the arguments to those handler functions, and the code cannot be compiled. This commit adds an action to write the type declarations to a separate header file. --- copilot-c99/src/Copilot/Compile/C99/Compile.hs | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/copilot-c99/src/Copilot/Compile/C99/Compile.hs b/copilot-c99/src/Copilot/Compile/C99/Compile.hs index 60f41916b..6cece14e2 100644 --- a/copilot-c99/src/Copilot/Compile/C99/Compile.hs +++ b/copilot-c99/src/Copilot/Compile/C99/Compile.hs @@ -38,6 +38,7 @@ compileWith cSettings prefix spec | otherwise = do let cfile = render $ pretty $ C.translate $ compilec cSettings spec hfile = render $ pretty $ C.translate $ compileh cSettings spec + typeDeclnsFile = safeCRender $ compileTypeDeclns cSettings spec cmacros = unlines [ "#include " , "#include " @@ -53,6 +54,7 @@ compileWith cSettings prefix spec createDirectoryIfMissing True dir writeFile (dir prefix ++ ".c") $ cmacros ++ cfile writeFile (dir prefix ++ ".h") hfile + writeFile (dir prefix ++ "_types.h") typeDeclnsFile -- | Compile a specification to a .h and a .c file. -- @@ -181,3 +183,11 @@ compileTypeDeclns _cSettings spec = C.TransUnit declns [] mkTypeDecln (UType ty) = case ty of Struct _ -> Just $ mkstructdecln ty _ -> Nothing + +-- * Auxiliary definitions + +-- | Render a C.TransUnit to a String, accounting for the case in which the +-- translation unit is empty. +safeCRender :: C.TransUnit -> String +safeCRender (C.TransUnit [] []) = "" +safeCRender transUnit = render $ pretty $ C.translate transUnit From b40d1c4df548819f856fcbfdc8d68de7bf9674ee Mon Sep 17 00:00:00 2001 From: Frank Dedden Date: Mon, 31 Oct 2022 12:00:43 +0100 Subject: [PATCH 0489/1222] copilot-c99: Include type declarations in generated `.c` file. Refs #373. Copilot-generated C99 monitor implementation files import the corresponding generated headers before defining the necessary C structs. Part of those headers contain the declarations of the handlers, which may take structs as arguments. By using such forward declarations, the C compiler is not always able to figure out the size of the arguments to those handler functions, and the code cannot be compiled. This commit includes the generated type declarations header file before the header file that declares the handlers. This ensures that all the types are declared before the functions that use them are declared. --- copilot-c99/src/Copilot/Compile/C99/Compile.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/copilot-c99/src/Copilot/Compile/C99/Compile.hs b/copilot-c99/src/Copilot/Compile/C99/Compile.hs index 6cece14e2..683ddcecb 100644 --- a/copilot-c99/src/Copilot/Compile/C99/Compile.hs +++ b/copilot-c99/src/Copilot/Compile/C99/Compile.hs @@ -46,6 +46,7 @@ compileWith cSettings prefix spec , "#include " , "#include " , "" + , "#include \"" ++ prefix ++ "_types.h\"" , "#include \"" ++ prefix ++ ".h\"" , "" ] From d97202d0039f6508d7baeff49e0491fa7a428134 Mon Sep 17 00:00:00 2001 From: Frank Dedden Date: Mon, 31 Oct 2022 19:26:19 +0100 Subject: [PATCH 0490/1222] copilot-c99: Document changes in CHANGELOG. Refs #373. --- copilot-c99/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot-c99/CHANGELOG b/copilot-c99/CHANGELOG index d9f5e6079..415278df3 100644 --- a/copilot-c99/CHANGELOG +++ b/copilot-c99/CHANGELOG @@ -1,5 +1,6 @@ -2022-10-18 +2022-10-31 * Removed deprecated flag from cabal file. (#380) + * Generate type declarations in separate header file. (#373) 2022-09-07 * Version bump (3.11). (#376) From 588adbc73a3deeb881ca6522e8c0cd6aabe5a249 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Wed, 12 Oct 2022 13:40:08 +0000 Subject: [PATCH 0491/1222] copilot-core: Replace uses of Copilot.Core.Type.Equality. Refs #379. The module Copilot.Core.Type.Equality provides definitions to reason about type equality. That module is very similar to base:Data.Type.Equality, and all uses of the former can be replaced by uses of the latter. This commit replaces all uses of Copilot.Core.Type.Equality in copilot-core with definitions from base:Data.Type.Equality. Both modules are imported qualified to disambiguate their names, since an instance of a class defined in the module Copilot.Core.Type.Equality must still be made available to users during the transition period. --- copilot-core/src/Copilot/Core/Type.hs | 43 ++++++++++++++++++--------- 1 file changed, 29 insertions(+), 14 deletions(-) diff --git a/copilot-core/src/Copilot/Core/Type.hs b/copilot-core/src/Copilot/Core/Type.hs index bfb651541..46b8f9f73 100644 --- a/copilot-core/src/Copilot/Core/Type.hs +++ b/copilot-core/src/Copilot/Core/Type.hs @@ -39,7 +39,8 @@ module Copilot.Core.Type import Data.Int import Data.Word -import Copilot.Core.Type.Equality +import Data.Type.Equality as DE +import Copilot.Core.Type.Equality as CE import Copilot.Core.Type.Array import Data.Typeable (Typeable, typeRep) @@ -115,19 +116,33 @@ tysize ty@(Array ty'@(Array _)) = tylength ty * tysize ty' tysize ty@(Array _ ) = tylength ty instance EqualType Type where - (=~=) Bool Bool = Just Refl - (=~=) Int8 Int8 = Just Refl - (=~=) Int16 Int16 = Just Refl - (=~=) Int32 Int32 = Just Refl - (=~=) Int64 Int64 = Just Refl - (=~=) Word8 Word8 = Just Refl - (=~=) Word16 Word16 = Just Refl - (=~=) Word32 Word32 = Just Refl - (=~=) Word64 Word64 = Just Refl - (=~=) Float Float = Just Refl - (=~=) Double Double = Just Refl + (=~=) Bool Bool = Just CE.Refl + (=~=) Int8 Int8 = Just CE.Refl + (=~=) Int16 Int16 = Just CE.Refl + (=~=) Int32 Int32 = Just CE.Refl + (=~=) Int64 Int64 = Just CE.Refl + (=~=) Word8 Word8 = Just CE.Refl + (=~=) Word16 Word16 = Just CE.Refl + (=~=) Word32 Word32 = Just CE.Refl + (=~=) Word64 Word64 = Just CE.Refl + (=~=) Float Float = Just CE.Refl + (=~=) Double Double = Just CE.Refl (=~=) _ _ = Nothing +instance TestEquality Type where + testEquality Bool Bool = Just DE.Refl + testEquality Int8 Int8 = Just DE.Refl + testEquality Int16 Int16 = Just DE.Refl + testEquality Int32 Int32 = Just DE.Refl + testEquality Int64 Int64 = Just DE.Refl + testEquality Word8 Word8 = Just DE.Refl + testEquality Word16 Word16 = Just DE.Refl + testEquality Word32 Word32 = Just DE.Refl + testEquality Word64 Word64 = Just DE.Refl + testEquality Float Float = Just DE.Refl + testEquality Double Double = Just DE.Refl + testEquality _ _ = Nothing + -- | A simple, monomorphic representation of types that facilitates putting -- variables in heterogeneous lists and environments in spite of their types -- being different. @@ -162,8 +177,8 @@ instance Eq SimpleType where SWord64 == SWord64 = True SFloat == SFloat = True SDouble == SDouble = True - (SArray t1) == (SArray t2) | Just Refl <- t1 =~= t2 = True - | otherwise = False + (SArray t1) == (SArray t2) | Just DE.Refl <- testEquality t1 t2 = True + | otherwise = False SStruct == SStruct = True _ == _ = False From 670a6ca3fed75e419ceb8df95d598c9a157e1bbc Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Wed, 12 Oct 2022 13:40:34 +0000 Subject: [PATCH 0492/1222] copilot-theorem: Replace uses of Copilot.Core.Type.Equality. Refs #379. The module Copilot.Core.Type.Equality provides definitions to reason about type equality. That module is very similar to base:Data.Type.Equality, and all uses of the former can be replaced by uses of the latter. This commit replaces all uses of Copilot.Core.Type.Equality in copilot-theorem with definitions from base:Data.Type.Equality. --- copilot-theorem/src/Copilot/Theorem/TransSys/Type.hs | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/copilot-theorem/src/Copilot/Theorem/TransSys/Type.hs b/copilot-theorem/src/Copilot/Theorem/TransSys/Type.hs index 4a3359d39..e1408f044 100644 --- a/copilot-theorem/src/Copilot/Theorem/TransSys/Type.hs +++ b/copilot-theorem/src/Copilot/Theorem/TransSys/Type.hs @@ -8,7 +8,7 @@ module Copilot.Theorem.TransSys.Type , U (..) ) where -import Copilot.Core.Type.Equality +import Data.Type.Equality -- | A type at both value and type level. -- @@ -19,11 +19,11 @@ data Type a where Real :: Type Double -- | Proofs of type equality. -instance EqualType Type where - Bool =~= Bool = Just Refl - Integer =~= Integer = Just Refl - Real =~= Real = Just Refl - _ =~= _ = Nothing +instance TestEquality Type where + testEquality Bool Bool = Just Refl + testEquality Integer Integer = Just Refl + testEquality Real Real = Just Refl + testEquality _ _ = Nothing -- | Unknown types. -- From 1e183e1d5c2b4ee5384e19a9dec0d0cee959f0b9 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Wed, 2 Nov 2022 17:55:33 +0000 Subject: [PATCH 0493/1222] copilot-core: Deprecate module Copilot.Core.Type.Equality. Refs #379. The module Copilot.Core.Type.Equality provides definitions to reason about type equality. That module is very similar to base:Data.Type.Equality, and all uses of the former have been replaced by uses of the latter. Consequently, the former is no longer used in Copilot, and it is not required by Copilot's requirements. This commit deprecates the module Copilot.Core.Type.Equality so that it can be removed in a future version of Copilot. --- copilot-core/src/Copilot/Core/Type/Equality.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/copilot-core/src/Copilot/Core/Type/Equality.hs b/copilot-core/src/Copilot/Core/Type/Equality.hs index 5b81951d6..8e01901a3 100644 --- a/copilot-core/src/Copilot/Core/Type/Equality.hs +++ b/copilot-core/src/Copilot/Core/Type/Equality.hs @@ -6,6 +6,7 @@ -- | Propositional equality and type equality. module Copilot.Core.Type.Equality + {-# DEPRECATED "This module is deprecated in Copilot 3.12. Use base:Data.Type.Equality instead." #-} ( Equal (..) , EqualType (..) , coerce From fadf76ed44227bd54f71ec297707881e4a5aa888 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 3 Nov 2022 04:43:49 +0000 Subject: [PATCH 0494/1222] copilot-core: Disable warning due to import of deprecated module. Refs #379. The module Copilot.Core.Type.Equality has been deprecated, as it is no longer needed due to the same functionality being available in base. Our transition policy requires 2 versions to continue offering the deprecated API until it can be properly removed. Due to an instance of a class from Copilot.Core.Type.Equality being defined in Copilot.Core.Type, and due to the former module now being deprecated, the import of the module is causing compilation warnings. This commit temporarily disables such warnings, adding a note to help understand the reason for that adaptation and when it can be removed. --- copilot-core/src/Copilot/Core/Type.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/copilot-core/src/Copilot/Core/Type.hs b/copilot-core/src/Copilot/Core/Type.hs index 46b8f9f73..ba56e6151 100644 --- a/copilot-core/src/Copilot/Core/Type.hs +++ b/copilot-core/src/Copilot/Core/Type.hs @@ -1,3 +1,7 @@ +-- The following flag is disabled in this module so that the import of +-- Copilot.Core.Type.Equality does not give rise to warnings. +{-# OPTIONS_GHC -fno-warn-deprecations #-} + -- Copyright © 2011 National Institute of Aerospace / Galois, Inc. -- | Typing for Core. From 55b2765c6345d581afd13bbafc366defd2527437 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Wed, 2 Nov 2022 17:59:08 +0000 Subject: [PATCH 0495/1222] copilot-core: Document changes in CHANGELOG. Refs #379. --- copilot-core/CHANGELOG | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/copilot-core/CHANGELOG b/copilot-core/CHANGELOG index 5320941bb..f896b62ec 100644 --- a/copilot-core/CHANGELOG +++ b/copilot-core/CHANGELOG @@ -1,5 +1,7 @@ -2022-10-21 +2022-11-02 * Deprecate Copilot.Core.PrettyPrinter. (#383) + * Replace uses of Copilot.Core.Type.Equality with definitions from + base:Data.Type.Equality; deprecate Copilot.Core.Type.Equality. (#379) 2022-09-07 * Version bump (3.11). (#376) From ef3072f026161f2c45df2095bfdbac0b50af4ece Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Wed, 2 Nov 2022 17:59:48 +0000 Subject: [PATCH 0496/1222] copilot-theorem: Document changes in CHANGELOG. Refs #379. --- copilot-theorem/CHANGELOG | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/copilot-theorem/CHANGELOG b/copilot-theorem/CHANGELOG index 31299d6b2..d3dfa2992 100644 --- a/copilot-theorem/CHANGELOG +++ b/copilot-theorem/CHANGELOG @@ -1,6 +1,8 @@ -2022-10-21 +2022-11-02 * Add functionality for bisimulation proofs of Copilot specifications. (#363) * Use pretty-printer from copilot-prettyprinter. (#383) + * Replace uses of Copilot.Core.Type.Equality with definitions from + base:Data.Type.Equality. (#379) 2022-09-07 * Version bump (3.11). (#376) From 6fae5d194fafb94d5fcc31c17c9e4b233272f700 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 3 Nov 2022 10:05:33 -0700 Subject: [PATCH 0497/1222] copilot-core: Import modules explicitly in Copilot.Core.Operators. Refs #332. According to our style guide, all imports must be explicit. This commit makes all imports in the module Copilot.Core.Operators explicit. --- copilot-core/src/Copilot/Core/Operators.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot-core/src/Copilot/Core/Operators.hs b/copilot-core/src/Copilot/Core/Operators.hs index 7055e5fe5..0a12ce60b 100644 --- a/copilot-core/src/Copilot/Core/Operators.hs +++ b/copilot-core/src/Copilot/Core/Operators.hs @@ -15,7 +15,7 @@ import GHC.TypeLits (KnownSymbol) import Copilot.Core.Type (Type(..), Field(..)) import Copilot.Core.Type.Array (Array) -import Data.Bits +import Data.Bits (Bits) import Data.Word (Word32) -- | Unary operators. From ce0504378111d480ed15a50d92edd43619d1ad34 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 3 Nov 2022 10:05:33 -0700 Subject: [PATCH 0498/1222] copilot-core: Import modules explicitly in Copilot.Core.Type. Refs #332. According to our style guide, all imports must be explicit. This commit makes all imports in the module Copilot.Core.Type explicit. --- copilot-core/src/Copilot/Core/Type.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/copilot-core/src/Copilot/Core/Type.hs b/copilot-core/src/Copilot/Core/Type.hs index ba56e6151..f743c0ad3 100644 --- a/copilot-core/src/Copilot/Core/Type.hs +++ b/copilot-core/src/Copilot/Core/Type.hs @@ -41,11 +41,11 @@ module Copilot.Core.Type , accessorname ) where -import Data.Int -import Data.Word +import Data.Int (Int16, Int32, Int64, Int8) +import Data.Word (Word16, Word32, Word64, Word8) import Data.Type.Equality as DE import Copilot.Core.Type.Equality as CE -import Copilot.Core.Type.Array +import Copilot.Core.Type.Array (Array) import Data.Typeable (Typeable, typeRep) From a18d9b72b82bcbb51ee72e96ac03263047b267ec Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 3 Nov 2022 10:05:33 -0700 Subject: [PATCH 0499/1222] copilot-core: Import modules explicitly in Copilot.Core.Type.ShowInternal. Refs #332. According to our style guide, all imports must be explicit. This commit makes all imports in the module Copilot.Core.Type.ShowInternal explicit. --- copilot-core/src/Copilot/Core/Type/ShowInternal.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot-core/src/Copilot/Core/Type/ShowInternal.hs b/copilot-core/src/Copilot/Core/Type/ShowInternal.hs index a27a2fd0b..f812b4edc 100644 --- a/copilot-core/src/Copilot/Core/Type/ShowInternal.hs +++ b/copilot-core/src/Copilot/Core/Type/ShowInternal.hs @@ -11,7 +11,7 @@ module Copilot.Core.Type.ShowInternal , showType ) where -import Copilot.Core.Type +import Copilot.Core.Type (Type (..)) -- Are we proving equivalence with a C backend, in which case we want to show -- Booleans as '0' and '1'. From 022f3606e3805b15265ac88a75475e624b709a78 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 3 Nov 2022 10:16:36 -0700 Subject: [PATCH 0500/1222] copilot-core: Group and sort imports in Copilot.Core.Expr. Refs #332. According to our style guide, all imports must be grouped, sorted, alphabetized, and aligned. This commit groups all imports in the module Copilot.Core.Expr by whether they are internal to copilot-core or external, aligns them vertically, and alphabetically sorts both the modules and the elements imported from each module. --- copilot-core/src/Copilot/Core/Expr.hs | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/copilot-core/src/Copilot/Core/Expr.hs b/copilot-core/src/Copilot/Core/Expr.hs index 5be6703b4..a9b63c462 100644 --- a/copilot-core/src/Copilot/Core/Expr.hs +++ b/copilot-core/src/Copilot/Core/Expr.hs @@ -13,11 +13,13 @@ module Copilot.Core.Expr , DropIdx ) where -import Copilot.Core.Operators (Op1, Op2, Op3) -import Copilot.Core.Type (Type) -import Data.Word (Word32) - +-- External imports import Data.Typeable (Typeable) +import Data.Word (Word32) + +-- Internal imports +import Copilot.Core.Operators (Op1, Op2, Op3) +import Copilot.Core.Type (Type) -- | A stream identifier. type Id = Int From 06d0b9448cdfe2335752c3b9dfd944b9d03fb26d Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 3 Nov 2022 10:16:36 -0700 Subject: [PATCH 0501/1222] copilot-core: Group and sort imports in Copilot.Core.Operators. Refs #332. According to our style guide, all imports must be grouped, sorted, alphabetized, and aligned. This commit groups all imports in the module Copilot.Core.Operators by whether they are internal to copilot-core or external, aligns them vertically, and alphabetically sorts both the modules and the elements imported from each module. --- copilot-core/src/Copilot/Core/Operators.hs | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/copilot-core/src/Copilot/Core/Operators.hs b/copilot-core/src/Copilot/Core/Operators.hs index 0a12ce60b..fcb1fa319 100644 --- a/copilot-core/src/Copilot/Core/Operators.hs +++ b/copilot-core/src/Copilot/Core/Operators.hs @@ -11,12 +11,14 @@ module Copilot.Core.Operators , Op3 (..) ) where -import GHC.TypeLits (KnownSymbol) +-- External imports +import Data.Bits (Bits) +import Data.Word (Word32) +import GHC.TypeLits (KnownSymbol) -import Copilot.Core.Type (Type(..), Field(..)) -import Copilot.Core.Type.Array (Array) -import Data.Bits (Bits) -import Data.Word (Word32) +-- Internal imports +import Copilot.Core.Type (Field (..), Type (..)) +import Copilot.Core.Type.Array (Array) -- | Unary operators. data Op1 a b where From 0b603e8a87508c70d7e9aa2413e8dd0385151438 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 3 Nov 2022 10:16:36 -0700 Subject: [PATCH 0502/1222] copilot-core: Group and sort imports in Copilot.Core.Spec. Refs #332. According to our style guide, all imports must be grouped, sorted, alphabetized, and aligned. This commit groups all imports in the module Copilot.Core.Spec by whether they are internal to copilot-core or external, aligns them vertically, and alphabetically sorts both the modules and the elements imported from each module. --- copilot-core/src/Copilot/Core/Spec.hs | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/copilot-core/src/Copilot/Core/Spec.hs b/copilot-core/src/Copilot/Core/Spec.hs index 962a57b47..3541c8e24 100644 --- a/copilot-core/src/Copilot/Core/Spec.hs +++ b/copilot-core/src/Copilot/Core/Spec.hs @@ -21,10 +21,13 @@ module Copilot.Core.Spec , Property (..) ) where -import Copilot.Core.Expr (Name, Id, Expr, UExpr) -import Copilot.Core.Type (Type, Typed) +-- External imports import Data.Typeable (Typeable) +-- Internal imports +import Copilot.Core.Expr (Expr, Id, Name, UExpr) +import Copilot.Core.Type (Type, Typed) + -- | A stream in an infinite succession of values of the same type. -- -- Stream can carry different types of data. Boolean streams play a special From f1985bbff8ce17b82bc47c3d0640220d62fa0604 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 3 Nov 2022 10:16:36 -0700 Subject: [PATCH 0503/1222] copilot-core: Group and sort imports in Copilot.Core.Type. Refs #332. According to our style guide, all imports must be grouped, sorted, alphabetized, and aligned. This commit groups all imports in the module Copilot.Core.Type by whether they are internal to copilot-core or external, aligns them vertically, and alphabetically sorts both the modules and the elements imported from each module. --- copilot-core/src/Copilot/Core/Type.hs | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/copilot-core/src/Copilot/Core/Type.hs b/copilot-core/src/Copilot/Core/Type.hs index f743c0ad3..073d8c56e 100644 --- a/copilot-core/src/Copilot/Core/Type.hs +++ b/copilot-core/src/Copilot/Core/Type.hs @@ -41,18 +41,18 @@ module Copilot.Core.Type , accessorname ) where -import Data.Int (Int16, Int32, Int64, Int8) -import Data.Word (Word16, Word32, Word64, Word8) -import Data.Type.Equality as DE -import Copilot.Core.Type.Equality as CE +-- External imports +import Data.Int (Int16, Int32, Int64, Int8) +import Data.List (intercalate) +import Data.Proxy (Proxy (..)) +import Data.Type.Equality as DE +import Data.Typeable (Typeable, typeRep) +import Data.Word (Word16, Word32, Word64, Word8) +import GHC.TypeLits (KnownNat, KnownSymbol, Symbol, natVal, symbolVal) + +-- Internal imports import Copilot.Core.Type.Array (Array) - -import Data.Typeable (Typeable, typeRep) - -import GHC.TypeLits (KnownNat, natVal, Symbol, KnownSymbol, symbolVal) -import Data.Proxy (Proxy (..)) - -import Data.List (intercalate) +import Copilot.Core.Type.Equality as CE -- | The value of that is a product or struct, defined as a constructor with -- several fields. From 25190622173204251ee40fa0561c74e3e58d3ff0 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 3 Nov 2022 10:16:36 -0700 Subject: [PATCH 0504/1222] copilot-core: Group and sort imports in Copilot.Core.Type.Array. Refs #332. According to our style guide, all imports must be grouped, sorted, alphabetized, and aligned. This commit groups all imports in the module Copilot.Core.Type.Array by whether they are internal to copilot-core or external, aligns them vertically, and alphabetically sorts both the modules and the elements imported from each module. --- copilot-core/src/Copilot/Core/Type/Array.hs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/copilot-core/src/Copilot/Core/Type/Array.hs b/copilot-core/src/Copilot/Core/Type/Array.hs index 7a1775a3e..aafe5cb47 100644 --- a/copilot-core/src/Copilot/Core/Type/Array.hs +++ b/copilot-core/src/Copilot/Core/Type/Array.hs @@ -24,8 +24,9 @@ module Copilot.Core.Type.Array , arrayelems ) where -import GHC.TypeLits (Nat, KnownNat, natVal) -import Data.Proxy (Proxy (..)) +-- External imports +import Data.Proxy (Proxy (..)) +import GHC.TypeLits (KnownNat, Nat, natVal) -- | Implementation of an array that uses type literals to store length. data Array (n :: Nat) t where From 84f251e6b87c99763ebe5e3f87a3c612587262aa Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 3 Nov 2022 10:16:36 -0700 Subject: [PATCH 0505/1222] copilot-core: Group and sort imports in Copilot.Core.Type.ShowInternal. Refs #332. According to our style guide, all imports must be grouped, sorted, alphabetized, and aligned. This commit groups all imports in the module Copilot.Core.Type.ShowInternal by whether they are internal to copilot-core or external, aligns them vertically, and alphabetically sorts both the modules and the elements imported from each module. --- copilot-core/src/Copilot/Core/Type/ShowInternal.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/copilot-core/src/Copilot/Core/Type/ShowInternal.hs b/copilot-core/src/Copilot/Core/Type/ShowInternal.hs index f812b4edc..580845b42 100644 --- a/copilot-core/src/Copilot/Core/Type/ShowInternal.hs +++ b/copilot-core/src/Copilot/Core/Type/ShowInternal.hs @@ -11,6 +11,7 @@ module Copilot.Core.Type.ShowInternal , showType ) where +-- Internal imports import Copilot.Core.Type (Type (..)) -- Are we proving equivalence with a C backend, in which case we want to show From 4a9118d50a43fddd30889800a3dc803cd06b4a09 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 3 Nov 2022 11:50:24 -0700 Subject: [PATCH 0506/1222] copilot-core: Group and sort imports in Copilot.Core. Refs #332. According to our style guide, all imports must be grouped, sorted, alphabetized, and aligned. This commit groups all imports in the module Copilot.Core by whether they are internal to copilot-core or external, aligns them vertically, and alphabetically sorts both the modules and the elements imported from each module. --- copilot-core/src/Copilot/Core.hs | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/copilot-core/src/Copilot/Core.hs b/copilot-core/src/Copilot/Core.hs index 642ea3793..6591a339a 100644 --- a/copilot-core/src/Copilot/Core.hs +++ b/copilot-core/src/Copilot/Core.hs @@ -35,11 +35,14 @@ module Copilot.Core , module Data.Word ) where +-- External imports +import Data.Int +import Data.Word + +-- Internal imports import Copilot.Core.Expr import Copilot.Core.External -- See GHC flag enabled above import Copilot.Core.Operators import Copilot.Core.Spec import Copilot.Core.Type import Copilot.Core.Type.Array -import Data.Int -import Data.Word From 2b34504d00c178e1e51097370278daa4cc15a0d6 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 3 Nov 2022 11:18:27 -0700 Subject: [PATCH 0507/1222] copilot-core: Adjust indentation to 2 spaces in Copilot.Core.Error. Refs #332. This commit adjusts indentation in Copilot.Core.Error to 2 spaces, in conformance with our style guide. --- copilot-core/src/Copilot/Core/Error.hs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/copilot-core/src/Copilot/Core/Error.hs b/copilot-core/src/Copilot/Core/Error.hs index 0495bf29e..6b2b0d22f 100644 --- a/copilot-core/src/Copilot/Core/Error.hs +++ b/copilot-core/src/Copilot/Core/Error.hs @@ -4,8 +4,9 @@ -- | Custom functions to report error messages to users. module Copilot.Core.Error - ( impossible - , badUsage ) where + ( impossible + , badUsage ) + where -- | Report an error due to a bug in Copilot. impossible :: String -- ^ Name of the function in which the error was detected. From 031736359103213bbbd63d9472f668c4627d5878 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 3 Nov 2022 11:18:27 -0700 Subject: [PATCH 0508/1222] copilot-core: Adjust indentation to 2 spaces in Copilot.Core.Expr. Refs #332. This commit adjusts indentation in Copilot.Core.Expr to 2 spaces, in conformance with our style guide. --- copilot-core/src/Copilot/Core/Expr.hs | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/copilot-core/src/Copilot/Core/Expr.hs b/copilot-core/src/Copilot/Core/Expr.hs index a9b63c462..2fbb10880 100644 --- a/copilot-core/src/Copilot/Core/Expr.hs +++ b/copilot-core/src/Copilot/Core/Expr.hs @@ -6,12 +6,13 @@ -- | Internal representation of Copilot stream expressions. module Copilot.Core.Expr - ( Id - , Name - , Expr (..) - , UExpr (..) - , DropIdx - ) where + ( Id + , Name + , Expr (..) + , UExpr (..) + , DropIdx + ) + where -- External imports import Data.Typeable (Typeable) From 7255d6c66d41af6071fc854e3a12ee4588d7fe38 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 3 Nov 2022 11:18:27 -0700 Subject: [PATCH 0509/1222] copilot-core: Adjust indentation to 2 spaces in Copilot.Core.Operators. Refs #332. This commit adjusts indentation in Copilot.Core.Operators to 2 spaces, in conformance with our style guide. --- copilot-core/src/Copilot/Core/Operators.hs | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/copilot-core/src/Copilot/Core/Operators.hs b/copilot-core/src/Copilot/Core/Operators.hs index fcb1fa319..7f8a0b2dc 100644 --- a/copilot-core/src/Copilot/Core/Operators.hs +++ b/copilot-core/src/Copilot/Core/Operators.hs @@ -6,10 +6,11 @@ -- | Internal representation of Copilot operators. module Copilot.Core.Operators - ( Op1 (..) - , Op2 (..) - , Op3 (..) - ) where + ( Op1 (..) + , Op2 (..) + , Op3 (..) + ) + where -- External imports import Data.Bits (Bits) From 5851ce8530959d23be764c841137e6faefd5539c Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 3 Nov 2022 11:18:27 -0700 Subject: [PATCH 0510/1222] copilot-core: Adjust indentation to 2 spaces in Copilot.Core.Spec. Refs #332. This commit adjusts indentation in Copilot.Core.Spec to 2 spaces, in conformance with our style guide. --- copilot-core/src/Copilot/Core/Spec.hs | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/copilot-core/src/Copilot/Core/Spec.hs b/copilot-core/src/Copilot/Core/Spec.hs index 3541c8e24..a1213aefd 100644 --- a/copilot-core/src/Copilot/Core/Spec.hs +++ b/copilot-core/src/Copilot/Core/Spec.hs @@ -14,12 +14,13 @@ -- into Copilot Core's 'Spec'. This module defines the low-level Copilot Core -- representations for Specs and the main types of element in a spec.. module Copilot.Core.Spec - ( Stream (..) - , Observer (..) - , Trigger (..) - , Spec (..) - , Property (..) - ) where + ( Stream (..) + , Observer (..) + , Trigger (..) + , Spec (..) + , Property (..) + ) + where -- External imports import Data.Typeable (Typeable) From 6ae55b4a9e95d0092bb959e6e08bc6192a43d0e8 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 3 Nov 2022 11:18:27 -0700 Subject: [PATCH 0511/1222] copilot-core: Adjust indentation to 2 spaces in Copilot.Core.Type. Refs #332. This commit adjusts indentation in Copilot.Core.Type to 2 spaces, in conformance with our style guide. --- copilot-core/src/Copilot/Core/Type.hs | 35 ++++++++++++++------------- 1 file changed, 18 insertions(+), 17 deletions(-) diff --git a/copilot-core/src/Copilot/Core/Type.hs b/copilot-core/src/Copilot/Core/Type.hs index 073d8c56e..5abc9654a 100644 --- a/copilot-core/src/Copilot/Core/Type.hs +++ b/copilot-core/src/Copilot/Core/Type.hs @@ -23,23 +23,24 @@ {-# LANGUAGE UndecidableInstances #-} module Copilot.Core.Type - ( Type (..) - , Typed (..) - , UType (..) - , SimpleType (..) - - , tysize - , tylength - - , Value (..) - , toValues - , Field (..) - , typename - - , Struct - , fieldname - , accessorname - ) where + ( Type (..) + , Typed (..) + , UType (..) + , SimpleType (..) + + , tysize + , tylength + + , Value (..) + , toValues + , Field (..) + , typename + + , Struct + , fieldname + , accessorname + ) + where -- External imports import Data.Int (Int16, Int32, Int64, Int8) From 17eab73182d7b9490ff48612f20fc603c1d25a32 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 3 Nov 2022 11:18:27 -0700 Subject: [PATCH 0512/1222] copilot-core: Adjust indentation to 2 spaces in Copilot.Core.Type.Array. Refs #332. This commit adjusts indentation in Copilot.Core.Type.Array to 2 spaces, in conformance with our style guide. --- copilot-core/src/Copilot/Core/Type/Array.hs | 17 +++++++++-------- 1 file changed, 9 insertions(+), 8 deletions(-) diff --git a/copilot-core/src/Copilot/Core/Type/Array.hs b/copilot-core/src/Copilot/Core/Type/Array.hs index aafe5cb47..7a25022cf 100644 --- a/copilot-core/src/Copilot/Core/Type/Array.hs +++ b/copilot-core/src/Copilot/Core/Type/Array.hs @@ -15,14 +15,15 @@ -- arrays. module Copilot.Core.Type.Array - ( Array - , array - , flatten - , size - , Flatten - , InnerType - , arrayelems - ) where + ( Array + , array + , flatten + , size + , Flatten + , InnerType + , arrayelems + ) + where -- External imports import Data.Proxy (Proxy (..)) From 8e637d6574c9afd9a9308f164133b828119ad1fd Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 3 Nov 2022 11:18:27 -0700 Subject: [PATCH 0513/1222] copilot-core: Adjust indentation to 2 spaces in Copilot.Core.Type.ShowInternal. Refs #332. This commit adjusts indentation in Copilot.Core.Type.ShowInternal to 2 spaces, in conformance with our style guide. --- .../src/Copilot/Core/Type/ShowInternal.hs | 19 ++++++++++--------- 1 file changed, 10 insertions(+), 9 deletions(-) diff --git a/copilot-core/src/Copilot/Core/Type/ShowInternal.hs b/copilot-core/src/Copilot/Core/Type/ShowInternal.hs index 580845b42..e06818700 100644 --- a/copilot-core/src/Copilot/Core/Type/ShowInternal.hs +++ b/copilot-core/src/Copilot/Core/Type/ShowInternal.hs @@ -6,10 +6,11 @@ -- | Show Copilot Core types and typed values. module Copilot.Core.Type.ShowInternal - ( showWithType - , ShowType(..) - , showType - ) where + ( showWithType + , ShowType(..) + , showType + ) + where -- Internal imports import Copilot.Core.Type (Type (..)) @@ -25,16 +26,16 @@ data ShowType = C | Haskell -- language. Booleans are represented differently depending on the backend. showWithType :: ShowType -> Type a -> a -> String showWithType showT t x = - case showT of - C -> case t of + case showT of + C -> case t of Bool -> if x then "1" else "0" _ -> sw - Haskell -> case t of + Haskell -> case t of Bool -> if x then "true" else "false" _ -> sw where - sw = case showWit t of - ShowWit -> show x + sw = case showWit t of + ShowWit -> show x -- | Show Copilot Core type. showType :: Type a -> String From 6f1304f4562689e4d399589a89f761473c3f1097 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 3 Nov 2022 11:50:58 -0700 Subject: [PATCH 0514/1222] copilot-core: Adjust indentation to 2 spaces in Copilot.Core. Refs #332. This commit adjusts indentation in Copilot.Core to 2 spaces, in conformance with our style guide. --- copilot-core/src/Copilot/Core.hs | 19 ++++++++++--------- 1 file changed, 10 insertions(+), 9 deletions(-) diff --git a/copilot-core/src/Copilot/Core.hs b/copilot-core/src/Copilot/Core.hs index 6591a339a..3ea7ae348 100644 --- a/copilot-core/src/Copilot/Core.hs +++ b/copilot-core/src/Copilot/Core.hs @@ -25,15 +25,16 @@ {-# OPTIONS_GHC -fno-warn-deprecations #-} module Copilot.Core - ( module Copilot.Core.Expr - , module Copilot.Core.External - , module Copilot.Core.Operators - , module Copilot.Core.Spec - , module Copilot.Core.Type - , module Copilot.Core.Type.Array - , module Data.Int - , module Data.Word - ) where + ( module Copilot.Core.Expr + , module Copilot.Core.External + , module Copilot.Core.Operators + , module Copilot.Core.Spec + , module Copilot.Core.Type + , module Copilot.Core.Type.Array + , module Data.Int + , module Data.Word + ) + where -- External imports import Data.Int From 29e548823a0fceeb14581fd06f5cbed023387744 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 3 Nov 2022 11:32:03 -0700 Subject: [PATCH 0515/1222] copilot-core: Remove redundant pragma from Copilot.Core.Type.Array. Refs #332. According to our style guide, redundant pragmas should not be present in modules. This commit removes a redundant pragma from the module Copilot.Core.Type.Array. --- copilot-core/src/Copilot/Core/Type/Array.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/copilot-core/src/Copilot/Core/Type/Array.hs b/copilot-core/src/Copilot/Core/Type/Array.hs index 7a25022cf..237931f4e 100644 --- a/copilot-core/src/Copilot/Core/Type/Array.hs +++ b/copilot-core/src/Copilot/Core/Type/Array.hs @@ -3,7 +3,6 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} -{-# LANGUAGE KindSignatures #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE Safe #-} {-# LANGUAGE ScopedTypeVariables #-} From 3af557a5c5ddf669c105ed445accc65150bd7857 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 3 Nov 2022 11:54:19 -0700 Subject: [PATCH 0516/1222] copilot-core: Format copyright notice using haddock in Copilot.Core. Refs #332. This commit adjusts the copyright notice in Copilot.Core so that it is rendered correctly using haddock. The copyright symbol is replaced with (c) to avoid line-width / formatting issues. --- copilot-core/src/Copilot/Core.hs | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/copilot-core/src/Copilot/Core.hs b/copilot-core/src/Copilot/Core.hs index 3ea7ae348..76208071d 100644 --- a/copilot-core/src/Copilot/Core.hs +++ b/copilot-core/src/Copilot/Core.hs @@ -1,6 +1,7 @@ --- Copyright © 2011 National Institute of Aerospace / Galois, Inc. - --- | Intermediate representation for Copilot specifications. +-- | +-- Description: Intermediate representation for Copilot specifications. +-- Copyright: (c) 2011 National Institute of Aerospace / Galois, Inc. +-- -- The following articles might also be useful: -- -- * Carette, Jacques and Kiselyov, Oleg and Shan, Chung-chieh, From 5a1a2eac78690b1be3cf37c700675ba48dba006c Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 3 Nov 2022 11:54:19 -0700 Subject: [PATCH 0517/1222] copilot-core: Format copyright notice using haddock in Copilot.Core.Error. Refs #332. This commit adjusts the copyright notice in Copilot.Core.Error so that it is rendered correctly using haddock. The copyright symbol is replaced with (c) to avoid line-width / formatting issues. --- copilot-core/src/Copilot/Core/Error.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/copilot-core/src/Copilot/Core/Error.hs b/copilot-core/src/Copilot/Core/Error.hs index 6b2b0d22f..28619e43b 100644 --- a/copilot-core/src/Copilot/Core/Error.hs +++ b/copilot-core/src/Copilot/Core/Error.hs @@ -1,8 +1,8 @@ --- Copyright © 2011 National Institute of Aerospace / Galois, Inc. - {-# LANGUAGE Safe #-} --- | Custom functions to report error messages to users. +-- | +-- Description: Custom functions to report error messages to users. +-- Copyright: (c) 2011 National Institute of Aerospace / Galois, Inc. module Copilot.Core.Error ( impossible , badUsage ) From ddcaba8871fdcf689fff46d6151100029f8f84d0 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 3 Nov 2022 11:54:19 -0700 Subject: [PATCH 0518/1222] copilot-core: Format copyright notice using haddock in Copilot.Core.Expr. Refs #332. This commit adjusts the copyright notice in Copilot.Core.Expr so that it is rendered correctly using haddock. The copyright symbol is replaced with (c) to avoid line-width / formatting issues. --- copilot-core/src/Copilot/Core/Expr.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/copilot-core/src/Copilot/Core/Expr.hs b/copilot-core/src/Copilot/Core/Expr.hs index 2fbb10880..3c4afd268 100644 --- a/copilot-core/src/Copilot/Core/Expr.hs +++ b/copilot-core/src/Copilot/Core/Expr.hs @@ -1,10 +1,10 @@ --- Copyright © 2011 National Institute of Aerospace / Galois, Inc. - {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE Safe #-} --- | Internal representation of Copilot stream expressions. +-- | +-- Description: Internal representation of Copilot stream expressions. +-- Copyright: (c) 2011 National Institute of Aerospace / Galois, Inc. module Copilot.Core.Expr ( Id , Name From dbff3ec587ce16c06df9efd8a9deeecd9c625f2e Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 3 Nov 2022 11:54:19 -0700 Subject: [PATCH 0519/1222] copilot-core: Format copyright notice using haddock in Copilot.Core.Operators. Refs #332. This commit adjusts the copyright notice in Copilot.Core.Operators so that it is rendered correctly using haddock. The copyright symbol is replaced with (c) to avoid line-width / formatting issues. --- copilot-core/src/Copilot/Core/Operators.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/copilot-core/src/Copilot/Core/Operators.hs b/copilot-core/src/Copilot/Core/Operators.hs index 7f8a0b2dc..ba735c374 100644 --- a/copilot-core/src/Copilot/Core/Operators.hs +++ b/copilot-core/src/Copilot/Core/Operators.hs @@ -1,10 +1,10 @@ --- Copyright © 2011 National Institute of Aerospace / Galois, Inc. - {-# LANGUAGE GADTs #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE Safe #-} --- | Internal representation of Copilot operators. +-- | +-- Description: Internal representation of Copilot operators. +-- Copyright: (c) 2011 National Institute of Aerospace / Galois, Inc. module Copilot.Core.Operators ( Op1 (..) , Op2 (..) From abfcdca767d686c3e496eb7aa9928bc39215c60e Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 3 Nov 2022 11:54:19 -0700 Subject: [PATCH 0520/1222] copilot-core: Format copyright notice using haddock in Copilot.Core.Spec. Refs #332. This commit adjusts the copyright notice in Copilot.Core.Spec so that it is rendered correctly using haddock. The copyright symbol is replaced with (c) to avoid line-width / formatting issues. --- copilot-core/src/Copilot/Core/Spec.hs | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/copilot-core/src/Copilot/Core/Spec.hs b/copilot-core/src/Copilot/Core/Spec.hs index a1213aefd..57c76e9d1 100644 --- a/copilot-core/src/Copilot/Core/Spec.hs +++ b/copilot-core/src/Copilot/Core/Spec.hs @@ -1,10 +1,11 @@ --- Copyright © 2011 National Institute of Aerospace / Galois, Inc. - {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE Safe #-} --- | Copilot specifications constitute the main declaration of Copilot modules. +-- | +-- Copyright: (c) 2011 National Institute of Aerospace / Galois, Inc. +-- +-- Copilot specifications constitute the main declaration of Copilot modules. -- -- A specification normally contains the association between streams to monitor -- and their handling functions, or streams to observe, or a theorem that must From d4a615ff346bbd06b4dd30547c151b0ee4934c3a Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 3 Nov 2022 11:54:19 -0700 Subject: [PATCH 0521/1222] copilot-core: Format copyright notice using haddock in Copilot.Core.Type. Refs #332. This commit adjusts the copyright notice in Copilot.Core.Type so that it is rendered correctly using haddock. The copyright symbol is replaced with (c) to avoid line-width / formatting issues. --- copilot-core/src/Copilot/Core/Type.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/copilot-core/src/Copilot/Core/Type.hs b/copilot-core/src/Copilot/Core/Type.hs index 5abc9654a..0cd019c82 100644 --- a/copilot-core/src/Copilot/Core/Type.hs +++ b/copilot-core/src/Copilot/Core/Type.hs @@ -2,9 +2,9 @@ -- Copilot.Core.Type.Equality does not give rise to warnings. {-# OPTIONS_GHC -fno-warn-deprecations #-} --- Copyright © 2011 National Institute of Aerospace / Galois, Inc. - --- | Typing for Core. +-- | +-- Description: Typing for Core. +-- Copyright: (c) 2011 National Institute of Aerospace / Galois, Inc. -- -- All expressions and streams in Core are accompanied by a representation of -- the types of the underlying expressions used or carried by the streams. From cbe6ce23d560ac4359205a79ab7f10f988468487 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 3 Nov 2022 11:54:19 -0700 Subject: [PATCH 0522/1222] copilot-core: Format copyright notice using haddock in Copilot.Core.Type.Array. Refs #332. This commit adjusts the copyright notice in Copilot.Core.Type.Array so that it is rendered correctly using haddock. The copyright symbol is replaced with (c) to avoid line-width / formatting issues. --- copilot-core/src/Copilot/Core/Type/Array.hs | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/copilot-core/src/Copilot/Core/Type/Array.hs b/copilot-core/src/Copilot/Core/Type/Array.hs index 237931f4e..cf53ca1b0 100644 --- a/copilot-core/src/Copilot/Core/Type/Array.hs +++ b/copilot-core/src/Copilot/Core/Type/Array.hs @@ -1,5 +1,3 @@ --- Copyright © 2011 National Institute of Aerospace / Galois, Inc. - {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} @@ -9,7 +7,10 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} --- | Implementation of an array that uses type literals to store length. No +-- | +-- Copyright: (c) 2011 National Institute of Aerospace / Galois, Inc. +-- +-- Implementation of an array that uses type literals to store length. No -- explicit indexing is used for the input data. Supports arbitrary nesting of -- arrays. From c3e7b30fdc0a21f436f957f962e95b3d0f46cd08 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 3 Nov 2022 11:54:19 -0700 Subject: [PATCH 0523/1222] copilot-core: Format copyright notice using haddock in Copilot.Core.Type.ShowInternal. Refs #332. This commit adjusts the copyright notice in Copilot.Core.Type.ShowInternal so that it is rendered correctly using haddock. The copyright symbol is replaced with (c) to avoid line-width / formatting issues. --- copilot-core/src/Copilot/Core/Type/ShowInternal.hs | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/copilot-core/src/Copilot/Core/Type/ShowInternal.hs b/copilot-core/src/Copilot/Core/Type/ShowInternal.hs index e06818700..9b854f6ec 100644 --- a/copilot-core/src/Copilot/Core/Type/ShowInternal.hs +++ b/copilot-core/src/Copilot/Core/Type/ShowInternal.hs @@ -1,10 +1,11 @@ --- Copyright © 2011 National Institute of Aerospace / Galois, Inc. - {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE Safe #-} --- | Show Copilot Core types and typed values. +-- | +-- Copyright: (c) 2011 National Institute of Aerospace / Galois, Inc. +-- +-- Show Copilot Core types and typed values. module Copilot.Core.Type.ShowInternal ( showWithType , ShowType(..) From 34b248aaf1955c11b07c7c1aa0cc2317c5f2f338 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 3 Nov 2022 12:25:34 -0700 Subject: [PATCH 0524/1222] copilot-core: Adjust horizontal space in Copilot.Core.Expr. Refs #332. This commit adjusts the horizontal space in Copilot.Core.Expr so no extra space is added unless needed (e.g., to align elements). --- copilot-core/src/Copilot/Core/Expr.hs | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/copilot-core/src/Copilot/Core/Expr.hs b/copilot-core/src/Copilot/Core/Expr.hs index 3c4afd268..0e2c09e38 100644 --- a/copilot-core/src/Copilot/Core/Expr.hs +++ b/copilot-core/src/Copilot/Core/Expr.hs @@ -37,19 +37,19 @@ type DropIdx = Word32 -- representation contains information about the types of elements in the -- stream. data Expr a where - Const :: Typeable a => Type a -> a -> Expr a - Drop :: Typeable a => Type a -> DropIdx -> Id -> Expr a - Local :: Typeable a => Type a -> Type b -> Name -> Expr a -> Expr b -> Expr b - Var :: Typeable a => Type a -> Name -> Expr a - ExternVar :: Typeable a => Type a -> Name -> Maybe [a] -> Expr a - Op1 :: Typeable a => Op1 a b -> Expr a -> Expr b - Op2 :: (Typeable a, Typeable b) => Op2 a b c -> Expr a -> Expr b -> Expr c - Op3 :: (Typeable a, Typeable b, Typeable c) => Op3 a b c d -> Expr a -> Expr b -> Expr c -> Expr d - Label :: Typeable a => Type a -> String -> Expr a -> Expr a + Const :: Typeable a => Type a -> a -> Expr a + Drop :: Typeable a => Type a -> DropIdx -> Id -> Expr a + Local :: Typeable a => Type a -> Type b -> Name -> Expr a -> Expr b -> Expr b + Var :: Typeable a => Type a -> Name -> Expr a + ExternVar :: Typeable a => Type a -> Name -> Maybe [a] -> Expr a + Op1 :: Typeable a => Op1 a b -> Expr a -> Expr b + Op2 :: (Typeable a, Typeable b) => Op2 a b c -> Expr a -> Expr b -> Expr c + Op3 :: (Typeable a, Typeable b, Typeable c) => Op3 a b c d -> Expr a -> Expr b -> Expr c -> Expr d + Label :: Typeable a => Type a -> String -> Expr a -> Expr a -- | A untyped expression that carries the information about the type of the -- expression as a value, as opposed to exposing it at type level (using an -- existential). -data UExpr = forall a. Typeable a => UExpr +data UExpr = forall a . Typeable a => UExpr { uExprType :: Type a , uExprExpr :: Expr a } From 82d97b0c9f0eb1875b90fc7285b1d879e09403f5 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 3 Nov 2022 12:25:34 -0700 Subject: [PATCH 0525/1222] copilot-core: Adjust horizontal space in Copilot.Core.Operators. Refs #332. This commit adjusts the horizontal space in Copilot.Core.Operators so no extra space is added unless needed (e.g., to align elements). --- copilot-core/src/Copilot/Core/Operators.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/copilot-core/src/Copilot/Core/Operators.hs b/copilot-core/src/Copilot/Core/Operators.hs index ba735c374..dbc9c30c3 100644 --- a/copilot-core/src/Copilot/Core/Operators.hs +++ b/copilot-core/src/Copilot/Core/Operators.hs @@ -50,7 +50,7 @@ data Op1 a b where Ceiling :: RealFrac a => Type a -> Op1 a a Floor :: RealFrac a => Type a -> Op1 a a -- Bitwise operators. - BwNot :: Bits a => Type a -> Op1 a a + BwNot :: Bits a => Type a -> Op1 a a -- Casting operator. Cast :: (Integral a, Num b) => Type a -> Type b -> Op1 a b -- ^ Casting operator. @@ -90,8 +90,8 @@ data Op2 a b c where BwAnd :: Bits a => Type a -> Op2 a a a BwOr :: Bits a => Type a -> Op2 a a a BwXor :: Bits a => Type a -> Op2 a a a - BwShiftL :: ( Bits a, Integral b ) => Type a -> Type b -> Op2 a b a - BwShiftR :: ( Bits a, Integral b ) => Type a -> Type b -> Op2 a b a + BwShiftL :: (Bits a, Integral b) => Type a -> Type b -> Op2 a b a + BwShiftR :: (Bits a, Integral b) => Type a -> Type b -> Op2 a b a -- Array operator. Index :: Type (Array n t) -> Op2 (Array n t) Word32 t @@ -100,4 +100,4 @@ data Op2 a b c where -- | Ternary operators. data Op3 a b c d where -- Conditional operator: - Mux :: Type a -> Op3 Bool a a a + Mux :: Type a -> Op3 Bool a a a From 6361c796ee0ad997bf9481c4be86c91237212ab8 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 3 Nov 2022 12:25:34 -0700 Subject: [PATCH 0526/1222] copilot-core: Adjust horizontal space in Copilot.Core.Spec. Refs #332. This commit adjusts the horizontal space in Copilot.Core.Spec so no extra space is added unless needed (e.g., to align elements). --- copilot-core/src/Copilot/Core/Spec.hs | 30 +++++++++++++-------------- 1 file changed, 15 insertions(+), 15 deletions(-) diff --git a/copilot-core/src/Copilot/Core/Spec.hs b/copilot-core/src/Copilot/Core/Spec.hs index 57c76e9d1..451e79e10 100644 --- a/copilot-core/src/Copilot/Core/Spec.hs +++ b/copilot-core/src/Copilot/Core/Spec.hs @@ -35,15 +35,15 @@ import Copilot.Core.Type (Type, Typed) -- Stream can carry different types of data. Boolean streams play a special -- role: they are used by other parts (e.g., 'Trigger') to detect when the -- properties being monitored are violated. -data Stream = forall a. (Typeable a, Typed a) => Stream - { streamId :: Id - , streamBuffer :: [a] - , streamExpr :: Expr a - , streamExprType :: Type a } +data Stream = forall a . (Typeable a, Typed a) => Stream + { streamId :: Id + , streamBuffer :: [a] + , streamExpr :: Expr a + , streamExprType :: Type a } -- | An observer, representing a stream that we observe during interpretation -- at every sample. -data Observer = forall a. Typeable a => Observer +data Observer = forall a . Typeable a => Observer { observerName :: Name , observerExpr :: Expr a , observerExprType :: Type a } @@ -51,20 +51,20 @@ data Observer = forall a. Typeable a => Observer -- | A trigger, representing a function we execute when a boolean stream becomes -- true at a sample. data Trigger = Trigger - { triggerName :: Name - , triggerGuard :: Expr Bool - , triggerArgs :: [UExpr] } + { triggerName :: Name + , triggerGuard :: Expr Bool + , triggerArgs :: [UExpr] } -- | A property, representing a boolean stream that is existentially or -- universally quantified over time. data Property = Property - { propertyName :: Name - , propertyExpr :: Expr Bool } + { propertyName :: Name + , propertyExpr :: Expr Bool } -- | A Copilot specification is a list of streams, together with monitors on -- these streams implemented as observers, triggers or properties. data Spec = Spec - { specStreams :: [Stream] - , specObservers :: [Observer] - , specTriggers :: [Trigger] - , specProperties :: [Property] } + { specStreams :: [Stream] + , specObservers :: [Observer] + , specTriggers :: [Trigger] + , specProperties :: [Property] } From 5682386ddffd5f5a4bc951cfee94b5f356febb97 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 3 Nov 2022 12:25:34 -0700 Subject: [PATCH 0527/1222] copilot-core: Adjust horizontal space in Copilot.Core.Type. Refs #332. This commit adjusts the horizontal space in Copilot.Core.Type so no extra space is added unless needed (e.g., to align elements). --- copilot-core/src/Copilot/Core/Type.hs | 78 +++++++++++++-------------- 1 file changed, 39 insertions(+), 39 deletions(-) diff --git a/copilot-core/src/Copilot/Core/Type.hs b/copilot-core/src/Copilot/Core/Type.hs index 0cd019c82..4eb79dc93 100644 --- a/copilot-core/src/Copilot/Core/Type.hs +++ b/copilot-core/src/Copilot/Core/Type.hs @@ -64,19 +64,19 @@ class Struct a where toValues :: a -> [Value a] -- | The field of a struct, together with a representation of its type. -data Value a = forall s t. (Typeable t, KnownSymbol s, Show t) => Value (Type t) (Field s t) +data Value a = forall s t . (Typeable t, KnownSymbol s, Show t) => Value (Type t) (Field s t) -- | A field in a struct. The name of the field is a literal at the type -- level. data Field (s :: Symbol) t = Field t -- | Extract the name of a field. -fieldname :: forall s t. KnownSymbol s => Field s t -> String +fieldname :: forall s t . KnownSymbol s => Field s t -> String fieldname _ = symbolVal (Proxy :: Proxy s) -- | Extract the name of an accessor (a function that returns a field of a -- struct). -accessorname :: forall a s t. (Struct a, KnownSymbol s) => (a -> Field s t) -> String +accessorname :: forall a s t . (Struct a, KnownSymbol s) => (a -> Field s t) -> String accessorname _ = symbolVal (Proxy :: Proxy s) instance (KnownSymbol s, Show t) => Show (Field s t) where @@ -95,28 +95,28 @@ instance {-# OVERLAPPABLE #-} (Typed t, Struct t) => Show t where -- former, the length of the array is part of the type. In the latter, the -- names of the fields are part of the type. data Type :: * -> * where - Bool :: Type Bool - Int8 :: Type Int8 - Int16 :: Type Int16 - Int32 :: Type Int32 - Int64 :: Type Int64 - Word8 :: Type Word8 - Word16 :: Type Word16 - Word32 :: Type Word32 - Word64 :: Type Word64 - Float :: Type Float - Double :: Type Double - Array :: forall n t. ( KnownNat n + Bool :: Type Bool + Int8 :: Type Int8 + Int16 :: Type Int16 + Int32 :: Type Int32 + Int64 :: Type Int64 + Word8 :: Type Word8 + Word16 :: Type Word16 + Word32 :: Type Word32 + Word64 :: Type Word64 + Float :: Type Float + Double :: Type Double + Array :: forall n t . ( KnownNat n , Typed t ) => Type t -> Type (Array n t) - Struct :: (Typed a, Struct a) => a -> Type a + Struct :: (Typed a, Struct a) => a -> Type a -- | Return the length of an array from its type -tylength :: forall n t. KnownNat n => Type (Array n t) -> Int +tylength :: forall n t . KnownNat n => Type (Array n t) -> Int tylength _ = fromIntegral $ natVal (Proxy :: Proxy n) -- | Return the total (nested) size of an array from its type -tysize :: forall n t. KnownNat n => Type (Array n t) -> Int +tysize :: forall n t . KnownNat n => Type (Array n t) -> Int tysize ty@(Array ty'@(Array _)) = tylength ty * tysize ty' tysize ty@(Array _ ) = tylength ty @@ -171,20 +171,20 @@ data SimpleType where -- This instance is necessary, otherwise the type of SArray can't be inferred. instance Eq SimpleType where - SBool == SBool = True - SInt8 == SInt8 = True - SInt16 == SInt16 = True - SInt32 == SInt32 = True - SInt64 == SInt64 = True - SWord8 == SWord8 = True - SWord16 == SWord16 = True - SWord32 == SWord32 = True - SWord64 == SWord64 = True - SFloat == SFloat = True - SDouble == SDouble = True + SBool == SBool = True + SInt8 == SInt8 = True + SInt16 == SInt16 = True + SInt32 == SInt32 = True + SInt64 == SInt64 = True + SWord8 == SWord8 = True + SWord16 == SWord16 = True + SWord32 == SWord32 = True + SWord64 == SWord64 = True + SFloat == SFloat = True + SDouble == SDouble = True (SArray t1) == (SArray t2) | Just DE.Refl <- testEquality t1 t2 = True | otherwise = False - SStruct == SStruct = True + SStruct == SStruct = True _ == _ = False -- | A typed expression, from which we can obtain the two type representations @@ -194,22 +194,22 @@ class (Show a, Typeable a) => Typed a where simpleType :: Type a -> SimpleType simpleType _ = SStruct -instance Typed Bool where +instance Typed Bool where typeOf = Bool simpleType _ = SBool -instance Typed Int8 where +instance Typed Int8 where typeOf = Int8 simpleType _ = SBool -instance Typed Int16 where +instance Typed Int16 where typeOf = Int16 simpleType _ = SInt16 -instance Typed Int32 where +instance Typed Int32 where typeOf = Int32 simpleType _ = SInt32 -instance Typed Int64 where +instance Typed Int64 where typeOf = Int64 simpleType _ = SInt64 -instance Typed Word8 where +instance Typed Word8 where typeOf = Word8 simpleType _ = SWord8 instance Typed Word16 where @@ -221,15 +221,15 @@ instance Typed Word32 where instance Typed Word64 where typeOf = Word64 simpleType _ = SWord64 -instance Typed Float where +instance Typed Float where typeOf = Float simpleType _ = SFloat instance Typed Double where typeOf = Double simpleType _ = SDouble instance (Typeable t, Typed t, KnownNat n) => Typed (Array n t) where - typeOf = Array typeOf - simpleType (Array t) = SArray t + typeOf = Array typeOf + simpleType (Array t) = SArray t -- | A untyped type (no phantom type). data UType = forall a . Typeable a => UType { uTypeType :: Type a } From 755706e7d25a84194e13464f85ef95fd9e0087de Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 3 Nov 2022 12:25:34 -0700 Subject: [PATCH 0528/1222] copilot-core: Adjust horizontal space in Copilot.Core.Type.ShowInternal. Refs #332. This commit adjusts the horizontal space in Copilot.Core.Type.ShowInternal so no extra space is added unless needed (e.g., to align elements). --- .../src/Copilot/Core/Type/ShowInternal.hs | 50 +++++++++---------- 1 file changed, 25 insertions(+), 25 deletions(-) diff --git a/copilot-core/src/Copilot/Core/Type/ShowInternal.hs b/copilot-core/src/Copilot/Core/Type/ShowInternal.hs index 9b854f6ec..dc68df9cf 100644 --- a/copilot-core/src/Copilot/Core/Type/ShowInternal.hs +++ b/copilot-core/src/Copilot/Core/Type/ShowInternal.hs @@ -8,7 +8,7 @@ -- Show Copilot Core types and typed values. module Copilot.Core.Type.ShowInternal ( showWithType - , ShowType(..) + , ShowType (..) , showType ) where @@ -42,18 +42,18 @@ showWithType showT t x = showType :: Type a -> String showType t = case t of - Bool -> "Bool" - Int8 -> "Int8" - Int16 -> "Int16" - Int32 -> "Int32" - Int64 -> "Int64" - Word8 -> "Word8" - Word16 -> "Word16" - Word32 -> "Word32" - Word64 -> "Word64" - Float -> "Float" - Double -> "Double" - Array t -> "Array " ++ showType t + Bool -> "Bool" + Int8 -> "Int8" + Int16 -> "Int16" + Int32 -> "Int32" + Int64 -> "Int64" + Word8 -> "Word8" + Word16 -> "Word16" + Word32 -> "Word32" + Word64 -> "Word64" + Float -> "Float" + Double -> "Double" + Array t -> "Array " ++ showType t Struct t -> "Struct" -- * Auxiliary show instance @@ -65,16 +65,16 @@ data ShowWit a = Show a => ShowWit showWit :: Type a -> ShowWit a showWit t = case t of - Bool -> ShowWit - Int8 -> ShowWit - Int16 -> ShowWit - Int32 -> ShowWit - Int64 -> ShowWit - Word8 -> ShowWit - Word16 -> ShowWit - Word32 -> ShowWit - Word64 -> ShowWit - Float -> ShowWit - Double -> ShowWit - Array t -> ShowWit + Bool -> ShowWit + Int8 -> ShowWit + Int16 -> ShowWit + Int32 -> ShowWit + Int64 -> ShowWit + Word8 -> ShowWit + Word16 -> ShowWit + Word32 -> ShowWit + Word64 -> ShowWit + Float -> ShowWit + Double -> ShowWit + Array t -> ShowWit Struct t -> ShowWit From 554d00be4dcea4c566f18d7df8fb1ca3649c66c5 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 3 Nov 2022 12:30:09 -0700 Subject: [PATCH 0529/1222] copilot-core: Align bracketed expressions in Copilot.Core.Error. Refs #332. This commit adjust bracketed expressions (e.g., record fields, export lists) in Copilot.Core.Error so that the separating commas and the brackets are all in the leading column. --- copilot-core/src/Copilot/Core/Error.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot-core/src/Copilot/Core/Error.hs b/copilot-core/src/Copilot/Core/Error.hs index 28619e43b..fed3f26bf 100644 --- a/copilot-core/src/Copilot/Core/Error.hs +++ b/copilot-core/src/Copilot/Core/Error.hs @@ -5,7 +5,8 @@ -- Copyright: (c) 2011 National Institute of Aerospace / Galois, Inc. module Copilot.Core.Error ( impossible - , badUsage ) + , badUsage + ) where -- | Report an error due to a bug in Copilot. From 72c332d20ca6bbef1510015ddd6a6c3065a1c6ee Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 3 Nov 2022 12:30:09 -0700 Subject: [PATCH 0530/1222] copilot-core: Align bracketed expressions in Copilot.Core.Expr. Refs #332. This commit adjust bracketed expressions (e.g., record fields, export lists) in Copilot.Core.Expr so that the separating commas and the brackets are all in the leading column. --- copilot-core/src/Copilot/Core/Expr.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot-core/src/Copilot/Core/Expr.hs b/copilot-core/src/Copilot/Core/Expr.hs index 0e2c09e38..b34113ab9 100644 --- a/copilot-core/src/Copilot/Core/Expr.hs +++ b/copilot-core/src/Copilot/Core/Expr.hs @@ -52,4 +52,5 @@ data Expr a where -- existential). data UExpr = forall a . Typeable a => UExpr { uExprType :: Type a - , uExprExpr :: Expr a } + , uExprExpr :: Expr a + } From be924d8d5eaf747633cb23821110cc8a339420ab Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 3 Nov 2022 12:30:09 -0700 Subject: [PATCH 0531/1222] copilot-core: Align bracketed expressions in Copilot.Core.Spec. Refs #332. This commit adjust bracketed expressions (e.g., record fields, export lists) in Copilot.Core.Spec so that the separating commas and the brackets are all in the leading column. --- copilot-core/src/Copilot/Core/Spec.hs | 15 ++++++++++----- 1 file changed, 10 insertions(+), 5 deletions(-) diff --git a/copilot-core/src/Copilot/Core/Spec.hs b/copilot-core/src/Copilot/Core/Spec.hs index 451e79e10..534caf927 100644 --- a/copilot-core/src/Copilot/Core/Spec.hs +++ b/copilot-core/src/Copilot/Core/Spec.hs @@ -39,27 +39,31 @@ data Stream = forall a . (Typeable a, Typed a) => Stream { streamId :: Id , streamBuffer :: [a] , streamExpr :: Expr a - , streamExprType :: Type a } + , streamExprType :: Type a + } -- | An observer, representing a stream that we observe during interpretation -- at every sample. data Observer = forall a . Typeable a => Observer { observerName :: Name , observerExpr :: Expr a - , observerExprType :: Type a } + , observerExprType :: Type a + } -- | A trigger, representing a function we execute when a boolean stream becomes -- true at a sample. data Trigger = Trigger { triggerName :: Name , triggerGuard :: Expr Bool - , triggerArgs :: [UExpr] } + , triggerArgs :: [UExpr] + } -- | A property, representing a boolean stream that is existentially or -- universally quantified over time. data Property = Property { propertyName :: Name - , propertyExpr :: Expr Bool } + , propertyExpr :: Expr Bool + } -- | A Copilot specification is a list of streams, together with monitors on -- these streams implemented as observers, triggers or properties. @@ -67,4 +71,5 @@ data Spec = Spec { specStreams :: [Stream] , specObservers :: [Observer] , specTriggers :: [Trigger] - , specProperties :: [Property] } + , specProperties :: [Property] + } From eb7ccf503cb5d9f67f8e109f8d002258e24c166e Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 3 Nov 2022 12:36:44 -0700 Subject: [PATCH 0532/1222] copilot-core: Add extra vertical space in Copilot.Core.Type. Refs #332. This commit add vertical space between top-level definitions in Copilot.Core.Type. --- copilot-core/src/Copilot/Core/Type.hs | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/copilot-core/src/Copilot/Core/Type.hs b/copilot-core/src/Copilot/Core/Type.hs index 4eb79dc93..567873213 100644 --- a/copilot-core/src/Copilot/Core/Type.hs +++ b/copilot-core/src/Copilot/Core/Type.hs @@ -197,36 +197,47 @@ class (Show a, Typeable a) => Typed a where instance Typed Bool where typeOf = Bool simpleType _ = SBool + instance Typed Int8 where typeOf = Int8 simpleType _ = SBool + instance Typed Int16 where typeOf = Int16 simpleType _ = SInt16 + instance Typed Int32 where typeOf = Int32 simpleType _ = SInt32 + instance Typed Int64 where typeOf = Int64 simpleType _ = SInt64 + instance Typed Word8 where typeOf = Word8 simpleType _ = SWord8 + instance Typed Word16 where typeOf = Word16 simpleType _ = SWord16 + instance Typed Word32 where typeOf = Word32 simpleType _ = SWord32 + instance Typed Word64 where typeOf = Word64 simpleType _ = SWord64 + instance Typed Float where typeOf = Float simpleType _ = SFloat + instance Typed Double where typeOf = Double simpleType _ = SDouble + instance (Typeable t, Typed t, KnownNat n) => Typed (Array n t) where typeOf = Array typeOf simpleType (Array t) = SArray t From 2f60c46337f10b408d688e3f694765bb9d2a2aa7 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 3 Nov 2022 12:43:41 -0700 Subject: [PATCH 0533/1222] copilot-core: Place pragmas at top of file in Copilot.Core.Type. Refs #332. This commit moves the pragmas to the very top of the module Copilot.Core.Type, to be consistent with the order used in other modules. --- copilot-core/src/Copilot/Core/Type.hs | 21 ++++++++++----------- 1 file changed, 10 insertions(+), 11 deletions(-) diff --git a/copilot-core/src/Copilot/Core/Type.hs b/copilot-core/src/Copilot/Core/Type.hs index 567873213..25425691d 100644 --- a/copilot-core/src/Copilot/Core/Type.hs +++ b/copilot-core/src/Copilot/Core/Type.hs @@ -1,3 +1,13 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE Safe #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE UndecidableInstances #-} + -- The following flag is disabled in this module so that the import of -- Copilot.Core.Type.Equality does not give rise to warnings. {-# OPTIONS_GHC -fno-warn-deprecations #-} @@ -11,17 +21,6 @@ -- This information is needed by the compiler to generate code, since it must -- initialize variables and equivalent representations for those types in -- the target languages. - -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE ExistentialQuantification #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE KindSignatures #-} -{-# LANGUAGE Safe #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE UndecidableInstances #-} - module Copilot.Core.Type ( Type (..) , Typed (..) From e9f76614a16debcfbcd550f69b5bc90a79567470 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 3 Nov 2022 13:03:37 -0700 Subject: [PATCH 0534/1222] copilot-core: Place pragmas, GHC options at top of file in Copilot.Core. Refs #332. This commit moves the pragmas and GHC options to the very top of the module Copilot.Core, to be consistent with the order used in other modules. --- copilot-core/src/Copilot/Core.hs | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/copilot-core/src/Copilot/Core.hs b/copilot-core/src/Copilot/Core.hs index 76208071d..1ab1b6e27 100644 --- a/copilot-core/src/Copilot/Core.hs +++ b/copilot-core/src/Copilot/Core.hs @@ -1,3 +1,10 @@ +{-# LANGUAGE Safe #-} + +-- The following warning is enabled in this module so that the import of +-- Copilot.Core.External does not give rise to a warning. It can be removed +-- when that module is removed from the implementation. +{-# OPTIONS_GHC -fno-warn-deprecations #-} + -- | -- Description: Intermediate representation for Copilot specifications. -- Copyright: (c) 2011 National Institute of Aerospace / Galois, Inc. @@ -18,13 +25,6 @@ -- ("Copilot.Core.Interpret") -- and the pretty-printer -- ("Copilot.Core.PrettyPrint"). - -{-# LANGUAGE Safe #-} --- The following warning is enabled in this module so that the import of --- Copilot.Core.External does not give rise to a warning. It can be removed --- when that module is removed from the implementation. -{-# OPTIONS_GHC -fno-warn-deprecations #-} - module Copilot.Core ( module Copilot.Core.Expr , module Copilot.Core.External From 5f65a278cc4d00f790ff20540b4e78711b6df8bb Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 3 Nov 2022 13:18:38 -0700 Subject: [PATCH 0535/1222] copilot-core: Remove unnecessary vertical space in Copilot.Core.Operators. Refs #332. This commit removes vertical space in a type definition, to remain consistent with the style used in the rest of the definition. --- copilot-core/src/Copilot/Core/Operators.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/copilot-core/src/Copilot/Core/Operators.hs b/copilot-core/src/Copilot/Core/Operators.hs index dbc9c30c3..e34a449cd 100644 --- a/copilot-core/src/Copilot/Core/Operators.hs +++ b/copilot-core/src/Copilot/Core/Operators.hs @@ -93,7 +93,6 @@ data Op2 a b c where BwShiftL :: (Bits a, Integral b) => Type a -> Type b -> Op2 a b a BwShiftR :: (Bits a, Integral b) => Type a -> Type b -> Op2 a b a -- Array operator. - Index :: Type (Array n t) -> Op2 (Array n t) Word32 t -- ^ Array access/projection of an array element. From c21244d3d7c6dc2b1b85e065cc7d38d05a8e31cd Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 3 Nov 2022 13:26:37 -0700 Subject: [PATCH 0536/1222] copilot-core: Remove unnecessary vertical space in Copilot.Core.Type. Refs #332. This commit removes unnecessary vertical space before a function. --- copilot-core/src/Copilot/Core/Type.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/copilot-core/src/Copilot/Core/Type.hs b/copilot-core/src/Copilot/Core/Type.hs index 25425691d..749ae57ea 100644 --- a/copilot-core/src/Copilot/Core/Type.hs +++ b/copilot-core/src/Copilot/Core/Type.hs @@ -168,7 +168,6 @@ data SimpleType where -- | Type equality, used to help type inference. -- This instance is necessary, otherwise the type of SArray can't be inferred. - instance Eq SimpleType where SBool == SBool = True SInt8 == SInt8 = True From 0f433583301e0b161b1db43c9d3e62c9884cb22c Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 3 Nov 2022 12:44:35 -0700 Subject: [PATCH 0537/1222] copilot-core: Remove unnecessary vertical space in Copilot.Core.Type.Array. Refs #332. This commit removes the vertical space between a module documentation and its definition, to remain consistent with the style used in the rest of the Copilot project. --- copilot-core/src/Copilot/Core/Type/Array.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/copilot-core/src/Copilot/Core/Type/Array.hs b/copilot-core/src/Copilot/Core/Type/Array.hs index cf53ca1b0..afba29b45 100644 --- a/copilot-core/src/Copilot/Core/Type/Array.hs +++ b/copilot-core/src/Copilot/Core/Type/Array.hs @@ -13,7 +13,6 @@ -- Implementation of an array that uses type literals to store length. No -- explicit indexing is used for the input data. Supports arbitrary nesting of -- arrays. - module Copilot.Core.Type.Array ( Array , array From 8235d8317636dbf650423088f83a3e1ccd204f61 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 3 Nov 2022 12:53:08 -0700 Subject: [PATCH 0538/1222] copilot-core: Break lines at 80 characters in Copilot.Core.Expr. Refs #332. This commit adds line breaks in the signatures of data constructors in the module Copilot.Core.Expr. For consistency and readability, we do it also for constructors of the same type for which the complete signature would fit in 80 characters, since they all have a recurrent pattern. --- copilot-core/src/Copilot/Core/Expr.hs | 35 ++++++++++++++++++++------- 1 file changed, 26 insertions(+), 9 deletions(-) diff --git a/copilot-core/src/Copilot/Core/Expr.hs b/copilot-core/src/Copilot/Core/Expr.hs index b34113ab9..618b18fab 100644 --- a/copilot-core/src/Copilot/Core/Expr.hs +++ b/copilot-core/src/Copilot/Core/Expr.hs @@ -37,15 +37,32 @@ type DropIdx = Word32 -- representation contains information about the types of elements in the -- stream. data Expr a where - Const :: Typeable a => Type a -> a -> Expr a - Drop :: Typeable a => Type a -> DropIdx -> Id -> Expr a - Local :: Typeable a => Type a -> Type b -> Name -> Expr a -> Expr b -> Expr b - Var :: Typeable a => Type a -> Name -> Expr a - ExternVar :: Typeable a => Type a -> Name -> Maybe [a] -> Expr a - Op1 :: Typeable a => Op1 a b -> Expr a -> Expr b - Op2 :: (Typeable a, Typeable b) => Op2 a b c -> Expr a -> Expr b -> Expr c - Op3 :: (Typeable a, Typeable b, Typeable c) => Op3 a b c d -> Expr a -> Expr b -> Expr c -> Expr d - Label :: Typeable a => Type a -> String -> Expr a -> Expr a + Const :: Typeable a + => Type a -> a -> Expr a + + Drop :: Typeable a + => Type a -> DropIdx -> Id -> Expr a + + Local :: Typeable a + => Type a -> Type b -> Name -> Expr a -> Expr b -> Expr b + + Var :: Typeable a + => Type a -> Name -> Expr a + + ExternVar :: Typeable a + => Type a -> Name -> Maybe [a] -> Expr a + + Op1 :: Typeable a + => Op1 a b -> Expr a -> Expr b + + Op2 :: (Typeable a, Typeable b) + => Op2 a b c -> Expr a -> Expr b -> Expr c + + Op3 :: (Typeable a, Typeable b, Typeable c) + => Op3 a b c d -> Expr a -> Expr b -> Expr c -> Expr d + + Label :: Typeable a + => Type a -> String -> Expr a -> Expr a -- | A untyped expression that carries the information about the type of the -- expression as a value, as opposed to exposing it at type level (using an From 32d9f6401ac6bdcdd02cb5192c59d1f1e60301d4 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 3 Nov 2022 12:54:47 -0700 Subject: [PATCH 0539/1222] copilot-core: Break lines at 80 characters in Copilot.Core.Type. Refs #332. This commit breaks long lines in the module Copilot.Core.Type to fit in under 80 characters, as per our style guide. --- copilot-core/src/Copilot/Core/Type.hs | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/copilot-core/src/Copilot/Core/Type.hs b/copilot-core/src/Copilot/Core/Type.hs index 749ae57ea..fb69cea76 100644 --- a/copilot-core/src/Copilot/Core/Type.hs +++ b/copilot-core/src/Copilot/Core/Type.hs @@ -63,7 +63,8 @@ class Struct a where toValues :: a -> [Value a] -- | The field of a struct, together with a representation of its type. -data Value a = forall s t . (Typeable t, KnownSymbol s, Show t) => Value (Type t) (Field s t) +data Value a = + forall s t . (Typeable t, KnownSymbol s, Show t) => Value (Type t) (Field s t) -- | A field in a struct. The name of the field is a literal at the type -- level. @@ -75,7 +76,8 @@ fieldname _ = symbolVal (Proxy :: Proxy s) -- | Extract the name of an accessor (a function that returns a field of a -- struct). -accessorname :: forall a s t . (Struct a, KnownSymbol s) => (a -> Field s t) -> String +accessorname :: forall a s t . (Struct a, KnownSymbol s) + => (a -> Field s t) -> String accessorname _ = symbolVal (Proxy :: Proxy s) instance (KnownSymbol s, Show t) => Show (Field s t) where From ad68988fe64ede2a299f515f04c469883dd958d8 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 3 Nov 2022 13:15:49 -0700 Subject: [PATCH 0540/1222] copilot-core: Remove orphan comment. Refs #332. This commit removes a comment in the file that is phrased as a question but does not seem to be associated to any specific definition. --- copilot-core/src/Copilot/Core/Type/ShowInternal.hs | 3 --- 1 file changed, 3 deletions(-) diff --git a/copilot-core/src/Copilot/Core/Type/ShowInternal.hs b/copilot-core/src/Copilot/Core/Type/ShowInternal.hs index dc68df9cf..f170ab677 100644 --- a/copilot-core/src/Copilot/Core/Type/ShowInternal.hs +++ b/copilot-core/src/Copilot/Core/Type/ShowInternal.hs @@ -16,9 +16,6 @@ module Copilot.Core.Type.ShowInternal -- Internal imports import Copilot.Core.Type (Type (..)) --- Are we proving equivalence with a C backend, in which case we want to show --- Booleans as '0' and '1'. - -- | Target language for showing a typed value. Used to adapt the -- representation of booleans. data ShowType = C | Haskell From e08e77f0dc0ae74da5a77170f701ec2ef7f4107e Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 3 Nov 2022 13:21:39 -0700 Subject: [PATCH 0541/1222] copilot-core: Format comment in type definition in Copilot.Core.Operators. Refs #332. This commit makes a small formatting adjustment in a comment in the module Copilot.Core.Operators for consistency with other comments in the same file. --- copilot-core/src/Copilot/Core/Operators.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot-core/src/Copilot/Core/Operators.hs b/copilot-core/src/Copilot/Core/Operators.hs index e34a449cd..6e5459d39 100644 --- a/copilot-core/src/Copilot/Core/Operators.hs +++ b/copilot-core/src/Copilot/Core/Operators.hs @@ -98,5 +98,5 @@ data Op2 a b c where -- | Ternary operators. data Op3 a b c d where - -- Conditional operator: + -- Conditional operator. Mux :: Type a -> Op3 Bool a a a From 2768fc9ea50a0c800b0606421452cdf11dc147a4 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 3 Nov 2022 12:56:30 -0700 Subject: [PATCH 0542/1222] copilot-core: Document changes in CHANGELOG. Refs #332. --- copilot-core/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot-core/CHANGELOG b/copilot-core/CHANGELOG index f896b62ec..a1d7dd7c5 100644 --- a/copilot-core/CHANGELOG +++ b/copilot-core/CHANGELOG @@ -1,7 +1,8 @@ -2022-11-02 +2022-11-03 * Deprecate Copilot.Core.PrettyPrinter. (#383) * Replace uses of Copilot.Core.Type.Equality with definitions from base:Data.Type.Equality; deprecate Copilot.Core.Type.Equality. (#379) + * Compliance with style guide. (#332) 2022-09-07 * Version bump (3.11). (#376) From 975aefa428b05ca6885e89b07d2d44d2d6cfbf06 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 7 Nov 2022 23:15:03 +0000 Subject: [PATCH 0543/1222] Bump versions and constraints (3.12). Refs #389. --- copilot-c99/copilot-c99.cabal | 4 ++-- copilot-core/copilot-core.cabal | 2 +- copilot-interpreter/copilot-interpreter.cabal | 2 +- copilot-language/copilot-language.cabal | 10 +++++----- copilot-libraries/copilot-libraries.cabal | 4 ++-- copilot-prettyprinter/copilot-prettyprinter.cabal | 2 +- copilot-theorem/copilot-theorem.cabal | 6 +++--- copilot/copilot.cabal | 12 ++++++------ 8 files changed, 21 insertions(+), 21 deletions(-) diff --git a/copilot-c99/copilot-c99.cabal b/copilot-c99/copilot-c99.cabal index c03507302..50580e551 100644 --- a/copilot-c99/copilot-c99.cabal +++ b/copilot-c99/copilot-c99.cabal @@ -1,6 +1,6 @@ cabal-version : >= 1.10 name : copilot-c99 -version : 3.11 +version : 3.12 synopsis : A compiler for Copilot targeting C99. description : This package is a back-end from Copilot to C. @@ -45,7 +45,7 @@ library , mtl >= 2.2 && < 2.4 , pretty >= 1.1 && < 1.2 - , copilot-core >= 3.11 && < 3.12 + , copilot-core >= 3.12 && < 3.13 , language-c99 >= 0.2.0 && < 0.3 , language-c99-simple >= 0.2.2 && < 0.3 diff --git a/copilot-core/copilot-core.cabal b/copilot-core/copilot-core.cabal index 66e64f5ef..128264327 100644 --- a/copilot-core/copilot-core.cabal +++ b/copilot-core/copilot-core.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-core -version: 3.11 +version: 3.12 synopsis: An intermediate representation for Copilot. description: Intermediate representation for Copilot. diff --git a/copilot-interpreter/copilot-interpreter.cabal b/copilot-interpreter/copilot-interpreter.cabal index 26ddf5314..9ab66c38f 100644 --- a/copilot-interpreter/copilot-interpreter.cabal +++ b/copilot-interpreter/copilot-interpreter.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-interpreter -version: 3.11 +version: 3.12 synopsis: Interpreter for Copilot. description: Interpreter for Copilot. diff --git a/copilot-language/copilot-language.cabal b/copilot-language/copilot-language.cabal index f0196778c..c64fe2d7e 100644 --- a/copilot-language/copilot-language.cabal +++ b/copilot-language/copilot-language.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-language -version: 3.11 +version: 3.12 synopsis: A Haskell-embedded DSL for monitoring hard real-time distributed systems. description: @@ -42,10 +42,10 @@ library , data-reify >= 0.6 && < 0.7 , mtl >= 2.0 && < 3 - , copilot-core >= 3.11 && < 3.12 - , copilot-interpreter >= 3.11 && < 3.12 - , copilot-prettyprinter >= 3.11 && < 3.12 - , copilot-theorem >= 3.11 && < 3.12 + , copilot-core >= 3.12 && < 3.13 + , copilot-interpreter >= 3.12 && < 3.13 + , copilot-prettyprinter >= 3.12 && < 3.13 + , copilot-theorem >= 3.12 && < 3.13 exposed-modules: Copilot.Language , Copilot.Language.Operators.BitWise diff --git a/copilot-libraries/copilot-libraries.cabal b/copilot-libraries/copilot-libraries.cabal index 384af14b8..783fc7763 100644 --- a/copilot-libraries/copilot-libraries.cabal +++ b/copilot-libraries/copilot-libraries.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-libraries -version: 3.11 +version: 3.12 synopsis: Libraries for the Copilot language. description: Libraries for the Copilot language. @@ -41,7 +41,7 @@ library , containers >= 0.4 && < 0.7 , mtl >= 2.0 && < 2.4 , parsec >= 2.0 && < 3.2 - , copilot-language >= 3.11 && < 3.12 + , copilot-language >= 3.12 && < 3.13 exposed-modules: Copilot.Library.Libraries diff --git a/copilot-prettyprinter/copilot-prettyprinter.cabal b/copilot-prettyprinter/copilot-prettyprinter.cabal index 6e298d624..e3cd1fc2d 100644 --- a/copilot-prettyprinter/copilot-prettyprinter.cabal +++ b/copilot-prettyprinter/copilot-prettyprinter.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-prettyprinter -version: 3.11 +version: 3.12 synopsis: A prettyprinter of Copilot Specifications. description: A prettyprinter of Copilot specifications. diff --git a/copilot-theorem/copilot-theorem.cabal b/copilot-theorem/copilot-theorem.cabal index 5b6bbe87e..ded60f836 100644 --- a/copilot-theorem/copilot-theorem.cabal +++ b/copilot-theorem/copilot-theorem.cabal @@ -14,7 +14,7 @@ description: . -version : 3.11 +version : 3.12 license : BSD3 license-file : LICENSE maintainer : Ivan Perez @@ -63,8 +63,8 @@ library , xml >= 1.3 && < 1.4 , what4 >= 1.3 && < 1.4 - , copilot-core >= 3.11 && < 3.12 - , copilot-prettyprinter >= 3.11 && < 3.12 + , copilot-core >= 3.12 && < 3.13 + , copilot-prettyprinter >= 3.12 && < 3.13 exposed-modules : Copilot.Theorem , Copilot.Theorem.Prove diff --git a/copilot/copilot.cabal b/copilot/copilot.cabal index 878a99729..4be046950 100644 --- a/copilot/copilot.cabal +++ b/copilot/copilot.cabal @@ -1,5 +1,5 @@ name: copilot -version: 3.11 +version: 3.12 cabal-version: >= 1.10 license: BSD3 license-file: LICENSE @@ -52,11 +52,11 @@ library , directory >= 1.3 && < 1.4 , filepath >= 1.4 && < 1.5 - , copilot-core >= 3.11 && < 3.12 - , copilot-theorem >= 3.11 && < 3.12 - , copilot-language >= 3.11 && < 3.12 - , copilot-libraries >= 3.11 && < 3.12 - , copilot-c99 >= 3.11 && < 3.12 + , copilot-core >= 3.12 && < 3.13 + , copilot-theorem >= 3.12 && < 3.13 + , copilot-language >= 3.12 && < 3.13 + , copilot-libraries >= 3.12 && < 3.13 + , copilot-c99 >= 3.12 && < 3.13 exposed-modules: Language.Copilot, Language.Copilot.Main From a131e9a501ac508780e0ff64da5f5bde96b7ab3c Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 7 Nov 2022 23:17:03 +0000 Subject: [PATCH 0544/1222] Document changes in CHANGELOG. Refs #389. --- copilot-c99/CHANGELOG | 3 ++- copilot-core/CHANGELOG | 3 ++- copilot-interpreter/CHANGELOG | 3 ++- copilot-language/CHANGELOG | 3 ++- copilot-libraries/CHANGELOG | 3 +++ copilot-prettyprinter/CHANGELOG | 3 ++- copilot-theorem/CHANGELOG | 3 ++- copilot/CHANGELOG | 3 +++ 8 files changed, 18 insertions(+), 6 deletions(-) diff --git a/copilot-c99/CHANGELOG b/copilot-c99/CHANGELOG index 415278df3..16c4d1a36 100644 --- a/copilot-c99/CHANGELOG +++ b/copilot-c99/CHANGELOG @@ -1,4 +1,5 @@ -2022-10-31 +2022-11-07 + * Version bump (3.12). (#389) * Removed deprecated flag from cabal file. (#380) * Generate type declarations in separate header file. (#373) diff --git a/copilot-core/CHANGELOG b/copilot-core/CHANGELOG index a1d7dd7c5..de7501646 100644 --- a/copilot-core/CHANGELOG +++ b/copilot-core/CHANGELOG @@ -1,4 +1,5 @@ -2022-11-03 +2022-11-07 + * Version bump (3.12). (#389) * Deprecate Copilot.Core.PrettyPrinter. (#383) * Replace uses of Copilot.Core.Type.Equality with definitions from base:Data.Type.Equality; deprecate Copilot.Core.Type.Equality. (#379) diff --git a/copilot-interpreter/CHANGELOG b/copilot-interpreter/CHANGELOG index 36b857c54..45f73df85 100644 --- a/copilot-interpreter/CHANGELOG +++ b/copilot-interpreter/CHANGELOG @@ -1,4 +1,5 @@ -2022-10-21 +2022-11-07 + * Version bump (3.12). (#389) * Use pretty-printer from copilot-prettyprinter. (#383) 2022-09-07 diff --git a/copilot-language/CHANGELOG b/copilot-language/CHANGELOG index d0d810b06..16b831c21 100644 --- a/copilot-language/CHANGELOG +++ b/copilot-language/CHANGELOG @@ -1,4 +1,5 @@ -2022-10-21 +2022-11-07 + * Version bump (3.12). (#389) * Use pretty-printer from copilot-prettyprinter. (#383) 2022-09-07 diff --git a/copilot-libraries/CHANGELOG b/copilot-libraries/CHANGELOG index 48ff3a2cc..e5b301ab9 100644 --- a/copilot-libraries/CHANGELOG +++ b/copilot-libraries/CHANGELOG @@ -1,3 +1,6 @@ +2022-11-07 + * Version bump (3.12). (#389) + 2022-09-07 * Version bump (3.11). (#376) diff --git a/copilot-prettyprinter/CHANGELOG b/copilot-prettyprinter/CHANGELOG index 2cb7160ac..03eaa0fae 100644 --- a/copilot-prettyprinter/CHANGELOG +++ b/copilot-prettyprinter/CHANGELOG @@ -1,2 +1,3 @@ -2022-10-21 +2022-11-07 + * Version bump (3.12). (#389) * Create new library for pretty-printer. (#383) diff --git a/copilot-theorem/CHANGELOG b/copilot-theorem/CHANGELOG index d3dfa2992..c88d3e0bf 100644 --- a/copilot-theorem/CHANGELOG +++ b/copilot-theorem/CHANGELOG @@ -1,4 +1,5 @@ -2022-11-02 +2022-11-07 + * Version bump (3.12). (#389) * Add functionality for bisimulation proofs of Copilot specifications. (#363) * Use pretty-printer from copilot-prettyprinter. (#383) * Replace uses of Copilot.Core.Type.Equality with definitions from diff --git a/copilot/CHANGELOG b/copilot/CHANGELOG index 1677ec349..dd4925c02 100644 --- a/copilot/CHANGELOG +++ b/copilot/CHANGELOG @@ -1,3 +1,6 @@ +2022-11-07 + * Version bump (3.12). (#389) + 2022-09-07 * Version bump (3.11). (#376) From 87a5cb0ca452ddbd47eb9899831cd69b1b577a0b Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 27 Dec 2022 11:51:20 -0800 Subject: [PATCH 0545/1222] copilot-core: Fix bug in definition of simpleType for Int8. Refs #393. The function Copilot.Core.Type.simpleType returns SBool for the simple type representation of an Int8 :: Typed Int8. This commit fixes that instance definition to return SInt8 instead. --- copilot-core/src/Copilot/Core/Type.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot-core/src/Copilot/Core/Type.hs b/copilot-core/src/Copilot/Core/Type.hs index fb69cea76..7e4305c15 100644 --- a/copilot-core/src/Copilot/Core/Type.hs +++ b/copilot-core/src/Copilot/Core/Type.hs @@ -200,7 +200,7 @@ instance Typed Bool where instance Typed Int8 where typeOf = Int8 - simpleType _ = SBool + simpleType _ = SInt8 instance Typed Int16 where typeOf = Int16 From 2a6984d2a1415b1bed43a1b00144d69621798073 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 27 Dec 2022 11:53:10 -0800 Subject: [PATCH 0546/1222] copilot-core: Add test for simpleType. Refs #393. The function Copilot.Core.Type.simpleType previously returned SBool for the simple type representation of an Int8 :: Typed Int8, when it should instead return SInt8. This error was not not caught by the tests because that specific aspect of that function was not being tested. This commit adds a regression test for simpleType that will catch that error, as well as similar errors for simpleType. We do not consider the case of structs or arrays due to the complexity of generating random values of those types. --- copilot-core/tests/Test/Copilot/Core/Type.hs | 39 ++++++++++++++++++-- 1 file changed, 35 insertions(+), 4 deletions(-) diff --git a/copilot-core/tests/Test/Copilot/Core/Type.hs b/copilot-core/tests/Test/Copilot/Core/Type.hs index 6a3ffd57f..a568c4118 100644 --- a/copilot-core/tests/Test/Copilot/Core/Type.hs +++ b/copilot-core/tests/Test/Copilot/Core/Type.hs @@ -4,17 +4,19 @@ module Test.Copilot.Core.Type where -- External imports import Test.Framework (Test, testGroup) import Test.Framework.Providers.QuickCheck2 (testProperty) -import Test.QuickCheck (Property, elements, forAllBlind, - shuffle, (==>)) +import Test.QuickCheck (Gen, Property, elements, + forAllBlind, shuffle, (==>)) -- Internal imports: library modules being tested -import Copilot.Core.Type (SimpleType (..)) +import Copilot.Core.Type (SimpleType (..), Type(..), simpleType) -- | All unit tests for copilot-core:Copilot.Core.Type. tests :: Test.Framework.Test tests = testGroup "Copilot.Core.Type" - [ testProperty "reflexivity of equality of simple types" + [ testProperty "simpleType preserves inequality" + testSimpleTypesInequality + , testProperty "reflexivity of equality of simple types" testSimpleTypesEqualityReflexive , testProperty "symmetry of equality of simple types" testSimpleTypesEqualitySymmetric @@ -24,6 +26,35 @@ tests = testSimpleTypesEqualityUniqueness ] +-- | Test that the function simpleTypes preserves inequality, that is, it +-- returns different values for different types. This test is limited; we do +-- not test structs or arrays. +testSimpleTypesInequality :: Property +testSimpleTypesInequality = forAllBlind twoDiffTypes $ \(t1, t2) -> + t1 /= t2 + where + twoDiffTypes :: Gen (SimpleType, SimpleType) + twoDiffTypes = do + shuffled <- shuffle diffTypes + case shuffled of + (t1:t2:_) -> return (t1, t2) + _ -> return (SBool, SBool) + + -- | A list of types that should all be different. + diffTypes :: [SimpleType] + diffTypes = [ simpleType Bool + , simpleType Int8 + , simpleType Int16 + , simpleType Int32 + , simpleType Int64 + , simpleType Word8 + , simpleType Word16 + , simpleType Word32 + , simpleType Word64 + , simpleType Float + , simpleType Double + ] + -- | Test that the equality relation for simple types is reflexive. testSimpleTypesEqualityReflexive :: Property testSimpleTypesEqualityReflexive = From 206105adf482b74d452db19eb2541e2fa2f6c0d9 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 27 Dec 2022 11:54:17 -0800 Subject: [PATCH 0547/1222] copilot-core: Document changes in CHANGELOG. Refs #393. --- copilot-core/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-core/CHANGELOG b/copilot-core/CHANGELOG index de7501646..710258c98 100644 --- a/copilot-core/CHANGELOG +++ b/copilot-core/CHANGELOG @@ -1,3 +1,6 @@ +2022-12-27 + * Fix bug in definition of simpleType for Int8. (#393) + 2022-11-07 * Version bump (3.12). (#389) * Deprecate Copilot.Core.PrettyPrinter. (#383) From a79b4fc4084ed72e10ccc4b5d62a5ac665a184a8 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 27 Dec 2022 15:28:42 -0800 Subject: [PATCH 0548/1222] copilot-core: Remove test for module Copilot.Core.External. Refs #391. The module Copilot.Core.External is not being used by any other part of Copilot. It was deprecated in Copilot 3.10 and no messages have been received requesting that it be kept in the implementation. As per our internal policy of waiting 3 versions from deprecation until a public interface declaration can be removed, this module can now be removed. This commit removes all tests associated to that module, so that it can be removed safely. --- copilot-core/copilot-core.cabal | 1 - copilot-core/tests/Main.hs | 4 +- .../tests/Test/Copilot/Core/External.hs | 47 ------------------- 3 files changed, 1 insertion(+), 51 deletions(-) delete mode 100644 copilot-core/tests/Test/Copilot/Core/External.hs diff --git a/copilot-core/copilot-core.cabal b/copilot-core/copilot-core.cabal index 128264327..672c75102 100644 --- a/copilot-core/copilot-core.cabal +++ b/copilot-core/copilot-core.cabal @@ -77,7 +77,6 @@ test-suite unit-tests other-modules: Test.Extra - Test.Copilot.Core.External Test.Copilot.Core.Interpret.Eval Test.Copilot.Core.Type Test.Copilot.Core.Type.Array diff --git a/copilot-core/tests/Main.hs b/copilot-core/tests/Main.hs index 6312cdf91..f1ed09983 100644 --- a/copilot-core/tests/Main.hs +++ b/copilot-core/tests/Main.hs @@ -5,7 +5,6 @@ module Main where import Test.Framework (Test, defaultMain) -- Internal library modules being tested -import qualified Test.Copilot.Core.External import qualified Test.Copilot.Core.Interpret.Eval import qualified Test.Copilot.Core.Type import qualified Test.Copilot.Core.Type.Array @@ -18,8 +17,7 @@ main = defaultMain tests -- | All unit tests in copilot-core. tests :: [Test.Framework.Test] tests = - [ Test.Copilot.Core.External.tests - , Test.Copilot.Core.Interpret.Eval.tests + [ Test.Copilot.Core.Interpret.Eval.tests , Test.Copilot.Core.Type.tests , Test.Copilot.Core.Type.Array.tests , Test.Copilot.Core.Type.Show.tests diff --git a/copilot-core/tests/Test/Copilot/Core/External.hs b/copilot-core/tests/Test/Copilot/Core/External.hs deleted file mode 100644 index 4e9001942..000000000 --- a/copilot-core/tests/Test/Copilot/Core/External.hs +++ /dev/null @@ -1,47 +0,0 @@ --- The following warning is enabled in this module so that the import of --- Copilot.Core.External does not give rise to a warning. -{-# OPTIONS_GHC -fno-warn-deprecations #-} - --- | Test copilot-core:Copilot.Core.External. -module Test.Copilot.Core.External where - --- External imports -import Data.List (sort) -import Test.Framework (Test, testGroup) -import Test.Framework.Providers.HUnit (testCase) -import Test.HUnit (assertBool) - --- Internal imports: library modules being tested -import Copilot.Core.Expr (Expr (ExternVar, Op1)) -import Copilot.Core.External (externVarName, externVars) -import Copilot.Core.Operators (Op1 (Abs, Sign)) -import Copilot.Core.Spec (Spec (..), Stream (..)) -import Copilot.Core.Type (Type (Int64)) - --- | All unit tests for copilot-core:Copilot.Core.External. -tests :: Test.Framework.Test -tests = - testGroup "Copilot.Core.External" - [ testCase "externVars" testExternVarsFind - ] - --- * Individual tests - --- | Test that 'externVars' will find an extern in a spec. -testExternVarsFind :: IO () -testExternVarsFind = do - -- A simple stream and a nested stream - let s1 = Stream 1 [] (ExternVar Int64 "z" Nothing) Int64 - s2 = Stream 2 [] s2Expr Int64 - s2Expr = Op1 (Abs Int64) - $ Op1 (Sign Int64) - $ ExternVar Int64 "y" Nothing - - -- Calculate the expected external vars in a spec - let res = sort $ map externVarName $ externVars $ Spec [s1, s2] [] [] [] - - -- Compare result with the expectation - let success = [ "y", "z" ] == res - assertBool - "The function externVars could not find the expected externs" - success From 633d88f36f5c586963d84193319976ad0a5ff051 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 27 Dec 2022 15:30:38 -0800 Subject: [PATCH 0549/1222] copilot-core: Remove module Copilot.Core.External. Refs #391. The module Copilot.Core.External is not being used by any other part of Copilot. It was deprecated in Copilot 3.10 and no messages have been received requesting that it be kept in the implementation. As per our internal policy of waiting 3 versions from deprecation until a public interface declaration can be removed, this module can now be removed. This commit removes the module completely. A notice to allow for deprecations in Copilot.Core is also being removed, since it was added only to allow re-exporting of Copilot.Core.External without warnings. --- copilot-core/copilot-core.cabal | 1 - copilot-core/src/Copilot/Core.hs | 7 -- copilot-core/src/Copilot/Core/External.hs | 78 ----------------------- 3 files changed, 86 deletions(-) delete mode 100644 copilot-core/src/Copilot/Core/External.hs diff --git a/copilot-core/copilot-core.cabal b/copilot-core/copilot-core.cabal index 672c75102..20678fd11 100644 --- a/copilot-core/copilot-core.cabal +++ b/copilot-core/copilot-core.cabal @@ -50,7 +50,6 @@ library Copilot.Core Copilot.Core.Expr - Copilot.Core.External Copilot.Core.Interpret Copilot.Core.Interpret.Eval Copilot.Core.Operators diff --git a/copilot-core/src/Copilot/Core.hs b/copilot-core/src/Copilot/Core.hs index 1ab1b6e27..65938f238 100644 --- a/copilot-core/src/Copilot/Core.hs +++ b/copilot-core/src/Copilot/Core.hs @@ -1,10 +1,5 @@ {-# LANGUAGE Safe #-} --- The following warning is enabled in this module so that the import of --- Copilot.Core.External does not give rise to a warning. It can be removed --- when that module is removed from the implementation. -{-# OPTIONS_GHC -fno-warn-deprecations #-} - -- | -- Description: Intermediate representation for Copilot specifications. -- Copyright: (c) 2011 National Institute of Aerospace / Galois, Inc. @@ -27,7 +22,6 @@ -- ("Copilot.Core.PrettyPrint"). module Copilot.Core ( module Copilot.Core.Expr - , module Copilot.Core.External , module Copilot.Core.Operators , module Copilot.Core.Spec , module Copilot.Core.Type @@ -43,7 +37,6 @@ import Data.Word -- Internal imports import Copilot.Core.Expr -import Copilot.Core.External -- See GHC flag enabled above import Copilot.Core.Operators import Copilot.Core.Spec import Copilot.Core.Type diff --git a/copilot-core/src/Copilot/Core/External.hs b/copilot-core/src/Copilot/Core/External.hs deleted file mode 100644 index 4af789a20..000000000 --- a/copilot-core/src/Copilot/Core/External.hs +++ /dev/null @@ -1,78 +0,0 @@ --- Copyright © 2011 National Institute of Aerospace / Galois, Inc. - -{-# LANGUAGE ExistentialQuantification #-} -{-# LANGUAGE Rank2Types #-} -{-# LANGUAGE Trustworthy #-} - --- | Internal Copilot Core representation of Copilot externs. -module Copilot.Core.External - {-# DEPRECATED "This module is deprecated in Copilot 3.10." #-} - ( ExtVar (..) - , externVars - ) where - -import Copilot.Core.Expr -import Copilot.Core.Type -import Copilot.Core.Spec -import Data.DList (DList, empty, singleton, append, concat, toList) -import Data.List (nubBy) -import Prelude hiding (all, concat, foldr) - -import Data.Typeable (Typeable) - --- | An extern variable declaration, together with the type of the underlying --- extern. -data ExtVar = ExtVar - { externVarName :: Name - , externVarType :: UType } - --- | List of all externs used in a specification. -externVars :: Spec -> [ExtVar] -externVars = nubBy eqExt . toList . all externVarsExpr - where - eqExt :: ExtVar -> ExtVar -> Bool - eqExt ExtVar { externVarName = name1 } ExtVar { externVarName = name2 } = - name1 == name2 - --- | Extract all externs used in a Copilot expression. -externVarsExpr :: Expr a -> DList ExtVar -externVarsExpr e0 = case e0 of - Const _ _ -> empty - Drop _ _ _ -> empty - Local _ _ _ e1 e2 -> externVarsExpr e1 `append` externVarsExpr e2 - Var _ _ -> empty - ExternVar t name _ -> singleton (ExtVar name (UType t)) - Op1 _ e -> externVarsExpr e - Op2 _ e1 e2 -> externVarsExpr e1 `append` externVarsExpr e2 - Op3 _ e1 e2 e3 -> externVarsExpr e1 `append` - externVarsExpr e2 `append` - externVarsExpr e3 - Label _ _ e -> externVarsExpr e - --- | Extract all expressions used in an untyped Copilot expression. -externVarsUExpr :: UExpr -> DList ExtVar -externVarsUExpr UExpr { uExprExpr = e } = externVarsExpr e - --- | Apply a function to all expressions in a specification, concatenating the --- results. -all :: (forall a . Expr a -> DList b) -> Spec -> DList b -all f spec = - concat (fmap (allStream) (specStreams spec)) `append` - concat (fmap allTrigger (specTriggers spec)) `append` - concat (fmap allObserver (specObservers spec)) - - where - - allStream - Stream { streamExpr = e } = f e - - allTrigger - Trigger - { triggerGuard = e - , triggerArgs = args } = f e `append` concat (fmap allUExpr args) - - allUExpr - (UExpr _ e1) = f e1 - - allObserver - Observer { observerExpr = e } = f e From def87ddcef39bf3514ff7371412eee5c2b0da8e9 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 27 Dec 2022 16:14:58 -0800 Subject: [PATCH 0550/1222] copilot-core: Remove dependency from cabal file. Refs #391. The module Copilot.Core.External is not being used by any other part of Copilot. It was deprecated in Copilot 3.10 and no messages have been received requesting that it be kept in the implementation. As per our internal policy of waiting 3 versions from deprecation until a public interface declaration can be removed, this module can now be removed. This commit removes the dependency on the package dlist, which was only used by the now-removed Copilot.Core.External. --- copilot-core/copilot-core.cabal | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/copilot-core/copilot-core.cabal b/copilot-core/copilot-core.cabal index 20678fd11..3dfc08092 100644 --- a/copilot-core/copilot-core.cabal +++ b/copilot-core/copilot-core.cabal @@ -43,8 +43,7 @@ library build-depends: base >= 4.9 && < 5, - pretty >= 1.0 && < 1.2, - dlist + pretty >= 1.0 && < 1.2 exposed-modules: From 57fc5ec6aebb4244a1fb09dd58cc368db1c2dc33 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 27 Dec 2022 15:32:14 -0800 Subject: [PATCH 0551/1222] copilot-core: Document changes in CHANGELOG. Refs #391. --- copilot-core/CHANGELOG | 1 + 1 file changed, 1 insertion(+) diff --git a/copilot-core/CHANGELOG b/copilot-core/CHANGELOG index 710258c98..10ca8e048 100644 --- a/copilot-core/CHANGELOG +++ b/copilot-core/CHANGELOG @@ -1,4 +1,5 @@ 2022-12-27 + * Remove Copilot.Core.External. (#391) * Fix bug in definition of simpleType for Int8. (#393) 2022-11-07 From 39d52cc6fc42d5ec0471e5e8ead0c765dab7ad9e Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 27 Dec 2022 17:42:26 -0800 Subject: [PATCH 0552/1222] copilot-core: Remove tests involving Copilot.Core.Type.Show. Refs #392. The module Copilot.Core.Type.Show is not being used outside of copilot-core. It was deprecated in Copilot 3.10 and no messages have been received requesting that it be kept in the implementation. As per our internal policy of waiting 3 versions from deprecation until a public interface declaration can be removed, this module can now be completely hidden from the public interface. This commit removes all tests associated to or using that module, so that it can be removed safely. Tests related to the interpreter are removed as well, since they are also present in the copilot-interpreter package. --- copilot-core/copilot-core.cabal | 2 - copilot-core/tests/Main.hs | 6 +- .../tests/Test/Copilot/Core/Interpret/Eval.hs | 789 ------------------ .../tests/Test/Copilot/Core/Type/Show.hs | 38 - 4 files changed, 1 insertion(+), 834 deletions(-) delete mode 100644 copilot-core/tests/Test/Copilot/Core/Interpret/Eval.hs delete mode 100644 copilot-core/tests/Test/Copilot/Core/Type/Show.hs diff --git a/copilot-core/copilot-core.cabal b/copilot-core/copilot-core.cabal index 3dfc08092..6d30f748e 100644 --- a/copilot-core/copilot-core.cabal +++ b/copilot-core/copilot-core.cabal @@ -75,10 +75,8 @@ test-suite unit-tests other-modules: Test.Extra - Test.Copilot.Core.Interpret.Eval Test.Copilot.Core.Type Test.Copilot.Core.Type.Array - Test.Copilot.Core.Type.Show build-depends: base diff --git a/copilot-core/tests/Main.hs b/copilot-core/tests/Main.hs index f1ed09983..621700fd9 100644 --- a/copilot-core/tests/Main.hs +++ b/copilot-core/tests/Main.hs @@ -5,10 +5,8 @@ module Main where import Test.Framework (Test, defaultMain) -- Internal library modules being tested -import qualified Test.Copilot.Core.Interpret.Eval import qualified Test.Copilot.Core.Type import qualified Test.Copilot.Core.Type.Array -import qualified Test.Copilot.Core.Type.Show -- | Run all unit tests on copilot-core. main :: IO () @@ -17,8 +15,6 @@ main = defaultMain tests -- | All unit tests in copilot-core. tests :: [Test.Framework.Test] tests = - [ Test.Copilot.Core.Interpret.Eval.tests - , Test.Copilot.Core.Type.tests + [ Test.Copilot.Core.Type.tests , Test.Copilot.Core.Type.Array.tests - , Test.Copilot.Core.Type.Show.tests ] diff --git a/copilot-core/tests/Test/Copilot/Core/Interpret/Eval.hs b/copilot-core/tests/Test/Copilot/Core/Interpret/Eval.hs deleted file mode 100644 index 9d6f250bd..000000000 --- a/copilot-core/tests/Test/Copilot/Core/Interpret/Eval.hs +++ /dev/null @@ -1,789 +0,0 @@ -{-# LANGUAGE ExistentialQuantification #-} --- The following warning is disabled in this module so that the import of --- Copilot.Core.Type.Show does not give rise to a warning. -{-# OPTIONS_GHC -fno-warn-deprecations #-} - --- | Test copilot-core:Copilot.Core.Interpret.Eval. --- --- The gist of this evaluation is in 'SemanticsP' and 'checkSemanticsP' which --- evaluates an expression using Copilot's evaluator and compares it against --- its expected meaning. -module Test.Copilot.Core.Interpret.Eval where - --- External imports -import Data.Bits (Bits, complement, shiftL, shiftR, - xor, (.&.), (.|.)) -import Data.Int (Int16, Int32, Int64, Int8) -import Data.List (lookup) -import Data.Maybe (fromMaybe) -import Data.Typeable (Typeable) -import Data.Word (Word16, Word32, Word64, Word8) -import Test.Framework (Test, testGroup) -import Test.Framework.Providers.QuickCheck2 (testProperty) -import Test.QuickCheck (Arbitrary, Gen, Property, - arbitrary, chooseInt, elements, - forAll, forAllShow, frequency, - getPositive, oneof, suchThat, - vectorOf) -import Text.PrettyPrint.HughesPJ (render) - --- Internal imports: library modules being tested -import Copilot.Core.Expr (Expr (Const, Drop, Op1, Op2, Op3), - UExpr (UExpr)) -import Copilot.Core.Interpret.Eval (ExecTrace (interpObservers), eval) -import Copilot.Core.Operators (Op1 (..), Op2 (..), Op3 (..)) -import Copilot.Core.PrettyPrint (ppExpr) -import Copilot.Core.Spec (Observer (..), Spec (..), Stream (Stream)) -import Copilot.Core.Type (Typed (typeOf)) -import Copilot.Core.Type.Show (ShowType (Haskell), showType) - --- Internal imports: auxiliary functions -import Test.Extra (apply1, apply2, apply3) - --- * Constants - --- | Max length of the traces being tested. -maxTraceLength :: Int -maxTraceLength = 200 - --- | All unit tests for copilot-core:Copilot.Core.Interpret.Eval. -tests :: Test.Framework.Test -tests = - testGroup "Copilot.Core.Interpret.Eval" - [ testProperty "eval Expr" testEvalExpr - , testProperty "eval Expr with Drop" testEvalExprWithDrop - ] - --- * Individual tests - --- | Test for expression evaluation. -testEvalExpr :: Property -testEvalExpr = - forAll (chooseInt (0, maxTraceLength)) $ \steps -> - forAllShow arbitrarySemanticsP (semanticsShowK steps) $ \pair -> - checkSemanticsP steps [] pair - --- | Test for expression evaluation with a drop. -testEvalExprWithDrop :: Property -testEvalExprWithDrop = - forAll (chooseInt (0, maxTraceLength)) $ \steps -> - forAllShow arbitrarySemanticsP (semanticsShowK steps) $ \pair -> - forAllShow (arbitraryDrop pair) (semanticsShowK steps . snd) $ \(str, sem) -> - checkSemanticsP steps [str] sem - --- * Random generators - --- ** Random SemanticsP generators - --- | An arbitrary expression, paired with its expected meaning. --- --- See the function 'checkSemanticsP' to evaluate the pair. -arbitrarySemanticsP :: Gen SemanticsP -arbitrarySemanticsP = oneof - [ SemanticsP <$> (arbitraryBoolExpr :: Gen (Semantics Bool)) - , SemanticsP <$> (arbitraryNumExpr :: Gen (Semantics Int8)) - , SemanticsP <$> (arbitraryNumExpr :: Gen (Semantics Int16)) - , SemanticsP <$> (arbitraryNumExpr :: Gen (Semantics Int32)) - , SemanticsP <$> (arbitraryNumExpr :: Gen (Semantics Int64)) - , SemanticsP <$> (arbitraryNumExpr :: Gen (Semantics Word8)) - , SemanticsP <$> (arbitraryNumExpr :: Gen (Semantics Word16)) - , SemanticsP <$> (arbitraryNumExpr :: Gen (Semantics Word32)) - , SemanticsP <$> (arbitraryNumExpr :: Gen (Semantics Word64)) - , SemanticsP <$> (arbitraryFloatingExpr :: Gen (Semantics Float)) - , SemanticsP <$> (arbitraryFloatingExpr :: Gen (Semantics Double)) - , SemanticsP <$> (arbitraryRealFracExpr :: Gen (Semantics Float)) - , SemanticsP <$> (arbitraryRealFracExpr :: Gen (Semantics Double)) - , SemanticsP <$> (arbitraryRealFloatExpr :: Gen (Semantics Float)) - , SemanticsP <$> (arbitraryRealFloatExpr :: Gen (Semantics Double)) - , SemanticsP <$> (arbitraryFractionalExpr :: Gen (Semantics Float)) - , SemanticsP <$> (arbitraryFractionalExpr :: Gen (Semantics Double)) - , SemanticsP <$> (arbitraryIntegralExpr :: Gen (Semantics Int8)) - , SemanticsP <$> (arbitraryIntegralExpr :: Gen (Semantics Int16)) - , SemanticsP <$> (arbitraryIntegralExpr :: Gen (Semantics Int32)) - , SemanticsP <$> (arbitraryIntegralExpr :: Gen (Semantics Int64)) - , SemanticsP <$> (arbitraryIntegralExpr :: Gen (Semantics Word8)) - , SemanticsP <$> (arbitraryIntegralExpr :: Gen (Semantics Word16)) - , SemanticsP <$> (arbitraryIntegralExpr :: Gen (Semantics Word32)) - , SemanticsP <$> (arbitraryIntegralExpr :: Gen (Semantics Word64)) - , SemanticsP <$> (arbitraryBitsExpr :: Gen (Semantics Bool)) - , SemanticsP <$> (arbitraryBitsExpr :: Gen (Semantics Int8)) - , SemanticsP <$> (arbitraryBitsExpr :: Gen (Semantics Int16)) - , SemanticsP <$> (arbitraryBitsExpr :: Gen (Semantics Int32)) - , SemanticsP <$> (arbitraryBitsExpr :: Gen (Semantics Int64)) - , SemanticsP <$> (arbitraryBitsExpr :: Gen (Semantics Word8)) - , SemanticsP <$> (arbitraryBitsExpr :: Gen (Semantics Word16)) - , SemanticsP <$> (arbitraryBitsExpr :: Gen (Semantics Word32)) - , SemanticsP <$> (arbitraryBitsExpr :: Gen (Semantics Word64)) - , SemanticsP <$> (arbitraryBitsIntegralExpr :: Gen (Semantics Int8)) - , SemanticsP <$> (arbitraryBitsIntegralExpr :: Gen (Semantics Int16)) - , SemanticsP <$> (arbitraryBitsIntegralExpr :: Gen (Semantics Int32)) - , SemanticsP <$> (arbitraryBitsIntegralExpr :: Gen (Semantics Int64)) - , SemanticsP <$> (arbitraryBitsIntegralExpr :: Gen (Semantics Word8)) - , SemanticsP <$> (arbitraryBitsIntegralExpr :: Gen (Semantics Word16)) - , SemanticsP <$> (arbitraryBitsIntegralExpr :: Gen (Semantics Word32)) - , SemanticsP <$> (arbitraryBitsIntegralExpr :: Gen (Semantics Word64)) - ] - --- | Generate an arbitrary drop by taking an expression, adding a number of --- elements to it, and then dropping some. -arbitraryDrop :: SemanticsP -> Gen (Stream, SemanticsP) -arbitraryDrop (SemanticsP (expr, meaning)) = do - -- Randomly generate a list of elements - prependLength <- getPositive <$> arbitrary - buffer <- vectorOf prependLength arbitrary - - -- Build the stream with the buffer - let streamId = 0 - stream = Stream streamId buffer expr typeOf - - -- Select how many elements to drop from the stream (up to the length of the - -- buffer) - dropLength <- chooseInt (0, prependLength) - - -- Build a drop expression that drops those many elements, paired with its - -- meaning. - let expr' = Drop typeOf (fromIntegral dropLength) streamId - meaning' = drop dropLength buffer ++ meaning - - return (stream, SemanticsP (expr', meaning')) - --- ** Random Expr generators - --- | An arbitrary constant expression of any type, paired with its expected --- meaning. -arbitraryConst :: (Arbitrary t, Typed t) - => Gen (Expr t, [t]) -arbitraryConst = (\v -> (Const typeOf v, repeat v)) <$> arbitrary - --- | An arbitrary boolean expression, paired with its expected meaning. -arbitraryBoolExpr :: Gen (Expr Bool, [Bool]) -arbitraryBoolExpr = - -- We use frequency instead of oneof because the random expression generator - -- seems to generate expressions that are too large and the test fails due - -- to running out of memory. - frequency - [ (10, arbitraryConst) - - , (5, apply1 <$> arbitraryBoolOp1 <*> arbitraryBoolExpr) - - , (1, apply2 <$> arbitraryBoolOp2 - <*> arbitraryBoolExpr - <*> arbitraryBoolExpr) - - , (1, apply2 <$> arbitraryEqOp2 - <*> arbitraryBoolExpr - <*> arbitraryBoolExpr) - - , (1, apply2 <$> arbitraryEqOp2 - <*> arbitraryBitsExpr - <*> (arbitraryBitsExpr :: Gen (Expr Int8, [Int8]))) - - , (1, apply2 <$> arbitraryEqOp2 - <*> arbitraryBitsExpr - <*> (arbitraryBitsExpr :: Gen (Expr Int16, [Int16]))) - - , (1, apply2 <$> arbitraryEqOp2 - <*> arbitraryBitsExpr - <*> (arbitraryBitsExpr :: Gen (Expr Int32, [Int32]))) - - , (1, apply2 <$> arbitraryEqOp2 - <*> arbitraryBitsExpr - <*> (arbitraryBitsExpr :: Gen (Expr Int64, [Int64]))) - - , (1, apply2 <$> arbitraryEqOp2 - <*> arbitraryBitsExpr - <*> (arbitraryBitsExpr :: Gen (Expr Word8, [Word8]))) - - , (1, apply2 <$> arbitraryEqOp2 - <*> arbitraryBitsExpr - <*> (arbitraryBitsExpr :: Gen (Expr Word16, [Word16]))) - - , (1, apply2 <$> arbitraryEqOp2 - <*> arbitraryBitsExpr - <*> (arbitraryBitsExpr :: Gen (Expr Word32, [Word32]))) - - , (1, apply2 <$> arbitraryEqOp2 - <*> arbitraryBitsExpr - <*> (arbitraryBitsExpr :: Gen (Expr Word64, [Word64]))) - - , (1, apply2 <$> arbitraryEqOp2 - <*> arbitraryNumExpr - <*> (arbitraryNumExpr :: Gen (Expr Int8, [Int8]))) - - , (1, apply2 <$> arbitraryEqOp2 - <*> arbitraryNumExpr - <*> (arbitraryNumExpr :: Gen (Expr Int16, [Int16]))) - - , (1, apply2 <$> arbitraryEqOp2 - <*> arbitraryNumExpr - <*> (arbitraryNumExpr :: Gen (Expr Int32, [Int32]))) - - , (1, apply2 <$> arbitraryEqOp2 - <*> arbitraryNumExpr - <*> (arbitraryNumExpr :: Gen (Expr Int64, [Int64]))) - - , (1, apply2 <$> arbitraryEqOp2 - <*> arbitraryNumExpr - <*> (arbitraryNumExpr :: Gen (Expr Word8, [Word8]))) - - , (1, apply2 <$> arbitraryEqOp2 - <*> arbitraryNumExpr - <*> (arbitraryNumExpr :: Gen (Expr Word16, [Word16]))) - - , (1, apply2 <$> arbitraryEqOp2 - <*> arbitraryNumExpr - <*> (arbitraryNumExpr :: Gen (Expr Word32, [Word32]))) - - , (1, apply2 <$> arbitraryEqOp2 - <*> arbitraryNumExpr - <*> (arbitraryNumExpr :: Gen (Expr Word64, [Word64]))) - - , (1, apply2 <$> arbitraryOrdOp2 - <*> arbitraryNumExpr - <*> (arbitraryNumExpr :: Gen (Expr Int8, [Int8]))) - - , (1, apply2 <$> arbitraryOrdOp2 - <*> arbitraryNumExpr - <*> (arbitraryNumExpr :: Gen (Expr Int16, [Int16]))) - - , (1, apply2 <$> arbitraryOrdOp2 - <*> arbitraryNumExpr - <*> (arbitraryNumExpr :: Gen (Expr Int32, [Int32]))) - - , (1, apply2 <$> arbitraryOrdOp2 - <*> arbitraryNumExpr - <*> (arbitraryNumExpr :: Gen (Expr Int64, [Int64]))) - - , (1, apply2 <$> arbitraryOrdOp2 - <*> arbitraryNumExpr - <*> (arbitraryNumExpr :: Gen (Expr Word8, [Word8]))) - - , (1, apply2 <$> arbitraryOrdOp2 - <*> arbitraryNumExpr - <*> (arbitraryNumExpr :: Gen (Expr Word16, [Word16]))) - - , (1, apply2 <$> arbitraryOrdOp2 - <*> arbitraryNumExpr - <*> (arbitraryNumExpr :: Gen (Expr Word32, [Word32]))) - - , (1, apply2 <$> arbitraryOrdOp2 - <*> arbitraryNumExpr - <*> (arbitraryNumExpr :: Gen (Expr Word64, [Word64]))) - - , (1, apply2 <$> arbitraryOrdOp2 - <*> arbitraryFloatingExpr - <*> (arbitraryFloatingExpr :: Gen (Expr Float, [Float]))) - - , (1, apply2 <$> arbitraryOrdOp2 - <*> arbitraryFloatingExpr - <*> (arbitraryFloatingExpr :: Gen (Expr Double, [Double]))) - - , (1, apply3 <$> arbitraryITEOp3 - <*> arbitraryBoolExpr - <*> arbitraryBoolExpr - <*> arbitraryBoolExpr) - ] - --- | An arbitrary numeric expression, paired with its expected meaning. -arbitraryNumExpr :: (Arbitrary t, Typed t, Num t) - => Gen (Expr t, [t]) -arbitraryNumExpr = - -- We use frequency instead of oneof because the random expression generator - -- seems to generate expressions that are too large and the test fails due - -- to running out of memory. - frequency - [ (10, arbitraryConst) - - , (5, apply1 <$> arbitraryNumOp1 <*> arbitraryNumExpr) - - , (2, apply2 <$> arbitraryNumOp2 <*> arbitraryNumExpr <*> arbitraryNumExpr) - - , (2, apply3 <$> arbitraryITEOp3 - <*> arbitraryBoolExpr - <*> arbitraryNumExpr - <*> arbitraryNumExpr) - ] - --- | An arbitrary floating point expression, paired with its expected meaning. -arbitraryFloatingExpr :: (Arbitrary t, Typed t, Floating t) - => Gen (Expr t, [t]) -arbitraryFloatingExpr = - -- We use frequency instead of oneof because the random expression generator - -- seems to generate expressions that are too large and the test fails due - -- to running out of memory. - frequency - [ (10, arbitraryConst) - - , (5, apply1 <$> arbitraryFloatingOp1 <*> arbitraryFloatingExpr) - - , (5, apply1 <$> arbitraryNumOp1 <*> arbitraryFloatingExpr) - - , (2, apply2 <$> arbitraryFloatingOp2 - <*> arbitraryFloatingExpr - <*> arbitraryFloatingExpr) - - , (2, apply2 <$> arbitraryNumOp2 - <*> arbitraryFloatingExpr - <*> arbitraryFloatingExpr) - - , (1, apply3 <$> arbitraryITEOp3 - <*> arbitraryBoolExpr - <*> arbitraryFloatingExpr - <*> arbitraryFloatingExpr) - ] - --- | An arbitrary realfrac expression, paired with its expected meaning. -arbitraryRealFracExpr :: (Arbitrary t, Typed t, RealFrac t) - => Gen (Expr t, [t]) -arbitraryRealFracExpr = - -- We use frequency instead of oneof because the random expression generator - -- seems to generate expressions that are too large and the test fails due - -- to running out of memory. - frequency - [ (10, arbitraryConst) - - , (2, apply1 <$> arbitraryRealFracOp1 <*> arbitraryRealFracExpr) - - , (5, apply1 <$> arbitraryNumOp1 <*> arbitraryRealFracExpr) - - , (1, apply2 <$> arbitraryNumOp2 - <*> arbitraryRealFracExpr - <*> arbitraryRealFracExpr) - - , (1, apply3 <$> arbitraryITEOp3 - <*> arbitraryBoolExpr - <*> arbitraryRealFracExpr - <*> arbitraryRealFracExpr) - ] - --- | An arbitrary realfloat expression, paired with its expected meaning. -arbitraryRealFloatExpr :: (Arbitrary t, Typed t, RealFloat t) - => Gen (Expr t, [t]) -arbitraryRealFloatExpr = - -- We use frequency instead of oneof because the random expression generator - -- seems to generate expressions that are too large and the test fails due - -- to running out of memory. - frequency - [ (10, arbitraryConst) - - , (2, apply1 <$> arbitraryNumOp1 <*> arbitraryRealFloatExpr) - - , (5, apply2 <$> arbitraryRealFloatOp2 - <*> arbitraryRealFloatExpr - <*> arbitraryRealFloatExpr) - - , (1, apply2 <$> arbitraryNumOp2 - <*> arbitraryRealFloatExpr - <*> arbitraryRealFloatExpr) - - , (1, apply3 <$> arbitraryITEOp3 - <*> arbitraryBoolExpr - <*> arbitraryRealFloatExpr - <*> arbitraryRealFloatExpr) - ] - --- | An arbitrary fractional expression, paired with its expected meaning. --- --- We add the constraint Eq because we sometimes need to make sure numbers are --- not zero. -arbitraryFractionalExpr :: (Arbitrary t, Typed t, Fractional t, Eq t) - => Gen (Expr t, [t]) -arbitraryFractionalExpr = - -- We use frequency instead of oneof because the random expression generator - -- seems to generate expressions that are too large and the test fails due - -- to running out of memory. - frequency - [ (10, arbitraryConst) - - , (5, apply1 <$> arbitraryFractionalOp1 <*> arbitraryFractionalExpr) - - , (5, apply1 <$> arbitraryNumOp1 <*> arbitraryFractionalExpr) - - , (2, apply2 <$> arbitraryFractionalOp2 - <*> arbitraryFractionalExpr - <*> arbitraryFractionalExprNonZero) - - , (1, apply3 <$> arbitraryITEOp3 - <*> arbitraryBoolExpr - <*> arbitraryFractionalExpr - <*> arbitraryFractionalExpr) - ] - where - - -- Generator for fractional expressions that are never zero. - -- - -- The list is infinite, so this generator checks up to maxTraceLength - -- elements. - arbitraryFractionalExprNonZero = arbitraryFractionalExpr - `suchThat` (notElem 0 . take maxTraceLength . snd) - --- | An arbitrary integral expression, paired with its expected meaning. --- --- We add the constraint Eq because we sometimes need to make sure numbers are --- not zero. -arbitraryIntegralExpr :: (Arbitrary t, Typed t, Integral t, Eq t) - => Gen (Expr t, [t]) -arbitraryIntegralExpr = - -- We use frequency instead of oneof because the random expression generator - -- seems to generate expressions that are too large and the test fails due - -- to running out of memory. - frequency - [ (10, arbitraryConst) - - , (5, apply1 <$> arbitraryNumOp1 <*> arbitraryIntegralExpr) - - , (2, apply2 <$> arbitraryNumOp2 - <*> arbitraryIntegralExpr - <*> arbitraryIntegralExpr) - - , (2, apply2 <$> arbitraryIntegralOp2 - <*> arbitraryIntegralExpr - <*> arbitraryIntegralExprNonZero) - - , (1, apply3 <$> arbitraryITEOp3 - <*> arbitraryBoolExpr - <*> arbitraryIntegralExpr - <*> arbitraryIntegralExpr) - ] - where - - -- Generator for integral expressions that are never zero. - -- - -- The list is infinite, so this generator checks up to maxTraceLength - -- elements. - arbitraryIntegralExprNonZero = arbitraryIntegralExpr - `suchThat` (notElem 0 . take maxTraceLength . snd) - --- | An arbitrary Bits expression, paired with its expected meaning. -arbitraryBitsExpr :: (Arbitrary t, Typed t, Bits t) - => Gen (Expr t, [t]) -arbitraryBitsExpr = - -- We use frequency instead of oneof because the random expression generator - -- seems to generate expressions that are too large and the test fails due - -- to running out of memory. - frequency - [ (10, arbitraryConst) - - , (5, apply1 <$> arbitraryBitsOp1 <*> arbitraryBitsExpr) - - , (2, apply2 <$> arbitraryBitsOp2 - <*> arbitraryBitsExpr - <*> arbitraryBitsExpr) - - , (2, apply3 <$> arbitraryITEOp3 - <*> arbitraryBoolExpr - <*> arbitraryBitsExpr <*> arbitraryBitsExpr) - ] - --- | An arbitrary expression for types that are instances of Bits and Integral, --- paired with its expected meaning. -arbitraryBitsIntegralExpr :: (Arbitrary t, Typed t, Bits t, Integral t) - => Gen (Expr t, [t]) -arbitraryBitsIntegralExpr = - -- We use frequency instead of oneof because the random expression - -- generator seems to generate expressions that are too large and the - -- test fails due to running out of memory. - frequency - [ (10, arbitraryConst) - - , (2, apply1 <$> arbitraryNumOp1 <*> arbitraryBitsIntegralExpr) - - , (1, apply2 <$> arbitraryNumOp2 - <*> arbitraryBitsIntegralExpr - <*> arbitraryBitsIntegralExpr) - - , (5, apply2 <$> arbitraryBitsIntegralOp2 - <*> arbitraryBitsIntegralExpr - <*> arbitraryBitsIntegralExprConstPos) - - , (1, apply3 <$> arbitraryITEOp3 - <*> arbitraryBoolExpr - <*> arbitraryBitsIntegralExpr - <*> arbitraryBitsIntegralExpr) - ] - where - - -- Generator for constant bit integral expressions that, when converted to - -- type 't', result in a positive number. We use a constant generator, as - -- opposed to a generator based on the more comprehensive - -- arbitraryBitsIntegralExpr, because the latter runs out of memory easily - -- when nested and filtered with suchThat. - arbitraryBitsIntegralExprConstPos = - (\v -> (Const typeOf v, repeat v)) <$> intThatFits - where - -- In this context: - -- - -- intThatFits :: Gen t - intThatFits = - suchThat arbitrary ((> 0) . (\x -> (fromIntegral x) :: Int)) - --- ** Operators - --- *** Op 1 - --- | Generator for arbitrary boolean operators with arity 1, paired with their --- expected meaning. -arbitraryBoolOp1 :: Gen (Expr Bool -> Expr Bool, [Bool] -> [Bool]) -arbitraryBoolOp1 = elements - [ (Op1 Not, fmap not) - ] - --- | Generator for arbitrary numeric operators with arity 1, paired with their --- expected meaning. -arbitraryNumOp1 :: (Typed t, Num t) - => Gen (Expr t -> Expr t, [t] -> [t]) -arbitraryNumOp1 = elements - [ (Op1 (Abs typeOf), fmap abs) - , (Op1 (Sign typeOf), fmap signum) - ] - --- | Generator for arbitrary floating point operators with arity 1, paired with --- their expected meaning. -arbitraryFloatingOp1 :: (Typed t, Floating t) - => Gen (Expr t -> Expr t, [t] -> [t]) -arbitraryFloatingOp1 = elements - [ (Op1 (Exp typeOf), fmap exp) - , (Op1 (Sqrt typeOf), fmap sqrt) - , (Op1 (Log typeOf), fmap log) - , (Op1 (Sin typeOf), fmap sin) - , (Op1 (Tan typeOf), fmap tan) - , (Op1 (Cos typeOf), fmap cos) - , (Op1 (Asin typeOf), fmap asin) - , (Op1 (Atan typeOf), fmap atan) - , (Op1 (Acos typeOf), fmap acos) - , (Op1 (Sinh typeOf), fmap sinh) - , (Op1 (Tanh typeOf), fmap tanh) - , (Op1 (Cosh typeOf), fmap cosh) - , (Op1 (Asinh typeOf), fmap asinh) - , (Op1 (Atanh typeOf), fmap atanh) - , (Op1 (Acosh typeOf), fmap acosh) - ] - --- | Generator for arbitrary realfrac operators with arity 1, paired with their --- expected meaning. -arbitraryRealFracOp1 :: (Typed t, RealFrac t) - => Gen (Expr t -> Expr t, [t] -> [t]) -arbitraryRealFracOp1 = elements - [ (Op1 (Ceiling typeOf), fmap (fromIntegral . idI . ceiling)) - , (Op1 (Floor typeOf), fmap (fromIntegral . idI . floor)) - ] - where - -- Auxiliary function to help the compiler determine which integral type - -- the result of ceiling must be converted to. An Integer ensures that the - -- result fits and there is no loss of precision due to the intermediate - -- casting. - idI :: Integer -> Integer - idI = id - --- | Generator for arbitrary fractional operators with arity 1, paired with --- their expected meaning. -arbitraryFractionalOp1 :: (Typed t, Fractional t) - => Gen (Expr t -> Expr t, [t] -> [t]) -arbitraryFractionalOp1 = elements - [ (Op1 (Recip typeOf), fmap recip) - ] - --- | Generator for arbitrary bitwise operators with arity 1, paired with their --- expected meaning. -arbitraryBitsOp1 :: (Typed t, Bits t) - => Gen (Expr t -> Expr t, [t] -> [t]) -arbitraryBitsOp1 = elements - [ (Op1 (BwNot typeOf), fmap complement) - ] - --- *** Op 2 - --- | Generator for arbitrary boolean operators with arity 2, paired with their --- expected meaning. -arbitraryBoolOp2 :: Gen ( Expr Bool -> Expr Bool -> Expr Bool - , [Bool] -> [Bool] -> [Bool] - ) -arbitraryBoolOp2 = elements - [ (Op2 And, zipWith (&&)) - , (Op2 Or, zipWith (||)) - ] - --- | Generator for arbitrary numeric operators with arity 2, paired with their --- expected meaning. -arbitraryNumOp2 :: (Typed t, Num t) - => Gen (Expr t -> Expr t -> Expr t, [t] -> [t] -> [t]) -arbitraryNumOp2 = elements - [ (Op2 (Add typeOf), zipWith (+)) - , (Op2 (Sub typeOf), zipWith (-)) - , (Op2 (Mul typeOf), zipWith (*)) - ] - --- | Generator for arbitrary integral operators with arity 2, paired with their --- expected meaning. -arbitraryIntegralOp2 :: (Typed t, Integral t) - => Gen (Expr t -> Expr t -> Expr t, [t] -> [t] -> [t]) -arbitraryIntegralOp2 = elements - [ (Op2 (Mod typeOf), zipWith mod) - , (Op2 (Div typeOf), zipWith quot) - ] - --- | Generator for arbitrary fractional operators with arity 2, paired with --- their expected meaning. -arbitraryFractionalOp2 :: (Typed t, Fractional t) - => Gen (Expr t -> Expr t -> Expr t, [t] -> [t] -> [t]) -arbitraryFractionalOp2 = elements - [ (Op2 (Fdiv typeOf), zipWith (/)) - ] - --- | Generator for arbitrary floating point operators with arity 2, paired with --- their expected meaning. -arbitraryFloatingOp2 :: (Typed t, Floating t) - => Gen (Expr t -> Expr t -> Expr t, [t] -> [t] -> [t]) -arbitraryFloatingOp2 = elements - [ (Op2 (Pow typeOf), zipWith (**)) - , (Op2 (Logb typeOf), zipWith logBase) - ] - --- | Generator for arbitrary floating point operators with arity 2, paired with --- their expected meaning. -arbitraryRealFloatOp2 :: (Typed t, RealFloat t) - => Gen (Expr t -> Expr t -> Expr t, [t] -> [t] -> [t]) -arbitraryRealFloatOp2 = elements - [ (Op2 (Atan2 typeOf), zipWith atan2) - ] - --- | Generator for arbitrary equality operators with arity 2, paired with their --- expected meaning. -arbitraryEqOp2 :: (Typed t, Eq t) - => Gen (Expr t -> Expr t -> Expr Bool, [t] -> [t] -> [Bool]) -arbitraryEqOp2 = elements - [ (Op2 (Eq typeOf), zipWith (==)) - , (Op2 (Ne typeOf), zipWith (/=)) - ] - --- | Generator for arbitrary ordering operators with arity 2, paired with their --- expected meaning. -arbitraryOrdOp2 :: (Typed t, Ord t) - => Gen (Expr t -> Expr t -> Expr Bool, [t] -> [t] -> [Bool]) -arbitraryOrdOp2 = elements - [ (Op2 (Le typeOf), zipWith (<=)) - , (Op2 (Lt typeOf), zipWith (<)) - , (Op2 (Ge typeOf), zipWith (>=)) - , (Op2 (Gt typeOf), zipWith (>)) - ] - --- | Generator for arbitrary bitwise operators with arity 2, paired with their --- expected meaning. -arbitraryBitsOp2 :: (Typed t, Bits t) - => Gen (Expr t -> Expr t -> Expr t, [t] -> [t] -> [t]) -arbitraryBitsOp2 = elements - [ (Op2 (BwAnd typeOf), zipWith (.&.)) - , (Op2 (BwOr typeOf), zipWith (.|.)) - , (Op2 (BwXor typeOf), zipWith xor) - ] - --- | Generator for arbitrary bit shifting operators with arity 2, paired with --- their expected meaning. --- --- This generator is a bit more strict in its type signature than the --- underlying bit-shifting operators being tested, since it enforces both the --- value being manipulated and the value that indicates how much to shift by to --- have the same type. -arbitraryBitsIntegralOp2 :: (Typed t, Bits t, Integral t) - => Gen (Expr t -> Expr t -> Expr t, [t] -> [t] -> [t]) -arbitraryBitsIntegralOp2 = elements - [ (Op2 (BwShiftL typeOf typeOf), zipWith (\x y -> shiftL x (fromIntegral y))) - , (Op2 (BwShiftR typeOf typeOf), zipWith (\x y -> shiftR x (fromIntegral y))) - ] - --- *** Op 3 - --- | Generator for if-then-else operator (with arity 3), paired with its --- expected meaning. --- --- Although this is constant and there is nothing arbitrary, we use the same --- structure and naming convention as with others for simplicity. -arbitraryITEOp3 :: (Arbitrary t, Typed t) - => Gen ( Expr Bool -> Expr t -> Expr t -> Expr t - , [Bool] -> [t] -> [t] -> [t] - ) -arbitraryITEOp3 = return - (Op3 (Mux typeOf), zipWith3 (\x y z -> if x then y else z)) - --- * Semantics - --- | Type that pairs an expression with its meaning as an infinite stream. -type Semantics t = (Expr t, [t]) - --- | A phantom semantics pair is an existential type that encloses an --- expression and its expected meaning as an infinite list of values. --- --- It is needed by the arbitrary expression generator, to create a --- heterogeneous list. -data SemanticsP = forall t - . (Typeable t, Read t, Eq t, Show t, Typed t, Arbitrary t) - => SemanticsP - { semanticsPair :: (Expr t, [t]) - } - --- | Show function for test triplets that limits the accompanying list --- to a certain length. -semanticsShowK :: Int -> SemanticsP -> String -semanticsShowK steps (SemanticsP (expr, exprList)) = - show (showType ty, render $ ppExpr expr, take steps exprList) - - where - - -- Type of the expression. The type is enforced by _u below. - ty = typeOf - - -- We want to show the type. To help GHC determine that the type t is the - -- same as the expression's (expr), we use an UExpr, which has an - -- additional constraint. This definition serves no other purpose than to - -- help enforce that constraint. - _u = UExpr ty expr - --- | Check that the expression in the semantics pair is evaluated to the given --- list, up to a number of steps. --- --- Some operations will overflow and return NaN. Because comparing any NaN --- will, as per IEEE 754, always fail (i.e., return False), we handle that --- specific case by stating that the test succeeds if any expected values --- is NaN. -checkSemanticsP :: Int -> [Stream] -> SemanticsP -> Bool -checkSemanticsP steps streams (SemanticsP (expr, exprList)) = - any isNaN' expectation || resultValues == expectation - where - -- Limit expectation to the number of evaluation steps. - expectation = take steps exprList - - -- Obtain the results by looking up the observer in the spec - -- and parsing the results into Haskell values. - resultValues = fmap readResult results - results = lookupWithDefault testObserverName [] - $ interpObservers trace - - -- Spec with just one observer of one expression. - trace = eval Haskell steps spec - spec = Spec streams observers [] [] - observers = [Observer testObserverName expr typeOf] - - -- Fixed name for the observer. Used to obtain the result from the - -- trace. It should be the only observer in the trace. - testObserverName :: String - testObserverName = "res" - - -- | Is NaN with Eq requirement only. - isNaN' :: Eq a => a -> Bool - isNaN' x = x /= x - --- * Auxiliary - --- | Read a Haskell value from the output of the evaluator. -readResult :: Read a => String -> a -readResult = read . readResult' - where - readResult' :: String -> String - readResult' "false" = "False" - readResult' "true" = "True" - readResult' s = s - --- | Variant of 'lookup' with an additional default value returned when the key --- provided is not found in the map. -lookupWithDefault :: Ord k => k -> v -> [(k, v)] -> v -lookupWithDefault k def = fromMaybe def . lookup k diff --git a/copilot-core/tests/Test/Copilot/Core/Type/Show.hs b/copilot-core/tests/Test/Copilot/Core/Type/Show.hs deleted file mode 100644 index 3bd350b05..000000000 --- a/copilot-core/tests/Test/Copilot/Core/Type/Show.hs +++ /dev/null @@ -1,38 +0,0 @@ --- The following warning is disnabled in this module so that the import of --- Copilot.Core.Type.Show does not give rise to a warning. -{-# OPTIONS_GHC -fno-warn-deprecations #-} - --- | Test copilot-core:Copilot.Core.Type.Show. -module Test.Copilot.Core.Type.Show where - --- External imports -import Test.Framework (Test, testGroup) -import Test.Framework.Providers.QuickCheck2 (testProperty) -import Test.QuickCheck (Arbitrary, Property, property) -import Text.Read (readMaybe) - --- Internal imports: library modules being tested -import Copilot.Core.Type (Type (Double, Float, Int16, Int32, Int64)) -import Copilot.Core.Type.Show (ShowType (Haskell), showWithType) - --- | All unit tests for copilot-core:Copilot.Core.Type.Show. -tests :: Test.Framework.Test -tests = - testGroup "Copilot.Core.Type.Show" - [ testProperty "read . showWithType == identity (Int16)" - (testShowRead Int16) - , testProperty "read . showWithType == identity (Int32)" - (testShowRead Int32) - , testProperty "read . showWithType == identity (Int64)" - (testShowRead Int64) - , testProperty "read . showWithType == identity (Float)" - (testShowRead Float) - , testProperty "read . showWithType == identity (Double)" - (testShowRead Double) - ] - --- | Test that showing a value with 'showWithType' and reading it back results --- in the same value. -testShowRead :: (Arbitrary a, Eq a, Read a) => Type a -> a -> Property -testShowRead t v = property $ - Just v == readMaybe (showWithType Haskell t v) From 618462281917000c17be4cce7ebc6cefe3633e5c Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 27 Dec 2022 17:42:38 -0800 Subject: [PATCH 0553/1222] copilot-core: Remove module Copilot.Core.Type.Show. Refs #392. The module Copilot.Core.Type.Show is not being used outside of copilot-core. It was deprecated in Copilot 3.10 and no messages have been received requesting that it be kept in the implementation. As per our internal policy of waiting 3 versions from deprecation until a public interface declaration can be removed, this module can now be completely hidden from the public interface. This commit removes the module completely. --- copilot-core/copilot-core.cabal | 1 - copilot-core/src/Copilot/Core/Type/Show.hs | 11 ----------- 2 files changed, 12 deletions(-) delete mode 100644 copilot-core/src/Copilot/Core/Type/Show.hs diff --git a/copilot-core/copilot-core.cabal b/copilot-core/copilot-core.cabal index 6d30f748e..3c437882a 100644 --- a/copilot-core/copilot-core.cabal +++ b/copilot-core/copilot-core.cabal @@ -56,7 +56,6 @@ library Copilot.Core.Type Copilot.Core.Type.Array Copilot.Core.Type.Equality - Copilot.Core.Type.Show Copilot.Core.PrettyPrint Copilot.Core.PrettyDot diff --git a/copilot-core/src/Copilot/Core/Type/Show.hs b/copilot-core/src/Copilot/Core/Type/Show.hs deleted file mode 100644 index fbf23cd71..000000000 --- a/copilot-core/src/Copilot/Core/Type/Show.hs +++ /dev/null @@ -1,11 +0,0 @@ --- Copyright © 2011 National Institute of Aerospace / Galois, Inc. - --- | Show Copilot Core types and typed values. -module Copilot.Core.Type.Show - {-# DEPRECATED "This module is deprecated in Copilot 3.10." #-} - ( showWithType - , ShowType(..) - , showType - ) where - -import Copilot.Core.Type.ShowInternal (ShowType (..), showType, showWithType) From 8190f69c01d6c282fb95f3c6428e2218aabe6c79 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 27 Dec 2022 17:45:09 -0800 Subject: [PATCH 0554/1222] copilot-core: Rename Copilot.Core.Type.ShowInternal. Refs #392. The module Copilot.Core.Type.Show is not being used outside of copilot-core. It was deprecated in Copilot 3.10 and no messages have been received requesting that it be kept in the implementation. As per our internal policy of waiting 3 versions from deprecation until a public interface declaration can be removed, this module can now be completely hidden from the public interface. A prior commit removed the aforementioned module. The name can now be used for the internal module Copilot.Core.Type.ShowInternal, which is still being used inside copilot-core. This commit renames Copilot.Core.Type.ShowInternal to Copilot.Core.Type.Show. The module remains hidden from the public API. All imports are adjusted accordingly. --- copilot-core/copilot-core.cabal | 2 +- copilot-core/src/Copilot/Core/Interpret.hs | 2 +- copilot-core/src/Copilot/Core/Interpret/Eval.hs | 15 +++++++-------- copilot-core/src/Copilot/Core/PrettyDot.hs | 2 +- copilot-core/src/Copilot/Core/PrettyPrint.hs | 2 +- .../Core/Type/{ShowInternal.hs => Show.hs} | 2 +- 6 files changed, 12 insertions(+), 13 deletions(-) rename copilot-core/src/Copilot/Core/Type/{ShowInternal.hs => Show.hs} (98%) diff --git a/copilot-core/copilot-core.cabal b/copilot-core/copilot-core.cabal index 3c437882a..9cfb4dee5 100644 --- a/copilot-core/copilot-core.cabal +++ b/copilot-core/copilot-core.cabal @@ -63,7 +63,7 @@ library Copilot.Core.Error Copilot.Core.Interpret.Render - Copilot.Core.Type.ShowInternal + Copilot.Core.Type.Show test-suite unit-tests type: diff --git a/copilot-core/src/Copilot/Core/Interpret.hs b/copilot-core/src/Copilot/Core/Interpret.hs index 6ed2d604f..7789a4d60 100644 --- a/copilot-core/src/Copilot/Core/Interpret.hs +++ b/copilot-core/src/Copilot/Core/Interpret.hs @@ -17,7 +17,7 @@ module Copilot.Core.Interpret import Copilot.Core import Copilot.Core.Interpret.Eval import Copilot.Core.Interpret.Render -import Copilot.Core.Type.ShowInternal (ShowType(..)) +import Copilot.Core.Type.Show (ShowType (..)) -- | Output format for the results of a Copilot spec interpretation. data Format = Table | CSV diff --git a/copilot-core/src/Copilot/Core/Interpret/Eval.hs b/copilot-core/src/Copilot/Core/Interpret/Eval.hs index 7fe7005f0..4f338f80c 100644 --- a/copilot-core/src/Copilot/Core/Interpret/Eval.hs +++ b/copilot-core/src/Copilot/Core/Interpret/Eval.hs @@ -16,14 +16,13 @@ module Copilot.Core.Interpret.Eval , ShowType (..) ) where -import Copilot.Core (Expr (..), Field (..), Id, Name, - Observer (..), Op1 (..), Op2 (..), - Op3 (..), Spec, Stream (..), - Trigger (..), Type (Struct), UExpr (..), - arrayelems, specObservers, specStreams, - specTriggers) -import Copilot.Core.Error (badUsage) -import Copilot.Core.Type.ShowInternal (ShowType (..), showWithType) +import Copilot.Core (Expr (..), Field (..), Id, Name, Observer (..), + Op1 (..), Op2 (..), Op3 (..), Spec, Stream (..), + Trigger (..), Type (Struct), UExpr (..), + arrayelems, specObservers, specStreams, + specTriggers) +import Copilot.Core.Error (badUsage) +import Copilot.Core.Type.Show (ShowType (..), showWithType) import Prelude hiding (id) import qualified Prelude as P diff --git a/copilot-core/src/Copilot/Core/PrettyDot.hs b/copilot-core/src/Copilot/Core/PrettyDot.hs index 638e861a1..1393602de 100644 --- a/copilot-core/src/Copilot/Core/PrettyDot.hs +++ b/copilot-core/src/Copilot/Core/PrettyDot.hs @@ -12,7 +12,7 @@ module Copilot.Core.PrettyDot ) where import Copilot.Core -import Copilot.Core.Type.ShowInternal (showWithType, ShowType(..), showType) +import Copilot.Core.Type.Show (showWithType, ShowType(..), showType) import Prelude hiding (id, (<>)) import Text.PrettyPrint.HughesPJ import Data.List (intersperse) diff --git a/copilot-core/src/Copilot/Core/PrettyPrint.hs b/copilot-core/src/Copilot/Core/PrettyPrint.hs index e6ed6ab8b..5a3396020 100644 --- a/copilot-core/src/Copilot/Core/PrettyPrint.hs +++ b/copilot-core/src/Copilot/Core/PrettyPrint.hs @@ -13,7 +13,7 @@ module Copilot.Core.PrettyPrint import Copilot.Core import Copilot.Core.Error (impossible) -import Copilot.Core.Type.ShowInternal (showWithType, ShowType(..), showType) +import Copilot.Core.Type.Show (showWithType, ShowType(..), showType) import Prelude hiding (id, (<>)) import Text.PrettyPrint.HughesPJ import Data.List (intersperse) diff --git a/copilot-core/src/Copilot/Core/Type/ShowInternal.hs b/copilot-core/src/Copilot/Core/Type/Show.hs similarity index 98% rename from copilot-core/src/Copilot/Core/Type/ShowInternal.hs rename to copilot-core/src/Copilot/Core/Type/Show.hs index f170ab677..d752445e8 100644 --- a/copilot-core/src/Copilot/Core/Type/ShowInternal.hs +++ b/copilot-core/src/Copilot/Core/Type/Show.hs @@ -6,7 +6,7 @@ -- Copyright: (c) 2011 National Institute of Aerospace / Galois, Inc. -- -- Show Copilot Core types and typed values. -module Copilot.Core.Type.ShowInternal +module Copilot.Core.Type.Show ( showWithType , ShowType (..) , showType From 04724c8fed500d6d4aa3d7f76705c0ab0472236d Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 27 Dec 2022 17:46:03 -0800 Subject: [PATCH 0555/1222] copilot-core: Document changes in CHANGELOG. Refs #392. --- copilot-core/CHANGELOG | 1 + 1 file changed, 1 insertion(+) diff --git a/copilot-core/CHANGELOG b/copilot-core/CHANGELOG index 10ca8e048..996c8d657 100644 --- a/copilot-core/CHANGELOG +++ b/copilot-core/CHANGELOG @@ -1,6 +1,7 @@ 2022-12-27 * Remove Copilot.Core.External. (#391) * Fix bug in definition of simpleType for Int8. (#393) + * Hide module Copilot.Core.Type.Show. (#392) 2022-11-07 * Version bump (3.12). (#389) From 6c05347f532ac483eba989d1866b85cf3951f70e Mon Sep 17 00:00:00 2001 From: Ryan Scott Date: Wed, 4 Jan 2023 15:18:04 -0600 Subject: [PATCH 0556/1222] copilot-core: Implement missing cases of type equality for arrays and structs. Refs #400. The `TestEquality Type` instance is used as part of the code which checks to see if an `extern` has been declared to have two different types. This instance lacked cases for `Array` and `Struct` types, which meant that `copilot` would incorrectly believe that a nested array type (e.g., `Array 2 (Array 2 Int16)` or `Array 2 StructType`) was not equal to itself, leading to `extern`s with that type erroneously being rejected. This patch adds the missing `Array` and `Struct` cases to the `TestEquality` instance. This proves relatively straightfoward: * `Array n1 a1` equals `Array n2 a2` iff `n1` equals `n2` and `a1` equals `a2`. * Two `Struct` types are equal iff they are equal according to their `Typeable` instances. There is a very similar `EqualType Type` instance that also lacks cases for `Array` and `Struct`. This patch does not change the `EqualType Type` instance, however, for two reasons: 1. The `EqualType` class is defined in the `Copilot.Core.Type.Equality` module, which is deprecated. 2. This instance is not used anywhere in the `copilot` ecosystem. --- copilot-core/src/Copilot/Core/Type.hs | 21 +++++++++++++++++++-- 1 file changed, 19 insertions(+), 2 deletions(-) diff --git a/copilot-core/src/Copilot/Core/Type.hs b/copilot-core/src/Copilot/Core/Type.hs index 7e4305c15..cb330d90a 100644 --- a/copilot-core/src/Copilot/Core/Type.hs +++ b/copilot-core/src/Copilot/Core/Type.hs @@ -6,6 +6,7 @@ {-# LANGUAGE KindSignatures #-} {-# LANGUAGE Safe #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} -- The following flag is disabled in this module so that the import of @@ -46,9 +47,10 @@ import Data.Int (Int16, Int32, Int64, Int8) import Data.List (intercalate) import Data.Proxy (Proxy (..)) import Data.Type.Equality as DE -import Data.Typeable (Typeable, typeRep) +import Data.Typeable (Typeable, eqT, typeRep) import Data.Word (Word16, Word32, Word64, Word8) -import GHC.TypeLits (KnownNat, KnownSymbol, Symbol, natVal, symbolVal) +import GHC.TypeLits (KnownNat, KnownSymbol, Symbol, natVal, sameNat, + symbolVal) -- Internal imports import Copilot.Core.Type.Array (Array) @@ -147,6 +149,21 @@ instance TestEquality Type where testEquality Word64 Word64 = Just DE.Refl testEquality Float Float = Just DE.Refl testEquality Double Double = Just DE.Refl + testEquality (Array t1) (Array t2) = + testArrayEquality t1 t2 + where + testArrayEquality :: forall n1 a1 n2 a2. + (KnownNat n1, KnownNat n2) + => Type a1 + -> Type a2 + -> Maybe (Array n1 a1 :~: Array n2 a2) + testArrayEquality ty1 ty2 + | Just DE.Refl <- sameNat (Proxy :: Proxy n1) (Proxy :: Proxy n2) + , Just DE.Refl <- testEquality ty1 ty2 + = Just DE.Refl + | otherwise + = Nothing + testEquality (Struct _) (Struct _) = eqT testEquality _ _ = Nothing -- | A simple, monomorphic representation of types that facilitates putting From 8a6d32f31d5976eefd0a312f2f07d522c61e219e Mon Sep 17 00:00:00 2001 From: Ryan Scott Date: Wed, 4 Jan 2023 15:29:07 -0600 Subject: [PATCH 0557/1222] copilot-core: Document changes in CHANGELOG. Refs #400. --- copilot-core/CHANGELOG | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/copilot-core/CHANGELOG b/copilot-core/CHANGELOG index 996c8d657..e637106f4 100644 --- a/copilot-core/CHANGELOG +++ b/copilot-core/CHANGELOG @@ -1,3 +1,7 @@ +2023-01-04 + * Implement missing cases of type equality for arrays and structs. + (#400) + 2022-12-27 * Remove Copilot.Core.External. (#391) * Fix bug in definition of simpleType for Int8. (#393) From db2e63be2f01f10c4fcbb8c287d27e28488e208c Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Wed, 4 Jan 2023 12:19:42 -0800 Subject: [PATCH 0558/1222] copilot-c99: Declare local array variables in generated guards as pointers. Refs #401. Copilot's c99 backend is producing invalid code for variable initializers when local is used. The code produced for temporary variables of type array indicates their length in the type, but the value they are initialized to is a compound literal, which is not a valid initialization expression. This patch modifies the translation of a local or temporary variable of array type to use a pointer for (the outermost layer of) arrays. The use of a pointer allows us to use any expression to initialize the variable on the right-hand side, making the current expressions, which use compound literals, valid. Note that the word local is used in this context, both in the commit message and in the code, with two different meanings: one is Copilot's local operator, used to define "let expressions", and the other is the notion of a local variable in C. --- copilot-c99/src/Copilot/Compile/C99/Translate.hs | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) diff --git a/copilot-c99/src/Copilot/Compile/C99/Translate.hs b/copilot-c99/src/Copilot/Compile/C99/Translate.hs index 6bb3a074c..d1f336065 100644 --- a/copilot-c99/src/Copilot/Compile/C99/Translate.hs +++ b/copilot-c99/src/Copilot/Compile/C99/Translate.hs @@ -18,7 +18,7 @@ transexpr (Const ty x) = return $ constty ty x transexpr (Local ty1 _ name e1 e2) = do e1' <- transexpr e1 - let cty1 = transtype ty1 + let cty1 = transLocalVarDeclType ty1 init = Just $ C.InitExpr e1' statetell [C.VarDecln Nothing cty1 name init] @@ -303,6 +303,16 @@ transtype ty = case ty of length = Just $ C.LitInt $ fromIntegral $ tylength ty Struct s -> C.TypeSpec $ C.Struct (typename s) +-- | Translate a Copilot type to a valid (local) variable declaration C99 type. +-- +-- If the type denotes an array, translate it to a pointer to whatever the +-- array holds. This special case is needed when the type is used for a local +-- variable declaration. We treat global variables differently (we generate +-- list initializers). +transLocalVarDeclType :: Type a -> C.Type +transLocalVarDeclType (Array ty') = C.Ptr $ transtype ty' +transLocalVarDeclType ty = transtype ty + -- | Translate a Copilot type intro a C typename transtypename :: Type a -> C.TypeName transtypename ty = C.TypeName $ transtype ty From ab85ab0fbf84224edc59d19bf7c076e8cd63f488 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 7 Jan 2023 11:20:57 -0800 Subject: [PATCH 0559/1222] copilot-c99: Document changes in CHANGELOG. Refs #401. --- copilot-c99/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-c99/CHANGELOG b/copilot-c99/CHANGELOG index 16c4d1a36..e450700d4 100644 --- a/copilot-c99/CHANGELOG +++ b/copilot-c99/CHANGELOG @@ -1,3 +1,6 @@ +2023-01-07 + * Declare local array variables in generated guards as pointers. (#401) + 2022-11-07 * Version bump (3.12). (#389) * Removed deprecated flag from cabal file. (#380) From ea89ae96bb68a253e091291347f12cc4173101e1 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Wed, 28 Dec 2022 09:53:17 -0800 Subject: [PATCH 0560/1222] copilot-c99: Use pointer to pass output array as argument to generators. Refs #386. Copilot's C99 backend generates incorrect code. The functions that generate values used to update variable buffers (which are ultimately used also to pass arguments to trigger functions) may return pointers to stack-allocated arrays. That memory may be used for something else after the call to such "generator" functions, so it may be overwritten or freed by the time the value is used to update the buffer. This may lead to buffers holding incorrect values, and also to calls to trigger functions with incorrect arguments. This commit changes generator functions for arrays so that they receive a pointer to an array for the output argument. The alternative implementation passes the responsibility of allocating the array to the caller. The part of the generated code to update the values of buffers is adjusted accordingly to provide pre-allocated arrays as arguments. Two local functions in the CodeGen module (memcpy and tyElemName) are promoted from the scope of the function mkstep to the top-level of the module, as they are needed by a newly introduced function. --- .../src/Copilot/Compile/C99/CodeGen.hs | 58 +++++++++++++------ .../src/Copilot/Compile/C99/Compile.hs | 3 + copilot-c99/src/Copilot/Compile/C99/Util.hs | 4 ++ 3 files changed, 48 insertions(+), 17 deletions(-) diff --git a/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs b/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs index 73fec8c5e..616bd1dbd 100644 --- a/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs +++ b/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs @@ -12,6 +12,7 @@ import Data.Typeable (Typeable) import qualified Language.C99.Simple as C import Copilot.Core +import Copilot.Compile.C99.Error (impossible) import Copilot.Compile.C99.Util import Copilot.Compile.C99.External import Copilot.Compile.C99.Settings @@ -30,6 +31,28 @@ genfun name expr ty = C.FunDef cty name [] cvars [C.Return $ Just cexpr] cty = C.decay $ transtype ty (cexpr, cvars) = runState (transexpr expr) mempty +-- | Write a generator function for a stream that returns an array. +genFunArray :: String -> String -> Expr a -> Type a -> C.FunDef +genFunArray name nameArg expr ty@(Array _) = + C.FunDef funType name [ outputParam ] varDecls stmts + where + funType = C.TypeSpec C.Void + + -- The output value is an array + outputParam = C.Param cArrayType nameArg + cArrayType = transtype ty + + -- Output value, and any variable declarations needed + (cexpr, varDecls) = runState (transexpr expr) mempty + + -- Copy expression to output argument + stmts = [ C.Expr $ memcpy (C.Ident nameArg) cexpr size ] + size = C.LitInt (fromIntegral $ tysize ty) + C..* C.SizeOfType (C.TypeName $ tyElemName ty) + +genFunArray name nameArg expr _ = + impossible "genFunArray" "copilot-c99" + -- | Make a extern declaration of a variable. mkextdecln :: External -> C.Decln mkextdecln (External name _ ty) = decln @@ -99,10 +122,8 @@ mkstep cSettings streams triggers exts = tmpdecln = C.VarDecln Nothing cty tmp_var Nothing tmpassign = case ty of - Array _ -> C.Expr $ memcpy (C.Ident tmp_var) val size - where - size = C.LitInt (fromIntegral $ tysize ty) - C..* C.SizeOfType (C.TypeName (tyElemName ty)) + Array _ -> C.Expr $ C.Funcall (C.Ident $ generatorname sid) + [ C.Ident tmp_var ] _ -> C.Expr $ C.Ident tmp_var C..= val bufferupdate = case ty of @@ -219,19 +240,6 @@ mkstep cSettings streams triggers exts = args' = take (length args) (map argcall (argnames name)) argcall name = C.Funcall (C.Ident name) [] - -- Write a call to the memcpy function. - memcpy :: C.Expr -> C.Expr -> C.Expr -> C.Expr - memcpy dest src size = C.Funcall (C.Ident "memcpy") [dest, src, size] - - -- Translate a Copilot type to a C99 type, handling arrays especially. - -- - -- If the given type is an array (including multi-dimensional arrays), the - -- type is that of the elements in the array. Otherwise, it is just the - -- equivalent representation of the given type in C. - tyElemName :: Type a -> C.Type - tyElemName ty = case ty of - Array ty' -> tyElemName ty' - _ -> transtype ty -- | Write a struct declaration based on its definition. mkstructdecln :: Struct a => Type a -> C.Decln @@ -278,3 +286,19 @@ gatherexprs streams triggers = map streamexpr streams where streamexpr (Stream _ _ expr ty) = UExpr ty expr triggerexpr (Trigger _ guard args) = UExpr Bool guard : args + +-- * Auxiliary functions + +-- Write a call to the memcpy function. +memcpy :: C.Expr -> C.Expr -> C.Expr -> C.Expr +memcpy dest src size = C.Funcall (C.Ident "memcpy") [dest, src, size] + +-- Translate a Copilot type to a C99 type, handling arrays especially. +-- +-- If the given type is an array (including multi-dimensional arrays), the +-- type is that of the elements in the array. Otherwise, it is just the +-- equivalent representation of the given type in C. +tyElemName :: Type a -> C.Type +tyElemName ty = case ty of + Array ty' -> tyElemName ty' + _ -> transtype ty diff --git a/copilot-c99/src/Copilot/Compile/C99/Compile.hs b/copilot-c99/src/Copilot/Compile/C99/Compile.hs index 683ddcecb..c76d0bc2b 100644 --- a/copilot-c99/src/Copilot/Compile/C99/Compile.hs +++ b/copilot-c99/src/Copilot/Compile/C99/Compile.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE GADTs #-} -- | Compile Copilot specifications to C99 code. module Copilot.Compile.C99.Compile ( compile @@ -103,6 +104,8 @@ compilec cSettings spec = C.TransUnit declns funs accessdecln (Stream sid buff _ ty) = mkaccessdecln sid ty buff streamgen :: Stream -> C.FunDef + streamgen (Stream sid _ expr ty@(Array _)) = + genFunArray (generatorname sid) (generatorOutputArgName sid) expr ty streamgen (Stream sid _ expr ty) = genfun (generatorname sid) expr ty triggergen :: Trigger -> [C.FunDef] diff --git a/copilot-c99/src/Copilot/Compile/C99/Util.hs b/copilot-c99/src/Copilot/Compile/C99/Util.hs index 8240ddcbc..10d6f9a83 100644 --- a/copilot-c99/src/Copilot/Compile/C99/Util.hs +++ b/copilot-c99/src/Copilot/Compile/C99/Util.hs @@ -47,6 +47,10 @@ excpyname name = name ++ "_cpy" generatorname :: Id -> String generatorname sid = streamname sid ++ "_gen" +-- | Turn stream id into name of its output argument array. +generatorOutputArgName :: Id -> String +generatorOutputArgName sid = streamname sid ++ "_output" + -- | Turn the name of a trigger into a guard generator. guardname :: String -> String guardname name = name ++ "_guard" From 37797aa15a3b8582564023a7106f8062fd4f6ffe Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 7 Jan 2023 14:08:13 -0800 Subject: [PATCH 0561/1222] copilot-c99: Document changes in CHANGELOG. Refs #386. --- copilot-c99/CHANGELOG | 1 + 1 file changed, 1 insertion(+) diff --git a/copilot-c99/CHANGELOG b/copilot-c99/CHANGELOG index e450700d4..006a89029 100644 --- a/copilot-c99/CHANGELOG +++ b/copilot-c99/CHANGELOG @@ -1,5 +1,6 @@ 2023-01-07 * Declare local array variables in generated guards as pointers. (#401) + * Use pointer to pass output array as argument to generators. (#386) 2022-11-07 * Version bump (3.12). (#389) From 5fbb1f08d9ed828368331256c1f36f79a31f6766 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 7 Jan 2023 18:30:13 -0800 Subject: [PATCH 0562/1222] Bump versions and constraints. Refs #406. --- copilot-c99/copilot-c99.cabal | 4 ++-- copilot-core/copilot-core.cabal | 2 +- copilot-interpreter/copilot-interpreter.cabal | 4 ++-- copilot-language/copilot-language.cabal | 10 +++++----- copilot-libraries/copilot-libraries.cabal | 4 ++-- copilot-prettyprinter/copilot-prettyprinter.cabal | 4 ++-- copilot-theorem/copilot-theorem.cabal | 6 +++--- copilot/copilot.cabal | 12 ++++++------ 8 files changed, 23 insertions(+), 23 deletions(-) diff --git a/copilot-c99/copilot-c99.cabal b/copilot-c99/copilot-c99.cabal index 50580e551..4ef9c86db 100644 --- a/copilot-c99/copilot-c99.cabal +++ b/copilot-c99/copilot-c99.cabal @@ -1,6 +1,6 @@ cabal-version : >= 1.10 name : copilot-c99 -version : 3.12 +version : 3.13 synopsis : A compiler for Copilot targeting C99. description : This package is a back-end from Copilot to C. @@ -45,7 +45,7 @@ library , mtl >= 2.2 && < 2.4 , pretty >= 1.1 && < 1.2 - , copilot-core >= 3.12 && < 3.13 + , copilot-core >= 3.13 && < 3.14 , language-c99 >= 0.2.0 && < 0.3 , language-c99-simple >= 0.2.2 && < 0.3 diff --git a/copilot-core/copilot-core.cabal b/copilot-core/copilot-core.cabal index 9cfb4dee5..1b73a4a9c 100644 --- a/copilot-core/copilot-core.cabal +++ b/copilot-core/copilot-core.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-core -version: 3.12 +version: 3.13 synopsis: An intermediate representation for Copilot. description: Intermediate representation for Copilot. diff --git a/copilot-interpreter/copilot-interpreter.cabal b/copilot-interpreter/copilot-interpreter.cabal index 9ab66c38f..c51d3e92d 100644 --- a/copilot-interpreter/copilot-interpreter.cabal +++ b/copilot-interpreter/copilot-interpreter.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-interpreter -version: 3.12 +version: 3.13 synopsis: Interpreter for Copilot. description: Interpreter for Copilot. @@ -44,7 +44,7 @@ library base >= 4.9 && < 5, pretty >= 1.0 && < 1.2, - copilot-core + copilot-core >= 3.13 && < 3.14 exposed-modules: diff --git a/copilot-language/copilot-language.cabal b/copilot-language/copilot-language.cabal index c64fe2d7e..f6e97ce2f 100644 --- a/copilot-language/copilot-language.cabal +++ b/copilot-language/copilot-language.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-language -version: 3.12 +version: 3.13 synopsis: A Haskell-embedded DSL for monitoring hard real-time distributed systems. description: @@ -42,10 +42,10 @@ library , data-reify >= 0.6 && < 0.7 , mtl >= 2.0 && < 3 - , copilot-core >= 3.12 && < 3.13 - , copilot-interpreter >= 3.12 && < 3.13 - , copilot-prettyprinter >= 3.12 && < 3.13 - , copilot-theorem >= 3.12 && < 3.13 + , copilot-core >= 3.13 && < 3.14 + , copilot-interpreter >= 3.13 && < 3.14 + , copilot-prettyprinter >= 3.13 && < 3.14 + , copilot-theorem >= 3.13 && < 3.14 exposed-modules: Copilot.Language , Copilot.Language.Operators.BitWise diff --git a/copilot-libraries/copilot-libraries.cabal b/copilot-libraries/copilot-libraries.cabal index 783fc7763..f71d2701c 100644 --- a/copilot-libraries/copilot-libraries.cabal +++ b/copilot-libraries/copilot-libraries.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-libraries -version: 3.12 +version: 3.13 synopsis: Libraries for the Copilot language. description: Libraries for the Copilot language. @@ -41,7 +41,7 @@ library , containers >= 0.4 && < 0.7 , mtl >= 2.0 && < 2.4 , parsec >= 2.0 && < 3.2 - , copilot-language >= 3.12 && < 3.13 + , copilot-language >= 3.13 && < 3.14 exposed-modules: Copilot.Library.Libraries diff --git a/copilot-prettyprinter/copilot-prettyprinter.cabal b/copilot-prettyprinter/copilot-prettyprinter.cabal index e3cd1fc2d..e6e15ba1e 100644 --- a/copilot-prettyprinter/copilot-prettyprinter.cabal +++ b/copilot-prettyprinter/copilot-prettyprinter.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-prettyprinter -version: 3.12 +version: 3.13 synopsis: A prettyprinter of Copilot Specifications. description: A prettyprinter of Copilot specifications. @@ -45,7 +45,7 @@ library base >= 4.9 && < 5, pretty >= 1.0 && < 1.2, - copilot-core + copilot-core >= 3.13 && < 3.14 exposed-modules: diff --git a/copilot-theorem/copilot-theorem.cabal b/copilot-theorem/copilot-theorem.cabal index ded60f836..d959fc1ea 100644 --- a/copilot-theorem/copilot-theorem.cabal +++ b/copilot-theorem/copilot-theorem.cabal @@ -14,7 +14,7 @@ description: . -version : 3.12 +version : 3.13 license : BSD3 license-file : LICENSE maintainer : Ivan Perez @@ -63,8 +63,8 @@ library , xml >= 1.3 && < 1.4 , what4 >= 1.3 && < 1.4 - , copilot-core >= 3.12 && < 3.13 - , copilot-prettyprinter >= 3.12 && < 3.13 + , copilot-core >= 3.13 && < 3.14 + , copilot-prettyprinter >= 3.13 && < 3.14 exposed-modules : Copilot.Theorem , Copilot.Theorem.Prove diff --git a/copilot/copilot.cabal b/copilot/copilot.cabal index 4be046950..8636dc8a1 100644 --- a/copilot/copilot.cabal +++ b/copilot/copilot.cabal @@ -1,5 +1,5 @@ name: copilot -version: 3.12 +version: 3.13 cabal-version: >= 1.10 license: BSD3 license-file: LICENSE @@ -52,11 +52,11 @@ library , directory >= 1.3 && < 1.4 , filepath >= 1.4 && < 1.5 - , copilot-core >= 3.12 && < 3.13 - , copilot-theorem >= 3.12 && < 3.13 - , copilot-language >= 3.12 && < 3.13 - , copilot-libraries >= 3.12 && < 3.13 - , copilot-c99 >= 3.12 && < 3.13 + , copilot-core >= 3.13 && < 3.14 + , copilot-theorem >= 3.13 && < 3.14 + , copilot-language >= 3.13 && < 3.14 + , copilot-libraries >= 3.13 && < 3.14 + , copilot-c99 >= 3.13 && < 3.14 exposed-modules: Language.Copilot, Language.Copilot.Main From 2f42c82f99e7ca743610886f68c93d13910f0d18 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 7 Jan 2023 18:31:42 -0800 Subject: [PATCH 0563/1222] Document changes in CHANGELOG. Refs #406. --- copilot-c99/CHANGELOG | 1 + copilot-core/CHANGELOG | 3 ++- copilot-interpreter/CHANGELOG | 3 +++ copilot-language/CHANGELOG | 3 +++ copilot-libraries/CHANGELOG | 3 +++ copilot-prettyprinter/CHANGELOG | 3 +++ copilot-theorem/CHANGELOG | 3 +++ copilot/CHANGELOG | 3 +++ 8 files changed, 21 insertions(+), 1 deletion(-) diff --git a/copilot-c99/CHANGELOG b/copilot-c99/CHANGELOG index 006a89029..d1d0dec94 100644 --- a/copilot-c99/CHANGELOG +++ b/copilot-c99/CHANGELOG @@ -1,4 +1,5 @@ 2023-01-07 + * Version bump (3.13). (#406) * Declare local array variables in generated guards as pointers. (#401) * Use pointer to pass output array as argument to generators. (#386) diff --git a/copilot-core/CHANGELOG b/copilot-core/CHANGELOG index e637106f4..a7f6f872e 100644 --- a/copilot-core/CHANGELOG +++ b/copilot-core/CHANGELOG @@ -1,4 +1,5 @@ -2023-01-04 +2023-01-07 + * Version bump (3.13). (#406) * Implement missing cases of type equality for arrays and structs. (#400) diff --git a/copilot-interpreter/CHANGELOG b/copilot-interpreter/CHANGELOG index 45f73df85..60c54300e 100644 --- a/copilot-interpreter/CHANGELOG +++ b/copilot-interpreter/CHANGELOG @@ -1,3 +1,6 @@ +2023-01-07 + * Version bump (3.13). (#406) + 2022-11-07 * Version bump (3.12). (#389) * Use pretty-printer from copilot-prettyprinter. (#383) diff --git a/copilot-language/CHANGELOG b/copilot-language/CHANGELOG index 16b831c21..7f516d6e6 100644 --- a/copilot-language/CHANGELOG +++ b/copilot-language/CHANGELOG @@ -1,3 +1,6 @@ +2023-01-07 + * Version bump (3.13). (#406) + 2022-11-07 * Version bump (3.12). (#389) * Use pretty-printer from copilot-prettyprinter. (#383) diff --git a/copilot-libraries/CHANGELOG b/copilot-libraries/CHANGELOG index e5b301ab9..305a73845 100644 --- a/copilot-libraries/CHANGELOG +++ b/copilot-libraries/CHANGELOG @@ -1,3 +1,6 @@ +2023-01-07 + * Version bump (3.13). (#406) + 2022-11-07 * Version bump (3.12). (#389) diff --git a/copilot-prettyprinter/CHANGELOG b/copilot-prettyprinter/CHANGELOG index 03eaa0fae..f42d560be 100644 --- a/copilot-prettyprinter/CHANGELOG +++ b/copilot-prettyprinter/CHANGELOG @@ -1,3 +1,6 @@ +2023-01-07 + * Version bump (3.13). (#406) + 2022-11-07 * Version bump (3.12). (#389) * Create new library for pretty-printer. (#383) diff --git a/copilot-theorem/CHANGELOG b/copilot-theorem/CHANGELOG index c88d3e0bf..26602f745 100644 --- a/copilot-theorem/CHANGELOG +++ b/copilot-theorem/CHANGELOG @@ -1,3 +1,6 @@ +2023-01-07 + * Version bump (3.13). (#406) + 2022-11-07 * Version bump (3.12). (#389) * Add functionality for bisimulation proofs of Copilot specifications. (#363) diff --git a/copilot/CHANGELOG b/copilot/CHANGELOG index dd4925c02..587c1f749 100644 --- a/copilot/CHANGELOG +++ b/copilot/CHANGELOG @@ -1,3 +1,6 @@ +2023-01-07 + * Version bump (3.13). (#406) + 2022-11-07 * Version bump (3.12). (#389) From 6878321625202789265c01d1e59bcc385f891d3f Mon Sep 17 00:00:00 2001 From: Will Pogge Date: Tue, 7 Feb 2023 13:37:02 -0500 Subject: [PATCH 0564/1222] copilot-core: Remove Copilot.Core.PrettyDot module. Refs #409. The module Copilot.Core.PrettyDot is not being used by any other part of Copilot. It was deprecated in Copilot 3.11 and no messages have been received requesting that it be kept in the implementation. As per our internal policy of waiting 3 versions from deprecation until a public interface declaration can be removed, this module can now be removed. This commit removes the module completely. --- copilot-core/copilot-core.cabal | 1 - copilot-core/src/Copilot/Core/PrettyDot.hs | 306 --------------------- 2 files changed, 307 deletions(-) delete mode 100644 copilot-core/src/Copilot/Core/PrettyDot.hs diff --git a/copilot-core/copilot-core.cabal b/copilot-core/copilot-core.cabal index 1b73a4a9c..51a193ce3 100644 --- a/copilot-core/copilot-core.cabal +++ b/copilot-core/copilot-core.cabal @@ -57,7 +57,6 @@ library Copilot.Core.Type.Array Copilot.Core.Type.Equality Copilot.Core.PrettyPrint - Copilot.Core.PrettyDot other-modules: diff --git a/copilot-core/src/Copilot/Core/PrettyDot.hs b/copilot-core/src/Copilot/Core/PrettyDot.hs deleted file mode 100644 index 1393602de..000000000 --- a/copilot-core/src/Copilot/Core/PrettyDot.hs +++ /dev/null @@ -1,306 +0,0 @@ --- Copyright © 2011 National Institute of Aerospace / Galois, Inc. - --- | A pretty printer for Copilot specifications as GraphViz/dot graphs. - -{-# LANGUAGE GADTs #-} -{-# LANGUAGE Safe #-} - -module Copilot.Core.PrettyDot - {-# DEPRECATED "This module is deprecated in Copilot 3.11." #-} - ( prettyPrintDot - , prettyPrintExprDot - ) where - -import Copilot.Core -import Copilot.Core.Type.Show (showWithType, ShowType(..), showType) -import Prelude hiding (id, (<>)) -import Text.PrettyPrint.HughesPJ -import Data.List (intersperse) -import Text.Printf - --- | Create a temporary/internal name from an extern variable name. -mkExtTmpVar :: String -> String -mkExtTmpVar = ("ext_" ++) - --- | Pretty print a Copilot Expression as a GraphViz graph part. --- --- See the --- for details. -ppExprDot :: Int -- ^ Index or ID of the next node in the graph. - -> Int -- ^ Index or ID of the parent node in the graph. - -> Bool -- ^ Mark externs with the prefix @externV:@. - -> Expr a -- ^ The expression to pretty print. - -> (Doc,Int) -ppExprDot ii pere bb e0 = case e0 of - Const t x -> (text (printf "%s [label=\"const: %s\",color=red1, style=filled]\n" (show ii::String) ((showWithType Haskell t x)::String) ) - <> text (printf "%s -> %s\n" (show pere::String) (show ii::String)),ii+1) - Drop _ 0 id -> (text (printf "%s [label=\"stream: %s\",color=crimson, style=filled]\n" (show ii::String) (show id::String) ) - <> text (printf "%s -> %s\n" (show pere::String) (show ii::String)),ii+1) - Drop _ i id -> (text (printf "%s [label=\"drop %s: \nstream: %s\",color=crimson, style=filled]\n" (show ii::String) (show i::String) (show id::String) ) - <> text (printf "%s -> %s\n" (show pere::String) (show ii::String)),ii+1) - ExternVar _ name _ -> (if bb - then (text (printf "%s [label=\"externV: %s\",color=cyan1, style=filled]\n" (show ii::String) (name::String)) <> text (printf "%s -> %s\n" (show pere::String) (show ii::String))) - else (text (printf "%s [label=\"%s\",color=cyan1, style=filled]\n" (show ii::String) (mkExtTmpVar name)) <> text (printf "%s -> %s\n" (show pere::String) (show ii::String))) - ,ii+1) - Local _ _ name e1 e2 -> let (r1, i1) = ppExprDot (ii+2) (ii+1) bb e1 - in let (r2, i2) = ppExprDot (i1) ii bb e2 - in (text (printf "%s [label=\"local:\",color=blue, style=filled]\n" (show ii::String) ) - <> text (printf "%s -> %s\n" (show pere::String) (show ii::String)) - <> text (printf "%s [label=\"def: %s\",color=blue, style=filled]\n" ((show $ ii+1)::String) (name::String) ) - <> text (printf "%s -> %s\n" (show ii::String) (show $ ii+1::String)) - <> r1 - <> r2, i2) - - Var _ name -> (text (printf "%s [label=\"var: %s\",color=blue, style=filled]\n" (show ii::String) (name::String) ) - <> text (printf "%s -> %s\n" (show pere::String) (show ii::String)),ii+1) - - Op1 op e -> let (r1,i1) = ppExprDot (ii+1) ii bb e - in (text (printf "%s [label=\"op1: %s\",color=green4, style=filled]\n" (show ii::String) (ppOp1 op::String)) - <> text (printf "%s -> %s\n" (show pere::String) (show ii::String)) - <> r1,i1) - - Op2 op e1 e2 -> let (r1,i1) = ppExprDot (ii+1) ii bb e1 - in let (r2,i2) = ppExprDot i1 ii bb e2 - in (text (printf "%s [label=\"op2: %s\",color=green4, style=filled]\n" (show ii::String) (ppOp2 op::String)) - <> text (printf "%s -> %s\n" (show pere::String) (show ii::String)) - <> r1 - <> r2, i2) - Op3 op e1 e2 e3 -> let (r1,i1) = ppExprDot (ii+1) ii bb e1 - in let (r2,i2) = ppExprDot i1 ii bb e2 - in let (r3,i3) = ppExprDot i2 ii bb e3 - in (text (printf "%s [label=\"op3: %s\",color=green4, style=filled]\n" (show ii::String) (ppOp3 op::String)) - <> text (printf "%s -> %s\n" (show pere::String) (show ii::String)) - <> r1 - <> r2 - <> r3, i3) - - Label _ s e -> let (r1,i1) = ppExprDot (ii+1) ii bb e - in (text (printf "%s [label=\"label: %s\",color=plum, style=filled]\n" (show ii::String) (s::String)) - <> text (printf "%s -> %s\n" (show pere::String) (show ii::String)) - <> r1,i1) - --- | Pretty print an untyped Copilot Expression as a graphiViz graph part. --- --- See the --- for details. -ppUExpr :: Int -- ^ Index or ID of the next node in the graph. - -> Int -- ^ Index or ID of the parent node in the graph. - -> Bool -- ^ Mark externs with the prefix @externV:@. - -> UExpr -- ^ The expression to pretty print. - -> (Doc, Int) -ppUExpr i pere bb UExpr { uExprExpr = e0 } = ppExprDot i pere bb e0 - --- | Pretty print a unary operator. -ppOp1 :: Op1 a b -> String -ppOp1 op = case op of - Not -> "not" - Abs _ -> "abs" - Sign _ -> "signum" - Recip _ -> "recip" - Exp _ -> "exp" - Sqrt _ -> "sqrt" - Log _ -> "log" - Sin _ -> "sin" - Tan _ -> "tan" - Cos _ -> "cos" - Asin _ -> "asin" - Atan _ -> "atan" - Acos _ -> "acos" - Sinh _ -> "sinh" - Tanh _ -> "tanh" - Cosh _ -> "cosh" - Asinh _ -> "asinh" - Atanh _ -> "atanh" - Acosh _ -> "acosh" - Ceiling _ -> "ceiling" - Floor _ -> "floor" - BwNot _ -> "~" - Cast _ _ -> "(cast)" - --- | Pretty print a binary operator. -ppOp2 :: Op2 a b c -> String -ppOp2 op = case op of - And -> "&&" - Or -> "||" - Add _ -> "+" - Sub _ -> "-" - Mul _ -> "*" - Div _ -> "div" - Mod _ -> "mod" - Fdiv _ -> "/" - Pow _ -> "**" - Logb _ -> "logBase" - Atan2 _ -> "atan2" - Eq _ -> "==" - Ne _ -> "/=" - Le _ -> "<=" - Ge _ -> ">=" - Lt _ -> "<" - Gt _ -> ">" - BwAnd _ -> "&" - BwOr _ -> "|" - BwXor _ -> "^" - BwShiftL _ _ -> "<<" - BwShiftR _ _ -> ">>" - --- | Pretty print a ternary operator. -ppOp3 :: Op3 a b c d -> String -ppOp3 op = case op of - Mux _ -> "mux" - --- | Pretty print a stream as a GraphViz graph part. -ppStream :: Int -- ^ Index or ID of the next node in the graph. - -> Stream -- ^ Stream to pretty print - -> (Doc, Int) -ppStream i - Stream - { streamId = id - , streamBuffer = buffer - , streamExpr = e - , streamExprType = t - } - = - (text (printf "%s [label=\"stream: %s\ntype: %s\",color=mediumblue, style=filled]\n" (show i::String) (show id::String) (showType t::String)) - <> text (printf "%s [label=\"++\",color=yellow, style=filled]\n" ((show $ i+1)::String)) - <> text (printf "%s -> %s\n" (show i::String) ((show $ i+1)::String)) - <> text (printf "%s [label=\"[%s]\",color=green, style=filled]\n" ((show $ i+2)::String) ((concat $ intersperse "," $ map (showWithType Haskell t) buffer )) ::String) - <> text (printf "%s -> %s\n" (show (i+1)::String) ((show $ i+2)::String)) - <> r1, i1) - where - (r1, i1) = ppExprDot (i+3) (i+1) True e - --- | Pretty print a trigger as a GraphViz graph part. -ppTrigger :: Int -- ^ Index or ID of the next node in the graph. - -> Trigger -- ^ Trigger to pretty print - -> (Doc, Int) -ppTrigger i - Trigger - { triggerName = name - , triggerGuard = e - , triggerArgs = args } - = ( text (printf "%s [label=\"trigger: %s\",color=mediumblue, style=filled]\n" (show i::String) (name::String) ) - <> text (printf "%s [label=\"guard\",color=yellow, style=filled]\n" ((show $ i+1)::String)) - <> text (printf "%s -> %s\n" (show i::String) ((show $ i+1)::String)) - <> r1 - <> text (printf "%s [label=\"args\",color=yellow, style=filled]\n" (show i1::String)) - <> text (printf "%s -> %s\n" (show i::String) (show i1::String)) - <> (vcat (r2)) - ,i2) - where - (r1, i1) = ppExprDot (i+2) (i+1) True e - (r2, i2) = ppUExprL (i1+1) (i1) True args - --- | Pretty print a list of untyped Copilot Expressions as a GraphViz graph --- part. -ppUExprL :: Int -- ^ Index or ID of the next node in the graph. - -> Int -- ^ Index or ID of the parent node in the graph. - -> Bool -- ^ Mark externs with the prefix @externV:@. - -> [UExpr] -- ^ The list of expressions to pretty print. - -> ([Doc], Int) -ppUExprL i _ _ [] = ([], i) - -ppUExprL i pere bb (a:b) = ((r1:r2), i2) - where - (r1, i1) = ppUExpr i pere bb a - (r2, i2) = ppUExprL i1 pere bb b - --- | Pretty print an observer as a GraphViz graph part. -ppObserver :: Int -- ^ Index or ID of the next node in the graph. - -> Observer -- ^ Observer to pretty print - -> (Doc, Int) -ppObserver i - Observer - { observerName = name - , observerExpr = e } - = - (text (printf "%s [label=\"observer: \n%s\",color=mediumblue, style=filled]\n" (show i::String) name::String) - <> r1, i1) - where - (r1, i1) = ppExprDot (i+1) i True e - --- | Pretty print a property as a GraphViz graph part. -ppProperty :: Int -- ^ Index or ID of the next node in the graph. - -> Property -- ^ Property to pretty print - -> (Doc, Int) -ppProperty i - Property - { propertyName = name - , propertyExpr = e } - = - (text (printf "%s [label=\"property: \n%s\",color=mediumblue, style=filled]\n" (show i::String) name::String) - <> r1, i1) - where - (r1, i1) = ppExprDot (i+1) i True e - --- | Pretty print a list of streams as a GraphViz graph part. -ppStreamL :: Int -- ^ Index or ID of the next node in the graph. - -> [Stream] -- ^ List of streams to pretty print - -> (Doc, Int) -ppStreamL i [] = (empty,i) - -ppStreamL i (a:b) = ((s1$$s2),(i2)) - where - (s1,i1) = ppStream i a - (s2,i2) = ppStreamL i1 b - --- | Pretty print a list of triggers as a GraphViz graph part. -ppTriggerL :: Int -- ^ Index or ID of the next node in the graph. - -> [Trigger] -- ^ List of triggers to pretty print - -> (Doc, Int) -ppTriggerL i [] = (empty,i) - -ppTriggerL i (a:b) = ((s1$$s2),(i2)) - where - (s1,i1) = ppTrigger i a - (s2,i2) = ppTriggerL i1 b - --- | Pretty print a list of observers as a GraphViz graph part. -ppObserverL :: Int -- ^ Index or ID of the next node in the graph. - -> [Observer] -- ^ List of observers to pretty print - -> (Doc, Int) -ppObserverL i [] = (empty,i) - -ppObserverL i (a:b) = ((s1$$s2),(i2)) - where - (s1,i1) = ppObserver i a - (s2,i2) = ppObserverL i1 b - --- | Pretty print a list of properties as a GraphViz graph part. -ppPropertyL :: Int -- ^ Index or ID of the next node in the graph. - -> [Property] -- ^ List of properties to pretty print - -> (Doc, Int) -ppPropertyL i [] = (empty,i) - -ppPropertyL i (a:b) = ((s1$$s2),(i2)) - where - (s1,i1) = ppProperty i a - (s2,i2) = ppPropertyL i1 b - --- | Pretty-print a Copilot specification as a GraphViz/dot graph. -ppSpecDot :: Int -- ^ Index or ID of the next node in the graph. - -> Spec -- ^ Spec to pretty print. - -> (Doc, Int) -ppSpecDot i spec = - ((aa $$ cs $$ ds $$ es $$ fs $$ bb),i4) - where - aa = text "digraph G {\nnode [shape=box]\n" - (cs, i1) = ppStreamL i (specStreams spec) - (ds, i2) = ppTriggerL i1 (specTriggers spec) - (es, i3) = ppObserverL i2 (specObservers spec) - (fs, i4) = ppPropertyL i3 (specProperties spec) - bb = text "\n}\n" - --- | Pretty-print a Copilot expression as a GraphViz/dot graph. -prettyPrintExprDot :: Bool -- ^ Mark externs with the prefix @externV:@. - -> Expr a -- ^ The expression to pretty print. - -> String -prettyPrintExprDot bb s = render rr - where - (r1, _) = ppExprDot 1 0 bb s - rr = text "digraph G {\nnode [shape=box]\n" $$ (text "0 [label=\"file: \n?????\",color=red, style=filled]\n") <> r1 $$ text "\n}\n" - --- | Pretty-print a Copilot specification as a GraphViz/dot graph. -prettyPrintDot :: Spec -> String -prettyPrintDot s = render r1 - where - (r1, _) = ppSpecDot 0 s From 12342630c85ce9a292b65bf23f90c7c24215932d Mon Sep 17 00:00:00 2001 From: Will Pogge Date: Tue, 7 Feb 2023 13:39:50 -0500 Subject: [PATCH 0565/1222] copilot-core: Document changes in CHANGELOG. Refs #409. --- copilot-core/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-core/CHANGELOG b/copilot-core/CHANGELOG index a7f6f872e..161da40e9 100644 --- a/copilot-core/CHANGELOG +++ b/copilot-core/CHANGELOG @@ -1,3 +1,6 @@ +2023-02-07 + * Remove Copilot.Core.PrettyDot. (#409) + 2023-01-07 * Version bump (3.13). (#406) * Implement missing cases of type equality for arrays and structs. From 2c3f4cbdae789ecc0f7cb7f605b418e8a634e5d1 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 17 Feb 2023 18:24:20 -0800 Subject: [PATCH 0566/1222] copilot-core: Fix formatting error in CHANGELOG. Refs #414. During the last release (3.13), a formatting error was introduced in the copilot-core's CHANGELOG. Each block of changes should be associated to a release, but we have an "orphan" block with no release (dated 2022-12-27). This commit merges that block with the one corresponding to the next release (2023-01-07). --- copilot-core/CHANGELOG | 2 -- 1 file changed, 2 deletions(-) diff --git a/copilot-core/CHANGELOG b/copilot-core/CHANGELOG index 161da40e9..5f54522aa 100644 --- a/copilot-core/CHANGELOG +++ b/copilot-core/CHANGELOG @@ -5,8 +5,6 @@ * Version bump (3.13). (#406) * Implement missing cases of type equality for arrays and structs. (#400) - -2022-12-27 * Remove Copilot.Core.External. (#391) * Fix bug in definition of simpleType for Int8. (#393) * Hide module Copilot.Core.Type.Show. (#392) From 25e51ac552e1a1f25162f3fc26561dcd31d81f37 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 17 Feb 2023 18:26:16 -0800 Subject: [PATCH 0567/1222] copilot-core: Document changes in CHANGELOG. Refs #414. --- copilot-core/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot-core/CHANGELOG b/copilot-core/CHANGELOG index 5f54522aa..c20e714ee 100644 --- a/copilot-core/CHANGELOG +++ b/copilot-core/CHANGELOG @@ -1,5 +1,6 @@ -2023-02-07 +2023-02-17 * Remove Copilot.Core.PrettyDot. (#409) + * Fix formatting error in CHANGELOG. (#414) 2023-01-07 * Version bump (3.13). (#406) From daa31397e24c93285f6f7d3b725a1fcee568f4e5 Mon Sep 17 00:00:00 2001 From: Will Pogge Date: Tue, 21 Feb 2023 13:53:27 -0500 Subject: [PATCH 0568/1222] copilot: Replace import of Copilot.Language.prettyPrint. Refs #412. We have decided to remove the function Copilot.Language.prettyPrint from the copilot-language library. This commit adds the implementation of that function as a local definition in Language.Copilot.Main so that it can be used by defaultMain. The new code uses Copilot.PrettyPrint.prettyPrint. --- copilot/src/Language/Copilot/Main.hs | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/copilot/src/Language/Copilot/Main.hs b/copilot/src/Language/Copilot/Main.hs index 3b42b23ff..cc23524b3 100644 --- a/copilot/src/Language/Copilot/Main.hs +++ b/copilot/src/Language/Copilot/Main.hs @@ -3,9 +3,10 @@ module Language.Copilot.Main ( copilotMain, defaultMain ) where import qualified Copilot.Core as C (Spec) -import Copilot.Language (interpret, prettyPrint) +import Copilot.Language (interpret) import Copilot.Language.Reify (reify) import Copilot.Language (Spec) +import qualified Copilot.PrettyPrint as PP import Options.Applicative import Data.Semigroup ((<>)) @@ -86,3 +87,8 @@ copilotMain interp pretty comp spec = main =<< execParser opts -- command line options. defaultMain :: Compiler -> Spec -> IO () defaultMain = copilotMain interpret prettyPrint + where + -- Transform a high-level Copilot Language specification into a low-level + -- Copilot Core specification and pretty-print it to stdout. + prettyPrint :: Spec -> IO () + prettyPrint e = fmap PP.prettyPrint (reify e) >>= putStr From 6de3660e2ef35d8c7834d143102101eb36b2f5e5 Mon Sep 17 00:00:00 2001 From: Will Pogge Date: Tue, 21 Feb 2023 13:53:03 -0500 Subject: [PATCH 0569/1222] copilot: Add dependency for copilot-prettyprinter. Refs #412. --- copilot/copilot.cabal | 21 +++++++++++---------- 1 file changed, 11 insertions(+), 10 deletions(-) diff --git a/copilot/copilot.cabal b/copilot/copilot.cabal index 8636dc8a1..bc6dc9c9d 100644 --- a/copilot/copilot.cabal +++ b/copilot/copilot.cabal @@ -47,16 +47,17 @@ library -Wall -fno-warn-orphans build-depends: - base >= 4.9 && < 5 - , optparse-applicative >= 0.14 && < 0.18 - , directory >= 1.3 && < 1.4 - , filepath >= 1.4 && < 1.5 - - , copilot-core >= 3.13 && < 3.14 - , copilot-theorem >= 3.13 && < 3.14 - , copilot-language >= 3.13 && < 3.14 - , copilot-libraries >= 3.13 && < 3.14 - , copilot-c99 >= 3.13 && < 3.14 + base >= 4.9 && < 5 + , optparse-applicative >= 0.14 && < 0.18 + , directory >= 1.3 && < 1.4 + , filepath >= 1.4 && < 1.5 + + , copilot-core >= 3.13 && < 3.14 + , copilot-theorem >= 3.13 && < 3.14 + , copilot-language >= 3.13 && < 3.14 + , copilot-libraries >= 3.13 && < 3.14 + , copilot-c99 >= 3.13 && < 3.14 + , copilot-prettyprinter >= 3.13 && < 3.14 exposed-modules: Language.Copilot, Language.Copilot.Main From 90905f9740b7f1e2551ca30713160972a36fe32b Mon Sep 17 00:00:00 2001 From: Will Pogge Date: Tue, 21 Feb 2023 08:53:26 -0500 Subject: [PATCH 0570/1222] copilot-language: Remove Copilot.Language.prettyPrint. Refs #412. The function Copilot.Language.prettyPrint is not being used by any other part of Copilot. It was deprecated in Copilot 3.11 and no messages have been received requesting that it be kept in the implementation. As per our internal policy of waiting 3 versions from deprecation until a public interface declaration can be removed, this function can now be removed. This commit removes the function completely. The function prettyPrint, which was imported from copilot-prettyprinter, is no longer needed. --- copilot-language/src/Copilot/Language.hs | 8 -------- 1 file changed, 8 deletions(-) diff --git a/copilot-language/src/Copilot/Language.hs b/copilot-language/src/Copilot/Language.hs index 5d950a28e..8dda0ef87 100644 --- a/copilot-language/src/Copilot/Language.hs +++ b/copilot-language/src/Copilot/Language.hs @@ -39,7 +39,6 @@ module Copilot.Language , prop , theorem , forall, exists - , prettyPrint ) where import Data.Int hiding (Int) @@ -67,10 +66,3 @@ import Copilot.Language.Reify import Copilot.Language.Prelude import Copilot.Language.Spec import Copilot.Language.Stream (Stream) -import qualified Copilot.PrettyPrint as PP - --- | Transform a high-level Copilot Language specification into a low-level --- Copilot Core specification and pretty-print it to stdout. -{-# DEPRECATED prettyPrint "This function is deprecated in Copilot 3.11." #-} -prettyPrint :: Spec -> IO () -prettyPrint e = fmap PP.prettyPrint (reify e) >>= putStr From 03059b61d4ec459dd949445e826329e9cb3d193a Mon Sep 17 00:00:00 2001 From: Will Pogge Date: Tue, 21 Feb 2023 08:50:19 -0500 Subject: [PATCH 0571/1222] copilot-language: Remove dependency on copilot-prettyprinter. Refs #412. The function Copilot.Language.prettyPrint is not being used by any other part of Copilot. It was deprecated in Copilot 3.11 and no messages have been received requesting that it be kept in the implementation. As per our internal policy of waiting 3 versions from deprecation until a public interface declaration can be removed, this function can be removed. A prior commit removed the function. The library copilot-language no longer imports any definitions from copilot-prettyprinter, so that library can now be removed from the dependency list in the cabal file. --- copilot-language/copilot-language.cabal | 1 - 1 file changed, 1 deletion(-) diff --git a/copilot-language/copilot-language.cabal b/copilot-language/copilot-language.cabal index f6e97ce2f..3c6a7d6ec 100644 --- a/copilot-language/copilot-language.cabal +++ b/copilot-language/copilot-language.cabal @@ -44,7 +44,6 @@ library , copilot-core >= 3.13 && < 3.14 , copilot-interpreter >= 3.13 && < 3.14 - , copilot-prettyprinter >= 3.13 && < 3.14 , copilot-theorem >= 3.13 && < 3.14 exposed-modules: Copilot.Language From ff350418fd0493e379acb484f9c28e67a4386c26 Mon Sep 17 00:00:00 2001 From: Will Pogge Date: Tue, 21 Feb 2023 14:11:31 -0500 Subject: [PATCH 0572/1222] copilot: Document changes in CHANGELOG. Refs #412. --- copilot/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot/CHANGELOG b/copilot/CHANGELOG index 587c1f749..88ed5414c 100644 --- a/copilot/CHANGELOG +++ b/copilot/CHANGELOG @@ -1,3 +1,6 @@ +2023-02-21 + * Replace import of Copilot.Language.prettyPrint. (#412) + 2023-01-07 * Version bump (3.13). (#406) From ead6ba56ea80cf95b226c7f99f87325213362298 Mon Sep 17 00:00:00 2001 From: Will Pogge Date: Tue, 21 Feb 2023 13:40:23 -0500 Subject: [PATCH 0573/1222] copilot-language: Document changes in CHANGELOG. Refs #412. --- copilot-language/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-language/CHANGELOG b/copilot-language/CHANGELOG index 7f516d6e6..2f2e0ddb0 100644 --- a/copilot-language/CHANGELOG +++ b/copilot-language/CHANGELOG @@ -1,3 +1,6 @@ +2023-02-21 + * Remove function Copilot.Language.prettyPrint. (#412) + 2023-01-07 * Version bump (3.13). (#406) From b5f78eb6b9cdeb90349ead583397cc8717614add Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 4 Mar 2023 00:21:16 +0000 Subject: [PATCH 0574/1222] copilot-core: Remove module space Copilot.Core.Interpret. Refs #410. The modules Copilot.Core.Interpret and Copilot.Core.Interpret.Eval are not being used by any other part of Copilot. They were deprecated in Copilot 3.11 and their code moved to the copilot-interpreter library. As per our internal policy of waiting 3 versions from deprecation until a public interface declaration can be removed, this module can now be removed. This commit removes all modules in copilot-core specific to the interpreter, and adjusts the Cabal file so that there are no references to them. --- copilot-core/copilot-core.cabal | 3 - copilot-core/src/Copilot/Core/Interpret.hs | 35 -- .../src/Copilot/Core/Interpret/Eval.hs | 352 ------------------ .../src/Copilot/Core/Interpret/Render.hs | 127 ------- 4 files changed, 517 deletions(-) delete mode 100644 copilot-core/src/Copilot/Core/Interpret.hs delete mode 100644 copilot-core/src/Copilot/Core/Interpret/Eval.hs delete mode 100644 copilot-core/src/Copilot/Core/Interpret/Render.hs diff --git a/copilot-core/copilot-core.cabal b/copilot-core/copilot-core.cabal index 51a193ce3..9363ac616 100644 --- a/copilot-core/copilot-core.cabal +++ b/copilot-core/copilot-core.cabal @@ -49,8 +49,6 @@ library Copilot.Core Copilot.Core.Expr - Copilot.Core.Interpret - Copilot.Core.Interpret.Eval Copilot.Core.Operators Copilot.Core.Spec Copilot.Core.Type @@ -61,7 +59,6 @@ library other-modules: Copilot.Core.Error - Copilot.Core.Interpret.Render Copilot.Core.Type.Show test-suite unit-tests diff --git a/copilot-core/src/Copilot/Core/Interpret.hs b/copilot-core/src/Copilot/Core/Interpret.hs deleted file mode 100644 index 7789a4d60..000000000 --- a/copilot-core/src/Copilot/Core/Interpret.hs +++ /dev/null @@ -1,35 +0,0 @@ --- The following warning is enabled in this module so that the import of --- Copilot.Core.Interpret.Eval and Render do not give rise to warnings. -{-# OPTIONS_GHC -fno-warn-deprecations #-} - --- Copyright © 2011 National Institute of Aerospace / Galois, Inc. - --- | An interpreter for Copilot specifications. - -{-# LANGUAGE Safe #-} - -module Copilot.Core.Interpret - {-# DEPRECATED "This module is deprecated in Copilot 3.11. Use copilot-interpreter instead." #-} - ( Format (..) - , interpret - ) where - -import Copilot.Core -import Copilot.Core.Interpret.Eval -import Copilot.Core.Interpret.Render -import Copilot.Core.Type.Show (ShowType (..)) - --- | Output format for the results of a Copilot spec interpretation. -data Format = Table | CSV - --- | Interpret a Copilot specification. -interpret :: Format -- ^ Format to be used for the output. - -> Int -- ^ Number of steps to interpret. - -> Spec -- ^ Specification to interpret. - -> String -interpret format k spec = - case format of - Table -> renderAsTable e - CSV -> renderAsCSV e - where - e = eval Haskell k spec diff --git a/copilot-core/src/Copilot/Core/Interpret/Eval.hs b/copilot-core/src/Copilot/Core/Interpret/Eval.hs deleted file mode 100644 index 4f338f80c..000000000 --- a/copilot-core/src/Copilot/Core/Interpret/Eval.hs +++ /dev/null @@ -1,352 +0,0 @@ --- Copyright © 2011 National Institute of Aerospace / Galois, Inc. - --- | A tagless interpreter for Copilot specifications. - -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE Safe #-} - -module Copilot.Core.Interpret.Eval - {-# DEPRECATED "This module is deprecated in Copilot 3.11. Use copilot-interpreter instead." #-} - ( Env - , Output - , ExecTrace (..) - , eval - , ShowType (..) - ) where - -import Copilot.Core (Expr (..), Field (..), Id, Name, Observer (..), - Op1 (..), Op2 (..), Op3 (..), Spec, Stream (..), - Trigger (..), Type (Struct), UExpr (..), - arrayelems, specObservers, specStreams, - specTriggers) -import Copilot.Core.Error (badUsage) -import Copilot.Core.Type.Show (ShowType (..), showWithType) - -import Prelude hiding (id) -import qualified Prelude as P - -import Control.Exception (Exception, throw) -import Data.Bits (complement, shiftL, shiftR, xor, (.&.), (.|.)) -import Data.Dynamic (Dynamic, fromDynamic, toDyn) -import Data.List (transpose) -import Data.Maybe (fromJust) -import Data.Typeable (Typeable) - --- | Exceptions that may be thrown during interpretation of a Copilot --- specification. -data InterpException - = ArrayWrongSize Name Int -- ^ Extern array has incorrect size. - | ArrayIdxOutofBounds Name Int Int -- ^ Index out-of-bounds exception. - | DivideByZero -- ^ Division by zero. - | NotEnoughValues Name Int -- ^ For one or more streams, not enough - -- values are available to simulate the - -- number of steps requested. - | NoExtsInterp Name -- ^ One of the externs used by the - -- specification does not declare - -- sample values to be used during - -- simulation. - deriving Typeable - --- | Show a descriptive message of the exception. -instance Show InterpException where - --------------------------------------- - show (ArrayWrongSize name expectedSize) = - badUsage $ "in the environment for external array " ++ name - ++ ", we expect a list of length " ++ show expectedSize - ++ ", but the length of the array you supplied is of a different length." - --------------------------------------- - show (ArrayIdxOutofBounds name index size) = - badUsage $ "in the environment for external array " ++ name - ++ ", you gave an index of " ++ show index - ++ " where the size of the array is " ++ show size ++ "; the size must " - ++ " be strictly greater than the index." - --------------------------------------- - show DivideByZero = - badUsage "divide by zero." - --------------------------------------- - show (NotEnoughValues name k) = - badUsage $ "on the " ++ show k ++ "th iteration, we ran out of " - ++ "values for simulating the external element " ++ name ++ "." - --------------------------------------- - show (NoExtsInterp name) = - badUsage $ "in a call of external symbol " ++ name ++ ", you did not " - ++ "provide an expression for interpretation. In your external " - ++ "declaration, you need to provide a 'Just strm', where 'strm' is " - ++ "some stream with which to simulate the function." - --------------------------------------- - --- | Allow throwing and catching 'InterpException' using Haskell's standard --- exception mechanisms. -instance Exception InterpException - --- | An environment that contains an association between (stream or extern) --- names and their values. -type Env nm = [(nm, Dynamic)] - --- | The simulation output is defined as a string. Different backends may --- choose to format their results differently. -type Output = String - --- | An execution trace, containing the traces associated to each individual --- monitor trigger and observer. -data ExecTrace = ExecTrace - { interpTriggers :: [(String, [Maybe [Output]])] - - -- ^ Map from trigger names to their optional output, which is a list of - -- strings representing their values. The output may be 'Nothing' if the - -- guard for the trigger was false. The order is important, since we - -- compare the arg lists between the interpreter and backends. - - , interpObservers :: [(String, [Output])] - -- ^ Map from observer names to their outputs. - } - deriving Show - --- We could write this in a beautiful lazy style like above, but that creates a --- space leak in the interpreter that is hard to fix while maintaining laziness. --- We take a more brute-force appraoch below. - --- | Evaluate a specification for a number of steps. -eval :: ShowType -- ^ Show booleans as @0@\/@1@ (C) or @True@\/@False@ - -- (Haskell). - -> Int -- ^ Number of steps to evaluate. - -> Spec -- ^ Specification to evaluate. - -> ExecTrace -eval showType k spec = - - let initStrms = map initStrm (specStreams spec) in - - let strms = evalStreams k (specStreams spec) initStrms in - - let trigs = map (evalTrigger showType k strms) - (specTriggers spec) in - - let obsvs = map (evalObserver showType k strms) - (specObservers spec) in - - strms `seq` ExecTrace - { interpTriggers = - zip (map triggerName (specTriggers spec)) trigs - , interpObservers = - zip (map observerName (specObservers spec)) obsvs - } - --- | An environment that contains an association between (stream or extern) --- names and their values. -type LocalEnv = [(Name, Dynamic)] - --- | Evaluate an expression for a number of steps, obtaining the value --- of the sample at that time. -evalExpr_ :: Typeable a => Int -> Expr a -> LocalEnv -> Env Id -> a -evalExpr_ k e0 locs strms = case e0 of - Const _ x -> x - Drop t i id -> - let Just buff = lookup id strms >>= fromDynamic in - reverse buff !! (fromIntegral i + k) - Local t1 _ name e1 e2 -> - let x = evalExpr_ k e1 locs strms in - let locs' = (name, toDyn x) : locs in - x `seq` locs' `seq` evalExpr_ k e2 locs' strms - Var t name -> fromJust $ lookup name locs >>= fromDynamic - ExternVar _ name xs -> evalExternVar k name xs - Op1 op e1 -> - let ev1 = evalExpr_ k e1 locs strms in - let op1 = evalOp1 op in - ev1 `seq` op1 `seq` op1 ev1 - Op2 op e1 e2 -> - let ev1 = evalExpr_ k e1 locs strms in - let ev2 = evalExpr_ k e2 locs strms in - let op2 = evalOp2 op in - ev1 `seq` ev2 `seq` op2 `seq` op2 ev1 ev2 - Op3 op e1 e2 e3 -> - let ev1 = evalExpr_ k e1 locs strms in - let ev2 = evalExpr_ k e2 locs strms in - let ev3 = evalExpr_ k e3 locs strms in - let op3 = evalOp3 op in - ev1 `seq` ev2 `seq` ev3 `seq` op3 `seq` op3 ev1 ev2 ev3 - Label _ _ e1 -> - let ev1 = evalExpr_ k e1 locs strms in - ev1 - --- | Evaluate an extern stream for a number of steps, obtaining the value of --- the sample at that time. -evalExternVar :: Int -> Name -> Maybe [a] -> a -evalExternVar k name exts = - case exts of - Nothing -> throw (NoExtsInterp name) - Just xs -> - case safeIndex k xs of - Nothing -> throw (NotEnoughValues name k) - Just x -> x - --- | Evaluate an 'Copilot.Core.Operators.Op1' by producing an equivalent --- Haskell function operating on the same types as the --- 'Copilot.Core.Operators.Op1'. -evalOp1 :: Op1 a b -> (a -> b) -evalOp1 op = case op of - Not -> P.not - Abs _ -> P.abs - Sign _ -> P.signum - Recip _ -> P.recip - Exp _ -> P.exp - Sqrt _ -> P.sqrt - Log _ -> P.log - Sin _ -> P.sin - Tan _ -> P.tan - Cos _ -> P.cos - Asin _ -> P.asin - Atan _ -> P.atan - Acos _ -> P.acos - Sinh _ -> P.sinh - Tanh _ -> P.tanh - Cosh _ -> P.cosh - Asinh _ -> P.asinh - Atanh _ -> P.atanh - Acosh _ -> P.acosh - Ceiling _ -> P.fromIntegral . idI . P.ceiling - Floor _ -> P.fromIntegral . idI . P.floor - BwNot _ -> complement - Cast _ _ -> P.fromIntegral - GetField (Struct _) _ f -> unfield . f - where - -- Used to help GHC pick a return type for ceiling/floor - idI :: Integer -> Integer - idI = P.id - - -- Extract value from field - unfield (Field v) = v - --- | Evaluate an 'Copilot.Core.Operators.Op2' by producing an equivalent --- Haskell function operating on the same types as the --- 'Copilot.Core.Operators.Op2'. -evalOp2 :: Op2 a b c -> (a -> b -> c) -evalOp2 op = case op of - And -> (&&) - Or -> (||) - Add _ -> (+) - Sub _ -> (-) - Mul _ -> (*) - Mod _ -> (catchZero P.mod) - Div _ -> (catchZero P.quot) - Fdiv _ -> (P./) - Pow _ -> (P.**) - Logb _ -> P.logBase - Atan2 _ -> P.atan2 - Eq _ -> (==) - Ne _ -> (/=) - Le _ -> (<=) - Ge _ -> (>=) - Lt _ -> (<) - Gt _ -> (>) - BwAnd _ -> (.&.) - BwOr _ -> (.|.) - BwXor _ -> (xor) - BwShiftL _ _ -> ( \ !a !b -> shiftL a $! fromIntegral b ) - BwShiftR _ _ -> ( \ !a !b -> shiftR a $! fromIntegral b ) - Index _ -> \xs n -> (arrayelems xs) !! (fromIntegral n) - --- | Apply a function to two numbers, so long as the second one is --- not zero. --- --- Used to detect attempts at dividing by zero and produce the appropriate --- 'InterpException'. -catchZero :: Integral a => (a -> a -> a) -> (a -> a -> a) -catchZero _ _ 0 = throw DivideByZero -catchZero f x y = f x y - --- | Evaluate an 'Copilot.Core.Operators.Op3' by producing an equivalent --- Haskell function operating on the same types as the --- 'Copilot.Core.Operators.Op3'. -evalOp3 :: Op3 a b c d -> (a -> b -> c -> d) -evalOp3 (Mux _) = \ !v !x !y -> if v then x else y - --- | Turn a stream into a key-value pair that can be added to an 'Env' for --- simulation. -initStrm :: Stream -> (Id, Dynamic) -initStrm Stream { streamId = id - , streamBuffer = buffer - , streamExprType = t } = - (id, toDyn (reverse buffer)) - --- | Evaluate several streams for a number of steps, producing the environment --- at the end of the evaluation. -evalStreams :: Int -> [Stream] -> Env Id -> Env Id -evalStreams top specStrms initStrms = - -- XXX actually only need to compute until shortest stream is of length k - -- XXX this should just be a foldl' over [0,1..k] - evalStreams_ 0 initStrms - where - evalStreams_ :: Int -> Env Id -> Env Id - evalStreams_ k strms | k == top = strms - evalStreams_ k strms | otherwise = - evalStreams_ (k+1) $! strms_ - where - strms_ = map evalStream specStrms - evalStream Stream { streamId = id - , streamExpr = e - , streamExprType = t } = - let xs = fromJust $ lookup id strms >>= fromDynamic in - let x = evalExpr_ k e [] strms in - let ls = x `seq` (x:xs) in - (id, toDyn ls) - --- | Evaluate a trigger for a number of steps. -evalTrigger :: ShowType -- ^ Show booleans as @0@/@1@ (C) or - -- @True@/@False@ (Haskell). - -> Int -- ^ Number of steps to evaluate. - -> Env Id -- ^ Environment to use with known - -- stream-value associations. - -> Trigger -- ^ Trigger to evaluate. - -> [Maybe [Output]] -evalTrigger showType k strms - Trigger - { triggerGuard = e - , triggerArgs = args - } = map tag (zip bs vs) - - where - tag :: (Bool, a) -> Maybe a - tag (True, x) = Just x - tag (False, _) = Nothing - - -- Is the guard true? - bs :: [Bool] - bs = evalExprs_ k e strms - - -- The argument outputs. - vs :: [[Output]] - vs = if null args then replicate k [] -- might be 0 args. - else transpose $ map evalUExpr args - - evalUExpr :: UExpr -> [Output] - evalUExpr (UExpr t e1) = - map (showWithType showType t) (evalExprs_ k e1 strms) - --- | Evaluate an observer for a number of steps. -evalObserver :: ShowType -- ^ Show booleans as @0@/@1@ (C) or @True@/@False@ - -- (Haskell). - -> Int -- ^ Number of steps to evaluate. - -> Env Id -- ^ Environment to use with known stream-value - -- associations. - -> Observer -- ^ Observer to evaluate. - -> [Output] -evalObserver showType k strms - Observer - { observerExpr = e - , observerExprType = t } - = map (showWithType showType t) (evalExprs_ k e strms) - --- | Evaluate an expression for a number of steps, producing a list with the --- changing value of the expression until that time. -evalExprs_ :: Typeable a => Int -> Expr a -> Env Id -> [a] -evalExprs_ k e strms = - map (\i -> evalExpr_ i e [] strms) [0..(k-1)] - --- | Safe indexing (!!) on possibly infininite lists. -safeIndex :: Int -> [a] -> Maybe a -safeIndex i ls = - let ls' = take (i+1) ls in - if length ls' > i then Just (ls' !! i) - else Nothing diff --git a/copilot-core/src/Copilot/Core/Interpret/Render.hs b/copilot-core/src/Copilot/Core/Interpret/Render.hs deleted file mode 100644 index b0762d43c..000000000 --- a/copilot-core/src/Copilot/Core/Interpret/Render.hs +++ /dev/null @@ -1,127 +0,0 @@ --- The following warning is enabled in this module so that the import of --- Copilot.Core.Interpret.Eval does not give rise to a warning. -{-# OPTIONS_GHC -fno-warn-deprecations #-} - --- Copyright © 2011 National Institute of Aerospace / Galois, Inc. - --- | Pretty-print the results of a simulation. - -{-# LANGUAGE Safe #-} - -module Copilot.Core.Interpret.Render - {-# DEPRECATED "This module is deprecated in Copilot 3.11. Use copilot-interpreter instead." #-} - ( renderAsTable - , renderAsCSV - ) where - -import Data.List (intersperse, transpose, foldl') -import Data.Maybe (catMaybes) -import Copilot.Core.Interpret.Eval (Output, ExecTrace (..)) -import Text.PrettyPrint - -import Prelude hiding ((<>)) - --- | Render an execution trace as a table, formatted to faciliate readability. -renderAsTable :: ExecTrace -> String -renderAsTable - ExecTrace - { interpTriggers = trigs - , interpObservers = obsvs } = ( render - . asColumns - . transpose - . (:) (ppTriggerNames ++ ppObserverNames) - . transpose - ) (ppTriggerOutputs ++ ppObserverOutputs) - where - - ppTriggerNames :: [Doc] - ppTriggerNames = map (text . (++ ":")) (map fst trigs) - - ppObserverNames :: [Doc] - ppObserverNames = map (text . (++ ":")) (map fst obsvs) - - ppTriggerOutputs :: [[Doc]] - ppTriggerOutputs = map (map ppTriggerOutput) (map snd trigs) - - ppTriggerOutput :: Maybe [Output] -> Doc - ppTriggerOutput (Just vs) = text $ "(" ++ concat (intersperse "," vs) ++ ")" - ppTriggerOutput Nothing = text "--" - - ppObserverOutputs :: [[Doc]] - ppObserverOutputs = map (map text) (map snd obsvs) - --- | Render an execution trace as using comma-separate value (CSV) format. -renderAsCSV :: ExecTrace -> String -renderAsCSV = render . unfold - --- | Pretty print all the steps of the execution trace and concatenate the --- results. -unfold :: ExecTrace -> Doc -unfold r = - case step r of - (cs, Nothing) -> cs - (cs, Just r') -> cs $$ unfold r' - --- | Pretty print the state of the triggers, and provide a continuation --- for the execution trace at the next point in time. -step :: ExecTrace -> (Doc, Maybe ExecTrace) -step ExecTrace - { interpTriggers = trigs - } = - if null trigs then (empty, Nothing) - else (foldl' ($$) empty (text "#" : ppTriggerOutputs), tails) - - where - - ppTriggerOutputs :: [Doc] - ppTriggerOutputs = - catMaybes - . fmap ppTriggerOutput - . map (fmap head) - $ trigs - - ppTriggerOutput :: (String, Maybe [Output]) -> Maybe Doc - ppTriggerOutput (_, Nothing) = Nothing - ppTriggerOutput (cs, Just xs) = Just $ - text cs <> text "," <> - (foldr (<>) empty . map text . intersperse ",") xs - - tails :: Maybe ExecTrace - tails = - if any null (fmap (tail.snd) trigs) - then Nothing - else Just - ExecTrace - { interpTriggers = map (fmap tail) trigs - , interpObservers = [] - } - --- Copied from pretty-ncols because of incompatibility with newer GHC versions. -asColumns :: [[Doc]] -> Doc -asColumns = flip asColumnsWithBuff $ 1 - -asColumnsWithBuff :: [[Doc]] -> Int -> Doc -asColumnsWithBuff lls q = normalize - where - normalize = vcat $ map hsep - $ map (\x -> pad (length x) longColumnLen empty x) - $ pad' longEntryLen q - $ transpose lls -- normalize column height - longColumnLen = maximum (map length lls) - longEntryLen = maximum $ map docLen (concat lls) - -docLen d = length $ render d - --- | Pad a string on the right to reach an expected length. -pad :: Int -> Int -> a -> [a] -> [a] -pad lx max b ls = ls ++ replicate (max - lx) b - --- | Pad a list of strings on the right with spaces. -pad' :: Int -- ^ Mininum number of spaces to add - -> Int -- ^ Maximum number of spaces to add - -> [[Doc]] -- ^ List of documents to pad - -> [[Doc]] -pad' _ _ [] = [] -pad' mx q (ls:xs) = map buf ls : pad' mx q xs - where - buf x = x <> (hcat $ replicate q space) <> (hcat $ replicate (mx - (docLen x)) space) From 37f65dfc3db6d710354cd44a3212f14b18919084 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 7 Mar 2023 17:54:49 +0000 Subject: [PATCH 0575/1222] copilot-core: Remove Copilot.Core.Error.badUsage. Refs #410. The function Copilot.Core.Error.badUsage was only being used by Copilot.Core.Interpret.Eval. It's not exposed in the API, and therefore not needed now that Copilot.Core.Interpret.Eval has been removed. This commit removes the function Copilot.Core.Error.badUsage. --- copilot-core/src/Copilot/Core/Error.hs | 6 ------ 1 file changed, 6 deletions(-) diff --git a/copilot-core/src/Copilot/Core/Error.hs b/copilot-core/src/Copilot/Core/Error.hs index fed3f26bf..130ba29d2 100644 --- a/copilot-core/src/Copilot/Core/Error.hs +++ b/copilot-core/src/Copilot/Core/Error.hs @@ -5,7 +5,6 @@ -- Copyright: (c) 2011 National Institute of Aerospace / Galois, Inc. module Copilot.Core.Error ( impossible - , badUsage ) where @@ -19,8 +18,3 @@ impossible function package = ++ ". Please file an issue at " ++ "https://github.com/Copilot-Language/copilot/issues" ++ "or email the maintainers at " - --- | Report an error due to an error detected by Copilot (e.g., user error). -badUsage :: String -- ^ Description of the error. - -> a -badUsage msg = error $ "Copilot error: " ++ msg From 2eed47656370721aa5b7ad454fb359f7b8c05fc5 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 4 Mar 2023 00:21:22 +0000 Subject: [PATCH 0576/1222] copilot-core: Update reference to interpreter in docs. Refs #410. All modules under the namespace Copilot.Core.Interpret have been removed from copilot-core. The interpreter is now in the library copilot-interpreter, under a different module name space. This commit updates a reference in the documentation that pointed to Copilot.Core.Interpret, so that it instead refers to the library where that implementation now lives. We cannot point to the new module name specifically because haddock cannot resolve a link to a module we do not depend on (a module which, depends on copilot-core itself). We instead choose to just name the whole library, since it's dedicated to the interpreter and fits the purpose intended in the comment. --- copilot-core/src/Copilot/Core.hs | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/copilot-core/src/Copilot/Core.hs b/copilot-core/src/Copilot/Core.hs index 65938f238..cad4aa066 100644 --- a/copilot-core/src/Copilot/Core.hs +++ b/copilot-core/src/Copilot/Core.hs @@ -16,8 +16,7 @@ -- Electronic Notes in Theoretical Computer Science vol. 174, p. 23-39, 2007. -- -- For examples of how to traverse a Copilot specification see --- the source code of the interpreter --- ("Copilot.Core.Interpret") +-- the source code of the interpreter (@copilot-interpreter@) -- and the pretty-printer -- ("Copilot.Core.PrettyPrint"). module Copilot.Core From 067f05a722b71f48864e2135c3b294b5c86cdb46 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 4 Mar 2023 00:37:54 +0000 Subject: [PATCH 0577/1222] copilot-core: Document changes in CHANGELOG. Refs #410. --- copilot-core/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot-core/CHANGELOG b/copilot-core/CHANGELOG index c20e714ee..9555026a0 100644 --- a/copilot-core/CHANGELOG +++ b/copilot-core/CHANGELOG @@ -1,6 +1,7 @@ -2023-02-17 +2023-03-03 * Remove Copilot.Core.PrettyDot. (#409) * Fix formatting error in CHANGELOG. (#414) + * Remove module space Copilot.Core.Interpret. (#410) 2023-01-07 * Version bump (3.13). (#406) From 213ca12c08384ce6f85e9227aab7e2bee8e4b501 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 7 Mar 2023 18:51:32 +0000 Subject: [PATCH 0578/1222] copilot-core: Remove tests related to definitions scheduled for removal. Refs #411. The functions Copilot.Core.Type.Array.flatten and Copilot.Core.Type.Array.size, the classes Copilot.Core.Type.Array.Flatten and Copilot.Core.Type.Array.InnerType, and the Foldable instance for Array, are not being used by any other part of Copilot. They were deprecated in Copilot 3.11 and no messages have been received requesting that they be kept in the implementation. As per our internal policy of waiting 3 versions from deprecation until a public interface declaration can be removed, these definitions can now be removed. This commit removes any tests that require those definitions that will be removed from Copilot.Core.Type.Array. --- .../tests/Test/Copilot/Core/Type/Array.hs | 89 +------------------ 1 file changed, 1 insertion(+), 88 deletions(-) diff --git a/copilot-core/tests/Test/Copilot/Core/Type/Array.hs b/copilot-core/tests/Test/Copilot/Core/Type/Array.hs index 34b56e849..4a0f0f523 100644 --- a/copilot-core/tests/Test/Copilot/Core/Type/Array.hs +++ b/copilot-core/tests/Test/Copilot/Core/Type/Array.hs @@ -13,7 +13,7 @@ import Test.QuickCheck (Gen, Property, arbitrary, forAll, vectorOf) -- Internal imports: library modules being tested -import Copilot.Core.Type.Array (Array, array, arrayelems, flatten, size) +import Copilot.Core.Type.Array (Array, array, arrayelems) -- | All unit tests for copilot-core:Copilot.Core.Array. tests :: Test.Framework.Test @@ -25,30 +25,6 @@ tests = (testArrayElemsLeft (Proxy :: Proxy 5)) , testProperty "arrayElems . array (identity; 200)" (testArrayElemsLeft (Proxy :: Proxy 200)) - , testProperty "arrayFlatten . array (identity; 0)" - (testArrayFlattenLeft (Proxy :: Proxy 0)) - , testProperty "arrayFlatten . array (identity; 1)" - (testArrayFlattenLeft (Proxy :: Proxy 1)) - , testProperty "arrayFlatten . array (identity; 2)" - (testArrayFlattenLeft (Proxy :: Proxy 2)) - , testProperty "arrayFlatten . array (identity; 22)" - (testArrayFlattenLeft (Proxy :: Proxy 22)) - , testProperty "arrayFlatten . array (identity; 50)" - (testArrayFlattenLeft (Proxy :: Proxy 50)) - , testProperty "arrayFlatten . array (identity; nested; nested; 2x6)" - (testArrayFlattenNestedLeft (Proxy :: Proxy 2) (Proxy :: Proxy 6)) - , testProperty "arrayFlatten . array (identity; nested; nested; 10x2)" - (testArrayFlattenNestedLeft (Proxy :: Proxy 10) (Proxy :: Proxy 2)) - , testProperty "arrayFlatten . array (identity; nested; nested; 38x20)" - (testArrayFlattenNestedLeft (Proxy :: Proxy 38) (Proxy :: Proxy 20)) - , testProperty "arrayFlatten . array (identity; nested; nested; 125x100)" - (testArrayFlattenNestedLeft (Proxy :: Proxy 125) (Proxy :: Proxy 100)) - , testProperty "arraySize . array (identity; 0)" - (testArraySizeLeft (Proxy :: Proxy 0)) - , testProperty "arraySize . array (identity; 45)" - (testArraySizeLeft (Proxy :: Proxy 45)) - , testProperty "arraySize . array (identity; 100)" - (testArraySizeLeft (Proxy :: Proxy 100)) ] -- * Individual tests @@ -67,66 +43,3 @@ testArrayElemsLeft len = -- Generator for lists of Int64 of known length. xsInt64 :: Gen [Int64] xsInt64 = vectorOf (fromIntegral (natVal len)) arbitrary - --- | Test that building an array from a list and extracting the elements with --- the function 'flatten' will result in the same list. --- --- This test tests only plain arrays (no nesting). -testArrayFlattenLeft :: forall n . KnownNat n => Proxy n -> Property -testArrayFlattenLeft len = - forAll xsInt64 $ \ls -> - let array' :: Array n Int64 - array' = array ls - in flatten array' == ls - - where - - -- Generator for lists of Int64 of known length. - xsInt64 :: Gen [Int64] - xsInt64 = vectorOf (fromIntegral (natVal len)) arbitrary - --- | Test that building a nested array of a known size and extracting the --- elements with the function 'flatten' will result in a list with a size that --- is the product of the sizes provided. -testArrayFlattenNestedLeft :: forall n1 n2 - . (KnownNat n1, KnownNat n2) - => Proxy n1 - -> Proxy n2 - -> Property -testArrayFlattenNestedLeft len1 len2 = - forAll xsArrays $ \array' -> - length (flatten array' :: [Int64]) == expectedSize - - where - - -- Expected size of the matrix / array. - expectedSize :: Int - expectedSize = fromIntegral $ natVal len1 * natVal len2 - - -- Generator for nested matrices of Int64 of known size. - xsArrays :: Gen (Array n1 (Array n2 Int64)) - xsArrays = - array <$> vectorOf (fromIntegral (natVal len1)) xsArrayInt64 - - -- Generator for arrays of Int64 of known length. - xsArrayInt64 :: Gen (Array n2 Int64) - xsArrayInt64 = array <$> xsInt64 - - -- Generator for lists of Int64 of known length. - xsInt64 :: Gen [Int64] - xsInt64 = vectorOf (fromIntegral (natVal len2)) arbitrary - --- | Test that building an array from a list and calculating the size will --- return the length of the list. -testArraySizeLeft :: forall n . KnownNat n => Proxy n -> Property -testArraySizeLeft len = - forAll xsInt64 $ \ls -> - let array' :: Array n Int64 - array' = array ls - in size array' == length ls - - where - - -- Generator for lists of Int64 of known length. - xsInt64 :: Gen [Int64] - xsInt64 = vectorOf (fromIntegral (natVal len)) arbitrary From 09a9ed76f779675ec10b718a7c6769b117b5ea97 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 4 Mar 2023 00:58:00 +0000 Subject: [PATCH 0579/1222] copilot-core: Remove unused definitions from Copilot.Core.Type.Array. Refs #411. The functions Copilot.Core.Type.Array.flatten and Copilot.Core.Type.Array.size, the classes Copilot.Core.Type.Array.Flatten and Copilot.Core.Type.Array.InnerType, and the Foldable instance for Array, are not being used by any other part of Copilot. They were deprecated in Copilot 3.11 and no messages have been received requesting that they be kept in the implementation. As per our internal policy of waiting 3 versions from deprecation until a public interface declaration can be removed, these definitions can now be removed. This commit removes those definitions from the module Copilot.Core.Type.Array, as well as any language extensions that were only needed for those features removed. --- copilot-core/src/Copilot/Core/Type/Array.hs | 47 +++------------------ 1 file changed, 5 insertions(+), 42 deletions(-) diff --git a/copilot-core/src/Copilot/Core/Type/Array.hs b/copilot-core/src/Copilot/Core/Type/Array.hs index afba29b45..5f0995b2c 100644 --- a/copilot-core/src/Copilot/Core/Type/Array.hs +++ b/copilot-core/src/Copilot/Core/Type/Array.hs @@ -1,11 +1,8 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE Safe #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE Safe #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} -- | -- Copyright: (c) 2011 National Institute of Aerospace / Galois, Inc. @@ -16,10 +13,6 @@ module Copilot.Core.Type.Array ( Array , array - , flatten - , size - , Flatten - , InnerType , arrayelems ) where @@ -46,36 +39,6 @@ array xs | datalen == typelen = Array xs errmsg = "Length of data (" ++ show datalen ++ ") does not match length of type (" ++ show typelen ++ ")." --- | Association between an array and the type of the elements it contains. -{-# DEPRECATED InnerType "This type family is deprecated in Copilot 3.11." #-} -type family InnerType x where - InnerType (Array _ x) = InnerType x - InnerType x = x - --- | Flattening or conversion of arrays to lists. -{-# DEPRECATED Flatten "This class is deprecated in Copilot 3.11." #-} -{-# DEPRECATED flatten "This function is deprecated in Copilot 3.11." #-} -class Flatten a b where - -- | Flatten an array to a list. - flatten :: Array n a -> [b] - --- | Flattening of plain arrays. -instance Flatten a a where - flatten (Array xs) = xs - --- | Flattening of nested arrays. -instance Flatten a b => Flatten (Array n a) b where - flatten (Array xss) = concat $ map flatten xss - --- | This instance is deprecated in Copilot 3.11. -instance Foldable (Array n) where - foldr f base (Array xs) = foldr f base xs - --- | Total number of elements in a possibly nested array. -{-# DEPRECATED size "This function is deprecated in Copilot 3.11." #-} -size :: forall a n b. (Flatten a b, b ~ InnerType a) => Array n a -> Int -size xs = length $ (flatten xs :: [b]) - -- | Return the elemts of an array. arrayelems :: Array n a -> [a] arrayelems (Array xs) = xs From 4021bafc0daba06dd943428f2438aafd6e627fc2 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 4 Mar 2023 01:00:31 +0000 Subject: [PATCH 0580/1222] copilot-core: Document changes in CHANGELOG. Refs #411. --- copilot-core/CHANGELOG | 1 + 1 file changed, 1 insertion(+) diff --git a/copilot-core/CHANGELOG b/copilot-core/CHANGELOG index 9555026a0..83ac6d1a7 100644 --- a/copilot-core/CHANGELOG +++ b/copilot-core/CHANGELOG @@ -2,6 +2,7 @@ * Remove Copilot.Core.PrettyDot. (#409) * Fix formatting error in CHANGELOG. (#414) * Remove module space Copilot.Core.Interpret. (#410) + * Remove unused definitions from Copilot.Core.Type.Array. (#411) 2023-01-07 * Version bump (3.13). (#406) From cca7b6a9b70efd73ba1f0c84744c555995d6b5e7 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 3 Feb 2023 02:45:01 +0000 Subject: [PATCH 0581/1222] copilot: Re-structure README. Refs #415. Copilot's README contains outdated information and is not adapted for our current target audience. The instructions should be updated to reflect up-to-date installation methods, be more approachable for non-Haskellers, and describe the current software development processes (e.g., how to file issues or make contributions, if possible). This commit re-structures the README with the following changes: - Styled header - List of features - TOC - Updated installation instructions - Examples (minor tweaks) - Related projects - Documentation (including papers) - How to contribute - Contributors and acknowledgements The license is removed since it is available in each package. --- copilot/README.md | 363 +++++++++++++++++++++++++++++++--------------- 1 file changed, 249 insertions(+), 114 deletions(-) diff --git a/copilot/README.md b/copilot/README.md index 1ec02ad16..dd85ad1ef 100644 --- a/copilot/README.md +++ b/copilot/README.md @@ -1,89 +1,162 @@ -# Copilot: Stream DSL for hard real-time runtime verification +
+ +# Copilot [![Build Status](https://travis-ci.com/Copilot-Language/copilot.svg?branch=master)](https://app.travis-ci.com/github/Copilot-Language/copilot) [![Version on Hackage](https://img.shields.io/hackage/v/copilot.svg)](https://hackage.haskell.org/package/copilot) -Copilot is a runtime verification framework written in Haskell. It allows the -user to write programs in a simple but powerful way using a stream-based -approach. - +Copilot is a runtime verification framework for hard real-time systems. Programs can be interpreted for testing, or translated into C99 code to be -incorporated in a project or as a standalone application. The C99 backend -output is constant in memory and time, making it suitable for systems with hard -realtime requirements. +incorporated in a project or standalone application. The C99 code generated +is constant in memory and time, making it suitable for systems with hard +real-time requirements. + +[Installation](#installation) • +[Examples](#examples) • +[Related projects](#related-projects) • +[Documentation](#documentation) • +[Contributions](#contributions) • +[Acknowledgements](#acknowledgements) +
-## Using Copilot -Assuming you have GHC and cabal already installed (see [Haskell -Platform](http://hackage.haskell.org/platform/) or -[ghcup](https://www.haskell.org/ghcup/)), there are several ways to use -Copilot: +## Features -* Adding Copilot to your project +- Write simple, high-level specifications using a stream-based language. - Copilot is available from - [Hackage](https://hackage.haskell.org/package/copilot). Adding `copilot` - to your project's cabal file should be enough to get going. +- Produce hard real-time C99 runtime monitors that run in constant memory and time. -* Adding Copilot to the default GHC environment +- Catch errors in specifications early using expressive static type system. - ```bash - cabal v2-install --lib copilot - ``` +- Prove properties about specifications using theorem proving extensions. - After which Copilot will be available from ghci. +- Interpret specifications for testing and debugging purposes. -* Launching a repl with Copilot +- Obtain proofs of correctness of the generated code. - Another quick solution is to cabal to launch a repl with Copilot - available. +## Table of Contents - ```bash - cabal v2-repl --build-depends copilot - ``` +- [Installation](#installation) + - [Linux installation](#linux-installation) + - [Mac installation](#mac-installation) + - [Troubleshooting](#troubleshooting) +- [Examples](#examples) +- [Related projects](#related-projects) +- [Documentation](#documentation) + - [API documentation and tutorials](#api-documentation-and-tutorials) + - [Publications](#publications) + - [Website](#website) +- [Contributions](#contributions) +- [Acknowledgements](#acknowledgements) + - [The Copilot team](#the-copilot-team) + - [Institutional support](#institutional-support) - Cabal will download and build Copilot only to make it available in the - launched repl. The global GHC environment will not be affected. +# Installation +[(Back to top)](#table-of-contents) -* Building from source (typically done for development): +## Linux installation +[(Back to top)](#table-of-contents) - ```bash - git clone https://github.com/Copilot-Language/copilot.git - cd copilot - ``` +### Debian Bookworm / Ubuntu 23.04 + +On Debian Bookworm / Ubuntu 23.04 or newer, Copilot can be installed directly +from the package repositories with: + +```sh +$ sudo apt-get install libghc-copilot-dev +``` - Compiling can either be done in a Nix-style build, or a traditional one: +To test that Copilot is available, execute the following: +```sh +$ ghci <<< 'import Language.Copilot' +``` - _Nix-Style build (Cabal >= 2.x)_ +It should end with a line like the following and not print any error messages: +```sh +ghci> ghci> Leaving GHCi. +``` - ```bash - cabal build copilot-*/ # For Cabal 3.x - cabal v2-build copilot-*/ # For Cabal 2.x - ``` +### Other Linux distributions - _Traditional build (Cabal 1.x)_ - ```bash - cd copilot - cabal install --dependencies-only . ../copilot-*/ - cabal install ../copilot-*/ - cabal build - ``` +On other Linux distributions or older Debian-based distributions, to use +Copilot you must install a Haskell compiler (GHC) and the package manager +Cabal. We currently support all versions of GHC from 8.6.5 to modern versions +(9.2 as of this writing). You can install the toolchain using +[ghcup](https://www.haskell.org/ghcup/) or, if you are on Debian/Ubuntu, +directly with `apt-get`: -Note there is a TravisCI build (linked to at the top of this README) if you -have trouble building/installing. +```sh +$ sudo apt-get install ghc cabal-install +``` + +Once the compiler is installed, install Copilot from +[Hackage](https://hackage.haskell.org/package/copilot) with: + +```sh +cabal v2-install --lib copilot +``` + +To test that Copilot is available, execute the following: +```sh +$ ghci <<< 'import Language.Copilot' +``` + +It should end with a line like the following and not print any error messages: +```sh +ghci> ghci> Leaving GHCi. +``` +## Mac installation +[(Back to top)](#table-of-contents) -## Example -Here follows a simple example of a heating system. Other examples can be found +To use Copilot you must have a Haskell compiler (GHC) and the package manager +Cabal. We currently support all versions of GHC from 8.6.5 to modern versions +(9.2 as of this writing). You can install the toolchain using +[ghcup](https://www.haskell.org/ghcup/), as well as with Homebrew: + +```sh +$ brew install ghc cabal-install +``` + +Once the compiler is installed, install Copilot from +[Hackage](https://hackage.haskell.org/package/copilot) with: + +```sh +$ cabal v2-install --lib copilot +``` + +To test that Copilot is available, execute the following: +```sh +$ ghci <<< 'import Language.Copilot' +``` + +It should end with a line like the following and not print any error messages: +```sh +ghci> ghci> Leaving GHCi. +``` + +## Troubleshooting +[(Back to top)](#table-of-contents) + +Feel free to open an issue if you are unable to install Copilot following these +instructions. + +There is a TravisCI file at the root of the repository that may help with +troubleshooting the installation. Our issues often include comments with +Dockerfiles listing the steps necessary to install Copilot from scratch. + +## Examples +[(Back to top)](#table-of-contents) + +Here follows a simple example of a heating system. More examples can be found in the [examples directory](https://github.com/Copilot-Language/copilot/tree/master/copilot/examples) of the main repository. ```haskell --- This is a simple example with basic usage. It implements a simple home --- heating system: It heats when temp gets too low, and stops when it is high --- enough. It read temperature as a byte (range -50C to 100C) and translates --- this to Celsius. +-- This example implements a simple home heating system. The system heats +-- when the temperature gets too low, and stops when it is high enough. It read +-- temperature as a byte (range -50C to 100C) and translates this to Celsius. module Heater where @@ -92,12 +165,13 @@ import Copilot.Compile.C99 import Prelude hiding ((>), (<), div) --- External temperature as a byte, range of -50C to 100C +-- External temperature as a byte, ranging from -50C to 100C. temp :: Stream Word8 temp = extern "temperature" Nothing --- Calculate temperature in Celsius. --- We need to cast the Word8 to a Float. Note that it is an unsafeCast, as there +-- Temperature in Celsius. +-- +-- We need to cast the Word8 to a Float. This is an unsafeCast, as there -- is no direct relation between Word8 and Float. ctemp :: Stream Float ctemp = (unsafeCast temp) * (150.0 / 255.0) - 50.0 @@ -112,83 +186,144 @@ spec = do main = reify spec >>= compile "heater" ``` -The examples located in the `examples/` directory can be run from the root of -the project. Each example has a name. As a rule of thumb, the examples are -named after the filename (without extension) in lowercase letters, and -directory seperators replaced with a '-'. For example: +If you save this example in a file `Heater.hs` and run: +```sh +$ runhaskell Heater.hs +``` +it will produce the files `heater.c`, `heater.h` and `heater_types.h`, +containing, respectively, the implementation of the monitors, the interface, +and a declaration of any types declared in the specification (empty in this +case). + +If you clone the repository, the examples in the `examples/` directory can be +run from the root of the project. As a rule of thumb, each example is named +after the filename (without extension) in lowercase letters, and directory +separators replaced with a '-'. For example: ```sh -cabal run addmult -f examples -cabal run counter -f examples -cabal run what4-arithmetic -f examples +$ cabal run addmult -f examples +$ cabal run counter -f examples +$ cabal run what4-arithmetic -f examples ``` -## Contributions -Feel free to open new issues and send pull requests. +# Related projects +[(Back to top)](#table-of-contents) + +_Disclaimer: The following projects are not part of Copilot. Their mention here +does not constitute any form of endorsement._ -In order to contribute to Copilot, please use the following steps which will -make the process of evaluating and including your changes much easier: +- [Ogma](https://github.com/nasa/ogma) is a NASA tool to facilitate the + integration of safe runtime monitors into other systems, including those + built using NASA's Core Flight System or the Robot Operating System (ROS 2). -* Create an issue for every individual change or problem with Copilot. Document - the issue well. +- [arduino-copilot](https://hackage.haskell.org/package/arduino-copilot) + facilitates building copilot applications that run on Arduino. -* Always comment on the issues you are addressing in every commit. Be - descriptive, and use the syntax `#` so that we can track - changes and issues easily. +- [sketch-frp-copilot](https://hackage.haskell.org/package/sketch-frp-copilot) + extends Copilot with an FRP-like interface. -* Every commit should mention one issue and, ideally, only one. +- [zephir-copilot](https://hackage.haskell.org/package/zephyr-copilot) + facilitates building copilot applications that run on boards supported by the + Zephyr project. -* Do not send a PR or commit that addresses multiple problems, unless they are - related and cannot be separated. +# Documentation +[(Back to top)](#table-of-contents) -* Do not commit to master directly, except for branch merges. Make sure you - always merge onto master using `--no-ff` so that we can tell that features - were addressed separately, completed, tested, and then merged. If you are a - Copilot developer, create a branch for every issue you are addressing, complete - it, and then merge onto master. Document every commit in every branch, - including the last merge commit, stating the issues it addresses or closes. +## API documentation and tutorials +[(Back to top)](#table-of-contents) -This process is similar to [Git -Flow](http://nvie.com/posts/a-successful-git-branching-model/). The equivalent -of Git Flow's master branch is our latest tag, and the equivalent of Git Flow's -develop branch is our master. +A tutorial on Copilot can be found +[here](https://copilot-language.github.io/downloads/copilot_tutorial.pdf). +The API is documented throughout the different libraries and published on +Hackage: -## Further information -For further information, including documentation and a tutorial, please visit -the Copilot website: +- [copilot](https://hackage.haskell.org/package/copilot) +- [copilot-c99](https://hackage.haskell.org/package/copilot-c99) +- [copilot-core](https://hackage.haskell.org/package/copilot-core) +- [copilot-interpreter](https://hackage.haskell.org/package/copilot-interpreter) +- [copilot-language](https://hackage.haskell.org/package/copilot-language) +- [copilot-libraries](https://hackage.haskell.org/package/copilot-libraries) +- [copilot-prettyprinter](https://hackage.haskell.org/package/copilot-prettyprinter) +- [copilot-theorem](https://hackage.haskell.org/package/copilot-theorem) + +## Publications +[(Back to top)](#table-of-contents) + +The best introduction to the fundamentals of Copilot apart from the tutorial +is: + +- [Copilot 3](https://ntrs.nasa.gov/citations/20200003164) + +Other relevant papers include: + +- [Automated Translation of Natural Language Requirements to Runtime Monitors](https://link.springer.com/chapter/10.1007/978-3-030-99524-9_21) + +- [Copilot: A Hard Real-Time Runtime Monitor](https://link.springer.com/chapter/10.1007/978-3-642-16612-9_26) + +- [Copilot: monitoring embedded systems](https://link.springer.com/article/10.1007/s11334-013-0223-x) + +- [From Requirements to Autonomous Flight: An Overview of the Monitoring ICAROUS Project](https://arxiv.org/abs/2012.03745) + +- [Integrating FRET with Copilot: Automated Translation of Natural Language Requirements to Runtime Monitors](https://ntrs.nasa.gov/citations/20220000049) + +- [Monitoring Distributed Real-Time Systems: A Survey and Future Directions](https://ntrs.nasa.gov/citations/20100027427) + +- [Monitoring ROS2: from Requirements to Autonomous Robots](https://arxiv.org/abs/2209.14030) + +## Website +[(Back to top)](#table-of-contents) + +For further information, including links to more documentation and the +tutorial, please visit the Copilot website: [https://copilot-language.github.io](https://copilot-language.github.io). +# Contributions +[(Back to top)](#table-of-contents) -## Acknowledgements -We are grateful for NASA Contract NNL08AD13T to Galois, Inc. and the National -Institute of Aerospace, which partially supported this work. +Copilot cannot accept pull requests or code contributions from developers +outside the development team at this point. -Additionally NASA Langley contracts 80LARC17C0004 and NNL09AA00A supported -further development of Copilot. +If you have a question, find a bug, or would like to request a change, please +file an issue adding as much information as you can to help us reproduce the +error or identify the use case. Please file the issue with no labels. +# Acknowledgements +[(Back to top)](#table-of-contents) -## License -Copilot is distributed under the BSD-3-Clause license, which can be found -[here](https://raw.githubusercontent.com/Copilot-Language/copilot/master/copilot/LICENSE). +## The Copilot team +[(Back to top)](#table-of-contents) +Copilot is currently maintained by: -## The Copilot Team -The development of Copilot spans across several years. During these years -the following people have helped develop Copilot (in no particular order): +* Alwyn Goodloe +* Ivan Perez -* Lee Pike -* Alwyn Goodloe (maintainer) -* Robin Morisset -* Sebastian Niller -* Nis Wegmann +Past and current team members also include (in alphabetical order): + +* Macallan Cruff +* Frank Dedden * Chris Hathhorn -* Eli Mendelson -* Jonathan Laurent -* Laura Titolo * Georges-Axel Jolayan -* Macallan Cruff -* Ryan Spring +* Jonathan Laurent +* Eli Mendelson +* Robin Morisset +* Sebastian Niller * Lauren Pick -* Frank Dedden (maintainer: contact at dev@dedden.net) -* Ivan Perez (maintainer) +* Lee Pike +* Will Pogge +* Ryan Spring +* Laura Titolo +* Nis Wegmann + +For a complete list of contributors, including external contributors, see: +https://github.com/Copilot-Language/copilot/graphs/contributors + +## Institutional support +[(Back to top)](#table-of-contents) + +We are grateful for NASA Contract NNL08AD13T to Galois, Inc. and the National +Institute of Aerospace, which partially supported this work. + +Additionally NASA Langley contracts 80LARC17C0004 and NNL09AA00A supported +further development of Copilot. From 24e6586e7edd2548d0f81f1621fef364da854d41 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Wed, 8 Mar 2023 04:16:20 +0000 Subject: [PATCH 0582/1222] copilot: Document changes in CHANGELOG. Refs #415. --- copilot/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot/CHANGELOG b/copilot/CHANGELOG index 88ed5414c..125d1bb18 100644 --- a/copilot/CHANGELOG +++ b/copilot/CHANGELOG @@ -1,5 +1,6 @@ -2023-02-21 +2023-03-07 * Replace import of Copilot.Language.prettyPrint. (#412) + * Re-structure README. (#415) 2023-01-07 * Version bump (3.13). (#406) From 4bd02a79adc49deb63efe10be47514ad787efb0f Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Wed, 8 Mar 2023 04:33:26 +0000 Subject: [PATCH 0583/1222] copilot-theorem: Bump constraint on what4. Refs #423. In order to keep Copilot effectively working in the current Haskell ecosystem, as well as new versions of GHC, we need to extend the versions of dependencies that Copilot can be installed with. For example, what4 has seen a new release 0.14, but copilot-theorem needs versions strictly lower than 0.14. We also do not support GHC 9.4 or above. This commit bumps te upper bounds on what so that it can be installed with the 1.4 series. --- copilot-theorem/copilot-theorem.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot-theorem/copilot-theorem.cabal b/copilot-theorem/copilot-theorem.cabal index d959fc1ea..aabf23719 100644 --- a/copilot-theorem/copilot-theorem.cabal +++ b/copilot-theorem/copilot-theorem.cabal @@ -61,7 +61,7 @@ library , random >= 1.1 && < 1.3 , transformers >= 0.5 && < 0.7 , xml >= 1.3 && < 1.4 - , what4 >= 1.3 && < 1.4 + , what4 >= 1.3 && < 1.5 , copilot-core >= 3.13 && < 3.14 , copilot-prettyprinter >= 3.13 && < 3.14 From ee6557a9c43f986bfac6ddef7a397df0aaaa24f7 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Wed, 8 Mar 2023 06:02:55 +0000 Subject: [PATCH 0584/1222] copilot-language: Avoid name clashes with names in base 4.17. Refs #423. New versions of base include names in Data.Bits that clash with those in Copilot.Language.Operators.BitWise. This commit uses CPP to hide imports to avoid clashes. A function is also defined only if not already available in Data.Bits (the definitions coincide). --- .../src/Copilot/Language/Operators/BitWise.hs | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/copilot-language/src/Copilot/Language/Operators/BitWise.hs b/copilot-language/src/Copilot/Language/Operators/BitWise.hs index 8fc12e350..3b3c99d13 100644 --- a/copilot-language/src/Copilot/Language/Operators/BitWise.hs +++ b/copilot-language/src/Copilot/Language/Operators/BitWise.hs @@ -1,5 +1,6 @@ -- Copyright © 2011 National Institute of Aerospace / Galois, Inc. +{-# LANGUAGE CPP #-} {-# LANGUAGE Safe #-} {-# OPTIONS_GHC -fno-warn-orphans #-} @@ -16,7 +17,12 @@ import Copilot.Core (Typed, typeOf) import qualified Copilot.Core as Core import Copilot.Language.Stream import qualified Prelude as P + +#if MIN_VERSION_base(4,17,0) +import Data.Bits hiding ((.>>.), (.<<.)) +#else import Data.Bits +#endif -- | Instance of the 'Bits' class for 'Stream's. -- @@ -36,9 +42,11 @@ instance (Typed a, Bits a) => Bits (Stream a) where bit = P.error "tbd: bit" popCount = P.error "tbd: popCount" +#if !MIN_VERSION_base(4,17,0) -- | See 'xor'. (.^.) :: Bits a => a -> a -> a (.^.) = xor -- Avoid redefinition of the Operators.Boolean xor +#endif -- | Shifting values of a stream to the left. (.<<.) :: (Bits a, Typed a, Typed b, P.Integral b) From 92eaa8a837174c4770c58339ccecb9602fc9e349 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Wed, 8 Mar 2023 06:43:08 +0000 Subject: [PATCH 0585/1222] copilot: Update instructions to reflect latest version of GHC supported. Refs #423. Prior commits extend the versions of what4 and GHC that copilot can be installed with. This commit adjusts the README to reflect that Copilot works with GHC 9.4. --- copilot/README.md | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/copilot/README.md b/copilot/README.md index dd85ad1ef..d25a45a8d 100644 --- a/copilot/README.md +++ b/copilot/README.md @@ -81,7 +81,7 @@ ghci> ghci> Leaving GHCi. On other Linux distributions or older Debian-based distributions, to use Copilot you must install a Haskell compiler (GHC) and the package manager Cabal. We currently support all versions of GHC from 8.6.5 to modern versions -(9.2 as of this writing). You can install the toolchain using +(9.4 as of this writing). You can install the toolchain using [ghcup](https://www.haskell.org/ghcup/) or, if you are on Debian/Ubuntu, directly with `apt-get`: @@ -111,7 +111,7 @@ ghci> ghci> Leaving GHCi. To use Copilot you must have a Haskell compiler (GHC) and the package manager Cabal. We currently support all versions of GHC from 8.6.5 to modern versions -(9.2 as of this writing). You can install the toolchain using +(9.4 as of this writing). You can install the toolchain using [ghcup](https://www.haskell.org/ghcup/), as well as with Homebrew: ```sh From 3803521129df416626882050124176335fa93a76 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Wed, 8 Mar 2023 06:28:23 +0000 Subject: [PATCH 0586/1222] copilot-theorem: Document changes in CHANGELOG. Refs #423. --- copilot-theorem/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-theorem/CHANGELOG b/copilot-theorem/CHANGELOG index 26602f745..6d6b827f7 100644 --- a/copilot-theorem/CHANGELOG +++ b/copilot-theorem/CHANGELOG @@ -1,3 +1,6 @@ +2023-03-07 + * Adjust contraints on version of what4. (#423) + 2023-01-07 * Version bump (3.13). (#406) From b4f97161e49ab846a5918b6b0cc99c6b3919f2f8 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Wed, 8 Mar 2023 06:29:30 +0000 Subject: [PATCH 0587/1222] copilot-language: Document changes in CHANGELOG. Refs #423. --- copilot-language/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot-language/CHANGELOG b/copilot-language/CHANGELOG index 2f2e0ddb0..71287191a 100644 --- a/copilot-language/CHANGELOG +++ b/copilot-language/CHANGELOG @@ -1,5 +1,6 @@ -2023-02-21 +2023-03-07 * Remove function Copilot.Language.prettyPrint. (#412) + * Adjust to work with GHC 9.4. (#423) 2023-01-07 * Version bump (3.13). (#406) From 0f53d7239d3f496d980a5b772c3428654756dff5 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Wed, 8 Mar 2023 06:50:30 +0000 Subject: [PATCH 0588/1222] copilot: Document changes in CHANGELOG. Refs #423. --- copilot/CHANGELOG | 1 + 1 file changed, 1 insertion(+) diff --git a/copilot/CHANGELOG b/copilot/CHANGELOG index 125d1bb18..d31f36109 100644 --- a/copilot/CHANGELOG +++ b/copilot/CHANGELOG @@ -1,6 +1,7 @@ 2023-03-07 * Replace import of Copilot.Language.prettyPrint. (#412) * Re-structure README. (#415) + * Update README to reflect support for GHC 9.4. (#423) 2023-01-07 * Version bump (3.13). (#406) From 798e5d1434d34ca8387679009710166d2fcf3579 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Wed, 8 Mar 2023 07:15:37 +0000 Subject: [PATCH 0589/1222] Bump versions and constraints. Refs #422. --- copilot-c99/copilot-c99.cabal | 4 ++-- copilot-core/copilot-core.cabal | 2 +- copilot-interpreter/copilot-interpreter.cabal | 4 ++-- copilot-language/copilot-language.cabal | 8 ++++---- copilot-libraries/copilot-libraries.cabal | 4 ++-- copilot-prettyprinter/copilot-prettyprinter.cabal | 4 ++-- copilot-theorem/copilot-theorem.cabal | 6 +++--- copilot/copilot.cabal | 14 +++++++------- 8 files changed, 23 insertions(+), 23 deletions(-) diff --git a/copilot-c99/copilot-c99.cabal b/copilot-c99/copilot-c99.cabal index 4ef9c86db..947ca889a 100644 --- a/copilot-c99/copilot-c99.cabal +++ b/copilot-c99/copilot-c99.cabal @@ -1,6 +1,6 @@ cabal-version : >= 1.10 name : copilot-c99 -version : 3.13 +version : 3.14 synopsis : A compiler for Copilot targeting C99. description : This package is a back-end from Copilot to C. @@ -45,7 +45,7 @@ library , mtl >= 2.2 && < 2.4 , pretty >= 1.1 && < 1.2 - , copilot-core >= 3.13 && < 3.14 + , copilot-core >= 3.14 && < 3.15 , language-c99 >= 0.2.0 && < 0.3 , language-c99-simple >= 0.2.2 && < 0.3 diff --git a/copilot-core/copilot-core.cabal b/copilot-core/copilot-core.cabal index 9363ac616..25268a67e 100644 --- a/copilot-core/copilot-core.cabal +++ b/copilot-core/copilot-core.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-core -version: 3.13 +version: 3.14 synopsis: An intermediate representation for Copilot. description: Intermediate representation for Copilot. diff --git a/copilot-interpreter/copilot-interpreter.cabal b/copilot-interpreter/copilot-interpreter.cabal index c51d3e92d..986616e98 100644 --- a/copilot-interpreter/copilot-interpreter.cabal +++ b/copilot-interpreter/copilot-interpreter.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-interpreter -version: 3.13 +version: 3.14 synopsis: Interpreter for Copilot. description: Interpreter for Copilot. @@ -44,7 +44,7 @@ library base >= 4.9 && < 5, pretty >= 1.0 && < 1.2, - copilot-core >= 3.13 && < 3.14 + copilot-core >= 3.14 && < 3.15 exposed-modules: diff --git a/copilot-language/copilot-language.cabal b/copilot-language/copilot-language.cabal index 3c6a7d6ec..abdcc0329 100644 --- a/copilot-language/copilot-language.cabal +++ b/copilot-language/copilot-language.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-language -version: 3.13 +version: 3.14 synopsis: A Haskell-embedded DSL for monitoring hard real-time distributed systems. description: @@ -42,9 +42,9 @@ library , data-reify >= 0.6 && < 0.7 , mtl >= 2.0 && < 3 - , copilot-core >= 3.13 && < 3.14 - , copilot-interpreter >= 3.13 && < 3.14 - , copilot-theorem >= 3.13 && < 3.14 + , copilot-core >= 3.14 && < 3.15 + , copilot-interpreter >= 3.14 && < 3.15 + , copilot-theorem >= 3.14 && < 3.15 exposed-modules: Copilot.Language , Copilot.Language.Operators.BitWise diff --git a/copilot-libraries/copilot-libraries.cabal b/copilot-libraries/copilot-libraries.cabal index f71d2701c..e7cbaa78c 100644 --- a/copilot-libraries/copilot-libraries.cabal +++ b/copilot-libraries/copilot-libraries.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-libraries -version: 3.13 +version: 3.14 synopsis: Libraries for the Copilot language. description: Libraries for the Copilot language. @@ -41,7 +41,7 @@ library , containers >= 0.4 && < 0.7 , mtl >= 2.0 && < 2.4 , parsec >= 2.0 && < 3.2 - , copilot-language >= 3.13 && < 3.14 + , copilot-language >= 3.14 && < 3.15 exposed-modules: Copilot.Library.Libraries diff --git a/copilot-prettyprinter/copilot-prettyprinter.cabal b/copilot-prettyprinter/copilot-prettyprinter.cabal index e6e15ba1e..30e543ebe 100644 --- a/copilot-prettyprinter/copilot-prettyprinter.cabal +++ b/copilot-prettyprinter/copilot-prettyprinter.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-prettyprinter -version: 3.13 +version: 3.14 synopsis: A prettyprinter of Copilot Specifications. description: A prettyprinter of Copilot specifications. @@ -45,7 +45,7 @@ library base >= 4.9 && < 5, pretty >= 1.0 && < 1.2, - copilot-core >= 3.13 && < 3.14 + copilot-core >= 3.14 && < 3.15 exposed-modules: diff --git a/copilot-theorem/copilot-theorem.cabal b/copilot-theorem/copilot-theorem.cabal index aabf23719..ba2855553 100644 --- a/copilot-theorem/copilot-theorem.cabal +++ b/copilot-theorem/copilot-theorem.cabal @@ -14,7 +14,7 @@ description: . -version : 3.13 +version : 3.14 license : BSD3 license-file : LICENSE maintainer : Ivan Perez @@ -63,8 +63,8 @@ library , xml >= 1.3 && < 1.4 , what4 >= 1.3 && < 1.5 - , copilot-core >= 3.13 && < 3.14 - , copilot-prettyprinter >= 3.13 && < 3.14 + , copilot-core >= 3.14 && < 3.15 + , copilot-prettyprinter >= 3.14 && < 3.15 exposed-modules : Copilot.Theorem , Copilot.Theorem.Prove diff --git a/copilot/copilot.cabal b/copilot/copilot.cabal index bc6dc9c9d..f12109969 100644 --- a/copilot/copilot.cabal +++ b/copilot/copilot.cabal @@ -1,5 +1,5 @@ name: copilot -version: 3.13 +version: 3.14 cabal-version: >= 1.10 license: BSD3 license-file: LICENSE @@ -52,12 +52,12 @@ library , directory >= 1.3 && < 1.4 , filepath >= 1.4 && < 1.5 - , copilot-core >= 3.13 && < 3.14 - , copilot-theorem >= 3.13 && < 3.14 - , copilot-language >= 3.13 && < 3.14 - , copilot-libraries >= 3.13 && < 3.14 - , copilot-c99 >= 3.13 && < 3.14 - , copilot-prettyprinter >= 3.13 && < 3.14 + , copilot-core >= 3.14 && < 3.15 + , copilot-theorem >= 3.14 && < 3.15 + , copilot-language >= 3.14 && < 3.15 + , copilot-libraries >= 3.14 && < 3.15 + , copilot-c99 >= 3.14 && < 3.15 + , copilot-prettyprinter >= 3.14 && < 3.15 exposed-modules: Language.Copilot, Language.Copilot.Main From c0d72be7709deb07be610f9a672f2abd63748585 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Wed, 8 Mar 2023 07:17:44 +0000 Subject: [PATCH 0590/1222] Document changes in CHANGELOG. Refs #422. --- copilot-c99/CHANGELOG | 3 +++ copilot-core/CHANGELOG | 3 ++- copilot-interpreter/CHANGELOG | 3 +++ copilot-language/CHANGELOG | 1 + copilot-libraries/CHANGELOG | 3 +++ copilot-prettyprinter/CHANGELOG | 3 +++ copilot-theorem/CHANGELOG | 1 + copilot/CHANGELOG | 1 + 8 files changed, 17 insertions(+), 1 deletion(-) diff --git a/copilot-c99/CHANGELOG b/copilot-c99/CHANGELOG index d1d0dec94..e4f0b899a 100644 --- a/copilot-c99/CHANGELOG +++ b/copilot-c99/CHANGELOG @@ -1,3 +1,6 @@ +2023-03-07 + * Version bump (3.14). (#422) + 2023-01-07 * Version bump (3.13). (#406) * Declare local array variables in generated guards as pointers. (#401) diff --git a/copilot-core/CHANGELOG b/copilot-core/CHANGELOG index 83ac6d1a7..d4846f900 100644 --- a/copilot-core/CHANGELOG +++ b/copilot-core/CHANGELOG @@ -1,4 +1,5 @@ -2023-03-03 +2023-03-07 + * Version bump (3.14). (#422) * Remove Copilot.Core.PrettyDot. (#409) * Fix formatting error in CHANGELOG. (#414) * Remove module space Copilot.Core.Interpret. (#410) diff --git a/copilot-interpreter/CHANGELOG b/copilot-interpreter/CHANGELOG index 60c54300e..60fabe2e7 100644 --- a/copilot-interpreter/CHANGELOG +++ b/copilot-interpreter/CHANGELOG @@ -1,3 +1,6 @@ +2023-03-07 + * Version bump (3.14). (#422) + 2023-01-07 * Version bump (3.13). (#406) diff --git a/copilot-language/CHANGELOG b/copilot-language/CHANGELOG index 71287191a..46ffa9994 100644 --- a/copilot-language/CHANGELOG +++ b/copilot-language/CHANGELOG @@ -1,4 +1,5 @@ 2023-03-07 + * Version bump (3.14). (#422) * Remove function Copilot.Language.prettyPrint. (#412) * Adjust to work with GHC 9.4. (#423) diff --git a/copilot-libraries/CHANGELOG b/copilot-libraries/CHANGELOG index 305a73845..f4bc08411 100644 --- a/copilot-libraries/CHANGELOG +++ b/copilot-libraries/CHANGELOG @@ -1,3 +1,6 @@ +2023-03-07 + * Version bump (3.14). (#422) + 2023-01-07 * Version bump (3.13). (#406) diff --git a/copilot-prettyprinter/CHANGELOG b/copilot-prettyprinter/CHANGELOG index f42d560be..ca076385c 100644 --- a/copilot-prettyprinter/CHANGELOG +++ b/copilot-prettyprinter/CHANGELOG @@ -1,3 +1,6 @@ +2023-03-07 + * Version bump (3.14). (#422) + 2023-01-07 * Version bump (3.13). (#406) diff --git a/copilot-theorem/CHANGELOG b/copilot-theorem/CHANGELOG index 6d6b827f7..ac38a74bd 100644 --- a/copilot-theorem/CHANGELOG +++ b/copilot-theorem/CHANGELOG @@ -1,4 +1,5 @@ 2023-03-07 + * Version bump (3.14). (#422) * Adjust contraints on version of what4. (#423) 2023-01-07 diff --git a/copilot/CHANGELOG b/copilot/CHANGELOG index d31f36109..0b3d7cde1 100644 --- a/copilot/CHANGELOG +++ b/copilot/CHANGELOG @@ -1,4 +1,5 @@ 2023-03-07 + * Version bump (3.14). (#422) * Replace import of Copilot.Language.prettyPrint. (#412) * Re-structure README. (#415) * Update README to reflect support for GHC 9.4. (#423) From 2d4d2cabab7ef97fce5a037dc60e81feff17f285 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 17 Apr 2023 22:40:47 +0000 Subject: [PATCH 0591/1222] copilot-core: Remove uses of Copilot.Core.Type.Equality. Refs #427. The module Copilot.Core.Type.Equality is not being used by any other part of Copilot. It's implementation was replaced by definitions existing in the base library. The implementation in copilot-core was deprecated in Copilot 3.12 and no messages have been received requesting that it be kept in this library. As per our internal policy of waiting 3 versions from deprecation until a public interface declaration can be removed, this module can now be removed. This commit removes all uses of definitions from Copilot.Core.Type.Equality, which were being kept in copilot-core to facilitate a transition to the new interface based on Data.Type.Equality while respecting our deprecation policy. Definitions equivalent to the ones removed, but based on Data.Type.Equality, are still made available. --- copilot-core/src/Copilot/Core/Type.hs | 22 +--------------------- 1 file changed, 1 insertion(+), 21 deletions(-) diff --git a/copilot-core/src/Copilot/Core/Type.hs b/copilot-core/src/Copilot/Core/Type.hs index cb330d90a..9a3908061 100644 --- a/copilot-core/src/Copilot/Core/Type.hs +++ b/copilot-core/src/Copilot/Core/Type.hs @@ -8,11 +8,6 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} - --- The following flag is disabled in this module so that the import of --- Copilot.Core.Type.Equality does not give rise to warnings. -{-# OPTIONS_GHC -fno-warn-deprecations #-} - -- | -- Description: Typing for Core. -- Copyright: (c) 2011 National Institute of Aerospace / Galois, Inc. @@ -53,8 +48,7 @@ import GHC.TypeLits (KnownNat, KnownSymbol, Symbol, natVal, sameNat, symbolVal) -- Internal imports -import Copilot.Core.Type.Array (Array) -import Copilot.Core.Type.Equality as CE +import Copilot.Core.Type.Array (Array) -- | The value of that is a product or struct, defined as a constructor with -- several fields. @@ -123,20 +117,6 @@ tysize :: forall n t . KnownNat n => Type (Array n t) -> Int tysize ty@(Array ty'@(Array _)) = tylength ty * tysize ty' tysize ty@(Array _ ) = tylength ty -instance EqualType Type where - (=~=) Bool Bool = Just CE.Refl - (=~=) Int8 Int8 = Just CE.Refl - (=~=) Int16 Int16 = Just CE.Refl - (=~=) Int32 Int32 = Just CE.Refl - (=~=) Int64 Int64 = Just CE.Refl - (=~=) Word8 Word8 = Just CE.Refl - (=~=) Word16 Word16 = Just CE.Refl - (=~=) Word32 Word32 = Just CE.Refl - (=~=) Word64 Word64 = Just CE.Refl - (=~=) Float Float = Just CE.Refl - (=~=) Double Double = Just CE.Refl - (=~=) _ _ = Nothing - instance TestEquality Type where testEquality Bool Bool = Just DE.Refl testEquality Int8 Int8 = Just DE.Refl From c173628b9243e62451228cb27b8b9cfa0dd54cba Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 17 Apr 2023 22:40:16 +0000 Subject: [PATCH 0592/1222] copilot-core: Remove module Copilot.Core.Type.Equality. Refs #427. The module Copilot.Core.Type.Equality is not being used by any other part of Copilot. It's implementation was replaced by definitions existing in the base library. The implementation in copilot-core was deprecated in Copilot 3.12 and no messages have been received requesting that it be kept in this library. As per our internal policy of waiting 3 versions from deprecation until a public interface declaration can be removed, this module can now be removed. This commit removes the module Copilot.Core.Type.Equality. --- copilot-core/copilot-core.cabal | 1 - .../src/Copilot/Core/Type/Equality.hs | 46 ------------------- 2 files changed, 47 deletions(-) delete mode 100644 copilot-core/src/Copilot/Core/Type/Equality.hs diff --git a/copilot-core/copilot-core.cabal b/copilot-core/copilot-core.cabal index 25268a67e..1a091323a 100644 --- a/copilot-core/copilot-core.cabal +++ b/copilot-core/copilot-core.cabal @@ -53,7 +53,6 @@ library Copilot.Core.Spec Copilot.Core.Type Copilot.Core.Type.Array - Copilot.Core.Type.Equality Copilot.Core.PrettyPrint other-modules: diff --git a/copilot-core/src/Copilot/Core/Type/Equality.hs b/copilot-core/src/Copilot/Core/Type/Equality.hs deleted file mode 100644 index 8e01901a3..000000000 --- a/copilot-core/src/Copilot/Core/Type/Equality.hs +++ /dev/null @@ -1,46 +0,0 @@ --- Copyright © 2011 National Institute of Aerospace / Galois, Inc. - -{-# LANGUAGE GADTs #-} -{-# LANGUAGE KindSignatures #-} -{-# LANGUAGE Safe #-} - --- | Propositional equality and type equality. -module Copilot.Core.Type.Equality - {-# DEPRECATED "This module is deprecated in Copilot 3.12. Use base:Data.Type.Equality instead." #-} - ( Equal (..) - , EqualType (..) - , coerce - , refl - , trans - , symm - , cong - ) where - --- | Propositional equality. -data Equal :: * -> * -> * where - Refl :: Equal a a - --- | Type equality. If the value of @x =~= y@ is @Just Refl@, then the two --- types @x@ and @y@ are equal. -class EqualType t where - (=~=) :: t a -> t b -> Maybe (Equal a b) - --- | Safe coercion, which requires proof of equality. -coerce :: Equal a b -> a -> b -coerce Refl x = x - --- | Proof of propositional equality. -refl :: Equal a a -refl = Refl - --- | Symmetry. -symm :: Equal a b -> Equal b a -symm Refl = Refl - --- | Transitivity. -trans :: Equal a b -> Equal b c -> Equal a c -trans Refl Refl = Refl - --- | Congruence. -cong :: Equal a b -> Equal (f a) (f b) -cong Refl = Refl From 4867e303b62a7f3ec1fadf6fcdc6eea2569554c5 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 17 Apr 2023 22:44:28 +0000 Subject: [PATCH 0593/1222] copilot-core: Document changes in CHANGELOG. Refs #427. --- copilot-core/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-core/CHANGELOG b/copilot-core/CHANGELOG index d4846f900..f716fd465 100644 --- a/copilot-core/CHANGELOG +++ b/copilot-core/CHANGELOG @@ -1,3 +1,6 @@ +2023-04-17 + * Remove Copilot.Core.Type.Equality. (#427) + 2023-03-07 * Version bump (3.14). (#422) * Remove Copilot.Core.PrettyDot. (#409) From 030852bdb5a1ad1b0a409cca94dbb313fa595c13 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 18 Apr 2023 01:46:16 +0000 Subject: [PATCH 0594/1222] copilot-language: Remove outdated comment about pretty-printer. Refs #428. The pretty-printer is no longer exported by the copilot-language library. However, module Copilot.Language mentions the existence of a pretty-printer in its documentation. This commit removes that mention from the module's haddock documentation. --- copilot-language/src/Copilot/Language.hs | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/copilot-language/src/Copilot/Language.hs b/copilot-language/src/Copilot/Language.hs index 8dda0ef87..658ccb191 100644 --- a/copilot-language/src/Copilot/Language.hs +++ b/copilot-language/src/Copilot/Language.hs @@ -3,8 +3,7 @@ -- | Main Copilot language export file. -- -- This is mainly a meta-module that re-exports most definitions in this --- library. It also provides a default pretty printer that prints a --- specification to stdout. +-- library. {-# LANGUAGE Safe #-} From 2358fbe2525158789db58f7ba90c04ac0bcb9336 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 18 Apr 2023 01:48:23 +0000 Subject: [PATCH 0595/1222] copilot-language: Document changes in CHANGELOG. Refs #428. --- copilot-language/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-language/CHANGELOG b/copilot-language/CHANGELOG index 46ffa9994..6f6b88b83 100644 --- a/copilot-language/CHANGELOG +++ b/copilot-language/CHANGELOG @@ -1,3 +1,6 @@ +2023-04-17 + * Remove outdated comment about pretty-printer. (#428) + 2023-03-07 * Version bump (3.14). (#422) * Remove function Copilot.Language.prettyPrint. (#412) From e81c9319a9afee8fd131e5b31c6f8ae1eb0f0fbb Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Wed, 19 Apr 2023 15:43:43 +0000 Subject: [PATCH 0596/1222] copilot-core: Update reference to point to copilot-prettyprinter. Refs #426. The module Copilot.Core.PrettyPrint is not being used by any other part of Copilot. It's implementation was moved to a dedicated library copilot-prettyprint. The implementation in copilot-core was deprecated in Copilot 3.12 and no messages have been received requesting that it be kept in this library. As per our internal policy of waiting 3 versions from deprecation until a public interface declaration can be removed, this module can now be removed. This commit updates a reference in a comment to point to the library copilot-prettyprinter, instead of the module Copilot.Core.PrettyPrint. --- copilot-core/src/Copilot/Core.hs | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/copilot-core/src/Copilot/Core.hs b/copilot-core/src/Copilot/Core.hs index cad4aa066..87ad13b15 100644 --- a/copilot-core/src/Copilot/Core.hs +++ b/copilot-core/src/Copilot/Core.hs @@ -17,8 +17,7 @@ -- -- For examples of how to traverse a Copilot specification see -- the source code of the interpreter (@copilot-interpreter@) --- and the pretty-printer --- ("Copilot.Core.PrettyPrint"). +-- and the pretty-printer (@copilot-prettyprinter@). module Copilot.Core ( module Copilot.Core.Expr , module Copilot.Core.Operators From dd491bac944cc4f1c373ea8d76e9c7a491b28f88 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Wed, 19 Apr 2023 15:45:17 +0000 Subject: [PATCH 0597/1222] copilot-core: Remove module Copilot.Core.PrettyPrint. Refs #426. The module Copilot.Core.PrettyPrint is not being used by any other part of Copilot. It's implementation was moved to a dedicated library copilot-prettyprint. The implementation in copilot-core was deprecated in Copilot 3.12 and no messages have been received requesting that it be kept in this library. As per our internal policy of waiting 3 versions from deprecation until a public interface declaration can be removed, this module can now be removed. This commit removes the module Copilot.Core.PrettyPrint from copilot-core. --- copilot-core/copilot-core.cabal | 1 - copilot-core/src/Copilot/Core/PrettyPrint.hs | 195 ------------------- 2 files changed, 196 deletions(-) delete mode 100644 copilot-core/src/Copilot/Core/PrettyPrint.hs diff --git a/copilot-core/copilot-core.cabal b/copilot-core/copilot-core.cabal index 1a091323a..d7e578be9 100644 --- a/copilot-core/copilot-core.cabal +++ b/copilot-core/copilot-core.cabal @@ -53,7 +53,6 @@ library Copilot.Core.Spec Copilot.Core.Type Copilot.Core.Type.Array - Copilot.Core.PrettyPrint other-modules: diff --git a/copilot-core/src/Copilot/Core/PrettyPrint.hs b/copilot-core/src/Copilot/Core/PrettyPrint.hs deleted file mode 100644 index 5a3396020..000000000 --- a/copilot-core/src/Copilot/Core/PrettyPrint.hs +++ /dev/null @@ -1,195 +0,0 @@ --- Copyright © 2011 National Institute of Aerospace / Galois, Inc. - --- | A pretty printer for Copilot specifications. - -{-# LANGUAGE GADTs #-} -{-# LANGUAGE Safe #-} - -module Copilot.Core.PrettyPrint - {-# DEPRECATED "This module is deprecated in Copilot 3.12. Use copilot-prettyprinter instead." #-} - ( prettyPrint - , ppExpr - ) where - -import Copilot.Core -import Copilot.Core.Error (impossible) -import Copilot.Core.Type.Show (showWithType, ShowType(..), showType) -import Prelude hiding (id, (<>)) -import Text.PrettyPrint.HughesPJ -import Data.List (intersperse) - --- | Create a unique stream name by prefixing the given ID by a lowercase --- letter @"s"@. -strmName :: Int -> Doc -strmName id = text "s" <> int id - --- | Pretty-print a Copilot expression. --- --- The type is ignored, and only the expression is pretty-printed. -ppExpr :: Expr a -> Doc -ppExpr e0 = case e0 of - Const t x -> text (showWithType Haskell t x) - Drop _ 0 id -> strmName id - Drop _ i id -> text "drop" <+> text (show i) <+> strmName id - ExternVar _ name _ -> text "Ext_" <> (text name) - Local _ _ name e1 e2 -> text "local" <+> doubleQuotes (text name) <+> equals - <+> ppExpr e1 $$ text "in" <+> ppExpr e2 - Var _ name -> text "var" <+> doubleQuotes (text name) - Op1 op e -> ppOp1 op (ppExpr e) - Op2 op e1 e2 -> ppOp2 op (ppExpr e1) (ppExpr e2) - Op3 op e1 e2 e3 -> ppOp3 op (ppExpr e1) (ppExpr e2) (ppExpr e3) - Label _ s e -> text "label "<> doubleQuotes (text s) <+> (ppExpr e) - --- | Pretty-print an untyped expression. --- --- The type is ignored, and only the expression is pretty-printed. -ppUExpr :: UExpr -> Doc -ppUExpr UExpr { uExprExpr = e0 } = ppExpr e0 - --- | Pretty-print a unary operation. -ppOp1 :: Op1 a b -> Doc -> Doc -ppOp1 op = case op of - Not -> ppPrefix "not" - Abs _ -> ppPrefix "abs" - Sign _ -> ppPrefix "signum" - Recip _ -> ppPrefix "recip" - Exp _ -> ppPrefix "exp" - Sqrt _ -> ppPrefix "sqrt" - Log _ -> ppPrefix "log" - Sin _ -> ppPrefix "sin" - Tan _ -> ppPrefix "tan" - Cos _ -> ppPrefix "cos" - Asin _ -> ppPrefix "asin" - Atan _ -> ppPrefix "atan" - Acos _ -> ppPrefix "acos" - Sinh _ -> ppPrefix "sinh" - Tanh _ -> ppPrefix "tanh" - Cosh _ -> ppPrefix "cosh" - Asinh _ -> ppPrefix "asinh" - Atanh _ -> ppPrefix "atanh" - Acosh _ -> ppPrefix "acosh" - Ceiling _ -> ppPrefix "ceiling" - Floor _ -> ppPrefix "floor" - BwNot _ -> ppPrefix "~" - Cast _ _ -> ppPrefix "(cast)" - GetField (Struct _) _ f -> \e -> ppInfix "#" e (text $ accessorname f) - GetField _ _ _ -> impossible "ppOp1" "Copilot.Core.PrettyPrint" - --- | Pretty-print a binary operation. -ppOp2 :: Op2 a b c -> Doc -> Doc -> Doc -ppOp2 op = case op of - And -> ppInfix "&&" - Or -> ppInfix "||" - Add _ -> ppInfix "+" - Sub _ -> ppInfix "-" - Mul _ -> ppInfix "*" - Div _ -> ppInfix "div" - Mod _ -> ppInfix "mod" - Fdiv _ -> ppInfix "/" - Pow _ -> ppInfix "**" - Logb _ -> ppInfix "logBase" - Atan2 _ -> ppInfix "atan2" - Eq _ -> ppInfix "==" - Ne _ -> ppInfix "/=" - Le _ -> ppInfix "<=" - Ge _ -> ppInfix ">=" - Lt _ -> ppInfix "<" - Gt _ -> ppInfix ">" - BwAnd _ -> ppInfix "&" - BwOr _ -> ppInfix "|" - BwXor _ -> ppInfix "^" - BwShiftL _ _ -> ppInfix "<<" - BwShiftR _ _ -> ppInfix ">>" - Index _ -> ppInfix ".!!" - --- | Pretty-print a ternary operation. -ppOp3 :: Op3 a b c d -> Doc -> Doc -> Doc -> Doc -ppOp3 op = case op of - Mux _ -> \ doc1 doc2 doc3 -> - text "(if" <+> doc1 <+> - text "then" <+> doc2 <+> - text "else" <+> doc3 <> text ")" - --- | Parenthesize two 'Doc's, separated by an infix 'String'. -ppInfix :: String -> Doc -> Doc -> Doc -ppInfix cs doc1 doc2 = parens $ doc1 <+> text cs <+> doc2 - --- | Prefix a 'Doc' by a 'String'. -ppPrefix :: String -> Doc -> Doc -ppPrefix cs = (text cs <+>) - --- | Pretty-print a Copilot stream as a case of a top-level function for --- streams of that type, by pattern matching on the stream name. -ppStream :: Stream -> Doc -ppStream - Stream - { streamId = id - , streamBuffer = buffer - , streamExpr = e - , streamExprType = t - } - = (parens . text . showType) t - <+> strmName id - <+> text "=" - <+> text ("[" - ++ ( concat $ intersperse "," - $ map (showWithType Haskell t) buffer ) - ++ "]") - <+> text "++" - <+> ppExpr e - --- | Pretty-print a Copilot trigger as a case of a top-level @trigger@ --- function, by pattern matching on the trigger name. -ppTrigger :: Trigger -> Doc -ppTrigger - Trigger - { triggerName = name - , triggerGuard = e - , triggerArgs = args } - = text "trigger" <+> text "\"" <> text name <> text "\"" - <+> text "=" - <+> ppExpr e - <+> lbrack - $$ (nest 2 $ vcat (punctuate comma $ - map (\a -> text "arg" <+> ppUExpr a) args)) - $$ nest 2 rbrack - --- | Pretty-print a Copilot observer as a case of a top-level @observer@ --- function, by pattern matching on the observer name. -ppObserver :: Observer -> Doc -ppObserver - Observer - { observerName = name - , observerExpr = e } - = text "observer \"" <> text name <> text "\"" - <+> text "=" - <+> ppExpr e - --- | Pretty-print a Copilot property as a case of a top-level @property@ --- function, by pattern matching on the property name. -ppProperty :: Property -> Doc -ppProperty - Property - { propertyName = name - , propertyExpr = e } - = text "property \"" <> text name <> text "\"" - <+> text "=" - <+> ppExpr e - --- | Pretty-print a Copilot specification, in the following order: --- --- - Streams definitions --- - Trigger definitions --- - Observer definitions --- - Property definitions -ppSpec :: Spec -> Doc -ppSpec spec = cs $$ ds $$ es $$ fs - where - cs = foldr (($$) . ppStream) empty (specStreams spec) - ds = foldr (($$) . ppTrigger) empty (specTriggers spec) - es = foldr (($$) . ppObserver) empty (specObservers spec) - fs = foldr (($$) . ppProperty) empty (specProperties spec) - --- | Pretty-print a Copilot specification. -prettyPrint :: Spec -> String -prettyPrint = render . ppSpec From 566875effb73666cecb448fd99b84a4f889e388f Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Wed, 19 Apr 2023 15:46:48 +0000 Subject: [PATCH 0598/1222] copilot-core: Remove module Copilot.Core.Error. Refs #426. The module Copilot.Core.PrettyPrint has been removed from copilot-core, and was the only module that used definitions from Copilot.Core.Error, which was not exposed by the API. Consequently, the latter can now be removed. This commit removes the module Copilot.Core.Error from copilot-core. --- copilot-core/copilot-core.cabal | 1 - copilot-core/src/Copilot/Core/Error.hs | 20 -------------------- 2 files changed, 21 deletions(-) delete mode 100644 copilot-core/src/Copilot/Core/Error.hs diff --git a/copilot-core/copilot-core.cabal b/copilot-core/copilot-core.cabal index d7e578be9..31a627aa2 100644 --- a/copilot-core/copilot-core.cabal +++ b/copilot-core/copilot-core.cabal @@ -56,7 +56,6 @@ library other-modules: - Copilot.Core.Error Copilot.Core.Type.Show test-suite unit-tests diff --git a/copilot-core/src/Copilot/Core/Error.hs b/copilot-core/src/Copilot/Core/Error.hs deleted file mode 100644 index 130ba29d2..000000000 --- a/copilot-core/src/Copilot/Core/Error.hs +++ /dev/null @@ -1,20 +0,0 @@ -{-# LANGUAGE Safe #-} - --- | --- Description: Custom functions to report error messages to users. --- Copyright: (c) 2011 National Institute of Aerospace / Galois, Inc. -module Copilot.Core.Error - ( impossible - ) - where - --- | Report an error due to a bug in Copilot. -impossible :: String -- ^ Name of the function in which the error was detected. - -> String -- ^ Name of the package in which the function is located. - -> a -impossible function package = - error $ "\"Impossible\" error in function " - ++ function ++ ", in package " ++ package - ++ ". Please file an issue at " - ++ "https://github.com/Copilot-Language/copilot/issues" - ++ "or email the maintainers at " From 6d1e27bd3700704ea3ba8101e953156b5575dd4e Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Wed, 19 Apr 2023 17:35:27 +0000 Subject: [PATCH 0599/1222] copilot-core: Remove module Copilot.Core.Type.Show. Refs #426. The module Copilot.Core.PrettyPrint has been removed from copilot-core, and was the only module that used definitions from Copilot.Core.Type.Show, which was not exposed by the API. Consequently, the latter can now be removed. This commit removes the module Copilot.Core.Type.Show from copilot-core. --- copilot-core/copilot-core.cabal | 4 -- copilot-core/src/Copilot/Core/Type/Show.hs | 77 ---------------------- 2 files changed, 81 deletions(-) delete mode 100644 copilot-core/src/Copilot/Core/Type/Show.hs diff --git a/copilot-core/copilot-core.cabal b/copilot-core/copilot-core.cabal index 31a627aa2..36380ad96 100644 --- a/copilot-core/copilot-core.cabal +++ b/copilot-core/copilot-core.cabal @@ -54,10 +54,6 @@ library Copilot.Core.Type Copilot.Core.Type.Array - other-modules: - - Copilot.Core.Type.Show - test-suite unit-tests type: exitcode-stdio-1.0 diff --git a/copilot-core/src/Copilot/Core/Type/Show.hs b/copilot-core/src/Copilot/Core/Type/Show.hs deleted file mode 100644 index d752445e8..000000000 --- a/copilot-core/src/Copilot/Core/Type/Show.hs +++ /dev/null @@ -1,77 +0,0 @@ -{-# LANGUAGE ExistentialQuantification #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE Safe #-} - --- | --- Copyright: (c) 2011 National Institute of Aerospace / Galois, Inc. --- --- Show Copilot Core types and typed values. -module Copilot.Core.Type.Show - ( showWithType - , ShowType (..) - , showType - ) - where - --- Internal imports -import Copilot.Core.Type (Type (..)) - --- | Target language for showing a typed value. Used to adapt the --- representation of booleans. -data ShowType = C | Haskell - --- | Show a value. The representation depends on the type and the target --- language. Booleans are represented differently depending on the backend. -showWithType :: ShowType -> Type a -> a -> String -showWithType showT t x = - case showT of - C -> case t of - Bool -> if x then "1" else "0" - _ -> sw - Haskell -> case t of - Bool -> if x then "true" else "false" - _ -> sw - where - sw = case showWit t of - ShowWit -> show x - --- | Show Copilot Core type. -showType :: Type a -> String -showType t = - case t of - Bool -> "Bool" - Int8 -> "Int8" - Int16 -> "Int16" - Int32 -> "Int32" - Int64 -> "Int64" - Word8 -> "Word8" - Word16 -> "Word16" - Word32 -> "Word32" - Word64 -> "Word64" - Float -> "Float" - Double -> "Double" - Array t -> "Array " ++ showType t - Struct t -> "Struct" - --- * Auxiliary show instance - --- | Witness datatype for showing a value, used by 'showWithType'. -data ShowWit a = Show a => ShowWit - --- | Turn a type into a show witness. -showWit :: Type a -> ShowWit a -showWit t = - case t of - Bool -> ShowWit - Int8 -> ShowWit - Int16 -> ShowWit - Int32 -> ShowWit - Int64 -> ShowWit - Word8 -> ShowWit - Word16 -> ShowWit - Word32 -> ShowWit - Word64 -> ShowWit - Float -> ShowWit - Double -> ShowWit - Array t -> ShowWit - Struct t -> ShowWit From 67a4aaea41c6c5a60ba280541f68e128a525a42a Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Wed, 19 Apr 2023 16:45:33 +0000 Subject: [PATCH 0600/1222] copilot-core: Remove dependency on pretty. Refs #426. The module Copilot.Core.PrettyPrint has been removed from copilot-core, and was the only module that used definitions from the library pretty. Consequently, the latter is no longer needed. This commit removes the dependency on pretty from the cabal file. --- copilot-core/copilot-core.cabal | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/copilot-core/copilot-core.cabal b/copilot-core/copilot-core.cabal index 36380ad96..d2059c4d9 100644 --- a/copilot-core/copilot-core.cabal +++ b/copilot-core/copilot-core.cabal @@ -42,8 +42,7 @@ library -fno-warn-orphans build-depends: - base >= 4.9 && < 5, - pretty >= 1.0 && < 1.2 + base >= 4.9 && < 5 exposed-modules: @@ -70,7 +69,6 @@ test-suite unit-tests base , HUnit , QuickCheck - , pretty , test-framework , test-framework-hunit , test-framework-quickcheck2 From d623d1e722f0d1c1d3e3746eff43ed5d512f37c4 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Wed, 19 Apr 2023 15:49:33 +0000 Subject: [PATCH 0601/1222] copilot-core: Document changes in CHANGELOG. Refs #426. --- copilot-core/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot-core/CHANGELOG b/copilot-core/CHANGELOG index f716fd465..488e3d0f3 100644 --- a/copilot-core/CHANGELOG +++ b/copilot-core/CHANGELOG @@ -1,5 +1,6 @@ -2023-04-17 +2023-04-19 * Remove Copilot.Core.Type.Equality. (#427) + * Remove Copilot.Core.PrettyPrint. (#426) 2023-03-07 * Version bump (3.14). (#422) From 78eaaedc796e49e73c80248b8b6250687496d136 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 7 May 2023 22:34:13 -0700 Subject: [PATCH 0602/1222] Bump versions and constraints. Refs #438. --- copilot-c99/copilot-c99.cabal | 4 ++-- copilot-core/copilot-core.cabal | 2 +- copilot-interpreter/copilot-interpreter.cabal | 4 ++-- copilot-language/copilot-language.cabal | 8 ++++---- copilot-libraries/copilot-libraries.cabal | 4 ++-- copilot-prettyprinter/copilot-prettyprinter.cabal | 4 ++-- copilot-theorem/copilot-theorem.cabal | 6 +++--- copilot/copilot.cabal | 14 +++++++------- 8 files changed, 23 insertions(+), 23 deletions(-) diff --git a/copilot-c99/copilot-c99.cabal b/copilot-c99/copilot-c99.cabal index 947ca889a..7c811e67b 100644 --- a/copilot-c99/copilot-c99.cabal +++ b/copilot-c99/copilot-c99.cabal @@ -1,6 +1,6 @@ cabal-version : >= 1.10 name : copilot-c99 -version : 3.14 +version : 3.15 synopsis : A compiler for Copilot targeting C99. description : This package is a back-end from Copilot to C. @@ -45,7 +45,7 @@ library , mtl >= 2.2 && < 2.4 , pretty >= 1.1 && < 1.2 - , copilot-core >= 3.14 && < 3.15 + , copilot-core >= 3.15 && < 3.16 , language-c99 >= 0.2.0 && < 0.3 , language-c99-simple >= 0.2.2 && < 0.3 diff --git a/copilot-core/copilot-core.cabal b/copilot-core/copilot-core.cabal index d2059c4d9..2e102418e 100644 --- a/copilot-core/copilot-core.cabal +++ b/copilot-core/copilot-core.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-core -version: 3.14 +version: 3.15 synopsis: An intermediate representation for Copilot. description: Intermediate representation for Copilot. diff --git a/copilot-interpreter/copilot-interpreter.cabal b/copilot-interpreter/copilot-interpreter.cabal index 986616e98..6bfb1a60f 100644 --- a/copilot-interpreter/copilot-interpreter.cabal +++ b/copilot-interpreter/copilot-interpreter.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-interpreter -version: 3.14 +version: 3.15 synopsis: Interpreter for Copilot. description: Interpreter for Copilot. @@ -44,7 +44,7 @@ library base >= 4.9 && < 5, pretty >= 1.0 && < 1.2, - copilot-core >= 3.14 && < 3.15 + copilot-core >= 3.15 && < 3.16 exposed-modules: diff --git a/copilot-language/copilot-language.cabal b/copilot-language/copilot-language.cabal index abdcc0329..9d3f9ac89 100644 --- a/copilot-language/copilot-language.cabal +++ b/copilot-language/copilot-language.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-language -version: 3.14 +version: 3.15 synopsis: A Haskell-embedded DSL for monitoring hard real-time distributed systems. description: @@ -42,9 +42,9 @@ library , data-reify >= 0.6 && < 0.7 , mtl >= 2.0 && < 3 - , copilot-core >= 3.14 && < 3.15 - , copilot-interpreter >= 3.14 && < 3.15 - , copilot-theorem >= 3.14 && < 3.15 + , copilot-core >= 3.15 && < 3.16 + , copilot-interpreter >= 3.15 && < 3.16 + , copilot-theorem >= 3.15 && < 3.16 exposed-modules: Copilot.Language , Copilot.Language.Operators.BitWise diff --git a/copilot-libraries/copilot-libraries.cabal b/copilot-libraries/copilot-libraries.cabal index e7cbaa78c..45d058114 100644 --- a/copilot-libraries/copilot-libraries.cabal +++ b/copilot-libraries/copilot-libraries.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-libraries -version: 3.14 +version: 3.15 synopsis: Libraries for the Copilot language. description: Libraries for the Copilot language. @@ -41,7 +41,7 @@ library , containers >= 0.4 && < 0.7 , mtl >= 2.0 && < 2.4 , parsec >= 2.0 && < 3.2 - , copilot-language >= 3.14 && < 3.15 + , copilot-language >= 3.15 && < 3.16 exposed-modules: Copilot.Library.Libraries diff --git a/copilot-prettyprinter/copilot-prettyprinter.cabal b/copilot-prettyprinter/copilot-prettyprinter.cabal index 30e543ebe..6944aa7e9 100644 --- a/copilot-prettyprinter/copilot-prettyprinter.cabal +++ b/copilot-prettyprinter/copilot-prettyprinter.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-prettyprinter -version: 3.14 +version: 3.15 synopsis: A prettyprinter of Copilot Specifications. description: A prettyprinter of Copilot specifications. @@ -45,7 +45,7 @@ library base >= 4.9 && < 5, pretty >= 1.0 && < 1.2, - copilot-core >= 3.14 && < 3.15 + copilot-core >= 3.15 && < 3.16 exposed-modules: diff --git a/copilot-theorem/copilot-theorem.cabal b/copilot-theorem/copilot-theorem.cabal index ba2855553..6420d297b 100644 --- a/copilot-theorem/copilot-theorem.cabal +++ b/copilot-theorem/copilot-theorem.cabal @@ -14,7 +14,7 @@ description: . -version : 3.14 +version : 3.15 license : BSD3 license-file : LICENSE maintainer : Ivan Perez @@ -63,8 +63,8 @@ library , xml >= 1.3 && < 1.4 , what4 >= 1.3 && < 1.5 - , copilot-core >= 3.14 && < 3.15 - , copilot-prettyprinter >= 3.14 && < 3.15 + , copilot-core >= 3.15 && < 3.16 + , copilot-prettyprinter >= 3.15 && < 3.16 exposed-modules : Copilot.Theorem , Copilot.Theorem.Prove diff --git a/copilot/copilot.cabal b/copilot/copilot.cabal index f12109969..0dd1f4f88 100644 --- a/copilot/copilot.cabal +++ b/copilot/copilot.cabal @@ -1,5 +1,5 @@ name: copilot -version: 3.14 +version: 3.15 cabal-version: >= 1.10 license: BSD3 license-file: LICENSE @@ -52,12 +52,12 @@ library , directory >= 1.3 && < 1.4 , filepath >= 1.4 && < 1.5 - , copilot-core >= 3.14 && < 3.15 - , copilot-theorem >= 3.14 && < 3.15 - , copilot-language >= 3.14 && < 3.15 - , copilot-libraries >= 3.14 && < 3.15 - , copilot-c99 >= 3.14 && < 3.15 - , copilot-prettyprinter >= 3.14 && < 3.15 + , copilot-core >= 3.15 && < 3.16 + , copilot-theorem >= 3.15 && < 3.16 + , copilot-language >= 3.15 && < 3.16 + , copilot-libraries >= 3.15 && < 3.16 + , copilot-c99 >= 3.15 && < 3.16 + , copilot-prettyprinter >= 3.15 && < 3.16 exposed-modules: Language.Copilot, Language.Copilot.Main From daf54a78794b0e533241a606e49c34abc51ccfaa Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 7 May 2023 23:21:50 -0700 Subject: [PATCH 0603/1222] Document changes in CHANGELOG. Refs #438. --- copilot-c99/CHANGELOG | 3 +++ copilot-core/CHANGELOG | 3 ++- copilot-interpreter/CHANGELOG | 3 +++ copilot-language/CHANGELOG | 3 ++- copilot-libraries/CHANGELOG | 3 +++ copilot-prettyprinter/CHANGELOG | 3 +++ copilot-theorem/CHANGELOG | 3 +++ copilot/CHANGELOG | 3 +++ 8 files changed, 22 insertions(+), 2 deletions(-) diff --git a/copilot-c99/CHANGELOG b/copilot-c99/CHANGELOG index e4f0b899a..a07b97ad2 100644 --- a/copilot-c99/CHANGELOG +++ b/copilot-c99/CHANGELOG @@ -1,3 +1,6 @@ +2023-05-07 + * Version bump (3.15). (#438) + 2023-03-07 * Version bump (3.14). (#422) diff --git a/copilot-core/CHANGELOG b/copilot-core/CHANGELOG index 488e3d0f3..2b189fc7e 100644 --- a/copilot-core/CHANGELOG +++ b/copilot-core/CHANGELOG @@ -1,4 +1,5 @@ -2023-04-19 +2023-05-07 + * Version bump (3.15). (#438) * Remove Copilot.Core.Type.Equality. (#427) * Remove Copilot.Core.PrettyPrint. (#426) diff --git a/copilot-interpreter/CHANGELOG b/copilot-interpreter/CHANGELOG index 60fabe2e7..556f93cf4 100644 --- a/copilot-interpreter/CHANGELOG +++ b/copilot-interpreter/CHANGELOG @@ -1,3 +1,6 @@ +2023-05-07 + * Version bump (3.15). (#438) + 2023-03-07 * Version bump (3.14). (#422) diff --git a/copilot-language/CHANGELOG b/copilot-language/CHANGELOG index 6f6b88b83..f8172456a 100644 --- a/copilot-language/CHANGELOG +++ b/copilot-language/CHANGELOG @@ -1,4 +1,5 @@ -2023-04-17 +2023-05-07 + * Version bump (3.15). (#438) * Remove outdated comment about pretty-printer. (#428) 2023-03-07 diff --git a/copilot-libraries/CHANGELOG b/copilot-libraries/CHANGELOG index f4bc08411..f49a945b2 100644 --- a/copilot-libraries/CHANGELOG +++ b/copilot-libraries/CHANGELOG @@ -1,3 +1,6 @@ +2023-05-07 + * Version bump (3.15). (#438) + 2023-03-07 * Version bump (3.14). (#422) diff --git a/copilot-prettyprinter/CHANGELOG b/copilot-prettyprinter/CHANGELOG index ca076385c..637bcc857 100644 --- a/copilot-prettyprinter/CHANGELOG +++ b/copilot-prettyprinter/CHANGELOG @@ -1,3 +1,6 @@ +2023-05-07 + * Version bump (3.15). (#438) + 2023-03-07 * Version bump (3.14). (#422) diff --git a/copilot-theorem/CHANGELOG b/copilot-theorem/CHANGELOG index ac38a74bd..5573b4125 100644 --- a/copilot-theorem/CHANGELOG +++ b/copilot-theorem/CHANGELOG @@ -1,3 +1,6 @@ +2023-05-07 + * Version bump (3.15). (#438) + 2023-03-07 * Version bump (3.14). (#422) * Adjust contraints on version of what4. (#423) diff --git a/copilot/CHANGELOG b/copilot/CHANGELOG index 0b3d7cde1..ee7ac6cef 100644 --- a/copilot/CHANGELOG +++ b/copilot/CHANGELOG @@ -1,3 +1,6 @@ +2023-05-07 + * Version bump (3.15). (#438) + 2023-03-07 * Version bump (3.14). (#422) * Replace import of Copilot.Language.prettyPrint. (#412) From 9bff3d0b596f9e669b5b4070b4d00c467b45e60b Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 4 Jul 2023 15:20:15 -0700 Subject: [PATCH 0604/1222] copilot-c99: Add testing infrastructure. Refs #413. As part of the requirements for Class D (NPR7150.2C), we need unit tests for all of copilot. This commit adds tests for copilot-c99, including the following cases: - A valid specification is compiled correctly (without errors). - A valid specification generates C code that can be compiled correctly. - A valid specification generates C code that behaves as expected. We test both normal streams (using plain types), as well as streams carrying arrays. Tests are enabled in the Travis CI infrastructure so that they run on every pull request. We do not test structs (yet) due to the general difficulty in generating structs using QuickCheck, a limitation we found when building tests for other parts of Copilot. That feature is deferred to future work. --- .travis.yml | 2 +- copilot-c99/copilot-c99.cabal | 35 + copilot-c99/tests/Main.hs | 18 + copilot-c99/tests/Test/Copilot/Compile/C99.hs | 955 ++++++++++++++++++ 4 files changed, 1009 insertions(+), 1 deletion(-) create mode 100644 copilot-c99/tests/Main.hs create mode 100644 copilot-c99/tests/Test/Copilot/Compile/C99.hs diff --git a/.travis.yml b/.travis.yml index 22b0431cc..cf88b9d51 100644 --- a/.travis.yml +++ b/.travis.yml @@ -27,4 +27,4 @@ script: # Run tests only on GHC 8.10.4 # # Only libraries with tests are listed below or the v2-test command fails. - - if [ "${GHCVER}" == "8.10.4" ]; then cabal v2-test -j1 copilot-core copilot-language copilot-interpreter; fi + - if [ "${GHCVER}" == "8.10.4" ]; then cabal v2-test -j1 copilot-core copilot-language copilot-interpreter copilot-c99; fi diff --git a/copilot-c99/copilot-c99.cabal b/copilot-c99/copilot-c99.cabal index 7c811e67b..586ce6630 100644 --- a/copilot-c99/copilot-c99.cabal +++ b/copilot-c99/copilot-c99.cabal @@ -58,3 +58,38 @@ library , Copilot.Compile.C99.External , Copilot.Compile.C99.Compile , Copilot.Compile.C99.Settings + +test-suite unit-tests + type: + exitcode-stdio-1.0 + + main-is: + Main.hs + + other-modules: + Test.Copilot.Compile.C99 + + build-depends: + base + , directory + , HUnit + , QuickCheck + , pretty + , process + , random + , test-framework + , test-framework-hunit + , test-framework-quickcheck2 + , unix + + , copilot-core + , copilot-c99 + + hs-source-dirs: + tests + + default-language: + Haskell2010 + + ghc-options: + -Wall diff --git a/copilot-c99/tests/Main.hs b/copilot-c99/tests/Main.hs new file mode 100644 index 000000000..57ea63bdc --- /dev/null +++ b/copilot-c99/tests/Main.hs @@ -0,0 +1,18 @@ +-- | Test copilot-c99. +module Main where + +-- External imports +import Test.Framework (Test, defaultMain) + +-- Internal library modules being tested +import qualified Test.Copilot.Compile.C99 + +-- | Run all unit tests on copilot-c99. +main :: IO () +main = defaultMain tests + +-- | All unit tests in copilot-c99. +tests :: [Test.Framework.Test] +tests = + [ Test.Copilot.Compile.C99.tests + ] diff --git a/copilot-c99/tests/Test/Copilot/Compile/C99.hs b/copilot-c99/tests/Test/Copilot/Compile/C99.hs new file mode 100644 index 000000000..2c98bb856 --- /dev/null +++ b/copilot-c99/tests/Test/Copilot/Compile/C99.hs @@ -0,0 +1,955 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE ScopedTypeVariables #-} +-- | Test copilot-c99:Copilot.Compile.C99. +module Test.Copilot.Compile.C99 + ( tests ) + where + +-- External imports +import Control.Arrow ((&&&)) +import Control.Exception (IOException, catch) +import Control.Monad (when) +import Data.Bits (Bits, complement) +import Data.List (intercalate) +import Data.Type.Equality (testEquality) +import Data.Typeable (Proxy (..), (:~:) (Refl)) +import GHC.TypeLits (KnownNat, natVal) +import System.Directory (doesFileExist, + getTemporaryDirectory, + removeDirectory, removeFile, + setCurrentDirectory) +import System.IO (hPutStrLn, stderr) +import System.Posix.Temp (mkdtemp) +import System.Process (callProcess, readProcess) +import System.Random (Random) +import Test.Framework (Test, testGroup) +import Test.Framework.Providers.QuickCheck2 (testProperty) +import Test.QuickCheck (Arbitrary, Gen, Property, + arbitrary, choose, elements, + forAll, forAllBlind, frequency, + getPositive, ioProperty, oneof, + vectorOf, (.&&.)) +import Test.QuickCheck.Gen (chooseAny, chooseBoundedIntegral) + +-- External imports: Copilot +import Copilot.Core hiding (Property) +import Copilot.Core.Type.Array (array) + +-- External imports: Modules being tested +import Copilot.Compile.C99 (cSettingsOutputDirectory, compile, compileWith, + mkDefaultCSettings) + +-- * Constants + +-- | All unit tests for copilot-core:Copilot.Core.Type. +tests :: Test.Framework.Test +tests = + testGroup "Copilot.Compile.C99" + [ testProperty "Compile specification" testCompile + , testProperty "Compile specification in custom dir" testCompileCustomDir + , testProperty "Run specification" testRun + , testProperty "Run and compare results" testRunCompare + ] + +-- * Individual tests + +-- | Test compiling a spec. +testCompile :: Property +testCompile = ioProperty $ do + tmpDir <- getTemporaryDirectory + setCurrentDirectory tmpDir + + testDir <- mkdtemp "copilot_test_" + setCurrentDirectory testDir + + compile "copilot_test" spec + r <- compileC "copilot_test" + + -- Remove file produced by GCC + removeFile "copilot_test.o" + + -- Remove files produced by Copilot + removeFile "copilot_test.c" + removeFile "copilot_test.h" + removeFile "copilot_test_types.h" + + setCurrentDirectory tmpDir + removeDirectory testDir + + return r + + where + + spec = Spec streams observers triggers properties + + streams = [ Stream 0 [1] (Const Int8 1) Int8] + observers = [] + triggers = [ Trigger function guard args ] + properties = [] + + function = "func" + + guard = Const Bool True + + args = [] + +-- | Test compiling a spec in a custom directory. +testCompileCustomDir :: Property +testCompileCustomDir = ioProperty $ do + tmpDir <- getTemporaryDirectory + setCurrentDirectory tmpDir + + testDir <- mkdtemp "copilot_test_" + + compileWith (mkDefaultCSettings { cSettingsOutputDirectory = testDir }) + "copilot_test" + spec + + setCurrentDirectory testDir + r <- compileC "copilot_test" + + -- Remove file produced by GCC + removeFile "copilot_test.o" + + -- Remove files produced by Copilot + removeFile "copilot_test.c" + removeFile "copilot_test.h" + removeFile "copilot_test_types.h" + + setCurrentDirectory tmpDir + removeDirectory testDir + + return r + + where + + spec = Spec streams observers triggers properties + + streams = [ Stream 0 [1] (Const Int8 1) Int8] + observers = [] + triggers = [ Trigger function guard args ] + properties = [] + + function = "nop" + + guard = Const Bool True + + args = [] + +-- | Test compiling a spec and running the resulting program. +-- +-- The actual behavior is ignored. +testRun :: Property +testRun = ioProperty $ do + tmpDir <- getTemporaryDirectory + setCurrentDirectory tmpDir + + testDir <- mkdtemp "copilot_test_" + setCurrentDirectory testDir + + compile "copilot_test" spec + r <- compileC "copilot_test" + + let cProgram = unlines + [ "#include \"copilot_test.h\"" + , "" + , "void nop () {" + , "}" + , "" + , "void main () {" + , " step();" + , "}" + ] + + writeFile "main.c" cProgram + + -- Compile a main program + r2 <- compileExecutable "main" [ "copilot_test.o" ] + callProcess "./main" [] + + -- Remove file produced by GCC + removeFile "copilot_test.o" + removeFile "main" + + -- Remove files produced "by hand" + removeFile "main.c" + + -- Remove files produced by Copilot + removeFile "copilot_test.c" + removeFile "copilot_test.h" + removeFile "copilot_test_types.h" + + setCurrentDirectory tmpDir + removeDirectory testDir + + return $ r && r2 + + where + + spec = Spec streams observers triggers properties + + streams = [ Stream 0 [1] (Const Int8 1) Int8] + observers = [] + triggers = [ Trigger function guard args ] + properties = [] + + function = "nop" + + guard = Const Bool True + + args = [] + +-- | Test running compiled spec and comparing the results to the +-- expectation. +testRunCompare :: Property +testRunCompare = + testRunCompare1 (arbitraryOpIntegralBool :: Gen (TestCase1 Int8 Bool)) + .&&. testRunCompare1 (arbitraryOpIntegralBool :: Gen (TestCase1 Int16 Bool)) + .&&. testRunCompare1 (arbitraryOpIntegralBool :: Gen (TestCase1 Int32 Bool)) + .&&. testRunCompare1 (arbitraryOpIntegralBool :: Gen (TestCase1 Int64 Bool)) + .&&. testRunCompare1 (arbitraryOpIntegralBool :: Gen (TestCase1 Word8 Bool)) + .&&. testRunCompare1 (arbitraryOpIntegralBool :: Gen (TestCase1 Word16 Bool)) + .&&. testRunCompare1 (arbitraryOpIntegralBool :: Gen (TestCase1 Word32 Bool)) + .&&. testRunCompare1 (arbitraryOpIntegralBool :: Gen (TestCase1 Word64 Bool)) + .&&. testRunCompare1 (arbitraryOpFloatingBool :: Gen (TestCase1 Float Bool)) + .&&. testRunCompare1 (arbitraryOpFloatingBool :: Gen (TestCase1 Double Bool)) + .&&. testRunCompare2 (arbitraryArrayNum :: Gen (TestCase2 (Array 2 Int8) Word32 Int8)) + .&&. testRunCompare2 (arbitraryArrayNum :: Gen (TestCase2 (Array 2 Int16) Word32 Int16)) + +-- * Random generators + +-- ** Random function generators + +-- | Generator of functions that produce booleans. +arbitraryOpBool :: Typed a => Gen (Fun a Bool, [a] -> [Bool]) +arbitraryOpBool = + frequency + [ (5, arbitraryOp1Any) + , (5, funCompose1 <$> arbitraryOp1Bool <*> arbitraryOpBool) + , (2, funCompose2 <$> arbitraryOp2Bool <*> arbitraryOpBool <*> arbitraryOpBool) + , (1, funCompose2 <$> arbitraryOp2Eq <*> arbitraryOpBool <*> arbitraryOpBool) + , (1, funCompose2 <$> arbitraryOp2Ord <*> arbitraryOpBool <*> arbitraryOpBool) + ] + +-- | Generator of functions that take Bits and produce booleans. +arbitraryOpBoolBits :: (Typed a, Bits a) => Gen (Fun a Bool, [a] -> [Bool]) +arbitraryOpBoolBits = + frequency + [ (1, funCompose2 <$> arbitraryOp2Eq <*> arbitraryOpBits <*> arbitraryOpBits) + ] + +-- | Generator of functions that take Nums and produce booleans. +arbitaryOpBoolOrdEqNum :: (Typed a, Eq a, Ord a, Num a) + => Gen (Fun a Bool, [a] -> [Bool]) +arbitaryOpBoolOrdEqNum = + frequency + [ (1, funCompose2 <$> arbitraryOp2Eq <*> arbitraryOpNum <*> arbitraryOpNum) + , (1, funCompose2 <$> arbitraryOp2Ord <*> arbitraryOpNum <*> arbitraryOpNum) + ] + +-- | Generator of functions that take Floating point numbers and produce +-- booleans. +arbitraryOpBoolEqNumFloat :: (Typed t, Eq t, Num t, Floating t) + => Gen (Fun t Bool, [t] -> [Bool]) +arbitraryOpBoolEqNumFloat = + frequency + [ (1, funCompose2 <$> arbitraryOp2Eq <*> arbitraryOpNum <*> arbitraryOpFloat) + , (1, funCompose2 <$> arbitraryOp2Eq <*> arbitraryOpFloat <*> arbitraryOpNum) + ] + +-- | Generator of functions that take and produce Bits. +arbitraryOpBits :: (Bits t, Typed t) + => Gen (Fun t t, [t] -> [t]) +arbitraryOpBits = elements + [ (Op1 (BwNot typeOf), fmap complement) + ] + +-- | Generator of functions that take and produce Nums. +arbitraryOpNum :: (Typed t, Num t) => Gen (Fun t t, [t] -> [t]) +arbitraryOpNum = elements + [ (Op1 (Abs typeOf), fmap abs) + , (Op1 (Sign typeOf), fmap signum) + ] + +-- | Generator of functions that take an arrays and indicates and produce +-- elements from the array. +arbitraryArrayIx :: forall t n . (Typed t, KnownNat n, Num t) + => Gen ( Fun2 (Array n t) Word32 t + , [Array n t] -> [Word32] -> [t] + ) +arbitraryArrayIx = return + (Op2 (Index typeOf), zipWith (\x y -> arrayelems x !! fromIntegral y)) + +-- | Generator of functions on Floating point numbers. +arbitraryOpFloat :: (Floating t, Typed t) => Gen (Fun t t, [t] -> [t]) +arbitraryOpFloat = elements + [ (Op1 (Exp typeOf), fmap exp) + , (Op1 (Sqrt typeOf), fmap sqrt) + , (Op1 (Log typeOf), fmap log) + , (Op1 (Sin typeOf), fmap sin) + , (Op1 (Tan typeOf), fmap tan) + , (Op1 (Cos typeOf), fmap cos) + , (Op1 (Asin typeOf), fmap asin) + , (Op1 (Atan typeOf), fmap atan) + , (Op1 (Acos typeOf), fmap acos) + , (Op1 (Sinh typeOf), fmap sinh) + , (Op1 (Tanh typeOf), fmap tanh) + , (Op1 (Cosh typeOf), fmap cosh) + , (Op1 (Asinh typeOf), fmap asinh) + , (Op1 (Atanh typeOf), fmap atanh) + , (Op1 (Acosh typeOf), fmap acosh) + ] + +-- | Generator of functions on that produce elements of any type. +arbitraryOp1Any :: forall a b + . (Arbitrary b, Typed a, Typed b) + => Gen (Fun a b, [a] -> [b]) +arbitraryOp1Any = oneof $ + [ (\v -> (\_ -> Const typeOf v, fmap (const v))) <$> arbitrary ] + ++ + rest + where + rest | Just Refl <- testEquality t1 t2 + = [return (id, id)] + | otherwise + = [] + + t1 :: Type a + t1 = typeOf + + t2 :: Type b + t2 = typeOf + +-- | Generator of functions on Booleans. +arbitraryOp1Bool :: Gen (Fun Bool Bool, [Bool] -> [Bool]) +arbitraryOp1Bool = elements + [ (Op1 Not, fmap not) + ] + +-- | Generator of binary functions on Booleans. +arbitraryOp2Bool :: Gen (Fun2 Bool Bool Bool, [Bool] -> [Bool] -> [Bool]) +arbitraryOp2Bool = elements + [ (Op2 And, zipWith (&&)) + , (Op2 Or, zipWith (||)) + ] + +-- | Generator of binary functions that take two Eq elements of the same type +-- and return a Bool. +arbitraryOp2Eq :: (Typed t, Eq t) + => Gen (Fun2 t t Bool, [t] -> [t] -> [Bool]) +arbitraryOp2Eq = elements + [ (Op2 (Eq typeOf), zipWith (==)) + , (Op2 (Ne typeOf), zipWith (/=)) + ] + +-- | Generator of binary functions that take two Ord elements of the same type +-- and return a Bool. +arbitraryOp2Ord :: (Typed t, Ord t) + => Gen (Fun2 t t Bool, [t] -> [t] -> [Bool]) +arbitraryOp2Ord = elements + [ (Op2 (Le typeOf), zipWith (<=)) + , (Op2 (Lt typeOf), zipWith (<)) + , (Op2 (Ge typeOf), zipWith (>=)) + , (Op2 (Gt typeOf), zipWith (>)) + ] + +-- ** Random data generators + +-- | Random array generator. +arbitraryArray :: forall n t . (KnownNat n, Random t) => Gen (Array n t) +arbitraryArray = array <$> vectorOf len chooseAny + where + len :: Int + len = fromIntegral $ natVal (Proxy :: Proxy n) + +-- ** Random test case generators + +-- | Generator for test cases on integral numbers that produce booleans. +arbitraryOpIntegralBool :: (Typed t, Bounded t, Integral t, Bits t) + => Gen (TestCase1 t Bool) +arbitraryOpIntegralBool = frequency + [ (5, mkTestCase1 + arbitraryOpBool + (chooseBoundedIntegral (minBound, maxBound))) + + , (2, mkTestCase1 + arbitraryOpBoolBits + (chooseBoundedIntegral (minBound, maxBound))) + + -- we need to use +1 because certain operations overflow the number + , (2, mkTestCase1 + arbitaryOpBoolOrdEqNum + (chooseBoundedIntegral (minBound + 1, maxBound))) + ] + +-- | Generator for test cases on floating-point numbers that produce booleans. +arbitraryOpFloatingBool :: (Random t, Typed t, Floating t, Eq t) + => Gen (TestCase1 t Bool) +arbitraryOpFloatingBool = oneof + [ mkTestCase1 arbitraryOpBoolEqNumFloat chooseAny + ] + +-- | Generator for test cases on Arrays selection producing values of the +-- array. +arbitraryArrayNum :: forall n a + . (KnownNat n, Num a, Random a, Typed a) + => Gen (TestCase2 (Array n a) Word32 a) +arbitraryArrayNum = oneof + [ mkTestCase2 arbitraryArrayIx arbitraryArray gen + ] + where + gen :: Gen Word32 + gen = choose (0, len - 1) + + len :: Word32 + len = fromIntegral $ natVal (Proxy :: Proxy n) + +-- * Semantics + +-- ** Functions + +-- | Unary Copilot function. +type Fun a b = Expr a -> Expr b + +-- | Binary Copilot function. +type Fun2 a b c = Expr a -> Expr b -> Expr c + +-- | Compose functions, paired with the Haskell functions that define their +-- idealized meaning. +funCompose1 :: (Fun b c, [b] -> [c]) + -> (Fun a b, [a] -> [b]) + -> (Fun a c, [a] -> [c]) +funCompose1 (f1, g1) (f2, g2) = (f1 . f2, g1 . g2) + +-- | Compose a binary function, with two functions, one for each argument. +funCompose2 :: (Fun2 b c d, [b] -> [c] -> [d]) + -> (Fun a b, [a] -> [b]) + -> (Fun a c, [a] -> [c]) + -> (Fun a d, [a] -> [d]) +funCompose2 (f1, g1) (f2, g2) (f3, g3) = + (uncurry f1 . (f2 &&& f3), uncurry g1 . (g2 &&& g3)) + +-- ** Test cases + +-- | Test case specification for specs with one input variable and one output. +data TestCase1 a b = TestCase1 + { wrapTC1Expr :: Spec + -- ^ Specification containing a trigger an extern of type 'a' and a trigger + -- with an argument of type 'b'. + + , wrapTC1Fun :: [a] -> [b] + -- ^ Function expected to function in the same way as the Spec being + -- tested. + + , wrapTC1CopInp :: (String -> String, String, String, Gen a) + -- ^ Input specification. + -- + -- - The first element is a function that prints the variable declaration + -- in C. + -- + -- - The second element obtains a C expression that calculates the size of + -- the variable in C. + -- + -- - The third contains the variable name in C. + -- + -- - The latter contains a randomized generator for values of the given + -- type. + + , wrapTC1CopOut :: (String, String) + -- ^ Output specification. + -- + -- The first element of the tuple contains the type of the output in C. + -- + -- The second element of the tuple is the formatting string when printing + -- values of the given kind. + } + +-- | Test case specification for specs with two input variables and one output. +data TestCase2 a b c = TestCase2 + { wrapTC2Expr :: Spec + -- ^ Specification containing a trigger an extern of type 'a' and a trigger + -- with an argument of type 'b'. + + , wrapTC2Fun :: [a] -> [b] -> [c] + -- ^ Function expected to function in the same way as the Spec being + -- tested. + + , wrapTC2CopInp1 :: (String -> String, String, String, Gen a) + -- ^ Input specification for the first input. + -- + -- - The first element is a function that prints the variable declaration + -- in C. + -- + -- - The second element obtains a C expression that calculates the size of + -- the variable in C. + -- + -- - The third contains the variable name in C. + -- + -- - The latter contains a randomized generator for values of the given + -- type. + + , wrapTC2CopInp2 :: (String -> String, String, String, Gen b) + -- ^ Input specification for the second input. + -- + -- - The first element is a function that prints the variable declaration + -- in C. + -- + -- - The second element obtains a C expression that calculates the size of + -- the variable in C. + -- + -- - The third contains the variable name in C. + -- + -- - The latter contains a randomized generator for values of the given + -- type. + + , wrapTC2CopOut :: (String, String) + -- ^ Output specification. + -- + -- The first element of the tuple contains the type of the output in C. + -- + -- The second element of the tuple is the formatting string when printing + -- values of the given kind. + } + +-- | Generate test cases for expressions that behave like unary functions. +mkTestCase1 :: (Typed a, Typed b) + => Gen (Fun a b, [a] -> [b]) + -> Gen a + -> Gen (TestCase1 a b) +mkTestCase1 genO gen = do + (copilotF, semF) <- genO + + let spec = alwaysTriggerArg1 (UExpr t2 appliedOp) + appliedOp = copilotF (ExternVar t1 varName Nothing) + + return $ + TestCase1 + spec + semF + ( varDeclC t1, sizeC t1, varName, gen ) + ( typeC t2, formatC t2) + + where + + t1 = typeOf + t2 = typeOf + + varName = "input" + +-- | Generate test cases for expressions that behave like binary functions. +mkTestCase2 :: (Typed a, Typed b, Typed c) + => Gen (Fun2 a b c, [a] -> [b] -> [c]) + -> Gen a + -> Gen b + -> Gen (TestCase2 a b c) +mkTestCase2 genO genA genB = do + (copilotF, semF) <- genO + + let spec = alwaysTriggerArg1 (UExpr t3 appliedOp) + appliedOp = copilotF (ExternVar t1 varName1 Nothing) + (ExternVar t2 varName2 Nothing) + + return $ + TestCase2 + spec + semF + ( varDeclC t1, sizeC t1, varName1, genA ) + ( varDeclC t2, sizeC t2, varName2, genB ) + ( typeC t3, formatC t3) + + where + + t1 = typeOf + t2 = typeOf + t3 = typeOf + + varName1 = "input1" + varName2 = "input2" + +-- | Test running a compiled C program and comparing the results. +testRunCompare1 :: (Show a, CShow a, ReadableFromC b, Eq b) + => Gen (TestCase1 a b) -> Property +testRunCompare1 ops = + forAllBlind ops $ \testCase -> + let (TestCase1 copilotSpec haskellFun inputVar outputVar) = testCase + (cTypeInput, size, cInputName, gen) = inputVar + + in forAll (getPositive <$> arbitrary) $ \len -> + + forAll (vectorOf len gen) $ \nums -> do + + let inputs = [ (cTypeInput, size, fmap cshow nums, cInputName) ] + outputs = haskellFun nums + + testRunCompareArg inputs len outputs copilotSpec outputVar + +-- | Test running a compiled C program and comparing the results. +testRunCompare2 :: (Show a1, CShow a1, Show a2, CShow a2, ReadableFromC b, Eq b) + => Gen (TestCase2 a1 a2 b) -> Property +testRunCompare2 ops = + forAllBlind ops $ \testCase -> + let (TestCase2 copilotSpec haskellFun inputVar1 inputVar2 outputVar) = + testCase + + (cTypeInput1, size1, cInputName1, gen1) = inputVar1 + (cTypeInput2, size2, cInputName2, gen2) = inputVar2 + + in forAll (getPositive <$> arbitrary) $ \len -> + forAll (vectorOf len gen1) $ \nums1 -> + forAll (vectorOf len gen2) $ \nums2 -> do + let inputs = [ (cTypeInput1, size1, fmap cshow nums1, cInputName1) + , (cTypeInput2, size2, fmap cshow nums2, cInputName2) + ] + + outputs = haskellFun nums1 nums2 + + testRunCompareArg inputs len outputs copilotSpec outputVar + +-- | Test running a compiled C program and comparing the results, when the +-- program produces one output as an argument to a trigger that always fires. +-- +-- PRE: all lists (second argument) of inputs have the length given as second +-- argument. +-- +-- PRE: the monitoring code this is linked against uses the function +-- @printBack@ with exactly one argument to pass the results. +testRunCompareArg :: (ReadableFromC b, Eq b) + => [(String -> String, String, [String], String)] + -> Int + -> [b] + -> Spec + -> (String, String) + -> Property +testRunCompareArg inputs numInputs nums spec outputVar = + ioProperty $ do + tmpDir <- getTemporaryDirectory + setCurrentDirectory tmpDir + + -- Operate in temporary directory + testDir <- mkdtemp "copilot_test_" + setCurrentDirectory testDir + + -- Produce copilot monitoring code + compile "copilot_test" spec + r <- compileC "copilot_test" + + -- Produce wrapper program + let cProgram = testRunCompareArgCProgram inputs numInputs outputVar + writeFile "main.c" cProgram + + -- Compile main program + r2 <- compileExecutable "main" [ "copilot_test.o" ] + + -- Print result so far (for debugging purposes only) + print r2 + print testDir + + -- Run program and compare result + out <- readProcess "./main" [] "" + let outNums = readFromC <$> lines out + comparison = outNums == nums + + -- Only clean up if the test succeeded; otherwise, we want to inspect it. + when comparison $ do + -- Remove file produced by GCC + removeFile "copilot_test.o" + removeFile "main" + + -- Remove files produced "by hand" + removeFile "main.c" + + -- Remove files produced by Copilot + removeFile "copilot_test.c" + removeFile "copilot_test.h" + removeFile "copilot_test_types.h" + + -- Remove temporary directory + setCurrentDirectory tmpDir + removeDirectory testDir + + return $ r && r2 && comparison + +-- | Return a wrapper C program that runs a loop for a number of iterations, +-- putting values in global variables at every step, running the monitors, and +-- publishing the results of any outputs. +testRunCompareArgCProgram + :: [(String -> String, String, [String], String)] + -> Int + -> (String, String) + -> String +testRunCompareArgCProgram inputs numSteps outputVar = unlines $ + [ "#include " + , "#include " + , "#include " + , "#include " + , "#include " + , "#include \"copilot_test.h\"" + , "" + ] + ++ varDecls ++ + [ "" + , "void printBack (" ++ cTypeRes ++ " num) {" + , " printf(\"" ++ cStr ++ "\\n\", num);" + , "}" + , "" + , "int main () {" + , " int i = 0;" + , " for (i = 0; i < " ++ maxInputsName ++ "; i++) {" + ] + ++ inputUpdates ++ + [ "" + , " step();" + , " }" + , " return 0;" + , "}" + ] + + where + + varDecls :: [String] + varDecls = + [ "int " ++ maxInputsName ++ " = " ++ show numSteps ++ ";" ] + ++ inputVarDecls + + inputVarDecls :: [String] + inputVarDecls = + concatMap + (\(ctypeF, _size, varName, arrVar, arrVals) -> + + let inputsStr = intercalate ", " (arrVals :: [String]) + + in [ ctypeF (arrVar ++ "[]") ++ " = {" ++ inputsStr ++ "};" + , "" + , ctypeF varName ++ ";" + ] + ) + vars + + inputUpdates :: [String] + inputUpdates = concatMap (\(_ctype, size, varName, arrVar, _arrVals) -> + [ " memcpy(&" ++ varName ++ ", &" ++ arrVar ++ "[i], " ++ size ++ ");" + ]) + vars + + (cTypeRes, cStr) = outputVar + + vars = map oneInput inputs + oneInput (cTypeInput, size, inputVals, cInputName) = + (cTypeInput, size, inputVarName, inputArrVarName, inputVals) + where + inputVarName = cInputName + inputArrVarName = cInputName ++ "_s" + + maxInputsName = "MAX_STEPS" + +-- * Auxiliary functions + +-- ** Specs handling + +-- | Build a 'Spec' that triggers at every step, passing the given expression +-- as argument, and execution a function 'printBack'. +alwaysTriggerArg1 :: UExpr -> Spec +alwaysTriggerArg1 = triggerArg1 (Const Bool True) + + where + + -- | Build a 'Spec' that triggers based on a given boolean stream, passing + -- the given expression as argument, and execution a function 'printBack'. + triggerArg1 :: Expr Bool -> UExpr -> Spec + triggerArg1 guard expr = Spec streams observers triggers properties + + where + + streams = [] + observers = [] + properties = [] + + triggers = [ Trigger function guard args ] + function = "printBack" + args = [ expr ] + +-- ** Compilation of C programs + +-- | Compile a C file given its basename. +compileC :: String -> IO Bool +compileC baseName = do + result <- catch (do callProcess "gcc" [ "-c", baseName ++ ".c" ] + return True + ) + (\e -> do + hPutStrLn stderr $ + "copilot-c99: error: compileC: cannot compile " + ++ baseName ++ ".c with gcc" + hPutStrLn stderr $ + "copilot-c99: exception: " ++ show (e :: IOException) + return False + ) + if result + then doesFileExist $ baseName ++ ".o" + else return False + +-- | Compile a C file into an executable, given its basename and files to link +-- with it. +compileExecutable :: String -> [String] -> IO Bool +compileExecutable baseName linked = do + result <- catch (do callProcess "gcc" $ [ baseName ++ ".c" ] + ++ linked + ++ [ "-lm" ] + ++ [ "-o", baseName ] + return True + ) + (\e -> do + hPutStrLn stderr $ + "copilot-c99: error: compileExecutable: cannot compile " + ++ baseName ++ ".c with gcc" + hPutStrLn stderr $ + "copilot-c99: exception: " ++ show (e :: IOException) + return False + ) + if result + then doesFileExist baseName + else return False + +-- ** Interfacing between Haskell and C + +-- | C formatting string that can be used to print values of a given type. +formatC :: Typed a => Type a -> String +formatC Bool = "%d" +formatC Int8 = "%d" +formatC Int16 = "%d" +formatC Int32 = "%d" +formatC Int64 = "%ld" +formatC Word8 = "%d" +formatC Word16 = "%d" +formatC Word32 = "%d" +formatC Word64 = "%ld" +formatC Float = "%f" +formatC Double = "%lf" +formatC _ = error + "copilot-c99 (test): Printing of arrays and structs is not yet supported." + +-- | C type used to store values of a given type. +typeC :: Typed a => Type a -> String +typeC Bool = "bool" +typeC Int8 = "int8_t" +typeC Int16 = "int16_t" +typeC Int32 = "int32_t" +typeC Int64 = "int64_t" +typeC Word8 = "uint8_t" +typeC Word16 = "uint16_t" +typeC Word32 = "uint32_t" +typeC Word64 = "uint64_t" +typeC Float = "float" +typeC Double = "double" +typeC (Array tE) = typeC tE ++ "[]" +typeC _ = error + "copilot-c99 (test): Input variables of type struct are not yet supported." + +-- | C variable declaration for values of a given type. +varDeclC :: Typed a => Type a -> String -> String +varDeclC Bool v = "bool " ++ v +varDeclC Int8 v = "int8_t " ++ v +varDeclC Int16 v = "int16_t " ++ v +varDeclC Int32 v = "int32_t " ++ v +varDeclC Int64 v = "int64_t " ++ v +varDeclC Word8 v = "uint8_t " ++ v +varDeclC Word16 v = "uint16_t " ++ v +varDeclC Word32 v = "uint32_t " ++ v +varDeclC Word64 v = "uint64_t " ++ v +varDeclC Float v = "float " ++ v +varDeclC Double v = "double " ++ v +varDeclC t@(Array tE) v = + typeC tE ++ " " ++ v ++ "[" ++ show (tylength t) ++ "]" +varDeclC _ _ = error + "copilot-c99 (test): Input variables of type struct are not yet supported." + +-- | Expression that calculates the size of a variable of a given type. +sizeC :: Typed a => Type a -> String +sizeC Bool = "sizeof(bool)" +sizeC Int8 = "sizeof(int8_t)" +sizeC Int16 = "sizeof(int16_t)" +sizeC Int32 = "sizeof(int32_t)" +sizeC Int64 = "sizeof(int64_t)" +sizeC Word8 = "sizeof(uint8_t)" +sizeC Word16 = "sizeof(uint16_t)" +sizeC Word32 = "sizeof(uint32_t)" +sizeC Word64 = "sizeof(uint64_t)" +sizeC Float = "sizeof(float)" +sizeC Double = "sizeof(double)" +sizeC t@(Array tE) = show (tylength t) ++ "* sizeof(" ++ typeC tE ++ ")" +sizeC _ = error + "copilot-c99 (test): Input variables of type struct are not yet supported." + +-- | Show a value of a given type in C. +class CShow s where + cshow :: s -> String + +instance CShow Int8 where + cshow = show + +instance CShow Int16 where + cshow = show + +instance CShow Int32 where + cshow = show + +instance CShow Int64 where + cshow = show + +instance CShow Word8 where + cshow = show + +instance CShow Word16 where + cshow = show + +instance CShow Word32 where + cshow = show + +instance CShow Word64 where + cshow = show + +instance CShow Float where + cshow = show + +instance CShow Double where + cshow = show + +instance CShow Bool where + cshow True = "true" + cshow False = "false" + +instance CShow t => CShow (Array n t) where + cshow a = intercalate "," $ map cshow $ arrayelems a + +-- | Read a value of a given type in C. +class ReadableFromC a where + readFromC :: String -> a + +instance ReadableFromC Bool where + readFromC "0" = False + readFromC _ = True + +instance ReadableFromC Int8 where + readFromC = read + +instance ReadableFromC Int16 where + readFromC = read + +instance ReadableFromC Int32 where + readFromC = read + +instance ReadableFromC Int64 where + readFromC = read + +instance ReadableFromC Word8 where + readFromC = read + +instance ReadableFromC Word16 where + readFromC = read + +instance ReadableFromC Word32 where + readFromC = read + +instance ReadableFromC Word64 where + readFromC = read From c5366b29052cc99037859d297086a286a96e4f48 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 4 Jul 2023 15:20:01 -0700 Subject: [PATCH 0605/1222] copilot-c99: Document changes in CHANGELOG. Refs #413. --- copilot-c99/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-c99/CHANGELOG b/copilot-c99/CHANGELOG index a07b97ad2..a4d884ade 100644 --- a/copilot-c99/CHANGELOG +++ b/copilot-c99/CHANGELOG @@ -1,3 +1,6 @@ +2023-07-04 + * Introduce testing infrastructure. (#413) + 2023-05-07 * Version bump (3.15). (#438) From 9f1c439a639d1f53076254566fffdb544b189588 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 7 Jul 2023 13:46:07 +0000 Subject: [PATCH 0606/1222] copilot-language: Move Copilot.Language.Stream.Arg to Copilot.Language.Spec. Refs #446. The type Copilot.Language.Stream.Arg is defined in the same module as a Stream, but nothing in that module uses an Arg. Architecturally, that type doesn't belong in that module, but, rather, should be listed in Copilot.Language.Spec, where it is used in the definition of Trigger. Consequently, Copilot.Language.Stream.Arg should be moved to Copilot.Language.Spec. As per our internal policy of waiting 3 versions from deprecation until a public interface declaration can be hidden, this definition should be deprecated in Copilot.Language.Stream.Arg and re-published from Copilot.Language.Spec. However, Haskell offers no mechanism to do that. If we deprecate it in Copilot.Language.Stream.Arg, we cannot make that warning disappear when imported from Copilot.Language.Spec, even with {-# OPTIONS_GHC -fno-warn-deprecations #-}. This commit moves Copilot.Language.Stream.Arg to Copilot.Language.Spec. All imports are adjusted accordingly. --- copilot-language/src/Copilot/Language/Analyze.hs | 2 +- copilot-language/src/Copilot/Language/Reify.hs | 2 +- copilot-language/src/Copilot/Language/Spec.hs | 5 +++++ copilot-language/src/Copilot/Language/Stream.hs | 5 ----- 4 files changed, 7 insertions(+), 7 deletions(-) diff --git a/copilot-language/src/Copilot/Language/Analyze.hs b/copilot-language/src/Copilot/Language/Analyze.hs index 99e1604db..9d326395c 100644 --- a/copilot-language/src/Copilot/Language/Analyze.hs +++ b/copilot-language/src/Copilot/Language/Analyze.hs @@ -14,7 +14,7 @@ module Copilot.Language.Analyze import Copilot.Core (DropIdx) import qualified Copilot.Core as C -import Copilot.Language.Stream (Stream (..), Arg (..)) +import Copilot.Language.Stream (Stream (..)) import Copilot.Language.Spec import Copilot.Language.Error (badUsage) diff --git a/copilot-language/src/Copilot/Language/Reify.hs b/copilot-language/src/Copilot/Language/Reify.hs index 2202698d6..092458b78 100644 --- a/copilot-language/src/Copilot/Language/Reify.hs +++ b/copilot-language/src/Copilot/Language/Reify.hs @@ -17,7 +17,7 @@ import Copilot.Core (Typed, Id, typeOf) import Copilot.Language.Analyze (analyze) import Copilot.Language.Error (impossible) import Copilot.Language.Spec -import Copilot.Language.Stream (Stream (..), Arg (..)) +import Copilot.Language.Stream (Stream (..)) import Copilot.Theorem.Prove diff --git a/copilot-language/src/Copilot/Language/Spec.hs b/copilot-language/src/Copilot/Language/Spec.hs index c6ec11caf..2240f21ce 100644 --- a/copilot-language/src/Copilot/Language/Spec.hs +++ b/copilot-language/src/Copilot/Language/Spec.hs @@ -22,6 +22,7 @@ module Copilot.Language.Spec , Trigger (..) , trigger, triggers , arg + , Arg(..) , Property (..) , Prop (..) , prop, properties @@ -198,3 +199,7 @@ theorem name e (Proof p) = tell [TheoremItem (Property name (extractProp e), p)] -- the current samples of the given streams. arg :: Typed a => Stream a -> Arg arg = Arg + +-- | Wrapper to use 'Stream's as arguments to triggers. +data Arg where + Arg :: Typed a => Stream a -> Arg diff --git a/copilot-language/src/Copilot/Language/Stream.hs b/copilot-language/src/Copilot/Language/Stream.hs index d8689a4a5..3c2a2f838 100644 --- a/copilot-language/src/Copilot/Language/Stream.hs +++ b/copilot-language/src/Copilot/Language/Stream.hs @@ -9,7 +9,6 @@ module Copilot.Language.Stream ( Stream (..) - , Arg (..) , Copilot.Language.Stream.ceiling , Copilot.Language.Stream.floor , Copilot.Language.Stream.atan2 @@ -48,10 +47,6 @@ data Stream :: * -> * where => Core.Op3 a b c d -> Stream a -> Stream b -> Stream c -> Stream d Label :: Typed a => String -> Stream a -> Stream a --- | Wrapper to use 'Stream's as arguments to triggers. -data Arg where - Arg :: Typed a => Stream a -> Arg - -- | Dummy instance in order to make 'Stream' an instance of 'Num'. instance Show (Stream a) where show _ = "Stream" From a77a080f540dde5fa0ab5d769d2948c363bc9c17 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 7 Jul 2023 13:50:26 +0000 Subject: [PATCH 0607/1222] copilot-language: Document changes in CHANGELOG. Refs #446. --- copilot-language/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-language/CHANGELOG b/copilot-language/CHANGELOG index f8172456a..567773f46 100644 --- a/copilot-language/CHANGELOG +++ b/copilot-language/CHANGELOG @@ -1,3 +1,6 @@ +2023-07-07 + * Move Copilot.Language.Stream.Arg to Copilot.Language.Spec. (#446) + 2023-05-07 * Version bump (3.15). (#438) * Remove outdated comment about pretty-printer. (#428) From 6340fbc13c3fb32694887dca79e8c99b43c05266 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 7 Jul 2023 21:30:47 +0000 Subject: [PATCH 0608/1222] Bump versions and constraints. Refs #448. --- copilot-c99/copilot-c99.cabal | 4 ++-- copilot-core/copilot-core.cabal | 2 +- copilot-interpreter/copilot-interpreter.cabal | 4 ++-- copilot-language/copilot-language.cabal | 8 ++++---- copilot-libraries/copilot-libraries.cabal | 4 ++-- copilot-prettyprinter/copilot-prettyprinter.cabal | 4 ++-- copilot-theorem/copilot-theorem.cabal | 6 +++--- copilot/copilot.cabal | 14 +++++++------- 8 files changed, 23 insertions(+), 23 deletions(-) diff --git a/copilot-c99/copilot-c99.cabal b/copilot-c99/copilot-c99.cabal index 586ce6630..b3c6f2f4a 100644 --- a/copilot-c99/copilot-c99.cabal +++ b/copilot-c99/copilot-c99.cabal @@ -1,6 +1,6 @@ cabal-version : >= 1.10 name : copilot-c99 -version : 3.15 +version : 3.16 synopsis : A compiler for Copilot targeting C99. description : This package is a back-end from Copilot to C. @@ -45,7 +45,7 @@ library , mtl >= 2.2 && < 2.4 , pretty >= 1.1 && < 1.2 - , copilot-core >= 3.15 && < 3.16 + , copilot-core >= 3.16 && < 3.17 , language-c99 >= 0.2.0 && < 0.3 , language-c99-simple >= 0.2.2 && < 0.3 diff --git a/copilot-core/copilot-core.cabal b/copilot-core/copilot-core.cabal index 2e102418e..be40f9319 100644 --- a/copilot-core/copilot-core.cabal +++ b/copilot-core/copilot-core.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-core -version: 3.15 +version: 3.16 synopsis: An intermediate representation for Copilot. description: Intermediate representation for Copilot. diff --git a/copilot-interpreter/copilot-interpreter.cabal b/copilot-interpreter/copilot-interpreter.cabal index 6bfb1a60f..f5f36fcf3 100644 --- a/copilot-interpreter/copilot-interpreter.cabal +++ b/copilot-interpreter/copilot-interpreter.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-interpreter -version: 3.15 +version: 3.16 synopsis: Interpreter for Copilot. description: Interpreter for Copilot. @@ -44,7 +44,7 @@ library base >= 4.9 && < 5, pretty >= 1.0 && < 1.2, - copilot-core >= 3.15 && < 3.16 + copilot-core >= 3.16 && < 3.17 exposed-modules: diff --git a/copilot-language/copilot-language.cabal b/copilot-language/copilot-language.cabal index 9d3f9ac89..4aa502a7b 100644 --- a/copilot-language/copilot-language.cabal +++ b/copilot-language/copilot-language.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-language -version: 3.15 +version: 3.16 synopsis: A Haskell-embedded DSL for monitoring hard real-time distributed systems. description: @@ -42,9 +42,9 @@ library , data-reify >= 0.6 && < 0.7 , mtl >= 2.0 && < 3 - , copilot-core >= 3.15 && < 3.16 - , copilot-interpreter >= 3.15 && < 3.16 - , copilot-theorem >= 3.15 && < 3.16 + , copilot-core >= 3.16 && < 3.17 + , copilot-interpreter >= 3.16 && < 3.17 + , copilot-theorem >= 3.16 && < 3.17 exposed-modules: Copilot.Language , Copilot.Language.Operators.BitWise diff --git a/copilot-libraries/copilot-libraries.cabal b/copilot-libraries/copilot-libraries.cabal index 45d058114..781285708 100644 --- a/copilot-libraries/copilot-libraries.cabal +++ b/copilot-libraries/copilot-libraries.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-libraries -version: 3.15 +version: 3.16 synopsis: Libraries for the Copilot language. description: Libraries for the Copilot language. @@ -41,7 +41,7 @@ library , containers >= 0.4 && < 0.7 , mtl >= 2.0 && < 2.4 , parsec >= 2.0 && < 3.2 - , copilot-language >= 3.15 && < 3.16 + , copilot-language >= 3.16 && < 3.17 exposed-modules: Copilot.Library.Libraries diff --git a/copilot-prettyprinter/copilot-prettyprinter.cabal b/copilot-prettyprinter/copilot-prettyprinter.cabal index 6944aa7e9..41838ac1c 100644 --- a/copilot-prettyprinter/copilot-prettyprinter.cabal +++ b/copilot-prettyprinter/copilot-prettyprinter.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-prettyprinter -version: 3.15 +version: 3.16 synopsis: A prettyprinter of Copilot Specifications. description: A prettyprinter of Copilot specifications. @@ -45,7 +45,7 @@ library base >= 4.9 && < 5, pretty >= 1.0 && < 1.2, - copilot-core >= 3.15 && < 3.16 + copilot-core >= 3.16 && < 3.17 exposed-modules: diff --git a/copilot-theorem/copilot-theorem.cabal b/copilot-theorem/copilot-theorem.cabal index 6420d297b..11ab2e80a 100644 --- a/copilot-theorem/copilot-theorem.cabal +++ b/copilot-theorem/copilot-theorem.cabal @@ -14,7 +14,7 @@ description: . -version : 3.15 +version : 3.16 license : BSD3 license-file : LICENSE maintainer : Ivan Perez @@ -63,8 +63,8 @@ library , xml >= 1.3 && < 1.4 , what4 >= 1.3 && < 1.5 - , copilot-core >= 3.15 && < 3.16 - , copilot-prettyprinter >= 3.15 && < 3.16 + , copilot-core >= 3.16 && < 3.17 + , copilot-prettyprinter >= 3.16 && < 3.17 exposed-modules : Copilot.Theorem , Copilot.Theorem.Prove diff --git a/copilot/copilot.cabal b/copilot/copilot.cabal index 0dd1f4f88..b9c562bb9 100644 --- a/copilot/copilot.cabal +++ b/copilot/copilot.cabal @@ -1,5 +1,5 @@ name: copilot -version: 3.15 +version: 3.16 cabal-version: >= 1.10 license: BSD3 license-file: LICENSE @@ -52,12 +52,12 @@ library , directory >= 1.3 && < 1.4 , filepath >= 1.4 && < 1.5 - , copilot-core >= 3.15 && < 3.16 - , copilot-theorem >= 3.15 && < 3.16 - , copilot-language >= 3.15 && < 3.16 - , copilot-libraries >= 3.15 && < 3.16 - , copilot-c99 >= 3.15 && < 3.16 - , copilot-prettyprinter >= 3.15 && < 3.16 + , copilot-core >= 3.16 && < 3.17 + , copilot-theorem >= 3.16 && < 3.17 + , copilot-language >= 3.16 && < 3.17 + , copilot-libraries >= 3.16 && < 3.17 + , copilot-c99 >= 3.16 && < 3.17 + , copilot-prettyprinter >= 3.16 && < 3.17 exposed-modules: Language.Copilot, Language.Copilot.Main From 8add77a3e0b7157883cfeec9a7c6df44b7552ad9 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 7 Jul 2023 21:33:02 +0000 Subject: [PATCH 0609/1222] Document changes in CHANGELOG. Refs #448. --- copilot-c99/CHANGELOG | 3 ++- copilot-core/CHANGELOG | 3 +++ copilot-interpreter/CHANGELOG | 3 +++ copilot-language/CHANGELOG | 1 + copilot-libraries/CHANGELOG | 3 +++ copilot-prettyprinter/CHANGELOG | 3 +++ copilot-theorem/CHANGELOG | 3 +++ copilot/CHANGELOG | 3 +++ 8 files changed, 21 insertions(+), 1 deletion(-) diff --git a/copilot-c99/CHANGELOG b/copilot-c99/CHANGELOG index a4d884ade..cb3fe2d8c 100644 --- a/copilot-c99/CHANGELOG +++ b/copilot-c99/CHANGELOG @@ -1,4 +1,5 @@ -2023-07-04 +2023-07-07 + * Version bump (3.16). (#448) * Introduce testing infrastructure. (#413) 2023-05-07 diff --git a/copilot-core/CHANGELOG b/copilot-core/CHANGELOG index 2b189fc7e..e28ec7b71 100644 --- a/copilot-core/CHANGELOG +++ b/copilot-core/CHANGELOG @@ -1,3 +1,6 @@ +2023-07-07 + * Version bump (3.16). (#448) + 2023-05-07 * Version bump (3.15). (#438) * Remove Copilot.Core.Type.Equality. (#427) diff --git a/copilot-interpreter/CHANGELOG b/copilot-interpreter/CHANGELOG index 556f93cf4..c5cf8343c 100644 --- a/copilot-interpreter/CHANGELOG +++ b/copilot-interpreter/CHANGELOG @@ -1,3 +1,6 @@ +2023-07-07 + * Version bump (3.16). (#448) + 2023-05-07 * Version bump (3.15). (#438) diff --git a/copilot-language/CHANGELOG b/copilot-language/CHANGELOG index 567773f46..60ef8a9e1 100644 --- a/copilot-language/CHANGELOG +++ b/copilot-language/CHANGELOG @@ -1,4 +1,5 @@ 2023-07-07 + * Version bump (3.16). (#448) * Move Copilot.Language.Stream.Arg to Copilot.Language.Spec. (#446) 2023-05-07 diff --git a/copilot-libraries/CHANGELOG b/copilot-libraries/CHANGELOG index f49a945b2..00e706a4e 100644 --- a/copilot-libraries/CHANGELOG +++ b/copilot-libraries/CHANGELOG @@ -1,3 +1,6 @@ +2023-07-07 + * Version bump (3.16). (#448) + 2023-05-07 * Version bump (3.15). (#438) diff --git a/copilot-prettyprinter/CHANGELOG b/copilot-prettyprinter/CHANGELOG index 637bcc857..522cb828e 100644 --- a/copilot-prettyprinter/CHANGELOG +++ b/copilot-prettyprinter/CHANGELOG @@ -1,3 +1,6 @@ +2023-07-07 + * Version bump (3.16). (#448) + 2023-05-07 * Version bump (3.15). (#438) diff --git a/copilot-theorem/CHANGELOG b/copilot-theorem/CHANGELOG index 5573b4125..715d3de7b 100644 --- a/copilot-theorem/CHANGELOG +++ b/copilot-theorem/CHANGELOG @@ -1,3 +1,6 @@ +2023-07-07 + * Version bump (3.16). (#448) + 2023-05-07 * Version bump (3.15). (#438) diff --git a/copilot/CHANGELOG b/copilot/CHANGELOG index ee7ac6cef..148832575 100644 --- a/copilot/CHANGELOG +++ b/copilot/CHANGELOG @@ -1,3 +1,6 @@ +2023-07-07 + * Version bump (3.16). (#448) + 2023-05-07 * Version bump (3.15). (#438) From fd437586085aa3d7c5a790cd381a804cd354b938 Mon Sep 17 00:00:00 2001 From: Max Fan Date: Wed, 26 Jul 2023 17:16:29 +0000 Subject: [PATCH 0610/1222] copilot-libraries: Fix semantics of since in Copilot.Library.PTLTL. Refs #443. The current implementation of `Copilot.Library.PTLTL.since` does not conform to the standard semantics of since, as a temporal operator. `since` is an existential claim; it must be true when there exists *any* prior period in which s2 holds and after which s1 has been continuously true. The current implementation only looks for the first time s2 is true, which is non-standard. This commit fixes the implementation and updates the comment to reflect the correct semantics. --- copilot-libraries/src/Copilot/Library/PTLTL.hs | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/copilot-libraries/src/Copilot/Library/PTLTL.hs b/copilot-libraries/src/Copilot/Library/PTLTL.hs index f3ee5cd92..de07eef90 100644 --- a/copilot-libraries/src/Copilot/Library/PTLTL.hs +++ b/copilot-libraries/src/Copilot/Library/PTLTL.hs @@ -39,8 +39,6 @@ eventuallyPrev s = s || tmp where tmp = [ False ] ++ s || tmp --- | Once @s2@ holds, in the following state (period), does @s1@ continuously hold? -since :: Stream Bool -> Stream Bool -> Stream Bool -since s1 s2 = alwaysBeen ( tmp ==> s1 ) - where - tmp = eventuallyPrev $ [ False ] ++ s2 +-- | Is there a time when @s2@ holds and after which @s1@ continuously holds? +since :: Stream Bool -> Stream Bool -> Stream Bool +since s1 s2 = eventuallyPrev (s2 ==> (alwaysBeen s1)) From 54853d7db4ff42b106c10e953c44f7aa58273806 Mon Sep 17 00:00:00 2001 From: Max Fan Date: Thu, 27 Jul 2023 18:58:38 +0000 Subject: [PATCH 0611/1222] copilot-libraries: Document changes in CHANGELOG. Refs #443. --- copilot-libraries/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-libraries/CHANGELOG b/copilot-libraries/CHANGELOG index 00e706a4e..15812d174 100644 --- a/copilot-libraries/CHANGELOG +++ b/copilot-libraries/CHANGELOG @@ -1,3 +1,6 @@ +2023-07-27 + * Fix semantics of since in Copilot.Library.PTLTL. (#443) + 2023-07-07 * Version bump (3.16). (#448) From 300430a7d011330e444f564287cbe9cace75fda0 Mon Sep 17 00:00:00 2001 From: Ryan Scott Date: Thu, 27 Jul 2023 16:22:35 -0400 Subject: [PATCH 0612/1222] copilot-libraries: Don't generate unused locals in majority vote implementation. Refs #408. The Copilot.Library.Voting.majority' function, used as part of an implementation of a majority-vote algorithm, would generate unused local variables if given a list with only one vote stream. This happens quite a lot, as majority' is a recursive function that decreases the size of the list at every recursive call. Moreover, these unused local variables will cause the C code generated by Copilot to trigger warnings when compiled. This fixes the issue by adding a special case in majority' for when the input list only has one vote stream which avoids needlessly binding a local variable. --- copilot-libraries/src/Copilot/Library/Voting.hs | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) diff --git a/copilot-libraries/src/Copilot/Library/Voting.hs b/copilot-libraries/src/Copilot/Library/Voting.hs index 84ebec194..306fe424c 100644 --- a/copilot-libraries/src/Copilot/Library/Voting.hs +++ b/copilot-libraries/src/Copilot/Library/Voting.hs @@ -56,7 +56,17 @@ majority' (x:xs) can cnt = where inZero zero = local (if zero then x else can) inCan where - inCan can' = local (if zero || x == can then cnt+1 else cnt-1) inCnt + inCan can' = + -- We include a special case for when `xs` is empty that immediately + -- returns `can'`. We could omit this special case without changing the + -- final result, but this has the downside that `local` would bind a + -- local variable that would go unused in `inCnt`. (Note that `inCnt` + -- recursively invokes `majority'`, which doesn't use its last argument + -- if the list of vote streams is empty.) These unused local variables + -- would result in C code that triggers compiler warnings. + case xs of + [] -> can' + _ -> local (if zero || x == can then cnt+1 else cnt-1) inCnt where inCnt cnt' = majority' xs can' cnt' From f07e2d4bc6911e1d3133636a72811a808db8fc5e Mon Sep 17 00:00:00 2001 From: Ryan Scott Date: Thu, 27 Jul 2023 16:31:40 -0400 Subject: [PATCH 0613/1222] copilot-libraries: Document changes in CHANGELOG. Refs #408. --- copilot-libraries/CHANGELOG | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/copilot-libraries/CHANGELOG b/copilot-libraries/CHANGELOG index 15812d174..b3117bb47 100644 --- a/copilot-libraries/CHANGELOG +++ b/copilot-libraries/CHANGELOG @@ -1,5 +1,7 @@ -2023-07-27 +2023-08-08 * Fix semantics of since in Copilot.Library.PTLTL. (#443) + * Prevent the majority function from generating unused local variables. + (#408) 2023-07-07 * Version bump (3.16). (#448) From 3787d4f3179c2ec10006f1230e01424273c7899f Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 4 Sep 2023 12:22:02 -0700 Subject: [PATCH 0614/1222] copilot-c99: Change names to lowerCamelCase. Refs #453. Our styling rules state that names should use lowerCamelCase/CamelCase (depending on whether they are types or values). Accordingly, this commit renames variables and functions to use lowerCamelCase. --- .../src/Copilot/Compile/C99/CodeGen.hs | 208 +++++++++--------- .../src/Copilot/Compile/C99/Compile.hs | 122 +++++----- .../src/Copilot/Compile/C99/External.hs | 48 ++-- .../src/Copilot/Compile/C99/Translate.hs | 178 +++++++-------- copilot-c99/src/Copilot/Compile/C99/Util.hs | 46 ++-- 5 files changed, 301 insertions(+), 301 deletions(-) diff --git a/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs b/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs index 616bd1dbd..884d627d0 100644 --- a/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs +++ b/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs @@ -19,17 +19,17 @@ import Copilot.Compile.C99.Settings import Copilot.Compile.C99.Translate -- | Write a declaration for a generator function. -gendecln :: String -> Type a -> C.Decln -gendecln name ty = C.FunDecln Nothing cty name [] +genDecln :: String -> Type a -> C.Decln +genDecln name ty = C.FunDecln Nothing cTy name [] where - cty = C.decay $ transtype ty + cTy = C.decay $ transType ty -- | Write a generator function for a stream. -genfun :: String -> Expr a -> Type a -> C.FunDef -genfun name expr ty = C.FunDef cty name [] cvars [C.Return $ Just cexpr] +genFun :: String -> Expr a -> Type a -> C.FunDef +genFun name expr ty = C.FunDef cTy name [] cVars [C.Return $ Just cExpr] where - cty = C.decay $ transtype ty - (cexpr, cvars) = runState (transexpr expr) mempty + cTy = C.decay $ transType ty + (cExpr, cVars) = runState (transExpr expr) mempty -- | Write a generator function for a stream that returns an array. genFunArray :: String -> String -> Expr a -> Type a -> C.FunDef @@ -40,13 +40,13 @@ genFunArray name nameArg expr ty@(Array _) = -- The output value is an array outputParam = C.Param cArrayType nameArg - cArrayType = transtype ty + cArrayType = transType ty -- Output value, and any variable declarations needed - (cexpr, varDecls) = runState (transexpr expr) mempty + (cExpr, varDecls) = runState (transExpr expr) mempty -- Copy expression to output argument - stmts = [ C.Expr $ memcpy (C.Ident nameArg) cexpr size ] + stmts = [ C.Expr $ memcpy (C.Ident nameArg) cExpr size ] size = C.LitInt (fromIntegral $ tysize ty) C..* C.SizeOfType (C.TypeName $ tyElemName ty) @@ -54,79 +54,79 @@ genFunArray name nameArg expr _ = impossible "genFunArray" "copilot-c99" -- | Make a extern declaration of a variable. -mkextdecln :: External -> C.Decln -mkextdecln (External name _ ty) = decln +mkExtDecln :: External -> C.Decln +mkExtDecln (External name _ ty) = decln where - decln = C.VarDecln (Just C.Extern) cty name Nothing - cty = transtype ty + decln = C.VarDecln (Just C.Extern) cTy name Nothing + cTy = transType ty -- | Make a declaration for a copy of an external variable. -mkextcpydecln :: External -> C.Decln -mkextcpydecln (External name cpyname ty) = decln +mkExtCpyDecln :: External -> C.Decln +mkExtCpyDecln (External name cpyName ty) = decln where - cty = transtype ty - decln = C.VarDecln (Just C.Static) cty cpyname Nothing + cTy = transType ty + decln = C.VarDecln (Just C.Static) cTy cpyName Nothing -- | Make a C buffer variable and initialise it with the stream buffer. -mkbuffdecln :: Id -> Type a -> [a] -> C.Decln -mkbuffdecln sid ty xs = C.VarDecln (Just C.Static) cty name initvals +mkBuffDecln :: Id -> Type a -> [a] -> C.Decln +mkBuffDecln sId ty xs = C.VarDecln (Just C.Static) cTy name initVals where - name = streamname sid - cty = C.Array (transtype ty) (Just $ C.LitInt $ fromIntegral buffsize) - buffsize = length xs - initvals = Just $ C.InitList $ constarray ty xs + name = streamName sId + cTy = C.Array (transType ty) (Just $ C.LitInt $ fromIntegral buffSize) + buffSize = length xs + initVals = Just $ C.InitList $ constArray ty xs -- | Make a C index variable and initialise it to 0. -mkindexdecln :: Id -> C.Decln -mkindexdecln sid = C.VarDecln (Just C.Static) cty name initval +mkIndexDecln :: Id -> C.Decln +mkIndexDecln sId = C.VarDecln (Just C.Static) cTy name initVal where - name = indexname sid - cty = C.TypeSpec $ C.TypedefName "size_t" - initval = Just $ C.InitExpr $ C.LitInt 0 + name = indexName sId + cTy = C.TypeSpec $ C.TypedefName "size_t" + initVal = Just $ C.InitExpr $ C.LitInt 0 -- | Define an accessor functions for the ring buffer associated with a stream -mkaccessdecln :: Id -> Type a -> [a] -> C.FunDef -mkaccessdecln sid ty xs = C.FunDef cty name params [] [C.Return (Just expr)] +mkAccessDecln :: Id -> Type a -> [a] -> C.FunDef +mkAccessDecln sId ty xs = C.FunDef cTy name params [] [C.Return (Just expr)] where - cty = C.decay $ transtype ty - name = streamaccessorname sid - bufflength = C.LitInt $ fromIntegral $ length xs + cTy = C.decay $ transType ty + name = streamAccessorName sId + buffLength = C.LitInt $ fromIntegral $ length xs params = [C.Param (C.TypeSpec $ C.TypedefName "size_t") "x"] - index = (C.Ident (indexname sid) C..+ C.Ident "x") C..% bufflength - expr = C.Index (C.Ident (streamname sid)) index + index = (C.Ident (indexName sId) C..+ C.Ident "x") C..% buffLength + expr = C.Index (C.Ident (streamName sId)) index -- | Writes the step function, that updates all streams. -mkstep :: CSettings -> [Stream] -> [Trigger] -> [External] -> C.FunDef -mkstep cSettings streams triggers exts = +mkStep :: CSettings -> [Stream] -> [Trigger] -> [External] -> C.FunDef +mkStep cSettings streams triggers exts = C.FunDef void (cSettingsStepFunctionName cSettings) [] declns stmts where void = C.TypeSpec C.Void - stmts = map mkexcopy exts + stmts = map mkExCopy exts ++ triggerStmts - ++ tmpassigns - ++ bufferupdates - ++ indexupdates + ++ tmpAssigns + ++ bufferUpdates + ++ indexUpdates declns = streamDeclns ++ concat triggerDeclns - (streamDeclns, tmpassigns, bufferupdates, indexupdates) = - unzip4 $ map mkupdateglobals streams + (streamDeclns, tmpAssigns, bufferUpdates, indexUpdates) = + unzip4 $ map mkUpdateGlobals streams (triggerDeclns, triggerStmts) = - unzip $ map mktriggercheck triggers + unzip $ map mkTriggerCheck triggers -- Write code to update global stream buffers and index. - mkupdateglobals :: Stream -> (C.Decln, C.Stmt, C.Stmt, C.Stmt) - mkupdateglobals (Stream sid buff expr ty) = - (tmpdecln, tmpassign, bufferupdate, indexupdate) + mkUpdateGlobals :: Stream -> (C.Decln, C.Stmt, C.Stmt, C.Stmt) + mkUpdateGlobals (Stream sId buff expr ty) = + (tmpDecln, tmpAssign, bufferUpdate, indexUpdate) where - tmpdecln = C.VarDecln Nothing cty tmp_var Nothing + tmpDecln = C.VarDecln Nothing cTy tmp_var Nothing - tmpassign = case ty of - Array _ -> C.Expr $ C.Funcall (C.Ident $ generatorname sid) + tmpAssign = case ty of + Array _ -> C.Expr $ C.Funcall (C.Ident $ generatorName sId) [ C.Ident tmp_var ] _ -> C.Expr $ C.Ident tmp_var C..= val - bufferupdate = case ty of + bufferUpdate = case ty of Array _ -> C.Expr $ memcpy dest (C.Ident tmp_var) size where dest = C.Index buff_var index_var @@ -135,28 +135,28 @@ mkstep cSettings streams triggers exts = _ -> C.Expr $ C.Index buff_var index_var C..= (C.Ident tmp_var) - indexupdate = C.Expr $ index_var C..= (incindex C..% bufflength) + indexUpdate = C.Expr $ index_var C..= (incIndex C..% buffLength) where - bufflength = C.LitInt $ fromIntegral $ length buff - incindex = index_var C..+ C.LitInt 1 + buffLength = C.LitInt $ fromIntegral $ length buff + incIndex = index_var C..+ C.LitInt 1 - tmp_var = streamname sid ++ "_tmp" - buff_var = C.Ident $ streamname sid - index_var = C.Ident $ indexname sid - val = C.Funcall (C.Ident $ generatorname sid) [] - cty = transtype ty + tmp_var = streamName sId ++ "_tmp" + buff_var = C.Ident $ streamName sId + index_var = C.Ident $ indexName sId + val = C.Funcall (C.Ident $ generatorName sId) [] + cTy = transType ty -- Make code that copies an external variable to its local one. - mkexcopy :: External -> C.Stmt - mkexcopy (External name cpyname ty) = C.Expr $ case ty of - Array _ -> memcpy exvar locvar size + mkExCopy :: External -> C.Stmt + mkExCopy (External name cpyName ty) = C.Expr $ case ty of + Array _ -> memcpy exVar locVar size where - exvar = C.Ident cpyname - locvar = C.Ident name + exVar = C.Ident cpyName + locVar = C.Ident name size = C.LitInt (fromIntegral $ tysize ty) C..* C.SizeOfType (C.TypeName (tyElemName ty)) - _ -> C.Ident cpyname C..= C.Ident name + _ -> C.Ident cpyName C..= C.Ident name -- Make if-statement to check the guard, call the handler if necessary. -- This returns two things: @@ -192,8 +192,8 @@ mkstep cSettings streams triggers exts = -- 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 :: Trigger -> ([C.Decln], C.Stmt) + mkTriggerCheck (Trigger name guard args) = (aTmpDeclns, ifStmt) where aTmpDeclns = zipWith (\tmpVar arg -> @@ -209,19 +209,19 @@ mkstep cSettings streams triggers exts = -- the `arg` function will return a pointer, not an array, and -- C doesn't make it easy to cast directly from an array to a -- pointer. - Array ty' -> C.Ptr $ transtype ty' - _ -> transtype ty + Array ty' -> C.Ptr $ transType ty' + _ -> transType ty aTempNames = take (length args) (argTempNames name) - ifStmt = C.If guard' firetrigger + ifStmt = C.If guard' fireTrigger - guard' = C.Funcall (C.Ident $ guardname name) [] + guard' = C.Funcall (C.Ident $ guardName name) [] -- 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. - firetrigger = map C.Expr argAssigns ++ + fireTrigger = map C.Expr argAssigns ++ [C.Expr $ C.Funcall (C.Ident name) (zipWith passArg aTempNames args)] where @@ -237,55 +237,55 @@ mkstep cSettings streams triggers exts = C.AssignOp C.Assign (C.Ident aTempName) arg) aTempNames args' - args' = take (length args) (map argcall (argnames name)) - argcall name = C.Funcall (C.Ident name) [] + args' = take (length args) (map argCall (argNames name)) + argCall name = C.Funcall (C.Ident name) [] -- | Write a struct declaration based on its definition. -mkstructdecln :: Struct a => Type a -> C.Decln -mkstructdecln (Struct x) = C.TypeDecln struct +mkStructDecln :: Struct a => Type a -> C.Decln +mkStructDecln (Struct x) = C.TypeDecln struct where struct = C.TypeSpec $ C.StructDecln (Just $ typename x) fields - fields = NonEmpty.fromList $ map mkfield (toValues x) + fields = NonEmpty.fromList $ map mkField (toValues x) - mkfield :: Value a -> C.FieldDecln - mkfield (Value ty field) = C.FieldDecln (transtype ty) (fieldname field) + mkField :: Value a -> C.FieldDecln + mkField (Value ty field) = C.FieldDecln (transType ty) (fieldname field) -- | Write a forward struct declaration. -mkstructforwdecln :: Struct a => Type a -> C.Decln -mkstructforwdecln (Struct x) = C.TypeDecln struct +mkStructForwDecln :: Struct a => Type a -> C.Decln +mkStructForwDecln (Struct x) = C.TypeDecln struct where struct = C.TypeSpec $ C.Struct (typename x) -- | List all types of an expression, returns items uniquely. -exprtypes :: Typeable a => Expr a -> [UType] -exprtypes e = case e of - Const ty _ -> typetypes ty - Local ty1 ty2 _ e1 e2 -> typetypes ty1 `union` typetypes ty2 - `union` exprtypes e1 `union` exprtypes e2 - Var ty _ -> typetypes ty - Drop ty _ _ -> typetypes ty - ExternVar ty _ _ -> typetypes ty - Op1 _ e1 -> exprtypes e1 - Op2 _ e1 e2 -> exprtypes e1 `union` exprtypes e2 - Op3 _ e1 e2 e3 -> exprtypes e1 `union` exprtypes e2 `union` exprtypes e3 - Label ty _ _ -> typetypes ty +exprTypes :: Typeable a => Expr a -> [UType] +exprTypes e = case e of + Const ty _ -> typeTypes ty + Local ty1 ty2 _ e1 e2 -> typeTypes ty1 `union` typeTypes ty2 + `union` exprTypes e1 `union` exprTypes e2 + Var ty _ -> typeTypes ty + Drop ty _ _ -> typeTypes ty + ExternVar ty _ _ -> typeTypes ty + Op1 _ e1 -> exprTypes e1 + Op2 _ e1 e2 -> exprTypes e1 `union` exprTypes e2 + Op3 _ e1 e2 e3 -> exprTypes e1 `union` exprTypes e2 `union` exprTypes e3 + Label ty _ _ -> typeTypes ty -- | List all types of a type, returns items uniquely. -typetypes :: Typeable a => Type a -> [UType] -typetypes ty = case ty of - Array ty' -> typetypes ty' `union` [UType ty] - Struct x -> concatMap (\(Value ty' _) -> typetypes ty') (toValues x) `union` [UType ty] +typeTypes :: Typeable a => Type a -> [UType] +typeTypes ty = case ty of + Array ty' -> typeTypes ty' `union` [UType ty] + Struct x -> concatMap (\(Value ty' _) -> typeTypes ty') (toValues x) `union` [UType ty] _ -> [UType ty] -- | Collect all expression of a list of streams and triggers and wrap them -- into an UEXpr. -gatherexprs :: [Stream] -> [Trigger] -> [UExpr] -gatherexprs streams triggers = map streamexpr streams - ++ concatMap triggerexpr triggers +gatherExprs :: [Stream] -> [Trigger] -> [UExpr] +gatherExprs streams triggers = map streamExpr streams + ++ concatMap triggerExpr triggers where - streamexpr (Stream _ _ expr ty) = UExpr ty expr - triggerexpr (Trigger _ guard args) = UExpr Bool guard : args + streamExpr (Stream _ _ expr ty) = UExpr ty expr + triggerExpr (Trigger _ guard args) = UExpr Bool guard : args -- * Auxiliary functions @@ -301,4 +301,4 @@ memcpy dest src size = C.Funcall (C.Ident "memcpy") [dest, src, size] tyElemName :: Type a -> C.Type tyElemName ty = case ty of Array ty' -> tyElemName ty' - _ -> transtype ty + _ -> transType ty diff --git a/copilot-c99/src/Copilot/Compile/C99/Compile.hs b/copilot-c99/src/Copilot/Compile/C99/Compile.hs index c76d0bc2b..79048b565 100644 --- a/copilot-c99/src/Copilot/Compile/C99/Compile.hs +++ b/copilot-c99/src/Copilot/Compile/C99/Compile.hs @@ -37,11 +37,11 @@ compileWith cSettings prefix spec exitFailure | otherwise - = do let cfile = render $ pretty $ C.translate $ compilec cSettings spec - hfile = render $ pretty $ C.translate $ compileh cSettings spec + = do let cFile = render $ pretty $ C.translate $ compileC cSettings spec + hFile = render $ pretty $ C.translate $ compileH cSettings spec typeDeclnsFile = safeCRender $ compileTypeDeclns cSettings spec - cmacros = unlines [ "#include " + cMacros = unlines [ "#include " , "#include " , "#include " , "#include " @@ -54,8 +54,8 @@ compileWith cSettings prefix spec let dir = cSettingsOutputDirectory cSettings createDirectoryIfMissing True dir - writeFile (dir prefix ++ ".c") $ cmacros ++ cfile - writeFile (dir prefix ++ ".h") hfile + writeFile (dir prefix ++ ".c") $ cMacros ++ cFile + writeFile (dir prefix ++ ".h") hFile writeFile (dir prefix ++ "_types.h") typeDeclnsFile -- | Compile a specification to a .h and a .c file. @@ -72,99 +72,99 @@ compile = compileWith mkDefaultCSettings -- * Declarations of global buffers and indices. -- * Generator functions for streams, guards and trigger arguments. -- * Declaration of the @step()@ function. -compilec :: CSettings -> Spec -> C.TransUnit -compilec cSettings spec = C.TransUnit declns funs +compileC :: CSettings -> Spec -> C.TransUnit +compileC cSettings spec = C.TransUnit declns funs where streams = specStreams spec triggers = specTriggers spec - exts = gatherexts streams triggers + exts = gatherExts streams triggers - declns = mkexts exts ++ mkglobals streams - funs = genfuns streams triggers ++ [mkstep cSettings streams triggers exts] + declns = mkExts exts ++ mkGlobals streams + funs = genFuns streams triggers ++ [mkStep cSettings streams triggers exts] -- Make declarations for copies of external variables. - mkexts :: [External] -> [C.Decln] - mkexts exts = map mkextcpydecln exts + mkExts :: [External] -> [C.Decln] + mkExts exts = map mkExtCpyDecln exts -- Make buffer and index declarations for streams. - mkglobals :: [Stream] -> [C.Decln] - mkglobals streams = map buffdecln streams ++ map indexdecln streams + mkGlobals :: [Stream] -> [C.Decln] + mkGlobals streams = map buffDecln streams ++ map indexDecln streams where - buffdecln (Stream sid buff _ ty) = mkbuffdecln sid ty buff - indexdecln (Stream sid _ _ _ ) = mkindexdecln sid + buffDecln (Stream sId buff _ ty) = mkBuffDecln sId ty buff + indexDecln (Stream sId _ _ _ ) = mkIndexDecln sId -- Make generator functions, including trigger arguments. - genfuns :: [Stream] -> [Trigger] -> [C.FunDef] - genfuns streams triggers = map accessdecln streams - ++ map streamgen streams - ++ concatMap triggergen triggers + genFuns :: [Stream] -> [Trigger] -> [C.FunDef] + genFuns streams triggers = map accessDecln streams + ++ map streamGen streams + ++ concatMap triggerGen triggers where - accessdecln :: Stream -> C.FunDef - accessdecln (Stream sid buff _ ty) = mkaccessdecln sid ty buff + accessDecln :: Stream -> C.FunDef + accessDecln (Stream sId buff _ ty) = mkAccessDecln sId ty buff - streamgen :: Stream -> C.FunDef - streamgen (Stream sid _ expr ty@(Array _)) = - genFunArray (generatorname sid) (generatorOutputArgName sid) expr ty - streamgen (Stream sid _ expr ty) = genfun (generatorname sid) expr ty + streamGen :: Stream -> C.FunDef + streamGen (Stream sId _ expr ty@(Array _)) = + genFunArray (generatorName sId) (generatorOutputArgName sId) expr ty + streamGen (Stream sId _ expr ty) = genFun (generatorName sId) expr ty - triggergen :: Trigger -> [C.FunDef] - triggergen (Trigger name guard args) = guarddef : argdefs + triggerGen :: Trigger -> [C.FunDef] + triggerGen (Trigger name guard args) = guardDef : argDefs where - guarddef = genfun (guardname name) guard Bool - argdefs = map arggen (zip (argnames name) args) + guardDef = genFun (guardName name) guard Bool + argDefs = map argGen (zip (argNames name) args) - arggen :: (String, UExpr) -> C.FunDef - arggen (argname, UExpr ty expr) = genfun argname expr ty + argGen :: (String, UExpr) -> C.FunDef + argGen (argName, UExpr ty expr) = genFun argName expr ty -- | Generate the .h file from a 'Spec'. -compileh :: CSettings -> Spec -> C.TransUnit -compileh cSettings spec = C.TransUnit declns [] +compileH :: CSettings -> Spec -> C.TransUnit +compileH cSettings spec = C.TransUnit declns [] where streams = specStreams spec triggers = specTriggers spec - exts = gatherexts streams triggers - exprs = gatherexprs streams triggers + exts = gatherExts streams triggers + exprs = gatherExprs streams triggers - declns = mkstructforwdeclns exprs - ++ mkexts exts - ++ extfundeclns triggers - ++ [stepdecln] + declns = mkStructForwDeclns exprs + ++ mkExts exts + ++ extFunDeclns triggers + ++ [stepDecln] - mkstructforwdeclns :: [UExpr] -> [C.Decln] - mkstructforwdeclns es = catMaybes $ map mkdecln utypes + mkStructForwDeclns :: [UExpr] -> [C.Decln] + mkStructForwDeclns es = catMaybes $ map mkDecln uTypes where - mkdecln (UType ty) = case ty of - Struct x -> Just $ mkstructforwdecln ty + mkDecln (UType ty) = case ty of + Struct x -> Just $ mkStructForwDecln ty _ -> Nothing - utypes = nub $ concatMap (\(UExpr _ e) -> exprtypes e) es + uTypes = nub $ concatMap (\(UExpr _ e) -> exprTypes e) es -- Make declarations for external variables. - mkexts :: [External] -> [C.Decln] - mkexts = map mkextdecln + mkExts :: [External] -> [C.Decln] + mkExts = map mkExtDecln - extfundeclns :: [Trigger] -> [C.Decln] - extfundeclns triggers = map extfundecln triggers + extFunDeclns :: [Trigger] -> [C.Decln] + extFunDeclns triggers = map extFunDecln triggers where - extfundecln :: Trigger -> C.Decln - extfundecln (Trigger name _ args) = C.FunDecln Nothing cty name params + extFunDecln :: Trigger -> C.Decln + extFunDecln (Trigger name _ args) = C.FunDecln Nothing cTy name params where - cty = C.TypeSpec C.Void - params = map mkparam $ zip (argnames name) args - mkparam (name, UExpr ty _) = C.Param (mkParamTy ty) name + cTy = C.TypeSpec C.Void + params = map mkParam $ zip (argNames name) args + mkParam (name, UExpr ty _) = C.Param (mkParamTy ty) name -- Special case for Struct, to pass struct arguments by reference. -- Arrays are also passed by reference, but using C's array type -- does that automatically. mkParamTy ty = case ty of - Struct _ -> C.Ptr (transtype ty) - _ -> transtype ty + Struct _ -> C.Ptr (transType ty) + _ -> transType ty -- Declaration for the step function. - stepdecln :: C.Decln - stepdecln = C.FunDecln Nothing (C.TypeSpec C.Void) + stepDecln :: C.Decln + stepDecln = C.FunDecln Nothing (C.TypeSpec C.Void) (cSettingsStepFunctionName cSettings) [] -- | Generate a C translation unit that contains all type declarations needed @@ -174,7 +174,7 @@ compileTypeDeclns _cSettings spec = C.TransUnit declns [] where declns = mkTypeDeclns exprs - exprs = gatherexprs streams triggers + exprs = gatherExprs streams triggers streams = specStreams spec triggers = specTriggers spec @@ -182,10 +182,10 @@ compileTypeDeclns _cSettings spec = C.TransUnit declns [] mkTypeDeclns :: [UExpr] -> [C.Decln] mkTypeDeclns es = catMaybes $ map mkTypeDecln uTypes where - uTypes = nub $ concatMap (\(UExpr _ e) -> exprtypes e) es + uTypes = nub $ concatMap (\(UExpr _ e) -> exprTypes e) es mkTypeDecln (UType ty) = case ty of - Struct _ -> Just $ mkstructdecln ty + Struct _ -> Just $ mkStructDecln ty _ -> Nothing -- * Auxiliary definitions diff --git a/copilot-c99/src/Copilot/Compile/C99/External.hs b/copilot-c99/src/Copilot/Compile/C99/External.hs index 0d75fafd7..062a4f8c1 100644 --- a/copilot-c99/src/Copilot/Compile/C99/External.hs +++ b/copilot-c99/src/Copilot/Compile/C99/External.hs @@ -11,44 +11,44 @@ import Copilot.Compile.C99.Util -- | Representation of external variables. data External = forall a. External - { extname :: String - , extcpyname :: String - , exttype :: Type a + { extName :: String + , extCpyName :: String + , extType :: Type a } -- | Union over lists of External, we solely base the equality on the --- extname's. -extunion :: [External] -> [External] -> [External] -extunion = unionBy (\a b -> extname a == extname b) +-- extName's. +extUnion :: [External] -> [External] -> [External] +extUnion = unionBy (\a b -> extName a == extName b) -- | Collect all external variables from the streams and triggers. -- -- Although Copilot specifications can contain also properties and theorems, -- the C99 backend currently only generates code for streams and triggers. -gatherexts :: [Stream] -> [Trigger] -> [External] -gatherexts streams triggers = streamsexts `extunion` triggersexts +gatherExts :: [Stream] -> [Trigger] -> [External] +gatherExts streams triggers = streamsExts `extUnion` triggersExts where - streamsexts = foldr extunion mempty $ map streamexts streams - triggersexts = foldr extunion mempty $ map triggerexts triggers + streamsExts = foldr extUnion mempty $ map streamExts streams + triggersExts = foldr extUnion mempty $ map triggerExts triggers - streamexts :: Stream -> [External] - streamexts (Stream _ _ expr _) = exprexts expr + streamExts :: Stream -> [External] + streamExts (Stream _ _ expr _) = exprExts expr - triggerexts :: Trigger -> [External] - triggerexts (Trigger _ guard args) = guardexts `extunion` argexts + triggerExts :: Trigger -> [External] + triggerExts (Trigger _ guard args) = guardExts `extUnion` argExts where - guardexts = exprexts guard - argexts = concat $ map uexprexts args + guardExts = exprExts guard + argExts = concat $ map uExprExts args - uexprexts :: UExpr -> [External] - uexprexts (UExpr _ expr) = exprexts expr + uExprExts :: UExpr -> [External] + uExprExts (UExpr _ expr) = exprExts expr - exprexts :: Expr a -> [External] - exprexts expr = let rec = exprexts in case expr of - Local _ _ _ e1 e2 -> rec e1 `extunion` rec e2 - ExternVar ty name _ -> [External name (excpyname name) ty] + exprExts :: Expr a -> [External] + exprExts expr = let rec = exprExts in case expr of + Local _ _ _ e1 e2 -> rec e1 `extUnion` rec e2 + ExternVar ty name _ -> [External name (exCpyName name) ty] Op1 _ e -> rec e - Op2 _ e1 e2 -> rec e1 `extunion` rec e2 - Op3 _ e1 e2 e3 -> rec e1 `extunion` rec e2 `extunion` rec e3 + Op2 _ e1 e2 -> rec e1 `extUnion` rec e2 + Op3 _ e1 e2 e3 -> rec e1 `extUnion` rec e2 `extUnion` rec e3 Label _ _ e -> rec e _ -> [] diff --git a/copilot-c99/src/Copilot/Compile/C99/Translate.hs b/copilot-c99/src/Copilot/Compile/C99/Translate.hs index d1f336065..9c691d06e 100644 --- a/copilot-c99/src/Copilot/Compile/C99/Translate.hs +++ b/copilot-c99/src/Copilot/Compile/C99/Translate.hs @@ -13,47 +13,47 @@ import Copilot.Compile.C99.Util import qualified Language.C99.Simple as C -- | Translates a Copilot Core expression into a C99 expression. -transexpr :: Expr a -> State FunEnv C.Expr -transexpr (Const ty x) = return $ constty ty x +transExpr :: Expr a -> State FunEnv C.Expr +transExpr (Const ty x) = return $ constTy ty x -transexpr (Local ty1 _ name e1 e2) = do - e1' <- transexpr e1 - let cty1 = transLocalVarDeclType ty1 +transExpr (Local ty1 _ name e1 e2) = do + e1' <- transExpr e1 + let cTy1 = transLocalVarDeclType ty1 init = Just $ C.InitExpr e1' - statetell [C.VarDecln Nothing cty1 name init] + stateTell [C.VarDecln Nothing cTy1 name init] - transexpr e2 + transExpr e2 -transexpr (Var _ n) = return $ C.Ident n +transExpr (Var _ n) = return $ C.Ident n -transexpr (Drop _ amount sid) = do - let accessvar = streamaccessorname sid +transExpr (Drop _ amount sId) = do + let accessVar = streamAccessorName sId index = C.LitInt (fromIntegral amount) - return $ funcall accessvar [index] + return $ funCall accessVar [index] -transexpr (ExternVar _ name _) = return $ C.Ident (excpyname name) +transExpr (ExternVar _ name _) = return $ C.Ident (exCpyName name) -transexpr (Label _ _ e) = transexpr e -- ignore label +transExpr (Label _ _ e) = transExpr e -- ignore label -transexpr (Op1 op e) = do - e' <- transexpr e - return $ transop1 op e' +transExpr (Op1 op e) = do + e' <- transExpr e + return $ transOp1 op e' -transexpr (Op2 op e1 e2) = do - e1' <- transexpr e1 - e2' <- transexpr e2 - return $ transop2 op e1' e2' +transExpr (Op2 op e1 e2) = do + e1' <- transExpr e1 + e2' <- transExpr e2 + return $ transOp2 op e1' e2' -transexpr (Op3 op e1 e2 e3) = do - e1' <- transexpr e1 - e2' <- transexpr e2 - e3' <- transexpr e3 - return $ transop3 op e1' e2' e3' +transExpr (Op3 op e1 e2 e3) = do + e1' <- transExpr e1 + e2' <- transExpr e2 + e3' <- transExpr e3 + return $ transOp3 op e1' e2' e3' -- | Translates a Copilot unary operator and its argument into a C99 -- expression. -transop1 :: Op1 a b -> C.Expr -> C.Expr -transop1 op e = +transOp1 :: Op1 a b -> C.Expr -> C.Expr +transOp1 op e = -- There are three types of ways in which a function in Copilot Core can be -- translated into C: -- @@ -65,31 +65,31 @@ transop1 op e = Abs ty -> transAbs ty e Sign ty -> transSign ty e Recip ty -> (constNumTy ty 1) C../ e - Acos ty -> funcall (specializeMathFunName ty "acos") [e] - Asin ty -> funcall (specializeMathFunName ty "asin") [e] - Atan ty -> funcall (specializeMathFunName ty "atan") [e] - Cos ty -> funcall (specializeMathFunName ty "cos") [e] - Sin ty -> funcall (specializeMathFunName ty "sin") [e] - Tan ty -> funcall (specializeMathFunName ty "tan") [e] - Acosh ty -> funcall (specializeMathFunName ty "acosh") [e] - Asinh ty -> funcall (specializeMathFunName ty "asinh") [e] - Atanh ty -> funcall (specializeMathFunName ty "atanh") [e] - Cosh ty -> funcall (specializeMathFunName ty "cosh") [e] - Sinh ty -> funcall (specializeMathFunName ty "sinh") [e] - Tanh ty -> funcall (specializeMathFunName ty "tanh") [e] - Exp ty -> funcall (specializeMathFunName ty "exp") [e] - Log ty -> funcall (specializeMathFunName ty "log") [e] - Sqrt ty -> funcall (specializeMathFunName ty "sqrt") [e] - Ceiling ty -> funcall (specializeMathFunName ty "ceil") [e] - Floor ty -> funcall (specializeMathFunName ty "floor") [e] + Acos ty -> funCall (specializeMathFunName ty "acos") [e] + Asin ty -> funCall (specializeMathFunName ty "asin") [e] + Atan ty -> funCall (specializeMathFunName ty "atan") [e] + Cos ty -> funCall (specializeMathFunName ty "cos") [e] + Sin ty -> funCall (specializeMathFunName ty "sin") [e] + Tan ty -> funCall (specializeMathFunName ty "tan") [e] + Acosh ty -> funCall (specializeMathFunName ty "acosh") [e] + Asinh ty -> funCall (specializeMathFunName ty "asinh") [e] + Atanh ty -> funCall (specializeMathFunName ty "atanh") [e] + Cosh ty -> funCall (specializeMathFunName ty "cosh") [e] + Sinh ty -> funCall (specializeMathFunName ty "sinh") [e] + Tanh ty -> funCall (specializeMathFunName ty "tanh") [e] + Exp ty -> funCall (specializeMathFunName ty "exp") [e] + Log ty -> funCall (specializeMathFunName ty "log") [e] + Sqrt ty -> funCall (specializeMathFunName ty "sqrt") [e] + Ceiling ty -> funCall (specializeMathFunName ty "ceil") [e] + Floor ty -> funCall (specializeMathFunName ty "floor") [e] BwNot _ -> (C..~) e - Cast _ ty -> C.Cast (transtypename ty) e + Cast _ ty -> C.Cast (transTypeName ty) e GetField (Struct _) _ f -> C.Dot e (accessorname f) -- | Translates a Copilot binary operator and its arguments into a C99 -- expression. -transop2 :: Op2 a b c -> C.Expr -> C.Expr -> C.Expr -transop2 op e1 e2 = case op of +transOp2 :: Op2 a b c -> C.Expr -> C.Expr -> C.Expr +transOp2 op e1 e2 = case op of And -> e1 C..&& e2 Or -> e1 C..|| e2 Add _ -> e1 C..+ e2 @@ -98,10 +98,10 @@ transop2 op e1 e2 = case op of Mod _ -> e1 C..% e2 Div _ -> e1 C../ e2 Fdiv _ -> e1 C../ e2 - Pow ty -> funcall (specializeMathFunName ty "pow") [e1, e2] - Logb ty -> funcall (specializeMathFunName ty "log") [e2] C../ - funcall (specializeMathFunName ty "log") [e1] - Atan2 ty -> funcall (specializeMathFunName ty "atan2") [e1, e2] + Pow ty -> funCall (specializeMathFunName ty "pow") [e1, e2] + Logb ty -> funCall (specializeMathFunName ty "log") [e2] C../ + funCall (specializeMathFunName ty "log") [e1] + Atan2 ty -> funCall (specializeMathFunName ty "atan2") [e1, e2] Eq _ -> e1 C..== e2 Ne _ -> e1 C..!= e2 Le _ -> e1 C..<= e2 @@ -117,8 +117,8 @@ transop2 op e1 e2 = case op of -- | Translates a Copilot ternary operator and its arguments into a C99 -- expression. -transop3 :: Op3 a b c d -> C.Expr -> C.Expr -> C.Expr -> C.Expr -transop3 op e1 e2 e3 = case op of +transOp3 :: Op3 a b c d -> C.Expr -> C.Expr -> C.Expr -> C.Expr +transOp3 op e1 e2 e3 = case op of Mux _ -> C.Cond e1 e2 e3 -- | Translate @'Abs' e@ in Copilot Core into a C99 expression. @@ -135,7 +135,7 @@ transAbs :: Type a -> C.Expr -> C.Expr transAbs ty e -- Abs for floats/doubles is called fabs in C99's math.h. | typeIsFloating ty - = funcall (specializeMathFunName ty "fabs") [e] + = funCall (specializeMathFunName ty "fabs") [e] -- C99 provides multiple implementations of abs, depending on the type of -- the arguments. For integers, it provides C99 abs, labs, and llabs, which @@ -213,32 +213,32 @@ transSign ty e = positiveCase $ negativeCase e -- | Transform a Copilot Core literal, based on its value and type, into a C99 -- literal. -constty :: Type a -> a -> C.Expr -constty ty = case ty of +constTy :: Type a -> a -> C.Expr +constTy ty = case ty of Bool -> C.LitBool - Int8 -> explicitty ty . C.LitInt . fromIntegral - Int16 -> explicitty ty . C.LitInt . fromIntegral - Int32 -> explicitty ty . C.LitInt . fromIntegral - Int64 -> explicitty ty . C.LitInt . fromIntegral - Word8 -> explicitty ty . C.LitInt . fromIntegral - Word16 -> explicitty ty . C.LitInt . fromIntegral - Word32 -> explicitty ty . C.LitInt . fromIntegral - Word64 -> explicitty ty . C.LitInt . fromIntegral - Float -> explicitty ty . C.LitFloat - Double -> explicitty ty . C.LitDouble + Int8 -> explicitTy ty . C.LitInt . fromIntegral + Int16 -> explicitTy ty . C.LitInt . fromIntegral + Int32 -> explicitTy ty . C.LitInt . fromIntegral + Int64 -> explicitTy ty . C.LitInt . fromIntegral + Word8 -> explicitTy ty . C.LitInt . fromIntegral + Word16 -> explicitTy ty . C.LitInt . fromIntegral + Word32 -> explicitTy ty . C.LitInt . fromIntegral + Word64 -> explicitTy ty . C.LitInt . fromIntegral + Float -> explicitTy ty . C.LitFloat + Double -> explicitTy ty . C.LitDouble Struct _ -> \v -> - C.InitVal (transtypename ty) (constStruct (toValues v)) + C.InitVal (transTypeName ty) (constStruct (toValues v)) Array ty' -> \v -> - C.InitVal (transtypename ty) (constarray ty' (arrayelems v)) + C.InitVal (transTypeName ty) (constArray ty' (arrayelems v)) -- | Transform a Copilot Core literal, based on its value and type, into a C99 -- initializer. -constinit :: Type a -> a -> C.Init -constinit ty val = case ty of - -- We include two special cases for Struct and Array to avoid using constty +constInit :: Type a -> a -> C.Init +constInit ty val = case ty of + -- We include two special cases for Struct and Array to avoid using constTy -- on them. -- - -- In the default case (i.e., InitExpr (constty ty val)), constant + -- In the default case (i.e., InitExpr (constTy ty val)), constant -- initializations are explicitly cast. However, doing so 1) may result in -- incorrect values for arrays, and 2) will be considered a non-constant -- expression in the case of arrays and structs, and thus not allowed as the @@ -255,7 +255,7 @@ constinit ty val = case ty of -- whole expression as an array of two int32_t's (as opposed to a nested -- array). This can either lead to compile-time errors (if you're lucky) or -- incorrect runtime semantics (if you're unlucky). - Array ty' -> C.InitList $ constarray ty' $ arrayelems val + Array ty' -> C.InitList $ constArray ty' $ arrayelems val -- We use InitArray to initialize a struct because the syntax used for -- initializing arrays and structs is compatible. For instance, {1, 2} works @@ -263,30 +263,30 @@ constinit ty val = case ty of -- two int fields, although the two expressions are conceptually different -- (structs can also be initialized as { .a = 1, .b = 2}. Struct _ -> C.InitList $ constStruct (toValues val) - _ -> C.InitExpr $ constty ty val + _ -> C.InitExpr $ constTy ty val -- | Transform a Copilot Core struct field into a C99 initializer. -constfieldinit :: Value a -> C.InitItem -constfieldinit (Value ty (Field val)) = C.InitItem Nothing $ constinit ty val +constFieldInit :: Value a -> C.InitItem +constFieldInit (Value ty (Field val)) = C.InitItem Nothing $ constInit ty val -- | Transform a Copilot Struct, based on the struct fields, into a list of C99 -- initializer values. constStruct :: [Value a] -> NonEmpty.NonEmpty C.InitItem -constStruct val = NonEmpty.fromList $ map constfieldinit val +constStruct val = NonEmpty.fromList $ map constFieldInit val -- | Transform a Copilot Array, based on the element values and their type, -- into a list of C99 initializer values. -constarray :: Type a -> [a] -> NonEmpty.NonEmpty C.InitItem -constarray ty = - NonEmpty.fromList . map (C.InitItem Nothing . constinit ty) +constArray :: Type a -> [a] -> NonEmpty.NonEmpty C.InitItem +constArray ty = + NonEmpty.fromList . map (C.InitItem Nothing . constInit ty) -- | Explicitly cast a C99 value to a type. -explicitty :: Type a -> C.Expr -> C.Expr -explicitty ty = C.Cast (transtypename ty) +explicitTy :: Type a -> C.Expr -> C.Expr +explicitTy ty = C.Cast (transTypeName ty) -- | Translate a Copilot type to a C99 type. -transtype :: Type a -> C.Type -transtype ty = case ty of +transType :: Type a -> C.Type +transType ty = case ty of Bool -> C.TypeSpec $ C.TypedefName "bool" Int8 -> C.TypeSpec $ C.TypedefName "int8_t" Int16 -> C.TypeSpec $ C.TypedefName "int16_t" @@ -298,7 +298,7 @@ transtype ty = case ty of Word64 -> C.TypeSpec $ C.TypedefName "uint64_t" Float -> C.TypeSpec C.Float Double -> C.TypeSpec C.Double - Array ty' -> C.Array (transtype ty') length + Array ty' -> C.Array (transType ty') length where length = Just $ C.LitInt $ fromIntegral $ tylength ty Struct s -> C.TypeSpec $ C.Struct (typename s) @@ -310,12 +310,12 @@ transtype ty = case ty of -- variable declaration. We treat global variables differently (we generate -- list initializers). transLocalVarDeclType :: Type a -> C.Type -transLocalVarDeclType (Array ty') = C.Ptr $ transtype ty' -transLocalVarDeclType ty = transtype ty +transLocalVarDeclType (Array ty') = C.Ptr $ transType ty' +transLocalVarDeclType ty = transType ty -- | Translate a Copilot type intro a C typename -transtypename :: Type a -> C.TypeName -transtypename ty = C.TypeName $ transtype ty +transTypeName :: Type a -> C.TypeName +transTypeName ty = C.TypeName $ transType ty -- Translate a literal number of type @ty@ into a C99 literal. -- diff --git a/copilot-c99/src/Copilot/Compile/C99/Util.hs b/copilot-c99/src/Copilot/Compile/C99/Util.hs index 10d6f9a83..de1a9222f 100644 --- a/copilot-c99/src/Copilot/Compile/C99/Util.hs +++ b/copilot-c99/src/Copilot/Compile/C99/Util.hs @@ -12,14 +12,14 @@ import qualified Language.C99.Simple.AST as C type FunEnv = [C.Decln] -- | `tell` equivalent for `State`. -statetell :: Monoid m => m -> State m () -statetell m = modify ((flip mappend) m) +stateTell :: Monoid m => m -> State m () +stateTell m = modify ((flip mappend) m) -- | Generate fresh variable name based on a given one. fresh :: String -> [String] -> String -fresh name used = head $ dropWhile (flip elem used) (name:freshnames) +fresh name used = head $ dropWhile (flip elem used) (name:freshNames) where - freshnames = (name ++).show <$> [0..] + freshNames = (name ++).show <$> [0..] -- | Collect all the names from a list of C99 declarations. names :: [C.Decln] -> [String] @@ -28,36 +28,36 @@ names ds = map match ds match (C.VarDecln _ _ name _) = name -- | Turn a stream id into a suitable C variable name. -streamname :: Id -> String -streamname sid = "s" ++ show sid +streamName :: Id -> String +streamName sId = "s" ++ show sId -- | Turn a stream id into the global varname for indices. -indexname :: Id -> String -indexname sid = streamname sid ++ "_idx" +indexName :: Id -> String +indexName sId = streamName sId ++ "_idx" -- | Turn a stream id into the name of its accessor function -streamaccessorname :: Id -> String -streamaccessorname sid = streamname sid ++ "_get" +streamAccessorName :: Id -> String +streamAccessorName sId = streamName sId ++ "_get" -- | Add a postfix for copies of external variables the name. -excpyname :: String -> String -excpyname name = name ++ "_cpy" +exCpyName :: String -> String +exCpyName name = name ++ "_cpy" -- | Turn stream id into name of its generator function. -generatorname :: Id -> String -generatorname sid = streamname sid ++ "_gen" +generatorName :: Id -> String +generatorName sId = streamName sId ++ "_gen" -- | Turn stream id into name of its output argument array. generatorOutputArgName :: Id -> String -generatorOutputArgName sid = streamname sid ++ "_output" +generatorOutputArgName sId = streamName sId ++ "_output" -- | Turn the name of a trigger into a guard generator. -guardname :: String -> String -guardname name = name ++ "_guard" +guardName :: String -> String +guardName name = name ++ "_guard" -- | Turn a trigger name into a an trigger argument name. -argname :: String -> Int -> String -argname name n = name ++ "_arg" ++ show n +argName :: String -> Int -> String +argName name n = name ++ "_arg" ++ show n -- | Turn a handler function name into a name for a temporary variable for a -- handler argument. @@ -65,13 +65,13 @@ argTempName :: String -> Int -> String argTempName name n = name ++ "_arg_temp" ++ show n -- | Enumerate all argument names based on trigger name. -argnames :: String -> [String] -argnames base = [aname | n <- [0..], let aname = argname base n] +argNames :: String -> [String] +argNames base = [aName | n <- [0..], let aName = argName base n] -- | Enumerate all temporary variable names based on handler function name. argTempNames :: String -> [String] argTempNames base = map (argTempName base) [0..] -- | Define a C expression that calls a function with arguments. -funcall :: C.Ident -> [C.Expr] -> C.Expr -funcall name args = C.Funcall (C.Ident name) args +funCall :: C.Ident -> [C.Expr] -> C.Expr +funCall name args = C.Funcall (C.Ident name) args From ccd36be592439f0594ab7c4bdcf74e8d4fdce602 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 4 Sep 2023 12:24:16 -0700 Subject: [PATCH 0615/1222] copilot-c99: Remove underscores from variable names. Refs #453. Our styling rules state that names should use lowerCamelCase/CamelCase (depending on whether they are types or values), and that underscores are not allowed. This commit renames variables with underscore to use lowerCamelCase instead. --- .../src/Copilot/Compile/C99/CodeGen.hs | 26 +++++++++---------- 1 file changed, 13 insertions(+), 13 deletions(-) diff --git a/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs b/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs index 884d627d0..c0ad660e4 100644 --- a/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs +++ b/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs @@ -119,32 +119,32 @@ mkStep cSettings streams triggers exts = mkUpdateGlobals (Stream sId buff expr ty) = (tmpDecln, tmpAssign, bufferUpdate, indexUpdate) where - tmpDecln = C.VarDecln Nothing cTy tmp_var Nothing + tmpDecln = C.VarDecln Nothing cTy tmpVar Nothing tmpAssign = case ty of Array _ -> C.Expr $ C.Funcall (C.Ident $ generatorName sId) - [ C.Ident tmp_var ] - _ -> C.Expr $ C.Ident tmp_var C..= val + [ C.Ident tmpVar ] + _ -> C.Expr $ C.Ident tmpVar C..= val bufferUpdate = case ty of - Array _ -> C.Expr $ memcpy dest (C.Ident tmp_var) size + Array _ -> C.Expr $ memcpy dest (C.Ident tmpVar) size where - dest = C.Index buff_var index_var + dest = C.Index buffVar indexVar size = C.LitInt (fromIntegral $ tysize ty) C..* C.SizeOfType (C.TypeName (tyElemName ty)) _ -> C.Expr $ - C.Index buff_var index_var C..= (C.Ident tmp_var) + C.Index buffVar indexVar C..= (C.Ident tmpVar) - indexUpdate = C.Expr $ index_var C..= (incIndex C..% buffLength) + indexUpdate = C.Expr $ indexVar C..= (incIndex C..% buffLength) where buffLength = C.LitInt $ fromIntegral $ length buff - incIndex = index_var C..+ C.LitInt 1 + incIndex = indexVar C..+ C.LitInt 1 - tmp_var = streamName sId ++ "_tmp" - buff_var = C.Ident $ streamName sId - index_var = C.Ident $ indexName sId - val = C.Funcall (C.Ident $ generatorName sId) [] - cTy = transType ty + tmpVar = streamName sId ++ "_tmp" + buffVar = C.Ident $ streamName sId + indexVar = C.Ident $ indexName sId + val = C.Funcall (C.Ident $ generatorName sId) [] + cTy = transType ty -- Make code that copies an external variable to its local one. mkExCopy :: External -> C.Stmt From 8ffe048f3adeb9145ead6baa308f4cb0733a6055 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 4 Sep 2023 12:26:59 -0700 Subject: [PATCH 0616/1222] copilot-c99: Remove redundant brackets. Refs #453. This commit removes brackets that are not necessary. In some cases, the brackets might aid legibility. However, other portions of the code with similar constracts don't have them, so for consistency we remove redundant brackets in such cases too. --- copilot-c99/src/Copilot/Compile/C99/CodeGen.hs | 2 +- copilot-c99/src/Copilot/Compile/C99/Translate.hs | 2 +- copilot-c99/src/Copilot/Compile/C99/Util.hs | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs b/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs index c0ad660e4..e9810f6f3 100644 --- a/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs +++ b/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs @@ -133,7 +133,7 @@ mkStep cSettings streams triggers exts = size = C.LitInt (fromIntegral $ tysize ty) C..* C.SizeOfType (C.TypeName (tyElemName ty)) _ -> C.Expr $ - C.Index buffVar indexVar C..= (C.Ident tmpVar) + C.Index buffVar indexVar C..= C.Ident tmpVar indexUpdate = C.Expr $ indexVar C..= (incIndex C..% buffLength) where diff --git a/copilot-c99/src/Copilot/Compile/C99/Translate.hs b/copilot-c99/src/Copilot/Compile/C99/Translate.hs index 9c691d06e..73af5102b 100644 --- a/copilot-c99/src/Copilot/Compile/C99/Translate.hs +++ b/copilot-c99/src/Copilot/Compile/C99/Translate.hs @@ -64,7 +64,7 @@ transOp1 op e = Not -> (C..!) e Abs ty -> transAbs ty e Sign ty -> transSign ty e - Recip ty -> (constNumTy ty 1) C../ e + Recip ty -> constNumTy ty 1 C../ e Acos ty -> funCall (specializeMathFunName ty "acos") [e] Asin ty -> funCall (specializeMathFunName ty "asin") [e] Atan ty -> funCall (specializeMathFunName ty "atan") [e] diff --git a/copilot-c99/src/Copilot/Compile/C99/Util.hs b/copilot-c99/src/Copilot/Compile/C99/Util.hs index de1a9222f..2cb677778 100644 --- a/copilot-c99/src/Copilot/Compile/C99/Util.hs +++ b/copilot-c99/src/Copilot/Compile/C99/Util.hs @@ -13,7 +13,7 @@ type FunEnv = [C.Decln] -- | `tell` equivalent for `State`. stateTell :: Monoid m => m -> State m () -stateTell m = modify ((flip mappend) m) +stateTell m = modify (flip mappend m) -- | Generate fresh variable name based on a given one. fresh :: String -> [String] -> String From 7acff3edc26c6aff8c914d96e645753da3d8f1b4 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 5 Sep 2023 00:19:12 -0700 Subject: [PATCH 0617/1222] copilot-c99: Make exports explicit. Refs #453. This commit makes exports of all modules explicit. This will help identify unused definitions, as well as force us to think about the interface provided by each module. --- copilot-c99/src/Copilot/Compile/C99/CodeGen.hs | 16 +++++++++++++++- copilot-c99/src/Copilot/Compile/C99/External.hs | 6 +++++- copilot-c99/src/Copilot/Compile/C99/Settings.hs | 6 +++++- copilot-c99/src/Copilot/Compile/C99/Translate.hs | 7 ++++++- copilot-c99/src/Copilot/Compile/C99/Util.hs | 16 +++++++++++++++- 5 files changed, 46 insertions(+), 5 deletions(-) diff --git a/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs b/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs index e9810f6f3..b5fcb46c9 100644 --- a/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs +++ b/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs @@ -2,7 +2,21 @@ {-# LANGUAGE ScopedTypeVariables #-} -- | High-level translation of Copilot Core into C99. -module Copilot.Compile.C99.CodeGen where +module Copilot.Compile.C99.CodeGen + ( genFun + , genFunArray + , mkAccessDecln + , mkBuffDecln + , mkExtCpyDecln + , mkExtDecln + , mkIndexDecln + , mkStep + , mkStructDecln + , mkStructForwDecln + , exprTypes + , gatherExprs + ) + where import Control.Monad.State (runState) import Data.List (union, unzip4) diff --git a/copilot-c99/src/Copilot/Compile/C99/External.hs b/copilot-c99/src/Copilot/Compile/C99/External.hs index 062a4f8c1..3ead9853f 100644 --- a/copilot-c99/src/Copilot/Compile/C99/External.hs +++ b/copilot-c99/src/Copilot/Compile/C99/External.hs @@ -2,7 +2,11 @@ -- | Represent information about externs needed in the generation of C99 code -- for stream declarations and triggers. -module Copilot.Compile.C99.External where +module Copilot.Compile.C99.External + ( External(..) + , gatherExts + ) + where import Data.List (unionBy) diff --git a/copilot-c99/src/Copilot/Compile/C99/Settings.hs b/copilot-c99/src/Copilot/Compile/C99/Settings.hs index 782096e57..bb52271ae 100644 --- a/copilot-c99/src/Copilot/Compile/C99/Settings.hs +++ b/copilot-c99/src/Copilot/Compile/C99/Settings.hs @@ -1,5 +1,9 @@ -- | Settings used by the code generator to customize the code. -module Copilot.Compile.C99.Settings where +module Copilot.Compile.C99.Settings + ( CSettings(..) + , mkDefaultCSettings + ) + where -- | Settings used to customize the code generated. data CSettings = CSettings diff --git a/copilot-c99/src/Copilot/Compile/C99/Translate.hs b/copilot-c99/src/Copilot/Compile/C99/Translate.hs index 73af5102b..34dc2699a 100644 --- a/copilot-c99/src/Copilot/Compile/C99/Translate.hs +++ b/copilot-c99/src/Copilot/Compile/C99/Translate.hs @@ -1,7 +1,12 @@ {-# LANGUAGE GADTs #-} -- | Translate Copilot Core expressions and operators to C99. -module Copilot.Compile.C99.Translate where +module Copilot.Compile.C99.Translate + ( transExpr + , transType + , constArray + ) + where import Control.Monad.State import qualified Data.List.NonEmpty as NonEmpty diff --git a/copilot-c99/src/Copilot/Compile/C99/Util.hs b/copilot-c99/src/Copilot/Compile/C99/Util.hs index 2cb677778..910959907 100644 --- a/copilot-c99/src/Copilot/Compile/C99/Util.hs +++ b/copilot-c99/src/Copilot/Compile/C99/Util.hs @@ -1,5 +1,19 @@ -- | Auxiliary helper functions to generate C99 code. -module Copilot.Compile.C99.Util where +module Copilot.Compile.C99.Util + ( FunEnv + , stateTell + , funCall + , argNames + , argTempNames + , exCpyName + , generatorName + , generatorOutputArgName + , guardName + , indexName + , streamAccessorName + , streamName + ) + where import Control.Monad.State From d3a65e1b2ad8e42c046ac519f2bdbdb0358f9ef8 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 5 Sep 2023 00:28:28 -0700 Subject: [PATCH 0618/1222] copilot-c99: Remove unused variables. Refs #453. --- copilot-c99/src/Copilot/Compile/C99/CodeGen.hs | 6 ------ copilot-c99/src/Copilot/Compile/C99/Util.hs | 12 ------------ 2 files changed, 18 deletions(-) diff --git a/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs b/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs index b5fcb46c9..2bb8778c8 100644 --- a/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs +++ b/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs @@ -32,12 +32,6 @@ import Copilot.Compile.C99.External import Copilot.Compile.C99.Settings import Copilot.Compile.C99.Translate --- | Write a declaration for a generator function. -genDecln :: String -> Type a -> C.Decln -genDecln name ty = C.FunDecln Nothing cTy name [] - where - cTy = C.decay $ transType ty - -- | Write a generator function for a stream. genFun :: String -> Expr a -> Type a -> C.FunDef genFun name expr ty = C.FunDef cTy name [] cVars [C.Return $ Just cExpr] diff --git a/copilot-c99/src/Copilot/Compile/C99/Util.hs b/copilot-c99/src/Copilot/Compile/C99/Util.hs index 910959907..6f3f70a34 100644 --- a/copilot-c99/src/Copilot/Compile/C99/Util.hs +++ b/copilot-c99/src/Copilot/Compile/C99/Util.hs @@ -29,18 +29,6 @@ type FunEnv = [C.Decln] stateTell :: Monoid m => m -> State m () stateTell m = modify (flip mappend m) --- | Generate fresh variable name based on a given one. -fresh :: String -> [String] -> String -fresh name used = head $ dropWhile (flip elem used) (name:freshNames) - where - freshNames = (name ++).show <$> [0..] - --- | Collect all the names from a list of C99 declarations. -names :: [C.Decln] -> [String] -names ds = map match ds - where - match (C.VarDecln _ _ name _) = name - -- | Turn a stream id into a suitable C variable name. streamName :: Id -> String streamName sId = "s" ++ show sId From a5b5d0c1d132b71fc07def317d9365814126096d Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 5 Sep 2023 09:22:41 -0700 Subject: [PATCH 0619/1222] copilot-c99: Make imports explicit. Refs #453. According to our style guide, all imports must be explicit. This commit makes all imports in all modules explicit. --- copilot-c99/src/Copilot/Compile/C99.hs | 5 +++-- .../src/Copilot/Compile/C99/CodeGen.hs | 17 ++++++++++------ .../src/Copilot/Compile/C99/Compile.hs | 20 +++++++++++++------ .../src/Copilot/Compile/C99/External.hs | 5 +++-- .../src/Copilot/Compile/C99/Translate.hs | 12 +++++++---- 5 files changed, 39 insertions(+), 20 deletions(-) diff --git a/copilot-c99/src/Copilot/Compile/C99.hs b/copilot-c99/src/Copilot/Compile/C99.hs index 3602fa6f1..e03f1b644 100644 --- a/copilot-c99/src/Copilot/Compile/C99.hs +++ b/copilot-c99/src/Copilot/Compile/C99.hs @@ -6,5 +6,6 @@ module Copilot.Compile.C99 , mkDefaultCSettings ) where -import Copilot.Compile.C99.Compile -import Copilot.Compile.C99.Settings +-- Internal imports +import Copilot.Compile.C99.Compile ( compile, compileWith ) +import Copilot.Compile.C99.Settings ( CSettings (..), mkDefaultCSettings ) diff --git a/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs b/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs index 2bb8778c8..84f88dec8 100644 --- a/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs +++ b/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs @@ -25,12 +25,17 @@ import Data.Typeable (Typeable) import qualified Language.C99.Simple as C -import Copilot.Core -import Copilot.Compile.C99.Error (impossible) -import Copilot.Compile.C99.Util -import Copilot.Compile.C99.External -import Copilot.Compile.C99.Settings -import Copilot.Compile.C99.Translate +import Copilot.Compile.C99.Error ( impossible ) +import Copilot.Compile.C99.External ( External (..) ) +import Copilot.Compile.C99.Settings ( CSettings, cSettingsStepFunctionName ) +import Copilot.Compile.C99.Translate ( constArray, transExpr, transType ) +import Copilot.Compile.C99.Util ( argNames, argTempNames, generatorName, + guardName, indexName, streamAccessorName, + streamName ) +import Copilot.Core ( Expr (..), Id, Stream (..), Struct (..), + Trigger (..), Type (..), UExpr (..), + UType (..), Value (..), fieldname, + tysize ) -- | Write a generator function for a stream. genFun :: String -> Expr a -> Type a -> C.FunDef diff --git a/copilot-c99/src/Copilot/Compile/C99/Compile.hs b/copilot-c99/src/Copilot/Compile/C99/Compile.hs index 79048b565..e2cf7b392 100644 --- a/copilot-c99/src/Copilot/Compile/C99/Compile.hs +++ b/copilot-c99/src/Copilot/Compile/C99/Compile.hs @@ -16,12 +16,20 @@ import System.IO (hPutStrLn, stderr) import Language.C99.Pretty (pretty) import qualified Language.C99.Simple as C -import Copilot.Core -import Copilot.Compile.C99.Util -import Copilot.Compile.C99.External -import Copilot.Compile.C99.Settings -import Copilot.Compile.C99.Translate -import Copilot.Compile.C99.CodeGen +import Copilot.Compile.C99.CodeGen ( exprTypes, gatherExprs, genFun, + genFunArray, mkAccessDecln, mkBuffDecln, + mkExtCpyDecln, mkExtDecln, mkIndexDecln, + mkStep, mkStructDecln, + mkStructForwDecln ) +import Copilot.Compile.C99.External ( External, gatherExts ) +import Copilot.Compile.C99.Settings ( CSettings, cSettingsOutputDirectory, + cSettingsStepFunctionName, + mkDefaultCSettings ) +import Copilot.Compile.C99.Translate ( transType ) +import Copilot.Compile.C99.Util ( argNames, generatorName, + generatorOutputArgName, guardName ) +import Copilot.Core ( Spec (..), Stream (..), Trigger (..), + Type (..), UExpr (..), UType (..) ) -- | Compile a specification to a .h and a .c file. -- diff --git a/copilot-c99/src/Copilot/Compile/C99/External.hs b/copilot-c99/src/Copilot/Compile/C99/External.hs index 3ead9853f..ebd62cc8d 100644 --- a/copilot-c99/src/Copilot/Compile/C99/External.hs +++ b/copilot-c99/src/Copilot/Compile/C99/External.hs @@ -10,8 +10,9 @@ module Copilot.Compile.C99.External import Data.List (unionBy) -import Copilot.Core -import Copilot.Compile.C99.Util +import Copilot.Compile.C99.Util ( exCpyName ) +import Copilot.Core ( Expr (..), Stream (..), Trigger (..), Type, + UExpr (..) ) -- | Representation of external variables. data External = forall a. External diff --git a/copilot-c99/src/Copilot/Compile/C99/Translate.hs b/copilot-c99/src/Copilot/Compile/C99/Translate.hs index 34dc2699a..2f0baae4c 100644 --- a/copilot-c99/src/Copilot/Compile/C99/Translate.hs +++ b/copilot-c99/src/Copilot/Compile/C99/Translate.hs @@ -8,12 +8,16 @@ module Copilot.Compile.C99.Translate ) where -import Control.Monad.State +import Control.Monad.State (State, modify) import qualified Data.List.NonEmpty as NonEmpty -import Copilot.Core -import Copilot.Compile.C99.Error (impossible) -import Copilot.Compile.C99.Util +import Copilot.Compile.C99.Error ( impossible ) +import Copilot.Compile.C99.Util ( FunEnv, exCpyName, funCall, stateTell, + streamAccessorName ) +import Copilot.Core ( Expr (..), Field (..), Op1 (..), Op2 (..), + Op3 (..), Type (..), Value (..), + accessorname, arrayelems, toValues, tylength, + typename ) import qualified Language.C99.Simple as C From fba21efc24dd1061101a44b60dd280ac7043e051 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 5 Sep 2023 09:24:20 -0700 Subject: [PATCH 0620/1222] copilot-c99: Move auxiliary function to module that uses it. Refs #453. This commit moves a function from the Util module to the Translate module, since only the latter uses it and it's not a function that has other uses within the C99 backend. --- copilot-c99/src/Copilot/Compile/C99/Translate.hs | 6 ++++-- copilot-c99/src/Copilot/Compile/C99/Util.hs | 7 ------- 2 files changed, 4 insertions(+), 9 deletions(-) diff --git a/copilot-c99/src/Copilot/Compile/C99/Translate.hs b/copilot-c99/src/Copilot/Compile/C99/Translate.hs index 2f0baae4c..b8894373b 100644 --- a/copilot-c99/src/Copilot/Compile/C99/Translate.hs +++ b/copilot-c99/src/Copilot/Compile/C99/Translate.hs @@ -12,7 +12,7 @@ import Control.Monad.State (State, modify) import qualified Data.List.NonEmpty as NonEmpty import Copilot.Compile.C99.Error ( impossible ) -import Copilot.Compile.C99.Util ( FunEnv, exCpyName, funCall, stateTell, +import Copilot.Compile.C99.Util ( FunEnv, exCpyName, funCall, streamAccessorName ) import Copilot.Core ( Expr (..), Field (..), Op1 (..), Op2 (..), Op3 (..), Type (..), Value (..), @@ -29,7 +29,9 @@ transExpr (Local ty1 _ name e1 e2) = do e1' <- transExpr e1 let cTy1 = transLocalVarDeclType ty1 init = Just $ C.InitExpr e1' - stateTell [C.VarDecln Nothing cTy1 name init] + + -- Add new decl to the tail of the fun env + modify (++ [C.VarDecln Nothing cTy1 name init]) transExpr e2 diff --git a/copilot-c99/src/Copilot/Compile/C99/Util.hs b/copilot-c99/src/Copilot/Compile/C99/Util.hs index 6f3f70a34..074a34230 100644 --- a/copilot-c99/src/Copilot/Compile/C99/Util.hs +++ b/copilot-c99/src/Copilot/Compile/C99/Util.hs @@ -1,7 +1,6 @@ -- | Auxiliary helper functions to generate C99 code. module Copilot.Compile.C99.Util ( FunEnv - , stateTell , funCall , argNames , argTempNames @@ -15,8 +14,6 @@ module Copilot.Compile.C99.Util ) where -import Control.Monad.State - import Copilot.Core (Id) import qualified Language.C99.Simple.AST as C @@ -25,10 +22,6 @@ import qualified Language.C99.Simple.AST as C -- listed first at the top of the function body. type FunEnv = [C.Decln] --- | `tell` equivalent for `State`. -stateTell :: Monoid m => m -> State m () -stateTell m = modify (flip mappend m) - -- | Turn a stream id into a suitable C variable name. streamName :: Id -> String streamName sId = "s" ++ show sId From fc1581e0152da7404194137f52b36084c3f05c75 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 5 Sep 2023 09:25:44 -0700 Subject: [PATCH 0621/1222] copilot-c99: Move auxiliary type to module that uses it. Refs #453. This commit moves the type FunEnv from the Util module to the Translate module, since only the latter uses it it's not a type that has other uses within the C99 backend. --- copilot-c99/src/Copilot/Compile/C99/Translate.hs | 8 ++++++-- copilot-c99/src/Copilot/Compile/C99/Util.hs | 8 +------- 2 files changed, 7 insertions(+), 9 deletions(-) diff --git a/copilot-c99/src/Copilot/Compile/C99/Translate.hs b/copilot-c99/src/Copilot/Compile/C99/Translate.hs index b8894373b..2ad80cd23 100644 --- a/copilot-c99/src/Copilot/Compile/C99/Translate.hs +++ b/copilot-c99/src/Copilot/Compile/C99/Translate.hs @@ -12,8 +12,7 @@ import Control.Monad.State (State, modify) import qualified Data.List.NonEmpty as NonEmpty import Copilot.Compile.C99.Error ( impossible ) -import Copilot.Compile.C99.Util ( FunEnv, exCpyName, funCall, - streamAccessorName ) +import Copilot.Compile.C99.Util ( exCpyName, funCall, streamAccessorName ) import Copilot.Core ( Expr (..), Field (..), Op1 (..), Op2 (..), Op3 (..), Type (..), Value (..), accessorname, arrayelems, toValues, tylength, @@ -398,3 +397,8 @@ typeIsFloating :: Type a -> Bool typeIsFloating Float = True typeIsFloating Double = True typeIsFloating _ = False + +-- | Auxiliary type used to collect all the declarations of all the variables +-- used in a function to be generated, since variable declarations are always +-- listed first at the top of the function body. +type FunEnv = [C.Decln] diff --git a/copilot-c99/src/Copilot/Compile/C99/Util.hs b/copilot-c99/src/Copilot/Compile/C99/Util.hs index 074a34230..c155b2de7 100644 --- a/copilot-c99/src/Copilot/Compile/C99/Util.hs +++ b/copilot-c99/src/Copilot/Compile/C99/Util.hs @@ -1,7 +1,6 @@ -- | Auxiliary helper functions to generate C99 code. module Copilot.Compile.C99.Util - ( FunEnv - , funCall + ( funCall , argNames , argTempNames , exCpyName @@ -17,11 +16,6 @@ module Copilot.Compile.C99.Util import Copilot.Core (Id) import qualified Language.C99.Simple.AST as C --- | Auxiliary type used to collect all the declarations of all the variables --- used in a function to be generated, since variable declarations are always --- listed first at the top of the function body. -type FunEnv = [C.Decln] - -- | Turn a stream id into a suitable C variable name. streamName :: Id -> String streamName sId = "s" ++ show sId From 78fb5816e293a671b03d1aa82e64711914d50173 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Wed, 6 Sep 2023 03:08:05 -0700 Subject: [PATCH 0622/1222] copilot-c99: Move auxiliary functions to module that uses them. Refs #453. This commit moves functions that obtain information about Copilot expressions and types from the CodeGen module to the Compile module, since the latter is the only one that uses them. --- .../src/Copilot/Compile/C99/CodeGen.hs | 38 +-------------- .../src/Copilot/Compile/C99/Compile.hs | 47 ++++++++++++++++--- 2 files changed, 42 insertions(+), 43 deletions(-) diff --git a/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs b/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs index 84f88dec8..0f6d9c53c 100644 --- a/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs +++ b/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs @@ -13,15 +13,12 @@ module Copilot.Compile.C99.CodeGen , mkStep , mkStructDecln , mkStructForwDecln - , exprTypes - , gatherExprs ) where import Control.Monad.State (runState) -import Data.List (union, unzip4) +import Data.List (unzip4) import qualified Data.List.NonEmpty as NonEmpty -import Data.Typeable (Typeable) import qualified Language.C99.Simple as C @@ -34,8 +31,7 @@ import Copilot.Compile.C99.Util ( argNames, argTempNames, generatorName, streamName ) import Copilot.Core ( Expr (..), Id, Stream (..), Struct (..), Trigger (..), Type (..), UExpr (..), - UType (..), Value (..), fieldname, - tysize ) + Value (..), fieldname, tysize ) -- | Write a generator function for a stream. genFun :: String -> Expr a -> Type a -> C.FunDef @@ -270,36 +266,6 @@ mkStructForwDecln (Struct x) = C.TypeDecln struct where struct = C.TypeSpec $ C.Struct (typename x) --- | List all types of an expression, returns items uniquely. -exprTypes :: Typeable a => Expr a -> [UType] -exprTypes e = case e of - Const ty _ -> typeTypes ty - Local ty1 ty2 _ e1 e2 -> typeTypes ty1 `union` typeTypes ty2 - `union` exprTypes e1 `union` exprTypes e2 - Var ty _ -> typeTypes ty - Drop ty _ _ -> typeTypes ty - ExternVar ty _ _ -> typeTypes ty - Op1 _ e1 -> exprTypes e1 - Op2 _ e1 e2 -> exprTypes e1 `union` exprTypes e2 - Op3 _ e1 e2 e3 -> exprTypes e1 `union` exprTypes e2 `union` exprTypes e3 - Label ty _ _ -> typeTypes ty - --- | List all types of a type, returns items uniquely. -typeTypes :: Typeable a => Type a -> [UType] -typeTypes ty = case ty of - Array ty' -> typeTypes ty' `union` [UType ty] - Struct x -> concatMap (\(Value ty' _) -> typeTypes ty') (toValues x) `union` [UType ty] - _ -> [UType ty] - --- | Collect all expression of a list of streams and triggers and wrap them --- into an UEXpr. -gatherExprs :: [Stream] -> [Trigger] -> [UExpr] -gatherExprs streams triggers = map streamExpr streams - ++ concatMap triggerExpr triggers - where - streamExpr (Stream _ _ expr ty) = UExpr ty expr - triggerExpr (Trigger _ guard args) = UExpr Bool guard : args - -- * Auxiliary functions -- Write a call to the memcpy function. diff --git a/copilot-c99/src/Copilot/Compile/C99/Compile.hs b/copilot-c99/src/Copilot/Compile/C99/Compile.hs index e2cf7b392..6ccc6b972 100644 --- a/copilot-c99/src/Copilot/Compile/C99/Compile.hs +++ b/copilot-c99/src/Copilot/Compile/C99/Compile.hs @@ -6,8 +6,9 @@ module Copilot.Compile.C99.Compile ) where import Text.PrettyPrint (render) -import Data.List (nub) +import Data.List (nub, union) import Data.Maybe (catMaybes) +import Data.Typeable (Typeable) import System.Directory (createDirectoryIfMissing) import System.Exit (exitFailure) import System.FilePath (()) @@ -16,10 +17,9 @@ import System.IO (hPutStrLn, stderr) import Language.C99.Pretty (pretty) import qualified Language.C99.Simple as C -import Copilot.Compile.C99.CodeGen ( exprTypes, gatherExprs, genFun, - genFunArray, mkAccessDecln, mkBuffDecln, - mkExtCpyDecln, mkExtDecln, mkIndexDecln, - mkStep, mkStructDecln, +import Copilot.Compile.C99.CodeGen ( genFun, genFunArray, mkAccessDecln, + mkBuffDecln, mkExtCpyDecln, mkExtDecln, + mkIndexDecln, mkStep, mkStructDecln, mkStructForwDecln ) import Copilot.Compile.C99.External ( External, gatherExts ) import Copilot.Compile.C99.Settings ( CSettings, cSettingsOutputDirectory, @@ -28,8 +28,9 @@ import Copilot.Compile.C99.Settings ( CSettings, cSettingsOutputDirectory, import Copilot.Compile.C99.Translate ( transType ) import Copilot.Compile.C99.Util ( argNames, generatorName, generatorOutputArgName, guardName ) -import Copilot.Core ( Spec (..), Stream (..), Trigger (..), - Type (..), UExpr (..), UType (..) ) +import Copilot.Core ( Expr (..), Spec (..), Stream (..), + Struct (..), Trigger (..), Type (..), + UExpr (..), UType (..), Value (..) ) -- | Compile a specification to a .h and a .c file. -- @@ -203,3 +204,35 @@ compileTypeDeclns _cSettings spec = C.TransUnit declns [] safeCRender :: C.TransUnit -> String safeCRender (C.TransUnit [] []) = "" safeCRender transUnit = render $ pretty $ C.translate transUnit + +-- ** Obtain information from Copilot Core Exprs and Types. + +-- | List all types of an expression, returns items uniquely. +exprTypes :: Typeable a => Expr a -> [UType] +exprTypes e = case e of + Const ty _ -> typeTypes ty + Local ty1 ty2 _ e1 e2 -> typeTypes ty1 `union` typeTypes ty2 + `union` exprTypes e1 `union` exprTypes e2 + Var ty _ -> typeTypes ty + Drop ty _ _ -> typeTypes ty + ExternVar ty _ _ -> typeTypes ty + Op1 _ e1 -> exprTypes e1 + Op2 _ e1 e2 -> exprTypes e1 `union` exprTypes e2 + Op3 _ e1 e2 e3 -> exprTypes e1 `union` exprTypes e2 `union` exprTypes e3 + Label ty _ _ -> typeTypes ty + +-- | List all types of a type, returns items uniquely. +typeTypes :: Typeable a => Type a -> [UType] +typeTypes ty = case ty of + Array ty' -> typeTypes ty' `union` [UType ty] + Struct x -> concatMap (\(Value ty' _) -> typeTypes ty') (toValues x) `union` [UType ty] + _ -> [UType ty] + +-- | Collect all expression of a list of streams and triggers and wrap them +-- into an UEXpr. +gatherExprs :: [Stream] -> [Trigger] -> [UExpr] +gatherExprs streams triggers = map streamExpr streams + ++ concatMap triggerExpr triggers + where + streamExpr (Stream _ _ expr ty) = UExpr ty expr + triggerExpr (Trigger _ guard args) = UExpr Bool guard : args From d3109b768db9774f6b9ca24062578dca4a23284b Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Wed, 6 Sep 2023 03:34:00 -0700 Subject: [PATCH 0623/1222] copilot-c99: Move auxiliary function to module that uses it. Refs #453. This commit moves a function from the Util module to the Translate module, since only the latter uses it and it's not a function that has other uses within the C99 backend. --- copilot-c99/src/Copilot/Compile/C99/Translate.hs | 6 +++++- copilot-c99/src/Copilot/Compile/C99/Util.hs | 8 +------- 2 files changed, 6 insertions(+), 8 deletions(-) diff --git a/copilot-c99/src/Copilot/Compile/C99/Translate.hs b/copilot-c99/src/Copilot/Compile/C99/Translate.hs index 2ad80cd23..f38e0ec8f 100644 --- a/copilot-c99/src/Copilot/Compile/C99/Translate.hs +++ b/copilot-c99/src/Copilot/Compile/C99/Translate.hs @@ -12,7 +12,7 @@ import Control.Monad.State (State, modify) import qualified Data.List.NonEmpty as NonEmpty import Copilot.Compile.C99.Error ( impossible ) -import Copilot.Compile.C99.Util ( exCpyName, funCall, streamAccessorName ) +import Copilot.Compile.C99.Util ( exCpyName, streamAccessorName ) import Copilot.Core ( Expr (..), Field (..), Op1 (..), Op2 (..), Op3 (..), Type (..), Value (..), accessorname, arrayelems, toValues, tylength, @@ -402,3 +402,7 @@ typeIsFloating _ = False -- used in a function to be generated, since variable declarations are always -- listed first at the top of the function body. type FunEnv = [C.Decln] + +-- | Define a C expression that calls a function with arguments. +funCall :: C.Ident -> [C.Expr] -> C.Expr +funCall name args = C.Funcall (C.Ident name) args diff --git a/copilot-c99/src/Copilot/Compile/C99/Util.hs b/copilot-c99/src/Copilot/Compile/C99/Util.hs index c155b2de7..c69929dca 100644 --- a/copilot-c99/src/Copilot/Compile/C99/Util.hs +++ b/copilot-c99/src/Copilot/Compile/C99/Util.hs @@ -1,7 +1,6 @@ -- | Auxiliary helper functions to generate C99 code. module Copilot.Compile.C99.Util - ( funCall - , argNames + ( argNames , argTempNames , exCpyName , generatorName @@ -14,7 +13,6 @@ module Copilot.Compile.C99.Util where import Copilot.Core (Id) -import qualified Language.C99.Simple.AST as C -- | Turn a stream id into a suitable C variable name. streamName :: Id -> String @@ -60,7 +58,3 @@ argNames base = [aName | n <- [0..], let aName = argName base n] -- | Enumerate all temporary variable names based on handler function name. argTempNames :: String -> [String] argTempNames base = map (argTempName base) [0..] - --- | Define a C expression that calls a function with arguments. -funCall :: C.Ident -> [C.Expr] -> C.Expr -funCall name args = C.Funcall (C.Ident name) args From e9e2e50295030b44687997314d36acb6e4c2b3af Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Wed, 6 Sep 2023 03:08:38 -0700 Subject: [PATCH 0624/1222] copilot-c99: Remove unnecessary extension. Refs #453. This commit removes an unnecessary language extension from CodeGen. --- copilot-c99/src/Copilot/Compile/C99/CodeGen.hs | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs b/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs index 0f6d9c53c..1d9e3c1bf 100644 --- a/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs +++ b/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs @@ -1,5 +1,4 @@ -{-# LANGUAGE GADTs #-} -{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE GADTs #-} -- | High-level translation of Copilot Core into C99. module Copilot.Compile.C99.CodeGen From a03851e36aa2bcc546afdb47a6e1f783aff1bc4a Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Wed, 6 Sep 2023 03:13:19 -0700 Subject: [PATCH 0625/1222] copilot-c99: Make function local. Refs #453. This commit makes a function local, instead of being declared at top level in the module, because it's only used in the body of another function, and it makes it harder to present a clear module if the function is kept at top level. --- copilot-c99/src/Copilot/Compile/C99/External.hs | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/copilot-c99/src/Copilot/Compile/C99/External.hs b/copilot-c99/src/Copilot/Compile/C99/External.hs index ebd62cc8d..7235aff36 100644 --- a/copilot-c99/src/Copilot/Compile/C99/External.hs +++ b/copilot-c99/src/Copilot/Compile/C99/External.hs @@ -21,11 +21,6 @@ data External = forall a. External , extType :: Type a } --- | Union over lists of External, we solely base the equality on the --- extName's. -extUnion :: [External] -> [External] -> [External] -extUnion = unionBy (\a b -> extName a == extName b) - -- | Collect all external variables from the streams and triggers. -- -- Although Copilot specifications can contain also properties and theorems, @@ -57,3 +52,8 @@ gatherExts streams triggers = streamsExts `extUnion` triggersExts Op3 _ e1 e2 e3 -> rec e1 `extUnion` rec e2 `extUnion` rec e3 Label _ _ e -> rec e _ -> [] + + -- | Union over lists of External, we solely base the equality on the + -- extName's. + extUnion :: [External] -> [External] -> [External] + extUnion = unionBy (\a b -> extName a == extName b) From 801738821d8c0a56d66eeaa61e087c41c643e11e Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Wed, 6 Sep 2023 03:09:50 -0700 Subject: [PATCH 0626/1222] copilot-c99: Fix typo. Refs #453. --- copilot-c99/src/Copilot/Compile/C99/Util.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot-c99/src/Copilot/Compile/C99/Util.hs b/copilot-c99/src/Copilot/Compile/C99/Util.hs index c69929dca..6391ebb99 100644 --- a/copilot-c99/src/Copilot/Compile/C99/Util.hs +++ b/copilot-c99/src/Copilot/Compile/C99/Util.hs @@ -42,7 +42,7 @@ generatorOutputArgName sId = streamName sId ++ "_output" guardName :: String -> String guardName name = name ++ "_guard" --- | Turn a trigger name into a an trigger argument name. +-- | Turn a trigger name into a trigger argument name. argName :: String -> Int -> String argName name n = name ++ "_arg" ++ show n From d873528d841d51e55dcf72576d183794602c3799 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Wed, 6 Sep 2023 03:18:07 -0700 Subject: [PATCH 0627/1222] copilot-c99: Rename rec variable. Refs #453. This commit renames a variable called rec, since that is a keyword in Haskell and it's best to avoid naming variables like keywords for legibility. --- copilot-c99/src/Copilot/Compile/C99/External.hs | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/copilot-c99/src/Copilot/Compile/C99/External.hs b/copilot-c99/src/Copilot/Compile/C99/External.hs index 7235aff36..2e48a8495 100644 --- a/copilot-c99/src/Copilot/Compile/C99/External.hs +++ b/copilot-c99/src/Copilot/Compile/C99/External.hs @@ -44,14 +44,14 @@ gatherExts streams triggers = streamsExts `extUnion` triggersExts uExprExts (UExpr _ expr) = exprExts expr exprExts :: Expr a -> [External] - exprExts expr = let rec = exprExts in case expr of - Local _ _ _ e1 e2 -> rec e1 `extUnion` rec e2 - ExternVar ty name _ -> [External name (exCpyName name) ty] - Op1 _ e -> rec e - Op2 _ e1 e2 -> rec e1 `extUnion` rec e2 - Op3 _ e1 e2 e3 -> rec e1 `extUnion` rec e2 `extUnion` rec e3 - Label _ _ e -> rec e - _ -> [] + exprExts (Local _ _ _ e1 e2) = exprExts e1 `extUnion` exprExts e2 + exprExts (ExternVar ty name _) = [External name (exCpyName name) ty] + exprExts (Op1 _ e) = exprExts e + exprExts (Op2 _ e1 e2) = exprExts e1 `extUnion` exprExts e2 + exprExts (Op3 _ e1 e2 e3) = exprExts e1 `extUnion` exprExts e2 + `extUnion` exprExts e3 + exprExts (Label _ _ e) = exprExts e + exprExts _ = [] -- | Union over lists of External, we solely base the equality on the -- extName's. From fd3e35df2b0a027635e6b2bd53301526c60f6482 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Wed, 6 Sep 2023 03:10:49 -0700 Subject: [PATCH 0628/1222] copilot-c99: Simplify expression. Refs #453. This commit simplifies a list comprehension by using map. --- copilot-c99/src/Copilot/Compile/C99/Util.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot-c99/src/Copilot/Compile/C99/Util.hs b/copilot-c99/src/Copilot/Compile/C99/Util.hs index 6391ebb99..bb480ab75 100644 --- a/copilot-c99/src/Copilot/Compile/C99/Util.hs +++ b/copilot-c99/src/Copilot/Compile/C99/Util.hs @@ -53,7 +53,7 @@ argTempName name n = name ++ "_arg_temp" ++ show n -- | Enumerate all argument names based on trigger name. argNames :: String -> [String] -argNames base = [aName | n <- [0..], let aName = argName base n] +argNames base = map (argName base) [0..] -- | Enumerate all temporary variable names based on handler function name. argTempNames :: String -> [String] From bd69f84b119abdba19ae7fde4c04dba533b1b9a3 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Wed, 6 Sep 2023 03:21:45 -0700 Subject: [PATCH 0629/1222] copilot-c99: Simplify expression. Refs #453. This commit simplifies an expression by using mapMaybe instead of catMaybes . map. --- copilot-c99/src/Copilot/Compile/C99/Compile.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/copilot-c99/src/Copilot/Compile/C99/Compile.hs b/copilot-c99/src/Copilot/Compile/C99/Compile.hs index 6ccc6b972..e73b75081 100644 --- a/copilot-c99/src/Copilot/Compile/C99/Compile.hs +++ b/copilot-c99/src/Copilot/Compile/C99/Compile.hs @@ -7,7 +7,7 @@ module Copilot.Compile.C99.Compile import Text.PrettyPrint (render) import Data.List (nub, union) -import Data.Maybe (catMaybes) +import Data.Maybe (mapMaybe) import Data.Typeable (Typeable) import System.Directory (createDirectoryIfMissing) import System.Exit (exitFailure) @@ -141,7 +141,7 @@ compileH cSettings spec = C.TransUnit declns [] ++ [stepDecln] mkStructForwDeclns :: [UExpr] -> [C.Decln] - mkStructForwDeclns es = catMaybes $ map mkDecln uTypes + mkStructForwDeclns es = mapMaybe mkDecln uTypes where mkDecln (UType ty) = case ty of Struct x -> Just $ mkStructForwDecln ty @@ -189,7 +189,7 @@ compileTypeDeclns _cSettings spec = C.TransUnit declns [] -- Generate type declarations. mkTypeDeclns :: [UExpr] -> [C.Decln] - mkTypeDeclns es = catMaybes $ map mkTypeDecln uTypes + mkTypeDeclns es = mapMaybe mkTypeDecln uTypes where uTypes = nub $ concatMap (\(UExpr _ e) -> exprTypes e) es From 3c510b6396746afd41168774fba8d5532b398bee Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Wed, 6 Sep 2023 03:23:40 -0700 Subject: [PATCH 0630/1222] copilot-c99: Simplify expression. Refs #453. This commit simplifies several expressions by using zipWith instead of map . zip. Because zipWith takes a binary function as argument, we also curry the function being applied. --- copilot-c99/src/Copilot/Compile/C99/Compile.hs | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/copilot-c99/src/Copilot/Compile/C99/Compile.hs b/copilot-c99/src/Copilot/Compile/C99/Compile.hs index e73b75081..60c68cad1 100644 --- a/copilot-c99/src/Copilot/Compile/C99/Compile.hs +++ b/copilot-c99/src/Copilot/Compile/C99/Compile.hs @@ -121,10 +121,10 @@ compileC cSettings spec = C.TransUnit declns funs triggerGen (Trigger name guard args) = guardDef : argDefs where guardDef = genFun (guardName name) guard Bool - argDefs = map argGen (zip (argNames name) args) + argDefs = zipWith argGen (argNames name) args - argGen :: (String, UExpr) -> C.FunDef - argGen (argName, UExpr ty expr) = genFun argName expr ty + argGen :: String -> UExpr -> C.FunDef + argGen argName (UExpr ty expr) = genFun argName expr ty -- | Generate the .h file from a 'Spec'. compileH :: CSettings -> Spec -> C.TransUnit @@ -160,8 +160,8 @@ compileH cSettings spec = C.TransUnit declns [] extFunDecln (Trigger name _ args) = C.FunDecln Nothing cTy name params where cTy = C.TypeSpec C.Void - params = map mkParam $ zip (argNames name) args - mkParam (name, UExpr ty _) = C.Param (mkParamTy ty) name + params = zipWith mkParam (argNames name) args + mkParam name (UExpr ty _) = C.Param (mkParamTy ty) name -- Special case for Struct, to pass struct arguments by reference. -- Arrays are also passed by reference, but using C's array type From 8f21be03f9d6ff43ffc57dc87e12b614e71904de Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Wed, 6 Sep 2023 03:25:16 -0700 Subject: [PATCH 0631/1222] copilot-c99: Simplify expression. Refs #453. This commit simplifies an expression by using foldr with a composition as argument, instead of foldr f . map g (for some pair of functions, f and g). --- copilot-c99/src/Copilot/Compile/C99/External.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/copilot-c99/src/Copilot/Compile/C99/External.hs b/copilot-c99/src/Copilot/Compile/C99/External.hs index 2e48a8495..d749f7c24 100644 --- a/copilot-c99/src/Copilot/Compile/C99/External.hs +++ b/copilot-c99/src/Copilot/Compile/C99/External.hs @@ -28,8 +28,8 @@ data External = forall a. External gatherExts :: [Stream] -> [Trigger] -> [External] gatherExts streams triggers = streamsExts `extUnion` triggersExts where - streamsExts = foldr extUnion mempty $ map streamExts streams - triggersExts = foldr extUnion mempty $ map triggerExts triggers + streamsExts = foldr (extUnion . streamExts) mempty streams + triggersExts = foldr (extUnion . triggerExts) mempty triggers streamExts :: Stream -> [External] streamExts (Stream _ _ expr _) = exprExts expr From 5188ff21559b78e4aa8dcfe552a2db8ad3562da6 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Wed, 6 Sep 2023 03:27:33 -0700 Subject: [PATCH 0632/1222] copilot-c99: Simplify expression. Refs #453. This commit simplifies an expression by using concatMap instead of concat . map. --- copilot-c99/src/Copilot/Compile/C99/External.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot-c99/src/Copilot/Compile/C99/External.hs b/copilot-c99/src/Copilot/Compile/C99/External.hs index d749f7c24..ce3106936 100644 --- a/copilot-c99/src/Copilot/Compile/C99/External.hs +++ b/copilot-c99/src/Copilot/Compile/C99/External.hs @@ -38,7 +38,7 @@ gatherExts streams triggers = streamsExts `extUnion` triggersExts triggerExts (Trigger _ guard args) = guardExts `extUnion` argExts where guardExts = exprExts guard - argExts = concat $ map uExprExts args + argExts = concatMap uExprExts args uExprExts :: UExpr -> [External] uExprExts (UExpr _ expr) = exprExts expr From 695afa38db258f3fe316e62ddaac2d4c959fe576 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Wed, 6 Sep 2023 03:29:14 -0700 Subject: [PATCH 0633/1222] copilot-c99: Simplify expression. Refs #453. This commit simplifies a definition by using function composition instead of defining a lambda and capturing the arguments. --- copilot-c99/src/Copilot/Compile/C99/Translate.hs | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/copilot-c99/src/Copilot/Compile/C99/Translate.hs b/copilot-c99/src/Copilot/Compile/C99/Translate.hs index f38e0ec8f..00f0c64e5 100644 --- a/copilot-c99/src/Copilot/Compile/C99/Translate.hs +++ b/copilot-c99/src/Copilot/Compile/C99/Translate.hs @@ -236,10 +236,8 @@ constTy ty = case ty of Word64 -> explicitTy ty . C.LitInt . fromIntegral Float -> explicitTy ty . C.LitFloat Double -> explicitTy ty . C.LitDouble - Struct _ -> \v -> - C.InitVal (transTypeName ty) (constStruct (toValues v)) - Array ty' -> \v -> - C.InitVal (transTypeName ty) (constArray ty' (arrayelems v)) + Struct _ -> C.InitVal (transTypeName ty) . constStruct . toValues + Array ty' -> C.InitVal (transTypeName ty) . constArray ty' . arrayelems -- | Transform a Copilot Core literal, based on its value and type, into a C99 -- initializer. From 7c3504485c94364fa40bd12a4a536c397296a70f Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Wed, 6 Sep 2023 03:40:46 -0700 Subject: [PATCH 0634/1222] copilot-c99: Swap arguments that are used in reverse order. Refs #453. This commit swaps the order of arguments in an auxiliary function, since they are used in the order opposite to how they are defined in the LHS of the function definition. --- copilot-c99/src/Copilot/Compile/C99/CodeGen.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs b/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs index 1d9e3c1bf..8be465073 100644 --- a/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs +++ b/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs @@ -204,10 +204,10 @@ mkStep cSettings streams triggers exts = mkTriggerCheck (Trigger name guard args) = (aTmpDeclns, ifStmt) where - aTmpDeclns = zipWith (\tmpVar arg -> + aTmpDeclns = zipWith (\arg tmpVar -> C.VarDecln Nothing (tempType arg) tmpVar Nothing) - aTempNames args + aTempNames where tempType (UExpr { uExprType = ty }) = case ty of From 9a081de1901dbca0795dc91d09e5dec6d8369605 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 7 Sep 2023 06:43:58 -0700 Subject: [PATCH 0635/1222] copilot-c99: Consistent order of local definitions. Refs #453. This commit reorganizes local definitions so that the most important or higher level ones appear before the auxiliary ones. --- copilot-c99/src/Copilot/Compile/C99/CodeGen.hs | 8 +++++--- copilot-c99/src/Copilot/Compile/C99/Compile.hs | 16 ++++++++-------- 2 files changed, 13 insertions(+), 11 deletions(-) diff --git a/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs b/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs index 8be465073..a47a82d3a 100644 --- a/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs +++ b/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs @@ -108,15 +108,17 @@ mkStep :: CSettings -> [Stream] -> [Trigger] -> [External] -> C.FunDef mkStep cSettings streams triggers exts = C.FunDef void (cSettingsStepFunctionName cSettings) [] declns stmts where - void = C.TypeSpec C.Void + + declns = streamDeclns + ++ concat triggerDeclns + stmts = map mkExCopy exts ++ triggerStmts ++ tmpAssigns ++ bufferUpdates ++ indexUpdates - declns = streamDeclns - ++ concat triggerDeclns + (streamDeclns, tmpAssigns, bufferUpdates, indexUpdates) = unzip4 $ map mkUpdateGlobals streams (triggerDeclns, triggerStmts) = diff --git a/copilot-c99/src/Copilot/Compile/C99/Compile.hs b/copilot-c99/src/Copilot/Compile/C99/Compile.hs index 60c68cad1..869fee1f9 100644 --- a/copilot-c99/src/Copilot/Compile/C99/Compile.hs +++ b/copilot-c99/src/Copilot/Compile/C99/Compile.hs @@ -84,13 +84,13 @@ compile = compileWith mkDefaultCSettings compileC :: CSettings -> Spec -> C.TransUnit compileC cSettings spec = C.TransUnit declns funs where + declns = mkExts exts ++ mkGlobals streams + funs = genFuns streams triggers ++ [mkStep cSettings streams triggers exts] + streams = specStreams spec triggers = specTriggers spec exts = gatherExts streams triggers - declns = mkExts exts ++ mkGlobals streams - funs = genFuns streams triggers ++ [mkStep cSettings streams triggers exts] - -- Make declarations for copies of external variables. mkExts :: [External] -> [C.Decln] mkExts exts = map mkExtCpyDecln exts @@ -130,16 +130,16 @@ compileC cSettings spec = C.TransUnit declns funs compileH :: CSettings -> Spec -> C.TransUnit compileH cSettings spec = C.TransUnit declns [] where - streams = specStreams spec - triggers = specTriggers spec - exts = gatherExts streams triggers - exprs = gatherExprs streams triggers - declns = mkStructForwDeclns exprs ++ mkExts exts ++ extFunDeclns triggers ++ [stepDecln] + exprs = gatherExprs streams triggers + exts = gatherExts streams triggers + streams = specStreams spec + triggers = specTriggers spec + mkStructForwDeclns :: [UExpr] -> [C.Decln] mkStructForwDeclns es = mapMaybe mkDecln uTypes where From aaa0a9d89328986d5f6c222d65accf4f950c07d6 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 7 Sep 2023 09:51:04 -0700 Subject: [PATCH 0636/1222] copilot-c99: Consistent order of local definitions. Refs #453. This commit reorganizes local definitions so that the one mentioned earlier is defined earlier. --- copilot-c99/src/Copilot/Compile/C99/CodeGen.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs b/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs index a47a82d3a..4c63ea354 100644 --- a/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs +++ b/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs @@ -72,8 +72,8 @@ mkExtDecln (External name _ ty) = decln mkExtCpyDecln :: External -> C.Decln mkExtCpyDecln (External name cpyName ty) = decln where - cTy = transType ty decln = C.VarDecln (Just C.Static) cTy cpyName Nothing + cTy = transType ty -- | Make a C buffer variable and initialise it with the stream buffer. mkBuffDecln :: Id -> Type a -> [a] -> C.Decln From af7dc20af66eff3130faa6844f3925704ffd1d9c Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 7 Sep 2023 06:43:07 -0700 Subject: [PATCH 0637/1222] copilot-c99: Consistent alignment. Refs #453. This commit aligns auxiliary definitions together in a way that is consistent with the horizontal alignment used in other modules. --- copilot-c99/src/Copilot/Compile/C99/CodeGen.hs | 13 +++++++------ copilot-c99/src/Copilot/Compile/C99/Compile.hs | 9 ++++++--- 2 files changed, 13 insertions(+), 9 deletions(-) diff --git a/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs b/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs index 4c63ea354..938df2bf6 100644 --- a/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs +++ b/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs @@ -36,7 +36,7 @@ import Copilot.Core ( Expr (..), Id, Stream (..), Struct (..), genFun :: String -> Expr a -> Type a -> C.FunDef genFun name expr ty = C.FunDef cTy name [] cVars [C.Return $ Just cExpr] where - cTy = C.decay $ transType ty + cTy = C.decay $ transType ty (cExpr, cVars) = runState (transExpr expr) mempty -- | Write a generator function for a stream that returns an array. @@ -140,8 +140,9 @@ mkStep cSettings streams triggers exts = Array _ -> C.Expr $ memcpy dest (C.Ident tmpVar) size where dest = C.Index buffVar indexVar - size = C.LitInt (fromIntegral $ tysize ty) - C..* C.SizeOfType (C.TypeName (tyElemName ty)) + size = C.LitInt + (fromIntegral $ tysize ty) + C..* C.SizeOfType (C.TypeName (tyElemName ty)) _ -> C.Expr $ C.Index buffVar indexVar C..= C.Ident tmpVar @@ -231,9 +232,9 @@ mkStep cSettings streams triggers exts = -- 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. - fireTrigger = map C.Expr argAssigns ++ - [C.Expr $ C.Funcall (C.Ident name) - (zipWith passArg aTempNames args)] + fireTrigger = map C.Expr argAssigns + ++ [C.Expr $ C.Funcall (C.Ident name) + (zipWith passArg aTempNames args)] where passArg aTempName (UExpr { uExprType = ty }) = case ty of diff --git a/copilot-c99/src/Copilot/Compile/C99/Compile.hs b/copilot-c99/src/Copilot/Compile/C99/Compile.hs index 869fee1f9..b37809ab2 100644 --- a/copilot-c99/src/Copilot/Compile/C99/Compile.hs +++ b/copilot-c99/src/Copilot/Compile/C99/Compile.hs @@ -84,8 +84,11 @@ compile = compileWith mkDefaultCSettings compileC :: CSettings -> Spec -> C.TransUnit compileC cSettings spec = C.TransUnit declns funs where - declns = mkExts exts ++ mkGlobals streams - funs = genFuns streams triggers ++ [mkStep cSettings streams triggers exts] + declns = mkExts exts + ++ mkGlobals streams + + funs = genFuns streams triggers + ++ [mkStep cSettings streams triggers exts] streams = specStreams spec triggers = specTriggers spec @@ -212,7 +215,7 @@ exprTypes :: Typeable a => Expr a -> [UType] exprTypes e = case e of Const ty _ -> typeTypes ty Local ty1 ty2 _ e1 e2 -> typeTypes ty1 `union` typeTypes ty2 - `union` exprTypes e1 `union` exprTypes e2 + `union` exprTypes e1 `union` exprTypes e2 Var ty _ -> typeTypes ty Drop ty _ _ -> typeTypes ty ExternVar ty _ _ -> typeTypes ty From cb539b1177fd9876068fb6a491534a72c3a4560f Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 7 Sep 2023 06:44:22 -0700 Subject: [PATCH 0638/1222] copilot-c99: Adjust vertical and horizontal space. Refs #453. Remove unnecessary space and add necessary space (to keep files consistent in terms of spacing). --- copilot-c99/src/Copilot/Compile/C99/Compile.hs | 2 +- copilot-c99/src/Copilot/Compile/C99/Util.hs | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/copilot-c99/src/Copilot/Compile/C99/Compile.hs b/copilot-c99/src/Copilot/Compile/C99/Compile.hs index b37809ab2..7ca07ee38 100644 --- a/copilot-c99/src/Copilot/Compile/C99/Compile.hs +++ b/copilot-c99/src/Copilot/Compile/C99/Compile.hs @@ -111,7 +111,6 @@ compileC cSettings spec = C.TransUnit declns funs ++ map streamGen streams ++ concatMap triggerGen triggers where - accessDecln :: Stream -> C.FunDef accessDecln (Stream sId buff _ ty) = mkAccessDecln sId ty buff @@ -164,6 +163,7 @@ compileH cSettings spec = C.TransUnit declns [] where cTy = C.TypeSpec C.Void params = zipWith mkParam (argNames name) args + mkParam name (UExpr ty _) = C.Param (mkParamTy ty) name -- Special case for Struct, to pass struct arguments by reference. diff --git a/copilot-c99/src/Copilot/Compile/C99/Util.hs b/copilot-c99/src/Copilot/Compile/C99/Util.hs index bb480ab75..26e69c08b 100644 --- a/copilot-c99/src/Copilot/Compile/C99/Util.hs +++ b/copilot-c99/src/Copilot/Compile/C99/Util.hs @@ -12,7 +12,7 @@ module Copilot.Compile.C99.Util ) where -import Copilot.Core (Id) +import Copilot.Core (Id) -- | Turn a stream id into a suitable C variable name. streamName :: Id -> String From 14ed7ae4eb4cb6aa789eb27487e08af2c3e01d15 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 7 Sep 2023 06:47:50 -0700 Subject: [PATCH 0639/1222] copilot-c99: Reorganize imports. Refs #453. This commit groups imports by External, Internal (from elsewhere in Copilot), and Internal. --- .../src/Copilot/Compile/C99/CodeGen.hs | 14 +++++---- .../src/Copilot/Compile/C99/Compile.hs | 31 ++++++++++--------- .../src/Copilot/Compile/C99/External.hs | 7 +++-- .../src/Copilot/Compile/C99/Translate.hs | 16 +++++----- copilot-c99/src/Copilot/Compile/C99/Util.hs | 1 + 5 files changed, 40 insertions(+), 29 deletions(-) diff --git a/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs b/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs index 938df2bf6..40a32076b 100644 --- a/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs +++ b/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs @@ -15,12 +15,17 @@ module Copilot.Compile.C99.CodeGen ) where -import Control.Monad.State (runState) -import Data.List (unzip4) +-- External imports +import Control.Monad.State ( runState ) +import Data.List ( unzip4 ) import qualified Data.List.NonEmpty as NonEmpty - import qualified Language.C99.Simple as C +-- Internal imports: Copilot +import Copilot.Core ( Expr (..), Id, Stream (..), Struct (..), Trigger (..), + Type (..), UExpr (..), Value (..), fieldname, tysize ) + +-- Internal imports import Copilot.Compile.C99.Error ( impossible ) import Copilot.Compile.C99.External ( External (..) ) import Copilot.Compile.C99.Settings ( CSettings, cSettingsStepFunctionName ) @@ -28,9 +33,6 @@ import Copilot.Compile.C99.Translate ( constArray, transExpr, transType ) import Copilot.Compile.C99.Util ( argNames, argTempNames, generatorName, guardName, indexName, streamAccessorName, streamName ) -import Copilot.Core ( Expr (..), Id, Stream (..), Struct (..), - Trigger (..), Type (..), UExpr (..), - Value (..), fieldname, tysize ) -- | Write a generator function for a stream. genFun :: String -> Expr a -> Type a -> C.FunDef diff --git a/copilot-c99/src/Copilot/Compile/C99/Compile.hs b/copilot-c99/src/Copilot/Compile/C99/Compile.hs index 7ca07ee38..6e5f76721 100644 --- a/copilot-c99/src/Copilot/Compile/C99/Compile.hs +++ b/copilot-c99/src/Copilot/Compile/C99/Compile.hs @@ -5,18 +5,24 @@ module Copilot.Compile.C99.Compile , compileWith ) where -import Text.PrettyPrint (render) -import Data.List (nub, union) -import Data.Maybe (mapMaybe) -import Data.Typeable (Typeable) -import System.Directory (createDirectoryIfMissing) -import System.Exit (exitFailure) -import System.FilePath (()) -import System.IO (hPutStrLn, stderr) - -import Language.C99.Pretty (pretty) +-- External imports +import Data.List ( nub, union ) +import Data.Maybe ( mapMaybe ) +import Data.Typeable ( Typeable ) +import Language.C99.Pretty ( pretty ) import qualified Language.C99.Simple as C - +import System.Directory ( createDirectoryIfMissing ) +import System.Exit ( exitFailure ) +import System.FilePath ( () ) +import System.IO ( hPutStrLn, stderr ) +import Text.PrettyPrint ( render ) + +-- Internal imports: Copilot +import Copilot.Core ( Expr (..), Spec (..), Stream (..), Struct (..), + Trigger (..), Type (..), UExpr (..), UType (..), + Value (..) ) + +-- Internal imports import Copilot.Compile.C99.CodeGen ( genFun, genFunArray, mkAccessDecln, mkBuffDecln, mkExtCpyDecln, mkExtDecln, mkIndexDecln, mkStep, mkStructDecln, @@ -28,9 +34,6 @@ import Copilot.Compile.C99.Settings ( CSettings, cSettingsOutputDirectory, import Copilot.Compile.C99.Translate ( transType ) import Copilot.Compile.C99.Util ( argNames, generatorName, generatorOutputArgName, guardName ) -import Copilot.Core ( Expr (..), Spec (..), Stream (..), - Struct (..), Trigger (..), Type (..), - UExpr (..), UType (..), Value (..) ) -- | Compile a specification to a .h and a .c file. -- diff --git a/copilot-c99/src/Copilot/Compile/C99/External.hs b/copilot-c99/src/Copilot/Compile/C99/External.hs index ce3106936..4d24ca504 100644 --- a/copilot-c99/src/Copilot/Compile/C99/External.hs +++ b/copilot-c99/src/Copilot/Compile/C99/External.hs @@ -8,11 +8,14 @@ module Copilot.Compile.C99.External ) where +-- External imports import Data.List (unionBy) +-- Internal imports: Copilot +import Copilot.Core ( Expr (..), Stream (..), Trigger (..), Type, UExpr (..) ) + +-- Internal imports import Copilot.Compile.C99.Util ( exCpyName ) -import Copilot.Core ( Expr (..), Stream (..), Trigger (..), Type, - UExpr (..) ) -- | Representation of external variables. data External = forall a. External diff --git a/copilot-c99/src/Copilot/Compile/C99/Translate.hs b/copilot-c99/src/Copilot/Compile/C99/Translate.hs index 00f0c64e5..ba78f314d 100644 --- a/copilot-c99/src/Copilot/Compile/C99/Translate.hs +++ b/copilot-c99/src/Copilot/Compile/C99/Translate.hs @@ -8,17 +8,19 @@ module Copilot.Compile.C99.Translate ) where -import Control.Monad.State (State, modify) +-- External imports +import Control.Monad.State ( State, modify ) import qualified Data.List.NonEmpty as NonEmpty +import qualified Language.C99.Simple as C + +-- Internal imports: Copilot +import Copilot.Core ( Expr (..), Field (..), Op1 (..), Op2 (..), Op3 (..), + Type (..), Value (..), accessorname, arrayelems, toValues, + tylength, typename ) +-- Internal imports import Copilot.Compile.C99.Error ( impossible ) import Copilot.Compile.C99.Util ( exCpyName, streamAccessorName ) -import Copilot.Core ( Expr (..), Field (..), Op1 (..), Op2 (..), - Op3 (..), Type (..), Value (..), - accessorname, arrayelems, toValues, tylength, - typename ) - -import qualified Language.C99.Simple as C -- | Translates a Copilot Core expression into a C99 expression. transExpr :: Expr a -> State FunEnv C.Expr diff --git a/copilot-c99/src/Copilot/Compile/C99/Util.hs b/copilot-c99/src/Copilot/Compile/C99/Util.hs index 26e69c08b..a05ab031e 100644 --- a/copilot-c99/src/Copilot/Compile/C99/Util.hs +++ b/copilot-c99/src/Copilot/Compile/C99/Util.hs @@ -12,6 +12,7 @@ module Copilot.Compile.C99.Util ) where +-- External imports: Copilot import Copilot.Core (Id) -- | Turn a stream id into a suitable C variable name. From 53630cf7f86d3ce7bb3a6d4cf1b1358ffbcd0250 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 7 Sep 2023 07:09:55 -0700 Subject: [PATCH 0640/1222] copilot-c99: Organize exports and functions in module. Refs #453. This commit reorganizes functions in a module to better tell the story of what is being defined in that module. Two functions are renamed for consistency, and to better express that story. --- .../src/Copilot/Compile/C99/CodeGen.hs | 127 ++++++++++-------- .../src/Copilot/Compile/C99/Compile.hs | 26 ++-- 2 files changed, 86 insertions(+), 67 deletions(-) diff --git a/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs b/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs index 40a32076b..389a90057 100644 --- a/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs +++ b/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs @@ -2,16 +2,26 @@ -- | High-level translation of Copilot Core into C99. module Copilot.Compile.C99.CodeGen - ( genFun - , genFunArray - , mkAccessDecln - , mkBuffDecln - , mkExtCpyDecln + ( + -- * Externs + mkExtCpyDecln , mkExtDecln - , mkIndexDecln - , mkStep + + -- * Type declarations , mkStructDecln , mkStructForwDecln + + -- * Ring buffers + , mkBuffDecln + , mkIndexDecln + , mkAccessDecln + + -- * Stream generators + , mkGenFun + , mkGenFunArray + + -- * Monitor processing + , mkStep ) where @@ -34,34 +44,7 @@ import Copilot.Compile.C99.Util ( argNames, argTempNames, generatorName, guardName, indexName, streamAccessorName, streamName ) --- | Write a generator function for a stream. -genFun :: String -> Expr a -> Type a -> C.FunDef -genFun name expr ty = C.FunDef cTy name [] cVars [C.Return $ Just cExpr] - where - cTy = C.decay $ transType ty - (cExpr, cVars) = runState (transExpr expr) mempty - --- | Write a generator function for a stream that returns an array. -genFunArray :: String -> String -> Expr a -> Type a -> C.FunDef -genFunArray name nameArg expr ty@(Array _) = - C.FunDef funType name [ outputParam ] varDecls stmts - where - funType = C.TypeSpec C.Void - - -- The output value is an array - outputParam = C.Param cArrayType nameArg - cArrayType = transType ty - - -- Output value, and any variable declarations needed - (cExpr, varDecls) = runState (transExpr expr) mempty - - -- Copy expression to output argument - stmts = [ C.Expr $ memcpy (C.Ident nameArg) cExpr size ] - size = C.LitInt (fromIntegral $ tysize ty) - C..* C.SizeOfType (C.TypeName $ tyElemName ty) - -genFunArray name nameArg expr _ = - impossible "genFunArray" "copilot-c99" +-- * Externs -- | Make a extern declaration of a variable. mkExtDecln :: External -> C.Decln @@ -77,6 +60,26 @@ mkExtCpyDecln (External name cpyName ty) = decln decln = C.VarDecln (Just C.Static) cTy cpyName Nothing cTy = transType ty +-- * Type declarations + +-- | Write a struct declaration based on its definition. +mkStructDecln :: Struct a => Type a -> C.Decln +mkStructDecln (Struct x) = C.TypeDecln struct + where + struct = C.TypeSpec $ C.StructDecln (Just $ typename x) fields + fields = NonEmpty.fromList $ map mkField (toValues x) + + mkField :: Value a -> C.FieldDecln + mkField (Value ty field) = C.FieldDecln (transType ty) (fieldname field) + +-- | Write a forward struct declaration. +mkStructForwDecln :: Struct a => Type a -> C.Decln +mkStructForwDecln (Struct x) = C.TypeDecln struct + where + struct = C.TypeSpec $ C.Struct (typename x) + +-- * Ring buffers + -- | Make a C buffer variable and initialise it with the stream buffer. mkBuffDecln :: Id -> Type a -> [a] -> C.Decln mkBuffDecln sId ty xs = C.VarDecln (Just C.Static) cTy name initVals @@ -94,7 +97,7 @@ mkIndexDecln sId = C.VarDecln (Just C.Static) cTy name initVal cTy = C.TypeSpec $ C.TypedefName "size_t" initVal = Just $ C.InitExpr $ C.LitInt 0 --- | Define an accessor functions for the ring buffer associated with a stream +-- | Define an accessor functions for the ring buffer associated with a stream. mkAccessDecln :: Id -> Type a -> [a] -> C.FunDef mkAccessDecln sId ty xs = C.FunDef cTy name params [] [C.Return (Just expr)] where @@ -105,7 +108,40 @@ mkAccessDecln sId ty xs = C.FunDef cTy name params [] [C.Return (Just expr)] index = (C.Ident (indexName sId) C..+ C.Ident "x") C..% buffLength expr = C.Index (C.Ident (streamName sId)) index --- | Writes the step function, that updates all streams. +-- * Stream generators + +-- | Write a generator function for a stream. +mkGenFun :: String -> Expr a -> Type a -> C.FunDef +mkGenFun name expr ty = C.FunDef cTy name [] cVars [C.Return $ Just cExpr] + where + cTy = C.decay $ transType ty + (cExpr, cVars) = runState (transExpr expr) mempty + +-- | Write a generator function for a stream that returns an array. +mkGenFunArray :: String -> String -> Expr a -> Type a -> C.FunDef +mkGenFunArray name nameArg expr ty@(Array _) = + C.FunDef funType name [ outputParam ] varDecls stmts + where + funType = C.TypeSpec C.Void + + -- The output value is an array + outputParam = C.Param cArrayType nameArg + cArrayType = transType ty + + -- Output value, and any variable declarations needed + (cExpr, varDecls) = runState (transExpr expr) mempty + + -- Copy expression to output argument + stmts = [ C.Expr $ memcpy (C.Ident nameArg) cExpr size ] + size = C.LitInt (fromIntegral $ tysize ty) + C..* C.SizeOfType (C.TypeName $ tyElemName ty) + +mkGenFunArray name nameArg expr _ = + impossible "mkGenFunArray" "copilot-c99" + +-- * Monitor processing + +-- | Define the step function that updates all streams. mkStep :: CSettings -> [Stream] -> [Trigger] -> [External] -> C.FunDef mkStep cSettings streams triggers exts = C.FunDef void (cSettingsStepFunctionName cSettings) [] declns stmts @@ -253,23 +289,6 @@ mkStep cSettings streams triggers exts = args' = take (length args) (map argCall (argNames name)) argCall name = C.Funcall (C.Ident name) [] - --- | Write a struct declaration based on its definition. -mkStructDecln :: Struct a => Type a -> C.Decln -mkStructDecln (Struct x) = C.TypeDecln struct - where - struct = C.TypeSpec $ C.StructDecln (Just $ typename x) fields - fields = NonEmpty.fromList $ map mkField (toValues x) - - mkField :: Value a -> C.FieldDecln - mkField (Value ty field) = C.FieldDecln (transType ty) (fieldname field) - --- | Write a forward struct declaration. -mkStructForwDecln :: Struct a => Type a -> C.Decln -mkStructForwDecln (Struct x) = C.TypeDecln struct - where - struct = C.TypeSpec $ C.Struct (typename x) - -- * Auxiliary functions -- Write a call to the memcpy function. diff --git a/copilot-c99/src/Copilot/Compile/C99/Compile.hs b/copilot-c99/src/Copilot/Compile/C99/Compile.hs index 6e5f76721..7eff55ec7 100644 --- a/copilot-c99/src/Copilot/Compile/C99/Compile.hs +++ b/copilot-c99/src/Copilot/Compile/C99/Compile.hs @@ -23,10 +23,10 @@ import Copilot.Core ( Expr (..), Spec (..), Stream (..), Struct (..), Value (..) ) -- Internal imports -import Copilot.Compile.C99.CodeGen ( genFun, genFunArray, mkAccessDecln, - mkBuffDecln, mkExtCpyDecln, mkExtDecln, - mkIndexDecln, mkStep, mkStructDecln, - mkStructForwDecln ) +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.Settings ( CSettings, cSettingsOutputDirectory, cSettingsStepFunctionName, @@ -90,7 +90,7 @@ compileC cSettings spec = C.TransUnit declns funs declns = mkExts exts ++ mkGlobals streams - funs = genFuns streams triggers + funs = mkGenFuns streams triggers ++ [mkStep cSettings streams triggers exts] streams = specStreams spec @@ -109,27 +109,27 @@ compileC cSettings spec = C.TransUnit declns funs indexDecln (Stream sId _ _ _ ) = mkIndexDecln sId -- Make generator functions, including trigger arguments. - genFuns :: [Stream] -> [Trigger] -> [C.FunDef] - genFuns streams triggers = map accessDecln streams - ++ map streamGen streams - ++ concatMap triggerGen triggers + mkGenFuns :: [Stream] -> [Trigger] -> [C.FunDef] + mkGenFuns streams triggers = map accessDecln streams + ++ map streamGen streams + ++ concatMap triggerGen triggers where accessDecln :: Stream -> C.FunDef accessDecln (Stream sId buff _ ty) = mkAccessDecln sId ty buff streamGen :: Stream -> C.FunDef streamGen (Stream sId _ expr ty@(Array _)) = - genFunArray (generatorName sId) (generatorOutputArgName sId) expr ty - streamGen (Stream sId _ expr ty) = genFun (generatorName sId) expr ty + mkGenFunArray (generatorName sId) (generatorOutputArgName sId) expr ty + streamGen (Stream sId _ expr ty) = mkGenFun (generatorName sId) expr ty triggerGen :: Trigger -> [C.FunDef] triggerGen (Trigger name guard args) = guardDef : argDefs where - guardDef = genFun (guardName name) guard Bool + guardDef = mkGenFun (guardName name) guard Bool argDefs = zipWith argGen (argNames name) args argGen :: String -> UExpr -> C.FunDef - argGen argName (UExpr ty expr) = genFun argName expr ty + argGen argName (UExpr ty expr) = mkGenFun argName expr ty -- | Generate the .h file from a 'Spec'. compileH :: CSettings -> Spec -> C.TransUnit From 77605b87090565312ea3b4a0f8eab6f5691028f6 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 7 Sep 2023 06:51:37 -0700 Subject: [PATCH 0641/1222] copilot-c99: Use haddock notice to capture copyright. Refs #453. Move copyright notice to the haddock header, eliminating the code separators as well. --- copilot-c99/src/Copilot/Compile/C99/Error.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/copilot-c99/src/Copilot/Compile/C99/Error.hs b/copilot-c99/src/Copilot/Compile/C99/Error.hs index 8534b6dcc..f42c794de 100644 --- a/copilot-c99/src/Copilot/Compile/C99/Error.hs +++ b/copilot-c99/src/Copilot/Compile/C99/Error.hs @@ -1,9 +1,9 @@ --------------------------------------------------------------------------------- --- Copyright © 2011 National Institute of Aerospace / Galois, Inc. --------------------------------------------------------------------------------- {-# LANGUAGE Safe #-} --- | Custom functions to report error messages to users. +-- | +-- Copyright: (c) 2011 National Institute of Aerospace / Galois, Inc. +-- +-- Custom functions to report error messages to users. module Copilot.Compile.C99.Error ( impossible ) where From fd79efb6f097abd94ee7375e9febd9f3b05bb818 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 7 Sep 2023 06:54:08 -0700 Subject: [PATCH 0642/1222] copilot-c99: Eta-reduce. Refs #453. This commit removes final arguments that are used in the final position in the expresssion that defines the result of a function. --- copilot-c99/src/Copilot/Compile/C99/Compile.hs | 4 ++-- copilot-c99/src/Copilot/Compile/C99/Translate.hs | 6 ++++-- 2 files changed, 6 insertions(+), 4 deletions(-) diff --git a/copilot-c99/src/Copilot/Compile/C99/Compile.hs b/copilot-c99/src/Copilot/Compile/C99/Compile.hs index 7eff55ec7..d3d41277c 100644 --- a/copilot-c99/src/Copilot/Compile/C99/Compile.hs +++ b/copilot-c99/src/Copilot/Compile/C99/Compile.hs @@ -99,7 +99,7 @@ compileC cSettings spec = C.TransUnit declns funs -- Make declarations for copies of external variables. mkExts :: [External] -> [C.Decln] - mkExts exts = map mkExtCpyDecln exts + mkExts = map mkExtCpyDecln -- Make buffer and index declarations for streams. mkGlobals :: [Stream] -> [C.Decln] @@ -159,7 +159,7 @@ compileH cSettings spec = C.TransUnit declns [] mkExts = map mkExtDecln extFunDeclns :: [Trigger] -> [C.Decln] - extFunDeclns triggers = map extFunDecln triggers + extFunDeclns = map extFunDecln where extFunDecln :: Trigger -> C.Decln extFunDecln (Trigger name _ args) = C.FunDecln Nothing cTy name params diff --git a/copilot-c99/src/Copilot/Compile/C99/Translate.hs b/copilot-c99/src/Copilot/Compile/C99/Translate.hs index ba78f314d..788f72eef 100644 --- a/copilot-c99/src/Copilot/Compile/C99/Translate.hs +++ b/copilot-c99/src/Copilot/Compile/C99/Translate.hs @@ -404,5 +404,7 @@ typeIsFloating _ = False type FunEnv = [C.Decln] -- | Define a C expression that calls a function with arguments. -funCall :: C.Ident -> [C.Expr] -> C.Expr -funCall name args = C.Funcall (C.Ident name) args +funCall :: C.Ident -- ^ Function name + -> [C.Expr] -- ^ Arguments + -> C.Expr +funCall name = C.Funcall (C.Ident name) From de17786952a24473a00abd5c500971112fab88cc Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 7 Sep 2023 06:56:50 -0700 Subject: [PATCH 0643/1222] copilot-c99: Break lines at 80 characters. Refs #453. This commit breaks long lines in the module Copilot.Compile.C99.Compile to fit in under 80 characters, as per our style guide. --- copilot-c99/src/Copilot/Compile/C99/Compile.hs | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/copilot-c99/src/Copilot/Compile/C99/Compile.hs b/copilot-c99/src/Copilot/Compile/C99/Compile.hs index d3d41277c..67a94dcbc 100644 --- a/copilot-c99/src/Copilot/Compile/C99/Compile.hs +++ b/copilot-c99/src/Copilot/Compile/C99/Compile.hs @@ -224,14 +224,16 @@ exprTypes e = case e of ExternVar ty _ _ -> typeTypes ty Op1 _ e1 -> exprTypes e1 Op2 _ e1 e2 -> exprTypes e1 `union` exprTypes e2 - Op3 _ e1 e2 e3 -> exprTypes e1 `union` exprTypes e2 `union` exprTypes e3 + Op3 _ e1 e2 e3 -> exprTypes e1 `union` exprTypes e2 + `union` exprTypes e3 Label ty _ _ -> typeTypes ty -- | List all types of a type, returns items uniquely. typeTypes :: Typeable a => Type a -> [UType] typeTypes ty = case ty of Array ty' -> typeTypes ty' `union` [UType ty] - Struct x -> concatMap (\(Value ty' _) -> typeTypes ty') (toValues x) `union` [UType ty] + Struct x -> concatMap (\(Value ty' _) -> typeTypes ty') (toValues x) + `union` [UType ty] _ -> [UType ty] -- | Collect all expression of a list of streams and triggers and wrap them From ddc599c70a8e18b2214c16965d4b7f6cd4721fb6 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 7 Sep 2023 08:48:55 -0700 Subject: [PATCH 0644/1222] copilot-c99: Clarify implementation. Refs #453. This commit adds types and reorders statements in a definition to clarify the implementation. --- .../src/Copilot/Compile/C99/CodeGen.hs | 81 ++++++++++++------- 1 file changed, 50 insertions(+), 31 deletions(-) diff --git a/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs b/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs index 389a90057..04c49921c 100644 --- a/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs +++ b/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs @@ -243,13 +243,18 @@ mkStep cSettings streams triggers exts = -- will not affect the internals of the monitoring code. mkTriggerCheck :: Trigger -> ([C.Decln], C.Stmt) mkTriggerCheck (Trigger name guard args) = - (aTmpDeclns, ifStmt) + (aTmpDeclns, triggerCheckStmt) where - aTmpDeclns = zipWith (\arg tmpVar -> - C.VarDecln Nothing (tempType arg) tmpVar Nothing) - args - aTempNames + aTmpDeclns :: [C.Decln] + aTmpDeclns = zipWith declare args aTempNames where + declare :: UExpr -> C.Ident -> C.Decln + declare arg tmpVar = + C.VarDecln Nothing (tempType arg) tmpVar Nothing + + -- Type of the temporary variable used to store values of the type + -- of a given expression. + tempType :: UExpr -> C.Type tempType (UExpr { uExprType = ty }) = case ty of -- If a temporary variable is being used to store an array, @@ -261,33 +266,47 @@ mkStep cSettings streams triggers exts = Array ty' -> C.Ptr $ transType ty' _ -> transType ty - aTempNames = take (length args) (argTempNames name) - - ifStmt = C.If guard' fireTrigger - - guard' = C.Funcall (C.Ident $ guardName name) [] - - -- 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. - fireTrigger = map C.Expr argAssigns - ++ [C.Expr $ C.Funcall (C.Ident name) - (zipWith passArg aTempNames args)] + triggerCheckStmt :: C.Stmt + triggerCheckStmt = C.If guard' fireTrigger where - passArg aTempName (UExpr { uExprType = ty }) = - case ty of - -- Special case for Struct to pass reference to temporary - -- struct variable to handler. (See the comments for - -- mktriggercheck for details.) - Struct _ -> C.UnaryOp C.Ref $ C.Ident aTempName - _ -> C.Ident aTempName - - argAssigns = zipWith (\aTempName arg -> - C.AssignOp C.Assign (C.Ident aTempName) arg) - aTempNames - args' - args' = take (length args) (map argCall (argNames name)) - argCall name = C.Funcall (C.Ident name) [] + guard' = C.Funcall (C.Ident $ guardName name) [] + + -- 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. + fireTrigger = map C.Expr argAssigns + ++ [C.Expr $ + C.Funcall (C.Ident name) + (zipWith passArg aTempNames args)] + where + -- List of assignments of values of temporary variables. + argAssigns :: [C.Expr] + argAssigns = zipWith assign aTempNames args' + + assign :: C.Ident -> C.Expr -> C.Expr + assign aTempName = C.AssignOp C.Assign (C.Ident aTempName) + + args' = take (length args) (map argCall (argNames name)) + argCall name = C.Funcall (C.Ident name) [] + + -- Build an expression to pass a temporary variable as argument + -- to a trigger handler. + -- + -- We need to pass a reference to the variable in some cases, + -- 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 }) = + case ty of + -- Special case for Struct to pass reference to temporary + -- struct variable to handler. (See the comments for + -- mktriggercheck for details.) + Struct _ -> C.UnaryOp C.Ref $ C.Ident aTempName + _ -> C.Ident aTempName + + aTempNames :: [String] + aTempNames = take (length args) (argTempNames name) -- * Auxiliary functions From 740efe4a50e976d351115329d509b912462b8cdf Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 7 Sep 2023 09:39:41 -0700 Subject: [PATCH 0645/1222] copilot-c99: Split module. Refs #453. This commit splits the Translate module into two submodules: one to deal with Types, and another to deal with Expressions. This split helps architecture the library in a cleaner way. --- copilot-c99/copilot-c99.cabal | 3 +- .../src/Copilot/Compile/C99/CodeGen.hs | 15 +++--- .../src/Copilot/Compile/C99/Compile.hs | 22 ++++----- .../Compile/C99/{Translate.hs => Expr.hs} | 41 ++-------------- copilot-c99/src/Copilot/Compile/C99/Type.hs | 48 +++++++++++++++++++ 5 files changed, 73 insertions(+), 56 deletions(-) rename copilot-c99/src/Copilot/Compile/C99/{Translate.hs => Expr.hs} (90%) create mode 100644 copilot-c99/src/Copilot/Compile/C99/Type.hs diff --git a/copilot-c99/copilot-c99.cabal b/copilot-c99/copilot-c99.cabal index b3c6f2f4a..4e2921adf 100644 --- a/copilot-c99/copilot-c99.cabal +++ b/copilot-c99/copilot-c99.cabal @@ -51,7 +51,8 @@ library exposed-modules : Copilot.Compile.C99 - other-modules : Copilot.Compile.C99.Translate + other-modules : Copilot.Compile.C99.Expr + , Copilot.Compile.C99.Type , Copilot.Compile.C99.Error , Copilot.Compile.C99.Util , Copilot.Compile.C99.CodeGen diff --git a/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs b/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs index 04c49921c..bda95a85c 100644 --- a/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs +++ b/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs @@ -36,13 +36,14 @@ import Copilot.Core ( Expr (..), Id, Stream (..), Struct (..), Trigger (..), Type (..), UExpr (..), Value (..), fieldname, tysize ) -- Internal imports -import Copilot.Compile.C99.Error ( impossible ) -import Copilot.Compile.C99.External ( External (..) ) -import Copilot.Compile.C99.Settings ( CSettings, cSettingsStepFunctionName ) -import Copilot.Compile.C99.Translate ( constArray, transExpr, transType ) -import Copilot.Compile.C99.Util ( argNames, argTempNames, generatorName, - guardName, indexName, streamAccessorName, - streamName ) +import Copilot.Compile.C99.Error ( impossible ) +import Copilot.Compile.C99.Expr ( constArray, transExpr ) +import Copilot.Compile.C99.External ( External (..) ) +import Copilot.Compile.C99.Settings ( CSettings, cSettingsStepFunctionName ) +import Copilot.Compile.C99.Type ( transType ) +import Copilot.Compile.C99.Util ( argNames, argTempNames, generatorName, + guardName, indexName, streamAccessorName, + streamName ) -- * Externs diff --git a/copilot-c99/src/Copilot/Compile/C99/Compile.hs b/copilot-c99/src/Copilot/Compile/C99/Compile.hs index 67a94dcbc..d8fdbc706 100644 --- a/copilot-c99/src/Copilot/Compile/C99/Compile.hs +++ b/copilot-c99/src/Copilot/Compile/C99/Compile.hs @@ -23,17 +23,17 @@ import Copilot.Core ( Expr (..), Spec (..), Stream (..), Struct (..), 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.Settings ( CSettings, cSettingsOutputDirectory, - cSettingsStepFunctionName, - mkDefaultCSettings ) -import Copilot.Compile.C99.Translate ( transType ) -import Copilot.Compile.C99.Util ( argNames, generatorName, - generatorOutputArgName, guardName ) +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.Settings ( CSettings, cSettingsOutputDirectory, + cSettingsStepFunctionName, + mkDefaultCSettings ) +import Copilot.Compile.C99.Type ( transType ) +import Copilot.Compile.C99.Util ( argNames, generatorName, + generatorOutputArgName, guardName ) -- | Compile a specification to a .h and a .c file. -- diff --git a/copilot-c99/src/Copilot/Compile/C99/Translate.hs b/copilot-c99/src/Copilot/Compile/C99/Expr.hs similarity index 90% rename from copilot-c99/src/Copilot/Compile/C99/Translate.hs rename to copilot-c99/src/Copilot/Compile/C99/Expr.hs index 788f72eef..e5a689a59 100644 --- a/copilot-c99/src/Copilot/Compile/C99/Translate.hs +++ b/copilot-c99/src/Copilot/Compile/C99/Expr.hs @@ -1,9 +1,8 @@ {-# LANGUAGE GADTs #-} -- | Translate Copilot Core expressions and operators to C99. -module Copilot.Compile.C99.Translate +module Copilot.Compile.C99.Expr ( transExpr - , transType , constArray ) where @@ -15,11 +14,12 @@ import qualified Language.C99.Simple as C -- Internal imports: Copilot import Copilot.Core ( Expr (..), Field (..), Op1 (..), Op2 (..), Op3 (..), - Type (..), Value (..), accessorname, arrayelems, toValues, - tylength, typename ) + Type (..), Value (..), accessorname, arrayelems, + toValues ) -- Internal imports import Copilot.Compile.C99.Error ( impossible ) +import Copilot.Compile.C99.Type ( transLocalVarDeclType, transTypeName ) import Copilot.Compile.C99.Util ( exCpyName, streamAccessorName ) -- | Translates a Copilot Core expression into a C99 expression. @@ -294,39 +294,6 @@ constArray ty = explicitTy :: Type a -> C.Expr -> C.Expr explicitTy ty = C.Cast (transTypeName ty) --- | Translate a Copilot type to a C99 type. -transType :: Type a -> C.Type -transType ty = case ty of - Bool -> C.TypeSpec $ C.TypedefName "bool" - Int8 -> C.TypeSpec $ C.TypedefName "int8_t" - Int16 -> C.TypeSpec $ C.TypedefName "int16_t" - Int32 -> C.TypeSpec $ C.TypedefName "int32_t" - Int64 -> C.TypeSpec $ C.TypedefName "int64_t" - Word8 -> C.TypeSpec $ C.TypedefName "uint8_t" - Word16 -> C.TypeSpec $ C.TypedefName "uint16_t" - Word32 -> C.TypeSpec $ C.TypedefName "uint32_t" - Word64 -> C.TypeSpec $ C.TypedefName "uint64_t" - Float -> C.TypeSpec C.Float - Double -> C.TypeSpec C.Double - Array ty' -> C.Array (transType ty') length - where - length = Just $ C.LitInt $ fromIntegral $ tylength ty - Struct s -> C.TypeSpec $ C.Struct (typename s) - --- | Translate a Copilot type to a valid (local) variable declaration C99 type. --- --- If the type denotes an array, translate it to a pointer to whatever the --- array holds. This special case is needed when the type is used for a local --- variable declaration. We treat global variables differently (we generate --- list initializers). -transLocalVarDeclType :: Type a -> C.Type -transLocalVarDeclType (Array ty') = C.Ptr $ transType ty' -transLocalVarDeclType ty = transType ty - --- | Translate a Copilot type intro a C typename -transTypeName :: Type a -> C.TypeName -transTypeName ty = C.TypeName $ transType ty - -- Translate a literal number of type @ty@ into a C99 literal. -- -- PRE: The type of PRE is numeric (integer or floating-point), that diff --git a/copilot-c99/src/Copilot/Compile/C99/Type.hs b/copilot-c99/src/Copilot/Compile/C99/Type.hs new file mode 100644 index 000000000..764943703 --- /dev/null +++ b/copilot-c99/src/Copilot/Compile/C99/Type.hs @@ -0,0 +1,48 @@ +{-# LANGUAGE GADTs #-} + +-- | Translate Copilot Core expressions and operators to C99. +module Copilot.Compile.C99.Type + ( transType + , transLocalVarDeclType + , transTypeName + ) + where + +-- External imports +import qualified Language.C99.Simple as C + +-- Internal imports: Copilot +import Copilot.Core ( Type (..), tylength, typename ) + +-- | Translate a Copilot type to a C99 type. +transType :: Type a -> C.Type +transType ty = case ty of + Bool -> C.TypeSpec $ C.TypedefName "bool" + Int8 -> C.TypeSpec $ C.TypedefName "int8_t" + Int16 -> C.TypeSpec $ C.TypedefName "int16_t" + Int32 -> C.TypeSpec $ C.TypedefName "int32_t" + Int64 -> C.TypeSpec $ C.TypedefName "int64_t" + Word8 -> C.TypeSpec $ C.TypedefName "uint8_t" + Word16 -> C.TypeSpec $ C.TypedefName "uint16_t" + Word32 -> C.TypeSpec $ C.TypedefName "uint32_t" + Word64 -> C.TypeSpec $ C.TypedefName "uint64_t" + Float -> C.TypeSpec C.Float + Double -> C.TypeSpec C.Double + Array ty' -> C.Array (transType ty') length + where + length = Just $ C.LitInt $ fromIntegral $ tylength ty + Struct s -> C.TypeSpec $ C.Struct (typename s) + +-- | Translate a Copilot type to a valid (local) variable declaration C99 type. +-- +-- If the type denotes an array, translate it to a pointer to whatever the +-- array holds. This special case is needed when the type is used for a local +-- variable declaration. We treat global variables differently (we generate +-- list initializers). +transLocalVarDeclType :: Type a -> C.Type +transLocalVarDeclType (Array ty') = C.Ptr $ transType ty' +transLocalVarDeclType ty = transType ty + +-- | Translate a Copilot type intro a C typename +transTypeName :: Type a -> C.TypeName +transTypeName ty = C.TypeName $ transType ty From fd8fa0bfa516f0b52fd81c0c4a63973dc8a54b29 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 7 Sep 2023 10:10:57 -0700 Subject: [PATCH 0646/1222] copilot-c99: Rename module. Refs #453. This commit renames a module to better match the current status and direction of the Compiler. --- copilot-c99/copilot-c99.cabal | 2 +- copilot-c99/src/Copilot/Compile/C99/CodeGen.hs | 6 +++--- copilot-c99/src/Copilot/Compile/C99/Compile.hs | 4 ++-- copilot-c99/src/Copilot/Compile/C99/Expr.hs | 2 +- copilot-c99/src/Copilot/Compile/C99/External.hs | 2 +- copilot-c99/src/Copilot/Compile/C99/{Util.hs => Name.hs} | 4 ++-- 6 files changed, 10 insertions(+), 10 deletions(-) rename copilot-c99/src/Copilot/Compile/C99/{Util.hs => Name.hs} (95%) diff --git a/copilot-c99/copilot-c99.cabal b/copilot-c99/copilot-c99.cabal index 4e2921adf..7886b8ee8 100644 --- a/copilot-c99/copilot-c99.cabal +++ b/copilot-c99/copilot-c99.cabal @@ -54,7 +54,7 @@ library other-modules : Copilot.Compile.C99.Expr , Copilot.Compile.C99.Type , Copilot.Compile.C99.Error - , Copilot.Compile.C99.Util + , Copilot.Compile.C99.Name , Copilot.Compile.C99.CodeGen , Copilot.Compile.C99.External , Copilot.Compile.C99.Compile diff --git a/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs b/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs index bda95a85c..37d2ba8c8 100644 --- a/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs +++ b/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs @@ -39,11 +39,11 @@ import Copilot.Core ( Expr (..), Id, Stream (..), Struct (..), Trigger (..), import Copilot.Compile.C99.Error ( impossible ) import Copilot.Compile.C99.Expr ( constArray, transExpr ) import Copilot.Compile.C99.External ( External (..) ) -import Copilot.Compile.C99.Settings ( CSettings, cSettingsStepFunctionName ) -import Copilot.Compile.C99.Type ( transType ) -import Copilot.Compile.C99.Util ( argNames, argTempNames, generatorName, +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 ) -- * Externs diff --git a/copilot-c99/src/Copilot/Compile/C99/Compile.hs b/copilot-c99/src/Copilot/Compile/C99/Compile.hs index d8fdbc706..a55ae736d 100644 --- a/copilot-c99/src/Copilot/Compile/C99/Compile.hs +++ b/copilot-c99/src/Copilot/Compile/C99/Compile.hs @@ -28,12 +28,12 @@ import Copilot.Compile.C99.CodeGen ( mkAccessDecln, mkBuffDecln, mkExtCpyDecln, 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.Util ( argNames, generatorName, - generatorOutputArgName, guardName ) -- | Compile a specification to a .h and a .c file. -- diff --git a/copilot-c99/src/Copilot/Compile/C99/Expr.hs b/copilot-c99/src/Copilot/Compile/C99/Expr.hs index e5a689a59..6d7597828 100644 --- a/copilot-c99/src/Copilot/Compile/C99/Expr.hs +++ b/copilot-c99/src/Copilot/Compile/C99/Expr.hs @@ -19,8 +19,8 @@ import Copilot.Core ( Expr (..), Field (..), Op1 (..), Op2 (..), Op3 (..), -- Internal imports import Copilot.Compile.C99.Error ( impossible ) +import Copilot.Compile.C99.Name ( exCpyName, streamAccessorName ) import Copilot.Compile.C99.Type ( transLocalVarDeclType, transTypeName ) -import Copilot.Compile.C99.Util ( exCpyName, streamAccessorName ) -- | Translates a Copilot Core expression into a C99 expression. transExpr :: Expr a -> State FunEnv C.Expr diff --git a/copilot-c99/src/Copilot/Compile/C99/External.hs b/copilot-c99/src/Copilot/Compile/C99/External.hs index 4d24ca504..8d8080451 100644 --- a/copilot-c99/src/Copilot/Compile/C99/External.hs +++ b/copilot-c99/src/Copilot/Compile/C99/External.hs @@ -15,7 +15,7 @@ import Data.List (unionBy) import Copilot.Core ( Expr (..), Stream (..), Trigger (..), Type, UExpr (..) ) -- Internal imports -import Copilot.Compile.C99.Util ( exCpyName ) +import Copilot.Compile.C99.Name ( exCpyName ) -- | Representation of external variables. data External = forall a. External diff --git a/copilot-c99/src/Copilot/Compile/C99/Util.hs b/copilot-c99/src/Copilot/Compile/C99/Name.hs similarity index 95% rename from copilot-c99/src/Copilot/Compile/C99/Util.hs rename to copilot-c99/src/Copilot/Compile/C99/Name.hs index a05ab031e..bebaf6bea 100644 --- a/copilot-c99/src/Copilot/Compile/C99/Util.hs +++ b/copilot-c99/src/Copilot/Compile/C99/Name.hs @@ -1,5 +1,5 @@ --- | Auxiliary helper functions to generate C99 code. -module Copilot.Compile.C99.Util +-- | Naming of variables and functions in C. +module Copilot.Compile.C99.Name ( argNames , argTempNames , exCpyName From 225513570cc996ff467b50e332055266a3320cda Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 7 Sep 2023 09:49:37 -0700 Subject: [PATCH 0647/1222] copilot-c99: Prevent name shadowing. Refs #453. This commit renames a variable to prevent shadowing of a definition with the same name. --- copilot-c99/src/Copilot/Compile/C99/Type.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/copilot-c99/src/Copilot/Compile/C99/Type.hs b/copilot-c99/src/Copilot/Compile/C99/Type.hs index 764943703..f94dbac65 100644 --- a/copilot-c99/src/Copilot/Compile/C99/Type.hs +++ b/copilot-c99/src/Copilot/Compile/C99/Type.hs @@ -28,9 +28,9 @@ transType ty = case ty of Word64 -> C.TypeSpec $ C.TypedefName "uint64_t" Float -> C.TypeSpec C.Float Double -> C.TypeSpec C.Double - Array ty' -> C.Array (transType ty') length + Array ty' -> C.Array (transType ty') len where - length = Just $ C.LitInt $ fromIntegral $ tylength ty + len = Just $ C.LitInt $ fromIntegral $ tylength ty Struct s -> C.TypeSpec $ C.Struct (typename s) -- | Translate a Copilot type to a valid (local) variable declaration C99 type. From ad243bba77e75a3dc3fd66ed54b8e0ccbb245ca8 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 7 Sep 2023 09:50:14 -0700 Subject: [PATCH 0648/1222] copilot-c99: Prevent name shadowing. Refs #453. This commit renames a variable to prevent shadowing of a definition with the same name. --- copilot-c99/src/Copilot/Compile/C99/Expr.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/copilot-c99/src/Copilot/Compile/C99/Expr.hs b/copilot-c99/src/Copilot/Compile/C99/Expr.hs index 6d7597828..faa522b86 100644 --- a/copilot-c99/src/Copilot/Compile/C99/Expr.hs +++ b/copilot-c99/src/Copilot/Compile/C99/Expr.hs @@ -28,11 +28,11 @@ transExpr (Const ty x) = return $ constTy ty x transExpr (Local ty1 _ name e1 e2) = do e1' <- transExpr e1 - let cTy1 = transLocalVarDeclType ty1 - init = Just $ C.InitExpr e1' + let cTy1 = transLocalVarDeclType ty1 + initExpr = Just $ C.InitExpr e1' -- Add new decl to the tail of the fun env - modify (++ [C.VarDecln Nothing cTy1 name init]) + modify (++ [C.VarDecln Nothing cTy1 name initExpr]) transExpr e2 From 150c8db1f20af96527d1026031e2300569ff45a3 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 7 Sep 2023 09:54:07 -0700 Subject: [PATCH 0649/1222] copilot-c99: Prevent name shadowing. Refs #453. This commit renames a variable to prevent shadowing of a definition with the same name. --- copilot-c99/src/Copilot/Compile/C99/CodeGen.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs b/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs index 37d2ba8c8..e5bc4e3a1 100644 --- a/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs +++ b/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs @@ -288,8 +288,8 @@ mkStep cSettings streams triggers exts = assign :: C.Ident -> C.Expr -> C.Expr assign aTempName = C.AssignOp C.Assign (C.Ident aTempName) - args' = take (length args) (map argCall (argNames name)) - argCall name = C.Funcall (C.Ident name) [] + args' = take (length args) (map argCall (argNames name)) + argCall name' = C.Funcall (C.Ident name') [] -- Build an expression to pass a temporary variable as argument -- to a trigger handler. From d81e47489ea59efb8b72735d207d15efbfde93a0 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 7 Sep 2023 09:58:40 -0700 Subject: [PATCH 0650/1222] copilot-c99: Prevent name shadowing. Refs #453. This commit renames variables and functions to prevent shadowing of definitions with the same name. --- .../src/Copilot/Compile/C99/Compile.hs | 19 ++++++++++--------- 1 file changed, 10 insertions(+), 9 deletions(-) diff --git a/copilot-c99/src/Copilot/Compile/C99/Compile.hs b/copilot-c99/src/Copilot/Compile/C99/Compile.hs index a55ae736d..2ba472791 100644 --- a/copilot-c99/src/Copilot/Compile/C99/Compile.hs +++ b/copilot-c99/src/Copilot/Compile/C99/Compile.hs @@ -103,16 +103,17 @@ compileC cSettings spec = C.TransUnit declns funs -- Make buffer and index declarations for streams. mkGlobals :: [Stream] -> [C.Decln] - mkGlobals streams = map buffDecln streams ++ map indexDecln streams + mkGlobals streamList = map buffDecln streamList + ++ map indexDecln streamList where buffDecln (Stream sId buff _ ty) = mkBuffDecln sId ty buff indexDecln (Stream sId _ _ _ ) = mkIndexDecln sId -- Make generator functions, including trigger arguments. mkGenFuns :: [Stream] -> [Trigger] -> [C.FunDef] - mkGenFuns streams triggers = map accessDecln streams - ++ map streamGen streams - ++ concatMap triggerGen triggers + mkGenFuns streamList triggerList = map accessDecln streamList + ++ map streamGen streamList + ++ concatMap triggerGen triggerList where accessDecln :: Stream -> C.FunDef accessDecln (Stream sId buff _ ty) = mkAccessDecln sId ty buff @@ -167,7 +168,7 @@ compileH cSettings spec = C.TransUnit declns [] cTy = C.TypeSpec C.Void params = zipWith mkParam (argNames name) args - mkParam name (UExpr ty _) = C.Param (mkParamTy ty) name + mkParam paramName (UExpr ty _) = C.Param (mkParamTy ty) paramName -- Special case for Struct, to pass struct arguments by reference. -- Arrays are also passed by reference, but using C's array type @@ -239,8 +240,8 @@ typeTypes ty = case ty of -- | Collect all expression of a list of streams and triggers and wrap them -- into an UEXpr. gatherExprs :: [Stream] -> [Trigger] -> [UExpr] -gatherExprs streams triggers = map streamExpr streams - ++ concatMap triggerExpr triggers +gatherExprs streams triggers = map streamUExpr streams + ++ concatMap triggerUExpr triggers where - streamExpr (Stream _ _ expr ty) = UExpr ty expr - triggerExpr (Trigger _ guard args) = UExpr Bool guard : args + streamUExpr (Stream _ _ expr ty) = UExpr ty expr + triggerUExpr (Trigger _ guard args) = UExpr Bool guard : args From 21ea489136ce6d1b54e2f65668535a4e9dd3c379 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 7 Sep 2023 09:51:19 -0700 Subject: [PATCH 0651/1222] copilot-c99: Use wildcards for variables not used. Refs #453. Prevent warning by marking unused variable with a wildcard (underscore) character. --- copilot-c99/src/Copilot/Compile/C99/CodeGen.hs | 8 ++++---- copilot-c99/src/Copilot/Compile/C99/Compile.hs | 2 +- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs b/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs index e5bc4e3a1..b9c3feb84 100644 --- a/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs +++ b/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs @@ -56,7 +56,7 @@ mkExtDecln (External name _ ty) = decln -- | Make a declaration for a copy of an external variable. mkExtCpyDecln :: External -> C.Decln -mkExtCpyDecln (External name cpyName ty) = decln +mkExtCpyDecln (External _name cpyName ty) = decln where decln = C.VarDecln (Just C.Static) cTy cpyName Nothing cTy = transType ty @@ -137,7 +137,7 @@ mkGenFunArray name nameArg expr ty@(Array _) = size = C.LitInt (fromIntegral $ tysize ty) C..* C.SizeOfType (C.TypeName $ tyElemName ty) -mkGenFunArray name nameArg expr _ = +mkGenFunArray _name _nameArg _expr _ty = impossible "mkGenFunArray" "copilot-c99" -- * Monitor processing @@ -165,7 +165,7 @@ mkStep cSettings streams triggers exts = -- Write code to update global stream buffers and index. mkUpdateGlobals :: Stream -> (C.Decln, C.Stmt, C.Stmt, C.Stmt) - mkUpdateGlobals (Stream sId buff expr ty) = + mkUpdateGlobals (Stream sId buff _expr ty) = (tmpDecln, tmpAssign, bufferUpdate, indexUpdate) where tmpDecln = C.VarDecln Nothing cTy tmpVar Nothing @@ -243,7 +243,7 @@ mkStep cSettings streams triggers exts = -- 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 (Trigger name _guard args) = (aTmpDeclns, triggerCheckStmt) where aTmpDeclns :: [C.Decln] diff --git a/copilot-c99/src/Copilot/Compile/C99/Compile.hs b/copilot-c99/src/Copilot/Compile/C99/Compile.hs index 2ba472791..bf7c05784 100644 --- a/copilot-c99/src/Copilot/Compile/C99/Compile.hs +++ b/copilot-c99/src/Copilot/Compile/C99/Compile.hs @@ -150,7 +150,7 @@ compileH cSettings spec = C.TransUnit declns [] mkStructForwDeclns es = mapMaybe mkDecln uTypes where mkDecln (UType ty) = case ty of - Struct x -> Just $ mkStructForwDecln ty + Struct _ -> Just $ mkStructForwDecln ty _ -> Nothing uTypes = nub $ concatMap (\(UExpr _ e) -> exprTypes e) es From 22cfd558bcf749aecee34ea7a0da17a39eb8a0b4 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 7 Sep 2023 22:15:11 -0700 Subject: [PATCH 0652/1222] copilot-c99: Document changes in CHANGELOG. Refs #453. --- copilot-c99/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-c99/CHANGELOG b/copilot-c99/CHANGELOG index cb3fe2d8c..1c944c351 100644 --- a/copilot-c99/CHANGELOG +++ b/copilot-c99/CHANGELOG @@ -1,3 +1,6 @@ +2023-09-07 + * Clean code. (#453) + 2023-07-07 * Version bump (3.16). (#448) * Introduce testing infrastructure. (#413) From 3006a798ee8619aa6aea4f2928768d03540ae22f Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 7 Sep 2023 23:00:50 -0700 Subject: [PATCH 0653/1222] Bump versions and constraints. Refs #455. --- copilot-c99/copilot-c99.cabal | 8 ++++---- copilot-core/copilot-core.cabal | 2 +- copilot-interpreter/copilot-interpreter.cabal | 4 ++-- copilot-language/copilot-language.cabal | 8 ++++---- copilot-libraries/copilot-libraries.cabal | 4 ++-- copilot-prettyprinter/copilot-prettyprinter.cabal | 4 ++-- copilot-theorem/copilot-theorem.cabal | 6 +++--- copilot/copilot.cabal | 14 +++++++------- 8 files changed, 25 insertions(+), 25 deletions(-) diff --git a/copilot-c99/copilot-c99.cabal b/copilot-c99/copilot-c99.cabal index 7886b8ee8..d0e5ff904 100644 --- a/copilot-c99/copilot-c99.cabal +++ b/copilot-c99/copilot-c99.cabal @@ -1,6 +1,6 @@ cabal-version : >= 1.10 name : copilot-c99 -version : 3.16 +version : 3.16.1 synopsis : A compiler for Copilot targeting C99. description : This package is a back-end from Copilot to C. @@ -45,9 +45,9 @@ library , mtl >= 2.2 && < 2.4 , pretty >= 1.1 && < 1.2 - , copilot-core >= 3.16 && < 3.17 - , language-c99 >= 0.2.0 && < 0.3 - , language-c99-simple >= 0.2.2 && < 0.3 + , copilot-core >= 3.16.1 && < 3.17 + , language-c99 >= 0.2.0 && < 0.3 + , language-c99-simple >= 0.2.2 && < 0.3 exposed-modules : Copilot.Compile.C99 diff --git a/copilot-core/copilot-core.cabal b/copilot-core/copilot-core.cabal index be40f9319..e50e0e488 100644 --- a/copilot-core/copilot-core.cabal +++ b/copilot-core/copilot-core.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-core -version: 3.16 +version: 3.16.1 synopsis: An intermediate representation for Copilot. description: Intermediate representation for Copilot. diff --git a/copilot-interpreter/copilot-interpreter.cabal b/copilot-interpreter/copilot-interpreter.cabal index f5f36fcf3..7479470b5 100644 --- a/copilot-interpreter/copilot-interpreter.cabal +++ b/copilot-interpreter/copilot-interpreter.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-interpreter -version: 3.16 +version: 3.16.1 synopsis: Interpreter for Copilot. description: Interpreter for Copilot. @@ -44,7 +44,7 @@ library base >= 4.9 && < 5, pretty >= 1.0 && < 1.2, - copilot-core >= 3.16 && < 3.17 + copilot-core >= 3.16.1 && < 3.17 exposed-modules: diff --git a/copilot-language/copilot-language.cabal b/copilot-language/copilot-language.cabal index 4aa502a7b..61c45393f 100644 --- a/copilot-language/copilot-language.cabal +++ b/copilot-language/copilot-language.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-language -version: 3.16 +version: 3.16.1 synopsis: A Haskell-embedded DSL for monitoring hard real-time distributed systems. description: @@ -42,9 +42,9 @@ library , data-reify >= 0.6 && < 0.7 , mtl >= 2.0 && < 3 - , copilot-core >= 3.16 && < 3.17 - , copilot-interpreter >= 3.16 && < 3.17 - , copilot-theorem >= 3.16 && < 3.17 + , copilot-core >= 3.16.1 && < 3.17 + , copilot-interpreter >= 3.16.1 && < 3.17 + , copilot-theorem >= 3.16.1 && < 3.17 exposed-modules: Copilot.Language , Copilot.Language.Operators.BitWise diff --git a/copilot-libraries/copilot-libraries.cabal b/copilot-libraries/copilot-libraries.cabal index 781285708..9d4a4d1bb 100644 --- a/copilot-libraries/copilot-libraries.cabal +++ b/copilot-libraries/copilot-libraries.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-libraries -version: 3.16 +version: 3.16.1 synopsis: Libraries for the Copilot language. description: Libraries for the Copilot language. @@ -41,7 +41,7 @@ library , containers >= 0.4 && < 0.7 , mtl >= 2.0 && < 2.4 , parsec >= 2.0 && < 3.2 - , copilot-language >= 3.16 && < 3.17 + , copilot-language >= 3.16.1 && < 3.17 exposed-modules: Copilot.Library.Libraries diff --git a/copilot-prettyprinter/copilot-prettyprinter.cabal b/copilot-prettyprinter/copilot-prettyprinter.cabal index 41838ac1c..7de26fe8c 100644 --- a/copilot-prettyprinter/copilot-prettyprinter.cabal +++ b/copilot-prettyprinter/copilot-prettyprinter.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-prettyprinter -version: 3.16 +version: 3.16.1 synopsis: A prettyprinter of Copilot Specifications. description: A prettyprinter of Copilot specifications. @@ -45,7 +45,7 @@ library base >= 4.9 && < 5, pretty >= 1.0 && < 1.2, - copilot-core >= 3.16 && < 3.17 + copilot-core >= 3.16.1 && < 3.17 exposed-modules: diff --git a/copilot-theorem/copilot-theorem.cabal b/copilot-theorem/copilot-theorem.cabal index 11ab2e80a..3e457a807 100644 --- a/copilot-theorem/copilot-theorem.cabal +++ b/copilot-theorem/copilot-theorem.cabal @@ -14,7 +14,7 @@ description: . -version : 3.16 +version : 3.16.1 license : BSD3 license-file : LICENSE maintainer : Ivan Perez @@ -63,8 +63,8 @@ library , xml >= 1.3 && < 1.4 , what4 >= 1.3 && < 1.5 - , copilot-core >= 3.16 && < 3.17 - , copilot-prettyprinter >= 3.16 && < 3.17 + , copilot-core >= 3.16.1 && < 3.17 + , copilot-prettyprinter >= 3.16.1 && < 3.17 exposed-modules : Copilot.Theorem , Copilot.Theorem.Prove diff --git a/copilot/copilot.cabal b/copilot/copilot.cabal index b9c562bb9..ae09b8328 100644 --- a/copilot/copilot.cabal +++ b/copilot/copilot.cabal @@ -1,5 +1,5 @@ name: copilot -version: 3.16 +version: 3.16.1 cabal-version: >= 1.10 license: BSD3 license-file: LICENSE @@ -52,12 +52,12 @@ library , directory >= 1.3 && < 1.4 , filepath >= 1.4 && < 1.5 - , copilot-core >= 3.16 && < 3.17 - , copilot-theorem >= 3.16 && < 3.17 - , copilot-language >= 3.16 && < 3.17 - , copilot-libraries >= 3.16 && < 3.17 - , copilot-c99 >= 3.16 && < 3.17 - , copilot-prettyprinter >= 3.16 && < 3.17 + , copilot-core >= 3.16.1 && < 3.17 + , copilot-theorem >= 3.16.1 && < 3.17 + , copilot-language >= 3.16.1 && < 3.17 + , copilot-libraries >= 3.16.1 && < 3.17 + , copilot-c99 >= 3.16.1 && < 3.17 + , copilot-prettyprinter >= 3.16.1 && < 3.17 exposed-modules: Language.Copilot, Language.Copilot.Main From b84017c2709fb0b6e3af9d3c0c31c9272818c4ef Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 7 Sep 2023 23:01:02 -0700 Subject: [PATCH 0654/1222] Document changes in CHANGELOG. Refs #455. --- copilot-c99/CHANGELOG | 1 + copilot-core/CHANGELOG | 3 +++ copilot-interpreter/CHANGELOG | 3 +++ copilot-language/CHANGELOG | 3 +++ copilot-libraries/CHANGELOG | 3 ++- copilot-prettyprinter/CHANGELOG | 3 +++ copilot-theorem/CHANGELOG | 3 +++ copilot/CHANGELOG | 3 +++ 8 files changed, 21 insertions(+), 1 deletion(-) diff --git a/copilot-c99/CHANGELOG b/copilot-c99/CHANGELOG index 1c944c351..846861da8 100644 --- a/copilot-c99/CHANGELOG +++ b/copilot-c99/CHANGELOG @@ -1,4 +1,5 @@ 2023-09-07 + * Version bump (3.16.1). (#455) * Clean code. (#453) 2023-07-07 diff --git a/copilot-core/CHANGELOG b/copilot-core/CHANGELOG index e28ec7b71..492963d4a 100644 --- a/copilot-core/CHANGELOG +++ b/copilot-core/CHANGELOG @@ -1,3 +1,6 @@ +2023-09-07 + * Version bump (3.16.1). (#455) + 2023-07-07 * Version bump (3.16). (#448) diff --git a/copilot-interpreter/CHANGELOG b/copilot-interpreter/CHANGELOG index c5cf8343c..16411d435 100644 --- a/copilot-interpreter/CHANGELOG +++ b/copilot-interpreter/CHANGELOG @@ -1,3 +1,6 @@ +2023-09-07 + * Version bump (3.16.1). (#455) + 2023-07-07 * Version bump (3.16). (#448) diff --git a/copilot-language/CHANGELOG b/copilot-language/CHANGELOG index 60ef8a9e1..43616648f 100644 --- a/copilot-language/CHANGELOG +++ b/copilot-language/CHANGELOG @@ -1,3 +1,6 @@ +2023-09-07 + * Version bump (3.16.1). (#455) + 2023-07-07 * Version bump (3.16). (#448) * Move Copilot.Language.Stream.Arg to Copilot.Language.Spec. (#446) diff --git a/copilot-libraries/CHANGELOG b/copilot-libraries/CHANGELOG index b3117bb47..9d7e35086 100644 --- a/copilot-libraries/CHANGELOG +++ b/copilot-libraries/CHANGELOG @@ -1,4 +1,5 @@ -2023-08-08 +2023-09-07 + * Version bump (3.16.1). (#455) * Fix semantics of since in Copilot.Library.PTLTL. (#443) * Prevent the majority function from generating unused local variables. (#408) diff --git a/copilot-prettyprinter/CHANGELOG b/copilot-prettyprinter/CHANGELOG index 522cb828e..4bb2d40e9 100644 --- a/copilot-prettyprinter/CHANGELOG +++ b/copilot-prettyprinter/CHANGELOG @@ -1,3 +1,6 @@ +2023-09-07 + * Version bump (3.16.1). (#455) + 2023-07-07 * Version bump (3.16). (#448) diff --git a/copilot-theorem/CHANGELOG b/copilot-theorem/CHANGELOG index 715d3de7b..98e44fe83 100644 --- a/copilot-theorem/CHANGELOG +++ b/copilot-theorem/CHANGELOG @@ -1,3 +1,6 @@ +2023-09-07 + * Version bump (3.16.1). (#455) + 2023-07-07 * Version bump (3.16). (#448) diff --git a/copilot/CHANGELOG b/copilot/CHANGELOG index 148832575..b9238f5dc 100644 --- a/copilot/CHANGELOG +++ b/copilot/CHANGELOG @@ -1,3 +1,6 @@ +2023-09-07 + * Version bump (3.16.1). (#455) + 2023-07-07 * Version bump (3.16). (#448) From 9e282fa70a39d3ae3716c85bd0a74a67e099a485 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 3 Nov 2023 22:50:28 -0700 Subject: [PATCH 0655/1222] copilot: Fix typo in README. Refs #459. Fix spelling of Zephyr in README. --- copilot/README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot/README.md b/copilot/README.md index d25a45a8d..99166ae1a 100644 --- a/copilot/README.md +++ b/copilot/README.md @@ -222,7 +222,7 @@ does not constitute any form of endorsement._ - [sketch-frp-copilot](https://hackage.haskell.org/package/sketch-frp-copilot) extends Copilot with an FRP-like interface. -- [zephir-copilot](https://hackage.haskell.org/package/zephyr-copilot) +- [zephyr-copilot](https://hackage.haskell.org/package/zephyr-copilot) facilitates building copilot applications that run on boards supported by the Zephyr project. From 2310f70da905ce721dfe6d9b25b023b584615490 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 3 Nov 2023 22:51:48 -0700 Subject: [PATCH 0656/1222] copilot: Document changes in CHANGELOG. Refs #459. --- copilot/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot/CHANGELOG b/copilot/CHANGELOG index b9238f5dc..74185c53e 100644 --- a/copilot/CHANGELOG +++ b/copilot/CHANGELOG @@ -1,3 +1,6 @@ +2023-11-03 + * Fix typo in README. (#459) + 2023-09-07 * Version bump (3.16.1). (#455) From a8f6d7ef0f66f412f93e382f92f028082b01407c Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 3 Nov 2023 23:53:50 -0700 Subject: [PATCH 0657/1222] copilot-theorem: Relax version constraint on what4. Refs #461. In order to keep Copilot effectively working in the current Haskell ecosystem, we need to extend the versions of dependencies that Copilot can be installed with. For example, what4 has seen a new release 1.5 and 1.5.1, but copilot-theorem needs versions strictly lower than 1.5. This commit relaxes the upper bounds on what4 so that it can be installed with the 1.5 series. --- copilot-theorem/copilot-theorem.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot-theorem/copilot-theorem.cabal b/copilot-theorem/copilot-theorem.cabal index 3e457a807..665056330 100644 --- a/copilot-theorem/copilot-theorem.cabal +++ b/copilot-theorem/copilot-theorem.cabal @@ -61,7 +61,7 @@ library , random >= 1.1 && < 1.3 , transformers >= 0.5 && < 0.7 , xml >= 1.3 && < 1.4 - , what4 >= 1.3 && < 1.5 + , what4 >= 1.3 && < 1.6 , copilot-core >= 3.16.1 && < 3.17 , copilot-prettyprinter >= 3.16.1 && < 3.17 From 9ef909503cba54d1df741292230d716dbf30b2fb Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 3 Nov 2023 23:56:57 -0700 Subject: [PATCH 0658/1222] copilot-theorem: Document changes in CHANGELOG. Refs #461. --- copilot-theorem/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-theorem/CHANGELOG b/copilot-theorem/CHANGELOG index 98e44fe83..867ce1491 100644 --- a/copilot-theorem/CHANGELOG +++ b/copilot-theorem/CHANGELOG @@ -1,3 +1,6 @@ +2023-11-03 + * Relax version constraint on what4. (#461) + 2023-09-07 * Version bump (3.16.1). (#455) From 957fdd2fff7395d6ba97700989a0f2a419ff59c5 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 4 Nov 2023 08:54:13 -0700 Subject: [PATCH 0659/1222] copilot-core: Rename tysize to typeSize. Refs #457. To comply with our NASA Class D requirements, our code must abide by a style guide. More specifically, the function Copilot.Core.Type.tysize is not lowerCamelCase, and its name is not uniform (other functions in the same module spell out the word type). This commit introduces a function Copilot.Core.Type.typeSize that replaces the old Copilot.Core.Type.tysize. In compliance with our policy of waiting 3 versions from deprecation until a public interface declaration can be removed, the old function is deprecated. --- copilot-core/src/Copilot/Core/Type.hs | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/copilot-core/src/Copilot/Core/Type.hs b/copilot-core/src/Copilot/Core/Type.hs index 9a3908061..cea8b05af 100644 --- a/copilot-core/src/Copilot/Core/Type.hs +++ b/copilot-core/src/Copilot/Core/Type.hs @@ -23,6 +23,7 @@ module Copilot.Core.Type , UType (..) , SimpleType (..) + , typeSize , tysize , tylength @@ -112,10 +113,15 @@ data Type :: * -> * where tylength :: forall n t . KnownNat n => Type (Array n t) -> Int tylength _ = fromIntegral $ natVal (Proxy :: Proxy n) +-- | Return the total (nested) size of an array from its type +typeSize :: forall n t . KnownNat n => Type (Array n t) -> Int +typeSize ty@(Array ty'@(Array _)) = tylength ty * tysize ty' +typeSize ty@(Array _ ) = tylength ty + +{-# DEPRECATED tysize "Use typeSize instead." #-} -- | Return the total (nested) size of an array from its type tysize :: forall n t . KnownNat n => Type (Array n t) -> Int -tysize ty@(Array ty'@(Array _)) = tylength ty * tysize ty' -tysize ty@(Array _ ) = tylength ty +tysize = typeSize instance TestEquality Type where testEquality Bool Bool = Just DE.Refl From ed84627a6f3a9b225e1c10a48d08a2763119f8c7 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 4 Nov 2023 08:54:53 -0700 Subject: [PATCH 0660/1222] copilot-core: Rename tylength to typeLength. Refs #457. To comply with our NASA Class D requirements, our code must abide by a style guide. More specifically, the function Copilot.Core.Type.tylength is not lowerCamelCase, and its name is not uniform (other functions in the same module spell out the word type). This commit introduces a function Copilot.Core.Type.typeLength that replaces the old Copilot.Core.Type.tylength. In compliance with our policy of waiting 3 versions from deprecation until a public interface declaration can be removed, the old function is deprecated. --- copilot-core/src/Copilot/Core/Type.hs | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/copilot-core/src/Copilot/Core/Type.hs b/copilot-core/src/Copilot/Core/Type.hs index cea8b05af..3ed718e17 100644 --- a/copilot-core/src/Copilot/Core/Type.hs +++ b/copilot-core/src/Copilot/Core/Type.hs @@ -25,6 +25,7 @@ module Copilot.Core.Type , typeSize , tysize + , typeLength , tylength , Value (..) @@ -109,9 +110,14 @@ data Type :: * -> * where ) => Type t -> Type (Array n t) Struct :: (Typed a, Struct a) => a -> Type a +-- | Return the length of an array from its type +typeLength :: forall n t . KnownNat n => Type (Array n t) -> Int +typeLength _ = fromIntegral $ natVal (Proxy :: Proxy n) + +{-# DEPRECATED tylength "Use typeLength instead." #-} -- | Return the length of an array from its type tylength :: forall n t . KnownNat n => Type (Array n t) -> Int -tylength _ = fromIntegral $ natVal (Proxy :: Proxy n) +tylength = typeLength -- | Return the total (nested) size of an array from its type typeSize :: forall n t . KnownNat n => Type (Array n t) -> Int From 30e5b3ace831279e1fb74a10df48a749d43446df Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 4 Nov 2023 08:55:17 -0700 Subject: [PATCH 0661/1222] copilot-core: Rename typename to typeName. Refs #457. To comply with our NASA Class D requirements, our code must abide by a style guide. More specifically, the function Copilot.Core.Type.typename is not lowerCamelCase, which we require to be. This commit introduces a function Copilot.Core.Type.typeName that replaces the old Copilot.Core.Type.typename. In compliance with our policy of waiting 3 versions from deprecation until a public interface declaration can be removed, the old function is deprecated. --- copilot-core/src/Copilot/Core/Type.hs | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/copilot-core/src/Copilot/Core/Type.hs b/copilot-core/src/Copilot/Core/Type.hs index 3ed718e17..5677ce921 100644 --- a/copilot-core/src/Copilot/Core/Type.hs +++ b/copilot-core/src/Copilot/Core/Type.hs @@ -31,6 +31,7 @@ module Copilot.Core.Type , Value (..) , toValues , Field (..) + , typeName , typename , Struct @@ -52,11 +53,19 @@ import GHC.TypeLits (KnownNat, KnownSymbol, Symbol, natVal, sameNat, -- Internal imports import Copilot.Core.Type.Array (Array) +{-# DEPRECATED typename "Use typeName instead." #-} + -- | The value of that is a product or struct, defined as a constructor with -- several fields. class Struct a where + -- | Returns the name of struct in the target language. + typeName :: a -> String + typeName = typename + -- | Returns the name of struct in the target language. typename :: a -> String + typename = typeName + -- | Transforms all the struct's fields into a list of values. toValues :: a -> [Value a] From 2a7ce84cb11db5af47657ec7e42a22c3ca4199be Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 4 Nov 2023 08:55:56 -0700 Subject: [PATCH 0662/1222] copilot-core: Rename fieldname to fieldName. Refs #457. To comply with our NASA Class D requirements, our code must abide by a style guide. More specifically, the function Copilot.Core.Type.fieldname is not lowerCamelCase, which we require to be. This commit introduces a function Copilot.Core.Type.fieldName that replaces the old Copilot.Core.Type.fieldname. In compliance with our policy of waiting 3 versions from deprecation until a public interface declaration can be removed, the old function is deprecated. --- copilot-core/src/Copilot/Core/Type.hs | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/copilot-core/src/Copilot/Core/Type.hs b/copilot-core/src/Copilot/Core/Type.hs index 5677ce921..c880f4c00 100644 --- a/copilot-core/src/Copilot/Core/Type.hs +++ b/copilot-core/src/Copilot/Core/Type.hs @@ -35,6 +35,7 @@ module Copilot.Core.Type , typename , Struct + , fieldName , fieldname , accessorname ) @@ -77,9 +78,14 @@ data Value a = -- level. data Field (s :: Symbol) t = Field t +-- | Extract the name of a field. +fieldName :: forall s t . KnownSymbol s => Field s t -> String +fieldName _ = symbolVal (Proxy :: Proxy s) + +{-# DEPRECATED fieldname "Use fieldName instead." #-} -- | Extract the name of a field. fieldname :: forall s t . KnownSymbol s => Field s t -> String -fieldname _ = symbolVal (Proxy :: Proxy s) +fieldname = fieldName -- | Extract the name of an accessor (a function that returns a field of a -- struct). @@ -88,7 +94,7 @@ accessorname :: forall a s t . (Struct a, KnownSymbol s) accessorname _ = symbolVal (Proxy :: Proxy s) instance (KnownSymbol s, Show t) => Show (Field s t) where - show f@(Field v) = fieldname f ++ ":" ++ show v + show f@(Field v) = fieldName f ++ ":" ++ show v instance {-# OVERLAPPABLE #-} (Typed t, Struct t) => Show t where show t = "<" ++ fields ++ ">" From 6349d83abc02e44db29c1cf47d56ed148fc86669 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 4 Nov 2023 08:56:12 -0700 Subject: [PATCH 0663/1222] copilot-core: Rename accessorname to accessorName. Refs #457. To comply with our NASA Class D requirements, our code must abide by a style guide. More specifically, the function Copilot.Core.Type.accessorname is not lowerCamelCase, which we require to be. This commit introduces a function Copilot.Core.Type.accessorName that replaces the old Copilot.Core.Type.accessorname. In compliance with our policy of waiting 3 versions from deprecation until a public interface declaration can be removed, the old function is deprecated. --- copilot-core/src/Copilot/Core/Type.hs | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/copilot-core/src/Copilot/Core/Type.hs b/copilot-core/src/Copilot/Core/Type.hs index c880f4c00..2c58a6277 100644 --- a/copilot-core/src/Copilot/Core/Type.hs +++ b/copilot-core/src/Copilot/Core/Type.hs @@ -37,6 +37,7 @@ module Copilot.Core.Type , Struct , fieldName , fieldname + , accessorName , accessorname ) where @@ -87,11 +88,18 @@ fieldName _ = symbolVal (Proxy :: Proxy s) fieldname :: forall s t . KnownSymbol s => Field s t -> String fieldname = fieldName +-- | Extract the name of an accessor (a function that returns a field of a +-- struct). +accessorName :: forall a s t . (Struct a, KnownSymbol s) + => (a -> Field s t) -> String +accessorName _ = symbolVal (Proxy :: Proxy s) + +{-# DEPRECATED accessorname "Use accessorName instead." #-} -- | Extract the name of an accessor (a function that returns a field of a -- struct). accessorname :: forall a s t . (Struct a, KnownSymbol s) => (a -> Field s t) -> String -accessorname _ = symbolVal (Proxy :: Proxy s) +accessorname = accessorName instance (KnownSymbol s, Show t) => Show (Field s t) where show f@(Field v) = fieldName f ++ ":" ++ show v From 0a53d0108d69db9ca1c5a9633c826265e3ed2e30 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 4 Nov 2023 08:58:00 -0700 Subject: [PATCH 0664/1222] copilot-core: Rename arrayelems to arrayElems. Refs #457. To comply with our NASA Class D requirements, our code must abide by a style guide. More specifically, the function Copilot.Core.Type.Array.arrayelems is not lowerCamelCase, which we require to be. This commit introduces a function Copilot.Core.Type.Array.arrayElems that replaces the old Copilot.Core.Type.Array.arrayelems. In compliance with our policy of waiting 3 versions from deprecation until a public interface declaration can be removed, the old function is deprecated. --- copilot-core/src/Copilot/Core/Type/Array.hs | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/copilot-core/src/Copilot/Core/Type/Array.hs b/copilot-core/src/Copilot/Core/Type/Array.hs index 5f0995b2c..2bca9bc11 100644 --- a/copilot-core/src/Copilot/Core/Type/Array.hs +++ b/copilot-core/src/Copilot/Core/Type/Array.hs @@ -13,6 +13,7 @@ module Copilot.Core.Type.Array ( Array , array + , arrayElems , arrayelems ) where @@ -39,6 +40,11 @@ array xs | datalen == typelen = Array xs errmsg = "Length of data (" ++ show datalen ++ ") does not match length of type (" ++ show typelen ++ ")." +-- | Return the elements of an array. +arrayElems :: Array n a -> [a] +arrayElems (Array xs) = xs + +{-# DEPRECATED arrayelems "Use ArrayElems instead." #-} -- | Return the elemts of an array. arrayelems :: Array n a -> [a] -arrayelems (Array xs) = xs +arrayelems = arrayElems From c235a2afbe4ef9ad577cc15cc6a11d95a30c2b0a Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 5 Nov 2023 14:25:11 -0800 Subject: [PATCH 0665/1222] copilot-core: Update uses of tysize. Refs #457. The function tysize has been deprecated in favor of typeSize to comply with the coding standard. This commit updates all uses of tysize in this library with the new function name. --- copilot-core/src/Copilot/Core/Type.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot-core/src/Copilot/Core/Type.hs b/copilot-core/src/Copilot/Core/Type.hs index 2c58a6277..8c0a9d953 100644 --- a/copilot-core/src/Copilot/Core/Type.hs +++ b/copilot-core/src/Copilot/Core/Type.hs @@ -144,7 +144,7 @@ tylength = typeLength -- | Return the total (nested) size of an array from its type typeSize :: forall n t . KnownNat n => Type (Array n t) -> Int -typeSize ty@(Array ty'@(Array _)) = tylength ty * tysize ty' +typeSize ty@(Array ty'@(Array _)) = tylength ty * typeSize ty' typeSize ty@(Array _ ) = tylength ty {-# DEPRECATED tysize "Use typeSize instead." #-} From f5799609416bfaf12a7d3a3a42ca9de2a7e8b80c Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 5 Nov 2023 14:25:18 -0800 Subject: [PATCH 0666/1222] copilot-c99: Update uses of tysize. Refs #457. The function tysize has been deprecated in favor of typeSize to comply with the coding standard. This commit updates all uses of tysize in this library with the new function name. --- copilot-c99/src/Copilot/Compile/C99/CodeGen.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs b/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs index b9c3feb84..4c8a938c1 100644 --- a/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs +++ b/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs @@ -33,7 +33,7 @@ import qualified Language.C99.Simple as C -- Internal imports: Copilot import Copilot.Core ( Expr (..), Id, Stream (..), Struct (..), Trigger (..), - Type (..), UExpr (..), Value (..), fieldname, tysize ) + Type (..), UExpr (..), Value (..), fieldname, typeSize ) -- Internal imports import Copilot.Compile.C99.Error ( impossible ) @@ -134,7 +134,7 @@ mkGenFunArray name nameArg expr ty@(Array _) = -- Copy expression to output argument stmts = [ C.Expr $ memcpy (C.Ident nameArg) cExpr size ] - size = C.LitInt (fromIntegral $ tysize ty) + size = C.LitInt (fromIntegral $ typeSize ty) C..* C.SizeOfType (C.TypeName $ tyElemName ty) mkGenFunArray _name _nameArg _expr _ty = @@ -180,7 +180,7 @@ mkStep cSettings streams triggers exts = where dest = C.Index buffVar indexVar size = C.LitInt - (fromIntegral $ tysize ty) + (fromIntegral $ typeSize ty) C..* C.SizeOfType (C.TypeName (tyElemName ty)) _ -> C.Expr $ C.Index buffVar indexVar C..= C.Ident tmpVar @@ -203,7 +203,7 @@ mkStep cSettings streams triggers exts = where exVar = C.Ident cpyName locVar = C.Ident name - size = C.LitInt (fromIntegral $ tysize ty) + size = C.LitInt (fromIntegral $ typeSize ty) C..* C.SizeOfType (C.TypeName (tyElemName ty)) _ -> C.Ident cpyName C..= C.Ident name From 613b7b26d2dc5c2b9e804d970e13619a129c1b17 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 5 Nov 2023 14:26:47 -0800 Subject: [PATCH 0667/1222] copilot-core: Update uses of tylength. Refs #457. The function tylength has been deprecated in favor of typeLength to comply with the coding standard. This commit updates all uses of tylength in this library with the new function name. --- copilot-core/src/Copilot/Core/Type.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/copilot-core/src/Copilot/Core/Type.hs b/copilot-core/src/Copilot/Core/Type.hs index 8c0a9d953..3da6917dc 100644 --- a/copilot-core/src/Copilot/Core/Type.hs +++ b/copilot-core/src/Copilot/Core/Type.hs @@ -144,8 +144,8 @@ tylength = typeLength -- | Return the total (nested) size of an array from its type typeSize :: forall n t . KnownNat n => Type (Array n t) -> Int -typeSize ty@(Array ty'@(Array _)) = tylength ty * typeSize ty' -typeSize ty@(Array _ ) = tylength ty +typeSize ty@(Array ty'@(Array _)) = typeLength ty * typeSize ty' +typeSize ty@(Array _ ) = typeLength ty {-# DEPRECATED tysize "Use typeSize instead." #-} -- | Return the total (nested) size of an array from its type From 3aa0f4752ee6cccad545ce5b418e504ce00aa179 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 5 Nov 2023 14:28:08 -0800 Subject: [PATCH 0668/1222] copilot-c99: Update uses of tylength. Refs #457. The function tylength has been deprecated in favor of typeLength to comply with the coding standard. This commit updates all uses of tylength in this library with the new function name. --- copilot-c99/src/Copilot/Compile/C99/Type.hs | 4 ++-- copilot-c99/tests/Test/Copilot/Compile/C99.hs | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/copilot-c99/src/Copilot/Compile/C99/Type.hs b/copilot-c99/src/Copilot/Compile/C99/Type.hs index f94dbac65..40253d1f7 100644 --- a/copilot-c99/src/Copilot/Compile/C99/Type.hs +++ b/copilot-c99/src/Copilot/Compile/C99/Type.hs @@ -12,7 +12,7 @@ module Copilot.Compile.C99.Type import qualified Language.C99.Simple as C -- Internal imports: Copilot -import Copilot.Core ( Type (..), tylength, typename ) +import Copilot.Core ( Type (..), typeLength, typename ) -- | Translate a Copilot type to a C99 type. transType :: Type a -> C.Type @@ -30,7 +30,7 @@ transType ty = case ty of Double -> C.TypeSpec C.Double Array ty' -> C.Array (transType ty') len where - len = Just $ C.LitInt $ fromIntegral $ tylength ty + len = Just $ C.LitInt $ fromIntegral $ typeLength ty Struct s -> C.TypeSpec $ C.Struct (typename s) -- | Translate a Copilot type to a valid (local) variable declaration C99 type. diff --git a/copilot-c99/tests/Test/Copilot/Compile/C99.hs b/copilot-c99/tests/Test/Copilot/Compile/C99.hs index 2c98bb856..6a3f83794 100644 --- a/copilot-c99/tests/Test/Copilot/Compile/C99.hs +++ b/copilot-c99/tests/Test/Copilot/Compile/C99.hs @@ -860,7 +860,7 @@ varDeclC Word64 v = "uint64_t " ++ v varDeclC Float v = "float " ++ v varDeclC Double v = "double " ++ v varDeclC t@(Array tE) v = - typeC tE ++ " " ++ v ++ "[" ++ show (tylength t) ++ "]" + typeC tE ++ " " ++ v ++ "[" ++ show (typeLength t) ++ "]" varDeclC _ _ = error "copilot-c99 (test): Input variables of type struct are not yet supported." @@ -877,7 +877,7 @@ sizeC Word32 = "sizeof(uint32_t)" sizeC Word64 = "sizeof(uint64_t)" sizeC Float = "sizeof(float)" sizeC Double = "sizeof(double)" -sizeC t@(Array tE) = show (tylength t) ++ "* sizeof(" ++ typeC tE ++ ")" +sizeC t@(Array tE) = show (typeLength t) ++ "* sizeof(" ++ typeC tE ++ ")" sizeC _ = error "copilot-c99 (test): Input variables of type struct are not yet supported." From 2351b6666892396817cd9ecef401d498eedef0b5 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 4 Nov 2023 09:08:03 -0700 Subject: [PATCH 0669/1222] copilot-c99: Update uses of typename. Refs #457. The function typename has been deprecated in favor of typeName to comply with the coding standard. This commit updates all uses of typename in this library with the new function name. --- copilot-c99/src/Copilot/Compile/C99/CodeGen.hs | 4 ++-- copilot-c99/src/Copilot/Compile/C99/Type.hs | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs b/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs index 4c8a938c1..fe9eee014 100644 --- a/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs +++ b/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs @@ -67,7 +67,7 @@ mkExtCpyDecln (External _name cpyName ty) = decln mkStructDecln :: Struct a => Type a -> C.Decln mkStructDecln (Struct x) = C.TypeDecln struct where - struct = C.TypeSpec $ C.StructDecln (Just $ typename x) fields + struct = C.TypeSpec $ C.StructDecln (Just $ typeName x) fields fields = NonEmpty.fromList $ map mkField (toValues x) mkField :: Value a -> C.FieldDecln @@ -77,7 +77,7 @@ mkStructDecln (Struct x) = C.TypeDecln struct mkStructForwDecln :: Struct a => Type a -> C.Decln mkStructForwDecln (Struct x) = C.TypeDecln struct where - struct = C.TypeSpec $ C.Struct (typename x) + struct = C.TypeSpec $ C.Struct (typeName x) -- * Ring buffers diff --git a/copilot-c99/src/Copilot/Compile/C99/Type.hs b/copilot-c99/src/Copilot/Compile/C99/Type.hs index 40253d1f7..78777617b 100644 --- a/copilot-c99/src/Copilot/Compile/C99/Type.hs +++ b/copilot-c99/src/Copilot/Compile/C99/Type.hs @@ -12,7 +12,7 @@ module Copilot.Compile.C99.Type import qualified Language.C99.Simple as C -- Internal imports: Copilot -import Copilot.Core ( Type (..), typeLength, typename ) +import Copilot.Core ( Type (..), typeLength, typeName ) -- | Translate a Copilot type to a C99 type. transType :: Type a -> C.Type @@ -31,7 +31,7 @@ transType ty = case ty of Array ty' -> C.Array (transType ty') len where len = Just $ C.LitInt $ fromIntegral $ typeLength ty - Struct s -> C.TypeSpec $ C.Struct (typename s) + Struct s -> C.TypeSpec $ C.Struct (typeName s) -- | Translate a Copilot type to a valid (local) variable declaration C99 type. -- From 26cf867ba2ef1da663bd1dd403689e3b8038fc5b Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 4 Nov 2023 09:08:29 -0700 Subject: [PATCH 0670/1222] copilot: Update uses of typename. Refs #457. The function typename has been deprecated in favor of typeName to comply with the coding standard. This commit updates all uses of typename in this library with the new function name. --- copilot/examples/Structs.hs | 4 ++-- copilot/examples/what4/Structs.hs | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/copilot/examples/Structs.hs b/copilot/examples/Structs.hs index f826585a4..f3b83b1f3 100644 --- a/copilot/examples/Structs.hs +++ b/copilot/examples/Structs.hs @@ -19,7 +19,7 @@ data Volts = Volts -- | `Struct` instance for `Volts`. instance Struct Volts where - typename _ = "volts" + typeName _ = "volts" toValues volts = [ Value Word16 (numVolts volts) , Value Bool (flag volts) ] @@ -36,7 +36,7 @@ data Battery = Battery -- | `Battery` instance for `Struct`. instance Struct Battery where - typename _ = "battery" + typeName _ = "battery" toValues battery = [ Value typeOf (temp battery) , Value typeOf (volts battery) , Value typeOf (other battery) diff --git a/copilot/examples/what4/Structs.hs b/copilot/examples/what4/Structs.hs index 413bc454f..ff44ec25c 100644 --- a/copilot/examples/what4/Structs.hs +++ b/copilot/examples/what4/Structs.hs @@ -20,7 +20,7 @@ data Volts = Volts -- | `Struct` instance for `Volts`. instance Struct Volts where - typename _ = "volts" + typeName _ = "volts" toValues volts = [ Value Word16 (numVolts volts) , Value Bool (flag volts) ] @@ -37,7 +37,7 @@ data Battery = Battery -- | `Battery` instance for `Struct`. instance Struct Battery where - typename _ = "battery" + typeName _ = "battery" toValues battery = [ Value typeOf (temp battery) , Value typeOf (volts battery) , Value typeOf (other battery) From e4f727d2529694ea5a4ff5c93970588e7e43ab45 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 4 Nov 2023 09:10:39 -0700 Subject: [PATCH 0671/1222] copilot-c99: Update uses of fieldname. Refs #457. The function fieldname has been deprecated in favor of fieldName to comply with the coding standard. This commit updates all uses of fieldname in this library with the new function name. --- copilot-c99/src/Copilot/Compile/C99/CodeGen.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs b/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs index fe9eee014..23b9de256 100644 --- a/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs +++ b/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs @@ -33,7 +33,7 @@ import qualified Language.C99.Simple as C -- Internal imports: Copilot import Copilot.Core ( Expr (..), Id, Stream (..), Struct (..), Trigger (..), - Type (..), UExpr (..), Value (..), fieldname, typeSize ) + Type (..), UExpr (..), Value (..), fieldName, typeSize ) -- Internal imports import Copilot.Compile.C99.Error ( impossible ) @@ -71,7 +71,7 @@ mkStructDecln (Struct x) = C.TypeDecln struct fields = NonEmpty.fromList $ map mkField (toValues x) mkField :: Value a -> C.FieldDecln - mkField (Value ty field) = C.FieldDecln (transType ty) (fieldname field) + mkField (Value ty field) = C.FieldDecln (transType ty) (fieldName field) -- | Write a forward struct declaration. mkStructForwDecln :: Struct a => Type a -> C.Decln From 196563dcd4f902510e5bb94192ba41ce85df9c79 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 4 Nov 2023 09:11:52 -0700 Subject: [PATCH 0672/1222] copilot-c99: Update uses of accessorname. Refs #457. The function accessorname has been deprecated in favor of accessorName to comply with the coding standard. This commit updates all uses of accessorname in this library with the new function name. --- copilot-c99/src/Copilot/Compile/C99/Expr.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/copilot-c99/src/Copilot/Compile/C99/Expr.hs b/copilot-c99/src/Copilot/Compile/C99/Expr.hs index faa522b86..03c4f3866 100644 --- a/copilot-c99/src/Copilot/Compile/C99/Expr.hs +++ b/copilot-c99/src/Copilot/Compile/C99/Expr.hs @@ -14,7 +14,7 @@ import qualified Language.C99.Simple as C -- Internal imports: Copilot import Copilot.Core ( Expr (..), Field (..), Op1 (..), Op2 (..), Op3 (..), - Type (..), Value (..), accessorname, arrayelems, + Type (..), Value (..), accessorName, arrayelems, toValues ) -- Internal imports @@ -96,7 +96,7 @@ transOp1 op e = Floor ty -> funCall (specializeMathFunName ty "floor") [e] BwNot _ -> (C..~) e Cast _ ty -> C.Cast (transTypeName ty) e - GetField (Struct _) _ f -> C.Dot e (accessorname f) + GetField (Struct _) _ f -> C.Dot e (accessorName f) -- | Translates a Copilot binary operator and its arguments into a C99 -- expression. From 7a76d8b6b91236557864a196268a8303f18cfb38 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 4 Nov 2023 09:12:13 -0700 Subject: [PATCH 0673/1222] copilot-prettyprinter: Update uses of accessorname. Refs #457. The function accessorname has been deprecated in favor of accessorName to comply with the coding standard. This commit updates all uses of accessorname in this library with the new function name. --- copilot-prettyprinter/src/Copilot/PrettyPrint.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot-prettyprinter/src/Copilot/PrettyPrint.hs b/copilot-prettyprinter/src/Copilot/PrettyPrint.hs index 10100a88f..887346827 100644 --- a/copilot-prettyprinter/src/Copilot/PrettyPrint.hs +++ b/copilot-prettyprinter/src/Copilot/PrettyPrint.hs @@ -71,7 +71,7 @@ ppOp1 op = case op of Floor _ -> ppPrefix "floor" BwNot _ -> ppPrefix "~" Cast _ _ -> ppPrefix "(cast)" - GetField (Struct _) _ f -> \e -> ppInfix "#" e (text $ accessorname f) + GetField (Struct _) _ f -> \e -> ppInfix "#" e (text $ accessorName f) GetField _ _ _ -> impossible "ppOp1" "Copilot.PrettyPrint" -- | Pretty-print a binary operation. From 8976a63f91a21032c4a898fb63a22d7161de1673 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 4 Nov 2023 09:14:00 -0700 Subject: [PATCH 0674/1222] copilot-core: Update uses of arrayelems. Refs #457. The function arrayelems has been deprecated in favor of arrayElems to comply with the coding standard. This commit updates all uses of arrayelems in this library with the new function name. --- copilot-core/tests/Test/Copilot/Core/Type/Array.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/copilot-core/tests/Test/Copilot/Core/Type/Array.hs b/copilot-core/tests/Test/Copilot/Core/Type/Array.hs index 4a0f0f523..9a98d49cc 100644 --- a/copilot-core/tests/Test/Copilot/Core/Type/Array.hs +++ b/copilot-core/tests/Test/Copilot/Core/Type/Array.hs @@ -13,7 +13,7 @@ import Test.QuickCheck (Gen, Property, arbitrary, forAll, vectorOf) -- Internal imports: library modules being tested -import Copilot.Core.Type.Array (Array, array, arrayelems) +import Copilot.Core.Type.Array (Array, array, arrayElems) -- | All unit tests for copilot-core:Copilot.Core.Array. tests :: Test.Framework.Test @@ -30,13 +30,13 @@ tests = -- * Individual tests -- | Test that building an array from a list and extracting the elements with --- the function 'arrayelems' will result in the same list. +-- the function 'arrayElems' will result in the same list. testArrayElemsLeft :: forall n . KnownNat n => Proxy n -> Property testArrayElemsLeft len = forAll xsInt64 $ \ls -> let array' :: Array n Int64 array' = array ls - in arrayelems array' == ls + in arrayElems array' == ls where From 3c212e5f780688d2d98d82ceb7dc21d3771b27a3 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 4 Nov 2023 09:15:20 -0700 Subject: [PATCH 0675/1222] copilot-c99: Update uses of arrayelems. Refs #457. The function arrayelems has been deprecated in favor of arrayElems to comply with the coding standard. This commit updates all uses of arrayelems in this library with the new function name. --- copilot-c99/src/Copilot/Compile/C99/Expr.hs | 6 +++--- copilot-c99/tests/Test/Copilot/Compile/C99.hs | 4 ++-- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/copilot-c99/src/Copilot/Compile/C99/Expr.hs b/copilot-c99/src/Copilot/Compile/C99/Expr.hs index 03c4f3866..1c8108996 100644 --- a/copilot-c99/src/Copilot/Compile/C99/Expr.hs +++ b/copilot-c99/src/Copilot/Compile/C99/Expr.hs @@ -14,7 +14,7 @@ import qualified Language.C99.Simple as C -- Internal imports: Copilot import Copilot.Core ( Expr (..), Field (..), Op1 (..), Op2 (..), Op3 (..), - Type (..), Value (..), accessorName, arrayelems, + Type (..), Value (..), accessorName, arrayElems, toValues ) -- Internal imports @@ -239,7 +239,7 @@ constTy ty = case ty of Float -> explicitTy ty . C.LitFloat Double -> explicitTy ty . C.LitDouble Struct _ -> C.InitVal (transTypeName ty) . constStruct . toValues - Array ty' -> C.InitVal (transTypeName ty) . constArray ty' . arrayelems + Array ty' -> C.InitVal (transTypeName ty) . constArray ty' . arrayElems -- | Transform a Copilot Core literal, based on its value and type, into a C99 -- initializer. @@ -265,7 +265,7 @@ constInit ty val = case ty of -- whole expression as an array of two int32_t's (as opposed to a nested -- array). This can either lead to compile-time errors (if you're lucky) or -- incorrect runtime semantics (if you're unlucky). - Array ty' -> C.InitList $ constArray ty' $ arrayelems val + Array ty' -> C.InitList $ constArray ty' $ arrayElems val -- We use InitArray to initialize a struct because the syntax used for -- initializing arrays and structs is compatible. For instance, {1, 2} works diff --git a/copilot-c99/tests/Test/Copilot/Compile/C99.hs b/copilot-c99/tests/Test/Copilot/Compile/C99.hs index 6a3f83794..dfca17809 100644 --- a/copilot-c99/tests/Test/Copilot/Compile/C99.hs +++ b/copilot-c99/tests/Test/Copilot/Compile/C99.hs @@ -279,7 +279,7 @@ arbitraryArrayIx :: forall t n . (Typed t, KnownNat n, Num t) , [Array n t] -> [Word32] -> [t] ) arbitraryArrayIx = return - (Op2 (Index typeOf), zipWith (\x y -> arrayelems x !! fromIntegral y)) + (Op2 (Index typeOf), zipWith (\x y -> arrayElems x !! fromIntegral y)) -- | Generator of functions on Floating point numbers. arbitraryOpFloat :: (Floating t, Typed t) => Gen (Fun t t, [t] -> [t]) @@ -920,7 +920,7 @@ instance CShow Bool where cshow False = "false" instance CShow t => CShow (Array n t) where - cshow a = intercalate "," $ map cshow $ arrayelems a + cshow a = intercalate "," $ map cshow $ arrayElems a -- | Read a value of a given type in C. class ReadableFromC a where From 919919d16de2e5ee0737090d7ab72124980f8377 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 4 Nov 2023 09:15:50 -0700 Subject: [PATCH 0676/1222] copilot-interpreter: Update uses of arrayelems. Refs #457. The function arrayelems has been deprecated in favor of arrayElems to comply with the coding standard. This commit updates all uses of arrayelems in this library with the new function name. --- copilot-interpreter/src/Copilot/Interpret/Eval.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/copilot-interpreter/src/Copilot/Interpret/Eval.hs b/copilot-interpreter/src/Copilot/Interpret/Eval.hs index 19d7e61d4..a0083524c 100644 --- a/copilot-interpreter/src/Copilot/Interpret/Eval.hs +++ b/copilot-interpreter/src/Copilot/Interpret/Eval.hs @@ -17,7 +17,7 @@ module Copilot.Interpret.Eval import Copilot.Core (Expr (..), Field (..), Id, Name, Observer (..), Op1 (..), Op2 (..), Op3 (..), Spec, Stream (..), - Trigger (..), Type (..), UExpr (..), arrayelems, + Trigger (..), Type (..), UExpr (..), arrayElems, specObservers, specStreams, specTriggers) import Copilot.Interpret.Error (badUsage) @@ -242,7 +242,7 @@ evalOp2 op = case op of BwXor _ -> (xor) BwShiftL _ _ -> ( \ !a !b -> shiftL a $! fromIntegral b ) BwShiftR _ _ -> ( \ !a !b -> shiftR a $! fromIntegral b ) - Index _ -> \xs n -> (arrayelems xs) !! (fromIntegral n) + Index _ -> \xs n -> (arrayElems xs) !! (fromIntegral n) -- | Apply a function to two numbers, so long as the second one is -- not zero. From 4f32459054b50b1eb42d13a1b9d6e74a3053bd6f Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 4 Nov 2023 09:16:14 -0700 Subject: [PATCH 0677/1222] copilot-theorem: Update uses of arrayelems. Refs #457. The function arrayelems has been deprecated in favor of arrayElems to comply with the coding standard. This commit updates all uses of arrayelems in this library with the new function name. --- copilot-theorem/src/Copilot/Theorem/What4/Translate.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot-theorem/src/Copilot/Theorem/What4/Translate.hs b/copilot-theorem/src/Copilot/Theorem/What4/Translate.hs index 128033750..f55e3884e 100644 --- a/copilot-theorem/src/Copilot/Theorem/What4/Translate.hs +++ b/copilot-theorem/src/Copilot/Theorem/What4/Translate.hs @@ -365,7 +365,7 @@ translateConstExpr sym tp a = case tp of CT.Float -> XFloat <$> WFP.iFloatLitSingle sym a CT.Double -> XDouble <$> WFP.iFloatLitDouble sym a CT.Array tp -> do - elts <- traverse (translateConstExpr sym tp) (CT.arrayelems a) + elts <- traverse (translateConstExpr sym tp) (CT.arrayElems a) Some n <- return $ mkNatRepr (genericLength elts) case isZeroOrGT1 n of Left Refl -> return XEmptyArray From 4c8c94eba38240be12d7977c141c41ca0758a69f Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 5 Nov 2023 14:50:41 -0800 Subject: [PATCH 0678/1222] copilot-core: Document changes in CHANGELOG. Refs #457. --- copilot-core/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-core/CHANGELOG b/copilot-core/CHANGELOG index 492963d4a..cf836f048 100644 --- a/copilot-core/CHANGELOG +++ b/copilot-core/CHANGELOG @@ -1,3 +1,6 @@ +2023-11-05 + * Compliance with style guide. (#457) + 2023-09-07 * Version bump (3.16.1). (#455) From bdf1f6b8ae5048db8df5987d53f304508db758f5 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 5 Nov 2023 14:51:32 -0800 Subject: [PATCH 0679/1222] copilot-c99: Document changes in CHANGELOG. Refs #457. --- copilot-c99/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-c99/CHANGELOG b/copilot-c99/CHANGELOG index 846861da8..12382d90a 100644 --- a/copilot-c99/CHANGELOG +++ b/copilot-c99/CHANGELOG @@ -1,3 +1,6 @@ +2023-11-05 + * Replace uses of deprecated functions. (#457) + 2023-09-07 * Version bump (3.16.1). (#455) * Clean code. (#453) From 8728f2e188dd9aa242cd4b31b7b12dcd1254c8f1 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 5 Nov 2023 14:51:49 -0800 Subject: [PATCH 0680/1222] copilot-interpreter: Document changes in CHANGELOG. Refs #457. --- copilot-interpreter/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-interpreter/CHANGELOG b/copilot-interpreter/CHANGELOG index 16411d435..b4bbd09f5 100644 --- a/copilot-interpreter/CHANGELOG +++ b/copilot-interpreter/CHANGELOG @@ -1,3 +1,6 @@ +2023-11-05 + * Replace uses of deprecated functions. (#457) + 2023-09-07 * Version bump (3.16.1). (#455) From 25c67cb17e439923dbc532de0b2a89decfc4150d Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 5 Nov 2023 14:52:07 -0800 Subject: [PATCH 0681/1222] copilot-prettyprinter: Document changes in CHANGELOG. Refs #457. --- copilot-prettyprinter/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-prettyprinter/CHANGELOG b/copilot-prettyprinter/CHANGELOG index 4bb2d40e9..c982374b6 100644 --- a/copilot-prettyprinter/CHANGELOG +++ b/copilot-prettyprinter/CHANGELOG @@ -1,3 +1,6 @@ +2023-11-05 + * Replace uses of deprecated functions. (#457) + 2023-09-07 * Version bump (3.16.1). (#455) From a11a818e23c90e10cc5e1b08cc1d39e1a074f1b4 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 5 Nov 2023 14:52:28 -0800 Subject: [PATCH 0682/1222] copilot-theorem: Document changes in CHANGELOG. Refs #457. --- copilot-theorem/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot-theorem/CHANGELOG b/copilot-theorem/CHANGELOG index 867ce1491..be9e693f0 100644 --- a/copilot-theorem/CHANGELOG +++ b/copilot-theorem/CHANGELOG @@ -1,5 +1,6 @@ -2023-11-03 +2023-11-05 * Relax version constraint on what4. (#461) + * Replace uses of deprecated functions. (#457) 2023-09-07 * Version bump (3.16.1). (#455) From 73aee20036c760b698679f5a32f3b0ac23e17545 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 5 Nov 2023 14:52:46 -0800 Subject: [PATCH 0683/1222] copilot: Document changes in CHANGELOG. Refs #457. --- copilot/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot/CHANGELOG b/copilot/CHANGELOG index 74185c53e..b3764b01e 100644 --- a/copilot/CHANGELOG +++ b/copilot/CHANGELOG @@ -1,3 +1,6 @@ +2023-11-05 + * Replace uses of deprecated functions. (#457) + 2023-11-03 * Fix typo in README. (#459) From a835d3bd13f3b80c949d875206101dadc31930fa Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 7 Nov 2023 10:55:49 -0800 Subject: [PATCH 0684/1222] Bump versions and constraints. Refs #466. --- copilot-c99/copilot-c99.cabal | 8 ++++---- copilot-core/copilot-core.cabal | 2 +- copilot-interpreter/copilot-interpreter.cabal | 4 ++-- copilot-language/copilot-language.cabal | 8 ++++---- copilot-libraries/copilot-libraries.cabal | 4 ++-- copilot-prettyprinter/copilot-prettyprinter.cabal | 4 ++-- copilot-theorem/copilot-theorem.cabal | 6 +++--- copilot/copilot.cabal | 14 +++++++------- 8 files changed, 25 insertions(+), 25 deletions(-) diff --git a/copilot-c99/copilot-c99.cabal b/copilot-c99/copilot-c99.cabal index d0e5ff904..15831a308 100644 --- a/copilot-c99/copilot-c99.cabal +++ b/copilot-c99/copilot-c99.cabal @@ -1,6 +1,6 @@ cabal-version : >= 1.10 name : copilot-c99 -version : 3.16.1 +version : 3.17 synopsis : A compiler for Copilot targeting C99. description : This package is a back-end from Copilot to C. @@ -45,9 +45,9 @@ library , mtl >= 2.2 && < 2.4 , pretty >= 1.1 && < 1.2 - , copilot-core >= 3.16.1 && < 3.17 - , language-c99 >= 0.2.0 && < 0.3 - , language-c99-simple >= 0.2.2 && < 0.3 + , copilot-core >= 3.17 && < 3.18 + , language-c99 >= 0.2.0 && < 0.3 + , language-c99-simple >= 0.2.2 && < 0.3 exposed-modules : Copilot.Compile.C99 diff --git a/copilot-core/copilot-core.cabal b/copilot-core/copilot-core.cabal index e50e0e488..c74cdeb86 100644 --- a/copilot-core/copilot-core.cabal +++ b/copilot-core/copilot-core.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-core -version: 3.16.1 +version: 3.17 synopsis: An intermediate representation for Copilot. description: Intermediate representation for Copilot. diff --git a/copilot-interpreter/copilot-interpreter.cabal b/copilot-interpreter/copilot-interpreter.cabal index 7479470b5..caa713c00 100644 --- a/copilot-interpreter/copilot-interpreter.cabal +++ b/copilot-interpreter/copilot-interpreter.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-interpreter -version: 3.16.1 +version: 3.17 synopsis: Interpreter for Copilot. description: Interpreter for Copilot. @@ -44,7 +44,7 @@ library base >= 4.9 && < 5, pretty >= 1.0 && < 1.2, - copilot-core >= 3.16.1 && < 3.17 + copilot-core >= 3.17 && < 3.18 exposed-modules: diff --git a/copilot-language/copilot-language.cabal b/copilot-language/copilot-language.cabal index 61c45393f..8a802b4f1 100644 --- a/copilot-language/copilot-language.cabal +++ b/copilot-language/copilot-language.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-language -version: 3.16.1 +version: 3.17 synopsis: A Haskell-embedded DSL for monitoring hard real-time distributed systems. description: @@ -42,9 +42,9 @@ library , data-reify >= 0.6 && < 0.7 , mtl >= 2.0 && < 3 - , copilot-core >= 3.16.1 && < 3.17 - , copilot-interpreter >= 3.16.1 && < 3.17 - , copilot-theorem >= 3.16.1 && < 3.17 + , copilot-core >= 3.17 && < 3.18 + , copilot-interpreter >= 3.17 && < 3.18 + , copilot-theorem >= 3.17 && < 3.18 exposed-modules: Copilot.Language , Copilot.Language.Operators.BitWise diff --git a/copilot-libraries/copilot-libraries.cabal b/copilot-libraries/copilot-libraries.cabal index 9d4a4d1bb..f93304cd5 100644 --- a/copilot-libraries/copilot-libraries.cabal +++ b/copilot-libraries/copilot-libraries.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-libraries -version: 3.16.1 +version: 3.17 synopsis: Libraries for the Copilot language. description: Libraries for the Copilot language. @@ -41,7 +41,7 @@ library , containers >= 0.4 && < 0.7 , mtl >= 2.0 && < 2.4 , parsec >= 2.0 && < 3.2 - , copilot-language >= 3.16.1 && < 3.17 + , copilot-language >= 3.17 && < 3.18 exposed-modules: Copilot.Library.Libraries diff --git a/copilot-prettyprinter/copilot-prettyprinter.cabal b/copilot-prettyprinter/copilot-prettyprinter.cabal index 7de26fe8c..fef76fa05 100644 --- a/copilot-prettyprinter/copilot-prettyprinter.cabal +++ b/copilot-prettyprinter/copilot-prettyprinter.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-prettyprinter -version: 3.16.1 +version: 3.17 synopsis: A prettyprinter of Copilot Specifications. description: A prettyprinter of Copilot specifications. @@ -45,7 +45,7 @@ library base >= 4.9 && < 5, pretty >= 1.0 && < 1.2, - copilot-core >= 3.16.1 && < 3.17 + copilot-core >= 3.17 && < 3.18 exposed-modules: diff --git a/copilot-theorem/copilot-theorem.cabal b/copilot-theorem/copilot-theorem.cabal index 665056330..142c29d60 100644 --- a/copilot-theorem/copilot-theorem.cabal +++ b/copilot-theorem/copilot-theorem.cabal @@ -14,7 +14,7 @@ description: . -version : 3.16.1 +version : 3.17 license : BSD3 license-file : LICENSE maintainer : Ivan Perez @@ -63,8 +63,8 @@ library , xml >= 1.3 && < 1.4 , what4 >= 1.3 && < 1.6 - , copilot-core >= 3.16.1 && < 3.17 - , copilot-prettyprinter >= 3.16.1 && < 3.17 + , copilot-core >= 3.17 && < 3.18 + , copilot-prettyprinter >= 3.17 && < 3.18 exposed-modules : Copilot.Theorem , Copilot.Theorem.Prove diff --git a/copilot/copilot.cabal b/copilot/copilot.cabal index ae09b8328..556ff157d 100644 --- a/copilot/copilot.cabal +++ b/copilot/copilot.cabal @@ -1,5 +1,5 @@ name: copilot -version: 3.16.1 +version: 3.17 cabal-version: >= 1.10 license: BSD3 license-file: LICENSE @@ -52,12 +52,12 @@ library , directory >= 1.3 && < 1.4 , filepath >= 1.4 && < 1.5 - , copilot-core >= 3.16.1 && < 3.17 - , copilot-theorem >= 3.16.1 && < 3.17 - , copilot-language >= 3.16.1 && < 3.17 - , copilot-libraries >= 3.16.1 && < 3.17 - , copilot-c99 >= 3.16.1 && < 3.17 - , copilot-prettyprinter >= 3.16.1 && < 3.17 + , copilot-core >= 3.17 && < 3.18 + , copilot-theorem >= 3.17 && < 3.18 + , copilot-language >= 3.17 && < 3.18 + , copilot-libraries >= 3.17 && < 3.18 + , copilot-c99 >= 3.17 && < 3.18 + , copilot-prettyprinter >= 3.17 && < 3.18 exposed-modules: Language.Copilot, Language.Copilot.Main From fe10732c7e718b54cceb9d1cf729ab9ac70b4fc3 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 7 Nov 2023 10:57:23 -0800 Subject: [PATCH 0685/1222] Document changes in CHANGELOG. Refs #466. --- copilot-c99/CHANGELOG | 3 ++- copilot-core/CHANGELOG | 3 ++- copilot-interpreter/CHANGELOG | 3 ++- copilot-language/CHANGELOG | 3 +++ copilot-libraries/CHANGELOG | 3 +++ copilot-prettyprinter/CHANGELOG | 3 +++ copilot-theorem/CHANGELOG | 3 ++- copilot/CHANGELOG | 3 ++- 8 files changed, 19 insertions(+), 5 deletions(-) diff --git a/copilot-c99/CHANGELOG b/copilot-c99/CHANGELOG index 12382d90a..df7352597 100644 --- a/copilot-c99/CHANGELOG +++ b/copilot-c99/CHANGELOG @@ -1,4 +1,5 @@ -2023-11-05 +2023-11-07 + * Version bump (3.17). (#466) * Replace uses of deprecated functions. (#457) 2023-09-07 diff --git a/copilot-core/CHANGELOG b/copilot-core/CHANGELOG index cf836f048..004210696 100644 --- a/copilot-core/CHANGELOG +++ b/copilot-core/CHANGELOG @@ -1,4 +1,5 @@ -2023-11-05 +2023-11-07 + * Version bump (3.17). (#466) * Compliance with style guide. (#457) 2023-09-07 diff --git a/copilot-interpreter/CHANGELOG b/copilot-interpreter/CHANGELOG index b4bbd09f5..2a0f148a1 100644 --- a/copilot-interpreter/CHANGELOG +++ b/copilot-interpreter/CHANGELOG @@ -1,4 +1,5 @@ -2023-11-05 +2023-11-07 + * Version bump (3.17). (#466) * Replace uses of deprecated functions. (#457) 2023-09-07 diff --git a/copilot-language/CHANGELOG b/copilot-language/CHANGELOG index 43616648f..71215201b 100644 --- a/copilot-language/CHANGELOG +++ b/copilot-language/CHANGELOG @@ -1,3 +1,6 @@ +2023-11-07 + * Version bump (3.17). (#466) + 2023-09-07 * Version bump (3.16.1). (#455) diff --git a/copilot-libraries/CHANGELOG b/copilot-libraries/CHANGELOG index 9d7e35086..4810f9ef4 100644 --- a/copilot-libraries/CHANGELOG +++ b/copilot-libraries/CHANGELOG @@ -1,3 +1,6 @@ +2023-11-07 + * Version bump (3.17). (#466) + 2023-09-07 * Version bump (3.16.1). (#455) * Fix semantics of since in Copilot.Library.PTLTL. (#443) diff --git a/copilot-prettyprinter/CHANGELOG b/copilot-prettyprinter/CHANGELOG index c982374b6..eb2cfdd95 100644 --- a/copilot-prettyprinter/CHANGELOG +++ b/copilot-prettyprinter/CHANGELOG @@ -1,3 +1,6 @@ +2023-11-07 + * Version bump (3.17). (#466) + 2023-11-05 * Replace uses of deprecated functions. (#457) diff --git a/copilot-theorem/CHANGELOG b/copilot-theorem/CHANGELOG index be9e693f0..025312f98 100644 --- a/copilot-theorem/CHANGELOG +++ b/copilot-theorem/CHANGELOG @@ -1,4 +1,5 @@ -2023-11-05 +2023-11-07 + * Version bump (3.17). (#466) * Relax version constraint on what4. (#461) * Replace uses of deprecated functions. (#457) diff --git a/copilot/CHANGELOG b/copilot/CHANGELOG index b3764b01e..58a41afbe 100644 --- a/copilot/CHANGELOG +++ b/copilot/CHANGELOG @@ -1,4 +1,5 @@ -2023-11-05 +2023-11-07 + * Version bump (3.17). (#466) * Replace uses of deprecated functions. (#457) 2023-11-03 From a3b3ece30130f0a8c4d0d73b116fa7168e36b484 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 14 Dec 2023 00:41:32 -0800 Subject: [PATCH 0686/1222] copilot-c99: Change return type of main generated for tests. Refs #468. copilot-c99's tests sometimes fail because the return code of the programs being generated and executed during tests is not zero. When such tests are executed, the test interprets non-zero exit codes as failures. More specifically, the return type of the main function included in the generated C code is void, and compilers are not mandated to end the process with a zero return code in such cases. This commit modifies the type of the main function used during tests to make it an int. C compilers will then make the exit code zero by default. --- copilot-c99/tests/Test/Copilot/Compile/C99.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot-c99/tests/Test/Copilot/Compile/C99.hs b/copilot-c99/tests/Test/Copilot/Compile/C99.hs index dfca17809..542641a6b 100644 --- a/copilot-c99/tests/Test/Copilot/Compile/C99.hs +++ b/copilot-c99/tests/Test/Copilot/Compile/C99.hs @@ -157,7 +157,7 @@ testRun = ioProperty $ do , "void nop () {" , "}" , "" - , "void main () {" + , "int main () {" , " step();" , "}" ] From 1da7ac48f400d06c06935fe926b994e3c9e65e5f Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 14 Dec 2023 00:48:04 -0800 Subject: [PATCH 0687/1222] copilot-c99: Document changes in CHANGELOG. Refs #468. --- copilot-c99/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-c99/CHANGELOG b/copilot-c99/CHANGELOG index df7352597..f648fc969 100644 --- a/copilot-c99/CHANGELOG +++ b/copilot-c99/CHANGELOG @@ -1,3 +1,6 @@ +2023-12-14 + * Change return type of main generated for tests. (#468) + 2023-11-07 * Version bump (3.17). (#466) * Replace uses of deprecated functions. (#457) From 2bd21f6503c52eb0dd3b0992c6523693a4af1cec Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 17 Dec 2023 17:09:42 +0000 Subject: [PATCH 0688/1222] copilot-language: Add type annotation to help type inference engine. Refs #469. copilot-language's tests fail to compile with GHC 9.4. Prior versions made some arbitrary decisions during type interfence, and the new type checker will simply reject such programs. This commit modifies a function in the tests that uses an existential type, by adding an explicit type signature. Doing so helps GHC versions after 9.4 typecheck the code. --- copilot-language/tests/Test/Copilot/Language/Reify.hs | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/copilot-language/tests/Test/Copilot/Language/Reify.hs b/copilot-language/tests/Test/Copilot/Language/Reify.hs index e056d946a..b9d5085ba 100644 --- a/copilot-language/tests/Test/Copilot/Language/Reify.hs +++ b/copilot-language/tests/Test/Copilot/Language/Reify.hs @@ -31,7 +31,7 @@ import qualified Copilot.Language.Operators.Integral as Copilot import qualified Copilot.Language.Operators.Mux as Copilot import qualified Copilot.Language.Operators.Ord as Copilot import Copilot.Language.Reify (reify) -import Copilot.Language.Spec (observer) +import Copilot.Language.Spec (Spec, observer) import Copilot.Language.Stream (Stream) import qualified Copilot.Language.Stream as Copilot @@ -732,7 +732,11 @@ semanticsShowK steps (SemanticsP (expr, exprList)) = checkSemanticsP :: Int -> [a] -> SemanticsP -> IO Bool checkSemanticsP steps _streams (SemanticsP (expr, exprList)) = do -- Spec with just one observer of one expression. - let spec = observer testObserverName expr + -- + -- Because SemanticsP is an existential type, we need to help GHC figure + -- out the type of spec. + let spec :: Spec + spec = observer testObserverName expr -- Reified stream (low-level) llSpec <- reify spec From e25c7afaf743a5fdc7a9638516f59b006383bef0 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 17 Dec 2023 17:13:06 +0000 Subject: [PATCH 0689/1222] copilot-language: Document changes in CHANGELOG. Refs #469. --- copilot-language/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-language/CHANGELOG b/copilot-language/CHANGELOG index 71215201b..44d0b6970 100644 --- a/copilot-language/CHANGELOG +++ b/copilot-language/CHANGELOG @@ -1,3 +1,6 @@ +2023-12-17 + * Add type annotation to help type inference engine. (#469) + 2023-11-07 * Version bump (3.17). (#466) From 05815aa9a31fbcf00fcddbb5b0f6cde85e360566 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 17 Dec 2023 22:38:09 +0000 Subject: [PATCH 0690/1222] copilot-c99: Print constants in tests using portable suffixes. Refs #471. The code generated by copilot-c99 during tests produces warnings during compilation. The reason is that some constants included in the code are too big and the compiler is making assumptions about their necessary types. If those constants are annotated, their intention will be made clearer. This commit modifies the CShow instance for integer and unsigned integer constants, which is used to print them in the test C code generated, so that they use portable macros from stdint.h to print the number with the right suffixes. --- copilot-c99/tests/Test/Copilot/Compile/C99.hs | 40 +++++++++++++++---- 1 file changed, 32 insertions(+), 8 deletions(-) diff --git a/copilot-c99/tests/Test/Copilot/Compile/C99.hs b/copilot-c99/tests/Test/Copilot/Compile/C99.hs index 542641a6b..60276e870 100644 --- a/copilot-c99/tests/Test/Copilot/Compile/C99.hs +++ b/copilot-c99/tests/Test/Copilot/Compile/C99.hs @@ -886,28 +886,52 @@ class CShow s where cshow :: s -> String instance CShow Int8 where - cshow = show + -- Use a macro to ensure that any necessary suffixes are added to the number. + -- We choose this macro instead of specifically adding a suffix for reasons + -- of portability. + cshow x = "INT8_C(" ++ show x ++ ")" instance CShow Int16 where - cshow = show + -- Use a macro to ensure that any necessary suffixes are added to the number. + -- We choose this macro instead of specifically adding a suffix for reasons + -- of portability. + cshow x = "INT16_C(" ++ show x ++ ")" instance CShow Int32 where - cshow = show + -- Use a macro to ensure that any necessary suffixes are added to the number. + -- We choose this macro instead of specifically adding a suffix for reasons + -- of portability. + cshow x = "INT32_C(" ++ show x ++ ")" instance CShow Int64 where - cshow = show + -- Use a macro to ensure that any necessary suffixes are added to the number. + -- We choose this macro instead of specifically adding a suffix for reasons + -- of portability. + cshow x = "INT64_C(" ++ show x ++ ")" instance CShow Word8 where - cshow = show + -- Use a macro to ensure that any necessary suffixes are added to the number. + -- We choose this macro instead of specifically adding a suffix for reasons + -- of portability. + cshow x = "UINT8_C(" ++ show x ++ ")" instance CShow Word16 where - cshow = show + -- Use a macro to ensure that any necessary suffixes are added to the number. + -- We choose this macro instead of specifically adding a suffix for reasons + -- of portability. + cshow x = "UINT16_C(" ++ show x ++ ")" instance CShow Word32 where - cshow = show + -- Use a macro to ensure that any necessary suffixes are added to the number. + -- We choose this macro instead of specifically adding a suffix for reasons + -- of portability. + cshow x = "UINT32_C(" ++ show x ++ ")" instance CShow Word64 where - cshow = show + -- Use a macro to ensure that any necessary suffixes are added to the number. + -- We choose this macro instead of specifically adding a suffix for reasons + -- of portability. + cshow x = "UINT64_C(" ++ show x ++ ")" instance CShow Float where cshow = show From f06f9038d3f40fad30da5d9806cfe210c4a7a2b0 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 17 Dec 2023 22:41:25 +0000 Subject: [PATCH 0691/1222] copilot-c99: Document changes in CHANGELOG. Refs #471. --- copilot-c99/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot-c99/CHANGELOG b/copilot-c99/CHANGELOG index f648fc969..b22788fce 100644 --- a/copilot-c99/CHANGELOG +++ b/copilot-c99/CHANGELOG @@ -1,5 +1,6 @@ -2023-12-14 +2023-12-17 * Change return type of main generated for tests. (#468) + * Print constants in tests using portable suffixes. (#471). 2023-11-07 * Version bump (3.17). (#466) From 25f31316573c210891de3a628cc393ffbbac186a Mon Sep 17 00:00:00 2001 From: Ryan Scott Date: Sat, 9 Dec 2023 16:10:43 -0500 Subject: [PATCH 0692/1222] copilot-c99: Pass output arrays as arguments to trigger argument functions. Refs #431. Copilot's C99 backend generates incorrect code for trigger argument functions that return constant arrays. Currently, the code will return a pointer to a stack-allocated array. That memory may be used for something else after the call to the trigger argument function, so it may be overwritten or freed by the time the array is used. This may lead to the array holding incorrect values. This is almost the same issue that was noticed in #386, except that #386 was specifically about stream generator functions, whereas this issue is specifically about trigger argument functions. This commit changes array trigger argument functions so that they receive a pointer to an array for the output argument. The part of the generated code that applies the trigger argument functions has also been updated accordingly such that when the argument has an array type, the output array is passed directly as an argument (e.g., `f_arg0(temp_array)`) rather than being assigned (e.g., `temp_array = f_arg0()`). Because we pass output arrays directly to trigger argument functions, we no longer have to have a special case in the code for declaring temporary variables for output arrays as pointers (e.g., `int* temp_array;`). Instead, we can declare these temporary variables directly as arrays (e.g., `int temp_array[2];`). This makes the intent clearer and simplifies the implementation in `copilot-c99`. --- .../src/Copilot/Compile/C99/CodeGen.hs | 36 ++++++++----------- .../src/Copilot/Compile/C99/Compile.hs | 5 ++- 2 files changed, 19 insertions(+), 22 deletions(-) diff --git a/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs b/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs index 23b9de256..d4f115ae4 100644 --- a/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs +++ b/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs @@ -250,22 +250,8 @@ mkStep cSettings streams triggers exts = aTmpDeclns = zipWith declare args aTempNames where declare :: UExpr -> C.Ident -> C.Decln - declare arg tmpVar = - C.VarDecln Nothing (tempType arg) tmpVar Nothing - - -- Type of the temporary variable used to store values of the type - -- of a given expression. - tempType :: UExpr -> C.Type - tempType (UExpr { uExprType = ty }) = - case ty of - -- If a temporary variable is being used to store an array, - -- declare the type of the temporary variable as a pointer, not - -- an array. The problem with declaring it as an array is that - -- the `arg` function will return a pointer, not an array, and - -- C doesn't make it easy to cast directly from an array to a - -- pointer. - Array ty' -> C.Ptr $ transType ty' - _ -> transType ty + declare (UExpr { uExprType = ty }) tmpVar = + C.VarDecln Nothing (transType ty) tmpVar Nothing triggerCheckStmt :: C.Stmt triggerCheckStmt = C.If guard' fireTrigger @@ -283,13 +269,21 @@ mkStep cSettings streams triggers exts = where -- List of assignments of values of temporary variables. argAssigns :: [C.Expr] - argAssigns = zipWith assign aTempNames args' + argAssigns = zipWith3 assign aTempNames aArgNames args - assign :: C.Ident -> C.Expr -> C.Expr - assign aTempName = C.AssignOp C.Assign (C.Ident aTempName) + assign :: C.Ident -> C.Ident -> UExpr -> C.Expr + assign aTempName aArgName (UExpr { uExprType = ty }) = + case ty of + Array _ -> argCall aArgName [C.Ident aTempName] + _ -> C.AssignOp C.Assign + (C.Ident aTempName) + (argCall aArgName []) + + aArgNames :: [C.Ident] + aArgNames = take (length args) (argNames name) - args' = take (length args) (map argCall (argNames name)) - argCall name' = C.Funcall (C.Ident name') [] + argCall :: C.Ident -> [C.Expr] -> C.Expr + argCall name' = C.Funcall (C.Ident name') -- Build an expression to pass a temporary variable as argument -- to a trigger handler. diff --git a/copilot-c99/src/Copilot/Compile/C99/Compile.hs b/copilot-c99/src/Copilot/Compile/C99/Compile.hs index bf7c05784..7133bab06 100644 --- a/copilot-c99/src/Copilot/Compile/C99/Compile.hs +++ b/copilot-c99/src/Copilot/Compile/C99/Compile.hs @@ -130,7 +130,10 @@ compileC cSettings spec = C.TransUnit declns funs argDefs = zipWith argGen (argNames name) args argGen :: String -> UExpr -> C.FunDef - argGen argName (UExpr ty expr) = mkGenFun argName expr ty + argGen argName (UExpr ty expr) = + case ty of + Array _ -> mkGenFunArray argName (argName ++ "_output") expr ty + _ -> mkGenFun argName expr ty -- | Generate the .h file from a 'Spec'. compileH :: CSettings -> Spec -> C.TransUnit From 501c99aef0864aa1d5b626c280d0746d9a802ae5 Mon Sep 17 00:00:00 2001 From: Ryan Scott Date: Tue, 19 Dec 2023 14:38:02 -0500 Subject: [PATCH 0693/1222] copilot-c99: Refactor variable update functionality. Refs #431. The previous commit introduced functionality for handling array arguments in trigger argument functions as a special case. The special-casing needed to handle array arguments in trigger argument functions is nearly identical to the special-casing needed in stream generator functions. This patch refactors the code to share the special-casing in common between the two sorts of functions. --- .../src/Copilot/Compile/C99/CodeGen.hs | 25 +++++++++---------- .../src/Copilot/Compile/C99/Compile.hs | 20 ++++++++++----- 2 files changed, 26 insertions(+), 19 deletions(-) diff --git a/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs b/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs index d4f115ae4..70bb71aad 100644 --- a/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs +++ b/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs @@ -163,6 +163,16 @@ mkStep cSettings streams triggers exts = (triggerDeclns, triggerStmts) = unzip $ map mkTriggerCheck triggers + -- Update the value of a variable with the result of calling a function that + -- generates the next value in a stream expression. If the type of the + -- variable is an array, then we cannot perform a direct C assignment, so + -- we instead pass the variable as an output array to the function. + updateVar :: C.Ident -> C.Ident -> Type a -> C.Expr + updateVar varName genName (Array _) = + C.Funcall (C.Ident genName) [C.Ident varName] + updateVar varName genName _ = + C.AssignOp C.Assign (C.Ident varName) (C.Funcall (C.Ident genName) []) + -- Write code to update global stream buffers and index. mkUpdateGlobals :: Stream -> (C.Decln, C.Stmt, C.Stmt, C.Stmt) mkUpdateGlobals (Stream sId buff _expr ty) = @@ -170,10 +180,7 @@ mkStep cSettings streams triggers exts = where tmpDecln = C.VarDecln Nothing cTy tmpVar Nothing - tmpAssign = case ty of - Array _ -> C.Expr $ C.Funcall (C.Ident $ generatorName sId) - [ C.Ident tmpVar ] - _ -> C.Expr $ C.Ident tmpVar C..= val + tmpAssign = C.Expr $ updateVar tmpVar (generatorName sId) ty bufferUpdate = case ty of Array _ -> C.Expr $ memcpy dest (C.Ident tmpVar) size @@ -193,7 +200,6 @@ mkStep cSettings streams triggers exts = tmpVar = streamName sId ++ "_tmp" buffVar = C.Ident $ streamName sId indexVar = C.Ident $ indexName sId - val = C.Funcall (C.Ident $ generatorName sId) [] cTy = transType ty -- Make code that copies an external variable to its local one. @@ -273,18 +279,11 @@ mkStep cSettings streams triggers exts = assign :: C.Ident -> C.Ident -> UExpr -> C.Expr assign aTempName aArgName (UExpr { uExprType = ty }) = - case ty of - Array _ -> argCall aArgName [C.Ident aTempName] - _ -> C.AssignOp C.Assign - (C.Ident aTempName) - (argCall aArgName []) + updateVar aTempName aArgName ty aArgNames :: [C.Ident] aArgNames = take (length args) (argNames name) - argCall :: C.Ident -> [C.Expr] -> C.Expr - argCall name' = C.Funcall (C.Ident name') - -- Build an expression to pass a temporary variable as argument -- to a trigger handler. -- diff --git a/copilot-c99/src/Copilot/Compile/C99/Compile.hs b/copilot-c99/src/Copilot/Compile/C99/Compile.hs index 7133bab06..515078258 100644 --- a/copilot-c99/src/Copilot/Compile/C99/Compile.hs +++ b/copilot-c99/src/Copilot/Compile/C99/Compile.hs @@ -119,9 +119,8 @@ compileC cSettings spec = C.TransUnit declns funs accessDecln (Stream sId buff _ ty) = mkAccessDecln sId ty buff streamGen :: Stream -> C.FunDef - streamGen (Stream sId _ expr ty@(Array _)) = - mkGenFunArray (generatorName sId) (generatorOutputArgName sId) expr ty - streamGen (Stream sId _ expr ty) = mkGenFun (generatorName sId) expr ty + streamGen (Stream sId _ expr ty) = + exprGen (generatorName sId) (generatorOutputArgName sId) expr ty triggerGen :: Trigger -> [C.FunDef] triggerGen (Trigger name guard args) = guardDef : argDefs @@ -131,9 +130,18 @@ compileC cSettings spec = C.TransUnit declns funs argGen :: String -> UExpr -> C.FunDef argGen argName (UExpr ty expr) = - case ty of - Array _ -> mkGenFunArray argName (argName ++ "_output") expr ty - _ -> mkGenFun argName expr ty + exprGen argName (argName ++ "_output") expr ty + + -- Create a function that calculates the current value generated by an + -- expression `expr` of type `ty`. The generator treats arrays + -- specially, and the function takes an output array as a parameter. + -- The second identifier `outputArrName` is not used if `expr` is not an + -- array. + exprGen :: C.Ident -> C.Ident -> Expr a -> Type a -> C.FunDef + exprGen funName outputArrName expr ty@(Array _) = + mkGenFunArray funName outputArrName expr ty + exprGen funName _ expr ty = + mkGenFun funName expr ty -- | Generate the .h file from a 'Spec'. compileH :: CSettings -> Spec -> C.TransUnit From e975b4a0e007241f14e1c1032f46111ec4d69e83 Mon Sep 17 00:00:00 2001 From: Ryan Scott Date: Wed, 13 Dec 2023 07:51:35 -0500 Subject: [PATCH 0694/1222] copilot-c99: Document changes in CHANGELOG. Refs #431. --- copilot-c99/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot-c99/CHANGELOG b/copilot-c99/CHANGELOG index b22788fce..7a9315d43 100644 --- a/copilot-c99/CHANGELOG +++ b/copilot-c99/CHANGELOG @@ -1,6 +1,7 @@ -2023-12-17 +2023-12-19 * Change return type of main generated for tests. (#468) * Print constants in tests using portable suffixes. (#471). + * Pass output arrays as arguments to trigger argument functions. (#431) 2023-11-07 * Version bump (3.17). (#466) From d6d772c5d22a470327a5cdf8b3a9ca4647fda7db Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 7 Nov 2023 09:25:21 -0800 Subject: [PATCH 0695/1222] copilot-theorem: Introduce testing infrastructure for Copilot.Theorem.What4. Refs #474. As part of the requirements for Class D (NPR7150.2C), we need unit tests for all of copilot. This commit introduces testing infrastructure for Copilot.Theorem.What4. The module only defines some basic tests using Z3, but it does not exploit all possible solvers supported by What4, or other connections provided by other modules in copilot-theorem. We do so to limit the scope (and thefore difficulty) of the change, and because old modules that provided backends that we can now connect through What4 will likely disappear from future versions of copilot-theorem. --- copilot-theorem/copilot-theorem.cabal | 28 +++++ copilot-theorem/tests/Main.hs | 18 +++ .../tests/Test/Copilot/Theorem/What4.hs | 108 ++++++++++++++++++ 3 files changed, 154 insertions(+) create mode 100644 copilot-theorem/tests/Main.hs create mode 100644 copilot-theorem/tests/Test/Copilot/Theorem/What4.hs diff --git a/copilot-theorem/copilot-theorem.cabal b/copilot-theorem/copilot-theorem.cabal index 142c29d60..fedd81556 100644 --- a/copilot-theorem/copilot-theorem.cabal +++ b/copilot-theorem/copilot-theorem.cabal @@ -108,3 +108,31 @@ library , Copilot.Theorem.TransSys.Type , Copilot.Theorem.What4.Translate + +test-suite unit-tests + type: + exitcode-stdio-1.0 + + main-is: + Main.hs + + other-modules: + Test.Copilot.Theorem.What4 + + build-depends: + base + , QuickCheck + , test-framework + , test-framework-quickcheck2 + + , copilot-core + , copilot-theorem + + hs-source-dirs: + tests + + default-language: + Haskell2010 + + ghc-options: + -Wall diff --git a/copilot-theorem/tests/Main.hs b/copilot-theorem/tests/Main.hs new file mode 100644 index 000000000..780a4e1ec --- /dev/null +++ b/copilot-theorem/tests/Main.hs @@ -0,0 +1,18 @@ +-- | Test copilot-theorem. +module Main where + +-- External imports +import Test.Framework (Test, defaultMain) + +-- Internal imports +import qualified Test.Copilot.Theorem.What4 + +-- | Run all unit tests on copilot-theorem. +main :: IO () +main = defaultMain tests + +-- | All unit tests in copilot-theorem. +tests :: [Test.Framework.Test] +tests = + [ Test.Copilot.Theorem.What4.tests + ] diff --git a/copilot-theorem/tests/Test/Copilot/Theorem/What4.hs b/copilot-theorem/tests/Test/Copilot/Theorem/What4.hs new file mode 100644 index 000000000..8297ba262 --- /dev/null +++ b/copilot-theorem/tests/Test/Copilot/Theorem/What4.hs @@ -0,0 +1,108 @@ +-- The following warning is disabled due to a necessary instance of SatResult +-- defined in this module. +{-# OPTIONS_GHC -fno-warn-orphans #-} +-- | Test copilot-theorem:Copilot.Theorem.What4. +module Test.Copilot.Theorem.What4 where + +-- External imports +import Data.Int (Int8) +import Test.Framework (Test, testGroup) +import Test.Framework.Providers.QuickCheck2 (testProperty) +import Test.QuickCheck (Property, arbitrary, forAll) +import Test.QuickCheck.Monadic (monadicIO, run) + +-- External imports: Copilot +import Copilot.Core.Expr (Expr (Const, Op2)) +import Copilot.Core.Operators (Op2 (..)) +import Copilot.Core.Spec (Spec (..)) +import qualified Copilot.Core.Spec as Copilot +import Copilot.Core.Type (Typed (typeOf)) + +-- Internal imports: Modules being tested +import Copilot.Theorem.What4 (SatResult (..), Solver (..), prove) + +-- * Constants + +-- | Unit tests for copilot-theorem:Copilot.Theorem.What4. +tests :: Test.Framework.Test +tests = + testGroup "Copilot.Theorem.What4" + [ testProperty "Prove via Z3 that true is valid" testProveZ3True + , testProperty "Prove via Z3 that false is invalid" testProveZ3False + , testProperty "Prove via Z3 that x == x is valid" testProveZ3EqConst + ] + +-- * Individual tests + +-- | Test that Z3 is able to prove the following expression valid: +-- @ +-- constant True +-- @ +testProveZ3True :: Property +testProveZ3True = + monadicIO $ run $ checkResult Z3 propName spec Valid + where + propName :: String + propName = "prop" + + spec :: Spec + spec = propSpec propName $ Const typeOf True + +-- | Test that Z3 is able to prove the following expression invalid: +-- @ +-- constant False +-- @ +testProveZ3False :: Property +testProveZ3False = + monadicIO $ run $ checkResult Z3 propName spec Invalid + where + propName :: String + propName = "prop" + + spec :: Spec + spec = propSpec propName $ Const typeOf False + +-- | Test that Z3 is able to prove the following expresion valid: +-- @ +-- for all (x :: Int8), constant x == constant x +-- @ +testProveZ3EqConst :: Property +testProveZ3EqConst = forAll arbitrary $ \x -> + monadicIO $ run $ checkResult Z3 propName (spec x) Valid + where + propName :: String + propName = "prop" + + spec :: Int8 -> Spec + spec x = propSpec propName $ + Op2 (Eq typeOf) (Const typeOf x) (Const typeOf x) + +-- | Check that the solver's satisfiability result for the given property in +-- the given spec matches the expectation. +checkResult :: Solver -> String -> Spec -> SatResult -> IO Bool +checkResult solver propName spec expectation = do + results <- prove solver spec + + -- Find the satisfiability result for propName. + let propResult = lookup propName results + + -- The following check also works for the case in which the property name + -- does not exist in the results, in which case the lookup returns 'Nothing'. + return $ propResult == Just expectation + +-- * Auxiliary + +-- | Build a 'Spec' that contains one property with the given name and defined +-- by the given boolean expression. +propSpec :: String -> Expr Bool -> Spec +propSpec propName propExpr = Spec [] [] [] [Copilot.Property propName propExpr] + +-- | Equality for 'SatResult'. +-- +-- This is an orphan instance, so we suppress the warning that GHC would +-- normally produce with a GHC option at the top. +instance Eq SatResult where + Valid == Valid = True + Invalid == Invalid = True + Unknown == Unknown = True + _ == _ = False From 1373ff995b43a76838a0cf57cfd266a472b95ebe Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 19 Dec 2023 07:46:40 +0000 Subject: [PATCH 0696/1222] copilot: Enable tests for copilot-theorem in CI script. Refs #474. As part of the test plan included to comply with NPR7150.2, Copilot is required to run tests for every change, before it is integrated in the codebase. This commit expands the tests run for every pull request, before it is accepted, to include also copilot-theorem. --- .travis.yml | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/.travis.yml b/.travis.yml index cf88b9d51..5958a9625 100644 --- a/.travis.yml +++ b/.travis.yml @@ -15,6 +15,11 @@ before_install: - travis_retry sudo add-apt-repository -y ppa:hvr/ghc - travis_retry sudo apt-get update - travis_retry sudo apt-get install cabal-install-$CABALVER ghc-$GHCVER # see note about happy/alex + + # We install z3 only for the tests, since it is not needed for normal + # compilation. + - if [ "${GHCVER}" == "8.10.4" ]; then travis_retry sudo apt-get install --yes z3; fi + - export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$PATH - cabal --version - echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo '?')]" @@ -27,4 +32,7 @@ script: # Run tests only on GHC 8.10.4 # # Only libraries with tests are listed below or the v2-test command fails. - - if [ "${GHCVER}" == "8.10.4" ]; then cabal v2-test -j1 copilot-core copilot-language copilot-interpreter copilot-c99; fi + # + # Testing copilot-theorem requires z3. See above conditional installation, + # and keep GHC version numbers in both places in sync. + - if [ "${GHCVER}" == "8.10.4" ]; then cabal v2-test -j1 copilot-core copilot-language copilot-interpreter copilot-c99 copilot-theorem; fi From 9643615b2c9d68b48744fd5776873eca353839da Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 19 Dec 2023 07:03:29 +0000 Subject: [PATCH 0697/1222] copilot-theorem: Document changes in CHANGELOG. Refs #474. --- copilot-theorem/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-theorem/CHANGELOG b/copilot-theorem/CHANGELOG index 025312f98..d6accbf3b 100644 --- a/copilot-theorem/CHANGELOG +++ b/copilot-theorem/CHANGELOG @@ -1,3 +1,6 @@ +2023-12-18 + * Introduce testing infrastructure for Copilot.Theorem.What4. (#474) + 2023-11-07 * Version bump (3.17). (#466) * Relax version constraint on what4. (#461) From e717ae2620bfd7cf8e2339addb74eb2c7e1f64ea Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 19 Dec 2023 07:49:20 +0000 Subject: [PATCH 0698/1222] copilot: Document changes in CHANGELOG. Refs #474. --- copilot/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot/CHANGELOG b/copilot/CHANGELOG index 58a41afbe..706573829 100644 --- a/copilot/CHANGELOG +++ b/copilot/CHANGELOG @@ -1,3 +1,6 @@ +2023-12-18 + * Enable tests for copilot-theorem in CI script. (#474) + 2023-11-07 * Version bump (3.17). (#466) * Replace uses of deprecated functions. (#457) From 48b56217d5557e6936d4d4bcd8bcb0a7ff2b0105 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 21 Dec 2023 01:30:54 +0000 Subject: [PATCH 0699/1222] copilot-libraries: Introduce testing infrastructure for Copilot.Library. Refs #475. As part of the requirements for Class D (NPR7150.2C), we need unit tests for all of Copilot. This commit introduces testing infrastructure for Copilot.Library. The module only defines some basic tests specifically for the PTLTL module, using both evaluation (interpretation) and an SMT-solver (via what4, with Z3). The commit only seeks to introduce the infrastructure needed to test other definitions provided by the library, and to demonstrate how such infrastructure can be used. --- copilot-libraries/copilot-libraries.cabal | 31 + copilot-libraries/tests/Main.hs | 18 + .../tests/Test/Copilot/Library/PTLTL.hs | 72 +++ copilot-libraries/tests/Test/Extra.hs | 555 ++++++++++++++++++ 4 files changed, 676 insertions(+) create mode 100644 copilot-libraries/tests/Main.hs create mode 100644 copilot-libraries/tests/Test/Copilot/Library/PTLTL.hs create mode 100644 copilot-libraries/tests/Test/Extra.hs diff --git a/copilot-libraries/copilot-libraries.cabal b/copilot-libraries/copilot-libraries.cabal index f93304cd5..704823643 100644 --- a/copilot-libraries/copilot-libraries.cabal +++ b/copilot-libraries/copilot-libraries.cabal @@ -57,3 +57,34 @@ library ghc-options: -Wall + +test-suite unit-tests + type: + exitcode-stdio-1.0 + + main-is: + Main.hs + + other-modules: + Test.Copilot.Library.PTLTL + Test.Extra + + build-depends: + base + , QuickCheck + , test-framework + , test-framework-quickcheck2 + + , copilot-interpreter + , copilot-language + , copilot-libraries + , copilot-theorem + + hs-source-dirs: + tests + + default-language: + Haskell2010 + + ghc-options: + -Wall diff --git a/copilot-libraries/tests/Main.hs b/copilot-libraries/tests/Main.hs new file mode 100644 index 000000000..018134083 --- /dev/null +++ b/copilot-libraries/tests/Main.hs @@ -0,0 +1,18 @@ +-- | Test copilot-libraries. +module Main where + +-- External imports +import Test.Framework (Test, defaultMain) + +-- Internal imports +import qualified Test.Copilot.Library.PTLTL + +-- | Run all unit tests on copilot-libraries. +main :: IO () +main = defaultMain tests + +-- | All unit tests in copilot-libraries. +tests :: [Test.Framework.Test] +tests = + [ Test.Copilot.Library.PTLTL.tests + ] diff --git a/copilot-libraries/tests/Test/Copilot/Library/PTLTL.hs b/copilot-libraries/tests/Test/Copilot/Library/PTLTL.hs new file mode 100644 index 000000000..58c002308 --- /dev/null +++ b/copilot-libraries/tests/Test/Copilot/Library/PTLTL.hs @@ -0,0 +1,72 @@ +-- | Test copilot-libraries:Copilot.Library.PTLTL +module Test.Copilot.Library.PTLTL + (tests) + where + +-- External imports +import Test.Framework (Test, testGroup) +import Test.Framework.Providers.QuickCheck2 (testProperty) +import Test.QuickCheck (Gen, Property) + +-- External imports: Copilot +import Copilot.Language (extern) +import qualified Copilot.Language.Operators.Boolean as Copilot +import Copilot.Language.Stream (Stream) +import Copilot.Theorem.What4 (SatResult (..)) + +-- Internal imports: auxiliary functions +import Test.Extra (arbitraryBoolExpr, testWithInterpreter, testWithTheorem) + +-- Internal imports: Modules being tested +import Copilot.Library.PTLTL (eventuallyPrev, previous) + +-- * Constants + +-- | Unit tests for copilot-libraries:Copilot.Library.PTLTL. +tests :: Test.Framework.Test +tests = + testGroup "Copilot.Library.PTLTL" + [ testProperty "previous x ==> eventuallyPrev x (theorem)" + testProvePreviousEventually + , testProperty "previous x ==> eventuallyPrev x (interpreter)" + testCheckPreviousEventually + ] + +-- * Individual tests + +-- | Test that Z3 is able to prove the following expression valid: +-- @ +-- previous x ==> eventuallyPrev x +-- @ +testProvePreviousEventually :: Property +testProvePreviousEventually = testWithTheorem pair + where + pair :: Gen (Stream Bool, SatResult) + pair = pure (stream, expectation) + + stream :: Stream Bool + stream = + previous boolStream Copilot.==> eventuallyPrev boolStream + where + boolStream = extern "x" Nothing + + expectation :: SatResult + expectation = Valid + +-- | Test that the following stream is always true: +-- @ +-- previous x ==> eventuallyPrev x +-- @ +testCheckPreviousEventually :: Property +testCheckPreviousEventually = testWithInterpreter pair + where + pair :: Gen (Stream Bool, [Bool]) + pair = do + -- We discard the expectation from the expression; the temporal formula + -- holds at all times regardless. + boolStream <- fst <$> arbitraryBoolExpr + let prop = previous boolStream Copilot.==> eventuallyPrev boolStream + return (prop, expectation) + + expectation :: [Bool] + expectation = repeat True diff --git a/copilot-libraries/tests/Test/Extra.hs b/copilot-libraries/tests/Test/Extra.hs new file mode 100644 index 000000000..44d7a5272 --- /dev/null +++ b/copilot-libraries/tests/Test/Extra.hs @@ -0,0 +1,555 @@ +-- The following warning is disabled due to a necessary instance of SatResult +-- defined in this module. +{-# OPTIONS_GHC -fno-warn-orphans #-} +-- | Testing facilities based on the connection to SMT solvers and the +-- interpreter. +-- +-- This module provides functions to check if a stream meets some expectation, +-- and to generate random streams. +-- +-- The test against an expectation can be done by checking a boolean stream +-- with copilot-theorem and comparing it with the expected validity, or by +-- evaluating a stream with the interpreter and comparing it with the expected +-- list of values it should contain. +module Test.Extra + ( + -- * Test using copilot-theorem + testWithTheorem + + -- * Test using copilot-interpreter + , testWithInterpreter + + -- * Random Stream generators + , arbitraryConst + , arbitraryBoolExpr + , arbitraryNumExpr + , arbitraryFloatingExpr + , arbitraryBitsExpr + ) + where + +-- External imports +import Control.Arrow ((***)) +import Control.Monad (void) +import Data.Bits (Bits, complement, xor, (.&.), (.|.)) +import Data.Int (Int16, Int32, Int64, Int8) +import Data.Maybe (fromMaybe) +import Data.Word (Word16, Word32, Word64, Word8) +import Test.QuickCheck (Arbitrary, Gen, Property, arbitrary, chooseInt, + elements, forAll, forAllShow, frequency) +import Test.QuickCheck.Monadic (monadicIO, run) + +-- External imports: Copilot +import Copilot.Interpret.Eval (ExecTrace (interpObservers), + ShowType (Haskell), eval) +import Copilot.Language (Spec, Stream, Typed, + forall, observer, prop) +import qualified Copilot.Language.Operators.Boolean as Copilot +import qualified Copilot.Language.Operators.Constant as Copilot +import qualified Copilot.Language.Operators.Eq as Copilot +import qualified Copilot.Language.Operators.Mux as Copilot +import qualified Copilot.Language.Operators.Ord as Copilot +import Copilot.Language.Reify (reify) +import Copilot.Theorem.What4 (SatResult (..), + Solver (..), prove) + +-- * Test using copilot-theorem + +-- | Define a QuickCheck property based on a generator of boolean streams and +-- their validity as Copilot properties. +-- +-- Uses the connection to copilot-theorem to determine whether the expectation +-- is the same as what copilot-theorem determines. +testWithTheorem :: Gen (Stream Bool, SatResult) -> Property +testWithTheorem gen = + forAll gen $ \(stream, expectation) -> do + let propName :: String + propName = "prop" + + spec :: Spec + spec = void $ prop propName $ forall stream + + monadicIO $ run $ checkResult Z3 propName spec expectation + +-- | Check that the solver's satisfiability result for the given Copilot +-- property in the given spec matches the expectation. +checkResult :: Solver -> String -> Spec -> SatResult -> IO Bool +checkResult solver propName spec expectation = do + spec' <- reify spec + results <- prove solver spec' + + -- Find the satisfiability result for propName. + let propResult = lookup propName results + + -- The following check also works for the case in which the property name + -- does not exist in the results, in which case the lookup returns 'Nothing'. + return $ propResult == Just expectation + +-- | Equality for 'SatResult'. +-- +-- This is an orphan instance. We suppress the warning that GHC would normally +-- produce with a GHC option at the top. +instance Eq SatResult where + Valid == Valid = True + Invalid == Invalid = True + Unknown == Unknown = True + _ == _ = False + +-- * Testing facilities based on copilot-interpreter + +-- | Max length of the traces being tested. +maxTraceLength :: Int +maxTraceLength = 200 + +-- | Define a QuickCheck property based on an interpretation of the stream and +-- a comparison with a list, up to a given 'maxTraceLength'. +-- +-- Uses the connection to copilot-interpreter to determine whether the +-- expectation is the same as what the interpreter determines. +testWithInterpreter :: (Eq t, Read t, Typed t) + => Gen (Stream t, [t]) + -> Property +testWithInterpreter stream = + forAll (chooseInt (0, maxTraceLength)) $ \steps -> + forAllShow stream (testPairShowK steps) $ \pair -> + monadicIO $ run (checkTestPairP steps pair) + +-- | Show function for test pairs that limits the accompanying list to a +-- certain length. +testPairShowK :: Show t => Int -> (Stream t, [t]) -> String +testPairShowK steps (_expr, exprList) = + show ("Cannot show stream", take steps exprList) + +-- | Check that the expression in the test pair is evaluated to the given list, +-- up to a number of steps. +-- +-- Some operations will overflow and return NaN. Because comparing any NaN +-- will, as per IEEE 754, always fail (i.e., return False), we handle that +-- specific case by stating that the test succeeds if any expected values is +-- NaN. +checkTestPairP :: (Eq t, Read t, Typed t, Show t) + => Int + -> (Stream t, [t]) + -> IO Bool +checkTestPairP steps (expr, exprList) = do + -- Spec with just one observer of one expression. + -- + -- We need to help GHC figure out the type of spec. + let spec :: Spec + spec = observer testObserverName expr + + -- Reified stream (low-level) + llSpec <- reify spec + + let trace = eval Haskell steps llSpec + + -- Limit expectation to the number of evaluation steps. + let expectation = take steps exprList + + -- Obtain the results by looking up the observer in the spec + -- and parsing the results into Haskell values. + let resultValues = fmap readResult results + results = lookupWithDefault testObserverName [] + $ interpObservers trace + + return $ any isNaN' expectation || resultValues == expectation + + where + + -- Fixed name for the observer. Used to obtain the result from the + -- trace. It should be the only observer in the trace. + testObserverName :: String + testObserverName = "res" + + -- | Is NaN with Eq requirement only. + isNaN' :: Eq a => a -> Bool + isNaN' x = x /= x + + -- | Read a Haskell value from the output of the evaluator. + readResult :: Read a => String -> a + readResult = read . readResult' + where + readResult' :: String -> String + readResult' "false" = "False" + readResult' "true" = "True" + readResult' s = s + +-- * Random Stream generators + +-- | An arbitrary constant expression of any type, paired with its expected +-- meaning. +arbitraryConst :: (Arbitrary t, Typed t) + => Gen (Stream t, [t]) +arbitraryConst = (\v -> (Copilot.constant v, repeat v)) <$> arbitrary + +-- | Generator for constant boolean streams, paired with their expected +-- meaning. +arbitraryBoolOp0 :: Gen (Stream Bool, [Bool]) +arbitraryBoolOp0 = elements + [ (Copilot.false, repeat False) + , (Copilot.true, repeat True) + ] + +-- | An arbitrary boolean expression, paired with its expected meaning. +arbitraryBoolExpr :: Gen (Stream Bool, [Bool]) +arbitraryBoolExpr = + -- We use frequency instead of oneof because the random expression generator + -- seems to generate expressions that are too large and the test fails due + -- to running out of memory. + frequency + [ (10, arbitraryConst) + + , (5, arbitraryBoolOp0) + + , (5, apply1 <$> arbitraryBoolOp1 <*> arbitraryBoolExpr) + + , (1, apply2 <$> arbitraryBoolOp2 + <*> arbitraryBoolExpr + <*> arbitraryBoolExpr) + + , (1, apply2 <$> arbitraryEqOp2 + <*> arbitraryBoolExpr + <*> arbitraryBoolExpr) + + , (1, apply2 <$> arbitraryEqOp2 + <*> arbitraryBitsExpr + <*> (arbitraryBitsExpr :: Gen (Stream Int8, [Int8]))) + + , (1, apply2 <$> arbitraryEqOp2 + <*> arbitraryBitsExpr + <*> (arbitraryBitsExpr :: Gen (Stream Int16, [Int16]))) + + , (1, apply2 <$> arbitraryEqOp2 + <*> arbitraryBitsExpr + <*> (arbitraryBitsExpr :: Gen (Stream Int32, [Int32]))) + + , (1, apply2 <$> arbitraryEqOp2 + <*> arbitraryBitsExpr + <*> (arbitraryBitsExpr :: Gen (Stream Int64, [Int64]))) + + , (1, apply2 <$> arbitraryEqOp2 + <*> arbitraryBitsExpr + <*> (arbitraryBitsExpr :: Gen (Stream Word8, [Word8]))) + + , (1, apply2 <$> arbitraryEqOp2 + <*> arbitraryBitsExpr + <*> (arbitraryBitsExpr :: Gen (Stream Word16, [Word16]))) + + , (1, apply2 <$> arbitraryEqOp2 + <*> arbitraryBitsExpr + <*> (arbitraryBitsExpr :: Gen (Stream Word32, [Word32]))) + + , (1, apply2 <$> arbitraryEqOp2 + <*> arbitraryBitsExpr + <*> (arbitraryBitsExpr :: Gen (Stream Word64, [Word64]))) + + , (1, apply2 <$> arbitraryEqOp2 + <*> arbitraryNumExpr + <*> (arbitraryNumExpr :: Gen (Stream Int8, [Int8]))) + + , (1, apply2 <$> arbitraryEqOp2 + <*> arbitraryNumExpr + <*> (arbitraryNumExpr :: Gen (Stream Int16, [Int16]))) + + , (1, apply2 <$> arbitraryEqOp2 + <*> arbitraryNumExpr + <*> (arbitraryNumExpr :: Gen (Stream Int32, [Int32]))) + + , (1, apply2 <$> arbitraryEqOp2 + <*> arbitraryNumExpr + <*> (arbitraryNumExpr :: Gen (Stream Int64, [Int64]))) + + , (1, apply2 <$> arbitraryEqOp2 + <*> arbitraryNumExpr + <*> (arbitraryNumExpr :: Gen (Stream Word8, [Word8]))) + + , (1, apply2 <$> arbitraryEqOp2 + <*> arbitraryNumExpr + <*> (arbitraryNumExpr :: Gen (Stream Word16, [Word16]))) + + , (1, apply2 <$> arbitraryEqOp2 + <*> arbitraryNumExpr + <*> (arbitraryNumExpr :: Gen (Stream Word32, [Word32]))) + + , (1, apply2 <$> arbitraryEqOp2 + <*> arbitraryNumExpr + <*> (arbitraryNumExpr :: Gen (Stream Word64, [Word64]))) + + , (1, apply2 <$> arbitraryOrdOp2 + <*> arbitraryNumExpr + <*> (arbitraryNumExpr :: Gen (Stream Int8, [Int8]))) + + , (1, apply2 <$> arbitraryOrdOp2 + <*> arbitraryNumExpr + <*> (arbitraryNumExpr :: Gen (Stream Int16, [Int16]))) + + , (1, apply2 <$> arbitraryOrdOp2 + <*> arbitraryNumExpr + <*> (arbitraryNumExpr :: Gen (Stream Int32, [Int32]))) + + , (1, apply2 <$> arbitraryOrdOp2 + <*> arbitraryNumExpr + <*> (arbitraryNumExpr :: Gen (Stream Int64, [Int64]))) + + , (1, apply2 <$> arbitraryOrdOp2 + <*> arbitraryNumExpr + <*> (arbitraryNumExpr :: Gen (Stream Word8, [Word8]))) + + , (1, apply2 <$> arbitraryOrdOp2 + <*> arbitraryNumExpr + <*> (arbitraryNumExpr :: Gen (Stream Word16, [Word16]))) + + , (1, apply2 <$> arbitraryOrdOp2 + <*> arbitraryNumExpr + <*> (arbitraryNumExpr :: Gen (Stream Word32, [Word32]))) + + , (1, apply2 <$> arbitraryOrdOp2 + <*> arbitraryNumExpr + <*> (arbitraryNumExpr :: Gen (Stream Word64, [Word64]))) + + , (1, apply2 <$> arbitraryOrdOp2 + <*> arbitraryFloatingExpr + <*> (arbitraryFloatingExpr :: Gen (Stream Float, [Float]))) + + , (1, apply2 <$> arbitraryOrdOp2 + <*> arbitraryFloatingExpr + <*> (arbitraryFloatingExpr :: Gen (Stream Double, [Double]))) + + , (1, apply3 <$> arbitraryITEOp3 + <*> arbitraryBoolExpr + <*> arbitraryBoolExpr + <*> arbitraryBoolExpr) + ] + +-- | An arbitrary numeric expression, paired with its expected meaning. +arbitraryNumExpr :: (Arbitrary t, Typed t, Num t, Eq t) + => Gen (Stream t, [t]) +arbitraryNumExpr = + -- We use frequency instead of oneof because the random expression generator + -- seems to generate expressions that are too large and the test fails due + -- to running out of memory. + frequency + [ (10, arbitraryConst) + + , (5, apply1 <$> arbitraryNumOp1 <*> arbitraryNumExpr) + + , (2, apply2 <$> arbitraryNumOp2 <*> arbitraryNumExpr <*> arbitraryNumExpr) + + , (2, apply3 <$> arbitraryITEOp3 + <*> arbitraryBoolExpr + <*> arbitraryNumExpr + <*> arbitraryNumExpr) + ] + +-- | An arbitrary floating point expression, paired with its expected meaning. +arbitraryFloatingExpr :: (Arbitrary t, Typed t, Floating t, Eq t) + => Gen (Stream t, [t]) +arbitraryFloatingExpr = + -- We use frequency instead of oneof because the random expression generator + -- seems to generate expressions that are too large and the test fails due + -- to running out of memory. + frequency + [ (10, arbitraryConst) + + , (5, apply1 <$> arbitraryFloatingOp1 <*> arbitraryFloatingExpr) + + , (5, apply1 <$> arbitraryNumOp1 <*> arbitraryFloatingExpr) + + , (2, apply2 <$> arbitraryFloatingOp2 + <*> arbitraryFloatingExpr + <*> arbitraryFloatingExpr) + + , (2, apply2 <$> arbitraryNumOp2 + <*> arbitraryFloatingExpr + <*> arbitraryFloatingExpr) + + , (1, apply3 <$> arbitraryITEOp3 + <*> arbitraryBoolExpr + <*> arbitraryFloatingExpr + <*> arbitraryFloatingExpr) + ] + +-- | An arbitrary Bits expression, paired with its expected meaning. +arbitraryBitsExpr :: (Arbitrary t, Typed t, Bits t) + => Gen (Stream t, [t]) +arbitraryBitsExpr = + -- We use frequency instead of oneof because the random expression generator + -- seems to generate expressions that are too large and the test fails due + -- to running out of memory. + frequency + [ (10, arbitraryConst) + + , (5, apply1 <$> arbitraryBitsOp1 <*> arbitraryBitsExpr) + + , (2, apply2 <$> arbitraryBitsOp2 + <*> arbitraryBitsExpr + <*> arbitraryBitsExpr) + + , (2, apply3 <$> arbitraryITEOp3 + <*> arbitraryBoolExpr + <*> arbitraryBitsExpr <*> arbitraryBitsExpr) + ] + +-- ** Operators + +-- *** Op 1 + +-- | Generator for arbitrary boolean operators with arity 1, paired with their +-- expected meaning. +arbitraryBoolOp1 :: Gen (Stream Bool -> Stream Bool, [Bool] -> [Bool]) +arbitraryBoolOp1 = elements + [ (Copilot.not, fmap not) + ] + +-- | Generator for arbitrary numeric operators with arity 1, paired with their +-- expected meaning. +arbitraryNumOp1 :: (Typed t, Num t, Eq t) + => Gen (Stream t -> Stream t, [t] -> [t]) +arbitraryNumOp1 = elements + [ (abs, fmap abs) + , (signum, fmap signum) + ] + +-- | Generator for arbitrary floating point operators with arity 1, paired with +-- their expected meaning. +arbitraryFloatingOp1 :: (Typed t, Floating t, Eq t) + => Gen (Stream t -> Stream t, [t] -> [t]) +arbitraryFloatingOp1 = elements + [ (exp, fmap exp) + , (sqrt, fmap sqrt) + , (log, fmap log) + , (sin, fmap sin) + , (tan, fmap tan) + , (cos, fmap cos) + , (asin, fmap asin) + , (atan, fmap atan) + , (acos, fmap acos) + , (sinh, fmap sinh) + , (tanh, fmap tanh) + , (cosh, fmap cosh) + , (asinh, fmap asinh) + , (atanh, fmap atanh) + , (acosh, fmap acosh) + ] + +-- | Generator for arbitrary bitwise operators with arity 1, paired with their +-- expected meaning. +arbitraryBitsOp1 :: (Typed t, Bits t) + => Gen (Stream t -> Stream t, [t] -> [t]) +arbitraryBitsOp1 = elements + [ (complement, fmap complement) + ] + +-- *** Op 2 + +-- | Generator for arbitrary boolean operators with arity 2, paired with their +-- expected meaning. +arbitraryBoolOp2 :: Gen ( Stream Bool -> Stream Bool -> Stream Bool + , [Bool] -> [Bool] -> [Bool] + ) +arbitraryBoolOp2 = elements + [ ((Copilot.&&), zipWith (&&)) + , ((Copilot.||), zipWith (||)) + , ((Copilot.==>), zipWith (\x y -> not x || y)) + , ((Copilot.xor), zipWith (\x y -> (x || y) && not (x && y))) + ] + +-- | Generator for arbitrary numeric operators with arity 2, paired with their +-- expected meaning. +arbitraryNumOp2 :: (Typed t, Num t, Eq t) + => Gen (Stream t -> Stream t -> Stream t, [t] -> [t] -> [t]) +arbitraryNumOp2 = elements + [ ((+), zipWith (+)) + , ((-), zipWith (-)) + , ((*), zipWith (*)) + ] + +-- | Generator for arbitrary floating point operators with arity 2, paired with +-- their expected meaning. +arbitraryFloatingOp2 :: (Typed t, Floating t, Eq t) + => Gen ( Stream t -> Stream t -> Stream t + , [t] -> [t] -> [t] + ) +arbitraryFloatingOp2 = elements + [ ((**), zipWith (**)) + , (logBase, zipWith logBase) + ] + +-- | Generator for arbitrary equality operators with arity 2, paired with their +-- expected meaning. +arbitraryEqOp2 :: (Typed t, Eq t) + => Gen ( Stream t -> Stream t -> Stream Bool + , [t] -> [t] -> [Bool] + ) +arbitraryEqOp2 = elements + [ ((Copilot.==), zipWith (==)) + , ((Copilot./=), zipWith (/=)) + ] + +-- | Generator for arbitrary ordering operators with arity 2, paired with their +-- expected meaning. +arbitraryOrdOp2 :: (Typed t, Ord t) + => Gen ( Stream t -> Stream t -> Stream Bool + , [t] -> [t] -> [Bool] + ) +arbitraryOrdOp2 = elements + [ ((Copilot.<=), zipWith (<=)) + , ((Copilot.<), zipWith (<)) + , ((Copilot.>=), zipWith (>=)) + , ((Copilot.>), zipWith (>)) + ] + +-- | Generator for arbitrary bitwise operators with arity 2, paired with their +-- expected meaning. +arbitraryBitsOp2 :: (Typed t, Bits t) + => Gen (Stream t -> Stream t -> Stream t, [t] -> [t] -> [t]) +arbitraryBitsOp2 = elements + [ ((.&.), zipWith (.&.)) + , ((.|.), zipWith (.|.)) + , (xor, zipWith xor) + ] + +-- *** Op 3 + +-- | Generator for if-then-else operator (with arity 3), paired with its +-- expected meaning. +-- +-- Although this is constant and there is nothing arbitrary, we use the same +-- structure and naming convention as with others for simplicity. +arbitraryITEOp3 :: (Arbitrary t, Typed t) + => Gen ( Stream Bool -> Stream t -> Stream t -> Stream t + , [Bool] -> [t] -> [t] -> [t] + ) +arbitraryITEOp3 = return + (Copilot.mux, zipWith3 (\x y z -> if x then y else z)) + +-- * Auxiliary + +-- | Apply a tuple with two functions to a tuple of arguments. +apply1 :: (a1 -> b1, a2 -> b2) -- ^ Pair with functions + -> (a1, a2) -- ^ Pair with arguments + -> (b1, b2) -- ^ Pair with results +apply1 = uncurry (***) + +-- | Apply a tuple with two functions on two arguments to their tupled +-- arguments. +apply2 :: (a1 -> b1 -> c1, a2 -> b2 -> c2) -- ^ Pair with functions + -> (a1, a2) -- ^ Pair with first arguments + -> (b1, b2) -- ^ Pair with second arguments + -> (c1, c2) -- ^ Pair with results +apply2 fs = apply1 . apply1 fs + +-- | Apply a tuple with two functions on three arguments to their tupled +-- arguments. +apply3 :: (a1 -> b1 -> c1 -> d1, a2 -> b2 -> c2 -> d2) + -- ^ Pair with functions + -> (a1, a2) -- ^ Pair with first arguments + -> (b1, b2) -- ^ Pair with second arguments + -> (c1, c2) -- ^ Pair with third arguments + -> (d1, d2) -- ^ Pair with results +apply3 fs = apply2 . apply1 fs + +-- | Variant of 'lookup' with an additional default value returned when the key +-- provided is not found in the map. +lookupWithDefault :: Ord k => k -> v -> [(k, v)] -> v +lookupWithDefault k def = fromMaybe def . lookup k From 590bbf02de894c9a9136d37ea72fe73c9a949ea7 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Dec 2023 03:15:03 +0000 Subject: [PATCH 0700/1222] copilot: Enable tests for copilot-libraries in CI script. Refs #475. As part of the test plan needed to comply with NPR7150.2, Copilot is required to run tests for every change, before it is integrated in the codebase. This commit expands the tests run for every pull request, before it is accepted, to include also copilot-libraries. --- .travis.yml | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/.travis.yml b/.travis.yml index 5958a9625..8b52b02fe 100644 --- a/.travis.yml +++ b/.travis.yml @@ -33,6 +33,7 @@ script: # # Only libraries with tests are listed below or the v2-test command fails. # - # Testing copilot-theorem requires z3. See above conditional installation, - # and keep GHC version numbers in both places in sync. - - if [ "${GHCVER}" == "8.10.4" ]; then cabal v2-test -j1 copilot-core copilot-language copilot-interpreter copilot-c99 copilot-theorem; fi + # Testing copilot-theorem and copilot-libraries requires z3. See above + # conditional installation, and keep GHC version numbers in both places in + # sync. + - if [ "${GHCVER}" == "8.10.4" ]; then cabal v2-test -j1 copilot-core copilot-language copilot-interpreter copilot-c99 copilot-theorem copilot-libraries; fi From 0b356cd7ad4b94e8e72df031e44b949c5598cd13 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 24 Dec 2023 21:51:31 +0000 Subject: [PATCH 0701/1222] copilot-libraries: Document changes in CHANGELOG. Refs #475. --- copilot-libraries/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-libraries/CHANGELOG b/copilot-libraries/CHANGELOG index 4810f9ef4..a43d716bb 100644 --- a/copilot-libraries/CHANGELOG +++ b/copilot-libraries/CHANGELOG @@ -1,3 +1,6 @@ +2023-12-24 + * Introduce testing infrastructure for Copilot.Library. (#475) + 2023-11-07 * Version bump (3.17). (#466) From 15ca5779c64e89dd7dc8fa8f5296baed129d4dd8 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 25 Dec 2023 03:16:11 +0000 Subject: [PATCH 0702/1222] copilot: Document changes in CHANGELOG. Refs #475. --- copilot/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot/CHANGELOG b/copilot/CHANGELOG index 706573829..d07db1cd0 100644 --- a/copilot/CHANGELOG +++ b/copilot/CHANGELOG @@ -1,5 +1,6 @@ -2023-12-18 +2023-12-24 * Enable tests for copilot-theorem in CI script. (#474) + * Enable tests for copilot-libraries in CI script. (#475) 2023-11-07 * Version bump (3.17). (#466) From 1a02b68721d0bd70c3ac3c4f1d3a4e61f979494e Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 28 Dec 2023 00:04:45 +0000 Subject: [PATCH 0703/1222] copilot-language: Rename forall to forAll. Refs #470. Copilot's API offers the function Copilot.Language.Spec.forall, which future versions of GHC will disallow due to the clash with the keyword forall. This commit introduces a new function Copilot.Language.Spec.forAll that replaces the old function Copilot.Language.Spec.forall. In compliance with our policy of waiting 3 versions from deprecation until a public interface declaration can be removed, the old function is deprecated. --- copilot-language/src/Copilot/Language.hs | 1 + copilot-language/src/Copilot/Language/Spec.hs | 8 +++++++- 2 files changed, 8 insertions(+), 1 deletion(-) diff --git a/copilot-language/src/Copilot/Language.hs b/copilot-language/src/Copilot/Language.hs index 658ccb191..400cc51c1 100644 --- a/copilot-language/src/Copilot/Language.hs +++ b/copilot-language/src/Copilot/Language.hs @@ -37,6 +37,7 @@ module Copilot.Language , arg , prop , theorem + , forAll , forall, exists ) where diff --git a/copilot-language/src/Copilot/Language/Spec.hs b/copilot-language/src/Copilot/Language/Spec.hs index 2240f21ce..26bc30aee 100644 --- a/copilot-language/src/Copilot/Language/Spec.hs +++ b/copilot-language/src/Copilot/Language/Spec.hs @@ -27,6 +27,7 @@ module Copilot.Language.Spec , Prop (..) , prop, properties , theorem, theorems + , forAll , forall, exists , extractProp , Universal, Existential @@ -160,9 +161,14 @@ data Prop a where Forall :: Stream Bool -> Prop Universal Exists :: Stream Bool -> Prop Existential +-- | Universal quantification of boolean streams over time. +forAll :: Stream Bool -> Prop Universal +forAll = Forall + +{-# DEPRECATED forall "Use forAll instead." #-} -- | Universal quantification of boolean streams over time. forall :: Stream Bool -> Prop Universal -forall = Forall +forall = forAll -- | Existential quantification of boolean streams over time. exists :: Stream Bool -> Prop Existential From f351722de54c72fa9dfe136598b293cf02d8a79e Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 28 Dec 2023 00:10:17 +0000 Subject: [PATCH 0704/1222] copilot-libraries: Update uses of forall. Refs #470. The function forall has been deprecated in favor of forAll to keep Copilot compatible with newer versions of GHC. This commit updates all uses of forall in this library with the new function name. --- copilot-libraries/tests/Test/Extra.hs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/copilot-libraries/tests/Test/Extra.hs b/copilot-libraries/tests/Test/Extra.hs index 44d7a5272..da462cb05 100644 --- a/copilot-libraries/tests/Test/Extra.hs +++ b/copilot-libraries/tests/Test/Extra.hs @@ -43,7 +43,8 @@ import Test.QuickCheck.Monadic (monadicIO, run) import Copilot.Interpret.Eval (ExecTrace (interpObservers), ShowType (Haskell), eval) import Copilot.Language (Spec, Stream, Typed, - forall, observer, prop) + observer, prop) +import qualified Copilot.Language as Copilot import qualified Copilot.Language.Operators.Boolean as Copilot import qualified Copilot.Language.Operators.Constant as Copilot import qualified Copilot.Language.Operators.Eq as Copilot @@ -67,7 +68,7 @@ testWithTheorem gen = propName = "prop" spec :: Spec - spec = void $ prop propName $ forall stream + spec = void $ prop propName $ Copilot.forAll stream monadicIO $ run $ checkResult Z3 propName spec expectation From 4bc82bca9ac9b5f4c55c934792be4bb2ca829b8f Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 28 Dec 2023 00:10:42 +0000 Subject: [PATCH 0705/1222] copilot-theorem: Update uses of forall. Refs #470. The function forall has been deprecated in favor of forAll to keep Copilot compatible with newer versions of GHC. This commit updates all uses of forall in this library with the new function name. --- copilot-theorem/examples/BoyerMoore.hs | 6 ++-- copilot-theorem/examples/Grey.hs | 4 +-- copilot-theorem/examples/Incr.hs | 6 ++-- copilot-theorem/examples/SerialBoyerMoore.hs | 4 +-- copilot-theorem/examples/SphericalWCV.hs | 36 ++++++++++---------- copilot-theorem/examples/Trig.hs | 30 ++++++++-------- copilot-theorem/examples/WCV.hs | 36 ++++++++++---------- 7 files changed, 61 insertions(+), 61 deletions(-) diff --git a/copilot-theorem/examples/BoyerMoore.hs b/copilot-theorem/examples/BoyerMoore.hs index f32c5a30a..d4cebf638 100644 --- a/copilot-theorem/examples/BoyerMoore.hs +++ b/copilot-theorem/examples/BoyerMoore.hs @@ -54,9 +54,9 @@ spec = do observer ((P.++) "s" (show k)) s observer "maj" maj - i1 <- prop "i1" (forall $ s1 == 1 && s2 == 1 && s3 == 1 && s4 == 1) - theorem "r1" (forall $ maj == 1) $ assume i1 >> induct - theorem "OK" (forall $ okWith (arbitraryCst "n") ss maj) induct + i1 <- prop "i1" (forAll $ s1 == 1 && s2 == 1 && s3 == 1 && s4 == 1) + theorem "r1" (forAll $ maj == 1) $ assume i1 >> induct + theorem "OK" (forAll $ okWith (arbitraryCst "n") ss maj) induct where s1 = externW8 "s1" (Just $ repeat 1) diff --git a/copilot-theorem/examples/Grey.hs b/copilot-theorem/examples/Grey.hs index eb67b4046..9a1ca4319 100644 --- a/copilot-theorem/examples/Grey.hs +++ b/copilot-theorem/examples/Grey.hs @@ -22,8 +22,8 @@ greyTick reset = a && b b = (not reset) && ([False] ++ a) spec = do - theorem "iResetOk" (forall $ r ==> (ic == 0)) induct - theorem "eqCounters" (forall $ it == gt) $ kinduct 3 + theorem "iResetOk" (forAll $ r ==> (ic == 0)) induct + theorem "eqCounters" (forAll $ it == gt) $ kinduct 3 where ic = intCounter r diff --git a/copilot-theorem/examples/Incr.hs b/copilot-theorem/examples/Incr.hs index 3e392cc4b..3c39a008d 100644 --- a/copilot-theorem/examples/Incr.hs +++ b/copilot-theorem/examples/Incr.hs @@ -7,9 +7,9 @@ import Copilot.Theorem import Copilot.Theorem.Prover.Z3 spec = do - bounds <- prop "bounds" (forall $ x < 255) - theorem "gt1" (forall $ x > 1) (assume bounds >> induct) - theorem "neq0" (forall $ x /= 0) (assume bounds >> induct) + bounds <- prop "bounds" (forAll $ x < 255) + theorem "gt1" (forAll $ x > 1) (assume bounds >> induct) + theorem "neq0" (forAll $ x /= 0) (assume bounds >> induct) where x :: Stream Word8 diff --git a/copilot-theorem/examples/SerialBoyerMoore.hs b/copilot-theorem/examples/SerialBoyerMoore.hs index e4de00989..5f0d42092 100644 --- a/copilot-theorem/examples/SerialBoyerMoore.hs +++ b/copilot-theorem/examples/SerialBoyerMoore.hs @@ -48,8 +48,8 @@ spec = do observer "s" s observer "j" j - inRange <- prop "inRange" (forall $ input < 3) - theorem "J" (forall j) $ assume inRange >> induct + inRange <- prop "inRange" (forAll $ input < 3) + theorem "J" (forAll j) $ assume inRange >> induct where input = externW64 "in" (Just [1, 1, 2, 1, 2, 2, 1, 2, 2, 1, 2, 1]) diff --git a/copilot-theorem/examples/SphericalWCV.hs b/copilot-theorem/examples/SphericalWCV.hs index 25d566527..74b899583 100644 --- a/copilot-theorem/examples/SphericalWCV.hs +++ b/copilot-theorem/examples/SphericalWCV.hs @@ -184,41 +184,41 @@ horizontalWCV tvar s v = (norm s <= dthr) || ((dcpa s v <= dthr) && (0 <= tvar s -- Horizontal symmetry -- horizSymmetry = do - theorem "1a" (forall $ tau s v ~= tau (neg s) (neg v)) arith - theorem "1b" (forall $ tcpa s v ~= tcpa (neg s) (neg v)) arith - theorem "1c" (forall $ taumod s v ~= taumod (neg s) (neg v)) arith - theorem "1d" (forall $ tep s v ~= tep (neg s) (neg v)) arith + theorem "1a" (forAll $ tau s v ~= tau (neg s) (neg v)) arith + theorem "1b" (forAll $ tcpa s v ~= tcpa (neg s) (neg v)) arith + theorem "1c" (forAll $ taumod s v ~= taumod (neg s) (neg v)) arith + theorem "1d" (forAll $ tep s v ~= tep (neg s) (neg v)) arith -- Horizontal ordering -- horizOrdering = do - theorem "2a" (forall $ ((s |*| v) < 0 && norm s > dthr && dcpa s v <= dthr) + theorem "2a" (forAll $ ((s |*| v) < 0 && norm s > dthr && dcpa s v <= dthr) ==> (tep s v <= taumod s v)) arith - theorem "2b" (forall $ ((s |*| v) < 0 && norm s > dthr && dcpa s v <= dthr) + theorem "2b" (forAll $ ((s |*| v) < 0 && norm s > dthr && dcpa s v <= dthr) ==> (taumod s v <= tcpa s v)) arith - theorem "2c" (forall $ ((s |*| v) < 0 && norm s > dthr && dcpa s v <= dthr) + theorem "2c" (forAll $ ((s |*| v) < 0 && norm s > dthr && dcpa s v <= dthr) ==> (tcpa s v <= tau s v)) arith -- Symmetry -- symmetry = do - theorem "3a" (forall $ wcv tau s sz v vz == wcv tau (neg s) (-sz) (neg v) (-vz)) + theorem "3a" (forAll $ wcv tau s sz v vz == wcv tau (neg s) (-sz) (neg v) (-vz)) arith - theorem "3b" (forall $ wcv tcpa s sz v vz == wcv tcpa (neg s) (-sz) (neg v) (-vz)) + theorem "3b" (forAll $ wcv tcpa s sz v vz == wcv tcpa (neg s) (-sz) (neg v) (-vz)) arith - theorem "3c" (forall $ wcv taumod s sz v vz == wcv taumod (neg s) (-sz) (neg v) (-vz)) + theorem "3c" (forAll $ wcv taumod s sz v vz == wcv taumod (neg s) (-sz) (neg v) (-vz)) arith - theorem "3d" (forall $ wcv tep s sz v vz == wcv tep (neg s) (-sz) (neg v) (-vz)) + theorem "3d" (forAll $ wcv tep s sz v vz == wcv tep (neg s) (-sz) (neg v) (-vz)) arith -- Inclusion -- inclusion = do - theorem "4i" (forall $ wcv tau s sz v vz ==> wcv tcpa s sz v vz) + theorem "4i" (forAll $ wcv tau s sz v vz ==> wcv tcpa s sz v vz) arith - theorem "4ii" (forall $ wcv tcpa s sz v vz ==> wcv taumod s sz v vz ) + theorem "4ii" (forAll $ wcv tcpa s sz v vz ==> wcv taumod s sz v vz ) arith - theorem "4iii" (forall $ wcv taumod s sz v vz ==> wcv tep s sz v vz) + theorem "4iii" (forAll $ wcv taumod s sz v vz ==> wcv tep s sz v vz) arith -- Local convexity -- @@ -235,10 +235,10 @@ locallyConvex tvar = (0 <= t1 && t1 <= t2 && t2 <= t3) && wcv tvar (sx + t3*vx, sy + t3*vy) (sz + t3*vz) v vz) localConvexity = do - theorem "5a" (forall $ locallyConvex tcpa) arith - theorem "5b" (forall $ locallyConvex taumod) arith - theorem "5c" (forall $ locallyConvex tep) arith - theorem "6" (P.not (forall $ locallyConvex tau)) arithSat + theorem "5a" (forAll $ locallyConvex tcpa) arith + theorem "5b" (forAll $ locallyConvex taumod) arith + theorem "5c" (forAll $ locallyConvex tep) arith + theorem "6" (P.not (forAll $ locallyConvex tau)) arithSat arith :: Proof Universal arith = onlyValidity def { nraNLSat = True, debug = False } diff --git a/copilot-theorem/examples/Trig.hs b/copilot-theorem/examples/Trig.hs index 3b09cb89f..bfcf44671 100644 --- a/copilot-theorem/examples/Trig.hs +++ b/copilot-theorem/examples/Trig.hs @@ -25,37 +25,37 @@ arithSat = onlySat def { debug = False } dReal a ~= b = abs (a - b) < 0.001 spec = do - bounds <- prop "bounds" (forall $ bounds) + bounds <- prop "bounds" (forAll $ bounds) -- dReal/metit fails this one. - -- theorem "dist_eq" (forall $ d1 ~= d2) + -- theorem "dist_eq" (forAll $ d1 ~= d2) -- $ assume bounds >> arith - theorem_ "2sin" (forall $ (2 * (sin x)) <= 3) + theorem_ "2sin" (forAll $ (2 * (sin x)) <= 3) $ assume bounds >> arith - theorem_ "sin_cos" (forall $ ((sin x) ** 2 + (cos x) ** 2) ~= 1) + theorem_ "sin_cos" (forAll $ ((sin x) ** 2 + (cos x) ** 2) ~= 1) $ assume bounds >> arith - theorem_ "sin_cos_pi" ( forall $ ((sin x) ** 2 + (cos $ x + pi) ** 2) ~= 1) + theorem_ "sin_cos_pi" ( forAll $ ((sin x) ** 2 + (cos $ x + pi) ** 2) ~= 1) $ assume bounds >> arith - theorem_ "sin_2pi" ( forall $ (sin x) ~= (sin $ x + 2 * pi)) + theorem_ "sin_2pi" ( forAll $ (sin x) ~= (sin $ x + 2 * pi)) $ assume bounds >> arith - theorem_ "cos_2pi" ( forall $ (cos x) ~= (cos $ x + 2 * pi)) + theorem_ "cos_2pi" ( forAll $ (cos x) ~= (cos $ x + 2 * pi)) $ assume bounds >> arith - theorem_ "sin_eq_cos_pi2" ( forall $ (sin x) ~= (cos $ x - (pi/2))) + theorem_ "sin_eq_cos_pi2" ( forAll $ (sin x) ~= (cos $ x - (pi/2))) $ assume bounds >> arith - theorem_ "x^2_2" ( forall $ (x ** 2 + 1) >= x) + theorem_ "x^2_2" ( forAll $ (x ** 2 + 1) >= x) $ assume bounds >> arith - theorem_ "sqrt_x" ( forall $ (x > 2) ==> ((sqrt x) < x)) + theorem_ "sqrt_x" ( forAll $ (x > 2) ==> ((sqrt x) < x)) $ assume bounds >> arith - theorem_ "x = y" (P.not $ forall $ x == y) + theorem_ "x = y" (P.not $ forAll $ x == y) $ assume bounds >> arithSat - theorem_ "sin_cos_3" (P.not $ forall $ ((sin x) ** 2 + (cos $ x + 3) ** 2) ~= 1) + theorem_ "sin_cos_3" (P.not $ forAll $ ((sin x) ** 2 + (cos $ x + 3) ** 2) ~= 1) $ assume bounds >> arithSat - theorem_ "sin_pi" (P.not $ forall $ (sin x) ~= (sin $ x + pi)) + theorem_ "sin_pi" (P.not $ forAll $ (sin x) ~= (sin $ x + pi)) $ assume bounds >> arithSat - theorem_ "sin_eq_cos_3" (P.not $ forall $ (sin x) ~= (cos $ x - (3/2))) + theorem_ "sin_eq_cos_3" (P.not $ forAll $ (sin x) ~= (cos $ x - (3/2))) $ assume bounds >> arithSat - theorem_ "sin_eq_cos" (P.not $ forall $ (sin x) ~= (cos x)) + theorem_ "sin_eq_cos" (P.not $ forAll $ (sin x) ~= (cos x)) $ assume bounds >> arithSat where diff --git a/copilot-theorem/examples/WCV.hs b/copilot-theorem/examples/WCV.hs index f184d4860..62c27f287 100644 --- a/copilot-theorem/examples/WCV.hs +++ b/copilot-theorem/examples/WCV.hs @@ -108,41 +108,41 @@ horizontalWCV tvar s v = -- Horizontal symmetry -- horizSymmetry = do - theorem "1a" (forall $ (tau s v) ~= (tau (neg s) (neg v))) arith - theorem "1b" (forall $ (tcpa s v) ~= (tcpa (neg s) (neg v))) arith - theorem "1c" (forall $ (taumod s v) ~= (taumod (neg s) (neg v))) arith - theorem "1d" (forall $ (tep s v) ~= (tep (neg s) (neg v))) arith + theorem "1a" (forAll $ (tau s v) ~= (tau (neg s) (neg v))) arith + theorem "1b" (forAll $ (tcpa s v) ~= (tcpa (neg s) (neg v))) arith + theorem "1c" (forAll $ (taumod s v) ~= (taumod (neg s) (neg v))) arith + theorem "1d" (forAll $ (tep s v) ~= (tep (neg s) (neg v))) arith -- Horizontal ordering -- horizOrdering = do - theorem "2a" (forall $ ((s |*| v) < 0 && (norm s) > dthr && (dcpa s v) <= dthr) + theorem "2a" (forAll $ ((s |*| v) < 0 && (norm s) > dthr && (dcpa s v) <= dthr) ==> ((tep s v) <= (taumod s v))) arith - theorem "2b" (forall $ ((s |*| v) < 0 && (norm s) > dthr && (dcpa s v) <= dthr) + theorem "2b" (forAll $ ((s |*| v) < 0 && (norm s) > dthr && (dcpa s v) <= dthr) ==> ((taumod s v) <= (tcpa s v))) arith - theorem "2c" (forall $ ((s |*| v) < 0 && (norm s) > dthr && (dcpa s v) <= dthr) + theorem "2c" (forAll $ ((s |*| v) < 0 && (norm s) > dthr && (dcpa s v) <= dthr) ==> ((tcpa s v) <= (tau s v))) arith -- Symmetry -- symmetry = do - theorem "3a" (forall $ (wcv tau s sz v vz) == (wcv tau (neg s) (-sz) (neg v) (-vz))) + theorem "3a" (forAll $ (wcv tau s sz v vz) == (wcv tau (neg s) (-sz) (neg v) (-vz))) arith - theorem "3b" (forall $ (wcv tcpa s sz v vz) == (wcv tcpa (neg s) (-sz) (neg v) (-vz))) + theorem "3b" (forAll $ (wcv tcpa s sz v vz) == (wcv tcpa (neg s) (-sz) (neg v) (-vz))) arith - theorem "3c" (forall $ (wcv taumod s sz v vz) == (wcv taumod (neg s) (-sz) (neg v) (-vz))) + theorem "3c" (forAll $ (wcv taumod s sz v vz) == (wcv taumod (neg s) (-sz) (neg v) (-vz))) arith - theorem "3d" (forall $ (wcv tep s sz v vz) == (wcv tep (neg s) (-sz) (neg v) (-vz))) + theorem "3d" (forAll $ (wcv tep s sz v vz) == (wcv tep (neg s) (-sz) (neg v) (-vz))) arith -- Inclusion -- inclusion = do - theorem "4i" (forall $ (wcv tau s sz v vz) ==> (wcv tcpa s sz v vz)) + theorem "4i" (forAll $ (wcv tau s sz v vz) ==> (wcv tcpa s sz v vz)) arith - theorem "4ii" (forall $ (wcv tcpa s sz v vz) ==> (wcv taumod s sz v vz )) + theorem "4ii" (forAll $ (wcv tcpa s sz v vz) ==> (wcv taumod s sz v vz )) arith - theorem "4iii" (forall $ (wcv taumod s sz v vz) ==> (wcv tep s sz v vz)) + theorem "4iii" (forAll $ (wcv taumod s sz v vz) ==> (wcv tep s sz v vz)) arith -- Local convexity -- @@ -159,10 +159,10 @@ locallyConvex tvar = (0 <= t1 && t1 <= t2 && t2 <= t3) && (wcv tvar (sx + t3*vx, sy + t3*vy) (sz + t3*vz) v vz)) localConvexity = do - theorem "5a" (forall $ locallyConvex tcpa) arith - theorem "5b" (forall $ locallyConvex taumod) arith - theorem "5c" (forall $ locallyConvex tep) arith - theorem "6" (P.not (forall $ locallyConvex tau)) arithSat + theorem "5a" (forAll $ locallyConvex tcpa) arith + theorem "5b" (forAll $ locallyConvex taumod) arith + theorem "5c" (forAll $ locallyConvex tep) arith + theorem "6" (P.not (forAll $ locallyConvex tau)) arithSat arith :: Proof Universal arith = onlyValidity def { nraNLSat = True, debug = False } From 6b4abdab0809999fe51205bd11a6108a5124138d Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 28 Dec 2023 00:10:54 +0000 Subject: [PATCH 0706/1222] copilot: Update uses of forall. Refs #470. The function forall has been deprecated in favor of forAll to keep Copilot compatible with newer versions of GHC. This commit updates all uses of forall in this library with the new function name. --- copilot/examples/WCV.hs | 4 ++-- copilot/examples/what4/Arithmetic.hs | 12 ++++++------ copilot/examples/what4/Propositional.hs | 14 +++++++------- copilot/examples/what4/Structs.hs | 4 ++-- 4 files changed, 17 insertions(+), 17 deletions(-) diff --git a/copilot/examples/WCV.hs b/copilot/examples/WCV.hs index 0fa67094a..3ac016fb3 100644 --- a/copilot/examples/WCV.hs +++ b/copilot/examples/WCV.hs @@ -151,8 +151,8 @@ horizontalWCV tvar s v = (((dcpa s v) <= dthr) && (0 <= (tvar s v)) && ((tvar s v) <= tthr)) spec = do - Monad.void $ prop "1a" (forall $ (tau s v) ~= (tau (neg s) (neg v))) - -- Monad.void $ prop "3d" (forall $ (wcv tep s sz v vz) == (wcv tep (neg s) (-sz) (neg v) (-vz))) + Monad.void $ prop "1a" (forAll $ (tau s v) ~= (tau (neg s) (neg v))) + -- Monad.void $ prop "3d" (forAll $ (wcv tep s sz v vz) == (wcv tep (neg s) (-sz) (neg v) (-vz))) main :: IO () main = do diff --git a/copilot/examples/what4/Arithmetic.hs b/copilot/examples/what4/Arithmetic.hs index d3fd284a2..ed7e0385c 100644 --- a/copilot/examples/what4/Arithmetic.hs +++ b/copilot/examples/what4/Arithmetic.hs @@ -21,22 +21,22 @@ spec = do efloat = extern "efloat" Nothing -- The simplest example involving numbers: equality on constant values. - void $ prop "Example 1" (forall ((constant (1 :: Int8)) == (constant 1))) + void $ prop "Example 1" (forAll ((constant (1 :: Int8)) == (constant 1))) -- Testing "a < a + 1". This should fail, because it isn't true. - void $ prop "Example 2" (forall (eint8 < (eint8 + 1))) + void $ prop "Example 2" (forAll (eint8 < (eint8 + 1))) -- Adding another condition to the above property to make it true. - void $ prop "Example 3" (forall ((eint8 < (eint8 + 1)) || (eint8 == 127))) + void $ prop "Example 3" (forAll ((eint8 < (eint8 + 1)) || (eint8 == 127))) -- Just like the previous example, but with words. - void $ prop "Example 4" (forall ((eword8 < (eword8 + 1)) || (eword8 == 255))) + void $ prop "Example 4" (forAll ((eword8 < (eword8 + 1)) || (eword8 == 255))) -- An example with floats. - void $ prop "Example 5" (forall ((2 * efloat) == (efloat + efloat))) + void $ prop "Example 5" (forAll ((2 * efloat) == (efloat + efloat))) -- Another example with floats. This fails, because it isn't true. - void $ prop "Example 6" (forall ((efloat + 1) /= efloat)) + void $ prop "Example 6" (forAll ((efloat + 1) /= efloat)) main :: IO () main = do diff --git a/copilot/examples/what4/Propositional.hs b/copilot/examples/what4/Propositional.hs index 5dc62431c..75dcf55fc 100644 --- a/copilot/examples/what4/Propositional.hs +++ b/copilot/examples/what4/Propositional.hs @@ -13,38 +13,38 @@ spec :: Spec spec = do -- The constant value true, which is translated as the corresponding SMT -- boolean literal. - void $ prop "Example 1" (forall true) + void $ prop "Example 1" (forAll true) -- The constant value false, which is translated as the corresponding SMT -- boolean literal. - void $ prop "Example 2" (forall false) + void $ prop "Example 2" (forAll false) -- An inductively defined flavor of true, which requires induction to prove, -- and hence is found to be invalid by the SMT solver (since no inductive -- hypothesis is made). let a = [True] ++ a - void $ prop "Example 3" (forall a) + void $ prop "Example 3" (forAll a) -- An inductively defined "a or not a" proposition, which is unprovable by -- the SMT solver. let a = [False] ++ b b = [True] ++ a - void $ prop "Example 4" (forall (a || b)) + void $ prop "Example 4" (forAll (a || b)) -- A version of "a or not a" proposition which does not require any sort of -- inductive argument, and hence is provable. let a = [False] ++ b b = not a - void $ prop "Example 5" (forall (a || b)) + void $ prop "Example 5" (forAll (a || b)) -- A bit more convoluted version of Example 5, which is provable. let a = [True, False] ++ b b = [False] ++ not (drop 1 a) - void $ prop "Example 6" (forall (a || b)) + void $ prop "Example 6" (forAll (a || b)) -- An example using external streams. let a = extern "a" Nothing - void $ prop "Example 7" (forall (a || not a)) + void $ prop "Example 7" (forAll (a || not a)) main :: IO () main = do diff --git a/copilot/examples/what4/Structs.hs b/copilot/examples/what4/Structs.hs index ff44ec25c..de4e4efbd 100644 --- a/copilot/examples/what4/Structs.hs +++ b/copilot/examples/what4/Structs.hs @@ -56,12 +56,12 @@ spec = do -- Check equality, indexing into nested structs and arrays. Note that this is -- trivial by equality. - void $ prop "Example 1" $ forall $ + void $ prop "Example 1" $ forAll $ (((battery#volts) .!! 0)#numVolts) == (((battery#volts) .!! 0)#numVolts) -- Same as previous example, but get a different array index (so should be -- false). - void $ prop "Example 2" $ forall $ + void $ prop "Example 2" $ forAll $ (((battery#other) .!! 2) .!! 3) == (((battery#other) .!! 2) .!! 4) main :: IO () From 450567ac02564fe024dea7b2844ca8452191a751 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 28 Dec 2023 01:47:08 +0000 Subject: [PATCH 0707/1222] copilot-language: Document changes in CHANGELOG. Refs #470. --- copilot-language/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot-language/CHANGELOG b/copilot-language/CHANGELOG index 44d0b6970..b8a9e663f 100644 --- a/copilot-language/CHANGELOG +++ b/copilot-language/CHANGELOG @@ -1,5 +1,6 @@ -2023-12-17 +2023-12-27 * Add type annotation to help type inference engine. (#469) + * Rename forall to forAll. (#470) 2023-11-07 * Version bump (3.17). (#466) From 13a58666a32fa204f111bcafc937f6525aa83e56 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 28 Dec 2023 01:48:30 +0000 Subject: [PATCH 0708/1222] copilot-libraries: Document changes in CHANGELOG. Refs #470. --- copilot-libraries/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot-libraries/CHANGELOG b/copilot-libraries/CHANGELOG index a43d716bb..221e34a7a 100644 --- a/copilot-libraries/CHANGELOG +++ b/copilot-libraries/CHANGELOG @@ -1,5 +1,6 @@ -2023-12-24 +2023-12-27 * Introduce testing infrastructure for Copilot.Library. (#475) + * Replace uses of forall with forAll. (#470) 2023-11-07 * Version bump (3.17). (#466) From 4d61e7c3ca99a4ca28374c12094d228474ccd0f0 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 28 Dec 2023 01:48:53 +0000 Subject: [PATCH 0709/1222] copilot-theorem: Document changes in CHANGELOG. Refs #470. --- copilot-theorem/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot-theorem/CHANGELOG b/copilot-theorem/CHANGELOG index d6accbf3b..b78bee0d4 100644 --- a/copilot-theorem/CHANGELOG +++ b/copilot-theorem/CHANGELOG @@ -1,5 +1,6 @@ -2023-12-18 +2023-12-27 * Introduce testing infrastructure for Copilot.Theorem.What4. (#474) + * Replace uses of forall with forAll. (#470) 2023-11-07 * Version bump (3.17). (#466) From a7aa7678d98de2be69dd4011cb2ddac373654798 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 28 Dec 2023 01:49:12 +0000 Subject: [PATCH 0710/1222] copilot: Document changes in CHANGELOG. Refs #470. --- copilot/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot/CHANGELOG b/copilot/CHANGELOG index d07db1cd0..077bdfe2f 100644 --- a/copilot/CHANGELOG +++ b/copilot/CHANGELOG @@ -1,6 +1,7 @@ -2023-12-24 +2023-12-27 * Enable tests for copilot-theorem in CI script. (#474) * Enable tests for copilot-libraries in CI script. (#475) + * Replace uses of forall with forAll. (#470) 2023-11-07 * Version bump (3.17). (#466) From 32ceb9c00c3302ef4ec5ee839f0bad33bc520a66 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 4 Jan 2024 05:00:57 +0000 Subject: [PATCH 0711/1222] copilot-c99: Adapt backend to work with language-c99-simple 0.3. Refs #472. It has been determined that Copilot-generated code should comply with the MISRA C coding standard. The code generated by the C99 backend does not specify that guards and generator functions are internal to the module, even though they are only meant to be called by `step`. However, the lack of a storage class implies that they are implicitly defined with external linkage, violating several rules in MISRA (8.4 and 8.7). In order to fix that, we need to specify that such functions are static, but the language-c99-simple library only incorporated the ability to specify storage information for function definitions in version 0.3. This commit updates the cabal file of the C99 backend to use language-c99-simple >= 0.3. It also updates all uses affected by the change in API, but does not otherwise alter the behavior of the C99 backend. --- copilot-c99/copilot-c99.cabal | 2 +- copilot-c99/src/Copilot/Compile/C99/CodeGen.hs | 10 ++++++---- 2 files changed, 7 insertions(+), 5 deletions(-) diff --git a/copilot-c99/copilot-c99.cabal b/copilot-c99/copilot-c99.cabal index 15831a308..28ec471ce 100644 --- a/copilot-c99/copilot-c99.cabal +++ b/copilot-c99/copilot-c99.cabal @@ -47,7 +47,7 @@ library , copilot-core >= 3.17 && < 3.18 , language-c99 >= 0.2.0 && < 0.3 - , language-c99-simple >= 0.2.2 && < 0.3 + , language-c99-simple >= 0.3 && < 0.4 exposed-modules : Copilot.Compile.C99 diff --git a/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs b/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs index 70bb71aad..adec5df60 100644 --- a/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs +++ b/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs @@ -100,7 +100,8 @@ mkIndexDecln sId = C.VarDecln (Just C.Static) cTy name initVal -- | Define an accessor functions for the ring buffer associated with a stream. mkAccessDecln :: Id -> Type a -> [a] -> C.FunDef -mkAccessDecln sId ty xs = C.FunDef cTy name params [] [C.Return (Just expr)] +mkAccessDecln sId ty xs = + C.FunDef Nothing cTy name params [] [C.Return (Just expr)] where cTy = C.decay $ transType ty name = streamAccessorName sId @@ -113,7 +114,8 @@ mkAccessDecln sId ty xs = C.FunDef cTy name params [] [C.Return (Just expr)] -- | Write a generator function for a stream. mkGenFun :: String -> Expr a -> Type a -> C.FunDef -mkGenFun name expr ty = C.FunDef cTy name [] cVars [C.Return $ Just cExpr] +mkGenFun name expr ty = + C.FunDef Nothing cTy name [] cVars [C.Return $ Just cExpr] where cTy = C.decay $ transType ty (cExpr, cVars) = runState (transExpr expr) mempty @@ -121,7 +123,7 @@ mkGenFun name expr ty = C.FunDef cTy name [] cVars [C.Return $ Just cExpr] -- | Write a generator function for a stream that returns an array. mkGenFunArray :: String -> String -> Expr a -> Type a -> C.FunDef mkGenFunArray name nameArg expr ty@(Array _) = - C.FunDef funType name [ outputParam ] varDecls stmts + C.FunDef Nothing funType name [ outputParam ] varDecls stmts where funType = C.TypeSpec C.Void @@ -145,7 +147,7 @@ mkGenFunArray _name _nameArg _expr _ty = -- | Define the step function that updates all streams. mkStep :: CSettings -> [Stream] -> [Trigger] -> [External] -> C.FunDef mkStep cSettings streams triggers exts = - C.FunDef void (cSettingsStepFunctionName cSettings) [] declns stmts + C.FunDef Nothing void (cSettingsStepFunctionName cSettings) [] declns stmts where void = C.TypeSpec C.Void From 6779d032d2f8f0a6b5e7d7067e75c6ce901d41e9 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 4 Jan 2024 05:05:00 +0000 Subject: [PATCH 0712/1222] copilot-c99: Make functions internal to the module static. Refs #472. It has been determined that Copilot-generated code should comply with the MISRA C coding standard. The code generated by the C99 backend does not specify that guards and generator functions are internal to the module, even though they are only meant to be called by `step`. However, the lack of a storage class implies that they are implicitly defined with external linkage, violating several rules in MISRA (8.4 and 8.7). This commit updates the guards and generators so that they are marked as static and therefore internal to the module in which they are defined. This addresses the aforementioned violations. --- copilot-c99/src/Copilot/Compile/C99/CodeGen.hs | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs b/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs index adec5df60..0ab783bea 100644 --- a/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs +++ b/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs @@ -101,8 +101,9 @@ mkIndexDecln sId = C.VarDecln (Just C.Static) cTy name initVal -- | Define an accessor functions for the ring buffer associated with a stream. mkAccessDecln :: Id -> Type a -> [a] -> C.FunDef mkAccessDecln sId ty xs = - C.FunDef Nothing cTy name params [] [C.Return (Just expr)] + C.FunDef static cTy name params [] [C.Return (Just expr)] where + static = Just C.Static cTy = C.decay $ transType ty name = streamAccessorName sId buffLength = C.LitInt $ fromIntegral $ length xs @@ -115,16 +116,18 @@ mkAccessDecln sId ty xs = -- | Write a generator function for a stream. mkGenFun :: String -> Expr a -> Type a -> C.FunDef mkGenFun name expr ty = - C.FunDef Nothing cTy name [] cVars [C.Return $ Just cExpr] + C.FunDef static cTy name [] cVars [C.Return $ Just cExpr] where + static = Just C.Static cTy = C.decay $ transType ty (cExpr, cVars) = runState (transExpr expr) mempty -- | Write a generator function for a stream that returns an array. mkGenFunArray :: String -> String -> Expr a -> Type a -> C.FunDef mkGenFunArray name nameArg expr ty@(Array _) = - C.FunDef Nothing funType name [ outputParam ] varDecls stmts + C.FunDef static funType name [ outputParam ] varDecls stmts where + static = Just C.Static funType = C.TypeSpec C.Void -- The output value is an array From a867e72b83e98ac90d6b5f265af0a2494cde67b0 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 5 Jan 2024 10:09:49 +0000 Subject: [PATCH 0713/1222] copilot-c99: Cast constants of type size_t used in math operations. Refs #472. It has been determined that Copilot-generated code should comply with the MISRA C coding standard. The code generated by the C99 backend does not specify the types of all constants used in specifications. Specifically, constants are being used in the calculations needed to access and advance the ring buffers, but the type of such constants, which is supposed to be `size_t`, is not specified. This is a possible violation of MISRA C 2012 Rule 10.4, and cppcheck reports it as so (although other tools do not report this violation). This commit updates the functions that access or update ring buffers to specify the types used in constants referring to the index in the buffer or its length, thus solving the existing violation of rule 10.4. --- copilot-c99/src/Copilot/Compile/C99/CodeGen.hs | 15 ++++++++++++--- 1 file changed, 12 insertions(+), 3 deletions(-) diff --git a/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs b/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs index 0ab783bea..ad14f1f01 100644 --- a/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs +++ b/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs @@ -106,7 +106,12 @@ mkAccessDecln sId ty xs = static = Just C.Static cTy = C.decay $ transType ty name = streamAccessorName sId - buffLength = C.LitInt $ fromIntegral $ length xs + + -- We cast the buffer length to a size_t to make sure that there are no + -- implicit conversions. This is a requirement for compliance with MISRA C + -- (Rule 10.4). + buffLength = C.Cast sizeT $ C.LitInt $ fromIntegral $ length xs + sizeT = C.TypeName $ C.TypeSpec $ C.TypedefName "size_t" params = [C.Param (C.TypeSpec $ C.TypedefName "size_t") "x"] index = (C.Ident (indexName sId) C..+ C.Ident "x") C..% buffLength expr = C.Index (C.Ident (streamName sId)) index @@ -199,8 +204,12 @@ mkStep cSettings streams triggers exts = indexUpdate = C.Expr $ indexVar C..= (incIndex C..% buffLength) where - buffLength = C.LitInt $ fromIntegral $ length buff - incIndex = indexVar C..+ C.LitInt 1 + -- We cast the buffer length and the literal one to a size_t to + -- make sure that there are no implicit conversions. This is a + -- requirement for compliance with MISRA C (Rule 10.4). + buffLength = C.Cast sizeT $ C.LitInt $ fromIntegral $ length buff + incIndex = indexVar C..+ C.Cast sizeT (C.LitInt 1) + sizeT = C.TypeName $ C.TypeSpec $ C.TypedefName "size_t" tmpVar = streamName sId ++ "_tmp" buffVar = C.Ident $ streamName sId From 56dad3080c965b53fdfc686f24d0251ba9f4da2f Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 7 Jan 2024 02:36:57 +0000 Subject: [PATCH 0714/1222] copilot: Update CI job to check for MISRA compliance with cppcheck. Refs #472. It has been determined that Copilot-generated code should comply with the MISRA C coding standard. To ensure that future versions of Copilot keep complying with MISRA, this commit modifies the CI job to check a sample file for compliance using cppcheck. Note that the version of cppcheck included with xenial, which is the distribution used currently by Travis by default, does not include a version of cppcheck modern enough to accept the flag --addon=misra.py. Consequently, we update the dist to be focal. --- .travis.yml | 19 +++++++++++++++---- 1 file changed, 15 insertions(+), 4 deletions(-) diff --git a/.travis.yml b/.travis.yml index 8b52b02fe..c7c69118d 100644 --- a/.travis.yml +++ b/.travis.yml @@ -1,3 +1,6 @@ +# dist should be at least focal because we need cppcheck >= 1.88. +dist: focal + # NB: don't set `language: haskell` here # The following enables several GHC versions to be tested; often it's enough to @@ -16,9 +19,9 @@ before_install: - travis_retry sudo apt-get update - travis_retry sudo apt-get install cabal-install-$CABALVER ghc-$GHCVER # see note about happy/alex - # We install z3 only for the tests, since it is not needed for normal - # compilation. - - if [ "${GHCVER}" == "8.10.4" ]; then travis_retry sudo apt-get install --yes z3; fi + # We install z3 and cppcheck only for the tests, since they are not needed + # for normal compilation. + - if [ "${GHCVER}" == "8.10.4" ]; then travis_retry sudo apt-get install --yes z3 cppcheck; fi - export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$PATH - cabal --version @@ -27,7 +30,10 @@ before_install: - git submodule update --remote script: - - travis_wait 30 cabal v2-install --lib copilot + # We explicitly install all libraries so that they are exposed and we can use + # them for tests (e.g., with runhaskell). There is no harm in doing this + # instead of installing just copilot. + - travis_wait 30 cabal v2-install --lib copilot copilot-core copilot-c99 copilot-language copilot-libraries copilot-theorem copilot-interpreter copilot-prettyprinter # Run tests only on GHC 8.10.4 # @@ -37,3 +43,8 @@ script: # conditional installation, and keep GHC version numbers in both places in # sync. - if [ "${GHCVER}" == "8.10.4" ]; then cabal v2-test -j1 copilot-core copilot-language copilot-interpreter copilot-c99 copilot-theorem copilot-libraries; fi + + # Check that the code produced by Copilot complies with MISRA C 2012. We + # explicitly make cppcheck produce a non-zero exit code on non-compliance + # with the standard to make the CI build fail. + - if [ "${GHCVER}" == "8.10.4" ]; then runhaskell copilot/examples/Heater.hs; cppcheck --force --addon=misra.py --suppress=misra-c2012-14.4 --error-exitcode=2 heater.c; fi From 3950c99f7891acabe5975aa29ff263cc1faf01fb Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 4 Jan 2024 05:08:03 +0000 Subject: [PATCH 0715/1222] copilot-c99: Document changes in CHANGELOG. Refs #472. --- copilot-c99/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot-c99/CHANGELOG b/copilot-c99/CHANGELOG index 7a9315d43..6e0c8b47a 100644 --- a/copilot-c99/CHANGELOG +++ b/copilot-c99/CHANGELOG @@ -1,7 +1,8 @@ -2023-12-19 +2024-01-06 * Change return type of main generated for tests. (#468) * Print constants in tests using portable suffixes. (#471). * Pass output arrays as arguments to trigger argument functions. (#431) + * Compliance with MISRA C 2023 / MISRA C 2012. (#472) 2023-11-07 * Version bump (3.17). (#466) From e0dd7f0b49d2fda711d4fdf1c1ce7723598eb686 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 7 Jan 2024 02:38:14 +0000 Subject: [PATCH 0716/1222] copilot: Document changes in CHANGELOG. Refs #472. --- copilot/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot/CHANGELOG b/copilot/CHANGELOG index 077bdfe2f..332384cbf 100644 --- a/copilot/CHANGELOG +++ b/copilot/CHANGELOG @@ -1,7 +1,8 @@ -2023-12-27 +2024-01-06 * Enable tests for copilot-theorem in CI script. (#474) * Enable tests for copilot-libraries in CI script. (#475) * Replace uses of forall with forAll. (#470) + * Update CI job to check for MISRA compliance with cppcheck. (#472) 2023-11-07 * Version bump (3.17). (#466) From ab717f637df3d18e61cde169d520da6d3aa6490c Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 7 Jan 2024 21:45:44 +0000 Subject: [PATCH 0717/1222] copilot: Relax version constraint on optparse-applicative. Refs #488. In order to keep Copilot effectively working in the current Haskell ecosystem, we need to extend the versions of dependencies that Copilot can be installed with. For example, optparse-applicative has seen a new release 0.18.1.0, but copilot needs versions strictly lower than 0.18. This commit relaxes the upper bounds on optparse-applicative so that it can be installed with the 0.18 series. --- copilot/copilot.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot/copilot.cabal b/copilot/copilot.cabal index 556ff157d..c50babe0a 100644 --- a/copilot/copilot.cabal +++ b/copilot/copilot.cabal @@ -48,7 +48,7 @@ library -fno-warn-orphans build-depends: base >= 4.9 && < 5 - , optparse-applicative >= 0.14 && < 0.18 + , optparse-applicative >= 0.14 && < 0.19 , directory >= 1.3 && < 1.4 , filepath >= 1.4 && < 1.5 From 2f92b7f84e42e15b041f88e54656a4fdfa577072 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 7 Jan 2024 22:02:52 +0000 Subject: [PATCH 0718/1222] copilot: Document changes in CHANGELOG. Refs #488. --- copilot/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot/CHANGELOG b/copilot/CHANGELOG index 332384cbf..4628d09ee 100644 --- a/copilot/CHANGELOG +++ b/copilot/CHANGELOG @@ -1,8 +1,9 @@ -2024-01-06 +2024-01-07 * Enable tests for copilot-theorem in CI script. (#474) * Enable tests for copilot-libraries in CI script. (#475) * Replace uses of forall with forAll. (#470) * Update CI job to check for MISRA compliance with cppcheck. (#472) + * Relax version constraint on optparse-applicative. (#488) 2023-11-07 * Version bump (3.17). (#466) From 085259b6dd00e23c41745c959460b9b7f0264b85 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 7 Jan 2024 23:29:06 +0000 Subject: [PATCH 0719/1222] Bump versions and constraints. Refs #487. --- copilot-c99/copilot-c99.cabal | 4 ++-- copilot-core/copilot-core.cabal | 2 +- copilot-interpreter/copilot-interpreter.cabal | 4 ++-- copilot-language/copilot-language.cabal | 8 ++++---- copilot-libraries/copilot-libraries.cabal | 4 ++-- copilot-prettyprinter/copilot-prettyprinter.cabal | 4 ++-- copilot-theorem/copilot-theorem.cabal | 6 +++--- copilot/copilot.cabal | 14 +++++++------- 8 files changed, 23 insertions(+), 23 deletions(-) diff --git a/copilot-c99/copilot-c99.cabal b/copilot-c99/copilot-c99.cabal index 28ec471ce..c93a5348e 100644 --- a/copilot-c99/copilot-c99.cabal +++ b/copilot-c99/copilot-c99.cabal @@ -1,6 +1,6 @@ cabal-version : >= 1.10 name : copilot-c99 -version : 3.17 +version : 3.18 synopsis : A compiler for Copilot targeting C99. description : This package is a back-end from Copilot to C. @@ -45,7 +45,7 @@ library , mtl >= 2.2 && < 2.4 , pretty >= 1.1 && < 1.2 - , copilot-core >= 3.17 && < 3.18 + , copilot-core >= 3.18 && < 3.19 , language-c99 >= 0.2.0 && < 0.3 , language-c99-simple >= 0.3 && < 0.4 diff --git a/copilot-core/copilot-core.cabal b/copilot-core/copilot-core.cabal index c74cdeb86..32ea1302f 100644 --- a/copilot-core/copilot-core.cabal +++ b/copilot-core/copilot-core.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-core -version: 3.17 +version: 3.18 synopsis: An intermediate representation for Copilot. description: Intermediate representation for Copilot. diff --git a/copilot-interpreter/copilot-interpreter.cabal b/copilot-interpreter/copilot-interpreter.cabal index caa713c00..48f985272 100644 --- a/copilot-interpreter/copilot-interpreter.cabal +++ b/copilot-interpreter/copilot-interpreter.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-interpreter -version: 3.17 +version: 3.18 synopsis: Interpreter for Copilot. description: Interpreter for Copilot. @@ -44,7 +44,7 @@ library base >= 4.9 && < 5, pretty >= 1.0 && < 1.2, - copilot-core >= 3.17 && < 3.18 + copilot-core >= 3.18 && < 3.19 exposed-modules: diff --git a/copilot-language/copilot-language.cabal b/copilot-language/copilot-language.cabal index 8a802b4f1..67b793782 100644 --- a/copilot-language/copilot-language.cabal +++ b/copilot-language/copilot-language.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-language -version: 3.17 +version: 3.18 synopsis: A Haskell-embedded DSL for monitoring hard real-time distributed systems. description: @@ -42,9 +42,9 @@ library , data-reify >= 0.6 && < 0.7 , mtl >= 2.0 && < 3 - , copilot-core >= 3.17 && < 3.18 - , copilot-interpreter >= 3.17 && < 3.18 - , copilot-theorem >= 3.17 && < 3.18 + , copilot-core >= 3.18 && < 3.19 + , copilot-interpreter >= 3.18 && < 3.19 + , copilot-theorem >= 3.18 && < 3.19 exposed-modules: Copilot.Language , Copilot.Language.Operators.BitWise diff --git a/copilot-libraries/copilot-libraries.cabal b/copilot-libraries/copilot-libraries.cabal index 704823643..75cb0f0a0 100644 --- a/copilot-libraries/copilot-libraries.cabal +++ b/copilot-libraries/copilot-libraries.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-libraries -version: 3.17 +version: 3.18 synopsis: Libraries for the Copilot language. description: Libraries for the Copilot language. @@ -41,7 +41,7 @@ library , containers >= 0.4 && < 0.7 , mtl >= 2.0 && < 2.4 , parsec >= 2.0 && < 3.2 - , copilot-language >= 3.17 && < 3.18 + , copilot-language >= 3.18 && < 3.19 exposed-modules: Copilot.Library.Libraries diff --git a/copilot-prettyprinter/copilot-prettyprinter.cabal b/copilot-prettyprinter/copilot-prettyprinter.cabal index fef76fa05..e6338773d 100644 --- a/copilot-prettyprinter/copilot-prettyprinter.cabal +++ b/copilot-prettyprinter/copilot-prettyprinter.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-prettyprinter -version: 3.17 +version: 3.18 synopsis: A prettyprinter of Copilot Specifications. description: A prettyprinter of Copilot specifications. @@ -45,7 +45,7 @@ library base >= 4.9 && < 5, pretty >= 1.0 && < 1.2, - copilot-core >= 3.17 && < 3.18 + copilot-core >= 3.18 && < 3.19 exposed-modules: diff --git a/copilot-theorem/copilot-theorem.cabal b/copilot-theorem/copilot-theorem.cabal index fedd81556..92721420b 100644 --- a/copilot-theorem/copilot-theorem.cabal +++ b/copilot-theorem/copilot-theorem.cabal @@ -14,7 +14,7 @@ description: . -version : 3.17 +version : 3.18 license : BSD3 license-file : LICENSE maintainer : Ivan Perez @@ -63,8 +63,8 @@ library , xml >= 1.3 && < 1.4 , what4 >= 1.3 && < 1.6 - , copilot-core >= 3.17 && < 3.18 - , copilot-prettyprinter >= 3.17 && < 3.18 + , copilot-core >= 3.18 && < 3.19 + , copilot-prettyprinter >= 3.18 && < 3.19 exposed-modules : Copilot.Theorem , Copilot.Theorem.Prove diff --git a/copilot/copilot.cabal b/copilot/copilot.cabal index c50babe0a..9a6e30a68 100644 --- a/copilot/copilot.cabal +++ b/copilot/copilot.cabal @@ -1,5 +1,5 @@ name: copilot -version: 3.17 +version: 3.18 cabal-version: >= 1.10 license: BSD3 license-file: LICENSE @@ -52,12 +52,12 @@ library , directory >= 1.3 && < 1.4 , filepath >= 1.4 && < 1.5 - , copilot-core >= 3.17 && < 3.18 - , copilot-theorem >= 3.17 && < 3.18 - , copilot-language >= 3.17 && < 3.18 - , copilot-libraries >= 3.17 && < 3.18 - , copilot-c99 >= 3.17 && < 3.18 - , copilot-prettyprinter >= 3.17 && < 3.18 + , copilot-core >= 3.18 && < 3.19 + , copilot-theorem >= 3.18 && < 3.19 + , copilot-language >= 3.18 && < 3.19 + , copilot-libraries >= 3.18 && < 3.19 + , copilot-c99 >= 3.18 && < 3.19 + , copilot-prettyprinter >= 3.18 && < 3.19 exposed-modules: Language.Copilot, Language.Copilot.Main From d3f5a5d99e83a137de03a443d32052a9b205df36 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 7 Jan 2024 23:31:42 +0000 Subject: [PATCH 0720/1222] Document changes in CHANGELOG. Refs #487. --- copilot-c99/CHANGELOG | 3 ++- copilot-core/CHANGELOG | 3 +++ copilot-interpreter/CHANGELOG | 3 +++ copilot-language/CHANGELOG | 3 ++- copilot-libraries/CHANGELOG | 3 ++- copilot-prettyprinter/CHANGELOG | 3 +++ copilot-theorem/CHANGELOG | 3 ++- copilot/CHANGELOG | 1 + 8 files changed, 18 insertions(+), 4 deletions(-) diff --git a/copilot-c99/CHANGELOG b/copilot-c99/CHANGELOG index 6e0c8b47a..01d7012fa 100644 --- a/copilot-c99/CHANGELOG +++ b/copilot-c99/CHANGELOG @@ -1,4 +1,5 @@ -2024-01-06 +2024-01-07 + * Version bump (3.18). (#487) * Change return type of main generated for tests. (#468) * Print constants in tests using portable suffixes. (#471). * Pass output arrays as arguments to trigger argument functions. (#431) diff --git a/copilot-core/CHANGELOG b/copilot-core/CHANGELOG index 004210696..95c7c3686 100644 --- a/copilot-core/CHANGELOG +++ b/copilot-core/CHANGELOG @@ -1,3 +1,6 @@ +2024-01-07 + * Version bump (3.18). (#487) + 2023-11-07 * Version bump (3.17). (#466) * Compliance with style guide. (#457) diff --git a/copilot-interpreter/CHANGELOG b/copilot-interpreter/CHANGELOG index 2a0f148a1..e8b837519 100644 --- a/copilot-interpreter/CHANGELOG +++ b/copilot-interpreter/CHANGELOG @@ -1,3 +1,6 @@ +2024-01-07 + * Version bump (3.18). (#487) + 2023-11-07 * Version bump (3.17). (#466) * Replace uses of deprecated functions. (#457) diff --git a/copilot-language/CHANGELOG b/copilot-language/CHANGELOG index b8a9e663f..6006a524c 100644 --- a/copilot-language/CHANGELOG +++ b/copilot-language/CHANGELOG @@ -1,4 +1,5 @@ -2023-12-27 +2024-01-07 + * Version bump (3.18). (#487) * Add type annotation to help type inference engine. (#469) * Rename forall to forAll. (#470) diff --git a/copilot-libraries/CHANGELOG b/copilot-libraries/CHANGELOG index 221e34a7a..7899f485f 100644 --- a/copilot-libraries/CHANGELOG +++ b/copilot-libraries/CHANGELOG @@ -1,4 +1,5 @@ -2023-12-27 +2024-01-07 + * Version bump (3.18). (#487) * Introduce testing infrastructure for Copilot.Library. (#475) * Replace uses of forall with forAll. (#470) diff --git a/copilot-prettyprinter/CHANGELOG b/copilot-prettyprinter/CHANGELOG index eb2cfdd95..72560b9f3 100644 --- a/copilot-prettyprinter/CHANGELOG +++ b/copilot-prettyprinter/CHANGELOG @@ -1,3 +1,6 @@ +2024-01-07 + * Version bump (3.18). (#487) + 2023-11-07 * Version bump (3.17). (#466) diff --git a/copilot-theorem/CHANGELOG b/copilot-theorem/CHANGELOG index b78bee0d4..0ad495eff 100644 --- a/copilot-theorem/CHANGELOG +++ b/copilot-theorem/CHANGELOG @@ -1,4 +1,5 @@ -2023-12-27 +2024-01-07 + * Version bump (3.18). (#487) * Introduce testing infrastructure for Copilot.Theorem.What4. (#474) * Replace uses of forall with forAll. (#470) diff --git a/copilot/CHANGELOG b/copilot/CHANGELOG index 4628d09ee..52245ae95 100644 --- a/copilot/CHANGELOG +++ b/copilot/CHANGELOG @@ -1,4 +1,5 @@ 2024-01-07 + * Version bump (3.18). (#487) * Enable tests for copilot-theorem in CI script. (#474) * Enable tests for copilot-libraries in CI script. (#475) * Replace uses of forall with forAll. (#470) From 1c6e0c77ec6be4304de091633d8599dc00abc736 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 8 Jan 2024 05:27:31 +0000 Subject: [PATCH 0721/1222] copilot-theorem: Mark module as trustworthy. Refs #491. The module Copilot.Theorem.Misc.Utils, which is marked as safe, imports System.Directory, which in a recent minor update, has been marked as not safe. This makes the import illegal. This commit updates the module Copilot.Theorem.Misc.Utils as trustworthy, so that the import of System.Directory does not lead to a compilation error. --- copilot-theorem/src/Copilot/Theorem/Misc/Utils.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot-theorem/src/Copilot/Theorem/Misc/Utils.hs b/copilot-theorem/src/Copilot/Theorem/Misc/Utils.hs index 9f15a0fa3..10b4666a4 100644 --- a/copilot-theorem/src/Copilot/Theorem/Misc/Utils.hs +++ b/copilot-theorem/src/Copilot/Theorem/Misc/Utils.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE Safe #-} +{-# LANGUAGE Trustworthy #-} -- | Utility / auxiliary functions. module Copilot.Theorem.Misc.Utils From b826f4230b464a191f832c46e9890c38ef8f05f8 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 8 Jan 2024 07:03:48 +0000 Subject: [PATCH 0722/1222] copilot-theorem: Add explicit imports for Control.Monad. Refs #491. The modules in Control.Monad.* in mtl >= 2.3 no longer re-export Control.Monad, leading to a number of compilation errors in copilot-theorem. Since mtl >= 2.3 is required for Copilot to work with GHC 9.6 and above, this issue prevents Copilot from compiling with current versions of GHC, including the one in hackage. This commit updates copilot-theorem so that any imports from Control.Monad are explicit and not via re-exports from other modules. --- copilot-theorem/src/Copilot/Theorem/IL/Translate.hs | 1 + copilot-theorem/src/Copilot/Theorem/Prove.hs | 1 + copilot-theorem/src/Copilot/Theorem/TransSys/Translate.hs | 1 + copilot-theorem/src/Copilot/Theorem/What4.hs | 1 + 4 files changed, 4 insertions(+) diff --git a/copilot-theorem/src/Copilot/Theorem/IL/Translate.hs b/copilot-theorem/src/Copilot/Theorem/IL/Translate.hs index cf2e06ee2..0bb6bfa37 100644 --- a/copilot-theorem/src/Copilot/Theorem/IL/Translate.hs +++ b/copilot-theorem/src/Copilot/Theorem/IL/Translate.hs @@ -14,6 +14,7 @@ import qualified Copilot.Core as C import qualified Data.Map.Strict as Map +import Control.Monad (forM, liftM2, when) import Control.Monad.State import Data.Char diff --git a/copilot-theorem/src/Copilot/Theorem/Prove.hs b/copilot-theorem/src/Copilot/Theorem/Prove.hs index f1a3d3297..ed9a7d78d 100644 --- a/copilot-theorem/src/Copilot/Theorem/Prove.hs +++ b/copilot-theorem/src/Copilot/Theorem/Prove.hs @@ -22,6 +22,7 @@ import qualified Copilot.Core as Core import Data.List (intercalate) import Control.Applicative (liftA2) +import Control.Monad (ap, liftM) import Control.Monad.Writer -- | Output produced by a prover, containing the 'Status' of the proof and diff --git a/copilot-theorem/src/Copilot/Theorem/TransSys/Translate.hs b/copilot-theorem/src/Copilot/Theorem/TransSys/Translate.hs index 5dbab52be..cc557e429 100644 --- a/copilot-theorem/src/Copilot/Theorem/TransSys/Translate.hs +++ b/copilot-theorem/src/Copilot/Theorem/TransSys/Translate.hs @@ -47,6 +47,7 @@ import Copilot.Theorem.TransSys.Spec import Copilot.Theorem.TransSys.Cast import Copilot.Theorem.Misc.Utils +import Control.Monad (liftM, liftM2, unless) import Control.Monad.State.Lazy import Data.Char (isNumber) diff --git a/copilot-theorem/src/Copilot/Theorem/What4.hs b/copilot-theorem/src/Copilot/Theorem/What4.hs index 48dc8047c..6971ae673 100644 --- a/copilot-theorem/src/Copilot/Theorem/What4.hs +++ b/copilot-theorem/src/Copilot/Theorem/What4.hs @@ -57,6 +57,7 @@ import qualified What4.InterpretedFloatingPoint as WFP import qualified What4.Solver as WS import qualified What4.Solver.DReal as WS +import Control.Monad (forM) import Control.Monad.State import qualified Data.BitVector.Sized as BV import Data.Foldable (foldrM) From 0a8d1a9fa66cda41d76613083691a299a463e610 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 8 Jan 2024 07:42:26 +0000 Subject: [PATCH 0723/1222] copilot: Update README to reflect support for GHC 9.6. Refs #491. A recent update to copilot-theorem makes all of Copilot compatible with GHC 9.6. This commit updates the README to reflect such compatibility. --- copilot/README.md | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/copilot/README.md b/copilot/README.md index 99166ae1a..18ab79517 100644 --- a/copilot/README.md +++ b/copilot/README.md @@ -81,7 +81,7 @@ ghci> ghci> Leaving GHCi. On other Linux distributions or older Debian-based distributions, to use Copilot you must install a Haskell compiler (GHC) and the package manager Cabal. We currently support all versions of GHC from 8.6.5 to modern versions -(9.4 as of this writing). You can install the toolchain using +(9.6 as of this writing). You can install the toolchain using [ghcup](https://www.haskell.org/ghcup/) or, if you are on Debian/Ubuntu, directly with `apt-get`: @@ -111,7 +111,7 @@ ghci> ghci> Leaving GHCi. To use Copilot you must have a Haskell compiler (GHC) and the package manager Cabal. We currently support all versions of GHC from 8.6.5 to modern versions -(9.4 as of this writing). You can install the toolchain using +(9.6 as of this writing). You can install the toolchain using [ghcup](https://www.haskell.org/ghcup/), as well as with Homebrew: ```sh From 9a75038c2f0fdf6095ddc1974843469a9b010d05 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 8 Jan 2024 07:43:21 +0000 Subject: [PATCH 0724/1222] copilot-theorem: Document changes in CHANGELOG. Refs #491. --- copilot-theorem/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-theorem/CHANGELOG b/copilot-theorem/CHANGELOG index 0ad495eff..e86a5ad04 100644 --- a/copilot-theorem/CHANGELOG +++ b/copilot-theorem/CHANGELOG @@ -1,3 +1,6 @@ +2024-01-07 + * Adjust to work with GHC 9.6. (#491) + 2024-01-07 * Version bump (3.18). (#487) * Introduce testing infrastructure for Copilot.Theorem.What4. (#474) From b9c7f5861cd05fe87958f9f067f91ff1bfe908bb Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 8 Jan 2024 07:43:55 +0000 Subject: [PATCH 0725/1222] copilot: Document changes in CHANGELOG. Refs #491. --- copilot/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot/CHANGELOG b/copilot/CHANGELOG index 52245ae95..cfeb1684d 100644 --- a/copilot/CHANGELOG +++ b/copilot/CHANGELOG @@ -1,3 +1,6 @@ +2024-01-07 + * Update README to reflect support for GHC 9.6. (#491) + 2024-01-07 * Version bump (3.18). (#487) * Enable tests for copilot-theorem in CI script. (#474) From 574cefb5c5428843abe9b7288f523b81eb3ff770 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 8 Jan 2024 08:59:16 +0000 Subject: [PATCH 0726/1222] Bump versions and constraints. Refs #493. --- copilot-c99/copilot-c99.cabal | 8 ++++---- copilot-core/copilot-core.cabal | 2 +- copilot-interpreter/copilot-interpreter.cabal | 4 ++-- copilot-language/copilot-language.cabal | 8 ++++---- copilot-libraries/copilot-libraries.cabal | 4 ++-- copilot-prettyprinter/copilot-prettyprinter.cabal | 4 ++-- copilot-theorem/copilot-theorem.cabal | 6 +++--- copilot/copilot.cabal | 14 +++++++------- 8 files changed, 25 insertions(+), 25 deletions(-) diff --git a/copilot-c99/copilot-c99.cabal b/copilot-c99/copilot-c99.cabal index c93a5348e..4a5dbbd54 100644 --- a/copilot-c99/copilot-c99.cabal +++ b/copilot-c99/copilot-c99.cabal @@ -1,6 +1,6 @@ cabal-version : >= 1.10 name : copilot-c99 -version : 3.18 +version : 3.18.1 synopsis : A compiler for Copilot targeting C99. description : This package is a back-end from Copilot to C. @@ -45,9 +45,9 @@ library , mtl >= 2.2 && < 2.4 , pretty >= 1.1 && < 1.2 - , copilot-core >= 3.18 && < 3.19 - , language-c99 >= 0.2.0 && < 0.3 - , language-c99-simple >= 0.3 && < 0.4 + , copilot-core >= 3.18.1 && < 3.19 + , language-c99 >= 0.2.0 && < 0.3 + , language-c99-simple >= 0.3 && < 0.4 exposed-modules : Copilot.Compile.C99 diff --git a/copilot-core/copilot-core.cabal b/copilot-core/copilot-core.cabal index 32ea1302f..463789f21 100644 --- a/copilot-core/copilot-core.cabal +++ b/copilot-core/copilot-core.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-core -version: 3.18 +version: 3.18.1 synopsis: An intermediate representation for Copilot. description: Intermediate representation for Copilot. diff --git a/copilot-interpreter/copilot-interpreter.cabal b/copilot-interpreter/copilot-interpreter.cabal index 48f985272..46092fb46 100644 --- a/copilot-interpreter/copilot-interpreter.cabal +++ b/copilot-interpreter/copilot-interpreter.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-interpreter -version: 3.18 +version: 3.18.1 synopsis: Interpreter for Copilot. description: Interpreter for Copilot. @@ -44,7 +44,7 @@ library base >= 4.9 && < 5, pretty >= 1.0 && < 1.2, - copilot-core >= 3.18 && < 3.19 + copilot-core >= 3.18.1 && < 3.19 exposed-modules: diff --git a/copilot-language/copilot-language.cabal b/copilot-language/copilot-language.cabal index 67b793782..ebdb78aa1 100644 --- a/copilot-language/copilot-language.cabal +++ b/copilot-language/copilot-language.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-language -version: 3.18 +version: 3.18.1 synopsis: A Haskell-embedded DSL for monitoring hard real-time distributed systems. description: @@ -42,9 +42,9 @@ library , data-reify >= 0.6 && < 0.7 , mtl >= 2.0 && < 3 - , copilot-core >= 3.18 && < 3.19 - , copilot-interpreter >= 3.18 && < 3.19 - , copilot-theorem >= 3.18 && < 3.19 + , copilot-core >= 3.18.1 && < 3.19 + , copilot-interpreter >= 3.18.1 && < 3.19 + , copilot-theorem >= 3.18.1 && < 3.19 exposed-modules: Copilot.Language , Copilot.Language.Operators.BitWise diff --git a/copilot-libraries/copilot-libraries.cabal b/copilot-libraries/copilot-libraries.cabal index 75cb0f0a0..2a6449e45 100644 --- a/copilot-libraries/copilot-libraries.cabal +++ b/copilot-libraries/copilot-libraries.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-libraries -version: 3.18 +version: 3.18.1 synopsis: Libraries for the Copilot language. description: Libraries for the Copilot language. @@ -41,7 +41,7 @@ library , containers >= 0.4 && < 0.7 , mtl >= 2.0 && < 2.4 , parsec >= 2.0 && < 3.2 - , copilot-language >= 3.18 && < 3.19 + , copilot-language >= 3.18.1 && < 3.19 exposed-modules: Copilot.Library.Libraries diff --git a/copilot-prettyprinter/copilot-prettyprinter.cabal b/copilot-prettyprinter/copilot-prettyprinter.cabal index e6338773d..0ab1b9214 100644 --- a/copilot-prettyprinter/copilot-prettyprinter.cabal +++ b/copilot-prettyprinter/copilot-prettyprinter.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-prettyprinter -version: 3.18 +version: 3.18.1 synopsis: A prettyprinter of Copilot Specifications. description: A prettyprinter of Copilot specifications. @@ -45,7 +45,7 @@ library base >= 4.9 && < 5, pretty >= 1.0 && < 1.2, - copilot-core >= 3.18 && < 3.19 + copilot-core >= 3.18.1 && < 3.19 exposed-modules: diff --git a/copilot-theorem/copilot-theorem.cabal b/copilot-theorem/copilot-theorem.cabal index 92721420b..8d441ecf2 100644 --- a/copilot-theorem/copilot-theorem.cabal +++ b/copilot-theorem/copilot-theorem.cabal @@ -14,7 +14,7 @@ description: . -version : 3.18 +version : 3.18.1 license : BSD3 license-file : LICENSE maintainer : Ivan Perez @@ -63,8 +63,8 @@ library , xml >= 1.3 && < 1.4 , what4 >= 1.3 && < 1.6 - , copilot-core >= 3.18 && < 3.19 - , copilot-prettyprinter >= 3.18 && < 3.19 + , copilot-core >= 3.18.1 && < 3.19 + , copilot-prettyprinter >= 3.18.1 && < 3.19 exposed-modules : Copilot.Theorem , Copilot.Theorem.Prove diff --git a/copilot/copilot.cabal b/copilot/copilot.cabal index 9a6e30a68..7f0715d93 100644 --- a/copilot/copilot.cabal +++ b/copilot/copilot.cabal @@ -1,5 +1,5 @@ name: copilot -version: 3.18 +version: 3.18.1 cabal-version: >= 1.10 license: BSD3 license-file: LICENSE @@ -52,12 +52,12 @@ library , directory >= 1.3 && < 1.4 , filepath >= 1.4 && < 1.5 - , copilot-core >= 3.18 && < 3.19 - , copilot-theorem >= 3.18 && < 3.19 - , copilot-language >= 3.18 && < 3.19 - , copilot-libraries >= 3.18 && < 3.19 - , copilot-c99 >= 3.18 && < 3.19 - , copilot-prettyprinter >= 3.18 && < 3.19 + , copilot-core >= 3.18.1 && < 3.19 + , copilot-theorem >= 3.18.1 && < 3.19 + , copilot-language >= 3.18.1 && < 3.19 + , copilot-libraries >= 3.18.1 && < 3.19 + , copilot-c99 >= 3.18.1 && < 3.19 + , copilot-prettyprinter >= 3.18.1 && < 3.19 exposed-modules: Language.Copilot, Language.Copilot.Main From 70da64a31d97abe3d7ece3e62e3335af7e3ed786 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 8 Jan 2024 09:00:54 +0000 Subject: [PATCH 0727/1222] Document changes in CHANGELOG. Refs #493. --- copilot-c99/CHANGELOG | 3 +++ copilot-core/CHANGELOG | 3 +++ copilot-interpreter/CHANGELOG | 3 +++ copilot-language/CHANGELOG | 3 +++ copilot-libraries/CHANGELOG | 3 +++ copilot-prettyprinter/CHANGELOG | 3 +++ copilot-theorem/CHANGELOG | 1 + copilot/CHANGELOG | 1 + 8 files changed, 20 insertions(+) diff --git a/copilot-c99/CHANGELOG b/copilot-c99/CHANGELOG index 01d7012fa..c79e188ae 100644 --- a/copilot-c99/CHANGELOG +++ b/copilot-c99/CHANGELOG @@ -1,3 +1,6 @@ +2024-01-07 + * Version bump (3.18.1). (#493) + 2024-01-07 * Version bump (3.18). (#487) * Change return type of main generated for tests. (#468) diff --git a/copilot-core/CHANGELOG b/copilot-core/CHANGELOG index 95c7c3686..c13107a0a 100644 --- a/copilot-core/CHANGELOG +++ b/copilot-core/CHANGELOG @@ -1,3 +1,6 @@ +2024-01-07 + * Version bump (3.18.1). (#493) + 2024-01-07 * Version bump (3.18). (#487) diff --git a/copilot-interpreter/CHANGELOG b/copilot-interpreter/CHANGELOG index e8b837519..6cf78476f 100644 --- a/copilot-interpreter/CHANGELOG +++ b/copilot-interpreter/CHANGELOG @@ -1,3 +1,6 @@ +2024-01-07 + * Version bump (3.18.1). (#493) + 2024-01-07 * Version bump (3.18). (#487) diff --git a/copilot-language/CHANGELOG b/copilot-language/CHANGELOG index 6006a524c..aac248ca5 100644 --- a/copilot-language/CHANGELOG +++ b/copilot-language/CHANGELOG @@ -1,3 +1,6 @@ +2024-01-07 + * Version bump (3.18.1). (#493) + 2024-01-07 * Version bump (3.18). (#487) * Add type annotation to help type inference engine. (#469) diff --git a/copilot-libraries/CHANGELOG b/copilot-libraries/CHANGELOG index 7899f485f..00d22c6a7 100644 --- a/copilot-libraries/CHANGELOG +++ b/copilot-libraries/CHANGELOG @@ -1,3 +1,6 @@ +2024-01-07 + * Version bump (3.18.1). (#493) + 2024-01-07 * Version bump (3.18). (#487) * Introduce testing infrastructure for Copilot.Library. (#475) diff --git a/copilot-prettyprinter/CHANGELOG b/copilot-prettyprinter/CHANGELOG index 72560b9f3..0beea5fb4 100644 --- a/copilot-prettyprinter/CHANGELOG +++ b/copilot-prettyprinter/CHANGELOG @@ -1,3 +1,6 @@ +2024-01-07 + * Version bump (3.18.1). (#493) + 2024-01-07 * Version bump (3.18). (#487) diff --git a/copilot-theorem/CHANGELOG b/copilot-theorem/CHANGELOG index e86a5ad04..7629ac0b7 100644 --- a/copilot-theorem/CHANGELOG +++ b/copilot-theorem/CHANGELOG @@ -1,4 +1,5 @@ 2024-01-07 + * Version bump (3.18.1). (#493) * Adjust to work with GHC 9.6. (#491) 2024-01-07 diff --git a/copilot/CHANGELOG b/copilot/CHANGELOG index cfeb1684d..b2a494985 100644 --- a/copilot/CHANGELOG +++ b/copilot/CHANGELOG @@ -1,4 +1,5 @@ 2024-01-07 + * Version bump (3.18.1). (#493) * Update README to reflect support for GHC 9.6. (#491) 2024-01-07 From 89e22b5f49e900f9e8a31a2c3434df1416dca019 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 8 Mar 2024 01:38:21 +0000 Subject: [PATCH 0728/1222] copilot-core: Remove deprecated function Copilot.Core.Type.tysize. Refs #500. The function Copilot.Core.Type.tysize not being used by any other part of Copilot. It was replaced by a function with lowerCamelCase format, in compliance with Copilot's style guide. The original function was deprecated in Copilot 3.17. As per our internal policy of waiting 3 versions from deprecation until a public interface declaration can be removed, this function can now be removed. This commit removes the function Copilot.Core.Type.tysize from copilot-core. --- copilot-core/src/Copilot/Core/Type.hs | 6 ------ 1 file changed, 6 deletions(-) diff --git a/copilot-core/src/Copilot/Core/Type.hs b/copilot-core/src/Copilot/Core/Type.hs index 3da6917dc..001aec9e2 100644 --- a/copilot-core/src/Copilot/Core/Type.hs +++ b/copilot-core/src/Copilot/Core/Type.hs @@ -24,7 +24,6 @@ module Copilot.Core.Type , SimpleType (..) , typeSize - , tysize , typeLength , tylength @@ -147,11 +146,6 @@ typeSize :: forall n t . KnownNat n => Type (Array n t) -> Int typeSize ty@(Array ty'@(Array _)) = typeLength ty * typeSize ty' typeSize ty@(Array _ ) = typeLength ty -{-# DEPRECATED tysize "Use typeSize instead." #-} --- | Return the total (nested) size of an array from its type -tysize :: forall n t . KnownNat n => Type (Array n t) -> Int -tysize = typeSize - instance TestEquality Type where testEquality Bool Bool = Just DE.Refl testEquality Int8 Int8 = Just DE.Refl From d68c03d9d73fa203d8220c6b409195ede047658d Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 8 Mar 2024 01:39:04 +0000 Subject: [PATCH 0729/1222] copilot-core: Remove deprecated function Copilot.Core.Type.tylength. Refs #500. The function Copilot.Core.Type.tylength not being used by any other part of Copilot. It was replaced by a function with lowerCamelCase format, in compliance with Copilot's style guide. The original function was deprecated in Copilot 3.17. As per our internal policy of waiting 3 versions from deprecation until a public interface declaration can be removed, this function can now be removed. This commit removes the function Copilot.Core.Type.tylength from copilot-core. --- copilot-core/src/Copilot/Core/Type.hs | 6 ------ 1 file changed, 6 deletions(-) diff --git a/copilot-core/src/Copilot/Core/Type.hs b/copilot-core/src/Copilot/Core/Type.hs index 001aec9e2..e10365881 100644 --- a/copilot-core/src/Copilot/Core/Type.hs +++ b/copilot-core/src/Copilot/Core/Type.hs @@ -25,7 +25,6 @@ module Copilot.Core.Type , typeSize , typeLength - , tylength , Value (..) , toValues @@ -136,11 +135,6 @@ data Type :: * -> * where typeLength :: forall n t . KnownNat n => Type (Array n t) -> Int typeLength _ = fromIntegral $ natVal (Proxy :: Proxy n) -{-# DEPRECATED tylength "Use typeLength instead." #-} --- | Return the length of an array from its type -tylength :: forall n t . KnownNat n => Type (Array n t) -> Int -tylength = typeLength - -- | Return the total (nested) size of an array from its type typeSize :: forall n t . KnownNat n => Type (Array n t) -> Int typeSize ty@(Array ty'@(Array _)) = typeLength ty * typeSize ty' From d14323ec8797ccdb894121e15a2b47334de61c35 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 8 Mar 2024 01:39:30 +0000 Subject: [PATCH 0730/1222] copilot-core: Remove deprecated function Copilot.Core.Type.typename. Refs #500. The function Copilot.Core.Type.typename not being used by any other part of Copilot. It was replaced by a function with lowerCamelCase format, in compliance with Copilot's style guide. The original function was deprecated in Copilot 3.17. As per our internal policy of waiting 3 versions from deprecation until a public interface declaration can be removed, this function can now be removed. This commit removes the function Copilot.Core.Type.typename from copilot-core. --- copilot-core/src/Copilot/Core/Type.hs | 8 -------- 1 file changed, 8 deletions(-) diff --git a/copilot-core/src/Copilot/Core/Type.hs b/copilot-core/src/Copilot/Core/Type.hs index e10365881..5c50f0514 100644 --- a/copilot-core/src/Copilot/Core/Type.hs +++ b/copilot-core/src/Copilot/Core/Type.hs @@ -30,7 +30,6 @@ module Copilot.Core.Type , toValues , Field (..) , typeName - , typename , Struct , fieldName @@ -53,18 +52,11 @@ import GHC.TypeLits (KnownNat, KnownSymbol, Symbol, natVal, sameNat, -- Internal imports import Copilot.Core.Type.Array (Array) -{-# DEPRECATED typename "Use typeName instead." #-} - -- | The value of that is a product or struct, defined as a constructor with -- several fields. class Struct a where -- | Returns the name of struct in the target language. typeName :: a -> String - typeName = typename - - -- | Returns the name of struct in the target language. - typename :: a -> String - typename = typeName -- | Transforms all the struct's fields into a list of values. toValues :: a -> [Value a] From a7cf5a44304547ba928907e1c9131d0698cee30f Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 8 Mar 2024 01:39:59 +0000 Subject: [PATCH 0731/1222] copilot-core: Remove deprecated function Copilot.Core.Type.fieldname. Refs #500. The function Copilot.Core.Type.fieldname not being used by any other part of Copilot. It was replaced by a function with lowerCamelCase format, in compliance with Copilot's style guide. The original function was deprecated in Copilot 3.17. As per our internal policy of waiting 3 versions from deprecation until a public interface declaration can be removed, this function can now be removed. This commit removes the function Copilot.Core.Type.fieldname from copilot-core. --- copilot-core/src/Copilot/Core/Type.hs | 6 ------ 1 file changed, 6 deletions(-) diff --git a/copilot-core/src/Copilot/Core/Type.hs b/copilot-core/src/Copilot/Core/Type.hs index 5c50f0514..9f8c8a142 100644 --- a/copilot-core/src/Copilot/Core/Type.hs +++ b/copilot-core/src/Copilot/Core/Type.hs @@ -33,7 +33,6 @@ module Copilot.Core.Type , Struct , fieldName - , fieldname , accessorName , accessorname ) @@ -73,11 +72,6 @@ data Field (s :: Symbol) t = Field t fieldName :: forall s t . KnownSymbol s => Field s t -> String fieldName _ = symbolVal (Proxy :: Proxy s) -{-# DEPRECATED fieldname "Use fieldName instead." #-} --- | Extract the name of a field. -fieldname :: forall s t . KnownSymbol s => Field s t -> String -fieldname = fieldName - -- | Extract the name of an accessor (a function that returns a field of a -- struct). accessorName :: forall a s t . (Struct a, KnownSymbol s) From 8794bec268911933ff2ac7301a4521c2cd7cce6c Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 8 Mar 2024 01:40:11 +0000 Subject: [PATCH 0732/1222] copilot-core: Remove deprecated function Copilot.Core.Type.accessorname. Refs #500. The function Copilot.Core.Type.accessorname not being used by any other part of Copilot. It was replaced by a function with lowerCamelCase format, in compliance with Copilot's style guide. The original function was deprecated in Copilot 3.17. As per our internal policy of waiting 3 versions from deprecation until a public interface declaration can be removed, this function can now be removed. This commit removes the function Copilot.Core.Type.accessorname from copilot-core. --- copilot-core/src/Copilot/Core/Type.hs | 8 -------- 1 file changed, 8 deletions(-) diff --git a/copilot-core/src/Copilot/Core/Type.hs b/copilot-core/src/Copilot/Core/Type.hs index 9f8c8a142..f32260d5b 100644 --- a/copilot-core/src/Copilot/Core/Type.hs +++ b/copilot-core/src/Copilot/Core/Type.hs @@ -34,7 +34,6 @@ module Copilot.Core.Type , Struct , fieldName , accessorName - , accessorname ) where @@ -78,13 +77,6 @@ accessorName :: forall a s t . (Struct a, KnownSymbol s) => (a -> Field s t) -> String accessorName _ = symbolVal (Proxy :: Proxy s) -{-# DEPRECATED accessorname "Use accessorName instead." #-} --- | Extract the name of an accessor (a function that returns a field of a --- struct). -accessorname :: forall a s t . (Struct a, KnownSymbol s) - => (a -> Field s t) -> String -accessorname = accessorName - instance (KnownSymbol s, Show t) => Show (Field s t) where show f@(Field v) = fieldName f ++ ":" ++ show v From 200245100bc03f288fefc8d1d62193497c86a21e Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 8 Mar 2024 01:40:22 +0000 Subject: [PATCH 0733/1222] copilot-core: Remove deprecated function Copilot.Core.Type.Array.arrayelems. Refs #500. The function Copilot.Core.Type.Array.arrayelems not being used by any other part of Copilot. It was replaced by a function with lowerCamelCase format, in compliance with Copilot's style guide. The original function was deprecated in Copilot 3.17. As per our internal policy of waiting 3 versions from deprecation until a public interface declaration can be removed, this function can now be removed. This commit removes the function Copilot.Core.Type.Array.arrayelems from copilot-core. --- copilot-core/src/Copilot/Core/Type/Array.hs | 6 ------ 1 file changed, 6 deletions(-) diff --git a/copilot-core/src/Copilot/Core/Type/Array.hs b/copilot-core/src/Copilot/Core/Type/Array.hs index 2bca9bc11..8d98c556f 100644 --- a/copilot-core/src/Copilot/Core/Type/Array.hs +++ b/copilot-core/src/Copilot/Core/Type/Array.hs @@ -14,7 +14,6 @@ module Copilot.Core.Type.Array ( Array , array , arrayElems - , arrayelems ) where @@ -43,8 +42,3 @@ array xs | datalen == typelen = Array xs -- | Return the elements of an array. arrayElems :: Array n a -> [a] arrayElems (Array xs) = xs - -{-# DEPRECATED arrayelems "Use ArrayElems instead." #-} --- | Return the elemts of an array. -arrayelems :: Array n a -> [a] -arrayelems = arrayElems From 975c6d02a8399867d07c9d6dac2ab7de74042b5e Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 8 Mar 2024 01:48:46 +0000 Subject: [PATCH 0734/1222] copilot-core: Document changes in CHANGELOG. Refs #500. --- copilot-core/CHANGELOG | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/copilot-core/CHANGELOG b/copilot-core/CHANGELOG index c13107a0a..e9edcccd8 100644 --- a/copilot-core/CHANGELOG +++ b/copilot-core/CHANGELOG @@ -1,3 +1,7 @@ +2024-03-07 + * Remove deprecated functions in Copilot.Core.Type and + Copilot.Core.Type.Array. (#500) + 2024-01-07 * Version bump (3.18.1). (#493) From 12a7ffe49ea9b7c98d81723a07d0d075dc958421 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 8 Mar 2024 06:29:23 +0000 Subject: [PATCH 0735/1222] copilot-core: Increase test coverage of Copilot.Core.Type. Refs #502. The test coverage of copilot-core is currently reported at 25% by Hackage. This commit includes tests for all top-level functions in Copilot.Core.Type, except uTypeType. We cannot generate random values of type-level literals, so any tests involving struct field types and array types with specific lengths use hard-coded values. --- copilot-core/tests/Test/Copilot/Core/Type.hs | 245 ++++++++++++++++++- 1 file changed, 242 insertions(+), 3 deletions(-) diff --git a/copilot-core/tests/Test/Copilot/Core/Type.hs b/copilot-core/tests/Test/Copilot/Core/Type.hs index a568c4118..602dfa08a 100644 --- a/copilot-core/tests/Test/Copilot/Core/Type.hs +++ b/copilot-core/tests/Test/Copilot/Core/Type.hs @@ -1,14 +1,24 @@ +{-# LANGUAGE DataKinds #-} -- | Test copilot-core:Copilot.Core.Type. module Test.Copilot.Core.Type where -- External imports +import Data.Int (Int16, Int32, Int64, Int8) +import Data.Maybe (isJust) +import Data.Type.Equality (testEquality) +import Data.Word (Word16, Word32, Word64, Word8) import Test.Framework (Test, testGroup) import Test.Framework.Providers.QuickCheck2 (testProperty) -import Test.QuickCheck (Gen, Property, elements, - forAllBlind, shuffle, (==>)) +import Test.QuickCheck (Gen, Property, arbitrary, elements, + expectFailure, forAll, forAllBlind, + property, shuffle, (==>)) -- Internal imports: library modules being tested -import Copilot.Core.Type (SimpleType (..), Type(..), simpleType) +import Copilot.Core.Type (Field (..), SimpleType (..), Struct (..), + Type (..), Typed, UType (..), Value (..), + accessorName, fieldName, simpleType, typeLength, + typeOf, typeSize) +import Copilot.Core.Type.Array (Array) -- | All unit tests for copilot-core:Copilot.Core.Type. tests :: Test.Framework.Test @@ -24,6 +34,38 @@ tests = testSimpleTypesEqualityTransitive , testProperty "uniqueness of equality of simple types" testSimpleTypesEqualityUniqueness + , testProperty "typeLength matches array size for 1-dimensional arrays" + testTypeLength1 + , testProperty "typeLength matches array size for 2-dimensional arrays" + testTypeLength2 + , testProperty "typeSize matches full array size for 1-dimensional arrays" + testTypeSize1 + , testProperty "typeSize matches full array size for 2-dimensional arrays" + testTypeSize2 + , testProperty "equality of types" + testUTypesEqualitySymmetric + , testProperty "equality of utype" + testUTypesEq + , testProperty "inequality of utype" + testUTypesInequality + , testProperty "inequality of utype via typeOf" + testUTypesTypeOfInequality + , testProperty "fieldName matches field name (positive)" + testFieldNameOk + , testProperty "fieldName matches field name (negative)" + testFieldNameFail + , testProperty "Show field name" + testShowField + , testProperty "Show struct" + testShowStruct + , testProperty "accessorName matches field name (positive)" + testAccessorNameOk + , testProperty "accessorName matches field name (negative)" + testAccessorNameFail + , testProperty "typeName matches struct type name (positive)" + testTypeNameOk + , testProperty "typeName matches struct type name (negative)" + testTypeNameFail ] -- | Test that the function simpleTypes preserves inequality, that is, it @@ -53,6 +95,8 @@ testSimpleTypesInequality = forAllBlind twoDiffTypes $ \(t1, t2) -> , simpleType Word64 , simpleType Float , simpleType Double + , simpleType (Array Int8 :: Type (Array 3 Int8)) + , simpleType (Struct (S (Field 0))) ] -- | Test that the equality relation for simple types is reflexive. @@ -97,4 +141,199 @@ simpleTypes = , SFloat , SDouble , SStruct + , SArray Int8 + , SArray Int16 ] + +-- | Test that the length of an array is as expected. +testTypeLength1 :: Property +testTypeLength1 = property $ typeLength a == 3 + where + a :: Type (Array 3 Int8) + a = Array Int8 + +-- | Test that the length of an multi-dimensional array is as expected. +testTypeLength2 :: Property +testTypeLength2 = property $ typeLength a == 3 + where + a :: Type (Array 3 (Array 12 Int8)) + a = Array (Array Int8) + +-- | Test that the size of an array is as expected. +testTypeSize1 :: Property +testTypeSize1 = property $ typeLength a == 3 + where + a :: Type (Array 3 Int8) + a = Array Int8 + +-- | Test that the size of a multi-dimensional array is as expected (flattens +-- the array). +testTypeSize2 :: Property +testTypeSize2 = property $ typeSize a == 36 + where + a :: Type (Array 3 (Array 12 Int8)) + a = Array (Array Int8) + +-- | Test that equality is symmetric for UTypes via testEquality. +testUTypesEqualitySymmetric :: Property +testUTypesEqualitySymmetric = + forAllBlind (elements utypes) $ \(UType t1) -> isJust (testEquality t1 t1) + +-- | Test that testEquality implies equality for UTypes. +testUTypesEq :: Property +testUTypesEq = + forAllBlind (elements utypes) $ \t@(UType t1) -> isJust (testEquality t1 t1) ==> t == t + +-- | Test that any two different UTypes are not equal. +-- +-- This function pre-selects two UTypes from a list of different UTypes, which +-- guarantees that they will be different. +testUTypesInequality :: Property +testUTypesInequality = forAllBlind twoDiffTypes $ \(t1, t2) -> + t1 /= t2 + where + twoDiffTypes :: Gen (UType, UType) + twoDiffTypes = do + shuffled <- shuffle utypes + case shuffled of + (t1:t2:_) -> return (t1, t2) + _ -> return (UType Bool, UType Bool) + +-- | Different UTypes. +utypes :: [UType] +utypes = + [ UType Bool + , UType Int8 + , UType Int16 + , UType Int32 + , UType Int64 + , UType Word8 + , UType Word16 + , UType Word32 + , UType Word64 + , UType Float + , UType Double + , UType a + , UType b + , UType c + ] + where + a :: Type (Array 3 Int8) + a = Array Int8 + + b :: Type (Array 4 Int8) + b = Array Int8 + + c :: Type S + c = Struct (S (Field 0)) + +-- | Test that any two different UTypes are not equal. +-- +-- This function pre-selects two UTypes from a list of different UTypes built +-- via the function typeOf, which guarantees that they will be different. +testUTypesTypeOfInequality :: Property +testUTypesTypeOfInequality = forAllBlind twoDiffTypes $ \(t1@(UType t1'), t2@(UType t2')) -> + -- The seqs are important: otherwise, the coverage goes down drastically + -- because the typeOf function is not really executed. + t1' `seq` t2' `seq` t1 /= t2 + where + twoDiffTypes :: Gen (UType, UType) + twoDiffTypes = do + shuffled <- shuffle uTypesTypeOf + case shuffled of + (t1:t2:_) -> t1 `seq` t2 `seq` return (t1, t2) + _ -> return (UType Bool, UType Bool) + +-- | Different UTypes, produced by using the function typeOf. +uTypesTypeOf :: [UType] +uTypesTypeOf = + [ UType (typeOf :: Type Bool) + , UType (typeOf :: Type Int8) + , UType (typeOf :: Type Int16) + , UType (typeOf :: Type Int32) + , UType (typeOf :: Type Int64) + , UType (typeOf :: Type Word8) + , UType (typeOf :: Type Word16) + , UType (typeOf :: Type Word32) + , UType (typeOf :: Type Word64) + , UType (typeOf :: Type Float) + , UType (typeOf :: Type Double) + , UType (typeOf :: Type (Array 3 Int8)) + , UType (typeOf :: Type S) + ] + +-- | Test the fieldName function (should succeed). +testFieldNameOk :: Property +testFieldNameOk = forAll arbitrary $ \k -> + fieldName (s1 (S (Field k))) == s1FieldName + where + s1FieldName = "field" + +-- | Test the fieldName function (should fail). +testFieldNameFail :: Property +testFieldNameFail = expectFailure $ property $ + fieldName (s1 sampleS) == s1FieldName + where + sampleS = S (Field 0) + s1FieldName = "Field" + +-- | Test showing a field of a struct. +testShowField :: Property +testShowField = forAll arbitrary $ \k -> + show (s1 (S (Field k))) == ("field:" ++ show k) + +-- | Test showing a struct. +testShowStruct :: Property +testShowStruct = forAll arbitrary $ \k -> + show (S (Field k)) == "" + +-- | Test the accessorName of a field of a struct (should succeed). +testAccessorNameOk :: Property +testAccessorNameOk = property $ + accessorName s1 == s1FieldName + where + s1FieldName = "field" + +-- | Test the accessorName of a field of a struct (should fail). +testAccessorNameFail :: Property +testAccessorNameFail = expectFailure $ property $ + accessorName s1 == s1FieldName + where + s1FieldName = "Field" + +-- | Test the typeName of a struct (should succeed). +testTypeNameOk :: Property +testTypeNameOk = property $ + typeName sampleS == s1TypeName + + where + + sampleS :: S + sampleS = S (Field 0) + + s1TypeName :: String + s1TypeName = "S" + +-- | Test the typeName of a struct (should fail). +testTypeNameFail :: Property +testTypeNameFail = expectFailure $ property $ + typeName sampleS == s1TypeName + + where + + sampleS :: S + sampleS = S (Field 0) + + s1TypeName :: String + s1TypeName = "s" + +-- | Auxiliary struct defined for testing purposes. +data S = S { s1 :: Field "field" Int8 } + +instance Struct S where + typeName _ = "S" + + toValues s = [ Value Int8 (s1 s) ] + +instance Typed S where + typeOf = Struct (S (Field 0)) From a8404c9c004ddbb3ee610be7332aa7ce61a7d055 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 8 Mar 2024 06:28:34 +0000 Subject: [PATCH 0736/1222] copilot-core: Increase test coverage of Copilot.Core.Type.Array. Refs #502. The test coverage of copilot-core is currently reported at 25% by Hackage. This commit includes tests for all top-level functions in Copilot.Core.Type.Array. We cannot generate random values of type-level literals, so any tests involving array types with specific lengths use hard-coded values. --- .../tests/Test/Copilot/Core/Type/Array.hs | 21 +++++++++++++++++-- 1 file changed, 19 insertions(+), 2 deletions(-) diff --git a/copilot-core/tests/Test/Copilot/Core/Type/Array.hs b/copilot-core/tests/Test/Copilot/Core/Type/Array.hs index 9a98d49cc..208fe2fc5 100644 --- a/copilot-core/tests/Test/Copilot/Core/Type/Array.hs +++ b/copilot-core/tests/Test/Copilot/Core/Type/Array.hs @@ -9,8 +9,9 @@ import Data.Proxy (Proxy (..)) import GHC.TypeNats (KnownNat, natVal) import Test.Framework (Test, testGroup) import Test.Framework.Providers.QuickCheck2 (testProperty) -import Test.QuickCheck (Gen, Property, arbitrary, forAll, - vectorOf) +import Test.QuickCheck (Gen, Property, arbitrary, + expectFailure, forAll, property, + vector, vectorOf) -- Internal imports: library modules being tested import Copilot.Core.Type.Array (Array, array, arrayElems) @@ -25,6 +26,10 @@ tests = (testArrayElemsLeft (Proxy :: Proxy 5)) , testProperty "arrayElems . array (identity; 200)" (testArrayElemsLeft (Proxy :: Proxy 200)) + , testProperty "array of incorrect length" + testArrayElemsFail + , testProperty "Show for arrays" + testShowArray ] -- * Individual tests @@ -43,3 +48,15 @@ testArrayElemsLeft len = -- Generator for lists of Int64 of known length. xsInt64 :: Gen [Int64] xsInt64 = vectorOf (fromIntegral (natVal len)) arbitrary + +-- | Test that arrays cannot be properly evaluated if their length does not +-- match their type. +testArrayElemsFail :: Property +testArrayElemsFail = expectFailure $ forAll (vector 3) $ \l -> + let v = array l :: Array 4 Int64 + in arrayElems v == l + +-- | Test show for arrays. +testShowArray :: Property +testShowArray = forAll (vector 3) $ \l -> property $ + show (array l :: Array 3 Int64) == show (l :: [Int64]) From 16c76a4fcaecf8b1c2707dfa6e6e7da6d9227e09 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 8 Mar 2024 06:36:45 +0000 Subject: [PATCH 0737/1222] copilot-core: Document changes in CHANGELOG. Refs #502. --- copilot-core/CHANGELOG | 1 + 1 file changed, 1 insertion(+) diff --git a/copilot-core/CHANGELOG b/copilot-core/CHANGELOG index e9edcccd8..e56d03e48 100644 --- a/copilot-core/CHANGELOG +++ b/copilot-core/CHANGELOG @@ -1,6 +1,7 @@ 2024-03-07 * Remove deprecated functions in Copilot.Core.Type and Copilot.Core.Type.Array. (#500) + * Increase test coverage. (#502) 2024-01-07 * Version bump (3.18.1). (#493) From 4202e39da0dfa203fd9aa9bcc9a0ffd46b479a93 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 8 Mar 2024 08:05:07 +0000 Subject: [PATCH 0738/1222] Bump versions and constraints. Refs #504. --- copilot-c99/copilot-c99.cabal | 8 ++++---- copilot-core/copilot-core.cabal | 2 +- copilot-interpreter/copilot-interpreter.cabal | 4 ++-- copilot-language/copilot-language.cabal | 8 ++++---- copilot-libraries/copilot-libraries.cabal | 4 ++-- copilot-prettyprinter/copilot-prettyprinter.cabal | 4 ++-- copilot-theorem/copilot-theorem.cabal | 6 +++--- copilot/copilot.cabal | 14 +++++++------- 8 files changed, 25 insertions(+), 25 deletions(-) diff --git a/copilot-c99/copilot-c99.cabal b/copilot-c99/copilot-c99.cabal index 4a5dbbd54..70a9ec422 100644 --- a/copilot-c99/copilot-c99.cabal +++ b/copilot-c99/copilot-c99.cabal @@ -1,6 +1,6 @@ cabal-version : >= 1.10 name : copilot-c99 -version : 3.18.1 +version : 3.19 synopsis : A compiler for Copilot targeting C99. description : This package is a back-end from Copilot to C. @@ -45,9 +45,9 @@ library , mtl >= 2.2 && < 2.4 , pretty >= 1.1 && < 1.2 - , copilot-core >= 3.18.1 && < 3.19 - , language-c99 >= 0.2.0 && < 0.3 - , language-c99-simple >= 0.3 && < 0.4 + , copilot-core >= 3.19 && < 3.20 + , language-c99 >= 0.2.0 && < 0.3 + , language-c99-simple >= 0.3 && < 0.4 exposed-modules : Copilot.Compile.C99 diff --git a/copilot-core/copilot-core.cabal b/copilot-core/copilot-core.cabal index 463789f21..4554c52c1 100644 --- a/copilot-core/copilot-core.cabal +++ b/copilot-core/copilot-core.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-core -version: 3.18.1 +version: 3.19 synopsis: An intermediate representation for Copilot. description: Intermediate representation for Copilot. diff --git a/copilot-interpreter/copilot-interpreter.cabal b/copilot-interpreter/copilot-interpreter.cabal index 46092fb46..03fa5405b 100644 --- a/copilot-interpreter/copilot-interpreter.cabal +++ b/copilot-interpreter/copilot-interpreter.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-interpreter -version: 3.18.1 +version: 3.19 synopsis: Interpreter for Copilot. description: Interpreter for Copilot. @@ -44,7 +44,7 @@ library base >= 4.9 && < 5, pretty >= 1.0 && < 1.2, - copilot-core >= 3.18.1 && < 3.19 + copilot-core >= 3.19 && < 3.20 exposed-modules: diff --git a/copilot-language/copilot-language.cabal b/copilot-language/copilot-language.cabal index ebdb78aa1..b07cdb54e 100644 --- a/copilot-language/copilot-language.cabal +++ b/copilot-language/copilot-language.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-language -version: 3.18.1 +version: 3.19 synopsis: A Haskell-embedded DSL for monitoring hard real-time distributed systems. description: @@ -42,9 +42,9 @@ library , data-reify >= 0.6 && < 0.7 , mtl >= 2.0 && < 3 - , copilot-core >= 3.18.1 && < 3.19 - , copilot-interpreter >= 3.18.1 && < 3.19 - , copilot-theorem >= 3.18.1 && < 3.19 + , copilot-core >= 3.19 && < 3.20 + , copilot-interpreter >= 3.19 && < 3.20 + , copilot-theorem >= 3.19 && < 3.20 exposed-modules: Copilot.Language , Copilot.Language.Operators.BitWise diff --git a/copilot-libraries/copilot-libraries.cabal b/copilot-libraries/copilot-libraries.cabal index 2a6449e45..6d72ab2f8 100644 --- a/copilot-libraries/copilot-libraries.cabal +++ b/copilot-libraries/copilot-libraries.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-libraries -version: 3.18.1 +version: 3.19 synopsis: Libraries for the Copilot language. description: Libraries for the Copilot language. @@ -41,7 +41,7 @@ library , containers >= 0.4 && < 0.7 , mtl >= 2.0 && < 2.4 , parsec >= 2.0 && < 3.2 - , copilot-language >= 3.18.1 && < 3.19 + , copilot-language >= 3.19 && < 3.20 exposed-modules: Copilot.Library.Libraries diff --git a/copilot-prettyprinter/copilot-prettyprinter.cabal b/copilot-prettyprinter/copilot-prettyprinter.cabal index 0ab1b9214..74f421cfc 100644 --- a/copilot-prettyprinter/copilot-prettyprinter.cabal +++ b/copilot-prettyprinter/copilot-prettyprinter.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-prettyprinter -version: 3.18.1 +version: 3.19 synopsis: A prettyprinter of Copilot Specifications. description: A prettyprinter of Copilot specifications. @@ -45,7 +45,7 @@ library base >= 4.9 && < 5, pretty >= 1.0 && < 1.2, - copilot-core >= 3.18.1 && < 3.19 + copilot-core >= 3.19 && < 3.20 exposed-modules: diff --git a/copilot-theorem/copilot-theorem.cabal b/copilot-theorem/copilot-theorem.cabal index 8d441ecf2..225ccd456 100644 --- a/copilot-theorem/copilot-theorem.cabal +++ b/copilot-theorem/copilot-theorem.cabal @@ -14,7 +14,7 @@ description: . -version : 3.18.1 +version : 3.19 license : BSD3 license-file : LICENSE maintainer : Ivan Perez @@ -63,8 +63,8 @@ library , xml >= 1.3 && < 1.4 , what4 >= 1.3 && < 1.6 - , copilot-core >= 3.18.1 && < 3.19 - , copilot-prettyprinter >= 3.18.1 && < 3.19 + , copilot-core >= 3.19 && < 3.20 + , copilot-prettyprinter >= 3.19 && < 3.20 exposed-modules : Copilot.Theorem , Copilot.Theorem.Prove diff --git a/copilot/copilot.cabal b/copilot/copilot.cabal index 7f0715d93..3f598386c 100644 --- a/copilot/copilot.cabal +++ b/copilot/copilot.cabal @@ -1,5 +1,5 @@ name: copilot -version: 3.18.1 +version: 3.19 cabal-version: >= 1.10 license: BSD3 license-file: LICENSE @@ -52,12 +52,12 @@ library , directory >= 1.3 && < 1.4 , filepath >= 1.4 && < 1.5 - , copilot-core >= 3.18.1 && < 3.19 - , copilot-theorem >= 3.18.1 && < 3.19 - , copilot-language >= 3.18.1 && < 3.19 - , copilot-libraries >= 3.18.1 && < 3.19 - , copilot-c99 >= 3.18.1 && < 3.19 - , copilot-prettyprinter >= 3.18.1 && < 3.19 + , copilot-core >= 3.19 && < 3.20 + , copilot-theorem >= 3.19 && < 3.20 + , copilot-language >= 3.19 && < 3.20 + , copilot-libraries >= 3.19 && < 3.20 + , copilot-c99 >= 3.19 && < 3.20 + , copilot-prettyprinter >= 3.19 && < 3.20 exposed-modules: Language.Copilot, Language.Copilot.Main From 58809726f6c38f0f0aab04c8d1be133c7036d4d4 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 8 Mar 2024 08:06:46 +0000 Subject: [PATCH 0739/1222] Document changes in CHANGELOG. Refs #504. --- copilot-c99/CHANGELOG | 3 +++ copilot-core/CHANGELOG | 1 + copilot-interpreter/CHANGELOG | 3 +++ copilot-language/CHANGELOG | 3 +++ copilot-libraries/CHANGELOG | 3 +++ copilot-prettyprinter/CHANGELOG | 3 +++ copilot-theorem/CHANGELOG | 3 +++ copilot/CHANGELOG | 3 +++ 8 files changed, 22 insertions(+) diff --git a/copilot-c99/CHANGELOG b/copilot-c99/CHANGELOG index c79e188ae..9e3cd8b43 100644 --- a/copilot-c99/CHANGELOG +++ b/copilot-c99/CHANGELOG @@ -1,3 +1,6 @@ +2024-03-07 + * Version bump (3.19). (#504) + 2024-01-07 * Version bump (3.18.1). (#493) diff --git a/copilot-core/CHANGELOG b/copilot-core/CHANGELOG index e56d03e48..761fcebe9 100644 --- a/copilot-core/CHANGELOG +++ b/copilot-core/CHANGELOG @@ -1,4 +1,5 @@ 2024-03-07 + * Version bump (3.19). (#504) * Remove deprecated functions in Copilot.Core.Type and Copilot.Core.Type.Array. (#500) * Increase test coverage. (#502) diff --git a/copilot-interpreter/CHANGELOG b/copilot-interpreter/CHANGELOG index 6cf78476f..0a7a64611 100644 --- a/copilot-interpreter/CHANGELOG +++ b/copilot-interpreter/CHANGELOG @@ -1,3 +1,6 @@ +2024-03-07 + * Version bump (3.19). (#504) + 2024-01-07 * Version bump (3.18.1). (#493) diff --git a/copilot-language/CHANGELOG b/copilot-language/CHANGELOG index aac248ca5..8834a2974 100644 --- a/copilot-language/CHANGELOG +++ b/copilot-language/CHANGELOG @@ -1,3 +1,6 @@ +2024-03-07 + * Version bump (3.19). (#504) + 2024-01-07 * Version bump (3.18.1). (#493) diff --git a/copilot-libraries/CHANGELOG b/copilot-libraries/CHANGELOG index 00d22c6a7..6a7bb7514 100644 --- a/copilot-libraries/CHANGELOG +++ b/copilot-libraries/CHANGELOG @@ -1,3 +1,6 @@ +2024-03-07 + * Version bump (3.19). (#504) + 2024-01-07 * Version bump (3.18.1). (#493) diff --git a/copilot-prettyprinter/CHANGELOG b/copilot-prettyprinter/CHANGELOG index 0beea5fb4..3d8091be9 100644 --- a/copilot-prettyprinter/CHANGELOG +++ b/copilot-prettyprinter/CHANGELOG @@ -1,3 +1,6 @@ +2024-03-07 + * Version bump (3.19). (#504) + 2024-01-07 * Version bump (3.18.1). (#493) diff --git a/copilot-theorem/CHANGELOG b/copilot-theorem/CHANGELOG index 7629ac0b7..bcaa4842a 100644 --- a/copilot-theorem/CHANGELOG +++ b/copilot-theorem/CHANGELOG @@ -1,3 +1,6 @@ +2024-03-07 + * Version bump (3.19). (#504) + 2024-01-07 * Version bump (3.18.1). (#493) * Adjust to work with GHC 9.6. (#491) diff --git a/copilot/CHANGELOG b/copilot/CHANGELOG index b2a494985..994e999d1 100644 --- a/copilot/CHANGELOG +++ b/copilot/CHANGELOG @@ -1,3 +1,6 @@ +2024-03-07 + * Version bump (3.19). (#504) + 2024-01-07 * Version bump (3.18.1). (#493) * Update README to reflect support for GHC 9.6. (#491) From 866a40769ab3c5f2103fceb93f2c1b390e9db979 Mon Sep 17 00:00:00 2001 From: Ryan Scott Date: Mon, 22 Apr 2024 08:58:46 -0400 Subject: [PATCH 0740/1222] copilot-theorem: Look for `falsifiable` (not `invalid`). Refs #495. In Kind2, disproven properties are tagged with `falsifiable` in the XML output, but the code in `copilot-theorem`'s Kind2 backend was instead searching for a tag named `invalid`. As a result, `copilot-theorem` would error when attempting to disprove properties that are false, as it fail to parse the XML output. This fixes the issue by replacing `invalid` with `falsifiable`. --- copilot-theorem/src/Copilot/Theorem/Kind2/Output.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/copilot-theorem/src/Copilot/Theorem/Kind2/Output.hs b/copilot-theorem/src/Copilot/Theorem/Kind2/Output.hs index 49da4790f..42a2f60dc 100644 --- a/copilot-theorem/src/Copilot/Theorem/Kind2/Output.hs +++ b/copilot-theorem/src/Copilot/Theorem/Kind2/Output.hs @@ -19,9 +19,9 @@ parseOutput :: String -- ^ Property whose validity is being checked. parseOutput prop xml = fromJust $ do root <- parseXMLDoc xml case findAnswer . findPropTag $ root of - "valid" -> return (Output Valid []) - "invalid" -> return (Output Invalid []) - s -> err $ "Unrecognized status : " ++ s + "valid" -> return (Output Valid []) + "falsifiable" -> return (Output Invalid []) + s -> err $ "Unrecognized status : " ++ s where From b153fbc2231ad33862d2b7a94986f0a90bf501f9 Mon Sep 17 00:00:00 2001 From: Ryan Scott Date: Mon, 22 Apr 2024 09:08:11 -0400 Subject: [PATCH 0741/1222] copilot-theorem: Document changes in CHANGELOG. Refs #495. --- copilot-theorem/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-theorem/CHANGELOG b/copilot-theorem/CHANGELOG index bcaa4842a..1c091e591 100644 --- a/copilot-theorem/CHANGELOG +++ b/copilot-theorem/CHANGELOG @@ -1,3 +1,6 @@ +2024-05-05 + * Fix handling of unsatisfiable properties with Kind2. (#495) + 2024-03-07 * Version bump (3.19). (#504) From bdf0d6352e8d9fcd009e1e7d578958df7da0ef5e Mon Sep 17 00:00:00 2001 From: Frank Dedden Date: Mon, 29 Apr 2024 11:46:38 +0200 Subject: [PATCH 0742/1222] copilot-theorem: Remove mention of non-existent `Driver.hs` in README. Refs #452. The section about combining provers mentioned this was shown in the `Driver.hs` file, which does not exist anymore. Additionally, the 'Some examples' section mentioned `Driver.hs` as part of the examples, containing a main function. The `Driver.hs` file does not exist anymore, so these references should be removed. --- copilot-theorem/README.md | 9 ++------- 1 file changed, 2 insertions(+), 7 deletions(-) diff --git a/copilot-theorem/README.md b/copilot-theorem/README.md index 4d75004b3..062a6b08c 100644 --- a/copilot-theorem/README.md +++ b/copilot-theorem/README.md @@ -202,7 +202,7 @@ precise* output. It would be interesting to implement other merging behaviours in the future. For instance, a *lazy* one such that C launches B only if A has returns *unknown* or *error*. -As an example, the following prover is used in `Driver.hs`: +As an example: ```haskell prover = @@ -251,12 +251,7 @@ later. ### Some examples -Some examples are in the *examples* folder. The `Driver.hs` contains the `main` -function to run any example. Each other example file exports a specification -`spec` and a proof scheme `scheme`. You can change the example being run just -by changing one *import* directive in `Driver.hs`. - -These examples include: +Some examples are in the *examples* folder, including: * `Incr.hs` : a straightforward example in the style of the previous one. * `Grey.hs` : an example where two different implementations of a periodical From 78d7fbe3588bf42beae2309b3a8c7f727b19f158 Mon Sep 17 00:00:00 2001 From: Frank Dedden Date: Mon, 29 Apr 2024 14:16:02 +0200 Subject: [PATCH 0743/1222] copilot-theorem: Remove sections about `lightProver` in README. Refs #452. The Light Prover implementation is no longer part of copilot-theorem, and has been replaced by several K-Induction implementations. The sections in the README can be removed. --- copilot-theorem/README.md | 134 ++------------------------------------ 1 file changed, 4 insertions(+), 130 deletions(-) diff --git a/copilot-theorem/README.md b/copilot-theorem/README.md index 062a6b08c..e770c8137 100644 --- a/copilot-theorem/README.md +++ b/copilot-theorem/README.md @@ -67,8 +67,8 @@ Let's say we want to check that `gt0` holds. For this, we use the `prove :: Prover -> ProofScheme -> Spec -> IO ()` function exported by `Copilot.Theorem`. This function takes three arguments: -* The prover we want to use. For now, two provers are available, exported by - the `Copilot.Theorem.Light` and `Copilot.Theorem.Kind2` module. +* The prover we want to use. For now, several provers are available, exported by + the `Copilot.Theorem.Provers.SMT` and `Copilot.Theorem.Kind2` modules. * A *proof scheme*, which is a sequence of instructions like *check*, *assume*, *assert*... * The Copilot specification @@ -120,64 +120,6 @@ argument and checks if the assumptions logically entail the conclusion. -Two provers are provided by default: `Light` and `Kind2`. - -#### The light prover - -The *light prover* is a really simple prover which uses the Yices SMT solver -with the `QF_UFLIA` theory and is limited to prove *k-inductive* properties, -that is properties such that there exists some *k* such that: - -* The property holds during the first *k* steps of the algorithm. -* From the hypothesis the property has held during *k* consecutive steps, we - can prove it is still true one step further. - -For instance, in this example - -```haskell -spec :: Spec -spec = do - prop "gt0" (x > 0) - prop "neq0" (x /= 0) - where - x = [1] ++ (1 + x) -``` -the property `"gt0"` is inductive (1-inductive) but the property `"neq0"` is -not. - - -The *light prover* is defined in `Copilot.Theorem.Light`. This module exports the -`lightProver :: Options -> Prover` function which builds a prover from a record -of type `Options` : - -```haskell -data Options = Options - { kTimeout :: Integer - , onlyBmc :: Bool - , debugMode :: Bool } -``` - -Here, - -* `kTimeout` is the maximum number of steps of the k-induction algorithm the - prover executes before giving up. -* If `onlyBmc` is set to `True`, the prover will only search for - counterexamples and won't try to prove the properties discharged to it. -* If `debugMode` is set to `True`, the SMTLib queries produced by the prover - are displayed in the standard output. - -`Options` is an instance of the `Data.Default` typeclass: - -```haskell -instance Default Options where - def = Options - { kTimeout = 100 - , debugMode = False - , onlyBmc = False } -``` - -Therefore, `def` stands for the default configuration. - #### The Kind2 prover The *Kind2* prover uses the model checker with the same name, from Iowa @@ -283,8 +225,8 @@ available: * The **IL** format: a Copilot program is translated into a list of quantifier-free equations over integer sequences, implicitly universally quantified by a free variable *n*. Each sequence roughly corresponds to a - stream. This format is the one used in G. Hagen's thesis [4]. The *light - prover* works with this format. + stream. This format is the one used in G. Hagen's thesis [4]. Several provers + work with this format. * The **TransSys** format: a Copilot program is *flattened* and translated into a *state transition system* [1]. Moreover, in order to keep some @@ -391,66 +333,6 @@ The file `CoreUtils/Operators` contains helper functions to translate Copilot operators into *copilot-theorem* operators. -#### The Light prover - -As said in the tutorial, the *light prover* is a simple tool implementing the -basic *k-induction* algorithm [1]. The `Light` directory contains three files: - -* `Prover.hs`: the prover and the *k-induction* algorithm are implemented in - this file. -* `SMT.hs` contains some functions to interact with the Yices SMT provers. -* `SMTLib.hs` is a set of functions to output SMTLib directives. It uses the - `Misc.SExpr` module to deal with S-expressions. - -The code is both concise and simple and should be worth a look. - -The prover first translates the copilot specification into the *IL* format. -This translation is implemented in `IL.Translate`. It is straightforward as the -*IL* format does not differ a lot from the *copilot core* format. This is the -case because the reification process has transformed the copilot program such -that the `++` operator only occurs at the top of a stream definition. -Therefore, each stream definition directly gives us a recurrence equation and -initial conditions for the associated sequence. - -The translation process mostly: - -* converts the types and operators, using uninterpreted functions to handle - non-linear operators and external functions. -* creates a sequence for each stream, local stream ands external stream. - -The reader is invited to use the *light prover* on the examples with `debugMode -= true`, in order to have a look at the SMTLib code produced. For instance, if -we check the property `"pos"` on the previous example involving the Fibonacci -sequence, we get: - -``` - (set-logic QF_UFLIA) - (declare-fun n () Int) - (declare-fun s0 (Int) Int) - (assert (= (s0 (+ n 2)) (+ (s0 (+ n 0)) (s0 (+ n 1))))) - (assert (= (s0 (+ n 3)) (+ (s0 (+ n 1)) (s0 (+ n 2))))) - (assert (> (s0 (+ n 0)) 0)) - (push 1) - (assert (or false (not (> (s0 (+ n 1)) 0)))) - (check-sat) - (pop 1) - (assert (= (s0 (+ n 4)) (+ (s0 (+ n 2)) (s0 (+ n 3))))) - (assert (> (s0 (+ n 1)) 0)) - (push 1) - (assert (or false (not (> (s0 (+ n 2)) 0)))) - (check-sat) -unsat - (pop 1) -``` - -Here, we just kept the outputs related to the `` psolver, which is the -solver trying to prove the *continuation step*. - -You can see that the SMT solver is used in an incremental way (`push` and `pop` -instructions), so we don't need to restart it at each step of the algorithm -(see [2]). - - #### The Kind2 prover The *Kind2 prover* first translates the copilot specification into a *modular @@ -802,14 +684,6 @@ architecture of Kind2. ## FAQ -### Why does the light prover not deliver counterexamples ? - -The problem is the light prover is using uninterpreted functions to represent -streams and Yices2 can't give you values for uninterpreted functions when you -ask it for a valid assignment. Maybe we could get better performances and -easily counterexample display if we rewrite the *light prover* so that it works -with *transition systems* instead of *IL*. - ### Why does the code related to transition systems look so complex ? It is true the code of `TransSys` is quite complex. In fact, it would be really From beb6e28ed5d237a04cdafdf60d4c2b2d8242af12 Mon Sep 17 00:00:00 2001 From: Frank Dedden Date: Wed, 1 May 2024 20:00:09 +0200 Subject: [PATCH 0744/1222] copilot-theorem: Replace usage of Light Prover in README. Refs #452. Parts referring to usage specifics of the Light Prover should be updated to the equivalent K-Induction prover, this commit updates these parts. --- copilot-theorem/README.md | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/copilot-theorem/README.md b/copilot-theorem/README.md index e770c8137..5986bd9a8 100644 --- a/copilot-theorem/README.md +++ b/copilot-theorem/README.md @@ -76,10 +76,10 @@ This function takes three arguments: Here, we can just write ```haskell -prove (lightProver def) (check "gt0") spec +prove (kInduction def) (check "gt0") spec ``` -where `lightProver def` stands for the *light prover* with default +where `kInduction def` stands for the *K-Induction prover* with default configuration. ### The Prover interface @@ -133,7 +133,7 @@ It is provided by the `Copilot.Theorem.Kind2` module, which exports a `kind2Prov data Options = Options { bmcMax :: Int } ``` and where `bmcMax` corresponds to the `--bmc_max` option of *kind2* and is -equivalent to the `kTimeout` option of the light prover. Its default value is +equivalent to the `maxK` option of the K-Induction prover. Its default value is 0, which stands for infinity. #### Combining provers @@ -148,7 +148,7 @@ As an example: ```haskell prover = - lightProver def {onlyBmc = True, kTimeout = 5} + kInduction def {kTimeout = 5} `combine` kind2Prover def ``` @@ -563,14 +563,14 @@ The use of SMT solvers introduces two kind of limitations: Let's consider the first point. SMT solving is costly and its performances are sometimes unpredictable. For instance, when running the `SerialBoyerMoore` -example with the *light prover*, Yices2 does not terminate. However, the *z3* +example with the *k-induction prover*, Yices2 does not terminate. However, the *z3* SMT solver used by *Kind2* solves the problem instantaneously. Note that this performance gap is not due to the use of the IC3 algorithm because the property to check is inductive. It could be related to the fact the SMT problem produced -by the *light prover* uses uninterpreted functions for encoding streams instead +by the *k-induction prover* uses uninterpreted functions for encoding streams instead of simple integer variables, which is the case when the copilot program is translated into a transition system. However, this wouldn't explain why the -*light prover* still terminates instantaneously on the `BoyerMoore` example, +*k-induction prover* still terminates instantaneously on the `BoyerMoore` example, which seems not simpler by far. The second point keeps you from expressing or proving some properties From 1d616d4cd42e35f272b477a97050cc1d303ac726 Mon Sep 17 00:00:00 2001 From: Frank Dedden Date: Tue, 7 May 2024 18:08:53 +0200 Subject: [PATCH 0745/1222] copilot-theorem: Ignore output of `prop` in README. Refs #452. The current `prop` returns a reference to the proposition, we have to discard because otherwise the result is not a `Spec`. --- copilot-theorem/README.md | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/copilot-theorem/README.md b/copilot-theorem/README.md index 5986bd9a8..d2fcb8d4c 100644 --- a/copilot-theorem/README.md +++ b/copilot-theorem/README.md @@ -58,7 +58,7 @@ For instance, here is a straightforward specification declaring one property: ```haskell spec :: Spec spec = do - prop "gt0" (x > 0) + void $ prop "gt0" (x > 0) where x = [1] ++ (1 + x) ``` @@ -162,8 +162,8 @@ Let's consider again this example: ```haskell spec :: Spec spec = do - prop "gt0" (x > 0) - prop "neq0" (x /= 0) + void $ prop "gt0" (x > 0) + void $ prop "neq0" (x /= 0) where x = [1] ++ (1 + x) ``` @@ -249,7 +249,7 @@ The following program: ```haskell spec = do - prop "pos" (fib > 0) + void $ prop "pos" (fib > 0) where fib :: Stream Word64 From 0c77e6cbcf0f91dca3f124621942fde3b21408fb Mon Sep 17 00:00:00 2001 From: Frank Dedden Date: Tue, 7 May 2024 18:44:31 +0200 Subject: [PATCH 0746/1222] copilot-theorem: Add `forAll` to propositions in README. Refs #452. The interface for `prop` has changed and now expects a `Prop` of some type as an argument. This commit universally quantifies all argument streams in uses of `prop`. --- copilot-theorem/README.md | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/copilot-theorem/README.md b/copilot-theorem/README.md index d2fcb8d4c..da3a1c8b7 100644 --- a/copilot-theorem/README.md +++ b/copilot-theorem/README.md @@ -58,7 +58,7 @@ For instance, here is a straightforward specification declaring one property: ```haskell spec :: Spec spec = do - void $ prop "gt0" (x > 0) + void $ prop "gt0" (forAll $ x > 0) where x = [1] ++ (1 + x) ``` @@ -162,8 +162,8 @@ Let's consider again this example: ```haskell spec :: Spec spec = do - void $ prop "gt0" (x > 0) - void $ prop "neq0" (x /= 0) + void $ prop "gt0" (forAll $ x > 0) + void $ prop "neq0" (forAll $ x /= 0) where x = [1] ++ (1 + x) ``` @@ -249,7 +249,7 @@ The following program: ```haskell spec = do - void $ prop "pos" (fib > 0) + void $ prop "pos" (forAll $ fib > 0) where fib :: Stream Word64 From 4be277768e77b9d207057bffb2c2f369a8dfb49c Mon Sep 17 00:00:00 2001 From: Frank Dedden Date: Tue, 7 May 2024 18:44:55 +0200 Subject: [PATCH 0747/1222] copilot-theorem: Update installation instructions in README. Refs #452. The installation instructions were outdated. This commit points users to the only installation instructions of Copilot. --- copilot-theorem/README.md | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/copilot-theorem/README.md b/copilot-theorem/README.md index da3a1c8b7..761d3951f 100644 --- a/copilot-theorem/README.md +++ b/copilot-theorem/README.md @@ -28,15 +28,13 @@ properties on Copilot programs. It includes: *copilot-theorem* needs the following dependencies to be installed: -* The *copilot-core* and *copilot-language* Haskell libraries +* The *copilot-core* and *copilot-prettyprinter* Haskell libraries * The *Yices2* SMT-solver: `yices-smt2` must be in your `$PATH` * The *Z3* SMT-solver: `z3` must be in your `$PATH` * The *Kind2* model checker: `kind2` must be in your `$PATH` -To build it, just clone this repository and use `cabal install`. You will find -some examples in the `examples` folder, which can be built with `cabal install` -too, producing an executable `copilot-theorem-example` in your `.cabal/bin` -folder. +To build it, just install the Copilot library as described in the top-level +README. ### First steps From 0fdd6f53878a340de571d9b08781110716525931 Mon Sep 17 00:00:00 2001 From: Frank Dedden Date: Tue, 7 May 2024 18:50:46 +0200 Subject: [PATCH 0748/1222] copilot-theorem: Update usage of `prove` in README. Refs #452. The interface of `prove` has changed a lot. It no longer matches the description. This commit updates all mentions of `prove`, both text and examples, to match the current interface. The old examples used the `kInduction` prover which no longer matches the interface. This commit replaces those calls by the Kind2 prover. --- copilot-theorem/README.md | 20 +++++++++++--------- 1 file changed, 11 insertions(+), 9 deletions(-) diff --git a/copilot-theorem/README.md b/copilot-theorem/README.md index 761d3951f..9f1311810 100644 --- a/copilot-theorem/README.md +++ b/copilot-theorem/README.md @@ -62,22 +62,24 @@ spec = do ``` Let's say we want to check that `gt0` holds. For this, we use the `prove :: -Prover -> ProofScheme -> Spec -> IO ()` function exported by `Copilot.Theorem`. +Copilot.Core.Spec.Spec -> String -> UProof -> IO Bool` function exported by +`Copilot.Theorem`. This function takes three arguments: -* The prover we want to use. For now, several provers are available, exported by - the `Copilot.Theorem.Provers.SMT` and `Copilot.Theorem.Kind2` modules. -* A *proof scheme*, which is a sequence of instructions like *check*, *assume*, - *assert*... -* The Copilot specification +* A reified Copilot.Language.Spec. +* The name of the proposition we want to check. +* A strategy to prove the proposition. -Here, we can just write +In this case the proposition is simple enough so that we can check it directly +by k-induction using `kind2Prover`. Therefore we can just write: ```haskell -prove (kInduction def) (check "gt0") spec +main = do + spec' <- reify spec + prove spec' "gt0" (tell [Check $ kind2Prover def]) ``` -where `kInduction def` stands for the *K-Induction prover* with default +where `kind2Prover def` stands for the *Kind2 prover* with default configuration. ### The Prover interface From 383f9bd22d0086eb3ca24729d5af790609abda61 Mon Sep 17 00:00:00 2001 From: Frank Dedden Date: Tue, 7 May 2024 18:52:09 +0200 Subject: [PATCH 0749/1222] copilot-theorem: Remove outdated section about prover interface in README. Refs #452. The section did not reflect the current state of copilot-theorem anymore. We will make a decision later whether a replacement is necessary, but for now it is simply removed. --- copilot-theorem/README.md | 38 -------------------------------------- 1 file changed, 38 deletions(-) diff --git a/copilot-theorem/README.md b/copilot-theorem/README.md index 9f1311810..710af1eb6 100644 --- a/copilot-theorem/README.md +++ b/copilot-theorem/README.md @@ -82,44 +82,6 @@ main = do where `kind2Prover def` stands for the *Kind2 prover* with default configuration. -### The Prover interface - -The `Copilot.Theorem.Prover` defines a general interface for provers. Therefore, -it is really easy to add a new prover by creating a new object of type -`Prover`. The latter is defined like this: - -```haskell -data Cex = Cex - -type Infos = [String] - -data Output = Output Status Infos - -data Status - = Valid - | Invalid (Maybe Cex) - | Unknown - | Error - -data Feature = GiveCex | HandleAssumptions - -data Prover = forall r . Prover - { proverName :: String - , hasFeature :: Feature -> Bool - , startProver :: Core.Spec -> IO r - , askProver :: r -> [PropId] -> PropId -> IO Output - , closeProver :: r -> IO () - } -``` - -Each prover mostly has to provide a `askProver` function which takes as an -argument -* The prover descriptor -* A list of assumptions -* A conclusion - -and checks if the assumptions logically entail the conclusion. - #### The Kind2 prover The *Kind2* prover uses the model checker with the same name, from Iowa From a5340b453991bdac9f3390c3b9b5024d1bbfd7c5 Mon Sep 17 00:00:00 2001 From: Frank Dedden Date: Tue, 7 May 2024 18:53:39 +0200 Subject: [PATCH 0750/1222] copilot-theorem: Remove section about combining provers in README. Refs #452. Currently only the Kind2 prover can be combined with itself, so it no longer makes sense to have a section about combining provers. This commit removes that section. --- copilot-theorem/README.md | 19 ------------------- 1 file changed, 19 deletions(-) diff --git a/copilot-theorem/README.md b/copilot-theorem/README.md index 710af1eb6..f47904c34 100644 --- a/copilot-theorem/README.md +++ b/copilot-theorem/README.md @@ -98,25 +98,6 @@ and where `bmcMax` corresponds to the `--bmc_max` option of *kind2* and is equivalent to the `maxK` option of the K-Induction prover. Its default value is 0, which stands for infinity. -#### Combining provers - -The `combine :: Prover -> Prover -> Prover` function lets you merge two provers -A and B into a prover C which launches both A and B and returns the *most -precise* output. It would be interesting to implement other merging behaviours -in the future. For instance, a *lazy* one such that C launches B only if A has -returns *unknown* or *error*. - -As an example: - -```haskell -prover = - kInduction def {kTimeout = 5} - `combine` kind2Prover def -``` - -We will discuss the internals and the experimental results of these provers -later. - ### Proof schemes Let's consider again this example: From 1afdeb93ac44717d61961fabf64959516fc4f765 Mon Sep 17 00:00:00 2001 From: Frank Dedden Date: Tue, 7 May 2024 19:00:16 +0200 Subject: [PATCH 0751/1222] copilot-theorem: Remove outdated section about proof schemes in README. Refs #452. The section did not reflect the current state of copilot-theorem anymore. We will make a decision later whether a replacement is necessary, but for now it is simply removed. --- copilot-theorem/README.md | 36 ------------------------------------ 1 file changed, 36 deletions(-) diff --git a/copilot-theorem/README.md b/copilot-theorem/README.md index f47904c34..1f1ac3c7d 100644 --- a/copilot-theorem/README.md +++ b/copilot-theorem/README.md @@ -98,42 +98,6 @@ and where `bmcMax` corresponds to the `--bmc_max` option of *kind2* and is equivalent to the `maxK` option of the K-Induction prover. Its default value is 0, which stands for infinity. -### Proof schemes - -Let's consider again this example: - -```haskell -spec :: Spec -spec = do - void $ prop "gt0" (forAll $ x > 0) - void $ prop "neq0" (forAll $ x /= 0) - where - x = [1] ++ (1 + x) -``` - -and let's say we want to prove `"neq0"`. Currently, the two available solvers -fail at showing this non-inductive property (we will discuss this limitation -later). Therefore, we can prove the more general inductive lemma `"gt0"` and -deduce our main goal from this. For this, we use the proof scheme - -```haskell -assert "gt0" >> check "neq0" -``` -instead of just `check "neq0"`. A proof scheme is chain of primitives schemes -glued by the `>>` operator. For now, the available primitives are: - -* `check "prop"` checks whether or not a given property is true in the current - context. -* `assume "prop"` adds an assumption in the current context. -* `assert "prop"` is a shortcut for `check "prop" >> assume "prop"`. -* `assuming :: [PropId] -> ProofScheme -> ProofScheme` is such that `assuming - props scheme` assumes the list of properties *props*, executes the proof - scheme *scheme* in this context, and forgets the assumptions. -* `msg "..."` displays a string in the standard output - -We will discuss the limitations of this tool and a way to use it in practice -later. - ### Some examples Some examples are in the *examples* folder, including: From b76c1ef309dfdcf4d637dee6146aa3c4ba76d767 Mon Sep 17 00:00:00 2001 From: Frank Dedden Date: Tue, 7 May 2024 19:07:07 +0200 Subject: [PATCH 0752/1222] copilot-theorem: Remove references to old modules in README. Refs #452. Remove mentions of modules that no longer exist. --- copilot-theorem/README.md | 29 +---------------------------- 1 file changed, 1 insertion(+), 28 deletions(-) diff --git a/copilot-theorem/README.md b/copilot-theorem/README.md index 1f1ac3c7d..e16d7f1ea 100644 --- a/copilot-theorem/README.md +++ b/copilot-theorem/README.md @@ -147,9 +147,6 @@ contains at least * `PrettyPrint.hs` for pretty printing (useful for debugging) * `Translate.hs` where the translation process from `Core.Spec` is defined. -These three formats share a simplified set of types and operators, defined -respectively in `Misc.Type` and `Misc.Operator`. - ##### An example The following program: @@ -226,20 +223,6 @@ other Copilot libraries. *copilot-theorem* handles only three types which are sense it ignores integer overflow problems and the loss of precision due to floating point arithmetic. -The rules of translation between Copilot types and *copilot-theorem* types are -defined in `Misc/Cast`. - -#### Operators - -The operators provided by `Misc.Operator` mostly consists in boolean -connectors, linear operators, equality and inequality operators. If other -operators are used in the Copilot program, they are handled using -non-determinism or uninterpreted functions. - -The file `CoreUtils/Operators` contains helper functions to translate Copilot -operators into *copilot-theorem* operators. - - #### The Kind2 prover The *Kind2 prover* first translates the copilot specification into a *modular @@ -493,8 +476,7 @@ arbitrary constant stream because it is the quantified property which is inductive and not the property specialized for a given constant stream. That's why we have no other solution than replacing universal quantification by *bounded* universal quantification by assuming all the elements of the input -stream are in the finite list `allowed` and using the function `forAllCst` -defined in `Copilot.Kind.Lib`: +stream are in the finite list `allowed` and using the function `forAllCst`: ```haskell conj :: [Stream Bool] -> Stream Bool @@ -565,15 +547,6 @@ architecture of Kind2. + Use Template Haskell to declare automatically some observers with the same names used in the original program. -### Refactoring suggestions - -+ Implement a cleaner way to deal with arbitrary streams and arbitrary - constants by extending the `Copilot.Core.Expr type`. See the - `Copilot.Kind.Lib` module to observe how inelegant the current solution is. - -+ Use `Cnub` as an intermediary step in the translation from `Core.Spec` to - `IL.Spec` and `TransSys.Spec`. - ### More advanced enhancements + Enhance the proof scheme system such that when proving a property depending From c947b3ef432a534e304e701ab4ef62a3ebd93a18 Mon Sep 17 00:00:00 2001 From: Frank Dedden Date: Tue, 7 May 2024 19:17:18 +0200 Subject: [PATCH 0753/1222] copilot-theorem: Document changes in CHANGELOG. Refs #452. --- copilot-theorem/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot-theorem/CHANGELOG b/copilot-theorem/CHANGELOG index 1c091e591..417a03696 100644 --- a/copilot-theorem/CHANGELOG +++ b/copilot-theorem/CHANGELOG @@ -1,5 +1,6 @@ -2024-05-05 +2024-05-07 * Fix handling of unsatisfiable properties with Kind2. (#495) + * Remove outdated details from README. (#452) 2024-03-07 * Version bump (3.19). (#504) From 5834d442aeb5c9a3f63484c93026017db3b77520 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Wed, 8 May 2024 06:20:47 +0000 Subject: [PATCH 0754/1222] Bump versions and constraints. Refs #512. --- copilot-c99/copilot-c99.cabal | 8 +++---- copilot-core/copilot-core.cabal | 2 +- copilot-interpreter/copilot-interpreter.cabal | 4 ++-- copilot-language/copilot-language.cabal | 18 +++++++------- copilot-libraries/copilot-libraries.cabal | 12 +++++----- .../copilot-prettyprinter.cabal | 4 ++-- copilot-theorem/copilot-theorem.cabal | 6 ++--- copilot/copilot.cabal | 24 +++++++++---------- 8 files changed, 39 insertions(+), 39 deletions(-) diff --git a/copilot-c99/copilot-c99.cabal b/copilot-c99/copilot-c99.cabal index 70a9ec422..48079d8ba 100644 --- a/copilot-c99/copilot-c99.cabal +++ b/copilot-c99/copilot-c99.cabal @@ -1,6 +1,6 @@ cabal-version : >= 1.10 name : copilot-c99 -version : 3.19 +version : 3.19.1 synopsis : A compiler for Copilot targeting C99. description : This package is a back-end from Copilot to C. @@ -45,9 +45,9 @@ library , mtl >= 2.2 && < 2.4 , pretty >= 1.1 && < 1.2 - , copilot-core >= 3.19 && < 3.20 - , language-c99 >= 0.2.0 && < 0.3 - , language-c99-simple >= 0.3 && < 0.4 + , copilot-core >= 3.19.1 && < 3.20 + , language-c99 >= 0.2.0 && < 0.3 + , language-c99-simple >= 0.3 && < 0.4 exposed-modules : Copilot.Compile.C99 diff --git a/copilot-core/copilot-core.cabal b/copilot-core/copilot-core.cabal index 4554c52c1..78197bbed 100644 --- a/copilot-core/copilot-core.cabal +++ b/copilot-core/copilot-core.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-core -version: 3.19 +version: 3.19.1 synopsis: An intermediate representation for Copilot. description: Intermediate representation for Copilot. diff --git a/copilot-interpreter/copilot-interpreter.cabal b/copilot-interpreter/copilot-interpreter.cabal index 03fa5405b..c5995cfa1 100644 --- a/copilot-interpreter/copilot-interpreter.cabal +++ b/copilot-interpreter/copilot-interpreter.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-interpreter -version: 3.19 +version: 3.19.1 synopsis: Interpreter for Copilot. description: Interpreter for Copilot. @@ -44,7 +44,7 @@ library base >= 4.9 && < 5, pretty >= 1.0 && < 1.2, - copilot-core >= 3.19 && < 3.20 + copilot-core >= 3.19.1 && < 3.20 exposed-modules: diff --git a/copilot-language/copilot-language.cabal b/copilot-language/copilot-language.cabal index b07cdb54e..be1d377e8 100644 --- a/copilot-language/copilot-language.cabal +++ b/copilot-language/copilot-language.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-language -version: 3.19 +version: 3.19.1 synopsis: A Haskell-embedded DSL for monitoring hard real-time distributed systems. description: @@ -35,16 +35,16 @@ source-repository head library default-language: Haskell2010 hs-source-dirs: src - build-depends: base >= 4.9 && < 5 + build-depends: base >= 4.9 && < 5 - , array >= 0.5 && < 0.6 - , containers >= 0.4 && < 0.7 - , data-reify >= 0.6 && < 0.7 - , mtl >= 2.0 && < 3 + , array >= 0.5 && < 0.6 + , containers >= 0.4 && < 0.7 + , data-reify >= 0.6 && < 0.7 + , mtl >= 2.0 && < 3 - , copilot-core >= 3.19 && < 3.20 - , copilot-interpreter >= 3.19 && < 3.20 - , copilot-theorem >= 3.19 && < 3.20 + , copilot-core >= 3.19.1 && < 3.20 + , copilot-interpreter >= 3.19.1 && < 3.20 + , copilot-theorem >= 3.19.1 && < 3.20 exposed-modules: Copilot.Language , Copilot.Language.Operators.BitWise diff --git a/copilot-libraries/copilot-libraries.cabal b/copilot-libraries/copilot-libraries.cabal index 6d72ab2f8..e8830fc60 100644 --- a/copilot-libraries/copilot-libraries.cabal +++ b/copilot-libraries/copilot-libraries.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-libraries -version: 3.19 +version: 3.19.1 synopsis: Libraries for the Copilot language. description: Libraries for the Copilot language. @@ -36,12 +36,12 @@ library hs-source-dirs: src - build-depends: base >= 4.9 && < 5 + build-depends: base >= 4.9 && < 5 - , containers >= 0.4 && < 0.7 - , mtl >= 2.0 && < 2.4 - , parsec >= 2.0 && < 3.2 - , copilot-language >= 3.19 && < 3.20 + , containers >= 0.4 && < 0.7 + , mtl >= 2.0 && < 2.4 + , parsec >= 2.0 && < 3.2 + , copilot-language >= 3.19.1 && < 3.20 exposed-modules: Copilot.Library.Libraries diff --git a/copilot-prettyprinter/copilot-prettyprinter.cabal b/copilot-prettyprinter/copilot-prettyprinter.cabal index 74f421cfc..bcdb3d142 100644 --- a/copilot-prettyprinter/copilot-prettyprinter.cabal +++ b/copilot-prettyprinter/copilot-prettyprinter.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-prettyprinter -version: 3.19 +version: 3.19.1 synopsis: A prettyprinter of Copilot Specifications. description: A prettyprinter of Copilot specifications. @@ -45,7 +45,7 @@ library base >= 4.9 && < 5, pretty >= 1.0 && < 1.2, - copilot-core >= 3.19 && < 3.20 + copilot-core >= 3.19.1 && < 3.20 exposed-modules: diff --git a/copilot-theorem/copilot-theorem.cabal b/copilot-theorem/copilot-theorem.cabal index 225ccd456..4616c0810 100644 --- a/copilot-theorem/copilot-theorem.cabal +++ b/copilot-theorem/copilot-theorem.cabal @@ -14,7 +14,7 @@ description: . -version : 3.19 +version : 3.19.1 license : BSD3 license-file : LICENSE maintainer : Ivan Perez @@ -63,8 +63,8 @@ library , xml >= 1.3 && < 1.4 , what4 >= 1.3 && < 1.6 - , copilot-core >= 3.19 && < 3.20 - , copilot-prettyprinter >= 3.19 && < 3.20 + , copilot-core >= 3.19.1 && < 3.20 + , copilot-prettyprinter >= 3.19.1 && < 3.20 exposed-modules : Copilot.Theorem , Copilot.Theorem.Prove diff --git a/copilot/copilot.cabal b/copilot/copilot.cabal index 3f598386c..7c0969c3b 100644 --- a/copilot/copilot.cabal +++ b/copilot/copilot.cabal @@ -1,5 +1,5 @@ name: copilot -version: 3.19 +version: 3.19.1 cabal-version: >= 1.10 license: BSD3 license-file: LICENSE @@ -47,17 +47,17 @@ library -Wall -fno-warn-orphans build-depends: - base >= 4.9 && < 5 - , optparse-applicative >= 0.14 && < 0.19 - , directory >= 1.3 && < 1.4 - , filepath >= 1.4 && < 1.5 - - , copilot-core >= 3.19 && < 3.20 - , copilot-theorem >= 3.19 && < 3.20 - , copilot-language >= 3.19 && < 3.20 - , copilot-libraries >= 3.19 && < 3.20 - , copilot-c99 >= 3.19 && < 3.20 - , copilot-prettyprinter >= 3.19 && < 3.20 + base >= 4.9 && < 5 + , optparse-applicative >= 0.14 && < 0.19 + , directory >= 1.3 && < 1.4 + , filepath >= 1.4 && < 1.5 + + , copilot-core >= 3.19.1 && < 3.20 + , copilot-theorem >= 3.19.1 && < 3.20 + , copilot-language >= 3.19.1 && < 3.20 + , copilot-libraries >= 3.19.1 && < 3.20 + , copilot-c99 >= 3.19.1 && < 3.20 + , copilot-prettyprinter >= 3.19.1 && < 3.20 exposed-modules: Language.Copilot, Language.Copilot.Main From 3a2be02e232322d339b89a036787791dc3b61e8f Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Wed, 8 May 2024 06:22:31 +0000 Subject: [PATCH 0755/1222] Document changes in CHANGELOG. Refs #512. --- copilot-c99/CHANGELOG | 3 +++ copilot-core/CHANGELOG | 3 +++ copilot-interpreter/CHANGELOG | 3 +++ copilot-language/CHANGELOG | 3 +++ copilot-libraries/CHANGELOG | 3 +++ copilot-prettyprinter/CHANGELOG | 3 +++ copilot-theorem/CHANGELOG | 1 + copilot/CHANGELOG | 3 +++ 8 files changed, 22 insertions(+) diff --git a/copilot-c99/CHANGELOG b/copilot-c99/CHANGELOG index 9e3cd8b43..0c1e0556b 100644 --- a/copilot-c99/CHANGELOG +++ b/copilot-c99/CHANGELOG @@ -1,3 +1,6 @@ +2024-05-07 + * Version bump (3.19.1). (#512) + 2024-03-07 * Version bump (3.19). (#504) diff --git a/copilot-core/CHANGELOG b/copilot-core/CHANGELOG index 761fcebe9..67d9686d5 100644 --- a/copilot-core/CHANGELOG +++ b/copilot-core/CHANGELOG @@ -1,3 +1,6 @@ +2024-05-07 + * Version bump (3.19.1). (#512) + 2024-03-07 * Version bump (3.19). (#504) * Remove deprecated functions in Copilot.Core.Type and diff --git a/copilot-interpreter/CHANGELOG b/copilot-interpreter/CHANGELOG index 0a7a64611..259c86cf6 100644 --- a/copilot-interpreter/CHANGELOG +++ b/copilot-interpreter/CHANGELOG @@ -1,3 +1,6 @@ +2024-05-07 + * Version bump (3.19.1). (#512) + 2024-03-07 * Version bump (3.19). (#504) diff --git a/copilot-language/CHANGELOG b/copilot-language/CHANGELOG index 8834a2974..f7f1c89cb 100644 --- a/copilot-language/CHANGELOG +++ b/copilot-language/CHANGELOG @@ -1,3 +1,6 @@ +2024-05-07 + * Version bump (3.19.1). (#512) + 2024-03-07 * Version bump (3.19). (#504) diff --git a/copilot-libraries/CHANGELOG b/copilot-libraries/CHANGELOG index 6a7bb7514..7fa4005fa 100644 --- a/copilot-libraries/CHANGELOG +++ b/copilot-libraries/CHANGELOG @@ -1,3 +1,6 @@ +2024-05-07 + * Version bump (3.19.1). (#512) + 2024-03-07 * Version bump (3.19). (#504) diff --git a/copilot-prettyprinter/CHANGELOG b/copilot-prettyprinter/CHANGELOG index 3d8091be9..e2dd781c9 100644 --- a/copilot-prettyprinter/CHANGELOG +++ b/copilot-prettyprinter/CHANGELOG @@ -1,3 +1,6 @@ +2024-05-07 + * Version bump (3.19.1). (#512) + 2024-03-07 * Version bump (3.19). (#504) diff --git a/copilot-theorem/CHANGELOG b/copilot-theorem/CHANGELOG index 417a03696..348227766 100644 --- a/copilot-theorem/CHANGELOG +++ b/copilot-theorem/CHANGELOG @@ -1,4 +1,5 @@ 2024-05-07 + * Version bump (3.19.1). (#512) * Fix handling of unsatisfiable properties with Kind2. (#495) * Remove outdated details from README. (#452) diff --git a/copilot/CHANGELOG b/copilot/CHANGELOG index 994e999d1..17563c868 100644 --- a/copilot/CHANGELOG +++ b/copilot/CHANGELOG @@ -1,3 +1,6 @@ +2024-05-07 + * Version bump (3.19.1). (#512) + 2024-03-07 * Version bump (3.19). (#504) From f1ffc113ed50adaaf4c71711908037ad303a40b3 Mon Sep 17 00:00:00 2001 From: Frank Dedden Date: Mon, 1 Jul 2024 13:35:21 +0200 Subject: [PATCH 0756/1222] copilot-theorem: Bump `what4` upper bound to `< 1.7`. Refs #514. what4 has seen a new release 1.6, but copilot-theorem needs versions strictly lower than 1.6. This version is API-compatible for all features used by copilot-theorem, but it includes support for GHC 9.8, which we want to also support. --- copilot-theorem/copilot-theorem.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot-theorem/copilot-theorem.cabal b/copilot-theorem/copilot-theorem.cabal index 4616c0810..be5868e9f 100644 --- a/copilot-theorem/copilot-theorem.cabal +++ b/copilot-theorem/copilot-theorem.cabal @@ -61,7 +61,7 @@ library , random >= 1.1 && < 1.3 , transformers >= 0.5 && < 0.7 , xml >= 1.3 && < 1.4 - , what4 >= 1.3 && < 1.6 + , what4 >= 1.3 && < 1.7 , copilot-core >= 3.19.1 && < 3.20 , copilot-prettyprinter >= 3.19.1 && < 3.20 From 4cf2dce291b7e111f76cba26c89a39d1b197f34a Mon Sep 17 00:00:00 2001 From: Frank Dedden Date: Sat, 6 Jul 2024 00:55:46 +0200 Subject: [PATCH 0757/1222] copilot-theorem: Document changes in CHANGELOG. Refs #514. --- copilot-theorem/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-theorem/CHANGELOG b/copilot-theorem/CHANGELOG index 348227766..df16eb0f8 100644 --- a/copilot-theorem/CHANGELOG +++ b/copilot-theorem/CHANGELOG @@ -1,3 +1,6 @@ +2024-07-06 + * What4 upper-bound dependency version bump. (#514) + 2024-05-07 * Version bump (3.19.1). (#512) * Fix handling of unsatisfiable properties with Kind2. (#495) From c603bc8cf3c46b1c9d80cc7e652c82a57174e36f Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 7 Jul 2024 01:35:47 +0000 Subject: [PATCH 0758/1222] copilot-language: Remove deprecated function Copilot.Language.Spec.forall. Refs #518. The function Copilot.Language.Spec.forall not being used by any other part of Copilot. It was replaced by a function with a different name due to the lowercase name not being allowed in newer versions of GHC. The original function was deprecated in Copilot 3.18. As per our internal policy of waiting 3 versions from deprecation until a public interface declaration can be removed, this function can now be removed. This commit removes the function Copilot.Language.Spec.forall from copilot-language (both in the module that defines it and in a module that re-exports it). --- copilot-language/src/Copilot/Language.hs | 2 +- copilot-language/src/Copilot/Language/Spec.hs | 7 +------ 2 files changed, 2 insertions(+), 7 deletions(-) diff --git a/copilot-language/src/Copilot/Language.hs b/copilot-language/src/Copilot/Language.hs index 400cc51c1..674d601f7 100644 --- a/copilot-language/src/Copilot/Language.hs +++ b/copilot-language/src/Copilot/Language.hs @@ -38,7 +38,7 @@ module Copilot.Language , prop , theorem , forAll - , forall, exists + , exists ) where import Data.Int hiding (Int) diff --git a/copilot-language/src/Copilot/Language/Spec.hs b/copilot-language/src/Copilot/Language/Spec.hs index 26bc30aee..b5fc94b61 100644 --- a/copilot-language/src/Copilot/Language/Spec.hs +++ b/copilot-language/src/Copilot/Language/Spec.hs @@ -28,7 +28,7 @@ module Copilot.Language.Spec , prop, properties , theorem, theorems , forAll - , forall, exists + , exists , extractProp , Universal, Existential ) where @@ -165,11 +165,6 @@ data Prop a where forAll :: Stream Bool -> Prop Universal forAll = Forall -{-# DEPRECATED forall "Use forAll instead." #-} --- | Universal quantification of boolean streams over time. -forall :: Stream Bool -> Prop Universal -forall = forAll - -- | Existential quantification of boolean streams over time. exists :: Stream Bool -> Prop Existential exists = Exists From a1090fe1b8021125e46f5365cd0e96750fda3f30 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 7 Jul 2024 03:22:31 +0000 Subject: [PATCH 0759/1222] copilot: Update README to reflect support for GHC 9.8. Refs #518. A recent update to copilot-language makes all of Copilot compatible with GHC 9.8. This commit updates the README to reflect such compatibility. --- copilot/README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot/README.md b/copilot/README.md index 18ab79517..aef1fb26b 100644 --- a/copilot/README.md +++ b/copilot/README.md @@ -81,7 +81,7 @@ ghci> ghci> Leaving GHCi. On other Linux distributions or older Debian-based distributions, to use Copilot you must install a Haskell compiler (GHC) and the package manager Cabal. We currently support all versions of GHC from 8.6.5 to modern versions -(9.6 as of this writing). You can install the toolchain using +(9.8 as of this writing). You can install the toolchain using [ghcup](https://www.haskell.org/ghcup/) or, if you are on Debian/Ubuntu, directly with `apt-get`: From 41bb643c7f4f8d6ce278f53e9eabaec6354b573c Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 7 Jul 2024 01:38:16 +0000 Subject: [PATCH 0760/1222] copilot-language: Document changes in CHANGELOG. Refs #518. --- copilot-language/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-language/CHANGELOG b/copilot-language/CHANGELOG index f7f1c89cb..d25c83b59 100644 --- a/copilot-language/CHANGELOG +++ b/copilot-language/CHANGELOG @@ -1,3 +1,6 @@ +2024-07-06 + * Remove deprecated function Copilot.Language.Spec.forall. (#518) + 2024-05-07 * Version bump (3.19.1). (#512) From 7c8e7dd1691506ee0cbe6079cfe34b7cbeec9f90 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 7 Jul 2024 03:23:28 +0000 Subject: [PATCH 0761/1222] copilot: Document changes in CHANGELOG. Refs #518. --- copilot/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot/CHANGELOG b/copilot/CHANGELOG index 17563c868..a9d94f77e 100644 --- a/copilot/CHANGELOG +++ b/copilot/CHANGELOG @@ -1,3 +1,6 @@ +2024-07-06 + * Update README to reflect support for GHC 9.8. (#518) + 2024-05-07 * Version bump (3.19.1). (#512) From 6c8ae3f541e295338b6bf5d784dfb11a37cbc607 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 30 Jun 2024 11:11:50 +0000 Subject: [PATCH 0762/1222] copilot-core: Introduce new kind of struct field update operator. Refs #520. Copilot currently supports reading values from fields of structs, but not changing them. This commit adds a new Op2 that allows struct fields to be modified. We include additional constraints, Typeable and Show, that are needed for the C99 backend and the interpreter. Co-authored-by: Frank Dedden Co-authored-by: Ryan Scott --- copilot-core/src/Copilot/Core/Operators.hs | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) diff --git a/copilot-core/src/Copilot/Core/Operators.hs b/copilot-core/src/Copilot/Core/Operators.hs index 6e5459d39..b8f903ae9 100644 --- a/copilot-core/src/Copilot/Core/Operators.hs +++ b/copilot-core/src/Copilot/Core/Operators.hs @@ -13,9 +13,10 @@ module Copilot.Core.Operators where -- External imports -import Data.Bits (Bits) -import Data.Word (Word32) -import GHC.TypeLits (KnownSymbol) +import Data.Bits (Bits) +import Data.Typeable (Typeable) +import Data.Word (Word32) +import GHC.TypeLits (KnownSymbol) -- Internal imports import Copilot.Core.Type (Field (..), Type (..)) @@ -96,6 +97,11 @@ data Op2 a b c where Index :: Type (Array n t) -> Op2 (Array n t) Word32 t -- ^ Array access/projection of an array element. + -- Struct operator. + UpdateField :: (Typeable b, KnownSymbol s, Show b) + => Type a -> Type b -> (a -> Field s b) -> Op2 a b a + -- ^ Update a field of a struct. + -- | Ternary operators. data Op3 a b c d where -- Conditional operator. From c9998e35841e095dbdd9a1a1294be637eb21b966 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 7 Jul 2024 16:09:36 +0000 Subject: [PATCH 0763/1222] copilot-core: Add new update operation to Struct. Refs #520. Copilot currently supports reading values from fields of structs, but not changing them. We'd like to be able to modify a struct by adjusting the values of specific fields. In order to add support to the interpreter for Struct field updates, we need an operation that will perform the modification in the specific struct type itself (the one that is an instance of the Struct class). This commit modifies the Struct class with the new operation. We use Value as an argument, which imposes a Typeable and Show constraint, which were added to the Op2 definition in a prior commit. To make the class backwards compatible, we pre-define the method to an error call that indicates to users that the operation has not been defined for that specific type. Co-authored-by: Frank Dedden Co-authored-by: Ryan Scott --- copilot-core/src/Copilot/Core/Type.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/copilot-core/src/Copilot/Core/Type.hs b/copilot-core/src/Copilot/Core/Type.hs index f32260d5b..5710465f3 100644 --- a/copilot-core/src/Copilot/Core/Type.hs +++ b/copilot-core/src/Copilot/Core/Type.hs @@ -34,6 +34,7 @@ module Copilot.Core.Type , Struct , fieldName , accessorName + , updateField ) where @@ -59,6 +60,9 @@ class Struct a where -- | Transforms all the struct's fields into a list of values. toValues :: a -> [Value a] + updateField :: a -> Value t -> a + updateField = error "Field updates not supported for this type." + -- | The field of a struct, together with a representation of its type. data Value a = forall s t . (Typeable t, KnownSymbol s, Show t) => Value (Type t) (Field s t) From 17160986cd53f9250e062ccbdc26fec5cb721097 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 7 Jul 2024 16:10:38 +0000 Subject: [PATCH 0764/1222] copilot-interpreter: Implement struct updates in interpreter. Refs #520. Copilot currently supports reading values from fields of structs, but not changing them. We'd like to be able to modify a struct by adjusting the values of specific fields. This commit modifies the interpreter to support the evaluation of update field operators applied to streams of structs. Co-authored-by: Frank Dedden Co-authored-by: Ryan Scott --- .../src/Copilot/Interpret/Eval.hs | 20 +++++++++++++------ 1 file changed, 14 insertions(+), 6 deletions(-) diff --git a/copilot-interpreter/src/Copilot/Interpret/Eval.hs b/copilot-interpreter/src/Copilot/Interpret/Eval.hs index a0083524c..3d8df44a7 100644 --- a/copilot-interpreter/src/Copilot/Interpret/Eval.hs +++ b/copilot-interpreter/src/Copilot/Interpret/Eval.hs @@ -2,10 +2,11 @@ -- | A tagless interpreter for Copilot specifications. -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE Safe #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE Safe #-} +{-# LANGUAGE ScopedTypeVariables #-} module Copilot.Interpret.Eval ( Env @@ -17,8 +18,9 @@ module Copilot.Interpret.Eval import Copilot.Core (Expr (..), Field (..), Id, Name, Observer (..), Op1 (..), Op2 (..), Op3 (..), Spec, Stream (..), - Trigger (..), Type (..), UExpr (..), arrayElems, - specObservers, specStreams, specTriggers) + Trigger (..), Type (..), UExpr (..), Value (..), + arrayElems, specObservers, specStreams, + specTriggers, updateField) import Copilot.Interpret.Error (badUsage) import Prelude hiding (id) @@ -244,6 +246,12 @@ evalOp2 op = case op of BwShiftR _ _ -> ( \ !a !b -> shiftR a $! fromIntegral b ) Index _ -> \xs n -> (arrayElems xs) !! (fromIntegral n) + UpdateField (Struct _) ty (fieldAccessor :: a -> Field s b) -> + \stream fieldValue -> + let newField :: Field s b + newField = Field fieldValue + in updateField stream (Value ty newField) + -- | Apply a function to two numbers, so long as the second one is -- not zero. -- From d7bc241e862e1afbef9bf989a00573f2e5366e8e Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 30 Jun 2024 11:13:45 +0000 Subject: [PATCH 0765/1222] copilot-c99: Expand expression translation environment to include statements. Refs #520. Copilot currently supports reading values from fields of structs, but not changing them. We'd like to be able to modify a struct by adjusting the values of specific fields. The current implementation of the translation of expressions generates variable declarations, but we now need to keep a counter of the new variables that have been created, and additional statements that must be executed after the variables are declared. This commit modifies the function environment to allow for such elements, without adding any specific code that uses those. This change, in isolation, should not modify the extensible behavior of Copilot. Co-authored-by: Frank Dedden Co-authored-by: Ryan Scott --- .../src/Copilot/Compile/C99/CodeGen.hs | 29 ++++++++++++------- copilot-c99/src/Copilot/Compile/C99/Expr.hs | 6 ++-- 2 files changed, 23 insertions(+), 12 deletions(-) diff --git a/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs b/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs index ad14f1f01..3f9693438 100644 --- a/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs +++ b/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs @@ -121,11 +121,13 @@ mkAccessDecln sId ty xs = -- | Write a generator function for a stream. mkGenFun :: String -> Expr a -> Type a -> C.FunDef mkGenFun name expr ty = - C.FunDef static cTy name [] cVars [C.Return $ Just cExpr] + C.FunDef static cTy name [] cVars stmts where - static = Just C.Static - cTy = C.decay $ transType ty - (cExpr, cVars) = runState (transExpr expr) mempty + static = Just C.Static + cTy = C.decay $ transType ty + (cExpr, state') = runState (transExpr expr) (0, mempty, mempty) + (_, cVars, stmts') = state' + stmts = stmts' ++ [C.Return $ Just cExpr] -- | Write a generator function for a stream that returns an array. mkGenFunArray :: String -> String -> Expr a -> Type a -> C.FunDef @@ -139,13 +141,20 @@ mkGenFunArray name nameArg expr ty@(Array _) = outputParam = C.Param cArrayType nameArg cArrayType = transType ty - -- Output value, and any variable declarations needed - (cExpr, varDecls) = runState (transExpr expr) mempty + -- Statements to execute as part of the generator. They include statements + -- related to calculating the values of intermediate expressions, and + -- statements related to copying the final value to the destination array. + stmts = stmts' ++ [ copyStmt ] - -- Copy expression to output argument - stmts = [ C.Expr $ memcpy (C.Ident nameArg) cExpr size ] - size = C.LitInt (fromIntegral $ typeSize ty) - C..* C.SizeOfType (C.TypeName $ tyElemName ty) + -- Output value, variable declarations needed, and other statements that + -- must be executed to calculate intermediate values. + (cExpr, state') = runState (transExpr expr) (0, mempty, mempty) + (_, varDecls, stmts') = state' + + -- Copy expression to output argument. + copyStmt = C.Expr $ memcpy (C.Ident nameArg) cExpr size + size = C.LitInt (fromIntegral $ typeSize ty) + C..* C.SizeOfType (C.TypeName $ tyElemName ty) mkGenFunArray _name _nameArg _expr _ty = impossible "mkGenFunArray" "copilot-c99" diff --git a/copilot-c99/src/Copilot/Compile/C99/Expr.hs b/copilot-c99/src/Copilot/Compile/C99/Expr.hs index 1c8108996..aa035f303 100644 --- a/copilot-c99/src/Copilot/Compile/C99/Expr.hs +++ b/copilot-c99/src/Copilot/Compile/C99/Expr.hs @@ -32,7 +32,9 @@ transExpr (Local ty1 _ name e1 e2) = do initExpr = Just $ C.InitExpr e1' -- Add new decl to the tail of the fun env - modify (++ [C.VarDecln Nothing cTy1 name initExpr]) + modify (\(i, x, y) + -> (i, x ++ [C.VarDecln Nothing cTy1 name initExpr], y) + ) transExpr e2 @@ -368,7 +370,7 @@ typeIsFloating _ = False -- | Auxiliary type used to collect all the declarations of all the variables -- used in a function to be generated, since variable declarations are always -- listed first at the top of the function body. -type FunEnv = [C.Decln] +type FunEnv = (Int, [C.Decln], [C.Stmt]) -- | Define a C expression that calls a function with arguments. funCall :: C.Ident -- ^ Function name From def91c5e57a7711577464263942c39e79be8147b Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 30 Jun 2024 11:16:12 +0000 Subject: [PATCH 0766/1222] copilot-c99: Handle new struct update operator. Refs #520. Copilot currently supports reading values from fields of structs, but not changing them. We'd like to be able to modify a struct by adjusting the values of specific fields. This commit extends the C99 backend to support updates to fields of structs. We use a dedicated translation that injects statements as well as new variable declarations, which are needed to calculate intermediate values and the returned struct value in generators. The original function that translated Copilot Op2's to C functions is modified to not accept an UpdateField argument, as that case is now handled separately due to its more complex functionality and type. Co-authored-by: Frank Dedden Co-authored-by: Ryan Scott --- copilot-c99/src/Copilot/Compile/C99/Expr.hs | 114 +++++++++++++++----- 1 file changed, 87 insertions(+), 27 deletions(-) diff --git a/copilot-c99/src/Copilot/Compile/C99/Expr.hs b/copilot-c99/src/Copilot/Compile/C99/Expr.hs index aa035f303..40b130086 100644 --- a/copilot-c99/src/Copilot/Compile/C99/Expr.hs +++ b/copilot-c99/src/Copilot/Compile/C99/Expr.hs @@ -8,19 +8,20 @@ module Copilot.Compile.C99.Expr where -- External imports -import Control.Monad.State ( State, modify ) +import Control.Monad.State ( State, get, modify ) import qualified Data.List.NonEmpty as NonEmpty import qualified Language.C99.Simple as C -- Internal imports: Copilot import Copilot.Core ( Expr (..), Field (..), Op1 (..), Op2 (..), Op3 (..), Type (..), Value (..), accessorName, arrayElems, - toValues ) + toValues, typeSize ) -- Internal imports import Copilot.Compile.C99.Error ( impossible ) import Copilot.Compile.C99.Name ( exCpyName, streamAccessorName ) -import Copilot.Compile.C99.Type ( transLocalVarDeclType, transTypeName ) +import Copilot.Compile.C99.Type ( transLocalVarDeclType, transType, + transTypeName ) -- | Translates a Copilot Core expression into a C99 expression. transExpr :: Expr a -> State FunEnv C.Expr @@ -53,6 +54,48 @@ transExpr (Op1 op e) = do e' <- transExpr e return $ transOp1 op e' +transExpr (Op2 (UpdateField ty1@(Struct _) ty2 f) e1 e2) = do + -- Translating a struct update Op requires initializing a variable to the + -- "old" value, updating the field, and returning the new value. + e1' <- transExpr e1 + e2' <- transExpr e2 + + -- Variable to hold the updated struct + (i, _, _) <- get + let varName = "_v" ++ show i + modify (\(i, x, y) -> (i + 1, x, y)) + + -- Add new var decl + let initDecl = C.VarDecln Nothing cTy1 varName Nothing + cTy1 = transLocalVarDeclType ty1 + modify (\(i, x, y) -> (i, x ++ [initDecl], y)) + + -- Initialize the var to the same value as the original struct + let initStmt = C.Expr + $ C.AssignOp + C.Assign + (C.Ident varName) + e1' + + -- Update field f with given value e2. + let updateStmt = case ty2 of + Array _ -> C.Expr $ memcpy dest e2' size + where + dest = C.Dot (C.Ident varName) (accessorName f) + size = C.LitInt + (fromIntegral $ typeSize ty2) + C..* C.SizeOfType (C.TypeName (tyElemName ty2)) + + _ -> C.Expr + $ C.AssignOp + C.Assign + (C.Dot (C.Ident varName) (accessorName f)) + e2' + + modify (\(i, x, y) -> (i, x, y ++ [ initStmt, updateStmt ])) + + return $ C.Ident varName + transExpr (Op2 op e1 e2) = do e1' <- transExpr e1 e2' <- transExpr e2 @@ -102,32 +145,35 @@ transOp1 op e = -- | Translates a Copilot binary operator and its arguments into a C99 -- expression. +-- +-- PRE: op is not a struct update operation (i.e., 'UpdateField'). transOp2 :: Op2 a b c -> C.Expr -> C.Expr -> C.Expr transOp2 op e1 e2 = case op of - And -> e1 C..&& e2 - Or -> e1 C..|| e2 - Add _ -> e1 C..+ e2 - Sub _ -> e1 C..- e2 - Mul _ -> e1 C..* e2 - Mod _ -> e1 C..% e2 - Div _ -> e1 C../ e2 - Fdiv _ -> e1 C../ e2 - Pow ty -> funCall (specializeMathFunName ty "pow") [e1, e2] - Logb ty -> funCall (specializeMathFunName ty "log") [e2] C../ - funCall (specializeMathFunName ty "log") [e1] - Atan2 ty -> funCall (specializeMathFunName ty "atan2") [e1, e2] - Eq _ -> e1 C..== e2 - Ne _ -> e1 C..!= e2 - Le _ -> e1 C..<= e2 - Ge _ -> e1 C..>= e2 - Lt _ -> e1 C..< e2 - Gt _ -> e1 C..> e2 - BwAnd _ -> e1 C..& e2 - BwOr _ -> e1 C..| e2 - BwXor _ -> e1 C..^ e2 - BwShiftL _ _ -> e1 C..<< e2 - BwShiftR _ _ -> e1 C..>> e2 - Index _ -> C.Index e1 e2 + And -> e1 C..&& e2 + Or -> e1 C..|| e2 + Add _ -> e1 C..+ e2 + Sub _ -> e1 C..- e2 + Mul _ -> e1 C..* e2 + Mod _ -> e1 C..% e2 + Div _ -> e1 C../ e2 + Fdiv _ -> e1 C../ e2 + Pow ty -> funCall (specializeMathFunName ty "pow") [e1, e2] + Logb ty -> funCall (specializeMathFunName ty "log") [e2] C../ + funCall (specializeMathFunName ty "log") [e1] + Atan2 ty -> funCall (specializeMathFunName ty "atan2") [e1, e2] + Eq _ -> e1 C..== e2 + Ne _ -> e1 C..!= e2 + Le _ -> e1 C..<= e2 + Ge _ -> e1 C..>= e2 + Lt _ -> e1 C..< e2 + Gt _ -> e1 C..> e2 + BwAnd _ -> e1 C..& e2 + BwOr _ -> e1 C..| e2 + BwXor _ -> e1 C..^ e2 + BwShiftL _ _ -> e1 C..<< e2 + BwShiftR _ _ -> e1 C..>> e2 + Index _ -> C.Index e1 e2 + UpdateField _ _ _ -> impossible "transOp2" "copilot-c99" -- | Translates a Copilot ternary operator and its arguments into a C99 -- expression. @@ -377,3 +423,17 @@ funCall :: C.Ident -- ^ Function name -> [C.Expr] -- ^ Arguments -> C.Expr funCall name = C.Funcall (C.Ident name) + +-- Write a call to the memcpy function. +memcpy :: C.Expr -> C.Expr -> C.Expr -> C.Expr +memcpy dest src size = C.Funcall (C.Ident "memcpy") [dest, src, size] + +-- Translate a Copilot type to a C99 type, handling arrays especially. +-- +-- If the given type is an array (including multi-dimensional arrays), the +-- type is that of the elements in the array. Otherwise, it is just the +-- equivalent representation of the given type in C. +tyElemName :: Type a -> C.Type +tyElemName ty = case ty of + Array ty' -> tyElemName ty' + _ -> transType ty From 05d616c6d65d7e228dee756dc6a53390e136314b Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 30 Jun 2024 11:16:37 +0000 Subject: [PATCH 0767/1222] copilot-language: High-level array update operator. Refs #520. Copilot currently supports reading values from fields of structs, but not changing them. We'd like to be able to modify a struct by adjusting the values of specific fields. A prior commit has extended copilot-core with a low-level interface to support struct field updates, and the C99 backend and the interpreter have been extended accordingly. This commit extends the high-level language definition to support struct field updates. We need to add an auxiliary type Projection to provide the notation we would like to support. Co-authored-by: Frank Dedden Co-authored-by: Ryan Scott --- .../src/Copilot/Language/Operators/Struct.hs | 71 ++++++++++++++++++- 1 file changed, 69 insertions(+), 2 deletions(-) diff --git a/copilot-language/src/Copilot/Language/Operators/Struct.hs b/copilot-language/src/Copilot/Language/Operators/Struct.hs index 78f4d037d..355da508f 100644 --- a/copilot-language/src/Copilot/Language/Operators/Struct.hs +++ b/copilot-language/src/Copilot/Language/Operators/Struct.hs @@ -1,8 +1,35 @@ {-# LANGUAGE Safe #-} -- | Combinators to deal with streams carrying structs. +-- +-- We support two kinds of operations on structs: reading the fields of structs +-- and modifying the fields of structs. +-- +-- To obtain the values of field @x@ of a struct @s@, you can just write: +-- +-- @ +-- expr = s # x +-- @ +-- +-- If you want to update it, use instead a double hash to refer to the field. +-- You can either update the field: +-- +-- @ +-- expr = s ## x =: 75 +-- @ +-- +-- To update it by applying a function to it, for example, the function that +-- updates a stream by one unit, just do: +-- +-- @ +-- expr = s ## x =$ (+1) +-- @ module Copilot.Language.Operators.Struct ( (#) + , Projection + , (##) + , (=:) + , (=$) ) where import Copilot.Core.Type @@ -18,6 +45,46 @@ import GHC.TypeLits (KnownSymbol) -- of type @Word8@, and @s@ is a stream of type @Stream T@, then @s # t2@ has -- type @Stream Word8@ and contains the values of the @t2@ field of the structs -- in @s@ at any point in time. -(#) :: (KnownSymbol s, Typed t, Typed a, Struct a) - => Stream a -> (a -> Field s t) -> Stream t +(#) :: (KnownSymbol f, Typed t, Typed s, Struct s) + => Stream s -> (s -> Field f t) -> Stream t (#) s f = Op1 (GetField typeOf typeOf f) s + +-- | Type represented an unapplied struct field accessor and a stream carrying +-- structs. +data Projection s f t = Projection (Stream s) (s -> Field f t) + +-- | Pair a stream with a field accessor, without applying it to obtain the +-- value of the field. +-- +-- This function is needed to refer to a field accessor when the goal is to +-- update the field value, not just to read it. +(##) :: (KnownSymbol f, Typed t, Typed s, Struct s) + => Stream s -> (s -> Field f t) -> Projection s f t +(##) = Projection + +-- | Create a stream where the field of a struct has been updated with values +-- from another stream. +-- +-- For example, if a struct of type @T@ has two fields, @t1@ of type @Int32@ +-- and @t2@ of type @Word8@, and @s@ is a stream of type @Stream T@, and $sT1$ +-- is a stream of type @Int32@ then @s ## t2 =: sT1@ has type @Stream T@ and +-- contains structs where the value of @t1@ is that of @sT1@ and the value of +-- @t2@ is the value that the same field had in @s@, at any point in time. +infixl 8 =: +(=:) :: (KnownSymbol f, Typed t, Typed s, Struct s) + => Projection s f t -> Stream t -> Stream s +(=:) (Projection s f) v = Op2 (UpdateField typeOf typeOf f) s v + +-- | Create a stream where the field of a struct has been updated by applying a +-- function to it. +-- +-- For example, if a struct of type @T@ has two fields, @t1@ of type @Int32@ +-- and @t2@ of type @Word8@, and @s@ is a stream of type @Stream T@, and $f$ is +-- a function from @Stream Int32 -> Stream Int32@ then @s ## t2 =$ f@ has type +-- @Stream T@ and contains structs where the value of @t1@ is that of @f@ +-- applied to the original value of @t1@ in @s@, and the value of @t2@ is the +-- value that the same field had in @s@, at any point in time. +infixl 8 =$ +(=$) :: (KnownSymbol f, Typed t, Typed s, Struct s) + => Projection s f t -> (Stream t -> Stream t) -> Stream s +(=$) (Projection s f) op = s ## f =: (op (s # f)) From 51996b76006fda289a1b836f23800001c7276793 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 7 Jul 2024 17:26:08 +0000 Subject: [PATCH 0768/1222] copilot-core: Document changes in CHANGELOG. Refs #520. --- copilot-core/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-core/CHANGELOG b/copilot-core/CHANGELOG index 67d9686d5..9d40a3660 100644 --- a/copilot-core/CHANGELOG +++ b/copilot-core/CHANGELOG @@ -1,3 +1,6 @@ +2024-07-07 + * Update Op2, Struct to support struct field updates. (#520) + 2024-05-07 * Version bump (3.19.1). (#512) From 1a2bfedb0bc1fc438120927382eb01ffac52364e Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 7 Jul 2024 17:31:27 +0000 Subject: [PATCH 0769/1222] copilot-interpreter: Document changes in CHANGELOG. Refs #520. --- copilot-interpreter/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-interpreter/CHANGELOG b/copilot-interpreter/CHANGELOG index 259c86cf6..d69607dbc 100644 --- a/copilot-interpreter/CHANGELOG +++ b/copilot-interpreter/CHANGELOG @@ -1,3 +1,6 @@ +2024-07-07 + * Add support for struct field updates. (#520) + 2024-05-07 * Version bump (3.19.1). (#512) From ce34955c0fe734038ff8205402de4d514aee098d Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 7 Jul 2024 17:31:42 +0000 Subject: [PATCH 0770/1222] copilot-c99: Document changes in CHANGELOG. Refs #520. --- copilot-c99/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-c99/CHANGELOG b/copilot-c99/CHANGELOG index 0c1e0556b..1114bdef9 100644 --- a/copilot-c99/CHANGELOG +++ b/copilot-c99/CHANGELOG @@ -1,3 +1,6 @@ +2024-07-07 + * Add support for struct field updates. (#520) + 2024-05-07 * Version bump (3.19.1). (#512) From 5fb6d605b4e25714f54a7ebfac1c6afaeb2e7519 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 7 Jul 2024 17:32:17 +0000 Subject: [PATCH 0771/1222] copilot-language: Document changes in CHANGELOG. Refs #520. --- copilot-language/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot-language/CHANGELOG b/copilot-language/CHANGELOG index d25c83b59..917338ef5 100644 --- a/copilot-language/CHANGELOG +++ b/copilot-language/CHANGELOG @@ -1,5 +1,6 @@ -2024-07-06 +2024-07-07 * Remove deprecated function Copilot.Language.Spec.forall. (#518) + * Add support for struct field updates. (#520) 2024-05-07 * Version bump (3.19.1). (#512) From 2fcf3a793dceed1692943884921edf8b025343f0 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 8 Jul 2024 02:10:15 +0000 Subject: [PATCH 0772/1222] Bump versions and constraints. Refs #522. --- copilot-c99/copilot-c99.cabal | 8 +++---- copilot-core/copilot-core.cabal | 2 +- copilot-interpreter/copilot-interpreter.cabal | 4 ++-- copilot-language/copilot-language.cabal | 18 +++++++------- copilot-libraries/copilot-libraries.cabal | 12 +++++----- .../copilot-prettyprinter.cabal | 4 ++-- copilot-theorem/copilot-theorem.cabal | 6 ++--- copilot/copilot.cabal | 24 +++++++++---------- 8 files changed, 39 insertions(+), 39 deletions(-) diff --git a/copilot-c99/copilot-c99.cabal b/copilot-c99/copilot-c99.cabal index 48079d8ba..ca3cf1d15 100644 --- a/copilot-c99/copilot-c99.cabal +++ b/copilot-c99/copilot-c99.cabal @@ -1,6 +1,6 @@ cabal-version : >= 1.10 name : copilot-c99 -version : 3.19.1 +version : 3.20 synopsis : A compiler for Copilot targeting C99. description : This package is a back-end from Copilot to C. @@ -45,9 +45,9 @@ library , mtl >= 2.2 && < 2.4 , pretty >= 1.1 && < 1.2 - , copilot-core >= 3.19.1 && < 3.20 - , language-c99 >= 0.2.0 && < 0.3 - , language-c99-simple >= 0.3 && < 0.4 + , copilot-core >= 3.20 && < 3.21 + , language-c99 >= 0.2.0 && < 0.3 + , language-c99-simple >= 0.3 && < 0.4 exposed-modules : Copilot.Compile.C99 diff --git a/copilot-core/copilot-core.cabal b/copilot-core/copilot-core.cabal index 78197bbed..b49a0629a 100644 --- a/copilot-core/copilot-core.cabal +++ b/copilot-core/copilot-core.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-core -version: 3.19.1 +version: 3.20 synopsis: An intermediate representation for Copilot. description: Intermediate representation for Copilot. diff --git a/copilot-interpreter/copilot-interpreter.cabal b/copilot-interpreter/copilot-interpreter.cabal index c5995cfa1..1f844fcfa 100644 --- a/copilot-interpreter/copilot-interpreter.cabal +++ b/copilot-interpreter/copilot-interpreter.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-interpreter -version: 3.19.1 +version: 3.20 synopsis: Interpreter for Copilot. description: Interpreter for Copilot. @@ -44,7 +44,7 @@ library base >= 4.9 && < 5, pretty >= 1.0 && < 1.2, - copilot-core >= 3.19.1 && < 3.20 + copilot-core >= 3.20 && < 3.21 exposed-modules: diff --git a/copilot-language/copilot-language.cabal b/copilot-language/copilot-language.cabal index be1d377e8..99c5867f2 100644 --- a/copilot-language/copilot-language.cabal +++ b/copilot-language/copilot-language.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-language -version: 3.19.1 +version: 3.20 synopsis: A Haskell-embedded DSL for monitoring hard real-time distributed systems. description: @@ -35,16 +35,16 @@ source-repository head library default-language: Haskell2010 hs-source-dirs: src - build-depends: base >= 4.9 && < 5 + build-depends: base >= 4.9 && < 5 - , array >= 0.5 && < 0.6 - , containers >= 0.4 && < 0.7 - , data-reify >= 0.6 && < 0.7 - , mtl >= 2.0 && < 3 + , array >= 0.5 && < 0.6 + , containers >= 0.4 && < 0.7 + , data-reify >= 0.6 && < 0.7 + , mtl >= 2.0 && < 3 - , copilot-core >= 3.19.1 && < 3.20 - , copilot-interpreter >= 3.19.1 && < 3.20 - , copilot-theorem >= 3.19.1 && < 3.20 + , copilot-core >= 3.20 && < 3.21 + , copilot-interpreter >= 3.20 && < 3.21 + , copilot-theorem >= 3.20 && < 3.21 exposed-modules: Copilot.Language , Copilot.Language.Operators.BitWise diff --git a/copilot-libraries/copilot-libraries.cabal b/copilot-libraries/copilot-libraries.cabal index e8830fc60..ad89218d1 100644 --- a/copilot-libraries/copilot-libraries.cabal +++ b/copilot-libraries/copilot-libraries.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-libraries -version: 3.19.1 +version: 3.20 synopsis: Libraries for the Copilot language. description: Libraries for the Copilot language. @@ -36,12 +36,12 @@ library hs-source-dirs: src - build-depends: base >= 4.9 && < 5 + build-depends: base >= 4.9 && < 5 - , containers >= 0.4 && < 0.7 - , mtl >= 2.0 && < 2.4 - , parsec >= 2.0 && < 3.2 - , copilot-language >= 3.19.1 && < 3.20 + , containers >= 0.4 && < 0.7 + , mtl >= 2.0 && < 2.4 + , parsec >= 2.0 && < 3.2 + , copilot-language >= 3.20 && < 3.21 exposed-modules: Copilot.Library.Libraries diff --git a/copilot-prettyprinter/copilot-prettyprinter.cabal b/copilot-prettyprinter/copilot-prettyprinter.cabal index bcdb3d142..0f452c68d 100644 --- a/copilot-prettyprinter/copilot-prettyprinter.cabal +++ b/copilot-prettyprinter/copilot-prettyprinter.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-prettyprinter -version: 3.19.1 +version: 3.20 synopsis: A prettyprinter of Copilot Specifications. description: A prettyprinter of Copilot specifications. @@ -45,7 +45,7 @@ library base >= 4.9 && < 5, pretty >= 1.0 && < 1.2, - copilot-core >= 3.19.1 && < 3.20 + copilot-core >= 3.20 && < 3.21 exposed-modules: diff --git a/copilot-theorem/copilot-theorem.cabal b/copilot-theorem/copilot-theorem.cabal index be5868e9f..496ef8c32 100644 --- a/copilot-theorem/copilot-theorem.cabal +++ b/copilot-theorem/copilot-theorem.cabal @@ -14,7 +14,7 @@ description: . -version : 3.19.1 +version : 3.20 license : BSD3 license-file : LICENSE maintainer : Ivan Perez @@ -63,8 +63,8 @@ library , xml >= 1.3 && < 1.4 , what4 >= 1.3 && < 1.7 - , copilot-core >= 3.19.1 && < 3.20 - , copilot-prettyprinter >= 3.19.1 && < 3.20 + , copilot-core >= 3.20 && < 3.21 + , copilot-prettyprinter >= 3.20 && < 3.21 exposed-modules : Copilot.Theorem , Copilot.Theorem.Prove diff --git a/copilot/copilot.cabal b/copilot/copilot.cabal index 7c0969c3b..cfc61c628 100644 --- a/copilot/copilot.cabal +++ b/copilot/copilot.cabal @@ -1,5 +1,5 @@ name: copilot -version: 3.19.1 +version: 3.20 cabal-version: >= 1.10 license: BSD3 license-file: LICENSE @@ -47,17 +47,17 @@ library -Wall -fno-warn-orphans build-depends: - base >= 4.9 && < 5 - , optparse-applicative >= 0.14 && < 0.19 - , directory >= 1.3 && < 1.4 - , filepath >= 1.4 && < 1.5 - - , copilot-core >= 3.19.1 && < 3.20 - , copilot-theorem >= 3.19.1 && < 3.20 - , copilot-language >= 3.19.1 && < 3.20 - , copilot-libraries >= 3.19.1 && < 3.20 - , copilot-c99 >= 3.19.1 && < 3.20 - , copilot-prettyprinter >= 3.19.1 && < 3.20 + base >= 4.9 && < 5 + , optparse-applicative >= 0.14 && < 0.19 + , directory >= 1.3 && < 1.4 + , filepath >= 1.4 && < 1.5 + + , copilot-core >= 3.20 && < 3.21 + , copilot-theorem >= 3.20 && < 3.21 + , copilot-language >= 3.20 && < 3.21 + , copilot-libraries >= 3.20 && < 3.21 + , copilot-c99 >= 3.20 && < 3.21 + , copilot-prettyprinter >= 3.20 && < 3.21 exposed-modules: Language.Copilot, Language.Copilot.Main From 76bbefeeceba599803e67b4b1f226feed87e6d50 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 8 Jul 2024 02:12:08 +0000 Subject: [PATCH 0773/1222] Document changes in CHANGELOG. Refs #522. --- copilot-c99/CHANGELOG | 1 + copilot-core/CHANGELOG | 1 + copilot-interpreter/CHANGELOG | 1 + copilot-language/CHANGELOG | 1 + copilot-libraries/CHANGELOG | 3 +++ copilot-prettyprinter/CHANGELOG | 3 +++ copilot-theorem/CHANGELOG | 3 ++- copilot/CHANGELOG | 3 ++- 8 files changed, 14 insertions(+), 2 deletions(-) diff --git a/copilot-c99/CHANGELOG b/copilot-c99/CHANGELOG index 1114bdef9..836ff3415 100644 --- a/copilot-c99/CHANGELOG +++ b/copilot-c99/CHANGELOG @@ -1,4 +1,5 @@ 2024-07-07 + * Version bump (3.20). (#522) * Add support for struct field updates. (#520) 2024-05-07 diff --git a/copilot-core/CHANGELOG b/copilot-core/CHANGELOG index 9d40a3660..b912c7e51 100644 --- a/copilot-core/CHANGELOG +++ b/copilot-core/CHANGELOG @@ -1,4 +1,5 @@ 2024-07-07 + * Version bump (3.20). (#522) * Update Op2, Struct to support struct field updates. (#520) 2024-05-07 diff --git a/copilot-interpreter/CHANGELOG b/copilot-interpreter/CHANGELOG index d69607dbc..e3bfe6d92 100644 --- a/copilot-interpreter/CHANGELOG +++ b/copilot-interpreter/CHANGELOG @@ -1,4 +1,5 @@ 2024-07-07 + * Version bump (3.20). (#522) * Add support for struct field updates. (#520) 2024-05-07 diff --git a/copilot-language/CHANGELOG b/copilot-language/CHANGELOG index 917338ef5..bc428fddc 100644 --- a/copilot-language/CHANGELOG +++ b/copilot-language/CHANGELOG @@ -1,4 +1,5 @@ 2024-07-07 + * Version bump (3.20). (#522) * Remove deprecated function Copilot.Language.Spec.forall. (#518) * Add support for struct field updates. (#520) diff --git a/copilot-libraries/CHANGELOG b/copilot-libraries/CHANGELOG index 7fa4005fa..d93218fa5 100644 --- a/copilot-libraries/CHANGELOG +++ b/copilot-libraries/CHANGELOG @@ -1,3 +1,6 @@ +2024-07-07 + * Version bump (3.20). (#522) + 2024-05-07 * Version bump (3.19.1). (#512) diff --git a/copilot-prettyprinter/CHANGELOG b/copilot-prettyprinter/CHANGELOG index e2dd781c9..8bc83df62 100644 --- a/copilot-prettyprinter/CHANGELOG +++ b/copilot-prettyprinter/CHANGELOG @@ -1,3 +1,6 @@ +2024-07-07 + * Version bump (3.20). (#522) + 2024-05-07 * Version bump (3.19.1). (#512) diff --git a/copilot-theorem/CHANGELOG b/copilot-theorem/CHANGELOG index df16eb0f8..120e1e677 100644 --- a/copilot-theorem/CHANGELOG +++ b/copilot-theorem/CHANGELOG @@ -1,4 +1,5 @@ -2024-07-06 +2024-07-07 + * Version bump (3.20). (#522) * What4 upper-bound dependency version bump. (#514) 2024-05-07 diff --git a/copilot/CHANGELOG b/copilot/CHANGELOG index a9d94f77e..a83f6135f 100644 --- a/copilot/CHANGELOG +++ b/copilot/CHANGELOG @@ -1,4 +1,5 @@ -2024-07-06 +2024-07-07 + * Version bump (3.20). (#522) * Update README to reflect support for GHC 9.8. (#518) 2024-05-07 From d939de564d514b21f237c50be1e1fdcc220437bd Mon Sep 17 00:00:00 2001 From: Ryan Scott Date: Mon, 8 Jul 2024 08:15:31 -0400 Subject: [PATCH 0774/1222] copilot-theorem: Support translating `UpdateField` to what4. Refs #524. A new kind of `Op2`, called `UpdateField`, was added to `copilot-core` in a prior commit to support defining streams with updates to struct fields. This commit extends `copilot-theorem` to support reasoning about streams involving struct updates. We do so by providing a new case for the operation that translates a `copilot-core` `UpdateField` into a What4 representations of a Copilot expression. The implementation proves relatively straightforward, as struct field accessors always correspond to a concrete index value, which can then be used to update the value at the corresponding index in the list of struct fields. --- .../src/Copilot/Theorem/What4/Translate.hs | 51 +++++++++++++++++++ 1 file changed, 51 insertions(+) diff --git a/copilot-theorem/src/Copilot/Theorem/What4/Translate.hs b/copilot-theorem/src/Copilot/Theorem/What4/Translate.hs index f55e3884e..5b84b021b 100644 --- a/copilot-theorem/src/Copilot/Theorem/What4/Translate.hs +++ b/copilot-theorem/src/Copilot/Theorem/What4/Translate.hs @@ -799,6 +799,8 @@ translateOp2 sym origExpr op xe1 xe2 = case (op, xe1, xe2) of (CE.BwShiftL _ _, xe1, xe2) -> translateBwShiftL xe1 xe2 (CE.BwShiftR _ _, xe1, xe2) -> translateBwShiftR xe1 xe2 (CE.Index _, xe1, xe2) -> translateIndex xe1 xe2 + (CE.UpdateField atp _ftp extractor, structXe, fieldXe) -> + translateUpdateField atp extractor structXe fieldXe where -- Translate an 'CE.Add' operation and its arguments into a what4 -- representation of the appropriate type. @@ -964,6 +966,55 @@ translateOp2 sym origExpr op xe1 xe2 = case (op, xe1, xe2) of liftIO $ buildIndexExpr sym ix xes _ -> unexpectedValues "index operation" + -- Translate an 'CE.UpdateField' operation and its arguments into a what4 + -- representation. This function will panic if one of the following does not + -- hold: + -- + -- - The argument is not a struct. + -- + -- - The struct's field cannot be found. + translateUpdateField :: forall struct s. + KnownSymbol s + => CT.Type struct + -- ^ The type of the struct argument + -> (struct -> CT.Field s b) + -- ^ Extract a struct field + -> XExpr sym + -- ^ The first argument value (should be a struct) + -> XExpr sym + -- ^ The second argument value (should be the same type + -- as the struct field) + -> TransM sym (XExpr sym) + -- ^ The first argument value, but with an updated + -- value for the supplied field. + translateUpdateField structTp extractor structXe newFieldXe = + case (structTp, structXe) of + (CT.Struct s, XStruct structFieldXes) -> + case mIx s of + Just ix -> return $ XStruct $ updateAt ix newFieldXe structFieldXes + Nothing -> + panic [ "Could not find field " ++ show fieldNameRepr + , show s + ] + _ -> unexpectedValues "update-field operation" + where + -- Update an element of a list at a particular index. This assumes the + -- preconditions that the index is a non-negative number that is less + -- than the length of the list. + updateAt :: forall a. Int -> a -> [a] -> [a] + updateAt _ _ [] = [] + updateAt 0 new (_:xs) = new : xs + updateAt n new (x:xs) = x : updateAt (n-1) new xs + + fieldNameRepr :: SymbolRepr s + fieldNameRepr = fieldName (extractor undefined) + + structFieldNameReprs :: CT.Struct struct => struct -> [Some SymbolRepr] + structFieldNameReprs s = valueName <$> CT.toValues s + + mIx :: CT.Struct struct => struct -> Maybe Int + mIx s = elemIndex (Some fieldNameRepr) (structFieldNameReprs s) + -- Check the types of the arguments. If the arguments are bitvector values, -- apply the 'BVOp2'. If the arguments are floating-point values, apply the -- 'FPOp2'. Otherwise, 'panic'. From 634b928862bcbc4db744ef9d2aa82e18781ea28d Mon Sep 17 00:00:00 2001 From: Ryan Scott Date: Wed, 21 Aug 2024 11:22:01 -0400 Subject: [PATCH 0775/1222] copilot: Update example to demonstrate struct update support. Refs #524. This commit updates the `what4-structs` example in `copilot` (which depends on `copilot-theorem`) in order to demonstrate that `copilot-theorem` supports reasoning about a basic theorem involving a struct field update. --- copilot/examples/what4/Structs.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/copilot/examples/what4/Structs.hs b/copilot/examples/what4/Structs.hs index de4e4efbd..fc61feadf 100644 --- a/copilot/examples/what4/Structs.hs +++ b/copilot/examples/what4/Structs.hs @@ -64,6 +64,10 @@ spec = do void $ prop "Example 2" $ forAll $ (((battery#other) .!! 2) .!! 3) == (((battery#other) .!! 2) .!! 4) + -- Update a struct field, then check it for equality. + void $ prop "Example 3" $ forAll $ + ((battery ## temp =$ (+1))#temp == (battery#temp + 1)) + main :: IO () main = do spec' <- reify spec From 0ee80ccd9ce6a4856a4f551f590034fbc0c8def2 Mon Sep 17 00:00:00 2001 From: Ryan Scott Date: Wed, 21 Aug 2024 11:51:17 -0400 Subject: [PATCH 0776/1222] copilot-theorem: Add a test case for struct updates. Refs #524. This adds a basic test case that ensures that applying a struct update followed by accessing the updated field is equivalent to accessing the field and then updating it. --- .../tests/Test/Copilot/Theorem/What4.hs | 63 +++++++++++++++++-- 1 file changed, 59 insertions(+), 4 deletions(-) diff --git a/copilot-theorem/tests/Test/Copilot/Theorem/What4.hs b/copilot-theorem/tests/Test/Copilot/Theorem/What4.hs index 8297ba262..dbd98eb4a 100644 --- a/copilot-theorem/tests/Test/Copilot/Theorem/What4.hs +++ b/copilot-theorem/tests/Test/Copilot/Theorem/What4.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE DataKinds #-} -- The following warning is disabled due to a necessary instance of SatResult -- defined in this module. {-# OPTIONS_GHC -fno-warn-orphans #-} @@ -6,17 +7,22 @@ module Test.Copilot.Theorem.What4 where -- External imports import Data.Int (Int8) +import Data.Word (Word32) import Test.Framework (Test, testGroup) import Test.Framework.Providers.QuickCheck2 (testProperty) -import Test.QuickCheck (Property, arbitrary, forAll) +import Test.QuickCheck (Arbitrary (arbitrary), Property, + arbitrary, forAll) import Test.QuickCheck.Monadic (monadicIO, run) -- External imports: Copilot -import Copilot.Core.Expr (Expr (Const, Op2)) -import Copilot.Core.Operators (Op2 (..)) +import Copilot.Core.Expr (Expr (Const, Op1, Op2)) +import Copilot.Core.Operators (Op1 (..), Op2 (..)) import Copilot.Core.Spec (Spec (..)) import qualified Copilot.Core.Spec as Copilot -import Copilot.Core.Type (Typed (typeOf)) +import Copilot.Core.Type (Field (..), + Struct (toValues, typeName), + Type (Struct), Typed (typeOf), + Value (..)) -- Internal imports: Modules being tested import Copilot.Theorem.What4 (SatResult (..), Solver (..), prove) @@ -30,6 +36,7 @@ tests = [ testProperty "Prove via Z3 that true is valid" testProveZ3True , testProperty "Prove via Z3 that false is invalid" testProveZ3False , testProperty "Prove via Z3 that x == x is valid" testProveZ3EqConst + , testProperty "Prove via Z3 that a struct update is valid" testProveZ3StructUpdate ] -- * Individual tests @@ -77,6 +84,54 @@ testProveZ3EqConst = forAll arbitrary $ \x -> spec x = propSpec propName $ Op2 (Eq typeOf) (Const typeOf x) (Const typeOf x) +-- | Test that Z3 is able to prove the following expresion valid: +-- @ +-- for all (s :: MyStruct), +-- ((s ## testField =$ (+1)) # testField) == ((s # testField) + 1) +-- @ +testProveZ3StructUpdate :: Property +testProveZ3StructUpdate = forAll arbitrary $ \x -> + monadicIO $ run $ checkResult Z3 propName (spec x) Valid + where + propName :: String + propName = "prop" + + spec :: TestStruct -> Spec + spec s = propSpec propName $ + Op2 + (Eq typeOf) + (getField + (Op2 + (UpdateField typeOf typeOf testField) + sExpr + (add1 (getField sExpr)))) + (add1 (getField sExpr)) + where + sExpr :: Expr TestStruct + sExpr = Const typeOf s + + getField :: Expr TestStruct -> Expr Word32 + getField = Op1 (GetField typeOf typeOf testField) + + add1 :: Expr Word32 -> Expr Word32 + add1 x = Op2 (Add typeOf) x (Const typeOf 1) + +-- | A simple data type with a 'Struct' instance and a 'Field'. This is only +-- used as part of 'testProveZ3StructUpdate'. +newtype TestStruct = TestStruct { testField :: Field "testField" Word32 } + +instance Arbitrary TestStruct where + arbitrary = do + w32 <- arbitrary + return (TestStruct (Field w32)) + +instance Struct TestStruct where + typeName _ = "testStruct" + toValues s = [Value typeOf (testField s)] + +instance Typed TestStruct where + typeOf = Struct (TestStruct (Field 0)) + -- | Check that the solver's satisfiability result for the given property in -- the given spec matches the expectation. checkResult :: Solver -> String -> Spec -> SatResult -> IO Bool From 1818c721a8fea0e67b19954a90b21c4966d0adc9 Mon Sep 17 00:00:00 2001 From: Ryan Scott Date: Wed, 21 Aug 2024 11:53:10 -0400 Subject: [PATCH 0777/1222] copilot-theorem: Document changes in CHANGELOG. Refs #524. --- copilot-theorem/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-theorem/CHANGELOG b/copilot-theorem/CHANGELOG index 120e1e677..efc0d0bcf 100644 --- a/copilot-theorem/CHANGELOG +++ b/copilot-theorem/CHANGELOG @@ -1,3 +1,6 @@ +2024-08-30 + * Add support for struct updates in Copilot.Theorem.What4. (#524) + 2024-07-07 * Version bump (3.20). (#522) * What4 upper-bound dependency version bump. (#514) From bf0f4548f07484d8a262eba1784036ff17e5e3aa Mon Sep 17 00:00:00 2001 From: Ryan Scott Date: Fri, 30 Aug 2024 05:53:33 -0400 Subject: [PATCH 0778/1222] copilot: Document changes in CHANGELOG. Refs #524. --- copilot/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot/CHANGELOG b/copilot/CHANGELOG index a83f6135f..c71906891 100644 --- a/copilot/CHANGELOG +++ b/copilot/CHANGELOG @@ -1,3 +1,6 @@ +2024-08-30 + * Update example to demonstrate struct update support. (#524) + 2024-07-07 * Version bump (3.20). (#522) * Update README to reflect support for GHC 9.8. (#518) From fc261ea82e185f4caaddd1c9cb25c4ae80bb9c4e Mon Sep 17 00:00:00 2001 From: Ryan Scott Date: Mon, 8 Jul 2024 08:35:59 -0400 Subject: [PATCH 0779/1222] copilot-prettyprinter: Pretty-print struct update expressions. Refs #526. This commit adds pretty-printing of expressions that update fields of a struct. --- copilot-prettyprinter/src/Copilot/PrettyPrint.hs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-prettyprinter/src/Copilot/PrettyPrint.hs b/copilot-prettyprinter/src/Copilot/PrettyPrint.hs index 887346827..a92c61668 100644 --- a/copilot-prettyprinter/src/Copilot/PrettyPrint.hs +++ b/copilot-prettyprinter/src/Copilot/PrettyPrint.hs @@ -100,6 +100,9 @@ ppOp2 op = case op of BwShiftL _ _ -> ppInfix "<<" BwShiftR _ _ -> ppInfix ">>" Index _ -> ppInfix ".!!" + UpdateField (Struct _) _ f -> \ doc1 doc2 -> + parens $ doc1 <+> text "##" <+> text (accessorName f) <+> text "=:" <+> doc2 + UpdateField _ _ _ -> impossible "ppOp2" "Copilot.PrettyPrint" -- | Pretty-print a ternary operation. ppOp3 :: Op3 a b c d -> Doc -> Doc -> Doc -> Doc From cc9ca2276e86676ef41393412224cff96c952a61 Mon Sep 17 00:00:00 2001 From: Ryan Scott Date: Wed, 21 Aug 2024 12:03:35 -0400 Subject: [PATCH 0780/1222] copilot-prettyprinter: Document changes in CHANGELOG. Refs #526. --- copilot-prettyprinter/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-prettyprinter/CHANGELOG b/copilot-prettyprinter/CHANGELOG index 8bc83df62..d91bb375e 100644 --- a/copilot-prettyprinter/CHANGELOG +++ b/copilot-prettyprinter/CHANGELOG @@ -1,3 +1,6 @@ +2024-08-30 + * Add support for pretty-printing struct update expressions. (#526) + 2024-07-07 * Version bump (3.20). (#522) From 25f1c03e442b71982b2a92fe0a07acf6ed5199ae Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 6 Sep 2024 12:28:31 +0000 Subject: [PATCH 0781/1222] copilot-language: Rename operator for uniformity. Refs #36. We want to add support to be able to modify values of elements in arrays. In order to provide a uniform interface for arrays and structs, we have decided to unify the syntax for array and struct accessors, so that one operator symbol indicates read access, and doubling the same operator symbol indicates modification access. For example, (!) would indicate accessing an element of an array to consult it, and (!!) would indicate the same but to update it or modify it. The analogous operators for structs would be (#) and (##). At present, the symbol being used to access elements of arrays (.!!), which is not consistent with the naming approach described above. This commit defines a new operator (!) for array element access, and deprecates the old (.!!). --- .../src/Copilot/Language/Operators/Array.hs | 13 ++++++++++++- 1 file changed, 12 insertions(+), 1 deletion(-) diff --git a/copilot-language/src/Copilot/Language/Operators/Array.hs b/copilot-language/src/Copilot/Language/Operators/Array.hs index 6a9d17a35..38ae16333 100644 --- a/copilot-language/src/Copilot/Language/Operators/Array.hs +++ b/copilot-language/src/Copilot/Language/Operators/Array.hs @@ -5,6 +5,7 @@ -- | Combinators to deal with streams carrying arrays. module Copilot.Language.Operators.Array ( (.!!) + , (!) ) where import Copilot.Core ( Typed @@ -16,6 +17,15 @@ import Copilot.Language.Stream (Stream (..)) import Data.Word (Word32) import GHC.TypeLits (KnownNat) +-- | Create a stream that carries an element of an array in another stream. +-- +-- This function implements a projection of the element of an array at a given +-- position, over time. For example, if @s@ is a stream of type @Stream (Array +-- '5 Word8)@, then @s ! 3@ has type @Stream Word8@ and contains the 3rd +-- element (starting from zero) of the arrays in @s@ at any point in time. +(!) :: (KnownNat n, Typed t) + => Stream (Array n t) -> Stream Word32 -> Stream t +arr ! n = Op2 (Index typeOf) arr n -- | Create a stream that carries an element of an array in another stream. -- @@ -23,7 +33,8 @@ import GHC.TypeLits (KnownNat) -- position, over time. For example, if @s@ is a stream of type @Stream (Array -- '5 Word8)@, then @s .!! 3@ has type @Stream Word8@ and contains the 3rd -- element (starting from zero) of the arrays in @s@ at any point in time. +{-# DEPRECATED (.!!) "This function is deprecated in Copilot 4. Use (!)." #-} (.!!) :: ( KnownNat n , Typed t ) => Stream (Array n t) -> Stream Word32 -> Stream t -arr .!! n = Op2 (Index typeOf) arr n +(.!!) = (!) From 70e67d17e876da7760a62cba3f9e3e9d4af85a36 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 6 Sep 2024 11:55:58 +0000 Subject: [PATCH 0782/1222] copilot-prettyprinter: Update pretty printer access to use the symbol !. Refs #36. A prior commit has introduced a new symbol (!) as the preferred way to project an element of an array for the purposes of reading it. This commit modifies the pretty printer so that it uses the same notation when printing an expression that projects a value of an array. --- copilot-prettyprinter/src/Copilot/PrettyPrint.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot-prettyprinter/src/Copilot/PrettyPrint.hs b/copilot-prettyprinter/src/Copilot/PrettyPrint.hs index a92c61668..a8119b12e 100644 --- a/copilot-prettyprinter/src/Copilot/PrettyPrint.hs +++ b/copilot-prettyprinter/src/Copilot/PrettyPrint.hs @@ -99,7 +99,7 @@ ppOp2 op = case op of BwXor _ -> ppInfix "^" BwShiftL _ _ -> ppInfix "<<" BwShiftR _ _ -> ppInfix ">>" - Index _ -> ppInfix ".!!" + Index _ -> ppInfix "!" UpdateField (Struct _) _ f -> \ doc1 doc2 -> parens $ doc1 <+> text "##" <+> text (accessorName f) <+> text "=:" <+> doc2 UpdateField _ _ _ -> impossible "ppOp2" "Copilot.PrettyPrint" From 219bd8647ea193bc523739b149d090369d34cf09 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 6 Sep 2024 11:49:21 +0000 Subject: [PATCH 0783/1222] copilot: Update array example to use new syntax. Refs #36. A prior commit has introduced a new symbol (!) as the preferred way to project an element of an array for the purposes of reading it. This commit modifies all examples involving arrays to use the new notation. --- copilot/examples/Array.hs | 2 +- copilot/examples/Structs.hs | 4 ++-- copilot/examples/what4/Structs.hs | 4 ++-- 3 files changed, 5 insertions(+), 5 deletions(-) diff --git a/copilot/examples/Array.hs b/copilot/examples/Array.hs index c83387f53..fc924c11c 100644 --- a/copilot/examples/Array.hs +++ b/copilot/examples/Array.hs @@ -26,7 +26,7 @@ spec = do -- It passes the current value of arr as an argument. -- The prototype of 'func' would be: -- void func (int8_t arg[3]); - trigger "func" (arr .!! 0) [arg arr] + trigger "func" (arr ! 0) [arg arr] -- Compile the spec main :: IO () diff --git a/copilot/examples/Structs.hs b/copilot/examples/Structs.hs index f3b83b1f3..3b7b01fcc 100644 --- a/copilot/examples/Structs.hs +++ b/copilot/examples/Structs.hs @@ -56,13 +56,13 @@ spec = do -- Check equality, indexing into nested structs and arrays. Note that this is -- trivial by equality. trigger "equalitySameIndex" - ((((battery#volts) .!! 0)#numVolts) == (((battery#volts) .!! 0)#numVolts)) + ((((battery#volts) ! 0)#numVolts) == (((battery#volts) ! 0)#numVolts)) [arg battery] -- Same as previous example, but get a different array index (so should be -- false). trigger "equalityDifferentIndices" - ((((battery#other) .!! 2) .!! 3) == (((battery#other) .!! 2) .!! 4)) + ((((battery#other) ! 2) ! 3) == (((battery#other) ! 2) ! 4)) [arg battery] main :: IO () diff --git a/copilot/examples/what4/Structs.hs b/copilot/examples/what4/Structs.hs index fc61feadf..775572547 100644 --- a/copilot/examples/what4/Structs.hs +++ b/copilot/examples/what4/Structs.hs @@ -57,12 +57,12 @@ spec = do -- Check equality, indexing into nested structs and arrays. Note that this is -- trivial by equality. void $ prop "Example 1" $ forAll $ - (((battery#volts) .!! 0)#numVolts) == (((battery#volts) .!! 0)#numVolts) + (((battery#volts) ! 0)#numVolts) == (((battery#volts) ! 0)#numVolts) -- Same as previous example, but get a different array index (so should be -- false). void $ prop "Example 2" $ forAll $ - (((battery#other) .!! 2) .!! 3) == (((battery#other) .!! 2) .!! 4) + (((battery#other) ! 2) ! 3) == (((battery#other) ! 2) ! 4) -- Update a struct field, then check it for equality. void $ prop "Example 3" $ forAll $ From 6649dfd1249ff36b2540e8da54b6c78fd838b9b9 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 2 Sep 2024 17:13:08 +0000 Subject: [PATCH 0784/1222] copilot-libraries: Rename function to avoid name clash. Refs #36. We want to add support to be able to modify values of elements in arrays. In order to provide a uniform interface for arrays and structs, we have decided to unify the syntax for array and struct accessors, so that one operator symbol indicates read access, and doubling the same operator symbol indicates modification access. For example, (!) would indicate accessing an element of an array to consult it, and (!!) would indicate the same but to update it or modify it. The analogous operators for structs would be (#) and (##). At present, the symbol (!!) is being used for an auxiliary function that indexes a list of streams by a stream of indexes. That function is expensive, and rarely used in real specifications. This commit renames such rarely used function, (!!), to avoid a name clash with our desired name for the function to access elements of arrays in streams for the purposes of modifying them. --- .../src/Copilot/Library/Libraries.hs | 2 +- .../src/Copilot/Library/Utils.hs | 37 +++++++++++-------- 2 files changed, 23 insertions(+), 16 deletions(-) diff --git a/copilot-libraries/src/Copilot/Library/Libraries.hs b/copilot-libraries/src/Copilot/Library/Libraries.hs index f378063bb..6a217234c 100644 --- a/copilot-libraries/src/Copilot/Library/Libraries.hs +++ b/copilot-libraries/src/Copilot/Library/Libraries.hs @@ -23,6 +23,6 @@ import Copilot.Library.LTL import Copilot.Library.PTLTL import Copilot.Library.Statistics import Copilot.Library.RegExp -import Copilot.Library.Utils +import Copilot.Library.Utils hiding ((!!)) import Copilot.Library.Voting import Copilot.Library.Stacks diff --git a/copilot-libraries/src/Copilot/Library/Utils.hs b/copilot-libraries/src/Copilot/Library/Utils.hs index c3001076a..0200778a4 100644 --- a/copilot-libraries/src/Copilot/Library/Utils.hs +++ b/copilot-libraries/src/Copilot/Library/Utils.hs @@ -13,10 +13,10 @@ module Copilot.Library.Utils -- ** Scans nscanl, nscanr, nscanl1, nscanr1, -- ** Indexing - case', (!!)) + case', (!!), (!!!)) where -import Copilot.Language +import Copilot.Language hiding ((!!)) import qualified Prelude as P -- | Given a stream, produce an infinite list of streams dropping an increasing @@ -135,21 +135,28 @@ case' predicates alternatives = -- -- WARNING: Very expensive! Consider using this only for very short lists. (!!) :: (Typed a, Eq b, Num b, Typed b) => [Stream a] -> Stream b -> Stream a -ls !! n = let indices = map +(!!) = (!!!) +{-# DEPRECATED (!!) "This function is deprecated in Copilot 4. Use (!!!)." #-} + +-- | Index. +-- +-- WARNING: Very expensive! Consider using this only for very short lists. +(!!!) :: (Typed a, Eq b, Num b, Typed b) => [Stream a] -> Stream b -> Stream a +ls !!! n = let indices = map ( constant . fromIntegral ) [ 0 .. P.length ls - 1 ] - select [] _ = last ls - select - ( i : is ) - ( x : xs ) = mux ( i == n ) x ( select is xs ) - -- should not happen - select _ [] = badUsage ("in (!!) defined in Utils.hs " P.++ - "in copilot-libraries") - in if null ls then - badUsage ("in (!!) defined in Utils.hs " P.++ - "indexing the empty list with !! is not defined") - else - select indices ls + select [] _ = last ls + select + ( i : is ) + ( x : xs ) = mux ( i == n ) x ( select is xs ) + -- should not happen + select _ [] = badUsage ("in (!!) defined in Utils.hs " P.++ + "in copilot-libraries") + in if null ls then + badUsage ("in (!!) defined in Utils.hs " P.++ + "indexing the empty list with !! is not defined") + else + select indices ls -- | Cycle a list to form an infinite stream. cycle :: ( Typed a ) => [ a ] -> Stream a From b2cc118e555656aedf621641e44c306140766647 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 6 Aug 2024 08:26:36 -0700 Subject: [PATCH 0785/1222] copilot-core: Introduce new kind of array element update operator. Refs #36. Copilot currently supports reading values from arrays, but not changing them. This commit adds a new Op3 that allows array elements to be modified. Co-authored-by: Max Fan --- copilot-core/src/Copilot/Core/Operators.hs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-core/src/Copilot/Core/Operators.hs b/copilot-core/src/Copilot/Core/Operators.hs index b8f903ae9..172353ee2 100644 --- a/copilot-core/src/Copilot/Core/Operators.hs +++ b/copilot-core/src/Copilot/Core/Operators.hs @@ -106,3 +106,6 @@ data Op2 a b c where data Op3 a b c d where -- Conditional operator. Mux :: Type a -> Op3 Bool a a a + -- Array operator. + UpdateArray :: Type (Array n t) -> Op3 (Array n t) Word32 t (Array n t) + -- ^ Update an element of an array. From fc47b397c753dd76ade4a76a3bdbbd93a8a8eead Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 6 Aug 2024 08:35:38 -0700 Subject: [PATCH 0786/1222] copilot-core: Introduce operations to update arrays. Refs #36. Copilot defines a types for fixed-length arrays, but no way to update them. In order to implement array updates for values in streams, we need to have a mechanism to update values in individual arrays. This commit adds a function to arrays to update a value while preserving the length. Co-authored-by: Max Fan --- copilot-core/src/Copilot/Core/Type/Array.hs | 22 ++++++++++++++++++++- 1 file changed, 21 insertions(+), 1 deletion(-) diff --git a/copilot-core/src/Copilot/Core/Type/Array.hs b/copilot-core/src/Copilot/Core/Type/Array.hs index 8d98c556f..b11e8949b 100644 --- a/copilot-core/src/Copilot/Core/Type/Array.hs +++ b/copilot-core/src/Copilot/Core/Type/Array.hs @@ -3,6 +3,7 @@ {-# LANGUAGE Safe #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} -- | -- Copyright: (c) 2011 National Institute of Aerospace / Galois, Inc. @@ -14,12 +15,13 @@ module Copilot.Core.Type.Array ( Array , array , arrayElems + , arrayUpdate ) where -- External imports import Data.Proxy (Proxy (..)) -import GHC.TypeLits (KnownNat, Nat, natVal) +import GHC.TypeLits (KnownNat, Nat, natVal, type(-)) -- | Implementation of an array that uses type literals to store length. data Array (n :: Nat) t where @@ -42,3 +44,21 @@ array xs | datalen == typelen = Array xs -- | Return the elements of an array. arrayElems :: Array n a -> [a] arrayElems (Array xs) = xs + +-- | Update element of array to given element. +-- +-- PRE: the second argument denotes a valid index in the array. +arrayUpdate :: Array n a -> Int -> a -> Array n a +arrayUpdate (Array []) _ _ = error errMsg + where + errMsg = "copilot-core: arrayUpdate: Attempt to update empty array" + +arrayUpdate (Array (x:xs)) 0 y = Array (y:xs) + +arrayUpdate (Array (x:xs)) n y = + arrayAppend x (arrayUpdate (Array xs) (n - 1) y) + where + -- | Append to an array while preserving length information at the type + -- level. + arrayAppend :: a -> Array (n - 1) a -> Array n a + arrayAppend x (Array xs) = Array (x:xs) From 9b297a0171d804184435f1d53c5b90821ebf3b27 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 6 Sep 2024 12:29:09 +0000 Subject: [PATCH 0787/1222] copilot-language: Introduce new kind of array element update operation. Refs #36. Copilot currently supports reading values from arrays, but not changing them. This commit adds a new operation to the high-level Copilot language that allows updating array elements. It relies on a low-level Op3 that captures the correspnding operation in Copilot Core expressions. In order to provide a uniform interface for arrays and structs, we have decided to unify the syntax for array and struct accessors, so that the operator symbol (=:) is used to set the value of individual elements, and (=$) is used to apply a function to values of elements (at each time). To support using the same syntax for both structs and arrays, this commit moves those operators into a new class, defined in a module Copilot.Language.Operators.Projection. The module Copilot.Language.Operators.Struct now uses that module instead of defining the operators locally, and so does the new module Copilot.Language.Operators.Array. Co-authored-by: Max Fan --- copilot-language/copilot-language.cabal | 1 + .../src/Copilot/Language/Operators/Array.hs | 71 +++++++++++++--- .../Copilot/Language/Operators/Projection.hs | 38 +++++++++ .../src/Copilot/Language/Operators/Struct.hs | 83 ++++++++++--------- 4 files changed, 144 insertions(+), 49 deletions(-) create mode 100644 copilot-language/src/Copilot/Language/Operators/Projection.hs diff --git a/copilot-language/copilot-language.cabal b/copilot-language/copilot-language.cabal index 99c5867f2..921ed79b7 100644 --- a/copilot-language/copilot-language.cabal +++ b/copilot-language/copilot-language.cabal @@ -61,6 +61,7 @@ library , Copilot.Language.Operators.Ord , Copilot.Language.Operators.Temporal , Copilot.Language.Operators.Array + , Copilot.Language.Operators.Projection , Copilot.Language.Operators.Struct , Copilot.Language.Prelude , Copilot.Language.Reify diff --git a/copilot-language/src/Copilot/Language/Operators/Array.hs b/copilot-language/src/Copilot/Language/Operators/Array.hs index 38ae16333..dd5840439 100644 --- a/copilot-language/src/Copilot/Language/Operators/Array.hs +++ b/copilot-language/src/Copilot/Language/Operators/Array.hs @@ -1,22 +1,29 @@ -{-# LANGUAGE Safe #-} - -{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE Safe #-} +{-# LANGUAGE TypeFamilies #-} +-- The following warning is disabled due to a necessary instance of Projectable +-- defined in this module. +{-# OPTIONS_GHC -fno-warn-orphans #-} -- | Combinators to deal with streams carrying arrays. module Copilot.Language.Operators.Array ( (.!!) , (!) + , (!!) + , (=:) + , (=$) ) where -import Copilot.Core ( Typed - , Op2 (Index) - , typeOf - , Array - ) -import Copilot.Language.Stream (Stream (..)) +import Copilot.Core (Array, Op2 (Index), + Op3 (UpdateArray), Typed, typeOf) +import Copilot.Language.Operators.Projection (Projectable(..)) +import Copilot.Language.Stream (Stream (..)) + +import Data.Word (Word32) +import GHC.TypeLits (KnownNat) +import Prelude hiding ((!!)) -import Data.Word (Word32) -import GHC.TypeLits (KnownNat) -- | Create a stream that carries an element of an array in another stream. -- -- This function implements a projection of the element of an array at a given @@ -38,3 +45,45 @@ arr ! n = Op2 (Index typeOf) arr n , Typed t ) => Stream (Array n t) -> Stream Word32 -> Stream t (.!!) = (!) + +-- | Pair a stream with an element accessor, without applying it to obtain the +-- value of the element. +-- +-- This function is needed to refer to an element accessor when the goal is to +-- update the element value, not just to read it. +(!!) :: Stream (Array n t) + -> Stream Word32 + -> Projection (Array n t) (Stream Word32) t +(!!) = ProjectionA + +-- | Update a stream of arrays. + +-- This is an orphan instance; we suppress the warning that GHC would +-- normally produce with a GHC option at the top. +instance (KnownNat n, Typed t) => Projectable (Array n t) (Stream Word32) t where + + -- | A projection of an element of a stream of arrays. + data Projection (Array n t) (Stream Word32) t = + ProjectionA (Stream (Array n t)) (Stream Word32) + + -- | Create a stream where an element of an array has been updated with + -- values from another stream. + -- + -- For example, if an array has two elements of type @Int32@, and @s@ is a + -- stream of such array type (@Stream (Array 2 Int32)@), and $v0$ is a stream + -- of type @Int32@, then @s !! 0 =: v0@ has type @Stream (Array 2 Int32)@ and + -- contains arrays where the value of the first element of each array is that + -- of @v0@ at each point in time, and the value of the second element in the + -- array is the same it had in @s@. + (=:) (ProjectionA s ix) v = Op3 (UpdateArray typeOf) s ix v + + -- | Create a stream where an element of an array has been updated by + -- applying a stream function to it. + -- + -- For example, if an array has two elements of type @Int32@, and @s@ is a + -- stream of such array type (@Stream (Array 2 Int32)@), and $f$ is function + -- of type @Stream Int32 -> Stream Int32@, then @s !! 0 =$ f@ has type + -- @Stream (Array 2 Int32)@ and contains arrays where the value of the first + -- element of each array is that of @f (s ! 0)@ at each point in time, and + -- the value of the second element in the array is the same it had in @s@. + (=$) (ProjectionA s ix) op = Op3 (UpdateArray typeOf) s ix (op (s ! ix)) diff --git a/copilot-language/src/Copilot/Language/Operators/Projection.hs b/copilot-language/src/Copilot/Language/Operators/Projection.hs new file mode 100644 index 000000000..a350e9593 --- /dev/null +++ b/copilot-language/src/Copilot/Language/Operators/Projection.hs @@ -0,0 +1,38 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FunctionalDependencies #-} +{-# LANGUAGE TypeFamilies #-} +-- | Interface to access portions of a larger data structure. +-- +-- Default operations to access elements from structs and arrays (e.g., a field +-- of a struct, an element of an array) allow obtaining the values of those +-- elements, but not modifying. +-- +-- This module defines a common interface to manipulate portions of a larger +-- data structure. We define the interface in a generic way, using a type +-- class with two operations: one to set the value of the sub-element, and +-- one to update the value of such element applying a stream function. +module Copilot.Language.Operators.Projection + ( Projectable (..) ) + where + +import Copilot.Language.Stream (Stream) + +infixl 8 =: +infixl 8 =$ + +-- | Common interface to manipulate portions of a larger data structure. +-- +-- A projectable d s t means that it is possible to manipulate a sub-element s +-- of type t carried in a stream of type d.. +class Projectable d s t | d s -> t where + + -- | Unapplied projection or element access on a type. + data Projection d s t + + -- | Modify the value of a sub-element of a type in a stream of elements + -- of that type. + (=:) :: Projection d s t -> Stream t -> Stream d + + -- | Update the value of a sub-element of a type in a stream of elements of + -- that type, by applying a function on streams. + (=$) :: Projection d s t -> (Stream t -> Stream t) -> Stream d diff --git a/copilot-language/src/Copilot/Language/Operators/Struct.hs b/copilot-language/src/Copilot/Language/Operators/Struct.hs index 355da508f..f16005e1f 100644 --- a/copilot-language/src/Copilot/Language/Operators/Struct.hs +++ b/copilot-language/src/Copilot/Language/Operators/Struct.hs @@ -1,4 +1,10 @@ -{-# LANGUAGE Safe #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE Safe #-} +{-# LANGUAGE TypeFamilies #-} +-- The following warning is disabled due to a necessary instance of Projectable +-- defined in this module. +{-# OPTIONS_GHC -fno-warn-orphans #-} -- | Combinators to deal with streams carrying structs. -- @@ -25,18 +31,17 @@ -- expr = s ## x =$ (+1) -- @ module Copilot.Language.Operators.Struct - ( (#) - , Projection + ( Projectable(..) + , (#) , (##) - , (=:) - , (=$) ) where import Copilot.Core.Type import Copilot.Core.Operators -import Copilot.Language.Stream (Stream (..)) +import Copilot.Language.Operators.Projection +import Copilot.Language.Stream (Stream (..)) -import GHC.TypeLits (KnownSymbol) +import GHC.TypeLits (KnownSymbol) -- | Create a stream that carries a field of a struct in another stream. -- @@ -49,42 +54,44 @@ import GHC.TypeLits (KnownSymbol) => Stream s -> (s -> Field f t) -> Stream t (#) s f = Op1 (GetField typeOf typeOf f) s --- | Type represented an unapplied struct field accessor and a stream carrying --- structs. -data Projection s f t = Projection (Stream s) (s -> Field f t) - -- | Pair a stream with a field accessor, without applying it to obtain the -- value of the field. -- -- This function is needed to refer to a field accessor when the goal is to -- update the field value, not just to read it. (##) :: (KnownSymbol f, Typed t, Typed s, Struct s) - => Stream s -> (s -> Field f t) -> Projection s f t -(##) = Projection + => Stream s -> (s -> Field f t) -> Projection s (s -> Field f t) t +(##) = ProjectionS --- | Create a stream where the field of a struct has been updated with values --- from another stream. --- --- For example, if a struct of type @T@ has two fields, @t1@ of type @Int32@ --- and @t2@ of type @Word8@, and @s@ is a stream of type @Stream T@, and $sT1$ --- is a stream of type @Int32@ then @s ## t2 =: sT1@ has type @Stream T@ and --- contains structs where the value of @t1@ is that of @sT1@ and the value of --- @t2@ is the value that the same field had in @s@, at any point in time. -infixl 8 =: -(=:) :: (KnownSymbol f, Typed t, Typed s, Struct s) - => Projection s f t -> Stream t -> Stream s -(=:) (Projection s f) v = Op2 (UpdateField typeOf typeOf f) s v +-- | Update a stream of structs. --- | Create a stream where the field of a struct has been updated by applying a --- function to it. --- --- For example, if a struct of type @T@ has two fields, @t1@ of type @Int32@ --- and @t2@ of type @Word8@, and @s@ is a stream of type @Stream T@, and $f$ is --- a function from @Stream Int32 -> Stream Int32@ then @s ## t2 =$ f@ has type --- @Stream T@ and contains structs where the value of @t1@ is that of @f@ --- applied to the original value of @t1@ in @s@, and the value of @t2@ is the --- value that the same field had in @s@, at any point in time. -infixl 8 =$ -(=$) :: (KnownSymbol f, Typed t, Typed s, Struct s) - => Projection s f t -> (Stream t -> Stream t) -> Stream s -(=$) (Projection s f) op = s ## f =: (op (s # f)) +-- This is an orphan instance; we suppress the warning that GHC would +-- normally produce with a GHC option at the top. +instance (KnownSymbol f, Typed s, Typed t, Struct s) + => Projectable s (s -> Field f t) t + where + + -- | A projection of a field of a stream of structs. + data Projection s (s -> Field f t) t = ProjectionS (Stream s) (s -> Field f t) + + -- | Create a stream where the field of a struct has been updated with values + -- from another stream. + -- + -- For example, if a struct of type @T@ has two fields, @t1@ of type @Int32@ + -- and @t2@ of type @Word8@, and @s@ is a stream of type @Stream T@, and + -- $sT1$ is a stream of type @Int32@ then @s ## t2 =: sT1@ has type @Stream + -- T@ and contains structs where the value of @t1@ is that of @sT1@ and the + -- value of @t2@ is the value that the same field had in @s@, at any point in + -- time. + (=:) (ProjectionS s f) v = Op2 (UpdateField typeOf typeOf f) s v + + -- | Create a stream where the field of a struct has been updated by applying + -- a function to it. + -- + -- For example, if a struct of type @T@ has two fields, @t1@ of type @Int32@ + -- and @t2@ of type @Word8@, and @s@ is a stream of type @Stream T@, and $f$ + -- is a function from @Stream Int32 -> Stream Int32@ then @s ## t2 =$ f@ has + -- type @Stream T@ and contains structs where the value of @t1@ is that of + -- @f@ applied to the original value of @t1@ in @s@, and the value of @t2@ is + -- the value that the same field had in @s@, at any point in time. + (=$) (ProjectionS s f) op = Op2 (UpdateField typeOf typeOf f) s (op (s # f)) From dc6348749309b95530d1c50c780b052bbb4a5017 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 6 Aug 2024 08:44:04 -0700 Subject: [PATCH 0788/1222] copilot-c99: Translate array updates to C. Refs #36. Copilot currently supports reading values from arrays, but not changing them. This commit adds the translation to C of expressions that update an element of an array. Co-authored-by: Max Fan --- copilot-c99/src/Copilot/Compile/C99/Expr.hs | 50 +++++++++++++++++++-- 1 file changed, 46 insertions(+), 4 deletions(-) diff --git a/copilot-c99/src/Copilot/Compile/C99/Expr.hs b/copilot-c99/src/Copilot/Compile/C99/Expr.hs index 40b130086..14e129be9 100644 --- a/copilot-c99/src/Copilot/Compile/C99/Expr.hs +++ b/copilot-c99/src/Copilot/Compile/C99/Expr.hs @@ -13,9 +13,9 @@ import qualified Data.List.NonEmpty as NonEmpty import qualified Language.C99.Simple as C -- Internal imports: Copilot -import Copilot.Core ( Expr (..), Field (..), Op1 (..), Op2 (..), Op3 (..), - Type (..), Value (..), accessorName, arrayElems, - toValues, typeSize ) +import Copilot.Core ( Array, Expr (..), Field (..), Op1 (..), Op2 (..), + Op3 (..), Type (..), Value (..), accessorName, + arrayElems, toValues, typeLength, typeSize ) -- Internal imports import Copilot.Compile.C99.Error ( impossible ) @@ -101,6 +101,47 @@ transExpr (Op2 op e1 e2) = do e2' <- transExpr e2 return $ transOp2 op e1' e2' +transExpr e@(Op3 (UpdateArray arrTy@(Array ty2)) e1 e2 e3) = do + e1' <- transExpr e1 + e2' <- transExpr e2 + e3' <- transExpr e3 + + -- Variable to hold the updated array + (i, _, _) <- get + let varName = "_v" ++ show i + modify (\(i, x, y) -> (i + 1, x, y)) + + -- Add new var decl + let initDecl = C.VarDecln Nothing cTy1 varName Nothing + cTy1 = transType arrTy + modify (\(i, x, y) -> (i, x ++ [initDecl], y)) + + let size :: Type (Array n t) -> C.Expr + size arrTy@(Array ty) = C.LitInt (fromIntegral $ typeLength arrTy) + C..* C.SizeOfType (C.TypeName $ transType ty) + + -- Initialize the var to the same value as the original array + let initStmt = C.Expr $ memcpy (C.Ident varName) e1' (size arrTy) + + -- Update element of array + let updateStmt = case ty2 of + Array _ -> C.Expr $ memcpy dest e3' size + where + dest = C.Index (C.Ident varName) e2' + size = C.LitInt + (fromIntegral $ typeSize ty2) + C..* C.SizeOfType (C.TypeName (tyElemName ty2)) + + _ -> C.Expr + $ C.AssignOp + C.Assign + (C.Index (C.Ident varName) e2') + e3' + + modify (\(i, x, y) -> (i, x, y ++ [ initStmt, updateStmt ])) + + return $ C.Ident varName + transExpr (Op3 op e1 e2 e3) = do e1' <- transExpr e1 e2' <- transExpr e2 @@ -179,7 +220,8 @@ transOp2 op e1 e2 = case op of -- expression. transOp3 :: Op3 a b c d -> C.Expr -> C.Expr -> C.Expr -> C.Expr transOp3 op e1 e2 e3 = case op of - Mux _ -> C.Cond e1 e2 e3 + Mux _ -> C.Cond e1 e2 e3 + UpdateArray _ -> impossible "transOp3" "copilot-c99" -- | Translate @'Abs' e@ in Copilot Core into a C99 expression. -- From 04a8964d9eca57c060f753db0753c3ff8302c167 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 6 Aug 2024 08:49:00 -0700 Subject: [PATCH 0789/1222] copilot-interpreter: Interpret array update expressions. Refs #36. Copilot currently supports reading values from arrays, but not changing them. This commit adds the interpretation in Haskell of expressions that update an element of an array in a stream of arrays. Co-authored-by: Max Fan --- copilot-interpreter/src/Copilot/Interpret/Eval.hs | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/copilot-interpreter/src/Copilot/Interpret/Eval.hs b/copilot-interpreter/src/Copilot/Interpret/Eval.hs index 3d8df44a7..462b5853e 100644 --- a/copilot-interpreter/src/Copilot/Interpret/Eval.hs +++ b/copilot-interpreter/src/Copilot/Interpret/Eval.hs @@ -19,8 +19,8 @@ module Copilot.Interpret.Eval import Copilot.Core (Expr (..), Field (..), Id, Name, Observer (..), Op1 (..), Op2 (..), Op3 (..), Spec, Stream (..), Trigger (..), Type (..), UExpr (..), Value (..), - arrayElems, specObservers, specStreams, - specTriggers, updateField) + arrayElems, arrayUpdate, specObservers, + specStreams, specTriggers, updateField) import Copilot.Interpret.Error (badUsage) import Prelude hiding (id) @@ -32,6 +32,7 @@ import Data.Dynamic (Dynamic, fromDynamic, toDyn) import Data.List (transpose) import Data.Maybe (fromJust) import Data.Typeable (Typeable) +import GHC.TypeLits (KnownNat, Nat, natVal) -- | Exceptions that may be thrown during interpretation of a Copilot -- specification. @@ -265,7 +266,8 @@ catchZero f x y = f x y -- Haskell function operating on the same types as the -- 'Copilot.Core.Operators.Op3'. evalOp3 :: Op3 a b c d -> (a -> b -> c -> d) -evalOp3 (Mux _) = \ !v !x !y -> if v then x else y +evalOp3 (Mux _) = \ !v !x !y -> if v then x else y +evalOp3 (UpdateArray ty) = \xs n x -> arrayUpdate xs (fromIntegral n) x -- | Turn a stream into a key-value pair that can be added to an 'Env' for -- simulation. From 1dfc4dd020978e6d8e9789c185011080f37f9b3b Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 6 Aug 2024 08:50:27 -0700 Subject: [PATCH 0790/1222] copilot-prettyprinter: Pretty-print array update expressions. Refs #36. Copilot currently supports reading values from arrays, but not changing them. This commit add support to pretty-print expressions that update elements of an array. Co-authored-by: Max Fan --- copilot-prettyprinter/src/Copilot/PrettyPrint.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/copilot-prettyprinter/src/Copilot/PrettyPrint.hs b/copilot-prettyprinter/src/Copilot/PrettyPrint.hs index a8119b12e..64ca9c90a 100644 --- a/copilot-prettyprinter/src/Copilot/PrettyPrint.hs +++ b/copilot-prettyprinter/src/Copilot/PrettyPrint.hs @@ -111,6 +111,8 @@ ppOp3 op = case op of text "(if" <+> doc1 <+> text "then" <+> doc2 <+> text "else" <+> doc3 <> text ")" + UpdateArray _ -> \ doc1 doc2 doc3 -> + parens $ doc1 <+> text "!!" <+> doc2 <+> text "=:" <+> doc3 -- | Parenthesize two 'Doc's, separated by an infix 'String'. ppInfix :: String -> Doc -> Doc -> Doc From a5d50f9571c67f404e96cb3e5d6f6e54efb5193f Mon Sep 17 00:00:00 2001 From: Ryan Scott Date: Mon, 12 Aug 2024 06:29:44 -0400 Subject: [PATCH 0791/1222] copilot-theorem: Translate array updates to What4. Refs #36. Copilot currently supports reading values from arrays, but not changing them. This commit adds symbolic reasoning support for array update expressions by translating them to What4. The implementation is largely inspired by the existing translation for array index expressions. Because the index in an array update expression can be symbolic, we must build a chain of symbolic if-then-else expressions that check the value of the possibly-symbolic index against all possible concrete index values from `0` to `n - 1` (where `n` is the size of the array). --- .../src/Copilot/Theorem/What4/Translate.hs | 84 ++++++++++++++++++- 1 file changed, 81 insertions(+), 3 deletions(-) diff --git a/copilot-theorem/src/Copilot/Theorem/What4/Translate.hs b/copilot-theorem/src/Copilot/Theorem/What4/Translate.hs index 5b84b021b..f6ced33b7 100644 --- a/copilot-theorem/src/Copilot/Theorem/What4/Translate.hs +++ b/copilot-theorem/src/Copilot/Theorem/What4/Translate.hs @@ -52,16 +52,18 @@ import Data.Maybe (fromJust) import Data.Parameterized.Classes (KnownRepr (..)) import Data.Parameterized.Context (EmptyCtx, type (::>)) import Data.Parameterized.NatRepr (LeqProof (..), NatCases (..), - NatRepr, decNat, isZeroOrGT1, + NatRepr, decNat, incNat, + intValue, isZeroOrGT1, knownNat, minusPlusCancel, - mkNatRepr, testNatCases) + mkNatRepr, testNatCases, + testStrictLeq) import Data.Parameterized.Some (Some (..)) import Data.Parameterized.SymbolRepr (SymbolRepr, knownSymbol) import qualified Data.Parameterized.Vector as V import Data.Type.Equality (TestEquality (..), (:~:) (..)) import Data.Word (Word32) import GHC.TypeLits (KnownSymbol) -import GHC.TypeNats (KnownNat, type (<=)) +import GHC.TypeNats (KnownNat, type (<=), type (+)) import qualified Panic as Panic import qualified What4.BaseTypes as WT @@ -1141,7 +1143,37 @@ translateOp3 :: forall sym a b c d . translateOp3 sym origExpr op xe1 xe2 xe3 = case (op, xe1, xe2, xe3) of (CE.Mux _, XBool te, xe1, xe2) -> liftIO $ mkIte sym te xe1 xe2 (CE.Mux _, _, _, _) -> unexpectedValues "mux operation" + (CE.UpdateArray _, xe1, xe2, xe3) -> translateUpdateArray xe1 xe2 xe3 where + -- Translate an 'CE.UpdateArray' operation and its arguments into a what4 + -- representation. This checks that the first argument is an 'XArray' and + -- the second argument is an 'XWord32', invoking 'panic' is this invariant + -- is not upheld. + -- + -- Note: Currently, copilot only checks if array indices are out of bounds + -- as a side condition. The method of translation we are using simply + -- creates a nest of if-then-else expression to check the index expression + -- against all possible indices. If the index expression is known by the + -- solver to be out of bounds (for instance, if it is a constant 5 for an + -- array of 5 elements), then the if-then-else will trivially resolve to + -- true. + translateUpdateArray :: XExpr sym + -> XExpr sym + -> XExpr sym + -> TransM sym (XExpr sym) + translateUpdateArray xe1 xe2 newXe = case (xe1, xe2) of + (XArray xes, XWord32 ix) -> do + -- The second argument should not be out of bounds (i.e., greater than + -- or equal to the length of the array) + xesLenBV <- liftIO $ WI.bvLit sym knownNat $ BV.mkBV knownNat + $ toInteger $ V.lengthInt xes + inRange <- liftIO $ WI.bvUlt sym ix xesLenBV + addSidePred inRange + + xes' <- liftIO $ buildUpdateArrayExpr sym xes ix newXe + pure $ XArray xes' + _ -> unexpectedValues "update array operation" + unexpectedValues :: forall m x . (Panic.HasCallStack, MonadIO m) => String -> m x unexpectedValues op = @@ -1180,6 +1212,52 @@ buildIndexExpr sym ix = loop 0 ixEq <- WI.bvEq sym curIxExpr ix mkIte sym ixEq xe rstExpr +-- | Construct an expression that updates an array element at a particular index +-- by building a chain of @if@ expressions, where each expression checks if the +-- current index is equal to a given index in the array. If the indices are +-- equal, return the array with the element at that index updated. Otherwise, +-- proceed to the next @if@ expression, which checks the next index in the +-- array. +buildUpdateArrayExpr :: forall sym n. + (1 <= n, WFP.IsInterpretedFloatExprBuilder sym) + => sym + -> V.Vector n (XExpr sym) + -- ^ Elements + -> WI.SymBV sym 32 + -- ^ Index + -> XExpr sym + -- ^ New element + -> IO (V.Vector n (XExpr sym)) +buildUpdateArrayExpr sym xelts ix newXe = loop (knownNat @0) + where + n :: NatRepr n + n = V.length xelts + + n32 :: NatRepr 32 + n32 = knownNat @32 + + loop :: forall i. + ((i + 1) <= n) + => NatRepr i + -> IO (V.Vector n (XExpr sym)) + loop curIx = + case testStrictLeq nextIx n of + -- Recursive case + Left LeqProof -> do + rstExpr <- loop nextIx + curIxExpr <- WI.bvLit sym n32 $ BV.mkBV n32 $ intValue curIx + ixEq <- WI.bvEq sym curIxExpr ix + V.zipWithM (mkIte sym ixEq) newXelts rstExpr + -- Base case, we are at the last possible index (n - 1) + Right Refl -> + pure newXelts + where + nextIx :: NatRepr (i + 1) + nextIx = incNat curIx + + newXelts :: V.Vector n (XExpr sym) + newXelts = V.insertAt curIx newXe xelts + -- | Construct an @if@ expression of the appropriate type. mkIte :: WFP.IsInterpretedFloatExprBuilder sym => sym From b776616b44873f7ca63a6921a6705df34d5cd224 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 6 Sep 2024 11:52:53 +0000 Subject: [PATCH 0792/1222] copilot: Update array example to demonstrate array updates. Refs #36. Previous commits have introduced support to modify individual elements of arrays, either by giving a new stream of values for a position in an array, or by applying a stream function to an element. This commit updates an existing example in the examples/ directory to demonstrate array updates. --- copilot/examples/Array.hs | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/copilot/examples/Array.hs b/copilot/examples/Array.hs index fc924c11c..7f43a21b1 100644 --- a/copilot/examples/Array.hs +++ b/copilot/examples/Array.hs @@ -28,6 +28,20 @@ spec = do -- void func (int8_t arg[3]); trigger "func" (arr ! 0) [arg arr] + -- A trigger that fires 'func2' every time. + -- It passes the current value of arr as an argument, but updating the first + -- element of the array to always be True. + -- The prototype of 'func2' would be: + -- void func2 (int8_t arg[3]); + trigger "func2" true [arg (arr !! 0 =: true)] + + -- A trigger that fires 'func2' every time. + -- It passes the current value of arr as an argument, but negating the second + -- element of the array. + -- The prototype of 'func3' would be: + -- void func3 (int8_t arg[3]); + trigger "func3" true [arg (arr !! 1 =$ not)] + -- Compile the spec main :: IO () main = interpret 30 spec From 8e3bbba65288297a474835c389529488cde231ac Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 3 Sep 2024 08:21:31 -0700 Subject: [PATCH 0793/1222] copilot: Introduce example reasoning about array updates. Refs #36. Previous commits have introduced support to modify individual elements of arrays, either by giving a new stream of values for a position in an array, or by applying a stream function to an element. This commit introduces a new example in the examples/ directory to demonstrate using copilot-theorem to reason about arrays where individual elements are being updated. --- copilot/examples/what4/Arrays.hs | 42 ++++++++++++++++++++++++++++++++ 1 file changed, 42 insertions(+) create mode 100644 copilot/examples/what4/Arrays.hs diff --git a/copilot/examples/what4/Arrays.hs b/copilot/examples/what4/Arrays.hs new file mode 100644 index 000000000..3fd74544a --- /dev/null +++ b/copilot/examples/what4/Arrays.hs @@ -0,0 +1,42 @@ +-- | An example showing the usage of the What4 backend in copilot-theorem for +-- arrays where individual elements are updated. + +{-# LANGUAGE DataKinds #-} + +module Main where + +import qualified Prelude as P +import Control.Monad (void, forM_) + +import Language.Copilot +import Copilot.Theorem.What4 + +spec :: Spec +spec = do + let pair :: Stream (Array 2 Int16) + pair = extern "pair" Nothing + + -- Check equality, indexing into array and modifying the value. Note that + -- this is trivial by equality. + void $ prop "Example 1" $ forAll $ + ((pair !! 0 =$ (+1)) ! 0) == ((pair ! 0) + 1) + + -- Same as previous example, but get a different array index (so should be + -- false). + void $ prop "Example 2" $ forAll $ + ((pair !! 0 =$ (+1)) ! 1) == ((pair ! 0) + 1) + +main :: IO () +main = do + spec' <- reify spec + + -- Use Z3 to prove the properties. + results <- prove Z3 spec' + + -- Print the results. + forM_ results $ \(nm, res) -> do + putStr $ nm <> ": " + case res of + Valid -> putStrLn "valid" + Invalid -> putStrLn "invalid" + Unknown -> putStrLn "unknown" From 165e43094946e9f06efc61e50c8ccd8477d903dc Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 3 Sep 2024 08:22:54 -0700 Subject: [PATCH 0794/1222] copilot-core: Document changes in CHANGELOG. Refs #36. --- copilot-core/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-core/CHANGELOG b/copilot-core/CHANGELOG index b912c7e51..e55e962c8 100644 --- a/copilot-core/CHANGELOG +++ b/copilot-core/CHANGELOG @@ -1,3 +1,6 @@ +2024-09-03 + * Update Op3, Array to support array updates. (#36) + 2024-07-07 * Version bump (3.20). (#522) * Update Op2, Struct to support struct field updates. (#520) From 2bc48dc7226449e2e840841eb317e2bd7e71144a Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 3 Sep 2024 08:24:16 -0700 Subject: [PATCH 0795/1222] copilot-language: Document changes in CHANGELOG. Refs #36. --- copilot-language/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-language/CHANGELOG b/copilot-language/CHANGELOG index bc428fddc..55b56088e 100644 --- a/copilot-language/CHANGELOG +++ b/copilot-language/CHANGELOG @@ -1,3 +1,6 @@ +2024-09-03 + * Add support for array updates. (#36) + 2024-07-07 * Version bump (3.20). (#522) * Remove deprecated function Copilot.Language.Spec.forall. (#518) From 2d60f80951b9d642fc9ef0654b03ab5b62afa168 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 3 Sep 2024 08:24:43 -0700 Subject: [PATCH 0796/1222] copilot-c99: Document changes in CHANGELOG. Refs #36. --- copilot-c99/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-c99/CHANGELOG b/copilot-c99/CHANGELOG index 836ff3415..5c68efdab 100644 --- a/copilot-c99/CHANGELOG +++ b/copilot-c99/CHANGELOG @@ -1,3 +1,6 @@ +2024-09-03 + * Add support for array updates. (#36) + 2024-07-07 * Version bump (3.20). (#522) * Add support for struct field updates. (#520) From 7a1a3716c41012f58905d500f9b7ea377077dfc1 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 3 Sep 2024 08:25:17 -0700 Subject: [PATCH 0797/1222] copilot-interpreter: Document changes in CHANGELOG. Refs #36. --- copilot-interpreter/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-interpreter/CHANGELOG b/copilot-interpreter/CHANGELOG index e3bfe6d92..22b5915f0 100644 --- a/copilot-interpreter/CHANGELOG +++ b/copilot-interpreter/CHANGELOG @@ -1,3 +1,6 @@ +2024-09-03 + * Add support for array updates. (#36) + 2024-07-07 * Version bump (3.20). (#522) * Add support for struct field updates. (#520) From b868e9392b22ecb10f1fe5ce643046b7f6dd3eec Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 3 Sep 2024 08:25:48 -0700 Subject: [PATCH 0798/1222] copilot-prettyprinter: Document changes in CHANGELOG. Refs #36. --- copilot-prettyprinter/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot-prettyprinter/CHANGELOG b/copilot-prettyprinter/CHANGELOG index d91bb375e..d2b10e690 100644 --- a/copilot-prettyprinter/CHANGELOG +++ b/copilot-prettyprinter/CHANGELOG @@ -1,5 +1,6 @@ -2024-08-30 +2024-09-03 * Add support for pretty-printing struct update expressions. (#526) + * Add support for pretty-printing array update expressions. (#36) 2024-07-07 * Version bump (3.20). (#522) From 02c89d20b8bd2ee86848a19e2bacae35aeb1308c Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 3 Sep 2024 08:26:41 -0700 Subject: [PATCH 0799/1222] copilot-libraries: Document changes in CHANGELOG. Refs #36. --- copilot-libraries/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-libraries/CHANGELOG b/copilot-libraries/CHANGELOG index d93218fa5..7d807efb0 100644 --- a/copilot-libraries/CHANGELOG +++ b/copilot-libraries/CHANGELOG @@ -1,3 +1,6 @@ +2024-09-03 + * Rename operator to avoid name clash. (#36) + 2024-07-07 * Version bump (3.20). (#522) From f7fc2de590205715be0711e7e2ffc1981baf84e4 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 3 Sep 2024 08:27:16 -0700 Subject: [PATCH 0800/1222] copilot-theorem: Document changes in CHANGELOG. Refs #36. --- copilot-theorem/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot-theorem/CHANGELOG b/copilot-theorem/CHANGELOG index efc0d0bcf..3f9269bdb 100644 --- a/copilot-theorem/CHANGELOG +++ b/copilot-theorem/CHANGELOG @@ -1,5 +1,6 @@ -2024-08-30 +2024-09-03 * Add support for struct updates in Copilot.Theorem.What4. (#524) + * Add support for array updates in Copilot.Theorem.What4. (#36) 2024-07-07 * Version bump (3.20). (#522) From 191a75f096d5956f25737b354a1279b00a6e2cde Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 3 Sep 2024 08:27:45 -0700 Subject: [PATCH 0801/1222] copilot: Document changes in CHANGELOG. Refs #36. --- copilot/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot/CHANGELOG b/copilot/CHANGELOG index c71906891..1da30d3ee 100644 --- a/copilot/CHANGELOG +++ b/copilot/CHANGELOG @@ -1,5 +1,6 @@ -2024-08-30 +2024-09-03 * Update example to demonstrate struct update support. (#524) + * Update example to demonstrate array update support. (#36) 2024-07-07 * Version bump (3.20). (#522) From ccfb96e06de3f01259c7b885316e3690521fb644 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 8 Sep 2024 05:43:32 +0000 Subject: [PATCH 0802/1222] Bump versions and constraints. Refs #532. --- copilot-c99/copilot-c99.cabal | 4 ++-- copilot-core/copilot-core.cabal | 2 +- copilot-interpreter/copilot-interpreter.cabal | 4 ++-- copilot-language/copilot-language.cabal | 8 ++++---- copilot-libraries/copilot-libraries.cabal | 12 ++++++------ copilot-prettyprinter/copilot-prettyprinter.cabal | 4 ++-- copilot-theorem/copilot-theorem.cabal | 6 +++--- copilot/copilot.cabal | 14 +++++++------- 8 files changed, 27 insertions(+), 27 deletions(-) diff --git a/copilot-c99/copilot-c99.cabal b/copilot-c99/copilot-c99.cabal index ca3cf1d15..2acefad8c 100644 --- a/copilot-c99/copilot-c99.cabal +++ b/copilot-c99/copilot-c99.cabal @@ -1,6 +1,6 @@ cabal-version : >= 1.10 name : copilot-c99 -version : 3.20 +version : 4.0 synopsis : A compiler for Copilot targeting C99. description : This package is a back-end from Copilot to C. @@ -45,7 +45,7 @@ library , mtl >= 2.2 && < 2.4 , pretty >= 1.1 && < 1.2 - , copilot-core >= 3.20 && < 3.21 + , copilot-core >= 4.0 && < 4.1 , language-c99 >= 0.2.0 && < 0.3 , language-c99-simple >= 0.3 && < 0.4 diff --git a/copilot-core/copilot-core.cabal b/copilot-core/copilot-core.cabal index b49a0629a..500c97df8 100644 --- a/copilot-core/copilot-core.cabal +++ b/copilot-core/copilot-core.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-core -version: 3.20 +version: 4.0 synopsis: An intermediate representation for Copilot. description: Intermediate representation for Copilot. diff --git a/copilot-interpreter/copilot-interpreter.cabal b/copilot-interpreter/copilot-interpreter.cabal index 1f844fcfa..9ad90e75e 100644 --- a/copilot-interpreter/copilot-interpreter.cabal +++ b/copilot-interpreter/copilot-interpreter.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-interpreter -version: 3.20 +version: 4.0 synopsis: Interpreter for Copilot. description: Interpreter for Copilot. @@ -44,7 +44,7 @@ library base >= 4.9 && < 5, pretty >= 1.0 && < 1.2, - copilot-core >= 3.20 && < 3.21 + copilot-core >= 4.0 && < 4.1 exposed-modules: diff --git a/copilot-language/copilot-language.cabal b/copilot-language/copilot-language.cabal index 921ed79b7..a9b79547f 100644 --- a/copilot-language/copilot-language.cabal +++ b/copilot-language/copilot-language.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-language -version: 3.20 +version: 4.0 synopsis: A Haskell-embedded DSL for monitoring hard real-time distributed systems. description: @@ -42,9 +42,9 @@ library , data-reify >= 0.6 && < 0.7 , mtl >= 2.0 && < 3 - , copilot-core >= 3.20 && < 3.21 - , copilot-interpreter >= 3.20 && < 3.21 - , copilot-theorem >= 3.20 && < 3.21 + , copilot-core >= 4.0 && < 4.1 + , copilot-interpreter >= 4.0 && < 4.1 + , copilot-theorem >= 4.0 && < 4.1 exposed-modules: Copilot.Language , Copilot.Language.Operators.BitWise diff --git a/copilot-libraries/copilot-libraries.cabal b/copilot-libraries/copilot-libraries.cabal index ad89218d1..741a4cc8e 100644 --- a/copilot-libraries/copilot-libraries.cabal +++ b/copilot-libraries/copilot-libraries.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-libraries -version: 3.20 +version: 4.0 synopsis: Libraries for the Copilot language. description: Libraries for the Copilot language. @@ -36,12 +36,12 @@ library hs-source-dirs: src - build-depends: base >= 4.9 && < 5 + build-depends: base >= 4.9 && < 5 - , containers >= 0.4 && < 0.7 - , mtl >= 2.0 && < 2.4 - , parsec >= 2.0 && < 3.2 - , copilot-language >= 3.20 && < 3.21 + , containers >= 0.4 && < 0.7 + , mtl >= 2.0 && < 2.4 + , parsec >= 2.0 && < 3.2 + , copilot-language >= 4.0 && < 4.1 exposed-modules: Copilot.Library.Libraries diff --git a/copilot-prettyprinter/copilot-prettyprinter.cabal b/copilot-prettyprinter/copilot-prettyprinter.cabal index 0f452c68d..73746675a 100644 --- a/copilot-prettyprinter/copilot-prettyprinter.cabal +++ b/copilot-prettyprinter/copilot-prettyprinter.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-prettyprinter -version: 3.20 +version: 4.0 synopsis: A prettyprinter of Copilot Specifications. description: A prettyprinter of Copilot specifications. @@ -45,7 +45,7 @@ library base >= 4.9 && < 5, pretty >= 1.0 && < 1.2, - copilot-core >= 3.20 && < 3.21 + copilot-core >= 4.0 && < 4.1 exposed-modules: diff --git a/copilot-theorem/copilot-theorem.cabal b/copilot-theorem/copilot-theorem.cabal index 496ef8c32..46416e9ee 100644 --- a/copilot-theorem/copilot-theorem.cabal +++ b/copilot-theorem/copilot-theorem.cabal @@ -14,7 +14,7 @@ description: . -version : 3.20 +version : 4.0 license : BSD3 license-file : LICENSE maintainer : Ivan Perez @@ -63,8 +63,8 @@ library , xml >= 1.3 && < 1.4 , what4 >= 1.3 && < 1.7 - , copilot-core >= 3.20 && < 3.21 - , copilot-prettyprinter >= 3.20 && < 3.21 + , copilot-core >= 4.0 && < 4.1 + , copilot-prettyprinter >= 4.0 && < 4.1 exposed-modules : Copilot.Theorem , Copilot.Theorem.Prove diff --git a/copilot/copilot.cabal b/copilot/copilot.cabal index cfc61c628..394431a33 100644 --- a/copilot/copilot.cabal +++ b/copilot/copilot.cabal @@ -1,5 +1,5 @@ name: copilot -version: 3.20 +version: 4.0 cabal-version: >= 1.10 license: BSD3 license-file: LICENSE @@ -52,12 +52,12 @@ library , directory >= 1.3 && < 1.4 , filepath >= 1.4 && < 1.5 - , copilot-core >= 3.20 && < 3.21 - , copilot-theorem >= 3.20 && < 3.21 - , copilot-language >= 3.20 && < 3.21 - , copilot-libraries >= 3.20 && < 3.21 - , copilot-c99 >= 3.20 && < 3.21 - , copilot-prettyprinter >= 3.20 && < 3.21 + , copilot-core >= 4.0 && < 4.1 + , copilot-theorem >= 4.0 && < 4.1 + , copilot-language >= 4.0 && < 4.1 + , copilot-libraries >= 4.0 && < 4.1 + , copilot-c99 >= 4.0 && < 4.1 + , copilot-prettyprinter >= 4.0 && < 4.1 exposed-modules: Language.Copilot, Language.Copilot.Main From 2cea27decb7c62b375800f8b4bc1fdfa78433034 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 8 Sep 2024 05:47:15 +0000 Subject: [PATCH 0803/1222] Document changes in CHANGELOG. Refs #532. --- copilot-c99/CHANGELOG | 3 ++- copilot-core/CHANGELOG | 3 ++- copilot-interpreter/CHANGELOG | 3 ++- copilot-language/CHANGELOG | 3 ++- copilot-libraries/CHANGELOG | 3 ++- copilot-prettyprinter/CHANGELOG | 3 ++- copilot-theorem/CHANGELOG | 3 ++- copilot/CHANGELOG | 3 ++- 8 files changed, 16 insertions(+), 8 deletions(-) diff --git a/copilot-c99/CHANGELOG b/copilot-c99/CHANGELOG index 5c68efdab..406051dd8 100644 --- a/copilot-c99/CHANGELOG +++ b/copilot-c99/CHANGELOG @@ -1,4 +1,5 @@ -2024-09-03 +2024-09-07 + * Version bump (4.0). (#532) * Add support for array updates. (#36) 2024-07-07 diff --git a/copilot-core/CHANGELOG b/copilot-core/CHANGELOG index e55e962c8..db1a795be 100644 --- a/copilot-core/CHANGELOG +++ b/copilot-core/CHANGELOG @@ -1,4 +1,5 @@ -2024-09-03 +2024-09-07 + * Version bump (4.0). (#532) * Update Op3, Array to support array updates. (#36) 2024-07-07 diff --git a/copilot-interpreter/CHANGELOG b/copilot-interpreter/CHANGELOG index 22b5915f0..5cb1ad93c 100644 --- a/copilot-interpreter/CHANGELOG +++ b/copilot-interpreter/CHANGELOG @@ -1,4 +1,5 @@ -2024-09-03 +2024-09-07 + * Version bump (4.0). (#532) * Add support for array updates. (#36) 2024-07-07 diff --git a/copilot-language/CHANGELOG b/copilot-language/CHANGELOG index 55b56088e..c4f11fd36 100644 --- a/copilot-language/CHANGELOG +++ b/copilot-language/CHANGELOG @@ -1,4 +1,5 @@ -2024-09-03 +2024-09-07 + * Version bump (4.0). (#532) * Add support for array updates. (#36) 2024-07-07 diff --git a/copilot-libraries/CHANGELOG b/copilot-libraries/CHANGELOG index 7d807efb0..9bdfd287a 100644 --- a/copilot-libraries/CHANGELOG +++ b/copilot-libraries/CHANGELOG @@ -1,4 +1,5 @@ -2024-09-03 +2024-09-07 + * Version bump (4.0). (#532) * Rename operator to avoid name clash. (#36) 2024-07-07 diff --git a/copilot-prettyprinter/CHANGELOG b/copilot-prettyprinter/CHANGELOG index d2b10e690..e5409a927 100644 --- a/copilot-prettyprinter/CHANGELOG +++ b/copilot-prettyprinter/CHANGELOG @@ -1,4 +1,5 @@ -2024-09-03 +2024-09-07 + * Version bump (4.0). (#532) * Add support for pretty-printing struct update expressions. (#526) * Add support for pretty-printing array update expressions. (#36) diff --git a/copilot-theorem/CHANGELOG b/copilot-theorem/CHANGELOG index 3f9269bdb..fa1870c7f 100644 --- a/copilot-theorem/CHANGELOG +++ b/copilot-theorem/CHANGELOG @@ -1,4 +1,5 @@ -2024-09-03 +2024-09-07 + * Version bump (4.0). (#532) * Add support for struct updates in Copilot.Theorem.What4. (#524) * Add support for array updates in Copilot.Theorem.What4. (#36) diff --git a/copilot/CHANGELOG b/copilot/CHANGELOG index 1da30d3ee..16965d835 100644 --- a/copilot/CHANGELOG +++ b/copilot/CHANGELOG @@ -1,4 +1,5 @@ -2024-09-03 +2024-09-07 + * Version bump (4.0). (#532) * Update example to demonstrate struct update support. (#524) * Update example to demonstrate array update support. (#36) From 2f763ca634a1a45fe62191ec1bec8b7ddba4abe4 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 4 Oct 2024 12:47:05 +0000 Subject: [PATCH 0804/1222] copilot: Update contribution guidelines. Refs #476. Copilot now has a process that allows us to accept contributions from external users again. This commit updates the README to describe the new process that users should follow to contribute to Copilot. I am choosing to leave some details out to not overwhelm users in the README; that can be discussed later when the PR is processed. --- copilot/README.md | 34 ++++++++++++++++++++++++++++------ 1 file changed, 28 insertions(+), 6 deletions(-) diff --git a/copilot/README.md b/copilot/README.md index aef1fb26b..e5ab5572b 100644 --- a/copilot/README.md +++ b/copilot/README.md @@ -281,12 +281,34 @@ tutorial, please visit the Copilot website: # Contributions [(Back to top)](#table-of-contents) -Copilot cannot accept pull requests or code contributions from developers -outside the development team at this point. - -If you have a question, find a bug, or would like to request a change, please -file an issue adding as much information as you can to help us reproduce the -error or identify the use case. Please file the issue with no labels. +We'd love to receive your contributions, be it code fixes, new features, bug +reports, discussions, or anything else that can help the Copilot project. + +If you have any comments, questions, ideas, or other topics that you think may +be of interest, start a new discussion +[here](https://github.com/Copilot-Language/copilot/discussions). + +If you would like to contribute a fix for an issue, please comment on the issue +indicating that you want to fix it so that we can assign it to you and track +the status on our end. If the issue does not exist, create it first or ask that +an existing discussion be promoted to an issue. + +If you are unsure about whether your submission should be filed as an issue or +as a discussion, file it as a discussion. We can always move it later. + +To facilitate merging any pull requests that you send, please: +- Reference the issue you are addressing with the text `Refs #.` + at the end of the subject line of each commit message, in *every commit*. + Replace `` with the number of the specific issue that your pull + request is addressing. +- Describe what each commit does individually *in the commit's message*. It's + best to err on the side of being more descriptive than less. +- Update the CHANGELOGs in the *last commit(s)*. + +You can take a look at the repository's [commit +history](https://github.com/Copilot-Language/copilot/commits/master/) to better +understand the process we follow. Click on each commit to see how we write +commit messages. # Acknowledgements [(Back to top)](#table-of-contents) From ee6bf33faa742c6ffd0349947de33de683cdb659 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 4 Oct 2024 12:49:42 +0000 Subject: [PATCH 0805/1222] copilot: Document changes in CHANGELOG. Refs #476. --- copilot/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot/CHANGELOG b/copilot/CHANGELOG index 16965d835..6d84bf465 100644 --- a/copilot/CHANGELOG +++ b/copilot/CHANGELOG @@ -1,3 +1,6 @@ +2024-10-04 + * Update contribution guidelines (#476). + 2024-09-07 * Version bump (4.0). (#532) * Update example to demonstrate struct update support. (#524) From 58610b45cc9702cbcfb1410ef2fa033712b2755b Mon Sep 17 00:00:00 2001 From: Ryan Scott Date: Fri, 27 Sep 2024 14:04:43 -0400 Subject: [PATCH 0806/1222] copilot-language: Detect duplicate extern names in properties and theorems. Refs #536. The Copilot analysis functionality in `Copilot.Language.Analyze` was able to detect distinct externs with the same name (something that should be rejected with a proper error message) in triggers and observers, but not in properties or theorems. As a consequence of this, `copilot-theorem` could outright crash when attempting to prove properties in a specification with duplicate extern names. This fixes the issue by extending the analysis functionality to look into properties and theorems as well. --- .../src/Copilot/Language/Analyze.hs | 21 +++++++++++++++---- 1 file changed, 17 insertions(+), 4 deletions(-) diff --git a/copilot-language/src/Copilot/Language/Analyze.hs b/copilot-language/src/Copilot/Language/Analyze.hs index 9d326395c..04de14ed4 100644 --- a/copilot-language/src/Copilot/Language/Analyze.hs +++ b/copilot-language/src/Copilot/Language/Analyze.hs @@ -17,6 +17,7 @@ import qualified Copilot.Core as C import Copilot.Language.Stream (Stream (..)) import Copilot.Language.Spec import Copilot.Language.Error (badUsage) +import Copilot.Theorem.Prove (UProof) import Data.List (groupBy) import Data.IORef @@ -268,10 +269,16 @@ analyzeExts ExternEnv { externVarEnv = vars -- | Obtain all the externs in a specification. specExts :: IORef Env -> Spec' a -> IO ExternEnv specExts refStreams spec = do - env <- foldM triggerExts - (ExternEnv [] [] [] []) - (triggers $ runSpec spec) - foldM observerExts env (observers $ runSpec spec) + env0 <- foldM triggerExts + (ExternEnv [] [] [] []) + (triggers $ runSpec spec) + env1 <- foldM observerExts + env0 + (observers $ runSpec spec) + env2 <- foldM propertyExts + env1 + (properties $ runSpec spec) + foldM theoremExts env2 (theorems $ runSpec spec) where observerExts :: ExternEnv -> Observer -> IO ExternEnv @@ -283,6 +290,12 @@ specExts refStreams spec = do foldM (\env'' (Arg arg_) -> collectExts refStreams arg_ env'') env' args + propertyExts :: ExternEnv -> Property -> IO ExternEnv + propertyExts env (Property _ stream) = collectExts refStreams stream env + + theoremExts :: ExternEnv -> (Property, UProof) -> IO ExternEnv + theoremExts env (p, _) = propertyExts env p + -- | Obtain all the externs in a stream. collectExts :: C.Typed a => IORef Env -> Stream a -> ExternEnv -> IO ExternEnv collectExts refStreams stream_ env_ = do From 7873c0287914b9047ff93b42373a7ac58cbc7c49 Mon Sep 17 00:00:00 2001 From: Ryan Scott Date: Fri, 27 Sep 2024 14:42:16 -0400 Subject: [PATCH 0807/1222] copilot-language: Document changes in CHANGELOG. Refs #536. --- copilot-language/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-language/CHANGELOG b/copilot-language/CHANGELOG index c4f11fd36..73789c0c6 100644 --- a/copilot-language/CHANGELOG +++ b/copilot-language/CHANGELOG @@ -1,3 +1,6 @@ +2024-10-15 + * Reject duplicate externs in properties and theorems. (#536) + 2024-09-07 * Version bump (4.0). (#532) * Add support for array updates. (#36) From b5d8f37b126c07f24012e6b0ed5ea9f688a6e1d2 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 15 Oct 2024 01:57:17 +0000 Subject: [PATCH 0808/1222] copilot: Update README with missing publications. Refs #544. The current publications section of the README is missing several publications related to Copilot published by our team, including most recent publications. This commit updates the list to include all new papers, several older papers, and any known thesis. --- copilot/README.md | 22 ++++++++++++++++++++++ 1 file changed, 22 insertions(+) diff --git a/copilot/README.md b/copilot/README.md index e5ab5572b..870cca956 100644 --- a/copilot/README.md +++ b/copilot/README.md @@ -257,6 +257,28 @@ is: Other relevant papers include: +- [Runtime Verification in Real-Time with the Copilot Language: A Tutorial](https://link.springer.com/chapter/10.1007/978-3-031-71177-0_27) + +- [Trustworthy Runtime Verification via Bisimulation (Experience Report)](https://dl.acm.org/doi/abs/10.1145/3607841) + +- [An Introduction to Copilot](https://copilot-language.github.io/downloads/copilot_tutorial.pdf) + +- [Assuring the Guardians](https://link.springer.com/chapter/10.1007/978-3-319-23820-3_6) + +- [Experience report: a do-it-yourself high-assurance compiler](https://dl.acm.org/doi/abs/10.1145/2364527.2364553) + +- [Compiling an Haskell EDSL to C: A new C back-end for the Copilot runtime verification framework](https://studenttheses.uu.nl/handle/20.500.12932/29176) + +- [Challenges in High-Assurance Runtime Verification](https://link.springer.com/chapter/10.1007/978-3-319-47166-2_31) + +- [Runtime Monitoring On Hard Real-Time Operating Systems](http://hdl.handle.net/10342/4999) + +- [Design and Testing of an Approach to Automated In-Flight Safety Risk Management for sUAS Operations](https://ntrs.nasa.gov/citations/20220005948) + +- [The Essence of Reactivity](https://dl.acm.org/doi/10.1145/3609026.3609727) + +- [Types that Change: The Extensible Type Design Pattern](https://dl.acm.org/doi/abs/10.1145/3609025.3609475) + - [Automated Translation of Natural Language Requirements to Runtime Monitors](https://link.springer.com/chapter/10.1007/978-3-030-99524-9_21) - [Copilot: A Hard Real-Time Runtime Monitor](https://link.springer.com/chapter/10.1007/978-3-642-16612-9_26) From 9753a5b42eda91e938b22ac7cf65132c8e1d5024 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 15 Oct 2024 01:57:58 +0000 Subject: [PATCH 0809/1222] copilot: Document changes in CHANGELOG. Refs #544. --- copilot/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot/CHANGELOG b/copilot/CHANGELOG index 6d84bf465..c7f474576 100644 --- a/copilot/CHANGELOG +++ b/copilot/CHANGELOG @@ -1,5 +1,6 @@ -2024-10-04 +2024-10-14 * Update contribution guidelines (#476). + * Update README with missing publications. (#544) 2024-09-07 * Version bump (4.0). (#532) From ceae6480015fdb4b005b545138a2d31846033bbc Mon Sep 17 00:00:00 2001 From: Ryan Scott Date: Fri, 27 Sep 2024 15:17:51 -0400 Subject: [PATCH 0810/1222] copilot: Update what4-propositional example's comments to match results. Refs #535. Previously, the comments in the `what4-propositional` example claimed that certain examples were unprovable, even though they were actually provable. This is a result of the heuristics in `Copilot.Theorem.What4` becoming more intelligent after commit 4ae3f249fbf8c37c0909046150ff341d432bd042, but due to an oversight, the comments in the `what4-propositional` example were not updated at the time. This commit revamps the `what4-propositional` example so that each example's comments clearly and accurately state whether the example is provable with the current implementation of `Copilot.Theorem.What4`. I have organized the examples so that they are organized into logically separate sections, with each section requiring increasingly more sophisticated techniques to prove (or, in some cases, fail to prove). --- copilot/examples/what4/Propositional.hs | 65 +++++++++++++++++-------- 1 file changed, 45 insertions(+), 20 deletions(-) diff --git a/copilot/examples/what4/Propositional.hs b/copilot/examples/what4/Propositional.hs index 75dcf55fc..4caf669d4 100644 --- a/copilot/examples/what4/Propositional.hs +++ b/copilot/examples/what4/Propositional.hs @@ -11,40 +11,65 @@ import Copilot.Theorem.What4 spec :: Spec spec = do + -- * Non-inductive propositions + -- The constant value true, which is translated as the corresponding SMT - -- boolean literal. + -- boolean literal (and is therefore provable). void $ prop "Example 1" (forAll true) -- The constant value false, which is translated as the corresponding SMT - -- boolean literal. + -- boolean literal (and is therefore not provable). void $ prop "Example 2" (forAll false) - -- An inductively defined flavor of true, which requires induction to prove, - -- and hence is found to be invalid by the SMT solver (since no inductive - -- hypothesis is made). + -- An "a or not a" proposition which does not require any sort of inductive + -- argument (but see examples 5 and 6 below for versions that do require + -- induction to solve). This is easily proven. + let a = [False] ++ b + b = not a + void $ prop "Example 3" (forAll (a || b)) + + -- An "a or not a" proposition using external streams, which is also provable. + let a = extern "a" Nothing + void $ prop "Example 4" (forAll (a || not a)) + + -- * Simple inductive propositions + -- + -- While Copilot.Theorem.What4 is not able to solve all inductive propositions + -- in general (see the "Complex inductive propositions" section below), the + -- following inductive propositions are simple enough that the heuristics in + -- Copilot.Theorem.What4 can solve them without issue. + + -- An inductively defined flavor of true. let a = [True] ++ a - void $ prop "Example 3" (forAll a) + void $ prop "Example 5" (forAll a) - -- An inductively defined "a or not a" proposition, which is unprovable by - -- the SMT solver. + -- An inductively defined "a or not a" proposition (i.e., a more complex + -- version of example 3 above). let a = [False] ++ b b = [True] ++ a - void $ prop "Example 4" (forAll (a || b)) - - -- A version of "a or not a" proposition which does not require any sort of - -- inductive argument, and hence is provable. - let a = [False] ++ b - b = not a - void $ prop "Example 5" (forAll (a || b)) + void $ prop "Example 6" (forAll (a || b)) - -- A bit more convoluted version of Example 5, which is provable. + -- A bit more convoluted version of example 6. let a = [True, False] ++ b b = [False] ++ not (drop 1 a) - void $ prop "Example 6" (forAll (a || b)) + void $ prop "Example 7" (forAll (a || b)) - -- An example using external streams. - let a = extern "a" Nothing - void $ prop "Example 7" (forAll (a || not a)) + -- * Complex induction propositions + -- + -- The heuristics in Copilot.Theorem.What4 are not able to prove these + -- inductive propositions, so these will be reported as unprovable, even + -- though each proposition is actually provable. + + -- An inductively defined flavor of true (i.e., a more complex version of + -- example 5 above). + let a = [True] ++ ([True] ++ ([True] ++ a)) + void $ prop "Example 8" (forAll a) + + -- An inductively defined "a or not a" proposition (i.e., a more complex + -- version of example 6 above). + let a = [False] ++ ([False] ++ ([False] ++ b)) + b = [True] ++ ([True] ++ ([True] ++ a)) + void $ prop "Example 9" (forAll (a || b)) main :: IO () main = do From b71e159738b215bb35bf5fbd1e073d4d25c30d00 Mon Sep 17 00:00:00 2001 From: Ryan Scott Date: Fri, 27 Sep 2024 15:20:03 -0400 Subject: [PATCH 0811/1222] copilot: Document changes in CHANGELOG. Refs #535. --- copilot/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot/CHANGELOG b/copilot/CHANGELOG index c7f474576..fc36b32d4 100644 --- a/copilot/CHANGELOG +++ b/copilot/CHANGELOG @@ -1,6 +1,7 @@ -2024-10-14 +2024-10-18 * Update contribution guidelines (#476). * Update README with missing publications. (#544) + * Make the what4-propositional example's comments match results. (#535) 2024-09-07 * Version bump (4.0). (#532) From 2dc9fb4984b829b55425aed5adc7c574edca7aae Mon Sep 17 00:00:00 2001 From: Ryan Scott Date: Mon, 30 Sep 2024 15:33:28 -0400 Subject: [PATCH 0812/1222] copilot: Give example of how to implement updateField. Refs #525. This adds an `examples/StructsUpdateField.hs` example that (1) describes how to implement `updateField` for some example `Struct` instances, and (2) demonstrates that `updateField` works by using it with the Copilot interpreter. --- copilot/copilot.cabal | 12 ++ copilot/examples/Structs.hs | 7 ++ copilot/examples/StructsUpdateField.hs | 159 +++++++++++++++++++++++++ copilot/examples/what4/Structs.hs | 7 ++ 4 files changed, 185 insertions(+) create mode 100644 copilot/examples/StructsUpdateField.hs diff --git a/copilot/copilot.cabal b/copilot/copilot.cabal index 394431a33..467ae50c9 100644 --- a/copilot/copilot.cabal +++ b/copilot/copilot.cabal @@ -207,6 +207,18 @@ executable structs else buildable: False +executable structs-update-field + main-is: StructsUpdateField.hs + hs-source-dirs: examples + build-depends: base >= 4.9 && < 5 + , copilot + , copilot-c99 + default-language: Haskell2010 + if flag(examples) + buildable: True + else + buildable: False + executable voting main-is: Voting.hs hs-source-dirs: examples diff --git a/copilot/examples/Structs.hs b/copilot/examples/Structs.hs index 3b7b01fcc..559a5be29 100644 --- a/copilot/examples/Structs.hs +++ b/copilot/examples/Structs.hs @@ -23,6 +23,11 @@ instance Struct Volts where toValues volts = [ Value Word16 (numVolts volts) , Value Bool (flag volts) ] + -- Note that we do not implement `updateField` here. `updateField` is only + -- needed to make updates to structs work in the Copilot interpreter, and we + -- do not use the interpreter in this example. (See + -- `examples/StructsUpdateField.hs` for an example that does implement + -- `updateField`.) -- | `Volts` instance for `Typed`. instance Typed Volts where @@ -41,6 +46,8 @@ instance Struct Battery where , Value typeOf (volts battery) , Value typeOf (other battery) ] + -- Note that we do not implement `updateField` here for the same reasons as in + -- the `Struct Volts` instance above. -- | `Battery` instance for `Typed`. Note that `undefined` is used as an -- argument to `Field`. This argument is never used, so `undefined` will never diff --git a/copilot/examples/StructsUpdateField.hs b/copilot/examples/StructsUpdateField.hs new file mode 100644 index 000000000..33f5d319f --- /dev/null +++ b/copilot/examples/StructsUpdateField.hs @@ -0,0 +1,159 @@ +-- | An example showing how specifications involving structs (in particular, +-- nested structs) are interpreted and how they are compiled to C using +-- copilot-c99. + +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} + +module Main where + +import qualified Prelude as P +import Control.Monad (void, forM_) +import Data.Proxy (Proxy(..)) +import Data.Type.Equality (TestEquality(..), (:~:)(..)) +import GHC.TypeLits (sameSymbol) + +import Language.Copilot +import Copilot.Compile.C99 + +-- | Definition for `Volts`. +data Volts = Volts + { numVolts :: Field "numVolts" Word16 + , flag :: Field "flag" Bool + } + +-- | `Struct` instance for `Volts`. +instance Struct Volts where + typeName _ = "volts" + toValues volts = [ Value Word16 (numVolts volts) + , Value Bool (flag volts) + ] + -- In order to run struct updates (as used in the "equalityStructUpdate" + -- trigger below) in the Copilot interpreter, we must implement the + -- `updateField` method. To do so, we must check to see if the supplied + -- `Value` has a `Field` with the same name and type as a field in `Volts`. + updateField volts (Value fieldTy (field :: Field fieldName a)) + -- For each field in `Volts`, we must: + -- + -- 1. Check that the field names match using `sameSymbol`. Here, + -- "numVolts" is the expected name, and `fieldName` is the actual name + -- that is supplied as an argument to `updateField`. If the check + -- succeeds, then the `sameSymbol` function will return `Just p`, where + -- `p` is proof that the two names are the same. + | Just Refl <- sameSymbol (Proxy @"numVolts") (Proxy @fieldName) + -- 2. Check that the field types match using `testEquality`. Here, + -- `Word16` is the expected type, and `fieldTy` is the actual type that + -- is supplied as an argument. Again, `testEquality` will return `Just + -- p` (where `p` is a proof) if the two are the same. + , Just Refl <- testEquality Word16 fieldTy + -- 3. If both of the checks above succeed, then we can update the field's + -- value using a record update. + = volts { numVolts = field } + + -- It is possible that the `Value` passed as an argument could correspond + -- to any of the fields in `Volts`, so we must repeat this process for + -- the `flag` field as well. + | Just Refl <- sameSymbol (Proxy @fieldName) (Proxy @"flag") + , Just Refl <- testEquality fieldTy Bool + = volts { flag = field } + + -- If the supplied `Value` does not correspond to any field in `Volts`, + -- then something went wrong in the Copilot interpreter. This case reports + -- this as an error. + | otherwise + = error $ "Unexpected field: " P.++ show field + +-- | `Volts` instance for `Typed`. +instance Typed Volts where + typeOf = Struct (Volts (Field 0) (Field False)) + +data Battery = Battery + { temp :: Field "temp" Word16 + , volts :: Field "volts" (Array 10 Volts) + , other :: Field "other" (Array 10 (Array 5 Word32)) + } + +-- | `Battery` instance for `Struct`. +instance Struct Battery where + typeName _ = "battery" + toValues battery = [ Value typeOf (temp battery) + , Value typeOf (volts battery) + , Value typeOf (other battery) + ] + -- We implement `updateField` similarly to how we implement it in the + -- `Struct Volts` instance above. + updateField battery (Value fieldTy (field :: Field fieldName a)) + | Just Refl <- sameSymbol (Proxy @fieldName) (Proxy @"temp") + , Just Refl <- testEquality fieldTy Word16 + = battery { temp = field } + + | Just Refl <- sameSymbol (Proxy @fieldName) (Proxy @"volts") + -- Note that writing out the full `Type` for `Volts` is somewhat verbose, + -- so we make use of the `Typed Volts` instance and write `typeOf @Volts` + -- instead. + , Just Refl <- testEquality fieldTy (Array @10 (typeOf @Volts)) + = battery { volts = field } + + | Just Refl <- sameSymbol (Proxy @fieldName) (Proxy @"other") + , Just Refl <- testEquality fieldTy (Array @10 (Array @5 Word32)) + = battery { other = field } + + | otherwise + = error $ "Unexpected field: " P.++ show field + +-- | `Battery` instance for `Typed`. Note that `undefined` is used as an +-- argument to `Field`. This argument is never used, so `undefined` will never +-- throw an error. +instance Typed Battery where + typeOf = Struct (Battery (Field 0) (Field undefined) (Field undefined)) + +spec :: Spec +spec = do + let voltsValue :: Volts + voltsValue = + Volts + { numVolts = Field 42 + , flag = Field True + } + + batteryValue :: Battery + batteryValue = + Battery + { temp = Field 0 + , volts = Field (array (replicate 10 voltsValue)) + , other = Field (array (replicate 10 (array (replicate 5 0)))) + } + + battery :: Stream Battery + battery = extern "battery" (Just [batteryValue]) + + -- Check equality, indexing into nested structs and arrays. Note that this is + -- trivial by equality. + trigger "equalitySameIndex" + ((((battery#volts) ! 0)#numVolts) == (((battery#volts) ! 0)#numVolts)) + [arg battery] + + -- Same as previous example, but get a different array index (so should be + -- false). + trigger "equalityDifferentIndices" + ((((battery#other) ! 2) ! 3) == (((battery#other) ! 2) ! 4)) + [arg battery] + + -- Update a struct field, then check it for equality. + let batteryTemp1, batteryTemp2 :: Stream Word16 + batteryTemp1 = (battery ## temp =$ (+1))#temp + batteryTemp2 = battery#temp + 1 + trigger "equalityStructUpdate" + (batteryTemp1 == batteryTemp2) + [arg battery, arg batteryTemp1, arg batteryTemp2] + +main :: IO () +main = do + -- Run the specification using the Copilot interpreter. + interpret 1 spec + + -- Compile the specification to C. + spec' <- reify spec + compile "structs" spec' diff --git a/copilot/examples/what4/Structs.hs b/copilot/examples/what4/Structs.hs index 775572547..6b53d1098 100644 --- a/copilot/examples/what4/Structs.hs +++ b/copilot/examples/what4/Structs.hs @@ -24,6 +24,11 @@ instance Struct Volts where toValues volts = [ Value Word16 (numVolts volts) , Value Bool (flag volts) ] + -- Note that we do not implement `updateField` here. `updateField` is only + -- needed to make updates to structs work in the Copilot interpreter, and we + -- do not use the interpreter in this example. (See + -- `examples/StructsUpdateField.hs` for an example that does implement + -- `updateField`.) -- | `Volts` instance for `Typed`. instance Typed Volts where @@ -42,6 +47,8 @@ instance Struct Battery where , Value typeOf (volts battery) , Value typeOf (other battery) ] + -- Note that we do not implement `updateField` here for the same reasons as in + -- the `Struct Volts` instance above. -- | `Battery` instance for `Typed`. Note that `undefined` is used as an -- argument to `Field`. This argument is never used, so `undefined` will never From 93c3520ef32ff83b0831319f6d1b42bc5ed2bd92 Mon Sep 17 00:00:00 2001 From: Ryan Scott Date: Mon, 30 Sep 2024 15:37:01 -0400 Subject: [PATCH 0813/1222] copilot-core: Add Haddocks for updateField. Refs #525. This adds Haddocks to the `updateField` that briefly describes how one might implement `updateField` in custom `Struct` instances. Because the full details of implementing `updateField` are somewhat intricate, these Haddocks refer to the `copilot/examples/StructsUpdateField.hs` example for further information. --- copilot-core/src/Copilot/Core/Type.hs | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) diff --git a/copilot-core/src/Copilot/Core/Type.hs b/copilot-core/src/Copilot/Core/Type.hs index 5710465f3..34cdb4598 100644 --- a/copilot-core/src/Copilot/Core/Type.hs +++ b/copilot-core/src/Copilot/Core/Type.hs @@ -60,6 +60,25 @@ class Struct a where -- | Transforms all the struct's fields into a list of values. toValues :: a -> [Value a] + -- | Update the value of a struct field. This is only used by the Copilot + -- interpreter, so if you do not plan to use the interpreter, it is safe to + -- omit an implementation of this method. + -- + -- In order to implement 'updateField', you should do the following for each + -- 'Field' in a struct: + -- + -- 1. Check that the name of the 'Field' matches the name of the supplied + -- 'Value' (using 'GHC.TypeLits.sameSymbol'). + -- + -- 2. Check that the type of the 'Field' matches the 'Type' of the supplied + -- 'Value' (using 'DE.testEquality'). + -- + -- 3. If both (1) and (2) succeed, update the corresponding struct field using + -- a record update. + -- + -- For a complete end-to-end example that demonstrates how to implement + -- 'updateField' and use it in the Copilot interpreter, see the + -- @examples/StructsUpdateField.hs@ example in the @copilot@ library. updateField :: a -> Value t -> a updateField = error "Field updates not supported for this type." From b80e9478b51e5bfb5bda147fb788532e218a617d Mon Sep 17 00:00:00 2001 From: Ryan Scott Date: Fri, 18 Oct 2024 20:10:00 -0400 Subject: [PATCH 0814/1222] copilot-core: Make error message for unimplemented updateField more informative. Refs #525. Lacking a manual implementation, `updateField`'s default implementation is to throw an error message. This commit adds a suggestion to the user in the error message that the user should manually implement `updateField` in order to fix the error. --- copilot-core/src/Copilot/Core/Type.hs | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/copilot-core/src/Copilot/Core/Type.hs b/copilot-core/src/Copilot/Core/Type.hs index 34cdb4598..9e5bfddbc 100644 --- a/copilot-core/src/Copilot/Core/Type.hs +++ b/copilot-core/src/Copilot/Core/Type.hs @@ -80,7 +80,10 @@ class Struct a where -- 'updateField' and use it in the Copilot interpreter, see the -- @examples/StructsUpdateField.hs@ example in the @copilot@ library. updateField :: a -> Value t -> a - updateField = error "Field updates not supported for this type." + updateField = error $ unlines + [ "Field updates not supported for this type." + , "(Perhaps you need to implement 'updateField' for a 'Struct' instance?)" + ] -- | The field of a struct, together with a representation of its type. data Value a = From 7d9d8184b1a161d382cbccf57a225cc905d2e50b Mon Sep 17 00:00:00 2001 From: Ryan Scott Date: Mon, 30 Sep 2024 15:39:42 -0400 Subject: [PATCH 0815/1222] copilot: Document changes in CHANGELOG. Refs #525. --- copilot/CHANGELOG | 1 + 1 file changed, 1 insertion(+) diff --git a/copilot/CHANGELOG b/copilot/CHANGELOG index fc36b32d4..f1a66e960 100644 --- a/copilot/CHANGELOG +++ b/copilot/CHANGELOG @@ -2,6 +2,7 @@ * Update contribution guidelines (#476). * Update README with missing publications. (#544) * Make the what4-propositional example's comments match results. (#535) + * Add example describing how to implement updateField. (#525) 2024-09-07 * Version bump (4.0). (#532) From 75a3d9045dd6da368a2105ab8686129f71577075 Mon Sep 17 00:00:00 2001 From: Ryan Scott Date: Mon, 30 Sep 2024 15:39:50 -0400 Subject: [PATCH 0816/1222] copilot-core: Document changes in CHANGELOG. Refs #525. --- copilot-core/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-core/CHANGELOG b/copilot-core/CHANGELOG index db1a795be..dacde61da 100644 --- a/copilot-core/CHANGELOG +++ b/copilot-core/CHANGELOG @@ -1,3 +1,6 @@ +2024-10-18 + * Add Haddocks for updateField. (#525) + 2024-09-07 * Version bump (4.0). (#532) * Update Op3, Array to support array updates. (#36) From 713833c2f1ea10d885a4306fbf6afbea2f68c587 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 19 Oct 2024 17:59:50 +0000 Subject: [PATCH 0817/1222] copilot-c99: Standardize issue references in changelog. Refs #550. The CHANGELOGs contain lines with irregular formatting in the way that issue numbers are referenced: sometimes a period goes before, sometimes it's added after the issue number, sometimes both. This commit puts the period always before the issue number. --- copilot-c99/CHANGELOG | 36 ++++++++++++++++++------------------ 1 file changed, 18 insertions(+), 18 deletions(-) diff --git a/copilot-c99/CHANGELOG b/copilot-c99/CHANGELOG index 406051dd8..59946e6ac 100644 --- a/copilot-c99/CHANGELOG +++ b/copilot-c99/CHANGELOG @@ -18,7 +18,7 @@ 2024-01-07 * Version bump (3.18). (#487) * Change return type of main generated for tests. (#468) - * Print constants in tests using portable suffixes. (#471). + * Print constants in tests using portable suffixes. (#471) * Pass output arrays as arguments to trigger argument functions. (#431) * Compliance with MISRA C 2023 / MISRA C 2012. (#472) @@ -112,30 +112,30 @@ 2020-12-06 * Version bump (3.2). - * Implemented arrays in test driver (#176). - * Fixed nested array initialisation bug (#173). - * Fixed length of buffer allocation for n-dimensional arrays (#174). - * Fixed printing of long ints in test suite (#177). - * Fixed printing of unsigned ints in test suite (#177). - * Fixed '-Wsequence-point' warnings from GCC (#179). - * Split Property.hs (#180). - * Removed 'Test' from module paths (#181). - * Made compiletest take compiler options as an argument (#182). - * Fixed problem with property and empty string in driver CSV (#183). - * Added comma to output of driver to match the interpreter (#184). - * Implemented basic quickcheck based testing (#185). + * Implemented arrays in test driver. (#176) + * Fixed nested array initialisation bug. (#173) + * Fixed length of buffer allocation for n-dimensional arrays. (#174) + * Fixed printing of long ints in test suite. (#177) + * Fixed printing of unsigned ints in test suite. (#177) + * Fixed '-Wsequence-point' warnings from GCC. (#179) + * Split Property.hs. (#180) + * Removed 'Test' from module paths. (#181) + * Made compiletest take compiler options as an argument. (#182) + * Fixed problem with property and empty string in driver CSV. (#183) + * Added comma to output of driver to match the interpreter. (#184) + * Implemented basic quickcheck based testing. (#185) 2020-03-30 - * Version bump (3.1.2) + * Version bump (3.1.2). * Fixed bug where stream buffers are updated too soon. (#188) * Updated description of cabal package. (#192) 2019-12-23 * Version bump (3.1.1). - * Fixed bug with constant structs and arrays.(#200). + * Fixed bug with constant structs and arrays. (#200) 2019-11-22 * Version bump (3.1). - * Remove ExternFun (#207). - * Fix bug in code generation for local expression (#198). - * Implement code generation for labels (trivially) (#199). + * Remove ExternFun. (#207) + * Fix bug in code generation for local expression. (#198) + * Implement code generation for labels (trivially). (#199) From 7a7764633061bc89fe245456c209fab6593820a7 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 19 Oct 2024 18:01:04 +0000 Subject: [PATCH 0818/1222] copilot-core: Standardize issue references in changelog. Refs #550. The CHANGELOGs contain lines with irregular formatting in the way that issue numbers are referenced: sometimes a period goes before, sometimes it's added after the issue number, sometimes both. This commit puts the period always before the issue number. --- copilot-core/CHANGELOG | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/copilot-core/CHANGELOG b/copilot-core/CHANGELOG index dacde61da..872fbecc9 100644 --- a/copilot-core/CHANGELOG +++ b/copilot-core/CHANGELOG @@ -141,13 +141,13 @@ 2020-12-06 Ivan Perez * Version bump (3.2). - * Fixed implementation of tysize for n-dimensional arrays. (#147). - * Removed sorting of interpreter output (#148). - * Minor documentation fixes (#149, #151). + * Fixed implementation of tysize for n-dimensional arrays. (#147) + * Removed sorting of interpreter output. (#148) + * Minor documentation fixes. (#149, #151) * Credits: @fdedden. 2019-11-22 Ivan Perez * Version bump (3.1). - * Eliminate random modules and generators (#157). - * Updated contact information for 'impossible' error (#154). - * Implement missing pretty printer for Index operator (#155). + * Eliminate random modules and generators. (#157) + * Updated contact information for 'impossible' error. (#154) + * Implement missing pretty printer for Index operator. (#155) From 7db6774a907b197a9d88c74bd460c1c7bfdf9285 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 19 Oct 2024 18:01:17 +0000 Subject: [PATCH 0819/1222] copilot-language: Standardize issue references in changelog. Refs #550. The CHANGELOGs contain lines with irregular formatting in the way that issue numbers are referenced: sometimes a period goes before, sometimes it's added after the issue number, sometimes both. This commit puts the period always before the issue number. --- copilot-language/CHANGELOG | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/copilot-language/CHANGELOG b/copilot-language/CHANGELOG index 73789c0c6..175ac6981 100644 --- a/copilot-language/CHANGELOG +++ b/copilot-language/CHANGELOG @@ -112,11 +112,11 @@ 2020-05-07 * Version bump (3.2). - * Fixed the reverse order of triggers (#114). - * Update description, bug-reports, changelog fields in cabal file - (#116). - * Bump ghc-prim version bounds (#122). + * Fixed the reverse order of triggers. (#114) + * Update description, bug-reports, changelog fields in cabal file. + (#116) + * Bump ghc-prim version bounds. (#122) 2019-11-22 Ivan Perez * Version bump (3.1). - * Remove ExternFun (#118). + * Remove ExternFun. (#118) From ac701e5b8580f568b993c1b5303305a57c3ba735 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 19 Oct 2024 18:01:33 +0000 Subject: [PATCH 0820/1222] copilot-libraries: Standardize issue references in changelog. Refs #550. The CHANGELOGs contain lines with irregular formatting in the way that issue numbers are referenced: sometimes a period goes before, sometimes it's added after the issue number, sometimes both. This commit puts the period always before the issue number. --- copilot-libraries/CHANGELOG | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot-libraries/CHANGELOG b/copilot-libraries/CHANGELOG index 9bdfd287a..672949f3d 100644 --- a/copilot-libraries/CHANGELOG +++ b/copilot-libraries/CHANGELOG @@ -88,7 +88,7 @@ 2020-12-06 * Version bump (3.2). - * Update description, bug-reports, homepage fields in cabal file (#129). + * Update description, bug-reports, homepage fields in cabal file. (#129) 2019-11-22 Ivan Perez * Version bump (3.1). From c97ef5720b112838357392c5536fda7ccedfaf54 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 19 Oct 2024 18:01:44 +0000 Subject: [PATCH 0821/1222] copilot-theorem: Standardize issue references in changelog. Refs #550. The CHANGELOGs contain lines with irregular formatting in the way that issue numbers are referenced: sometimes a period goes before, sometimes it's added after the issue number, sometimes both. This commit puts the period always before the issue number. --- copilot-theorem/CHANGELOG | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/copilot-theorem/CHANGELOG b/copilot-theorem/CHANGELOG index fa1870c7f..31bdf9222 100644 --- a/copilot-theorem/CHANGELOG +++ b/copilot-theorem/CHANGELOG @@ -89,18 +89,18 @@ * Version bump (3.4). (#231) 2021-05-07 - * Version bump (3.3). (#217). - * Adjust contraints on version of what4. (#90). + * Version bump (3.3). (#217) + * Adjust contraints on version of what4. (#90) 2021-03-07 - * Version bump (3.2.1). (#92). - * Completed the documentation. (#95, #93). + * Version bump (3.2.1). (#92) + * Completed the documentation. (#95, #93) 2020-12-06 * Version bump (3.2). - * Update description, bug-reports and homepage field in cabal file - (#97). + * Update description, bug-reports and homepage field in cabal file. + (#97) 2019-11-22 Ivan Perez * Version bump (3.1). - * Remove ExternFun (#99). + * Remove ExternFun. (#99) From 20926fa582ed2f359340227fbeb2b541948a6aac Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 19 Oct 2024 18:01:54 +0000 Subject: [PATCH 0822/1222] copilot: Standardize issue references in changelog. Refs #550. The CHANGELOGs contain lines with irregular formatting in the way that issue numbers are referenced: sometimes a period goes before, sometimes it's added after the issue number, sometimes both. This commit puts the period always before the issue number. --- copilot/CHANGELOG | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/copilot/CHANGELOG b/copilot/CHANGELOG index f1a66e960..adfa10162 100644 --- a/copilot/CHANGELOG +++ b/copilot/CHANGELOG @@ -1,5 +1,5 @@ 2024-10-18 - * Update contribution guidelines (#476). + * Update contribution guidelines. (#476) * Update README with missing publications. (#544) * Make the what4-propositional example's comments match results. (#535) * Add example describing how to implement updateField. (#525) @@ -123,11 +123,11 @@ 2020-12-06 * Update optparse-applicative dependency version for newer base - versions. (#61). - * Add Ivan Perez as co-maintainer (#51). - * Update description in cabal file to match copilot-core (#50). + versions. (#61) + * Add Ivan Perez as co-maintainer. (#51) + * Update description in cabal file to match copilot-core. (#50) 2019-11-22 Ivan Perez * Version bump (3.1). - * Update multiple examples (#41). - * Update instructions to match new repositry name (#45). + * Update multiple examples. (#41) + * Update instructions to match new repositry name. (#45) From b7be4f0472c410af2d04365d6047d7461796229b Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 19 Oct 2024 20:07:02 +0000 Subject: [PATCH 0823/1222] copilot-c99: Add missing issue number. Refs #550. The standard format in the changelog is that entries should include the issue number that documents what led to the change. This commit adds missing issue numbers for known issues. --- copilot-c99/CHANGELOG | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/copilot-c99/CHANGELOG b/copilot-c99/CHANGELOG index 59946e6ac..6ce08a92a 100644 --- a/copilot-c99/CHANGELOG +++ b/copilot-c99/CHANGELOG @@ -111,7 +111,7 @@ * Completed the documentation. (#171) 2020-12-06 - * Version bump (3.2). + * Version bump (3.2). (#65) * Implemented arrays in test driver. (#176) * Fixed nested array initialisation bug. (#173) * Fixed length of buffer allocation for n-dimensional arrays. (#174) @@ -126,16 +126,16 @@ * Implemented basic quickcheck based testing. (#185) 2020-03-30 - * Version bump (3.1.2). + * Version bump (3.1.2). (#187) * Fixed bug where stream buffers are updated too soon. (#188) * Updated description of cabal package. (#192) 2019-12-23 - * Version bump (3.1.1). + * Version bump (3.1.1). (#191) * Fixed bug with constant structs and arrays. (#200) 2019-11-22 - * Version bump (3.1). + * Version bump (3.1). (#46) * Remove ExternFun. (#207) * Fix bug in code generation for local expression. (#198) * Implement code generation for labels (trivially). (#199) From 36a92ef5ead30d37b44949aec53da3c6455e30c4 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 19 Oct 2024 20:07:20 +0000 Subject: [PATCH 0824/1222] copilot-core: Add missing issue number. Refs #550. The standard format in the changelog is that entries should include the issue number that documents what led to the change. This commit adds missing issue numbers for known issues. --- copilot-core/CHANGELOG | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/copilot-core/CHANGELOG b/copilot-core/CHANGELOG index 872fbecc9..fa9caba6f 100644 --- a/copilot-core/CHANGELOG +++ b/copilot-core/CHANGELOG @@ -140,14 +140,14 @@ * Completed the documentation. (#145) 2020-12-06 Ivan Perez - * Version bump (3.2). + * Version bump (3.2). (#65) * Fixed implementation of tysize for n-dimensional arrays. (#147) * Removed sorting of interpreter output. (#148) * Minor documentation fixes. (#149, #151) * Credits: @fdedden. 2019-11-22 Ivan Perez - * Version bump (3.1). + * Version bump (3.1). (#46) * Eliminate random modules and generators. (#157) * Updated contact information for 'impossible' error. (#154) * Implement missing pretty printer for Index operator. (#155) From 45deee9b69af1549b39f9b51c1bf5705615e74a1 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 19 Oct 2024 20:07:26 +0000 Subject: [PATCH 0825/1222] copilot-language: Add missing issue number. Refs #550. The standard format in the changelog is that entries should include the issue number that documents what led to the change. This commit adds missing issue numbers for known issues. --- copilot-language/CHANGELOG | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/copilot-language/CHANGELOG b/copilot-language/CHANGELOG index 175ac6981..08c167726 100644 --- a/copilot-language/CHANGELOG +++ b/copilot-language/CHANGELOG @@ -111,12 +111,12 @@ * Completed the documentation. (#112) 2020-05-07 - * Version bump (3.2). + * Version bump (3.2). (#65) * Fixed the reverse order of triggers. (#114) * Update description, bug-reports, changelog fields in cabal file. (#116) * Bump ghc-prim version bounds. (#122) 2019-11-22 Ivan Perez - * Version bump (3.1). + * Version bump (3.1). (#46) * Remove ExternFun. (#118) From 186a9fbd3b92832c87693fdc54e02bb1726a25b4 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 19 Oct 2024 20:07:34 +0000 Subject: [PATCH 0826/1222] copilot-libraries: Add missing issue number. Refs #550. The standard format in the changelog is that entries should include the issue number that documents what led to the change. This commit adds missing issue numbers for known issues. --- copilot-libraries/CHANGELOG | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/copilot-libraries/CHANGELOG b/copilot-libraries/CHANGELOG index 672949f3d..789db4a3b 100644 --- a/copilot-libraries/CHANGELOG +++ b/copilot-libraries/CHANGELOG @@ -87,8 +87,8 @@ * Completed the documentation. (#127) 2020-12-06 - * Version bump (3.2). + * Version bump (3.2). (#65) * Update description, bug-reports, homepage fields in cabal file. (#129) 2019-11-22 Ivan Perez - * Version bump (3.1). + * Version bump (3.1). (#46) From 827d41072a3ce8dafd85b73adda4f127e2c15013 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 19 Oct 2024 20:07:40 +0000 Subject: [PATCH 0827/1222] copilot-theorem: Add missing issue number. Refs #550. The standard format in the changelog is that entries should include the issue number that documents what led to the change. This commit adds missing issue numbers for known issues. --- copilot-theorem/CHANGELOG | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/copilot-theorem/CHANGELOG b/copilot-theorem/CHANGELOG index 31bdf9222..be572ced5 100644 --- a/copilot-theorem/CHANGELOG +++ b/copilot-theorem/CHANGELOG @@ -97,10 +97,10 @@ * Completed the documentation. (#95, #93) 2020-12-06 - * Version bump (3.2). + * Version bump (3.2). (#65) * Update description, bug-reports and homepage field in cabal file. (#97) 2019-11-22 Ivan Perez - * Version bump (3.1). + * Version bump (3.1). (#46) * Remove ExternFun. (#99) From c95753400c03cc5d103ec500aa5a85c5fb8e0ab8 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 19 Oct 2024 20:07:48 +0000 Subject: [PATCH 0828/1222] copilot: Add missing issue number. Refs #550. The standard format in the changelog is that entries should include the issue number that documents what led to the change. This commit adds missing issue numbers for known issues. --- copilot/CHANGELOG | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot/CHANGELOG b/copilot/CHANGELOG index adfa10162..af2860daf 100644 --- a/copilot/CHANGELOG +++ b/copilot/CHANGELOG @@ -128,6 +128,6 @@ * Update description in cabal file to match copilot-core. (#50) 2019-11-22 Ivan Perez - * Version bump (3.1). + * Version bump (3.1). (#46) * Update multiple examples. (#41) * Update instructions to match new repositry name. (#45) From ca4f6d12f5cc064a86797f43c8cae8b1805cc6b7 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 19 Oct 2024 20:16:04 +0000 Subject: [PATCH 0829/1222] copilot-core: Remove maintainer from entry. Refs #550. Blocks of entries in the changelog do not have the maintainer next to them anymore. However, two of the entries uses an old format where the maintainer was listed next to the date. This commit removes that maintainer, to keep all blocks following a standard format. --- copilot-core/CHANGELOG | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/copilot-core/CHANGELOG b/copilot-core/CHANGELOG index fa9caba6f..3f21f08c8 100644 --- a/copilot-core/CHANGELOG +++ b/copilot-core/CHANGELOG @@ -139,14 +139,14 @@ * Version bump (3.2.1). (#136) * Completed the documentation. (#145) -2020-12-06 Ivan Perez +2020-12-06 * Version bump (3.2). (#65) * Fixed implementation of tysize for n-dimensional arrays. (#147) * Removed sorting of interpreter output. (#148) * Minor documentation fixes. (#149, #151) * Credits: @fdedden. -2019-11-22 Ivan Perez +2019-11-22 * Version bump (3.1). (#46) * Eliminate random modules and generators. (#157) * Updated contact information for 'impossible' error. (#154) From 22ca316dd6732ea133d173d17c7e3f1257093f07 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 19 Oct 2024 20:16:16 +0000 Subject: [PATCH 0830/1222] copilot-language: Remove maintainer from entry. Refs #550. Blocks of entries in the changelog do not have the maintainer next to them anymore. However, one of the entries uses an old format where the maintainer was listed next to the date. This commit removes that maintainer, to keep all blocks following a standard format. --- copilot-language/CHANGELOG | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot-language/CHANGELOG b/copilot-language/CHANGELOG index 08c167726..dac6be0d3 100644 --- a/copilot-language/CHANGELOG +++ b/copilot-language/CHANGELOG @@ -117,6 +117,6 @@ (#116) * Bump ghc-prim version bounds. (#122) -2019-11-22 Ivan Perez +2019-11-22 * Version bump (3.1). (#46) * Remove ExternFun. (#118) From e6ef7adc8449826a3bdef46cba4cb83e73d79e6b Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 19 Oct 2024 20:16:21 +0000 Subject: [PATCH 0831/1222] copilot-libraries: Remove maintainer from entry. Refs #550. Blocks of entries in the changelog do not have the maintainer next to them anymore. However, one of the entries uses an old format where the maintainer was listed next to the date. This commit removes that maintainer, to keep all blocks following a standard format. --- copilot-libraries/CHANGELOG | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot-libraries/CHANGELOG b/copilot-libraries/CHANGELOG index 789db4a3b..75d5360ba 100644 --- a/copilot-libraries/CHANGELOG +++ b/copilot-libraries/CHANGELOG @@ -90,5 +90,5 @@ * Version bump (3.2). (#65) * Update description, bug-reports, homepage fields in cabal file. (#129) -2019-11-22 Ivan Perez +2019-11-22 * Version bump (3.1). (#46) From b1b21965afd2aca79432662cef1f5a1588e0e22c Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 19 Oct 2024 20:16:27 +0000 Subject: [PATCH 0832/1222] copilot-theorem: Remove maintainer from entry. Refs #550. Blocks of entries in the changelog do not have the maintainer next to them anymore. However, one of the entries uses an old format where the maintainer was listed next to the date. This commit removes that maintainer, to keep all blocks following a standard format. --- copilot-theorem/CHANGELOG | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot-theorem/CHANGELOG b/copilot-theorem/CHANGELOG index be572ced5..ae70b7be8 100644 --- a/copilot-theorem/CHANGELOG +++ b/copilot-theorem/CHANGELOG @@ -101,6 +101,6 @@ * Update description, bug-reports and homepage field in cabal file. (#97) -2019-11-22 Ivan Perez +2019-11-22 * Version bump (3.1). (#46) * Remove ExternFun. (#99) From 47a8bf90ffabc7d72a81c4ec9219df306ff51593 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 19 Oct 2024 20:16:32 +0000 Subject: [PATCH 0833/1222] copilot: Remove maintainer from entry. Refs #550. Blocks of entries in the changelog do not have the maintainer next to them anymore. However, one of the entries uses an old format where the maintainer was listed next to the date. This commit removes that maintainer, to keep all blocks following a standard format. --- copilot/CHANGELOG | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot/CHANGELOG b/copilot/CHANGELOG index af2860daf..40d605645 100644 --- a/copilot/CHANGELOG +++ b/copilot/CHANGELOG @@ -127,7 +127,7 @@ * Add Ivan Perez as co-maintainer. (#51) * Update description in cabal file to match copilot-core. (#50) -2019-11-22 Ivan Perez +2019-11-22 * Version bump (3.1). (#46) * Update multiple examples. (#41) * Update instructions to match new repositry name. (#45) From 7332215c4325ad45c5fec7d2230734d98e726276 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 19 Oct 2024 18:03:33 +0000 Subject: [PATCH 0834/1222] copilot-c99: Document changes in CHANGELOG. Refs #550. --- copilot-c99/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-c99/CHANGELOG b/copilot-c99/CHANGELOG index 6ce08a92a..f8dd97230 100644 --- a/copilot-c99/CHANGELOG +++ b/copilot-c99/CHANGELOG @@ -1,3 +1,6 @@ +2024-10-19 + * Standardize changelog format. (#550) + 2024-09-07 * Version bump (4.0). (#532) * Add support for array updates. (#36) From 980cc5f044525266e572b30512e218bea3e2ab2d Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 19 Oct 2024 18:03:59 +0000 Subject: [PATCH 0835/1222] copilot-core: Document changes in CHANGELOG. Refs #550. --- copilot-core/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot-core/CHANGELOG b/copilot-core/CHANGELOG index 3f21f08c8..d93518477 100644 --- a/copilot-core/CHANGELOG +++ b/copilot-core/CHANGELOG @@ -1,5 +1,6 @@ -2024-10-18 +2024-10-19 * Add Haddocks for updateField. (#525) + * Standardize changelog format. (#550) 2024-09-07 * Version bump (4.0). (#532) From fe188d1923b5c3b8e751060d2c3a5507c939c074 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 19 Oct 2024 18:04:34 +0000 Subject: [PATCH 0836/1222] copilot-language: Document changes in CHANGELOG. Refs #550. --- copilot-language/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot-language/CHANGELOG b/copilot-language/CHANGELOG index dac6be0d3..0712d4cc6 100644 --- a/copilot-language/CHANGELOG +++ b/copilot-language/CHANGELOG @@ -1,5 +1,6 @@ -2024-10-15 +2024-10-19 * Reject duplicate externs in properties and theorems. (#536) + * Standardize changelog format. (#550) 2024-09-07 * Version bump (4.0). (#532) From a1010aeca66b8a21e7b5366fc560bfbe37da1713 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 19 Oct 2024 18:04:56 +0000 Subject: [PATCH 0837/1222] copilot-libraries: Document changes in CHANGELOG. Refs #550. --- copilot-libraries/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-libraries/CHANGELOG b/copilot-libraries/CHANGELOG index 75d5360ba..6c045c332 100644 --- a/copilot-libraries/CHANGELOG +++ b/copilot-libraries/CHANGELOG @@ -1,3 +1,6 @@ +2024-10-19 + * Standardize changelog format. (#550) + 2024-09-07 * Version bump (4.0). (#532) * Rename operator to avoid name clash. (#36) From 6edc8b5a5d8be8be3616d9b38a8ad622da9dae01 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 19 Oct 2024 18:05:25 +0000 Subject: [PATCH 0838/1222] copilot-theorem: Document changes in CHANGELOG. Refs #550. --- copilot-theorem/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-theorem/CHANGELOG b/copilot-theorem/CHANGELOG index ae70b7be8..67dabaacd 100644 --- a/copilot-theorem/CHANGELOG +++ b/copilot-theorem/CHANGELOG @@ -1,3 +1,6 @@ +2024-10-19 + * Standardize changelog format. (#550) + 2024-09-07 * Version bump (4.0). (#532) * Add support for struct updates in Copilot.Theorem.What4. (#524) From 578eff68a4a59a4e99b3179fbf5d47e97881ee07 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 19 Oct 2024 18:06:51 +0000 Subject: [PATCH 0839/1222] copilot: Document changes in CHANGELOG. Refs #550. --- copilot/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot/CHANGELOG b/copilot/CHANGELOG index 40d605645..72808ad85 100644 --- a/copilot/CHANGELOG +++ b/copilot/CHANGELOG @@ -1,8 +1,9 @@ -2024-10-18 +2024-10-19 * Update contribution guidelines. (#476) * Update README with missing publications. (#544) * Make the what4-propositional example's comments match results. (#535) * Add example describing how to implement updateField. (#525) + * Standardize changelog format. (#550) 2024-09-07 * Version bump (4.0). (#532) From 2fbe5d285d5319faa50d7110d2081e5a6b6fec15 Mon Sep 17 00:00:00 2001 From: Frank Dedden Date: Mon, 14 Oct 2024 14:30:24 +0200 Subject: [PATCH 0840/1222] copilot: Add installation instructions for Fedora 40 and up. Refs #542. Since September 2024, Copilot is available in Fedora 40 and newer. This commit adds installation instruction for Fedora. --- copilot/README.md | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) diff --git a/copilot/README.md b/copilot/README.md index 870cca956..4fb3180d4 100644 --- a/copilot/README.md +++ b/copilot/README.md @@ -76,6 +76,25 @@ It should end with a line like the following and not print any error messages: ghci> ghci> Leaving GHCi. ``` +### Fedora 40 + +On Fedora 40 or newer, Copilot can be installed directly from the package +repositories with: + +```sh +$ sudo dnf install ghc-copilot-devel +``` + +To test that Copilot is available, execute the following: +```sh +$ ghci <<< 'import Language.Copilot' +``` + +It should end with a line like the following and not print any error messages: +```sh +ghci> ghci> Leaving GHCi. +``` + ### Other Linux distributions On other Linux distributions or older Debian-based distributions, to use From ff796834052bba925bbc968454ab2d0f03d0f347 Mon Sep 17 00:00:00 2001 From: Frank Dedden Date: Tue, 22 Oct 2024 12:28:44 +0200 Subject: [PATCH 0841/1222] copilot: Document changes in CHANGELOG. Refs #542. --- copilot/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot/CHANGELOG b/copilot/CHANGELOG index 72808ad85..6d7fb9472 100644 --- a/copilot/CHANGELOG +++ b/copilot/CHANGELOG @@ -1,9 +1,10 @@ -2024-10-19 +2024-10-22 * Update contribution guidelines. (#476) * Update README with missing publications. (#544) * Make the what4-propositional example's comments match results. (#535) * Add example describing how to implement updateField. (#525) * Standardize changelog format. (#550) + * Add installation instructions for Fedora 40 and up. (#542) 2024-09-07 * Version bump (4.0). (#532) From 7de5f4a0734749e84f128ecbe134856495d4248b Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 28 Oct 2024 20:07:52 +0000 Subject: [PATCH 0842/1222] copilot-core: Deprecate Copilot.Core.Type.UType.uTypeType. Refs #484. The record field uTypeType, part of Copilot.Core.Type.UType, is never really used within the same module or in any other part of Copilot or, as far as we know, by any user of Copilot. Also, we cannot use it to obtain the value inside the UType due to it being an existential type. It also makes the test report lower coverage than they otherwise might be, since the record access function is not and cannot be used by the tests. This field is not a necessary part of Copilot's interface, and not required by Copilot's requirements. Therefore, it would be suitable to remove it from the module. This commit deprecates the field uTypeType, so that it can be removed in a future version of Copilot. --- copilot-core/src/Copilot/Core/Type.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/copilot-core/src/Copilot/Core/Type.hs b/copilot-core/src/Copilot/Core/Type.hs index 9e5bfddbc..b31a35094 100644 --- a/copilot-core/src/Copilot/Core/Type.hs +++ b/copilot-core/src/Copilot/Core/Type.hs @@ -268,6 +268,7 @@ instance (Typeable t, Typed t, KnownNat n) => Typed (Array n t) where -- | A untyped type (no phantom type). data UType = forall a . Typeable a => UType { uTypeType :: Type a } +{-# DEPRECATED uTypeType "This field is deprecated in Copilot 4.1. Use pattern matching instead." #-} instance Eq UType where UType ty1 == UType ty2 = typeRep ty1 == typeRep ty2 From 2a476637e44df5b1c125fa5c270c300479e0df72 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 28 Oct 2024 20:10:01 +0000 Subject: [PATCH 0843/1222] copilot-core: Document changes in CHANGELOG. Refs #484. --- copilot-core/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot-core/CHANGELOG b/copilot-core/CHANGELOG index d93518477..867d513c8 100644 --- a/copilot-core/CHANGELOG +++ b/copilot-core/CHANGELOG @@ -1,6 +1,7 @@ -2024-10-19 +2024-10-28 * Add Haddocks for updateField. (#525) * Standardize changelog format. (#550) + * Deprecate Copilot.Core.Type.UType.uTypeType. (#484) 2024-09-07 * Version bump (4.0). (#532) From fb38f274ff54c0cf3da9d72ecde10068cc121384 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 8 Nov 2024 09:02:17 +0000 Subject: [PATCH 0844/1222] Bump versions and constraints. Refs #561. --- copilot-c99/copilot-c99.cabal | 4 ++-- copilot-core/copilot-core.cabal | 2 +- copilot-interpreter/copilot-interpreter.cabal | 4 ++-- copilot-language/copilot-language.cabal | 8 ++++---- copilot-libraries/copilot-libraries.cabal | 4 ++-- copilot-prettyprinter/copilot-prettyprinter.cabal | 4 ++-- copilot-theorem/copilot-theorem.cabal | 6 +++--- copilot/copilot.cabal | 14 +++++++------- 8 files changed, 23 insertions(+), 23 deletions(-) diff --git a/copilot-c99/copilot-c99.cabal b/copilot-c99/copilot-c99.cabal index 2acefad8c..f6a196b81 100644 --- a/copilot-c99/copilot-c99.cabal +++ b/copilot-c99/copilot-c99.cabal @@ -1,6 +1,6 @@ cabal-version : >= 1.10 name : copilot-c99 -version : 4.0 +version : 4.1 synopsis : A compiler for Copilot targeting C99. description : This package is a back-end from Copilot to C. @@ -45,7 +45,7 @@ library , mtl >= 2.2 && < 2.4 , pretty >= 1.1 && < 1.2 - , copilot-core >= 4.0 && < 4.1 + , copilot-core >= 4.1 && < 4.2 , language-c99 >= 0.2.0 && < 0.3 , language-c99-simple >= 0.3 && < 0.4 diff --git a/copilot-core/copilot-core.cabal b/copilot-core/copilot-core.cabal index 500c97df8..232145325 100644 --- a/copilot-core/copilot-core.cabal +++ b/copilot-core/copilot-core.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-core -version: 4.0 +version: 4.1 synopsis: An intermediate representation for Copilot. description: Intermediate representation for Copilot. diff --git a/copilot-interpreter/copilot-interpreter.cabal b/copilot-interpreter/copilot-interpreter.cabal index 9ad90e75e..87e668aad 100644 --- a/copilot-interpreter/copilot-interpreter.cabal +++ b/copilot-interpreter/copilot-interpreter.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-interpreter -version: 4.0 +version: 4.1 synopsis: Interpreter for Copilot. description: Interpreter for Copilot. @@ -44,7 +44,7 @@ library base >= 4.9 && < 5, pretty >= 1.0 && < 1.2, - copilot-core >= 4.0 && < 4.1 + copilot-core >= 4.1 && < 4.2 exposed-modules: diff --git a/copilot-language/copilot-language.cabal b/copilot-language/copilot-language.cabal index a9b79547f..ad0ec0725 100644 --- a/copilot-language/copilot-language.cabal +++ b/copilot-language/copilot-language.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-language -version: 4.0 +version: 4.1 synopsis: A Haskell-embedded DSL for monitoring hard real-time distributed systems. description: @@ -42,9 +42,9 @@ library , data-reify >= 0.6 && < 0.7 , mtl >= 2.0 && < 3 - , copilot-core >= 4.0 && < 4.1 - , copilot-interpreter >= 4.0 && < 4.1 - , copilot-theorem >= 4.0 && < 4.1 + , copilot-core >= 4.1 && < 4.2 + , copilot-interpreter >= 4.1 && < 4.2 + , copilot-theorem >= 4.1 && < 4.2 exposed-modules: Copilot.Language , Copilot.Language.Operators.BitWise diff --git a/copilot-libraries/copilot-libraries.cabal b/copilot-libraries/copilot-libraries.cabal index 741a4cc8e..fc312c91d 100644 --- a/copilot-libraries/copilot-libraries.cabal +++ b/copilot-libraries/copilot-libraries.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-libraries -version: 4.0 +version: 4.1 synopsis: Libraries for the Copilot language. description: Libraries for the Copilot language. @@ -41,7 +41,7 @@ library , containers >= 0.4 && < 0.7 , mtl >= 2.0 && < 2.4 , parsec >= 2.0 && < 3.2 - , copilot-language >= 4.0 && < 4.1 + , copilot-language >= 4.1 && < 4.2 exposed-modules: Copilot.Library.Libraries diff --git a/copilot-prettyprinter/copilot-prettyprinter.cabal b/copilot-prettyprinter/copilot-prettyprinter.cabal index 73746675a..3d3371335 100644 --- a/copilot-prettyprinter/copilot-prettyprinter.cabal +++ b/copilot-prettyprinter/copilot-prettyprinter.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-prettyprinter -version: 4.0 +version: 4.1 synopsis: A prettyprinter of Copilot Specifications. description: A prettyprinter of Copilot specifications. @@ -45,7 +45,7 @@ library base >= 4.9 && < 5, pretty >= 1.0 && < 1.2, - copilot-core >= 4.0 && < 4.1 + copilot-core >= 4.1 && < 4.2 exposed-modules: diff --git a/copilot-theorem/copilot-theorem.cabal b/copilot-theorem/copilot-theorem.cabal index 46416e9ee..9d7dd0fda 100644 --- a/copilot-theorem/copilot-theorem.cabal +++ b/copilot-theorem/copilot-theorem.cabal @@ -14,7 +14,7 @@ description: . -version : 4.0 +version : 4.1 license : BSD3 license-file : LICENSE maintainer : Ivan Perez @@ -63,8 +63,8 @@ library , xml >= 1.3 && < 1.4 , what4 >= 1.3 && < 1.7 - , copilot-core >= 4.0 && < 4.1 - , copilot-prettyprinter >= 4.0 && < 4.1 + , copilot-core >= 4.1 && < 4.2 + , copilot-prettyprinter >= 4.1 && < 4.2 exposed-modules : Copilot.Theorem , Copilot.Theorem.Prove diff --git a/copilot/copilot.cabal b/copilot/copilot.cabal index 467ae50c9..c8383ae9a 100644 --- a/copilot/copilot.cabal +++ b/copilot/copilot.cabal @@ -1,5 +1,5 @@ name: copilot -version: 4.0 +version: 4.1 cabal-version: >= 1.10 license: BSD3 license-file: LICENSE @@ -52,12 +52,12 @@ library , directory >= 1.3 && < 1.4 , filepath >= 1.4 && < 1.5 - , copilot-core >= 4.0 && < 4.1 - , copilot-theorem >= 4.0 && < 4.1 - , copilot-language >= 4.0 && < 4.1 - , copilot-libraries >= 4.0 && < 4.1 - , copilot-c99 >= 4.0 && < 4.1 - , copilot-prettyprinter >= 4.0 && < 4.1 + , copilot-core >= 4.1 && < 4.2 + , copilot-theorem >= 4.1 && < 4.2 + , copilot-language >= 4.1 && < 4.2 + , copilot-libraries >= 4.1 && < 4.2 + , copilot-c99 >= 4.1 && < 4.2 + , copilot-prettyprinter >= 4.1 && < 4.2 exposed-modules: Language.Copilot, Language.Copilot.Main From 22aec9c96c9a9a0fadc216daa8d88df760397dd4 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 8 Nov 2024 09:06:11 +0000 Subject: [PATCH 0845/1222] Document changes in CHANGELOG. Refs #561. --- copilot-c99/CHANGELOG | 3 ++- copilot-core/CHANGELOG | 3 ++- copilot-interpreter/CHANGELOG | 3 +++ copilot-language/CHANGELOG | 3 ++- copilot-libraries/CHANGELOG | 3 ++- copilot-prettyprinter/CHANGELOG | 3 +++ copilot-theorem/CHANGELOG | 3 ++- copilot/CHANGELOG | 3 ++- 8 files changed, 18 insertions(+), 6 deletions(-) diff --git a/copilot-c99/CHANGELOG b/copilot-c99/CHANGELOG index f8dd97230..1c045c218 100644 --- a/copilot-c99/CHANGELOG +++ b/copilot-c99/CHANGELOG @@ -1,4 +1,5 @@ -2024-10-19 +2024-11-07 + * Version bump (4.1). (#561) * Standardize changelog format. (#550) 2024-09-07 diff --git a/copilot-core/CHANGELOG b/copilot-core/CHANGELOG index 867d513c8..7ca104937 100644 --- a/copilot-core/CHANGELOG +++ b/copilot-core/CHANGELOG @@ -1,4 +1,5 @@ -2024-10-28 +2024-11-07 + * Version bump (4.1). (#561) * Add Haddocks for updateField. (#525) * Standardize changelog format. (#550) * Deprecate Copilot.Core.Type.UType.uTypeType. (#484) diff --git a/copilot-interpreter/CHANGELOG b/copilot-interpreter/CHANGELOG index 5cb1ad93c..bd2aadc09 100644 --- a/copilot-interpreter/CHANGELOG +++ b/copilot-interpreter/CHANGELOG @@ -1,3 +1,6 @@ +2024-11-07 + * Version bump (4.1). (#561) + 2024-09-07 * Version bump (4.0). (#532) * Add support for array updates. (#36) diff --git a/copilot-language/CHANGELOG b/copilot-language/CHANGELOG index 0712d4cc6..1d205da0e 100644 --- a/copilot-language/CHANGELOG +++ b/copilot-language/CHANGELOG @@ -1,4 +1,5 @@ -2024-10-19 +2024-11-07 + * Version bump (4.1). (#561) * Reject duplicate externs in properties and theorems. (#536) * Standardize changelog format. (#550) diff --git a/copilot-libraries/CHANGELOG b/copilot-libraries/CHANGELOG index 6c045c332..c4ce6ddcf 100644 --- a/copilot-libraries/CHANGELOG +++ b/copilot-libraries/CHANGELOG @@ -1,4 +1,5 @@ -2024-10-19 +2024-11-07 + * Version bump (4.1). (#561) * Standardize changelog format. (#550) 2024-09-07 diff --git a/copilot-prettyprinter/CHANGELOG b/copilot-prettyprinter/CHANGELOG index e5409a927..ba157f37b 100644 --- a/copilot-prettyprinter/CHANGELOG +++ b/copilot-prettyprinter/CHANGELOG @@ -1,3 +1,6 @@ +2024-11-07 + * Version bump (4.1). (#561) + 2024-09-07 * Version bump (4.0). (#532) * Add support for pretty-printing struct update expressions. (#526) diff --git a/copilot-theorem/CHANGELOG b/copilot-theorem/CHANGELOG index 67dabaacd..09c28ca7e 100644 --- a/copilot-theorem/CHANGELOG +++ b/copilot-theorem/CHANGELOG @@ -1,4 +1,5 @@ -2024-10-19 +2024-11-07 + * Version bump (4.1). (#561) * Standardize changelog format. (#550) 2024-09-07 diff --git a/copilot/CHANGELOG b/copilot/CHANGELOG index 6d7fb9472..ce4a1c37a 100644 --- a/copilot/CHANGELOG +++ b/copilot/CHANGELOG @@ -1,4 +1,5 @@ -2024-10-22 +2024-11-07 + * Version bump (4.1). (#561) * Update contribution guidelines. (#476) * Update README with missing publications. (#544) * Make the what4-propositional example's comments match results. (#535) From 8ec934906599c19591c4c010b87b15964baa73ad Mon Sep 17 00:00:00 2001 From: kaBeech Date: Thu, 14 Nov 2024 17:58:44 -0800 Subject: [PATCH 0846/1222] copilot-c99: Remove uses of Copilot.Core.Expr.UExpr.uExprType. Refs #565. The record fields uExprType and uExprExpr, part of Copilot.Core.Expr.UExpr, are never really used within the module and only rarely used elsewhere in Copilot or, as far as we know, by any user of Copilot. As a matter of fact, we cannot use them to obtain the value inside the UExpr due to the existential it encloses. These fields are not necessary parts of the interface to use Copilot, and not required by Copilot's requirements. Therefore, it would be suitable to remove that definitions from the module. This commit removes any uses of uExprType and uExprExpr in copilot-c99 and uses positional arguments instead. --- copilot-c99/src/Copilot/Compile/C99/CodeGen.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs b/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs index 3f9693438..e71e7a0df 100644 --- a/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs +++ b/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs @@ -279,7 +279,7 @@ mkStep cSettings streams triggers exts = 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 @@ -301,7 +301,7 @@ mkStep cSettings streams triggers exts = 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] @@ -314,7 +314,7 @@ mkStep cSettings streams triggers exts = -- 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 From ec7899a3867dda2c52acca0d90bcac231d2e1fe2 Mon Sep 17 00:00:00 2001 From: kaBeech Date: Thu, 14 Nov 2024 18:20:55 -0800 Subject: [PATCH 0847/1222] copilot-prettyprinter: Remove uses of Copilot.Core.Expr.UExpr.uExprExpr. Refs #565. The record fields uExprType and uExprExpr, part of Copilot.Core.Expr.UExpr, are never really used within the module and only rarely used elsewhere in Copilot or, as far as we know, by any user of Copilot. As a matter of fact, we cannot use them to obtain the value inside the UExpr due to the existential it encloses. These fields are not necessary parts of the interface to use Copilot, and not required by Copilot's requirements. Therefore, it would be suitable to remove that definitions from the module. This commit removes any uses of uExprExpr in copilot-prettyprinter and uses positional arguments instead. --- copilot-prettyprinter/src/Copilot/PrettyPrint.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot-prettyprinter/src/Copilot/PrettyPrint.hs b/copilot-prettyprinter/src/Copilot/PrettyPrint.hs index 64ca9c90a..50be4466f 100644 --- a/copilot-prettyprinter/src/Copilot/PrettyPrint.hs +++ b/copilot-prettyprinter/src/Copilot/PrettyPrint.hs @@ -43,7 +43,7 @@ ppExpr e0 = case e0 of -- -- The type is ignored, and only the expression is pretty-printed. ppUExpr :: UExpr -> Doc -ppUExpr UExpr { uExprExpr = e0 } = ppExpr e0 +ppUExpr (UExpr _ e0) = ppExpr e0 -- | Pretty-print a unary operation. ppOp1 :: Op1 a b -> Doc -> Doc From 8852cc365e25d8dcad39ec287d4d29906cb598be Mon Sep 17 00:00:00 2001 From: kaBeech Date: Thu, 14 Nov 2024 18:32:27 -0800 Subject: [PATCH 0848/1222] copilot-theorem: Remove uses of Copilot.Core.Expr.UExpr.uExprType,uExprExpr. Refs #565. The record fields uExprType and uExprExpr, part of Copilot.Core.Expr.UExpr, are never really used within the module and only rarely used elsewhere in Copilot or, as far as we know, by any user of Copilot. As a matter of fact, we cannot use them to obtain the value inside the UExpr due to the existential it encloses. These fields are not necessary parts of the interface to use Copilot, and not required by Copilot's requirements. Therefore, it would be suitable to remove that definitions from the module. This commit removes any uses of uExprType and uExprExpr in copilot-theorem and uses positional arguments instead. --- copilot-theorem/src/Copilot/Theorem/What4.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot-theorem/src/Copilot/Theorem/What4.hs b/copilot-theorem/src/Copilot/Theorem/What4.hs index 6971ae673..960df8d93 100644 --- a/copilot-theorem/src/Copilot/Theorem/What4.hs +++ b/copilot-theorem/src/Copilot/Theorem/What4.hs @@ -324,7 +324,7 @@ computeTriggerState sym spec = forM (CS.specTriggers spec) $ args' <- mapM computeArg args return (nm, guard', args') where - computeArg (CE.UExpr { CE.uExprType = tp, CE.uExprExpr = ex }) = do + computeArg (CE.UExpr tp ex) = do v <- translateExpr sym mempty ex (RelativeOffset 0) return (Some tp, v) From af61c373a1a20a8ad29cedb097d9123cd7ea4ca8 Mon Sep 17 00:00:00 2001 From: kaBeech Date: Thu, 14 Nov 2024 18:38:34 -0800 Subject: [PATCH 0849/1222] copilot-core: Deprecate fields of Copilot.Core.Expr.UExpr. Refs #565. The record fields uExprType and uExprExpr, part of Copilot.Core.Expr.UExpr, are never really used within the module and only rarely used elsewhere in Copilot or, as far as we know, by any user of Copilot. As a matter of fact, we cannot use them to obtain the value inside the UExpr due to the existential it encloses. These fields are not necessary parts of the interface to use Copilot, and not required by Copilot's requirements. Therefore, it would be suitable to remove that definitions from the module. This commit deprecates the fields uExprType and uExprExpr, so that they can be removed in a future version of Copilot. --- copilot-core/src/Copilot/Core/Expr.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/copilot-core/src/Copilot/Core/Expr.hs b/copilot-core/src/Copilot/Core/Expr.hs index 618b18fab..277e919d1 100644 --- a/copilot-core/src/Copilot/Core/Expr.hs +++ b/copilot-core/src/Copilot/Core/Expr.hs @@ -71,3 +71,4 @@ data UExpr = forall a . Typeable a => UExpr { uExprType :: Type a , uExprExpr :: Expr a } +{-# DEPRECATED uExprType, uExprExpr "These fields are deprecated in Copilot 4.2. Use pattern matching instead." #-} From 41fa1d2aef42a1abbb18ff578790ad843822e1e3 Mon Sep 17 00:00:00 2001 From: kaBeech Date: Thu, 14 Nov 2024 18:44:54 -0800 Subject: [PATCH 0850/1222] copilot-c99: Document changes in CHANGELOG. Refs #565. --- copilot-c99/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-c99/CHANGELOG b/copilot-c99/CHANGELOG index 1c045c218..50c704f20 100644 --- a/copilot-c99/CHANGELOG +++ b/copilot-c99/CHANGELOG @@ -1,3 +1,6 @@ +2024-11-14 + * Remove uses of Copilot.Core.Expr.UExpr.uExprType. (#565) + 2024-11-07 * Version bump (4.1). (#561) * Standardize changelog format. (#550) From 0bbaac5ab53f39b436d492061ee74e51871a6ca4 Mon Sep 17 00:00:00 2001 From: kaBeech Date: Thu, 14 Nov 2024 18:49:12 -0800 Subject: [PATCH 0851/1222] copilot-prettyprinter: Document changes in CHANGELOG. Refs #565. --- copilot-prettyprinter/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-prettyprinter/CHANGELOG b/copilot-prettyprinter/CHANGELOG index ba157f37b..6ea452f0e 100644 --- a/copilot-prettyprinter/CHANGELOG +++ b/copilot-prettyprinter/CHANGELOG @@ -1,3 +1,6 @@ +2024-11-15 + * Remove uses of Copilot.Core.Expr.UExpr.uExprExpr. (#565) + 2024-11-07 * Version bump (4.1). (#561) From 0cdc163bca7447b416f18830e43d3a62ffea10b3 Mon Sep 17 00:00:00 2001 From: kaBeech Date: Thu, 14 Nov 2024 18:51:04 -0800 Subject: [PATCH 0852/1222] copilot-theorem: Document changes in CHANGELOG. Refs #565. --- copilot-theorem/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-theorem/CHANGELOG b/copilot-theorem/CHANGELOG index 09c28ca7e..7508a978d 100644 --- a/copilot-theorem/CHANGELOG +++ b/copilot-theorem/CHANGELOG @@ -1,3 +1,6 @@ +2024-11-15 + * Remove uses of Copilot.Core.Expr.UExpr.uExprType,uExprExpr. (#565) + 2024-11-07 * Version bump (4.1). (#561) * Standardize changelog format. (#550) From 4d8431d77632f4ed91cdab97bcc80f7331ce09cd Mon Sep 17 00:00:00 2001 From: kaBeech Date: Thu, 14 Nov 2024 18:52:31 -0800 Subject: [PATCH 0853/1222] copilot-core: Document changes in CHANGELOG. Refs #565. --- copilot-core/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-core/CHANGELOG b/copilot-core/CHANGELOG index 7ca104937..3770ee808 100644 --- a/copilot-core/CHANGELOG +++ b/copilot-core/CHANGELOG @@ -1,3 +1,6 @@ +2024-11-15 + * Deprecate fields of Copilot.Core.Expr.UExpr. (#565) + 2024-11-07 * Version bump (4.1). (#561) * Add Haddocks for updateField. (#525) From 233b5dbbf4c9f14e1a3c082a99a5fbfcf7aae2da Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Wed, 23 Oct 2024 17:55:45 +0000 Subject: [PATCH 0854/1222] copilot-core: Increase test coverage of Copilot.Core.Type. Refs #555. The test coverage of copilot-core is currently reported at 75% by Hackage. Although there are exceptions to what we can test (record fields of existential types) or should test (proxies, automatically generated constructors and accessor functions), the coverage of our tests should include very top level definition and expression that can be tested without having to modify the implementation of copilot-core itself. This commit increases the test coverage for Copilot.Core.Type by introducing new tests involving structs and arrays. Some of these are hard coded, contrary to the idea of using randomized testing to carry out the tests, because the use of dependent types limits how much can be generated at runtime without substantial and complex testing infrastructure. Proxies are still reported as untested, since doing so would require modifying the code of Copilot itself to introduce strictness. The same applies to functions that do not use some of their arguments (often involving dependent types). --- copilot-core/tests/Test/Copilot/Core/Type.hs | 164 ++++++++++++++++--- 1 file changed, 138 insertions(+), 26 deletions(-) diff --git a/copilot-core/tests/Test/Copilot/Core/Type.hs b/copilot-core/tests/Test/Copilot/Core/Type.hs index 602dfa08a..9f9cb6d5e 100644 --- a/copilot-core/tests/Test/Copilot/Core/Type.hs +++ b/copilot-core/tests/Test/Copilot/Core/Type.hs @@ -1,12 +1,19 @@ -{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} -- | Test copilot-core:Copilot.Core.Type. module Test.Copilot.Core.Type where -- External imports import Data.Int (Int16, Int32, Int64, Int8) import Data.Maybe (isJust) -import Data.Type.Equality (testEquality) +import Data.Proxy (Proxy (..)) +import Data.Type.Equality (TestEquality (..), testEquality, + (:~:) (..)) import Data.Word (Word16, Word32, Word64, Word8) +import GHC.TypeLits (sameSymbol) +import Prelude as P import Test.Framework (Test, testGroup) import Test.Framework.Providers.QuickCheck2 (testProperty) import Test.QuickCheck (Gen, Property, arbitrary, elements, @@ -50,6 +57,8 @@ tests = testUTypesInequality , testProperty "inequality of utype via typeOf" testUTypesTypeOfInequality + , testProperty "inequality of different types" + testTypesInequality , testProperty "fieldName matches field name (positive)" testFieldNameOk , testProperty "fieldName matches field name (negative)" @@ -58,6 +67,10 @@ tests = testShowField , testProperty "Show struct" testShowStruct + , testProperty "Update struct" + testUpdateStruct + , testProperty "Update struct" + testUpdateStructFail , testProperty "accessorName matches field name (positive)" testAccessorNameOk , testProperty "accessorName matches field name (negative)" @@ -96,7 +109,7 @@ testSimpleTypesInequality = forAllBlind twoDiffTypes $ \(t1, t2) -> , simpleType Float , simpleType Double , simpleType (Array Int8 :: Type (Array 3 Int8)) - , simpleType (Struct (S (Field 0))) + , simpleType (Struct (S (Field 0) (Field 0))) ] -- | Test that the equality relation for simple types is reflexive. @@ -177,12 +190,12 @@ testTypeSize2 = property $ typeSize a == 36 -- | Test that equality is symmetric for UTypes via testEquality. testUTypesEqualitySymmetric :: Property testUTypesEqualitySymmetric = - forAllBlind (elements utypes) $ \(UType t1) -> isJust (testEquality t1 t1) + forAllBlind (elements utypes) $ \(UType t1) -> testEquality t1 t1 == Just Refl -- | Test that testEquality implies equality for UTypes. testUTypesEq :: Property testUTypesEq = - forAllBlind (elements utypes) $ \t@(UType t1) -> isJust (testEquality t1 t1) ==> t == t + forAllBlind (elements utypes) $ \t@(UType t1) -> (testEquality t1 t1 == Just Refl) ==> t == t -- | Test that any two different UTypes are not equal. -- @@ -199,6 +212,21 @@ testUTypesInequality = forAllBlind twoDiffTypes $ \(t1, t2) -> (t1:t2:_) -> return (t1, t2) _ -> return (UType Bool, UType Bool) +-- | Test that any two different Types are not equal. +-- +-- This function pre-selects two Types from a list of different UTypes, which +-- guarantees that they will be different. +testTypesInequality :: Property +testTypesInequality = forAllBlind twoDiffTypes $ \(UType t1, UType t2) -> + testEquality t1 t2 == Nothing + where + twoDiffTypes :: Gen (UType, UType) + twoDiffTypes = do + shuffled <- shuffle utypes + case shuffled of + (t1:t2:_) -> return (t1, t2) + _ -> return (UType Bool, UType Bool) + -- | Different UTypes. utypes :: [UType] utypes = @@ -213,19 +241,43 @@ utypes = , UType Word64 , UType Float , UType Double - , UType a - , UType b + , UType a1 + , UType a2 + , UType a3 + , UType a4 + , UType b1 + , UType b2 + , UType b3 + , UType b4 , UType c ] where - a :: Type (Array 3 Int8) - a = Array Int8 + a1 :: Type (Array 3 Int8) + a1 = Array Int8 + + a2 :: Type (Array 4 Int8) + a2 = Array Int8 + + a3 :: Type (Array 5 Int8) + a3 = Array Int8 + + a4 :: Type (Array 6 Int8) + a4 = Array Int8 - b :: Type (Array 4 Int8) - b = Array Int8 + b1 :: Type (Array 3 Int16) + b1 = Array Int16 + + b2 :: Type (Array 4 Int16) + b2 = Array Int16 + + b3 :: Type (Array 5 Int16) + b3 = Array Int16 + + b4 :: Type (Array 6 Int16) + b4 = Array Int16 c :: Type S - c = Struct (S (Field 0)) + c = Struct (S (Field 0) (Field 0)) -- | Test that any two different UTypes are not equal. -- @@ -259,47 +311,86 @@ uTypesTypeOf = , UType (typeOf :: Type Float) , UType (typeOf :: Type Double) , UType (typeOf :: Type (Array 3 Int8)) + , UType (typeOf :: Type (Array 3 Int16)) + , UType (typeOf :: Type (Array 3 Int32)) + , UType (typeOf :: Type (Array 3 Int64)) + , UType (typeOf :: Type (Array 3 Word8)) + , UType (typeOf :: Type (Array 3 Word16)) + , UType (typeOf :: Type (Array 3 Word32)) + , UType (typeOf :: Type (Array 3 Word64)) + , UType (typeOf :: Type (Array 3 Double)) + , UType (typeOf :: Type (Array 3 Float)) , UType (typeOf :: Type S) ] -- | Test the fieldName function (should succeed). testFieldNameOk :: Property -testFieldNameOk = forAll arbitrary $ \k -> - fieldName (s1 (S (Field k))) == s1FieldName +testFieldNameOk = forAll arbitrary $ \k1 -> + forAll arbitrary $ \k2 -> + fieldName (s1 (S (Field k1) (Field k2))) == s1FieldName where - s1FieldName = "field" + s1FieldName = "field1" -- | Test the fieldName function (should fail). testFieldNameFail :: Property testFieldNameFail = expectFailure $ property $ fieldName (s1 sampleS) == s1FieldName where - sampleS = S (Field 0) + sampleS = S (Field 0) (Field 0) s1FieldName = "Field" -- | Test showing a field of a struct. testShowField :: Property testShowField = forAll arbitrary $ \k -> - show (s1 (S (Field k))) == ("field:" ++ show k) + show (s1 (S (Field k) (Field 0))) == ("field1:" ++ show k) -- | Test showing a struct. testShowStruct :: Property -testShowStruct = forAll arbitrary $ \k -> - show (S (Field k)) == "" +testShowStruct = forAll arbitrary $ \k1 -> + forAll arbitrary $ \k2 -> + show (S (Field k1) (Field k2)) == "" + +-- | Test showing a struct. +testUpdateStruct :: Property +testUpdateStruct = + forAll arbitrary $ \k1 -> + forAll arbitrary $ \k2 -> + let f :: Field "field1" Int8 + f = Field k2 + v :: Value Int8 + v = Value Int8 f + in unField (s1 (updateField (S (Field k1) (Field 0)) v)) == k2 + + where + unField (Field x) = x + +-- | Test showing a struct. +testUpdateStructFail :: Property +testUpdateStructFail = expectFailure $ + forAll arbitrary $ \k1 -> + forAll arbitrary $ \k3 -> + let f :: Field "field" Int8 + f = Field k3 + v :: Value Int8 + v = Value Int8 f + in unField (s3 (updateField (S3 (Field k1)) v)) == k3 + + where + unField (Field x) = x -- | Test the accessorName of a field of a struct (should succeed). testAccessorNameOk :: Property testAccessorNameOk = property $ accessorName s1 == s1FieldName where - s1FieldName = "field" + s1FieldName = "field1" -- | Test the accessorName of a field of a struct (should fail). testAccessorNameFail :: Property testAccessorNameFail = expectFailure $ property $ accessorName s1 == s1FieldName where - s1FieldName = "Field" + s1FieldName = "Field1" -- | Test the typeName of a struct (should succeed). testTypeNameOk :: Property @@ -309,7 +400,7 @@ testTypeNameOk = property $ where sampleS :: S - sampleS = S (Field 0) + sampleS = S (Field 0) (Field 0) s1TypeName :: String s1TypeName = "S" @@ -322,18 +413,39 @@ testTypeNameFail = expectFailure $ property $ where sampleS :: S - sampleS = S (Field 0) + sampleS = S (Field 0) (Field 0) s1TypeName :: String s1TypeName = "s" -- | Auxiliary struct defined for testing purposes. -data S = S { s1 :: Field "field" Int8 } +data S = S { s1 :: Field "field1" Int8, s2 :: Field "field2" Word8 } instance Struct S where typeName _ = "S" - toValues s = [ Value Int8 (s1 s) ] + toValues s = [ Value Int8 (s1 s), Value Word8 (s2 s) ] + + updateField s (Value fieldTy (field :: Field fieldName a)) + | Just Refl <- sameSymbol (Proxy @"field1") (Proxy @fieldName) + , Just Refl <- testEquality Int8 fieldTy + = s { s1 = field } + | Just Refl <- sameSymbol (Proxy @"field2") (Proxy @fieldName) + , Just Refl <- testEquality Word8 fieldTy + = s { s2 = field } + | otherwise + = error $ "Unexpected field: " P.++ show field instance Typed S where - typeOf = Struct (S (Field 0)) + typeOf = Struct (S (Field 0) (Field 0)) + +-- | Auxiliary struct defined for testing purposes. +data S3 = S3 { s3 :: Field "field" Int8 } + +instance Struct S3 where + typeName _ = "S3" + + toValues s = [ Value Int8 (s3 s) ] + +instance Typed S3 where + typeOf = Struct (S3 (Field 0)) From 07ff3f72d7e19785b3c24db326d656e91297ea07 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 17 Sep 2024 05:13:18 +0000 Subject: [PATCH 0855/1222] copilot-core: Increase test coverage of Copilot.Core.Type.Array. Refs #555. The test coverage of copilot-core is currently reported at 75% by Hackage. Although there are exceptions to what we can test (record fields of existential types) or should test (proxies, automatically generated constructors and accessor functions), the coverage of our tests should include very top level definition and expression that can be tested without having to modify the implementation of copilot-core itself. This commit increases the test coverage for Copilot.Core.Type.Array by introducing new tests for elements in the interface not previously tested. Proxies are still reported as untested, since doing so would require modifying the code of Copilot itself to introduce strictness. --- .../tests/Test/Copilot/Core/Type/Array.hs | 130 +++++++++++++++++- 1 file changed, 127 insertions(+), 3 deletions(-) diff --git a/copilot-core/tests/Test/Copilot/Core/Type/Array.hs b/copilot-core/tests/Test/Copilot/Core/Type/Array.hs index 208fe2fc5..e070f138b 100644 --- a/copilot-core/tests/Test/Copilot/Core/Type/Array.hs +++ b/copilot-core/tests/Test/Copilot/Core/Type/Array.hs @@ -10,11 +10,12 @@ import GHC.TypeNats (KnownNat, natVal) import Test.Framework (Test, testGroup) import Test.Framework.Providers.QuickCheck2 (testProperty) import Test.QuickCheck (Gen, Property, arbitrary, - expectFailure, forAll, property, - vector, vectorOf) + chooseInt, expectFailure, forAll, + getNegative, getNonNegative, oneof, + property, vector, vectorOf) -- Internal imports: library modules being tested -import Copilot.Core.Type.Array (Array, array, arrayElems) +import Copilot.Core.Type.Array (Array, array, arrayElems, arrayUpdate) -- | All unit tests for copilot-core:Copilot.Core.Array. tests :: Test.Framework.Test @@ -30,6 +31,14 @@ tests = testArrayElemsFail , testProperty "Show for arrays" testShowArray + , testProperty "arrayElems (arrayUpdate x i v) !! i == v" + (testArrayUpdateElem (Proxy :: Proxy 5)) + , testProperty "arrayUpdate x i ((arrayElems x) !! i) == x" + (testArrayUpdateElems (Proxy :: Proxy 5)) + , testProperty "arrayUpdate fails if out of range of array" + (testArrayUpdateWrong (Proxy :: Proxy 5)) + , testProperty "array fails length is wrong" + (testArrayMakeWrongLength (Proxy :: Proxy 5)) ] -- * Individual tests @@ -60,3 +69,118 @@ testArrayElemsFail = expectFailure $ forAll (vector 3) $ \l -> testShowArray :: Property testShowArray = forAll (vector 3) $ \l -> property $ show (array l :: Array 3 Int64) == show (l :: [Int64]) + +-- | Test that updating an array updates the element appropriately (if we +-- project that element we get the value we put in). +testArrayUpdateElem :: forall n . KnownNat n => Proxy n -> Property +testArrayUpdateElem len = + forAll xsInt64 $ \ls -> + forAll position $ \p -> + forAll xInt64 $ \v -> + let -- Original array + array' :: Array n Int64 + array' = array ls + + -- Updated array + array'' :: Array n Int64 + array'' = arrayUpdate array' p v + + in arrayElems array'' !! p == v + + where + + -- Generator for lists of Int64 of known length. + xsInt64 :: Gen [Int64] + xsInt64 = vectorOf (fromIntegral (natVal len)) arbitrary + + -- Generator for element of type Int64. + xInt64 :: Gen Int64 + xInt64 = arbitrary + + -- Generator for positions within the list. + position :: Gen Int + position = chooseInt (0, fromIntegral (natVal len) - 1) + +-- | Test that updating an array updates the element appropriately (if we +-- project that element we get the value we put in). +testArrayUpdateWrong :: forall n . KnownNat n => Proxy n -> Property +testArrayUpdateWrong len = + expectFailure $ + forAll xsInt64 $ \ls -> + forAll position $ \p -> + forAll xInt64 $ \v -> + let -- Original array + array' :: Array n Int64 + array' = array ls + + -- Updated array + array'' :: Array n Int64 + array'' = arrayUpdate array' (p + 10) v + + in arrayElems array'' !! p == v + + where + + -- Generator for lists of Int64 of known length. + xsInt64 :: Gen [Int64] + xsInt64 = vectorOf (fromIntegral (natVal len)) arbitrary + + -- Generator for element of type Int64. + xInt64 :: Gen Int64 + xInt64 = arbitrary + + -- Generator for positions within the list. + position :: Gen Int + position = oneof + [ (fromIntegral (natVal len) +) . getNonNegative <$> arbitrary + , getNegative <$> arbitrary + ] + +-- | Test that making an array of a specific length fails if the list of +-- elements supplied doesn't have the same length. +testArrayMakeWrongLength :: forall n . KnownNat n => Proxy n -> Property +testArrayMakeWrongLength len = + expectFailure $ + forAll wrongLength $ \length -> + forAll (xsInt64 length) $ \ls -> + let array' :: Array n Int64 + array' = array ls + in arrayElems array' == ls + where + xsInt64 length = vectorOf length arbitrary + expectedLength = fromIntegral (natVal len) + wrongLength = (expectedLength +) . getNonNegative <$> arbitrary + +-- | Test that updating an array updates the element appropriately (if we +-- project that element we get the value we put in). +testArrayUpdateElems :: forall n . KnownNat n => Proxy n -> Property +testArrayUpdateElems len = + forAll xsInt64 $ \ls -> + forAll position $ \p -> + forAll xInt64 $ \v -> + let -- Original array + array' :: Array n Int64 + array' = array ls + + -- Updated array + e :: Int64 + e = arrayElems array' !! p + + array'' :: Array n Int64 + array'' = arrayUpdate array' p e + + in arrayElems array'' == ls + + where + + -- Generator for lists of Int64 of known length. + xsInt64 :: Gen [Int64] + xsInt64 = vectorOf (fromIntegral (natVal len)) arbitrary + + -- Generator for element of type Int64. + xInt64 :: Gen Int64 + xInt64 = arbitrary + + -- Generator for positions within the list. + position :: Gen Int + position = chooseInt (0, fromIntegral (natVal len) - 1) From 51b058059304b3048faa44e19e6dbfd204c58a42 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 30 Dec 2024 03:37:55 +0000 Subject: [PATCH 0856/1222] copilot-core: Document changes in CHANGELOG. Refs #555. --- copilot-core/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot-core/CHANGELOG b/copilot-core/CHANGELOG index 3770ee808..a642472c4 100644 --- a/copilot-core/CHANGELOG +++ b/copilot-core/CHANGELOG @@ -1,5 +1,6 @@ -2024-11-15 +2024-12-29 * Deprecate fields of Copilot.Core.Expr.UExpr. (#565) + * Increase test coverage. (#555) 2024-11-07 * Version bump (4.1). (#561) From 5ac80921bc95846804006a64699070d7145d0e1a Mon Sep 17 00:00:00 2001 From: Frank Dedden Date: Fri, 20 Dec 2024 08:39:48 +0100 Subject: [PATCH 0857/1222] copilot-c99: Add specific `Trigger` representation. Refs #296. The current implementation of Copilot does not allow using the same trigger handler name multiple times, since the C99 backend produces multiple repeated declarations, which is invalid. Consequently, the code generator assumes that trigger names are unique. To allow for multiple triggers that trigger the same handler, we need to introduce a separate construct in triggers that acts as a unique identifier. This commit introduces an internal datatype to represent a `Trigger` with a unique name that is different from that of the function called when triggered. --- copilot-c99/copilot-c99.cabal | 1 + .../src/Copilot/Compile/C99/Representation.hs | 21 +++++++++++++++++++ 2 files changed, 22 insertions(+) create mode 100644 copilot-c99/src/Copilot/Compile/C99/Representation.hs diff --git a/copilot-c99/copilot-c99.cabal b/copilot-c99/copilot-c99.cabal index f6a196b81..4e441d314 100644 --- a/copilot-c99/copilot-c99.cabal +++ b/copilot-c99/copilot-c99.cabal @@ -59,6 +59,7 @@ library , Copilot.Compile.C99.External , Copilot.Compile.C99.Compile , Copilot.Compile.C99.Settings + , Copilot.Compile.C99.Representation test-suite unit-tests type: diff --git a/copilot-c99/src/Copilot/Compile/C99/Representation.hs b/copilot-c99/src/Copilot/Compile/C99/Representation.hs new file mode 100644 index 000000000..886808a8a --- /dev/null +++ b/copilot-c99/src/Copilot/Compile/C99/Representation.hs @@ -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 From e6356ef260524abbaf5891e2822bcb0ef5d3d3cf Mon Sep 17 00:00:00 2001 From: Frank Dedden Date: Fri, 20 Dec 2024 08:39:48 +0100 Subject: [PATCH 0858/1222] copilot-c99: Adapt `mkStep` to use unique triggers. Refs #296. The current implementation of Copilot does not allow using the same trigger handler name multiple times, since the C99 backend produces multiple repeated declarations, which is invalid. A prior commit has introduced a representation of triggers with unique IDs, allowing us to distinguish between a monitor for one condition within a Copilot spec vs the external C function being called when the condition becomes true. This commit updates the generation of the `step` function to use unique names for the triggers. --- .../src/Copilot/Compile/C99/CodeGen.hs | 33 +++++++++++-------- 1 file changed, 19 insertions(+), 14 deletions(-) diff --git a/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs b/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs index e71e7a0df..ce822e558 100644 --- a/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs +++ b/copilot-c99/src/Copilot/Compile/C99/CodeGen.hs @@ -36,14 +36,17 @@ import Copilot.Core ( Expr (..), Id, Stream (..), Struct (..), Trigger (..), 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 @@ mkGenFunArray _name _nameArg _expr _ty = -- * 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,8 +274,8 @@ mkStep cSettings streams triggers exts = -- 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] @@ -285,12 +288,14 @@ mkStep cSettings streams triggers exts = 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) @@ -305,7 +310,7 @@ mkStep cSettings streams triggers exts = 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. @@ -323,7 +328,7 @@ mkStep cSettings streams triggers exts = _ -> C.Ident aTempName aTempNames :: [String] - aTempNames = take (length args) (argTempNames name) + aTempNames = take (length args) (argTempNames uniqueName) -- * Auxiliary functions From c1f273817e166e134b2e937579d63f327bb72c4d Mon Sep 17 00:00:00 2001 From: Frank Dedden Date: Fri, 20 Dec 2024 08:39:48 +0100 Subject: [PATCH 0859/1222] copilot-c99: Adapt top-level compilation functions to use unique triggers. Refs #296. The current implementation of Copilot does not allow using the same trigger handler name multiple times, since the C99 backend produces multiple repeated declarations, which is invalid. Prior commits have introduced a representation of triggers with unique IDs (allowing us to distinguish between a monitor for one condition within a Copilot spec vs the external C function being called when the condition becomes true), and have adapted low-level functions accordingly. This commit adapts the top-level compilation functions in the same way, by generating trigger guards and argument functions using the unique names. --- .../src/Copilot/Compile/C99/Compile.hs | 47 ++++++++++--------- 1 file changed, 26 insertions(+), 21 deletions(-) diff --git a/copilot-c99/src/Copilot/Compile/C99/Compile.hs b/copilot-c99/src/Copilot/Compile/C99/Compile.hs index 515078258..b7e676a3d 100644 --- a/copilot-c99/src/Copilot/Compile/C99/Compile.hs +++ b/copilot-c99/src/Copilot/Compile/C99/Compile.hs @@ -23,17 +23,21 @@ import Copilot.Core ( Expr (..), Spec (..), Stream (..), Struct (..), 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. -- @@ -90,12 +94,13 @@ compileC cSettings spec = C.TransUnit declns funs 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 +115,7 @@ compileC cSettings spec = C.TransUnit declns funs 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 +127,11 @@ compileC cSettings spec = C.TransUnit declns funs 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) = From 3f866c8bfea320ff43afda403b8e470af0caf9de Mon Sep 17 00:00:00 2001 From: Frank Dedden Date: Fri, 20 Dec 2024 08:39:48 +0100 Subject: [PATCH 0860/1222] copilot-c99: Remove duplicate trigger declarations in .h output. Refs #296. The current implementation of Copilot's C99 backend produces multiple repeated declarations when the same trigger is used multiple times, which is invalid C code. This commit modifies the code that generates the header file to prevent the same trigger from being declared multiple times. --- .../src/Copilot/Compile/C99/Compile.hs | 25 +++++++++++++++++-- 1 file changed, 23 insertions(+), 2 deletions(-) diff --git a/copilot-c99/src/Copilot/Compile/C99/Compile.hs b/copilot-c99/src/Copilot/Compile/C99/Compile.hs index b7e676a3d..7ee083968 100644 --- a/copilot-c99/src/Copilot/Compile/C99/Compile.hs +++ b/copilot-c99/src/Copilot/Compile/C99/Compile.hs @@ -6,8 +6,9 @@ module Copilot.Compile.C99.Compile ) 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 @@ -160,7 +161,9 @@ compileH cSettings spec = C.TransUnit declns [] 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 @@ -261,3 +264,21 @@ gatherExprs streams triggers = map streamUExpr streams 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 From 4cd80053f7a5bec550b11c379c156fb8866fa413 Mon Sep 17 00:00:00 2001 From: Frank Dedden Date: Fri, 20 Dec 2024 08:39:48 +0100 Subject: [PATCH 0861/1222] copilot-c99: Disallow conflicting trigger definitions. Refs #296. The current implementation of Copilot does not allow using the same trigger handler name multiple times, since the C99 backend produces multiple repeated declarations, which is invalid. Prior commits have modified the C99 backend to now allow for multiple triggers with the same handler. However, the resulting code is only valid in C if the triggers always have the same type signatures, since C does not support polymorphism. This commit adds a check to the compilation step to ensure that triggers used multiple times are always used with the same types (and, consequently, the same arity). --- .../src/Copilot/Compile/C99/Compile.hs | 28 ++++++++++++++++++- 1 file changed, 27 insertions(+), 1 deletion(-) diff --git a/copilot-c99/src/Copilot/Compile/C99/Compile.hs b/copilot-c99/src/Copilot/Compile/C99/Compile.hs index 7ee083968..1467af403 100644 --- a/copilot-c99/src/Copilot/Compile/C99/Compile.hs +++ b/copilot-c99/src/Copilot/Compile/C99/Compile.hs @@ -47,12 +47,20 @@ import Copilot.Compile.C99.Representation ( UniqueTrigger (..), -- 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 @@ -74,6 +82,24 @@ compileWith cSettings prefix spec 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. -- From 1d389490d6e1017932679bb7a639dd9856bd04f8 Mon Sep 17 00:00:00 2001 From: Frank Dedden Date: Fri, 20 Dec 2024 09:02:26 +0100 Subject: [PATCH 0862/1222] copilot-c99: Document changes in CHANGELOG. Refs #296. --- copilot-c99/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot-c99/CHANGELOG b/copilot-c99/CHANGELOG index 50c704f20..635e0021a 100644 --- a/copilot-c99/CHANGELOG +++ b/copilot-c99/CHANGELOG @@ -1,5 +1,6 @@ -2024-11-14 +2024-12-20 * Remove uses of Copilot.Core.Expr.UExpr.uExprType. (#565) + * Allow using same trigger name in multiple declarations. (#296) 2024-11-07 * Version bump (4.1). (#561) From 5aee0c3e485177070959f9c360cba8beb676be31 Mon Sep 17 00:00:00 2001 From: kaBeech Date: Thu, 2 Jan 2025 13:20:32 -0800 Subject: [PATCH 0863/1222] copilot: Bump upper version constraint on filepath. Refs #570. In order to keep Copilot effectively working in the current Haskell ecosystem, and with new versions of GHC, we want to extend the versions of dependencies that Copilot can be installed with as much as possible to include newly released versions. This commit relaxes the upper bounds on the version constraints on filepath so that Copilot can be installed with version 1.5.2.0. --- copilot/copilot.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot/copilot.cabal b/copilot/copilot.cabal index c8383ae9a..f645bf43d 100644 --- a/copilot/copilot.cabal +++ b/copilot/copilot.cabal @@ -50,7 +50,7 @@ library base >= 4.9 && < 5 , optparse-applicative >= 0.14 && < 0.19 , directory >= 1.3 && < 1.4 - , filepath >= 1.4 && < 1.5 + , filepath >= 1.4 && < 1.6 , copilot-core >= 4.1 && < 4.2 , copilot-theorem >= 4.1 && < 4.2 From 818ca231a623bbf97c54fed18db17300e5f4cc35 Mon Sep 17 00:00:00 2001 From: kaBeech Date: Thu, 2 Jan 2025 13:26:18 -0800 Subject: [PATCH 0864/1222] copilot-c99: Bump upper version constraint on filepath. Refs #570. In order to keep Copilot effectively working in the current Haskell ecosystem, and with new versions of GHC, we want to extend the versions of dependencies that Copilot can be installed with as much as possible to include newly released versions. This commit relaxes the upper bounds on the version constraints on filepath so that Copilot can be installed with version 1.5.2.0. --- copilot-c99/copilot-c99.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot-c99/copilot-c99.cabal b/copilot-c99/copilot-c99.cabal index 4e441d314..09e987d81 100644 --- a/copilot-c99/copilot-c99.cabal +++ b/copilot-c99/copilot-c99.cabal @@ -41,7 +41,7 @@ library 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 From ddef3484d44a3ff080d1d0370fc95a6b683b5eab Mon Sep 17 00:00:00 2001 From: kaBeech Date: Thu, 2 Jan 2025 13:27:55 -0800 Subject: [PATCH 0865/1222] copilot-language: Bump upper version constraint on containers. Refs #570. In order to keep Copilot effectively working in the current Haskell ecosystem, and with new versions of GHC, we want to extend the versions of dependencies that Copilot can be installed with as much as possible to include newly released versions. This commit relaxes the upper bounds on the version constraints on containers so that Copilot can be installed with version 0.7. --- copilot-language/copilot-language.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot-language/copilot-language.cabal b/copilot-language/copilot-language.cabal index ad0ec0725..74d501421 100644 --- a/copilot-language/copilot-language.cabal +++ b/copilot-language/copilot-language.cabal @@ -38,7 +38,7 @@ library build-depends: base >= 4.9 && < 5 , array >= 0.5 && < 0.6 - , containers >= 0.4 && < 0.7 + , containers >= 0.4 && < 0.8 , data-reify >= 0.6 && < 0.7 , mtl >= 2.0 && < 3 From 9100e977d1853b0e8ce930835b133ce53484a849 Mon Sep 17 00:00:00 2001 From: kaBeech Date: Thu, 2 Jan 2025 13:30:19 -0800 Subject: [PATCH 0866/1222] copilot-libraries: Bump upper version constraint on containers. Refs #570. In order to keep Copilot effectively working in the current Haskell ecosystem, and with new versions of GHC, we want to extend the versions of dependencies that Copilot can be installed with as much as possible to include newly released versions. This commit relaxes the upper bounds on the version constraints on containers so that Copilot can be installed with version 0.7. --- copilot-libraries/copilot-libraries.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot-libraries/copilot-libraries.cabal b/copilot-libraries/copilot-libraries.cabal index fc312c91d..709d18236 100644 --- a/copilot-libraries/copilot-libraries.cabal +++ b/copilot-libraries/copilot-libraries.cabal @@ -38,7 +38,7 @@ library build-depends: base >= 4.9 && < 5 - , containers >= 0.4 && < 0.7 + , containers >= 0.4 && < 0.8 , mtl >= 2.0 && < 2.4 , parsec >= 2.0 && < 3.2 , copilot-language >= 4.1 && < 4.2 From 0c7c2667efec5cc5402f762d4b15a86ab7de1a1e Mon Sep 17 00:00:00 2001 From: kaBeech Date: Thu, 2 Jan 2025 13:31:06 -0800 Subject: [PATCH 0867/1222] copilot-theorem: Bump upper version constraint on containers. Refs #570. In order to keep Copilot effectively working in the current Haskell ecosystem, and with new versions of GHC, we want to extend the versions of dependencies that Copilot can be installed with as much as possible to include newly released versions. This commit relaxes the upper bounds on the version constraints on containers so that Copilot can be installed with version 0.7. --- copilot-theorem/copilot-theorem.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot-theorem/copilot-theorem.cabal b/copilot-theorem/copilot-theorem.cabal index 9d7dd0fda..f31c49805 100644 --- a/copilot-theorem/copilot-theorem.cabal +++ b/copilot-theorem/copilot-theorem.cabal @@ -48,7 +48,7 @@ library build-depends : base >= 4.9 && < 5 , bimap (>= 0.3 && < 0.4) || (>= 0.5 && < 0.6) , bv-sized >= 1.0.2 && < 1.1 - , containers >= 0.4 && < 0.7 + , containers >= 0.4 && < 0.8 , data-default >= 0.7 && < 0.8 , directory >= 1.3 && < 1.4 , libBF >= 0.6.2 && < 0.7 From 40d5f16538e3252d4d5c1ad5a626ef09e6540960 Mon Sep 17 00:00:00 2001 From: kaBeech Date: Thu, 2 Jan 2025 13:32:49 -0800 Subject: [PATCH 0868/1222] copilot-theorem: Bump upper version constraint on data-default. Refs #570. In order to keep Copilot effectively working in the current Haskell ecosystem, and with new versions of GHC, we want to extend the versions of dependencies that Copilot can be installed with as much as possible to include newly released versions. This commit relaxes the upper bounds on the version constraints on data-default so that Copilot can be installed with version 0.8.0.0. --- copilot-theorem/copilot-theorem.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot-theorem/copilot-theorem.cabal b/copilot-theorem/copilot-theorem.cabal index f31c49805..135d75d5a 100644 --- a/copilot-theorem/copilot-theorem.cabal +++ b/copilot-theorem/copilot-theorem.cabal @@ -49,7 +49,7 @@ library , bimap (>= 0.3 && < 0.4) || (>= 0.5 && < 0.6) , bv-sized >= 1.0.2 && < 1.1 , containers >= 0.4 && < 0.8 - , data-default >= 0.7 && < 0.8 + , data-default >= 0.7 && < 0.9 , directory >= 1.3 && < 1.4 , libBF >= 0.6.2 && < 0.7 , mtl >= 2.0 && < 2.4 From 6d9a674b3eaf01d3e2ca5e7b59816d03043cc085 Mon Sep 17 00:00:00 2001 From: kaBeech Date: Thu, 2 Jan 2025 13:38:40 -0800 Subject: [PATCH 0869/1222] copilot: Document changes in CHANGELOG. Refs #570. --- copilot/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot/CHANGELOG b/copilot/CHANGELOG index ce4a1c37a..40e0bdc24 100644 --- a/copilot/CHANGELOG +++ b/copilot/CHANGELOG @@ -1,3 +1,6 @@ +2025-01-02 + * Bump upper version constraint on filepath. (#570) + 2024-11-07 * Version bump (4.1). (#561) * Update contribution guidelines. (#476) From 66b9f84b393fabbc6445b65812f38c6420d09f5b Mon Sep 17 00:00:00 2001 From: kaBeech Date: Thu, 2 Jan 2025 13:40:18 -0800 Subject: [PATCH 0870/1222] copilot-c99: Document changes in CHANGELOG. Refs #570. --- copilot-c99/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot-c99/CHANGELOG b/copilot-c99/CHANGELOG index 635e0021a..dcd314cad 100644 --- a/copilot-c99/CHANGELOG +++ b/copilot-c99/CHANGELOG @@ -1,6 +1,7 @@ -2024-12-20 +2025-01-02 * 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) From 68cd36187c34b64d37ec955d31d1d7740d09881c Mon Sep 17 00:00:00 2001 From: kaBeech Date: Thu, 2 Jan 2025 13:41:39 -0800 Subject: [PATCH 0871/1222] copilot-language: Document changes in CHANGELOG. Refs #570. --- copilot-language/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-language/CHANGELOG b/copilot-language/CHANGELOG index 1d205da0e..64fe1728c 100644 --- a/copilot-language/CHANGELOG +++ b/copilot-language/CHANGELOG @@ -1,3 +1,6 @@ +2025-01-02 + * Bump upper version constraint on containers. (#570) + 2024-11-07 * Version bump (4.1). (#561) * Reject duplicate externs in properties and theorems. (#536) From c015b67cb416cc14f1d7ba175c8720855be228a1 Mon Sep 17 00:00:00 2001 From: kaBeech Date: Thu, 2 Jan 2025 13:42:58 -0800 Subject: [PATCH 0872/1222] copilot-libraries: Document changes in CHANGELOG. Refs #570. --- copilot-libraries/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-libraries/CHANGELOG b/copilot-libraries/CHANGELOG index c4ce6ddcf..4a7ed2674 100644 --- a/copilot-libraries/CHANGELOG +++ b/copilot-libraries/CHANGELOG @@ -1,3 +1,6 @@ +2025-01-02 + * Bump upper version constraint on containers. (#570) + 2024-11-07 * Version bump (4.1). (#561) * Standardize changelog format. (#550) From a31eb047e5d7e9d1f1d79d42898a667d05fd2389 Mon Sep 17 00:00:00 2001 From: kaBeech Date: Thu, 2 Jan 2025 13:47:12 -0800 Subject: [PATCH 0873/1222] copilot-theorem: Document changes in CHANGELOG. Refs #570. --- copilot-theorem/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot-theorem/CHANGELOG b/copilot-theorem/CHANGELOG index 7508a978d..e17fe667f 100644 --- a/copilot-theorem/CHANGELOG +++ b/copilot-theorem/CHANGELOG @@ -1,5 +1,6 @@ -2024-11-15 +2025-01-02 * Remove uses of Copilot.Core.Expr.UExpr.uExprType,uExprExpr. (#565) + * Bump upper constraint on containers, data-default. (#570) 2024-11-07 * Version bump (4.1). (#561) From b447d1c00e3aa1c3c80954aea1f4483800bd5457 Mon Sep 17 00:00:00 2001 From: Ryan Scott Date: Tue, 12 Nov 2024 11:31:57 -0500 Subject: [PATCH 0874/1222] copilot-core: Define generic implementations of Struct and Typed methods. Refs #564. Currently, using structs in Copilot requires defining instances of several type classes. Defining those instances is unnecessarily cumbersome, and it exposes the user to a substantial amount of Haskell even when they want to stay at the level of the Copilot language. This commit adds functionality for implementing the class methods of `Struct` and `Typed` using `GHC.Generics`. As such, one can now easily define instances of these classes by deriving a `Generic` instance for the struct data type, i.e., ```hs data MyStructType = ... deriving Generic instance Struct MyStructType where typeName = typeNameDefault toValues = toValuesDefault updateField = updateFieldDefault instance Typed MyStructType where typeOf = typeOfDefault ``` This work is based off of an initial implementation by Marten Wijnja (@Qqwy). Note that I do not yet change any of the default implementations of any `Struct` or `Typed` methods. This is because several `Struct` instances in the wild currently do not define implementations of `updateField`, and moreover, they also do not define `Generic` instances for the corresponding data types. As such, changing the default implementation of `updateField` to use a `Generic`-based default would cause these instances in the wild to no longer compile. We will explore changing the default implementations after a suitable transition period. --- copilot-core/src/Copilot/Core/Type.hs | 173 +++++++++++++++++++++++++- 1 file changed, 171 insertions(+), 2 deletions(-) diff --git a/copilot-core/src/Copilot/Core/Type.hs b/copilot-core/src/Copilot/Core/Type.hs index b31a35094..8ab5f195a 100644 --- a/copilot-core/src/Copilot/Core/Type.hs +++ b/copilot-core/src/Copilot/Core/Type.hs @@ -4,8 +4,9 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE KindSignatures #-} -{-# LANGUAGE Safe #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE Trustworthy #-} +{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} -- | @@ -20,6 +21,7 @@ module Copilot.Core.Type ( Type (..) , Typed (..) + , typeOfDefault , UType (..) , SimpleType (..) @@ -28,25 +30,32 @@ module Copilot.Core.Type , Value (..) , toValues + , toValuesDefault , Field (..) , typeName + , typeNameDefault , Struct , fieldName , accessorName , updateField + , updateFieldDefault ) where -- External imports +import Data.Char (isLower, isUpper, toLower) +import Data.Coerce (coerce) import Data.Int (Int16, Int32, Int64, Int8) import Data.List (intercalate) import Data.Proxy (Proxy (..)) import Data.Type.Equality as DE import Data.Typeable (Typeable, eqT, typeRep) import Data.Word (Word16, Word32, Word64, Word8) +import GHC.Generics (Datatype (..), D1, Generic (..), K1 (..), M1 (..), + U1 (..), (:*:) (..)) import GHC.TypeLits (KnownNat, KnownSymbol, Symbol, natVal, sameNat, - symbolVal) + sameSymbol, symbolVal) -- Internal imports import Copilot.Core.Type.Array (Array) @@ -272,3 +281,163 @@ data UType = forall a . Typeable a => UType { uTypeType :: Type a } instance Eq UType where UType ty1 == UType ty2 = typeRep ty1 == typeRep ty2 + +-- * GHC.Generics-based defaults + +-- | A default implementation of 'typeName' that leverages 'Generic'. In order +-- to use this, make sure you derive a 'Generic' instance for your data type and +-- then define @'typeName' = 'typeNameDefault'@ in its 'Struct' instance. +-- +-- This generates a struct name that consists of the name of the original +-- Haskell data type, but converted to snake_case. +typeNameDefault :: (Generic a, GDatatype (Rep a)) => a -> String +typeNameDefault = convert . gTypeName . from + where + convert :: String -> String + convert = convert' True True + + convert' :: Bool -- ^ Is this the first letter + -> Bool -- ^ Was the previous letter capital + -> String -- ^ Remainder of the string + -> String + convert' _ _ [] = [] + convert' _ v [x] + | v && isUpper x = toLower x : [] + | isUpper x = '_' : toLower x : [] + | otherwise = x : [] + convert' b v (x1:x2:xs) + | not b && isUpper x1 && (isLower x2 || not v) + = '_' : toLower x1 : convert' False (isUpper x1) (x2:xs) + | otherwise + = toLower x1 : convert' False (isUpper x1) (x2:xs) + +-- | A default implementation of 'toValues' that leverages 'Generic'. In order +-- to use this, make sure you derive a 'Generic' instance for your data type and +-- then define @'toValues' = 'toValuesDefault'@ in its 'Struct' instance. +toValuesDefault :: (Generic a, GStruct (Rep a)) => a -> [Value a] +toValuesDefault x = coerce $ gToValues $ from x + +-- | A default implementation of 'updateField' that leverages 'Generic'. In +-- order to use this, make sure you derive a 'Generic' instance for your data +-- type and then define @'updateField' = 'updateFieldDefault'@ in its 'Struct' +-- instance. +updateFieldDefault :: (Generic a, GStruct (Rep a)) => a -> Value t -> a +updateFieldDefault a v@(Value _ field) + | updated = to a' + | otherwise = error $ "Unexpected field: " ++ show field + where + (a', updated) = gUpdateField (from a) v + +-- | A default implementation of 'typeOf' that leverages 'Generic'. In order to +-- use this, make sure you derive a 'Generic' instance for your data type and +-- then define @'typeOf' = 'typeOfDefault'@ in its 'Typed' instance. +typeOfDefault :: + forall a. (Typed a, Struct a, Generic a, GTypedStruct (Rep a)) => Type a +typeOfDefault = Struct $ to $ gStructPlaceholder @(Rep a) @() + +-- ** Generic-based classes (not exported) + +-- | Capture the name of a Haskell data type from its 'Generic' metadata. +class GDatatype f where + -- | Returns the name of a Haskell data type. (Note that this differs from + -- 'typeName', which is expected to return the name of the struct in the + -- /target/ language). + gTypeName :: f p -> String + +-- | The only 'GDatatype' instance we need is for 'D1', which describes +-- 'Datatype' metadata (@d@). We ignore all other metadata (@_f@). +instance Datatype d => GDatatype (D1 d _f) where + gTypeName = datatypeName + +-- | Perform struct-related operations on 'Generic' representation types. +class GStruct f where + -- | Transforms all the struct representation's fields into a list of values. + gToValues :: f p -> [Value (f p)] + + -- | Update the value of a struct representation's field. This returns two + -- things: + -- + -- 1. @f p@: The struct representation, but with the field updated. + -- + -- 2. 'Bool': This is 'True' if the field was successfully updated and 'False' + -- otherwise. If this returns 'False', it is the responsibility of the + -- caller to raise an error. + gUpdateField :: f p -> Value t -> (f p, Bool) + +-- | 'U1' represents a data constructor with no fields. As such, 'gToValues' +-- returns an empty list of 'Value's, and 'gUpdateField' does not update +-- anything. +instance GStruct U1 where + gToValues U1 = [] + gUpdateField u _ = (u, False) + +-- | 'M1' is only used to store metadata, which the 'GStruct' class does not +-- make use of. As such, this instance discards the metadata and recurses. +instance GStruct f => GStruct (M1 _i _c f) where + gToValues (M1 x) = coerce (gToValues x) + gUpdateField (M1 x) v = (M1 x', updated) + where + (x', updated) = gUpdateField x v + +-- | @(':*:')@ represents a data constructor with multiple fields. +instance (GStruct f, GStruct g) => GStruct (f :*: g) where + -- Recursively compute two lists of Values and append them. + gToValues (f :*: g) = coerce (gToValues f) ++ coerce (gToValues g) + -- Recursively attempt to update the field in both branches and combine the + -- updated branches. We will have successfully updated the field if either + -- branch was successfully updated. + gUpdateField (f :*: g) v = (f' :*: g', updatedF || updatedG) + where + (f', updatedF) = gUpdateField f v + (g', updatedG) = gUpdateField g v + +-- | 'K1' represents a single field in a data constructor. This is the base +-- case. +instance (KnownSymbol name, Typed ty, c ~ Field name ty) => + GStruct (K1 _i c) where + -- Now that we have the field, return it in a singleton list. + gToValues (K1 field) = [Value typeOf field] + -- In order to update the field, we check that the field names and types + -- match. If they do, return the updated field and declare the update as + -- successful. Otherwise, return the old field and declare the update as + -- unsuccessful. + gUpdateField (K1 oldField) (Value newTy (newField :: Field newName newTy)) = + case (sameSymbol pName pNewName, testEquality ty newTy) of + (Just Refl, Just Refl) -> (K1 newField, True) + _ -> (K1 oldField, False) + where + pName = Proxy @name + pNewName = Proxy @newName + ty = typeOf @ty + +-- | Compute a 'Generic' placeholder value to use for a struct type. +class GTypedStruct f where + -- | A placeholder value to supply to use in a generic implementation of + -- 'typeOf' for a struct type. + gStructPlaceholder :: f p + +-- | 'U1' represents a data constructor with no fields. As such, +-- 'gStructPlaceholder' simply returns the data constructor with no other +-- information. +instance GTypedStruct U1 where + gStructPlaceholder = U1 + +-- | 'M1' is only used to store metadata, which the 'GTypedStruct' class does +-- not make use of. As such, this instance recursively computes a placeholder +-- value without inspecting the metadata. +instance GTypedStruct f => GTypedStruct (M1 _i _c f) where + gStructPlaceholder = M1 gStructPlaceholder + +-- | @(':*:')@ represents a data constructor with multiple fields. As such, +-- 'gStructPlaceholder' recursively computes placeholders for each field and +-- combines them into the overall data constructor. +instance (GTypedStruct f, GTypedStruct g) => GTypedStruct (f :*: g) where + gStructPlaceholder = gStructPlaceholder :*: gStructPlaceholder + +-- | 'K1' represents a single field in a data constructor. This is the base +-- case. This instance computes a placeholder value that works for any field of +-- any type. +instance (c ~ Field name ty) => GTypedStruct (K1 _i c) where + -- We use 'undefined' as the actual value for the 'Field' because Copilot + -- never inspects the value. + gStructPlaceholder = K1 $ Field undefined From 428209ea265f2aecbca838273888365744f7667f Mon Sep 17 00:00:00 2001 From: Ryan Scott Date: Tue, 12 Nov 2024 12:37:55 -0500 Subject: [PATCH 0875/1222] copilot-core: Warn about future generic default for updateField. Refs #564. Currently, using structs in Copilot requires defining instances of several type classes. Defining those instances is unnecessarily cumbersome, and it exposes the user to a substantial amount of Haskell even when they want to stay at the level of the Copilot language. In the previous commit, we added `Generic`-based defaults for several type class methods, including the `updateField` method of `Struct`. In the future, we plan to change the default implementation for `updateField` such that it will require a `Generic` instance. This will break any existing `Struct` instance that omits an implementation of `updateField` and also does not define a `Generic` instance for the struct data type. Unfortunately, there does not appear to be a way for GHC to warn about this combination of properties. This commit adds a verbal warning to the `updateField` Haddocks to make users aware of this potential problem. --- copilot-core/src/Copilot/Core/Type.hs | 37 +++++++++++++++++---------- 1 file changed, 24 insertions(+), 13 deletions(-) diff --git a/copilot-core/src/Copilot/Core/Type.hs b/copilot-core/src/Copilot/Core/Type.hs index 8ab5f195a..814a22c75 100644 --- a/copilot-core/src/Copilot/Core/Type.hs +++ b/copilot-core/src/Copilot/Core/Type.hs @@ -70,24 +70,35 @@ class Struct a where toValues :: a -> [Value a] -- | Update the value of a struct field. This is only used by the Copilot - -- interpreter, so if you do not plan to use the interpreter, it is safe to - -- omit an implementation of this method. + -- interpreter. -- - -- In order to implement 'updateField', you should do the following for each - -- 'Field' in a struct: + -- If you do not plan to use the interpreter, you can omit an implementation + -- of this method. If you do so, it is recommended that you derive a 'Generic' + -- instance for the struct data type. This is because in a future release, the + -- default implementation of 'updateField' (which will be picked if there is + -- not a manually written implementation) will be changed to require a + -- 'Generic' instance. -- - -- 1. Check that the name of the 'Field' matches the name of the supplied - -- 'Value' (using 'GHC.TypeLits.sameSymbol'). + -- In order to implement 'updateField', pick one of the following approaches: -- - -- 2. Check that the type of the 'Field' matches the 'Type' of the supplied - -- 'Value' (using 'DE.testEquality'). + -- * Derive a 'Generic' instance for the struct data type and then define + -- @'updateField' = 'updateFieldDefault'@ in the 'Struct' instance. -- - -- 3. If both (1) and (2) succeed, update the corresponding struct field using - -- a record update. + -- * Manually implement 'updateField' by doing the following for each 'Field' + -- in a struct: -- - -- For a complete end-to-end example that demonstrates how to implement - -- 'updateField' and use it in the Copilot interpreter, see the - -- @examples/StructsUpdateField.hs@ example in the @copilot@ library. + -- 1. Check that the name of the 'Field' matches the name of the supplied + -- 'Value' (using 'GHC.TypeLits.sameSymbol'). + -- + -- 2. Check that the type of the 'Field' matches the 'Type' of the supplied + -- 'Value' (using 'DE.testEquality'). + -- + -- 3. If both (1) and (2) succeed, update the corresponding struct field + -- using a record update. + -- + -- For a complete end-to-end example that demonstrates how to manually + -- implement 'updateField' and use it in the Copilot interpreter, see the + -- @examples/StructsUpdateField.hs@ example in the @copilot@ library. updateField :: a -> Value t -> a updateField = error $ unlines [ "Field updates not supported for this type." From ae41a73b4892359c5e192db4f92d7be19c44af3f Mon Sep 17 00:00:00 2001 From: Ryan Scott Date: Tue, 12 Nov 2024 11:48:50 -0500 Subject: [PATCH 0876/1222] copilot: Update struct examples to use generic method implementations. Refs #564. Currently, using structs in Copilot requires defining instances of several type classes. Defining those instances is unnecessarily cumbersome, and it exposes the user to a substantial amount of Haskell even when they want to stay at the level of the Copilot language. In a previous commit, we added `Generic`-based defaults for the methods of the `Struct` and `Typed` classes. In this commit, we leverage these default implementations to remove much of the boilerplate code needed to define `Struct` and `Typed` instances in the struct-related `copilot` examples. Note that I have intentionally _not_ used `updateFieldDefault` in the `StructsUpdateField.hs` example, as that example is intended to demonstrate how one would implement `updateField` by hand. This work is based off of an initial implementation by Marten Wijnja (@Qqwy). --- copilot/examples/Structs.hs | 41 +++++++++++------------ copilot/examples/StructsUpdateField.hs | 46 ++++++++++++++------------ copilot/examples/what4/Structs.hs | 41 +++++++++++------------ 3 files changed, 62 insertions(+), 66 deletions(-) diff --git a/copilot/examples/Structs.hs b/copilot/examples/Structs.hs index 559a5be29..1b036fe5e 100644 --- a/copilot/examples/Structs.hs +++ b/copilot/examples/Structs.hs @@ -1,28 +1,29 @@ -- | An example showing how specifications involving structs (in particular, -- nested structs) are compiled to C using copilot-c99. -{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} module Main where import qualified Prelude as P import Control.Monad (void, forM_) +import GHC.Generics (Generic) import Language.Copilot import Copilot.Compile.C99 -- | Definition for `Volts`. data Volts = Volts - { numVolts :: Field "numVolts" Word16 - , flag :: Field "flag" Bool - } + { numVolts :: Field "numVolts" Word16 + , flag :: Field "flag" Bool + } + deriving Generic -- | `Struct` instance for `Volts`. instance Struct Volts where - typeName _ = "volts" - toValues volts = [ Value Word16 (numVolts volts) - , Value Bool (flag volts) - ] + typeName = typeNameDefault + toValues = toValuesDefault -- Note that we do not implement `updateField` here. `updateField` is only -- needed to make updates to structs work in the Copilot interpreter, and we -- do not use the interpreter in this example. (See @@ -31,29 +32,25 @@ instance Struct Volts where -- | `Volts` instance for `Typed`. instance Typed Volts where - typeOf = Struct (Volts (Field 0) (Field False)) + typeOf = typeOfDefault data Battery = Battery - { temp :: Field "temp" Word16 - , volts :: Field "volts" (Array 10 Volts) - , other :: Field "other" (Array 10 (Array 5 Word32)) - } + { temp :: Field "temp" Word16 + , volts :: Field "volts" (Array 10 Volts) + , other :: Field "other" (Array 10 (Array 5 Word32)) + } + deriving Generic -- | `Battery` instance for `Struct`. instance Struct Battery where - typeName _ = "battery" - toValues battery = [ Value typeOf (temp battery) - , Value typeOf (volts battery) - , Value typeOf (other battery) - ] + typeName = typeNameDefault + toValues = toValuesDefault -- Note that we do not implement `updateField` here for the same reasons as in -- the `Struct Volts` instance above. --- | `Battery` instance for `Typed`. Note that `undefined` is used as an --- argument to `Field`. This argument is never used, so `undefined` will never --- throw an error. +-- | `Battery` instance for `Typed`. instance Typed Battery where - typeOf = Struct (Battery (Field 0) (Field undefined) (Field undefined)) + typeOf = typeOfDefault spec :: Spec spec = do diff --git a/copilot/examples/StructsUpdateField.hs b/copilot/examples/StructsUpdateField.hs index 33f5d319f..5b0c7a35d 100644 --- a/copilot/examples/StructsUpdateField.hs +++ b/copilot/examples/StructsUpdateField.hs @@ -3,6 +3,7 @@ -- copilot-c99. {-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} @@ -13,6 +14,7 @@ import qualified Prelude as P import Control.Monad (void, forM_) import Data.Proxy (Proxy(..)) import Data.Type.Equality (TestEquality(..), (:~:)(..)) +import GHC.Generics (Generic) import GHC.TypeLits (sameSymbol) import Language.Copilot @@ -20,20 +22,22 @@ import Copilot.Compile.C99 -- | Definition for `Volts`. data Volts = Volts - { numVolts :: Field "numVolts" Word16 - , flag :: Field "flag" Bool - } + { numVolts :: Field "numVolts" Word16 + , flag :: Field "flag" Bool + } + deriving Generic -- | `Struct` instance for `Volts`. instance Struct Volts where - typeName _ = "volts" - toValues volts = [ Value Word16 (numVolts volts) - , Value Bool (flag volts) - ] + typeName = typeNameDefault + toValues = toValuesDefault -- In order to run struct updates (as used in the "equalityStructUpdate" -- trigger below) in the Copilot interpreter, we must implement the -- `updateField` method. To do so, we must check to see if the supplied -- `Value` has a `Field` with the same name and type as a field in `Volts`. + -- (Alternatively, we could define this as @updateField = updateFieldDefault@, + -- but we demonstrate how to manually implement it below for educational + -- purposes.) updateField volts (Value fieldTy (field :: Field fieldName a)) -- For each field in `Volts`, we must: -- @@ -67,23 +71,23 @@ instance Struct Volts where -- | `Volts` instance for `Typed`. instance Typed Volts where - typeOf = Struct (Volts (Field 0) (Field False)) + typeOf = typeOfDefault data Battery = Battery - { temp :: Field "temp" Word16 - , volts :: Field "volts" (Array 10 Volts) - , other :: Field "other" (Array 10 (Array 5 Word32)) - } + { temp :: Field "temp" Word16 + , volts :: Field "volts" (Array 10 Volts) + , other :: Field "other" (Array 10 (Array 5 Word32)) + } + deriving Generic -- | `Battery` instance for `Struct`. instance Struct Battery where - typeName _ = "battery" - toValues battery = [ Value typeOf (temp battery) - , Value typeOf (volts battery) - , Value typeOf (other battery) - ] + typeName = typeNameDefault + toValues = toValuesDefault -- We implement `updateField` similarly to how we implement it in the - -- `Struct Volts` instance above. + -- `Struct Volts` instance above. (Alternatively, we could define this as + -- @updateField = updateFieldDefault@, but we demonstrate how to manually + -- implement it below for educational purposes.) updateField battery (Value fieldTy (field :: Field fieldName a)) | Just Refl <- sameSymbol (Proxy @fieldName) (Proxy @"temp") , Just Refl <- testEquality fieldTy Word16 @@ -103,11 +107,9 @@ instance Struct Battery where | otherwise = error $ "Unexpected field: " P.++ show field --- | `Battery` instance for `Typed`. Note that `undefined` is used as an --- argument to `Field`. This argument is never used, so `undefined` will never --- throw an error. +-- | `Battery` instance for `Typed`. instance Typed Battery where - typeOf = Struct (Battery (Field 0) (Field undefined) (Field undefined)) + typeOf = typeOfDefault spec :: Spec spec = do diff --git a/copilot/examples/what4/Structs.hs b/copilot/examples/what4/Structs.hs index 6b53d1098..cff433c4e 100644 --- a/copilot/examples/what4/Structs.hs +++ b/copilot/examples/what4/Structs.hs @@ -2,28 +2,29 @@ -- structs and arrays. Particular focus is on nested structs. -- For general usage of structs, refer to the general structs example. -{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} module Main where import qualified Prelude as P import Control.Monad (void, forM_) +import GHC.Generics (Generic) import Language.Copilot import Copilot.Theorem.What4 -- | Definition for `Volts`. data Volts = Volts - { numVolts :: Field "numVolts" Word16 - , flag :: Field "flag" Bool - } + { numVolts :: Field "numVolts" Word16 + , flag :: Field "flag" Bool + } + deriving Generic -- | `Struct` instance for `Volts`. instance Struct Volts where - typeName _ = "volts" - toValues volts = [ Value Word16 (numVolts volts) - , Value Bool (flag volts) - ] + typeName = typeNameDefault + toValues = toValuesDefault -- Note that we do not implement `updateField` here. `updateField` is only -- needed to make updates to structs work in the Copilot interpreter, and we -- do not use the interpreter in this example. (See @@ -32,29 +33,25 @@ instance Struct Volts where -- | `Volts` instance for `Typed`. instance Typed Volts where - typeOf = Struct (Volts (Field 0) (Field False)) + typeOf = typeOfDefault data Battery = Battery - { temp :: Field "temp" Word16 - , volts :: Field "volts" (Array 10 Volts) - , other :: Field "other" (Array 10 (Array 5 Word32)) - } + { temp :: Field "temp" Word16 + , volts :: Field "volts" (Array 10 Volts) + , other :: Field "other" (Array 10 (Array 5 Word32)) + } + deriving Generic -- | `Battery` instance for `Struct`. instance Struct Battery where - typeName _ = "battery" - toValues battery = [ Value typeOf (temp battery) - , Value typeOf (volts battery) - , Value typeOf (other battery) - ] + typeName = typeNameDefault + toValues = toValuesDefault -- Note that we do not implement `updateField` here for the same reasons as in -- the `Struct Volts` instance above. --- | `Battery` instance for `Typed`. Note that `undefined` is used as an --- argument to `Field`. This argument is never used, so `undefined` will never --- throw an error. +-- | `Battery` instance for `Typed`. instance Typed Battery where - typeOf = Struct (Battery (Field 0) (Field undefined) (Field undefined)) + typeOf = typeOfDefault spec :: Spec spec = do From 24201b5c114d181c94c005f18c6bad2314ab9a92 Mon Sep 17 00:00:00 2001 From: Ryan Scott Date: Tue, 12 Nov 2024 11:54:13 -0500 Subject: [PATCH 0877/1222] copilot-core: Document changes in CHANGELOG. Refs #564. --- copilot-core/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot-core/CHANGELOG b/copilot-core/CHANGELOG index a642472c4..c5ec07d11 100644 --- a/copilot-core/CHANGELOG +++ b/copilot-core/CHANGELOG @@ -1,6 +1,7 @@ -2024-12-29 +2025-01-06 * Deprecate fields of Copilot.Core.Expr.UExpr. (#565) * Increase test coverage. (#555) + * Define generic implementations of Struct and Typed methods. (#564) 2024-11-07 * Version bump (4.1). (#561) From cbab0cca637753b68d0d775095ab97f5a87937e0 Mon Sep 17 00:00:00 2001 From: Ryan Scott Date: Tue, 12 Nov 2024 11:55:11 -0500 Subject: [PATCH 0878/1222] copilot: Document changes in CHANGELOG. Refs #564. --- copilot/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot/CHANGELOG b/copilot/CHANGELOG index 40e0bdc24..72b6730e9 100644 --- a/copilot/CHANGELOG +++ b/copilot/CHANGELOG @@ -1,5 +1,6 @@ -2025-01-02 +2025-01-06 * Bump upper version constraint on filepath. (#570) + * Update struct examples to use generic method implementations. (#564) 2024-11-07 * Version bump (4.1). (#561) From d44bebd29df6c0e348169f7b10a5b1980758fd49 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 7 Jan 2025 19:39:12 +0000 Subject: [PATCH 0879/1222] Bump versions and constraints. Refs #577. --- copilot-c99/copilot-c99.cabal | 4 ++-- copilot-core/copilot-core.cabal | 2 +- copilot-interpreter/copilot-interpreter.cabal | 4 ++-- copilot-language/copilot-language.cabal | 8 ++++---- copilot-libraries/copilot-libraries.cabal | 4 ++-- copilot-prettyprinter/copilot-prettyprinter.cabal | 4 ++-- copilot-theorem/copilot-theorem.cabal | 6 +++--- copilot/copilot.cabal | 14 +++++++------- 8 files changed, 23 insertions(+), 23 deletions(-) diff --git a/copilot-c99/copilot-c99.cabal b/copilot-c99/copilot-c99.cabal index 09e987d81..a693b60f4 100644 --- a/copilot-c99/copilot-c99.cabal +++ b/copilot-c99/copilot-c99.cabal @@ -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. @@ -45,7 +45,7 @@ library , 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 diff --git a/copilot-core/copilot-core.cabal b/copilot-core/copilot-core.cabal index 232145325..963097d1e 100644 --- a/copilot-core/copilot-core.cabal +++ b/copilot-core/copilot-core.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-core -version: 4.1 +version: 4.2 synopsis: An intermediate representation for Copilot. description: Intermediate representation for Copilot. diff --git a/copilot-interpreter/copilot-interpreter.cabal b/copilot-interpreter/copilot-interpreter.cabal index 87e668aad..68a0316f9 100644 --- a/copilot-interpreter/copilot-interpreter.cabal +++ b/copilot-interpreter/copilot-interpreter.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-interpreter -version: 4.1 +version: 4.2 synopsis: Interpreter for Copilot. description: Interpreter for Copilot. @@ -44,7 +44,7 @@ library base >= 4.9 && < 5, pretty >= 1.0 && < 1.2, - copilot-core >= 4.1 && < 4.2 + copilot-core >= 4.2 && < 4.3 exposed-modules: diff --git a/copilot-language/copilot-language.cabal b/copilot-language/copilot-language.cabal index 74d501421..5a6a8adb9 100644 --- a/copilot-language/copilot-language.cabal +++ b/copilot-language/copilot-language.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-language -version: 4.1 +version: 4.2 synopsis: A Haskell-embedded DSL for monitoring hard real-time distributed systems. description: @@ -42,9 +42,9 @@ library , data-reify >= 0.6 && < 0.7 , mtl >= 2.0 && < 3 - , copilot-core >= 4.1 && < 4.2 - , copilot-interpreter >= 4.1 && < 4.2 - , copilot-theorem >= 4.1 && < 4.2 + , copilot-core >= 4.2 && < 4.3 + , copilot-interpreter >= 4.2 && < 4.3 + , copilot-theorem >= 4.2 && < 4.3 exposed-modules: Copilot.Language , Copilot.Language.Operators.BitWise diff --git a/copilot-libraries/copilot-libraries.cabal b/copilot-libraries/copilot-libraries.cabal index 709d18236..9d6a52ae9 100644 --- a/copilot-libraries/copilot-libraries.cabal +++ b/copilot-libraries/copilot-libraries.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-libraries -version: 4.1 +version: 4.2 synopsis: Libraries for the Copilot language. description: Libraries for the Copilot language. @@ -41,7 +41,7 @@ library , containers >= 0.4 && < 0.8 , mtl >= 2.0 && < 2.4 , parsec >= 2.0 && < 3.2 - , copilot-language >= 4.1 && < 4.2 + , copilot-language >= 4.2 && < 4.3 exposed-modules: Copilot.Library.Libraries diff --git a/copilot-prettyprinter/copilot-prettyprinter.cabal b/copilot-prettyprinter/copilot-prettyprinter.cabal index 3d3371335..ab5e63283 100644 --- a/copilot-prettyprinter/copilot-prettyprinter.cabal +++ b/copilot-prettyprinter/copilot-prettyprinter.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-prettyprinter -version: 4.1 +version: 4.2 synopsis: A prettyprinter of Copilot Specifications. description: A prettyprinter of Copilot specifications. @@ -45,7 +45,7 @@ library base >= 4.9 && < 5, pretty >= 1.0 && < 1.2, - copilot-core >= 4.1 && < 4.2 + copilot-core >= 4.2 && < 4.3 exposed-modules: diff --git a/copilot-theorem/copilot-theorem.cabal b/copilot-theorem/copilot-theorem.cabal index 135d75d5a..e708c0a6c 100644 --- a/copilot-theorem/copilot-theorem.cabal +++ b/copilot-theorem/copilot-theorem.cabal @@ -14,7 +14,7 @@ description: . -version : 4.1 +version : 4.2 license : BSD3 license-file : LICENSE maintainer : Ivan Perez @@ -63,8 +63,8 @@ library , xml >= 1.3 && < 1.4 , what4 >= 1.3 && < 1.7 - , copilot-core >= 4.1 && < 4.2 - , copilot-prettyprinter >= 4.1 && < 4.2 + , copilot-core >= 4.2 && < 4.3 + , copilot-prettyprinter >= 4.2 && < 4.3 exposed-modules : Copilot.Theorem , Copilot.Theorem.Prove diff --git a/copilot/copilot.cabal b/copilot/copilot.cabal index f645bf43d..2c1082075 100644 --- a/copilot/copilot.cabal +++ b/copilot/copilot.cabal @@ -1,5 +1,5 @@ name: copilot -version: 4.1 +version: 4.2 cabal-version: >= 1.10 license: BSD3 license-file: LICENSE @@ -52,12 +52,12 @@ library , directory >= 1.3 && < 1.4 , filepath >= 1.4 && < 1.6 - , copilot-core >= 4.1 && < 4.2 - , copilot-theorem >= 4.1 && < 4.2 - , copilot-language >= 4.1 && < 4.2 - , copilot-libraries >= 4.1 && < 4.2 - , copilot-c99 >= 4.1 && < 4.2 - , copilot-prettyprinter >= 4.1 && < 4.2 + , copilot-core >= 4.2 && < 4.3 + , copilot-theorem >= 4.2 && < 4.3 + , copilot-language >= 4.2 && < 4.3 + , copilot-libraries >= 4.2 && < 4.3 + , copilot-c99 >= 4.2 && < 4.3 + , copilot-prettyprinter >= 4.2 && < 4.3 exposed-modules: Language.Copilot, Language.Copilot.Main From e2f3f03b409a0f5cbd621691a2f73c880b478979 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 7 Jan 2025 19:40:32 +0000 Subject: [PATCH 0880/1222] Document changes in CHANGELOG. Refs #577. --- copilot-c99/CHANGELOG | 3 ++- copilot-core/CHANGELOG | 3 ++- copilot-interpreter/CHANGELOG | 3 +++ copilot-language/CHANGELOG | 3 ++- copilot-libraries/CHANGELOG | 3 ++- copilot-prettyprinter/CHANGELOG | 3 ++- copilot-theorem/CHANGELOG | 3 ++- copilot/CHANGELOG | 3 ++- 8 files changed, 17 insertions(+), 7 deletions(-) diff --git a/copilot-c99/CHANGELOG b/copilot-c99/CHANGELOG index dcd314cad..84254f6e6 100644 --- a/copilot-c99/CHANGELOG +++ b/copilot-c99/CHANGELOG @@ -1,4 +1,5 @@ -2025-01-02 +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) diff --git a/copilot-core/CHANGELOG b/copilot-core/CHANGELOG index c5ec07d11..d00518a78 100644 --- a/copilot-core/CHANGELOG +++ b/copilot-core/CHANGELOG @@ -1,4 +1,5 @@ -2025-01-06 +2025-01-07 + * Version bump (4.2). (#577) * Deprecate fields of Copilot.Core.Expr.UExpr. (#565) * Increase test coverage. (#555) * Define generic implementations of Struct and Typed methods. (#564) diff --git a/copilot-interpreter/CHANGELOG b/copilot-interpreter/CHANGELOG index bd2aadc09..46c8f0c6b 100644 --- a/copilot-interpreter/CHANGELOG +++ b/copilot-interpreter/CHANGELOG @@ -1,3 +1,6 @@ +2025-01-07 + * Version bump (4.2). (#577) + 2024-11-07 * Version bump (4.1). (#561) diff --git a/copilot-language/CHANGELOG b/copilot-language/CHANGELOG index 64fe1728c..0968f9f1f 100644 --- a/copilot-language/CHANGELOG +++ b/copilot-language/CHANGELOG @@ -1,4 +1,5 @@ -2025-01-02 +2025-01-07 + * Version bump (4.2). (#577) * Bump upper version constraint on containers. (#570) 2024-11-07 diff --git a/copilot-libraries/CHANGELOG b/copilot-libraries/CHANGELOG index 4a7ed2674..bd1a6b88c 100644 --- a/copilot-libraries/CHANGELOG +++ b/copilot-libraries/CHANGELOG @@ -1,4 +1,5 @@ -2025-01-02 +2025-01-07 + * Version bump (4.2). (#577) * Bump upper version constraint on containers. (#570) 2024-11-07 diff --git a/copilot-prettyprinter/CHANGELOG b/copilot-prettyprinter/CHANGELOG index 6ea452f0e..b51261ae8 100644 --- a/copilot-prettyprinter/CHANGELOG +++ b/copilot-prettyprinter/CHANGELOG @@ -1,4 +1,5 @@ -2024-11-15 +2025-01-07 + * Version bump (4.2). (#577) * Remove uses of Copilot.Core.Expr.UExpr.uExprExpr. (#565) 2024-11-07 diff --git a/copilot-theorem/CHANGELOG b/copilot-theorem/CHANGELOG index e17fe667f..cf46bf03d 100644 --- a/copilot-theorem/CHANGELOG +++ b/copilot-theorem/CHANGELOG @@ -1,4 +1,5 @@ -2025-01-02 +2025-01-07 + * Version bump (4.2). (#577) * Remove uses of Copilot.Core.Expr.UExpr.uExprType,uExprExpr. (#565) * Bump upper constraint on containers, data-default. (#570) diff --git a/copilot/CHANGELOG b/copilot/CHANGELOG index 72b6730e9..f317d91a9 100644 --- a/copilot/CHANGELOG +++ b/copilot/CHANGELOG @@ -1,4 +1,5 @@ -2025-01-06 +2025-01-07 + * Version bump (4.2). (#577) * Bump upper version constraint on filepath. (#570) * Update struct examples to use generic method implementations. (#564) From f652dead7772761d7dfbc9ddbaf2a1968191a269 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 25 Jan 2025 17:13:07 +0000 Subject: [PATCH 0881/1222] copilot-theorem: Fix multiple typos in README. Refs #560. The README in copilot-theorem includes several typos, such as proportionnal, occurences and latters. Those typos should be corrected. This commit fixes the typos found in the README. Improving the style of the writing or formatting the code is not included as part of the fix. --- copilot-theorem/README.md | 147 +++++++++++++++++++------------------- 1 file changed, 74 insertions(+), 73 deletions(-) diff --git a/copilot-theorem/README.md b/copilot-theorem/README.md index e16d7f1ea..64cce8995 100644 --- a/copilot-theorem/README.md +++ b/copilot-theorem/README.md @@ -4,7 +4,7 @@ Highly automated proof techniques are a necessary step for the widespread adoption of formal methods in the software industry. Moreover, it could provide -a partial answer to one of its main issue which is scalability. +a partial answer to one of its main issues, which is scalability. *copilot-theorem* is a Copilot library aimed at checking automatically some safety properties on Copilot programs. It includes: @@ -17,9 +17,9 @@ properties on Copilot programs. It includes: proving basic k-inductive properties and for pedagogical purposes. * A prover producing native inputs for the *Kind2* model checker, developed at - University of Iowa. The latter uses both the *k-induction algorithm* extended - with *path compression* and *structural abstraction* [2] and the **IC3 - algorithm** with counterexample generalization based on *approximate + the University of Iowa. The latter uses both the *k-induction algorithm* + extended with *path compression* and *structural abstraction* [2] and the + **IC3 algorithm** with counterexample generalization based on *approximate quantifier elimination* [3]. ## A Tutorial @@ -39,12 +39,12 @@ README. ### First steps *copilot-theorem* is aimed at checking **safety properties** on Copilot programs. -Intuitively, a safety property is a property which express the idea that +Intuitively, a safety property is a property that expresses the idea that *nothing bad can happen*. In particular, any invalid safety property can be disproved by a finite execution trace of the program called a **counterexample**. Safety properties are often opposed to **liveness** properties, which express the idea that *something good will eventually -happen*. The latters are out of the scope of *copilot-theorem*. +happen*. The latter is out of the scope of *copilot-theorem*. Safety properties are simply expressed with standard boolean streams. In addition to triggers and observers declarations, it is possible to bind a @@ -70,7 +70,7 @@ This function takes three arguments: * The name of the proposition we want to check. * A strategy to prove the proposition. -In this case the proposition is simple enough so that we can check it directly +In this case, the proposition is simple enough so that we can check it directly by k-induction using `kind2Prover`. Therefore we can just write: ```haskell @@ -79,14 +79,15 @@ main = do prove spec' "gt0" (tell [Check $ kind2Prover def]) ``` -where `kind2Prover def` stands for the *Kind2 prover* with default +where `kind2Prover def` stands for the *Kind2 prover* with the default configuration. #### The Kind2 prover -The *Kind2* prover uses the model checker with the same name, from Iowa -university. It translates the Copilot specification into a *modular transition -system* (the Kind2 native format) and then calls the `kind2` executable. +The *Kind2* prover uses the model checker with the same name, from the +University of Iowa. It translates the Copilot specification into a *modular +transition system* (the Kind2 native format) and then calls the `kind2` +executable. It is provided by the `Copilot.Theorem.Kind2` module, which exports a `kind2Prover :: Options -> Prover` where the `Options` type is defined as @@ -117,7 +118,7 @@ Some examples are in the *examples* folder, including: ### An introduction to SMT-based model checking An introduction to the model-checking techniques used by *copilot-theorem* can be -found in the `doc` folder of this repository. It consists in a self sufficient +found in the `doc` folder of this repository. It consists of a self-sufficient set of slides. You can find some additional readings in the *References* section. @@ -216,16 +217,16 @@ process* [7] and so we have no way to keep them. #### Types In these three formats, GADTs are used to statically ensure a part of the -type-corectness of the specification, in the same spirit it is done in the -other Copilot libraries. *copilot-theorem* handles only three types which are -`Integer`, `Real` and `Bool` and which are handled by the SMTLib standard. +type-correctness of the specification, in the same spirit as in +other Copilot libraries. *copilot-theorem* works with only three types, +`Integer`, `Real` and `Bool`, all of which SMT-Lib can handle. *copilot-theorem* works with *pure* reals and integers. Thus, it is unsafe in the sense it ignores integer overflow problems and the loss of precision due to floating point arithmetic. #### The Kind2 prover -The *Kind2 prover* first translates the copilot specification into a *modular +The *Kind2 prover* first translates the Copilot specification into a *modular transition system*. Then, a chain of transformations is applied to this system (for instance, in order to remove dependency cycles among nodes). After this, the system is translated into the *Kind2 native format* and the `kind2` @@ -234,7 +235,7 @@ this process. ##### Modular transition systems -Let's look at the definition of a *modular transition systems*, in the +Let's look at the definition of a *modular transition system*, in the `TransSys.Spec` module: ```haskell @@ -295,10 +296,10 @@ types of variables: ##### The translation process -First, a copilot specification is translated into a modular transition system. +First, a Copilot specification is translated into a modular transition system. This process is defined in the `TransSys.Translate` module. Each stream is -associated to a node. The most significant task of this translation process is -to *flatten* the copilot specification so the value of all streams at time *n* +associated with a node. The most significant task of this translation process is +to *flatten* the Copilot specification so the value of all streams at time *n* only depends on the values of all the streams at time *n - 1*, which is not the case in the `Fib` example shown earlier. This is done by a simple program transformation which turns this: @@ -337,13 +338,13 @@ consistent. However, it can't be directly translated into the *Kind2 native file format*. Indeed, it is natural to bind each node to a predicate but the Kind2 file format requires that each predicate only uses previously defined predicates. However, some nodes in our transition system could be mutually -recursive. Therefore, the goal of the `removeCycles :: Spec -> Spec` function -defined in `TransSys.Transform` is to remove such dependency cycles. +recursive. Therefore, the goal of the `removeCycles :: Spec -> Spec` function, +defined in `TransSys.Transform`, is to remove such dependency cycles. -This function relies on the `mergeNodes :: [NodeId] -> Spec -> Spec` function -which signature is self-explicit. The latter solves name conflicts by using the -`Misc.Renaming` monad. Some code complexity has been added so the variable -names remains as clear as possible after merging two nodes. +This function relies on the `mergeNodes :: [NodeId] -> Spec -> Spec` function, +whose signature is self-explicit. The latter solves name conflicts by using the +`Misc.Renaming` monad. Some code complexity has been added so variable names +remain as clear as possible after merging two nodes. The function `removeCycles` computes the strongly connected components of the dependency graph and merge each one into a single node. The complexity of this @@ -354,7 +355,7 @@ merged in most practical cases. After the cycles have been removed, it is useful to apply another transformation which makes the translation from `TransSys.Spec` to `Kind2.AST` easier. This transformation is implemented in the `complete` function. In a -nutshell, it transforms a system such that +nutshell, it transforms a system such that: * If a node depends on another, it imports *all* its variables. * The dependency graph is transitive, that is if *A* depends of *B* which @@ -374,7 +375,7 @@ inline spec = mergeNodes [nodeId n | n <- specNodes spec] spec which discards all the structure of a *modular transition system* and turns it into a *non-modular transition system* with only one node. In fact, when -translating a copilot specification to a kind2 file, two styles are available: +translating a Copilot specification to a Kind2 file, two styles are available: the `Kind2.toKind2` function takes a `Style` argument which can take the value `Inlined` or `Modular`. The only difference is that in the first case, a call to `removeCycles` is replaced by a call to `inline`. @@ -382,17 +383,17 @@ to `removeCycles` is replaced by a call to `inline`. ### Limitations of copilot-theorem Now, we will discuss some limitations of the *copilot-theorem* tool. These -limitations are organized in two categories: the limitations related to the -Copilot language itself and its implementation, and the limitations related to -the model-checking techniques we are using. +limitations are split into two categories: limitations related to the Copilot +language itself and its implementation, and limitations related to the +model-checking techniques we are using. #### Limitations related to Copilot implementation -The reification process used to build the `Core.Spec` object looses many -informations about the structure of the original Copilot program. In fact, a -stream is kept in the reified program only if it is recursively defined. -Otherwise, all its occurences will be inlined. Moreover, let's look at the -`intCounter` function defined in the example `Grey.hs`: +The reification process used to build the `Core.Spec` object loses information +about the structure of the original Copilot program. In fact, a stream is kept +in the reified program only if it is recursively defined. Otherwise, all its +occurrences will be inlined. Moreover, let's look at the `intCounter` function +defined in the example `Grey.hs`: ```haskell intCounter :: Stream Bool -> Stream Word64 @@ -413,8 +414,8 @@ There are many problems with this: * It makes the inputs given to the SMT solvers larger and repetitive. We can't rewrite the Copilot reification process in order to avoid these -inconvenients as these informations are lost by GHC itself before it occurs. -The only solution we can see would be to use *Template Haskell* to generate +inconveniences as this information is lost by GHC itself before it occurs. The +only solution we can see would be to use *Template Haskell* to generate automatically some structural annotations, which might not be worth the dirt introduced. @@ -423,7 +424,7 @@ introduced. ##### Limitations of the IC3 algorithm The IC3 algorithm was shown to be a very powerful tool for hardware -certification. However, the problems encountered when verifying softwares are +certification. However, the problems encountered when verifying software are much more complex. For now, very few non-inductive properties can be proved by *Kind2* when basic integer arithmetic is involved. @@ -433,32 +434,32 @@ the inductiveness* (CTI) for a property, these techniques are used to find a lemma discarding it which is general enough so that all CTIs can be discarded in a finite number of steps. -The lemmas found by the current version fo *Kind2* are often too weak. Some +The lemmas found by the current version of *Kind2* are often too weak. Some suggestions to enhance this are presented in [1]. We hope some progress will be -made in this area in a near future. +made in this area in the near future. -A workaround to this problem would be to write kind of an interactive mode -where the user is invited to provide some additional lemmas when automatic -techniques fail. Another solution would be to make the properties being checked +A workaround to this problem would be to write an interactive mode where the +user is invited to provide some additional lemmas when automatic techniques +fail. Another solution would be to make the properties being checked quasi-inductive by hand. In this case, *copilot-theorem* is still a useful tool (especially for finding bugs) but the verification of a program can be long and -requires a high level of technicity. +requires a high level of technical knowledge. ##### Limitations related to the SMT solvers -The use of SMT solvers introduces two kind of limitations: +The use of SMT solvers introduces two kinds of limitations: 1. We are limited by the computing power needed by the SMT solvers 2. SMT solvers can't handle quantifiers efficiently Let's consider the first point. SMT solving is costly and its performances are sometimes unpredictable. For instance, when running the `SerialBoyerMoore` -example with the *k-induction prover*, Yices2 does not terminate. However, the *z3* +example with the *k-induction prover*, Yices2 does not terminate. However, the *Z3* SMT solver used by *Kind2* solves the problem instantaneously. Note that this performance gap is not due to the use of the IC3 algorithm because the property to check is inductive. It could be related to the fact the SMT problem produced by the *k-induction prover* uses uninterpreted functions for encoding streams instead -of simple integer variables, which is the case when the copilot program is +of simple integer variables, which is the case when the Copilot program is translated into a transition system. However, this wouldn't explain why the *k-induction prover* still terminates instantaneously on the `BoyerMoore` example, which seems not simpler by far. @@ -472,10 +473,10 @@ property. This fact could be used to enhance the proof scheme system (see the *Future work* section). However, this trick is not always possible. For instance, in the `SerialBoyerMoore` example, the property being checked should be quantified over all integer constants. Here, we can't just introduce an -arbitrary constant stream because it is the quantified property which is +arbitrary constant stream because it is the quantified property that is inductive and not the property specialized for a given constant stream. That's -why we have no other solution than replacing universal quantification by -*bounded* universal quantification by assuming all the elements of the input +why we have no other solution than replacing universal quantification with +*bounded* universal quantification, assuming all the elements of the input stream are in the finite list `allowed` and using the function `forAllCst`: ```haskell @@ -487,13 +488,13 @@ forAllCst l f = conj $ map (f . constant) l ``` However, this solution isn't completely satisfying because the size of the -property generated is proportionnal to the cardinal of `allowed`. +property generated is proportional to the length of `allowed`. #### Some scalability issues -A standard way to prove large programs is to rely on its logical structure by -writing a specification for each of its functions. This very natural approach -is hard to follow in our case because of +A standard way to prove large programs is to rely on their logical structure, +by writing a specification for each of their functions. This very natural +approach is hard to follow in our case due to: * The difficulty to deal with universal quantification. * The lack of *true* functions in Copilot: the latter offers metaprogramming @@ -503,7 +504,7 @@ is hard to follow in our case because of Once again, *copilot-theorem* is still a very useful tool, especially for debugging purposes. However, we don't think it is adapted to write and check a -complete specification for large scale programs. +complete specification for large-scale programs. ## Future work @@ -512,19 +513,19 @@ complete specification for large scale programs. These features are not currently provided due to the lack of important features in the Kind2 SMT solver. -#### Counterexamples displaying +#### Displaying counterexamples Counterexamples are not displayed with the Kind2 prover because Kind2 doesn't support XML output of counterexamples. If the last feature is provided, it -should be easy to implement counterexamples displaying in *copilot-theorem*. For -this, we recommend to keep some informations about *observers* in +should be easy to implement displaying of counterexamples in *copilot-theorem*. +For this, we recommend keeping some information about *observers* in `TransSys.Spec` and to add one variable per observer in the Kind2 output file. #### Bad handling of non-linear operators and external functions Non-linear Copilot operators and external functions are poorly handled because -of the lack of support of uninterpreted functions in the Kind2 native format. A -good way to handle these would be to use uninterpreted functions. With this +of the lack of support for uninterpreted functions in the Kind2 native format. +A good way to handle these would be to use uninterpreted functions. With this solution, properties like ```haskell 2 * sin x + 1 <= 3 @@ -533,7 +534,7 @@ with `x` any stream can't be proven but at least the following can be proved ```haskell let y = x in sin x == sin y ``` -Currently, the *Kind2 prover* fail with the last example, as the results of +Currently, the *Kind2 prover* fails with the last example, as the results of unknown functions are turned into fresh unconstrained variables. ### Simple extensions @@ -542,7 +543,7 @@ The following extensions would be really simple to implement given the current architecture of Kind2. + If inductive proving of a property fails, giving the user a concrete CTI - (*Counterexample To The Inductiveness*, see the [1]). + (*Counterexample To The Inductiveness*, see [1]). + Use Template Haskell to declare automatically some observers with the same names used in the original program. @@ -559,29 +560,29 @@ architecture of Kind2. - Declare assumptions and invariants next to the associated code instead of gathering all properties in a single place. - - Declare a frequent code pattern which should be factorized in the - transition problem (see the section about Copilot limitations) + - Declare a frequent code pattern that can be factorized in the transition + problem (see the section about Copilot limitations) ## FAQ -### Why does the code related to transition systems look so complex ? +### Why does the code related to transition systems look so complex? -It is true the code of `TransSys` is quite complex. In fact, it would be really -straightforward to produce a flattened transition system and then a Kind2 file -with just a single *top* predicate. In fact, It would be as easy as producing -an *IL* specification. +It is true that the code of `TransSys` is quite complex. In fact, it would be +really straightforward to produce a flattened transition system and then a +Kind2 file with just a single *top* predicate. In fact, It would be as easy as +producing an *IL* specification. To be honest, I'm not sure producing a modular *Kind2* output is worth the complexity added. It's especially true at the time I write this in the sense that: * Each predicate introduced is used only one time (which is true because - copilot doesn't handle functions or parametrized streams like Lustre does and - everything is inlined during the reification process). + Copilot doesn't handle functions or parameterized streams like Lustre does + and everything is inlined during the reification process). * A similar form of structure could be obtained from a flattened Kind2 native input file with some basic static analysis by producing a dependency graph between variables. -* For now, the *Kind2* model-checker ignores these structure informations. +* For now, the *Kind2* model-checker ignores these structures. However, the current code offers some nice transformation tools (node merging, `Renaming` monad...) which could be useful if you intend to write a tool for From 2d7a06e3a16c6cbd0a2b43c4213d60112ea9bd44 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 25 Jan 2025 17:15:51 +0000 Subject: [PATCH 0882/1222] copilot-theorem: Document changes in CHANGELOG. Refs #560. --- copilot-theorem/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-theorem/CHANGELOG b/copilot-theorem/CHANGELOG index cf46bf03d..a130e6711 100644 --- a/copilot-theorem/CHANGELOG +++ b/copilot-theorem/CHANGELOG @@ -1,3 +1,6 @@ +2025-01-25 + * Fix multiple typos in README. (#560) + 2025-01-07 * Version bump (4.2). (#577) * Remove uses of Copilot.Core.Expr.UExpr.uExprType,uExprExpr. (#565) From 7e8829b1bacb82855f2e00a9bbae1755773a3d88 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Wed, 29 Jan 2025 01:57:07 +0000 Subject: [PATCH 0883/1222] copilot-core: Fix typo in documentation. Refs #587. This commit fixes a typo (a sentence ending in double period) in the documentation of `copilot-core`. --- copilot-core/src/Copilot/Core/Spec.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot-core/src/Copilot/Core/Spec.hs b/copilot-core/src/Copilot/Core/Spec.hs index 534caf927..7a71c780e 100644 --- a/copilot-core/src/Copilot/Core/Spec.hs +++ b/copilot-core/src/Copilot/Core/Spec.hs @@ -13,7 +13,7 @@ -- -- In order to be executed, high-level Copilot Language Spec must be turned -- into Copilot Core's 'Spec'. This module defines the low-level Copilot Core --- representations for Specs and the main types of element in a spec.. +-- representations for Specs and the main types of element in a spec. module Copilot.Core.Spec ( Stream (..) , Observer (..) From 6bfb6a197102aa8fabf8c9485a0fadbf2a64b168 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Wed, 29 Jan 2025 01:57:25 +0000 Subject: [PATCH 0884/1222] copilot-theorem: Fix typo in documentation. Refs #587. This commit fixes a typo (a sentence ending in double period) in the documentation of `copilot-theorem`. --- copilot-theorem/src/Copilot/Theorem/Misc/SExpr.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot-theorem/src/Copilot/Theorem/Misc/SExpr.hs b/copilot-theorem/src/Copilot/Theorem/Misc/SExpr.hs index 102ff6221..f828850b2 100644 --- a/copilot-theorem/src/Copilot/Theorem/Misc/SExpr.hs +++ b/copilot-theorem/src/Copilot/Theorem/Misc/SExpr.hs @@ -31,7 +31,7 @@ singleton a = List [Atom a] -- (s) list = List -- (ss) -- | Sequence of expressions with a root or main note, and a series of --- additional expressions or arguments.. +-- additional expressions or arguments. node a l = List (Atom a : l) -- (s ss) -- A straightforward string representation for 'SExpr's of Strings that From 751767d2a5cfe5bc9ad8caf6574e3bfa1cfd9d1f Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Wed, 29 Jan 2025 01:57:45 +0000 Subject: [PATCH 0885/1222] copilot-language: Fix typo in documentation. Refs #587. This commit fixes a typo (a sentence ending in double period) in the documentation of `copilot-language`. --- copilot-language/src/Copilot/Language/Operators/Projection.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot-language/src/Copilot/Language/Operators/Projection.hs b/copilot-language/src/Copilot/Language/Operators/Projection.hs index a350e9593..0d05c050f 100644 --- a/copilot-language/src/Copilot/Language/Operators/Projection.hs +++ b/copilot-language/src/Copilot/Language/Operators/Projection.hs @@ -23,7 +23,7 @@ infixl 8 =$ -- | Common interface to manipulate portions of a larger data structure. -- -- A projectable d s t means that it is possible to manipulate a sub-element s --- of type t carried in a stream of type d.. +-- of type t carried in a stream of type d. class Projectable d s t | d s -> t where -- | Unapplied projection or element access on a type. From 171e5f6be374efa56da95a0612ec4448d7b2a1de Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Wed, 29 Jan 2025 01:58:35 +0000 Subject: [PATCH 0886/1222] copilot-core: Document changes in CHANGELOG. Refs #587. --- copilot-core/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-core/CHANGELOG b/copilot-core/CHANGELOG index d00518a78..e51b49366 100644 --- a/copilot-core/CHANGELOG +++ b/copilot-core/CHANGELOG @@ -1,3 +1,6 @@ +2025-01-28 + * Fix typo in documentation. (#587) + 2025-01-07 * Version bump (4.2). (#577) * Deprecate fields of Copilot.Core.Expr.UExpr. (#565) From 3233cafa323be8529fa661fc9a0a3460a951d68d Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Wed, 29 Jan 2025 01:58:56 +0000 Subject: [PATCH 0887/1222] copilot-theorem: Document changes in CHANGELOG. Refs #587. --- copilot-theorem/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot-theorem/CHANGELOG b/copilot-theorem/CHANGELOG index a130e6711..4251f8875 100644 --- a/copilot-theorem/CHANGELOG +++ b/copilot-theorem/CHANGELOG @@ -1,5 +1,6 @@ -2025-01-25 +2025-01-28 * Fix multiple typos in README. (#560) + * Fix typo in documentation. (#587) 2025-01-07 * Version bump (4.2). (#577) From 0d9214e57b725cd0d9823aeb7bff360d9463a58d Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Wed, 29 Jan 2025 01:59:09 +0000 Subject: [PATCH 0888/1222] copilot-language: Document changes in CHANGELOG. Refs #587. --- copilot-language/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-language/CHANGELOG b/copilot-language/CHANGELOG index 0968f9f1f..f4668a9e1 100644 --- a/copilot-language/CHANGELOG +++ b/copilot-language/CHANGELOG @@ -1,3 +1,6 @@ +2025-01-28 + * Fix typo in documentation. (#587) + 2025-01-07 * Version bump (4.2). (#577) * Bump upper version constraint on containers. (#570) From 03a80598d9a0b9e5df4a36bfd7fd2a71c1490f59 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 31 Jan 2025 05:02:51 +0000 Subject: [PATCH 0889/1222] copilot: Include missing dependencies in installation instructions. Refs #591. The Linux section of the README lists GHC and Cabal as dependencies, but more packages are needed. Specifically, in a fresh new Ubuntu as provided via the Docker Hub, users also need to install libz-dev and pkg-config. The programs alex and happy also need to be available. This commit adjust the installation instructions for Linux distributions where Copilot is not directly available as a package to include other dependencies needed, namely libz-dev, pkg-config, alex and happy. The text prior to the instructions is also updated to reflect that this is no longer just the Haskell toolchain but, rather, all dependencies of Copilot. --- copilot/README.md | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/copilot/README.md b/copilot/README.md index 4fb3180d4..c03ccfbce 100644 --- a/copilot/README.md +++ b/copilot/README.md @@ -102,10 +102,10 @@ Copilot you must install a Haskell compiler (GHC) and the package manager Cabal. We currently support all versions of GHC from 8.6.5 to modern versions (9.8 as of this writing). You can install the toolchain using [ghcup](https://www.haskell.org/ghcup/) or, if you are on Debian/Ubuntu, -directly with `apt-get`: +you can use `apt-get` to install all dependencies as follows: ```sh -$ sudo apt-get install ghc cabal-install +$ sudo apt-get install ghc cabal-install alex happy pkg-config libz-dev ``` Once the compiler is installed, install Copilot from From b3bc4e43331ef0301b06d2aa5233f758dee4df87 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 31 Jan 2025 05:05:42 +0000 Subject: [PATCH 0890/1222] copilot: Document changes in CHANGELOG. Refs #591. --- copilot/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot/CHANGELOG b/copilot/CHANGELOG index f317d91a9..d9994c28d 100644 --- a/copilot/CHANGELOG +++ b/copilot/CHANGELOG @@ -1,3 +1,6 @@ +2025-01-30 + * Include missing dependencies in installation instructions. (#591) + 2025-01-07 * Version bump (4.2). (#577) * Bump upper version constraint on filepath. (#570) From 565d016a969b567156b1a7305f9c03ad80bb0acf Mon Sep 17 00:00:00 2001 From: Esther Conrad Date: Fri, 31 Jan 2025 13:45:45 -0500 Subject: [PATCH 0891/1222] copilot: Update version of GHC in README. Refs #590. Copilot is currently able to work with GHC 9.10, but the README still indicates that it is compatible with versions up to 9.8. This commit updates the installation instructions to reflect that Copilot is compatible with versions of GHC 9.10 as of this writing. --- copilot/README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot/README.md b/copilot/README.md index c03ccfbce..7ce1e482e 100644 --- a/copilot/README.md +++ b/copilot/README.md @@ -100,7 +100,7 @@ ghci> ghci> Leaving GHCi. On other Linux distributions or older Debian-based distributions, to use Copilot you must install a Haskell compiler (GHC) and the package manager Cabal. We currently support all versions of GHC from 8.6.5 to modern versions -(9.8 as of this writing). You can install the toolchain using +(9.10 as of this writing). You can install the toolchain using [ghcup](https://www.haskell.org/ghcup/) or, if you are on Debian/Ubuntu, you can use `apt-get` to install all dependencies as follows: From c1829da235e930760f1958804ec1b6140c7710ae Mon Sep 17 00:00:00 2001 From: Esther Conrad Date: Fri, 31 Jan 2025 13:52:48 -0500 Subject: [PATCH 0892/1222] copilot: Document changes in CHANGELOG. Refs #590. --- copilot/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot/CHANGELOG b/copilot/CHANGELOG index d9994c28d..d6574cd3e 100644 --- a/copilot/CHANGELOG +++ b/copilot/CHANGELOG @@ -1,5 +1,6 @@ -2025-01-30 +2025-01-31 * Include missing dependencies in installation instructions. (#591) + * Update version of GHC in README. (#590) 2025-01-07 * Version bump (4.2). (#577) From 0bd29d5ab0de07a2a7e4f7bf30687ff73343fe77 Mon Sep 17 00:00:00 2001 From: Ryan Scott Date: Mon, 10 Feb 2025 11:20:16 -0500 Subject: [PATCH 0893/1222] copilot-core: Add Show instance for Type. Refs #589. Currently, the `Copilot.Theorem.What4.prove` function returns a list of results, where each result contains a `SatResult` that describes whether a property is `Valid`, `Invalid`, or `Unknown`. The `Invalid` result has the limitation that it does not give any information about a specific counterexample that could drive Copilot into falsifying the property, however. This makes it challenging to interpret what the results of prove mean. To define a companion function to `prove` that also returns counterexample information upon a failed proof, it is convenient to be able to display `Type` information in panic messages. This commit derives a basic `Show` instance for `Type` so that `copilot-theorem` can display them whenever an internal invariant is violated. --- copilot-core/src/Copilot/Core/Type.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/copilot-core/src/Copilot/Core/Type.hs b/copilot-core/src/Copilot/Core/Type.hs index 814a22c75..8d54c82f3 100644 --- a/copilot-core/src/Copilot/Core/Type.hs +++ b/copilot-core/src/Copilot/Core/Type.hs @@ -5,6 +5,7 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE Trustworthy #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeOperators #-} @@ -154,6 +155,7 @@ data Type :: * -> * where , Typed t ) => Type t -> Type (Array n t) Struct :: (Typed a, Struct a) => a -> Type a +deriving instance Show (Type a) -- | Return the length of an array from its type typeLength :: forall n t . KnownNat n => Type (Array n t) -> Int From 86d75431c1552dedcd435e8e0efc345d228bc3d6 Mon Sep 17 00:00:00 2001 From: Ryan Scott Date: Mon, 10 Feb 2025 11:18:05 -0500 Subject: [PATCH 0894/1222] copilot-theorem: Record Typed evidence in XEmptyArray and XArray. Refs #589. Currently, the `Copilot.Theorem.What4.prove` function returns a list of results, where each result contains a `SatResult` that describes whether a property is `Valid`, `Invalid`, or `Unknown`. The `Invalid` result has the limitation that it does not give any information about a specific counterexample that could drive Copilot into falsifying the property, however. This makes it challenging to interpret what the results of prove mean. To update the `valFromExpr` function in order to produce concrete array values for counterexample purposes, we need to call the `Array` data constructor, which has a `Typed` constraint. However, the `XEmptyArray` and `XArray` data constructors do not record evidence that their array element types were instances of the `Typed` class, which makes it impossible to use them in `valFromExpr`. This commit adds the necessary constraints to each data constructor to make their array elements `Typed`. --- .../src/Copilot/Theorem/What4/Translate.hs | 57 ++++++++++++------- 1 file changed, 36 insertions(+), 21 deletions(-) diff --git a/copilot-theorem/src/Copilot/Theorem/What4/Translate.hs b/copilot-theorem/src/Copilot/Theorem/What4/Translate.hs index f6ced33b7..cef4829ee 100644 --- a/copilot-theorem/src/Copilot/Theorem/What4/Translate.hs +++ b/copilot-theorem/src/Copilot/Theorem/What4/Translate.hs @@ -56,7 +56,7 @@ import Data.Parameterized.NatRepr (LeqProof (..), NatCases (..), intValue, isZeroOrGT1, knownNat, minusPlusCancel, mkNatRepr, testNatCases, - testStrictLeq) + testStrictLeq, withKnownNat) import Data.Parameterized.Some (Some (..)) import Data.Parameterized.SymbolRepr (SymbolRepr, knownSymbol) import qualified Data.Parameterized.Vector as V @@ -370,10 +370,10 @@ translateConstExpr sym tp a = case tp of elts <- traverse (translateConstExpr sym tp) (CT.arrayElems a) Some n <- return $ mkNatRepr (genericLength elts) case isZeroOrGT1 n of - Left Refl -> return XEmptyArray + Left Refl -> return $ XEmptyArray tp Right LeqProof -> do let Just v = V.fromList n elts - return $ XArray v + return $ withKnownNat n $ XArray v CT.Struct _ -> do elts <- forM (CT.toValues a) $ \(CT.Value tp (CT.Field a)) -> translateConstExpr sym tp a @@ -409,7 +409,7 @@ freshCPConstant sym nm tp = case tp of atp@(CT.Array itp) -> do let n = arrayLen atp case isZeroOrGT1 n of - Left Refl -> return XEmptyArray + Left Refl -> return $ XEmptyArray itp Right LeqProof -> do Refl <- return $ minusPlusCancel n (knownNat @1) elts :: V.Vector n (XExpr t) <- @@ -1281,7 +1281,13 @@ mkIte sym pred xe1 xe2 = case (xe1, xe2) of XDouble <$> WFP.iFloatIte @_ @WFP.DoubleFloat sym pred e1 e2 (XStruct xes1, XStruct xes2) -> XStruct <$> zipWithM (mkIte sym pred) xes1 xes2 - (XEmptyArray, XEmptyArray) -> return XEmptyArray + (XEmptyArray tp1, XEmptyArray tp2) -> + case tp1 `testEquality` tp2 of + Just Refl -> return (XEmptyArray tp1) + Nothing -> panic [ "Element type mismatch in ite" + , show tp1 + , show tp2 + ] (XArray xes1, XArray xes2) -> case V.length xes1 `testEquality` V.length xes2 of Just Refl -> XArray <$> V.zipWithM (mkIte sym pred) xes1 xes2 @@ -1438,25 +1444,34 @@ data XExpr sym where sym (WFP.SymInterpretedFloatType sym WFP.DoubleFloat) -> XExpr sym - XEmptyArray :: XExpr sym - XArray :: 1 <= n => V.Vector n (XExpr sym) -> XExpr sym + + -- | An empty array. The 'CT.Typed' constraint and accompanying 'CT.Type' + -- field are necessary in order to record evidence that the array type can be + -- used in a context where 'CT.Typed' is required. + XEmptyArray :: CT.Typed t => CT.Type t -> XExpr sym + + -- | A non-empty array. The 'KnownNat' constraint is necessary in order to + -- record evidence that the array type can be used in a context for 'CT.Typed' + -- is required. + XArray :: (KnownNat n, 1 <= n) => V.Vector n (XExpr sym) -> XExpr sym + XStruct :: [XExpr sym] -> XExpr sym instance WI.IsExprBuilder sym => Show (XExpr sym) where - show (XBool e) = "XBool " ++ show (WI.printSymExpr e) - show (XInt8 e) = "XInt8 " ++ show (WI.printSymExpr e) - show (XInt16 e) = "XInt16 " ++ show (WI.printSymExpr e) - show (XInt32 e) = "XInt32 " ++ show (WI.printSymExpr e) - show (XInt64 e) = "XInt64 " ++ show (WI.printSymExpr e) - show (XWord8 e) = "XWord8 " ++ show (WI.printSymExpr e) - show (XWord16 e) = "XWord16 " ++ show (WI.printSymExpr e) - show (XWord32 e) = "XWord32 " ++ show (WI.printSymExpr e) - show (XWord64 e) = "XWord64 " ++ show (WI.printSymExpr e) - show (XFloat e) = "XFloat " ++ show (WI.printSymExpr e) - show (XDouble e) = "XDouble " ++ show (WI.printSymExpr e) - show XEmptyArray = "[]" - show (XArray vs) = showList (V.toList vs) "" - show (XStruct xs) = "XStruct " ++ showList xs "" + show (XBool e) = "XBool " ++ show (WI.printSymExpr e) + show (XInt8 e) = "XInt8 " ++ show (WI.printSymExpr e) + show (XInt16 e) = "XInt16 " ++ show (WI.printSymExpr e) + show (XInt32 e) = "XInt32 " ++ show (WI.printSymExpr e) + show (XInt64 e) = "XInt64 " ++ show (WI.printSymExpr e) + show (XWord8 e) = "XWord8 " ++ show (WI.printSymExpr e) + show (XWord16 e) = "XWord16 " ++ show (WI.printSymExpr e) + show (XWord32 e) = "XWord32 " ++ show (WI.printSymExpr e) + show (XWord64 e) = "XWord64 " ++ show (WI.printSymExpr e) + show (XFloat e) = "XFloat " ++ show (WI.printSymExpr e) + show (XDouble e) = "XDouble " ++ show (WI.printSymExpr e) + show (XEmptyArray _) = "[]" + show (XArray vs) = showList (V.toList vs) "" + show (XStruct xs) = "XStruct " ++ showList xs "" -- * Stream offsets From e23df09d3c8b2312269a4824c35ed0900dec4b30 Mon Sep 17 00:00:00 2001 From: Ryan Scott Date: Mon, 10 Feb 2025 11:36:21 -0500 Subject: [PATCH 0895/1222] copilot-theorem: Add XEmptyArray and XArray cases for valFromExpr. Refs #589. Currently, the `Copilot.Theorem.What4.prove` function returns a list of results, where each result contains a `SatResult` that describes whether a property is `Valid`, `Invalid`, or `Unknown`. The `Invalid` result has the limitation that it does not give any information about a specific counterexample that could drive Copilot into falsifying the property, however. This makes it challenging to interpret what the results of prove mean. The `valFromExpr` function (which produces concrete values when making a counterexample) was lacking cases for `XEmptyArray` and `XArray`, so it would fail if the function was called on these values. This commit adds these missing cases, which make use of the `Typed` evidence added to `XEmptyArray` and `XArray` in a previous commit. We do not yet add a case for structs, which prove more challenging. --- copilot-theorem/src/Copilot/Theorem/What4.hs | 36 ++++++++++++++++---- 1 file changed, 29 insertions(+), 7 deletions(-) diff --git a/copilot-theorem/src/Copilot/Theorem/What4.hs b/copilot-theorem/src/Copilot/Theorem/What4.hs index 960df8d93..76ebd90f6 100644 --- a/copilot-theorem/src/Copilot/Theorem/What4.hs +++ b/copilot-theorem/src/Copilot/Theorem/What4.hs @@ -45,9 +45,10 @@ module Copilot.Theorem.What4 , XExpr(..) ) where -import qualified Copilot.Core.Expr as CE -import qualified Copilot.Core.Spec as CS -import qualified Copilot.Core.Type as CT +import qualified Copilot.Core.Expr as CE +import qualified Copilot.Core.Spec as CS +import qualified Copilot.Core.Type as CT +import qualified Copilot.Core.Type.Array as CTA import qualified What4.Config as WC import qualified What4.Expr.Builder as WB @@ -66,6 +67,7 @@ import qualified Data.Map as Map import Data.Parameterized.NatRepr import Data.Parameterized.Nonce import Data.Parameterized.Some +import qualified Data.Parameterized.Vector as V import GHC.Float (castWord32ToFloat, castWord64ToDouble) import LibBF (BigFloat, bfToDouble, pattern NearEven) import qualified Panic as Panic @@ -387,10 +389,14 @@ expectedBool :: forall m sym a. expectedBool what xe = panic [what ++ " expected to have boolean result", show xe] -data CopilotValue a = CopilotValue { cvType :: CT.Type a - , cvVal :: a - } +-- | A Copilot value paired with its 'CT.Type'. +data CopilotValue a where + CopilotValue :: CT.Typed a => CT.Type a -> a -> CopilotValue a +-- | Convert a symbolic 'XExpr' into a concrete 'CopilotValue'. +-- +-- Struct values are not currently supported, so attempting to convert an +-- 'XStruct' value will raise an error. valFromExpr :: forall sym t st fm. ( sym ~ WB.ExprBuilder t st (WB.Flags fm) , WI.KnownRepr WB.FloatModeRepr fm @@ -420,7 +426,23 @@ valFromExpr ge xe = case xe of (fst . bfToDouble NearEven) fromRational (castWord64ToDouble . fromInteger . BV.asUnsigned) - _ -> error "valFromExpr unhandled case" + XEmptyArray tp -> + pure $ Some $ CopilotValue (CT.Array @0 tp) (CTA.array []) + XArray es -> do + (someCVs :: V.Vector n (Some CopilotValue)) <- traverse (valFromExpr ge) es + (Some (CopilotValue headTp _headVal), _) <- pure $ V.uncons someCVs + cvs <- + traverse + (\(Some (CopilotValue tp val)) -> + case tp `testEquality` headTp of + Just Refl -> pure val + Nothing -> panic [ "XArray with mismatched element types" + , show tp + , show headTp + ]) + someCVs + pure $ Some $ CopilotValue (CT.Array @n headTp) (CTA.array (V.toList cvs)) + XStruct _ -> error "valFromExpr: Structs not currently handled" where fromBV :: forall a w . Num a => BV.BV w -> a fromBV = fromInteger . BV.asUnsigned From c5ea1c0451b46157cf1c27e8f8607c7877f6ff8f Mon Sep 17 00:00:00 2001 From: Ryan Scott Date: Mon, 24 Feb 2025 16:00:49 -0500 Subject: [PATCH 0896/1222] copilot-theorem: Add function to produce counterexamples for invalid properties. Refs #589. Currently, the `Copilot.Theorem.What4.prove` function returns a list of results, where each result contains a `SatResult` that describes whether a property is `Valid`, `Invalid`, or `Unknown`. The `Invalid` result has the limitation that it does not give any information about a specific counterexample that could drive Copilot into falsifying the property, however. This makes it challenging to interpret what the results of prove mean. This introduces a new `proveWithCounterExample` function to `Copilot.Theorem.What4` that mirrors the type signature of `prove`, except that it returns a variant of `SatResult` (`SatResultCex`) where the `Invalid` equivalent (`InvalidCex`) encodes counterexample information. `copilot-theorem` users can then interpret the results of the counterexample in Copilot specifications. As part of this commit, we change the definition of the `CounterExample` data type. This is safe to do, as `CounterExample` was completely unused prior to this commit, nor was it exported. --- copilot-theorem/src/Copilot/Theorem/What4.hs | 269 +++++++++++++++++-- 1 file changed, 250 insertions(+), 19 deletions(-) diff --git a/copilot-theorem/src/Copilot/Theorem/What4.hs b/copilot-theorem/src/Copilot/Theorem/What4.hs index 76ebd90f6..6e3fd53a9 100644 --- a/copilot-theorem/src/Copilot/Theorem/What4.hs +++ b/copilot-theorem/src/Copilot/Theorem/What4.hs @@ -37,12 +37,17 @@ module Copilot.Theorem.What4 prove , Solver(..) , SatResult(..) + , proveWithCounterExample + , SatResultCex(..) + , CounterExample(..) -- * Bisimulation proofs about @copilot-c99@ code , computeBisimulationProofBundle , BisimulationProofBundle(..) , BisimulationProofState(..) -- * What4 representations of Copilot expressions , XExpr(..) + , CopilotValue(..) + , StreamOffset(..) ) where import qualified Copilot.Core.Expr as CE @@ -91,7 +96,160 @@ data Solver = CVC4 | DReal | Yices | Z3 data SatResult = Valid | Invalid | Unknown deriving Show -type CounterExample = [(String, Some CopilotValue)] +-- | The 'proveWithCounterExample' function returns results of this form for +-- each property in a spec. This is largely the same as 'SatResult', except that +-- 'InvalidCex' also records a 'CounterExample'. +data SatResultCex = ValidCex | InvalidCex CounterExample | UnknownCex + +-- | Concrete values that cause a property in a Copilot specification to be +-- invalid. As a simple example, consider the following spec: +-- +-- @ +-- spec :: Spec +-- spec = do +-- let s :: Stream Bool +-- s = [False] ++ constant True +-- void $ prop "should be invalid" (forAll s) +-- @ +-- +-- This defines a stream @s@ where the first value is @False@, but all +-- subsequent values are @True@'. This is used in a property that asserts that +-- the values in @s@ will be @True@ at all possible time steps. This is clearly +-- not true, given that @s@'s first value is @False@. As such, we would expect +-- that proving this property would yield an 'InvalidCex' result, where one of +-- the base cases would state that the @s@ stream contains a @False@ value. +-- +-- We can use the 'proveWithCounterExample' function to query an SMT solver to +-- compute a counterexample: +-- +-- @ +-- CounterExample +-- { 'baseCases' = +-- [False] +-- , 'inductionStep' = +-- True +-- , 'concreteExternVars' = +-- fromList [] +-- , 'concreteStreamValues' = +-- fromList +-- [ ( (0, 'AbsoluteOffset' 0), False ) +-- , ( (0, 'RelativeOffset' 0), False ) +-- , ( (0, 'RelativeOffset' 1), True ) +-- ] +-- } +-- @ +-- +-- Let's go over what this counterexample is saying: +-- +-- * The 'inductionStep' of the proof is 'True', so that part of the proof was +-- successful. On the other hand, the 'baseCases' contain a 'False', so the +-- proof was falsified when proving the base cases. (In this case, the list +-- has only one element, so there is only a single base case.) +-- +-- * 'concreteStreamValues' reports the SMT solver's concrete values for each +-- stream during relevant parts of the proof as a 'Map.Map'. +-- +-- The keys of the map are pairs. The first element of the pair is the stream +-- 'CE.Id', and in this example, the only 'CE.Id' is @0@, corresponding to the +-- stream @s@. The second element is the time offset. An 'AbsoluteOffset' +-- indicates an offset starting from the initial time step, and a +-- 'RelativeOffset' indicates an offset from an arbitrary point in time. +-- 'AbsoluteOffset's are used in the base cases of the proof, and +-- 'RelativeOffset's are used in the induction step of the proof. +-- +-- The part of the map that is most interesting to us is the +-- @( (0, 'AbsoluteOffset' 0), False )@ entry, which represents a base case +-- where there is a value of @False@ in the stream @s@ during the initial time +-- step. Sure enough, this is enough to falsify the property @forAll s@. +-- +-- * There are no extern streams in this example, so 'concreteExternVars' is +-- empty. +-- +-- We can also see an example of where a proof succeeds in the base cases, but +-- fails during the induction step: +-- +-- @ +-- spec :: Spec +-- spec = do +-- let t :: Stream Bool +-- t = [True] ++ constant False +-- void $ prop "should also be invalid" (forAll t) +-- @ +-- +-- With the @t@ stream above, the base cases will succeed +-- ('proveWithCounterExample' uses @k@-induction with a value of @k == 1@ in +-- this example, so there will only be a single base case). On the other hand, +-- the induction step will fail, as later values in the stream will be @False@. +-- If we try to 'proveWithCounterExample' this property, then it will fail with: +-- +-- @ +-- CounterExample +-- { 'baseCases' = +-- [True] +-- , 'inductionStep' = +-- False +-- , 'concreteExternVars' = +-- fromList [] +-- , 'concreteStreamValues' = +-- fromList +-- [ ( (0, 'AbsoluteOffset' 0), True ) +-- , ( (0, 'RelativeOffset' 0), True ) +-- , ( (0, 'RelativeOffset' 1), False ) +-- ] +-- } +-- @ +-- +-- This time, the 'inductionStep' is 'False'. If we look at the +-- 'concreteStreamValues', we see the values at @'RelativeOffset' 0@ and +-- @'RelativeOffset' 1@ (which are relevant to the induction step) are @True@ +-- and @False@, respectively. Since this is a proof by @k@-induction where +-- @k == 1@, the fact that the value at @'RelativeOffset 1@ is @False@ indicates +-- that the induction step was falsified. +-- +-- Note that this proof does not say /when/ exactly the time steps at +-- @'RelativeOffset' 0@ or @'RelativeOffset' 1@ occur, only that that will occur +-- relative to some arbitrary point in time. In this example, they occur +-- relative to the initial time step, so @'RelativeOffset' 1@ would occur at the +-- second time step overall. In general, however, these time steps may occur far +-- in the future, so it is possible that one would need to step through the +-- execution of the streams for quite some time before finding the +-- counterexample. +-- +-- Be aware that counterexamples involving struct values are not currently +-- supported. +data CounterExample = CounterExample + { -- | A list of base cases in the proof, where each entry in the list + -- corresponds to a particular time step. For instance, the first element + -- in the list corresponds to the initial time step, the second element in + -- the list corresponds to the second time step, and so on. A 'False' entry + -- anywhere in this list will cause the overall proof to be 'InvalidCex'. + -- + -- Because the proof uses @k@-induction, the number of base cases (i.e., the + -- number of entries in this list) is equal to the value of @k@, which is + -- chosen using heuristics. + baseCases :: [Bool] + -- | Whether the induction step of the proof was valid or not. That is, + -- given an arbitrary time step @n@, if the property is assumed to hold at + -- time steps @n@, @n+1@, ..., @n+k@, then this will be @True@ is the + -- property can the be proven to hold at time step @n+k+1@ (and 'False' + -- otherwise). If this is 'False', then the overall proof will be + -- 'InvalidCex'. + , inductionStep :: Bool + -- | The concrete values in the Copilot specification's extern streams that + -- lead to the property being invalid. + -- + -- Each key in the 'Map.Map' is the 'CE.Name' of an extern stream paired + -- with a 'StreamOffset' representing the time step. The key's corresponding + -- value is the concrete value of the extern stream at that time step. + , concreteExternValues :: Map.Map (CE.Name, StreamOffset) (Some CopilotValue) + -- | The concrete values in the Copilot specification's streams (excluding + -- extern streams) that lead to the property being invalid. + -- + -- Each key in the 'Map.Map' is the 'CE.Id' of a stream paired with a + -- 'StreamOffset' representing the time step. The key's corresponding value + -- is the concrete value of the extern stream at that time step. + , concreteStreamValues :: Map.Map (CE.Id, StreamOffset) (Some CopilotValue) + } -- | Attempt to prove all of the properties in a spec via an SMT solver (which -- must be installed locally on the host). Return an association list mapping @@ -101,7 +259,73 @@ prove :: Solver -> CS.Spec -- ^ Spec -> IO [(CE.Name, SatResult)] -prove solver spec = do +prove solver spec = proveInternal solver spec $ \_ _ _ satRes -> + case satRes of + WS.Sat _ -> pure Invalid + WS.Unsat _ -> pure Valid + WS.Unknown -> pure Unknown + +-- | Attempt to prove all of the properties in a spec via an SMT solver (which +-- must be installed locally on the host). Return an association list mapping +-- the names of each property to the result returned by the solver. +-- +-- Unlike 'prove', 'proveWithCounterExample' returns a 'SatResultCex'. This +-- means that if a result is invalid, then it will include a 'CounterExample' +-- which describes the circumstances under which the property was falsified. See +-- the Haddocks for 'CounterExample' for more details. +-- +-- Note that this function does not currently support creating counterexamples +-- involving struct values, so attempting to call 'proveWithCounterExample' on a +-- specification that uses structs will raise an error. +proveWithCounterExample :: Solver + -- ^ Solver to use + -> CS.Spec + -- ^ Spec + -> IO [(CE.Name, SatResultCex)] +proveWithCounterExample solver spec = + proveInternal solver spec $ \baseCases indStep st satRes -> + case satRes of + WS.Sat ge -> do + gBaseCases <- traverse (WG.groundEval ge) baseCases + gIndStep <- WG.groundEval ge indStep + gExternValues <- traverse (valFromExpr ge) (externVars st) + gStreamValues <- traverse (valFromExpr ge) (streamValues st) + let cex = CounterExample + { baseCases = gBaseCases + , inductionStep = gIndStep + , concreteExternValues = gExternValues + , concreteStreamValues = gStreamValues + } + pure (InvalidCex cex) + WS.Unsat _ -> pure ValidCex + WS.Unknown -> pure UnknownCex + +-- | Attempt to prove all of the properties in a spec via an SMT solver (which +-- must be installed locally on the host). For each 'WS.SatResult' returned by +-- the solver, pass it to a continuation along with the relevant parts of the +-- proof-related state. +-- +-- This is an internal-only function that is used to power 'prove' and +-- 'proveWithCounterExample'. +proveInternal :: Solver + -- ^ Solver to use + -> CS.Spec + -- ^ Spec + -> (forall sym t st fm + . ( sym ~ WB.ExprBuilder t st (WB.Flags fm) + , WI.KnownRepr WB.FloatModeRepr fm ) + => [WI.Pred sym] + -- The proof's base cases + -> WI.Pred sym + -- The proof's induction step + -> TransState sym + -- The proof state + -> WS.SatResult (WG.GroundEvalFn t) () + -- The overall result of the proof + -> IO a) + -- ^ Continuation to call on each solver result + -> IO [(CE.Name, a)] +proveInternal solver spec k = do -- Setup symbolic backend Some ng <- newIONonceGenerator sym <- WB.newExprBuilder WB.FloatIEEERepr EmptyState ng @@ -155,23 +379,30 @@ prove solver spec = do not_p <- liftIO $ WI.notPred sym p let clauses = [not_p] - case solver of - CVC4 -> liftIO $ WS.runCVC4InOverride sym WS.defaultLogData clauses $ \case - WS.Sat (_ge, _) -> return (CS.propertyName pr, Invalid) - WS.Unsat _ -> return (CS.propertyName pr, Valid) - WS.Unknown -> return (CS.propertyName pr, Unknown) - DReal -> liftIO $ WS.runDRealInOverride sym WS.defaultLogData clauses $ \case - WS.Sat (_ge, _) -> return (CS.propertyName pr, Invalid) - WS.Unsat _ -> return (CS.propertyName pr, Valid) - WS.Unknown -> return (CS.propertyName pr, Unknown) - Yices -> liftIO $ WS.runYicesInOverride sym WS.defaultLogData clauses $ \case - WS.Sat _ge -> return (CS.propertyName pr, Invalid) - WS.Unsat _ -> return (CS.propertyName pr, Valid) - WS.Unknown -> return (CS.propertyName pr, Unknown) - Z3 -> liftIO $ WS.runZ3InOverride sym WS.defaultLogData clauses $ \case - WS.Sat (_ge, _) -> return (CS.propertyName pr, Invalid) - WS.Unsat _ -> return (CS.propertyName pr, Valid) - WS.Unknown -> return (CS.propertyName pr, Unknown) + st <- get + let k' = k base_cases ind_case st + satRes <- + case solver of + CVC4 -> liftIO $ WS.runCVC4InOverride sym WS.defaultLogData clauses $ \case + WS.Sat (ge, _) -> k' (WS.Sat ge) + WS.Unsat x -> k' (WS.Unsat x) + WS.Unknown -> k' WS.Unknown + DReal -> liftIO $ WS.runDRealInOverride sym WS.defaultLogData clauses $ \case + WS.Sat (c, m) -> do + ge <- WS.getAvgBindings c m + k' (WS.Sat ge) + WS.Unsat x -> k' (WS.Unsat x) + WS.Unknown -> k' WS.Unknown + Yices -> liftIO $ WS.runYicesInOverride sym WS.defaultLogData clauses $ \case + WS.Sat ge -> k' (WS.Sat ge) + WS.Unsat x -> k' (WS.Unsat x) + WS.Unknown -> k' WS.Unknown + Z3 -> liftIO $ WS.runZ3InOverride sym WS.defaultLogData clauses $ \case + WS.Sat (ge, _) -> k' (WS.Sat ge) + WS.Unsat x -> k' (WS.Unsat x) + WS.Unknown -> k' WS.Unknown + + pure (CS.propertyName pr, satRes) -- Execute the action and return the results for each property runTransM spec proveProperties From 8d2a643035e6158ca1e6d450aee04659b108f578 Mon Sep 17 00:00:00 2001 From: Ryan Scott Date: Mon, 10 Feb 2025 12:19:26 -0500 Subject: [PATCH 0897/1222] copilot-theorem: Add Show and ShowF instances for counterexamples. Refs #589. Currently, the `Copilot.Theorem.What4.prove` function returns a list of results, where each result contains a `SatResult` that describes whether a property is `Valid`, `Invalid`, or `Unknown`. The `Invalid` result has the limitation that it does not give any information about a specific counterexample that could drive Copilot into falsifying the property, however. This makes it challenging to interpret what the results of prove mean. The `CounterExample`, `SatResultCex`, and `CopilotValue` data types lack `Show` and `ShowF` instances, which makes it impractical for users to display them. This commit adds `Show` and `ShowF` instances for all three data types so that they can be shown. --- copilot-theorem/src/Copilot/Theorem/What4.hs | 88 +++++++++++++------- 1 file changed, 56 insertions(+), 32 deletions(-) diff --git a/copilot-theorem/src/Copilot/Theorem/What4.hs b/copilot-theorem/src/Copilot/Theorem/What4.hs index 6e3fd53a9..eb692378f 100644 --- a/copilot-theorem/src/Copilot/Theorem/What4.hs +++ b/copilot-theorem/src/Copilot/Theorem/What4.hs @@ -69,6 +69,7 @@ import qualified Data.BitVector.Sized as BV import Data.Foldable (foldrM) import Data.List (genericLength) import qualified Data.Map as Map +import Data.Parameterized.Classes (ShowF) import Data.Parameterized.NatRepr import Data.Parameterized.Nonce import Data.Parameterized.Some @@ -100,6 +101,7 @@ data SatResult = Valid | Invalid | Unknown -- each property in a spec. This is largely the same as 'SatResult', except that -- 'InvalidCex' also records a 'CounterExample'. data SatResultCex = ValidCex | InvalidCex CounterExample | UnknownCex + deriving Show -- | Concrete values that cause a property in a Copilot specification to be -- invalid. As a simple example, consider the following spec: @@ -218,38 +220,42 @@ data SatResultCex = ValidCex | InvalidCex CounterExample | UnknownCex -- Be aware that counterexamples involving struct values are not currently -- supported. data CounterExample = CounterExample - { -- | A list of base cases in the proof, where each entry in the list - -- corresponds to a particular time step. For instance, the first element - -- in the list corresponds to the initial time step, the second element in - -- the list corresponds to the second time step, and so on. A 'False' entry - -- anywhere in this list will cause the overall proof to be 'InvalidCex'. - -- - -- Because the proof uses @k@-induction, the number of base cases (i.e., the - -- number of entries in this list) is equal to the value of @k@, which is - -- chosen using heuristics. - baseCases :: [Bool] - -- | Whether the induction step of the proof was valid or not. That is, - -- given an arbitrary time step @n@, if the property is assumed to hold at - -- time steps @n@, @n+1@, ..., @n+k@, then this will be @True@ is the - -- property can the be proven to hold at time step @n+k+1@ (and 'False' - -- otherwise). If this is 'False', then the overall proof will be - -- 'InvalidCex'. - , inductionStep :: Bool - -- | The concrete values in the Copilot specification's extern streams that - -- lead to the property being invalid. - -- - -- Each key in the 'Map.Map' is the 'CE.Name' of an extern stream paired - -- with a 'StreamOffset' representing the time step. The key's corresponding - -- value is the concrete value of the extern stream at that time step. - , concreteExternValues :: Map.Map (CE.Name, StreamOffset) (Some CopilotValue) - -- | The concrete values in the Copilot specification's streams (excluding - -- extern streams) that lead to the property being invalid. - -- - -- Each key in the 'Map.Map' is the 'CE.Id' of a stream paired with a - -- 'StreamOffset' representing the time step. The key's corresponding value - -- is the concrete value of the extern stream at that time step. - , concreteStreamValues :: Map.Map (CE.Id, StreamOffset) (Some CopilotValue) - } + { -- | A list of base cases in the proof, where each entry in the list + -- corresponds to a particular time step. For instance, the first element + -- in the list corresponds to the initial time step, the second element + -- in the list corresponds to the second time step, and so on. A 'False' + -- entry anywhere in this list will cause the overall proof to be + -- 'InvalidCex'. + -- + -- Because the proof uses @k@-induction, the number of base cases (i.e., + -- the number of entries in this list) is equal to the value of @k@, + -- which is chosen using heuristics. + baseCases :: [Bool] + -- | Whether the induction step of the proof was valid or not. That is, + -- given an arbitrary time step @n@, if the property is assumed to hold + -- at time steps @n@, @n+1@, ..., @n+k@, then this will be @True@ is the + -- property can the be proven to hold at time step @n+k+1@ (and 'False' + -- otherwise). If this is 'False', then the overall proof will be + -- 'InvalidCex'. + , inductionStep :: Bool + -- | The concrete values in the Copilot specification's extern streams + -- that lead to the property being invalid. + -- + -- Each key in the 'Map.Map' is the 'CE.Name' of an extern stream paired + -- with a 'StreamOffset' representing the time step. The key's + -- corresponding value is the concrete value of the extern stream at that + -- time step. + , concreteExternValues :: + Map.Map (CE.Name, StreamOffset) (Some CopilotValue) + -- | The concrete values in the Copilot specification's streams + -- (excluding extern streams) that lead to the property being invalid. + -- + -- Each key in the 'Map.Map' is the 'CE.Id' of a stream paired with a + -- 'StreamOffset' representing the time step. The key's corresponding + -- value is the concrete value of the extern stream at that time step. + , concreteStreamValues :: Map.Map (CE.Id, StreamOffset) (Some CopilotValue) + } + deriving Show -- | Attempt to prove all of the properties in a spec via an SMT solver (which -- must be installed locally on the host). Return an association list mapping @@ -624,6 +630,24 @@ expectedBool what xe = data CopilotValue a where CopilotValue :: CT.Typed a => CT.Type a -> a -> CopilotValue a +instance Show (CopilotValue a) where + showsPrec p (CopilotValue ty val) = + case ty of + CT.Bool -> showsPrec p val + CT.Int8 -> showsPrec p val + CT.Int16 -> showsPrec p val + CT.Int32 -> showsPrec p val + CT.Int64 -> showsPrec p val + CT.Word8 -> showsPrec p val + CT.Word16 -> showsPrec p val + CT.Word32 -> showsPrec p val + CT.Word64 -> showsPrec p val + CT.Float -> showsPrec p val + CT.Double -> showsPrec p val + CT.Array {} -> showsPrec p val + CT.Struct {} -> showsPrec p val +instance ShowF CopilotValue + -- | Convert a symbolic 'XExpr' into a concrete 'CopilotValue'. -- -- Struct values are not currently supported, so attempting to convert an From 0727256b0cfafbe458dc7df8d8134ff766cf3d00 Mon Sep 17 00:00:00 2001 From: Ryan Scott Date: Mon, 24 Feb 2025 16:01:09 -0500 Subject: [PATCH 0898/1222] copilot-theorem: Add test cases for proveWithCounterExample. Refs #589. Currently, the `Copilot.Theorem.What4.prove` function returns a list of results, where each result contains a `SatResult` that describes whether a property is `Valid`, `Invalid`, or `Unknown`. The `Invalid` result has the limitation that it does not give any information about a specific counterexample that could drive Copilot into falsifying the property, however. This makes it challenging to interpret what the results of prove mean. A prior commit has introduced a `proveWithCounterExample` function, which provides a counterexample when a property is proven invalid. This commit updates the test suite to ensure that basic uses of `proveWithCounterExample` work as intended. --- copilot-theorem/copilot-theorem.cabal | 1 + .../tests/Test/Copilot/Theorem/What4.hs | 123 ++++++++++++++++-- 2 files changed, 113 insertions(+), 11 deletions(-) diff --git a/copilot-theorem/copilot-theorem.cabal b/copilot-theorem/copilot-theorem.cabal index e708c0a6c..c3d2496dc 100644 --- a/copilot-theorem/copilot-theorem.cabal +++ b/copilot-theorem/copilot-theorem.cabal @@ -121,6 +121,7 @@ test-suite unit-tests build-depends: base + , HUnit , QuickCheck , test-framework , test-framework-quickcheck2 diff --git a/copilot-theorem/tests/Test/Copilot/Theorem/What4.hs b/copilot-theorem/tests/Test/Copilot/Theorem/What4.hs index dbd98eb4a..751310b5e 100644 --- a/copilot-theorem/tests/Test/Copilot/Theorem/What4.hs +++ b/copilot-theorem/tests/Test/Copilot/Theorem/What4.hs @@ -10,14 +10,15 @@ import Data.Int (Int8) import Data.Word (Word32) import Test.Framework (Test, testGroup) import Test.Framework.Providers.QuickCheck2 (testProperty) +import Test.HUnit (assertFailure) import Test.QuickCheck (Arbitrary (arbitrary), Property, arbitrary, forAll) import Test.QuickCheck.Monadic (monadicIO, run) -- External imports: Copilot -import Copilot.Core.Expr (Expr (Const, Op1, Op2)) +import Copilot.Core.Expr (Expr (Const, Drop, Op1, Op2), Id) import Copilot.Core.Operators (Op1 (..), Op2 (..)) -import Copilot.Core.Spec (Spec (..)) +import Copilot.Core.Spec (Spec (..), Stream (..)) import qualified Copilot.Core.Spec as Copilot import Copilot.Core.Type (Field (..), Struct (toValues, typeName), @@ -25,7 +26,9 @@ import Copilot.Core.Type (Field (..), Value (..)) -- Internal imports: Modules being tested -import Copilot.Theorem.What4 (SatResult (..), Solver (..), prove) +import Copilot.Theorem.What4 (CounterExample (..), SatResult (..), + SatResultCex (..), Solver (..), prove, + proveWithCounterExample) -- * Constants @@ -37,6 +40,8 @@ tests = , testProperty "Prove via Z3 that false is invalid" testProveZ3False , testProperty "Prove via Z3 that x == x is valid" testProveZ3EqConst , testProperty "Prove via Z3 that a struct update is valid" testProveZ3StructUpdate + , testProperty "Counterexample with invalid base case" testCounterExampleBaseCase + , testProperty "Counterexample with invalid induction step" testCounterExampleInductionStep ] -- * Individual tests @@ -53,7 +58,7 @@ testProveZ3True = propName = "prop" spec :: Spec - spec = propSpec propName $ Const typeOf True + spec = propSpec propName [] $ Const typeOf True -- | Test that Z3 is able to prove the following expression invalid: -- @ @@ -67,7 +72,7 @@ testProveZ3False = propName = "prop" spec :: Spec - spec = propSpec propName $ Const typeOf False + spec = propSpec propName [] $ Const typeOf False -- | Test that Z3 is able to prove the following expresion valid: -- @ @@ -81,7 +86,7 @@ testProveZ3EqConst = forAll arbitrary $ \x -> propName = "prop" spec :: Int8 -> Spec - spec x = propSpec propName $ + spec x = propSpec propName [] $ Op2 (Eq typeOf) (Const typeOf x) (Const typeOf x) -- | Test that Z3 is able to prove the following expresion valid: @@ -97,7 +102,7 @@ testProveZ3StructUpdate = forAll arbitrary $ \x -> propName = "prop" spec :: TestStruct -> Spec - spec s = propSpec propName $ + spec s = propSpec propName [] $ Op2 (Eq typeOf) (getField @@ -116,6 +121,70 @@ testProveZ3StructUpdate = forAll arbitrary $ \x -> add1 :: Expr Word32 -> Expr Word32 add1 x = Op2 (Add typeOf) x (Const typeOf 1) +-- | Test that Z3 is able to produce a counterexample to the following property, +-- where the base case is proved invalid: +-- +-- @ +-- let s :: Stream Bool +-- s = [False] ++ constant True +-- in forAll s +-- @ +testCounterExampleBaseCase :: Property +testCounterExampleBaseCase = + monadicIO $ run $ + checkCounterExample Z3 propName spec $ \cex -> + pure $ not $ and $ baseCases cex + where + propName :: String + propName = "prop" + + -- s = [False] ++ constant True + s :: Stream + s = Stream + { streamId = sId + , streamBuffer = [False] + , streamExpr = Const typeOf True + , streamExprType = typeOf + } + + sId :: Id + sId = 0 + + spec :: Spec + spec = propSpec propName [s] $ Drop typeOf 0 sId + +-- | Test that Z3 is able to produce a counterexample to the following property, +-- where the induction step is proved invalid: +-- +-- @ +-- let s :: Stream Bool +-- s = [True] ++ constant False +-- in forAll s +-- @ +testCounterExampleInductionStep :: Property +testCounterExampleInductionStep = + monadicIO $ run $ + checkCounterExample Z3 propName spec $ \cex -> + pure $ not $ inductionStep cex + where + propName :: String + propName = "prop" + + -- s = [True] ++ constant False + s :: Stream + s = Stream + { streamId = sId + , streamBuffer = [True] + , streamExpr = Const typeOf False + , streamExprType = typeOf + } + + sId :: Id + sId = 0 + + spec :: Spec + spec = propSpec propName [s] $ Drop typeOf 0 sId + -- | A simple data type with a 'Struct' instance and a 'Field'. This is only -- used as part of 'testProveZ3StructUpdate'. newtype TestStruct = TestStruct { testField :: Field "testField" Word32 } @@ -145,12 +214,44 @@ checkResult solver propName spec expectation = do -- does not exist in the results, in which case the lookup returns 'Nothing'. return $ propResult == Just expectation +-- | Check that the solver produces an invalid result for the given property and +-- that the resulting 'CounterExample' satifies the given predicate. +checkCounterExample :: Solver + -> String + -> Spec + -> (CounterExample -> IO Bool) + -> IO Bool +checkCounterExample solver propName spec cexPred = do + results <- proveWithCounterExample solver spec + + -- Find the satisfiability result for propName. If the property name does not + -- exist in the results, raise an assertion failure. + propResult <- + case lookup propName results of + Just propResult -> + pure propResult + Nothing -> + assertFailure $ + "Could not find property in results: " ++ propName + + -- Assert that the solver returned an invalid result and pass the + -- counterexample to the predicate. If the result is anything other than + -- invalid, raise an assertion failure. + case propResult of + InvalidCex cex -> + cexPred cex + ValidCex {} -> + assertFailure "Expected invalid result, but result was valid" + UnknownCex {} -> + assertFailure "Expected invalid result, but result was unknown" + -- * Auxiliary --- | Build a 'Spec' that contains one property with the given name and defined --- by the given boolean expression. -propSpec :: String -> Expr Bool -> Spec -propSpec propName propExpr = Spec [] [] [] [Copilot.Property propName propExpr] +-- | Build a 'Spec' that contains one property with the given name, which +-- contains the given streams, and is defined by the given boolean expression. +propSpec :: String -> [Stream] -> Expr Bool -> Spec +propSpec propName propStreams propExpr = + Spec propStreams [] [] [Copilot.Property propName propExpr] -- | Equality for 'SatResult'. -- From ed24a0e0026198ff8b6910f5eb36e08824ef4c8f Mon Sep 17 00:00:00 2001 From: Ryan Scott Date: Mon, 24 Feb 2025 17:25:46 -0500 Subject: [PATCH 0899/1222] copilot: Add example of how to use proveWithCounterExample. Refs #589. Currently, the `Copilot.Theorem.What4.prove` function returns a list of results, where each result contains a `SatResult` that describes whether a property is `Valid`, `Invalid`, or `Unknown`. The `Invalid` result has the limitation that it does not give any information about a specific counterexample that could drive Copilot into falsifying the property, however. This makes it challenging to interpret what the results of prove mean. To demonstrate how to effectively use the newly added `proveWithCounterExample` function, this commit adds a new `examples/what4/ArithmeticCounterExamples.hs` function that behaves like `examples/what4/Arithmetic.hs`, but using `proveWithCounterExamples` instead of `prove`. --- copilot/copilot.cabal | 13 +++ .../what4/ArithmeticCounterExamples.hs | 110 ++++++++++++++++++ 2 files changed, 123 insertions(+) create mode 100644 copilot/examples/what4/ArithmeticCounterExamples.hs diff --git a/copilot/copilot.cabal b/copilot/copilot.cabal index 2c1082075..272a3edb8 100644 --- a/copilot/copilot.cabal +++ b/copilot/copilot.cabal @@ -86,6 +86,19 @@ executable what4-arithmetic else buildable: False +executable what4-arithmetic-counterexamples + main-is: ArithmeticCounterExamples.hs + hs-source-dirs: examples/what4 + build-depends: base + , containers + , copilot + , copilot-theorem + default-language: Haskell2010 + if flag(examples) + buildable: True + else + buildable: False + executable what4-structs main-is: Structs.hs hs-source-dirs: examples/what4 diff --git a/copilot/examples/what4/ArithmeticCounterExamples.hs b/copilot/examples/what4/ArithmeticCounterExamples.hs new file mode 100644 index 000000000..d56f2b7b4 --- /dev/null +++ b/copilot/examples/what4/ArithmeticCounterExamples.hs @@ -0,0 +1,110 @@ +-- | An example showing the usage of the What4 backend in copilot-theorem for +-- simple arithmetic. This example uses the 'proveWithCounterExamples' function +-- to demonstrate counterexamples in the event of invalid properties. + +module Main where + +import qualified Prelude as P +import Control.Monad (void, forM_) +import qualified Data.Map as Map + +import Language.Copilot +import Copilot.Theorem.What4 + +spec :: Spec +spec = do + -- Define some external streams. Their values are not important, so external + -- streams suffice. + let eint8 :: Stream Int8 + eint8 = extern "eint8" Nothing + eword8 :: Stream Word8 + eword8 = extern "eword8" Nothing + efloat :: Stream Float + efloat = extern "efloat" Nothing + + -- The simplest example involving numbers: equality on constant values. + void $ prop "Example 1" (forAll ((constant (1 :: Int8)) == (constant 1))) + + -- Testing "a < a + 1". This should fail, because it isn't true. + void $ prop "Example 2" (forAll (eint8 < (eint8 + 1))) + + -- Adding another condition to the above property to make it true. + void $ prop "Example 3" (forAll ((eint8 < (eint8 + 1)) || (eint8 == 127))) + + -- Just like the previous example, but with words. + void $ prop "Example 4" (forAll ((eword8 < (eword8 + 1)) || (eword8 == 255))) + + -- An example with floats. + void $ prop "Example 5" (forAll ((2 * efloat) == (efloat + efloat))) + + -- Another example with floats. This fails, because it isn't true. + void $ prop "Example 6" (forAll ((efloat + 1) /= efloat)) + +main :: IO () +main = do + spec' <- reify spec + + -- Use Z3 to prove the properties. + results <- proveWithCounterExample Z3 spec' + + -- Print the results. + forM_ results $ \(nm, res) -> do + putStr $ nm <> ": " + case res of + ValidCex -> putStrLn "valid" + InvalidCex cex -> do + putStrLn "invalid" + putStrLn $ ppCounterExample cex + UnknownCex -> putStrLn "unknown" + +-- | Pretty-print a counterexample for user display. +ppCounterExample :: CounterExample -> String +ppCounterExample cex + | any P.not (baseCases cex) + = if Map.null baseCaseVals + then + " All possible extern values during the base case(s) " P.++ + "constitute a counterexample." + else + unlines $ + " The base cases failed with the following extern values:" : + map + (\((name, _), val) -> " " P.++ name P.++ ": " P.++ show val) + (Map.toList baseCaseVals) + + | P.not (inductionStep cex) + = if Map.null inductionStepVals + then + " All possible extern values during the induction step " P.++ + "constitute a counterexample." + else + unlines $ + " The induction step failed with the following extern values:" : + map + (\((name, _), val) -> " " P.++ name P.++ ": " P.++ show val) + (Map.toList inductionStepVals) + + | otherwise + = error $ + "ppCounterExample: " P.++ + "Counterexample without failing base cases or induction step" + where + allExternVals = concreteExternValues cex + + baseCaseVals = + Map.filterWithKey + (\(_, offset) _ -> + case offset of + AbsoluteOffset {} -> True + RelativeOffset {} -> False + ) + allExternVals + + inductionStepVals = + Map.filterWithKey + (\(_, offset) _ -> + case offset of + AbsoluteOffset {} -> False + RelativeOffset {} -> True + ) + allExternVals From a3d2310d5751692062678d44247046646b85fe7e Mon Sep 17 00:00:00 2001 From: Ryan Scott Date: Mon, 10 Feb 2025 12:25:49 -0500 Subject: [PATCH 0900/1222] copilot-core: Document changes in CHANGELOG. Refs #589. --- copilot-core/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot-core/CHANGELOG b/copilot-core/CHANGELOG index e51b49366..69de85d76 100644 --- a/copilot-core/CHANGELOG +++ b/copilot-core/CHANGELOG @@ -1,5 +1,6 @@ -2025-01-28 +2025-02-24 * Fix typo in documentation. (#587) + * Add a Show instance for Type. (#589) 2025-01-07 * Version bump (4.2). (#577) From 134bbdc201dac8934aa63601ceba9f81d7cf4afa Mon Sep 17 00:00:00 2001 From: Ryan Scott Date: Mon, 10 Feb 2025 12:27:49 -0500 Subject: [PATCH 0901/1222] copilot-theorem: Document changes in CHANGELOG. Refs #589. --- copilot-theorem/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot-theorem/CHANGELOG b/copilot-theorem/CHANGELOG index 4251f8875..f503de4e0 100644 --- a/copilot-theorem/CHANGELOG +++ b/copilot-theorem/CHANGELOG @@ -1,6 +1,7 @@ -2025-01-28 +2025-02-24 * Fix multiple typos in README. (#560) * Fix typo in documentation. (#587) + * Add function to produce counterexamples for invalid properties. (#589) 2025-01-07 * Version bump (4.2). (#577) From 9861071718850fb8ef85e533a6c0d6d083f69094 Mon Sep 17 00:00:00 2001 From: Ryan Scott Date: Mon, 24 Feb 2025 17:29:55 -0500 Subject: [PATCH 0902/1222] copilot: Document changes in CHANGELOG. Refs #589. --- copilot/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot/CHANGELOG b/copilot/CHANGELOG index d6574cd3e..64c5f7535 100644 --- a/copilot/CHANGELOG +++ b/copilot/CHANGELOG @@ -1,6 +1,7 @@ -2025-01-31 +2025-02-24 * Include missing dependencies in installation instructions. (#591) * Update version of GHC in README. (#590) + * Add example of how to use proveWithCounterExample. (#589) 2025-01-07 * Version bump (4.2). (#577) From 6061af73cc83d4acc1cf3680c602ec44f60515e9 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Wed, 5 Mar 2025 09:17:15 +0000 Subject: [PATCH 0903/1222] copilot: List all Copilot packages in installation command in README. Refs #597. The current installation instructions do not expose all packages, meaning that users can only access whatever is re-exported by the package copilot. This prevents users from accessing many key features of Copilot, and from compiling many specifications. This commit updates the manual installation instructions to include all packages, thus exposing all Copilot modules and allowing specifications that users write to compile. --- copilot/README.md | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/copilot/README.md b/copilot/README.md index 7ce1e482e..efdc58d28 100644 --- a/copilot/README.md +++ b/copilot/README.md @@ -112,7 +112,8 @@ Once the compiler is installed, install Copilot from [Hackage](https://hackage.haskell.org/package/copilot) with: ```sh -cabal v2-install --lib copilot +cabal v2-install --lib copilot copilot-core copilot-c99 copilot-language \ + copilot-theorem copilot-libraries copilot-interpreter copilot-prettyprinter ``` To test that Copilot is available, execute the following: @@ -141,7 +142,8 @@ Once the compiler is installed, install Copilot from [Hackage](https://hackage.haskell.org/package/copilot) with: ```sh -$ cabal v2-install --lib copilot +$ cabal v2-install --lib copilot copilot-core copilot-c99 copilot-language \ + copilot-theorem copilot-libraries copilot-interpreter copilot-prettyprinter ``` To test that Copilot is available, execute the following: From ea702c949b7f8fcf9881e37e5b25406d3f95b7d1 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Wed, 5 Mar 2025 09:19:25 +0000 Subject: [PATCH 0904/1222] copilot: Document changes in CHANGELOG. Refs #597. --- copilot/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot/CHANGELOG b/copilot/CHANGELOG index 64c5f7535..4961ed466 100644 --- a/copilot/CHANGELOG +++ b/copilot/CHANGELOG @@ -1,7 +1,8 @@ -2025-02-24 +2025-03-05 * Include missing dependencies in installation instructions. (#591) * Update version of GHC in README. (#590) * Add example of how to use proveWithCounterExample. (#589) + * List all Copilot packages in installation command in README. (#597) 2025-01-07 * Version bump (4.2). (#577) From 5b08e817fb6d23485bc86553a820135896fc54b1 Mon Sep 17 00:00:00 2001 From: Ryan Scott Date: Wed, 5 Mar 2025 16:59:35 -0500 Subject: [PATCH 0905/1222] copilot-core: Preserve proposition quantifiers. Refs Copilot-Language#254. Currently, `copilot-language` remembers whether a proposition (i.e., a stream of booleans) is quantified universally (i.e., using `forAll`) or existentially (i.e., using `exists`). When translating from `copilot-language` to `copilot-core`, however, the quantifier is discarded. This means that a `copilot-core` `Property` does not record any quantifier information at all, making it impossible for downstream libraries that use `copilot-core` to handle universal quantification differently from existential quantification. This commit changes the `copilot-core` API to preserve quantifier information. Specifically, it introduces a `Prop` data type in `copilot-core` (largely inspired by a data type of the same name in `copilot-language`) to record a proposition's quantifier, and it changes the `propertyExpr :: Expr Bool` field of `copilot-core`'s `Property` data type to `propertyProp :: Prop`. This commit also introduces an `extractProp :: Prop -> Expr Bool` function for retrieving the underlying boolean expression. Generally, this function should not be used, as different quantifiers usually require different treatment, and misuse of the `extractProp` function can potentially lead to unsoundness. There are a handful of places where the use of `extractProp` is justified, however. In each such place, a comment should be left to justify why the use of `extractProp` is sound. --- copilot-core/src/Copilot/Core/Spec.hs | 21 ++++++++++++++++++++- 1 file changed, 20 insertions(+), 1 deletion(-) diff --git a/copilot-core/src/Copilot/Core/Spec.hs b/copilot-core/src/Copilot/Core/Spec.hs index 7a71c780e..6614d0621 100644 --- a/copilot-core/src/Copilot/Core/Spec.hs +++ b/copilot-core/src/Copilot/Core/Spec.hs @@ -20,6 +20,8 @@ module Copilot.Core.Spec , Trigger (..) , Spec (..) , Property (..) + , Prop (..) + , extractProp ) where @@ -62,9 +64,26 @@ data Trigger = Trigger -- universally quantified over time. data Property = Property { propertyName :: Name - , propertyExpr :: Expr Bool + , propertyProp :: Prop } +-- | A proposition, representing a boolean stream that is existentially or +-- universally quantified over time. +data Prop + = Forall (Expr Bool) + | Exists (Expr Bool) + +-- | Extract the underlying stream from a quantified proposition. +-- +-- Think carefully before using this function, as this function will remove the +-- quantifier from a proposition. Universally quantified streams usually require +-- separate treatment from existentially quantified ones, so carelessly using +-- this function to remove quantifiers can result in hard-to-spot soundness +-- bugs. +extractProp :: Prop -> Expr Bool +extractProp (Forall e) = e +extractProp (Exists e) = e + -- | A Copilot specification is a list of streams, together with monitors on -- these streams implemented as observers, triggers or properties. data Spec = Spec From 0c3e7021d395563aa9ce10d7daab0dca5505689e Mon Sep 17 00:00:00 2001 From: Ryan Scott Date: Wed, 5 Mar 2025 17:03:18 -0500 Subject: [PATCH 0906/1222] copilot-language: Preserve proposition quantifiers. Refs Copilot-Language#254. Currently, `copilot-language` remembers whether a proposition (i.e., a stream of booleans) is quantified universally (i.e., using `forAll`) or existentially (i.e., using `exists`). When translating from `copilot-language` to `copilot-core`, however, the quantifier is discarded. This means that a `copilot-core` `Property` does not record any quantifier information at all, making it impossible for downstream libraries that use `copilot-core` to handle universal quantification differently from existential quantification. Now that `copilot-core` preserves quantifier information in its API, this commit updates `copilot-language` to respect quantifiers when translating into `copilot-core`. --- .../src/Copilot/Language/Analyze.hs | 13 +++++++++++-- copilot-language/src/Copilot/Language/Reify.hs | 18 +++++++++++++++--- copilot-language/src/Copilot/Language/Spec.hs | 12 +++++++++--- 3 files changed, 35 insertions(+), 8 deletions(-) diff --git a/copilot-language/src/Copilot/Language/Analyze.hs b/copilot-language/src/Copilot/Language/Analyze.hs index 04de14ed4..e7065f7b4 100644 --- a/copilot-language/src/Copilot/Language/Analyze.hs +++ b/copilot-language/src/Copilot/Language/Analyze.hs @@ -110,7 +110,11 @@ analyzeObserver refStreams (Observer _ e) = analyzeExpr refStreams e -- -- This function can fail with one of the exceptions in 'AnalyzeException'. analyzeProperty :: IORef Env -> Property -> IO () -analyzeProperty refStreams (Property _ e) = analyzeExpr refStreams e +analyzeProperty refStreams (Property _ p) = + -- Soundness note: it is OK to call `extractProp` here to drop the quantifier + -- from the proposition `p`, as the analysis does not depend on what the + -- quantifier is. + analyzeExpr refStreams (extractProp p) data SeenExtern = NoExtern | SeenFun @@ -291,7 +295,12 @@ specExts refStreams spec = do env' args propertyExts :: ExternEnv -> Property -> IO ExternEnv - propertyExts env (Property _ stream) = collectExts refStreams stream env + propertyExts env (Property _ p) = + -- Soundness note: it is OK to call `extractProp` here to drop the + -- quantifier from the proposition `p`. This is because we are simply + -- gathering externs from `p`, and the presence of externs does not depend + -- on what the quantifier is. + collectExts refStreams (extractProp p) env theoremExts :: ExternEnv -> (Property, UProof) -> IO ExternEnv theoremExts env (p, _) = propertyExts env p diff --git a/copilot-language/src/Copilot/Language/Reify.hs b/copilot-language/src/Copilot/Language/Reify.hs index 092458b78..60bae450b 100644 --- a/copilot-language/src/Copilot/Language/Reify.hs +++ b/copilot-language/src/Copilot/Language/Reify.hs @@ -4,6 +4,7 @@ -- specification. {-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE GADTs #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE Safe #-} @@ -105,11 +106,22 @@ mkProperty -> IORef [Core.Stream] -> Property -> IO Core.Property -mkProperty refMkId refStreams refMap (Property name guard) = do - w1 <- mkExpr refMkId refStreams refMap guard +mkProperty refMkId refStreams refMap (Property name p) = do + p' <- mkProp refMkId refStreams refMap p return Core.Property { Core.propertyName = name - , Core.propertyExpr = w1 } + , Core.propertyProp = p' } + +-- | Transform a Copilot proposition into a Copilot Core proposition. +mkProp :: IORef Int + -> IORef (Map Core.Id) + -> IORef [Core.Stream] + -> Prop a + -> IO Core.Prop +mkProp refMkId refStreams refMap prop = + case prop of + Forall e -> Core.Forall <$> mkExpr refMkId refStreams refMap e + Exists e -> Core.Exists <$> mkExpr refMkId refStreams refMap e -- | Transform a Copilot stream expression into a Copilot Core expression. {-# INLINE mkExpr #-} diff --git a/copilot-language/src/Copilot/Language/Spec.hs b/copilot-language/src/Copilot/Language/Spec.hs index b5fc94b61..0127cd24b 100644 --- a/copilot-language/src/Copilot/Language/Spec.hs +++ b/copilot-language/src/Copilot/Language/Spec.hs @@ -153,7 +153,7 @@ trigger name e args = tell [TriggerItem $ Trigger name e args] -- | A property, representing a boolean stream that is existentially or -- universally quantified over time. data Property where - Property :: String -> Stream Bool -> Property + Property :: String -> Prop a -> Property -- | A proposition, representing the quantification of a boolean streams over -- time. @@ -170,6 +170,12 @@ exists :: Stream Bool -> Prop Existential exists = Exists -- | Extract the underlying stream from a quantified proposition. +-- +-- Think carefully before using this function, as this function will remove the +-- quantifier from a proposition. Universally quantified streams usually require +-- separate treatment from existentially quantified ones, so carelessly using +-- this function to remove quantifiers can result in hard-to-spot soundness +-- bugs. extractProp :: Prop a -> Stream Bool extractProp (Forall p) = p extractProp (Exists p) = p @@ -180,7 +186,7 @@ extractProp (Exists p) = p -- This function returns, in the monadic context, a reference to the -- proposition. prop :: String -> Prop a -> Writer [SpecItem] (PropRef a) -prop name e = tell [PropertyItem $ Property name (extractProp e)] +prop name e = tell [PropertyItem $ Property name e] >> return (PropRef name) -- | A theorem, or proposition together with a proof. @@ -188,7 +194,7 @@ prop name e = tell [PropertyItem $ Property name (extractProp e)] -- This function returns, in the monadic context, a reference to the -- proposition. theorem :: String -> Prop a -> Proof a -> Writer [SpecItem] (PropRef a) -theorem name e (Proof p) = tell [TheoremItem (Property name (extractProp e), p)] +theorem name e (Proof p) = tell [TheoremItem (Property name e, p)] >> return (PropRef name) -- | Construct a function argument from a stream. From 8e46a139b96da91ffd4e078af3c1526e6230467c Mon Sep 17 00:00:00 2001 From: Ryan Scott Date: Wed, 5 Mar 2025 17:06:14 -0500 Subject: [PATCH 0907/1222] copilot-prettyprinter: Preserve proposition quantifiers. Refs Copilot-Language#254. Currently, `copilot-language` remembers whether a proposition (i.e., a stream of booleans) is quantified universally (i.e., using `forAll`) or existentially (i.e., using `exists`). When translating from `copilot-language` to `copilot-core`, however, the quantifier is discarded. This means that a `copilot-core` `Property` does not record any quantifier information at all, making it impossible for downstream libraries that use `copilot-core` to handle universal quantification differently from existential quantification. Now that `copilot-core` preserves quantifier information in its API, this commit updates `copilot-prettyprinter` to pretty-print quantifier information appropriately. --- copilot-prettyprinter/src/Copilot/PrettyPrint.hs | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/copilot-prettyprinter/src/Copilot/PrettyPrint.hs b/copilot-prettyprinter/src/Copilot/PrettyPrint.hs index 50be4466f..4bbad626b 100644 --- a/copilot-prettyprinter/src/Copilot/PrettyPrint.hs +++ b/copilot-prettyprinter/src/Copilot/PrettyPrint.hs @@ -175,10 +175,15 @@ ppProperty :: Property -> Doc ppProperty Property { propertyName = name - , propertyExpr = e } + , propertyProp = p } = text "property \"" <> text name <> text "\"" <+> text "=" - <+> ppExpr e + <+> ppProp p + +-- | Pretty-print a Copilot proposition. +ppProp :: Prop -> Doc +ppProp (Forall e) = text "forall" <+> parens (ppExpr e) +ppProp (Exists e) = text "exists" <+> parens (ppExpr e) -- | Pretty-print a Copilot specification, in the following order: -- From bce4c104862757b229dc931b1a35e477b64d3a39 Mon Sep 17 00:00:00 2001 From: Ryan Scott Date: Wed, 5 Mar 2025 17:07:58 -0500 Subject: [PATCH 0908/1222] copilot-theorem: Preserve proposition quantifiers. Refs Copilot-Language#254. Currently, `copilot-language` remembers whether a proposition (i.e., a stream of booleans) is quantified universally (i.e., using `forAll`) or existentially (i.e., using `exists`). When translating from `copilot-language` to `copilot-core`, however, the quantifier is discarded. This means that a `copilot-core` `Property` does not record any quantifier information at all, making it impossible for downstream libraries that use `copilot-core` to handle universal quantification differently from existential quantification. Now that `copilot-core` preserves quantifier information in its API, this commit updates `copilot-theorem` to make use of quantifier information when proving theorems. --- copilot-theorem/src/Copilot/Theorem/IL/Translate.hs | 9 +++++++-- .../src/Copilot/Theorem/TransSys/Translate.hs | 2 +- copilot-theorem/src/Copilot/Theorem/What4.hs | 9 +++++---- copilot-theorem/tests/Test/Copilot/Theorem/What4.hs | 2 +- 4 files changed, 14 insertions(+), 8 deletions(-) diff --git a/copilot-theorem/src/Copilot/Theorem/IL/Translate.hs b/copilot-theorem/src/Copilot/Theorem/IL/Translate.hs index 0bb6bfa37..c1a6606ba 100644 --- a/copilot-theorem/src/Copilot/Theorem/IL/Translate.hs +++ b/copilot-theorem/src/Copilot/Theorem/IL/Translate.hs @@ -63,8 +63,13 @@ translate' b (C.Spec {C.specStreams, C.specProperties}) = runTrans b $ do localConstraints <- popLocalConstraints properties <- Map.fromList <$> forM specProperties - (\(C.Property {C.propertyName, C.propertyExpr}) -> do - e' <- expr propertyExpr + (\(C.Property {C.propertyName, C.propertyProp}) -> do + -- Soundness note: it is OK to call `extractProp` here to drop the + -- quantifier from the proposition `propertyProp`. This is because we + -- IL translation always occurs within the context of a function that + -- returns a `Proof`, and these `Proof` functions are always careful to + -- use `Prover`s that respect the propositions's quantifier. + e' <- expr (C.extractProp propertyProp) propConds <- popLocalConstraints return (propertyName, (propConds, e'))) diff --git a/copilot-theorem/src/Copilot/Theorem/TransSys/Translate.hs b/copilot-theorem/src/Copilot/Theorem/TransSys/Translate.hs index cc557e429..68ddb8806 100644 --- a/copilot-theorem/src/Copilot/Theorem/TransSys/Translate.hs +++ b/copilot-theorem/src/Copilot/Theorem/TransSys/Translate.hs @@ -139,7 +139,7 @@ streamOfProp :: C.Property -> C.Stream streamOfProp prop = C.Stream { C.streamId = 42 , C.streamBuffer = [] - , C.streamExpr = C.propertyExpr prop + , C.streamExpr = C.extractProp (C.propertyProp prop) , C.streamExprType = C.Bool } stream :: C.Stream -> Trans Node diff --git a/copilot-theorem/src/Copilot/Theorem/What4.hs b/copilot-theorem/src/Copilot/Theorem/What4.hs index eb692378f..3cf43861d 100644 --- a/copilot-theorem/src/Copilot/Theorem/What4.hs +++ b/copilot-theorem/src/Copilot/Theorem/What4.hs @@ -350,9 +350,10 @@ proveInternal solver spec k = do -- This process performs k-induction where we use @k = maxBufLen@. -- The choice for @k@ is heuristic, but often effective. let proveProperties = forM (CS.specProperties spec) $ \pr -> do + let prop = CS.extractProp (CS.propertyProp pr) -- State the base cases for k induction. base_cases <- forM [0 .. maxBufLen - 1] $ \i -> do - xe <- translateExpr sym mempty (CS.propertyExpr pr) (AbsoluteOffset i) + xe <- translateExpr sym mempty prop (AbsoluteOffset i) case xe of XBool p -> return p _ -> expectedBool "Property" xe @@ -360,7 +361,7 @@ proveInternal solver spec k = do -- Translate the induction hypothesis for all values up to maxBufLen in -- the past ind_hyps <- forM [0 .. maxBufLen-1] $ \i -> do - xe <- translateExpr sym mempty (CS.propertyExpr pr) (RelativeOffset i) + xe <- translateExpr sym mempty prop (RelativeOffset i) case xe of XBool hyp -> return hyp _ -> expectedBool "Property" xe @@ -369,7 +370,7 @@ proveInternal solver spec k = do ind_goal <- do xe <- translateExpr sym mempty - (CS.propertyExpr pr) + prop (RelativeOffset maxBufLen) case xe of XBool p -> return p @@ -599,7 +600,7 @@ computeAssumptions sym properties spec = -- user-provided property assumptions. specPropertyExprs :: [CE.Expr Bool] specPropertyExprs = - [ CS.propertyExpr p + [ CS.extractProp (CS.propertyProp p) | p <- CS.specProperties spec , elem (CS.propertyName p) properties ] diff --git a/copilot-theorem/tests/Test/Copilot/Theorem/What4.hs b/copilot-theorem/tests/Test/Copilot/Theorem/What4.hs index 751310b5e..03e6b8dad 100644 --- a/copilot-theorem/tests/Test/Copilot/Theorem/What4.hs +++ b/copilot-theorem/tests/Test/Copilot/Theorem/What4.hs @@ -251,7 +251,7 @@ checkCounterExample solver propName spec cexPred = do -- contains the given streams, and is defined by the given boolean expression. propSpec :: String -> [Stream] -> Expr Bool -> Spec propSpec propName propStreams propExpr = - Spec propStreams [] [] [Copilot.Property propName propExpr] + Spec propStreams [] [] [Copilot.Property propName (Copilot.Forall propExpr)] -- | Equality for 'SatResult'. -- From d1392428abc45c5b42017cf494f31b50da2abf66 Mon Sep 17 00:00:00 2001 From: Ryan Scott Date: Tue, 4 Feb 2025 08:03:05 -0500 Subject: [PATCH 0909/1222] copilot-theorem: Reject existentially quantified propositions in What4 backend. Refs #254. The functions in `Copilot.Theorem.What4` (e.g., `prove`) take a proposition and attempt to prove that it is valid at all possible time steps. Currently, these functions do this regardless of whether the proposition is universally quantified or existentially quantified, which is unsound. The reason that this happens is because the functions call `extractProp` on the proposition being proven, causing the proposition's quantifier not to be taken into account. This commit removes the unsound uses of `extractProp` and instead checks if the proposition was actually quantified universally (i.e., with a `Forall`), which is the intended use case for `Copilot.Theorem.What4`. If the proposition was instead quantified existentially (i.e., with an `Exists`), then a `ProveException` will be thrown. Warnings have been added to Haddocks of the relevant functions that can potentially throw a `ProveException`. --- copilot-theorem/src/Copilot/Theorem/What4.hs | 41 +++++++++- .../tests/Test/Copilot/Theorem/What4.hs | 79 +++++++++++++++---- 2 files changed, 105 insertions(+), 15 deletions(-) diff --git a/copilot-theorem/src/Copilot/Theorem/What4.hs b/copilot-theorem/src/Copilot/Theorem/What4.hs index 3cf43861d..818ac9b3a 100644 --- a/copilot-theorem/src/Copilot/Theorem/What4.hs +++ b/copilot-theorem/src/Copilot/Theorem/What4.hs @@ -32,6 +32,12 @@ -- We perform @k@-induction on all the properties in a given specification where -- @k@ is chosen to be the maximum amount of delay on any of the involved -- streams. This is a heuristic choice, but often effective. +-- +-- The functions in this module are only designed to prove universally +-- quantified propositions (i.e., propositions that use @forAll@). Attempting to +-- prove an existentially quantified proposition (i.e., propositions that use +-- @exists@) will cause a 'UnexpectedExistentialProposition' exception to be +-- thrown. module Copilot.Theorem.What4 ( -- * Proving properties about Copilot specifications prove @@ -40,6 +46,7 @@ module Copilot.Theorem.What4 , proveWithCounterExample , SatResultCex(..) , CounterExample(..) + , ProveException(..) -- * Bisimulation proofs about @copilot-c99@ code , computeBisimulationProofBundle , BisimulationProofBundle(..) @@ -63,6 +70,7 @@ import qualified What4.InterpretedFloatingPoint as WFP import qualified What4.Solver as WS import qualified What4.Solver.DReal as WS +import Control.Exception (Exception, throw) import Control.Monad (forM) import Control.Monad.State import qualified Data.BitVector.Sized as BV @@ -257,9 +265,24 @@ data CounterExample = CounterExample } deriving Show +-- | Exceptions that can arise when attempting a proof. +data ProveException + = UnexpectedExistentialProposition + -- ^ The functions in "Copilot.Theorem.What4" can only prove properties with + -- universally quantified propositions. The functions in + -- "Copilot.Theorem.What4" will throw this exception if they encounter an + -- existentially quantified proposition. + deriving Show + +instance Exception ProveException + -- | Attempt to prove all of the properties in a spec via an SMT solver (which -- must be installed locally on the host). Return an association list mapping -- the names of each property to the result returned by the solver. +-- +-- PRE: All of the properties in the 'CS.Spec' use universally quantified +-- propositions. Attempting to supply an existentially quantified proposition +-- will cause a 'UnexpectedExistentialProposition' exception to be thrown. prove :: Solver -- ^ Solver to use -> CS.Spec @@ -350,7 +373,12 @@ proveInternal solver spec k = do -- This process performs k-induction where we use @k = maxBufLen@. -- The choice for @k@ is heuristic, but often effective. let proveProperties = forM (CS.specProperties spec) $ \pr -> do - let prop = CS.extractProp (CS.propertyProp pr) + -- This function only supports universally quantified propositions, so + -- throw an exception if we encounter an existentially quantified + -- proposition. + let prop = case CS.propertyProp pr of + CS.Forall p -> p + CS.Exists {} -> throw UnexpectedExistentialProposition -- State the base cases for k induction. base_cases <- forM [0 .. maxBufLen - 1] $ \i -> do xe <- translateExpr sym mempty prop (AbsoluteOffset i) @@ -420,6 +448,10 @@ proveInternal solver spec k = do -- to carry out a bisimulation proof that establishes a correspondence between -- the states of the Copilot stream program and the C code that @copilot-c99@ -- would generate for that Copilot program. +-- +-- PRE: All of the properties in the 'CS.Spec' use universally quantified +-- propositions. Attempting to supply an existentially quantified proposition +-- will cause a 'UnexpectedExistentialProposition' exception to be thrown. computeBisimulationProofBundle :: WFP.IsInterpretedFloatSymExprBuilder sym => sym @@ -581,6 +613,10 @@ computeExternalInputs sym = do return (nm, Some tp, v) -- | Compute the user-provided property assumptions in a Copilot program. +-- +-- PRE: All of the properties in the 'CS.Spec' use universally quantified +-- propositions. Attempting to supply an existentially quantified proposition +-- will cause a 'UnexpectedExistentialProposition' exception to be thrown. computeAssumptions :: forall sym. WFP.IsInterpretedFloatSymExprBuilder sym @@ -603,6 +639,9 @@ computeAssumptions sym properties spec = [ CS.extractProp (CS.propertyProp p) | p <- CS.specProperties spec , elem (CS.propertyName p) properties + , let prop = case CS.propertyProp p of + CS.Forall pr -> pr + CS.Exists {} -> throw UnexpectedExistentialProposition ] -- Compute all of the what4 predicates corresponding to each user-provided diff --git a/copilot-theorem/tests/Test/Copilot/Theorem/What4.hs b/copilot-theorem/tests/Test/Copilot/Theorem/What4.hs index 03e6b8dad..edd137700 100644 --- a/copilot-theorem/tests/Test/Copilot/Theorem/What4.hs +++ b/copilot-theorem/tests/Test/Copilot/Theorem/What4.hs @@ -1,4 +1,6 @@ -{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} -- The following warning is disabled due to a necessary instance of SatResult -- defined in this module. {-# OPTIONS_GHC -fno-warn-orphans #-} @@ -6,11 +8,15 @@ module Test.Copilot.Theorem.What4 where -- External imports +import Control.Exception (Exception, try) import Data.Int (Int8) +import Data.Proxy (Proxy (..)) +import Data.Typeable (typeRep) import Data.Word (Word32) import Test.Framework (Test, testGroup) import Test.Framework.Providers.QuickCheck2 (testProperty) -import Test.HUnit (assertFailure) +import Test.HUnit (Assertion, assertBool, + assertFailure) import Test.QuickCheck (Arbitrary (arbitrary), Property, arbitrary, forAll) import Test.QuickCheck.Monadic (monadicIO, run) @@ -26,9 +32,9 @@ import Copilot.Core.Type (Field (..), Value (..)) -- Internal imports: Modules being tested -import Copilot.Theorem.What4 (CounterExample (..), SatResult (..), - SatResultCex (..), Solver (..), prove, - proveWithCounterExample) +import Copilot.Theorem.What4 (CounterExample (..), ProveException (..), + SatResult (..), SatResultCex (..), Solver (..), + prove, proveWithCounterExample) -- * Constants @@ -42,6 +48,7 @@ tests = , testProperty "Prove via Z3 that a struct update is valid" testProveZ3StructUpdate , testProperty "Counterexample with invalid base case" testCounterExampleBaseCase , testProperty "Counterexample with invalid induction step" testCounterExampleInductionStep + , testProperty "Check that the What4 backend rejects existential quantification" testWhat4ExistsException ] -- * Individual tests @@ -58,7 +65,7 @@ testProveZ3True = propName = "prop" spec :: Spec - spec = propSpec propName [] $ Const typeOf True + spec = forallPropSpec propName [] $ Const typeOf True -- | Test that Z3 is able to prove the following expression invalid: -- @ @@ -72,7 +79,7 @@ testProveZ3False = propName = "prop" spec :: Spec - spec = propSpec propName [] $ Const typeOf False + spec = forallPropSpec propName [] $ Const typeOf False -- | Test that Z3 is able to prove the following expresion valid: -- @ @@ -86,7 +93,7 @@ testProveZ3EqConst = forAll arbitrary $ \x -> propName = "prop" spec :: Int8 -> Spec - spec x = propSpec propName [] $ + spec x = forallPropSpec propName [] $ Op2 (Eq typeOf) (Const typeOf x) (Const typeOf x) -- | Test that Z3 is able to prove the following expresion valid: @@ -102,7 +109,7 @@ testProveZ3StructUpdate = forAll arbitrary $ \x -> propName = "prop" spec :: TestStruct -> Spec - spec s = propSpec propName [] $ + spec s = forallPropSpec propName [] $ Op2 (Eq typeOf) (getField @@ -151,7 +158,7 @@ testCounterExampleBaseCase = sId = 0 spec :: Spec - spec = propSpec propName [s] $ Drop typeOf 0 sId + spec = forallPropSpec propName [s] $ Drop typeOf 0 sId -- | Test that Z3 is able to produce a counterexample to the following property, -- where the induction step is proved invalid: @@ -183,7 +190,23 @@ testCounterExampleInductionStep = sId = 0 spec :: Spec - spec = propSpec propName [s] $ Drop typeOf 0 sId + spec = forallPropSpec propName [s] $ Drop typeOf 0 sId + +-- | Test that @copilot-theorem@'s @what4@ backend will throw an exception if it +-- attempts to prove an existentially quantified proposition. +testWhat4ExistsException :: Property +testWhat4ExistsException = + monadicIO $ run $ + checkException (prove Z3 spec) isUnexpectedExistentialProposition + where + isUnexpectedExistentialProposition :: ProveException -> Bool + isUnexpectedExistentialProposition UnexpectedExistentialProposition = True + + propName :: String + propName = "prop" + + spec :: Spec + spec = existsPropSpec propName [] $ Const typeOf True -- | A simple data type with a 'Struct' instance and a 'Field'. This is only -- used as part of 'testProveZ3StructUpdate'. @@ -245,14 +268,42 @@ checkCounterExample solver propName spec cexPred = do UnknownCex {} -> assertFailure "Expected invalid result, but result was unknown" +-- | Check that the given 'IO' action throws a particular exception. This is +-- largely taken from the implementation of @shouldThrow@ in +-- @hspec-expectations@ (note that this test suite uses @test-framework@ instead +-- of @hspec@). +checkException :: forall e a. Exception e => IO a -> (e -> Bool) -> Assertion +checkException action p = do + r <- try action + case r of + Right _ -> + assertFailure $ + "did not get expected exception: " ++ exceptionType + Left e -> + assertBool + ("predicate failed on expected exception: " ++ exceptionType ++ + "\n" ++ show e) + (p e) + where + -- String representation of the expected exception's type + exceptionType = show $ typeRep $ Proxy @e + -- * Auxiliary -- | Build a 'Spec' that contains one property with the given name, which --- contains the given streams, and is defined by the given boolean expression. -propSpec :: String -> [Stream] -> Expr Bool -> Spec -propSpec propName propStreams propExpr = +-- contains the given streams, and is defined by the given boolean expression, +-- which is universally quantified. +forallPropSpec :: String -> [Stream] -> Expr Bool -> Spec +forallPropSpec propName propStreams propExpr = Spec propStreams [] [] [Copilot.Property propName (Copilot.Forall propExpr)] +-- | Build a 'Spec' that contains one property with the given name, which +-- contains the given streams, and is defined by the given boolean expression, +-- which is existentially quantified. +existsPropSpec :: String -> [Stream] -> Expr Bool -> Spec +existsPropSpec propName propStreams propExpr = + Spec propStreams [] [] [Copilot.Property propName (Copilot.Exists propExpr)] + -- | Equality for 'SatResult'. -- -- This is an orphan instance, so we suppress the warning that GHC would From 3ea5f1206c608528fbfca44e527d888eba7036e6 Mon Sep 17 00:00:00 2001 From: Ryan Scott Date: Tue, 4 Feb 2025 13:33:55 -0500 Subject: [PATCH 0910/1222] copilot-core: Document changes in CHANGELOG. Refs #254. --- copilot-core/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot-core/CHANGELOG b/copilot-core/CHANGELOG index 69de85d76..dc86d9739 100644 --- a/copilot-core/CHANGELOG +++ b/copilot-core/CHANGELOG @@ -1,6 +1,7 @@ -2025-02-24 +2025-02-28 * Fix typo in documentation. (#587) * Add a Show instance for Type. (#589) + * Add a Prop type to capture how a property is quantified. (#254) 2025-01-07 * Version bump (4.2). (#577) From b4664cd1d1b2a90ff2ed3ff5a91793aaa048f096 Mon Sep 17 00:00:00 2001 From: Ryan Scott Date: Tue, 4 Feb 2025 13:36:14 -0500 Subject: [PATCH 0911/1222] copilot-language: Document changes in CHANGELOG. Refs #254. --- copilot-language/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot-language/CHANGELOG b/copilot-language/CHANGELOG index f4668a9e1..2aa4f6008 100644 --- a/copilot-language/CHANGELOG +++ b/copilot-language/CHANGELOG @@ -1,5 +1,6 @@ -2025-01-28 +2025-02-28 * Fix typo in documentation. (#587) + * Record how a Property's underlying proposition is quantified. (#254) 2025-01-07 * Version bump (4.2). (#577) From 88a67f5eb876b25cbc440e5810247d5df7f4352c Mon Sep 17 00:00:00 2001 From: Ryan Scott Date: Tue, 4 Feb 2025 13:37:42 -0500 Subject: [PATCH 0912/1222] copilot-prettyprinter: Document changes in CHANGELOG. Refs #254. --- copilot-prettyprinter/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-prettyprinter/CHANGELOG b/copilot-prettyprinter/CHANGELOG index b51261ae8..f930b53d0 100644 --- a/copilot-prettyprinter/CHANGELOG +++ b/copilot-prettyprinter/CHANGELOG @@ -1,3 +1,6 @@ +2025-02-28 + * Update pretty-printing to handle Props. (#254) + 2025-01-07 * Version bump (4.2). (#577) * Remove uses of Copilot.Core.Expr.UExpr.uExprExpr. (#565) From 700508abfcefea5c59517e0bdc3087735fdaa692 Mon Sep 17 00:00:00 2001 From: Ryan Scott Date: Tue, 4 Feb 2025 13:42:29 -0500 Subject: [PATCH 0913/1222] copilot-theorem: Document changes in CHANGELOG. Refs #254. --- copilot-theorem/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot-theorem/CHANGELOG b/copilot-theorem/CHANGELOG index f503de4e0..1c76ef96a 100644 --- a/copilot-theorem/CHANGELOG +++ b/copilot-theorem/CHANGELOG @@ -1,7 +1,8 @@ -2025-02-24 +2025-02-28 * Fix multiple typos in README. (#560) * Fix typo in documentation. (#587) * Add function to produce counterexamples for invalid properties. (#589) + * Reject existentially quantified properties in What4 backend. (#254) 2025-01-07 * Version bump (4.2). (#577) From 83086bf4fbc940dff9e0c742068414dff01d92c6 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 7 Mar 2025 03:28:52 -0800 Subject: [PATCH 0914/1222] copilot-language: Remove deprecated function Copilot.Language.Operators.Array.(.!!). Refs #599. The function `copilot-language:Copilot.Language.Operators.Array.(.!!)` was deprecated due to the introduction of a new, common interface to interact with structures and arrays. The original function was deprecated in Copilot 4 and no messages have been received requesting that it be kept in this library. Per our internal policy of waiting 3 versions from deprecation until a public interface declaration can be removed, this function can now be removed. This commit removes the function `copilot-language:Copilot.Language.Operators.Array.(.!!)`. --- .../src/Copilot/Language/Operators/Array.hs | 15 +-------------- 1 file changed, 1 insertion(+), 14 deletions(-) diff --git a/copilot-language/src/Copilot/Language/Operators/Array.hs b/copilot-language/src/Copilot/Language/Operators/Array.hs index dd5840439..17bb3bff3 100644 --- a/copilot-language/src/Copilot/Language/Operators/Array.hs +++ b/copilot-language/src/Copilot/Language/Operators/Array.hs @@ -8,8 +8,7 @@ -- | Combinators to deal with streams carrying arrays. module Copilot.Language.Operators.Array - ( (.!!) - , (!) + ( (!) , (!!) , (=:) , (=$) @@ -34,18 +33,6 @@ import Prelude hiding ((!!)) => Stream (Array n t) -> Stream Word32 -> Stream t arr ! n = Op2 (Index typeOf) arr n --- | Create a stream that carries an element of an array in another stream. --- --- This function implements a projection of the element of an array at a given --- position, over time. For example, if @s@ is a stream of type @Stream (Array --- '5 Word8)@, then @s .!! 3@ has type @Stream Word8@ and contains the 3rd --- element (starting from zero) of the arrays in @s@ at any point in time. -{-# DEPRECATED (.!!) "This function is deprecated in Copilot 4. Use (!)." #-} -(.!!) :: ( KnownNat n - , Typed t - ) => Stream (Array n t) -> Stream Word32 -> Stream t -(.!!) = (!) - -- | Pair a stream with an element accessor, without applying it to obtain the -- value of the element. -- From 7414eba08898ce33c4394370ceaa1702779c6aad Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 7 Mar 2025 03:29:04 -0800 Subject: [PATCH 0915/1222] copilot-libraries: Remove deprecated function Copilot.Library.Utils.(!!). Refs #599. The function `copilot-libraries:Copilot.Library.Utils.(!!)` was deprecated due to the introduction of a new, common interface to interact with structures and arrays. The original function was deprecated in Copilot 4 and no messages have been received requesting that it be kept in this library. Per our internal policy of waiting 3 versions from deprecation until a public interface declaration can be removed, this function can now be removed. This commit removes the function `copilot-libraries:Copilot.Library.Utils.(!!)`, and adjusts any imports that were hiding either the same function or equally named functions to avoid clashes, since they would no longer occur. --- copilot-libraries/src/Copilot/Library/Libraries.hs | 2 +- copilot-libraries/src/Copilot/Library/Utils.hs | 11 ++--------- 2 files changed, 3 insertions(+), 10 deletions(-) diff --git a/copilot-libraries/src/Copilot/Library/Libraries.hs b/copilot-libraries/src/Copilot/Library/Libraries.hs index 6a217234c..f378063bb 100644 --- a/copilot-libraries/src/Copilot/Library/Libraries.hs +++ b/copilot-libraries/src/Copilot/Library/Libraries.hs @@ -23,6 +23,6 @@ import Copilot.Library.LTL import Copilot.Library.PTLTL import Copilot.Library.Statistics import Copilot.Library.RegExp -import Copilot.Library.Utils hiding ((!!)) +import Copilot.Library.Utils import Copilot.Library.Voting import Copilot.Library.Stacks diff --git a/copilot-libraries/src/Copilot/Library/Utils.hs b/copilot-libraries/src/Copilot/Library/Utils.hs index 0200778a4..6785aa88d 100644 --- a/copilot-libraries/src/Copilot/Library/Utils.hs +++ b/copilot-libraries/src/Copilot/Library/Utils.hs @@ -13,10 +13,10 @@ module Copilot.Library.Utils -- ** Scans nscanl, nscanr, nscanl1, nscanr1, -- ** Indexing - case', (!!), (!!!)) + case', (!!!)) where -import Copilot.Language hiding ((!!)) +import Copilot.Language import qualified Prelude as P -- | Given a stream, produce an infinite list of streams dropping an increasing @@ -131,13 +131,6 @@ case' predicates alternatives = P.++ "greater by one than the length of predicates list" in case'' predicates alternatives --- | Index. --- --- WARNING: Very expensive! Consider using this only for very short lists. -(!!) :: (Typed a, Eq b, Num b, Typed b) => [Stream a] -> Stream b -> Stream a -(!!) = (!!!) -{-# DEPRECATED (!!) "This function is deprecated in Copilot 4. Use (!!!)." #-} - -- | Index. -- -- WARNING: Very expensive! Consider using this only for very short lists. From f5bad968ab441339d9cca2672baf7ee857499b50 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 7 Mar 2025 03:46:56 -0800 Subject: [PATCH 0916/1222] copilot-language: Document changes in CHANGELOG. Refs #599. --- copilot-language/CHANGELOG | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/copilot-language/CHANGELOG b/copilot-language/CHANGELOG index 2aa4f6008..15466b154 100644 --- a/copilot-language/CHANGELOG +++ b/copilot-language/CHANGELOG @@ -1,6 +1,8 @@ -2025-02-28 +2025-03-07 * Fix typo in documentation. (#587) * Record how a Property's underlying proposition is quantified. (#254) + * Remove deprecated function Copilot.Language.Operators.Array.(.!!). + (#599) 2025-01-07 * Version bump (4.2). (#577) From 7d22a1b2f5f496bb5cc7e93e881ad36bc3e8a347 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 7 Mar 2025 03:47:28 -0800 Subject: [PATCH 0917/1222] copilot-libraries: Document changes in CHANGELOG. Refs #599. --- copilot-libraries/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-libraries/CHANGELOG b/copilot-libraries/CHANGELOG index bd1a6b88c..86c3318cd 100644 --- a/copilot-libraries/CHANGELOG +++ b/copilot-libraries/CHANGELOG @@ -1,3 +1,6 @@ +2025-03-07 + * Remove deprecated function Copilot.Library.Utils.(!!). (#599) + 2025-01-07 * Version bump (4.2). (#577) * Bump upper version constraint on containers. (#570) From bfc176a20aedc16dfe8083931fd582ffe7812631 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 7 Mar 2025 17:11:08 -0800 Subject: [PATCH 0918/1222] Bump versions and constraints. Refs #604. --- copilot-c99/copilot-c99.cabal | 4 ++-- copilot-core/copilot-core.cabal | 2 +- copilot-interpreter/copilot-interpreter.cabal | 4 ++-- copilot-language/copilot-language.cabal | 8 ++++---- copilot-libraries/copilot-libraries.cabal | 4 ++-- copilot-prettyprinter/copilot-prettyprinter.cabal | 4 ++-- copilot-theorem/copilot-theorem.cabal | 6 +++--- copilot/copilot.cabal | 14 +++++++------- 8 files changed, 23 insertions(+), 23 deletions(-) diff --git a/copilot-c99/copilot-c99.cabal b/copilot-c99/copilot-c99.cabal index a693b60f4..48fc6aa36 100644 --- a/copilot-c99/copilot-c99.cabal +++ b/copilot-c99/copilot-c99.cabal @@ -1,6 +1,6 @@ cabal-version : >= 1.10 name : copilot-c99 -version : 4.2 +version : 4.3 synopsis : A compiler for Copilot targeting C99. description : This package is a back-end from Copilot to C. @@ -45,7 +45,7 @@ library , mtl >= 2.2 && < 2.4 , pretty >= 1.1 && < 1.2 - , copilot-core >= 4.2 && < 4.3 + , copilot-core >= 4.3 && < 4.4 , language-c99 >= 0.2.0 && < 0.3 , language-c99-simple >= 0.3 && < 0.4 diff --git a/copilot-core/copilot-core.cabal b/copilot-core/copilot-core.cabal index 963097d1e..1140f129e 100644 --- a/copilot-core/copilot-core.cabal +++ b/copilot-core/copilot-core.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-core -version: 4.2 +version: 4.3 synopsis: An intermediate representation for Copilot. description: Intermediate representation for Copilot. diff --git a/copilot-interpreter/copilot-interpreter.cabal b/copilot-interpreter/copilot-interpreter.cabal index 68a0316f9..835f27106 100644 --- a/copilot-interpreter/copilot-interpreter.cabal +++ b/copilot-interpreter/copilot-interpreter.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-interpreter -version: 4.2 +version: 4.3 synopsis: Interpreter for Copilot. description: Interpreter for Copilot. @@ -44,7 +44,7 @@ library base >= 4.9 && < 5, pretty >= 1.0 && < 1.2, - copilot-core >= 4.2 && < 4.3 + copilot-core >= 4.3 && < 4.4 exposed-modules: diff --git a/copilot-language/copilot-language.cabal b/copilot-language/copilot-language.cabal index 5a6a8adb9..53c981618 100644 --- a/copilot-language/copilot-language.cabal +++ b/copilot-language/copilot-language.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-language -version: 4.2 +version: 4.3 synopsis: A Haskell-embedded DSL for monitoring hard real-time distributed systems. description: @@ -42,9 +42,9 @@ library , data-reify >= 0.6 && < 0.7 , mtl >= 2.0 && < 3 - , copilot-core >= 4.2 && < 4.3 - , copilot-interpreter >= 4.2 && < 4.3 - , copilot-theorem >= 4.2 && < 4.3 + , copilot-core >= 4.3 && < 4.4 + , copilot-interpreter >= 4.3 && < 4.4 + , copilot-theorem >= 4.3 && < 4.4 exposed-modules: Copilot.Language , Copilot.Language.Operators.BitWise diff --git a/copilot-libraries/copilot-libraries.cabal b/copilot-libraries/copilot-libraries.cabal index 9d6a52ae9..737a590e7 100644 --- a/copilot-libraries/copilot-libraries.cabal +++ b/copilot-libraries/copilot-libraries.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-libraries -version: 4.2 +version: 4.3 synopsis: Libraries for the Copilot language. description: Libraries for the Copilot language. @@ -41,7 +41,7 @@ library , containers >= 0.4 && < 0.8 , mtl >= 2.0 && < 2.4 , parsec >= 2.0 && < 3.2 - , copilot-language >= 4.2 && < 4.3 + , copilot-language >= 4.3 && < 4.4 exposed-modules: Copilot.Library.Libraries diff --git a/copilot-prettyprinter/copilot-prettyprinter.cabal b/copilot-prettyprinter/copilot-prettyprinter.cabal index ab5e63283..46e8de208 100644 --- a/copilot-prettyprinter/copilot-prettyprinter.cabal +++ b/copilot-prettyprinter/copilot-prettyprinter.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-prettyprinter -version: 4.2 +version: 4.3 synopsis: A prettyprinter of Copilot Specifications. description: A prettyprinter of Copilot specifications. @@ -45,7 +45,7 @@ library base >= 4.9 && < 5, pretty >= 1.0 && < 1.2, - copilot-core >= 4.2 && < 4.3 + copilot-core >= 4.3 && < 4.4 exposed-modules: diff --git a/copilot-theorem/copilot-theorem.cabal b/copilot-theorem/copilot-theorem.cabal index c3d2496dc..c6994913f 100644 --- a/copilot-theorem/copilot-theorem.cabal +++ b/copilot-theorem/copilot-theorem.cabal @@ -14,7 +14,7 @@ description: . -version : 4.2 +version : 4.3 license : BSD3 license-file : LICENSE maintainer : Ivan Perez @@ -63,8 +63,8 @@ library , xml >= 1.3 && < 1.4 , what4 >= 1.3 && < 1.7 - , copilot-core >= 4.2 && < 4.3 - , copilot-prettyprinter >= 4.2 && < 4.3 + , copilot-core >= 4.3 && < 4.4 + , copilot-prettyprinter >= 4.3 && < 4.4 exposed-modules : Copilot.Theorem , Copilot.Theorem.Prove diff --git a/copilot/copilot.cabal b/copilot/copilot.cabal index 272a3edb8..a39788ab8 100644 --- a/copilot/copilot.cabal +++ b/copilot/copilot.cabal @@ -1,5 +1,5 @@ name: copilot -version: 4.2 +version: 4.3 cabal-version: >= 1.10 license: BSD3 license-file: LICENSE @@ -52,12 +52,12 @@ library , directory >= 1.3 && < 1.4 , filepath >= 1.4 && < 1.6 - , copilot-core >= 4.2 && < 4.3 - , copilot-theorem >= 4.2 && < 4.3 - , copilot-language >= 4.2 && < 4.3 - , copilot-libraries >= 4.2 && < 4.3 - , copilot-c99 >= 4.2 && < 4.3 - , copilot-prettyprinter >= 4.2 && < 4.3 + , copilot-core >= 4.3 && < 4.4 + , copilot-theorem >= 4.3 && < 4.4 + , copilot-language >= 4.3 && < 4.4 + , copilot-libraries >= 4.3 && < 4.4 + , copilot-c99 >= 4.3 && < 4.4 + , copilot-prettyprinter >= 4.3 && < 4.4 exposed-modules: Language.Copilot, Language.Copilot.Main From 04f7bc4d6d78f07ae0a710a50f18c12074f1ed80 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 7 Mar 2025 17:12:58 -0800 Subject: [PATCH 0919/1222] Document changes in CHANGELOG. Refs #604. --- copilot-c99/CHANGELOG | 3 +++ copilot-core/CHANGELOG | 3 ++- copilot-interpreter/CHANGELOG | 3 +++ copilot-language/CHANGELOG | 1 + copilot-libraries/CHANGELOG | 1 + copilot-prettyprinter/CHANGELOG | 3 ++- copilot-theorem/CHANGELOG | 3 ++- copilot/CHANGELOG | 3 ++- 8 files changed, 16 insertions(+), 4 deletions(-) diff --git a/copilot-c99/CHANGELOG b/copilot-c99/CHANGELOG index 84254f6e6..48f275cf7 100644 --- a/copilot-c99/CHANGELOG +++ b/copilot-c99/CHANGELOG @@ -1,3 +1,6 @@ +2025-03-07 + * Version bump (4.3). (#604) + 2025-01-07 * Version bump (4.2). (#577) * Remove uses of Copilot.Core.Expr.UExpr.uExprType. (#565) diff --git a/copilot-core/CHANGELOG b/copilot-core/CHANGELOG index dc86d9739..371c8c2d9 100644 --- a/copilot-core/CHANGELOG +++ b/copilot-core/CHANGELOG @@ -1,4 +1,5 @@ -2025-02-28 +2025-03-07 + * Version bump (4.3). (#604) * Fix typo in documentation. (#587) * Add a Show instance for Type. (#589) * Add a Prop type to capture how a property is quantified. (#254) diff --git a/copilot-interpreter/CHANGELOG b/copilot-interpreter/CHANGELOG index 46c8f0c6b..924fa7436 100644 --- a/copilot-interpreter/CHANGELOG +++ b/copilot-interpreter/CHANGELOG @@ -1,3 +1,6 @@ +2025-03-07 + * Version bump (4.3). (#604) + 2025-01-07 * Version bump (4.2). (#577) diff --git a/copilot-language/CHANGELOG b/copilot-language/CHANGELOG index 15466b154..2f729caac 100644 --- a/copilot-language/CHANGELOG +++ b/copilot-language/CHANGELOG @@ -1,4 +1,5 @@ 2025-03-07 + * Version bump (4.3). (#604) * Fix typo in documentation. (#587) * Record how a Property's underlying proposition is quantified. (#254) * Remove deprecated function Copilot.Language.Operators.Array.(.!!). diff --git a/copilot-libraries/CHANGELOG b/copilot-libraries/CHANGELOG index 86c3318cd..228e37a5d 100644 --- a/copilot-libraries/CHANGELOG +++ b/copilot-libraries/CHANGELOG @@ -1,4 +1,5 @@ 2025-03-07 + * Version bump (4.3). (#604) * Remove deprecated function Copilot.Library.Utils.(!!). (#599) 2025-01-07 diff --git a/copilot-prettyprinter/CHANGELOG b/copilot-prettyprinter/CHANGELOG index f930b53d0..caec436ef 100644 --- a/copilot-prettyprinter/CHANGELOG +++ b/copilot-prettyprinter/CHANGELOG @@ -1,4 +1,5 @@ -2025-02-28 +2025-03-07 + * Version bump (4.3). (#604) * Update pretty-printing to handle Props. (#254) 2025-01-07 diff --git a/copilot-theorem/CHANGELOG b/copilot-theorem/CHANGELOG index 1c76ef96a..d3c2bd464 100644 --- a/copilot-theorem/CHANGELOG +++ b/copilot-theorem/CHANGELOG @@ -1,4 +1,5 @@ -2025-02-28 +2025-03-07 + * Version bump (4.3). (#604) * Fix multiple typos in README. (#560) * Fix typo in documentation. (#587) * Add function to produce counterexamples for invalid properties. (#589) diff --git a/copilot/CHANGELOG b/copilot/CHANGELOG index 4961ed466..abd146bba 100644 --- a/copilot/CHANGELOG +++ b/copilot/CHANGELOG @@ -1,4 +1,5 @@ -2025-03-05 +2025-03-07 + * Version bump (4.3). (#604) * Include missing dependencies in installation instructions. (#591) * Update version of GHC in README. (#590) * Add example of how to use proveWithCounterExample. (#589) From 007e80aabd893a3fa2b57c17f58f6530b00530bf Mon Sep 17 00:00:00 2001 From: Ryan Scott Date: Fri, 21 Feb 2025 16:22:12 -0500 Subject: [PATCH 0920/1222] copilot-theorem: Add Props to specProps. Refs #594. `copilot-theorem`'s Kind2 backend takes a proposition and attempts to prove that it is valid at all possible time steps. Currently, this happens regardless of whether the proposition is universally or existentially quantified. This is unsound, and it can lead to valid, existentially quantified properties being incorrectly labeled as invalid. This commit adds information about propositions' quantifiers to the Kind2 backend's implementation so that it may use the quantifiers when translating the properties to Kind2. This is accomplished by updating `specProps` to map each proposition's identifier to its corresponding `copilot-core` `Prop`. --- copilot-theorem/src/Copilot/Theorem/Kind2/Translate.hs | 4 ++-- .../src/Copilot/Theorem/TransSys/PrettyPrint.hs | 3 ++- copilot-theorem/src/Copilot/Theorem/TransSys/Spec.hs | 4 +++- copilot-theorem/src/Copilot/Theorem/TransSys/Transform.hs | 3 ++- copilot-theorem/src/Copilot/Theorem/TransSys/Translate.hs | 8 +++++--- 5 files changed, 14 insertions(+), 8 deletions(-) diff --git a/copilot-theorem/src/Copilot/Theorem/Kind2/Translate.hs b/copilot-theorem/src/Copilot/Theorem/Kind2/Translate.hs index d8115e893..123f6ed64 100644 --- a/copilot-theorem/src/Copilot/Theorem/Kind2/Translate.hs +++ b/copilot-theorem/src/Copilot/Theorem/Kind2/Translate.hs @@ -65,7 +65,7 @@ trSpec spec predCallsGraph _assumptions checkedProps = K.File preds props preds = map (trNode spec predCallsGraph) (specNodes spec) props = map trProp $ filter ((`elem` checkedProps) . fst) $ - Map.toList (specProps spec) + Map.toList $ Map.map fst $ specProps spec trProp :: (PropId, ExtVar) -> K.Prop trProp (pId, var) = K.Prop pId (trVar . extVarLocalPart $ var) @@ -98,7 +98,7 @@ addAssumptions spec assumptions (K.File {K.filePreds, K.fileProps}) = vars = let bindings = nodeImportedVars (specTopNode spec) - toExtVar a = fromJust $ Map.lookup a (specProps spec) + toExtVar a = fst $ fromJust $ Map.lookup a $ specProps spec toTopVar (ExtVar nId v) = assert (nId == specTopNodeId spec) v in map (varName . toTopVar . toExtVar) assumptions diff --git a/copilot-theorem/src/Copilot/Theorem/TransSys/PrettyPrint.hs b/copilot-theorem/src/Copilot/Theorem/TransSys/PrettyPrint.hs index 89fdc5787..3debe552c 100644 --- a/copilot-theorem/src/Copilot/Theorem/TransSys/PrettyPrint.hs +++ b/copilot-theorem/src/Copilot/Theorem/TransSys/PrettyPrint.hs @@ -27,7 +27,8 @@ pSpec spec = items $$ props items = foldr (($$) . pNode) empty (specNodes spec) props = text "PROPS" $$ Map.foldrWithKey (\k -> ($$) . pProp k) - empty (specProps spec) + empty + (Map.map fst (specProps spec)) pProp pId extvar = quotes (text pId) <+> text "is" <+> pExtVar extvar diff --git a/copilot-theorem/src/Copilot/Theorem/TransSys/Spec.hs b/copilot-theorem/src/Copilot/Theorem/TransSys/Spec.hs index d2a953387..e0a297535 100644 --- a/copilot-theorem/src/Copilot/Theorem/TransSys/Spec.hs +++ b/copilot-theorem/src/Copilot/Theorem/TransSys/Spec.hs @@ -24,6 +24,8 @@ module Copilot.Theorem.TransSys.Spec , specDependenciesGraph , specTopNode ) where +import qualified Copilot.Core as C + import Copilot.Theorem.TransSys.Type import Copilot.Theorem.TransSys.Operators import Copilot.Theorem.TransSys.Invariants @@ -55,7 +57,7 @@ type PropId = String data TransSys = TransSys { specNodes :: [Node] , specTopNodeId :: NodeId - , specProps :: Map PropId ExtVar } + , specProps :: Map PropId (ExtVar, C.Prop) } -- | A node is a set of variables living in a local namespace and corresponding -- to the 'Var' type. diff --git a/copilot-theorem/src/Copilot/Theorem/TransSys/Transform.hs b/copilot-theorem/src/Copilot/Theorem/TransSys/Transform.hs index 79edd2828..e59058496 100644 --- a/copilot-theorem/src/Copilot/Theorem/TransSys/Transform.hs +++ b/copilot-theorem/src/Copilot/Theorem/TransSys/Transform.hs @@ -42,7 +42,8 @@ mergeNodes toMergeIds spec = spec { specNodes = newNode : map (updateOtherNode newNodeId toMergeIds renamingExtF) otherNodes - , specProps = Map.map renamingExtF (specProps spec) } + , specProps = + Map.map (\(ev, prop) -> (renamingExtF ev, prop)) (specProps spec) } where nodes = specNodes spec diff --git a/copilot-theorem/src/Copilot/Theorem/TransSys/Translate.hs b/copilot-theorem/src/Copilot/Theorem/TransSys/Translate.hs index 68ddb8806..f15162e49 100644 --- a/copilot-theorem/src/Copilot/Theorem/TransSys/Translate.hs +++ b/copilot-theorem/src/Copilot/Theorem/TransSys/Translate.hs @@ -96,10 +96,12 @@ translate cspec = cprops :: [C.Property] cprops = C.specProperties cspec - propBindings :: Map PropId ExtVar + propBindings :: Map PropId (ExtVar, C.Prop) propBindings = Map.fromList $ do - pid <- map C.propertyName cprops - return (pid, mkExtVar topNodeId pid) + cprop <- cprops + let pid = C.propertyName cprop + prop = C.propertyProp cprop + return (pid, (mkExtVar topNodeId pid, prop)) ((modelNodes, propNodes), extvarNodesNames) = runTrans $ liftM2 (,) (mapM stream (C.specStreams cspec)) (mkPropNodes cprops) From a007efad3207b6603e46da408ebbd3d60e61018b Mon Sep 17 00:00:00 2001 From: Ryan Scott Date: Mon, 24 Feb 2025 05:41:21 -0500 Subject: [PATCH 0921/1222] copilot-theorem: Translate quantifiers correctly in Kind2 backend. Refs #594. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit `copilot-theorem`'s Kind2 backend takes a proposition and attempts to prove that it is valid at all possible time steps. Currently, this happens regardless of whether the proposition is universally or existentially quantified. This is unsound, and it can lead to valid, existentially quantified properties being incorrectly labeled as invalid. This commit fixes the translations of propositions to Kind2 (via Kind2's TransSys backend) such that the translated properties respect quantifier information. Specifically, this replaces an unsound use of the `extractProp` function with an analysis that translates the property differently depending on whether it is universally or existentially quantified. Because all TransSys propositions use universal quantification, we convert an existentially quantified property `∃x.P(x)` as `¬(∀x.¬(P(x)))` during the translation to TransSys. --- .../src/Copilot/Theorem/Kind2/Output.hs | 29 +++++++++++++++---- .../src/Copilot/Theorem/Kind2/Prover.hs | 18 +++++++++--- .../src/Copilot/Theorem/TransSys/Spec.hs | 3 +- .../src/Copilot/Theorem/TransSys/Translate.hs | 10 ++++++- 4 files changed, 49 insertions(+), 11 deletions(-) diff --git a/copilot-theorem/src/Copilot/Theorem/Kind2/Output.hs b/copilot-theorem/src/Copilot/Theorem/Kind2/Output.hs index 42a2f60dc..f80b8170b 100644 --- a/copilot-theorem/src/Copilot/Theorem/Kind2/Output.hs +++ b/copilot-theorem/src/Copilot/Theorem/Kind2/Output.hs @@ -8,19 +8,38 @@ import Text.XML.Light hiding (findChild) import Copilot.Theorem.Prove as P import Data.Maybe (fromJust) +import qualified Copilot.Core as C + import qualified Copilot.Theorem.Misc.Error as Err simpleName s = QName s Nothing Nothing -- | Parse output of Kind2. parseOutput :: String -- ^ Property whose validity is being checked. + -> C.Prop -- ^ The property's quantifier. -> String -- ^ XML output of Kind2 -> P.Output -parseOutput prop xml = fromJust $ do +parseOutput propId propQuantifier xml = fromJust $ do root <- parseXMLDoc xml case findAnswer . findPropTag $ root of - "valid" -> return (Output Valid []) - "falsifiable" -> return (Output Invalid []) + "valid" -> case propQuantifier of + -- We encode a universally quantified property P as + -- ∀x.P(x) in Kind2, so the original property is valid + -- iff the Kind2 property is valid. + C.Forall {} -> return (Output Valid []) + -- We encode an existentially quantified property P as + -- ¬(∀x.¬(P(x))) in Kind2, so the original property is + -- invalid iff the Kind2 property is valid. + C.Exists {} -> return (Output Invalid []) + "falsifiable" -> case propQuantifier of + -- We encode a universally quantified property P as + -- ∀x.P(x) in Kind2, so the original property is invalid + -- iff the Kind2 property is invalid. + C.Forall {} -> return (Output Invalid []) + -- We encode an existentially quantified property P as + -- ¬(∀x.¬(P(x))) in Kind2, so the original property is + -- valid iff the Kind2 property is invalid. + C.Exists {} -> return (Output Valid []) s -> err $ "Unrecognized status : " ++ s where @@ -31,10 +50,10 @@ parseOutput prop xml = fromJust $ do let rightElement elt = qName (elName elt) == "Property" && lookupAttr (simpleName "name") (elAttribs elt) - == Just prop + == Just propId in case filterChildren rightElement root of tag : _ -> tag - _ -> err $ "Tag for property " ++ prop ++ " not found" + _ -> err $ "Tag for property " ++ propId ++ " not found" findAnswer tag = case findChildren (simpleName "Answer") tag of diff --git a/copilot-theorem/src/Copilot/Theorem/Kind2/Prover.hs b/copilot-theorem/src/Copilot/Theorem/Kind2/Prover.hs index 3931c615b..66db2c346 100644 --- a/copilot-theorem/src/Copilot/Theorem/Kind2/Prover.hs +++ b/copilot-theorem/src/Copilot/Theorem/Kind2/Prover.hs @@ -19,10 +19,12 @@ import Copilot.Theorem.Misc.Utils (openTempFile) import System.Process -import System.Directory -import Data.Default +import System.Directory +import Data.Default +import qualified Data.Map as Map -import qualified Copilot.Theorem.TransSys as TS +import qualified Copilot.Theorem.Misc.Error as Err +import qualified Copilot.Theorem.TransSys as TS -- | Options for Kind2 data Options = Options @@ -68,4 +70,12 @@ askKind2 (ProverST opts spec) assumptions toCheck = do putStrLn kind2Input removeFile tempName - return $ parseOutput (head toCheck) output + + let propId = head toCheck + propQuantifier = case Map.lookup propId (TS.specProps spec) of + Just (_, quantifier) -> + quantifier + Nothing -> + Err.impossible $ + "askKind2: " ++ propId ++ " not in specProps" + return $ parseOutput propId propQuantifier output diff --git a/copilot-theorem/src/Copilot/Theorem/TransSys/Spec.hs b/copilot-theorem/src/Copilot/Theorem/TransSys/Spec.hs index e0a297535..b68181ae0 100644 --- a/copilot-theorem/src/Copilot/Theorem/TransSys/Spec.hs +++ b/copilot-theorem/src/Copilot/Theorem/TransSys/Spec.hs @@ -53,7 +53,8 @@ type NodeId = String type PropId = String -- | A modular transition system is defined by a graph of nodes and a series --- of properties, each mapped to a variable. +-- of properties, each mapped to a variable and a 'C.Prop' describing how the +-- property is quantified. data TransSys = TransSys { specNodes :: [Node] , specTopNodeId :: NodeId diff --git a/copilot-theorem/src/Copilot/Theorem/TransSys/Translate.hs b/copilot-theorem/src/Copilot/Theorem/TransSys/Translate.hs index f15162e49..2659fa6cb 100644 --- a/copilot-theorem/src/Copilot/Theorem/TransSys/Translate.hs +++ b/copilot-theorem/src/Copilot/Theorem/TransSys/Translate.hs @@ -141,7 +141,15 @@ streamOfProp :: C.Property -> C.Stream streamOfProp prop = C.Stream { C.streamId = 42 , C.streamBuffer = [] - , C.streamExpr = C.extractProp (C.propertyProp prop) + -- TransSys encodes all properties using universal quantification. + -- Therefore, in order to encode an existentially quantified + -- property ∃x.P(x), we must first convert it to ¬(∀x.¬(P(x))). + -- The `Exists` case below handles the ∀x.¬(P(x)) part by adding + -- an `Op1 Not` around the property. The outermost negation is + -- handled elsewhere (e.g., in Copilot.Theorem.Kind2.Output.parse). + , C.streamExpr = case C.propertyProp prop of + C.Forall p -> p + C.Exists p -> C.Op1 C.Not p , C.streamExprType = C.Bool } stream :: C.Stream -> Trans Node From 3b51c969d863755431cb628de80bc02e0c243a8d Mon Sep 17 00:00:00 2001 From: Ryan Scott Date: Fri, 7 Mar 2025 07:08:02 -0500 Subject: [PATCH 0922/1222] copilot-theorem: Document changes in CHANGELOG. Refs #594. --- copilot-theorem/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-theorem/CHANGELOG b/copilot-theorem/CHANGELOG index d3c2bd464..8416d3a75 100644 --- a/copilot-theorem/CHANGELOG +++ b/copilot-theorem/CHANGELOG @@ -1,3 +1,6 @@ +2025-04-17 + * Translate quantifiers correctly in Kind2 backend. (#594) + 2025-03-07 * Version bump (4.3). (#604) * Fix multiple typos in README. (#560) From 03b7adc2bc7d119f1d6214166208071378f43d41 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 21 Apr 2025 09:44:38 -0700 Subject: [PATCH 0923/1222] copilot-core: Remove deprecated Copilot.Core.Type.uTypeType. Refs #615. The record field uTypeType, part of Copilot.Core.Type.UType, is never really used within the module or in any other part of Copilot or, as far as we know, by any user of Copilot. The record field was deprecated in Copilot 4.1 and no messages have been received requesting that it be kept in this library. As per our internal policy of waiting 3 versions from deprecation until a public interface declaration can be removed, this definition can now be removed. This commit removes the field uTypeType from the definition of Copilot.Core.Type.UType, making the type no longer a record. --- copilot-core/src/Copilot/Core/Type.hs | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/copilot-core/src/Copilot/Core/Type.hs b/copilot-core/src/Copilot/Core/Type.hs index 8d54c82f3..b290810c2 100644 --- a/copilot-core/src/Copilot/Core/Type.hs +++ b/copilot-core/src/Copilot/Core/Type.hs @@ -289,8 +289,7 @@ instance (Typeable t, Typed t, KnownNat n) => Typed (Array n t) where simpleType (Array t) = SArray t -- | A untyped type (no phantom type). -data UType = forall a . Typeable a => UType { uTypeType :: Type a } -{-# DEPRECATED uTypeType "This field is deprecated in Copilot 4.1. Use pattern matching instead." #-} +data UType = forall a . Typeable a => UType (Type a) instance Eq UType where UType ty1 == UType ty2 = typeRep ty1 == typeRep ty2 From 3e0b13d8a1b4f9317759a11fc4a4c65056cb9033 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 21 Apr 2025 09:46:50 -0700 Subject: [PATCH 0924/1222] copilot-core: Document changes in CHANGELOG. Refs #615. --- copilot-core/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-core/CHANGELOG b/copilot-core/CHANGELOG index 371c8c2d9..9ae7dd071 100644 --- a/copilot-core/CHANGELOG +++ b/copilot-core/CHANGELOG @@ -1,3 +1,6 @@ +2025-04-21 + * Remove deprecated Copilot.Core.Type.uTypeType. (#615) + 2025-03-07 * Version bump (4.3). (#604) * Fix typo in documentation. (#587) From bb3a109c682b642eb40343746c255aaa177fbe20 Mon Sep 17 00:00:00 2001 From: kaBeech Date: Fri, 18 Apr 2025 11:11:42 -0700 Subject: [PATCH 0925/1222] copilot: Update build status URL. Refs #612. Currently the badge for the build status in the README doesn't show up correctly. GitHub has cached the result but it's not providing the resulting image, so we see "Build Status" instead. This commit updates the badge URL to the current "https://api.travis-ci.com/Copilot-Language/copilot.svg?branch=master", which enables the badge to show properly. --- copilot/README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot/README.md b/copilot/README.md index efdc58d28..893d6a933 100644 --- a/copilot/README.md +++ b/copilot/README.md @@ -2,7 +2,7 @@ # Copilot -[![Build Status](https://travis-ci.com/Copilot-Language/copilot.svg?branch=master)](https://app.travis-ci.com/github/Copilot-Language/copilot) +[![Build Status](https://api.travis-ci.com/Copilot-Language/copilot.svg?branch=master)](https://app.travis-ci.com/github/Copilot-Language/copilot) [![Version on Hackage](https://img.shields.io/hackage/v/copilot.svg)](https://hackage.haskell.org/package/copilot) Copilot is a runtime verification framework for hard real-time systems. From e54f7c0f43b8785a0f478988adea289d76ca634f Mon Sep 17 00:00:00 2001 From: kaBeech Date: Fri, 18 Apr 2025 11:34:58 -0700 Subject: [PATCH 0926/1222] copilot: Document changes in CHANGELOG. Refs #612. --- copilot/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot/CHANGELOG b/copilot/CHANGELOG index abd146bba..e39981d15 100644 --- a/copilot/CHANGELOG +++ b/copilot/CHANGELOG @@ -1,3 +1,6 @@ +2025-04-18 + * Update build status badge URL. (#612) + 2025-03-07 * Version bump (4.3). (#604) * Include missing dependencies in installation instructions. (#591) From faa9ba72a582da608be6d5d53a351e228cf44bc6 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Wed, 7 May 2025 20:21:58 -0700 Subject: [PATCH 0927/1222] Bump versions and constraints. Refs #618. --- copilot-c99/copilot-c99.cabal | 4 ++-- copilot-core/copilot-core.cabal | 2 +- copilot-interpreter/copilot-interpreter.cabal | 4 ++-- copilot-language/copilot-language.cabal | 8 ++++---- copilot-libraries/copilot-libraries.cabal | 4 ++-- copilot-prettyprinter/copilot-prettyprinter.cabal | 4 ++-- copilot-theorem/copilot-theorem.cabal | 6 +++--- copilot/copilot.cabal | 14 +++++++------- 8 files changed, 23 insertions(+), 23 deletions(-) diff --git a/copilot-c99/copilot-c99.cabal b/copilot-c99/copilot-c99.cabal index 48fc6aa36..dabf04bf0 100644 --- a/copilot-c99/copilot-c99.cabal +++ b/copilot-c99/copilot-c99.cabal @@ -1,6 +1,6 @@ cabal-version : >= 1.10 name : copilot-c99 -version : 4.3 +version : 4.4 synopsis : A compiler for Copilot targeting C99. description : This package is a back-end from Copilot to C. @@ -45,7 +45,7 @@ library , mtl >= 2.2 && < 2.4 , pretty >= 1.1 && < 1.2 - , copilot-core >= 4.3 && < 4.4 + , copilot-core >= 4.4 && < 4.5 , language-c99 >= 0.2.0 && < 0.3 , language-c99-simple >= 0.3 && < 0.4 diff --git a/copilot-core/copilot-core.cabal b/copilot-core/copilot-core.cabal index 1140f129e..daab8383b 100644 --- a/copilot-core/copilot-core.cabal +++ b/copilot-core/copilot-core.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-core -version: 4.3 +version: 4.4 synopsis: An intermediate representation for Copilot. description: Intermediate representation for Copilot. diff --git a/copilot-interpreter/copilot-interpreter.cabal b/copilot-interpreter/copilot-interpreter.cabal index 835f27106..d5b679829 100644 --- a/copilot-interpreter/copilot-interpreter.cabal +++ b/copilot-interpreter/copilot-interpreter.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-interpreter -version: 4.3 +version: 4.4 synopsis: Interpreter for Copilot. description: Interpreter for Copilot. @@ -44,7 +44,7 @@ library base >= 4.9 && < 5, pretty >= 1.0 && < 1.2, - copilot-core >= 4.3 && < 4.4 + copilot-core >= 4.4 && < 4.5 exposed-modules: diff --git a/copilot-language/copilot-language.cabal b/copilot-language/copilot-language.cabal index 53c981618..87d54101d 100644 --- a/copilot-language/copilot-language.cabal +++ b/copilot-language/copilot-language.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-language -version: 4.3 +version: 4.4 synopsis: A Haskell-embedded DSL for monitoring hard real-time distributed systems. description: @@ -42,9 +42,9 @@ library , data-reify >= 0.6 && < 0.7 , mtl >= 2.0 && < 3 - , copilot-core >= 4.3 && < 4.4 - , copilot-interpreter >= 4.3 && < 4.4 - , copilot-theorem >= 4.3 && < 4.4 + , copilot-core >= 4.4 && < 4.5 + , copilot-interpreter >= 4.4 && < 4.5 + , copilot-theorem >= 4.4 && < 4.5 exposed-modules: Copilot.Language , Copilot.Language.Operators.BitWise diff --git a/copilot-libraries/copilot-libraries.cabal b/copilot-libraries/copilot-libraries.cabal index 737a590e7..078d009fd 100644 --- a/copilot-libraries/copilot-libraries.cabal +++ b/copilot-libraries/copilot-libraries.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-libraries -version: 4.3 +version: 4.4 synopsis: Libraries for the Copilot language. description: Libraries for the Copilot language. @@ -41,7 +41,7 @@ library , containers >= 0.4 && < 0.8 , mtl >= 2.0 && < 2.4 , parsec >= 2.0 && < 3.2 - , copilot-language >= 4.3 && < 4.4 + , copilot-language >= 4.4 && < 4.5 exposed-modules: Copilot.Library.Libraries diff --git a/copilot-prettyprinter/copilot-prettyprinter.cabal b/copilot-prettyprinter/copilot-prettyprinter.cabal index 46e8de208..2a4a9578f 100644 --- a/copilot-prettyprinter/copilot-prettyprinter.cabal +++ b/copilot-prettyprinter/copilot-prettyprinter.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-prettyprinter -version: 4.3 +version: 4.4 synopsis: A prettyprinter of Copilot Specifications. description: A prettyprinter of Copilot specifications. @@ -45,7 +45,7 @@ library base >= 4.9 && < 5, pretty >= 1.0 && < 1.2, - copilot-core >= 4.3 && < 4.4 + copilot-core >= 4.4 && < 4.5 exposed-modules: diff --git a/copilot-theorem/copilot-theorem.cabal b/copilot-theorem/copilot-theorem.cabal index c6994913f..ad7ab8699 100644 --- a/copilot-theorem/copilot-theorem.cabal +++ b/copilot-theorem/copilot-theorem.cabal @@ -14,7 +14,7 @@ description: . -version : 4.3 +version : 4.4 license : BSD3 license-file : LICENSE maintainer : Ivan Perez @@ -63,8 +63,8 @@ library , xml >= 1.3 && < 1.4 , what4 >= 1.3 && < 1.7 - , copilot-core >= 4.3 && < 4.4 - , copilot-prettyprinter >= 4.3 && < 4.4 + , copilot-core >= 4.4 && < 4.5 + , copilot-prettyprinter >= 4.4 && < 4.5 exposed-modules : Copilot.Theorem , Copilot.Theorem.Prove diff --git a/copilot/copilot.cabal b/copilot/copilot.cabal index a39788ab8..6401ef883 100644 --- a/copilot/copilot.cabal +++ b/copilot/copilot.cabal @@ -1,5 +1,5 @@ name: copilot -version: 4.3 +version: 4.4 cabal-version: >= 1.10 license: BSD3 license-file: LICENSE @@ -52,12 +52,12 @@ library , directory >= 1.3 && < 1.4 , filepath >= 1.4 && < 1.6 - , copilot-core >= 4.3 && < 4.4 - , copilot-theorem >= 4.3 && < 4.4 - , copilot-language >= 4.3 && < 4.4 - , copilot-libraries >= 4.3 && < 4.4 - , copilot-c99 >= 4.3 && < 4.4 - , copilot-prettyprinter >= 4.3 && < 4.4 + , copilot-core >= 4.4 && < 4.5 + , copilot-theorem >= 4.4 && < 4.5 + , copilot-language >= 4.4 && < 4.5 + , copilot-libraries >= 4.4 && < 4.5 + , copilot-c99 >= 4.4 && < 4.5 + , copilot-prettyprinter >= 4.4 && < 4.5 exposed-modules: Language.Copilot, Language.Copilot.Main From 2ff7d9f9e4a5f69c04e88d5b67995e5b28da3cdc Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Wed, 7 May 2025 20:23:06 -0700 Subject: [PATCH 0928/1222] Document changes in CHANGELOG. Refs #618. --- copilot-c99/CHANGELOG | 3 +++ copilot-core/CHANGELOG | 3 ++- copilot-interpreter/CHANGELOG | 3 +++ copilot-language/CHANGELOG | 3 +++ copilot-libraries/CHANGELOG | 3 +++ copilot-prettyprinter/CHANGELOG | 3 +++ copilot-theorem/CHANGELOG | 3 ++- copilot/CHANGELOG | 3 ++- 8 files changed, 21 insertions(+), 3 deletions(-) diff --git a/copilot-c99/CHANGELOG b/copilot-c99/CHANGELOG index 48f275cf7..00f705df8 100644 --- a/copilot-c99/CHANGELOG +++ b/copilot-c99/CHANGELOG @@ -1,3 +1,6 @@ +2025-05-07 + * Version bump (4.4). (#618) + 2025-03-07 * Version bump (4.3). (#604) diff --git a/copilot-core/CHANGELOG b/copilot-core/CHANGELOG index 9ae7dd071..4a0902c21 100644 --- a/copilot-core/CHANGELOG +++ b/copilot-core/CHANGELOG @@ -1,4 +1,5 @@ -2025-04-21 +2025-05-07 + * Version bump (4.4). (#618) * Remove deprecated Copilot.Core.Type.uTypeType. (#615) 2025-03-07 diff --git a/copilot-interpreter/CHANGELOG b/copilot-interpreter/CHANGELOG index 924fa7436..c5f4894c8 100644 --- a/copilot-interpreter/CHANGELOG +++ b/copilot-interpreter/CHANGELOG @@ -1,3 +1,6 @@ +2025-05-07 + * Version bump (4.4). (#618) + 2025-03-07 * Version bump (4.3). (#604) diff --git a/copilot-language/CHANGELOG b/copilot-language/CHANGELOG index 2f729caac..fc28f01f1 100644 --- a/copilot-language/CHANGELOG +++ b/copilot-language/CHANGELOG @@ -1,3 +1,6 @@ +2025-05-07 + * Version bump (4.4). (#618) + 2025-03-07 * Version bump (4.3). (#604) * Fix typo in documentation. (#587) diff --git a/copilot-libraries/CHANGELOG b/copilot-libraries/CHANGELOG index 228e37a5d..a0c598f54 100644 --- a/copilot-libraries/CHANGELOG +++ b/copilot-libraries/CHANGELOG @@ -1,3 +1,6 @@ +2025-05-07 + * Version bump (4.4). (#618) + 2025-03-07 * Version bump (4.3). (#604) * Remove deprecated function Copilot.Library.Utils.(!!). (#599) diff --git a/copilot-prettyprinter/CHANGELOG b/copilot-prettyprinter/CHANGELOG index caec436ef..360d2e9a0 100644 --- a/copilot-prettyprinter/CHANGELOG +++ b/copilot-prettyprinter/CHANGELOG @@ -1,3 +1,6 @@ +2025-05-07 + * Version bump (4.4). (#618) + 2025-03-07 * Version bump (4.3). (#604) * Update pretty-printing to handle Props. (#254) diff --git a/copilot-theorem/CHANGELOG b/copilot-theorem/CHANGELOG index 8416d3a75..f221aec44 100644 --- a/copilot-theorem/CHANGELOG +++ b/copilot-theorem/CHANGELOG @@ -1,4 +1,5 @@ -2025-04-17 +2025-05-07 + * Version bump (4.4). (#618) * Translate quantifiers correctly in Kind2 backend. (#594) 2025-03-07 diff --git a/copilot/CHANGELOG b/copilot/CHANGELOG index e39981d15..b38dd2c3d 100644 --- a/copilot/CHANGELOG +++ b/copilot/CHANGELOG @@ -1,4 +1,5 @@ -2025-04-18 +2025-05-07 + * Version bump (4.4). (#618) * Update build status badge URL. (#612) 2025-03-07 From 39955b81ca3a2ed84702be73ebb3e67baeb9af06 Mon Sep 17 00:00:00 2001 From: Ryan Scott Date: Wed, 28 May 2025 15:14:33 -0400 Subject: [PATCH 0929/1222] copilot-bluespec: Include in mainline copilot repo. Refs #623. The `copilot-bluespec` package was originally developed in an external repo (https://github.com/Copilot-Language/copilot-bluespec), but there is interest in having all Copilot projects and libraries merged into the main https://github.com/Copilot-Language/copilot repo for ease of management. This commit includes the last state of the old `copilot-bluespec` repo into the main Copilot repo as a new subdirectory, disregarding the commit history. --- copilot-bluespec/.dockerignore | 29 + copilot-bluespec/CHANGELOG | 35 + copilot-bluespec/DESIGN.md | 928 +++++++++++ copilot-bluespec/Dockerfile | 36 + copilot-bluespec/LICENSE | 29 + copilot-bluespec/README.md | 57 + copilot-bluespec/Setup.hs | 2 + copilot-bluespec/copilot-bluespec.cabal | 100 ++ .../src/Copilot/Compile/Bluespec.hs | 12 + .../src/Copilot/Compile/Bluespec/CodeGen.hs | 262 +++ .../src/Copilot/Compile/Bluespec/Compile.hs | 350 ++++ .../src/Copilot/Compile/Bluespec/Error.hs | 20 + .../src/Copilot/Compile/Bluespec/Expr.hs | 671 ++++++++ .../src/Copilot/Compile/Bluespec/External.hs | 57 + .../Copilot/Compile/Bluespec/FloatingPoint.hs | 171 ++ .../src/Copilot/Compile/Bluespec/Name.hs | 95 ++ .../Compile/Bluespec/Representation.hs | 22 + .../src/Copilot/Compile/Bluespec/Settings.hs | 14 + .../src/Copilot/Compile/Bluespec/Type.hs | 95 ++ copilot-bluespec/tests/Main.hs | 18 + .../tests/Test/Copilot/Compile/Bluespec.hs | 1470 +++++++++++++++++ .../Test/Copilot/Compile/Bluespec/External.hs | 63 + 22 files changed, 4536 insertions(+) create mode 100644 copilot-bluespec/.dockerignore create mode 100644 copilot-bluespec/CHANGELOG create mode 100644 copilot-bluespec/DESIGN.md create mode 100644 copilot-bluespec/Dockerfile create mode 100644 copilot-bluespec/LICENSE create mode 100644 copilot-bluespec/README.md create mode 100644 copilot-bluespec/Setup.hs create mode 100644 copilot-bluespec/copilot-bluespec.cabal create mode 100644 copilot-bluespec/src/Copilot/Compile/Bluespec.hs create mode 100644 copilot-bluespec/src/Copilot/Compile/Bluespec/CodeGen.hs create mode 100644 copilot-bluespec/src/Copilot/Compile/Bluespec/Compile.hs create mode 100644 copilot-bluespec/src/Copilot/Compile/Bluespec/Error.hs create mode 100644 copilot-bluespec/src/Copilot/Compile/Bluespec/Expr.hs create mode 100644 copilot-bluespec/src/Copilot/Compile/Bluespec/External.hs create mode 100644 copilot-bluespec/src/Copilot/Compile/Bluespec/FloatingPoint.hs create mode 100644 copilot-bluespec/src/Copilot/Compile/Bluespec/Name.hs create mode 100644 copilot-bluespec/src/Copilot/Compile/Bluespec/Representation.hs create mode 100644 copilot-bluespec/src/Copilot/Compile/Bluespec/Settings.hs create mode 100644 copilot-bluespec/src/Copilot/Compile/Bluespec/Type.hs create mode 100644 copilot-bluespec/tests/Main.hs create mode 100644 copilot-bluespec/tests/Test/Copilot/Compile/Bluespec.hs create mode 100644 copilot-bluespec/tests/Test/Copilot/Compile/Bluespec/External.hs diff --git a/copilot-bluespec/.dockerignore b/copilot-bluespec/.dockerignore new file mode 100644 index 000000000..d1a0321bc --- /dev/null +++ b/copilot-bluespec/.dockerignore @@ -0,0 +1,29 @@ +dist +dist-* +cabal-dev +*.o +*.hi +*.chi +*.chs.h +*.dyn_o +*.dyn_hi +.hpc +.hsenv +.cabal-sandbox/ +cabal.sandbox.config +*.prof +*.aux +*.hp +*.eventlog +.stack-work/ +cabal.project.local +cabal.project.local~ +.HTF/ +.ghc.environment.* +copilot-profiling +.DS_Store +.log + +Dockerfile +.git +.gitignore diff --git a/copilot-bluespec/CHANGELOG b/copilot-bluespec/CHANGELOG new file mode 100644 index 000000000..e062468a0 --- /dev/null +++ b/copilot-bluespec/CHANGELOG @@ -0,0 +1,35 @@ +2025-05-08 + * Version bump (4.4). (#43) + +2025-05-05 + * Version bump (4.3.1). (#41) + * Move Copilot.Compile.Bluespec.External out of shared directory. (#36) + * Allow building with filepath-1.5.*. (#39) + +2025-03-10 + * Version bump (4.3). (#34) + +2025-01-20 + * Version bump (4.2). (#31) + * Implement missing floating-point operations. (#28) + * Allow using same trigger name in multiple declarations. (#30) + +2024-11-08 + * Version bump (4.1). (#25) + +2024-09-09 + * Version bump (4.0). (#23) + * Support translating Copilot array updates to Bluespec. (#19) + +2024-08-03 + * Test GHC 9.4 through 9.8. (#20) + +2024-07-11 + * Version bump (3.20). (#11) + * Support translating Copilot struct updates to Bluespec (#10). + * Fix a bug in the translation of the signum function. (#14) + * Fix a bug in the translation of floating-point comparisons. (#15) + +2024-03-08 + * Version bump (3.19). (#5) + * Create new library for Bluespec backend. diff --git a/copilot-bluespec/DESIGN.md b/copilot-bluespec/DESIGN.md new file mode 100644 index 000000000..dffb607ac --- /dev/null +++ b/copilot-bluespec/DESIGN.md @@ -0,0 +1,928 @@ +# The design of `copilot-bluespec` + +This document provides an overview of how the `copilot-bluespec` library +compiles a Copilot specification to a Bluespec program. We assume that you +already have some familiarity with core Copilot concepts such as streams, +triggers, externs, etc. + +## Bluespec overview + +Bluespec is a high-level hardware design language (HDL). Bluespec comes with a +compiler, `bsc`, as well as its own simulator, which allows users to run +Bluespec programs easily. Bluespec also supports compiling to Verilog. + +There are two different syntaxes for the Bluespec language: Bluespec Haskell +(BH) and Bluespec SystemVerilog (BSV). Bluespec Haskell (also known as Bluespec +Classic), the older of the two syntaxes, is a more functional, high-level +syntax that is heavily inspired by the Haskell programming language. Bluespec +SystemVerilog, which was created later, more closely SystemVerilog and targets +hardware design engineers who are more familiar with SystemVerilog's syntax. +Both syntaxes are merely front-ends for the same language, and programs written +in one syntax can be converted to the other. + +The `copilot-bluespec` library compiles to Bluespec Haskell rather than +Bluespec SystemVerilog. This is primarily because BH's Haskell-like syntax is a +closer fit to how Copilot is structured, which makes the design of the compiler +simpler. + +## A small example + +To get a sense for how `copilot-bluespec` works, let us compile a simple +Copilot specification down to Bluespec. Our specification will declare a stream +containing the Fibonacci numbers, along with some triggers that will fire if a +Fibonacci number is even or odd: + +```hs +module Main (main) where + +import qualified Prelude as P () + +import Language.Copilot +import Copilot.Compile.Bluespec + +fibs :: Stream Word32 +fibs = [1, 1] ++ (fibs + drop 1 fibs) + +evenStream :: Stream Word32 -> Stream Bool +evenStream n = (n `mod` constant 2) == constant 0 + +oddStream :: Stream Word32 -> Stream Bool +oddStream n = not (evenStream n) + +spec :: Spec +spec = do + trigger "even" (evenStream fibs) [arg fibs] + trigger "odd" (oddStream fibs) [arg fibs] + +main :: IO () +main = do + spec' <- reify spec + compile "Fibs" spec' +``` + +Note that the only parts of this program that are `copilot-bluespec`–specific +are: + +1. The `import Copilot.Compile.Bluespec` statement, and +2. The call to `compile "Fibs" spec'` in `main`. This will compile the Copilot + specification to a Bluespec program named `Fibs.bs`. + +Running this program will generate five files[^1]: + +[^1]: The actual code in these files is machine-generated and somewhat +difficult to read. We have cleaned up the code slightly to make it easier to +understand. + +* `FibsTypes.bs`: If the Copilot specification contains any structs, then this + file will contain the corresponding Bluespec struct definitions. The + specification does not contain any structs, so this file is mostly empty: + + ```bluespec + package FibsTypes where + + import FloatingPoint + import Vector + ``` + + Later in this document, we will see a different example that makes use of + structs. Note that the syntax used here is much like in Haskell, with a + notable difference being that Bluespec uses the `package` keyword instead of + `module`. + +* `FibsIfc.bs`: This file defines a _module interface_ `FibsIfc`, whose methods + correspond to the names of the triggers in the Copilot spec: + + ```bluespec + package FibsIfc where + + import FloatingPoint + import Vector + + import FibsTypes + + interface FibsIfc = + even :: UInt 32 -> Action + odd :: UInt 32 -> Action + ``` + + An interface like `FibsIfc` can be thought of as a special form of data type + that describes how a module (a hardware object) interacts with the + surrounding environment. In order for an application to make use of a Copilot + monitor, it must instantiate `FibsIfc`'s methods. Each method takes a `UInt + 32` (an unsigned 32-bit integer) as an argument and return an `Action`, which + is the Bluespec type for expressions that act on the state of the circuit (at + circuit execution time). Possible `Action`s include reading from and writing + to registers, as well as printing messages. + + We will see an example of how to instantiate `FibsIfc` later. + +* `Fibs.bs`: This file defines a `mkFibs` function, which orchestrates + everything in the generated Bluespec monitor: + + ```bluespec + package Fibs where + + import FloatingPoint + import Vector + + import FibsTypes + import FibsIfc + import BluespecFP + + mkFibs :: Module FibsIfc -> Module Empty + mkFibs ifcMod = + module + ifc <- ifcMod + + s0_0 :: Reg (UInt 32) <- mkReg 1 + s0_1 :: Reg (UInt 32) <- mkReg 1 + let s0 :: Vector 2 (Reg (UInt 32)) + s0 = update (update newVector 0 s0_0) 1 s0_1 + s0_idx :: Reg (Bit 64) <- mkReg 0 + + let s0_get :: Bit 64 -> UInt 32 + s0_get x = (select s0 ((s0_idx + x) % 2))._read + + s0_gen :: UInt 32 + s0_gen = s0_get 0 + s0_get 1 + + even_guard :: Bool + even_guard = + (s0_get 0 % 2) == 0 + + odd_guard :: Bool + odd_guard = + not (s0_get 0 % 2 == 0) + + rules + "even": when even_guard ==> + ifc.even (s0_get 0) + + "odd:": when odd_guard ==> + ifc.odd (s0_get 0) + + "step": when True ==> + action + select s0 s0_idx := s0_gen + s0_idx := (s0_idx + 1) % 2 + ``` + + `mkFibs` returns a module, which can be thought of as a generator of hardware + objects. `mkFibs` takes a `FibsIfc` module as an argument and returns another + module, which is parameterized by `Empty`. `Empty` is a standard interface + with no methods, and `Empty` is typically used in top-level modules that act + as program entrypoints. + + Note that the `module` and `action` keywords can be thought of as specialized + versions of Haskell's `do`-notation, where `module` denotes the `Module` + monad, and `action` denotes the `ActionValue` monad. (Note that `Action` is + an alias for `ActionValue ()`.) The `Monad` monad describes how to elaborate + the structure of a module, whereas the `ActionValue` monad describes the + behavior of a circuit at execution time. + +* `BluespecFP.bsv`: A collection of floating-point operations that leverage BDPI + (Bluespec's foreign-function interface). We will omit the full contents of + this file for brevity, but it will look something like this: + + ```bluespec + import FloatingPoint::*; + + import "BDPI" function Float bs_fp_expf (Float x); + import "BDPI" function Double bs_fp_exp (Double x); + import "BDPI" function Float bs_fp_logf (Float x); + import "BDPI" function Double bs_fp_log (Double x); + ... + ``` + + For more information on what this file does, see the "Floating-point numbers" + section below. + +* `bs_fp.c`: A collection of floating-point operations implemented in C. These + functions are imported via BDPI in `BluespecFP.bsv`. We will omit the full + contents of this file for brevity, but it will look something like this: + + ```bluespec + #include + + union ui_float { + unsigned int i; + float f; + }; + + union ull_double { + unsigned long long i; + double f; + }; + + unsigned int bs_fp_expf(unsigned int x) { + ... + } + + unsigned long long bs_fp_exp(unsigned long long x) { + ... + } + + unsigned int bs_fp_logf(unsigned int x) { + ... + } + + unsigned long long bs_fp_log(unsigned long long x) { + ... + } + + ... + ``` + + For more information on what this file does, see the "Floating-point numbers" + section below. + +In a larger application, a Copilot user would instantiate `mkFibs` with a +`FibsIfc` module that describes what should happen when the `even` and `odd` +triggers fire. `FibsIfc` contains everything that the user must supply; +everything else is handled within the module that `mkFibs` returns. + +Here is an example of a larger application might look like: + +```bluespec +package Top where + +import Fibs +import FibsIfc +import FibsTypes + +fibsIfc :: Module FibsIfc +fibsIfc = + module + interface + even x = + $display "Even Fibonacci number: %0d" x + + odd x = + $display "Odd Fibonacci number: %0d" x + +mkTop :: Module Empty +mkTop = mkFibs fibsIfc +``` + +`mkTop` is the top-level module that we will use as a program entrypoint. The +only interesting thing that it does is instantiate `mkFibs` with a custom +`FibsIfc`, where `even` and `odd` are defined to display a custom message +whenever an even or odd Fibonacci number is encountered, respectively. + +We can run `mkTop` by using Bluespec's simulator like so: + +``` +$ bsc -sim -g mkTop -u Top.bs +checking package dependencies +compiling Top.bs +code generation for mkTop starts +Elaborated module file created: mkTop.ba +All packages are up to date. + +$ bsc -sim -e mkTop -o mkTop.exe bs_fp.c +Bluesim object created: mkTop.{h,o} +Bluesim object created: model_mkTop.{h,o} +Simulation shared library created: mkTop.exe.so +Simulation executable created: mkTop.exe + +$ ./mkTop.exe -m 10 +Odd Fibonacci number: 1 +Odd Fibonacci number: 1 +Even Fibonacci number: 2 +Odd Fibonacci number: 3 +Odd Fibonacci number: 5 +Even Fibonacci number: 8 +Odd Fibonacci number: 13 +Odd Fibonacci number: 21 +Even Fibonacci number: 34 +``` + +We pass `-m 10` to instruct Bluespec's simulator to only run for 10 clock +cycles. Note that the first clock cycle does not fire any rules. This is a +quirk of how hardware works: the reset signal is off in the first cycle, and +the values of registers do not become ready until after the reset signal is +enabled. Because all of the rules depend on registers, none of them will fire +until the second clock cycle or later. + +## Streams + +Much like in `copilot-c99`, `copilot-bluespec` translates each stream +declaration into a ring buffer. More concretely, it translates a `Stream t` +into a `Vector n (Reg t)`, where: + +* A `Vector` is an array whose length is encoded at the type level, must + like Copilot's arrays. (Note that Bluespec has a separate `Array` type, but + `Array`s are more low-level, and they are not indexed by their length at the + type level.) + +* `n` is the minimum number of elements needed to compute later values in the + stream. + +* `t` is the stream's element type. + +* `Reg` is a register, which stores a value that can be read from and written + to. As time advances, we will update the `Reg`s in the ring buffer with later + values in the stream. + +(Commentary: a ring buffer is not the only way we could translate a stream to +Bluespec. Bluespec also has a +[`MIMO`](https://github.com/B-Lang-org/bsc/blob/f00d205867eefe09c60e11b4df155bb87041799a/src/Libraries/Base3-Misc/MIMO.bsv#L52-L73) +(many-in, many-out) queue that is _almost_ suitable for our needs, but it comes +with an unusual restriction that it must have a minimum size of 2 elements. +There exist Copilot streams that only require one element of storage, so we +would have to special-case these streams if we wanted to use a `MIMO`.) + +The `Fibs.bs` example above contains exactly one stream, which is created at +the top of the `mkFibs` function: + +```bluespec + s0_0 :: Reg (UInt 32) <- mkReg 1 + s0_1 :: Reg (UInt 32) <- mkReg 1 + let s0 :: Vector 2 (Reg (UInt 32)) + s0 = update (update newVector 0 s0_0) 1 s0_1 + s0_idx :: Reg (Bit 64) <- mkReg 0 +``` + +Here, `s0_idx`, tracks the index of the next stream element to be updated. +`mkFibs` then defines several functions in terms of `s0` and `s0_idx`, which +are then used in the rules, which we will describe later. Note that `s0_idx` is +a register of type `Bit 64`, which can be thought of as a raw 64-bit value. + +In order to access an element of a stream, we make use of the `s0_get` +function: + +```bluespec + let s0_get :: Bit 64 -> UInt 32 + s0_get x = (select s0 ((s0_idx + x) % 2))._read +``` + +This will use `s0_idx` and an offset `x` to compute which `Reg` in the `Vector` +to read from. + +## Rules + +The _rules_ govern what actions are performed during each cycle. There are +three actions in the `Fibs.hs` example: + +```bluespec + rules + "even": when even_guard ==> + ifc.even (s0_get 0) + + "odd:": when odd_guard ==> + ifc.odd (s0_get 0) + + "step": when True ==> do + select s0 s0_idx := s0_gen + s0_idx := (s0_idx + 1) % 2 +``` + +Each rule consists of three parts: + +1. A label (e.g., `"even"`) that uniquely identifies the rule within the + module. + +2. An explicit condition, which is a boolean expression of the form + `when ==> ...`. In order for a rule to fire on a given clock cycle, + its explicit condition `` must hold. + +3. A rule body (e.g., `ifc.even (s0_get 0)`), which describes what action the + rule performs if it fires on a given clock cycle. + +In the example above, the `"even"` and `"odd"` rules govern the behavior of the +triggers in the Copilot specification. These rules will only fire if +`even_guard` or `odd_guard` hold, and if they fire, they will call the `even` +or `odd` method of `FibsIfcs`, respectively. The definitions of `even_guard` +and `odd_guard` are: + +```bluespec + even_guard :: Bool + even_guard = + (s0_get 0 % 2) == 0 + + odd_guard :: Bool + odd_guard = + not (s0_get 0 % 2 == 0) +``` + +The `"step"` rule is the heart of the Copilot specification, and it always runs +on each clock cycle. `"step"` does two things: + +1. It computes the next element of the `s0` stream using the `s0_gen` function, + which is defined like so: + + ```bluespec + s0_gen :: UInt 32 + s0_gen = s0_get 0 + s0_get 1 + ``` + +2. It increments `s0_idx`, making sure to wrap around to `0` if its value + exceeds `1`. + +### A note on atomicity + +Bluespec rules are _atomic_, which means that the Bluespec compiler will ensure +that the rules are executed in some logical order that ensures the absence of +race conditions. Moreover, all register updates that occur within a module's +rules are performed simultaneously at the end of a clock cycle. + +This might seem strange if you are accustomed to the execution model of a +language like C, where all statements (and their accompanying side effects) are +invoked sequentially, one after the other. This is not how Bluespec works, +however. Recall the definitions of the three rules in the example program +above: + +```bluespec + rules + "even": when even_guard ==> + ifc.even (s0_get 0) + + "odd:": when odd_guard ==> + ifc.odd (s0_get 0) + + "step": when True ==> do + select s0 s0_idx := s0_gen + s0_idx := (s0_idx + 1) % 2 +``` + +If this were a language like C, then the order in which the rules appear would +have an effect on the runtime semantics of the program, as the behavior of +`s0_get` (used in the `"even"` and `"odd"` rules) depends on the current value +of `s0` and `s0_idx`. In Bluespec, however, the order of these rules do _not_ +matter. The `"step"` rule performs side effects of updating the value of `s0` +and `s0_idx`, but these effects are performed in a single, atomic transaction +at the end of the clock cycle. This means that the values of `s0` and `s0_idx` +that `s0_get` sees will always match their values at the start of the clock +cycle, regardless of what order Bluespec uses to invoke the rules. + +Because the Bluespec compiler can pick whatever rule order it wishes to, this +can impact the order in which `$display` output is presented. This doesn't +impact the example above, as the `"even"` and `"odd"` rules will never fire on +the same clock cycle, meaning that there is always only one `$display` call per +cycle. If program fires multiple rules on a clock cycle and each one calls +`$display`, then the order in which the `$display` calls will run is not +specified. + +## External streams + +The example above sampled data from a stream that was defined within the +Copilot specification. To see what happens when a specification uses an +external stream, let's make one small change to the example: + +```diff + fibs :: Stream Word32 +-fibs = [1, 1] ++ (fibs + drop 1 fibs) ++fibs = extern "fibs" Nothing +``` + +Now let's re-run the example and inspect the resulting Bluespec program. There +are two notable changes worth commenting on. The first change is in +`FibsIfc.bs`: + +```bluespec +package FibsIfc where + +import FloatingPoint +import Vector + +import FibsTypes + +interface FibsIfc = + even :: UInt 32 -> Action + odd :: UInt 32 -> Action + fibs :: Reg (UInt 32) +``` + +This time, the `FibsIfc` interface has an additional `fibs` method of type `Reg +(UInt 32)`. This register corresponds to the external stream that we just +defined, and it is the responsibility of the application which instantiates +`FibsIfc` to dictate what values should be written to the register. + +The second change is in `Fibs.bs`: + +```bluespec +package Fibs where + +import FloatingPoint +import Vector + +import FibsTypes +import FibsIfc + +mkFibs :: Module FibsIfc -> Module Empty +mkFibs ifcMod = + module + ifc <- ifcMod + + let even_guard :: Bool + even_guard = + (ifc.fibs._read % 2) == 0 + + odd_guard :: Bool + odd_guard = + not (ifc.fibs._read % 2 == 0) + + rules + "even": when even_guard ==> + ifc.even ifc.fibs._read + + "odd:": when odd_guard ==> + ifc.odd ifc.fibs._read +``` + +This time, the only stream that is referenced is `ifc.fibs`. As a consequence, +the `s0` stream, the `s0_idx` index, and the `"step"` rule are no longer +necessary, making the code considerably simpler. + +The flip side to having the generated code be simpler is that the application +which uses `mkFibs` must now do additional work to specify what the value of +`ifc.fibs` is. For example, we can port the behavior of the previous version +of the program like so: + +```bluespec +package Top where + +import Vector + +import Fibs +import FibsIfc +import FibsTypes + +fibsIfc :: Module FibsIfc +fibsIfc = + module + s0_0 :: Reg (UInt 32) <- mkReg 1 + s0_1 :: Reg (UInt 32) <- mkReg 1 + let s0 :: Vector 2 (Reg (UInt 32)) + s0 = update (update newVector 0 s0_0) 1 s0_1 + s0_idx :: Reg (Bit 64) <- mkReg 0 + + let s0_get :: Bit 64 -> UInt 32 + s0_get x = (select s0 ((s0_idx + x) % 2))._read + + s0_gen :: UInt 32 + s0_gen = s0_get 0 + s0_get 1 + + fibs_impl :: Reg (UInt 32) <- mkReg 1 + + interface + even x = + $display "Even Fibonacci number: %0d" x + + odd x = + $display "Odd Fibonacci number: %0d" x + + fibs = fibs_impl + + rules + "fibs": when True ==> + fibs_impl := s0_get 1 + + "step": when True ==> + action + select s0 s0_idx := s0_gen + s0_idx := (s0_idx + 1) % 2 + +mkTop :: Module Empty +mkTop = mkFibs fibsIfc +``` + +The code involving `s0`, `s0_idx`, and the `"step"` rule is exactly as before. +The only notable difference is that we create an additional `fibs_impl` +register, declare `fibs = fibs_impl` when instantiating the `FibsIfc` +interface, and declare an additional `"fibs"` rule to update the value of +`fibs_impl` on each clock cycle. Note that we always set the value of +`fibs_impl` to be `s0_get 1`, which corresponds to the most recently computed +Fibonacci number. If we set `fibs_impl` to be `s0_get 0` instead, then +`fibs_impl` would lag behind by one cycle. (Try it.) + +# Notes + +## Arrays + +Copilot's `Array n t` type is translated directly to Bluespec's `Vector n t` +type, which makes life very simple. + +## Structs + +Like Copilot, Bluespec has a notion of structs, e.g., + +```bluespec +struct Coord = + x :: UInt 32 + y :: UInt 32 + +exCoord :: Coord +exCoord = Coord { x = 27, y = 42 } + +flipCoord :: Coord -> Coord +flipCoord c = Coord { x = C.y, y = C.x } +``` + +As such, it proves fairly straightforward to translate Copilot structs to +Bluespec structs. For instance, given these Copilot structs: + +```hs +data Volts = Volts + { numVolts :: Field "numVolts" Word16 + , flag :: Field "flag" Bool + } + +instance Struct Volts where + typeName _ = "Volts" + toValues volts = [ Value Word16 (numVolts volts) + , Value Bool (flag volts) + ] + +instance Typed Volts where + typeOf = Struct (Volts (Field 0) (Field False)) + +data Battery = Battery + { temp :: Field "temp" Word16 + , volts :: Field "volts" Volts + } + +instance Struct Battery where + typeName _ = "Battery" + toValues battery = [ Value typeOf (temp battery) + , Value typeOf (volts battery) + ] + +instance Typed Battery where + typeOf = Struct (Battery (Field 0) (Field undefined)) +``` + +`copilot-bluespec` will generate the following `StructsTypes.bs` file: + +```bluespec +package StructsTypes where + +import FloatingPoint +import Vector + +struct Volts = + numVolts :: UInt 16 + flag :: Bool + deriving (Bits) + +struct Vattery = + temp :: UInt 16 + volts :: BS_volts + deriving (Bits) +``` + +The purpose of the `*Types.bs` file is to define structs separately from other +parts of the generated code. Note that each struct definition derives a `Bits` +instance so that it can be stored inside a `Reg`. + +## Capitalization of generated names + +Copilot allows users to name several things which will influence the names of +generated code, including external streams, triggers, structs, and the file +names. The `copilot-c99` backend is able to turn just about any user-supplied +name into the name of a C identifier, as C is a remarkably case-insensitive +language. For instance, both "`Volts`" and "`volts`" are legal struct names in +C. + +Bluespec, on the other hand, imposes restrictions on which identifiers can +begin with an uppercase letter and which can begin with a lowercase letter. +The following identifiers must begin with an uppercase letter: + +* Struct names +* Interface names + +The following identifiers must begin with a lowercase letter: + +* Function and value names +* Interface method names + +Package names and rule names may begin with either an uppercase or lowercase +letter. + +How do we ensure that `copilot-bluespec` respects Bluespec's capitalization +requirements? As an example, suppose a Copilot specification defines a struct +named "`volts`". This name cannot be used as a Bluespec struct name on its own, +as it does not begin with an uppercase letter. To avoid issues, we prepend the +prefix "`BS_`" to this name to get "`BS_volts`", which is a valid Bluespec +identifier. Similarly, `copilot-bluespec` will prepend the prefix `bs_` to +uppercase Copilot names if it is used in a place that expects lowercase +Bluespec identifiers. + +Note that `copilot-bluespec` will only prepend prefixes if they are necessary +to prevent the generated code from being littered with `BS_`/`bs_` prefixes in +the common case. + +## Floating-point numbers + +`copilot-bluespec` supports all of Copilot's floating-point operations with +varying degrees of performance. The following floating-point operations compile +directly to relatively performant circuits: + +* Basic arithmetic (`(+)`, `(-)`, `(*)`, `(/)`) +* Equality checking (`(==)` and `(/=)`) +* Inequality checking (`(<)`, `(<=)`, `(>)`, and `(>=)`) +* `abs` +* `signum` +* `recip` + +These operations correspond to the floating-point operations that the Bluespec +standard library provides that are well tested. Unfortunately, the Bluespec +standard library does not offer well-tested versions (or even _any_ versions) +of the remainder of Copilot's floating-point operations. The rest of these +operations are instead implemented by using BDPI (Bluespec's foreign function +interface) to interface with C code: + +* `sqrt` +* `acos` +* `asin` +* `atan` +* `atan2` +* `cos` +* `sin` +* `tan` +* `acosh` +* `asinh` +* `atanh` +* `cosh` +* `sinh` +* `tanh` +* `exp` +* `pow` +* `log` +* `logb` +* `ceiling` +* `floor` + +Implementing these operations via C provides high confidence that they are +implemented correctly, but at a somewhat steep performance penalty. + +Because these operations need to be implemented via BDPI, `copilot-bluespec` +generates two additional files: `BluespecFP.bsv` (which contains the Bluespec +function stubs for each function implemented via BDPI) and `bs_fp.c` (which +contains the corresponding C function definitions). To see how this works, +let us take a look at one of the BDPI'd functions, `sqrt`: + +```bluespec +import "BDPI" function Double bs_fp_sqrt (Double x); +import "BDPI" function Float bs_fp_sqrtf (Float x); +``` + +This declares a Bluespec function `bs_fp_sqrt` that is implemented using a C +function (also of the name `bs_fp_sqrt`) under the hood. This takes a Bluespec +`Double` as an argument and also returns a `Double`. Note that `Double` is not +treated magically by the Bluespec compiler here. This is because any Bluespec +struct can be used in BDPI (provided that the struct type implements the `Bits` +class), and Bluespec's `Double` is implemented as a struct with a `Bits` +instance that exactly matches the bit layout expected by IEEE-754 +double-precision floats. (Similarly for Bluespec's `Float` type.) + +Note that at present, the `import "BDPI"` feature is only available when using +the BSV syntax, not the BH syntax. As such, this is currently the only place +where we generate BSV code. + +The corresponding C code for `bs_fp_sqrt(f)` is: + +```c +union ull_double { + unsigned long long i; + double f; +}; + +union ui_float { + unsigned int i; + float f; +}; + +unsigned long long bs_fp_sqrt(unsigned long long x) { + union ull_double x_u; + union ull_double r_u; + x_u.i = x; + r_u.f = sqrt(x_u.f); + return r_u.i; +} + +unsigned int bs_fp_sqrtf(unsigned int x) { + union ui_float x_u; + union ui_float r_u; + x_u.i = x; + r_u.f = sqrtf(x_u.f); + return r_u.i; +} +``` + +There is a lot to unpack here. Let's go through this step by step: + +1. The C version of `bs_fp_sqrt` takes and returns an `unsigned long long`. The + use of `unsigned long long` is dictated by Bluespec itself: whenever you + use a Bluespec type in BDPI that fits in exactly 64 bits, then Bluespec + expects the corresponding C type to be `unsigned long long`. (You can see + this for yourself by inspecting the generated `imported_BDPI_functions.h` + header file.) + + There is a similar story for `bs_fp_sqrtf`, which takes an `unsigned int`. + Bluespec dictates the use of `unsigned int` when the BDPI types fits in + exactly 32 bits. + +2. This poses something of a challenge for us, since we want the implementation + of `bs_fp_sqrt` to work over `double`s, not `unsigned long long`s. To make + this possible, we define a `union ull_double` type that allows easily + converting an `unsigned long long` to a `double` and vice versa. + + There is an analogous story for `ui_float`, which allows conversion to and + from the `unsigned int` and `float` types. + +3. Finally, we perform the `sqrt(f)` function on the argument, using + `ull_double`/`ui_float` as necessary to make the types work out. + +Strictly speaking, it is only necessary to compile the generated `bs_fp.c` file +if the generated Bluespec program makes use of any of the BDPI-related +floating-point operations mentioned above. That being said, it doesn't hurt to +compile it even if the generated Bluespec program _doesn't_ use any of them, so +it's generally good practice to pass `bs_fp.c` to `bsc`. + +Eventually, we would like to stop using BDPI in favor of native Bluespec code, +which would be more performant. To do so, would we need to address the +following Bluespec issues: + +* The implementation of `sqrt` in Bluespec's standard library is buggy: + https://github.com/B-Lang-org/bsc/issues/710 + +* Bluespec's standard library does not implement the remaining floating-point + operations at all: https://github.com/B-Lang-org/bsc/issues/368 + +## Warnings + +Code generated by `copilot-bluespec` should always compile, but it is not +currently guaranteed that the code will compile without warnings. This is +because unlike `gcc` or `clang`, the `bsc` compiler produces much more warnings +by default, and in rare cases, you may trigger `bsc` warnings. This section +describes some of these warnings. + +### Rule bodies with no actions (G0023) + +Let's suppose you have a trigger named `nop`, and you instantiate it like so: + +```bluespec +exampleIfc :: Module ExampleIfc +exampleIfc = + module + interface + nop :: Action + nop = return () +``` + +As a result, firing the `nop` trigger will do absolutely nothing. `bsc` takes +notice of this fact and warns you about it: + +``` +Warning: "CopilotTest.bs", line 27, column 8: (G0023) + The body of rule `nop' has no actions. Removing... +``` + +Where `G0023` is a unique code associated with this class of warning. + +### Warning suppression notification (S0080) + +If you find the warnings above to be annoying, `bsc` offers a way to suppress +them with the `-suppress-warnings ::...` flag. +For instance, you can suppress the G0023 warning code by passing: + +``` +-suppress-warnings G0023 +``` + +This does indeed suppress them, but now `bsc` produces _another_ warning: + +``` +Warning: Unknown position: (S0080) + 1 warnings were suppressed. +``` + +That's right, `bsc` warns you about the use of `-suppress-warnings`. That feels +a bit silly to me, but in any case, the new warning comes with its own warning +code, S0080. As a result, you can _really_ suppress warnings by passing this to +`bsc`: + +``` +-suppress-warnings G0023:S0080 +``` + +## `language-bluespec` + +`copilot-bluespec` uses +[`language-bluespec`](https://github.com/GaloisInc/language-bluespec) as a +library for creating Bluespec Haskell ASTs. Most of the source code from +`language-bluespec` is directly based on the code in the Bluespec compiler, +[`bsc`](https://github.com/B-Lang-org/bsc). This is because there is (to our +knowledge) no other existing Haskell library for representing Bluespec Haskell +ASTs, and adapting the code in `bsc` proves to be the most straightforward way +of achieving what `copilot-bluespec` needs. + +It is conceivable that if the Bluespec language evolves in the future, then we +will need to update `language-bluespec` accordingly. This seems somewhat +unlikely, however, as we are generating code in a very simple subset of the +Bluespec language. + +Another possibility is to split out the AST parts of `bsc` into their own +library and maintain them going forward. See +https://github.com/B-Lang-org/bsc/issues/546 for more discussion on this point. diff --git a/copilot-bluespec/Dockerfile b/copilot-bluespec/Dockerfile new file mode 100644 index 000000000..381842442 --- /dev/null +++ b/copilot-bluespec/Dockerfile @@ -0,0 +1,36 @@ +FROM ubuntu:focal + +ENV DEBIAN_FRONTEND=noninteractive +RUN apt-get update && \ + apt-get install --yes curl gcc g++ git libz-dev make libgmp3-dev libtcl8.6 libtinfo-dev wget + +ENV BSC_VER=2023.07 +RUN mkdir -p /root/bsc +RUN wget https://github.com/B-Lang-org/bsc/releases/download/$BSC_VER/bsc-$BSC_VER-ubuntu-20.04.tar.gz -O /root/bsc.tar.gz && \ + tar -xvf /root/bsc.tar.gz -C /root/bsc --strip-components=1 && \ + rm /root/bsc.tar.gz + +ENV GHCUP_VER=0.1.22.0 +RUN mkdir -p /root/.ghcup/bin +RUN wget https://downloads.haskell.org/~ghcup/$GHCUP_VER/x86_64-linux-ghcup-$GHCUP_VER -O /root/.ghcup/bin/ghcup && \ + chmod a+x /root/.ghcup/bin/ghcup + +ENV PATH=/root/bsc/bin:/root/.cabal/bin:/root/.ghcup/bin:$PATH + +ENV GHC_VER=9.4.8 +ENV CABAL_VER=3.8.1.0 +RUN ghcup install ghc $GHC_VER && \ + ghcup set ghc $GHC_VER && \ + ghcup install cabal $CABAL_VER && \ + ghcup set cabal $CABAL_VER && \ + cabal update + +COPY . /copilot-bluespec +WORKDIR /copilot-bluespec + +RUN cabal configure --enable-tests && \ + cabal build --write-ghc-environment-files=always && \ + cabal install --lib copilot . --package-env . && \ + cabal test + +ENTRYPOINT ["/usr/bin/bash"] diff --git a/copilot-bluespec/LICENSE b/copilot-bluespec/LICENSE new file mode 100644 index 000000000..d4ed5bc4c --- /dev/null +++ b/copilot-bluespec/LICENSE @@ -0,0 +1,29 @@ +2009 +BSD3 License terms + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions +are met: + +Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. + +Redistributions in binary form must reproduce the above copyright +notice, this list of conditions and the following disclaimer in the +documentation and/or other materials provided with the distribution. + +Neither the name of the developers nor the names of its contributors +may be used to endorse or promote products derived from this software +without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR +CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, +EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, +PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR +PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF +LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING +NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/copilot-bluespec/README.md b/copilot-bluespec/README.md new file mode 100644 index 000000000..e85d9e8c5 --- /dev/null +++ b/copilot-bluespec/README.md @@ -0,0 +1,57 @@ +[![Build Status](https://github.com/Copilot-Language/copilot-bluespec/workflows/copilot-bluespec/badge.svg)](https://github.com/Copilot-Language/copilot-bluespec/actions?query=workflow%3Acopilot-bluespec) + +# Copilot: a stream DSL +Copilot-Bluespec implements a Bluespec backend for Copilot, producing code that +is suitable for FPGAs. + +Copilot is a runtime verification framework written in Haskell. It allows the +user to write programs in a simple but powerful way using a stream-based +approach. + +Programs can be interpreted for testing, or translated Bluespec code to be +incorporated in a project, or as a standalone application. The Bluespec backend +ensures us that the output is constant in memory and time, making it suitable +for systems with hard realtime requirements. + +## Installation +Copilot-Bluespec can be found on +[Hackage](https://hackage.haskell.org/package/copilot-bluespec). It is intended +to be installed alongside a Copilot distribution by running the following +commands: + +``` +$ cabal update +$ cabal install copilot +$ cabal install copilot-bluespec +``` + +For more detailed instructions on how to install Copilot, please refer to the +[Copilot website](https://copilot-language.github.io). + +The generated Bluespec code requires `bsc` (the Bluespec compiler) in order to +be compiled. `bsc` can be downloaded +[here](https://github.com/B-Lang-org/bsc/releases). + +We also provide a [Dockerfile](Dockerfile) which automates the process of +installing Copilot, Copilot-Bluespec, and `bsc`. The Dockerfile can be built and +run using the following commands: + +``` +$ docker build -t . +$ docker run -it +``` + +Where `` is a unique name for the Docker image. + +## Further information +For further information, install instructions and documentation, please visit +the Copilot website: +[https://copilot-language.github.io](https://copilot-language.github.io) + +There is also an implementation-focused design document +[here](https://raw.githubusercontent.com/Copilot-Language/copilot/master/copilot-bluespec/DESIGN.md). + + +## License +Copilot is distributed under the BSD-3-Clause license, which can be found +[here](https://raw.githubusercontent.com/Copilot-Language/copilot/master/copilot-bluespec/LICENSE). diff --git a/copilot-bluespec/Setup.hs b/copilot-bluespec/Setup.hs new file mode 100644 index 000000000..bf6890196 --- /dev/null +++ b/copilot-bluespec/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain \ No newline at end of file diff --git a/copilot-bluespec/copilot-bluespec.cabal b/copilot-bluespec/copilot-bluespec.cabal new file mode 100644 index 000000000..6509e7e2a --- /dev/null +++ b/copilot-bluespec/copilot-bluespec.cabal @@ -0,0 +1,100 @@ +cabal-version : >= 1.10 +name : copilot-bluespec +version : 4.4 +synopsis : A compiler for Copilot targeting FPGAs. +description : + This package is a back-end from Copilot to FPGAs in Bluespec. + . + Copilot is a stream (i.e., infinite lists) domain-specific language (DSL) in + Haskell. Copilot contains an interpreter, multiple back-end compilers, and + other verification tools. + . + A tutorial, examples, and other information are available at + . + +license : BSD3 +license-file : LICENSE +maintainer : Ryan Scott +homepage : https://copilot-language.github.io +bug-reports : https://github.com/Copilot-Language/copilot-bluespec/issues +stability : Experimental +category : Language, Embedded +build-type : Simple +extra-source-files : README.md + , CHANGELOG + +author : Frank Dedden + , Alwyn Goodloe + , Ivan Perez + , Ryan Scott + +x-curation: uncurated + +source-repository head + type: git + location: https://github.com/Copilot-Language/copilot-bluespec.git + +library + default-language : Haskell2010 + hs-source-dirs : src + + ghc-options : -Wall + build-depends : base >= 4.9 && < 5 + , directory >= 1.3 && < 1.4 + , filepath >= 1.4 && < 1.6 + , pretty >= 1.1.2 && < 1.2 + + , copilot-core >= 4.4 && < 4.5 + , language-bluespec >= 0.1 && < 0.2 + + exposed-modules : Copilot.Compile.Bluespec + + other-modules : Copilot.Compile.Bluespec.CodeGen + , Copilot.Compile.Bluespec.Compile + , Copilot.Compile.Bluespec.Error + , Copilot.Compile.Bluespec.Expr + , Copilot.Compile.Bluespec.External + , Copilot.Compile.Bluespec.FloatingPoint + , Copilot.Compile.Bluespec.Name + , Copilot.Compile.Bluespec.Representation + , Copilot.Compile.Bluespec.Settings + , Copilot.Compile.Bluespec.Type + +test-suite tests + type: + exitcode-stdio-1.0 + + main-is: + Main.hs + + other-modules: + Test.Copilot.Compile.Bluespec + + Test.Copilot.Compile.Bluespec.External + + build-depends: + base + , directory + , HUnit + , QuickCheck + , extra + , ieee754 + , pretty + , process + , random + , test-framework + , test-framework-hunit + , test-framework-quickcheck2 + , unix + + , copilot-core + , copilot-bluespec + + hs-source-dirs: + tests + + default-language: + Haskell2010 + + ghc-options: + -Wall diff --git a/copilot-bluespec/src/Copilot/Compile/Bluespec.hs b/copilot-bluespec/src/Copilot/Compile/Bluespec.hs new file mode 100644 index 000000000..499b1cff6 --- /dev/null +++ b/copilot-bluespec/src/Copilot/Compile/Bluespec.hs @@ -0,0 +1,12 @@ +-- | Compile Copilot specifications to Bluespec code. +module Copilot.Compile.Bluespec + ( compile + , compileWith + , BluespecSettings(..) + , mkDefaultBluespecSettings + ) where + +-- Internal imports +import Copilot.Compile.Bluespec.Compile ( compile, compileWith ) +import Copilot.Compile.Bluespec.Settings ( BluespecSettings (..), + mkDefaultBluespecSettings ) diff --git a/copilot-bluespec/src/Copilot/Compile/Bluespec/CodeGen.hs b/copilot-bluespec/src/Copilot/Compile/Bluespec/CodeGen.hs new file mode 100644 index 000000000..6d9fde04d --- /dev/null +++ b/copilot-bluespec/src/Copilot/Compile/Bluespec/CodeGen.hs @@ -0,0 +1,262 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} + +-- | High-level translation of Copilot Core into Bluespec. +module Copilot.Compile.Bluespec.CodeGen + ( -- * Type declarations + mkStructDecln + + -- * Ring buffers + , mkBuffDecln + , mkIndexDecln + , mkAccessDecln + + -- * Stream generators + , mkGenFun + + -- * Monitor processing + , mkStepRule + , mkTriggerRule + + -- * Module interface specifications + , mkSpecIfcFields + ) where + +-- External imports +import Data.String (IsString (..)) +import qualified Language.Bluespec.Classic.AST as BS +import qualified Language.Bluespec.Classic.AST.Builtin.Ids as BS +import qualified Language.Bluespec.Classic.AST.Builtin.Types as BS + +-- Internal imports: Copilot +import Copilot.Core + +-- Internal imports +import Copilot.Compile.Bluespec.Expr +import Copilot.Compile.Bluespec.External +import Copilot.Compile.Bluespec.Name +import Copilot.Compile.Bluespec.Representation +import Copilot.Compile.Bluespec.Type + +-- | Write a generator function for a stream. +mkGenFun :: String -> Expr a -> Type a -> BS.CDefl +mkGenFun name expr ty = + -- name :: ty + -- name = expr + BS.CLValueSign + (BS.CDef nameId (BS.CQType [] (transType ty)) [def]) + [] + where + nameId = BS.mkId BS.NoPos $ fromString $ lowercaseName name + def = BS.CClause [] [] (transExpr expr) + +-- | Bind a buffer variable and initialise it with the stream buffer. +mkBuffDecln :: forall a. Id -> Type a -> [a] -> [BS.CStmt] +mkBuffDecln sId ty xs = + initVals ++ [BS.CSletrec [initBufSig]] + where + -- sId_0 :: Reg <- mkReg xs_0 + -- ... + -- sId_(n-1) :: Reg <- mkReg xs_(n-1) + initVals = zipWith mkInitVal xs [0..] + -- sId :: Vector n (Reg ) + -- sId = update (... (update newVector 0 sId_0) ...) (n-1) sId_(n-1) + initBufSig = BS.CLValueSign + (BS.CDef nameId (BS.CQType [] vecTy) [initBufDef]) + [] + initBufDef = BS.CClause + [] + [] + (genVector + (\idx _ -> BS.CVar $ BS.mkId BS.NoPos $ + fromString $ streamElemName sId idx) + xs) + + nameId = BS.mkId BS.NoPos $ fromString $ streamName sId + bsTy = tReg `BS.TAp` transType ty + vecTy = tVector `BS.TAp` BS.cTNum numElems BS.NoPos `BS.TAp` bsTy + numElems = toInteger $ length xs + + mkInitVal :: a -> Int -> BS.CStmt + mkInitVal x elemNum = + BS.CSBindT + (BS.CPVar elemId) + Nothing + [] + (BS.CQType [] bsTy) + (BS.CApply (BS.CVar (BS.mkId BS.NoPos "mkReg")) [constTy ty x]) + where + elemName = streamElemName sId elemNum + elemId = BS.mkId BS.NoPos $ fromString elemName + +-- | Make an index variable and initialise it to 0. +mkIndexDecln :: Id -> BS.CStmt +mkIndexDecln sId = + -- sId_idx :: Reg (Bit 64) <- mkReg 0 + BS.CSBindT + (BS.CPVar nameId) + Nothing + [] + (BS.CQType [] bsTy) + (BS.CApply (BS.CVar (BS.mkId BS.NoPos "mkReg")) + [cLit $ BS.LInt $ BS.ilDec 0]) + where + nameId = BS.mkId BS.NoPos $ fromString $ indexName sId + bsTy = tReg `BS.TAp` BS.tBitN 64 BS.NoPos + +-- | Define an accessor function for the ring buffer associated with a stream +mkAccessDecln :: Id -> Type a -> [a] -> BS.CDefl +mkAccessDecln sId ty xs = + -- sId_get :: Bits 64 -> ty + -- sId_get x = (select sId ((sId_idx + x) % buffLength))._read + BS.CLValueSign (BS.CDef nameId (BS.CQType [] funTy) [def]) [] + where + def = BS.CClause [BS.CPVar argId] [] expr + argTy = BS.tBit `BS.TAp` BS.cTNum 64 BS.NoPos + retTy = transType ty + funTy = BS.tArrow `BS.TAp` argTy `BS.TAp` retTy + name = streamAccessorName sId + nameId = BS.mkId BS.NoPos $ fromString name + buffLength = cLit $ BS.LInt $ BS.ilDec $ toInteger $ length xs + argId = BS.mkId BS.NoPos "x" + index = BS.CApply (BS.CVar (BS.idPercentAt BS.NoPos)) + [ BS.CApply (BS.CVar BS.idPlus) + [ BS.CVar (BS.mkId BS.NoPos (fromString (indexName sId))) + , BS.CVar argId + ] + , buffLength + ] + indexExpr = cIndexVector + (BS.CVar (BS.mkId BS.NoPos (fromString (streamName sId)))) + index + expr = BS.CSelect indexExpr (BS.id_read BS.NoPos) + +-- | Define fields for a module interface containing a specification's trigger +-- functions and external variables. +mkSpecIfcFields :: [Trigger] -> [External] -> [BS.CField] +mkSpecIfcFields triggers exts = + map mkTriggerField triggers ++ map mkExtField exts + where + -- trigger :: args_1 -> ... -> args_n -> Action + mkTriggerField :: Trigger -> BS.CField + mkTriggerField (Trigger name _ args) = + mkField name $ + foldr + (\(UExpr arg _) res -> BS.tArrow `BS.TAp` transType arg `BS.TAp` res) + BS.tAction + args + + -- ext :: Reg ty + mkExtField :: External -> BS.CField + mkExtField (External name ty) = + mkField name $ tReg `BS.TAp` transType ty + +-- | Define a rule for a trigger function. +mkTriggerRule :: UniqueTrigger -> BS.CRule +mkTriggerRule (UniqueTrigger uniqueName (Trigger name _ args)) = + BS.CRule + [] + (Just $ cLit $ BS.LString uniqueName) + [ BS.CQFilter $ + BS.CVar $ BS.mkId BS.NoPos $ + fromString $ guardName uniqueName + ] + (BS.CApply nameExpr args') + where + ifcArgId = BS.mkId BS.NoPos $ fromString ifcArgName + -- Note that we use 'name' here instead of 'uniqueName', as 'name' is the + -- name of the actual external function. + nameId = BS.mkId BS.NoPos $ fromString $ lowercaseName name + nameExpr = BS.CSelect (BS.CVar ifcArgId) nameId + + args' = take (length args) (map argCall (argNames uniqueName)) + argCall = BS.CVar . BS.mkId BS.NoPos . fromString + +-- | Writes the @step@ rule that updates all streams. +mkStepRule :: [Stream] -> Maybe BS.CRule +mkStepRule streams + | null allUpdates + = -- If there is nothing to update, don't bother creating a step rule. + -- Doing so wouldn't harm anything, but bsc will generate a warning + -- when compiling such an empty rule. + Nothing + | otherwise + = Just $ + BS.CRule + [] + (Just $ cLit $ BS.LString "step") + [BS.CQFilter $ BS.CCon BS.idTrue []] + (BS.Caction BS.NoPos allUpdates) + where + allUpdates = bufferUpdates ++ indexUpdates + (bufferUpdates, indexUpdates) = unzip $ map mkUpdateGlobals streams + + -- Write code to update global stream buffers and index. + mkUpdateGlobals :: Stream -> (BS.CStmt, BS.CStmt) + mkUpdateGlobals (Stream sId buff _ _) = + (bufferUpdate, indexUpdate) + where + bufferUpdate = + BS.CSExpr Nothing $ + BS.Cwrite + BS.NoPos + (cIndexVector (BS.CVar buffId) (BS.CVar indexId)) + (BS.CVar genId) + + indexUpdate = + BS.CSExpr Nothing $ + BS.Cwrite + BS.NoPos + (BS.CVar indexId) + (BS.CApply (BS.CVar (BS.idPercentAt BS.NoPos)) + [incIndex, buffLength]) + where + buffLength = cLit $ BS.LInt $ BS.ilDec $ toInteger $ length buff + incIndex = BS.CApply (BS.CVar BS.idPlus) + [ BS.CVar indexId + , cLit $ BS.LInt $ BS.ilDec 1 + ] + + buffId = BS.mkId BS.NoPos $ fromString $ streamName sId + genId = BS.mkId BS.NoPos $ fromString $ generatorName sId + indexId = BS.mkId BS.NoPos $ fromString $ indexName sId + +-- | Write a struct declaration based on its definition. +mkStructDecln :: Struct a => a -> BS.CDefn +mkStructDecln x = + BS.Cstruct + True + BS.SStruct + (BS.IdK structId) + [] -- No type variables + structFields + -- Derive a Bits instance so that we can put this struct in a Reg + [BS.CTypeclass BS.idBits] + where + structId = BS.mkId BS.NoPos $ fromString $ uppercaseName $ typeName x + structFields = map mkStructField $ toValues x + + mkStructField :: Value a -> BS.CField + mkStructField (Value ty field) = + mkField (fieldName field) (transType ty) + +-- | Write a field of a struct or interface, along with its type. +mkField :: String -> BS.CType -> BS.CField +mkField name ty = + BS.CField + { BS.cf_name = BS.mkId BS.NoPos $ fromString $ lowercaseName name + , BS.cf_pragmas = Nothing + , BS.cf_type = BS.CQType [] ty + , BS.cf_default = [] + , BS.cf_orig_type = Nothing + } + +-- | The @Reg@ Bluespec interface type. +tReg :: BS.CType +tReg = BS.TCon $ + BS.TyCon + { BS.tcon_name = BS.idReg + , BS.tcon_kind = Just (BS.Kfun BS.KStar BS.KStar) + , BS.tcon_sort = BS.TIstruct (BS.SInterface []) + [BS.id_write BS.NoPos, BS.id_read BS.NoPos] + } diff --git a/copilot-bluespec/src/Copilot/Compile/Bluespec/Compile.hs b/copilot-bluespec/src/Copilot/Compile/Bluespec/Compile.hs new file mode 100644 index 000000000..c4701eaf7 --- /dev/null +++ b/copilot-bluespec/src/Copilot/Compile/Bluespec/Compile.hs @@ -0,0 +1,350 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | Compile Copilot specifications to Bluespec code. +module Copilot.Compile.Bluespec.Compile + ( compile + , compileWith + ) where + +-- External imports +import Data.List (nub, nubBy, union) +import Data.Maybe (catMaybes, maybeToList) +import Data.String (IsString (..)) +import Data.Type.Equality (testEquality, (:~:)(Refl)) +import Data.Typeable (Typeable) +import qualified Language.Bluespec.Classic.AST as BS +import qualified Language.Bluespec.Classic.AST.Builtin.Ids as BS +import qualified Language.Bluespec.Classic.AST.Builtin.Types as BS +import Text.PrettyPrint.HughesPJClass (Pretty (..), render) +import System.Directory (createDirectoryIfMissing) +import System.Exit (exitFailure) +import System.FilePath (()) +import System.IO (hPutStrLn, stderr) + +-- Internal imports: Copilot +import Copilot.Core + +-- Internal imports +import Copilot.Compile.Bluespec.CodeGen +import Copilot.Compile.Bluespec.External +import Copilot.Compile.Bluespec.FloatingPoint +import Copilot.Compile.Bluespec.Name +import Copilot.Compile.Bluespec.Representation +import Copilot.Compile.Bluespec.Settings + +-- | Compile a specification to a Bluespec file. +-- +-- The first argument is the settings for the Bluespec code generated. +-- +-- The second argument is used as a module name and the prefix for the .bs files +-- that are generated. +compileWith :: BluespecSettings -> String -> Spec -> IO () +compileWith bsSettings prefix spec + | null triggers + = do hPutStrLn stderr $ + "Copilot error: attempt at compiling empty specification.\n" + ++ "You must define at least one trigger to generate Bluespec 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 typesBsFile = render $ pPrint $ compileTypesBS bsSettings prefix spec + ifcBsFile = render $ pPrint $ compileIfcBS bsSettings prefix spec + bsFile = render $ pPrint $ compileBS bsSettings prefix spec + + let dir = bluespecSettingsOutputDirectory bsSettings + createDirectoryIfMissing True dir + writeFile (dir specTypesPkgName prefix ++ ".bs") typesBsFile + writeFile (dir specIfcPkgName prefix ++ ".bs") ifcBsFile + writeFile (dir "bs_fp.c") copilotBluespecFloatingPointC + writeFile (dir "BluespecFP.bsv") copilotBluespecFloatingPointBSV + writeFile (dir prefix ++ ".bs") bsFile + 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 Bluespec. +-- +-- The first argument is used as a prefix for the generated .bs files. +compile :: String -> Spec -> IO () +compile = compileWith mkDefaultBluespecSettings + +-- | Generate a @.bs@ file from a 'Spec'. This is the main payload of +-- the Bluespec backend. +-- +-- The generated Bluespec file will import a handful of files from the standard +-- library, as well as the following generated files: +-- +-- * @Ifc.bs@, which defines the interface containing the trigger +-- functions and external variables. +-- +-- * @Types.bs@, which defines any structs used in the 'Spec'. +-- +-- It will also generate a @mk :: Module Ifc -> Module Empty@ +-- function, which defines the module structure for this 'Spec'. The +-- @mk@ function has the following structure: +-- +-- * First, bind the argument of type @Module Ifc@ so that trigger +-- functions can be invoked and external variables can be used. +-- +-- * Next, declare stream buffers and indices. +-- +-- * Next, declare generator functions for streams, accessor functions for +-- streams, and guard functions for triggers. +-- +-- * Next, declare rules for each trigger function. +-- +-- * Finally, declare a single rule that updates the stream buffers and +-- indices. +compileBS :: BluespecSettings -> String -> Spec -> BS.CPackage +compileBS _bsSettings prefix spec = + BS.CPackage + (BS.mkId BS.NoPos (fromString prefix)) + (Right []) + (stdLibImports ++ genImports) + [] + [moduleDef] + [] + where + -- import Types + -- import Ifc + genImports :: [BS.CImport] + genImports = + [ BS.CImpId False $ BS.mkId BS.NoPos $ fromString + $ specTypesPkgName prefix + , BS.CImpId False $ BS.mkId BS.NoPos $ fromString + $ specIfcPkgName prefix + , BS.CImpId False $ BS.mkId BS.NoPos "BluespecFP" + ] + + moduleDef :: BS.CDefn + moduleDef = BS.CValueSign $ + BS.CDef + (BS.mkId BS.NoPos $ fromString $ "mk" ++ prefix) + -- :: Module Ifc -> Module Empty + (BS.CQType + [] + (BS.tArrow + `BS.TAp` (BS.tModule `BS.TAp` ifcTy) + `BS.TAp` (BS.tModule `BS.TAp` emptyTy))) + [ BS.CClause [BS.CPVar ifcModId] [] $ + BS.Cmodule BS.NoPos $ + BS.CMStmt + (BS.CSBind (BS.CPVar ifcArgId) Nothing [] (BS.CVar ifcModId)) + : map BS.CMStmt mkGlobals ++ + [ BS.CMStmt $ BS.CSletrec genFuns + , BS.CMrules $ BS.Crules [] rules + ] + ] + + ifcArgId = BS.mkId BS.NoPos $ fromString ifcArgName + ifcModId = BS.mkId BS.NoPos "ifcMod" + + rules :: [BS.CRule] + rules = map mkTriggerRule uniqueTriggers ++ maybeToList (mkStepRule streams) + + streams = specStreams spec + triggers = specTriggers spec + uniqueTriggers = mkUniqueTriggers triggers + exts = gatherExts streams triggers + + ifcId = BS.mkId BS.NoPos $ fromString $ specIfcName prefix + ifcFields = mkSpecIfcFields triggers exts + ifcTy = BS.TCon (BS.TyCon + { BS.tcon_name = ifcId + , BS.tcon_kind = Just BS.KStar + , BS.tcon_sort = BS.TIstruct + (BS.SInterface []) + (map BS.cf_name ifcFields) + }) + + emptyTy = BS.TCon (BS.TyCon + { BS.tcon_name = BS.idEmpty + , BS.tcon_kind = Just BS.KStar + , BS.tcon_sort = BS.TIstruct (BS.SInterface []) [] + }) + + -- Make buffer and index declarations for streams. + mkGlobals :: [BS.CStmt] + mkGlobals = concatMap buffDecln streams ++ map indexDecln streams + where + buffDecln (Stream sId buff _ ty) = mkBuffDecln sId ty buff + indexDecln (Stream sId _ _ _ ) = mkIndexDecln sId + + -- Make generator functions, including trigger arguments. + genFuns :: [BS.CDefl] + genFuns = map accessDecln streams + ++ map streamGen streams + ++ concatMap triggerGen uniqueTriggers + where + accessDecln :: Stream -> BS.CDefl + accessDecln (Stream sId buff _ ty) = mkAccessDecln sId ty buff + + streamGen :: Stream -> BS.CDefl + streamGen (Stream sId _ expr ty) = mkGenFun (generatorName sId) expr ty + + triggerGen :: UniqueTrigger -> [BS.CDefl] + triggerGen (UniqueTrigger uniqueName (Trigger _name guard args)) = + guardDef : argDefs + where + guardDef = mkGenFun (guardName uniqueName) guard Bool + argDefs = map argGen (zip (argNames uniqueName) args) + + argGen :: (String, UExpr) -> BS.CDefl + argGen (argName, UExpr ty expr) = mkGenFun argName expr ty + +-- | Generate a @Ifc.bs@ file from a 'Spec'. This contains the +-- definition of the @Ifc@ interface, which declares the types of all +-- trigger functions and external variables. This is put in a separate file so +-- that larger applications can use it separately. +compileIfcBS :: BluespecSettings -> String -> Spec -> BS.CPackage +compileIfcBS _bsSettings prefix spec = + BS.CPackage + ifcPkgId + (Right []) + (stdLibImports ++ genImports) + [] + [ifcDef] + [] + where + -- import Types + genImports :: [BS.CImport] + genImports = + [ BS.CImpId False $ BS.mkId BS.NoPos $ fromString + $ specTypesPkgName prefix + ] + + ifcId = BS.mkId BS.NoPos $ fromString $ specIfcName prefix + ifcPkgId = BS.mkId BS.NoPos $ fromString $ specIfcPkgName prefix + ifcFields = mkSpecIfcFields triggers exts + + streams = specStreams spec + exts = gatherExts streams triggers + + -- Remove duplicates due to multiple guards for the same trigger. + triggers = nubBy compareTrigger (specTriggers spec) + + ifcDef :: BS.CDefn + ifcDef = BS.Cstruct + True + (BS.SInterface []) + (BS.IdK ifcId) + [] -- No type variables + ifcFields + [] -- No derived instances + +-- | Generate a @Types.bs@ file from a 'Spec'. This declares the types +-- of any structs used by the Copilot specification. This is put in a separate +-- file so that larger applications can more easily substitute their own struct +-- definitions if desired. +compileTypesBS :: BluespecSettings -> String -> Spec -> BS.CPackage +compileTypesBS _bsSettings prefix spec = + BS.CPackage + typesId + (Right []) + stdLibImports + [] + structDefs + [] + where + typesId = BS.mkId BS.NoPos $ fromString $ specTypesPkgName prefix + + structDefs = mkTypeDeclns exprs + + exprs = gatherExprs streams triggers + streams = specStreams spec + + -- Remove duplicates due to multiple guards for the same trigger. + triggers = nubBy compareTrigger (specTriggers spec) + + -- Generate type declarations. + mkTypeDeclns :: [UExpr] -> [BS.CDefn] + mkTypeDeclns es = catMaybes $ map mkTypeDecln uTypes + where + uTypes = nub $ concatMap (\(UExpr _ e) -> exprTypes e) es + + mkTypeDecln (UType ty) = case ty of + Struct x -> Just $ mkStructDecln x + _ -> Nothing + +-- | Imports from the Bluespec standard library. +stdLibImports :: [BS.CImport] +stdLibImports = + [ BS.CImpId False $ BS.mkId BS.NoPos "FloatingPoint" + , BS.CImpId False $ BS.mkId BS.NoPos "Vector" + ] + +-- ** Obtain information from Copilot Core Exprs and Types. + +-- | List all types of an expression, returns items uniquely. +exprTypes :: Typeable a => Expr a -> [UType] +exprTypes e = case e of + Const ty _ -> typeTypes ty + Local ty1 ty2 _ e1 e2 -> typeTypes ty1 `union` typeTypes ty2 + `union` exprTypes e1 `union` exprTypes e2 + Var ty _ -> typeTypes ty + Drop ty _ _ -> typeTypes ty + ExternVar ty _ _ -> typeTypes ty + Op1 _ e1 -> exprTypes e1 + Op2 _ e1 e2 -> exprTypes e1 `union` exprTypes e2 + Op3 _ e1 e2 e3 -> exprTypes e1 `union` exprTypes e2 + `union` exprTypes e3 + Label ty _ _ -> typeTypes ty + +-- | List all types of a type, returns items uniquely. +typeTypes :: Typeable a => Type a -> [UType] +typeTypes ty = case ty of + Array ty' -> typeTypes ty' `union` [UType ty] + Struct x -> concatMap (\(Value ty' _) -> typeTypes ty') (toValues x) + `union` [UType ty] + _ -> [UType ty] + +-- | Collect all expression of a list of streams and triggers and wrap them +-- into an UEXpr. +gatherExprs :: [Stream] -> [Trigger] -> [UExpr] +gatherExprs streams triggers = map streamUExpr streams + ++ concatMap triggerUExpr triggers + 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 diff --git a/copilot-bluespec/src/Copilot/Compile/Bluespec/Error.hs b/copilot-bluespec/src/Copilot/Compile/Bluespec/Error.hs new file mode 100644 index 000000000..b3d719da0 --- /dev/null +++ b/copilot-bluespec/src/Copilot/Compile/Bluespec/Error.hs @@ -0,0 +1,20 @@ +{-# LANGUAGE Safe #-} + +-- | +-- Copyright: (c) 2011 National Institute of Aerospace / Galois, Inc. +-- +-- Custom functions to report error messages to users. +module Copilot.Compile.Bluespec.Error + ( impossible ) + where + +-- | Report an error due to a bug in Copilot. +impossible :: String -- ^ Name of the function in which the error was detected. + -> String -- ^ Name of the package in which the function is located. + -> a +impossible function package = + error $ "Impossible error in function " + ++ function ++ ", in package " ++ package + ++ ". Please file an issue at " + ++ "https://github.com/Copilot-Language/copilot/issues" + ++ " or email the maintainers at " diff --git a/copilot-bluespec/src/Copilot/Compile/Bluespec/Expr.hs b/copilot-bluespec/src/Copilot/Compile/Bluespec/Expr.hs new file mode 100644 index 000000000..c4978aef5 --- /dev/null +++ b/copilot-bluespec/src/Copilot/Compile/Bluespec/Expr.hs @@ -0,0 +1,671 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} + +-- | Translate Copilot Core expressions and operators to Bluespec. +module Copilot.Compile.Bluespec.Expr + ( transExpr + , cIndexVector + , cLit + , constTy + , genVector + ) where + +-- External imports +import Data.Foldable (foldl') +import Data.String (IsString (..)) +import qualified Language.Bluespec.Classic.AST as BS +import qualified Language.Bluespec.Classic.AST.Builtin.Ids as BS + +-- Internal imports: Copilot +import Copilot.Core + +-- Internal imports +import Copilot.Compile.Bluespec.Error (impossible) +import Copilot.Compile.Bluespec.Name +import Copilot.Compile.Bluespec.Type + +-- | Translates a Copilot Core expression into a Bluespec expression. +transExpr :: Expr a -> BS.CExpr +transExpr (Const ty x) = constTy ty x + +transExpr (Local ty1 _ name e1 e2) = + let nameId = BS.mkId BS.NoPos $ fromString name + e1' = transExpr e1 + ty1' = transType ty1 + e2' = transExpr e2 in + BS.Cletrec + [ BS.CLValueSign + (BS.CDef nameId (BS.CQType [] ty1') [BS.CClause [] [] e1']) + [] + ] + e2' + +transExpr (Var _ n) = BS.CVar $ BS.mkId BS.NoPos $ fromString n + +transExpr (Drop _ amount sid) = + let accessVar = streamAccessorName sid + index = BS.LInt $ BS.ilDec $ fromIntegral amount in + BS.CApply (BS.CVar $ BS.mkId BS.NoPos $ fromString accessVar) + [BS.CLit $ BS.CLiteral BS.NoPos index] + +transExpr (ExternVar _ name _) = + let ifcArgId = BS.mkId BS.NoPos $ fromString ifcArgName in + BS.CSelect + (BS.CSelect + (BS.CVar ifcArgId) + (BS.mkId BS.NoPos $ fromString $ lowercaseName name)) + (BS.id_read BS.NoPos) + +transExpr (Label _ _ e) = transExpr e -- ignore label + +transExpr (Op1 op e) = transOp1 op (transExpr e) + +transExpr (Op2 op e1 e2) = transOp2 op (transExpr e1) (transExpr e2) + +transExpr (Op3 op e1 e2 e3) = + transOp3 op (transExpr e1) (transExpr e2) (transExpr e3) + +-- | Translates a Copilot unary operator and its argument into a Bluespec +-- function. +transOp1 :: Op1 a b -> BS.CExpr -> BS.CExpr +transOp1 op e = + case op of + Not -> app BS.idNot + Abs _ty -> app $ BS.mkId BS.NoPos "abs" + Sign ty -> transSign ty e + -- Bluespec's Arith class does not have a `recip` method corresponding to + -- Haskell's `recip` in the `Fractional` class, so we implement it + -- ourselves. + Recip ty -> BS.CApply + (BS.CVar (BS.idSlashAt BS.NoPos)) + [constNumTy ty 1, e] + BwNot _ty -> app $ BS.idInvertAt BS.NoPos + + Cast fromTy toTy -> transCast fromTy toTy e + GetField (Struct _) _ f -> BS.CSelect e $ BS.mkId BS.NoPos $ + fromString $ lowercaseName $ accessorName f + GetField _ _ _ -> impossible "transOp1" "copilot-bluespec" + + -- BDPI-supported operations + Sqrt ty -> appFP ty "sqrt" + Exp ty -> appFP ty "exp" + Log ty -> appFP ty "log" + Acos ty -> appFP ty "acos" + Asin ty -> appFP ty "asin" + Atan ty -> appFP ty "atan" + Cos ty -> appFP ty "cos" + Sin ty -> appFP ty "sin" + Tan ty -> appFP ty "tan" + Acosh ty -> appFP ty "acosh" + Asinh ty -> appFP ty "asinh" + Atanh ty -> appFP ty "atanh" + Cosh ty -> appFP ty "cosh" + Sinh ty -> appFP ty "sinh" + Tanh ty -> appFP ty "tanh" + Ceiling ty -> appFP ty "ceiling" + Floor ty -> appFP ty "floor" + where + app :: BS.Id -> BS.CExpr + app i = BS.CApply (BS.CVar i) [e] + + appFP :: forall t. Type t -> String -> BS.CExpr + appFP ty funPrefix = app $ fpFunId ty funPrefix + +-- | Translates a Copilot binary operator and its arguments into a Bluespec +-- function. +transOp2 :: Op2 a b c -> BS.CExpr -> BS.CExpr -> BS.CExpr +transOp2 op e1 e2 = + case op of + And -> app BS.idAnd + Or -> app $ BS.idOrAt BS.NoPos + Add _ty -> app BS.idPlus + Sub _ty -> app BS.idMinus + Mul _ty -> app $ BS.idStarAt BS.NoPos + Mod _ty -> app $ BS.idPercentAt BS.NoPos + Div _ty -> app $ BS.idSlashAt BS.NoPos + Fdiv _ty -> app $ BS.idSlashAt BS.NoPos + Eq _ -> app BS.idEqual + Ne _ -> app BS.idNotEqual + Le ty -> transLe ty e1 e2 + Ge ty -> transGe ty e1 e2 + Lt ty -> transLt ty e1 e2 + Gt ty -> transGt ty e1 e2 + BwAnd _ -> app $ BS.idBitAndAt BS.NoPos + BwOr _ -> app $ BS.idBitOrAt BS.NoPos + BwXor _ -> app $ BS.idCaretAt BS.NoPos + BwShiftL _ _ -> app $ BS.idLshAt BS.NoPos + BwShiftR _ _ -> app $ BS.idRshAt BS.NoPos + Index _ -> cIndexVector e1 e2 + UpdateField (Struct _) _ f -> + let field :: BS.FString + field = fromString $ lowercaseName $ accessorName f in + BS.CStructUpd e1 [(BS.mkId BS.NoPos field, e2)] + UpdateField _ _ _ -> impossible "transOp2" "copilot-bluespec" + + -- BDPI-supported operations + Pow ty -> appFP ty "pow" + Logb ty -> appFP ty "logb" + Atan2 ty -> appFP ty "atan2" + where + app :: BS.Id -> BS.CExpr + app i = BS.CApply (BS.CVar i) [e1, e2] + + appFP :: forall t. Type t -> String -> BS.CExpr + appFP ty funPrefix = app $ fpFunId ty funPrefix + +-- | Translates a Copilot ternary operator and its arguments into a Bluespec +-- function. +transOp3 :: Op3 a b c d -> BS.CExpr -> BS.CExpr -> BS.CExpr -> BS.CExpr +transOp3 op e1 e2 e3 = + case op of + Mux _ -> BS.Cif BS.NoPos e1 e2 e3 + UpdateArray _ -> cUpdateVector e1 e2 e3 + +-- | Translate @'Sign' e@ in Copilot Core into a Bluespec expression. +-- +-- @signum e@ is translated as: +-- +-- @ +-- if e > 0 then 1 else (if e < 0 then negate 1 else e) +-- @ +-- +-- That is: +-- +-- 1. If @e@ is positive, return @1@. +-- +-- 2. If @e@ is negative, return @-1@. +-- +-- 3. Otherwise, return @e@. This handles the case where @e@ is @0@ when the +-- type is an integral type. If the type is a floating-point type, it also +-- handles the cases where @e@ is @-0@ or @NaN@. +-- +-- This implementation is modeled after how GHC implements 'signum' +-- . +transSign :: Type a -> BS.CExpr -> BS.CExpr +transSign ty e = positiveCase $ negativeCase e + where + -- If @e@ is positive, return @1@, otherwise fall back to the argument. + -- + -- Produces the following code, where @@ is the argument to this + -- function: + -- @ + -- if e > 0 then 1 else + -- @ + positiveCase :: BS.CExpr -- ^ Value returned if @e@ is not positive. + -> BS.CExpr + positiveCase = + BS.Cif BS.NoPos (transGt ty e (constNumTy ty 0)) (constNumTy ty 1) + + -- If @e@ is negative, return @1@, otherwise fall back to the argument. + -- + -- Produces the following code, where @@ is the argument to this + -- function: + -- @ + -- if e < 0 then negate 1 else + -- @ + negativeCase :: BS.CExpr -- ^ Value returned if @e@ is not negative. + -> BS.CExpr + negativeCase = + BS.Cif BS.NoPos (transLt ty e (constNumTy ty 0)) (constNumTy ty (-1)) + +-- | Translate a Copilot @x < y@ expression into Bluespec. We will generate +-- different code depending on whether the arguments have a floating-point type +-- or not. +transLt :: Type a + -- ^ The type of the arguments. + -> BS.CExpr -> BS.CExpr -> BS.CExpr +transLt ty e1 e2 + | typeIsFloating ty + = transLtOrGtFP (BS.mkId BS.NoPos "LT") e1 e2 + | otherwise + = BS.CApply (BS.CVar (BS.idLtAt BS.NoPos)) [e1, e2] + +-- | Translate a Copilot @x > y@ expression into Bluespec. We will generate +-- different code depending on whether the arguments have a floating-point type +-- or not. +transGt :: Type a + -- ^ The type of the arguments. + -> BS.CExpr -> BS.CExpr -> BS.CExpr +transGt ty e1 e2 + | typeIsFloating ty + = transLtOrGtFP (BS.mkId BS.NoPos "GT") e1 e2 + | otherwise + = BS.CApply (BS.CVar (BS.idGtAt BS.NoPos)) [e1, e2] + +-- | Translate a Copilot @x <= y@ expression into Bluespec. We will generate +-- different code depending on whether the arguments have a floating-point type +-- or not. +transLe :: Type a + -- ^ The type of the arguments. + -> BS.CExpr -> BS.CExpr -> BS.CExpr +transLe ty e1 e2 + | typeIsFloating ty + = transLeOrGeFP (BS.mkId BS.NoPos "LT") e1 e2 + | otherwise + = BS.CApply (BS.CVar (BS.idLtEqAt BS.NoPos)) [e1, e2] + +-- | Translate a Copilot @x >= y@ expression into Bluespec. We will generate +-- different code depending on whether the arguments have a floating-point type +-- or not. +transGe :: Type a + -- ^ The type of the arguments. + -> BS.CExpr -> BS.CExpr -> BS.CExpr +transGe ty e1 e2 + | typeIsFloating ty + = transLeOrGeFP (BS.mkId BS.NoPos "GT") e1 e2 + | otherwise + = BS.CApply (BS.CVar (BS.idGtEqAt BS.NoPos)) [e1, e2] + +-- | Translate a Copilot floating-point comparison involving @<@ or @>@ into a +-- Bluespec expression. Specifically, @x < y@ is translated to: +-- +-- @ +-- compareFP x y == LT +-- @ +-- +-- @x > y@ is translated similarly, except that @GT@ is used instead of @LT@. +-- +-- See the comments on 'compareFPExpr' for why we translate floating-point +-- comparison operators this way. +transLtOrGtFP :: BS.Id + -- ^ A @Disorder@ label, which we check against the result of + -- calling @compareFP@. This should be either @LT@ or @GT@. + -> BS.CExpr -> BS.CExpr -> BS.CExpr +transLtOrGtFP disorderLabel e1 e2 = + BS.CApply + (BS.CVar BS.idEqual) + [compareFPExpr e1 e2, BS.CCon disorderLabel []] + +-- | Translate a Copilot floating-point comparison involving @<=@ or @>=@ into +-- a Bluespec expression. Specifically, @x <= y@ is translated to: +-- +-- @ +-- let _c = compareFP x y +-- in (_c == LT) || (_c == EQ) +-- @ +-- +-- @x >= y@ is translated similarly, except that @GT@ is used instead of @LT@. +-- +-- See the comments on 'compareFPExpr' for why we translate floating-point +-- comparison operators this way. +transLeOrGeFP :: BS.Id + -- ^ A @Disorder@ label, which we check against the result of + -- calling @compareFP@. This should be either @LT@ or @GT@. + -> BS.CExpr -> BS.CExpr -> BS.CExpr +transLeOrGeFP disorderLabel e1 e2 = + BS.Cletrec + [BS.CLValue c [BS.CClause [] [] (compareFPExpr e1 e2)] []] + (BS.CApply + (BS.CVar (BS.idOrAt BS.NoPos)) + [ BS.CApply + (BS.CVar BS.idEqual) + [BS.CVar c, BS.CCon disorderLabel []] + , BS.CApply + (BS.CVar BS.idEqual) + [BS.CVar c, BS.CCon (BS.mkId BS.NoPos "EQ") []] + ]) + where + c = BS.mkId BS.NoPos "_c" + +-- | Generate an expression of the form @compareFP x y@. This is used to power +-- the translations of the Copilot @<@, @<=@, @>@, and @>=@ floating-point +-- operators to Bluespec. +-- +-- Translating these operators using @compareFP@ is a somewhat curious design +-- choice, given that Bluespec already defines its own versions of these +-- operators. Unfortunately, we cannot directly use the Bluespec versions of +-- these operators, as they are defined in such a way that they will call +-- @error@ when one of the arguments is a NaN value. This would pose two +-- problems: +-- +-- 1. This would differ from the semantics of Copilot, where @x < y@ will return +-- @False@ (instead of erroring) when one of the arguments is NaN. (Similarly +-- for the other floating-point comparison operators.) +-- +-- 2. Moreover, if you have a Bluespec program that calls @x < y@, where the +-- value of @x@ or @y@ is derived from a register, then @bsc@ will always +-- fail to compile the code. This is because Bluespec must generate hardware +-- for all possible code paths in @<@, and because one of the code paths +-- calls @error@, this will cause compilation to result in an error. (See +-- https://github.com/B-Lang-org/bsc/discussions/711#discussioncomment-10003586 +-- for a more detailed explanation.) +-- +-- As such, we avoid using Bluespec's comparison operators and instead translate +-- Copilot's comparison operators to expressions derived from @compareFP@. +-- Unlike Bluespec's other comparison operators, calling @compareFP@ will never +-- result in an error. +compareFPExpr :: BS.CExpr -> BS.CExpr -> BS.CExpr +compareFPExpr e1 e2 = + BS.CApply + (BS.CVar (BS.mkId BS.NoPos "compareFP")) + [e1, e2] + +-- | Bluespec does not have a general-purpose casting operation, so we must +-- handle casts on a case-by-case basis. +transCast :: Type a -> Type b -> BS.CExpr -> BS.CExpr +transCast fromTy toTy = + case (fromTy, toTy) of + ----- + -- "safe" casts that cannot lose information + ----- + + (Bool, Bool) -> id + (Bool, Word8) -> upcastBool + (Bool, Word16) -> upcastBool + (Bool, Word32) -> upcastBool + (Bool, Word64) -> upcastBool + (Bool, Int8) -> upcastBool + (Bool, Int16) -> upcastBool + (Bool, Int32) -> upcastBool + (Bool, Int64) -> upcastBool + + (Int8, Int8) -> id + (Int8, Int16) -> upcast + (Int8, Int32) -> upcast + (Int8, Int64) -> upcast + (Int16, Int16) -> id + (Int16, Int32) -> upcast + (Int16, Int64) -> upcast + (Int32, Int32) -> id + (Int32, Int64) -> upcast + (Int64, Int64) -> id + + (Word8, Int16) -> unpackPackUpcast Word16 + (Word8, Int32) -> unpackPackUpcast Word32 + (Word8, Int64) -> unpackPackUpcast Word64 + (Word8, Word8) -> id + (Word8, Word16) -> upcast + (Word8, Word32) -> upcast + (Word8, Word64) -> upcast + (Word16, Int32) -> unpackPackUpcast Word32 + (Word16, Int64) -> unpackPackUpcast Word64 + (Word16, Word16) -> id + (Word16, Word32) -> upcast + (Word16, Word64) -> upcast + (Word32, Int64) -> unpackPackUpcast Word64 + (Word32, Word32) -> id + (Word32, Word64) -> upcast + (Word64, Word64) -> id + + ----- + -- "unsafe" casts, which may lose information + ----- + + -- unsigned truncations + (Word64, Word32) -> downcast + (Word64, Word16) -> downcast + (Word64, Word8) -> downcast + (Word32, Word16) -> downcast + (Word32, Word8) -> downcast + (Word16, Word8) -> downcast + + -- signed truncations + (Int64, Int32) -> downcast + (Int64, Int16) -> downcast + (Int64, Int8) -> downcast + (Int32, Int16) -> downcast + (Int32, Int8) -> downcast + (Int16, Int8) -> downcast + + -- signed integer to float + (Int64, Float) -> castIntegralToFloatingPoint + (Int32, Float) -> castIntegralToFloatingPoint + (Int16, Float) -> castIntegralToFloatingPoint + (Int8, Float) -> castIntegralToFloatingPoint + + -- unsigned integer to float + (Word64, Float) -> castIntegralToFloatingPoint + (Word32, Float) -> castIntegralToFloatingPoint + (Word16, Float) -> castIntegralToFloatingPoint + (Word8, Float) -> castIntegralToFloatingPoint + + -- signed integer to double + (Int64, Double) -> castIntegralToFloatingPoint + (Int32, Double) -> castIntegralToFloatingPoint + (Int16, Double) -> castIntegralToFloatingPoint + (Int8, Double) -> castIntegralToFloatingPoint + + -- unsigned integer to double + (Word64, Double) -> castIntegralToFloatingPoint + (Word32, Double) -> castIntegralToFloatingPoint + (Word16, Double) -> castIntegralToFloatingPoint + (Word8, Double) -> castIntegralToFloatingPoint + + -- unsigned to signed conversion + (Word64, Int64) -> unpackPack + (Word32, Int32) -> unpackPack + (Word16, Int16) -> unpackPack + (Word8, Int8) -> unpackPack + + -- signed to unsigned conversion + (Int64, Word64) -> unpackPack + (Int32, Word32) -> unpackPack + (Int16, Word16) -> unpackPack + (Int8, Word8) -> unpackPack + + _ -> impossible "transCast" "copilot-bluespec" + where + -- unpackPack :: (Bits fromTy n, Bits toTy n) => fromTy -> toTy + -- unpackPack e = (unpack (pack e)) :: toTy + -- + -- The most basic cast. Used when fromTy and toTy are both integral types + -- with the same number of bits. + unpackPack :: BS.CExpr -> BS.CExpr + unpackPack e = withTypeAnnotation toTy $ + BS.CApply + (BS.CVar BS.idUnpack) + [BS.CApply (BS.CVar BS.idPack) [e]] + + -- upcastBool :: (Add k 1 n, Bits toTy n) => Bool -> toTy + -- upcastBool b = (unpack (extend (pack b))) :: toTy + -- + -- Cast a Bool to a `Bits 1` value, extend it to `Bits n`, and then + -- convert it back to an integral type. + upcastBool :: BS.CExpr -> BS.CExpr + upcastBool e = withTypeAnnotation toTy $ + BS.CApply + (BS.CVar BS.idUnpack) + [BS.CApply extendExpr [BS.CApply (BS.CVar BS.idPack) [e]]] + + -- upcast :: (BitExtend m n x) => x m -> x n + -- upcast e = (extend e) :: ty + -- + -- Convert a narrower integral type to a wider integral type (e.g., + -- `UInt 8` to `UInt 64` or `Int 8` to `Int 64`). Note that the `extend` + -- operation is smart enough to choose between sign-extension and + -- zero-extension depending on whether `x m` (i.e., fromTy) is a signed + -- or unsigned type, respectively. + upcast :: BS.CExpr -> BS.CExpr + upcast e = withTypeAnnotation toTy $ BS.CApply extendExpr [e] + + -- downcast :: (BitExtend m n x) => x n -> x m + -- downcast e = (truncate e) :: ty + -- + -- Convert a wider integral type to a narrow integral type (e.g., + -- `UInt 64` to `UInt 8` or `Int 64` to `Int 8`) by truncating the most + -- significant bits. + downcast :: BS.CExpr -> BS.CExpr + downcast e = withTypeAnnotation toTy $ BS.CApply truncateExpr [e] + + -- Apply upcast followed by unpackPack. This requires supplying the type to + -- upcast to for type disambiguation purposes. + unpackPackUpcast :: Type a -> BS.CExpr -> BS.CExpr + unpackPackUpcast upcastTy e = unpackPack $ + withTypeAnnotation upcastTy $ BS.CApply extendExpr [e] + + -- castIntegralToFloatingPoint :: (FixedFloatCVT fromTy toTy) => fromTy toTy + -- castIntegralToFloatingPoint e = + -- ((vFixedToFloat e (0 :: UInt 64) Rnd_Nearest_Even).fst) :: tfl + -- + -- While FloatingPoint does have a Bits instance, we don't want to convert + -- an integral type to a FloatingPoint type using the Bits class, as the + -- bit representation of an integral value differs quite a bit from the bit + -- representation of a FloatingPoint value. Instead, we use the + -- special-purpose FixedFloatCVT class for this task. + castIntegralToFloatingPoint :: BS.CExpr -> BS.CExpr + castIntegralToFloatingPoint e = + withTypeAnnotation toTy $ + BS.CSelect + (BS.CApply + (BS.CVar (BS.mkId BS.NoPos "vFixedToFloat")) + [ e + , constNumTy Word64 0 + , fpRM + ]) + BS.idPrimFst + + extendExpr = BS.CVar $ BS.mkId BS.NoPos "extend" + truncateExpr = BS.CVar $ BS.mkId BS.NoPos "truncate" + +-- | Transform a Copilot Core literal, based on its value and type, into a +-- Bluespec expression. +constTy :: Type a -> a -> BS.CExpr +constTy ty = + case ty of + -- The treatment of scalar types is relatively straightforward. Note that + -- Bool is an enum, so we must construct it using a CCon rather than with + -- a CLit. + Bool -> \v -> BS.CCon (if v then BS.idTrue else BS.idFalse) [] + Int8 -> constInt ty . toInteger + Int16 -> constInt ty . toInteger + Int32 -> constInt ty . toInteger + Int64 -> constInt ty . toInteger + Word8 -> constInt ty . toInteger + Word16 -> constInt ty . toInteger + Word32 -> constInt ty . toInteger + Word64 -> constInt ty . toInteger + Float -> constFP ty . realToFrac + Double -> constFP ty + + -- Translating a Copilot array literal to a Bluespec Vector is somewhat + -- involved. Given a Copilot array {x_0, ..., x_(n-1)}, the + -- corresponding Bluespec Vector will look something like: + -- + -- let arr = update (... (update newVector 0 x_0)) (n-1) x_(n-1) + -- + -- We use the `update` function instead of the := syntax (e.g., + -- { array_temp[0] := x; array_temp[1] := y; ...}) so that we can construct + -- a Vector in a pure context. + Array ty' -> constVector ty' . arrayElems + + -- Converting a Copilot struct { field_0 = x_0, ..., field_(n-1) = x_(n-1) } + -- to a Bluespec struct is quite straightforward, given Bluespec's struct + -- initialization syntax. + Struct s -> \v -> + BS.CStruct + (Just True) + (BS.mkId BS.NoPos $ fromString $ uppercaseName $ typeName s) + (map (\(Value ty'' field@(Field val)) -> + ( BS.mkId BS.NoPos $ fromString + $ lowercaseName + $ fieldName field + , constTy ty'' val + )) + (toValues v)) + +-- | Transform a list of Copilot Core expressions of a given 'Type' into a +-- Bluespec @Vector@ expression. +constVector :: Type a -> [a] -> BS.CExpr +constVector ty = genVector (\_ -> constTy ty) + +-- | Transform a list of Copilot Core expressions into a Bluespec @Vector@ +-- expression. When invoking @genVector f es@, where @es@ has length @n@, the +-- resulting @Vector@ will consist of +-- @[f 0 (es !! 0), f 1 (es !! 1), ..., f (n-1) (es !! (n-1))]@. +genVector :: (Int -> a -> BS.CExpr) -> [a] -> BS.CExpr +genVector f vec = + snd $ + foldl' + (\(!i, !v) x -> + ( i+1 + , cUpdateVector + v + (cLit (BS.LInt (BS.ilDec (toInteger i)))) + (f i x) + )) + (0, BS.CVar (BS.mkId BS.NoPos "newVector")) + vec + +-- | Translate a literal number of type @ty@ into a Bluespec expression. +-- +-- PRE: The type of PRE is numeric (integer or floating-point), that +-- is, not boolean, struct or array. +constNumTy :: Type a -> Integer -> BS.CExpr +constNumTy ty = + case ty of + Float -> constFP ty . fromInteger + Double -> constFP ty . fromInteger + _ -> constInt ty + +-- | Translate a Copilot integer literal into a Bluespec expression. +constInt :: Type a -> Integer -> BS.CExpr +constInt ty i + -- Bluespec intentionally does not support negative literal syntax (e.g., + -- -42), so we must create negative integer literals using the `negate` + -- function. + | i >= 0 = withTypeAnnotation ty $ cLit $ BS.LInt $ BS.ilDec i + | otherwise = withTypeAnnotation ty $ + BS.CApply + (BS.CVar $ BS.idNegateAt BS.NoPos) + [cLit $ BS.LInt $ BS.ilDec $ negate i] + +-- | Translate a Copilot floating-point literal into a Bluespec expression. +constFP :: Type ty -> Double -> BS.CExpr +constFP ty d + -- Bluespec intentionally does not support negative literal syntax (e.g., + -- -42.5), so we must create negative floating-point literals using the + -- `negate` function. + | d >= 0 = withTypeAnnotation ty $ cLit $ BS.LReal d + | otherwise = withTypeAnnotation ty $ + BS.CApply + (BS.CVar $ BS.idNegateAt BS.NoPos) + [cLit $ BS.LReal $ negate d] + +-- | Create a Bluespec expression consisting of a literal. +cLit :: BS.Literal -> BS.CExpr +cLit = BS.CLit . BS.CLiteral BS.NoPos + +-- | Create a Bluespec expression that indexes into a @Vector@. +cIndexVector :: BS.CExpr -> BS.CExpr -> BS.CExpr +cIndexVector vec idx = + BS.CApply (BS.CVar (BS.mkId BS.NoPos "select")) [vec, idx] + +-- | Create a Bluespec expression that updates a @Vector@ element at a +-- particular index. +cUpdateVector :: BS.CExpr -> BS.CExpr -> BS.CExpr -> BS.CExpr +cUpdateVector vec idx newElem = + BS.CApply + (BS.CVar (BS.mkId BS.NoPos "update")) + [vec, idx, newElem] + +-- | Create a Bluespec identifier for a floating-point function that Bluespec +-- imports using BDPI. +fpFunId :: Type a -> String -> BS.Id +fpFunId ty funPrefix = + BS.mkId BS.NoPos $ fromString $ "bs_fp_" ++ funName + where + funName :: String + funName = + case ty of + Float -> funPrefix ++ "f" + Double -> funPrefix + _ -> impossible "fpFunId" "copilot-bluespec" + +-- | Explicitly annotate an expression with a type signature. This is necessary +-- to prevent expressions from having ambiguous types in certain situations. +withTypeAnnotation :: Type a -> BS.CExpr -> BS.CExpr +withTypeAnnotation ty e = e `BS.CHasType` BS.CQType [] (transType ty) + +-- | True if the type given is a floating point number. +typeIsFloating :: Type a -> Bool +typeIsFloating Float = True +typeIsFloating Double = True +typeIsFloating _ = False + +-- | We assume round-near-even throughout, but this variable can be changed if +-- needed. This matches the behavior of @fpRM@ in @copilot-theorem@'s +-- @Copilot.Theorem.What4.Translate@ module. +fpRM :: BS.CExpr +fpRM = BS.CCon (BS.mkId BS.NoPos "Rnd_Nearest_Even") [] diff --git a/copilot-bluespec/src/Copilot/Compile/Bluespec/External.hs b/copilot-bluespec/src/Copilot/Compile/Bluespec/External.hs new file mode 100644 index 000000000..6d42105bb --- /dev/null +++ b/copilot-bluespec/src/Copilot/Compile/Bluespec/External.hs @@ -0,0 +1,57 @@ +{-# LANGUAGE ExistentialQuantification #-} + +-- | Represent information about externs needed in the generation of Bluespec +-- code for stream declarations and triggers. +module Copilot.Compile.Bluespec.External + ( External(..) + , gatherExts + ) where + +-- External imports +import Data.List (unionBy) + +-- Internal imports: Copilot +import Copilot.Core ( Expr (..), Stream (..), Trigger (..), Type, UExpr (..) ) + +-- | Representation of external variables. +data External = forall a. External + { extName :: String + , extType :: Type a + } + +-- | Collect all external variables from the streams and triggers. +-- +-- Although Copilot specifications can contain also properties and theorems, +-- the Bluespec backend currently only generates code for streams and triggers. +gatherExts :: [Stream] -> [Trigger] -> [External] +gatherExts streams triggers = streamsExts `extUnion` triggersExts + where + streamsExts = foldr (extUnion . streamExts) mempty streams + triggersExts = foldr (extUnion . triggerExts) mempty triggers + + streamExts :: Stream -> [External] + streamExts (Stream _ _ expr _) = exprExts expr + + triggerExts :: Trigger -> [External] + triggerExts (Trigger _ guard args) = guardExts `extUnion` argExts + where + guardExts = exprExts guard + argExts = concatMap uExprExts args + + uExprExts :: UExpr -> [External] + uExprExts (UExpr _ expr) = exprExts expr + + exprExts :: Expr a -> [External] + exprExts (Local _ _ _ e1 e2) = exprExts e1 `extUnion` exprExts e2 + exprExts (ExternVar ty name _) = [External name ty] + exprExts (Op1 _ e) = exprExts e + exprExts (Op2 _ e1 e2) = exprExts e1 `extUnion` exprExts e2 + exprExts (Op3 _ e1 e2 e3) = exprExts e1 `extUnion` exprExts e2 + `extUnion` exprExts e3 + exprExts (Label _ _ e) = exprExts e + exprExts _ = [] + + -- | Union over lists of External, we solely base the equality on the + -- extName's. + extUnion :: [External] -> [External] -> [External] + extUnion = unionBy (\a b -> extName a == extName b) diff --git a/copilot-bluespec/src/Copilot/Compile/Bluespec/FloatingPoint.hs b/copilot-bluespec/src/Copilot/Compile/Bluespec/FloatingPoint.hs new file mode 100644 index 000000000..a1683f1c1 --- /dev/null +++ b/copilot-bluespec/src/Copilot/Compile/Bluespec/FloatingPoint.hs @@ -0,0 +1,171 @@ +-- | Generate definitions that allow importing C implementations of +-- floating-point operations into Bluespec. +module Copilot.Compile.Bluespec.FloatingPoint + ( copilotBluespecFloatingPointBSV + , copilotBluespecFloatingPointC + ) where + +-- | The contents of the generated @BluespecFP.bsv@ file, which contains the +-- @import \"BDPI\"@ declarations needed to use imported C functions in +-- Bluespec. +copilotBluespecFloatingPointBSV :: String +copilotBluespecFloatingPointBSV = + unlines $ + [ "import FloatingPoint::*;" + , "" + ] ++ + concatMap + (\funName -> [importOp1 Float funName, importOp1 Double funName]) + unaryFloatOpNames ++ + concatMap + (\funName -> [importOp2 Float funName, importOp2 Double funName]) + [ "pow" + , "atan2" + , "logb" + ] + where + importOp1 :: FloatType -> String -> String + importOp1 ft funName = + "import \"BDPI\" function " ++ floatTypeName ft ++ " " ++ funNamePrefix + ++ funName ++ floatTypeSuffix ft ++ " (" ++ floatTypeName ft ++ " x);" + + importOp2 :: FloatType -> String -> String + importOp2 ft funName = + "import \"BDPI\" function " ++ floatTypeName ft ++ " " ++ funNamePrefix + ++ funName ++ floatTypeSuffix ft ++ " (" ++ floatTypeName ft ++ " x, " + ++ floatTypeName ft ++ " y);" + + floatTypeName :: FloatType -> String + floatTypeName Float = "Float" + floatTypeName Double = "Double" + +-- | The contents of the generated @bs_fp.c@ file, which contains the C wrapper +-- functions that Bluespec imports. +copilotBluespecFloatingPointC :: String +copilotBluespecFloatingPointC = + unlines $ + [ "#include " + , "" + , defineUnionType Float + , defineUnionType Double + ] ++ + concatMap + (\funName -> [defineOp1 Float funName, defineOp1 Double funName]) + unaryFloatOpNames ++ + concatMap + (\funName -> [defineOp2 Float funName, defineOp2 Double funName]) + [ "pow" + , "atan2" + ] ++ + -- There is no direct C counterpart to the `logb` function, so we implement + -- it in terms of `log`. + map + (\ft -> + defineOp2Skeleton ft "logb" $ + \_cFunName x y -> "log" ++ floatTypeSuffix ft ++ "(" ++ y ++ ") / log" + ++ floatTypeSuffix ft ++ "( " ++ x ++ ")") + [Float, Double] + where + defineUnionType :: FloatType -> String + defineUnionType ft = + unlines + [ "union " ++ unionTypeName ft ++ " {" + , " " ++ integerTypeName ft ++ " i;" + , " " ++ floatTypeName ft ++ " f;" + , "};" + ] + + defineOp1Skeleton :: + FloatType -> String -> (String -> String -> String) -> String + defineOp1Skeleton ft funName mkFloatOp = + let cFunName = funName ++ floatTypeSuffix ft in + unlines + [ integerTypeName ft ++ " " + ++ funNamePrefix ++ cFunName + ++ "(" ++ integerTypeName ft ++ " x) {" + , " union " ++ unionTypeName ft ++ " x_u;" + , " union " ++ unionTypeName ft ++ " r_u;" + , " x_u.i = x;" + , " r_u.f = " ++ mkFloatOp cFunName "x_u.f" ++ ";" + , " return r_u.i;" + , "}" + ] + + defineOp1 :: FloatType -> String -> String + defineOp1 ft funName = + defineOp1Skeleton ft funName $ + \cFunName x -> cFunName ++ "(" ++ x ++ ")" + + defineOp2Skeleton :: + FloatType -> String -> (String -> String -> String -> String) -> String + defineOp2Skeleton ft funName mkFloatOp = + let cFunName = funName ++ floatTypeSuffix ft in + unlines + [ integerTypeName ft ++ " " + ++ funNamePrefix ++ cFunName + ++ "(" ++ integerTypeName ft ++ " x, " ++ integerTypeName ft + ++ " y) {" + , " union " ++ unionTypeName ft ++ " x_u;" + , " union " ++ unionTypeName ft ++ " y_u;" + , " union " ++ unionTypeName ft ++ " r_u;" + , " x_u.i = x;" + , " y_u.i = y;" + , " r_u.f = " ++ mkFloatOp cFunName "x_u.f" "y_u.f" ++ ";" + , " return r_u.i;" + , "}" + ] + + defineOp2 :: FloatType -> String -> String + defineOp2 ft funName = + defineOp2Skeleton ft funName $ + \cFunName x y -> cFunName ++ "(" ++ x ++ ", " ++ y ++ ")" + + integerTypeName :: FloatType -> String + integerTypeName Float = "unsigned int" + integerTypeName Double = "unsigned long long" + + floatTypeName :: FloatType -> String + floatTypeName Float = "float" + floatTypeName Double = "double" + + unionTypeName :: FloatType -> String + unionTypeName Float = "ui_float" + unionTypeName Double = "ull_double" + +-- * Internals + +-- | Are we generating a function for a @float@ or @double@ operation? +data FloatType + = Float + | Double + +-- | The suffix to use in the generated function. +floatTypeSuffix :: FloatType -> String +floatTypeSuffix Float = "f" +floatTypeSuffix Double = "" + +-- | The prefix to use in the generated function. +funNamePrefix :: String +funNamePrefix = "bs_fp_" + +-- | The names of unary floating-point operations. +unaryFloatOpNames :: [String] +unaryFloatOpNames = + [ "exp" + , "log" + , "acos" + , "asin" + , "atan" + , "cos" + , "sin" + , "tan" + , "acosh" + , "asinh" + , "atanh" + , "cosh" + , "sinh" + , "tanh" + , "ceil" + , "floor" + , "sqrt" + ] diff --git a/copilot-bluespec/src/Copilot/Compile/Bluespec/Name.hs b/copilot-bluespec/src/Copilot/Compile/Bluespec/Name.hs new file mode 100644 index 000000000..dbc714a3b --- /dev/null +++ b/copilot-bluespec/src/Copilot/Compile/Bluespec/Name.hs @@ -0,0 +1,95 @@ +-- | Naming of variables and functions in Bluespec. +module Copilot.Compile.Bluespec.Name + ( argNames + , generatorName + , guardName + , ifcArgName + , indexName + , lowercaseName + , specIfcName + , specIfcPkgName + , specTypesPkgName + , streamAccessorName + , streamElemName + , streamName + , uppercaseName + ) where + +-- External imports +import Data.Char (isLower, isUpper) + +-- External imports: Copilot +import Copilot.Core (Id) + +-- | Turn a specification name into the name of its module interface. +specIfcName :: String -> String +specIfcName prefix = uppercaseName (specIfcPkgName prefix) + +-- | Turn a specification name into the name of the package that declares its +-- module interface. Note that 'specIfcPkgName' is not necessarily the same name +-- as 'specIfcName', as the former does not need to begin with an uppercase +-- letter, but the latter does. +specIfcPkgName :: String -> String +specIfcPkgName prefix = prefix ++ "Ifc" + +-- | Turn a specification name into the name of the package that declares its +-- struct types. +specTypesPkgName :: String -> String +specTypesPkgName prefix = prefix ++ "Types" + +-- | Turn a stream id into a stream element name. +streamElemName :: Id -> Int -> String +streamElemName sId n = streamName sId ++ "_" ++ show n + +-- | The name of the variable of type @Ifc@. This is used to select +-- trigger functions and external variables. +ifcArgName :: String +ifcArgName = "ifc" + +-- | Create a Bluespec name that must start with an uppercase letter (e.g., a +-- struct or interface name). If the supplied name already begins with an +-- uppercase letter, this function returns the name unchanged. Otherwise, this +-- function prepends a @BS_@ prefix (short for \"Bluespec\") at the front. +uppercaseName :: String -> String +uppercaseName [] = [] +uppercaseName n@(c:_) + | isUpper c = n + | otherwise = "BS_" ++ n + +-- | Create a Bluespec name that must start with a lowercase letter (e.g., a +-- function or method name). If the supplied name already begins with a +-- lowercase letter, this function returns the name unchanged. Otherwise, this +-- function prepends a @bs_@ prefix (short for \"Bluespec\") at the front. +lowercaseName :: String -> String +lowercaseName [] = [] +lowercaseName n@(c:_) + | isLower c = n + | otherwise = "bs_" ++ n + +-- | Turn a stream id into a suitable Bluespec variable name. +streamName :: Id -> String +streamName sId = "s" ++ show sId + +-- | Turn a stream id into the global varname for indices. +indexName :: Id -> String +indexName sId = streamName sId ++ "_idx" + +-- | Turn a stream id into the name of its accessor function +streamAccessorName :: Id -> String +streamAccessorName sId = streamName sId ++ "_get" + +-- | Turn stream id into name of its generator function. +generatorName :: Id -> String +generatorName sId = streamName sId ++ "_gen" + +-- | Turn the name of a trigger into a guard generator. +guardName :: String -> String +guardName name = lowercaseName name ++ "_guard" + +-- | Turn a trigger name into a an trigger argument name. +argName :: String -> Int -> String +argName name n = lowercaseName name ++ "_arg" ++ show n + +-- | Enumerate all argument names based on trigger name. +argNames :: String -> [String] +argNames base = map (argName base) [0..] diff --git a/copilot-bluespec/src/Copilot/Compile/Bluespec/Representation.hs b/copilot-bluespec/src/Copilot/Compile/Bluespec/Representation.hs new file mode 100644 index 000000000..d5bc44212 --- /dev/null +++ b/copilot-bluespec/src/Copilot/Compile/Bluespec/Representation.hs @@ -0,0 +1,22 @@ +-- | Bluespec backend specific versions of selected `Copilot.Core` datatypes. +module Copilot.Compile.Bluespec.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 :: Trigger -> Integer -> UniqueTrigger + mkUnique t@(Trigger name _ _) n = UniqueTrigger (name ++ "_" ++ show n) t diff --git a/copilot-bluespec/src/Copilot/Compile/Bluespec/Settings.hs b/copilot-bluespec/src/Copilot/Compile/Bluespec/Settings.hs new file mode 100644 index 000000000..47247b605 --- /dev/null +++ b/copilot-bluespec/src/Copilot/Compile/Bluespec/Settings.hs @@ -0,0 +1,14 @@ +-- | Settings used by the code generator to customize the code. +module Copilot.Compile.Bluespec.Settings + ( BluespecSettings(..) + , mkDefaultBluespecSettings + ) where + +-- | Settings used to customize the code generated. +newtype BluespecSettings = BluespecSettings + { bluespecSettingsOutputDirectory :: FilePath + } + +-- | Default Bluespec settings. Output to the current directory. +mkDefaultBluespecSettings :: BluespecSettings +mkDefaultBluespecSettings = BluespecSettings "." diff --git a/copilot-bluespec/src/Copilot/Compile/Bluespec/Type.hs b/copilot-bluespec/src/Copilot/Compile/Bluespec/Type.hs new file mode 100644 index 000000000..967b695b1 --- /dev/null +++ b/copilot-bluespec/src/Copilot/Compile/Bluespec/Type.hs @@ -0,0 +1,95 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | Translate Copilot Core expressions and operators to Bluespec. +module Copilot.Compile.Bluespec.Type + ( transType + , tVector + ) where + +-- External imports +import Data.String (IsString (..)) +import qualified Language.Bluespec.Classic.AST as BS +import qualified Language.Bluespec.Classic.AST.Builtin.Ids as BS +import qualified Language.Bluespec.Classic.AST.Builtin.Types as BS + +-- Internal imports: Copilot +import Copilot.Core + +-- Internal imports +import Copilot.Compile.Bluespec.Name + +-- | Translate a Copilot type to a Bluespec type. +transType :: Type a -> BS.CType +transType ty = case ty of + Bool -> BS.tBool + Int8 -> BS.tInt `BS.TAp` BS.cTNum 8 BS.NoPos + Int16 -> BS.tInt `BS.TAp` BS.cTNum 16 BS.NoPos + Int32 -> BS.tInt `BS.TAp` BS.cTNum 32 BS.NoPos + Int64 -> BS.tInt `BS.TAp` BS.cTNum 64 BS.NoPos + Word8 -> BS.tUInt `BS.TAp` BS.cTNum 8 BS.NoPos + Word16 -> BS.tUInt `BS.TAp` BS.cTNum 16 BS.NoPos + Word32 -> BS.tUInt `BS.TAp` BS.cTNum 32 BS.NoPos + Word64 -> BS.tUInt `BS.TAp` BS.cTNum 64 BS.NoPos + + Float -> BS.TCon $ + BS.TyCon + { BS.tcon_name = BS.mkId BS.NoPos "Float" + , BS.tcon_kind = Just BS.KStar + , BS.tcon_sort = BS.TItype 0 $ tFloatingPoint `BS.TAp` + BS.cTNum 8 BS.NoPos `BS.TAp` + BS.cTNum 23 BS.NoPos + } + Double -> BS.TCon $ + BS.TyCon + { BS.tcon_name = BS.mkId BS.NoPos "Double" + , BS.tcon_kind = Just BS.KStar + , BS.tcon_sort = BS.TItype 0 $ tFloatingPoint `BS.TAp` + BS.cTNum 11 BS.NoPos `BS.TAp` + BS.cTNum 52 BS.NoPos + } + Array ty' -> tVector `BS.TAp` BS.cTNum len BS.NoPos `BS.TAp` transType ty' + where + len = toInteger $ typeLength ty + Struct s -> BS.TCon $ + BS.TyCon + { BS.tcon_name = BS.mkId BS.NoPos $ + fromString $ + uppercaseName $ + typeName s + , BS.tcon_kind = Just BS.KStar + , BS.tcon_sort = + BS.TIstruct BS.SStruct $ + map (\(Value _tu field) -> + BS.mkId BS.NoPos $ + fromString $ + lowercaseName $ + fieldName field) + (toValues s) + } + +-- | The @Vector@ Bluespec data type. +tVector :: BS.CType +tVector = BS.TCon $ + BS.TyCon + { BS.tcon_name = BS.idVector + , BS.tcon_kind = Just (BS.Kfun BS.KNum (BS.Kfun BS.KStar BS.KStar)) + , BS.tcon_sort = + BS.TIdata + { BS.tidata_cons = [BS.mkId BS.NoPos "V"] + , BS.tidata_enum = False + } + } + +-- | The @FloatingPoint@ Bluespec struct type. +tFloatingPoint :: BS.CType +tFloatingPoint = BS.TCon $ + BS.TyCon + { BS.tcon_name = BS.mkId BS.NoPos "FloatingPoint" + , BS.tcon_kind = Just (BS.Kfun BS.KNum (BS.Kfun BS.KNum BS.KStar)) + , BS.tcon_sort = + BS.TIstruct BS.SStruct [ BS.mkId BS.NoPos "sign" + , BS.mkId BS.NoPos "exp" + , BS.mkId BS.NoPos "sfd" + ] + } diff --git a/copilot-bluespec/tests/Main.hs b/copilot-bluespec/tests/Main.hs new file mode 100644 index 000000000..928da7de3 --- /dev/null +++ b/copilot-bluespec/tests/Main.hs @@ -0,0 +1,18 @@ +-- | Test copilot-bluespec. +module Main where + +-- External imports +import Test.Framework (Test, defaultMain) + +-- Internal library modules being tested +import qualified Test.Copilot.Compile.Bluespec + +-- | Run all @copilot-bluespec@ tests. +main :: IO () +main = defaultMain tests + +-- | All @copilot-bluespec@ tests. +tests :: [Test.Framework.Test] +tests = + [ Test.Copilot.Compile.Bluespec.tests + ] diff --git a/copilot-bluespec/tests/Test/Copilot/Compile/Bluespec.hs b/copilot-bluespec/tests/Test/Copilot/Compile/Bluespec.hs new file mode 100644 index 000000000..ee99c6e75 --- /dev/null +++ b/copilot-bluespec/tests/Test/Copilot/Compile/Bluespec.hs @@ -0,0 +1,1470 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# OPTIONS_GHC -Wno-orphans #-} +-- | Test copilot-bluespec:Copilot.Compile.Bluespec. +module Test.Copilot.Compile.Bluespec + ( tests ) + where + +-- External imports +import Control.Arrow ((&&&)) +import Control.Exception (IOException, catch) +import Control.Monad (when) +import Data.AEq (AEq (..)) +import Data.Bits (Bits, complement) +import Data.Foldable (foldl') +import Data.List (intercalate, stripPrefix) +import Data.List.Extra (stripSuffix) +import Data.Type.Equality (testEquality) +import Data.Typeable (Proxy (..), (:~:) (Refl)) +import GHC.Float (castDoubleToWord64, + castFloatToWord32, + castWord32ToFloat, + castWord64ToDouble) +import GHC.TypeLits (KnownNat, natVal) +import Numeric.IEEE (infinity, nan) +import System.Directory (doesFileExist, + getTemporaryDirectory, + removeDirectoryRecursive, + setCurrentDirectory) +import System.IO (hPutStrLn, stderr) +import System.Posix.Temp (mkdtemp) +import System.Process (callProcess, readProcess) +import System.Random (Random) +import Test.Framework (Test, testGroup) +import Test.Framework.Providers.QuickCheck2 (testProperty) +import Test.QuickCheck (Arbitrary, Gen, Property, + arbitrary, choose, elements, + forAll, forAllBlind, frequency, + getPositive, ioProperty, once, + oneof, vectorOf, withMaxSuccess, + (.&&.)) +import Test.QuickCheck.Gen (chooseAny, chooseBoundedIntegral) +import Text.ParserCombinators.ReadPrec (minPrec) + +-- External imports: Copilot +import Copilot.Core hiding (Property) + +-- External imports +import Copilot.Compile.Bluespec (bluespecSettingsOutputDirectory, compile, + compileWith, mkDefaultBluespecSettings) + +-- Internal imports +import Test.Copilot.Compile.Bluespec.External (External (extName), gatherExts) + +-- * Constants + +-- | All tests for copilot-bluespec:Copilot.Compile.Bluespec. +tests :: Test.Framework.Test +tests = + testGroup "Copilot.Compile.Bluespec" + [ testGroup "Unit tests" + [ testProperty "Compile specification" testCompile + , testProperty "Compile specification in custom dir" testCompileCustomDir + , testProperty "Run specification" testRun + , testProperty "Run and compare results" testRunCompare + ] + , testGroup "Regression tests" + [ test14 + , test15 + ] + ] + +-- * Individual tests + +-- | Test compiling a spec. +testCompile :: Property +testCompile = once $ ioProperty $ do + tmpDir <- getTemporaryDirectory + setCurrentDirectory tmpDir + + testDir <- mkdtemp "CopilotTest" + setCurrentDirectory testDir + + compile "CopilotTest" spec + r <- compileBluespec "CopilotTest" [] + + setCurrentDirectory tmpDir + removeDirectoryRecursive testDir + + return r + + where + + spec = Spec streams observers triggers properties + + streams = [] + observers = [] + triggers = [ Trigger function guard args ] + properties = [] + + function = "func" + + guard = Const Bool True + + args = [] + +-- | Test compiling a spec in a custom directory. +testCompileCustomDir :: Property +testCompileCustomDir = once $ ioProperty $ do + tmpDir <- getTemporaryDirectory + setCurrentDirectory tmpDir + + testDir <- mkdtemp "CopilotTest" + + compileWith (mkDefaultBluespecSettings + { bluespecSettingsOutputDirectory = testDir }) + "CopilotTest" + spec + + setCurrentDirectory testDir + r <- compileBluespec "CopilotTest" [] + + setCurrentDirectory tmpDir + removeDirectoryRecursive testDir + + return r + + where + + spec = Spec streams observers triggers properties + + streams = [] + observers = [] + triggers = [ Trigger function guard args ] + properties = [] + + function = "nop" + + guard = Const Bool True + + args = [] + +-- | Test compiling a spec and running the resulting program. +-- +-- The actual behavior is ignored. +testRun :: Property +testRun = once $ ioProperty $ do + tmpDir <- getTemporaryDirectory + setCurrentDirectory tmpDir + + testDir <- mkdtemp "CopilotTest" + setCurrentDirectory testDir + + let bluespecProgram = unlines + [ "package Top where" + , "" + , "import CopilotTest" + , "import CopilotTestIfc" + , "import CopilotTestTypes" + , "" + , "copilotTestIfc :: Module CopilotTestIfc" + , "copilotTestIfc =" + , " module" + , " interface" + , " nop :: Action" + , " nop = return ()" + , "" + , "mkTop :: Module Empty" + , "mkTop = mkCopilotTest copilotTestIfc" + ] + + writeFile "Top.bs" bluespecProgram + + compile "CopilotTest" spec + r <- compileBluespec "Top" ["-g", "mkTop"] + + -- Compile a main program + r2 <- compileExecutable "mkTop" + callProcess "./mkTop" ["-m", "2"] + + setCurrentDirectory tmpDir + removeDirectoryRecursive testDir + + return $ r && r2 + + where + + spec = Spec streams observers triggers properties + + streams = [] + observers = [] + triggers = [ Trigger function guard args ] + properties = [] + + function = "nop" + + guard = Const Bool True + + args = [] + +-- | Test running compiled spec and comparing the results to the +-- expectation. +testRunCompare :: Property +testRunCompare = + -- It takes a pretty long time to run these tests, so we set the maximum + -- number of successful tests to 5 instead of the default (100) for the sake + -- of making the test suite complete in a more reasonable amount of time. + withMaxSuccess 5 $ + testRunCompare1 (arbitraryOpIntegralBool :: Gen (TestCase1 Int8 Bool)) + .&&. testRunCompare1 (arbitraryOpIntegralBool :: Gen (TestCase1 Int16 Bool)) + .&&. testRunCompare1 (arbitraryOpIntegralBool :: Gen (TestCase1 Int32 Bool)) + .&&. testRunCompare1 (arbitraryOpIntegralBool :: Gen (TestCase1 Int64 Bool)) + .&&. testRunCompare1 (arbitraryOpIntegralBool :: Gen (TestCase1 Word8 Bool)) + .&&. testRunCompare1 (arbitraryOpIntegralBool :: Gen (TestCase1 Word16 Bool)) + .&&. testRunCompare1 (arbitraryOpIntegralBool :: Gen (TestCase1 Word32 Bool)) + .&&. testRunCompare1 (arbitraryOpIntegralBool :: Gen (TestCase1 Word64 Bool)) + .&&. testRunCompare1 (arbitraryOpFloatingBool :: Gen (TestCase1 Float Bool)) + .&&. testRunCompare1 (arbitraryOpFloatingBool :: Gen (TestCase1 Double Bool)) + .&&. testRunCompare1 (arbitraryOpStruct :: Gen (TestCase1 MyStruct Int8)) + .&&. testRunCompare2 (arbitraryOp2Struct :: Gen (TestCase2 MyStruct Int8 MyStruct)) + .&&. testRunCompare2 (arbitraryArray2Num :: Gen (TestCase2 (Array 2 Int8) Word32 Int8)) + .&&. testRunCompare2 (arbitraryArray2Num :: Gen (TestCase2 (Array 2 Int16) Word32 Int16)) + .&&. testRunCompare3 (arbitraryArray3Num :: Gen (TestCase3 (Array 2 Int16) Word32 Int16 (Array 2 Int16))) + +-- * Regression tests + +-- | Regression tests for +-- https://github.com/Copilot-Language/copilot-bluespec/issues/14 which ensure +-- that @copilot-bluespec@ generates code for the @signum@ function that adheres +-- to Copilot's @signum@ semantics. +test14 :: Test.Framework.Test +test14 = + testGroup "#14" + [ testProperty "`signum @Int8` generates correct Bluespec code" $ + mkRegressionTest1 (Sign Int8) (fmap signum) + [-2, -1, 0, 1, 2] + , testProperty "`signum @Double` generates correct Bluespec code" $ + mkRegressionTest1 (Sign Double) (fmap signum) + [-nan, -infinity, -2, -1, -0.0, 0, 1, 2, infinity, nan] + ] + +-- | Regression tests for +-- https://github.com/Copilot-Language/copilot-bluespec/issues/15 which ensure +-- that @copilot-bluespec@ generates valid code for comparison operators (('<'), +-- ('<='), ('>'), and ('>=')) that are capable of handling NaN values. +test15 :: Test.Framework.Test +test15 = + testGroup "#15" + [ testProperty "Generates valid (<) code for NaNs" $ + mkRegressionTest2 (Lt Double) (zipWith (<)) vals + , testProperty "Generates valid (<=) code for NaNs" $ + mkRegressionTest2 (Le Double) (zipWith (<=)) vals + , testProperty "Generates valid (>) code for NaNs" $ + mkRegressionTest2 (Gt Double) (zipWith (>)) vals + , testProperty "Generates valid (>=) code for NaNs" $ + mkRegressionTest2 (Ge Double) (zipWith (>=)) vals + ] + where + vals :: [(Double, Double)] + vals = [(0, nan), (nan, 0)] + +-- | Test the behavior of a unary operation (an @'Op1' a b@ value) against its +-- expected behavior (as a Haskell function of type @[a] -> [b]@) using the +-- supplied inputs (of type @[a]@). This function is intended to be used to +-- construct regression tests. +mkRegressionTest1 :: (Typed a, Typed b, + DisplayableInBluespec b, ReadableFromBluespec b, AEq b) + => Op1 a b + -> ([a] -> [b]) + -> [a] + -> Property +mkRegressionTest1 op haskellFun vals = + let spec = alwaysTriggerArg1 (UExpr t2 appliedOp) + appliedOp = Op1 op (ExternVar t1 varName Nothing) + + len = length vals + inputs = filterOutUnusedExts + spec + [ (typeBluespec t1, + fmap (bluespecShow t1) vals, + varName) + ] + outputs = haskellFun vals in + + once $ + testRunCompareArg + inputs len outputs spec (typeBluespec t2) + + where + + t1 = typeOf + t2 = typeOf + + varName = "input" + +-- | Test the behavior of a binary operation (an @'Op2' a b c@ value) against +-- its expected behavior (as a Haskell function of type @[a] -> [b] -> [c]@) +-- using the supplied inputs (of type @[(a, b)]@). This function is intended to +-- be used to construct regression tests. +mkRegressionTest2 :: (Typed a, Typed b, Typed c, + DisplayableInBluespec c, ReadableFromBluespec c, AEq c) + => Op2 a b c + -> ([a] -> [b] -> [c]) + -> [(a, b)] + -> Property +mkRegressionTest2 op haskellFun vals = + let spec = alwaysTriggerArg1 (UExpr t3 appliedOp) + appliedOp = Op2 op (ExternVar t1 varName1 Nothing) + (ExternVar t2 varName2 Nothing) + + len = length vals + (vals1, vals2) = unzip vals + inputs = filterOutUnusedExts + spec + [ (typeBluespec t1, + fmap (bluespecShow t1) vals1, + varName1) + , (typeBluespec t2, + fmap (bluespecShow t2) vals2, + varName2) + ] + outputs = haskellFun vals1 vals2 in + + once $ + testRunCompareArg + inputs len outputs spec (typeBluespec t3) + + where + + t1 = typeOf + t2 = typeOf + t3 = typeOf + + varName1 = "input1" + varName2 = "input2" + +-- * Random generators + +-- ** Random function generators + +-- | Generator of functions that produce booleans. +arbitraryOpBool :: Typed a => Gen (Fun a Bool, [a] -> [Bool]) +arbitraryOpBool = + frequency + [ (5, arbitraryOp1Any) + , (5, funCompose1 <$> arbitraryOp1Bool <*> arbitraryOpBool) + , (2, funCompose2 <$> arbitraryOp2Bool <*> arbitraryOpBool <*> arbitraryOpBool) + , (1, funCompose2 <$> arbitraryOp2Eq <*> arbitraryOpBool <*> arbitraryOpBool) + ] + +-- | Generator of functions that take Bits and produce booleans. +arbitraryOpBoolBits :: (Typed a, Bits a) => Gen (Fun a Bool, [a] -> [Bool]) +arbitraryOpBoolBits = + frequency + [ (1, funCompose2 <$> arbitraryOp2Eq <*> arbitraryOpBits <*> arbitraryOpBits) + ] + +-- | Generator of functions that take Nums and produce booleans. +arbitaryOpBoolOrdEqNum :: (Typed a, Eq a, Ord a, Num a) + => Gen (Fun a Bool, [a] -> [Bool]) +arbitaryOpBoolOrdEqNum = + frequency + [ (1, funCompose2 <$> arbitraryOp2Eq <*> arbitraryOpNum <*> arbitraryOpNum) + , (1, funCompose2 <$> arbitraryOp2Ord <*> arbitraryOpNum <*> arbitraryOpNum) + ] + +-- | Generator of functions that take Floating point numbers and produce +-- booleans. +arbitraryOpBoolEqNumFloat :: (Typed t, Eq t, Num t, Floating t) + => Gen (Fun t Bool, [t] -> [Bool]) +arbitraryOpBoolEqNumFloat = + frequency + [ (1, funCompose2 <$> arbitraryOp2Eq <*> arbitraryOpNum <*> arbitraryOpFloat) + , (1, funCompose2 <$> arbitraryOp2Eq <*> arbitraryOpFloat <*> arbitraryOpNum) + ] + +-- | Generator of functions that take and produce Bits. +arbitraryOpBits :: (Bits t, Typed t) + => Gen (Fun t t, [t] -> [t]) +arbitraryOpBits = elements + [ (Op1 (BwNot typeOf), fmap complement) + ] + +-- | Generator of functions that take and produce Nums. +arbitraryOpNum :: (Typed t, Num t) => Gen (Fun t t, [t] -> [t]) +arbitraryOpNum = elements + [ (Op1 (Abs typeOf), fmap abs) + , (Op1 (Sign typeOf), fmap signum) + ] + +-- | Generator of functions that take an arrays and indicates and produce +-- elements from the array. +arbitraryArrayIx :: forall t n . (Typed t, KnownNat n, Num t) + => Gen ( Fun2 (Array n t) Word32 t + , [Array n t] -> [Word32] -> [t] + ) +arbitraryArrayIx = return + (Op2 (Index typeOf), zipWith (\x y -> arrayElems x !! fromIntegral y)) + +-- | Generator of functions that take arrays, indices, and values, and then +-- produce new arrays by updating the elements at the indices with the values. +arbitraryArrayUpdate :: forall t n . (Typed t, KnownNat n, Num t) + => Gen ( Fun3 (Array n t) Word32 t (Array n t) + , [Array n t] -> [Word32] -> [t] -> [Array n t] + ) +arbitraryArrayUpdate = return + (Op3 (UpdateArray typeOf), zipWith3 (\x y z -> array (updateAt y z (arrayElems x)))) + where + updateAt :: forall a. Word32 -> a -> [a] -> [a] + updateAt _ _ [] = [] + updateAt 0 x (_ : as) = x : as + updateAt n x (a : as) = a : updateAt (n-1) x as + +-- | Generator of functions that take structs produce fields of the struct. +arbitraryStructField :: Gen ( Fun MyStruct Int8 + , [MyStruct] -> [Int8] + ) +arbitraryStructField = elements + [ (Op1 (GetField typeOf typeOf myStruct1), fmap (unField . myStruct1)) + , (Op1 (GetField typeOf typeOf myStruct2), fmap (unField . myStruct2)) + ] + +-- | Generator of functions that take and produce structs, where the returned +-- structs have one field value updated. +arbitraryStructUpdate :: Gen ( Fun2 MyStruct Int8 MyStruct + , [MyStruct] -> [Int8] -> [MyStruct] + ) +arbitraryStructUpdate = elements + [ ( Op2 (UpdateField typeOf typeOf myStruct1) + , zipWith (\s i -> s { myStruct1 = Field i }) + ) + , ( Op2 (UpdateField typeOf typeOf myStruct2) + , zipWith (\s i -> s { myStruct2 = Field i }) + ) + ] + +-- | Generator of functions on Floating point numbers. +arbitraryOpFloat :: (Floating t, Typed t) => Gen (Fun t t, [t] -> [t]) +arbitraryOpFloat = elements + [ (Op1 (Recip typeOf), fmap recip) + , (Op1 (Exp typeOf), fmap exp) + , (Op1 (Sqrt typeOf), fmap sqrt) + , (Op1 (Log typeOf), fmap log) + , (Op1 (Sin typeOf), fmap sin) + , (Op1 (Tan typeOf), fmap tan) + , (Op1 (Cos typeOf), fmap cos) + , (Op1 (Asin typeOf), fmap asin) + , (Op1 (Atan typeOf), fmap atan) + , (Op1 (Acos typeOf), fmap acos) + , (Op1 (Sinh typeOf), fmap sinh) + , (Op1 (Tanh typeOf), fmap tanh) + , (Op1 (Cosh typeOf), fmap cosh) + , (Op1 (Asinh typeOf), fmap asinh) + , (Op1 (Atanh typeOf), fmap atanh) + , (Op1 (Acosh typeOf), fmap acosh) + ] + +-- | Generator of functions on that produce elements of any type. +arbitraryOp1Any :: forall a b + . (Arbitrary b, Typed a, Typed b) + => Gen (Fun a b, [a] -> [b]) +arbitraryOp1Any = oneof $ + [ (\v -> (\_ -> Const typeOf v, fmap (const v))) <$> arbitrary ] + ++ + rest + where + rest | Just Refl <- testEquality t1 t2 + = [return (id, id)] + | otherwise + = [] + + t1 :: Type a + t1 = typeOf + + t2 :: Type b + t2 = typeOf + +-- | Generator of functions on Booleans. +arbitraryOp1Bool :: Gen (Fun Bool Bool, [Bool] -> [Bool]) +arbitraryOp1Bool = elements + [ (Op1 Not, fmap not) + ] + +-- | Generator of binary functions on Booleans. +arbitraryOp2Bool :: Gen (Fun2 Bool Bool Bool, [Bool] -> [Bool] -> [Bool]) +arbitraryOp2Bool = elements + [ (Op2 And, zipWith (&&)) + , (Op2 Or, zipWith (||)) + ] + +-- | Generator of binary functions that take two Eq elements of the same type +-- and return a Bool. +arbitraryOp2Eq :: (Typed t, Eq t) + => Gen (Fun2 t t Bool, [t] -> [t] -> [Bool]) +arbitraryOp2Eq = elements + [ (Op2 (Eq typeOf), zipWith (==)) + , (Op2 (Ne typeOf), zipWith (/=)) + ] + +-- | Generator of binary functions that take two Ord elements of the same type +-- and return a Bool. +arbitraryOp2Ord :: (Typed t, Ord t) + => Gen (Fun2 t t Bool, [t] -> [t] -> [Bool]) +arbitraryOp2Ord = elements + [ (Op2 (Le typeOf), zipWith (<=)) + , (Op2 (Lt typeOf), zipWith (<)) + , (Op2 (Ge typeOf), zipWith (>=)) + , (Op2 (Gt typeOf), zipWith (>)) + ] + +-- ** Random data generators + +-- | Random array generator. +arbitraryArray :: forall n t . (KnownNat n, Random t) => Gen (Array n t) +arbitraryArray = array <$> vectorOf len chooseAny + where + len :: Int + len = fromIntegral $ natVal (Proxy :: Proxy n) + +-- | Random struct generator. +arbitraryStruct :: Gen MyStruct +arbitraryStruct = do + fld1 <- Field <$> gen + fld2 <- Field <$> gen + return $ MyStruct fld1 fld2 + where + gen :: Gen Int8 + gen = chooseBoundedIntegral (minBound, maxBound) + +-- ** Random test case generators + +-- | Generator for test cases on integral numbers that produce booleans. +arbitraryOpIntegralBool :: (Typed t, Bounded t, Integral t, Bits t) + => Gen (TestCase1 t Bool) +arbitraryOpIntegralBool = frequency + [ (5, mkTestCase1 + arbitraryOpBool + (chooseBoundedIntegral (minBound, maxBound))) + + , (2, mkTestCase1 + arbitraryOpBoolBits + (chooseBoundedIntegral (minBound, maxBound))) + + -- we need to use +1 because certain operations overflow the number + , (2, mkTestCase1 + arbitaryOpBoolOrdEqNum + (chooseBoundedIntegral (minBound + 1, maxBound))) + ] + +-- | Generator for test cases on floating-point numbers that produce booleans. +arbitraryOpFloatingBool :: (Random t, Typed t, Floating t, Eq t) + => Gen (TestCase1 t Bool) +arbitraryOpFloatingBool = oneof + [ mkTestCase1 arbitraryOpBoolEqNumFloat chooseAny + ] + +-- | Generator for test cases on Arrays selection producing values of the +-- array. +arbitraryArray2Num :: forall n a + . (KnownNat n, Num a, Random a, Typed a) + => Gen (TestCase2 (Array n a) Word32 a) +arbitraryArray2Num = oneof + [ mkTestCase2 arbitraryArrayIx arbitraryArray gen + ] + where + gen :: Gen Word32 + gen = choose (0, len - 1) + + len :: Word32 + len = fromIntegral $ natVal (Proxy :: Proxy n) + +-- | Generator for test cases on Arrays which update values of the array. +arbitraryArray3Num :: forall n a + . (KnownNat n, Num a, Random a, Typed a) + => Gen (TestCase3 (Array n a) Word32 a (Array n a)) +arbitraryArray3Num = oneof + [ mkTestCase3 arbitraryArrayUpdate arbitraryArray gen chooseAny + ] + where + gen :: Gen Word32 + gen = choose (0, len - 1) + + len :: Word32 + len = fromIntegral $ natVal (Proxy :: Proxy n) + +-- | Generator for test cases on structs that produce fields of the struct. +arbitraryOpStruct :: Gen (TestCase1 MyStruct Int8) +arbitraryOpStruct = oneof + [ mkTestCase1 + arbitraryStructField + arbitraryStruct + ] + +-- | Generator for test cases that take and produce structs, where the returned +-- structs have one field value updated. +arbitraryOp2Struct :: Gen (TestCase2 MyStruct Int8 MyStruct) +arbitraryOp2Struct = oneof + [ mkTestCase2 + arbitraryStructUpdate + arbitraryStruct + gen + ] + where + gen :: Gen Int8 + gen = chooseBoundedIntegral (minBound, maxBound) + +-- * Semantics + +-- ** Functions + +-- | Unary Copilot function. +type Fun a b = Expr a -> Expr b + +-- | Binary Copilot function. +type Fun2 a b c = Expr a -> Expr b -> Expr c + +-- | Ternary Copilot function. +type Fun3 a b c d = Expr a -> Expr b -> Expr c -> Expr d + +-- | Compose functions, paired with the Haskell functions that define their +-- idealized meaning. +funCompose1 :: (Fun b c, [b] -> [c]) + -> (Fun a b, [a] -> [b]) + -> (Fun a c, [a] -> [c]) +funCompose1 (f1, g1) (f2, g2) = (f1 . f2, g1 . g2) + +-- | Compose a binary function, with two functions, one for each argument. +funCompose2 :: (Fun2 b c d, [b] -> [c] -> [d]) + -> (Fun a b, [a] -> [b]) + -> (Fun a c, [a] -> [c]) + -> (Fun a d, [a] -> [d]) +funCompose2 (f1, g1) (f2, g2) (f3, g3) = + (uncurry f1 . (f2 &&& f3), uncurry g1 . (g2 &&& g3)) + +-- ** Test cases + +-- | Test case specification for specs with one input variable and one output. +data TestCase1 a b = TestCase1 + { wrapTC1Expr :: Spec + -- ^ Specification containing a trigger with an extern of type 'a'. + + , wrapTC1Fun :: [a] -> [b] + -- ^ Function expected to function in the same way as the Spec being + -- tested. + + , wrapTC1CopInp :: (Type a, String, Gen a) + -- ^ Input specification. + -- + -- - The first element contains the type of the input in Bluespec. + -- + -- - The second contains the variable name in Bluespec. + -- + -- - The latter contains a randomized generator for values of the given + -- type. + + , wrapTC1CopOut :: Type b + -- ^ The type of the output in Bluespec. + } + +-- | Test case specification for specs with two input variables and one output. +data TestCase2 a b c = TestCase2 + { wrapTC2Expr :: Spec + -- ^ Specification containing a trigger with an extern of type 'a' and a + -- trigger with an argument of type 'b'. + + , wrapTC2Fun :: [a] -> [b] -> [c] + -- ^ Function expected to function in the same way as the Spec being + -- tested. + + , wrapTC2CopInp1 :: (Type a, String, Gen a) + -- ^ Input specification for the first input. + -- + -- - The first element contains the type of the input in Bluespec. + -- + -- - The second contains the variable name in Bluespec. + -- + -- - The latter contains a randomized generator for values of the given + -- type. + + , wrapTC2CopInp2 :: (Type b, String, Gen b) + -- ^ Input specification for the second input. + -- + -- - The first element contains the type of the input in Bluespec. + -- + -- - The second contains the variable name in Bluespec. + -- + -- - The latter contains a randomized generator for values of the given + -- type. + + , wrapTC2CopOut :: Type c + -- ^ The type of the output in Bluespec. + } + +-- | Test case specification for specs with three input variables and one output. +data TestCase3 a b c d = TestCase3 + { wrapTC3Expr :: Spec + -- ^ Specification containing a trigger with an extern of type 'a', a + -- trigger with an argument of type 'b', and a trigger with an argument of + -- type 'c'. + + , wrapTC3Fun :: [a] -> [b] -> [c] -> [d] + -- ^ Function expected to function in the same way as the Spec being + -- tested. + + , wrapTC3CopInp1 :: (Type a, String, Gen a) + -- ^ Input specification for the first input. + -- + -- - The first element contains the type of the input in Bluespec. + -- + -- - The second contains the variable name in Bluespec. + -- + -- - The latter contains a randomized generator for values of the given + -- type. + + , wrapTC3CopInp2 :: (Type b, String, Gen b) + -- ^ Input specification for the second input. + -- + -- - The first element contains the type of the input in Bluespec. + -- + -- - The second contains the variable name in Bluespec. + -- + -- - The latter contains a randomized generator for values of the given + -- type. + + , wrapTC3CopInp3 :: (Type c, String, Gen c) + -- ^ Input specification for the second input. + -- + -- - The first element contains the type of the input in Bluespec. + -- + -- - The second contains the variable name in Bluespec. + -- + -- - The latter contains a randomized generator for values of the given + -- type. + + , wrapTC3CopOut :: Type d + -- ^ The type of the output in Bluespec. + } + +-- | Generate test cases for expressions that behave like unary functions. +mkTestCase1 :: (Typed a, Typed b) + => Gen (Fun a b, [a] -> [b]) + -> Gen a + -> Gen (TestCase1 a b) +mkTestCase1 genO gen = do + (copilotF, semF) <- genO + + let spec = alwaysTriggerArg1 (UExpr t2 appliedOp) + appliedOp = copilotF (ExternVar t1 varName Nothing) + + return $ + TestCase1 + { wrapTC1Expr = spec + , wrapTC1Fun = semF + , wrapTC1CopInp = ( t1, varName, gen ) + , wrapTC1CopOut = t2 + } + + where + + t1 = typeOf + t2 = typeOf + + varName = "input" + +-- | Generate test cases for expressions that behave like binary functions. +mkTestCase2 :: (Typed a, Typed b, Typed c) + => Gen (Fun2 a b c, [a] -> [b] -> [c]) + -> Gen a + -> Gen b + -> Gen (TestCase2 a b c) +mkTestCase2 genO genA genB = do + (copilotF, semF) <- genO + + let spec = alwaysTriggerArg1 (UExpr t3 appliedOp) + appliedOp = copilotF (ExternVar t1 varName1 Nothing) + (ExternVar t2 varName2 Nothing) + + return $ + TestCase2 + { wrapTC2Expr = spec + , wrapTC2Fun = semF + , wrapTC2CopInp1 = ( t1, varName1, genA ) + , wrapTC2CopInp2 = ( t2, varName2, genB ) + , wrapTC2CopOut = t3 + } + + where + + t1 = typeOf + t2 = typeOf + t3 = typeOf + + varName1 = "input1" + varName2 = "input2" + +-- | Generate test cases for expressions that behave like ternary functions. +mkTestCase3 :: (Typed a, Typed b, Typed c, Typed d) + => Gen (Fun3 a b c d, [a] -> [b] -> [c] -> [d]) + -> Gen a + -> Gen b + -> Gen c + -> Gen (TestCase3 a b c d) +mkTestCase3 genO genA genB genC = do + (copilotF, semF) <- genO + + let spec = alwaysTriggerArg1 (UExpr t4 appliedOp) + appliedOp = copilotF (ExternVar t1 varName1 Nothing) + (ExternVar t2 varName2 Nothing) + (ExternVar t3 varName3 Nothing) + + return $ + TestCase3 + { wrapTC3Expr = spec + , wrapTC3Fun = semF + , wrapTC3CopInp1 = ( t1, varName1, genA ) + , wrapTC3CopInp2 = ( t2, varName2, genB ) + , wrapTC3CopInp3 = ( t3, varName3, genC ) + , wrapTC3CopOut = t4 + } + + where + + t1 = typeOf + t2 = typeOf + t3 = typeOf + t4 = typeOf + + varName1 = "input1" + varName2 = "input2" + varName3 = "input3" + +-- | Test running a compiled Bluespec program and comparing the results. +testRunCompare1 :: (Show a, Typed a, + DisplayableInBluespec b, ReadableFromBluespec b, + AEq b, Typed b) + => Gen (TestCase1 a b) -> Property +testRunCompare1 ops = + forAllBlind ops $ \testCase -> + let (TestCase1 + { wrapTC1Expr = copilotSpec + , wrapTC1Fun = haskellFun + , wrapTC1CopInp = inputVar + , wrapTC1CopOut = outputType + }) = testCase + (bluespecTypeInput, bluespecInputName, gen) = inputVar + + in forAll (getPositive <$> arbitrary) $ \len -> + + forAll (vectorOf len gen) $ \vals -> do + + let inputs = filterOutUnusedExts + copilotSpec + [ (typeBluespec bluespecTypeInput, + fmap (bluespecShow bluespecTypeInput) vals, + bluespecInputName) + ] + outputs = haskellFun vals + + testRunCompareArg + inputs len outputs copilotSpec (typeBluespec outputType) + +-- | Test running a compiled Bluespec program and comparing the results. +testRunCompare2 :: (Show a1, Typed a1, Show a2, Typed a2, + DisplayableInBluespec b, ReadableFromBluespec b, + AEq b, Typed b) + => Gen (TestCase2 a1 a2 b) -> Property +testRunCompare2 ops = + forAllBlind ops $ \testCase -> + let (TestCase2 + { wrapTC2Expr = copilotSpec + , wrapTC2Fun = haskellFun + , wrapTC2CopInp1 = inputVar1 + , wrapTC2CopInp2 = inputVar2 + , wrapTC2CopOut = outputType + }) = + testCase + + (bluespecTypeInput1, bluespecInputName1, gen1) = inputVar1 + (bluespecTypeInput2, bluespecInputName2, gen2) = inputVar2 + + in forAll (getPositive <$> arbitrary) $ \len -> + forAll (vectorOf len gen1) $ \vals1 -> + forAll (vectorOf len gen2) $ \vals2 -> do + let inputs = filterOutUnusedExts + copilotSpec + [ (typeBluespec bluespecTypeInput1, + fmap (bluespecShow bluespecTypeInput1) vals1, + bluespecInputName1) + , (typeBluespec bluespecTypeInput2, + fmap (bluespecShow bluespecTypeInput2) vals2, + bluespecInputName2) + ] + outputs = haskellFun vals1 vals2 + + testRunCompareArg + inputs len outputs copilotSpec (typeBluespec outputType) + +-- | Test running a compiled Bluespec program and comparing the results. +testRunCompare3 :: (Show a1, Typed a1, Show a2, Typed a2, Show a3, Typed a3, + DisplayableInBluespec b, ReadableFromBluespec b, + AEq b, Typed b) + => Gen (TestCase3 a1 a2 a3 b) -> Property +testRunCompare3 ops = + forAllBlind ops $ \testCase -> + let (TestCase3 + { wrapTC3Expr = copilotSpec + , wrapTC3Fun = haskellFun + , wrapTC3CopInp1 = inputVar1 + , wrapTC3CopInp2 = inputVar2 + , wrapTC3CopInp3 = inputVar3 + , wrapTC3CopOut = outputType + }) = + testCase + + (bluespecTypeInput1, bluespecInputName1, gen1) = inputVar1 + (bluespecTypeInput2, bluespecInputName2, gen2) = inputVar2 + (bluespecTypeInput3, bluespecInputName3, gen3) = inputVar3 + + in forAll (getPositive <$> arbitrary) $ \len -> + forAll (vectorOf len gen1) $ \vals1 -> + forAll (vectorOf len gen2) $ \vals2 -> + forAll (vectorOf len gen3) $ \vals3 -> do + let inputs = filterOutUnusedExts + copilotSpec + [ (typeBluespec bluespecTypeInput1, + fmap (bluespecShow bluespecTypeInput1) vals1, + bluespecInputName1) + , (typeBluespec bluespecTypeInput2, + fmap (bluespecShow bluespecTypeInput2) vals2, + bluespecInputName2) + , (typeBluespec bluespecTypeInput3, + fmap (bluespecShow bluespecTypeInput3) vals3, + bluespecInputName3) + ] + outputs = haskellFun vals1 vals2 vals3 + + testRunCompareArg + inputs len outputs copilotSpec (typeBluespec outputType) + +-- | Test running a compiled Bluespec program and comparing the results, when +-- the program produces one output as an argument to a trigger that always +-- fires. +-- +-- PRE: all lists (second argument) of inputs have the length given as second +-- argument. +-- +-- PRE: the monitoring code this is linked against uses the function +-- @printBack@ with exactly one argument to pass the results. +testRunCompareArg :: forall b + . (DisplayableInBluespec b, ReadableFromBluespec b, AEq b) + => [(String, [String], String)] + -> Int + -> [b] + -> Spec + -> String + -> Property +testRunCompareArg inputs numInputs vals spec outputType = + ioProperty $ do + tmpDir <- getTemporaryDirectory + setCurrentDirectory tmpDir + + -- Operate in temporary directory + testDir <- mkdtemp "CopilotTest" + setCurrentDirectory testDir + + -- Produce wrapper program + let bluespecProgram = + testRunCompareArgBluespecProgram (Proxy :: Proxy b) inputs outputType + writeFile "Top.bs" bluespecProgram + + -- Produce copilot monitoring code + compile "CopilotTest" spec + r <- compileBluespec "Top" ["-g", "mkTop"] + + -- Compile main program + r2 <- compileExecutable "mkTop" + + -- Print result so far (for debugging purposes only) + {- + print r2 + print testDir + -} + + -- Run the program and compare the results. Note that we use (===) (using + -- the `AEq` class from the `ieee754` package) rather than (==) (using the + -- `Eq` class), as the former allows us to use exact equality comparisons + -- for floating-point types. This lets us ensure that we are handling NaN + -- and -0.0 values correctly. + out <- readProcess "./mkTop" ["-m", show (numInputs + 2)] "" + let outNums = readFromBluespec <$> lines out + comparison = outNums === vals + + -- Only clean up if the test succeeded; otherwise, we want to inspect it. + when comparison $ do + -- Remove temporary directory + setCurrentDirectory tmpDir + removeDirectoryRecursive testDir + + return $ r && r2 && comparison + +-- | Return a wrapper Bluespec program that runs for a number of clock cycles, +-- updating external stream registers on every cycle, running the monitors, and +-- publishing the results of any outputs. +testRunCompareArgBluespecProgram + :: DisplayableInBluespec b + => Proxy b + -> [(String, [String], String)] + -> String + -> String +testRunCompareArgBluespecProgram proxy inputs outputType = unlines $ + [ "package Top where" + , "" + , "import FloatingPoint" + , "import Vector" + , "" + , "import CopilotTest" + , "import CopilotTestIfc" + , "import CopilotTestTypes" + , "" + ] + ++ inputVecDecls ++ + [ "" + , "copilotTestIfc :: Module CopilotTestIfc" + , "copilotTestIfc =" + , " module" + ] + ++ inputRegs ++ + [ " i :: Reg (Bit 64) <- mkReg 0" + , " ready :: Reg Bool <- mkReg False" + , " interface" + , " printBack :: " ++ outputType ++ " -> Action" + , " printBack output = $display " ++ printBackDisplayArgs + , " when ready" + , "" + ] + ++ inputMethods ++ + [ "" + , " rules" + , " \"inputs\": when True ==> do" + ] + ++ inputUpdates ++ + [ " i := i + 1" + , " ready := True" + , "" + , "mkTop :: Module Empty" + , "mkTop = mkCopilotTest copilotTestIfc" + ] + where + printBackDisplayArgs :: String + printBackDisplayArgs = unwords (displayInBluespec proxy "output") + + inputVecDecls :: [String] + inputVecDecls = + concatMap + (\(bluespecType, _varName, _regName, inputVecName, inputVals) -> + [ inputVecName ++ " :: Vector " ++ show (length inputVals) ++ + " (" ++ bluespecType ++ ")" + , inputVecName ++ " = " ++ genVector inputVals + ]) + vars + + inputRegs :: [String] + inputRegs = + map + (\(bluespecType, _varName, regName, _inputVecName, _inputVals) -> + " " ++ regName ++ " :: Reg (" ++ bluespecType ++ ") <- mkRegU") + vars + + inputMethods :: [String] + inputMethods = + concatMap + (\(bluespecType, varName, regName, _inputVecName, _inputVals) -> + [ " " ++ varName ++ " :: Reg (" ++ bluespecType ++ ")" + , " " ++ varName ++ " = " ++ regName + ]) + vars + + inputUpdates :: [String] + inputUpdates = + map + (\(_bluespecType, _varName, regName, inputVecName, _inputVals) -> + " " ++ regName ++ " := select " ++ inputVecName ++ " i") + vars + + vars = map oneInput inputs + oneInput (bluespecTypeInput, inputVals, bluespecInputName) = + (bluespecTypeInput, inputVarName, inputRegVarName, inputVecVarName, + inputVals) + where + inputVarName = bluespecInputName + inputRegVarName = bluespecInputName ++ "Impl" + inputVecVarName = bluespecInputName ++ "Inputs" + +-- * Auxiliary functions + +-- ** Specs handling + +-- | Build a 'Spec' that triggers at every step, passing the given expression +-- as argument, and execution a function 'printBack'. +alwaysTriggerArg1 :: UExpr -> Spec +alwaysTriggerArg1 = triggerArg1 (Const Bool True) + + where + + -- | Build a 'Spec' that triggers based on a given boolean stream, passing + -- the given expression as argument, and execution a function 'printBack'. + triggerArg1 :: Expr Bool -> UExpr -> Spec + triggerArg1 guard expr = Spec streams observers triggers properties + + where + + streams = [] + observers = [] + properties = [] + + triggers = [ Trigger function guard args ] + function = "printBack" + args = [ expr ] + +-- | Filter out any elements in the input list (of type @[(a, b, String)]@) +-- whose first element (the name of an external stream) does not correspond to +-- the name of an external stream in the supplied 'Spec'. For example, a Copilot +-- source program may declare external streams, but if none of them are used in +-- the 'Spec', then the 'Spec' value itself will not contain any external stream +-- definitions. As a result, we want to ensure that the input list also does not +-- contain any external streams. +filterOutUnusedExts :: Spec -> [(a, b, String)] -> [(a, b, String)] +filterOutUnusedExts spec = filter (\(_, _, name) -> name `elem` extNames) + where + extNames = map extName $ gatherExts (specStreams spec) (specTriggers spec) + +-- ** Compilation of Bluespec programs + +-- | Compile a Bluespec file given its basename. +compileBluespec :: String -> [String] -> IO Bool +compileBluespec baseName extraArgs = do + result <- catch (do callProcess "bsc" $ extraArgs ++ + [ "-sim", "-quiet", "-u", + -- We suppress the G0023 warning, + -- which arises due to the `nop` + -- triggers defined above. See the + -- DESIGN.md document for more + -- details on what these warning + -- codes mean. + "-suppress-warnings", "G0023:S0080", + baseName ++ ".bs" ] + return True + ) + (\e -> do + hPutStrLn stderr $ + "copilot-bluespec: error: compileBluespec: " + ++ "cannot compile " ++ baseName ++ ".bs with bsc" + hPutStrLn stderr $ + "copilot-bluespec: exception: " ++ show (e :: IOException) + return False + ) + if result + then doesFileExist $ baseName ++ ".bo" + else return False + +-- | Compile a Bluespec file into an executable given its basename. +compileExecutable :: String -> IO Bool +compileExecutable topExe = do + result <- catch (do callProcess "bsc" [ "-sim", "-quiet" + , "-e", topExe + , "-o", topExe + , "bs_fp.c" + ] + return True + ) + (\e -> do + hPutStrLn stderr $ + "copilot-bluespec: error: compileExecutable: " + ++ "cannot compile " ++ topExe ++ " with bsc" + hPutStrLn stderr $ + "copilot-bluespec: exception: " + ++ show (e :: IOException) + return False + ) + if result + then doesFileExist topExe + else return False + +-- ** Interfacing between Haskell and Bluespec + +-- | Bluespec type used to store values of a given type. +typeBluespec :: Typed a => Type a -> String +typeBluespec Bool = "Bool" +typeBluespec Int8 = "Int 8" +typeBluespec Int16 = "Int 16" +typeBluespec Int32 = "Int 32" +typeBluespec Int64 = "Int 64" +typeBluespec Word8 = "UInt 8" +typeBluespec Word16 = "UInt 16" +typeBluespec Word32 = "UInt 32" +typeBluespec Word64 = "UInt 64" +typeBluespec Float = "Float" +typeBluespec Double = "Double" +typeBluespec t@(Array tE) = + "Vector " ++ show (typeLength t) ++ "(" ++ typeBluespec tE ++ ")" +typeBluespec (Struct s) = typeName s + +-- | Show a value of a given type in Bluespec. +bluespecShow :: Type a -> a -> String +bluespecShow Bool x = show x +bluespecShow Int8 x = bluespecShowIntegral x +bluespecShow Int16 x = bluespecShowIntegral x +bluespecShow Int32 x = bluespecShowIntegral x +bluespecShow Int64 x = bluespecShowIntegral x +bluespecShow Word8 x = bluespecShowIntegral x +bluespecShow Word16 x = bluespecShowIntegral x +bluespecShow Word32 x = bluespecShowIntegral x +bluespecShow Word64 x = bluespecShowIntegral x +bluespecShow Float x = bluespecShowRealFloat 32 castFloatToWord32 x +bluespecShow Double x = bluespecShowRealFloat 64 castDoubleToWord64 x +bluespecShow (Array tE) x = genVector $ map (bluespecShow tE) $ arrayElems x +bluespecShow (Struct s) x = + typeName s + ++ "{ " + ++ intercalate ";" + (map + (\(Value fldTy fld@(Field val)) -> + fieldName fld ++ " = " ++ bluespecShow fldTy val) + (toValues x)) + ++ "}" + +-- | Show a value of a integral type (e.g., 'Int8' or 'Word8'). +bluespecShowIntegral :: (Integral a, Num a, Ord a, Show a) => a -> String +bluespecShowIntegral x + | x >= 0 = show x + -- Bluespec Haskell doesn't have negative integer literals, so something like + -- "-42" won't parse. Instead, we must rely on Bluespec's `negate` function. + -- + -- We must be careful to negate an Integer literal rather than than a + -- fixed-precision literal. For instance, suppose we wanted to display + -- (-128 :: Int8). We wouldn't want to do this by displaying `negate 128`, + -- since 128 isn't a valid Int8 value—the maximum Int8 value is 127! + -- Instead, we want to display `fromInteger (negate 128)`, where 128 is an + -- Integer. This way, `negate` can turn `128` to `-128` without issues. + | otherwise = "fromInteger (negate " ++ show (abs (toInteger x)) ++ ")" + +-- | Show a value of a floating-point type (e.g., 'Float' or 'Double'). We make +-- sure to convert NaN and infinity values to the corresponding Bluespec +-- @FloatingPoint@ functions that construct these values. +bluespecShowRealFloat :: + (Num float, Ord float, RealFloat float, Show float, Show word) + => Int + -> (float -> word) + -> float + -> String +bluespecShowRealFloat floatSizeInBits castFloatToWord float + -- We want to ensure that NaN values are correctly translated to Bluespec, + -- bit by bit. We have two mechanisms to do so. On the Haskell side, we have + -- `ieee754`'s `nanWithPayload` function, and on the Bluespec side, we have + -- `FloatingPoint`'s `nanQuiet` function. Unfortunately, their arguments are + -- of different types, and it isn't quite clear how to express one function + -- in terms of the other. + -- + -- To avoid this problem, we take a more indirect approach: we first cast + -- the Haskell floating-point value to a word and then `unpack` the word to + -- a floating-point value on the Bluespec side. It's somewhat verbose, but + -- it gets the job done reliably. + | isNaN float + = "unpack (" ++ show (castFloatToWord float) ++ + " :: Bit " ++ show floatSizeInBits ++ ")" + + | isInfinite float + = "infinity " ++ show floatIsNeg + + | floatIsNeg + = "negate " ++ show (abs float) + + | otherwise + = show float + where + floatIsNeg = (float < 0) || isNegativeZero float + +-- | Given a list of elements as arguments, show a @Vector@ expression. For +-- example, @'genVector' [\"27\", \"42\"]@ will return +-- @\"updateVector (updateVector newVector 0 27) 1 42)\"@. +genVector :: [String] -> String +genVector vals = + snd $ + foldl' + (\(!i, !v) x -> + (i+1, "update (" ++ v ++ ") " ++ show i ++ " (" ++ x ++ ")")) + (0 :: Int, "newVector") + vals + +-- | Display a value of a given type in Bluespec using @$display@. +class DisplayableInBluespec a where + displayInBluespec :: + proxy a -- ^ The type of the value. + -> String -- ^ The name of the Bluespec variable. + -> [String] -- ^ All arguments that are passed to @$display@. + +-- | Most Bluespec types can be displayed using @fshow@. +fshowDisplay :: proxy a -> String -> [String] +fshowDisplay _ output = ["(fshow " ++ output ++ ")"] + +-- | We display floating-point numbers by converting them to an integer and +-- printing them in hexadecimal (using the @%x@ modifier). This somewhat unusual +-- choice is motivated by the fact that this output is easier to parse than the +-- @fshow@ output. +hexFloatDisplay :: proxy a -> String -> [String] +hexFloatDisplay _ output = ["\"%x\"", output] + +instance DisplayableInBluespec Bool where + displayInBluespec = fshowDisplay + +instance DisplayableInBluespec Int8 where + displayInBluespec = fshowDisplay + +instance DisplayableInBluespec Int16 where + displayInBluespec = fshowDisplay + +instance DisplayableInBluespec Int32 where + displayInBluespec = fshowDisplay + +instance DisplayableInBluespec Int64 where + displayInBluespec = fshowDisplay + +instance DisplayableInBluespec Word8 where + displayInBluespec = fshowDisplay + +instance DisplayableInBluespec Word16 where + displayInBluespec = fshowDisplay + +instance DisplayableInBluespec Word32 where + displayInBluespec = fshowDisplay + +instance DisplayableInBluespec Word64 where + displayInBluespec = fshowDisplay + +instance DisplayableInBluespec Float where + displayInBluespec = hexFloatDisplay + +instance DisplayableInBluespec Double where + displayInBluespec = hexFloatDisplay + +instance DisplayableInBluespec a => DisplayableInBluespec (Array n a) where + displayInBluespec = fshowDisplay + +-- | @copilot-bluespec@–generated structs currently do not have @FShow@ +-- instances. (Perhaps they should: see +-- https://github.com/Copilot-Language/copilot-bluespec/issues/12) +-- In lieu of this, we manually define the same code that would be used in a +-- derived @FShow@ instance. +instance DisplayableInBluespec MyStruct where + displayInBluespec _ output = + [ "\"MyStruct { myStruct1 = %d ; myStruct2 = %d }\"" + , output ++ ".myStruct1" + , output ++ ".myStruct2" + ] + +-- | Read a value of a given type in Bluespec. +class ReadableFromBluespec a where + readFromBluespec :: String -> a + +instance ReadableFromBluespec Bool where + readFromBluespec = read + +instance ReadableFromBluespec Int8 where + readFromBluespec = read + +instance ReadableFromBluespec Int16 where + readFromBluespec = read + +instance ReadableFromBluespec Int32 where + readFromBluespec = read + +instance ReadableFromBluespec Int64 where + readFromBluespec = read + +instance ReadableFromBluespec Word8 where + readFromBluespec = read + +instance ReadableFromBluespec Word16 where + readFromBluespec = read + +instance ReadableFromBluespec Word32 where + readFromBluespec = read + +instance ReadableFromBluespec Word64 where + readFromBluespec = read + +-- We print out floating-point values in hexadecimal (see `hexFloatDisplay` +-- above), so we parse them accordingly here. + +instance ReadableFromBluespec Float where + readFromBluespec s = castWord32ToFloat $ read $ "0x" ++ s + +instance ReadableFromBluespec Double where + readFromBluespec s = castWord64ToDouble $ read $ "0x" ++ s + +instance (KnownNat n, ReadableFromBluespec a) => ReadableFromBluespec (Array n a) where + readFromBluespec s0 + | Just s1 <- stripPrefix "" s1 + = array $ map readFromBluespec $ words s2 + | otherwise + = error $ "Unexpected Vector fshow output: " ++ s0 + +instance ReadableFromBluespec MyStruct where + readFromBluespec str = + case readsEither (readsStruct minPrec) str of + Left err -> error err + Right ms -> ms + +-- | Attempt to read a value of type @a@. If successful, return 'Right' with +-- the read value. Otherwise, return @'Left' err@, where @err@ is an error +-- message describing what went wrong. +readsEither :: ReadS a -> String -> Either String a +readsEither readIt s = + case [ x | (x,"") <- readIt s ] of + [x] -> Right x + [] -> Left $ "readsEither: no parse: " ++ s + _ -> Left $ "readsEither: ambiguous parse: " ++ s + +-- ** Orphan instances for Arrays + +instance Eq a => Eq (Array n a) where + a1 == a2 = arrayElems a1 == arrayElems a2 + +instance AEq a => AEq (Array n a) where + a1 === a2 = arrayElems a1 === arrayElems a2 + +-- ** A simple struct definition for unit testing purposes + +data MyStruct = MyStruct + { myStruct1 :: Field "myStruct1" Int8 + , myStruct2 :: Field "myStruct2" Int8 + } + +-- | Like a derived @Eq@ instance, except that this looks through 'Field's. +instance Eq MyStruct where + MyStruct (Field f1a) (Field f2a) == MyStruct (Field f1b) (Field f2b) = + f1a == f1b && f2a == f2b +instance AEq MyStruct + +-- | Like a derived @Read@ instance, except that this adds 'Field' wrappers as +-- needed. +readsStruct :: Int -> ReadS MyStruct +readsStruct p = readParen (p > 10) $ \s -> do + ("MyStruct", s1) <- lex s + ("{", s2) <- lex s1 + ("myStruct1", s3) <- lex s2 + ("=", s4) <- lex s3 + (f1, s5) <- readsPrec 0 s4 + (";", s6) <- lex s5 + ("myStruct2", s7) <- lex s6 + ("=", s8) <- lex s7 + (f2, s9) <- readsPrec 0 s8 + ("}", s10) <- lex s9 + pure (MyStruct (Field f1) (Field f2), s10) + +instance Struct MyStruct where + typeName _ = "MyStruct" + toValues ms = [ Value Int8 (myStruct1 ms) + , Value Int8 (myStruct2 ms) + ] + +instance Typed MyStruct where + typeOf = Struct (MyStruct (Field 0) (Field 0)) + +-- | Unwrap a 'Field' to obtain the underlying value. +unField :: Field s t -> t +unField (Field val) = val diff --git a/copilot-bluespec/tests/Test/Copilot/Compile/Bluespec/External.hs b/copilot-bluespec/tests/Test/Copilot/Compile/Bluespec/External.hs new file mode 100644 index 000000000..01b1038bb --- /dev/null +++ b/copilot-bluespec/tests/Test/Copilot/Compile/Bluespec/External.hs @@ -0,0 +1,63 @@ +{-# LANGUAGE ExistentialQuantification #-} + +-- | This is a duplicate version of @Copilot.Compile.Bluespec.External@ that is +-- specific to the test suite. Ideally, we would move this into a common library +-- that is shared between both @copilot-bluespec@ and @copilot-c99@ so that we +-- can avoid this duplication. See +-- https://github.com/Copilot-Language/copilot-bluespec/issues/3. +-- +-- Represent information about externs needed in the generation of Bluespec +-- code for stream declarations and triggers. +module Test.Copilot.Compile.Bluespec.External + ( External(..) + , gatherExts + ) where + +-- External imports +import Data.List (unionBy) + +-- External imports: Copilot +import Copilot.Core ( Expr (..), Stream (..), Trigger (..), Type, UExpr (..) ) + +-- | Representation of external variables. +data External = forall a. External + { extName :: String + , extType :: Type a + } + +-- | Collect all external variables from the streams and triggers. +-- +-- Although Copilot specifications can contain also properties and theorems, +-- the Bluespec backend currently only generates code for streams and triggers. +gatherExts :: [Stream] -> [Trigger] -> [External] +gatherExts streams triggers = streamsExts `extUnion` triggersExts + where + streamsExts = foldr (extUnion . streamExts) mempty streams + triggersExts = foldr (extUnion . triggerExts) mempty triggers + + streamExts :: Stream -> [External] + streamExts (Stream _ _ expr _) = exprExts expr + + triggerExts :: Trigger -> [External] + triggerExts (Trigger _ guard args) = guardExts `extUnion` argExts + where + guardExts = exprExts guard + argExts = concatMap uExprExts args + + uExprExts :: UExpr -> [External] + uExprExts (UExpr _ expr) = exprExts expr + + exprExts :: Expr a -> [External] + exprExts (Local _ _ _ e1 e2) = exprExts e1 `extUnion` exprExts e2 + exprExts (ExternVar ty name _) = [External name ty] + exprExts (Op1 _ e) = exprExts e + exprExts (Op2 _ e1 e2) = exprExts e1 `extUnion` exprExts e2 + exprExts (Op3 _ e1 e2 e3) = exprExts e1 `extUnion` exprExts e2 + `extUnion` exprExts e3 + exprExts (Label _ _ e) = exprExts e + exprExts _ = [] + + -- | Union over lists of External, we solely base the equality on the + -- extName's. + extUnion :: [External] -> [External] -> [External] + extUnion = unionBy (\a b -> extName a == extName b) From 54674815ef416b4ad660199f31e4abec27632175 Mon Sep 17 00:00:00 2001 From: Ryan Scott Date: Tue, 3 Jun 2025 11:12:14 -0400 Subject: [PATCH 0930/1222] copilot-bluespec: Adjust issue numbers in changelog. Refs #623. The `copilot-bluespec` package was originally developed in an external repo (https://github.com/Copilot-Language/copilot-bluespec), but there is interest in having all Copilot projects and libraries merged into the main https://github.com/Copilot-Language/copilot repo for ease of management. Now that the `copilot-bluespec` package lives in the `copilot` repo, this adjusts the issue numbers in the `copilot-bluespec` changelog to refer to the old repo so that they will not be confused with issues in the `copilot` repo. --- copilot-bluespec/CHANGELOG | 40 ++++++++++++++++++++++---------------- 1 file changed, 23 insertions(+), 17 deletions(-) diff --git a/copilot-bluespec/CHANGELOG b/copilot-bluespec/CHANGELOG index e062468a0..d1ba77494 100644 --- a/copilot-bluespec/CHANGELOG +++ b/copilot-bluespec/CHANGELOG @@ -1,35 +1,41 @@ 2025-05-08 - * Version bump (4.4). (#43) + * Version bump (4.4). (copilot-bluespec#43) 2025-05-05 - * Version bump (4.3.1). (#41) - * Move Copilot.Compile.Bluespec.External out of shared directory. (#36) - * Allow building with filepath-1.5.*. (#39) + * Version bump (4.3.1). (copilot-bluespec#41) + * Move Copilot.Compile.Bluespec.External out of shared directory. + (copilot-bluespec#36) + * Allow building with filepath-1.5.*. (copilot-bluespec#39) 2025-03-10 - * Version bump (4.3). (#34) + * Version bump (4.3). (copilot-bluespec#34) 2025-01-20 - * Version bump (4.2). (#31) - * Implement missing floating-point operations. (#28) - * Allow using same trigger name in multiple declarations. (#30) + * Version bump (4.2). (copilot-bluespec#31) + * Implement missing floating-point operations. (copilot-bluespec#28) + * Allow using same trigger name in multiple declarations. + (copilot-bluespec#30) 2024-11-08 - * Version bump (4.1). (#25) + * Version bump (4.1). (copilot-bluespec#25) 2024-09-09 - * Version bump (4.0). (#23) - * Support translating Copilot array updates to Bluespec. (#19) + * Version bump (4.0). (copilot-bluespec#23) + * Support translating Copilot array updates to Bluespec. + (copilot-bluespec#19) 2024-08-03 - * Test GHC 9.4 through 9.8. (#20) + * Test GHC 9.4 through 9.8. (copilot-bluespec#20) 2024-07-11 - * Version bump (3.20). (#11) - * Support translating Copilot struct updates to Bluespec (#10). - * Fix a bug in the translation of the signum function. (#14) - * Fix a bug in the translation of floating-point comparisons. (#15) + * Version bump (3.20). (copilot-bluespec#11) + * Support translating Copilot struct updates to Bluespec. + (copilot-bluespec#10) + * Fix a bug in the translation of the signum function. + (copilot-bluespec#14) + * Fix a bug in the translation of floating-point comparisons. + (copilot-bluespec#15) 2024-03-08 - * Version bump (3.19). (#5) + * Version bump (3.19). (copilot-bluespec#5) * Create new library for Bluespec backend. From 7433ba32d87727f947357f78293bd8b900bba0f6 Mon Sep 17 00:00:00 2001 From: Ryan Scott Date: Wed, 28 May 2025 15:15:36 -0400 Subject: [PATCH 0931/1222] copilot-bluespec: Document changes in CHANGELOG. Refs #623. --- copilot-bluespec/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-bluespec/CHANGELOG b/copilot-bluespec/CHANGELOG index d1ba77494..10f4486ec 100644 --- a/copilot-bluespec/CHANGELOG +++ b/copilot-bluespec/CHANGELOG @@ -1,3 +1,6 @@ +2025-05-18 + * Include `copilot-bluespec` in mainline `copilot` repo. (#623) + 2025-05-08 * Version bump (4.4). (copilot-bluespec#43) From fd769d4645f8c8e5cf6e457b719fc5fa7f93979e Mon Sep 17 00:00:00 2001 From: Ryan Scott Date: Fri, 20 Jun 2025 10:44:36 -0400 Subject: [PATCH 0932/1222] Explicitly list .cabal files in cabal.project. Refs #622. The `copilot-verifier` package was originally developed in an external repo (https://github.com/Copilot-Language/copilot-verifier), but there is interest in having all Copilot projects and libraries merged into the main https://github.com/Copilot-Language/copilot repo for ease of management. For now, we wish not to add `copilot-verifier` to the `cabal.project` file, as its version bounds are tighter than the range of GHC versions that `copilot` currently supports. As such, this commit explicitly lists the `.cabal` files of packages that we do want to include in the `cabal.project`, i.e., all of the `.cabal` files except for `copilot-verifier.cabal`. --- cabal.project | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/cabal.project b/cabal.project index 00dfed318..812c95ba6 100644 --- a/cabal.project +++ b/cabal.project @@ -1,2 +1,10 @@ packages: - */*.cabal + copilot-bluespec/copilot-bluespec.cabal + copilot-c99/copilot-c99.cabal + copilot-core/copilot-core.cabal + copilot-interpreter/copilot-interpreter.cabal + copilot-language/copilot-language.cabal + copilot-libraries/copilot-libraries.cabal + copilot-prettyprinter/copilot-prettyprinter.cabal + copilot-theorem/copilot-theorem.cabal + copilot/copilot.cabal From c8f422175ce480bc6655c0bb6207d122b42ccf71 Mon Sep 17 00:00:00 2001 From: Ryan Scott Date: Fri, 20 Jun 2025 10:03:13 -0400 Subject: [PATCH 0933/1222] copilot-verifier: Include in mainline copilot repo. Refs #622. The `copilot-verifier` package was originally developed in an external repo (https://github.com/Copilot-Language/copilot-verifier), but there is interest in having all Copilot projects and libraries merged into the main https://github.com/Copilot-Language/copilot repo for ease of management. This commit includes the last state of the old `copilot-verified` repo into the main Copilot repo as a new subdirectory, disregarding the commit history. --- copilot-verifier/CHANGELOG | 40 + copilot-verifier/LICENSE | 30 + copilot-verifier/README.md | 351 ++++ copilot-verifier/copilot-verifier.cabal | 152 ++ .../examples/Copilot/Verifier/Examples.hs | 97 + .../Examples/ShouldFail/Partial/AbsIntMin.hs | 28 + .../ShouldFail/Partial/AddSignedWrap.hs | 27 + .../Examples/ShouldFail/Partial/DivByZero.hs | 27 + .../ShouldFail/Partial/IndexOutOfBounds.hs | 31 + .../Examples/ShouldFail/Partial/ModByZero.hs | 27 + .../ShouldFail/Partial/MulSignedWrap.hs | 31 + .../ShouldFail/Partial/ShiftLTooLarge.hs | 32 + .../ShouldFail/Partial/ShiftRTooLarge.hs | 32 + .../ShouldFail/Partial/SubSignedWrap.hs | 27 + .../Verifier/Examples/ShouldPass/Arith.hs | 52 + .../Verifier/Examples/ShouldPass/Array.hs | 40 + .../Verifier/Examples/ShouldPass/ArrayGen.hs | 21 + .../Examples/ShouldPass/ArrayOfStructs.hs | 29 + .../ShouldPass/ArrayTriggerArgument.hs | 23 + .../Verifier/Examples/ShouldPass/Clock.hs | 46 + .../Verifier/Examples/ShouldPass/Counter.hs | 56 + .../Verifier/Examples/ShouldPass/Engine.hs | 44 + .../Examples/ShouldPass/FPNegation.hs | 62 + .../Verifier/Examples/ShouldPass/FPOps.hs | 88 + .../Verifier/Examples/ShouldPass/Heater.hs | 60 + .../Verifier/Examples/ShouldPass/IntOps.hs | 64 + .../Examples/ShouldPass/Partial/AbsIntMin.hs | 19 + .../ShouldPass/Partial/AddSignedWrap.hs | 19 + .../Examples/ShouldPass/Partial/DivByZero.hs | 19 + .../ShouldPass/Partial/IndexOutOfBounds.hs | 19 + .../Examples/ShouldPass/Partial/ModByZero.hs | 19 + .../ShouldPass/Partial/MulSignedWrap.hs | 19 + .../ShouldPass/Partial/ShiftLTooLarge.hs | 19 + .../ShouldPass/Partial/ShiftRTooLarge.hs | 19 + .../ShouldPass/Partial/SubSignedWrap.hs | 19 + .../Verifier/Examples/ShouldPass/Structs.hs | 92 + .../Examples/ShouldPass/UpdateArray.hs | 32 + .../Examples/ShouldPass/UpdateStruct.hs | 62 + .../Verifier/Examples/ShouldPass/Voting.hs | 64 + .../Verifier/Examples/ShouldPass/WCV.hs | 189 ++ copilot-verifier/exe/VerifyExamples.hs | 53 + copilot-verifier/src/Copilot/Verifier.hs | 1607 +++++++++++++++++ .../src/Copilot/Verifier/FloatMode.hs | 56 + copilot-verifier/src/Copilot/Verifier/Log.hs | 834 +++++++++ .../src/Copilot/Verifier/Solver.hs | 25 + copilot-verifier/test/Test.hs | 32 + 46 files changed, 4734 insertions(+) create mode 100644 copilot-verifier/CHANGELOG create mode 100644 copilot-verifier/LICENSE create mode 100644 copilot-verifier/README.md create mode 100644 copilot-verifier/copilot-verifier.cabal create mode 100644 copilot-verifier/examples/Copilot/Verifier/Examples.hs create mode 100644 copilot-verifier/examples/Copilot/Verifier/Examples/ShouldFail/Partial/AbsIntMin.hs create mode 100644 copilot-verifier/examples/Copilot/Verifier/Examples/ShouldFail/Partial/AddSignedWrap.hs create mode 100644 copilot-verifier/examples/Copilot/Verifier/Examples/ShouldFail/Partial/DivByZero.hs create mode 100644 copilot-verifier/examples/Copilot/Verifier/Examples/ShouldFail/Partial/IndexOutOfBounds.hs create mode 100644 copilot-verifier/examples/Copilot/Verifier/Examples/ShouldFail/Partial/ModByZero.hs create mode 100644 copilot-verifier/examples/Copilot/Verifier/Examples/ShouldFail/Partial/MulSignedWrap.hs create mode 100644 copilot-verifier/examples/Copilot/Verifier/Examples/ShouldFail/Partial/ShiftLTooLarge.hs create mode 100644 copilot-verifier/examples/Copilot/Verifier/Examples/ShouldFail/Partial/ShiftRTooLarge.hs create mode 100644 copilot-verifier/examples/Copilot/Verifier/Examples/ShouldFail/Partial/SubSignedWrap.hs create mode 100644 copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/Arith.hs create mode 100644 copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/Array.hs create mode 100644 copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/ArrayGen.hs create mode 100644 copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/ArrayOfStructs.hs create mode 100644 copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/ArrayTriggerArgument.hs create mode 100644 copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/Clock.hs create mode 100644 copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/Counter.hs create mode 100644 copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/Engine.hs create mode 100644 copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/FPNegation.hs create mode 100644 copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/FPOps.hs create mode 100644 copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/Heater.hs create mode 100644 copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/IntOps.hs create mode 100644 copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/Partial/AbsIntMin.hs create mode 100644 copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/Partial/AddSignedWrap.hs create mode 100644 copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/Partial/DivByZero.hs create mode 100644 copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/Partial/IndexOutOfBounds.hs create mode 100644 copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/Partial/ModByZero.hs create mode 100644 copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/Partial/MulSignedWrap.hs create mode 100644 copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/Partial/ShiftLTooLarge.hs create mode 100644 copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/Partial/ShiftRTooLarge.hs create mode 100644 copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/Partial/SubSignedWrap.hs create mode 100644 copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/Structs.hs create mode 100644 copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/UpdateArray.hs create mode 100644 copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/UpdateStruct.hs create mode 100644 copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/Voting.hs create mode 100644 copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/WCV.hs create mode 100644 copilot-verifier/exe/VerifyExamples.hs create mode 100644 copilot-verifier/src/Copilot/Verifier.hs create mode 100644 copilot-verifier/src/Copilot/Verifier/FloatMode.hs create mode 100644 copilot-verifier/src/Copilot/Verifier/Log.hs create mode 100644 copilot-verifier/src/Copilot/Verifier/Solver.hs create mode 100644 copilot-verifier/test/Test.hs diff --git a/copilot-verifier/CHANGELOG b/copilot-verifier/CHANGELOG new file mode 100644 index 000000000..2923ff5ed --- /dev/null +++ b/copilot-verifier/CHANGELOG @@ -0,0 +1,40 @@ +2025-05-08 + * Version bump (4.4). (#85) + +2025-03-10 + * Version bump (4.3). (#82) + * Add `smtSolver` option to `VerifierOptions`. (#78) + * Add `smtFloatMode` option to `VerifierOptions`. (#79) + +2025-01-20 + * Version bump (4.2). (#76) + * Reject specs that use multiple triggers with the same name. (#74) + +2024-11-08 + * Version bump (4.1). (#72) + +2024-09-09 + * Version bump (4.0). (#69) + * Support verifying programs that use array updates. (#63) + * Support verifying programs that use struct updates. (#57) + +2024-08-03 + * Support building with `crucible-llvm-0.7` and `crux-llvm-0.9`. (#64) + * Support GHC 9.4 through 9.8. (#65) + +2024-07-30 + * When using `Noisy` verbosity, always log proof goals related to the + core correspondence proof, even if the goals are trivial. (#51) + * When using `Noisy` verbosity, log more information about which proof + goals arise before or after calling the `step()` function. (#52) + +2024-07-11 + * Version bump (3.20). (#58) + +2024-03-08 + * Version bump (3.19). (#53) + * Provide more detailed feedback upon a successful run of the verifier. + * Make the examples build with Copilot 3.19. (#53) + +2024-02-06 + * Initial release of `copilot-verifier`. diff --git a/copilot-verifier/LICENSE b/copilot-verifier/LICENSE new file mode 100644 index 000000000..7192c3586 --- /dev/null +++ b/copilot-verifier/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2021-2024 Galois Inc. +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions +are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in + the documentation and/or other materials provided with the + distribution. + + * Neither the name of Galois, Inc. nor the names of its contributors + may be used to endorse or promote products derived from this + software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS +IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A +PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER +OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, +EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, +PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR +PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF +LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING +NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/copilot-verifier/README.md b/copilot-verifier/README.md new file mode 100644 index 000000000..85e28d9f5 --- /dev/null +++ b/copilot-verifier/README.md @@ -0,0 +1,351 @@ +[![Build Status](https://github.com/Copilot-Language/copilot-verifier/workflows/copilot-verifier/badge.svg)](https://github.com/Copilot-Language/copilot-verifier/actions?query=workflow%3Acopilot-verifier) +[![Version on Hackage](https://img.shields.io/hackage/v/copilot-verifier.svg)](https://hackage.haskell.org/package/copilot-verifier) + +# Copilot Verifier + +Copilot Verifier is an add-on to the [Copilot Stream +DSL](https://copilot-language.github.io) for verifying the correctness of C +code generated by the `copilot-c99` package. + +The main idea of the verifier is to use the +[Crucible symbolic simulator](https://github.com/galoisinc/crucible) +to interpret the semantics of the generated C program and +and to produce verification conditions sufficient to guarantee +that the meaning of the generated program corresponds in a precise +way to the meaning of the original stream specification. The generated +verification conditions are then dispatched to SMT solvers to +be automatically solved. We will have more to say about exactly +what is meant by this correspondence below. + +Copilot Verifier is described in the ICFP 2023 paper [_Trustworthy Runtime +Verification via Bisimulation (Experience +Report)_](https://dl.acm.org/doi/abs/10.1145/3607841). + +## Building + +To build the verifier from source, first make sure you have met the following +prerequisites: + +* Ensure that you have the `cabal` and `ghc` executables in your `PATH`. If you + don't already have them, we recommend using `ghcup` to install them: + https://www.haskell.org/ghcup/. We recommend `Cabal` 3.10 or newer, and one of + GHC 9.4, 9.6, or 9.8. + +* Ensure that you have the `clang` and `llvm-link` utilities from LLVM in your + `PATH`. Currently, LLVM versions up to 16 are supported. LLVM binaries are + available at https://github.com/llvm/llvm-project/releases. + +* Ensure that you have the `z3` SMT solver in your `PATH`. `z3` binaries are + available at https://github.com/Z3Prover/z3/releases. + + Alternatively, the verifier can be configured to use one of the following + SMT solvers instead: + + * `cvc4`: https://cvc4.github.io/downloads.html + * `cvc5`: https://github.com/cvc5/cvc5/releases/ + * `yices`: https://yices.csl.sri.com + +Then, clone the repo and run: + +``` +$ git submodule update --init +$ cabal test copilot-verifier +``` + +This will clone the repository, build the verifier, and run the associated test +suite. If you have performed all of the steps above correctly, the test suite +should pass. + +We also provide a [Dockerfile](Dockerfile) which automates the process of +installing Copilot and the verifier. The Dockerfile can be built and run using +the following commands: + +``` +$ docker build -t . +$ docker run -it +``` + +Where `` is a unique name for the Docker image. + +## Using the Copilot Verifier + +The main interface to the verifier is the `Copilot.Verifier.verify` +function, which takes some options to drive the code generation +process and a Copilot `Spec` object. It will invoke the Copilot +code generator to obtain C sources, compile the C sources into +LLVM bitcode using the `clang` compiler front-end, then +parse and interpret the bitcode using `crucible`. After generating +verification conditions, it will dispatch them to an SMT solver, +and the result of those queries will be presented to the user. + +There are a number of examples (based on similar examples +from the main Copilot repository) demonstrating how to +incorporate the verifier into a Copilot program. +See the `copilot-verifier/examples` subdirectory of this repository. + +## Details of the Verification + +### Synopsis of Copilot semantics + +The Copilot DSL represents a certain nicely-behaved +class of discrete-time stream programs. Each `Stream` +in Copilot denotes an infinite stream of values; one may +just as well think that `Stream a` represents a pure mathematical +function `ℕ → a` from natural numbers to values of type `a`. +See the +[Copilot manual](https://ntrs.nasa.gov/api/citations/20200003164/downloads/20200003164.pdf) +for more details of the Copilot language itself and its semantics. + +One of the central design considerations for Copilot is that is should +be possible to implement stream programs using a fixed, finite amount +of storage. As a result, Copilot will only accept stream programs +that access a bounded amount of their input streams (including any +recursive stream references). This allows an +implementation strategy where the generated C code can use fixed-size +ring buffers to store a limited number of previous stream values. + +The execution model for the generated programs is that the program +starts in a state corresponding to stream values at time `t = 0`; +"external" stream input values are placed in distinguished global +variables by the calling environment, which then executes a `step()` +function to move to the next time step. The `step()` function captures +the values of these external inputs and does whatever computation is +necessary to update its internal state from time `t=n` to time +`t=n+1`. In addition, it will call any defined "trigger" functions +if the stream state at that time step satisfies the defined guard condition. +In short, the generated C program steps one moment at a time through +the stream program, consuming a sequence of input values provided by +a cooperating environment and calling handler functions whenever +states of interest occur. + +### The Desired Correspondence + +What does it mean, then, for a generated C program in this style +to correctly implement a given stream program? The intuition +is basically that after `n` calls to the `step` function, +the state of the ring-buffers of the C program should correctly +compute the value of the corresponding stream expression +evaluated at index `n`, assuming the C program has been fed +inputs corresponding to the first `n` values of the external stream +inputs. Moreover, the trigger functions should be called from +the `step` function exactly at the time values when the stream expressions +evaluate to true. + +The notion of correspondence for the values flowing in streams is +relatively straightforward: these values consist of fixed-width +machine integers, floating-point values, structs and fixed-length +arrays. For each, the appropriate notion of equality is fairly clear. + +Both the original `Stream` program and the generated C program +can be viewed straightforwardly as a transition system, and under +this view, the correspondence we want to establish is a bisimulation +between the states of the high-level stream program and the low-level +C program. The proof method for bisimulation requires us to provide +a "correspondence" relation between the program states, and then prove +three things about this relation: + +1. that the initial states of the programs are in the relation; +2. if we assume two arbitrary program states begin in the relation +and each takes a single transition (consuming corresponding inputs), +the resulting states are back in the relation; +3. that any observable +actions taken by one program are exactly mirrored by the other. + +On the high-level side of the bisimulation, the program +state is essentially just the value of the current time step `n`, +whereas on the C side it consists of the regions of global memory that +contain the ring-buffers and their current indices. The transition +relation for the high-level program just increments the time value by +one, and the transition for the C program is defined by the action +of the generated `step()` function. + +Suppose `s` is one of the stream definitions in the original Copilot +program which is required to retain `k` previous values; +let `buf` be the global variable name of the ring-buffer in the C +program, and `idx` be the global variable name maintaining the +current index into the ring buffer. Then the correspondence +relation is basically that `0 <= idx < k` and +`s[n+i] = buf[(idx+i) mod k]` as `i` ranges from `0 .. k-1`. +By abuse of notation, here we mean that `s[j]` is +the value of the stream expression `s` evaluated at index `j`, +whereas `buf[j]` means the value obtained by reading the `j`th value +of the buffer `buf` from memory. The overall correspondence relation +is a conjunction of statements like this, one for each stream +expression that is realized via a buffer. + +### Implementing the Bisimulation proof steps + +The kind of program correspondence property we desire is a largely +mechanical affair. As the code under consideration is automatically +generated, it has a very regular structure and is specifically +intended to implement the semantics we wich to verify it against. As +such, we expect these proofs to be highly automatable. + +The proof principle of bisimulation itself is not amenable +to reduction to SMT, as if falls outside the first-order theories +those solvers understand. Likewise, the semantics of Copilot +and C might possibly be reducible directly to SMT, but it would be +impractical to do so. However, we can reduce the individual +proof obligations mentioned above into a series of lower-level +logical statements that are amenable to SMT proof by +defining the logical semantics of stream programs, and using +symbolic simulation techniques to interpret the semantics of the +C program. Performing this reduction is the key contribution +of `copilot-verifier`. + +#### Initial state correspondence + +The proof first obligation we must discharge is to show that +the initial states of the two programs correspond. For each +stream `s` there is a corresponding `k`, which is the length of +the ring-buffer implementing it. We must simply verify that +the C program initializes its buffer with the first `k` values +of the stream `s`, and that the `idx` value starts at 0. +Because of the restrictions Copilot places on programs, these +first `k` values must be specified concretely and will not be +able to depend on any external inputs. As such, this step +is quite easily performed, as it requires only direct evaluation +of concrete inputs. + +#### Transition correspondence + +The bulk of the proof effort consists of demonstrating that +the bisimulation relation is preserved by transitions. +In order to do this step, we must begin with totally symbolic +initial states: we know nothing except that we are at some +arbitrary time value `n`, and that the C program buffers +correspond to their stream values as required by the relation. +Thus, we create fresh symbolic variables for the streams +from `n` to `n + k-1`, and for the values of all the involved +external streams at time `n`. Then, we run forward the Copilot +program by evaluating the stream recurrence expression to +compute the value of each stream at time `n+k`. + +Next we set up an initial state of the C program by choosing, +for each ring buffer, an arbitrary value for its current index +within its allowed range, and then writing the variables +corresponding to each stream value into the buffers at +their appropriate offsets. The symbolic simulator is then +invoked to compute the state update effects of the `step()` +function. Afterward, we read the poststate values from the +ring-buffers and verify that they correspond to the stream +values from `n+1` up to `n+k`. + +As part of symbolic simulation, Crucible may also generate +side-conditions that relate to memory safety of the program, or to +error conditions that must be avoided. All of the bisimulation +equivalence conditions and the safety side-conditions will be +submitted to an SMT solver. + +#### Observable effects + +For our purposes, the only observable effects of a Copilot program +relate to any "trigger" functions defined in the spec. Our task is to +show that the generated C code calls the external trigger functions if +and only if the corresponding guard condition is true, and that the +arguments passed to those functions are as expected. +This proof obligation is proved in the same phase along with +the transition relation proof above because the `step()` function +is responsible for both invoking triggers and for performing state +updates. + +The technique we use to perform this aspect of the proof is to +install "override" functions to the external symbols corresponding +to the C trigger functions before we begin symbolic simulation. +In a real system, the external environment would be responsible +for implementing these functions and taking whatever appropriate +action is necessary when the triggers fire. However, we are verifying +the generated code in isolation from its environment, so we have no +implementation in hand. Instead, the override will +essentially implement a stub function that simply captures its +arguments and the path condition under which it was called. +After simulation completes, the captured arguments and path condition +are required to be equivalent to the corresponding trigger guard +and arguments from the Copilot spec. These conditions are +discharged to the SMT solver at the same time as the transition +relation obligations. + +Because of the way we model the trigger functions, we make a number of +implicit assumptions about how the actual implementations of those +functions must behave. The most important of those assumptions is that +the trigger functions must not modify any memory under the control of +the Copilot program, including its ring buffers and stack. We also +assume that the trigger functions are well defined, i.e. they are +memory safe and do not perform any undefined behavior. + +#### Partial operations + +A generated C program may make use of partial operations. These range from +division, which can fail if the second argument is zero, to signed integer +arithmetic, which can overflow and result in undefined behavior. The verifier +has two modes for dealing with partial operations: + +1. Any invocation of a partial operation on undefined inputs in the generated + C program will result in an error, provided that the user did not add an + assertion that assumes this behavior will not occur. + +2. If the generated C program invokes a partial operation on undefined inputs, + the verifier will check if this coincides with a corresponding invocation + of a partial operation in the Copilot spec. If so, the verification will + succeed. In other words, the verifier will check that the spec and the + C program are "crash-equivalent". + +The verifier uses mode (1) by default, but mode (2) can be enabled by using +`Copilot.Verifier.verifyWithOptions sideCondVerifierOptions`. In this mode, +the verifier will analyze any invocation of a operation which could be partial +and generate a side condition that this operation will only be invoked on +well defined inputs. During the transition step of the bisimulation proof, +the verifier will add these side conditions as assumptions. Therefore, if +simulating the C program generates any side conditions due to invoking partial +operations, these side conditions from the C program should be dischargeable +using the corresponding side conditions from the Copilot spec. + +Mode (2) has the caveat that `clang` may compile C code to LLVM bitcode in +which a partial function is no longer applied to undefined inputs. For +instance, `clang` will sometimes promote 16-bit integer values to 32 bits +before performing arithmetic on them. This can turn an operation that would +result in signed 16-bit integer overflow into a 32-bit integer operation +that does _not_ overflow, for instance. + +### Caveats About the Verifier + +We rely on the `clang` compiler front-end to consume C source files +and produce LLVM intermediate language, which then becomes the input +to the later verification steps. To the extent that the input program +is not fully-portable C, `clang` may make implementation-specific +decisions about how to compile the program which might be made +different if compiled by a different compiler (e.g. `gcc`). We expect +this aspect to be mitigated by the fact that Copilot programs are +automatically generated into a rather simple subset of the C language, +and is designed to be as simple as possible. +Any code-generation bugs in `clang` itself may affect the soundness +of our verifier. Again, however, Copilot generates a well-understood +subset of the language, and we expect `clang` to be well-tested on +the code patterns produced. + +The semantics of LLVM bitcode, as encoded in the `crucible-llvm` +package, may have errors that affect soundness. We mitigate this risk +by testing our semantics against a corpus of verification problems +produced for the SV-COMP verification competition, paying special +attention to any soundness issues that arise. `Crux`, a standalone +verification system based on `crucible-llvm`, was a participant in the +2022 edition of SV-COMP. + +The semantics of Copilot programs, as encoded in the +`Copilot.Theorem.What4` module may have errors that affect soundness. +For the moment we do not have an effective mitigation strategy for +this risk other than manual examination and comparison against the +intended semantics of Copilot, as encoded in the interpreter. + +There is limited SMT solver support for floating-point values, +especially for transcendental functions like the trig primitives. As a +result, we reason about floating point expressions via uninterpreted +functions. In other words, we leave the semantics of the +floating-point operations totally abstract, and simply verify that the +Copilot program and the corresponding C program apply the same +operations in the same order. This is sound, but leaves the possibility +that the compiler will apply some correct transformation to +floating-point expressions that we are nonetheless unable to verify. +However, on low optimizations and without the `--fast-math` flag, +compilers generally (and `clang` in particular) are very reluctant to +rearrange floating-point code, and the verifications generally succeed. diff --git a/copilot-verifier/copilot-verifier.cabal b/copilot-verifier/copilot-verifier.cabal new file mode 100644 index 000000000..f7151dfeb --- /dev/null +++ b/copilot-verifier/copilot-verifier.cabal @@ -0,0 +1,152 @@ +Cabal-version: 2.2 +Name: copilot-verifier +Version: 4.4 +Author: Galois Inc. +Maintainer: rscott@galois.com +Copyright: (c) Galois, Inc 2021-2024 +License: BSD-3-Clause +License-file: LICENSE +Build-type: Simple +Category: Language +Synopsis: System for verifying the correctness of generated Copilot programs +Description: + @copilot-verifier@ is an add-on to the [Copilot Stream + DSL](https://copilot-language.github.io) for verifying the correctness of C + code generated by the @copilot-c99@ package. + . + @copilot-verifier@ uses the [Crucible symbolic + simulator](https://github.com/galoisinc/crucible) to interpret the semantics + of the generated C program and and to produce verification conditions + sufficient to guarantee that the meaning of the generated program corresponds + in a precise way to the meaning of the original stream specification. The + generated verification conditions are then dispatched to SMT solvers to be + automatically solved. +extra-doc-files: CHANGELOG, README.md + +source-repository head + type: git + location: https://github.com/GaloisInc/copilot-verifier + subdir: copilot-verifier + +common bldflags + ghc-options: -Wall + -Werror=incomplete-patterns + -Werror=missing-methods + -Werror=overlapping-patterns + -Wpartial-fields + -Wincomplete-uni-patterns + ghc-prof-options: -O2 -fprof-auto-exported + default-language: Haskell2010 + default-extensions: + NondecreasingIndentation + build-depends: + aeson >= 1.5 && < 2.3, + base >= 4.8 && < 4.20, + bv-sized >= 1.0.0 && < 1.1, + bytestring, + containers >= 0.5.9.0, + copilot-c99 >= 4.4 && < 4.5, + copilot-core >= 4.4 && < 4.5, + copilot-theorem >= 4.4 && < 4.5, + crucible >= 0.7.1 && < 0.8, + crucible-llvm >= 0.7 && < 0.8, + crux >= 0.7.1 && < 0.8, + crux-llvm >= 0.9 && < 0.10, + filepath, + lens, + llvm-pretty >= 0.12.1.0 && < 0.13, + mtl, + panic >= 0.3, + parameterized-utils >= 2.1.4 && < 2.2, + prettyprinter >= 1.7.0, + text, + transformers, + vector, + what4 >= 1.6.1 && < 1.7 + +library + import: bldflags + + hs-source-dirs: src + exposed-modules: + Copilot.Verifier + Copilot.Verifier.FloatMode + Copilot.Verifier.Log + Copilot.Verifier.Solver + +library copilot-verifier-examples + import: bldflags + + hs-source-dirs: examples + build-depends: + case-insensitive, + copilot >= 4.4 && < 4.5, + copilot-language >= 4.4 && < 4.5, + copilot-libraries >= 4.4 && < 4.5, + copilot-prettyprinter >= 4.4 && < 4.5, + copilot-verifier + exposed-modules: + Copilot.Verifier.Examples + + Copilot.Verifier.Examples.ShouldFail.Partial.AbsIntMin + Copilot.Verifier.Examples.ShouldFail.Partial.AddSignedWrap + Copilot.Verifier.Examples.ShouldFail.Partial.DivByZero + Copilot.Verifier.Examples.ShouldFail.Partial.IndexOutOfBounds + Copilot.Verifier.Examples.ShouldFail.Partial.ModByZero + Copilot.Verifier.Examples.ShouldFail.Partial.MulSignedWrap + Copilot.Verifier.Examples.ShouldFail.Partial.ShiftLTooLarge + Copilot.Verifier.Examples.ShouldFail.Partial.ShiftRTooLarge + Copilot.Verifier.Examples.ShouldFail.Partial.SubSignedWrap + + Copilot.Verifier.Examples.ShouldPass.Array + Copilot.Verifier.Examples.ShouldPass.ArrayGen + Copilot.Verifier.Examples.ShouldPass.ArrayOfStructs + Copilot.Verifier.Examples.ShouldPass.ArrayTriggerArgument + Copilot.Verifier.Examples.ShouldPass.Arith + Copilot.Verifier.Examples.ShouldPass.Clock + Copilot.Verifier.Examples.ShouldPass.Counter + Copilot.Verifier.Examples.ShouldPass.Engine + Copilot.Verifier.Examples.ShouldPass.FPNegation + Copilot.Verifier.Examples.ShouldPass.FPOps + Copilot.Verifier.Examples.ShouldPass.Heater + Copilot.Verifier.Examples.ShouldPass.IntOps + Copilot.Verifier.Examples.ShouldPass.Partial.AbsIntMin + Copilot.Verifier.Examples.ShouldPass.Partial.AddSignedWrap + Copilot.Verifier.Examples.ShouldPass.Partial.DivByZero + Copilot.Verifier.Examples.ShouldPass.Partial.IndexOutOfBounds + Copilot.Verifier.Examples.ShouldPass.Partial.ModByZero + Copilot.Verifier.Examples.ShouldPass.Partial.MulSignedWrap + Copilot.Verifier.Examples.ShouldPass.Partial.ShiftLTooLarge + Copilot.Verifier.Examples.ShouldPass.Partial.ShiftRTooLarge + Copilot.Verifier.Examples.ShouldPass.Partial.SubSignedWrap + Copilot.Verifier.Examples.ShouldPass.Structs + Copilot.Verifier.Examples.ShouldPass.UpdateArray + Copilot.Verifier.Examples.ShouldPass.UpdateStruct + Copilot.Verifier.Examples.ShouldPass.Voting + Copilot.Verifier.Examples.ShouldPass.WCV + +executable verify-examples + import: bldflags + + hs-source-dirs: exe + main-is: VerifyExamples.hs + build-depends: + case-insensitive, + copilot-verifier, + copilot-verifier-examples, + optparse-applicative + +test-suite copilot-verifier-test + import: bldflags + + type: exitcode-stdio-1.0 + hs-source-dirs: test + build-depends: + case-insensitive, + copilot-verifier, + copilot-verifier-examples, + silently >= 1.2, + tasty >= 0.10, + tasty-expected-failure >= 0.12, + tasty-hunit >= 0.10 + main-is: Test.hs diff --git a/copilot-verifier/examples/Copilot/Verifier/Examples.hs b/copilot-verifier/examples/Copilot/Verifier/Examples.hs new file mode 100644 index 000000000..7e593a7e9 --- /dev/null +++ b/copilot-verifier/examples/Copilot/Verifier/Examples.hs @@ -0,0 +1,97 @@ +{-# LANGUAGE OverloadedStrings #-} +module Copilot.Verifier.Examples + ( shouldFailExamples + , shouldPassExamples + ) where + +import qualified Data.CaseInsensitive as CI +import Data.CaseInsensitive (CI) +import qualified Data.Map as Map +import Data.Map (Map) +import Data.Text (Text) + +import Copilot.Verifier (Verbosity) +import qualified Copilot.Verifier.Examples.ShouldFail.Partial.AbsIntMin as Fail.AbsIntMin +import qualified Copilot.Verifier.Examples.ShouldFail.Partial.AddSignedWrap as Fail.AddSignedWrap +import qualified Copilot.Verifier.Examples.ShouldFail.Partial.DivByZero as Fail.DivByZero +import qualified Copilot.Verifier.Examples.ShouldFail.Partial.IndexOutOfBounds as Fail.IndexOutOfBounds +import qualified Copilot.Verifier.Examples.ShouldFail.Partial.ModByZero as Fail.ModByZero +import qualified Copilot.Verifier.Examples.ShouldFail.Partial.MulSignedWrap as Fail.MulSignedWrap +import qualified Copilot.Verifier.Examples.ShouldFail.Partial.ShiftLTooLarge as Fail.ShiftLTooLarge +import qualified Copilot.Verifier.Examples.ShouldFail.Partial.ShiftRTooLarge as Fail.ShiftRTooLarge +import qualified Copilot.Verifier.Examples.ShouldFail.Partial.SubSignedWrap as Fail.SubSignedWrap +import qualified Copilot.Verifier.Examples.ShouldPass.Array as Array +import qualified Copilot.Verifier.Examples.ShouldPass.ArrayGen as ArrayGen +import qualified Copilot.Verifier.Examples.ShouldPass.ArrayOfStructs as ArrayOfStructs +import qualified Copilot.Verifier.Examples.ShouldPass.ArrayTriggerArgument as ArrayTriggerArgument +import qualified Copilot.Verifier.Examples.ShouldPass.Arith as Arith +import qualified Copilot.Verifier.Examples.ShouldPass.Clock as Clock +import qualified Copilot.Verifier.Examples.ShouldPass.Counter as Counter +import qualified Copilot.Verifier.Examples.ShouldPass.Engine as Engine +import qualified Copilot.Verifier.Examples.ShouldPass.FPNegation as FPNegation +import qualified Copilot.Verifier.Examples.ShouldPass.FPOps as FPOps +import qualified Copilot.Verifier.Examples.ShouldPass.Heater as Heater +import qualified Copilot.Verifier.Examples.ShouldPass.IntOps as IntOps +import qualified Copilot.Verifier.Examples.ShouldPass.Partial.AbsIntMin as Pass.AbsIntMin +import qualified Copilot.Verifier.Examples.ShouldPass.Partial.AddSignedWrap as Pass.AddSignedWrap +import qualified Copilot.Verifier.Examples.ShouldPass.Partial.IndexOutOfBounds as Pass.IndexOutOfBounds +import qualified Copilot.Verifier.Examples.ShouldPass.Partial.DivByZero as Pass.DivByZero +import qualified Copilot.Verifier.Examples.ShouldPass.Partial.ModByZero as Pass.ModByZero +import qualified Copilot.Verifier.Examples.ShouldPass.Partial.MulSignedWrap as Pass.MulSignedWrap +import qualified Copilot.Verifier.Examples.ShouldPass.Partial.ShiftLTooLarge as Pass.ShiftLTooLarge +import qualified Copilot.Verifier.Examples.ShouldPass.Partial.ShiftRTooLarge as Pass.ShiftRTooLarge +import qualified Copilot.Verifier.Examples.ShouldPass.Partial.SubSignedWrap as Pass.SubSignedWrap +import qualified Copilot.Verifier.Examples.ShouldPass.Structs as Structs +import qualified Copilot.Verifier.Examples.ShouldPass.UpdateArray as UpdateArray +import qualified Copilot.Verifier.Examples.ShouldPass.UpdateStruct as UpdateStruct +import qualified Copilot.Verifier.Examples.ShouldPass.Voting as Voting +import qualified Copilot.Verifier.Examples.ShouldPass.WCV as WCV + +shouldFailExamples :: Verbosity -> Map (CI Text) (IO ()) +shouldFailExamples verb = Map.fromList + [ -- Partial operation tests + example "AbsIntMin-fail" (Fail.AbsIntMin.verifySpec verb) + , example "AddSignedWrap-fail" (Fail.AddSignedWrap.verifySpec verb) + , example "DivByZero-fail" (Fail.DivByZero.verifySpec verb) + , example "IndexOutOfBounds-fail" (Fail.IndexOutOfBounds.verifySpec verb) + , example "ModByZero-fail" (Fail.ModByZero.verifySpec verb) + , example "MulSignedWrap-fail" (Fail.MulSignedWrap.verifySpec verb) + , example "ShiftLTooLarge-fail" (Fail.ShiftLTooLarge.verifySpec verb) + , example "ShiftRTooLarge-fail" (Fail.ShiftRTooLarge.verifySpec verb) + , example "SubSignedWrap-fail" (Fail.SubSignedWrap.verifySpec verb) + ] + +shouldPassExamples :: Verbosity -> Map (CI Text) (IO ()) +shouldPassExamples verb = Map.fromList + [ example "Array" (Array.verifySpec verb) + , example "ArrayGen" (ArrayGen.verifySpec verb) + , example "ArrayOfStructs" (ArrayOfStructs.verifySpec verb) + , example "ArrayTriggerArgument" (ArrayTriggerArgument.verifySpec verb) + , example "Arith" (Arith.verifySpec verb) + , example "Clock" (Clock.verifySpec verb) + , example "Counter" (Counter.verifySpec verb) + , example "Engine" (Engine.verifySpec verb) + , example "FPNegation" (FPNegation.verifySpec verb) + , example "FPOps" (FPOps.verifySpec verb) + , example "Heater" (Heater.verifySpec verb) + , example "IntOps" (IntOps.verifySpec verb) + , example "Structs" (Structs.verifySpec verb) + , example "UpdateArray" (UpdateArray.verifySpec verb) + , example "UpdateStruct" (UpdateStruct.verifySpec verb) + , example "Voting" (Voting.verifySpec verb) + , example "WCV" (WCV.verifySpec verb) + + -- Partial operation tests + , example "AbsIntMin-pass" (Pass.AbsIntMin.verifySpec verb) + , example "AddSignedWrap-pass" (Pass.AddSignedWrap.verifySpec verb) + , example "DivByZero-pass" (Pass.DivByZero.verifySpec verb) + , example "IndexOutOfBounds-pass" (Pass.IndexOutOfBounds.verifySpec verb) + , example "ModByZero-pass" (Pass.ModByZero.verifySpec verb) + , example "MulSignedWrap-pass" (Pass.MulSignedWrap.verifySpec verb) + , example "ShiftLTooLarge-pass" (Pass.ShiftLTooLarge.verifySpec verb) + , example "ShiftRTooLarge-pass" (Pass.ShiftRTooLarge.verifySpec verb) + , example "SubSignedWrap-pass" (Pass.SubSignedWrap.verifySpec verb) + ] + +example :: Text -> IO () -> (CI Text, IO ()) +example name action = (CI.mk name, action) diff --git a/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldFail/Partial/AbsIntMin.hs b/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldFail/Partial/AbsIntMin.hs new file mode 100644 index 000000000..70147e5a4 --- /dev/null +++ b/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldFail/Partial/AbsIntMin.hs @@ -0,0 +1,28 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +-- | This will fail to verify since the verification does not assume the +-- @notIntMin@ property, which is needed to prevent undefined behavior when +-- invoking the 'abs' function. +module Copilot.Verifier.Examples.ShouldFail.Partial.AbsIntMin where + +import Language.Copilot +import Copilot.Compile.C99 +import Copilot.Verifier ( Verbosity, VerifierOptions(..) + , defaultVerifierOptions, verifyWithOptions ) + +spec :: Spec +spec = do + let stream :: Stream Int32 + stream = extern "stream" Nothing + + _ <- prop "notIntMin" (forAll (stream > constI32 minBound)) + trigger "streamAbs" (abs stream == 1) [arg stream] + +verifySpec :: Verbosity -> IO () +verifySpec verb = do + spec' <- reify spec + verifyWithOptions defaultVerifierOptions{verbosity = verb} + mkDefaultCSettings + -- ["notIntMin"] + [] + "absIntMinFail" spec' diff --git a/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldFail/Partial/AddSignedWrap.hs b/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldFail/Partial/AddSignedWrap.hs new file mode 100644 index 000000000..5ae869641 --- /dev/null +++ b/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldFail/Partial/AddSignedWrap.hs @@ -0,0 +1,27 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +-- | This will fail to verify since the verification does not assume the +-- @notIntMax@ property, which is needed to prevent signed integer overflow. +module Copilot.Verifier.Examples.ShouldFail.Partial.AddSignedWrap where + +import Language.Copilot +import Copilot.Compile.C99 +import Copilot.Verifier ( Verbosity, VerifierOptions(..) + , defaultVerifierOptions, verifyWithOptions ) + +spec :: Spec +spec = do + let stream :: Stream Int32 + stream = extern "stream" Nothing + + _ <- prop "notIntMax" (forAll (stream < constI32 maxBound)) + trigger "streamAddSigned" ((stream + 1) == 1) [arg stream] + +verifySpec :: Verbosity -> IO () +verifySpec verb = do + spec' <- reify spec + verifyWithOptions defaultVerifierOptions{verbosity = verb} + mkDefaultCSettings + -- ["notIntMax"] + [] + "addSignedWrapFail" spec' diff --git a/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldFail/Partial/DivByZero.hs b/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldFail/Partial/DivByZero.hs new file mode 100644 index 000000000..53786931a --- /dev/null +++ b/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldFail/Partial/DivByZero.hs @@ -0,0 +1,27 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +-- | This will fail to verify since the verification does not assume the +-- @nonzero@ property, which is needed to prevent a division-by-zero error. +module Copilot.Verifier.Examples.ShouldFail.Partial.DivByZero where + +import Language.Copilot +import Copilot.Compile.C99 +import Copilot.Verifier ( Verbosity, VerifierOptions(..) + , defaultVerifierOptions, verifyWithOptions ) + +spec :: Spec +spec = do + let stream :: Stream Int16 + stream = extern "stream" Nothing + + _ <- prop "nonzero" (forAll (stream /= 0)) + trigger "streamDiv" ((stream `div` stream) == 1) [arg stream] + +verifySpec :: Verbosity -> IO () +verifySpec verb = do + spec' <- reify spec + verifyWithOptions defaultVerifierOptions{verbosity = verb} + mkDefaultCSettings + -- ["nonzero"] + [] + "divByZeroFail" spec' diff --git a/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldFail/Partial/IndexOutOfBounds.hs b/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldFail/Partial/IndexOutOfBounds.hs new file mode 100644 index 000000000..93f3812af --- /dev/null +++ b/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldFail/Partial/IndexOutOfBounds.hs @@ -0,0 +1,31 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE NoImplicitPrelude #-} + +-- | This will fail to verify since the verification does not assume the +-- @withinBounds@ property, which is needed to prevent an out-of-bounds array index. +module Copilot.Verifier.Examples.ShouldFail.Partial.IndexOutOfBounds where + +import Language.Copilot +import Copilot.Compile.C99 +import Copilot.Verifier ( Verbosity, VerifierOptions(..) + , defaultVerifierOptions, verifyWithOptions ) + +spec :: Spec +spec = do + let stream1 :: Stream (Array 2 Int16) + stream1 = constant (array [27, 42]) + + stream2 :: Stream Word32 + stream2 = extern "stream2" Nothing + + _ <- prop "withinBounds" (forAll (stream2 < constW32 2)) + trigger "streamIndex" ((stream1 ! stream2) == 1) [arg stream1, arg stream2] + +verifySpec :: Verbosity -> IO () +verifySpec verb = do + spec' <- reify spec + verifyWithOptions defaultVerifierOptions{verbosity = verb} + mkDefaultCSettings + -- ["withinBounds"] + [] + "indexFail" spec' diff --git a/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldFail/Partial/ModByZero.hs b/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldFail/Partial/ModByZero.hs new file mode 100644 index 000000000..c42f16c4e --- /dev/null +++ b/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldFail/Partial/ModByZero.hs @@ -0,0 +1,27 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +-- | This will fail to verify since the verification does not assume the +-- @nonzero@ property, which is needed to prevent a division-by-zero error. +module Copilot.Verifier.Examples.ShouldFail.Partial.ModByZero where + +import Language.Copilot +import Copilot.Compile.C99 +import Copilot.Verifier ( Verbosity, VerifierOptions(..) + , defaultVerifierOptions, verifyWithOptions ) + +spec :: Spec +spec = do + let stream :: Stream Int16 + stream = extern "stream" Nothing + + _ <- prop "nonzero" (forAll (stream /= 0)) + trigger "streamMod" ((stream `mod` stream) == 1) [arg stream] + +verifySpec :: Verbosity -> IO () +verifySpec verb = do + spec' <- reify spec + verifyWithOptions defaultVerifierOptions{verbosity = verb} + mkDefaultCSettings + -- ["nonzero"] + [] + "modByZeroFail" spec' diff --git a/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldFail/Partial/MulSignedWrap.hs b/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldFail/Partial/MulSignedWrap.hs new file mode 100644 index 000000000..41f746b34 --- /dev/null +++ b/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldFail/Partial/MulSignedWrap.hs @@ -0,0 +1,31 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +-- | This will fail to verify since the verification does not assume the +-- @withinRange@ property, which is needed to prevent signed integer underflow or overflow. +module Copilot.Verifier.Examples.ShouldFail.Partial.MulSignedWrap where + +import qualified Prelude as P + +import Language.Copilot +import Copilot.Compile.C99 +import Copilot.Verifier ( Verbosity, VerifierOptions(..) + , defaultVerifierOptions, verifyWithOptions ) + +spec :: Spec +spec = do + let stream :: Stream Int32 + stream = extern "stream" Nothing + + _ <- prop "withinRange" (forAll + (constI32 ((minBound P.+ 1) P.* 2) < stream + && stream < constI32 ((maxBound P.- 1) `P.div` 2))) + trigger "streamMulSigned" ((stream * 2) == 2) [arg stream] + +verifySpec :: Verbosity -> IO () +verifySpec verb = do + spec' <- reify spec + verifyWithOptions defaultVerifierOptions{verbosity = verb} + mkDefaultCSettings + -- ["withinRange"] + [] + "mulSignedWrapFail" spec' diff --git a/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldFail/Partial/ShiftLTooLarge.hs b/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldFail/Partial/ShiftLTooLarge.hs new file mode 100644 index 000000000..dbdcd8b0f --- /dev/null +++ b/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldFail/Partial/ShiftLTooLarge.hs @@ -0,0 +1,32 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +-- | This will fail to verify since the verification does not assume the +-- @lessThanBitWidth@ property, which is needed to prevent shifting by too +-- large of a value. +module Copilot.Verifier.Examples.ShouldFail.Partial.ShiftLTooLarge where + +import Language.Copilot +import Copilot.Compile.C99 +import Copilot.Verifier ( Verbosity, VerifierOptions(..) + , defaultVerifierOptions, verifyWithOptions ) + +spec :: Spec +spec = do + let stream1 :: Stream Int32 + stream1 = extern "stream1" Nothing + + stream2 :: Stream Int64 + stream2 = extern "stream2" Nothing + + _ <- prop "lessThanBitWidth" (forAll + (constI64 0 <= stream2 && stream2 < constI64 32)) + trigger "streamShiftL" ((stream1 .<<. stream2) == 1) [arg stream1, arg stream2] + +verifySpec :: Verbosity -> IO () +verifySpec verb = do + spec' <- reify spec + verifyWithOptions defaultVerifierOptions{verbosity = verb} + mkDefaultCSettings + -- ["lessThanBitWidth"] + [] + "shiftLTooLargeFail" spec' diff --git a/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldFail/Partial/ShiftRTooLarge.hs b/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldFail/Partial/ShiftRTooLarge.hs new file mode 100644 index 000000000..12fe7c1f1 --- /dev/null +++ b/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldFail/Partial/ShiftRTooLarge.hs @@ -0,0 +1,32 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +-- | This will fail to verify since the verification does not assume the +-- @lessThanBitWidth@ property, which is needed to prevent shifting by too +-- large of a value. +module Copilot.Verifier.Examples.ShouldFail.Partial.ShiftRTooLarge where + +import Language.Copilot +import Copilot.Compile.C99 +import Copilot.Verifier ( Verbosity, VerifierOptions(..) + , defaultVerifierOptions, verifyWithOptions ) + +spec :: Spec +spec = do + let stream1 :: Stream Int32 + stream1 = extern "stream1" Nothing + + stream2 :: Stream Int64 + stream2 = extern "stream2" Nothing + + _ <- prop "lessThanBitWidth" (forAll + (constI64 0 <= stream2 && stream2 < constI64 32)) + trigger "streamShiftR" ((stream1 .<<. stream2) == 1) [arg stream1, arg stream2] + +verifySpec :: Verbosity -> IO () +verifySpec verb = do + spec' <- reify spec + verifyWithOptions defaultVerifierOptions{verbosity = verb} + mkDefaultCSettings + -- ["lessThanBitWidth"] + [] + "shiftRTooLargeFail" spec' diff --git a/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldFail/Partial/SubSignedWrap.hs b/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldFail/Partial/SubSignedWrap.hs new file mode 100644 index 000000000..5503b1743 --- /dev/null +++ b/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldFail/Partial/SubSignedWrap.hs @@ -0,0 +1,27 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +-- | This will fail to verify since the verification does not assume the +-- @notIntMin@ property, which is needed to prevent signed integer underflow. +module Copilot.Verifier.Examples.ShouldFail.Partial.SubSignedWrap where + +import Language.Copilot +import Copilot.Compile.C99 +import Copilot.Verifier ( Verbosity, VerifierOptions(..) + , defaultVerifierOptions, verifyWithOptions ) + +spec :: Spec +spec = do + let stream :: Stream Int32 + stream = extern "stream" Nothing + + _ <- prop "notIntMin" (forAll (stream > constI32 minBound)) + trigger "streamSubSigned" ((stream - 1) == 1) [arg stream] + +verifySpec :: Verbosity -> IO () +verifySpec verb = do + spec' <- reify spec + verifyWithOptions defaultVerifierOptions{verbosity = verb} + mkDefaultCSettings + -- ["notIntMin"] + [] + "subSignedWrapFail" spec' diff --git a/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/Arith.hs b/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/Arith.hs new file mode 100644 index 000000000..58b75fb92 --- /dev/null +++ b/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/Arith.hs @@ -0,0 +1,52 @@ + +{-# LANGUAGE RebindableSyntax #-} + +module Copilot.Verifier.Examples.ShouldPass.Arith where + +import Control.Monad (when) +import qualified Prelude as P + +import Language.Copilot +import Copilot.Compile.C99 +import Copilot.Verifier ( Verbosity(..), VerifierOptions(..) + , defaultVerifierOptions, verifyWithOptions ) +import Copilot.Theorem.What4 (prove, Solver(..)) + +-- The largest unsigned 32-bit prime +lastPrime :: Stream Word32 +lastPrime = 31 +--lastPrime = 4294967291 -- Whelp, this prime seems too big for the solvers to handle well + +multRingSpec :: Spec +multRingSpec = do + _ <- prop "clamp nonzero" (forAll ((clamp > 0) && (clamp < lastPrime))) + _ <- prop "reduced" (forAll (acc < lastPrime)) + _ <- prop "nonzero" (forAll (acc > 0 && (acc < lastPrime))) + + trigger "outofrange" (not (acc > 0 && acc < lastPrime)) [arg acc] + + return () + + where + -- a stream of external values + vals = externW32 "values" Nothing + + -- Generate a value in [1, lastPrime), which + -- is the multiplictive group of Z_p + clamp :: Stream Word32 + clamp = (vals `mod` (lastPrime - 1)) + 1 + + -- Successively multiply new values + acc :: Stream Word32 + acc = [1] ++ unsafeCast ((cast acc * cast clamp) `mod` (cast lastPrime :: Stream Word64)) + +verifySpec :: Verbosity -> IO () +verifySpec verb = + do s <- reify multRingSpec + r <- prove Z3 s + when (verb P.>= Default) $ + print r + verifyWithOptions defaultVerifierOptions{verbosity = verb} + mkDefaultCSettings ["reduced"] "multRingSpec" s + +--verifySpec _ = interpret 10 engineMonitor diff --git a/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/Array.hs b/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/Array.hs new file mode 100644 index 000000000..365d54c4b --- /dev/null +++ b/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/Array.hs @@ -0,0 +1,40 @@ +-------------------------------------------------------------------------------- +-- Copyright © 2019 National Institute of Aerospace / Galois, Inc. +-------------------------------------------------------------------------------- + +-- | This is a simple example for arrays. As a program, it does not make much +-- sense, however it shows of the features of arrays nicely. + +-- | Enable compiler extension for type-level data, necesary for the array +-- length. + +{-# LANGUAGE RebindableSyntax #-} +{-# LANGUAGE DataKinds #-} + +module Copilot.Verifier.Examples.ShouldPass.Array where + +import Language.Copilot +import Copilot.Compile.C99 +import Copilot.Verifier ( Verbosity, VerifierOptions(..) + , defaultVerifierOptions, verifyWithOptions ) + +-- Lets define an array of length 2. +-- Make the buffer of the streams 3 elements long. +arr :: Stream (Array 2 Bool) +arr = [ array [True, False] + , array [True, True] + , array [False, False]] ++ arr + +spec :: Spec +spec = do + -- A trigger that fires 'func' when the first element of 'arr' is True. + -- It passes the current value of arr as an argument. + -- The prototype of 'func' would be: + -- void func (int8_t arg[3]); + trigger "func" (arr ! 0) [arg arr] + +-- Compile the spec +verifySpec :: Verbosity -> IO () +verifySpec verb = reify spec >>= verifyWithOptions defaultVerifierOptions{verbosity = verb} + mkDefaultCSettings [] "array" +-- verifySpec _ = interpret 30 spec diff --git a/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/ArrayGen.hs b/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/ArrayGen.hs new file mode 100644 index 000000000..115c753cb --- /dev/null +++ b/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/ArrayGen.hs @@ -0,0 +1,21 @@ +{-# LANGUAGE DataKinds #-} +module Copilot.Verifier.Examples.ShouldPass.ArrayGen where + +import Copilot.Compile.C99 +import Copilot.Verifier ( Verbosity, VerifierOptions(..) + , defaultVerifierOptions, verifyWithOptions ) +import Language.Copilot +import qualified Prelude hiding ((++), (>)) + +spec :: Spec +spec = trigger "f" (stream ! 0 > 0) [arg stream] + where + stream :: Stream (Array 2 Int16) + stream = [array [3,4]] ++ rest + + rest :: Stream (Array 2 Int16) + rest = constant $ array [5,6] + +verifySpec :: Verbosity -> IO () +verifySpec verb = reify spec >>= verifyWithOptions defaultVerifierOptions{verbosity = verb} + mkDefaultCSettings [] "arrayGen" diff --git a/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/ArrayOfStructs.hs b/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/ArrayOfStructs.hs new file mode 100644 index 000000000..b983531f0 --- /dev/null +++ b/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/ArrayOfStructs.hs @@ -0,0 +1,29 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE NoImplicitPrelude #-} +module Copilot.Verifier.Examples.ShouldPass.ArrayOfStructs where + +import Copilot.Compile.C99 +import Copilot.Verifier ( Verbosity, VerifierOptions(..) + , defaultVerifierOptions, verifyWithOptions ) +import Language.Copilot + +data S = S { field :: Field "field" Int16 } + +instance Struct S where + typeName _ = "s" + toValues s = [Value Int16 (field s)] + +instance Typed S where + typeOf = Struct (S (Field 0)) + +spec :: Spec +spec = trigger "f" ((stream ! 0)#field == 27) [arg stream] + where + stream :: Stream (Array 2 S) + stream = [array [S (Field 27), S (Field 42)]] ++ stream + +verifySpec :: Verbosity -> IO () +verifySpec verb = do + spec' <- reify spec + verifyWithOptions defaultVerifierOptions{verbosity = verb} + mkDefaultCSettings [] "arrayOfStructs" spec' diff --git a/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/ArrayTriggerArgument.hs b/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/ArrayTriggerArgument.hs new file mode 100644 index 000000000..5c06b626a --- /dev/null +++ b/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/ArrayTriggerArgument.hs @@ -0,0 +1,23 @@ +{-# LANGUAGE DataKinds #-} + +-- | A regression test for +-- . +module Copilot.Verifier.Examples.ShouldPass.ArrayTriggerArgument where + +import Language.Copilot +import Copilot.Compile.C99 +import Copilot.Verifier ( Verbosity, VerifierOptions(..) + , defaultVerifierOptions, verifyWithOptions ) + +spec :: Spec +spec = trigger "f" true [arg stream] + where + stream :: Stream (Array 2 Int16) + stream = constant (array [3,4]) + +verifySpec :: Verbosity -> IO () +verifySpec verb = do + spec' <- reify spec + verifyWithOptions + defaultVerifierOptions{verbosity = verb} + mkDefaultCSettings [] "arrayTriggerArgument" spec' diff --git a/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/Clock.hs b/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/Clock.hs new file mode 100644 index 000000000..7f9d8d303 --- /dev/null +++ b/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/Clock.hs @@ -0,0 +1,46 @@ +-------------------------------------------------------------------------------- +-- Copyright © 2019 National Institute of Aerospace / Galois, Inc. +-------------------------------------------------------------------------------- + +-- | Example showing usage of clocks to generate periodically recurring truth +-- values. + +module Copilot.Verifier.Examples.ShouldPass.Clock where + +import Control.Monad (when) +import qualified Prelude as P + +import Language.Copilot +import Copilot.Compile.C99 +import Copilot.Verifier ( Verbosity(..), VerifierOptions(..) + , defaultVerifierOptions, verifyWithOptions ) +import Copilot.Theorem.What4 (prove, Solver(..)) + +-- | We need to force a type for the argument of `period`. +p :: Word8 +p = 5 + +-- | Both have the same period, but a different phase. +clkStream :: Stream Bool +clkStream = clk (period p) (phase 0) + +clkStream' :: Stream Bool +clkStream' = clk (period p) (phase 2) + +spec :: Spec +spec = do + observer "clk" clkStream + observer "clk'" clkStream' + _ <- prop "clksPhase" (forAll (clkStream == drop 2 clkStream')) + _ <- prop "clksDistinct" (forAll (not (clkStream && clkStream'))) + trigger "clksHigh" (clkStream && clkStream') [] + + +verifySpec :: Verbosity -> IO () +verifySpec verb = + do s <- reify spec + r <- prove Z3 s + when (verb P.>= Default) $ + print r + verifyWithOptions defaultVerifierOptions{verbosity = verb} + mkDefaultCSettings [] "clock" s diff --git a/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/Counter.hs b/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/Counter.hs new file mode 100644 index 000000000..708ea662f --- /dev/null +++ b/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/Counter.hs @@ -0,0 +1,56 @@ +------------------------------------------------------------------------------- +-- Copyright © 2019 National Institute of Aerospace / Galois, Inc. +-------------------------------------------------------------------------------- + +-- | Example showing an implementation of a resettable counter. + +{-# LANGUAGE RebindableSyntax #-} + +module Copilot.Verifier.Examples.ShouldPass.Counter where + +import Control.Monad (when) +import qualified Prelude as P + +import Language.Copilot +import Copilot.Compile.C99 +import Copilot.Verifier ( Verbosity(..), VerifierOptions(..) + , defaultVerifierOptions, verifyWithOptions ) +import Copilot.Theorem.What4 (prove, Solver(..)) + +-- A resettable counter +counter :: (Typed a, Integral a) => Stream Bool -> Stream Bool -> Stream a +counter inc reset = cnt + where + cnt = if reset then 0 + else if inc then z + 1 + else z + z = [0] ++ cnt + +-- Counter that resets when it reaches 256 +bytecounter :: Stream Int32 +bytecounter = counter true (resetcounter `mod` 256 == 0) + +resetcounter :: Stream Word32 +resetcounter = counter true false + +bytecounter2 :: Stream Int32 +bytecounter2 = counter true ([False] ++ bytecounter2 == 255) + +spec :: Spec +spec = + do _ <- prop "range" (forAll (bytecounter == unsafeCast (resetcounter `mod` 256))) + _ <- prop "range2" (forAll (0 <= bytecounter2 && bytecounter2 <= 255)) + _ <- prop "same" (forAll ((0 <= bytecounter2 && bytecounter2 <= 255) && + (bytecounter == unsafeCast (resetcounter `mod` 256)) && + (bytecounter == bytecounter2))) + trigger "counter" true [arg $ bytecounter, arg $ bytecounter2] + +verifySpec :: Verbosity -> IO () +-- verifSpec _ = interpret 1280 spec +verifySpec verb = + do s <- reify spec + r <- prove Z3 s + when (verb P.>= Default) $ + print r + verifyWithOptions defaultVerifierOptions{verbosity = verb} + mkDefaultCSettings ["range", "range2"] "counter" s diff --git a/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/Engine.hs b/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/Engine.hs new file mode 100644 index 000000000..74e7509ee --- /dev/null +++ b/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/Engine.hs @@ -0,0 +1,44 @@ +-------------------------------------------------------------------------------- +-- Copyright © 2011 National Institute of Aerospace / Galois, Inc. +-------------------------------------------------------------------------------- + +-- | Example implementing an engine cooling control system. + +{-# LANGUAGE RebindableSyntax #-} + +module Copilot.Verifier.Examples.ShouldPass.Engine where + +import Language.Copilot +import Copilot.Compile.C99 +import Copilot.Verifier ( Verbosity, VerifierOptions(..) + , defaultVerifierOptions, verifyWithOptions ) + +import qualified Prelude as P + +{- If the majority of the engine temperature probes exeeds 250 degrees, then + - the cooler is engaged and remains engaged until the majority of the engine + - temperature probes drop to 250 or below. Otherwise, trigger an immediate + - shutdown of the engine. +-} + +engineMonitor :: Spec +engineMonitor = do + trigger "shutoff" (not ok) [arg maj] + + where + vals = [ externW8 "tmp_probe_0" two51 + , externW8 "tmp_probe_1" two51 + , externW8 "tmp_probe_2" zero] + exceed = map (> 250) vals + maj = majority exceed + checkMaj = aMajority exceed maj + ok = alwaysBeen ((maj && checkMaj) ==> extern "cooler" cooler) + + two51 = Just $ [251, 251] P.++ repeat (250 :: Word8) + zero = Just $ repeat (0 :: Word8) + cooler = Just $ [True, True] P.++ repeat False + +verifySpec :: Verbosity -> IO () +verifySpec verb = reify engineMonitor >>= verifyWithOptions defaultVerifierOptions{verbosity = verb} + mkDefaultCSettings [] "engine" +--verifySpec _ = interpret 10 engineMonitor diff --git a/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/FPNegation.hs b/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/FPNegation.hs new file mode 100644 index 000000000..5078d0775 --- /dev/null +++ b/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/FPNegation.hs @@ -0,0 +1,62 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +-- | This will not succeed when 'smtFloatMode' is 'FloatUninterpreted', as Clang +-- will turn @input /= 30.0@ below into a more complicated expression that also +-- checks if @30.0@ is NaN or not. This is logically equivalent to the original +-- specification, but an SMT solver cannot conclude this when all of the +-- floating-point operations involved are treated as uninterpreted functions. +-- +-- To make this work, we set 'smtFloatMode' to 'FloatIEEE' instead. This works +-- because all of the floating-point operations in the specification below are +-- native to SMT-LIB. +module Copilot.Verifier.Examples.ShouldPass.FPNegation where + +import Copilot.Compile.C99 (mkDefaultCSettings) +import Copilot.Verifier ( Verbosity, VerifierOptions(..) + , defaultVerifierOptions, verifyWithOptions ) +import Copilot.Verifier.FloatMode (FloatMode(..)) +import qualified Copilot.Library.PTLTL as PTLTL +import Language.Copilot + +input :: Stream Float +input = extern "input" Nothing + +-- | MyProperty +-- @ +-- Input is never 30.0 +-- @ +propMyProperty :: Stream Bool +propMyProperty = PTLTL.alwaysBeen (input /= 30.0) + +-- | Clock that increases in one-unit steps. +clock :: Stream Int64 +clock = [0] ++ (clock + 1) + +-- | First Time Point +ftp :: Stream Bool +ftp = [True] ++ false + +pre :: Stream Bool -> Stream Bool +pre = ([False] ++) + +tpre :: Stream Bool -> Stream Bool +tpre = ([True] ++) + +notPreviousNot :: Stream Bool -> Stream Bool +notPreviousNot = not . PTLTL.previous . not + +-- | Complete specification. Calls C handler functions when properties are +-- violated. +spec :: Spec +spec = do + trigger "handlerMyProperty" (not propMyProperty) [] + +verifySpec :: Verbosity -> IO () +verifySpec verb = do + spec' <- reify spec + verifyWithOptions + (defaultVerifierOptions + { verbosity = verb + , smtFloatMode = FloatIEEE + }) + mkDefaultCSettings [] "fpNegation" spec' diff --git a/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/FPOps.hs b/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/FPOps.hs new file mode 100644 index 000000000..02bd0130a --- /dev/null +++ b/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/FPOps.hs @@ -0,0 +1,88 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +module Copilot.Verifier.Examples.ShouldPass.FPOps where + +import Copilot.Compile.C99 (mkDefaultCSettings) +import qualified Copilot.Language.Stream as Copilot +import Copilot.Verifier ( Verbosity, VerifierOptions(..) + , defaultVerifierOptions, verifyWithOptions ) +import Data.Proxy (Proxy(..)) +import Language.Copilot +import qualified Prelude as P + +mkSpecFor :: forall a proxy. (RealFloat a, Typed a) => proxy a -> String -> Spec +mkSpecFor _ nameSuffix = do + let mkName :: String -> String + mkName namePrefix = namePrefix P.++ nameSuffix + + stream :: Stream a + stream = extern (mkName "stream") Nothing + + triggerOp1 (mkName "abs") abs stream + triggerOp1 (mkName "signum") signum stream + triggerOp1 (mkName "recip") recip stream + triggerOp1 (mkName "exp") exp stream + triggerOp1 (mkName "sqrt") sqrt stream + triggerOp1 (mkName "log") log stream + triggerOp1 (mkName "sin") sin stream + triggerOp1 (mkName "tan") tan stream + triggerOp1 (mkName "cos") cos stream + triggerOp1 (mkName "asin") asin stream + triggerOp1 (mkName "atan") atan stream + triggerOp1 (mkName "acos") acos stream + triggerOp1 (mkName "sinh") sinh stream + triggerOp1 (mkName "tanh") tanh stream + triggerOp1 (mkName "cosh") cosh stream + triggerOp1 (mkName "asinh") asinh stream + triggerOp1 (mkName "atanh") atanh stream + triggerOp1 (mkName "acosh") acosh stream + triggerOp1 (mkName "ceiling") Copilot.ceiling stream + triggerOp1 (mkName "floor") Copilot.floor stream + + triggerOp2 (mkName "add") (+) stream + triggerOp2 (mkName "sub") (-) stream + triggerOp2 (mkName "mul") (*) stream + triggerOp2 (mkName "div") (/) stream + triggerOp2 (mkName "pow") (**) stream + triggerOp2 (mkName "logBase") logBase stream + triggerOp2 (mkName "atan2") Copilot.atan2 stream + +spec :: Spec +spec = do + mkSpecFor (Proxy @Float) "F" + mkSpecFor (Proxy @Double) "D" + +triggerOp1 :: (RealFloat a, Typed a) => + String -> + (Stream a -> Stream a) -> + Stream a -> + Spec +triggerOp1 name op stream = + trigger (name P.++ "Trigger") (testOp1 op stream) [arg stream] + +triggerOp2 :: (RealFloat a, Typed a) => + String -> + (Stream a -> Stream a -> Stream a) -> + Stream a -> + Spec +triggerOp2 name op stream = + trigger (name P.++ "Trigger") (testOp2 op stream) [arg stream] + +testOp1 :: (RealFloat a, Typed a) => + (Stream a -> Stream a) -> Stream a -> Stream Bool +testOp1 op stream = + -- NB: Use (>=) rather than (==) here, as floating-point equality gets weird + -- due to NaNs. + op stream >= op stream + +testOp2 :: (RealFloat a, Typed a) => + (Stream a -> Stream a -> Stream a) -> Stream a -> Stream Bool +testOp2 op stream = + op stream stream >= op stream stream + +verifySpec :: Verbosity -> IO () +verifySpec verb = do + spec' <- reify spec + verifyWithOptions defaultVerifierOptions{verbosity = verb} + mkDefaultCSettings [] "fpOps" spec' diff --git a/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/Heater.hs b/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/Heater.hs new file mode 100644 index 000000000..b2c9101ff --- /dev/null +++ b/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/Heater.hs @@ -0,0 +1,60 @@ +-------------------------------------------------------------------------------- +-- Copyright 2019 National Institute of Aerospace / Galois, Inc. +-------------------------------------------------------------------------------- + +-- This is a simple example with basic usage. It implements a simple home +-- heating system: It heats when temp gets too low, and stops when it is high +-- enough. It read temperature as a byte (range -50C to 100C) and translates +-- this to Celcius. + +module Copilot.Verifier.Examples.ShouldPass.Heater where + +import Language.Copilot +import Copilot.Compile.C99 +import Copilot.PrettyPrint as PP +--import Copilot.Language.Prelude + +import Copilot.Verifier ( Verbosity(..), VerifierOptions(..) + , defaultVerifierOptions, verifyWithOptions ) + +import qualified Prelude as P +import Control.Monad (when) + +-- External temperature as a byte, range of -50C to 100C +temp :: Stream Word8 +temp = extern "temperature" Nothing + +-- Calculate temperature in Celcius. +-- We need to cast the Word8 to a Float. Note that it is an unsafeCast, as there +-- is no direct relation between Word8 and Float. +ctemp :: Stream Float +ctemp = (unsafeCast temp * constant (150.0/255.0)) - constant 50.0 + +-- width of the sliding window +window :: Int +window = 5 + +-- Compute the sliding average of the last 5 temps +-- (Here, 19.5 is the average of 18.0 and 21.0, the two temperature extremes +-- that we check for in the spec.) +avgTemp :: Stream Float +avgTemp = (sum window (replicate window 19.5 ++ ctemp)) / fromIntegral window + +spec :: Spec +spec = do + trigger "heaton" (avgTemp < 18.0) [arg avgTemp] + trigger "heatoff" (avgTemp > 21.0) [arg avgTemp] + +-- Compile the spec +verifySpec :: Verbosity -> IO () +verifySpec verb = + do rspec <- reify spec + when (verb P.>= Default) $ putStrLn (PP.prettyPrint rspec) + verifyWithOptions defaultVerifierOptions{verbosity = verb} + mkDefaultCSettings [] "heater" + rspec + +{- + do spec' <- reify spec + putStrLn $ prettyPrintDot spec' +-} diff --git a/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/IntOps.hs b/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/IntOps.hs new file mode 100644 index 000000000..f4c4a1db4 --- /dev/null +++ b/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/IntOps.hs @@ -0,0 +1,64 @@ +{-# LANGUAGE NoImplicitPrelude #-} +module Copilot.Verifier.Examples.ShouldPass.IntOps where + +import Copilot.Compile.C99 (mkDefaultCSettings) +import Copilot.Verifier ( Verbosity, VerifierOptions(..) + , defaultVerifierOptions, verifyWithOptions ) +import Language.Copilot +import qualified Prelude as P + +spec :: Spec +spec = do + let stream :: Stream Int16 + stream = extern "stream" Nothing + + shiftBy :: Stream Int16 + shiftBy = extern "shiftBy" Nothing + + _ <- prop "nonzero" (forAll (stream /= 0)) + _ <- prop "shiftByBits" (forAll (0 <= shiftBy && shiftBy < 16)) + + triggerOp1 "abs" abs stream + triggerOp1 "signum" signum stream + triggerOp1 "bwNot" complement stream + + triggerOp2 "add" (+) stream stream + triggerOp2 "sub" (-) stream stream + triggerOp2 "mul" (*) stream stream + triggerOp2 "mod" mod stream stream + triggerOp2 "div" div stream stream + triggerOp2 "bwAnd" (.&.) stream stream + triggerOp2 "bwOr" (.|.) stream stream + triggerOp2 "bwXor" (.^.) stream stream + triggerOp2 "bwShiftL" (.<<.) stream shiftBy + triggerOp2 "bwShiftR" (.>>.) stream shiftBy + +triggerOp1 :: String -> + (Stream Int16 -> Stream Int16) -> + Stream Int16 -> + Spec +triggerOp1 name op stream = + trigger (name P.++ "Trigger") (testOp1 op stream) [arg stream] + +triggerOp2 :: String -> + (Stream Int16 -> Stream Int16 -> Stream Int16) -> + Stream Int16 -> Stream Int16 -> + Spec +triggerOp2 name op stream1 stream2 = + trigger (name P.++ "Trigger") (testOp2 op stream1 stream2) [arg stream1, arg stream2] + +testOp1 :: (Stream Int16 -> Stream Int16) -> Stream Int16 -> Stream Bool +testOp1 op stream = + op stream == op stream + +testOp2 :: (Stream Int16 -> Stream Int16 -> Stream Int16) -> + Stream Int16 -> Stream Int16 -> + Stream Bool +testOp2 op stream1 stream2 = + op stream1 stream2 == op stream1 stream2 + +verifySpec :: Verbosity -> IO () +verifySpec verb = do + spec' <- reify spec + verifyWithOptions defaultVerifierOptions{verbosity = verb} + mkDefaultCSettings ["nonzero", "shiftByBits"] "intOps" spec' diff --git a/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/Partial/AbsIntMin.hs b/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/Partial/AbsIntMin.hs new file mode 100644 index 000000000..1b27fdeed --- /dev/null +++ b/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/Partial/AbsIntMin.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +-- | This will succeed with 'sideCondVerifierOptions', as Copilot's @Abs@ +-- operation is well defined precisely when C's @abs@ function is well defined. +module Copilot.Verifier.Examples.ShouldPass.Partial.AbsIntMin where + +import Language.Copilot +import Copilot.Compile.C99 +import Copilot.Verifier ( Verbosity, VerifierOptions(..) + , sideCondVerifierOptions, verifyWithOptions ) +import Copilot.Verifier.Examples.ShouldFail.Partial.AbsIntMin (spec) + +verifySpec :: Verbosity -> IO () +verifySpec verb = do + spec' <- reify spec + verifyWithOptions sideCondVerifierOptions{verbosity = verb} + mkDefaultCSettings + [] + "absIntMinPass" spec' diff --git a/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/Partial/AddSignedWrap.hs b/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/Partial/AddSignedWrap.hs new file mode 100644 index 000000000..bcf092f65 --- /dev/null +++ b/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/Partial/AddSignedWrap.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +-- | This will succeed with 'sideCondVerifierOptions', as Copilot's @Add@ +-- operation should overflow on signed integers precisely when C addition does. +module Copilot.Verifier.Examples.ShouldPass.Partial.AddSignedWrap where + +import Language.Copilot +import Copilot.Compile.C99 +import Copilot.Verifier ( Verbosity, VerifierOptions(..) + , sideCondVerifierOptions, verifyWithOptions ) +import Copilot.Verifier.Examples.ShouldFail.Partial.AddSignedWrap (spec) + +verifySpec :: Verbosity -> IO () +verifySpec verb = do + spec' <- reify spec + verifyWithOptions sideCondVerifierOptions{verbosity = verb} + mkDefaultCSettings + [] + "addSignedWrapPass" spec' diff --git a/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/Partial/DivByZero.hs b/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/Partial/DivByZero.hs new file mode 100644 index 000000000..6e5c7a65e --- /dev/null +++ b/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/Partial/DivByZero.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +-- | This will succeed with 'sideCondVerifierOptions', as Copilot's @Div@ +-- operation is well defined precisely when C division is well defined. +module Copilot.Verifier.Examples.ShouldPass.Partial.DivByZero where + +import Language.Copilot +import Copilot.Compile.C99 +import Copilot.Verifier ( Verbosity, VerifierOptions(..) + , sideCondVerifierOptions, verifyWithOptions ) +import Copilot.Verifier.Examples.ShouldFail.Partial.DivByZero (spec) + +verifySpec :: Verbosity -> IO () +verifySpec verb = do + spec' <- reify spec + verifyWithOptions sideCondVerifierOptions{verbosity = verb} + mkDefaultCSettings + [] + "divByZeroPass" spec' diff --git a/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/Partial/IndexOutOfBounds.hs b/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/Partial/IndexOutOfBounds.hs new file mode 100644 index 000000000..eb10f24b9 --- /dev/null +++ b/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/Partial/IndexOutOfBounds.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +-- | This will succeed with 'sideCondVerifierOptions', as Copilot's indexing +-- operation should be out of bounds precisely when C array indexes are out of bounds. +module Copilot.Verifier.Examples.ShouldPass.Partial.IndexOutOfBounds where + +import Language.Copilot +import Copilot.Compile.C99 +import Copilot.Verifier ( Verbosity, VerifierOptions(..) + , sideCondVerifierOptions, verifyWithOptions ) +import Copilot.Verifier.Examples.ShouldFail.Partial.IndexOutOfBounds (spec) + +verifySpec :: Verbosity -> IO () +verifySpec verb = do + spec' <- reify spec + verifyWithOptions sideCondVerifierOptions{verbosity = verb} + mkDefaultCSettings + [] + "indexPass" spec' diff --git a/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/Partial/ModByZero.hs b/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/Partial/ModByZero.hs new file mode 100644 index 000000000..1f9f6bf97 --- /dev/null +++ b/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/Partial/ModByZero.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +-- | This will succeed with 'sideCondVerifierOptions', as Copilot's @Mod@ +-- operation is well defined precisely when C's @%@ operator is well defined. +module Copilot.Verifier.Examples.ShouldPass.Partial.ModByZero where + +import Language.Copilot +import Copilot.Compile.C99 +import Copilot.Verifier ( Verbosity, VerifierOptions(..) + , sideCondVerifierOptions, verifyWithOptions ) +import Copilot.Verifier.Examples.ShouldFail.Partial.ModByZero (spec) + +verifySpec :: Verbosity -> IO () +verifySpec verb = do + spec' <- reify spec + verifyWithOptions sideCondVerifierOptions{verbosity = verb} + mkDefaultCSettings + [] + "modByZeroPass" spec' diff --git a/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/Partial/MulSignedWrap.hs b/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/Partial/MulSignedWrap.hs new file mode 100644 index 000000000..fe70f9451 --- /dev/null +++ b/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/Partial/MulSignedWrap.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +-- | This will succeed with 'sideCondVerifierOptions', as Copilot's @Mul@ +-- operation should wrap on signed integers precisely when C multiplication does. +module Copilot.Verifier.Examples.ShouldPass.Partial.MulSignedWrap where + +import Language.Copilot +import Copilot.Compile.C99 +import Copilot.Verifier ( Verbosity, VerifierOptions(..) + , sideCondVerifierOptions, verifyWithOptions ) +import Copilot.Verifier.Examples.ShouldFail.Partial.MulSignedWrap (spec) + +verifySpec :: Verbosity -> IO () +verifySpec verb = do + spec' <- reify spec + verifyWithOptions sideCondVerifierOptions{verbosity = verb} + mkDefaultCSettings + [] + "mulSignedWrapPass" spec' diff --git a/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/Partial/ShiftLTooLarge.hs b/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/Partial/ShiftLTooLarge.hs new file mode 100644 index 000000000..314070096 --- /dev/null +++ b/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/Partial/ShiftLTooLarge.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +-- | This will succeed with 'sideCondVerifierOptions', as Copilot's @BwShiftL@ +-- operation should only accept second arguments as large as C's @<<@ operation does. +module Copilot.Verifier.Examples.ShouldPass.Partial.ShiftLTooLarge where + +import Language.Copilot +import Copilot.Compile.C99 +import Copilot.Verifier ( Verbosity, VerifierOptions(..) + , sideCondVerifierOptions, verifyWithOptions ) +import Copilot.Verifier.Examples.ShouldFail.Partial.ShiftLTooLarge (spec) + +verifySpec :: Verbosity -> IO () +verifySpec verb = do + spec' <- reify spec + verifyWithOptions sideCondVerifierOptions{verbosity = verb} + mkDefaultCSettings + [] + "shiftLTooLargePass" spec' diff --git a/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/Partial/ShiftRTooLarge.hs b/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/Partial/ShiftRTooLarge.hs new file mode 100644 index 000000000..afab4ba46 --- /dev/null +++ b/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/Partial/ShiftRTooLarge.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +-- | This will succeed with 'sideCondVerifierOptions', as Copilot's @BwShiftR@ +-- operation should only accept second arguments as large as C's @>>@ operation does. +module Copilot.Verifier.Examples.ShouldPass.Partial.ShiftRTooLarge where + +import Language.Copilot +import Copilot.Compile.C99 +import Copilot.Verifier ( Verbosity, VerifierOptions(..) + , sideCondVerifierOptions, verifyWithOptions ) +import Copilot.Verifier.Examples.ShouldFail.Partial.ShiftRTooLarge (spec) + +verifySpec :: Verbosity -> IO () +verifySpec verb = do + spec' <- reify spec + verifyWithOptions sideCondVerifierOptions{verbosity = verb} + mkDefaultCSettings + [] + "shiftRTooLargePass" spec' diff --git a/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/Partial/SubSignedWrap.hs b/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/Partial/SubSignedWrap.hs new file mode 100644 index 000000000..9d180bd44 --- /dev/null +++ b/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/Partial/SubSignedWrap.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +-- | This will succeed with 'sideCondVerifierOptions', as Copilot's @Sub@ +-- operation should underflow on signed integers precisely when C subtraction does. +module Copilot.Verifier.Examples.ShouldPass.Partial.SubSignedWrap where + +import Language.Copilot +import Copilot.Compile.C99 +import Copilot.Verifier ( Verbosity, VerifierOptions(..) + , sideCondVerifierOptions, verifyWithOptions ) +import Copilot.Verifier.Examples.ShouldFail.Partial.SubSignedWrap (spec) + +verifySpec :: Verbosity -> IO () +verifySpec verb = do + spec' <- reify spec + verifyWithOptions sideCondVerifierOptions{verbosity = verb} + mkDefaultCSettings + [] + "subSignedWrapPass" spec' diff --git a/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/Structs.hs b/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/Structs.hs new file mode 100644 index 000000000..7f68e4b20 --- /dev/null +++ b/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/Structs.hs @@ -0,0 +1,92 @@ +-- | An example showing the usage of the What4 backend in copilot-theorem for +-- structs and arrays. Particular focus is on nested structs. +-- For general usage of structs, refer to the general structs example. + +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE NoImplicitPrelude #-} +module Copilot.Verifier.Examples.ShouldPass.Structs where + +import Control.Monad (void, forM_, when) +import qualified Prelude as P + +import Language.Copilot +import Copilot.Compile.C99 +import Copilot.Theorem.What4 +import Copilot.Verifier ( Verbosity(..), VerifierOptions(..) + , defaultVerifierOptions, verifyWithOptions ) + + +-- | Definition for `Volts`. +data Volts = Volts + { numVolts :: Field "numVolts" Word16 + , flag :: Field "flag" Bool + } + +-- | `Struct` instance for `Volts`. +instance Struct Volts where + typeName _ = "volts" + toValues vlts = [ Value Word16 (numVolts vlts) + , Value Bool (flag vlts) + ] + +-- | `Volts` instance for `Typed`. +instance Typed Volts where + typeOf = Struct (Volts (Field 0) (Field False)) + +data Battery = Battery + { temp :: Field "temp" Word16 + , volts :: Field "volts" (Array 10 Volts) + , other :: Field "other" (Array 10 (Array 5 Word32)) + } + +-- | `Battery` instance for `Struct`. +instance Struct Battery where + typeName _ = "battery" + toValues battery = [ Value typeOf (temp battery) + , Value typeOf (volts battery) + , Value typeOf (other battery) + ] + +-- | `Battery` instance for `Typed`. Note that `undefined` is used as an +-- argument to `Field`. This argument is never used, so `undefined` will never +-- throw an error. +instance Typed Battery where + typeOf = Struct (Battery (Field 0) (Field undefined) (Field undefined)) + +spec :: Spec +spec = do + let battery :: Stream Battery + battery = extern "battery" Nothing + + -- Check equality, indexing into nested structs and arrays. Note that this is + -- trivial by equality. + void $ prop "Example 1" $ forAll $ + (((battery#volts) ! 0)#numVolts) == (((battery#volts) ! 0)#numVolts) + + -- Same as previous example, but get a different array index (so should be + -- false). + void $ prop "Example 2" $ forAll $ + (((battery#other) ! 2) ! 3) == (((battery#other) ! 2) ! 4) + + -- Same as previous example, but in trigger form + trigger "otherTrig" ((((battery#other) ! 2) ! 3) == (((battery#other) ! 2) ! 4)) + [arg battery] + +verifySpec :: Verbosity -> IO () +verifySpec verb = do + spec' <- reify spec + + -- Use Z3 to prove the properties. + results <- prove Z3 spec' + + -- Print the results. + when (verb P.>= Default) $ + forM_ results $ \(nm, res) -> do + putStr $ nm <> ": " + case res of + Valid -> putStrLn "valid" + Invalid -> putStrLn "invalid" + Unknown -> putStrLn "unknown" + + verifyWithOptions defaultVerifierOptions{verbosity = verb} + mkDefaultCSettings [] "structs" spec' diff --git a/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/UpdateArray.hs b/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/UpdateArray.hs new file mode 100644 index 000000000..55a43b1ab --- /dev/null +++ b/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/UpdateArray.hs @@ -0,0 +1,32 @@ +{-# LANGUAGE RebindableSyntax #-} +{-# LANGUAGE DataKinds #-} + +-- | An example showing of using @copilot-verifier@ to verify a specification +-- involving arrays where individual elements are updated. +module Copilot.Verifier.Examples.ShouldPass.UpdateArray where + +import Language.Copilot +import Copilot.Compile.C99 +import Copilot.Verifier ( Verbosity, VerifierOptions(..) + , defaultVerifierOptions, verifyWithOptions ) + +spec :: Spec +spec = do + let pair :: Stream (Array 2 Word32) + pair = extern "pair" Nothing + + -- Check equality, indexing into array and modifying the value. Note that + -- this is trivial by equality. + trigger "trig_1" + (((pair !! 0 =$ (+1)) ! 0) == ((pair ! 0) + 1)) + [arg pair] + + -- Same as previous example, but get a different array index (so should be + -- false). + trigger "trig_2" + (((pair !! 0 =$ (+1)) ! 1) == ((pair ! 0) + 1)) + [arg pair] + +verifySpec :: Verbosity -> IO () +verifySpec verb = reify spec >>= verifyWithOptions defaultVerifierOptions{verbosity = verb} + mkDefaultCSettings [] "updateArray" diff --git a/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/UpdateStruct.hs b/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/UpdateStruct.hs new file mode 100644 index 000000000..ecf3f4bdd --- /dev/null +++ b/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/UpdateStruct.hs @@ -0,0 +1,62 @@ +{-# LANGUAGE RebindableSyntax #-} +{-# LANGUAGE DataKinds #-} + +-- | An example showing of using @copilot-verifier@ to verify a specification +-- involving structs where individual fields are updated. +module Copilot.Verifier.Examples.ShouldPass.UpdateStruct where + +import Language.Copilot +import Copilot.Compile.C99 +import Copilot.Verifier ( Verbosity, VerifierOptions(..) + , defaultVerifierOptions, verifyWithOptions ) + +-- | Definition for `Volts`. +data Volts = Volts + { numVolts :: Field "numVolts" Word32 + , flag :: Field "flag" Bool + } + +-- | `Struct` instance for `Volts`. +instance Struct Volts where + typeName _ = "volts" + toValues vlts = [ Value Word32 (numVolts vlts) + , Value Bool (flag vlts) + ] + +-- | `Volts` instance for `Typed`. +instance Typed Volts where + typeOf = Struct (Volts (Field 0) (Field False)) + +data Battery = Battery + { temp :: Field "temp" Word32 + , volts :: Field "volts" (Array 10 Volts) + , other :: Field "other" (Array 10 (Array 5 Word32)) + } + +-- | `Battery` instance for `Struct`. +instance Struct Battery where + typeName _ = "battery" + toValues battery = [ Value typeOf (temp battery) + , Value typeOf (volts battery) + , Value typeOf (other battery) + ] + +-- | `Battery` instance for `Typed`. Note that `undefined` is used as an +-- argument to `Field`. This argument is never used, so `undefined` will never +-- throw an error. +instance Typed Battery where + typeOf = Struct (Battery (Field 0) (Field undefined) (Field undefined)) + +spec :: Spec +spec = do + let battery :: Stream Battery + battery = extern "battery" Nothing + + -- Update a struct field, then check it for equality. + trigger "updateTrig" + ((battery ## temp =$ (+1))#temp == (battery#temp + 1)) + [arg battery] + +verifySpec :: Verbosity -> IO () +verifySpec verb = reify spec >>= verifyWithOptions defaultVerifierOptions{verbosity = verb} + mkDefaultCSettings [] "updateStruct" diff --git a/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/Voting.hs b/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/Voting.hs new file mode 100644 index 000000000..46562bdb1 --- /dev/null +++ b/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/Voting.hs @@ -0,0 +1,64 @@ +-------------------------------------------------------------------------------- +-- Copyright © 2019 National Institute of Aerospace / Galois, Inc. +-------------------------------------------------------------------------------- + +-- | Fault-tolerant voting examples. + +{-# LANGUAGE RebindableSyntax #-} + +module Copilot.Verifier.Examples.ShouldPass.Voting where + +import Language.Copilot +import Copilot.Compile.C99 +import Copilot.Verifier ( Verbosity, VerifierOptions(..) + , defaultVerifierOptions, verifyWithOptions ) + +vote :: Spec +vote = do + -- majority selects element with the biggest occurance. + trigger "maj" true [arg maj] + + -- aMajority checks if the selected element has a majority. + trigger "aMaj" true [arg $ aMajority inputs maj] + + where + maj = majority inputs + + -- 26 input streams to vote on + inputs :: [Stream Word32] + inputs = [ a, b, c, d, e, f, g, h, i, j, k, l, m + -- , n, o, p, q, r, s, t, u, v, w, x, y, z + ] + a = [0] ++ a + 1 + b = [0] ++ b + 1 + c = [0] ++ c + 1 + d = [0] ++ d + 1 + e = [1] ++ e + 1 + f = [1] ++ f + 1 + g = [1] ++ g + 1 + h = [1] ++ h + 1 + i = [1] ++ i + 1 + j = [1] ++ j + 1 + k = [1] ++ k + 1 + l = [1] ++ l + 1 + m = [1] ++ m + 1 +{- + n = [1] ++ n + 1 + o = [1] ++ o + 1 + p = [1] ++ p + 1 + q = [1] ++ q + 1 + r = [1] ++ r + 1 + s = [1] ++ s + 1 + t = [1] ++ t + 1 + u = [1] ++ u + 1 + v = [1] ++ v + 1 + w = [1] ++ w + 1 + x = [1] ++ x + 1 + y = [1] ++ y + 1 + z = [1] ++ z + 1 +-} + +verifySpec :: Verbosity -> IO () +--verifySpec _ = interpret 30 vote +verifySpec verb = reify vote >>= verifyWithOptions defaultVerifierOptions{verbosity = verb} + mkDefaultCSettings [] "voting" diff --git a/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/WCV.hs b/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/WCV.hs new file mode 100644 index 000000000..118e7a386 --- /dev/null +++ b/copilot-verifier/examples/Copilot/Verifier/Examples/ShouldPass/WCV.hs @@ -0,0 +1,189 @@ +-- | This example shows an implementation of the Well-Clear Violation +-- algorithm, it follows the implementation described in 'Analysis of +-- Well-Clear Bounday Models for the Integration of UAS in the NAS', +-- https://ntrs.nasa.gov/citations/20140010078. + +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE RebindableSyntax #-} + +module Copilot.Verifier.Examples.ShouldPass.WCV where + +import Language.Copilot +-- import qualified Copilot.Theorem.What4 as CT +import Copilot.Compile.C99 +import Copilot.Verifier ( Verbosity, VerifierOptions(..) + , defaultVerifierOptions, verifyWithOptions ) + +-- import Data.Foldable (forM_) +import qualified Control.Monad as Monad + + +-- | `dthr` is the horizontal distance threshold. +dthr :: Stream Double +dthr = extern "dthr" Nothing + +-- | `tthr` is the horizontal time threshold. +tthr :: Stream Double +tthr = extern "tthr" Nothing + +-- | `zthr` is the vertical distance / altitude threshold. +zthr :: Stream Double +zthr = extern "zthr" Nothing + +-- | `tcoathr` is the vertical time threshold. +tcoathr :: Stream Double +tcoathr = extern "tcoathr" Nothing + +type Vect2 = (Stream Double, Stream Double) + + +------------------ +-- The following section contains basic libraries for working with vectors. +------------------ + +-- | Multiply two Vectors. +(|*|) :: Vect2 -> Vect2 -> Stream Double +(|*|) (x1, y1) (x2, y2) = (x1 * x2) + (y1 * y2) + +-- | Calculate the square of a vector. +sq :: Vect2 -> Stream Double +sq x = x |*| x + +-- | Calculate the length of a vector. +norm :: Vect2 -> Stream Double +norm = sqrt . sq + +-- | Calculate the determinant of two vectors. +det :: Vect2 -> Vect2 -> Stream Double +det (x1, y1) (x2, y2) = (x1 * y2) - (x2 * y1) + +-- | Compare two vectors, taking into account the small error that is +-- introduced by the usage of `Double`s. +(~=) :: Stream Double -> Stream Double -> Stream Bool +a ~= b = (abs (a - b)) < 0.001 + +-- | Negate a vector. +neg :: Vect2 -> Vect2 +neg (x, y) = (negate x, negate y) + + +-------------------- +-- From here on the algorithm, as described by the paper mentioned on the top +-- of this file, is implemented. Please refer to the paper for details. +-------------------- + +tau :: Vect2 -> Vect2 -> Stream Double +tau s v = if s |*| v < 0 + then (-(sq s)) / (s |*| v) + else -1 + +tcpa :: Vect2 -> Vect2 -> Stream Double +tcpa s v@(vx, vy) = if vx ~= 0 && vy ~= 0 + then 0 + else -(s |*| v)/(sq v) + +taumod :: Vect2 -> Vect2 -> Stream Double +taumod s v = if s |*| v < 0 + then (dthr * dthr - (sq s))/(s |*| v) + else -1 + +tep :: Vect2 -> Vect2 -> Stream Double +tep s v = if (s |*| v < 0) && ((delta s v dthr) >= 0) + then theta s v dthr (-1) + else -1 + +delta :: Vect2 -> Vect2 -> Stream Double -> Stream Double +delta s v d = (d*d) * (sq v) - ((det s v)*(det s v)) +-- Here the formula says : (s . orth v)^2 which is the same as det(s,v)^2 + +theta :: Vect2 -> Vect2 -> Stream Double -> Stream Double -> Stream Double +theta s v d e = (-(s |*| v) + e * (sqrt $ delta s v d)) / (sq v) + + +tcoa :: Stream Double -> Stream Double -> Stream Double +tcoa sz vz = if (sz * vz) < 0 + then (-sz) / vz + else -1 + +dcpa :: Vect2 -> Vect2 -> Stream Double +dcpa s@(sx, sy) v@(vx, vy) = norm (sx + (tcpa s v) * vx, sy + (tcpa s v) * vy) + + +-------------------------- +-- Well clear Violation -- +-------------------------- + +-- | Determines if the well clear property is violated or not. +wcv :: (Vect2 -> Vect2 -> Stream Double) -> + Vect2 -> Stream Double -> + Vect2 -> Stream Double -> + Stream Bool +wcv tvar s sz v vz = (horizontalWCV tvar s v) && (verticalWCV sz vz) + +verticalWCV :: Stream Double -> Stream Double -> Stream Bool +verticalWCV sz vz = + ((abs $ sz) <= zthr) || + (0 <= (tcoa sz vz) && (tcoa sz vz) <= tcoathr) + +horizontalWCV :: (Vect2 -> Vect2 -> Stream Double) -> Vect2 -> Vect2 -> Stream Bool +horizontalWCV tvar s v = + (norm s <= dthr) || + (((dcpa s v) <= dthr) && (0 <= (tvar s v)) && ((tvar s v) <= tthr)) + +spec :: Spec +spec = do + -- External streams for relative position and velocity. + let -- The relative x velocity between ownship and the intruder. + vx :: Stream Double + vx = extern "relative_velocity_x" Nothing + + -- The relative y velocity between ownship and the intruder. + vy :: Stream Double + vy = extern "relative_velocity_y" Nothing + + -- The relative z velocity between ownship and the intruder. + vz :: Stream Double + vz = extern "relative_velocity_z" Nothing + + -- The relative velocity as a 2D vector. + v :: (Stream Double, Stream Double) + v = (vx, vy) + + + -- The relative x position between ownship and the intruder. + sx :: Stream Double + sx = extern "relative_position_x" Nothing + + -- The relative y position between ownship and the intruder. + sy :: Stream Double + sy = extern "relative_position_y" Nothing + + -- The relative z position between ownship and the intruder. + sz :: Stream Double + sz = extern "relative_position_z" Nothing + + -- The relative position as a 2D vector. + s :: (Stream Double, Stream Double) + s = (sx, sy) + Monad.void $ prop "1a" (forAll $ (tau s v) ~= (tau (neg s) (neg v))) + -- Monad.void $ prop "3d" (forAll $ (wcv tep s sz v vz) == (wcv tep (neg s) (-sz) (neg v) (-vz))) + trigger "well_clear_violation" (wcv tep s sz v vz) [] + +verifySpec :: Verbosity -> IO () +verifySpec verb = do + spec' <- reify spec + verifyWithOptions defaultVerifierOptions{verbosity = verb} + mkDefaultCSettings [] "wcv" spec' + +{- + -- Use Z3 to prove the properties. + results <- CT.prove CT.Z3 spec' + + -- Print the results. + forM_ results $ \(nm, res) -> do + putStr $ nm <> ": " + case res of + CT.Valid -> putStrLn "valid" + CT.Invalid -> putStrLn "invalid" + CT.Unknown -> putStrLn "unknown" +-} diff --git a/copilot-verifier/exe/VerifyExamples.hs b/copilot-verifier/exe/VerifyExamples.hs new file mode 100644 index 000000000..9fad16b53 --- /dev/null +++ b/copilot-verifier/exe/VerifyExamples.hs @@ -0,0 +1,53 @@ +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +module Main (main) where + +import qualified Data.CaseInsensitive as CI +import Data.CaseInsensitive (CI) +import Data.Foldable (for_) +import qualified Data.Map as Map +import qualified Data.Text as Text +import qualified Data.Text.IO as Text +import Data.Text (Text) +import Data.Traversable (for) +import Options.Applicative + +import Copilot.Verifier (Verbosity(..)) +import Copilot.Verifier.Examples (shouldFailExamples, shouldPassExamples) + +newtype Options = Options + { examples :: [CI Text] + } deriving Show + +optsParser :: Parser Options +optsParser = Options + <$> (some . strArgument) + ( metavar "EXAMPLE1 [EXAMPLE2 ...]" + <> help "The names of the examples to run" ) + +main :: IO () +main = execParser opts >>= verifyExamples + where + opts = info (optsParser <**> helper) + ( fullDesc + <> header "Run one or more copilot-verifier examples" + <> progDesc (unlines [ "Run one or more examples from the copilot-verifier/examples directory." + , "Each EXAMPLE must correspond to an example name." + ])) + +verifyExamples :: Options -> IO () +verifyExamples Options{examples} = do + -- Check that all requested examples exist + examplesWithMain <- for examples $ \example -> + case Map.lookup example (shouldFailExamples Default `Map.union` shouldPassExamples Default) of + Just m -> pure (example, m) + Nothing -> fail $ "No example named " ++ Text.unpack (CI.original example) + + -- Run the examples + for_ examplesWithMain $ \(example, exampleMain) -> do + Text.putStrLn "=====" + Text.putStrLn $ "== Running the " <> CI.original example <> " example..." + Text.putStrLn "=====" + Text.putStrLn "" + exampleMain + Text.putStrLn "" diff --git a/copilot-verifier/src/Copilot/Verifier.hs b/copilot-verifier/src/Copilot/Verifier.hs new file mode 100644 index 000000000..cd0f3d877 --- /dev/null +++ b/copilot-verifier/src/Copilot/Verifier.hs @@ -0,0 +1,1607 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE ExplicitNamespaces #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ImplicitParams #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeOperators #-} + +module Copilot.Verifier + ( verify + , verifyWithOptions + , VerifierOptions(..) + , defaultVerifierOptions + , sideCondVerifierOptions + , Verbosity(..) + ) where + +import Control.Lens (view, (^.), to) +import Control.Monad (foldM, forM_, unless, when) +import Control.Monad.IO.Class (liftIO) +import Control.Monad.State (execStateT, lift, StateT(..)) +import Data.Aeson (ToJSON) +import Data.Foldable (traverse_) +import Data.Functor (void) +import qualified Data.Text as Text +import qualified Data.Map.Strict as Map +import Data.IORef (newIORef, modifyIORef', readIORef, IORef) +import qualified Text.LLVM.AST as L +import Data.List (genericLength, sort) +import Data.List.NonEmpty (NonEmpty(..)) +import qualified Data.List.NonEmpty as NE +import qualified Data.Vector as V +import qualified Data.BitVector.Sized as BV +import GHC.Generics (Generic) +import qualified Prettyprinter as PP +import System.Exit (exitFailure) +import System.FilePath ((), (<.>)) + +import Copilot.Compile.C99 (CSettings(..), compileWith) +import Copilot.Core +import qualified Copilot.Core.Type as CT + +import qualified Copilot.Theorem.What4 as CW4 + +import qualified Copilot.Verifier.FloatMode as FloatMode +import qualified Copilot.Verifier.Log as Log +import qualified Copilot.Verifier.Solver as Solver + +import Data.Parameterized.Ctx (EmptyCtx) +import Data.Parameterized.Context (pattern Empty) +import qualified Data.Parameterized.Context as Ctx +import Data.Parameterized.NatRepr (intValue, natValue, testEquality, knownNat, type (<=) ) +import Data.Parameterized.Nonce (globalNonceGenerator) +import Data.Parameterized.Some (Some(..)) +import Data.Parameterized.TraversableFC (toListFC) +import Data.Parameterized.TraversableFC.WithIndex (ifoldlMFC) +import qualified Data.Parameterized.Vector as PVec + +import Lang.Crucible.Backend + ( IsSymInterface, Goals(..), Assumptions, Assertion + , pushAssumptionFrame, popUntilAssumptionFrame + , getProofObligations, clearProofObligations + , LabeledPred(..), abortExecBecause, AbortExecReason(..), addAssumption + , addDurableAssertion, addDurableProofObligation + , CrucibleAssumption(..), ppAbortExecReason + , IsSymBackend(..), HasSymInterface(..) + , labeledPred, labeledPredMsg + -- , ProofObligations, proofGoal, goalsToList, labeledPredMsg + ) +import Lang.Crucible.Backend.Simple (SimpleBackend, newSimpleBackend) +import Lang.Crucible.CFG.Core (AnyCFG(..), cfgArgTypes, cfgReturnType) +import Lang.Crucible.CFG.Common ( freshGlobalVar ) +import Lang.Crucible.FunctionHandle (HandleAllocator, newHandleAllocator) +import Lang.Crucible.Simulator + ( SimContext(..), ctxSymInterface, ExecResult(..), ExecState(..) + , defaultAbortHandler, runOverrideSim, partialValue, gpValue + , GlobalVar, executeCrucible, OverrideSim, ovrWithBackend, regValue + , readGlobal, modifyGlobal, callCFG, emptyRegMap, RegEntry(..) + , AbortedResult(..) + ) +import Lang.Crucible.Simulator.ExecutionTree ( withBackend ) +import Lang.Crucible.Simulator.GlobalState ( insertGlobal ) +import Lang.Crucible.Simulator.RegValue (RegValue, RegValue'(..)) +import Lang.Crucible.Simulator.SimError (SimError(..), SimErrorReason(..)) -- ppSimError +import Lang.Crucible.Types + ( TypeRepr(..), (:~:)(..), KnownRepr(..), NatType ) + +import Lang.Crucible.LLVM (llvmGlobals, registerLazyModule, register_llvm_overrides) +import Lang.Crucible.LLVM.Bytes (bitsToBytes) +import Lang.Crucible.LLVM.DataLayout (Alignment, DataLayout) +import Lang.Crucible.LLVM.Errors (BadBehavior) +import Lang.Crucible.LLVM.Extension (LLVM, ArchWidth) +import Lang.Crucible.LLVM.Globals (initializeAllMemory, populateAllGlobals) +import Lang.Crucible.LLVM.Intrinsics + ( IntrinsicsOptions, OverrideTemplate, basic_llvm_override, LLVMOverride(..) ) + +import Lang.Crucible.LLVM.MemType + ( MemType(..), SymType(..) + , i1, i8, i16, i32, i64 + , memTypeSize, memTypeAlign + , mkStructInfo + ) +import Lang.Crucible.LLVM.MemModel + ( mkMemVar, withPtrWidth, HasLLVMAnn, LLVMAnnMap, MemImpl + , HasPtrWidth, doResolveGlobal, doStore + , LLVMPtr, LLVMVal, MemOptions, PartLLVMVal(..), StorageType, bitvectorType + , ptrAdd, toStorableType, projectLLVM_bv + , pattern LLVMPointerRepr, pattern PtrRepr, loadRaw, llvmPointer_bv + , memRepr, Mem, unpackMemValue + ) +import Lang.Crucible.LLVM.MemModel.CallStack (CallStack) +import Lang.Crucible.LLVM.MemModel.Partial (BoolAnn(..)) +import Lang.Crucible.LLVM.PrettyPrint (ppSymbol) +import Lang.Crucible.LLVM.Translation + ( LLVMTranslationWarning(..), ModuleTranslation + , getTranslatedCFG, translateModule, globalInitMap + , transContext, llvmPtrWidth, llvmTypeCtx, llvmTypeAsRepr + ) +import Lang.Crucible.LLVM.TypeContext (TypeContext, llvmDataLayout) + +import Crux (defaultOutputConfig) +import Crux.Config (cfgJoin, Config(..)) +import Crux.Config.Load (fromFile, fromEnv) +import Crux.Config.Common + ( cruxOptions, CruxOptions(..), postprocessOptions, outputOptions + , OutputOptions(..) + ) +import Crux.Goal (proveGoalsOffline, provedGoalsTree) +import qualified Crux.Log as Log +import Crux.Types (SimCtxt, Crux, ProcessedGoals(..), ProofResult(..)) + +import Crux.LLVM.Config (llvmCruxConfig, LLVMOptions(..)) +import Crux.LLVM.Compile (genBitCode) +import qualified Crux.LLVM.Log as Log +import Crux.LLVM.Simulate (setupSimCtxt, parseLLVM, explainFailure) +import CruxLLVMMain (processLLVMOptions) + +import What4.Config + (extendConfig) +import What4.Interface + ( Pred, bvLit, bvAdd, bvUrem, bvMul, bvIsNonzero, bvEq, isEq + , getConfiguration, freshBoundedBV, predToBV + , getCurrentProgramLoc, printSymExpr + , truePred, falsePred, andPred, annotateTerm, backendPred + , getAnnotation, natAdd, natEq, natIte, natLit + ) +import What4.Expr.Builder + ( Flags, ExprBuilder, BoolExpr, startCaching + , newExprBuilder + ) +import What4.FunctionName (functionName) +import What4.InterpretedFloatingPoint + ( FloatInfoRepr(..), IsInterpretedFloatExprBuilder(..) + , SingleFloat, DoubleFloat + ) +import What4.ProgramLoc (ProgramLoc, mkProgramLoc, plFunction, Position(..)) +import What4.Solver.Adapter (SolverAdapter(..)) +import What4.Symbol (safeSymbol) + +-- | @'verify' csettings props prefix spec@ verifies the Copilot specification +-- @spec@ under the assumptions @props@ matches the behavior of the C program +-- compiled with @csettings@ within a directory prefixed by @prefix@. +verify :: CSettings -> [String] -> String -> Spec -> IO () +verify = verifyWithOptions defaultVerifierOptions + +-- | Options for configuring the behavior of the verifier. +data VerifierOptions = VerifierOptions + { verbosity :: Verbosity + -- ^ How much output the verifier should produce. + , assumePartialSideConds :: Bool + -- ^ If 'True', the verifier will determine the conditions under which + -- a Copilot specification's partial operations are well defined and + -- add these side conditions as assumptions. As a result, even if the + -- generated C code performs a partial operation, the verification will + -- succeed if this partial operation coincides with a corresponding + -- operation on the Copilot side. + -- + -- If 'False', the verifier will not assume any side conditions related + -- to partial operations in the Copilot specification. As a result, any + -- use of a partial operation in the generated C code will cause + -- verification to fail unless the user adds their own assumptions. + , logSmtInteractions :: Bool + -- ^ If 'True', create log files corresponding to the SMT solver + -- interactions used to discharge each proof goal. The file will be named + -- @--.smt2@, where: + -- + -- * @@ will be either @initial-step@ or @transition-step@, depending + -- on which step of the proof the goal corresponds to. + -- + -- * @@ will be the number of the goal, starting at 0 and + -- counting up. Note that each step of the proof has its own goal + -- numbers. This means that there can be both an + -- @initial-step-0-.smt2@ and a @transition-step-0-.smt2@, + -- and similarly for other numbers. + -- + -- * @@ is the name of the SMT solver used to discharge the proof + -- goal. Currently, this will always be @z3@, although we might make this + -- configurable in the future. + , smtSolver :: Solver.Solver + -- ^ Which SMT solver to use when solving proof goals. + , smtFloatMode :: FloatMode.FloatMode + -- ^ How the verifier should interpret floating-point operations when + -- translating them to SMT. + -- + -- By default, the verifier will treat all floating-point operations as + -- uninterpreted functions ('FloatMode.FloatUninterpreted'). This allows the + -- verifier to perform some limited reasoning about floating-point + -- operations that SMT solvers do not have built-in operations for (@sin@, + -- @cos@, @tan@, etc.), but at the expense of not being able to verify C + -- code in which the compiler optimizes floating-point expressions. One can + -- also opt into an alternative mode where floating-point values are treated + -- as IEEE-754 floats ('FloatMode.FloatIEEE'), but this comes with the + -- drawback that the verifier will not be able to perform /any/ reasoning + -- about @sin@, @cos@, @tan@, etc. + } deriving stock Show + +-- | The default 'VerifierOptions': +-- +-- * Produce a reasonable amount of diagnostics as verification proceeds +-- ('Default'). +-- +-- * Do not assume any side conditions related to partial operations. +-- +-- * Do not log any SMT solver interactions. +-- +-- * Use the Z3 SMT solver. +-- +-- * Treat all floating-point operations as uninterpreted functions when +-- translating to SMT. +defaultVerifierOptions :: VerifierOptions +defaultVerifierOptions = VerifierOptions + { verbosity = Default + , assumePartialSideConds = False + , logSmtInteractions = False + , smtSolver = Solver.Z3 + , smtFloatMode = FloatMode.FloatUninterpreted + } + +-- | Like 'defaultVerifierOptions', except that the verifier will assume side +-- conditions related to partial operations used in the Copilot spec. +sideCondVerifierOptions :: VerifierOptions +sideCondVerifierOptions = defaultVerifierOptions + { assumePartialSideConds = True + } + +-- | How much output should verification produce? +-- +-- The data constructors are listed in increasing order of how many diagnostics +-- they produce. +data Verbosity + = Quiet -- ^ Don't produce any diagnostics. + | Default -- ^ Produce a reasonable amount of diagnostics as verification proceeds. + | Noisy -- ^ Produce as many diagnostics as possible. + deriving stock (Eq, Ord, Show) + +-- | Like 'verify', but with 'VerifierOptions' to more finely control the +-- verifier's behavior. +verifyWithOptions :: VerifierOptions -> CSettings -> [String] -> String -> Spec -> IO () +verifyWithOptions opts csettings0 properties prefix spec = + withCopilotLogging $ + do -- munge options structures into the necessary forms + (ocfg, cruxOpts, llvmOpts, csettings, csrc) <- computeConfiguration opts csettings0 prefix + let ?outputConfig = ocfg + + -- Compile the Copilot spec into C source code, using + -- preexisting Copilot library calls. + compileWith csettings prefix spec + Log.sayCopilot $ Log.GeneratedCFile csrc + + -- Compile the C source into LLVM bitcode, using preexisting + -- Crux library calls. + bcFile <- genBitCode cruxOpts llvmOpts + Log.sayCopilot $ Log.CompiledBitcodeFile prefix bcFile + + -- Run the main verification procedure + verifyBitcode opts csettings properties spec cruxOpts llvmOpts csrc bcFile + + +-- | Do the (surprisingly large amount) of options munging necessary to set up +-- the crucible/crux environment. +computeConfiguration :: + Log.SupportsCruxLogMessage CopilotLogging => + VerifierOptions -> CSettings -> FilePath -> + IO (Log.OutputConfig CopilotLogging, CruxOptions, LLVMOptions, CSettings, FilePath) +computeConfiguration opts csettings0 prefix = + do ocfg1 <- defaultOutputConfig copilotLoggingToSayWhat + let quiet = verbosity opts == Quiet + let ocfg2 mbOutputOpts = (ocfg1 mbOutputOpts) { Log._quiet = quiet } + llvmcfg <- llvmCruxConfig + let cfg = cfgJoin cruxOptions llvmcfg + -- TODO, load from an actual configuration file? + fileOpts <- fromFile "copilot-verifier" cfg Nothing + (cruxOpts0, llvmOpts0) <- foldM fromEnv fileOpts (cfgEnv cfg) + let odir0 = cSettingsOutputDirectory csettings0 + let odir = -- A bit grimy, but this corresponds to how crux-llvm sets + -- its output directory. + if odir0 == "." + then "results" prefix + else odir0 + let csettings = csettings0{ cSettingsOutputDirectory = odir } + let csrc = odir prefix ++ ".c" + let cruxOpts1 = cruxOpts0{ outDir = odir, bldDir = odir, inputFiles = [csrc] + , outputOptions = + (outputOptions cruxOpts0) + { quietMode = quiet + , simVerbose = if verbosity opts > Default + then 2 + else 0 + } + } + let ?outputConfig = ocfg2 (Just (outputOptions cruxOpts1)) + cruxOpts2 <- postprocessOptions cruxOpts1 + + -- Tweak the options passed to Clang: + -- + -- - Fix the optimization level to -O0. + -- + -- - Pass -ffp-contract=off to prevent sequences of floating-point + -- multiplications/additions from being optimized to llvm.fmuladd + -- intrinsics, which makes floating-point verification fragile. + let llvmOpts1 = llvmOpts0 + { optLevel = 0 + , clangOpts = "-ffp-contract=off" : clangOpts llvmOpts0 + } + (cruxOpts3, llvmOpts2) <- processLLVMOptions (cruxOpts2, llvmOpts1) + + let ocfg3 = ocfg2 (Just (outputOptions cruxOpts3)) + return (ocfg3, cruxOpts3, llvmOpts2, csettings, csrc) + + +data CopilotVerifierData t = CopilotVerifierData + + +-- | Main entry point for the verifier. +verifyBitcode :: + Log.Logs msgs => + Log.SupportsCruxLogMessage msgs => + Log.SupportsCruxLLVMLogMessage msgs => + Log.SupportsCopilotLogMessage msgs => + VerifierOptions {- ^ Verifier-specific settings -} -> + CSettings {- ^ Settings used to compile the Copilot spec. Used to find the names of functions and variables. -} -> + [String] {- ^ Names of properties to assume during verification. -} -> + Spec {- ^ The input Copilot specification -} -> + CruxOptions {- ^ Crux options -} -> + LLVMOptions {- ^ CruxLLVM options -} -> + FilePath {- ^ Path to the generated C file (for logging purposes only) -} -> + FilePath {- ^ Path to the bitcode file to verify -} -> + IO () +verifyBitcode opts csettings properties spec cruxOpts llvmOpts cFile bcFile = + FloatMode.withFloatMode (smtFloatMode opts) $ \fm -> + do -- Set up the expression builder and symbolic backend + halloc <- newHandleAllocator + sym <- newExprBuilder fm CopilotVerifierData globalNonceGenerator + bak <- newSimpleBackend sym + -- turn on hash-consing + startCaching sym + + FloatMode.withInterpretedFloatExprBuilder sym fm $ + verifyWithSymBackend bak halloc + where + verifyWithSymBackend :: + forall t st fm. + IsInterpretedFloatExprBuilder (ExprBuilder t st (Flags fm)) => + SimpleBackend t st (Flags fm) -> + HandleAllocator -> + IO () + verifyWithSymBackend bak halloc = do + let sym = backendGetSym bak + -- capture LLVM side-condition information for use in error reporting + clRefs <- newCopilotLogRefs + let ?recordLLVMAnnotation = recordLLVMAnnotation clRefs + + -- Set up the solver to use for verification. + let adapter :: SolverAdapter st + adapter = Solver.solverAdapter (smtSolver opts) + extendConfig (solver_adapter_config_options adapter) (getConfiguration sym) + + -- Set up the Crucible/LLVM simulation context + memVar <- mkMemVar "llvm_memory" halloc + let simctx = (setupSimCtxt halloc bak (memOpts llvmOpts) memVar) + { printHandle = view Log.outputHandle ?outputConfig } + + -- Load and translate the input LLVM module + llvmMod <- parseLLVM bcFile + Some trans <- + let ?transOpts = transOpts llvmOpts + in translateModule halloc memVar llvmMod + + Log.sayCopilot Log.TranslatedToCrucible + + -- Grab some metadata from the bitcode file and options; + -- make the available via implicit arguments to the places + -- that expect them. + let llvmCtxt = trans ^. transContext + let ?lc = llvmCtxt ^. llvmTypeCtx + let ?memOpts = memOpts llvmOpts + let ?intrinsicsOpts = intrinsicsOpts llvmOpts + + llvmPtrWidth llvmCtxt $ \ptrW -> + withPtrWidth ptrW $ + + do -- Compute the LLVM memory state with global variables allocated + -- but not initialized + emptyMem <- initializeAllMemory bak llvmCtxt llvmMod + + -- Compute the LLVM memory state with global variables initialized + -- to their initial values. + initialMem <- populateAllGlobals bak (trans ^. globalInitMap) emptyMem + + -- Use the Copilot spec directly to compute the symbolic states + -- necessary to carry out the states of the bisimulation proof. + Log.sayCopilot Log.GeneratingProofState + proofStateBundle <- CW4.computeBisimulationProofBundle sym properties spec + + -- First check that the initial state of the program matches the starting + -- segment of the associated Copilot streams. + let cruxOptsInit = setCruxOfflineSolverOutput "initial-step" cruxOpts + initGoals <- + verifyInitialState cruxOptsInit [adapter] clRefs simctx initialMem + (CW4.initialStreamState proofStateBundle) + + -- Now, the real meat. Carry out the bisimulation step of the proof. + let cruxOptsTrans = setCruxOfflineSolverOutput "transition-step" cruxOpts + bisimGoals <- + verifyStepBisimulation opts cruxOptsTrans [adapter] csettings + clRefs simctx llvmMod trans memVar initialMem proofStateBundle + + Log.sayCopilot $ Log.SuccessfulProofSummary cFile initGoals bisimGoals + -- We only want to inform users about Noisy if the verbosity level is + -- sufficiently low. Crux's logging framework isn't particularly + -- suited to doing this, as it assumes that all log messages enabled + -- for low verbosity levels should also be enabled for higher + -- verbosity levels. That is a reasonable assumption most of the time, + -- but not here. + -- + -- To compensate, we hack around the issue by manually checking the + -- verbosity level before logging the message. + when (verbosity opts < Noisy) $ + Log.sayCopilot Log.NoisyVerbositySuggestion + + -- If @logSmtInteractions@ is enabled, enable offline solver output in the + -- supplied 'CruxOptions' with the supplied file template. Otherwise, return + -- the supplied 'CruxOptions' unaltered. + setCruxOfflineSolverOutput :: FilePath -> CruxOptions -> CruxOptions + setCruxOfflineSolverOutput template cruxOpts' + | logSmtInteractions opts + = cruxOpts' + { offlineSolverOutput = Just $ outDir cruxOpts' template <.> "smt2" } + | otherwise + = cruxOpts' + +-- | Capture LLVM side-condition information for use in error reporting. +recordLLVMAnnotation :: + IsSymInterface sym => + CopilotLogRefs sym -> + CallStack -> + BoolAnn sym -> + BadBehavior sym -> + IO () +recordLLVMAnnotation clRefs stk bann bb = + modifyIORef' (llvmAnnMapRef clRefs) (Map.insert bann (stk, bb)) + +-- | Prove that the state of the global variables at program startup +-- matches the expected initial segments of the associated Copilot +-- streams. +verifyInitialState :: + IsSymInterface sym => + Log.Logs msgs => + Log.SupportsCruxLogMessage msgs => + Log.SupportsCopilotLogMessage msgs => + sym ~ ExprBuilder t st fs => + HasPtrWidth wptr => + HasLLVMAnn sym => + (?memOpts :: MemOptions) => + (?lc :: TypeContext) => + + CruxOptions -> + [SolverAdapter st] -> + CopilotLogRefs sym -> + SimCtxt Crux sym LLVM -> + MemImpl sym -> + CW4.BisimulationProofState sym -> + IO Integer +verifyInitialState cruxOpts adapters clRefs simctx mem initialState = + withBackend simctx $ \bak -> + do Log.sayCopilot $ Log.ComputingConditions Log.InitialState + frm <- pushAssumptionFrame bak + + assertStateRelation bak clRefs mem + Log.InitialStateRelation initialState + + popUntilAssumptionFrame bak frm + + Log.sayCopilot $ Log.ProvingConditions Log.InitialState + proveObls cruxOpts adapters clRefs Log.InitialState simctx + + +verifyStepBisimulation :: + IsSymInterface sym => + Log.Logs msgs => + Log.SupportsCruxLogMessage msgs => + Log.SupportsCruxLLVMLogMessage msgs => + Log.SupportsCopilotLogMessage msgs => + sym ~ ExprBuilder t st fs => + HasPtrWidth wptr => + HasLLVMAnn sym => + (1 <= ArchWidth arch) => + HasPtrWidth (ArchWidth arch) => + (?memOpts :: MemOptions) => + (?lc :: TypeContext) => + (?intrinsicsOpts :: IntrinsicsOptions) => + + VerifierOptions -> + CruxOptions -> + [SolverAdapter st] -> + CSettings -> + CopilotLogRefs sym -> + SimCtxt Crux sym LLVM -> + L.Module -> + ModuleTranslation arch -> + GlobalVar Mem -> + MemImpl sym -> + CW4.BisimulationProofBundle sym -> + IO Integer +verifyStepBisimulation opts cruxOpts adapters csettings clRefs simctx llvmMod modTrans memVar mem prfbundle = + withBackend simctx $ \bak -> + do Log.sayCopilot $ Log.ComputingConditions Log.StepBisimulation + + frm <- pushAssumptionFrame bak + + do -- set up the memory image + mem' <- setupPrestate bak mem prfbundle + + -- sanity check, verify that we set up the memory in the expected relation + assertStateRelation bak clRefs mem' + Log.PreStepStateRelation (CW4.preStreamState prfbundle) + + -- set up trigger guard global variables + let halloc = simHandleAllocator simctx + -- See Note [Global variables for trigger functions] + let prepTrigger (nm, guard, _) = + do gv <- freshGlobalVar halloc (Text.pack (nm ++ "_called")) NatRepr + return (nm, gv, guard) + + checkDuplicateTriggerNames :: [Name] -> IO () + checkDuplicateTriggerNames triggers = + traverse_ checkDuplicateTriggerName $ NE.group $ sort triggers + + checkDuplicateTriggerName :: NonEmpty Name -> IO () + checkDuplicateTriggerName (trig :| dupTrigs) = + unless (null dupTrigs) $ + fail $ unlines + [ "The specification invokes the `" ++ trig ++ + "` trigger function multiple times," + , "which copilot-verifier does not currently support." + , "See https://github.com/Copilot-Language/copilot-verifier/issues/74." + ] + let triggerState = CW4.triggerState prfbundle + checkDuplicateTriggerNames $ map (\(nm,_,_) -> nm) triggerState + triggerGlobals <- mapM prepTrigger triggerState + + -- execute the step function + let overrides = zipWith (triggerOverride clRefs) triggerGlobals triggerState + mem'' <- executeStep opts csettings clRefs simctx memVar mem' llvmMod modTrans triggerGlobals overrides (CW4.assumptions prfbundle) (CW4.sideConds prfbundle) + + -- assert the poststate is in the relation + assertStateRelation bak clRefs mem'' + Log.PostStepStateRelation (CW4.postStreamState prfbundle) + + popUntilAssumptionFrame bak frm + + Log.sayCopilot $ Log.ProvingConditions Log.StepBisimulation + proveObls cruxOpts adapters clRefs Log.StepBisimulation simctx + + +-- | Set up the "trigger override" functions. These dummy functions +-- take the place of the external functions called by the Copilot +-- monitor when a guarded condition occurs. +-- +-- Each trigger statement has a corresponding global variable that +-- is used to record if the trigger function was called; initially +-- the global is false, and is set to true when the trigger function +-- is called. At the end of verification, we check that the value +-- of this global variable is true iff the corresponding trigger guard +-- condition is true. +-- +-- The other function of the trigger overrides is to check that, when called, +-- the functions are given the expected argument values. +-- +-- Otherwise, the override functions have no effects, which corresponds +-- to the assumption that the external environment makes no changes to the +-- program state that are observable to the Copilot monitor. +triggerOverride :: forall sym t arch msgs. + IsSymInterface sym => + Log.Logs msgs => + Log.SupportsCopilotLogMessage msgs => + (?memOpts :: MemOptions) => + (?lc :: TypeContext) => + (?intrinsicsOpts :: IntrinsicsOptions) => + (1 <= ArchWidth arch) => + HasPtrWidth (ArchWidth arch) => + HasLLVMAnn sym => + + CopilotLogRefs sym -> + (Name, GlobalVar NatType, Pred sym) -> + (Name, BoolExpr t, [(Some Type, CW4.XExpr sym)]) -> + OverrideTemplate (Crux sym) sym LLVM arch +triggerOverride clRefs (_,triggerGlobal,_) (nm, _guard, args) = + let args' = map toTypeRepr args in + case Ctx.fromList args' of + Some argCtx -> + basic_llvm_override $ + LLVMOverride decl argCtx UnitRepr $ + \memOps calledArgs -> + ovrWithBackend $ \bak -> + do let sym = backendGetSym bak + modifyGlobal triggerGlobal $ \count -> do + -- See Note [Global variables for trigger functions] + countPlusOne <- liftIO $ do + one <- natLit sym 1 + natAdd sym count one + pure ((), countPlusOne) + mem <- readGlobal memOps + liftIO $ checkArgs bak mem (toListFC Some calledArgs) args + return () + + where + decl = L.Declare + { L.decLinkage = Nothing + , L.decVisibility = Nothing + , L.decRetType = L.PrimType L.Void + , L.decName = L.Symbol nm + , L.decArgs = map llvmArgTy args + , L.decVarArgs = False + , L.decAttrs = [] + , L.decComdat = Nothing + } + + -- Use the `-CompositePtr` functions here to ensure that arguments with array + -- or struct types are treated as pointers. See Note [Arrays and structs]. + toTypeRepr (Some ctp, _) = llvmTypeAsRepr (copilotTypeToMemTypeCompositePtr (llvmDataLayout ?lc) ctp) Some + llvmArgTy (Some ctp, _) = copilotTypeToLLVMTypeCompositePtr ctp + + checkArgs :: forall bak. IsSymBackend sym bak => + bak -> MemImpl sym -> [Some (RegEntry sym)] -> [(Some Type, CW4.XExpr sym)] -> IO () + checkArgs bak mem = loop (0::Integer) + where + loop i (x:xs) ((ctp,v):vs) = checkArg bak mem i x ctp v >> loop (i+1) xs vs + loop _ [] [] = return () + loop _ _ _ = fail $ "Argument list mismatch in " ++ nm + + checkArg :: forall bak. IsSymBackend sym bak => + bak -> MemImpl sym -> Integer -> Some (RegEntry sym) -> Some Type -> CW4.XExpr sym -> IO () + checkArg bak mem i (Some (RegEntry tp v)) (Some ctp) x = + do let sym = backendGetSym bak + eq <- computeEqualVals bak clRefs mem ctp x tp v + (ann, eq') <- annotateTerm sym eq + let shortmsg = "Trigger " ++ show nm ++ " argument " ++ show i + let longmsg = show (printSymExpr eq') + let rsn = AssertFailureSimError shortmsg longmsg + loc <- getCurrentProgramLoc sym + modifyIORef' (verifierAssertionMapRef clRefs) + $ Map.insert (BoolAnn ann) + $ Log.TriggerArgumentEqualityAssertion + $ Log.SomeSome + $ Log.TriggerArgumentEquality sym loc nm i ctp x tp v + addDurableProofObligation bak (LabeledPred eq' (SimError loc rsn)) + + +-- | Actually execute the Crucible simulator on the generated "step" function. +-- This will record proof side-conditions into the symbolic backend, and +-- return the memory state corresponding to the function post-state. +-- +-- This function will record side-conditions that arise from the semantics +-- of C itself (e.g., memory is accessed in bounds and signed arithmetic +-- doesn't overflow) as well as the conditions related to trigger functions. +executeStep :: forall sym arch msgs. + IsSymInterface sym => + Log.Logs msgs => + Log.SupportsCruxLLVMLogMessage msgs => + Log.SupportsCopilotLogMessage msgs => + (?memOpts :: MemOptions) => + (?lc :: TypeContext) => + (?intrinsicsOpts :: IntrinsicsOptions) => + (1 <= ArchWidth arch) => + HasPtrWidth (ArchWidth arch) => + HasLLVMAnn sym => + + VerifierOptions -> + CSettings -> + CopilotLogRefs sym -> + SimCtxt Crux sym LLVM -> + GlobalVar Mem -> + MemImpl sym -> + L.Module -> + ModuleTranslation arch -> + [(Name, GlobalVar NatType, Pred sym)] -> + [OverrideTemplate (Crux sym) sym LLVM arch] -> + [Pred sym] {- User-provided property assumptions -} -> + [Pred sym] {- Side conditions related to partial operations -} -> + IO (MemImpl sym) +executeStep opts csettings clRefs simctx memVar mem llvmmod modTrans triggerGlobals triggerOverrides assums sideConds = + do globSt <- foldM setupTrigger (llvmGlobals memVar mem) triggerGlobals + let initSt = InitialState simctx globSt defaultAbortHandler memRepr $ + runOverrideSim memRepr runStep + res <- executeCrucible [] initSt + case res of + FinishedResult _ pr -> return (pr^.partialValue.gpValue.to regValue) + AbortedResult _ abortRes -> fail $ show $ ppAbortedResult abortRes + TimeoutResult{} -> fail "simulation timed out!" + + where + -- See Note [Global variables for trigger functions] + setupTrigger gs (_,gv,_) = do + zero <- liftIO $ natLit sym 0 + pure $ insertGlobal gv zero gs + llvm_ctx = modTrans ^. transContext + stepName = cSettingsStepFunctionName csettings + sym = simctx^.ctxSymInterface + + -- TODO, would be lovely to be able to do better than dummy positions for all these things + -- so we can correspond assumptions and asserts back to the parts of the original spec that + -- gave rise to them. + dummyLoc = mkProgramLoc "<>" InternalPos + + assumeProperty b = + withBackend simctx $ \bak -> + addAssumption bak (GenericAssumption dummyLoc "Property assumption" b) + + assumeSideCond b = + withBackend simctx $ \bak -> + addAssumption bak (GenericAssumption dummyLoc "Side condition for partial operation" b) + + ppAbortedResult :: AbortedResult sym ext -> PP.Doc ann + ppAbortedResult abortRes = + case gatherReasons abortRes of + reason :| [] -> reason + reasons -> PP.vcat $ "Simulation aborted for multiple reasons." + : NE.toList reasons + + gatherReasons :: AbortedResult sym ext -> NonEmpty (PP.Doc ann) + gatherReasons (AbortedExec rsn _) = + PP.vcat ["Simulation aborted!", ppAbortExecReason rsn] :| [] + gatherReasons (AbortedExit ec) = + PP.vcat ["Simulation called exit!", PP.viaShow ec] :| [] + gatherReasons (AbortedBranch _ _ t f) = + gatherReasons t <> gatherReasons f + + -- Simulator entry point + runStep :: OverrideSim (Crux sym) sym LLVM (RegEntry sym Mem) EmptyCtx Mem (MemImpl sym) + runStep = + do -- set up built-in functions and trigger overrides + _ <- register_llvm_overrides llvmmod [] triggerOverrides llvm_ctx + -- set up functions defined in the module + registerLazyModule sayTranslationWarning modTrans + + -- make any property assumptions + liftIO (mapM_ assumeProperty assums) + + -- assume side conditions related to partial operations + when (assumePartialSideConds opts) $ liftIO $ + mapM_ assumeSideCond sideConds + + -- look up and call the step function + mbCfg <- liftIO $ getTranslatedCFG modTrans (L.Symbol stepName) + () <- case mbCfg of + Just (_, AnyCFG anyCfg, warns) -> do + liftIO $ mapM_ sayTranslationWarning warns + case (cfgArgTypes anyCfg, cfgReturnType anyCfg) of + (Empty, UnitRepr) -> regValue <$> callCFG anyCfg emptyRegMap + _ -> fail $ unwords [show stepName, "should take no arguments and return void"] + Nothing -> fail $ unwords ["Could not find step function named", show stepName] + + -- Assert that the trigger functions were called exactly once iff the + -- associated guard condition was true. + -- See Note [Global variables for trigger functions]. + forM_ triggerGlobals $ \(nm, gv, guard) -> + do expectedCount <- liftIO $ do + one <- natLit sym 1 + zero <- natLit sym 0 + natIte sym guard one zero + actualCount <- readGlobal gv + eq <- liftIO $ natEq sym expectedCount actualCount + (ann, eq') <- liftIO $ annotateTerm sym eq + let shortmsg = "Trigger guard equality condition: " ++ show nm + let longmsg = show (printSymExpr eq') + let rsn = AssertFailureSimError shortmsg longmsg + liftIO + $ modifyIORef' (verifierAssertionMapRef clRefs) + $ Map.insert (BoolAnn ann) + $ Log.TriggersInvokedCorrespondinglyAssertion + $ Log.TriggersInvokedCorrespondingly dummyLoc nm expectedCount actualCount + withBackend simctx $ \bak -> + liftIO $ addDurableProofObligation bak (LabeledPred eq' (SimError dummyLoc rsn)) + + -- return the final state of the memory + readGlobal memVar + +-- | Given a bisimulation proof bundle and an empty initial state, +-- populate the global ring-buffer variables with abstract state +-- values, and write the abstract values of the external stream +-- values into their proper locations. +setupPrestate :: + IsSymBackend sym bak => + HasPtrWidth wptr => + HasLLVMAnn sym => + (?memOpts :: MemOptions) => + (?lc :: TypeContext) => + + bak -> + MemImpl sym -> + CW4.BisimulationProofBundle sym -> + IO (MemImpl sym) +setupPrestate bak mem0 prfbundle = + do mem' <- foldM setupStreamState mem0 (CW4.streamState (CW4.preStreamState prfbundle)) + foldM setupExternalInput mem' (CW4.externalInputs prfbundle) + + where + sym = backendGetSym bak + + sizeTStorage :: StorageType + sizeTStorage = bitvectorType (bitsToBytes (intValue ?ptrWidth)) + + setupExternalInput mem (nm, Some ctp, v) = + do -- Compute LLVM/Crucible type information from the Copilot type + let memTy = copilotTypeToMemTypeBool8 (llvmDataLayout ?lc) ctp + let typeAlign = memTypeAlign (llvmDataLayout ?lc) memTy + stType <- toStorableType memTy + Some typeRepr <- return (llvmTypeAsRepr memTy Some) + + -- resolve the global variable to a pointers + ptrVal <- doResolveGlobal bak mem (L.Symbol nm) + + -- write the value into the global + regVal <- copilotExprToRegValue sym v typeRepr + doStore bak mem ptrVal typeRepr stType typeAlign regVal + + setupStreamState mem (nm, Some ctp, vs) = + do -- TODO, should get these from somewhere inside copilot instead of building these names directly + let idxName = "s" ++ show nm ++ "_idx" + let bufName = "s" ++ show nm + let buflen = genericLength vs :: Integer + + -- Compute LLVM/Crucible type information from the Copilot type + let memTy = copilotTypeToMemTypeBool8 (llvmDataLayout ?lc) ctp + let typeLen = memTypeSize (llvmDataLayout ?lc) memTy + let typeAlign = memTypeAlign (llvmDataLayout ?lc) memTy + stType <- toStorableType memTy + Some typeRepr <- return (llvmTypeAsRepr memTy Some) + + -- Resolve the global names into base pointers + idxPtr <- doResolveGlobal bak mem (L.Symbol idxName) + bufPtr <- doResolveGlobal bak mem (L.Symbol bufName) + + -- Create a fresh index value in the proper range + idxVal <- freshBoundedBV sym (safeSymbol idxName) ?ptrWidth + (Just 0) (Just (fromIntegral (buflen - 1))) + idxVal' <- llvmPointer_bv sym idxVal + + -- store the index value in the correct location + let sizeTAlign = memTypeAlign (llvmDataLayout ?lc) (IntType (natValue ?ptrWidth)) + mem' <- doStore bak mem idxPtr (LLVMPointerRepr ?ptrWidth) sizeTStorage sizeTAlign idxVal' + + buflen' <- bvLit sym ?ptrWidth (BV.mkBV ?ptrWidth buflen) + typeLen' <- bvLit sym ?ptrWidth (BV.mkBV ?ptrWidth (toInteger typeLen)) + + -- Write each value of the stream ring buffer into its correct location + flip execStateT mem' $ + forM_ (zip vs [0 ..]) $ \(v,i) -> + do ptrVal <- lift $ + do x1 <- bvAdd sym idxVal =<< bvLit sym ?ptrWidth (BV.mkBV ?ptrWidth i) + x2 <- bvUrem sym x1 buflen' + x3 <- bvMul sym x2 typeLen' + ptrAdd sym ?ptrWidth bufPtr x3 + + regVal <- lift $ copilotExprToRegValue sym v typeRepr + StateT $ \m -> + do m' <- doStore bak m ptrVal typeRepr stType typeAlign regVal + return ((),m') + +-- | Given a memory image and a "proof state", assert that the global values +-- for each stream ring buffer have values that correspond to the given +-- stream state. This collection of assertions defines the bisimulation +-- relation. +assertStateRelation :: + IsSymBackend sym bak => + Log.Logs msgs => + HasPtrWidth wptr => + HasLLVMAnn sym => + (?memOpts :: MemOptions) => + (?lc :: TypeContext) => + bak -> + CopilotLogRefs sym -> + MemImpl sym -> + Log.StateRelationStep -> + CW4.BisimulationProofState sym -> + IO () +assertStateRelation bak clRefs mem stateRelStep prfst = + -- For each stream in the proof state, assert that the + -- generated ring buffer global contains the corresponding + -- values. + forM_ (CW4.streamState prfst) assertStreamState + + where + sym = backendGetSym bak + + sizeTStorage :: StorageType + sizeTStorage = bitvectorType (bitsToBytes (intValue ?ptrWidth)) + + assertStreamState (nm, Some ctp, vs) = + do -- TODO, should get these from somewhere inside copilot instead of building these names directly + let idxName = "s" ++ show nm ++ "_idx" + let bufName = "s" ++ show nm + let buflen = genericLength vs :: Integer + + -- Compute LLVM/Crucible type information from the Copilot type + let memTy = copilotTypeToMemTypeBool8 (llvmDataLayout ?lc) ctp + let typeLen = memTypeSize (llvmDataLayout ?lc) memTy + let typeAlign = memTypeAlign (llvmDataLayout ?lc) memTy + stType <- toStorableType memTy + Some typeRepr <- return (llvmTypeAsRepr memTy Some) + + -- Resolve the global names into base pointers + idxPtr <- doResolveGlobal bak mem (L.Symbol idxName) + bufPtr <- doResolveGlobal bak mem (L.Symbol bufName) + + -- read the value of the ring buffer index + let sizeTAlign = memTypeAlign (llvmDataLayout ?lc) (IntType (natValue ?ptrWidth)) + (bannIdxVal, pIdxVal, idxVal) <- + doLoadWithAnn bak mem idxPtr sizeTStorage (LLVMPointerRepr ?ptrWidth) sizeTAlign + idxVal' <- projectLLVM_bv bak idxVal + locIdxVal <- getCurrentProgramLoc sym + modifyIORef' (verifierAssertionMapRef clRefs) + $ Map.insert bannIdxVal + $ Log.RingBufferIndexLoadAssertion + $ Log.RingBufferIndexLoad sym stateRelStep locIdxVal (Text.pack idxName) pIdxVal + + buflen' <- bvLit sym ?ptrWidth (BV.mkBV ?ptrWidth buflen) + typeLen' <- bvLit sym ?ptrWidth (BV.mkBV ?ptrWidth (toInteger typeLen)) + + -- For each value in the stream description, read a corresponding value from + -- memory and assert that they are equal. + forM_ (zip vs [0 ..]) $ \(v,i) -> + do ptrVal <- + do x1 <- bvAdd sym idxVal' =<< bvLit sym ?ptrWidth (BV.mkBV ?ptrWidth i) + x2 <- bvUrem sym x1 buflen' + x3 <- bvMul sym x2 typeLen' + ptrAdd sym ?ptrWidth bufPtr x3 + + (bannv', pv', v') <- doLoadWithAnn bak mem ptrVal stType typeRepr typeAlign + locv' <- getCurrentProgramLoc sym + let bufNameT = Text.pack bufName + modifyIORef' (verifierAssertionMapRef clRefs) + $ Map.insert bannv' + $ Log.RingBufferLoadAssertion + $ Log.SomeSome + $ Log.RingBufferLoad sym stateRelStep locv' bufNameT i buflen ctp typeRepr pv' + eq <- computeEqualVals bak clRefs mem ctp v typeRepr v' + (ann, eq') <- annotateTerm sym eq + let shortmsg = "State equality condition: " ++ show nm ++ " index value " ++ show i + let longmsg = show (printSymExpr eq') + let rsn = AssertFailureSimError shortmsg longmsg + let loc = mkProgramLoc "<>" InternalPos + modifyIORef' (verifierAssertionMapRef clRefs) + $ Map.insert (BoolAnn ann) + $ Log.StreamValueEqualityAssertion + $ Log.SomeSome + $ Log.StreamValueEquality sym stateRelStep loc bufNameT i buflen ctp v typeRepr v' + addDurableProofObligation bak (LabeledPred eq' (SimError loc rsn)) + + return () + +-- | Translate the @XExpr@ values from the "Copilot.Theorem.What4" module into +-- Crucible @RegValue@s suitable for injection into the Crucible simulator. +copilotExprToRegValue :: forall sym tp. + IsSymInterface sym => + sym -> + CW4.XExpr sym -> + TypeRepr tp -> + IO (RegValue sym tp) +copilotExprToRegValue sym = loop + where + loop :: forall tp'. CW4.XExpr sym -> TypeRepr tp' -> IO (RegValue sym tp') + + loop (CW4.XBool b) (LLVMPointerRepr w) | Just Refl <- testEquality w (knownNat @1) = + llvmPointer_bv sym =<< predToBV sym b knownRepr + loop (CW4.XBool b) (LLVMPointerRepr w) | Just Refl <- testEquality w (knownNat @8) = + llvmPointer_bv sym =<< predToBV sym b knownRepr + loop (CW4.XInt8 x) (LLVMPointerRepr w) | Just Refl <- testEquality w (knownNat @8) = + llvmPointer_bv sym x + loop (CW4.XInt16 x) (LLVMPointerRepr w) | Just Refl <- testEquality w (knownNat @16) = + llvmPointer_bv sym x + loop (CW4.XInt32 x) (LLVMPointerRepr w) | Just Refl <- testEquality w (knownNat @32) = + llvmPointer_bv sym x + loop (CW4.XInt64 x) (LLVMPointerRepr w) | Just Refl <- testEquality w (knownNat @64) = + llvmPointer_bv sym x + loop (CW4.XWord8 x) (LLVMPointerRepr w) | Just Refl <- testEquality w (knownNat @8) = + llvmPointer_bv sym x + loop (CW4.XWord16 x) (LLVMPointerRepr w) | Just Refl <- testEquality w (knownNat @16) = + llvmPointer_bv sym x + loop (CW4.XWord32 x) (LLVMPointerRepr w) | Just Refl <- testEquality w (knownNat @32) = + llvmPointer_bv sym x + loop (CW4.XWord64 x) (LLVMPointerRepr w) | Just Refl <- testEquality w (knownNat @64) = + llvmPointer_bv sym x + + loop (CW4.XFloat x) (FloatRepr SingleFloatRepr) = return x + loop (CW4.XDouble x) (FloatRepr DoubleFloatRepr) = return x + + loop (CW4.XEmptyArray _ctp) (VectorRepr _tpr) = + pure V.empty + loop (CW4.XArray xs) (VectorRepr tpr) = + V.generateM (PVec.lengthInt xs) (\i -> loop (PVec.elemAtUnsafe i xs) tpr) + loop (CW4.XStruct xs) (StructRepr ctx) = + Ctx.traverseWithIndex + (\i tpr -> RV <$> loop (xs !! Ctx.indexVal i) tpr) + ctx + + loop x tpr = + fail $ unlines ["Mismatch between Copilot value and crucible value", show x, show tpr] + + +-- | Given an @XExpr@ from from the "Copilot.Theorem.What4" module, and +-- a Crucible @RegValue@ which is expected to match, compute an equality +-- predicate between the values. The Crucible values may be pointers, +-- requiring us to resolve the indirection through memory; this is necessary +-- for array and struct values, but would also work for scalars. +computeEqualVals :: forall sym bak tp a wptr. + IsSymBackend sym bak => + HasPtrWidth wptr => + HasLLVMAnn sym => + (?lc :: TypeContext) => + (?memOpts :: MemOptions) => + bak -> + CopilotLogRefs sym -> + MemImpl sym -> + Type a -> + CW4.XExpr sym -> + TypeRepr tp -> + RegValue sym tp -> + IO (Pred sym) +computeEqualVals bak clRefs mem = loop + where + sym = backendGetSym bak + + loop :: forall tp' a'. Type a' -> CW4.XExpr sym -> TypeRepr tp' -> RegValue sym tp' -> IO (Pred sym) + loop Bool (CW4.XBool b) (LLVMPointerRepr w) v | Just Refl <- testEquality w (knownNat @1) = + isEq sym b =<< bvIsNonzero sym =<< projectLLVM_bv bak v + loop Bool (CW4.XBool b) (LLVMPointerRepr w) v | Just Refl <- testEquality w (knownNat @8) = + isEq sym b =<< bvIsNonzero sym =<< projectLLVM_bv bak v + loop Int8 (CW4.XInt8 x) (LLVMPointerRepr w) v | Just Refl <- testEquality w (knownNat @8) = + bvEq sym x =<< projectLLVM_bv bak v + loop Int16 (CW4.XInt16 x) (LLVMPointerRepr w) v | Just Refl <- testEquality w (knownNat @16) = + bvEq sym x =<< projectLLVM_bv bak v + loop Int32 (CW4.XInt32 x) (LLVMPointerRepr w) v | Just Refl <- testEquality w (knownNat @32) = + bvEq sym x =<< projectLLVM_bv bak v + loop Int64 (CW4.XInt64 x) (LLVMPointerRepr w) v | Just Refl <- testEquality w (knownNat @64) = + bvEq sym x =<< projectLLVM_bv bak v + loop Word8 (CW4.XWord8 x) (LLVMPointerRepr w) v | Just Refl <- testEquality w (knownNat @8) = + bvEq sym x =<< projectLLVM_bv bak v + loop Word16 (CW4.XWord16 x) (LLVMPointerRepr w) v | Just Refl <- testEquality w (knownNat @16) = + bvEq sym x =<< projectLLVM_bv bak v + loop Word32 (CW4.XWord32 x) (LLVMPointerRepr w) v | Just Refl <- testEquality w (knownNat @32) = + bvEq sym x =<< projectLLVM_bv bak v + loop Word64 (CW4.XWord64 x) (LLVMPointerRepr w) v | Just Refl <- testEquality w (knownNat @64) = + bvEq sym x =<< projectLLVM_bv bak v + + loop Float (CW4.XFloat x) (FloatRepr SingleFloatRepr) v = iFloatEq @_ @SingleFloat sym x v + loop Double (CW4.XDouble x) (FloatRepr DoubleFloatRepr) v = iFloatEq @_ @DoubleFloat sym x v + + loop (Array _ctp) (CW4.XEmptyArray _ctp2) (VectorRepr _tpr) vs = + pure $ backendPred sym $ V.null vs + loop (Array ctp) (CW4.XArray xs) (VectorRepr tpr) vs + | PVec.lengthInt xs == V.length vs + = V.ifoldM (\pAcc i v -> andPred sym pAcc =<< loop ctp (PVec.elemAtUnsafe i xs) tpr v) + (truePred sym) vs + | otherwise + = pure (falsePred sym) + loop (Struct struct) (CW4.XStruct xs) (StructRepr ctx) vs + | length copilotVals == Ctx.sizeInt (Ctx.size vs) + = ifoldlMFC (\i pAcc tpr -> + case copilotVals !! Ctx.indexVal i of + (Value ctp _, x) -> + andPred sym pAcc =<< loop ctp x tpr (unRV (vs Ctx.! i))) + (truePred sym) ctx + | otherwise + = pure (falsePred sym) + where + copilotVals :: [(Value a', CW4.XExpr sym)] + copilotVals = zip (toValues struct) xs + + -- If we encounter a pointer, read the memory that it points to and recurse, + -- using the Copilot type as a guide for how much memory to read. This is + -- needed to make array- or struct-typed arguments work (see + -- Note [Arrays and structs]), although there is nothing about this code + -- that is array- or struct-specific. In fact, this code could also work + -- for pointer arguments of any other type. + loop ctp x PtrRepr v = + do let memTy = copilotTypeToMemTypeBool8 (llvmDataLayout ?lc) ctp + typeAlign = memTypeAlign (llvmDataLayout ?lc) memTy + stp <- toStorableType memTy + llvmTypeAsRepr memTy $ \tpr -> + do loc <- getCurrentProgramLoc sym + (bann, p, regVal) <- doLoadWithAnn bak mem v stp tpr typeAlign + modifyIORef' (verifierAssertionMapRef clRefs) + $ Map.insert bann + $ Log.PointerArgumentLoadAssertion + $ Log.SomeSome + $ Log.PointerArgumentLoad sym loc ctp tpr p + loop ctp x tpr regVal + + loop _ctp x tpr _v = + fail $ unlines ["Mismatch between Copilot value and crucible value", show x, show tpr] + +-- | Convert a Copilot 'CT.Type' to a Crucible 'MemType'. 'CT.Bool's are +-- assumed to be one bit in size. See @Note [How LLVM represents bool]@. +copilotTypeToMemType :: + DataLayout -> + CT.Type a -> + MemType +copilotTypeToMemType dl = loop + where + loop :: forall t. CT.Type t -> MemType + loop CT.Bool = i1 + loop CT.Int8 = i8 + loop CT.Int16 = i16 + loop CT.Int32 = i32 + loop CT.Int64 = i64 + loop CT.Word8 = i8 + loop CT.Word16 = i16 + loop CT.Word32 = i32 + loop CT.Word64 = i64 + loop CT.Float = FloatType + loop CT.Double = DoubleType + loop t0@(CT.Array tp) = + let len = fromIntegral (typeLength t0) in + ArrayType len (copilotTypeToMemTypeBool8 dl tp) + loop (CT.Struct v) = + StructType (mkStructInfo dl False (map val (CT.toValues v))) + + val :: forall t. CT.Value t -> MemType + val (CT.Value tp _) = copilotTypeToMemTypeBool8 dl tp + +-- | Like 'copilotTypeToMemType', except that 'CT.Bool's are assumed to be +-- eight bits, not one bit. See @Note [How LLVM represents bool]@. +copilotTypeToMemTypeBool8 :: + DataLayout -> + CT.Type a -> + MemType +copilotTypeToMemTypeBool8 _dl CT.Bool = i8 +copilotTypeToMemTypeBool8 dl tp = copilotTypeToMemType dl tp + +-- | Like 'copilotTypeToMemType', except that composite types (i.e., +-- 'CT.Array's and 'CT.Struct's) are converted to 'PtrType's instead of direct +-- 'ArrayType's or 'StructType's. See @Note [Arrays and structs]@. +copilotTypeToMemTypeCompositePtr :: + DataLayout -> + CT.Type a -> + MemType +copilotTypeToMemTypeCompositePtr dl (CT.Array tp) = + PtrType (MemType (copilotTypeToMemTypeBool8 dl tp)) +copilotTypeToMemTypeCompositePtr _dl (CT.Struct struct) = + PtrType (Alias (copilotStructIdent struct)) +copilotTypeToMemTypeCompositePtr dl tp = copilotTypeToMemType dl tp + +-- | Convert a Copilot 'CT.Type' to an LLVM 'L.Type'. 'CT.Bool's are +-- assumed to be one bit in size. See @Note [How LLVM represents bool]@. +copilotTypeToLLVMType :: + CT.Type a -> + L.Type +copilotTypeToLLVMType = loop + where + loop :: forall t. CT.Type t -> L.Type + loop CT.Bool = L.PrimType (L.Integer 1) + loop CT.Int8 = L.PrimType (L.Integer 8) + loop CT.Int16 = L.PrimType (L.Integer 16) + loop CT.Int32 = L.PrimType (L.Integer 32) + loop CT.Int64 = L.PrimType (L.Integer 64) + loop CT.Word8 = L.PrimType (L.Integer 8) + loop CT.Word16 = L.PrimType (L.Integer 16) + loop CT.Word32 = L.PrimType (L.Integer 32) + loop CT.Word64 = L.PrimType (L.Integer 64) + loop CT.Float = L.PrimType (L.FloatType L.Float) + loop CT.Double = L.PrimType (L.FloatType L.Double) + loop t0@(CT.Array tp) = + let len = fromIntegral (typeLength t0) in + L.Array len (copilotTypeToLLVMTypeBool8 tp) + loop (CT.Struct v) = + -- NB: Don't use L.Struct here. That represents a literal, unnamed + -- struct, but all of the structs used in a copilot-c99 program are + -- named structs. As such, we must identify the struct by its alias. + L.Alias (copilotStructIdent v) + +-- | Like 'copilotTypeToLLVMType', except that 'CT.Bool's are assumed to be +-- eight bits, not one bit. See @Note [How LLVM represents bool]@. +copilotTypeToLLVMTypeBool8 :: + CT.Type a -> + L.Type +copilotTypeToLLVMTypeBool8 CT.Bool = L.PrimType (L.Integer 8) +copilotTypeToLLVMTypeBool8 tp = copilotTypeToLLVMType tp + +-- | Like 'copilotTypeToLLVMType', except that composite types (i.e., +-- 'CT.Array's and 'CT.Struct's) are given special treatment involving +-- pointers. See @Note [Arrays and structs]@. +copilotTypeToLLVMTypeCompositePtr :: + CT.Type a -> + L.Type +copilotTypeToLLVMTypeCompositePtr (CT.Array tp) = + L.PtrTo (copilotTypeToLLVMTypeBool8 tp) +copilotTypeToLLVMTypeCompositePtr (CT.Struct struct) = + L.PtrTo (L.Alias (copilotStructIdent struct)) +copilotTypeToLLVMTypeCompositePtr tp = copilotTypeToLLVMType tp + +-- | Given a struct @s@, construct the name @struct.s@ as an LLVM identifier. +copilotStructIdent :: Struct a => a -> L.Ident +copilotStructIdent struct = L.Ident $ "struct." ++ typeName struct + +{- +Note [How LLVM represents bool] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +How are C values of type `bool` represented in LLVM? It depends. If it's being +stored directly a `bool`, it's represented with `i1` (i.e., a single bit). If +a `bool` is a member of some composite type, such as a pointer, array, or +struct, however, it's representing with `i8` (i.e., eight bits). This means +that we have to be careful when converting Bool-typed Copilot values, as they +can become `i1` or `i8` depending on the context. + +copilot-verifier handles this by having both `copilotTypeToLLVMType` and +`copilotTypeToLLVMTypeBool8` functions. The former function treats `bool`s as +`i1`, whereas the latter treats `bool`s as `i8`. The former is used when +converting "top-level" types (e.g., the argument types in a trigger override), +whereas the latter is used when converting types that are part of a larger +composite type (e.g., the element type in an array). + +The story for the `copilotTypeToMemType` and `copilotTypeToMemTypeBool8` +functions is similar. + +Note [Arrays and structs] +~~~~~~~~~~~~~~~~~~~~~~~~~ +When Clang compiles a function with an array argument, such as this trigger +function: + + void func(int32_t func_arg0[2]) { ... } + +It will produce the following LLVM code: + + declare void @func(i32*) { ... } + +Note that the argument is an i32*, not a [2 x i32]. As a result, we can't +translate Copilot array types directly to LLVM array types when they're used as +arguments to a function. This impedance mismatch is handled in two places: + +1. The `copilotTypeToMemTypeCompositePtr`/`copilotTypeToLLVMTypeCompositePtr` + functions special-case Copilot arrays such that they are translated to + pointers. These functions are used when declaring the argument types of an + override for a trigger function (see `triggerOverride`). +2. The `computeEqualVals` function has a special case for pointer + arguments—see the case that matches on `PtrRepr`. When a `PtrRepr` is + encountered, the underlying array values that it points to are read from + memory. Because `PtrRepr` doesn't record the type of the thing being pointed + to, `computeEqualVals` uses the corresponding Copilot type as a guide to + determine how much memory to read and at what type the memory should be + used. After this, `computeEqualVals` reads from the read array + element-by-element—see the `VectorRepr` cases. + + Note that unlike `computeEqualVals`, `copilotExprToRegValue` does not need + a `PtrRepr` case. This is because `copilotExprToRegValue` is ultimately used + in service of calling writing elements of streams to memory, and streams do + not store pointer values (at least, not in today's Copilot). + +There is a very similar story for structs. Copilot passes structs by reference +in trigger functions (e.g., `void trigger(struct s *ss)`), so we must also load +from a `PtrRepr` in `computeEqualVals` to handle structs. + +See Note [Global variables for trigger functions] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +As part of verifying that the behavior of a Copilot specification's trigger +functions behave the same way as the trigger functions in the corresponding C +program, we check that each trigger function in the C program is invoked the +appropriate number of times. That is, if the guard condition for a trigger is +true, the C trigger function should be invoked exactly once, and if the guard +condition is false, then the trigger function should not be invoked at all. + +To check this, we create a Nat-valued global variable for each trigger function +and initialize it to zero. Whenever we simulate a trigger function, we increment +the value of the corresponding global variable. At the end of simulation, we +check that the value in each global variable is equal to +`if guard_cond then 1 else 0`. +-} + +-- | Like @crucible-llvm@'s @doLoad@, but with the following differences: +-- +-- * This function returns the 'BoolAnn' and 'Pred' asserting the validity of +-- the load, which the verifier needs for logging purposes. +-- +-- * This always generates a durable proof goal so that Crucible will always +-- record it, even if it is trivial. +doLoadWithAnn :: + ( IsSymBackend sym bak, HasPtrWidth wptr, HasLLVMAnn sym + , ?memOpts :: MemOptions ) => + bak -> + MemImpl sym -> + LLVMPtr sym wptr {- ^ pointer to load from -} -> + StorageType {- ^ type of value to load -} -> + TypeRepr tp {- ^ crucible type of the result -} -> + Alignment {- ^ assumed pointer alignment -} -> + IO (BoolAnn sym, Pred sym, RegValue sym tp) +doLoadWithAnn bak mem ptr valType tpr alignment = do + partLLVMVal <- loadRaw sym mem ptr valType alignment + (bann, p, llvmVal) <- assertSafeWithAnn bak partLLVMVal + regVal <- unpackMemValue sym tpr llvmVal + pure (bann, p, regVal) + where + sym = backendGetSym bak + +-- | Like @crucible-llvm@'s @assertSafe@, but with the following differences: +-- +-- * This function returns the 'BoolAnn' and 'Pred' corresponding to the +-- assertion, which the verifier needs for logging purposes. +-- +-- * This generates a durable assertion so that Crucible will always record it, +-- even if it is trivial. +assertSafeWithAnn :: + IsSymBackend sym bak => + bak -> + PartLLVMVal sym -> + IO (BoolAnn sym, Pred sym, LLVMVal sym) +assertSafeWithAnn bak partVal = do + loc <- getCurrentProgramLoc sym + let err = SimError loc rsn + case partVal of + NoErr p v -> do + (ann, p') <- annotateTerm sym p + addDurableAssertion bak (LabeledPred p' err) + return (BoolAnn ann, p', v) + Err p -> do + (_ann, p') <- annotateTerm sym p + addDurableProofObligation bak (LabeledPred p' err) + abortExecBecause (AssertionFailure err) + where + rsn = AssertFailureSimError "Error during memory load" "" + sym = backendGetSym bak + +-- | Given a simulator state, extract any collected proof obligations, +-- attempt to prove them, and present the results to the user. +-- +-- Afterward, the simulator state will be cleared of any proof obligations, +-- regardless of if they could all be proved. +proveObls :: + IsSymInterface sym => + sym ~ ExprBuilder t st fs => + Log.Logs msgs => + Log.SupportsCruxLogMessage msgs => + Log.SupportsCopilotLogMessage msgs => + CruxOptions -> + [SolverAdapter st] -> + CopilotLogRefs sym -> + Log.VerificationStep -> + SimCtxt Crux sym LLVM -> + IO Integer +proveObls cruxOpts adapters clRefs step simctx = + withBackend simctx $ \bak -> + do let sym = backendGetSym bak + obls <- getProofObligations bak + clearProofObligations bak + +-- mapM_ (print . ppSimError) (summarizeObls sym obls) + + vaMap <- readIORef $ verifierAssertionMapRef clRefs + let laMapRef = llvmAnnMapRef clRefs + laMap <- readIORef laMapRef + results <- proveGoalsOffline adapters cruxOpts simctx (explainFailure sym laMapRef) obls + presentResults sym vaMap laMap step results + +{- +summarizeObls :: sym -> ProofObligations sym -> [SimError] +summarizeObls _ Nothing = [] +summarizeObls _ (Just obls) = map (view labeledPredMsg . proofGoal) (goalsToList obls) +-} + +-- | Compute the number of goals that were proven during verification, logging +-- the goals as they are proven. If all goals are proven successfully, return +-- the number of goals. Otherwise, log the failing proof goals and abort. +presentResults :: + Log.Logs msgs => + Log.SupportsCopilotLogMessage msgs => + IsSymInterface sym => + sym -> + Map.Map (BoolAnn sym) (Log.VerifierAssertion sym) -> + LLVMAnnMap sym -> + Log.VerificationStep -> + (ProcessedGoals, Maybe (Goals (Assumptions sym) (Assertion sym, [ProgramLoc], ProofResult sym))) -> + IO Integer +presentResults sym vaMap laMap step (num, goals) + | numTotalGoals == 0 + = do Log.sayCopilot Log.AllGoalsProved + pure 0 + + -- All goals were proven + | numProvedGoals == numTotalGoals + = do traverse_ (logVerifierAssertions sym vaMap laMap step num) goals + printGoals + pure numProvedGoals + + -- There were some unproved goals, so fail with exit code 1 + | otherwise + = do printGoals + exitFailure + where + numTotalGoals = totalProcessedGoals num + numProvedGoals = provedGoals num + + printGoals = + do Log.sayCopilot $ Log.OnlySomeGoalsProved numProvedGoals numTotalGoals + goals' <- provedGoalsTree sym goals + case goals' of + Just g -> Log.logGoal g + Nothing -> return () + +-- | Upon a successful verification, log the various assertions that the +-- verifier makes. These assertions will be visible in the output if the +-- 'verbosity' is set to 'Noisy'. +logVerifierAssertions :: + forall sym msgs. + IsSymInterface sym => + Log.Logs msgs => + Log.SupportsCopilotLogMessage msgs => + sym -> + Map.Map (BoolAnn sym) (Log.VerifierAssertion sym) -> + LLVMAnnMap sym -> + Log.VerificationStep -> + ProcessedGoals -> + Goals (Assumptions sym) (Assertion sym, [ProgramLoc], ProofResult sym) -> + IO () +logVerifierAssertions sym vaMap laMap step num goals = void $ go 0 goals + where + numTotalGoals = totalProcessedGoals num + + go :: Integer -> + Goals (Assumptions sym) (Assertion sym, [ProgramLoc], ProofResult sym) -> + IO Integer + go goalIdx gs = + case gs of + Assuming _ gs' -> + go goalIdx gs' + + Prove (gl, locs, _) -> do + let p = gl^.labeledPred + nearestLoc = nearestProgramLoc locs + + -- First, obtain the verifier assertion. + va <- case getAnnotation sym p of + -- If the assertion has a BoolAnn, look it up in the assertion maps + -- that we have accumulated during verification. + Just ann + | Just va <- Map.lookup (BoolAnn ann) vaMap + -> pure va + | Just (stk, bb) <- Map.lookup (BoolAnn ann) laMap + -> pure $ Log.LLVMBadBehaviorCheckAssertion + $ Log.LLVMBadBehaviorCheck sym nearestLoc stk bb p + | otherwise + -> fail $ unlines + [ "Cannot find BoolAnn for assertion" + , show $ gl^.labeledPredMsg + , show $ printSymExpr p + ] + -- If the assertion does not have a BoolAnn, fall back to using + -- heuristics to guess what kind of assertion it is. + Nothing -> pure $ verifierAssertionHeuristics sym nearestLoc p + + -- Log the assertion. + case va of + Log.StreamValueEqualityAssertion (Log.SomeSome a) -> + Log.sayCopilot $ + Log.StreamValueEqualityProofGoal step goalIdx numTotalGoals a + Log.TriggersInvokedCorrespondinglyAssertion a -> + Log.sayCopilot $ + Log.TriggersInvokedCorrespondinglyProofGoal step goalIdx numTotalGoals a + Log.TriggerArgumentEqualityAssertion (Log.SomeSome a) -> + Log.sayCopilot $ + Log.TriggerArgumentEqualityProofGoal step goalIdx numTotalGoals a + Log.RingBufferLoadAssertion (Log.SomeSome a) -> + Log.sayCopilot $ + Log.RingBufferLoadProofGoal step goalIdx numTotalGoals a + Log.RingBufferIndexLoadAssertion a -> + Log.sayCopilot $ + Log.RingBufferIndexLoadProofGoal step goalIdx numTotalGoals a + Log.PointerArgumentLoadAssertion (Log.SomeSome a) -> + Log.sayCopilot $ + Log.PointerArgumentLoadProofGoal step goalIdx numTotalGoals a + Log.AccessorFunctionLoadAssertion a -> + Log.sayCopilot $ + Log.AccessorFunctionLoadProofGoal step goalIdx numTotalGoals a + Log.GuardFunctionLoadAssertion a -> + Log.sayCopilot $ + Log.GuardFunctionLoadProofGoal step goalIdx numTotalGoals a + Log.UnknownFunctionLoadAssertion a -> + Log.sayCopilot $ + Log.UnknownFunctionLoadProofGoal step goalIdx numTotalGoals a + Log.LLVMBadBehaviorCheckAssertion a -> + Log.sayCopilot $ + Log.LLVMBadBehaviorCheckProofGoal step goalIdx numTotalGoals a + + -- Finally, return the current goal index. + pure goalIdx + + ProveConj gs1 gs2 -> do + goalIdx' <- go goalIdx gs1 + go (goalIdx' + 1) gs2 + +-- | If a verifier assertion does not have a corresponding 'BoolAnn', then we +-- must use heuristics to guess what kind of assertion it is. These heuristics +-- are not perfect, and we fall back to 'Log.UnknownFunctionLoad' in the event +-- that we cannot figure out a more obvious cause for the assertion. +verifierAssertionHeuristics :: + IsSymInterface sym => + sym -> + ProgramLoc -> + Pred sym -> + Log.VerifierAssertion sym +verifierAssertionHeuristics sym loc p + | "_get" `Text.isSuffixOf` functionName funName + = Log.AccessorFunctionLoadAssertion $ + Log.AccessorFunctionLoad sym loc funName p + + | "_guard" `Text.isSuffixOf` functionName funName + = Log.GuardFunctionLoadAssertion $ + Log.GuardFunctionLoad sym loc funName p + + | otherwise + = Log.UnknownFunctionLoadAssertion $ + Log.UnknownFunctionLoad sym loc funName p + where + funName = plFunction loc + +-- | Pick the most recent 'ProgramLoc' in a trace of locations. If there are +-- no locations available, return a dummy location. +nearestProgramLoc :: [ProgramLoc] -> ProgramLoc +nearestProgramLoc locs = + case locs of + loc:_ -> loc + _ -> mkProgramLoc "<>" InternalPos + +-- | A collection of 'IORef's used to accumulate log messages that the verifier +-- may display at the end of verification. +data CopilotLogRefs sym = CopilotLogRefs + { verifierAssertionMapRef :: !(IORef (Map.Map (BoolAnn sym) (Log.VerifierAssertion sym))) + -- ^ A map of 'BoolAnn's (i.e., unique numbers) to 'Log.VerifierAssertions'. + , llvmAnnMapRef :: !(IORef (LLVMAnnMap sym)) + -- ^ A map of 'BoolAnn's (i.e., unique numbers) to assertions about checks + -- for bad behavior in LLVM. + + -- This is kept in a separate 'IORef' for technical reasons, as + -- @crucible-llvm@'s 'explainFailure' function expects this 'IORef' as an + -- argument. We could put everything into 'verifierAssertionMapRef', but + -- that would require some tiresome 'IORef' massaging to make work. + } + +-- | Create a new 'CopilotLogRefs' value. +newCopilotLogRefs :: IsSymInterface sym => IO (CopilotLogRefs sym) +newCopilotLogRefs = do + vaMapRef <- newIORef mempty + laMapRef <- newIORef mempty + pure $ CopilotLogRefs + { verifierAssertionMapRef = vaMapRef + , llvmAnnMapRef = laMapRef + } + +data CopilotLogging + = LoggingCrux Log.CruxLogMessage + | LoggingCruxLLVM Log.CruxLLVMLogMessage + | LoggingCopilot Log.CopilotLogMessage + deriving stock Generic + deriving anyclass ToJSON + +copilotLoggingToSayWhat :: CopilotLogging -> Log.SayWhat +copilotLoggingToSayWhat (LoggingCrux msg) = Log.cruxLogMessageToSayWhat msg +copilotLoggingToSayWhat (LoggingCruxLLVM msg) = Log.cruxLLVMLogMessageToSayWhat msg +copilotLoggingToSayWhat (LoggingCopilot msg) = Log.copilotLogMessageToSayWhat msg + +withCopilotLogging :: + ( ( Log.SupportsCruxLogMessage CopilotLogging + , Log.SupportsCruxLLVMLogMessage CopilotLogging + , Log.SupportsCopilotLogMessage CopilotLogging + ) => computation ) -> + computation +withCopilotLogging computation = do + let ?injectCruxLogMessage = LoggingCrux + ?injectCruxLLVMLogMessage = LoggingCruxLLVM + ?injectCopilotLogMessage = LoggingCopilot + in computation + +sayTranslationWarning :: + Log.Logs msgs => + Log.SupportsCruxLLVMLogMessage msgs => + LLVMTranslationWarning -> IO () +sayTranslationWarning = Log.sayCruxLLVM . f + where + f (LLVMTranslationWarning s p msg) = + Log.TranslationWarning (Text.pack (show (ppSymbol s))) (Text.pack (show p)) msg diff --git a/copilot-verifier/src/Copilot/Verifier/FloatMode.hs b/copilot-verifier/src/Copilot/Verifier/FloatMode.hs new file mode 100644 index 000000000..7d2f62786 --- /dev/null +++ b/copilot-verifier/src/Copilot/Verifier/FloatMode.hs @@ -0,0 +1,56 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE RankNTypes #-} + +module Copilot.Verifier.FloatMode + ( FloatMode(..) + , withFloatMode + , withInterpretedFloatExprBuilder + ) where + +import qualified What4.Expr.Builder as W4 +import qualified What4.InterpretedFloatingPoint as W4 + +-- | How the verifier should interpret floating-point operations. +data FloatMode + = -- | Floating-point values are treated as bitvectors of the appropriate + -- width, and all operations on them are translated as uninterpreted + -- functions. This is the verifier's default interpretation, and it is what + -- allows the verifier to perform any reasoning at all over floating-point + -- operations that are not native to SMT-LIB (@sin@, @cos@, @tan@, etc.). + FloatUninterpreted + + | -- | Floating-point values are treated as bit-precise IEEE-754 floats. This + -- interpretation can perform deeper reasoning about floating-point + -- operations that are native to SMT-LIB, but at the expense of causing the + -- verifier to throw an error if it encounters operations that are not + -- native to SMT-LIB (@sin@, @cos@, @tan@, etc.). Use at your own risk. + FloatIEEE + deriving Show + +-- | Convert a 'FloatMode' into a What4 'W4.FloatModeRepr' and pass it to a +-- continuation. +withFloatMode :: + FloatMode -> + (forall fm. W4.FloatModeRepr fm -> r) -> + r +withFloatMode fm k = + case fm of + FloatUninterpreted -> + k W4.FloatUninterpretedRepr + FloatIEEE -> + k W4.FloatIEEERepr + +-- | Match on a 'W4.FloatModeRepr', compute evidence that it gives rise to an +-- instance of 'W4.IsInterpretedFloatExprBuilder', and pass the evidence to a +-- continutation. +withInterpretedFloatExprBuilder :: + W4.ExprBuilder t st (W4.Flags fm) -> + W4.FloatModeRepr fm -> + (W4.IsInterpretedFloatExprBuilder (W4.ExprBuilder t st (W4.Flags fm)) => r) -> + r +withInterpretedFloatExprBuilder _sym fm k = + case fm of + W4.FloatUninterpretedRepr -> k + W4.FloatIEEERepr -> k + W4.FloatRealRepr -> k diff --git a/copilot-verifier/src/Copilot/Verifier/Log.hs b/copilot-verifier/src/Copilot/Verifier/Log.hs new file mode 100644 index 000000000..0f34711a7 --- /dev/null +++ b/copilot-verifier/src/Copilot/Verifier/Log.hs @@ -0,0 +1,834 @@ +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE ImplicitParams #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE TemplateHaskell #-} +module Copilot.Verifier.Log + ( SupportsCopilotLogMessage + , CopilotLogMessage(..) + , VerificationStep(..) + , StateRelationStep(..) + , VerifierAssertion(..) + , SomeSome(..) + , StreamValueEquality(..) + , TriggersInvokedCorrespondingly(..) + , TriggerArgumentEquality(..) + , RingBufferLoad(..) + , RingBufferIndexLoad(..) + , PointerArgumentLoad(..) + , AccessorFunctionLoad(..) + , GuardFunctionLoad(..) + , UnknownFunctionLoad(..) + , LLVMBadBehaviorCheck(..) + , sayCopilot + , copilotLogMessageToSayWhat + ) where + +import Crux (SayLevel (..), SayWhat (..)) +import qualified Crux.Log as Log +import Data.Aeson (ToJSON (..), Value (..)) +import Data.Aeson.TH (defaultOptions, deriveToJSON) +import Data.Kind (Type) +import qualified Data.Parameterized.Context as Ctx +import qualified Data.Parameterized.Vector as PV +import qualified Data.Parameterized.TraversableFC.WithIndex as PWI +import Data.Text (Text) +import qualified Data.Text as T +import qualified Data.Vector as V +import GHC.Generics (Generic) +import qualified Prettyprinter as PP +import qualified Prettyprinter.Render.Text as PP + +import qualified Copilot.Core.Expr as CE +import qualified Copilot.Core.Type as CT +import qualified Copilot.Theorem.What4 as CW4 + +import qualified Lang.Crucible.Simulator as LCS +import qualified Lang.Crucible.Types as LCT +import qualified Lang.Crucible.LLVM.Errors as LCLE +import qualified Lang.Crucible.LLVM.Errors.MemoryError as LCLEME +import qualified Lang.Crucible.LLVM.Errors.UndefinedBehavior as LCLEUB +import qualified Lang.Crucible.LLVM.MemModel as LCLM +import qualified Lang.Crucible.LLVM.MemModel.CallStack as LCLMCS +import qualified What4.FunctionName as WF +import qualified What4.Interface as WI +import qualified What4.ProgramLoc as WPL + +data CopilotLogMessage where + GeneratedCFile :: + FilePath + -- ^ The path of the generated C File + -> CopilotLogMessage + CompiledBitcodeFile :: + String + -- ^ The prefix to use in the compiled bitcode's directory + -> FilePath + -- ^ The name of the generated LLVM bitcode file + -> CopilotLogMessage + TranslatedToCrucible :: CopilotLogMessage + GeneratingProofState :: CopilotLogMessage + ComputingConditions :: VerificationStep -> CopilotLogMessage + ProvingConditions :: VerificationStep -> CopilotLogMessage + AllGoalsProved :: CopilotLogMessage + OnlySomeGoalsProved :: + Integer + -- ^ Number of goals proved + -> Integer + -- ^ Number of total goals + -> CopilotLogMessage + SuccessfulProofSummary :: + FilePath + -- ^ Name of the generated C file. + -> Integer + -- ^ Number of goals proven during for the initial state of the proof. + -> Integer + -- ^ Number of goals proven during the bisimulation step of the proof. + -> CopilotLogMessage + NoisyVerbositySuggestion :: CopilotLogMessage + + ----- + -- Types of proof goals the verifier emits + -- + -- The first three arguments to each constructor are: + -- + -- * Which step of the verifier we are on + -- * The current goal number (zero-indexed) + -- * The total number of goals + ----- + + StreamValueEqualityProofGoal :: + WI.IsSymExprBuilder sym + => VerificationStep + -> Integer + -> Integer + -> StreamValueEquality sym copilotType crucibleType + -> CopilotLogMessage + + TriggersInvokedCorrespondinglyProofGoal :: + WI.IsSymExprBuilder sym + => VerificationStep + -> Integer + -> Integer + -> TriggersInvokedCorrespondingly sym + -> CopilotLogMessage + + TriggerArgumentEqualityProofGoal :: + WI.IsSymExprBuilder sym + => VerificationStep + -> Integer + -> Integer + -> TriggerArgumentEquality sym copilotType crucibleType + -> CopilotLogMessage + + RingBufferLoadProofGoal :: + WI.IsSymExprBuilder sym + => VerificationStep + -> Integer + -> Integer + -> RingBufferLoad sym copilotType crucibleType + -> CopilotLogMessage + + RingBufferIndexLoadProofGoal :: + WI.IsSymExprBuilder sym + => VerificationStep + -> Integer + -> Integer + -> RingBufferIndexLoad sym + -> CopilotLogMessage + + PointerArgumentLoadProofGoal :: + WI.IsSymExprBuilder sym + => VerificationStep + -> Integer + -> Integer + -> PointerArgumentLoad sym copilotType crucibleType + -> CopilotLogMessage + + AccessorFunctionLoadProofGoal :: + WI.IsSymExprBuilder sym + => VerificationStep + -> Integer + -> Integer + -> AccessorFunctionLoad sym + -> CopilotLogMessage + + GuardFunctionLoadProofGoal :: + WI.IsSymExprBuilder sym + => VerificationStep + -> Integer + -> Integer + -> GuardFunctionLoad sym + -> CopilotLogMessage + + UnknownFunctionLoadProofGoal :: + WI.IsSymExprBuilder sym + => VerificationStep + -> Integer + -> Integer + -> UnknownFunctionLoad sym + -> CopilotLogMessage + + LLVMBadBehaviorCheckProofGoal :: + WI.IsSymExprBuilder sym + => VerificationStep + -> Integer + -> Integer + -> LLVMBadBehaviorCheck sym + -> CopilotLogMessage + +data VerificationStep + = InitialState + | StepBisimulation + deriving stock Generic + deriving anyclass ToJSON + +-- | The provenance of an assertion. +data AssertionProvenance + = VerifierProvenance + -- ^ Assertions that the verifier directly makes to check the correspondence + -- between the Copilot specification and the generated C code. Because these + -- assertions are core to the proof that the verifier is computing, these + -- assertions' proof goals are always logged, even if they are trivial. + | StepExecutionProvenance + -- ^ Assertions that arise during symbolic execution of the @step()@ + -- function as part of proving the memory safety of the generated C code. + -- These assertions' proof goals are only logged if they are non-trivial, + -- as there would be an excessive number of these proof goals otherwise. + +-- | At what step of the proof are we checking the state relation? We record +-- this so that we can better distinguish between transition step–related +-- proof goals that arise before or after calling the @step()@ function. +data StateRelationStep + = InitialStateRelation + -- ^ Check the state relation for the initial state. + | PreStepStateRelation + -- ^ During the transition step of the proof, check the state relation + -- before calling the @step()@ function. + | PostStepStateRelation + -- ^ During the transition step of the proof, check the state relation + -- after calling the @step()@ function. + deriving stock Generic + deriving anyclass ToJSON + +-- | Types of assertions that the verifier can make, which will count towards +-- the total number of proof goals. +data VerifierAssertion sym + = StreamValueEqualityAssertion (SomeSome (StreamValueEquality sym)) + | TriggersInvokedCorrespondinglyAssertion (TriggersInvokedCorrespondingly sym) + | TriggerArgumentEqualityAssertion (SomeSome (TriggerArgumentEquality sym)) + | RingBufferLoadAssertion (SomeSome (RingBufferLoad sym)) + | RingBufferIndexLoadAssertion (RingBufferIndexLoad sym) + | PointerArgumentLoadAssertion (SomeSome (PointerArgumentLoad sym)) + | AccessorFunctionLoadAssertion (AccessorFunctionLoad sym) + | GuardFunctionLoadAssertion (GuardFunctionLoad sym) + | UnknownFunctionLoadAssertion (UnknownFunctionLoad sym) + | LLVMBadBehaviorCheckAssertion (LLVMBadBehaviorCheck sym) + +-- | Like @Some@ in @parameterized-utils@, but existentially closing over two +-- type parameters instead of just one. +data SomeSome (f :: j -> k -> Type) where + SomeSome :: f x y -> SomeSome f + +-- | An assertion that an element in a Copilot stream is equal to the +-- corresponding element in a C ring buffer. +data StreamValueEquality sym copilotType crucibleType where + StreamValueEquality :: + sym + -> StateRelationStep + -- ^ When the values are checked for equality + -> WPL.ProgramLoc + -- ^ The locations of the values + -> Text + -- ^ The name of the buffer + -> Integer + -- ^ The offset from the buffer's index, which is used to compute the + -- element of the buffer to load + -> Integer + -- ^ The number of elements in the buffer + -> CT.Type copilotType + -- ^ The Copilot type + -> CW4.XExpr sym + -- ^ The Copilot value + -> LCT.TypeRepr crucibleType + -- ^ The Crucible type + -> LCS.RegValue sym crucibleType + -- ^ The Crucible value + -> StreamValueEquality sym copilotType crucibleType + +-- | An assertion that, given a Copilot trigger stream and its corresponding C +-- trigger function on a particular time step, either both fired at the same +-- time or both did not fire at all. +data TriggersInvokedCorrespondingly sym where + TriggersInvokedCorrespondingly :: + WPL.ProgramLoc + -- ^ The location of the trigger + -> CE.Name + -- ^ The trigger name + -> WI.SymNat sym + -- ^ The expected number of times the trigger was fired this step + -- (should be either 1 or 0). + -> WI.SymNat sym + -- ^ The actual number of times the trigger was fired this step. + -> TriggersInvokedCorrespondingly sym + +-- | An assertion that an argument to a Copilot trigger is equal to the +-- corresponding argument to a C trigger function. +data TriggerArgumentEquality sym copilotType crucibleType where + TriggerArgumentEquality :: + sym + -> WPL.ProgramLoc + -- ^ The locations of the arguments + -> CE.Name + -- ^ The trigger name + -> Integer + -- ^ The number of the argument (starting from 0) + -> CT.Type copilotType + -- ^ The Copilot type + -> CW4.XExpr sym + -- ^ The Copilot value + -> LCT.TypeRepr crucibleType + -- ^ The Crucible type + -> LCS.RegValue sym crucibleType + -- ^ The Crucible value + -> TriggerArgumentEquality sym copilotType crucibleType + +-- | An assertion that a load from a ring buffer in C is valid. +data RingBufferLoad sym copilotType crucibleType where + RingBufferLoad :: + sym + -> StateRelationStep + -- ^ When the ring buffer is loaded from + -> WPL.ProgramLoc + -- ^ The location of the buffer + -> Text + -- ^ The name of the buffer + -> Integer + -- ^ The offset from the buffer's index, which is used to compute the + -- element of the buffer to load + -> Integer + -- ^ The number of elements in the buffer + -> CT.Type copilotType + -- ^ The Copilot type of the elements of the array + -> LCT.TypeRepr crucibleType + -- ^ The Crucible type of the elements of the array + -> WI.Pred sym + -- ^ The assertion that must hold in order for this load to be valid + -> RingBufferLoad sym copilotType crucibleType + +-- | An assertion that a load from a global variable representing a ring +-- buffer's index in C is valid. +data RingBufferIndexLoad sym where + RingBufferIndexLoad :: + sym + -> StateRelationStep + -- ^ When the index's global variable is loaded from + -> WPL.ProgramLoc + -- ^ The location of the global index + -> Text + -- ^ The name of the global index + -> WI.Pred sym + -- ^ The assertion that must hold in order for this load to be valid + -> RingBufferIndexLoad sym + +-- | An assertion that a load from a pointer argument to a trigger function in C +-- is valid. +data PointerArgumentLoad sym copilotType crucibleType where + PointerArgumentLoad :: + sym + -> WPL.ProgramLoc + -- ^ The location of the pointer + -> CT.Type copilotType + -- ^ The Copilot type of the underlying memory + -> LCT.TypeRepr crucibleType + -- ^ The Crucible type of the underlying memory + -> WI.Pred sym + -- ^ The assertion that must hold in order for this load to be valid + -> PointerArgumentLoad sym copilotType crucibleType + +-- | An assertion that a load occurring from somewhere in a stream accessor +-- function in C (e.g., @s0_get@) is valid. This is a somewhat imprecise +-- assertion, as it doesn't identify /why/ the load occurs. (Most likely, it +-- happens because of an array index.) +data AccessorFunctionLoad sym where + AccessorFunctionLoad :: + sym + -> WPL.ProgramLoc + -- ^ The location of the accessor function + -> WF.FunctionName + -- ^ The name of the accessor function + -> WI.Pred sym + -- ^ The assertion that must hold in order for this load to be valid + -> AccessorFunctionLoad sym + +-- | An assertion that a load occurring from somewhere in a trigger guard +-- function in C (e.g., @even_guard@) is valid. This is a somewhat imprecise +-- assertion, as it doesn't identify /why/ the load occurs. (Most likely, it +-- happens because of an array index.) +data GuardFunctionLoad sym where + GuardFunctionLoad :: + sym + -> WPL.ProgramLoc + -- ^ The location of the guard function + -> WF.FunctionName + -- ^ The name of the guard function + -> WI.Pred sym + -- ^ The assertion that must hold in order for this load to be valid + -> GuardFunctionLoad sym + +-- | An assertion that a load occurring in some function is valid. If you +-- see this assertion, it is because the heuristics used to identify where +-- load-related assertions come from could not identify a more precise cause +-- for a load. +data UnknownFunctionLoad sym where + UnknownFunctionLoad :: + sym + -> WPL.ProgramLoc + -- ^ The location of the function + -> WF.FunctionName + -- ^ The name of the function + -> WI.Pred sym + -- ^ The assertion that must hold in order for this load to be valid + -> UnknownFunctionLoad sym + +-- | An assertion that checks that some form of bad behavior in LLVM does not +-- occur. Bad behavior includes both undefined behavior and memory unsafety. +data LLVMBadBehaviorCheck sym where + LLVMBadBehaviorCheck :: + sym + -> WPL.ProgramLoc + -- ^ The location of the check + -> LCLMCS.CallStack + -- ^ A call stack for the check, if one exists + -> LCLE.BadBehavior sym + -- ^ What type of LLVM bad behavior is being checked for + -> WI.Pred sym + -- ^ The assertion that must hold in order for this check to succeed + -> LLVMBadBehaviorCheck sym + +-- Silly ToJSON instances. Crux is only requiring a ToJSON constraint for +-- IDE-related functionality that we do not make use of, so the behavior of +-- these instances aren't very important. + +instance ToJSON (StreamValueEquality sym copilotType crucibleType) where + toJSON _ = String "StreamValueEquality" + +instance ToJSON (TriggersInvokedCorrespondingly sym) where + toJSON _ = String "TriggersInvokedCorrespondingly" + +instance ToJSON (TriggerArgumentEquality sym copilotType crucibleType) where + toJSON _ = String "TriggerArgumentEquality" + +instance ToJSON (RingBufferLoad sym copilotType crucibleType) where + toJSON _ = String "RingBufferLoad" + +instance ToJSON (RingBufferIndexLoad sym) where + toJSON _ = String "RingBufferIndexLoad" + +instance ToJSON (PointerArgumentLoad sym copilotType crucibleType) where + toJSON _ = String "PointerArgumentLoad" + +instance ToJSON (AccessorFunctionLoad sym) where + toJSON _ = String "AccessorFunctionLoad" + +instance ToJSON (GuardFunctionLoad sym) where + toJSON _ = String "GuardFunctionLoad" + +instance ToJSON (UnknownFunctionLoad sym) where + toJSON _ = String "UnknownFunctionLoad" + +instance ToJSON (LLVMBadBehaviorCheck sym) where + toJSON _ = String "LLVMBadBehaviorCheck" + +type SupportsCopilotLogMessage msgs = + (?injectCopilotLogMessage :: CopilotLogMessage -> msgs) + +sayCopilot :: + Log.Logs msgs => + SupportsCopilotLogMessage msgs => + CopilotLogMessage -> + IO () +sayCopilot msg = + let ?injectMessage = ?injectCopilotLogMessage + in Log.say msg + +copilotTag :: Text +copilotTag = "copilot-verifier" + +-- copilotFail :: Text -> SayWhat +-- copilotFail = SayWhat Fail copilotTag + +copilotSimply :: Text -> SayWhat +copilotSimply = SayWhat Simply copilotTag + +copilotNoisily :: Text -> SayWhat +copilotNoisily = SayWhat Noisily copilotTag + +-- copilotWarn :: Text -> SayWhat +-- copilotWarn = SayWhat Warn copilotTag + +copilotLogMessageToSayWhat :: CopilotLogMessage -> SayWhat +copilotLogMessageToSayWhat (GeneratedCFile csrc) = + copilotSimply $ "Generated " <> T.pack (show csrc) +copilotLogMessageToSayWhat (CompiledBitcodeFile prefix bcFile) = + copilotSimply $ "Compiled " <> T.pack prefix <> " into " <> T.pack bcFile +copilotLogMessageToSayWhat TranslatedToCrucible = + copilotSimply "Translated bitcode into Crucible" +copilotLogMessageToSayWhat GeneratingProofState = + copilotSimply "Generating proof state data" +copilotLogMessageToSayWhat (ComputingConditions step) = + copilotSimply $ "Computing " <> describeVerificationStep step <> " verification conditions" +copilotLogMessageToSayWhat (ProvingConditions step) = + copilotSimply $ "Proving " <> describeVerificationStep step <> " verification conditions" +copilotLogMessageToSayWhat AllGoalsProved = + copilotSimply "All obligations proved by concrete simplification" +copilotLogMessageToSayWhat (OnlySomeGoalsProved numProvedGoals numTotalGoals) = + copilotSimply $ T.unwords + [ "Proved", T.pack (show numProvedGoals) + , "of" + , T.pack (show numTotalGoals), "total goals" + ] +copilotLogMessageToSayWhat (SuccessfulProofSummary cFileName initGoals bisimGoals) = + copilotSimply $ T.unlines + [ "" + , "copilot-verifier has produced a mathematical proof that the behavior of" + , "the generated C program (" <> T.pack cFileName + <> ") precisely matches the behavior of" + , "the Copilot specification. This proof shows that the behaviors match for" + , "all possible moments in time, and in doing so, copilot-verifier examined" + , "how the programs behave at the start of execution (the \"initial state\")" + , "and at an arbitrary point of time in execution (the \"step bisimulation\")." + , "copilot-verifier decomposed the overall proof into smaller goals, the" + , "number of which depends on the size and complexity of the program. In this" + , "example, there are " <> T.pack (show initGoals) <> " initial state goal(s)" + <> " and " <> T.pack (show bisimGoals) <> " step bisimulation goal(s)," + , "and copilot-verifier was able to prove all of them." + ] +copilotLogMessageToSayWhat NoisyVerbositySuggestion = + copilotSimply $ T.unlines + [ "" + , "copilot-verifier is displaying an abridged summary of the verification results." + , "copilot-verifier also includes a \"noisy\" mode that prints detailed" + , "descriptions of each individual proof goal, including what type of goal it is," + , "why it needs to be proven, and where in the Copilot specification and/or C code" + , "the proof goal originated from. To enable noisy mode, invoke the verifier with" + , "the following options:" + , "" + , "```" + , "verifyWithOptions (defaultVerifierOptions { verbosity = Noisy }) ..." + , "```" + ] +copilotLogMessageToSayWhat + (StreamValueEqualityProofGoal verifStep goalIdx numTotalGoals + (StreamValueEquality + sym stateRelStep loc + bufName offset len + copilotTy copilotVal + crucibleTy crucibleVal)) = + copilotNoisily $ + displayStateRelationProofGoal + verifStep stateRelStep VerifierProvenance goalIdx numTotalGoals + "asserting the equality between two stream values" + [ renderStrict $ ppProgramLoc loc + , "* Ring buffer name: " <> bufName + , "* Offset into buffer (from current index): " <> T.pack (show offset) + , "* Number of elements in buffer: " <> T.pack (show len) + , "* Copilot type: " <> T.pack (showsCopilotType 0 copilotTy "") + , "* Copilot value:" + , renderStrict $ PP.indent 4 $ ppCopilotValue copilotVal + , "* Crucible value:" + , renderStrict $ PP.indent 4 $ ppCrucibleValue sym crucibleTy crucibleVal + ] +copilotLogMessageToSayWhat + (TriggersInvokedCorrespondinglyProofGoal step goalIdx numTotalGoals + (TriggersInvokedCorrespondingly loc name expected actual)) = + copilotNoisily $ + displayProofGoal + step VerifierProvenance goalIdx numTotalGoals + "asserting triggers fired in corresponding ways" + [ renderStrict $ ppProgramLoc loc + , "* Trigger name: " <> T.pack name + , "* Expected number of times trigger was fired:" + , renderStrict $ PP.indent 4 $ WI.printSymNat expected + , "* Actual number of times trigger was fired:" + , renderStrict $ PP.indent 4 $ WI.printSymNat actual + ] +copilotLogMessageToSayWhat + (TriggerArgumentEqualityProofGoal step goalIdx numTotalGoals + (TriggerArgumentEquality + sym loc + triggerName argNum + copilotTy copilotVal + crucibleTy crucibleVal)) = + copilotNoisily $ + displayProofGoal + step VerifierProvenance goalIdx numTotalGoals + "asserting the equality between two trigger arguments" + [ renderStrict $ ppProgramLoc loc + , "* Trigger name: " <> T.pack triggerName + , "* Number of argument: " <> T.pack (show argNum) + , "* Copilot type: " <> T.pack (showsCopilotType 0 copilotTy "") + , "* Copilot value:" + , renderStrict $ PP.indent 4 $ ppCopilotValue copilotVal + , "* Crucible value:" + , renderStrict $ PP.indent 4 $ ppCrucibleValue sym crucibleTy crucibleVal + ] +copilotLogMessageToSayWhat + (RingBufferLoadProofGoal verifStep goalIdx numTotalGoals + (RingBufferLoad + _sym stateRelStep loc bufName offset len copilotTy _crucibleTy p)) = + copilotNoisily $ + displayStateRelationProofGoal + verifStep stateRelStep VerifierProvenance goalIdx numTotalGoals + "asserting the validity of a memory load from a stream's ring buffer in C" + [ renderStrict $ ppProgramLoc loc + , "* Ring buffer name: " <> bufName + , "* Offset into buffer (from current index): " <> T.pack (show offset) + , "* Number of elements in buffer: " <> T.pack (show len) + , "* Copilot type of buffer elements:" <> T.pack (showsCopilotType 0 copilotTy "") + , "* Validity predicate:" + , renderStrict $ PP.indent 4 $ WI.printSymExpr p + ] +copilotLogMessageToSayWhat + (RingBufferIndexLoadProofGoal verifStep goalIdx numTotalGoals + (RingBufferIndexLoad _sym stateRelStep loc idxName p)) = + copilotNoisily $ + displayStateRelationProofGoal + verifStep stateRelStep VerifierProvenance goalIdx numTotalGoals + "asserting the validity of a memory load from the index to a stream's ring buffer in C" + [ renderStrict $ ppProgramLoc loc + , "* Ring buffer index name: " <> idxName + , "* Validity predicate:" + , renderStrict $ PP.indent 4 $ WI.printSymExpr p + ] +copilotLogMessageToSayWhat + (PointerArgumentLoadProofGoal step goalIdx numTotalGoals + (PointerArgumentLoad + _sym loc copilotTy _crucibleTy p)) = + copilotNoisily $ + displayProofGoal + step VerifierProvenance goalIdx numTotalGoals + "asserting the validity of a memory load from a pointer argument to a trigger" + [ renderStrict $ ppProgramLoc loc + , "* Copilot type: " <> T.pack (showsCopilotType 0 copilotTy "") + , "* Validity predicate:" + , renderStrict $ PP.indent 4 $ WI.printSymExpr p + ] +copilotLogMessageToSayWhat + (AccessorFunctionLoadProofGoal step goalIdx numTotalGoals + (AccessorFunctionLoad _sym loc accessorName p)) = + copilotNoisily $ + displayProofGoal + step StepExecutionProvenance goalIdx numTotalGoals + "asserting the validity of a memory load from a stream accessor function" + [ renderStrict $ ppProgramLoc loc + , "* Accessor function name: " <> WF.functionName accessorName + , "* Validity predicate:" + , renderStrict $ PP.indent 4 $ WI.printSymExpr p + ] +copilotLogMessageToSayWhat + (GuardFunctionLoadProofGoal step goalIdx numTotalGoals + (GuardFunctionLoad _sym loc accessorName p)) = + copilotNoisily $ + displayProofGoal + step StepExecutionProvenance goalIdx numTotalGoals + "asserting the validity of a memory load from a trigger guard function" + [ renderStrict $ ppProgramLoc loc + , "* Guard function name: " <> WF.functionName accessorName + , "* Validity predicate:" + , renderStrict $ PP.indent 4 $ WI.printSymExpr p + ] +copilotLogMessageToSayWhat + (UnknownFunctionLoadProofGoal step goalIdx numTotalGoals + (UnknownFunctionLoad _sym loc accessorName p)) = + copilotNoisily $ + displayProofGoal + step StepExecutionProvenance goalIdx numTotalGoals + "asserting the validity of a memory load from an unknown function" + [ renderStrict $ ppProgramLoc loc + , "* Function name: " <> WF.functionName accessorName + , "* Validity predicate:" + , renderStrict $ PP.indent 4 $ WI.printSymExpr p + ] +copilotLogMessageToSayWhat + (LLVMBadBehaviorCheckProofGoal step goalIdx numTotalGoals + (LLVMBadBehaviorCheck _sym loc stk bb p)) = + let ppLoc = renderStrict $ ppProgramLoc loc + ppCallStackLines = + [ "* Call stack:" + , " " <> renderCallStack stk + ] + ppValidPredLines = + [ "* Validity predicate:" + , renderStrict $ PP.indent 4 $ WI.printSymExpr p + ] in + case bb of + LCLE.BBUndefinedBehavior ub -> + copilotNoisily $ + displayProofGoal + step StepExecutionProvenance goalIdx numTotalGoals + "asserting that LLVM undefined behavior does not occur" + $ ppLoc : ppCallStackLines ++ + [ "* Undefined behavior description:" + , renderStrict $ PP.indent 4 $ LCLEUB.ppDetails ub + ] ++ ppValidPredLines + LCLE.BBMemoryError me -> + copilotNoisily $ + displayProofGoal + step StepExecutionProvenance goalIdx numTotalGoals + "asserting that LLVM memory unsafety does not occur" + $ ppLoc : ppCallStackLines ++ + [ "* Memory unsafety description:" + , renderStrict $ PP.indent 4 $ LCLEME.explain me + ] ++ ppValidPredLines + +describeVerificationStep :: VerificationStep -> Text +describeVerificationStep InitialState = "initial state" +describeVerificationStep StepBisimulation = "step bisimulation" + +-- | Display information about an emitted proof goal. +displayProofGoal :: + VerificationStep + -> AssertionProvenance + -> Integer + -> Integer + -> Text + -> [Text] + -> Text +displayProofGoal step assertProv goalIdx numTotalGoals why ls = T.unlines $ + [ banner + , "Emitted a proof goal (" <> why <> ")" + , " During the " <> displayStep + , " Required for proving the " <> displayAssertProv + , " Proof goal " <> T.pack (show goalIdx) + <> " (" + <> T.pack (show numTotalGoals) + <> " total)" + , "" + ] + ++ ls ++ [banner] + where + banner = "=====" + displayStep = + case step of + InitialState -> + "initial bisimulation state step" + StepBisimulation -> + "transition step of bisimulation" + displayAssertProv = + case assertProv of + VerifierProvenance -> + "correspondence between the spec and C code" + StepExecutionProvenance -> + "memory safety of the generated step() function" + +-- | Display information about an emitted proof goal that involves checking the +-- state relation. +displayStateRelationProofGoal :: + VerificationStep + -> StateRelationStep + -> AssertionProvenance + -> Integer + -> Integer + -> Text + -> [Text] + -> Text +displayStateRelationProofGoal verifStep stateRelStep assertProv goalIdx numTotalGoals why = + displayProofGoal verifStep assertProv goalIdx numTotalGoals why' + where + why' :: Text + why' = + case stateRelStep of + PreStepStateRelation -> why <> " before calling step()" + PostStepStateRelation -> why <> " after calling step()" + -- `displayProofGoal` already makes a note of the fact that we're + -- checking the initial state, so no need to do so again here. + InitialStateRelation -> why + +ppProgramLoc :: WPL.ProgramLoc -> PP.Doc a +ppProgramLoc pl = PP.vcat + [ "* Function:" PP.<+> PP.pretty (WPL.plFunction pl) + , " Position:" PP.<+> PP.pretty (WPL.plSourceLoc pl) + ] + +renderCallStack :: LCLMCS.CallStack -> Text +renderCallStack cs + | T.null ppText + = "" + | otherwise + = ppText + where + ppText = renderStrict $ LCLMCS.ppCallStack cs + +showsCopilotType :: Int -> CT.Type tp -> ShowS +showsCopilotType prec tp = + case tp of + CT.Bool -> showString "Bool" + CT.Int8 -> showString "Int8" + CT.Int16 -> showString "Int16" + CT.Int32 -> showString "Int32" + CT.Int64 -> showString "Int64" + CT.Word8 -> showString "Word8" + CT.Word16 -> showString "Word16" + CT.Word32 -> showString "Word32" + CT.Word64 -> showString "Word64" + CT.Float -> showString "Float" + CT.Double -> showString "Double" + CT.Array t -> showParen (prec >= 11) $ + showString "Array" . + showsPrec 11 (CT.typeSize tp) . + showsCopilotType 11 t + CT.Struct x -> showString $ CT.typeName x + +ppCopilotValue :: WI.IsSymExprBuilder sym => CW4.XExpr sym -> PP.Doc a +ppCopilotValue val = + case val of + CW4.XBool b -> WI.printSymExpr b + CW4.XInt8 i -> WI.printSymExpr i + CW4.XInt16 i -> WI.printSymExpr i + CW4.XInt32 i -> WI.printSymExpr i + CW4.XInt64 i -> WI.printSymExpr i + CW4.XWord8 w -> WI.printSymExpr w + CW4.XWord16 w -> WI.printSymExpr w + CW4.XWord32 w -> WI.printSymExpr w + CW4.XWord64 w -> WI.printSymExpr w + CW4.XFloat f -> WI.printSymExpr f + CW4.XDouble d -> WI.printSymExpr d + CW4.XEmptyArray {} -> "[]" + CW4.XArray a -> ppBracesWith ppCopilotValue (PV.toList a) + CW4.XStruct s -> ppBracketsWith ppCopilotValue s + +ppCrucibleValue :: WI.IsSymExprBuilder sym + => sym + -> LCT.TypeRepr tp + -> LCS.RegValue sym tp + -> PP.Doc a +ppCrucibleValue sym tp val = + case tp of + LCLM.LLVMPointerRepr _ -> LCLM.ppPtr val + LCT.FloatRepr _ -> WI.printSymExpr val + LCT.VectorRepr tpr -> ppBracketsWith (ppCrucibleValue sym tpr) (V.toList val) + LCT.StructRepr ctx -> withBraces $ + PWI.itoListFC (\i (LCS.RV v) -> ppCrucibleValue sym (ctx Ctx.! i) v) val + _ -> error $ "ppCrucibleValue: Unsupported type: " ++ show tp + +renderStrict :: PP.Doc a -> Text +renderStrict = PP.renderStrict . PP.layoutPretty PP.defaultLayoutOptions + +ppBracketsWith :: (a -> PP.Doc b) -> [a] -> PP.Doc b +ppBracketsWith f = PP.align . PP.list . map f + +ppBracesWith :: (a -> PP.Doc b) -> [a] -> PP.Doc b +ppBracesWith f = withBraces . map f + +withBraces :: [PP.Doc a] -> PP.Doc a +withBraces = + PP.align + . PP.encloseSep (PP.flatAlt "{ " "{") (PP.flatAlt " }" "}") ", " + +$(deriveToJSON defaultOptions ''CopilotLogMessage) diff --git a/copilot-verifier/src/Copilot/Verifier/Solver.hs b/copilot-verifier/src/Copilot/Verifier/Solver.hs new file mode 100644 index 000000000..8887be811 --- /dev/null +++ b/copilot-verifier/src/Copilot/Verifier/Solver.hs @@ -0,0 +1,25 @@ +module Copilot.Verifier.Solver + ( Solver(..) + , solverAdapter + ) where + +import qualified What4.Solver.Adapter as W4 +import qualified What4.Solver.CVC4 as W4.CVC4 +import qualified What4.Solver.CVC5 as W4.CVC5 +import qualified What4.Solver.Yices as W4.Yices +import qualified What4.Solver.Z3 as W4.Z3 + +-- | General-purpose SMT solvers that @copilot-verifier@ supports. +data Solver + = CVC4 + | CVC5 + | Yices + | Z3 + deriving Show + +-- | Return the @what4@ 'W4.SolverAdapter' corresponding to a given 'Solver'. +solverAdapter :: Solver -> W4.SolverAdapter st +solverAdapter CVC4 = W4.CVC4.cvc4Adapter +solverAdapter CVC5 = W4.CVC5.cvc5Adapter +solverAdapter Yices = W4.Yices.yicesAdapter +solverAdapter Z3 = W4.Z3.z3Adapter diff --git a/copilot-verifier/test/Test.hs b/copilot-verifier/test/Test.hs new file mode 100644 index 000000000..8ed51e915 --- /dev/null +++ b/copilot-verifier/test/Test.hs @@ -0,0 +1,32 @@ +module Main (main) where + +import qualified Data.CaseInsensitive as CI +import qualified Data.Map as Map +import qualified Data.Text as Text +import System.IO (stderr, stdout) +import System.IO.Silently (hSilence) +import Test.Tasty +import Test.Tasty.ExpectedFailure +import Test.Tasty.HUnit + +import Copilot.Verifier (Verbosity(..)) +import Copilot.Verifier.Examples (shouldFailExamples, shouldPassExamples) + +main :: IO () +main = defaultMain $ + testGroup "copilot-verifier-examples tests" + [ testGroup "should-fail tests" $ + -- Why use hSilence for the should-fail tests when we are passing + -- Quiet? It's because crux-llvm errors are logged at the highest + -- severity possible, and even Crux's quietMode isn't enough to + -- suppress those messages. We could try messing with things on the + -- Crux side to avoid this, but it's simpler just to use hSilence here. + -- After all, we don't really care about the output of failing tests + -- anyway, just their exit codes. + map (\(name, action) -> expectFail (testCase (Text.unpack (CI.original name)) + (hSilence [stderr, stdout] action))) + (Map.toAscList (shouldFailExamples Quiet)) + , testGroup "should-pass tests" $ + map (\(name, action) -> testCase (Text.unpack (CI.original name)) action) + (Map.toAscList (shouldPassExamples Quiet)) + ] From 1d299905a6c7b5885bc459ed4ab925c7c66145a1 Mon Sep 17 00:00:00 2001 From: Ryan Scott Date: Fri, 20 Jun 2025 10:05:21 -0400 Subject: [PATCH 0934/1222] copilot-verifier: Adjust issue numbers in changelog. Refs #622. The `copilot-verifier` package was originally developed in an external repo (https://github.com/Copilot-Language/copilot-verifier), but there is interest in having all Copilot projects and libraries merged into the main https://github.com/Copilot-Language/copilot repo for ease of management. Now that the `copilot-verifier` package lives in the `copilot` repo, this adjusts the issue numbers in the `copilot-verifier` changelog to refer to the old repo so that they will not be confused with issues in the `copilot` repo. --- copilot-verifier/CHANGELOG | 40 ++++++++++++++++++++++---------------- 1 file changed, 23 insertions(+), 17 deletions(-) diff --git a/copilot-verifier/CHANGELOG b/copilot-verifier/CHANGELOG index 2923ff5ed..4d3f2eacc 100644 --- a/copilot-verifier/CHANGELOG +++ b/copilot-verifier/CHANGELOG @@ -1,40 +1,46 @@ 2025-05-08 - * Version bump (4.4). (#85) + * Version bump (4.4). (copilot-verifier#85) 2025-03-10 - * Version bump (4.3). (#82) - * Add `smtSolver` option to `VerifierOptions`. (#78) - * Add `smtFloatMode` option to `VerifierOptions`. (#79) + * Version bump (4.3). (copilot-verifier#82) + * Add `smtSolver` option to `VerifierOptions`. (copilot-verifier#78) + * Add `smtFloatMode` option to `VerifierOptions`. (copilot-verifier#79) 2025-01-20 - * Version bump (4.2). (#76) - * Reject specs that use multiple triggers with the same name. (#74) + * Version bump (4.2). (copilot-verifier#76) + * Reject specs that use multiple triggers with the same name. + (copilot-verifier#74) 2024-11-08 - * Version bump (4.1). (#72) + * Version bump (4.1). (copilot-verifier#72) 2024-09-09 - * Version bump (4.0). (#69) - * Support verifying programs that use array updates. (#63) - * Support verifying programs that use struct updates. (#57) + * Version bump (4.0). (copilot-verifier#69) + * Support verifying programs that use array updates. + (copilot-verifier#63) + * Support verifying programs that use struct updates. + (copilot-verifier#57) 2024-08-03 - * Support building with `crucible-llvm-0.7` and `crux-llvm-0.9`. (#64) - * Support GHC 9.4 through 9.8. (#65) + * Support building with `crucible-llvm-0.7` and `crux-llvm-0.9`. + (copilot-verifier#64) + * Support GHC 9.4 through 9.8. (copilot-verifier#65) 2024-07-30 * When using `Noisy` verbosity, always log proof goals related to the - core correspondence proof, even if the goals are trivial. (#51) + core correspondence proof, even if the goals are trivial. + (copilot-verifier#51) * When using `Noisy` verbosity, log more information about which proof - goals arise before or after calling the `step()` function. (#52) + goals arise before or after calling the `step()` function. + (copilot-verifier#52) 2024-07-11 - * Version bump (3.20). (#58) + * Version bump (3.20). (copilot-verifier#58) 2024-03-08 - * Version bump (3.19). (#53) + * Version bump (3.19). (copilot-verifier#53) * Provide more detailed feedback upon a successful run of the verifier. - * Make the examples build with Copilot 3.19. (#53) + * Make the examples build with Copilot 3.19. (copilot-verifier#53) 2024-02-06 * Initial release of `copilot-verifier`. From 9e0dcac323f523277b1bdcb74869d823b6ad5324 Mon Sep 17 00:00:00 2001 From: Ryan Scott Date: Fri, 20 Jun 2025 10:06:43 -0400 Subject: [PATCH 0935/1222] copilot-verifier: Document changes in CHANGELOG. Refs #622. --- copilot-verifier/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-verifier/CHANGELOG b/copilot-verifier/CHANGELOG index 4d3f2eacc..03bd15246 100644 --- a/copilot-verifier/CHANGELOG +++ b/copilot-verifier/CHANGELOG @@ -1,3 +1,6 @@ +2025-06-20 + * Include `copilot-verifier` in mainline `copilot` repo. (#622) + 2025-05-08 * Version bump (4.4). (copilot-verifier#85) From 2230f35b0e258fe3088c7019959606b96d95cd88 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 27 Jun 2025 13:23:58 +0000 Subject: [PATCH 0936/1222] copilot-visualizer: Include in mainline. Refs #624. The copilot-visualizer package was developed outside of this repo, but there's interest in having all Copilot projects and libraries merged into a main repo for ease of management. This commit adds version 4.4 of copilot-visualizer as a subdirectory of the main repository. All files are added "as is". --- copilot-visualizer/.gitignore | 25 + copilot-visualizer/CHANGELOG | 3 + copilot-visualizer/LICENSE | 29 ++ copilot-visualizer/README.md | 34 ++ copilot-visualizer/Setup.hs | 2 + copilot-visualizer/copilot-visualizer.cabal | 130 +++++ .../data/static_html/index.html | 255 +++++++++ copilot-visualizer/data/tikz/tikz.tex | 37 ++ copilot-visualizer/examples/gui/Main.hs | 20 + copilot-visualizer/examples/gui/copilot.css | 50 ++ copilot-visualizer/examples/gui/copilot.js | 489 ++++++++++++++++++ copilot-visualizer/examples/gui/main.html | 67 +++ copilot-visualizer/examples/tikz/Heater.hs | 37 ++ .../src/Copilot/Visualize/Dynamic.hs | 253 +++++++++ .../src/Copilot/Visualize/Live.hs | 162 ++++++ .../src/Copilot/Visualize/Static.hs | 36 ++ .../src/Copilot/Visualize/TypedTrace.hs | 158 ++++++ .../src/Copilot/Visualize/UntypedTrace.hs | 176 +++++++ 18 files changed, 1963 insertions(+) create mode 100644 copilot-visualizer/.gitignore create mode 100644 copilot-visualizer/CHANGELOG create mode 100644 copilot-visualizer/LICENSE create mode 100644 copilot-visualizer/README.md create mode 100644 copilot-visualizer/Setup.hs create mode 100644 copilot-visualizer/copilot-visualizer.cabal create mode 100644 copilot-visualizer/data/static_html/index.html create mode 100644 copilot-visualizer/data/tikz/tikz.tex create mode 100644 copilot-visualizer/examples/gui/Main.hs create mode 100644 copilot-visualizer/examples/gui/copilot.css create mode 100644 copilot-visualizer/examples/gui/copilot.js create mode 100644 copilot-visualizer/examples/gui/main.html create mode 100644 copilot-visualizer/examples/tikz/Heater.hs create mode 100644 copilot-visualizer/src/Copilot/Visualize/Dynamic.hs create mode 100644 copilot-visualizer/src/Copilot/Visualize/Live.hs create mode 100644 copilot-visualizer/src/Copilot/Visualize/Static.hs create mode 100644 copilot-visualizer/src/Copilot/Visualize/TypedTrace.hs create mode 100644 copilot-visualizer/src/Copilot/Visualize/UntypedTrace.hs diff --git a/copilot-visualizer/.gitignore b/copilot-visualizer/.gitignore new file mode 100644 index 000000000..f94ebc47b --- /dev/null +++ b/copilot-visualizer/.gitignore @@ -0,0 +1,25 @@ +dist +dist-* +cabal-dev +*.o +*.hi +*.chi +*.chs.h +*.dyn_o +*.dyn_hi +.hpc +.hsenv +.cabal-sandbox/ +cabal.sandbox.config +*.prof +*.aux +*.hp +*.eventlog +.stack-work/ +cabal.project.local +cabal.project.local~ +.HTF/ +.ghc.environment.* +copilot-profiling +.DS_Store +.log diff --git a/copilot-visualizer/CHANGELOG b/copilot-visualizer/CHANGELOG new file mode 100644 index 000000000..44cb9f05e --- /dev/null +++ b/copilot-visualizer/CHANGELOG @@ -0,0 +1,3 @@ +2025-06-26 + * Release 4.4. (#5) + * Initial version. (#4) diff --git a/copilot-visualizer/LICENSE b/copilot-visualizer/LICENSE new file mode 100644 index 000000000..d3c9e46cd --- /dev/null +++ b/copilot-visualizer/LICENSE @@ -0,0 +1,29 @@ +2024-2025 (c) NASA +BSD3 License terms + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions +are met: + +Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. + +Redistributions in binary form must reproduce the above copyright +notice, this list of conditions and the following disclaimer in the +documentation and/or other materials provided with the distribution. + +Neither the name of the developers nor the names of its contributors +may be used to endorse or promote products derived from this software +without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR +CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, +EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, +PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR +PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF +LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING +NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/copilot-visualizer/README.md b/copilot-visualizer/README.md new file mode 100644 index 000000000..f4a93c4a2 --- /dev/null +++ b/copilot-visualizer/README.md @@ -0,0 +1,34 @@ +[![Build Status](https://travis-ci.com/Copilot-Language/copilot.svg?branch=master)](https://app.travis-ci.com/github/Copilot-Language/copilot) + +# Copilot: a stream DSL + +The visualizer, which draws Copilot specifications using different graphical +formats. + +Copilot is a runtime verification framework written in Haskell. It allows the +user to write programs in a simple but powerful way using a stream-based +approach. + +Programs can be interpreted for testing (with the library copilot-interpreter), +or translated C99 code to be incorporated in a project, or as a standalone +application. The C99 backend ensures us that the output is constant in memory +and time, making it suitable for systems with hard realtime requirements. + +## Installation + +Copilot-visualizer can be found on +[Hackage](https://hackage.haskell.org/package/copilot-interpreter). It is +typically only installed as part of the complete Copilot distribution. For +installation instructions, please refer to the [Copilot +website](https://copilot-language.github.io). + +## Further information + +For further information, install instructions and documentation, please visit +the Copilot website: +[https://copilot-language.github.io](https://copilot-language.github.io) + +## License + +Copilot is distributed under the BSD-3-Clause license, which can be found +[here](https://raw.githubusercontent.com/Copilot-Language/copilot/master/copilot-interpreter/LICENSE). diff --git a/copilot-visualizer/Setup.hs b/copilot-visualizer/Setup.hs new file mode 100644 index 000000000..9a994af67 --- /dev/null +++ b/copilot-visualizer/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/copilot-visualizer/copilot-visualizer.cabal b/copilot-visualizer/copilot-visualizer.cabal new file mode 100644 index 000000000..e57efd780 --- /dev/null +++ b/copilot-visualizer/copilot-visualizer.cabal @@ -0,0 +1,130 @@ +cabal-version: >= 1.10 +name: copilot-visualizer +version: 4.4 +synopsis: Visualizer for Copilot. +description: + Visualizer for Copilot. + . + Copilot is a stream (i.e., infinite lists) domain-specific language (DSL) in + Haskell that compiles into embedded C. Copilot contains an interpreter, + multiple back-end compilers, and other verification tools. + . + A tutorial, examples, and other information are available at + . + +author: Ivan Perez, Frank Dedden, Ryan Scott, Kyle Beechly +license: BSD3 +license-file: LICENSE +maintainer: Ivan Perez +homepage: https://copilot-language.github.io +bug-reports: https://github.com/Copilot-Language/copilot/issues +stability: Experimental +category: Language, Embedded +build-type: Simple +extra-source-files: README.md + CHANGELOG + examples/gui/Main.hs + examples/gui/main.html + examples/gui/copilot.css + examples/gui/copilot.js + examples/tikz/Heater.hs + +data-files: data/tikz/tikz.tex + data/static_html/index.html + +x-curation: uncurated + +source-repository head + type: git + location: https://github.com/Copilot-Language/copilot.git + subdir: copilot-visualizer + +flag examples + description: Enable examples + default: False + manual: True + +library + + default-language: + Haskell2010 + + hs-source-dirs: + src + + ghc-options: + -Wall + + build-depends: + base >= 4.9 && < 5, + aeson >= 2.0.0.0 && < 2.3, + filepath >= 1.4.2 && < 1.6, + hint >= 0.9.0 && < 1.10, + pretty >= 1.0 && < 1.2, + ogma-extra >= 1.6.0 && < 1.7, + text >= 1.2.3.1 && < 2.2, + websockets >= 0.12.7 && < 0.14, + + copilot >= 4.4 && < 4.5, + copilot-core >= 4.4 && < 4.5, + copilot-interpreter >= 4.4 && < 4.5, + copilot-language >= 4.4 && < 4.5 + + exposed-modules: + + Copilot.Visualize.Live + Copilot.Visualize.Static + + other-modules: + + Copilot.Visualize.Dynamic + Copilot.Visualize.TypedTrace + Copilot.Visualize.UntypedTrace + Paths_copilot_visualizer + +executable gui-example + main-is: + Main.hs + + default-language: + Haskell2010 + + hs-source-dirs: + examples/gui + + ghc-options: + -Wall + + build-depends: + base >= 4.9 && < 5, + + copilot-visualizer + + if flag(examples) + buildable: True + else + buildable: False + +executable tikz-example + main-is: + Heater.hs + + default-language: + Haskell2010 + + hs-source-dirs: + examples/tikz + + ghc-options: + -Wall + + build-depends: + base >= 4.9 && < 5, + + copilot >= 4.4 && < 4.5, + copilot-visualizer + + if flag(examples) + buildable: True + else + buildable: False diff --git a/copilot-visualizer/data/static_html/index.html b/copilot-visualizer/data/static_html/index.html new file mode 100644 index 000000000..2160ec87a --- /dev/null +++ b/copilot-visualizer/data/static_html/index.html @@ -0,0 +1,255 @@ + + + + + + Copilot Visualizer + + + + + + + +
+ +
+ + + + diff --git a/copilot-visualizer/data/tikz/tikz.tex b/copilot-visualizer/data/tikz/tikz.tex new file mode 100644 index 000000000..b05f2c186 --- /dev/null +++ b/copilot-visualizer/data/tikz/tikz.tex @@ -0,0 +1,37 @@ +{{=<% %>=}} +\documentclass{standalone} +\usepackage{tikz} +\usepackage{tikz-timing} +\usepackage{xcolor} +\definecolor{false}{HTML}{ECD9ED} +\definecolor{true}{HTML}{D9ECED} +\begin{document} +\newcommand{\true}{T} +\newcommand{\false}{F} +\tikzset{ +every picture/.style={ + execute at end picture={ + \path (current bounding box.south west) +(-1,-1) (current bounding box.north east) +(1,1); + } +} +} + +\tikzset{ +timing/.style={x=5ex,y=2ex}, +timing/rowdist=4ex, +timing/dslope=0.1, +x=5ex, +timing/coldist=1ex, +timing/name/.style={font=\sffamily\scriptsize}, +timing/d/text/.style={font=\sffamily\tiny}, +} +\begin{tikztimingtable} +<%#adTraceElems%> +<%teName%> & g<%#teValues%><%#tvIsEmpty%>S<%/tvIsEmpty%><%^tvIsEmpty%><%#teIsBoolean%>[fill=<%tvValue%>]D{\<%tvValue%>}<%/teIsBoolean%><%^teIsBoolean%>D{<%tvValue%>}<%/teIsBoolean%><%/tvIsEmpty%><%/teValues%>\\ +<%/adTraceElems%> +\extracode +\begin{background}[shift={(0.05,0)},help lines] +\vertlines[help lines,opacity=0.3]{-0.3ex,...,<%adLastSample%>} +\end{background} +\end{tikztimingtable} +\end{document} diff --git a/copilot-visualizer/examples/gui/Main.hs b/copilot-visualizer/examples/gui/Main.hs new file mode 100644 index 000000000..8b93b7cbd --- /dev/null +++ b/copilot-visualizer/examples/gui/Main.hs @@ -0,0 +1,20 @@ +import Copilot.Visualize.Live + +main = visualize spec + +spec :: String +spec = unlines + [ "let temperature :: Stream Word8" + , " temperature = extern \"temperature\" (Just [0, 15, 20, 25, 30])" + , "" + , " ctemp :: Stream Float" + , " ctemp = (unsafeCast temperature) * (150.0 / 255.0) - 50.0" + , "" + , " trueFalse :: Stream Bool" + , " trueFalse = [True] ++ not trueFalse" + , "" + , "in do trigger \"heaton\" (temperature < 18) [arg ctemp, arg (constI16 1), arg trueFalse]" + , " trigger \"heatoff\" (temperature > 21) [arg (constI16 1), arg ctemp]" + , " observer \"temperature\" temperature" + , " observer \"temperature2\" (temperature + 1)" + ] diff --git a/copilot-visualizer/examples/gui/copilot.css b/copilot-visualizer/examples/gui/copilot.css new file mode 100644 index 000000000..82a1a0af6 --- /dev/null +++ b/copilot-visualizer/examples/gui/copilot.css @@ -0,0 +1,50 @@ +/* Timeline */ +/* Timeline decoration: Grid */ +.axis path, +.axis line { + fill: none; + stroke: #000; + shape-rendering: crispEdges; +} +.grid-line { + stroke: #ccc; + stroke-width: 1; + stroke-dasharray: 3,3; +} + +/* Timeline decoration: Labels */ +.label { + font-size: 12px; +} +.time-label { + font-family: sans-serif; + font-size: 12px; + fill: black; +} +.value-text { + font-size: 10px; + text-anchor: middle; + dominant-baseline: middle; +} + +/* Timeline decoration: Values */ +.hexagon { + stroke: black; + stroke-width: 1px; + color: green; +} +.bool-background { + opacity: 0.3; +} + +/* Toolbar buttons */ +button { + width: 100px !important; + height: 48px !important; + border-radius: 24px !important; + background-color: #f1316b !important; + color: #fff !important; + margin-top: 45px !important; + border:none !important; + font-size: 12px !important; +} diff --git a/copilot-visualizer/examples/gui/copilot.js b/copilot-visualizer/examples/gui/copilot.js new file mode 100644 index 000000000..943e3c704 --- /dev/null +++ b/copilot-visualizer/examples/gui/copilot.js @@ -0,0 +1,489 @@ +/* Constants */ + +/* Timeline dimensions */ +const margin = {top: 20, right: 20, bottom: 30, left: 90}; +const width = 960 - margin.left - margin.right; +const height = 200 - margin.top - margin.bottom; +const rowHeight = 40; + +/** + * Position of the stream labels wrt. to the left side of the timeline. + */ +const labelPosX = -90; + +/* Timeline colors */ + +/* Default colors for true and false (just dim green and red). */ +const booleanColorDefaultTrue = "#90EE90"; +const booleanColorDefaultFalse = "#FFB6C1"; + +/* + * Alternative colors for true and false, making colored backgrounds more + * easily distinguishable in conditions with reduced color. Specifically: + * + * - Increase blue content in the 'false' color to increase distinction from + * the 'true' color in protanopic (no red) and deuteranopic (no green). + * + * - Decrease red content in the 'false' color to increase distinction from the + * 'true' color in achromatopsic (no color) conditions. + * + * This does not meaningfully address visibility considerations in reduced + * contrast or blurry conditions. + */ +const booleanColorHighContrastTrue = "#90EE90"; +const booleanColorHighContrastFalse = "#E1B6ED"; + +/* Timeline state */ +let svg; +let data = { adLastSample: 0, adTraceElems: [] }; +let xScale; +let numRows = 0; +let numSteps = 2; +let booleanColorTrue = booleanColorDefaultTrue; +let booleanColorFalse = booleanColorDefaultFalse; + +/** + * Process numeric data, adding duration and y-positions to each trace element. + */ +function processNumericData(data) +{ + // Calculate bounds of stream. + const maxValue = Math.max(...data.map(d => d.tvValue)); + const minValue = Math.min(...data.map(d => d.tvValue)); + + // Vertical scale of the stream. + const yScale = d3.scaleLinear() + .domain([minValue, maxValue]) + .range([rowHeight * 0.8, rowHeight * 0.2]); + + // Return the data augmented with duration for each sample, and the vertical + // scale. + return data.map((d, i) => ({ + ...d, + duration: + i < data.length - 1 ? data[i + 1].time - d.time : numSteps + 1 - d.time, + y: yScale(d.tvValue) + })); +} + +/** + * Create timeline labels. + */ +function createLabels() +{ + document.querySelectorAll(".label").forEach(function(lst) { + lst.remove(); + }); + + // Add row labels. + const labels = data.adTraceElems.map((x) => x.teName); + svg.selectAll(".label") + .data(labels) + .enter() + .append("text") + .attr("class", "label") + .attr("x", labelPosX) + .attr("y", (d, i) => i * rowHeight + rowHeight/2) + .text(d => d); +} + +/** + * Draw numeric row with stretched hexagons. + */ +function drawNumericRow(data, rowIndex) +{ + const rowG = svg.append("g") + .attr("class", "value_list") + .attr("transform", `translate(0,${rowIndex * rowHeight})`); + + const hexHeight = rowHeight * 0.8; + + time = 0; + + // Create hexagon groups. + const hexGroups = rowG.selectAll("g") + .data(data) + .enter() + .append("g") + .attr("transform", d => `translate(${xScale(time++)},${rowHeight * 0.1})`); + + // Add hexagons. + hexGroups.append("path") + .attr("class", "hexagon") + .attr("d", d => hexagonPath(xScale(1) - xScale(0), hexHeight)) + .attr("fill", "#f7fbff"); + + // Add value text. + hexGroups.append("text") + .attr("class", "value-text") + .attr("x", d => (xScale(1) - xScale(0)) / 2) + .attr("y", hexHeight / 2) + .text(d => d.tvValue); +} + +/** + * Draw boolean rows with colored backgrounds. + */ +function drawBooleanRow(data, rowIndex) +{ + const rowG = svg.append("g") + .attr("class", "value_list") + .attr("transform", `translate(0,${rowIndex * rowHeight})`); + + time = 0; + + // Draw colored backgrounds. + rowG.selectAll("rect") + .data(data) + .enter() + .append("rect") + .attr("class", "bool-background") + .attr("x", d => xScale(time++)) + .attr("y", 0) + .attr("width", d => xScale(1) - xScale(0)) + .attr("height", rowHeight) + .attr("fill", d => d.tvValue == "true" ? booleanColorTrue : booleanColorFalse); +} + +/** + * Re-draw complete timeline. + */ +function redraw() +{ + document.querySelectorAll(".value_list").forEach(function(lst) { + lst.remove(); + }); + + // Draw all rows. + i = 0; + data.adTraceElems.forEach(function(traceElem) { + if (traceElem.teIsBoolean) + { + drawBooleanRow(traceElem.teValues, i); + } + else + { + drawNumericRow(processNumericData(traceElem.teValues), i); + } + i++; + }); +} + +/** + * Create SVG for the timeline. + */ +function createSVG() +{ + // Clear all existing elements. + if (typeof svg !== 'undefined' ) { svg.selectAll("*").remove(); } + + // Calculate number of rows and columns (steps) from available data. + numRows = data.adTraceElems.length; + numSteps = data.adLastSample; + + // Create SVG. + svg = d3.select("#timeline") + .attr("width", width + margin.left + margin.right) + .attr("height", (rowHeight * numRows) + margin.top + margin.bottom) + .append("g") + .attr("transform", `translate(${margin.left},${margin.top})`); + + // Create scales. + xScale = d3.scaleLinear() + .domain([0, numSteps + 1]) + .range([0, width]); + + // Create x-axis with ticks at integer positions. + const xAxis = d3.axisBottom(xScale) + .tickValues(Array.from({length: 11}, (_, i) => i)) + .tickFormat(''); + + createLabels(); + redraw(); + + // Add the axis. + const axisGroup = svg.append("g") + .attr("class", "axis") + .attr("transform", `translate(0,${rowHeight * numRows})`) + .call(xAxis); + + // After creating the axis and labels, add vertical grid lines. + // + // Use light gray as color, a dotted line, start from the top (negative + // because we are going up from the axis), and end at the axis. + const gridLines = axisGroup.selectAll(".grid-line") + .data(Array.from({length: 11}, (_, i) => i)) + .enter() + .append("line") + .attr("class", "grid-line") + .attr("x1", d => xScale(d)) + .attr("x2", d => xScale(d)) + .attr("y1", -rowHeight * (numRows + 1)) + .attr("y2", 0) + .style("stroke", "#ccc") + .style("stroke-width", "1") + .style("stroke-dasharray", "3,3"); + + // Add offset labels. + const timeLabels = axisGroup.selectAll(".time-label") + .data(Array.from({length: numRows + 1}, (_, i) => i)) + .enter() + .append("text") + .attr("class", "time-label") + .attr("x", d => xScale(d + 0.5)) + .attr("y", 25) + .attr("text-anchor", "middle") + .text(d => d + ""); + + // Detect clicks on timeline. + svg.on("click", function(event) { + const mouseX = d3.pointer(event)[0]; + const time = Math.floor(xScale.invert(mouseX).toFixed(2)); + const row = Math.floor((event.offsetY - margin.top) / rowHeight); + const label = data.adTraceElems[row].teName; + + console.log("Label:", label , "Time:", time); + ws.send('(Up ' + time + ', "' + label + '")'); + }); + + // Detect mouse wheel on timeline. + svg.on("wheel", function(event) { + // Prevent default scroll behavior. + event.preventDefault(); + + const mouseX = d3.pointer(event)[0]; + const time = Math.floor(xScale.invert(mouseX).toFixed(2)); + const row = Math.floor((event.offsetY - margin.top) / rowHeight); + const label = data.adTraceElems[row].teName; + const dir = event.deltaY < 0 ? 'Up' : 'Down'; + + ws.send('(' + dir + ' ' + time + ', "' + label + '")'); + + console.log ( "Label:", label, "Time:", time, "Direction:", dir); + }); +} + +/** + * Add a step to the simulation. + */ +function stepUp() +{ + ws.send('(StepUp, "")'); +} + +/** + * Reduce the number of steps of the simulation. + */ +function stepDown() +{ + ws.send('(StepDown, "")'); +} + +/** + * Open a dialog requesting information to add a new stream to the simulation. + */ +function addStream() +{ + const popup = document.getElementById("popup"); + popup.classList.remove("hidden"); +} + +/** + * Cancel dialog requesting information to add a new stream to the simulation. + */ +function closePopup() +{ + const popup = document.getElementById("popup"); + popup.classList.add("hidden"); +} + +/** + * Add a new stream to the simulation. The definition provided must be correct + * in the context of the current simulation, and the name given to the new + * stream must be valid in Haskell, unique in the current context, and not + * clash with any existing names. + */ +function addStreamSubmit() +{ + const popup = document.getElementById("popup"); + const inputName = document.getElementById("inputName").value; + const inputExpr = document.getElementById("inputExpr").value; + ws.send('(AddStream "' + inputName + '" "(' + inputExpr + ')", "")'); + popup.classList.add("hidden"); +} + +/** + * Toggle the color scheme of the timeline. + */ +function toggleColors() +{ + const highContrastBtn = document.getElementById('high_contrast'); + if (highContrastBtn.checked) { + booleanColorTrue = booleanColorHighContrastTrue; + booleanColorFalse = booleanColorHighContrastFalse; + } else { + booleanColorTrue = booleanColorDefaultTrue; + booleanColorFalse = booleanColorDefaultFalse; + } + + createSVG(); +} + +/* Attach event handlers to UI elements */ + +// Somehow this does not work if we match the svg element directly, so we match +// the parent div. +document.getElementById("copyPNG").addEventListener("click", () => copyPNG("#timeline-parent")); + +document.getElementById("copySVG").addEventListener("click", () => copySVG("#timeline")); + +// Somehow this does not work if we match the svg element directly, so we match +// the parent div. +document.getElementById("downloadPNG").addEventListener("click", () => downloadPNG("#timeline-parent", "timeline")); + +document.getElementById("downloadSVG").addEventListener("click", () => downloadSVG("#timeline", "timeline")); + +document.getElementById("stepUp").addEventListener("click", stepUp); +document.getElementById("stepDown").addEventListener("click", stepDown); +document.getElementById("addStream").addEventListener("click", addStream); +document.getElementById("closePopup").addEventListener("click", closePopup); +document.getElementById("submitPopup").addEventListener("click", addStreamSubmit); + +// Adjust colors using high-contrast when applicable. +document.getElementById('high_contrast').addEventListener('change', toggleColors); + +createSVG(); + +// Communicate with the backend instance of Copilot via a websocket. +let ws = new WebSocket('ws://localhost:9160'); + +ws.onmessage = function(event) { + data = JSON.parse(event.data); + createSVG(); +}; + +ws.onclose = function() { + console.log('Disconnected from server'); +}; + +ws.onerror = function(error) { + console.log('Error: ' + error.message); +}; + +/* Auxiliary functions */ + +/** + * Create an hexagon path (used for cells or samples). + */ +function hexagonPath(width, height) +{ + return ` + M ${width-10},0 + L ${width},${height/2} + L ${width-10},${height} + L ${10},${height} + L ${0},${height/2} + L ${10},0 + Z + `; +} + +/** + * Download a file containing a given text. + */ +function download(filename, text) +{ + var element = document.createElement('a'); + element.setAttribute('href', 'data:text/plain;charset=utf-8,' + encodeURIComponent(text)); + element.setAttribute('download', filename); + + element.style.display = 'none'; + document.body.appendChild(element); + + element.click(); + + document.body.removeChild(element); +} + +/** + * Copy element as SVG to clipboard as SVG. + * + * @param {svg} queryString - Query string referring to an SVG element in the + * current document. + */ +function copySVG(queryString) +{ + const mySVG = document.querySelector(queryString); + const data = new XMLSerializer().serializeToString(mySVG); + + navigator.clipboard.writeText(data).then( + () => { + console.log("SVG copied to clipboard"); + }, + (err) => { + console.log("Failed to copy SVG to clipboard"); + } + ); +} + +/** + * Copy timeline to clipboard as PNG. + * + * @param {string} queryString - Query string referring to element in the + * current document. + */ +function copyPNG(queryString) +{ + const elem = document.querySelector(queryString); + html2canvas(elem).then(function(canvas) { + canvas.toBlob(function(blob) { + navigator.clipboard + .write([ + new ClipboardItem( + Object.defineProperty({}, blob.type, { + value: blob, + enumerable: true + }) + ) + ]).then(function() { + console.log("Copied to clipboard"); + }); + }); + }); +} + +/** + * Download screenshot of an element as a PNG file. + * + * @param {string} queryString - Query string referring to element in the + * current document. + * + * @param {string} defaultFilename - Default file name used in the save file + * dialog. + */ +function downloadPNG(queryString, defaultFilename) +{ + const mySVG = document.querySelector(queryString); + html2canvas(mySVG).then(function(canvas) { + var a = document.createElement('a'); + a.href = canvas.toDataURL(); + a.download = defaultFilename + ".png"; + a.click(); + }); +} + +/** + * Download screenshot of timeline as SVG file. + * + * @param {string} queryString - Query string referring to element in the + * current document. + * + * @param {string} defaultFilename - Default file name used in the save file + * dialog. + */ +function downloadSVG(queryString, defaultFilename) +{ + const mySVG = document.querySelector(queryString); + const data = new XMLSerializer().serializeToString(mySVG); + download(defaultFilename + ".svg", data); +} diff --git a/copilot-visualizer/examples/gui/main.html b/copilot-visualizer/examples/gui/main.html new file mode 100644 index 000000000..a2003d72a --- /dev/null +++ b/copilot-visualizer/examples/gui/main.html @@ -0,0 +1,67 @@ + + + Copilot Visualizer + + + + + + + + + + + + + + +
+ +
+ + +
+ + + + + + + +
+ + +
+ +
+ + + + + + + + diff --git a/copilot-visualizer/examples/tikz/Heater.hs b/copilot-visualizer/examples/tikz/Heater.hs new file mode 100644 index 000000000..e36cde926 --- /dev/null +++ b/copilot-visualizer/examples/tikz/Heater.hs @@ -0,0 +1,37 @@ +-- Copyright 2025 NASA +-- Copyright 2019 National Institute of Aerospace / Galois, Inc. + +-- This is a simple example with basic usage. It implements a simple home +-- heating system: It heats when temp gets too low, and stops when it is high +-- enough. It read temperature as a byte (range -50C to 100C) and translates +-- this to Celsius. + +module Main where + +import Language.Copilot +import Copilot.Visualize.Static + +import Prelude hiding ((>), (<)) + +-- External temperature as a byte, range of -50C to 100C +temp :: Stream Word8 +temp = extern "temperature" (Just [ 10, 15, 18, 19, 25, 5, 45 ]) + +-- Calculate temperature in Celsius. +-- We need to cast the Word8 to a Float. Note that it is an unsafeCast, as there +-- is no direct relation between Word8 and Float. +ctemp :: Stream Float +ctemp = (unsafeCast temp) * (150.0 / 255.0) - 50.0 + +spec = do + -- Triggers that fire when the ctemp is too low or too high, + -- pass the current ctemp as an argument. + trigger "heaton" (ctemp < 18.0) [arg ctemp] + trigger "heatoff" (ctemp > 21.0) [arg ctemp] + +-- Compile the spec and produce a LaTeX file in the current directory with a +-- Tikz drawing of the spec. +main :: IO () +main = do + spec' <- reify spec + visualize 3 spec' "tikz" "." diff --git a/copilot-visualizer/src/Copilot/Visualize/Dynamic.hs b/copilot-visualizer/src/Copilot/Visualize/Dynamic.hs new file mode 100644 index 000000000..26c535a93 --- /dev/null +++ b/copilot-visualizer/src/Copilot/Visualize/Dynamic.hs @@ -0,0 +1,253 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +-- | +-- Copyright : (c) NASA, 2024-2025 +-- License : BSD-style (see the LICENSE file in the distribution) +-- +-- Allow loading Copilot specifications from strings and modifying them live. +-- +-- An example of a spec that can be passed as argument to the live simulator +-- follows: +-- +-- @ +-- spec :: String +-- spec = unlines +-- [ "let temperature :: Stream Word8" +-- , " temperature = extern \"temperature\" (Just [0, 15, 20, 25, 30])" +-- , "" +-- , " ctemp :: Stream Float" +-- , " ctemp = (unsafeCast temperature) * (150.0 / 255.0) - 50.0" +-- , "" +-- , " trueFalse :: Stream Bool" +-- , " trueFalse = [True] ++ not trueFalse" +-- , "" +-- , "in do trigger \"heaton\" (temperature < 18) [arg ctemp, arg (constI16 1), arg trueFalse]" +-- , " trigger \"heatoff\" (temperature > 21) [arg (constI16 1), arg ctemp]" +-- , " observer \"temperature\" temperature" +-- , " observer \"temperature2\" (temperature + 1)" +-- ] +-- @ +-- +-- The imports are predefined. +module Copilot.Visualize.Dynamic + ( simInit + , simStep + , SimulationSettings(..) + , mkDefaultSimulationSettings + , SimData(..) + ) + where + +-- External imports +import qualified Language.Haskell.Interpreter as HI +import Prelude hiding (div, not, (++), (<), (>)) +import qualified Prelude + +-- External imports: Copilot +import qualified Copilot.Core as Core +import Copilot.Language hiding (interpret, typeOf) +import Language.Copilot hiding (interpret, typeOf) + +-- Internal imports +import Copilot.Visualize.TypedTrace + +-- | Simulation data. +data SimData = SimData + { simSteps :: Int -- ^ Number of steps to simulate. + , simSpec :: Core.Spec -- ^ Copilot spec to simulate. + , simString :: String -- ^ Textual representation of Copilot spec. + } + +-- | Initialize a simulation. +simInit :: SimulationSettings -> String -> IO SimData +simInit simulationSettings spec = do + -- Load the spec, and save it so that it doesn't need to be reloaded if it + -- doesn't change. + let numSteps = simulationSettingsInitialSteps simulationSettings + spec' <- readSpec simulationSettings spec + let simData = SimData numSteps spec' spec + return simData + +-- | Update the spec based on the input command received. +simStep :: SimulationSettings + -> SimData + -> (Command, String) + -> IO SimData +simStep _ simData (StepUp, _) = + pure simData { simSteps = simSteps simData + 1 } + +simStep _ simData (StepDown, _) = + pure simData { simSteps = simSteps simData + 1 } + +simStep simulationSettings simData (AddStream name expr, _) = do + let specN = concat [ simString simData, "\n", " ", completeExpr] + + completeExpr = concat [ "observer ", show name, " (", expr, ")" ] + + let trace = extractTrace $ simSpec simData + spec2 <- readSpec simulationSettings specN + let spec3 = updateWithTrace trace spec2 + + pure simData { simSpec = spec3, simString = specN } + +simStep simulationSettings simData (command, name) = do + spec' <- apply simulationSettings (simSpec simData) name command + pure simData { simSpec = spec' } + +-- | Settings used for a simulation. +data SimulationSettings = SimulationSettings + { simulationSettingsInitialSteps :: Int + , simulationSettingsImports :: [(String, Maybe String)] + } + +-- | Default settings that simulates 3 steps and provides default imports of +-- the main Copilot modules. +mkDefaultSimulationSettings :: SimulationSettings +mkDefaultSimulationSettings = + SimulationSettings + 3 + [ ("Control.Monad.Writer", Nothing) + , ("Copilot.Language", Nothing) + , ("Copilot.Language.Spec", Nothing) + , ("Data.Functor.Identity", Nothing) + , ("Language.Copilot", Nothing) + , ("Prelude", Just "P") + ] + +-- * Commands + +-- * Load specs from strings + +-- | Read a specification from a string and reify it. +readSpec :: SimulationSettings -> String -> IO Core.Spec +readSpec settings spec = do + r <- HI.runInterpreter (loadSpec settings spec) + case r of + Left err -> do putStrLn $ "Error: " Prelude.++ show err + error $ show err + Right s -> return s + +-- | Load a spec from a string, adding standard imports. +loadSpec :: SimulationSettings -> String -> HI.Interpreter Core.Spec +loadSpec settings spec = do + HI.setImportsQ (simulationSettingsImports settings) + spec' <- HI.interpret spec (HI.as :: Spec) + HI.liftIO $ reify spec' + +-- | Commands to apply to a running simulation. +data Command = StepUp + | StepDown + | Up Int + | Down Int + | AddStream String String + | Noop + deriving (Eq, Read, Show) + +-- | Apply a command to a simulation. +apply :: SimulationSettings -> Core.Spec -> String -> Command -> IO Core.Spec +apply settings spec _name (AddStream sName sExpr) = do + spec' <- addStream settings sName sExpr + -- TODO: I need to bring the streams from the other spec too, otherwise the + -- streams to include may refer to streams by ID that are in a different + -- scope. + let observers' = Core.specObservers spec' + observers = Core.specObservers spec + return $ spec { Core.specObservers = observers Prelude.++ observers' } + +apply _settings spec name command = pure $ spec + { Core.specStreams = + map (updateStream name command) (Core.specStreams spec) + , Core.specObservers = + map (updateObserver name command) (Core.specObservers spec) + , Core.specTriggers = + map (updateTrigger name command) (Core.specTriggers spec) + } + +-- | Apply a command to an observer. +updateObserver :: String -> Command -> Core.Observer -> Core.Observer +updateObserver name command (Core.Observer i e ty) = + Core.Observer i (updateExpr name command e) ty + +-- | Apply a command to a trigger. +updateTrigger :: String -> Command -> Core.Trigger -> Core.Trigger +updateTrigger name command (Core.Trigger i e es) = Core.Trigger i e' es' + where + e' = updateExpr name command e + es' = map (updateUExpr name command) es + +-- | Apply a command to a core expression. +updateExpr :: String -> Command -> Core.Expr a -> Core.Expr a +updateExpr name command expr = case expr of + Core.ExternVar ty nameE vs + | nameE Prelude.== name + -> Core.ExternVar ty nameE (updateValues vs ty command) + + | otherwise + -> expr + + Core.Op1 op expr1 -> + Core.Op1 op (updateExpr name command expr1) + + Core.Op2 op expr1 expr2 -> + Core.Op2 op (updateExpr name command expr1) (updateExpr name command expr2) + + Core.Op3 op expr1 expr2 expr3 -> + Core.Op3 + op + (updateExpr name command expr1) + (updateExpr name command expr2) + (updateExpr name command expr3) + + _ -> expr + +-- | Apply a command to an untyped expression that carries the information +-- about the type of the expression as a value (existential). +updateUExpr :: String -> Command -> Core.UExpr -> Core.UExpr +updateUExpr name cmd (Core.UExpr ty expr) = + Core.UExpr ty (updateExpr name cmd expr) + +-- | Apply a command to a stream. +updateStream :: String -> Command -> Core.Stream -> Core.Stream +updateStream name command (Core.Stream i buf expr ty) = + Core.Stream i buf (updateExpr name command expr) ty + +-- | Apply a command to a series of typed values, if any. +updateValues :: Maybe [a] -> Type a -> Command -> Maybe [a] +updateValues vsM ty command = + fmap (fmap (updateValue command ty) . zip [0..]) vsM + +-- | Apply a command to a typed value. +updateValue :: Command -> Type a -> (Int, a) -> a +updateValue (Up n) Core.Bool (ix, a) = + if n Prelude.== ix then Prelude.not a else a +updateValue (Down n) Core.Bool (ix, a) = + if n Prelude.== ix then Prelude.not a else a +updateValue (Up n) Core.Word8 (ix, a) = + if n Prelude.== ix then a + 1 else a +updateValue (Down n) Core.Word8 (ix, a) = + if n Prelude.== ix then a - 1 else a +updateValue _ _ (_, a) = a + +-- * Sample spec + +-- | Produce a specification from the expression for a stream. +addStream :: SimulationSettings -> String -> String -> IO Core.Spec +addStream settings name expr = do + r <- HI.runInterpreter (addStream' settings name expr) + case r of + Left err -> do putStrLn $ "Error: " Prelude.++ show err + error $ show err + Right spec -> return spec + +-- | Produce a specification from the expression for a stream, in an +-- interpreter context. +-- +-- Observe that Interpreter () is an alias for InterpreterT IO () +addStream' :: SimulationSettings -> String -> String -> HI.Interpreter Core.Spec +addStream' settings name expr = do + HI.setImportsQ (simulationSettingsImports settings) + let completeExpr = concat [ "observer ", show name, " (", expr, ")" ] + + spec <- HI.interpret completeExpr (HI.as :: Spec) + HI.liftIO $ reify spec diff --git a/copilot-visualizer/src/Copilot/Visualize/Live.hs b/copilot-visualizer/src/Copilot/Visualize/Live.hs new file mode 100644 index 000000000..973cd2feb --- /dev/null +++ b/copilot-visualizer/src/Copilot/Visualize/Live.hs @@ -0,0 +1,162 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE OverloadedStrings #-} +-- | +-- Copyright : (c) NASA, 2024-2025 +-- License : BSD-style (see the LICENSE file in the distribution) +-- +-- Run a Copilot simulation live and allow interacting with it using a +-- websocket. +-- +-- This visualizer enables adding new streams to a visualization. To do so, the +-- visualizer needs access to the original spec, and needs to be able to +-- interpret new expressions in the same context as the prior expressions. +-- +-- An example of a spec that can be passed as argument to the visualizer +-- follows: +-- +-- @ +-- spec :: String +-- spec = unlines +-- [ "let temperature :: Stream Word8" +-- , " temperature = extern \"temperature\" (Just [0, 15, 20, 25, 30])" +-- , "" +-- , " ctemp :: Stream Float" +-- , " ctemp = (unsafeCast temperature) * (150.0 / 255.0) - 50.0" +-- , "" +-- , " trueFalse :: Stream Bool" +-- , " trueFalse = [True] ++ not trueFalse" +-- , "" +-- , "in do trigger \"heaton\" (temperature < 18) [arg ctemp, arg (constI16 1), arg trueFalse]" +-- , " trigger \"heatoff\" (temperature > 21) [arg (constI16 1), arg ctemp]" +-- , " observer \"temperature\" temperature" +-- , " observer \"temperature2\" (temperature + 1)" +-- ] +-- @ +-- +-- The imports are predefined. +module Copilot.Visualize.Live + ( visualize + , visualizeWith + , VisualSettings(..) + , mkDefaultVisualSettings + , SimulationSettings(..) + , mkDefaultSimulationSettings + ) + where + +-- External imports +import Control.Exception (SomeException (..), handle) +import Data.Aeson (ToJSON (..), encode) +import qualified Data.Text as T +import qualified Network.WebSockets as WS +import Prelude hiding (div, not, (++), (<), (>)) +import qualified Prelude +import Text.Read (readMaybe) + +-- External imports: Copilot +import qualified Copilot.Core as Core +import Copilot.Interpret.Eval (ShowType (Haskell), eval) +import Copilot.Language hiding (interpret, typeOf) +import Copilot.Visualize.UntypedTrace (AppData, makeTraceEval) + +-- Internal imports +import Copilot.Visualize.Dynamic + +-- | Start a simulation for an input spec, listening for commands and +-- communicating the status via a websocket. +visualize :: String -> IO () +visualize = visualizeWith mkDefaultVisualSettings + +-- | Start a simulation for an input spec, listening for commands and +-- communicating the status via a websocket. +visualizeWith :: VisualSettings -> String -> IO () +visualizeWith settings spec = do + putStrLn $ concat + [ "WebSocket server starting on port " + , show (visualSettingsPort settings) + , "..." + ] + WS.runServer + (visualSettingsHost settings) + (visualSettingsPort settings) + (app settings spec) + +-- | Settings used to customize the simulation and interaction. +data VisualSettings = VisualSettings + { visualSettingsHost :: String + -- ^ Host interface to listen to. Use + -- "127.0.0.1" to listen at localhost. + + , visualSettingsPort :: Int + -- ^ Port to listen to. + + , visualSettingsSimulation :: SimulationSettings + -- ^ Settings for the simulation. + } + +-- | Default settings that simulates 3 steps and listens on localhost at port +-- 9160. +mkDefaultVisualSettings :: VisualSettings +mkDefaultVisualSettings = VisualSettings + { visualSettingsHost = "127.0.0.1" + , visualSettingsPort = 9160 + , visualSettingsSimulation = mkDefaultSimulationSettings + } + +-- * Server + +-- | Server application using web sockets. +app :: VisualSettings -> String -> WS.ServerApp +app settings spec pending = do + conn <- WS.acceptRequest pending + WS.withPingThread conn 30 (return ()) $ appInit settings spec conn + +-- | Initialize the backend. +appInit :: VisualSettings -> String -> WS.Connection -> IO () +appInit settings spec conn = handle appException $ do + -- Initialize the simulation. + simData <- simInit (visualSettingsSimulation settings) spec + + -- Communicate the current values of the trace, in JSON, via the web + -- socket. + let appData = mkAppData (simSteps simData) (simSpec simData) + let samples = encode $ toJSON appData + WS.sendTextData conn samples + + -- Start the application loop. + appMainLoop settings conn simData + + where + + appException :: SomeException -> IO () + appException e = do + putStrLn $ "Error:" Prelude.++ show e + error $ show e + +-- | Run the main application, repeatedly reading commands from a web socket +-- and returning results via the same web socket. +appMainLoop :: VisualSettings + -> WS.Connection + -> SimData + -> IO () +appMainLoop settings conn simData = do + -- Read a command from the web socket. + cmdM <- readMaybe . T.unpack <$> WS.receiveData conn + + -- Run a simulation step, if a command has been received. + let simulationSettings = visualSettingsSimulation settings + simData' <- maybe (pure simData) (simStep simulationSettings simData) cmdM + + -- Communicate the current values of the trace, in JSON, via the web socket. + let appData = mkAppData (simSteps simData') (simSpec simData') + samples = encode $ toJSON appData + WS.sendTextData conn samples + + appMainLoop settings conn simData' + +-- * Auxiliary functions + +-- | Obtain the trace data from a Copilot spec for a number of steps. +mkAppData :: Int -> Core.Spec -> AppData +mkAppData numSteps spec' = + makeTraceEval numSteps spec' (eval Haskell numSteps spec') diff --git a/copilot-visualizer/src/Copilot/Visualize/Static.hs b/copilot-visualizer/src/Copilot/Visualize/Static.hs new file mode 100644 index 000000000..bfe5f34a8 --- /dev/null +++ b/copilot-visualizer/src/Copilot/Visualize/Static.hs @@ -0,0 +1,36 @@ +-- | +-- Copyright : (c) NASA, 2024-2025 +-- License : BSD-style (see the LICENSE file in the distribution) +-- +-- Produce a visual representation of a Copilot specification. +module Copilot.Visualize.Static + ( visualize + ) + where + +-- External imports +import Data.Aeson (ToJSON (..)) +import System.Directory.Extra (copyTemplate) +import System.FilePath (()) + +-- External imports: Copilot +import Copilot.Core (Spec (..)) +import Copilot.Interpret.Eval (ShowType (Haskell), eval) + +-- Internal imports +import Copilot.Visualize.UntypedTrace (makeTraceEval) +import Paths_copilot_visualizer (getDataDir) + +-- | Produce a visual representation of a Copilot specification, for a given +-- number of steps, using a template. +visualize :: Int -- ^ Number of steps to interpret. + -> Spec -- ^ Specification to interpret. + -> String -- ^ Base used to expand the static file (i.e., @"tikz"@, + -- @"static_html"@). + -> FilePath + -> IO () +visualize k spec base target = do + dir <- getDataDir + let f = dir "data" base + let subs = toJSON $ makeTraceEval k spec $ eval Haskell k spec + copyTemplate f subs target diff --git a/copilot-visualizer/src/Copilot/Visualize/TypedTrace.hs b/copilot-visualizer/src/Copilot/Visualize/TypedTrace.hs new file mode 100644 index 000000000..901f42820 --- /dev/null +++ b/copilot-visualizer/src/Copilot/Visualize/TypedTrace.hs @@ -0,0 +1,158 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +-- | +-- Copyright : (c) NASA, 2024-2025 +-- License : BSD-style (see the LICENSE file in the distribution) +-- +-- Read and modify traces of specifications. +-- +-- In the context of this module, a trace refers only to the values of +-- externs, since the state of a spec can be reproduced if the values of +-- externs are known. +module Copilot.Visualize.TypedTrace + ( extractTrace + , updateWithTrace + , Trace(..) + , UValues(..) + ) + where + +-- External imports +import Data.List hiding ((++)) +import Data.Maybe (fromMaybe) +import qualified Data.Type.Equality as DE +import Data.Typeable (Typeable) +import Prelude hiding (div, not, (++), (<), (>)) + +-- External imports: Copilot +import qualified Copilot.Core as Core +import Language.Copilot hiding (interpret, typeOf) + +-- | Map stream names to their values. +newtype Trace = Trace + { traceMap :: [ (String, UValues) ] + } + +-- | Existentially typed list of values of a stream. +data UValues = forall a . Typeable a => UValues + { uvType :: Core.Type a + , uvValues :: [ a ] + } + +-- | Extract a trace from a core specification. +extractTrace :: Core.Spec -> Trace +extractTrace spec = Trace $ concat $ concat + [ fmap extractTraceStream (Core.specStreams spec) + , fmap extractTraceObserver (Core.specObservers spec) + , fmap extractTraceTrigger (Core.specTriggers spec) + ] + +-- | Extract the values of a core 'Stream'. +extractTraceStream :: Core.Stream -> [ (String, UValues) ] +extractTraceStream (Core.Stream _id _buf expr _ty) = + extractTraceExpr expr + +-- | Extract the values of a core 'Observer'. +extractTraceObserver :: Core.Observer -> [ (String, UValues) ] +extractTraceObserver (Core.Observer _name expr _ty) = + extractTraceExpr expr + +-- | Extract the values of a core 'Trigger'. +extractTraceTrigger :: Core.Trigger -> [ (String, UValues) ] +extractTraceTrigger (Core.Trigger _name expr args) = concat $ + extractTraceExpr expr + : fmap extractTraceUExpr args + +-- | Extract the values of a core 'Expr'. +extractTraceExpr :: Core.Expr a -> [ (String, UValues) ] +extractTraceExpr (Core.Local _ _ _ expr1 expr2) = concat + [ extractTraceExpr expr1 + , extractTraceExpr expr2 + ] +extractTraceExpr (Core.ExternVar ty name values) = + [ (name, UValues ty (fromMaybe [] values)) ] +extractTraceExpr (Core.Op1 _op expr) = + extractTraceExpr expr +extractTraceExpr (Core.Op2 _op expr1 expr2) = concat + [ extractTraceExpr expr1 + , extractTraceExpr expr2 + ] +extractTraceExpr (Core.Op3 _op expr1 expr2 expr3) = concat + [ extractTraceExpr expr1 + , extractTraceExpr expr2 + , extractTraceExpr expr3 + ] +extractTraceExpr (Core.Label _ty _lbl expr) = + extractTraceExpr expr +extractTraceExpr _ = [] + +-- | Extract the values of a core 'UExpr'. +extractTraceUExpr :: Core.UExpr -> [ (String, UValues) ] +extractTraceUExpr (Core.UExpr ty expr) = extractTraceExpr expr + +-- | Update externs in a spec. +updateWithTrace :: Trace -> Core.Spec -> Core.Spec +updateWithTrace trace spec = spec + { Core.specStreams = + fmap (updateWithTraceStream trace) (Core.specStreams spec) + , Core.specObservers = + fmap (updateWithTraceObserver trace) (Core.specObservers spec) + , Core.specTriggers = + fmap (updateWithTraceTrigger trace) (Core.specTriggers spec) + } + +-- | Update the values of a 'Stream' based on an input trace. +updateWithTraceStream :: Trace -> Core.Stream -> Core.Stream +updateWithTraceStream trace (Core.Stream ident buf expr ty) = + Core.Stream ident buf (updateWithTraceExpr trace expr) ty + +-- | Update the values of an 'Observer' based on an input trace. +updateWithTraceObserver :: Trace -> Core.Observer -> Core.Observer +updateWithTraceObserver trace (Core.Observer name expr ty) = + Core.Observer name (updateWithTraceExpr trace expr) ty + +-- | Update the values of a 'Trigger' based on an input trace. +updateWithTraceTrigger :: Trace -> Core.Trigger -> Core.Trigger +updateWithTraceTrigger trace (Core.Trigger name expr args) = + Core.Trigger + name + (updateWithTraceExpr trace expr) + (fmap (updateWithTraceUExpr trace) args) + +-- | Update the values of an 'Expr' based on an input trace. +updateWithTraceExpr :: Trace -> Core.Expr a -> Core.Expr a +updateWithTraceExpr trace (Core.Local ty1 ty2 name expr1 expr2) = + Core.Local + ty1 + ty2 + name + (updateWithTraceExpr trace expr1) + (updateWithTraceExpr trace expr2) +updateWithTraceExpr trace (Core.ExternVar ty name values) = + Core.ExternVar ty name values' + where + values' | Just (UValues ty2 vals) <- lookup name (traceMap trace) + , Just DE.Refl <- DE.testEquality ty ty2 + = Just vals + | otherwise + = values +updateWithTraceExpr trace (Core.Op1 op expr) = + Core.Op1 op (updateWithTraceExpr trace expr) +updateWithTraceExpr trace (Core.Op2 op expr1 expr2) = + Core.Op2 op + (updateWithTraceExpr trace expr1) + (updateWithTraceExpr trace expr2) +updateWithTraceExpr trace (Core.Op3 op expr1 expr2 expr3) = + Core.Op3 op + (updateWithTraceExpr trace expr1) + (updateWithTraceExpr trace expr2) + (updateWithTraceExpr trace expr3) +updateWithTraceExpr trace (Core.Label ty lbl expr) = + Core.Label ty lbl (updateWithTraceExpr trace expr) +updateWithTraceExpr trace x = x + +-- | Update the values of a 'UExpr' based on an input trace. +updateWithTraceUExpr :: Trace -> Core.UExpr -> Core.UExpr +updateWithTraceUExpr trace (Core.UExpr ty expr) = + Core.UExpr ty (updateWithTraceExpr trace expr) diff --git a/copilot-visualizer/src/Copilot/Visualize/UntypedTrace.hs b/copilot-visualizer/src/Copilot/Visualize/UntypedTrace.hs new file mode 100644 index 000000000..6bbc8365d --- /dev/null +++ b/copilot-visualizer/src/Copilot/Visualize/UntypedTrace.hs @@ -0,0 +1,176 @@ +{-# LANGUAGE DeriveGeneric #-} +-- | +-- Copyright : (c) NASA, 2024-2025 +-- License : BSD-style (see the LICENSE file in the distribution) +-- +-- Abstract representation of a trace as a series named streams with their +-- values, together with functions needed to convert a 'Spec' into a trace. +-- +-- This trace is flat (untyped). Information about the types is captured +-- using boolean flags. This kind of trace is most useful to render values +-- on in logicless templates, since they don't have the capability to examine +-- the Haskell types. +module Copilot.Visualize.UntypedTrace + ( AppData(..) + , Trace + , TraceElem(..) + , TraceValue(..) + , makeTraceEval + ) + where + +-- External imports +import Data.Aeson (ToJSON (..)) +import Data.Bifunctor (second) +import Data.List (find, transpose) +import Data.Maybe (isJust, isNothing) +import GHC.Generics (Generic) +import Text.Printf (printf) +import Text.Read (readMaybe) + +-- External imports: Copilot +import Copilot.Core (Spec (..), triggerArgs, triggerName) +import Copilot.Interpret.Eval (ExecTrace, Output, interpObservers, + interpTriggers) + +-- * Abstract representation of a trace + +-- | Data related to a specification. +data AppData = AppData + { adTraceElems :: Trace + , adLastSample :: Int + } + deriving (Generic, Show) + +instance ToJSON AppData + +-- | A trace, defined by a list of trace elements, each defining a stream (in +-- an abstract sense). +type Trace = [ TraceElem ] + +-- | An element of a trace, or stream, with a name, its values, and information +-- about its type, needed to render it correctly. +data TraceElem = TraceElem + { teName :: String + , teIsBoolean :: Bool + , teIsFloat :: Bool + , teValues :: [ TraceValue ] + } + deriving (Generic, Show) + +instance ToJSON TraceElem + +-- | An individual sample, with a value and an indication of whether the sample +-- exists. +data TraceValue = TraceValue + { tvValue :: String + , tvIsEmpty :: Bool + } + deriving (Generic, Show) + +instance ToJSON TraceValue + +-- | Generate an abstract representation of a trace of a specification +-- interpreted for a given number of steps. +makeTraceEval :: Int + -> Spec + -> ExecTrace + -> AppData +makeTraceEval k spec e = + AppData (observerTEs ++ triggerTEs) (k - 1) + where + observerTEs = map mkTraceElem (interpObserversOpt spec e) + triggerTEs = map mkTraceElem (interpTriggersWithArgs spec e) + +-- | Generate an element of a trace from a stream name and its values over +-- time. +mkTraceElem :: (String, [Maybe Output]) -> TraceElem +mkTraceElem (name, outputs) = TraceElem + { teName = name + , teValues = values + , teIsBoolean = any (isBoolean . tvValue) values + , teIsFloat = any (isFloat . tvValue) values + } + where + values = map mkTraceValue outputs + +-- | Generate an individual value (sample) of a trace. +mkTraceValue :: Maybe Output -> TraceValue +mkTraceValue x = TraceValue (showValue x) (isNothing x) + +-- * Auxiliary functions + +-- | Compute the list of values associated to observers. +interpObserversOpt :: Spec -> ExecTrace -> [(String, [Maybe Output])] +interpObserversOpt _spec = map (second (map Just)) . interpObservers + +-- | Compute the list of values associated to triggers and their arguments. +-- +-- For each trigger, we first include the values of the trigger itself, and +-- then the values of the arguments to the trigger. +interpTriggersWithArgs :: Spec -> ExecTrace -> [(String, [Maybe Output])] +interpTriggersWithArgs spec = concatMap triggerOutputs . interpTriggers + where + -- This function adds one more output for the trigger itself. + triggerOutputs :: (String, [Maybe [Output]]) -> [(String, [Maybe Output])] + triggerOutputs (triggerName, triggerArgs) = + (triggerName, triggerValues) : zip argNames argValues + where + triggerValues = map triggerValue triggerArgs + + -- Value for the trigger at a given time, based on the values of its + -- arguments. + triggerValue :: Maybe [Output] -> Maybe Output + triggerValue Nothing = Just "false" + triggerValue (Just _) = Just "true" + + -- Names and values for the arguments. + argNames = map (\ix -> triggerName ++ "Arg" ++ show ix) [0..] + argValues = transpose (transMaybes numArgs triggerArgs) + numArgs = triggerNumArgs spec triggerName + +-- Number of arguments to a trigger in a spec. +-- +-- PRE: name exists as a trigger in spec. +triggerNumArgs :: Spec -> String -> Int +triggerNumArgs spec name = + case find (\t -> triggerName t == name) (specTriggers spec) of + Nothing -> error "Couldn't find given trigger in spec, should never occur!" + Just t -> length $ triggerArgs t + +-- | True if the input value denotes a boolean value. +isBoolean :: String -> Bool +isBoolean "true" = True +isBoolean "false" = True +isBoolean _ = False + +-- | True if the input value denotes a floating point value. +isFloat :: String -> Bool +isFloat s = isJust asInt || isJust asFloat + where + asInt :: Maybe Int + asInt = readMaybe s + + asFloat :: Maybe Float + asFloat = readMaybe s + +-- | Show a value. +showValue :: Maybe Output -> String +showValue Nothing = "--" +showValue (Just s) | isFloat s = showValueFloat s + | otherwise = s + +-- | Show a floating point value. +showValueFloat :: Output -> String +showValueFloat = formatFloat . read + where + formatFloat :: Double -> String + formatFloat = printf "%.2g" + +-- | Given a list of maybe lists of known length, this function creates a list +-- of lists, pushing the Maybe's inside. +transMaybes :: Int -> [Maybe [a]] -> [[Maybe a]] +transMaybes = map . transMaybes' + where + transMaybes' argsLength (Just xs) = map Just xs + transMaybes' argsLength Nothing = replicate argsLength Nothing From 93df3925b06c4ba0c60ae58c6b67becfeacc9ca6 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 27 Jun 2025 13:26:16 +0000 Subject: [PATCH 0937/1222] copilot-visualizer: Remove duplicate .gitignore. Refs #624. The copilot-visualizer package was developed outside of this repo, but there's interest in having all Copilot projects and libraries merged into a main repo for ease of management. A prior commit add the copilot-visualizer library as a subdirectory of the main repository. The library included a .gitignore file, which is a duplicate of the one already present at the top level of the repository. This commit removes the duplicate file to have all ignored files governed by the .gitignore file at the top level. --- copilot-visualizer/.gitignore | 25 ------------------------- 1 file changed, 25 deletions(-) delete mode 100644 copilot-visualizer/.gitignore diff --git a/copilot-visualizer/.gitignore b/copilot-visualizer/.gitignore deleted file mode 100644 index f94ebc47b..000000000 --- a/copilot-visualizer/.gitignore +++ /dev/null @@ -1,25 +0,0 @@ -dist -dist-* -cabal-dev -*.o -*.hi -*.chi -*.chs.h -*.dyn_o -*.dyn_hi -.hpc -.hsenv -.cabal-sandbox/ -cabal.sandbox.config -*.prof -*.aux -*.hp -*.eventlog -.stack-work/ -cabal.project.local -cabal.project.local~ -.HTF/ -.ghc.environment.* -copilot-profiling -.DS_Store -.log From 398f75d4643f97c4b7aa1f5ade8473de96723838 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 27 Jun 2025 13:29:31 +0000 Subject: [PATCH 0938/1222] copilot-visualizer: Adjust issue numbers in CHANGELOG. Refs #624. The copilot-visualizer package was originally developed in an external repo, but there is interest in having all Copilot projects and libraries merged into the main repo for ease of management. A prior commit added the copilot-visualizer library as a subdirectory of the main copilot repo. However the CHANGELOG included with that library lists issue numbers that refer to issues in the original repo, not the main Copilot repo, which can cause confusion. This commit adjusts old issue numbers in the copilot-visualizer CHANGELOG to include the package name, to make it clear that they refer to the old repo. --- copilot-visualizer/CHANGELOG | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/copilot-visualizer/CHANGELOG b/copilot-visualizer/CHANGELOG index 44cb9f05e..0c219f99d 100644 --- a/copilot-visualizer/CHANGELOG +++ b/copilot-visualizer/CHANGELOG @@ -1,3 +1,3 @@ 2025-06-26 - * Release 4.4. (#5) - * Initial version. (#4) + * Release 4.4. (copilot-visualizer#5) + * Initial version. (copilot-visualizer#4) From b38f158b8a9ff437bd8458e3f6981ab59b69cf78 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 27 Jun 2025 13:38:11 +0000 Subject: [PATCH 0939/1222] copilot-visualizer: Document changes in CHANGELOG. Refs #624. --- copilot-visualizer/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-visualizer/CHANGELOG b/copilot-visualizer/CHANGELOG index 0c219f99d..b2058f089 100644 --- a/copilot-visualizer/CHANGELOG +++ b/copilot-visualizer/CHANGELOG @@ -1,3 +1,6 @@ +2025-06-27 + * Include in mainline. (#624) + 2025-06-26 * Release 4.4. (copilot-visualizer#5) * Initial version. (copilot-visualizer#4) From 1e24c308af55b0f01bb33af2334e74faba337918 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 28 Jun 2025 14:01:04 +0000 Subject: [PATCH 0940/1222] copilot-core: Remove deprecated fields of Copilot.Core.Expr.UExpr. Refs #636. The record fields uExprExpr and uExprType, part of Copilot.Core.Expr, are never really used within the module or in any other part of Copilot or, as far as we know, by any user of Copilot. The record fields were deprecated in Copilot 4.2 and no messages have been received requesting that they be kept in this library. As per our internal policy of waiting 3 versions from deprecation until a public interface declaration can be removed, these definitions can now be removed. This commit removes the fields uExprType and uExprExpr from the definition of Copilot.Core.Expr.UExpr, making the type no longer a record. --- copilot-core/src/Copilot/Core/Expr.hs | 6 +----- 1 file changed, 1 insertion(+), 5 deletions(-) diff --git a/copilot-core/src/Copilot/Core/Expr.hs b/copilot-core/src/Copilot/Core/Expr.hs index 277e919d1..b65126a04 100644 --- a/copilot-core/src/Copilot/Core/Expr.hs +++ b/copilot-core/src/Copilot/Core/Expr.hs @@ -67,8 +67,4 @@ data Expr a where -- | A untyped expression that carries the information about the type of the -- expression as a value, as opposed to exposing it at type level (using an -- existential). -data UExpr = forall a . Typeable a => UExpr - { uExprType :: Type a - , uExprExpr :: Expr a - } -{-# DEPRECATED uExprType, uExprExpr "These fields are deprecated in Copilot 4.2. Use pattern matching instead." #-} +data UExpr = forall a . Typeable a => UExpr (Type a) (Expr a) From 2f4cc73a5f6db04fdd3bbabca6e52d35d011836e Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 28 Jun 2025 14:05:52 +0000 Subject: [PATCH 0941/1222] copilot-core: Document changes in CHANGELOG. Refs #636. --- copilot-core/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-core/CHANGELOG b/copilot-core/CHANGELOG index 4a0902c21..edd45681e 100644 --- a/copilot-core/CHANGELOG +++ b/copilot-core/CHANGELOG @@ -1,3 +1,6 @@ +2025-06-28 + * Remove deprecated fields of Copilot.Core.Expr.UExpr. (#636) + 2025-05-07 * Version bump (4.4). (#618) * Remove deprecated Copilot.Core.Type.uTypeType. (#615) From 282a78fe127040aa77d042b01fa21b868e8dc7e4 Mon Sep 17 00:00:00 2001 From: carte731 Date: Thu, 29 May 2025 07:01:55 -0700 Subject: [PATCH 0942/1222] copilot-theorem: Remove 'GeneralizedNewtypeDeriving' unused pragma from 'what4.hs'. Refs #613. The code of copilot-theorem contains unused language pragmas. To comply with our coding style, which required unused code not to be included in the codebase, those pragmas should be removed. This commit removes an unused pragma from Copilot.Theorem.What4. --- copilot-theorem/src/Copilot/Theorem/What4.hs | 29 ++++++++++---------- 1 file changed, 14 insertions(+), 15 deletions(-) diff --git a/copilot-theorem/src/Copilot/Theorem/What4.hs b/copilot-theorem/src/Copilot/Theorem/What4.hs index 818ac9b3a..c2c7eb01b 100644 --- a/copilot-theorem/src/Copilot/Theorem/What4.hs +++ b/copilot-theorem/src/Copilot/Theorem/What4.hs @@ -1,18 +1,17 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE KindSignatures #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE MultiWayIf #-} -{-# LANGUAGE PatternSynonyms #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TupleSections #-} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeOperators #-} -- | -- Module : Copilot.Theorem.What4 From ad38ba44ee3e45ce0a196e5f4e78d981b3943236 Mon Sep 17 00:00:00 2001 From: carte731 Date: Thu, 29 May 2025 07:04:04 -0700 Subject: [PATCH 0943/1222] copilot-theorem: Remove 'MultiWayIf' unused pragma from 'what4.hs'. Refs #613. The code of copilot-theorem contains unused language pragmas. To comply with our coding style, which required unused code not to be included in the codebase, those pragmas should be removed. This commit removes an unused pragma from Copilot.Theorem.What4. --- copilot-theorem/src/Copilot/Theorem/What4.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/copilot-theorem/src/Copilot/Theorem/What4.hs b/copilot-theorem/src/Copilot/Theorem/What4.hs index c2c7eb01b..7c7e84233 100644 --- a/copilot-theorem/src/Copilot/Theorem/What4.hs +++ b/copilot-theorem/src/Copilot/Theorem/What4.hs @@ -3,7 +3,6 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE LambdaCase #-} -{-# LANGUAGE MultiWayIf #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} From 4f5f09adc31500cfd30950d31de3d7a6d4180f76 Mon Sep 17 00:00:00 2001 From: carte731 Date: Thu, 29 May 2025 07:05:14 -0700 Subject: [PATCH 0944/1222] copilot-theorem: Remove 'StandaloneDeriving' unused pragma from 'what4.hs'. Refs #613. The code of copilot-theorem contains unused language pragmas. To comply with our coding style, which required unused code not to be included in the codebase, those pragmas should be removed. This commit removes an unused pragma from Copilot.Theorem.What4. --- copilot-theorem/src/Copilot/Theorem/What4.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/copilot-theorem/src/Copilot/Theorem/What4.hs b/copilot-theorem/src/Copilot/Theorem/What4.hs index 7c7e84233..8610571c0 100644 --- a/copilot-theorem/src/Copilot/Theorem/What4.hs +++ b/copilot-theorem/src/Copilot/Theorem/What4.hs @@ -6,7 +6,6 @@ {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeApplications #-} From 61fa0b46cfd7fec8964b328fc9625243e6fa412e Mon Sep 17 00:00:00 2001 From: carte731 Date: Thu, 29 May 2025 07:07:14 -0700 Subject: [PATCH 0945/1222] copilot-theorem: Remove 'TemplateHaskell' unused pragma from 'what4.hs'. Refs #613. The code of copilot-theorem contains unused language pragmas. To comply with our coding style, which required unused code not to be included in the codebase, those pragmas should be removed. This commit removes an unused pragma from Copilot.Theorem.What4. --- copilot-theorem/src/Copilot/Theorem/What4.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/copilot-theorem/src/Copilot/Theorem/What4.hs b/copilot-theorem/src/Copilot/Theorem/What4.hs index 8610571c0..c9da7fe8b 100644 --- a/copilot-theorem/src/Copilot/Theorem/What4.hs +++ b/copilot-theorem/src/Copilot/Theorem/What4.hs @@ -6,7 +6,6 @@ {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeOperators #-} From 3088023b5e781b65afb8f4c96d93085c4a17b7fd Mon Sep 17 00:00:00 2001 From: carte731 Date: Thu, 29 May 2025 07:08:44 -0700 Subject: [PATCH 0946/1222] copilot-theorem: Remove 'TupleSections' unused pragma from 'what4.hs'. Refs #613. The code of copilot-theorem contains unused language pragmas. To comply with our coding style, which required unused code not to be included in the codebase, those pragmas should be removed. This commit removes an unused pragma from Copilot.Theorem.What4. --- copilot-theorem/src/Copilot/Theorem/What4.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/copilot-theorem/src/Copilot/Theorem/What4.hs b/copilot-theorem/src/Copilot/Theorem/What4.hs index c9da7fe8b..51ed6e8ff 100644 --- a/copilot-theorem/src/Copilot/Theorem/What4.hs +++ b/copilot-theorem/src/Copilot/Theorem/What4.hs @@ -6,7 +6,6 @@ {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeOperators #-} From bbb90b6c8fa777dc2cb088900a5ba5456bac8a49 Mon Sep 17 00:00:00 2001 From: carte731 Date: Thu, 29 May 2025 07:10:00 -0700 Subject: [PATCH 0947/1222] copilot-theorem: Remove 'LambdaCase' unused pragma from 'Prover.hs'. Refs #613. The code of copilot-theorem contains unused language pragmas. To comply with our coding style, which required unused code not to be included in the codebase, those pragmas should be removed. This commit removes an unused pragma from Copilot.Theorem.Kind2.Prover. --- copilot-theorem/src/Copilot/Theorem/Kind2/Prover.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/copilot-theorem/src/Copilot/Theorem/Kind2/Prover.hs b/copilot-theorem/src/Copilot/Theorem/Kind2/Prover.hs index 66db2c346..4bb52322e 100644 --- a/copilot-theorem/src/Copilot/Theorem/Kind2/Prover.hs +++ b/copilot-theorem/src/Copilot/Theorem/Kind2/Prover.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE LambdaCase #-} {-# LANGUAGE Trustworthy #-} -- | A prover backend based on Kind2. From 2d101a7398ae1cc86d4d00f66b4ad0b96f702b84 Mon Sep 17 00:00:00 2001 From: carte731 Date: Thu, 29 May 2025 07:11:08 -0700 Subject: [PATCH 0948/1222] copilot-theorem: Remove 'LambdaCase' unused pragma from 'SMTIO.hs'. Refs #613. The code of copilot-theorem contains unused language pragmas. To comply with our coding style, which required unused code not to be included in the codebase, those pragmas should be removed. This commit removes an unused pragma from Copilot.Theorem.Prover.SMTIO. --- copilot-theorem/src/Copilot/Theorem/Prover/SMTIO.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/copilot-theorem/src/Copilot/Theorem/Prover/SMTIO.hs b/copilot-theorem/src/Copilot/Theorem/Prover/SMTIO.hs index 2ce606b31..3035f718e 100644 --- a/copilot-theorem/src/Copilot/Theorem/Prover/SMTIO.hs +++ b/copilot-theorem/src/Copilot/Theorem/Prover/SMTIO.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE Safe #-} From c9954d663f2988b2db9bd8ce65f9f14e71512195 Mon Sep 17 00:00:00 2001 From: carte731 Date: Thu, 29 May 2025 09:24:36 -0700 Subject: [PATCH 0949/1222] copilot-theorem: Document changes in CHANGELOG. Refs #613. --- copilot-theorem/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-theorem/CHANGELOG b/copilot-theorem/CHANGELOG index f221aec44..d28cc3041 100644 --- a/copilot-theorem/CHANGELOG +++ b/copilot-theorem/CHANGELOG @@ -1,3 +1,6 @@ +2025-05-29 + * Removed unused pragmas. (#613) + 2025-05-07 * Version bump (4.4). (#618) * Translate quantifiers correctly in Kind2 backend. (#594) From 1152a8f4dea8a7afd6b6cca09e71f5c7e11b238f Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 6 Jul 2025 01:25:41 +0000 Subject: [PATCH 0950/1222] copilot-theorem: Relax version constraint on `what4`. Refs #611. what4 has seen a new release 1.7, but copilot-theorem needs versions strictly lower than 1.7. This version is API-compatible for all features used by copilot-theorem. --- copilot-theorem/copilot-theorem.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot-theorem/copilot-theorem.cabal b/copilot-theorem/copilot-theorem.cabal index ad7ab8699..50f777f49 100644 --- a/copilot-theorem/copilot-theorem.cabal +++ b/copilot-theorem/copilot-theorem.cabal @@ -61,7 +61,7 @@ library , random >= 1.1 && < 1.3 , transformers >= 0.5 && < 0.7 , xml >= 1.3 && < 1.4 - , what4 >= 1.3 && < 1.7 + , what4 >= 1.3 && < 1.8 , copilot-core >= 4.4 && < 4.5 , copilot-prettyprinter >= 4.4 && < 4.5 From 1f68f7e9d5f09a2a0e6cdd902cfd20d637c30fef Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 6 Jul 2025 01:28:06 +0000 Subject: [PATCH 0951/1222] copilot-theorem: Document changes in CHANGELOG. Refs #611. --- copilot-theorem/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot-theorem/CHANGELOG b/copilot-theorem/CHANGELOG index d28cc3041..c0a0a02bd 100644 --- a/copilot-theorem/CHANGELOG +++ b/copilot-theorem/CHANGELOG @@ -1,5 +1,6 @@ -2025-05-29 +2025-07-05 * Removed unused pragmas. (#613) + * Relax version constraint on what4. (#611) 2025-05-07 * Version bump (4.4). (#618) From a9545d72df7839a5bbb999a500278c52d8d19a86 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 8 Jul 2025 06:39:31 +0000 Subject: [PATCH 0952/1222] Bump versions and constraints. Refs #642. --- copilot-bluespec/copilot-bluespec.cabal | 4 ++-- copilot-c99/copilot-c99.cabal | 4 ++-- copilot-core/copilot-core.cabal | 2 +- copilot-interpreter/copilot-interpreter.cabal | 4 ++-- copilot-language/copilot-language.cabal | 8 ++++---- copilot-libraries/copilot-libraries.cabal | 4 ++-- .../copilot-prettyprinter.cabal | 4 ++-- copilot-theorem/copilot-theorem.cabal | 6 +++--- copilot-verifier/copilot-verifier.cabal | 16 ++++++++-------- copilot-visualizer/copilot-visualizer.cabal | 12 ++++++------ copilot/copilot.cabal | 14 +++++++------- 11 files changed, 39 insertions(+), 39 deletions(-) diff --git a/copilot-bluespec/copilot-bluespec.cabal b/copilot-bluespec/copilot-bluespec.cabal index 6509e7e2a..90d9f89d1 100644 --- a/copilot-bluespec/copilot-bluespec.cabal +++ b/copilot-bluespec/copilot-bluespec.cabal @@ -1,6 +1,6 @@ cabal-version : >= 1.10 name : copilot-bluespec -version : 4.4 +version : 4.5 synopsis : A compiler for Copilot targeting FPGAs. description : This package is a back-end from Copilot to FPGAs in Bluespec. @@ -44,7 +44,7 @@ library , filepath >= 1.4 && < 1.6 , pretty >= 1.1.2 && < 1.2 - , copilot-core >= 4.4 && < 4.5 + , copilot-core >= 4.5 && < 4.6 , language-bluespec >= 0.1 && < 0.2 exposed-modules : Copilot.Compile.Bluespec diff --git a/copilot-c99/copilot-c99.cabal b/copilot-c99/copilot-c99.cabal index dabf04bf0..17ec0d950 100644 --- a/copilot-c99/copilot-c99.cabal +++ b/copilot-c99/copilot-c99.cabal @@ -1,6 +1,6 @@ cabal-version : >= 1.10 name : copilot-c99 -version : 4.4 +version : 4.5 synopsis : A compiler for Copilot targeting C99. description : This package is a back-end from Copilot to C. @@ -45,7 +45,7 @@ library , mtl >= 2.2 && < 2.4 , pretty >= 1.1 && < 1.2 - , copilot-core >= 4.4 && < 4.5 + , copilot-core >= 4.5 && < 4.6 , language-c99 >= 0.2.0 && < 0.3 , language-c99-simple >= 0.3 && < 0.4 diff --git a/copilot-core/copilot-core.cabal b/copilot-core/copilot-core.cabal index daab8383b..ffd4031a9 100644 --- a/copilot-core/copilot-core.cabal +++ b/copilot-core/copilot-core.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-core -version: 4.4 +version: 4.5 synopsis: An intermediate representation for Copilot. description: Intermediate representation for Copilot. diff --git a/copilot-interpreter/copilot-interpreter.cabal b/copilot-interpreter/copilot-interpreter.cabal index d5b679829..4bcfb3138 100644 --- a/copilot-interpreter/copilot-interpreter.cabal +++ b/copilot-interpreter/copilot-interpreter.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-interpreter -version: 4.4 +version: 4.5 synopsis: Interpreter for Copilot. description: Interpreter for Copilot. @@ -44,7 +44,7 @@ library base >= 4.9 && < 5, pretty >= 1.0 && < 1.2, - copilot-core >= 4.4 && < 4.5 + copilot-core >= 4.5 && < 4.6 exposed-modules: diff --git a/copilot-language/copilot-language.cabal b/copilot-language/copilot-language.cabal index 87d54101d..e9d4de9a9 100644 --- a/copilot-language/copilot-language.cabal +++ b/copilot-language/copilot-language.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-language -version: 4.4 +version: 4.5 synopsis: A Haskell-embedded DSL for monitoring hard real-time distributed systems. description: @@ -42,9 +42,9 @@ library , data-reify >= 0.6 && < 0.7 , mtl >= 2.0 && < 3 - , copilot-core >= 4.4 && < 4.5 - , copilot-interpreter >= 4.4 && < 4.5 - , copilot-theorem >= 4.4 && < 4.5 + , copilot-core >= 4.5 && < 4.6 + , copilot-interpreter >= 4.5 && < 4.6 + , copilot-theorem >= 4.5 && < 4.6 exposed-modules: Copilot.Language , Copilot.Language.Operators.BitWise diff --git a/copilot-libraries/copilot-libraries.cabal b/copilot-libraries/copilot-libraries.cabal index 078d009fd..214fe7dc4 100644 --- a/copilot-libraries/copilot-libraries.cabal +++ b/copilot-libraries/copilot-libraries.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-libraries -version: 4.4 +version: 4.5 synopsis: Libraries for the Copilot language. description: Libraries for the Copilot language. @@ -41,7 +41,7 @@ library , containers >= 0.4 && < 0.8 , mtl >= 2.0 && < 2.4 , parsec >= 2.0 && < 3.2 - , copilot-language >= 4.4 && < 4.5 + , copilot-language >= 4.5 && < 4.6 exposed-modules: Copilot.Library.Libraries diff --git a/copilot-prettyprinter/copilot-prettyprinter.cabal b/copilot-prettyprinter/copilot-prettyprinter.cabal index 2a4a9578f..2953cfef6 100644 --- a/copilot-prettyprinter/copilot-prettyprinter.cabal +++ b/copilot-prettyprinter/copilot-prettyprinter.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-prettyprinter -version: 4.4 +version: 4.5 synopsis: A prettyprinter of Copilot Specifications. description: A prettyprinter of Copilot specifications. @@ -45,7 +45,7 @@ library base >= 4.9 && < 5, pretty >= 1.0 && < 1.2, - copilot-core >= 4.4 && < 4.5 + copilot-core >= 4.5 && < 4.6 exposed-modules: diff --git a/copilot-theorem/copilot-theorem.cabal b/copilot-theorem/copilot-theorem.cabal index 50f777f49..47cd076b0 100644 --- a/copilot-theorem/copilot-theorem.cabal +++ b/copilot-theorem/copilot-theorem.cabal @@ -14,7 +14,7 @@ description: . -version : 4.4 +version : 4.5 license : BSD3 license-file : LICENSE maintainer : Ivan Perez @@ -63,8 +63,8 @@ library , xml >= 1.3 && < 1.4 , what4 >= 1.3 && < 1.8 - , copilot-core >= 4.4 && < 4.5 - , copilot-prettyprinter >= 4.4 && < 4.5 + , copilot-core >= 4.5 && < 4.6 + , copilot-prettyprinter >= 4.5 && < 4.6 exposed-modules : Copilot.Theorem , Copilot.Theorem.Prove diff --git a/copilot-verifier/copilot-verifier.cabal b/copilot-verifier/copilot-verifier.cabal index f7151dfeb..8b915e154 100644 --- a/copilot-verifier/copilot-verifier.cabal +++ b/copilot-verifier/copilot-verifier.cabal @@ -1,6 +1,6 @@ Cabal-version: 2.2 Name: copilot-verifier -Version: 4.4 +Version: 4.5 Author: Galois Inc. Maintainer: rscott@galois.com Copyright: (c) Galois, Inc 2021-2024 @@ -45,9 +45,9 @@ common bldflags bv-sized >= 1.0.0 && < 1.1, bytestring, containers >= 0.5.9.0, - copilot-c99 >= 4.4 && < 4.5, - copilot-core >= 4.4 && < 4.5, - copilot-theorem >= 4.4 && < 4.5, + copilot-c99 >= 4.5 && < 4.6, + copilot-core >= 4.5 && < 4.6, + copilot-theorem >= 4.5 && < 4.6, crucible >= 0.7.1 && < 0.8, crucible-llvm >= 0.7 && < 0.8, crux >= 0.7.1 && < 0.8, @@ -80,10 +80,10 @@ library copilot-verifier-examples hs-source-dirs: examples build-depends: case-insensitive, - copilot >= 4.4 && < 4.5, - copilot-language >= 4.4 && < 4.5, - copilot-libraries >= 4.4 && < 4.5, - copilot-prettyprinter >= 4.4 && < 4.5, + copilot >= 4.5 && < 4.6, + copilot-language >= 4.5 && < 4.6, + copilot-libraries >= 4.5 && < 4.6, + copilot-prettyprinter >= 4.5 && < 4.6, copilot-verifier exposed-modules: Copilot.Verifier.Examples diff --git a/copilot-visualizer/copilot-visualizer.cabal b/copilot-visualizer/copilot-visualizer.cabal index e57efd780..f0f59c93d 100644 --- a/copilot-visualizer/copilot-visualizer.cabal +++ b/copilot-visualizer/copilot-visualizer.cabal @@ -1,6 +1,6 @@ cabal-version: >= 1.10 name: copilot-visualizer -version: 4.4 +version: 4.5 synopsis: Visualizer for Copilot. description: Visualizer for Copilot. @@ -65,10 +65,10 @@ library text >= 1.2.3.1 && < 2.2, websockets >= 0.12.7 && < 0.14, - copilot >= 4.4 && < 4.5, - copilot-core >= 4.4 && < 4.5, - copilot-interpreter >= 4.4 && < 4.5, - copilot-language >= 4.4 && < 4.5 + copilot >= 4.5 && < 4.6, + copilot-core >= 4.5 && < 4.6, + copilot-interpreter >= 4.5 && < 4.6, + copilot-language >= 4.5 && < 4.6 exposed-modules: @@ -121,7 +121,7 @@ executable tikz-example build-depends: base >= 4.9 && < 5, - copilot >= 4.4 && < 4.5, + copilot >= 4.5 && < 4.6, copilot-visualizer if flag(examples) diff --git a/copilot/copilot.cabal b/copilot/copilot.cabal index 6401ef883..6d9570b19 100644 --- a/copilot/copilot.cabal +++ b/copilot/copilot.cabal @@ -1,5 +1,5 @@ name: copilot -version: 4.4 +version: 4.5 cabal-version: >= 1.10 license: BSD3 license-file: LICENSE @@ -52,12 +52,12 @@ library , directory >= 1.3 && < 1.4 , filepath >= 1.4 && < 1.6 - , copilot-core >= 4.4 && < 4.5 - , copilot-theorem >= 4.4 && < 4.5 - , copilot-language >= 4.4 && < 4.5 - , copilot-libraries >= 4.4 && < 4.5 - , copilot-c99 >= 4.4 && < 4.5 - , copilot-prettyprinter >= 4.4 && < 4.5 + , copilot-core >= 4.5 && < 4.6 + , copilot-theorem >= 4.5 && < 4.6 + , copilot-language >= 4.5 && < 4.6 + , copilot-libraries >= 4.5 && < 4.6 + , copilot-c99 >= 4.5 && < 4.6 + , copilot-prettyprinter >= 4.5 && < 4.6 exposed-modules: Language.Copilot, Language.Copilot.Main From 3d8674a71e97dcededf6fcc21f2402f4cbc5098d Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 8 Jul 2025 06:49:34 +0000 Subject: [PATCH 0953/1222] Document changes in CHANGELOG. Refs #642. --- copilot-bluespec/CHANGELOG | 3 ++- copilot-c99/CHANGELOG | 3 +++ copilot-core/CHANGELOG | 3 ++- copilot-interpreter/CHANGELOG | 3 +++ copilot-language/CHANGELOG | 3 +++ copilot-libraries/CHANGELOG | 3 +++ copilot-prettyprinter/CHANGELOG | 3 +++ copilot-theorem/CHANGELOG | 3 ++- copilot-verifier/CHANGELOG | 3 ++- copilot-visualizer/CHANGELOG | 3 ++- copilot/CHANGELOG | 3 +++ 11 files changed, 28 insertions(+), 5 deletions(-) diff --git a/copilot-bluespec/CHANGELOG b/copilot-bluespec/CHANGELOG index 10f4486ec..ccfaad8ab 100644 --- a/copilot-bluespec/CHANGELOG +++ b/copilot-bluespec/CHANGELOG @@ -1,4 +1,5 @@ -2025-05-18 +2025-07-07 + * Version bump (4.5). (#642) * Include `copilot-bluespec` in mainline `copilot` repo. (#623) 2025-05-08 diff --git a/copilot-c99/CHANGELOG b/copilot-c99/CHANGELOG index 00f705df8..7b7d3aeb6 100644 --- a/copilot-c99/CHANGELOG +++ b/copilot-c99/CHANGELOG @@ -1,3 +1,6 @@ +2025-07-07 + * Version bump (4.5). (#642) + 2025-05-07 * Version bump (4.4). (#618) diff --git a/copilot-core/CHANGELOG b/copilot-core/CHANGELOG index edd45681e..810d39b24 100644 --- a/copilot-core/CHANGELOG +++ b/copilot-core/CHANGELOG @@ -1,4 +1,5 @@ -2025-06-28 +2025-07-07 + * Version bump (4.5). (#642) * Remove deprecated fields of Copilot.Core.Expr.UExpr. (#636) 2025-05-07 diff --git a/copilot-interpreter/CHANGELOG b/copilot-interpreter/CHANGELOG index c5f4894c8..cd1e6b431 100644 --- a/copilot-interpreter/CHANGELOG +++ b/copilot-interpreter/CHANGELOG @@ -1,3 +1,6 @@ +2025-07-07 + * Version bump (4.5). (#642) + 2025-05-07 * Version bump (4.4). (#618) diff --git a/copilot-language/CHANGELOG b/copilot-language/CHANGELOG index fc28f01f1..60112d6f8 100644 --- a/copilot-language/CHANGELOG +++ b/copilot-language/CHANGELOG @@ -1,3 +1,6 @@ +2025-07-07 + * Version bump (4.5). (#642) + 2025-05-07 * Version bump (4.4). (#618) diff --git a/copilot-libraries/CHANGELOG b/copilot-libraries/CHANGELOG index a0c598f54..c724f29b5 100644 --- a/copilot-libraries/CHANGELOG +++ b/copilot-libraries/CHANGELOG @@ -1,3 +1,6 @@ +2025-07-07 + * Version bump (4.5). (#642) + 2025-05-07 * Version bump (4.4). (#618) diff --git a/copilot-prettyprinter/CHANGELOG b/copilot-prettyprinter/CHANGELOG index 360d2e9a0..8f94d9fa6 100644 --- a/copilot-prettyprinter/CHANGELOG +++ b/copilot-prettyprinter/CHANGELOG @@ -1,3 +1,6 @@ +2025-07-07 + * Version bump (4.5). (#642) + 2025-05-07 * Version bump (4.4). (#618) diff --git a/copilot-theorem/CHANGELOG b/copilot-theorem/CHANGELOG index c0a0a02bd..da078ea43 100644 --- a/copilot-theorem/CHANGELOG +++ b/copilot-theorem/CHANGELOG @@ -1,4 +1,5 @@ -2025-07-05 +2025-07-07 + * Version bump (4.5). (#642) * Removed unused pragmas. (#613) * Relax version constraint on what4. (#611) diff --git a/copilot-verifier/CHANGELOG b/copilot-verifier/CHANGELOG index 03bd15246..59ac57d9a 100644 --- a/copilot-verifier/CHANGELOG +++ b/copilot-verifier/CHANGELOG @@ -1,4 +1,5 @@ -2025-06-20 +2025-07-07 + * Version bump (4.5). (#642) * Include `copilot-verifier` in mainline `copilot` repo. (#622) 2025-05-08 diff --git a/copilot-visualizer/CHANGELOG b/copilot-visualizer/CHANGELOG index b2058f089..91c4b41fd 100644 --- a/copilot-visualizer/CHANGELOG +++ b/copilot-visualizer/CHANGELOG @@ -1,4 +1,5 @@ -2025-06-27 +2025-07-07 + * Version bump (4.5). (#642) * Include in mainline. (#624) 2025-06-26 diff --git a/copilot/CHANGELOG b/copilot/CHANGELOG index b38dd2c3d..e92d2fe91 100644 --- a/copilot/CHANGELOG +++ b/copilot/CHANGELOG @@ -1,3 +1,6 @@ +2025-07-07 + * Version bump (4.5). (#642) + 2025-05-07 * Version bump (4.4). (#618) * Update build status badge URL. (#612) From 0a1612699cb7c559b504a80addb676a15d6ee0bb Mon Sep 17 00:00:00 2001 From: Sukhman Kahlon Date: Fri, 15 Aug 2025 15:08:13 -0700 Subject: [PATCH 0954/1222] copilot: Add hello world example for FPGA. Refs #657. We need an example that demonstrates how to work with FPGAs using Copilot. This will help users start with copilot-bluespec, and also help validate our work. This commit adds a hello world example that demonstrates how to control 4 LEDs from 4 switches. The tutorial describes how to install Vivado, create the spec, compile it (in bluespec and then verilog), and upload it to the board. --- .../examples/fpga/HelloWorld/HelloWorld.hs | 19 + copilot/examples/fpga/HelloWorld/README.md | 557 ++++++++++++++++++ copilot/examples/fpga/HelloWorld/Top.bs | 17 + .../examples/fpga/HelloWorld/constraints.xdc | 17 + copilot/examples/fpga/HelloWorld/mkTop.v | 75 +++ 5 files changed, 685 insertions(+) create mode 100644 copilot/examples/fpga/HelloWorld/HelloWorld.hs create mode 100644 copilot/examples/fpga/HelloWorld/README.md create mode 100644 copilot/examples/fpga/HelloWorld/Top.bs create mode 100644 copilot/examples/fpga/HelloWorld/constraints.xdc create mode 100644 copilot/examples/fpga/HelloWorld/mkTop.v diff --git a/copilot/examples/fpga/HelloWorld/HelloWorld.hs b/copilot/examples/fpga/HelloWorld/HelloWorld.hs new file mode 100644 index 000000000..c694c8f2e --- /dev/null +++ b/copilot/examples/fpga/HelloWorld/HelloWorld.hs @@ -0,0 +1,19 @@ +module Main where + +import Language.Copilot +import Copilot.Compile.Bluespec + +-- Define switches input +sw :: Stream Word8 +sw = extern "sw" Nothing + +-- Define LEDS output +leds :: Stream Word8 +leds = sw + +spec = do + trigger "leds" true [arg leds] + +main = do + spec' <- reify spec + compile "HelloWorld" spec' diff --git a/copilot/examples/fpga/HelloWorld/README.md b/copilot/examples/fpga/HelloWorld/README.md new file mode 100644 index 000000000..78ecd1aa8 --- /dev/null +++ b/copilot/examples/fpga/HelloWorld/README.md @@ -0,0 +1,557 @@ +# Hello World Example on an FPGA Board + +Copilot is a programming language for hard real-time systems. + +This tutorial shows how to use Copilot to control LEDs from hardware switches. +The demonstration serves as an introduction of the complete toolchain needed to +integrate Copilot into hardware projects. The specification is verified via the +onboard LEDs on an Artix-7 XC7A35T FPGA, using AMD/Xilinx Vivado Design Suite. + +This page lists all the necessary applications and auxiliary files required to +run Copilot onto an FPGA. Specifically, this page shows: + +- How to install the necessary dependencies. +- How to create Copilot code that invokes the Bluespec backend. +- How to compile the Bluespec files into Verilog. +- How to run and test the design on an FPGA board. + +## Table of Contents + +- [Installation](#installation) +- [Example](#example) + - [Hello World Code](#hello-world-code) + - [Compiling Copilot into Bluespec](#compiling-copilot-into-bluespec) + - [Compiling Bluespec to Verilog](#compiling-bluespec-to-verilog) +- [Running the Hello World Example on Vivado](#running-the-hello-world-example-on-vivado) +- [Acknowledgements](#acknowledgments) + +# Installation +[(Back to top)](#table-of-contents) + +## Vivado 2025.1 + +Vivado can be installed through terminal as suggested by the following process. +The steps provided are for a Vivado version that is ~50 GB less than the one +directly available on the AMD website. If issues arise, see the official +[Vivado +documentation](https://docs.amd.com/r/en-US/ug910-vivado-getting-started/Installing-the-Vivado-Design-Suite) +for an alternative installation method. + +1. Create an account on the +[AMD](https://www.amd.com/en/registration/create-account.html) website, which +allows downloading the Vivado Design Suite. + +2. Download the [Vivado +Edition 2025.1](https://www.xilinx.com/member/forms/download) +specific for your device and verify the information required by AMD. + +3. Open the command terminal, navigate to the directory containing the + downloaded Vivado installation file, and adjust the permissions of the file + so that it can be executed: + + ```sh + $ chmod a+x FPGAs_AdaptiveSoCs_Unified_SDI_2025.1_0530_0145_.bin + ``` + Replace `` with your operating system. + +4. Run the installation program: + + ```sh + $ ./FPGAs_AdaptiveSoCs_Unified_SDI_2025.1_0530_0145_.bin + ``` + +5. An installation window will pop up. Follow the installation prompt. When + the window *Select Product to Install* is shown, select the product + *Vivado*. Then, select the *Vivado ML Standard* edition from the two + options. In the *Vivado ML Standard* window, in the subcategory *Devices*, + select the FPGA board that you're working with (in our case the *7 Series*). + Hit *install* when prompted. The download should be ~20 GB to 50 GB. + +6. Ensure that the directory where you choose to install Vivado has + read/write permissions. If the candidate installation + directory is highlighted red, it means it has the wrong permissions and/or + owner. If that happens, change the owner into a different user, or try to + run the binary installer as sudo (root) by running the command: + ```sh + $ sudo ./FPGAs_AdaptiveSoCs_Unified_SDI_2025.1_0530_0145_.bin + ``` + + The rest of the instructions assume you have installed Vivado under + `/tools`. Adjust paths accordingly as needed. + +7. Install the drivers with: + + ```sh + $ source /tools/Xilinx/2025.1/Vivado/.settings64-Vivado.sh + $ sudo /tools/Xilinx/2025.1/data/xicom/cable_drivers//install_script/install_drivers/install_drivers + ``` + + The terminal should show a message indicating that the drivers were + installed successfully. A sample output is included below. Note that the + installation path may be different on your computer. + +
Terminal Output (click to expand) + + ``` + INFO: Installing cable drivers. + INFO: Script name = /tools/Xilinx/2025.1/data/xicom/cable_drivers/lin64/install_script/install_drivers/install_drivers + INFO: HostName = iron-B650M-C-V2-Y1 + INFO: RDI_BINROOT= /tools/Xilinx/2025.1/data/xicom/cable_drivers/lin64/install_script/install_drivers + INFO: Current working dir = /home/iron/Downloads + INFO: Kernel version = 6.8.0-60-generic. + INFO: Arch = x86_64. + Successfully installed Digilent Cable Drivers + --File /etc/udev/rules.d/52-xilinx-ftdi-usb.rules does not exist. + --File version of /etc/udev/rules.d/52-xilinx-ftdi-usb.rules = 0000. + --Updating rules file. + --File /etc/udev/rules.d/52-xilinx-pcusb.rules does not exist. + --File version of /etc/udev/rules.d/52-xilinx-pcusb.rules = 0000. + --Updating rules file. + + INFO: Digilent Return code = 0 + INFO: Xilinx Return code = 0 + INFO: Xilinx FTDI Return code = 0 + INFO: Return code = 0 + INFO: Driver installation successful. + CRITICAL WARNING: Cable(s) on the system must be unplugged then plugged back in order for the driver scripts to update the cables. + ``` +
+ +8. Verify that Vivado has been installed on your device by running the + following command and checking that you see version information + being printed: + + ```sh + $ vivado -version + vivado v2025.1 (64-bit) + Tool Version Limit: 2025.05 + SW Build 6140274 on Wed May 21 22:58:25 MDT 2025 + IP Build 6138677 on Thu May 22 03:10:11 MDT 2025 + SharedData Build 6139179 on Tue May 20 17:58:58 MDT 2025 + Copyright 1986-2022 Xilinx, Inc. All Rights Reserved. + Copyright 2022-2025 Advanced Micro Devices, Inc. All Rights Reserved. + ``` + +# Example + +## Hello World Code +[(Back to top)](#table-of-contents) + +This example shows how Copilot can be used to control LEDs using switches. We +use four switches and four LEDs available on the FPGA board. + +The main Copilot specification is created in a file `HelloWorld.hs`. The final +contents of that file is available in the [Copilot +repository](https://github.com/Copilot-Language/copilot/tree/master/copilot/examples/fpga/HelloWorld/HelloWorld.hs). +The same directory contains any auxiliary files needed to run the code onto an +FPGA board. + +The first definition in a Copilot specification is a module declaration, which +should always refer to the module as the `Main` module: + +```haskell +module Main where +``` + +Next, we import the main definitions of the Copilot language, as well as the +Bluespec backend: + +```haskell +import Copilot.Compile.Bluespec +import Language.Copilot +``` + +Copilot normally represents data as infinite successions of values or +*streams*. Streams whose values are provided by input devices are considered +external inputs for this specification or *externs*. Because switches are +inputs to the Copilot logic, we define the current value of the state of the +switches as an extern carrying values of typed 8-bit unsigned integer, or +`Word8`: + +```haskell +sw :: Stream Word8 +sw = extern "sw" Nothing +``` + +The four least-significant bits of the current value of `sw` represent the +current state of each of the four switches on the board, respectively. + +Next, we define the current value of the four LEDs in a similar way. To make +the state of the LEDs match that of the switches, we state that their values +are the same: + +```haskell +leds :: Stream Word8 +leds = sw +``` + +To connect the current values of the LEDs to the actual LEDs on the board, we +must communicate the current values as outputs of the specification which we do +with a *trigger*: + +```haskell +spec = do + trigger "leds" true [arg leds] +``` + +In the above trigger definition, `"leds"` is the name of the output, whereas +`leds` (without double quotes) is a Copilot stream that, at each point in time, +will contain the current values that the LEDs should have. + +We instruct Copilot to compile the file and generate Bluespec when the Copilot +spec is executed: + +```haskell +main = do + spec' <- reify spec + compile "HelloWorld" spec' +``` + +## Compiling Copilot into Bluespec +[(Back to top)](#table-of-contents) + +Copilot and Bluespec compiler must be installed on the device (see +[Copilot](https://github.com/Copilot-Language/copilot) and +[Bluespec](https://github.com/Copilot-Language/copilot-bluespec) for +installation instructions). + +In the terminal, navigate to the directory that has the `HelloWorld.hs` +example. Compile the Copilot specification into Bluespec by running: + +```shell +$ runhaskell HelloWorld.hs +``` + +This command generates three Bluespec files in the same directory: +`HelloWorld.bs`, `HelloWorldIfc.bs` and `HelloWorldTypes.bs`. These files make +up the internal logic and interface in Verilog. For reference, the expected +content of these files is included below. The specific content may change +slightly across versions of Copilot. + +
+Contents of generated Bluespec files (click to expand) + +**`HelloWorld.bs`** + +```bluespec +package HelloWorld where { +import FloatingPoint; + +import Vector; + +import HelloWorldTypes; + +import HelloWorldIfc; + +import BluespecFP; + +mkHelloWorld :: Prelude.Module HelloWorldIfc -> + Prelude.Module Prelude.Empty; +mkHelloWorld ifcMod = + module { + ifc <- ifcMod; + let { leds_0_guard :: Prelude.Bool; + leds_0_guard = Prelude.True; + leds_0_arg0 :: Prelude.UInt 8; + leds_0_arg0 = ifc.sw._read; }; + rules { + + "leds_0": when leds_0_guard ==> ifc.leds leds_0_arg0 + } + }; +} +``` + +**`HelloWorldIfc.bs`** + +```bluespec +package HelloWorldIfc where { +import FloatingPoint; + +import Vector; + +import HelloWorldTypes; + +interface HelloWorldIfc = { + leds :: Prelude.UInt 8 -> Prelude.Action; + sw :: Prelude.Reg (Prelude.UInt 8) +} +} +``` + +**`HelloWorldTypes.bs`** + +```bluespec +package HelloWorldTypes where { +import FloatingPoint; + +import Vector +} +``` +
+ +In the same directory, create a new file named `Top.bs`. This file serves as +top-level Bluespec module, connects the three generated files together and +contains the interface definitions. This file will later be compiled into +Verilog and deployed onto the FPGA. + +We define both the `helloWorldIfc` and `mkTop` modules. When `HelloWorld.bs` is +compiled, it makes `leds` an output, which translates to an *action* method in +Bluespec. Since an *action* method updates state rather than directly driving a +signal, we need a way to hold its value, so we create the register `led_reg`, +which stores the LEDs' value. The *type* of `led_reg` must match the *type* of +`leds` in `HelloWorldIfc.bs`. + +```bluespec +package Top where + + import HelloWorld + import HelloWorldIfc + import HelloWorldTypes + + helloWorldIfc :: Prelude.Module HelloWorldIfc + helloWorldIfc = + module + -- Register that connects the LEDs to values produced by Copilot + led_reg :: Prelude.Reg (Prelude.UInt 8) <- mkReg 0 + interface + leds reg = action + led_reg := reg + + mkTop :: Prelude.Module Empty + mkTop = mkHelloWorld helloWorldIfc +``` +## Compiling Bluespec to Verilog +[(Back to top)](#table-of-contents) + +We use the Bluespec compiler to generate Verilog output using the top-level +module. `mkTop` is a function in the `Top.bs` file that instantiates the +top-level module of the design. In the terminal, we run the following command: + +```shell +$ bsc -verilog -g mkTop -u Top.bs +``` + +This step generates the Verilog code that can be compiled to run onto the FPGA +board. We can ignore the warnings shown in terminal output, but we must ensure +that the file `mkTop.v` is successfully created in the current directory. + +To program the code onto the FPGA, the ports declarations and assignments need +modifications. In the `Top.bs` file, the module that had the register and +interface for the LEDs and switches is defined in `helloWorldIfc`. Due to this, +when compiling into Verilog, the Top level module does not have `sw` and `leds` +defined in its port declaration. This has to be modified manually. + +The following `mkTop.v` lines list the module ports in the `Top.bs` file. These +are the external signals that connect to this module: + +```verilog +module mkTop(CLK, + RST_N); + input CLK; + input RST_N; +``` + +We modify `mkTop` and add the input port `sw` and output port `leds` inside the +module port because these signals will externally connect to the FPGA. The FPGA +is limited to 4 LEDs and 4 switches. Alongside the existing definitions, we +need to *assign* the value of `ifc_led_reg$D_IN`, which is an internal wire +created by the Verilog code to the output `leds`. We *assign* the output `leds` +to the register. This register was defined in our `Top.bs` and appears as an +internal register `ifc_led_reg` and its current contents appears as the value +in `leds`. The value is updated on every rising edge of the `CLK`. + +For reference, the complete contents of the modified `mkTop.v` is included +below. + +
+Contents of modified `mkTop.v` file (click to expand) + +```verilog +// +// Generated by Bluespec Compiler, version 2025.01.1 (build 65e3a87a) +// +// Further modified by Sukhman Kahlon. +// +// On Thu Aug 14 14:52:29 PDT 2025 +// +// +// Ports: +// Name I/O size props +// CLK I 1 clock +// RST_N I 1 reset +// +// No combinational paths from inputs to outputs +// +// + +`ifdef BSV_ASSIGNMENT_DELAY +`else + `define BSV_ASSIGNMENT_DELAY +`endif + +`ifdef BSV_POSITIVE_RESET + `define BSV_RESET_VALUE 1'b1 + `define BSV_RESET_EDGE posedge +`else + `define BSV_RESET_VALUE 1'b0 + `define BSV_RESET_EDGE negedge +`endif + +module mkTop(CLK, + RST_N, + sw, + leds); + input CLK; + input RST_N; + input [3:0] sw; + output [3:0] leds; + + assign leds[3:0] = ifc_led_reg[3:0]; + + // register ifc_led_reg + reg [7 : 0] ifc_led_reg; + wire [7 : 0] ifc_led_reg$D_IN; + wire ifc_led_reg$EN; + + // register ifc_led_reg + assign ifc_led_reg$D_IN = sw[3:0]; + assign ifc_led_reg$EN = 1'd1 ; + + // handling of inlined registers + + always@(posedge CLK) + begin + if (RST_N == `BSV_RESET_VALUE) + begin + ifc_led_reg <= `BSV_ASSIGNMENT_DELAY 8'd0; + end + else + begin + if (ifc_led_reg$EN) + ifc_led_reg <= `BSV_ASSIGNMENT_DELAY ifc_led_reg$D_IN; + end + end + + // synopsys translate_off + `ifdef BSV_NO_INITIAL_BLOCKS + `else // not BSV_NO_INITIAL_BLOCKS + initial + begin + ifc_led_reg = 8'hAA; + end + `endif // BSV_NO_INITIAL_BLOCKS + // synopsys translate_on +endmodule // mkTop +``` +
+ +This code will be copied to Vivado and replace the default empty module created +by Vivado. + +To interface between the FPGA board and the code, a constraints file needs to +be created and is dependent on the type of FPGA board used. Please refer to the +reference manual for your specific FPGA board, to assign pins for LEDs +accordingly. Digilent offers I/O pins for the respective boards on the +[Digilent Github Repository](https://github.com/Digilent/digilent-xdc). + +Ensure the name of the external pins after `get_ports` matches the inputs / +outputs created in the port declaration. In this example, `CLK`, `RST_N`, +`leds`, and `sw` *must* be assigned. For reference, here is the constraints +file assigning LED 4-7 for the Arty 35T CSG324-1 to the output `leds`, and +setting the switches and period accordingly. + +
+Contents of constraints file `new_constraints.xdc` (click to expand) + +```xdc +set_property -dict { PACKAGE_PIN E3 IOSTANDARD LVCMOS33 } [get_ports CLK] +create_clock -add -name sys_clk_pin -period 10.00 -waveform {0 5} [get_ports CLK] + +set_property PACKAGE_PIN C2 [get_ports RST_N] +set_property IOSTANDARD LVCMOS33 [get_ports RST_N] + +# Switches +set_property -dict { PACKAGE_PIN A8 IOSTANDARD LVCMOS33 } [get_ports { sw[0] }]; #IO_L12N_T1_MRCC_16 Sch=sw[0] +set_property -dict { PACKAGE_PIN C11 IOSTANDARD LVCMOS33 } [get_ports { sw[1] }]; #IO_L13P_T2_MRCC_16 Sch=sw[1] +set_property -dict { PACKAGE_PIN C10 IOSTANDARD LVCMOS33 } [get_ports { sw[2] }]; #IO_L13N_T2_MRCC_16 Sch=sw[2] +set_property -dict { PACKAGE_PIN A10 IOSTANDARD LVCMOS33 } [get_ports { sw[3] }]; #IO_L14P_T2_SRCC_16 Sch=sw[3] + +# LEDs +set_property -dict { PACKAGE_PIN H5 IOSTANDARD LVCMOS33 } [get_ports { leds[0] }]; #IO_L24N_T3_35 Sch=led[4] +set_property -dict { PACKAGE_PIN J5 IOSTANDARD LVCMOS33 } [get_ports { leds[1] }]; #IO_25_35 Sch=led[5] +set_property -dict { PACKAGE_PIN T9 IOSTANDARD LVCMOS33 } [get_ports { leds[2] }]; #IO_L24P_T3_A01_D17_14 Sch=led[6] +set_property -dict { PACKAGE_PIN T10 IOSTANDARD LVCMOS33 } [get_ports { leds[3] }]; #IO_L24N_T3_A00_D16_14 Sch=led[7] +``` +
+ +# Running the Hello World Example on Vivado +[(Back to top)](#table-of-contents) + +Once installed, open the Vivado Design Suite. + +1. Click *Create Project* > *Next* > *Project Name:* `HelloWorld` and choose +the desired location. + +2. Select *Create Project Subdirectory* > *Next* > *RTL Project* > *Next*. + +3. Select *Do not specify sources at this time* > *Next*. + +4. Search for the board / chip. In this example, the board used is +`xc7a35tcsg324-1`. The project should be created and initialized. + +6. Once the Vivado workspace opens, under the *Sources* tab, select *+* > *Add +or create design sources* > *Next* > *Create File*. + +7. Introduce the following values: + - *File Type*: `Verilog` + - *File Name*: `mkTop` + - *File Location*: `` + +8. Under the *Sources* tab, select *+* > *Add or create constraints* > *Next* > + *Create File*. + +10. Introduce the following values: + - *File Type*: `XDC` + - *File Name*: `new_constraints` + - *File Location*: `` + +11. From the *Sources* drop down, select *Design Sources* and open the +created design file `mkTop.v`. + +12. Copy the contents of the Verilog code `mkTop.v` as previously modified. + +13. From the *Sources* drop down, select *Constraints* and select the created +constraints file `new_constraints.xdc`. + +14. Copy and modify the constraints file according to the specific FPGA board +that aligns with the project. + +15. To run and compile the code, on the left-hand bar labeled *Flow Navigator*, +under *Project Manager* > *Program and Debug*, Select *Generate Bitstream* to +compile the code. + +16. Once bitsream generation is completed. Navigate under *Hardware Manager* > +*Open Target* > *Plug in your FPGA board via USB* > *Auto Connect* > *Program +Device*. + +The LEDs on your FPGA board should now display the LEDs counting up in +correspondence to its binary value. + +# Acknowledgements +[(Back to top)](#table-of-contents) + +This tutorial has been created by Sukhman Kahlon. + +Special thanks to the following individuals and teams for their guidance and +support throughout this project: + +Pavlo Vlastos – for providing clear and helpful instructions on setting up +Vivado. + +Ryan Scott and the Bluespec team – for their assistance with `copilot-bluespec` +and Bluespec. + +Ivan Perez – for his support with Copilot and set up for this example. + +Kaveh Zare - for sampling the tutorial and providing feedback. diff --git a/copilot/examples/fpga/HelloWorld/Top.bs b/copilot/examples/fpga/HelloWorld/Top.bs new file mode 100644 index 000000000..9e9f00c76 --- /dev/null +++ b/copilot/examples/fpga/HelloWorld/Top.bs @@ -0,0 +1,17 @@ +package Top where + + import HelloWorld + import HelloWorldIfc + import HelloWorldTypes + + helloWorldIfc :: Prelude.Module HelloWorldIfc + helloWorldIfc = + module + -- Register that connects the LEDs to values produced by Copilot + led_reg :: Prelude.Reg (Prelude.UInt 8) <- mkReg 0 + interface + led reg = action + led_reg := reg + + mkTop :: Prelude.Module Prelude.Empty + mkTop = mkHelloWorld helloWorldIfc diff --git a/copilot/examples/fpga/HelloWorld/constraints.xdc b/copilot/examples/fpga/HelloWorld/constraints.xdc new file mode 100644 index 000000000..119f897f3 --- /dev/null +++ b/copilot/examples/fpga/HelloWorld/constraints.xdc @@ -0,0 +1,17 @@ +set_property -dict { PACKAGE_PIN E3 IOSTANDARD LVCMOS33 } [get_ports CLK] +create_clock -add -name sys_clk_pin -period 10.00 -waveform {0 5} [get_ports CLK] + +set_property PACKAGE_PIN C2 [get_ports RST_N] +set_property IOSTANDARD LVCMOS33 [get_ports RST_N] + +# Switches +set_property -dict { PACKAGE_PIN A8 IOSTANDARD LVCMOS33 } [get_ports { sw[0] }]; #IO_L12N_T1_MRCC_16 Sch=sw[0] +set_property -dict { PACKAGE_PIN C11 IOSTANDARD LVCMOS33 } [get_ports { sw[1] }]; #IO_L13P_T2_MRCC_16 Sch=sw[1] +set_property -dict { PACKAGE_PIN C10 IOSTANDARD LVCMOS33 } [get_ports { sw[2] }]; #IO_L13N_T2_MRCC_16 Sch=sw[2] +set_property -dict { PACKAGE_PIN A10 IOSTANDARD LVCMOS33 } [get_ports { sw[3] }]; #IO_L14P_T2_SRCC_16 Sch=sw[3] + +# LEDs +set_property -dict { PACKAGE_PIN H5 IOSTANDARD LVCMOS33 } [get_ports { leds[0] }]; #IO_L24N_T3_35 Sch=led[4] +set_property -dict { PACKAGE_PIN J5 IOSTANDARD LVCMOS33 } [get_ports { leds[1] }]; #IO_25_35 Sch=led[5] +set_property -dict { PACKAGE_PIN T9 IOSTANDARD LVCMOS33 } [get_ports { leds[2] }]; #IO_L24P_T3_A01_D17_14 Sch=led[6] +set_property -dict { PACKAGE_PIN T10 IOSTANDARD LVCMOS33 } [get_ports { leds[3] }]; #IO_L24N_T3_A00_D16_14 Sch=led[7] diff --git a/copilot/examples/fpga/HelloWorld/mkTop.v b/copilot/examples/fpga/HelloWorld/mkTop.v new file mode 100644 index 000000000..23ecef6ab --- /dev/null +++ b/copilot/examples/fpga/HelloWorld/mkTop.v @@ -0,0 +1,75 @@ +// +// Generated by Bluespec Compiler, version 2025.01.1 (build 65e3a87a) +// +// Further modified by Sukhman Kahlon. +// +// On Thu Aug 14 14:52:29 PDT 2025 +// +// +// Ports: +// Name I/O size props +// CLK I 1 clock +// RST_N I 1 reset +// +// No combinational paths from inputs to outputs +// +// + +`ifdef BSV_ASSIGNMENT_DELAY +`else + `define BSV_ASSIGNMENT_DELAY +`endif + +`ifdef BSV_POSITIVE_RESET + `define BSV_RESET_VALUE 1'b1 + `define BSV_RESET_EDGE posedge +`else + `define BSV_RESET_VALUE 1'b0 + `define BSV_RESET_EDGE negedge +`endif + +module mkTop(CLK, + RST_N, + sw, + leds); + input CLK; + input RST_N; + input [3:0] sw; + output [3:0] leds; + + assign leds[3:0] = ifc_led_reg[3:0]; + + // register ifc_led_reg + reg [7 : 0] ifc_led_reg; + wire [7 : 0] ifc_led_reg$D_IN; + wire ifc_led_reg$EN; + + // register ifc_led_reg + assign ifc_led_reg$D_IN = sw[3:0]; + assign ifc_led_reg$EN = 1'd1 ; + + // handling of inlined registers + + always@(posedge CLK) + begin + if (RST_N == `BSV_RESET_VALUE) + begin + ifc_led_reg <= `BSV_ASSIGNMENT_DELAY 8'd0; + end + else + begin + if (ifc_led_reg$EN) + ifc_led_reg <= `BSV_ASSIGNMENT_DELAY ifc_led_reg$D_IN; + end + end + + // synopsys translate_off + `ifdef BSV_NO_INITIAL_BLOCKS + `else // not BSV_NO_INITIAL_BLOCKS + initial + begin + ifc_led_reg = 8'hAA; + end + `endif // BSV_NO_INITIAL_BLOCKS + // synopsys translate_on +endmodule // mkTop From 47f83a0d2744b0019437e3baf7e7a2f691808889 Mon Sep 17 00:00:00 2001 From: Sukhman Kahlon Date: Thu, 21 Aug 2025 16:19:06 -0700 Subject: [PATCH 0955/1222] copilot: Document changes in CHANGELOG. Refs #657. --- copilot/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot/CHANGELOG b/copilot/CHANGELOG index e92d2fe91..edb13dcd5 100644 --- a/copilot/CHANGELOG +++ b/copilot/CHANGELOG @@ -1,3 +1,6 @@ +2025-08-21 + * Add hello world example for FPGA. (#657) + 2025-07-07 * Version bump (4.5). (#642) From 8c588539f7522594b0b6872d53c47c875bc7a8ad Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 1 Sep 2025 03:47:43 +0000 Subject: [PATCH 0956/1222] copilot-visualizer: Relax version constraint on `ogma-extra`. Refs #645. In order to keep Copilot effectively working in the current Haskell ecosystem, as well as new versions of GHC, we need to extend the versions of dependencies that Copilot can be installed with. The package `ogma-extra` has seen release 1.9, but copilot-visualizer depend on versions prior to 1.7. This commit relaxes the version constraint of on `ogma-extra` to allow installation of `copilot-visualizer` with versions in the 1.9 series. --- copilot-visualizer/copilot-visualizer.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot-visualizer/copilot-visualizer.cabal b/copilot-visualizer/copilot-visualizer.cabal index f0f59c93d..cf1399573 100644 --- a/copilot-visualizer/copilot-visualizer.cabal +++ b/copilot-visualizer/copilot-visualizer.cabal @@ -61,7 +61,7 @@ library filepath >= 1.4.2 && < 1.6, hint >= 0.9.0 && < 1.10, pretty >= 1.0 && < 1.2, - ogma-extra >= 1.6.0 && < 1.7, + ogma-extra >= 1.6.0 && < 1.10, text >= 1.2.3.1 && < 2.2, websockets >= 0.12.7 && < 0.14, From 7f6042049506600a59edcb153cf532dee64fd154 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 1 Sep 2025 03:50:17 +0000 Subject: [PATCH 0957/1222] copilot-visualizer: Document changes in CHANGELOG. Refs #645. --- copilot-visualizer/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-visualizer/CHANGELOG b/copilot-visualizer/CHANGELOG index 91c4b41fd..2b2449afa 100644 --- a/copilot-visualizer/CHANGELOG +++ b/copilot-visualizer/CHANGELOG @@ -1,3 +1,6 @@ +2025-08-31 + * Relax version constraint on `ogma-extra`. (#645) + 2025-07-07 * Version bump (4.5). (#642) * Include in mainline. (#624) From 70544fb89c82d09d66e0bfef256fec863cc70bb7 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 7 Sep 2025 10:21:46 +0000 Subject: [PATCH 0958/1222] copilot-theorem: Remove unused function Copilot.Theorem.Misc.SExpr.parseSExpr. Refs #661. The function `copilot-theorem:Copilot.Theorem.Misc.SExpr.parseSExpr` is not used anywhere in the implementation. The module is internal and not exposed to the user, so that function does not have and cannot have any users. This commit removes the function, as well as another definition in the module only used by `parseSExpr`, and an import only used by those two functions. --- .../src/Copilot/Theorem/Misc/SExpr.hs | 37 +------------------ 1 file changed, 1 insertion(+), 36 deletions(-) diff --git a/copilot-theorem/src/Copilot/Theorem/Misc/SExpr.hs b/copilot-theorem/src/Copilot/Theorem/Misc/SExpr.hs index f828850b2..cb7d35ff3 100644 --- a/copilot-theorem/src/Copilot/Theorem/Misc/SExpr.hs +++ b/copilot-theorem/src/Copilot/Theorem/Misc/SExpr.hs @@ -2,10 +2,9 @@ {-# LANGUAGE Safe #-} -- | A representation for structured expression trees, with support for pretty --- printing and for parsing. +-- printing. module Copilot.Theorem.Misc.SExpr where -import Text.ParserCombinators.Parsec import Text.PrettyPrint.HughesPJ as PP hiding (char, Str) import Control.Monad @@ -70,37 +69,3 @@ toDoc shouldIndent printAtom expr = case expr of doc $$ indent (toDoc shouldIndent printAtom s) | otherwise = doc <+> toDoc shouldIndent printAtom s - --- | Parser for strings of characters separated by spaces into a structured --- tree. --- --- Parentheses are interpreted as grouping elements, that is, defining a --- 'List', which may be empty. -parser :: GenParser Char st (SExpr String) -parser = - choice [try unitP, nodeP, leafP] - - where - symbol = oneOf "!#$%&|*+-/:<=>?@^_~." - lonelyStr = many1 (alphaNum <|> symbol) - - unitP = string "()" >> return unit - - leafP = atom <$> lonelyStr - - nodeP = do void $ char '(' - spaces - st <- sepBy parser spaces - spaces - void $ char ')' - return $ List st - --- | Parser for strings of characters separated by spaces into a structured --- tree. --- --- Parentheses are interpreted as grouping elements, that is, defining a --- 'List', which may be empty. -parseSExpr :: String -> Maybe (SExpr String) -parseSExpr str = case parse parser "" str of - Left s -> error (show s) -- Nothing - Right t -> Just t From 2d601665aef9b79007e701c937139e8653248905 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 7 Sep 2025 10:23:29 +0000 Subject: [PATCH 0959/1222] copilot-theorem: Removed unnecessary dependency on parsec. Refs #661. The function `copilot-theorem:Copilot.Theorem.Misc.SExpr.parseSExpr` is not used anywhere in the implementation. The module is internal and not exposed to the user, so that function does not have and cannot have any users. A prior commit has removed the function, which was the only user of the `parsec` library across `copilot-theorem`, thus rendering that dependency no longer necessary. This commit removes that dependency from the Cabal file. --- copilot-theorem/copilot-theorem.cabal | 1 - 1 file changed, 1 deletion(-) diff --git a/copilot-theorem/copilot-theorem.cabal b/copilot-theorem/copilot-theorem.cabal index 47cd076b0..f120240cb 100644 --- a/copilot-theorem/copilot-theorem.cabal +++ b/copilot-theorem/copilot-theorem.cabal @@ -54,7 +54,6 @@ library , libBF >= 0.6.2 && < 0.7 , mtl >= 2.0 && < 2.4 , panic >= 0.4.0 && < 0.5 - , parsec >= 2.0 && < 3.2 , parameterized-utils >= 2.1.1 && < 2.2 , pretty >= 1.0 && < 1.2 , process >= 1.6 && < 1.7 From b0d5e2bc652ff4cb3cd15e977ee49e503501dafa Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 7 Sep 2025 10:27:31 +0000 Subject: [PATCH 0960/1222] copilot-theorem: Document changes in CHANGELOG. Refs #661. --- copilot-theorem/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-theorem/CHANGELOG b/copilot-theorem/CHANGELOG index da078ea43..cd1fcbb93 100644 --- a/copilot-theorem/CHANGELOG +++ b/copilot-theorem/CHANGELOG @@ -1,3 +1,6 @@ +2025-09-07 + * Remove unused function Copilot.Theorem.Misc.SExpr.parseSExpr. (#661) + 2025-07-07 * Version bump (4.5). (#642) * Removed unused pragmas. (#613) From 3614cc1cf37fceed88bf325352d0559bd31d96ce Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 7 Sep 2025 14:56:58 -0700 Subject: [PATCH 0961/1222] copilot-core: Version bump (4.5.1). Refs #666. --- copilot-core/copilot-core.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot-core/copilot-core.cabal b/copilot-core/copilot-core.cabal index ffd4031a9..78e2d5808 100644 --- a/copilot-core/copilot-core.cabal +++ b/copilot-core/copilot-core.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-core -version: 4.5 +version: 4.5.1 synopsis: An intermediate representation for Copilot. description: Intermediate representation for Copilot. From 4af76e9b143c67b4f1a49b65eb8297a356c0ee6d Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 7 Sep 2025 14:56:58 -0700 Subject: [PATCH 0962/1222] copilot-bluespec: Version bump (4.5.1). Refs #666. --- copilot-bluespec/copilot-bluespec.cabal | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/copilot-bluespec/copilot-bluespec.cabal b/copilot-bluespec/copilot-bluespec.cabal index 90d9f89d1..f62cb2432 100644 --- a/copilot-bluespec/copilot-bluespec.cabal +++ b/copilot-bluespec/copilot-bluespec.cabal @@ -1,6 +1,6 @@ cabal-version : >= 1.10 name : copilot-bluespec -version : 4.5 +version : 4.5.1 synopsis : A compiler for Copilot targeting FPGAs. description : This package is a back-end from Copilot to FPGAs in Bluespec. @@ -44,7 +44,7 @@ library , filepath >= 1.4 && < 1.6 , pretty >= 1.1.2 && < 1.2 - , copilot-core >= 4.5 && < 4.6 + , copilot-core >= 4.5.1 && < 4.6 , language-bluespec >= 0.1 && < 0.2 exposed-modules : Copilot.Compile.Bluespec From c4a80ceef2c5e2ca47ec44023ea2f9fdeb06d8ff Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 7 Sep 2025 14:56:58 -0700 Subject: [PATCH 0963/1222] copilot-c99: Version bump (4.5.1). Refs #666. --- copilot-c99/copilot-c99.cabal | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/copilot-c99/copilot-c99.cabal b/copilot-c99/copilot-c99.cabal index 17ec0d950..b33f4e5bc 100644 --- a/copilot-c99/copilot-c99.cabal +++ b/copilot-c99/copilot-c99.cabal @@ -1,6 +1,6 @@ cabal-version : >= 1.10 name : copilot-c99 -version : 4.5 +version : 4.5.1 synopsis : A compiler for Copilot targeting C99. description : This package is a back-end from Copilot to C. @@ -45,7 +45,7 @@ library , mtl >= 2.2 && < 2.4 , pretty >= 1.1 && < 1.2 - , copilot-core >= 4.5 && < 4.6 + , copilot-core >= 4.5.1 && < 4.6 , language-c99 >= 0.2.0 && < 0.3 , language-c99-simple >= 0.3 && < 0.4 From f13c9f567c4abfdca96284b7a473f0fc77bbd070 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 7 Sep 2025 14:56:58 -0700 Subject: [PATCH 0964/1222] copilot-prettyprinter: Version bump (4.5.1). Refs #666. --- copilot-prettyprinter/copilot-prettyprinter.cabal | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/copilot-prettyprinter/copilot-prettyprinter.cabal b/copilot-prettyprinter/copilot-prettyprinter.cabal index 2953cfef6..a5acd909f 100644 --- a/copilot-prettyprinter/copilot-prettyprinter.cabal +++ b/copilot-prettyprinter/copilot-prettyprinter.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-prettyprinter -version: 4.5 +version: 4.5.1 synopsis: A prettyprinter of Copilot Specifications. description: A prettyprinter of Copilot specifications. @@ -45,7 +45,7 @@ library base >= 4.9 && < 5, pretty >= 1.0 && < 1.2, - copilot-core >= 4.5 && < 4.6 + copilot-core >= 4.5.1 && < 4.6 exposed-modules: From 808c8c66529c5036dccf29b6c51200b101e7ddd7 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 7 Sep 2025 14:56:58 -0700 Subject: [PATCH 0965/1222] copilot-interpreter: Version bump (4.5.1). Refs #666. --- copilot-interpreter/copilot-interpreter.cabal | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/copilot-interpreter/copilot-interpreter.cabal b/copilot-interpreter/copilot-interpreter.cabal index 4bcfb3138..b6b2c4fe7 100644 --- a/copilot-interpreter/copilot-interpreter.cabal +++ b/copilot-interpreter/copilot-interpreter.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-interpreter -version: 4.5 +version: 4.5.1 synopsis: Interpreter for Copilot. description: Interpreter for Copilot. @@ -44,7 +44,7 @@ library base >= 4.9 && < 5, pretty >= 1.0 && < 1.2, - copilot-core >= 4.5 && < 4.6 + copilot-core >= 4.5.1 && < 4.6 exposed-modules: From 680dbd6119e28210b10dc25e5474522ed004033f Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 7 Sep 2025 14:56:58 -0700 Subject: [PATCH 0966/1222] copilot-theorem: Version bump (4.5.1). Refs #666. --- copilot-theorem/copilot-theorem.cabal | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/copilot-theorem/copilot-theorem.cabal b/copilot-theorem/copilot-theorem.cabal index f120240cb..86bb1c68c 100644 --- a/copilot-theorem/copilot-theorem.cabal +++ b/copilot-theorem/copilot-theorem.cabal @@ -14,7 +14,7 @@ description: . -version : 4.5 +version : 4.5.1 license : BSD3 license-file : LICENSE maintainer : Ivan Perez @@ -62,8 +62,8 @@ library , xml >= 1.3 && < 1.4 , what4 >= 1.3 && < 1.8 - , copilot-core >= 4.5 && < 4.6 - , copilot-prettyprinter >= 4.5 && < 4.6 + , copilot-core >= 4.5.1 && < 4.6 + , copilot-prettyprinter >= 4.5.1 && < 4.6 exposed-modules : Copilot.Theorem , Copilot.Theorem.Prove From 67977320ff07b2d9be7fa1d636d7ead2c0230e69 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 7 Sep 2025 14:56:58 -0700 Subject: [PATCH 0967/1222] copilot-language: Version bump (4.5.1). Refs #666. --- copilot-language/copilot-language.cabal | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/copilot-language/copilot-language.cabal b/copilot-language/copilot-language.cabal index e9d4de9a9..7d02c0bfc 100644 --- a/copilot-language/copilot-language.cabal +++ b/copilot-language/copilot-language.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-language -version: 4.5 +version: 4.5.1 synopsis: A Haskell-embedded DSL for monitoring hard real-time distributed systems. description: @@ -42,9 +42,9 @@ library , data-reify >= 0.6 && < 0.7 , mtl >= 2.0 && < 3 - , copilot-core >= 4.5 && < 4.6 - , copilot-interpreter >= 4.5 && < 4.6 - , copilot-theorem >= 4.5 && < 4.6 + , copilot-core >= 4.5.1 && < 4.6 + , copilot-interpreter >= 4.5.1 && < 4.6 + , copilot-theorem >= 4.5.1 && < 4.6 exposed-modules: Copilot.Language , Copilot.Language.Operators.BitWise From d1b0ffdf8e514113b57c4df4339db83a1c447613 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 7 Sep 2025 14:56:58 -0700 Subject: [PATCH 0968/1222] copilot-libraries: Version bump (4.5.1). Refs #666. --- copilot-libraries/copilot-libraries.cabal | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/copilot-libraries/copilot-libraries.cabal b/copilot-libraries/copilot-libraries.cabal index 214fe7dc4..3402b5296 100644 --- a/copilot-libraries/copilot-libraries.cabal +++ b/copilot-libraries/copilot-libraries.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-libraries -version: 4.5 +version: 4.5.1 synopsis: Libraries for the Copilot language. description: Libraries for the Copilot language. @@ -38,10 +38,10 @@ library build-depends: base >= 4.9 && < 5 - , containers >= 0.4 && < 0.8 - , mtl >= 2.0 && < 2.4 - , parsec >= 2.0 && < 3.2 - , copilot-language >= 4.5 && < 4.6 + , containers >= 0.4 && < 0.8 + , mtl >= 2.0 && < 2.4 + , parsec >= 2.0 && < 3.2 + , copilot-language >= 4.5.1 && < 4.6 exposed-modules: Copilot.Library.Libraries From eec16989d5f0110dec1750de83db1a521f5a4fb2 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 7 Sep 2025 14:56:58 -0700 Subject: [PATCH 0969/1222] copilot-verifier: Version bump (4.5.1). Refs #666. --- copilot-verifier/copilot-verifier.cabal | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/copilot-verifier/copilot-verifier.cabal b/copilot-verifier/copilot-verifier.cabal index 8b915e154..808ac3823 100644 --- a/copilot-verifier/copilot-verifier.cabal +++ b/copilot-verifier/copilot-verifier.cabal @@ -1,6 +1,6 @@ Cabal-version: 2.2 Name: copilot-verifier -Version: 4.5 +Version: 4.5.1 Author: Galois Inc. Maintainer: rscott@galois.com Copyright: (c) Galois, Inc 2021-2024 @@ -45,9 +45,9 @@ common bldflags bv-sized >= 1.0.0 && < 1.1, bytestring, containers >= 0.5.9.0, - copilot-c99 >= 4.5 && < 4.6, - copilot-core >= 4.5 && < 4.6, - copilot-theorem >= 4.5 && < 4.6, + copilot-c99 >= 4.5.1 && < 4.6, + copilot-core >= 4.5.1 && < 4.6, + copilot-theorem >= 4.5.1 && < 4.6, crucible >= 0.7.1 && < 0.8, crucible-llvm >= 0.7 && < 0.8, crux >= 0.7.1 && < 0.8, @@ -80,10 +80,10 @@ library copilot-verifier-examples hs-source-dirs: examples build-depends: case-insensitive, - copilot >= 4.5 && < 4.6, - copilot-language >= 4.5 && < 4.6, - copilot-libraries >= 4.5 && < 4.6, - copilot-prettyprinter >= 4.5 && < 4.6, + copilot >= 4.5.1 && < 4.6, + copilot-language >= 4.5.1 && < 4.6, + copilot-libraries >= 4.5.1 && < 4.6, + copilot-prettyprinter >= 4.5.1 && < 4.6, copilot-verifier exposed-modules: Copilot.Verifier.Examples From d7c1281ae06f74b8b7d2140725d71126bb9a2dd3 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 7 Sep 2025 14:56:58 -0700 Subject: [PATCH 0970/1222] copilot-visualizer: Version bump (4.5.1). Refs #666. --- copilot-visualizer/copilot-visualizer.cabal | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/copilot-visualizer/copilot-visualizer.cabal b/copilot-visualizer/copilot-visualizer.cabal index cf1399573..c88f26f1f 100644 --- a/copilot-visualizer/copilot-visualizer.cabal +++ b/copilot-visualizer/copilot-visualizer.cabal @@ -1,6 +1,6 @@ cabal-version: >= 1.10 name: copilot-visualizer -version: 4.5 +version: 4.5.1 synopsis: Visualizer for Copilot. description: Visualizer for Copilot. @@ -65,10 +65,10 @@ library text >= 1.2.3.1 && < 2.2, websockets >= 0.12.7 && < 0.14, - copilot >= 4.5 && < 4.6, - copilot-core >= 4.5 && < 4.6, - copilot-interpreter >= 4.5 && < 4.6, - copilot-language >= 4.5 && < 4.6 + copilot >= 4.5.1 && < 4.6, + copilot-core >= 4.5.1 && < 4.6, + copilot-interpreter >= 4.5.1 && < 4.6, + copilot-language >= 4.5.1 && < 4.6 exposed-modules: @@ -121,7 +121,7 @@ executable tikz-example build-depends: base >= 4.9 && < 5, - copilot >= 4.5 && < 4.6, + copilot >= 4.5.1 && < 4.6, copilot-visualizer if flag(examples) From d1d2b270598cf398de857c3ae289e8b37f6549f9 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 7 Sep 2025 14:56:58 -0700 Subject: [PATCH 0971/1222] copilot: Version bump (4.5.1). Refs #666. --- copilot/copilot.cabal | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/copilot/copilot.cabal b/copilot/copilot.cabal index 6d9570b19..a15dd5cf3 100644 --- a/copilot/copilot.cabal +++ b/copilot/copilot.cabal @@ -1,5 +1,5 @@ name: copilot -version: 4.5 +version: 4.5.1 cabal-version: >= 1.10 license: BSD3 license-file: LICENSE @@ -52,12 +52,12 @@ library , directory >= 1.3 && < 1.4 , filepath >= 1.4 && < 1.6 - , copilot-core >= 4.5 && < 4.6 - , copilot-theorem >= 4.5 && < 4.6 - , copilot-language >= 4.5 && < 4.6 - , copilot-libraries >= 4.5 && < 4.6 - , copilot-c99 >= 4.5 && < 4.6 - , copilot-prettyprinter >= 4.5 && < 4.6 + , copilot-core >= 4.5.1 && < 4.6 + , copilot-theorem >= 4.5.1 && < 4.6 + , copilot-language >= 4.5.1 && < 4.6 + , copilot-libraries >= 4.5.1 && < 4.6 + , copilot-c99 >= 4.5.1 && < 4.6 + , copilot-prettyprinter >= 4.5.1 && < 4.6 exposed-modules: Language.Copilot, Language.Copilot.Main From 051b91322eec26cc5aae4efb401b4ca12cf81b70 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 7 Sep 2025 14:58:31 -0700 Subject: [PATCH 0972/1222] copilot-core: Document changes in CHANGELOG. Refs #666. --- copilot-core/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-core/CHANGELOG b/copilot-core/CHANGELOG index 810d39b24..62e89d1ef 100644 --- a/copilot-core/CHANGELOG +++ b/copilot-core/CHANGELOG @@ -1,3 +1,6 @@ +2025-09-07 + * Version bump (4.5.1). (#666) + 2025-07-07 * Version bump (4.5). (#642) * Remove deprecated fields of Copilot.Core.Expr.UExpr. (#636) From fda59ae9fef63606bb655c6fd7b7ea9f8dacd688 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 7 Sep 2025 14:58:31 -0700 Subject: [PATCH 0973/1222] copilot-bluespec: Document changes in CHANGELOG. Refs #666. --- copilot-bluespec/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-bluespec/CHANGELOG b/copilot-bluespec/CHANGELOG index ccfaad8ab..e7472493b 100644 --- a/copilot-bluespec/CHANGELOG +++ b/copilot-bluespec/CHANGELOG @@ -1,3 +1,6 @@ +2025-09-07 + * Version bump (4.5.1). (#666) + 2025-07-07 * Version bump (4.5). (#642) * Include `copilot-bluespec` in mainline `copilot` repo. (#623) From 7448c20bc13adc1a1d2aedc74a1cac24219ee8b3 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 7 Sep 2025 14:58:31 -0700 Subject: [PATCH 0974/1222] copilot-c99: Document changes in CHANGELOG. Refs #666. --- copilot-c99/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-c99/CHANGELOG b/copilot-c99/CHANGELOG index 7b7d3aeb6..e5f0b606d 100644 --- a/copilot-c99/CHANGELOG +++ b/copilot-c99/CHANGELOG @@ -1,3 +1,6 @@ +2025-09-07 + * Version bump (4.5.1). (#666) + 2025-07-07 * Version bump (4.5). (#642) From fb15c4ee661b2c6da8745ee6a2ffc962b9cd93e7 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 7 Sep 2025 14:58:31 -0700 Subject: [PATCH 0975/1222] copilot-prettyprinter: Document changes in CHANGELOG. Refs #666. --- copilot-prettyprinter/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-prettyprinter/CHANGELOG b/copilot-prettyprinter/CHANGELOG index 8f94d9fa6..73ca7c5bf 100644 --- a/copilot-prettyprinter/CHANGELOG +++ b/copilot-prettyprinter/CHANGELOG @@ -1,3 +1,6 @@ +2025-09-07 + * Version bump (4.5.1). (#666) + 2025-07-07 * Version bump (4.5). (#642) From 65c53b3ea01a33e60b803fecabc9399adb2bda45 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 7 Sep 2025 14:58:31 -0700 Subject: [PATCH 0976/1222] copilot-interpreter: Document changes in CHANGELOG. Refs #666. --- copilot-interpreter/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-interpreter/CHANGELOG b/copilot-interpreter/CHANGELOG index cd1e6b431..e819c4162 100644 --- a/copilot-interpreter/CHANGELOG +++ b/copilot-interpreter/CHANGELOG @@ -1,3 +1,6 @@ +2025-09-07 + * Version bump (4.5.1). (#666) + 2025-07-07 * Version bump (4.5). (#642) From 4406c1844bd33e32864efaea71473459c1e6a6e7 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 7 Sep 2025 14:58:31 -0700 Subject: [PATCH 0977/1222] copilot-theorem: Document changes in CHANGELOG. Refs #666. --- copilot-theorem/CHANGELOG | 1 + 1 file changed, 1 insertion(+) diff --git a/copilot-theorem/CHANGELOG b/copilot-theorem/CHANGELOG index cd1fcbb93..621417e73 100644 --- a/copilot-theorem/CHANGELOG +++ b/copilot-theorem/CHANGELOG @@ -1,4 +1,5 @@ 2025-09-07 + * Version bump (4.5.1). (#666) * Remove unused function Copilot.Theorem.Misc.SExpr.parseSExpr. (#661) 2025-07-07 From 6034ccfd294454190470fa96cb46ca46f5598b92 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 7 Sep 2025 14:58:31 -0700 Subject: [PATCH 0978/1222] copilot-language: Document changes in CHANGELOG. Refs #666. --- copilot-language/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-language/CHANGELOG b/copilot-language/CHANGELOG index 60112d6f8..ed8ebbebb 100644 --- a/copilot-language/CHANGELOG +++ b/copilot-language/CHANGELOG @@ -1,3 +1,6 @@ +2025-09-07 + * Version bump (4.5.1). (#666) + 2025-07-07 * Version bump (4.5). (#642) From bd1c2ce43b15e68bf1b086cb2f40fbb9edb9d32b Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 7 Sep 2025 14:58:31 -0700 Subject: [PATCH 0979/1222] copilot-libraries: Document changes in CHANGELOG. Refs #666. --- copilot-libraries/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-libraries/CHANGELOG b/copilot-libraries/CHANGELOG index c724f29b5..5d4323d7f 100644 --- a/copilot-libraries/CHANGELOG +++ b/copilot-libraries/CHANGELOG @@ -1,3 +1,6 @@ +2025-09-07 + * Version bump (4.5.1). (#666) + 2025-07-07 * Version bump (4.5). (#642) From fe74b7b0686eef85bbf68f96c48bb3924cc74987 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 7 Sep 2025 14:58:31 -0700 Subject: [PATCH 0980/1222] copilot-verifier: Document changes in CHANGELOG. Refs #666. --- copilot-verifier/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-verifier/CHANGELOG b/copilot-verifier/CHANGELOG index 59ac57d9a..e8b89e276 100644 --- a/copilot-verifier/CHANGELOG +++ b/copilot-verifier/CHANGELOG @@ -1,3 +1,6 @@ +2025-09-07 + * Version bump (4.5.1). (#666) + 2025-07-07 * Version bump (4.5). (#642) * Include `copilot-verifier` in mainline `copilot` repo. (#622) From e8a1af051cf43545dfc35302a27dc3032a38fc96 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 7 Sep 2025 14:58:31 -0700 Subject: [PATCH 0981/1222] copilot-visualizer: Document changes in CHANGELOG. Refs #666. --- copilot-visualizer/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot-visualizer/CHANGELOG b/copilot-visualizer/CHANGELOG index 2b2449afa..cf9f151fb 100644 --- a/copilot-visualizer/CHANGELOG +++ b/copilot-visualizer/CHANGELOG @@ -1,4 +1,5 @@ -2025-08-31 +2025-09-07 + * Version bump (4.5.1). (#666) * Relax version constraint on `ogma-extra`. (#645) 2025-07-07 From 4615b1a78b36768d6c271ddea5e399a56b342243 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 7 Sep 2025 14:58:31 -0700 Subject: [PATCH 0982/1222] copilot: Document changes in CHANGELOG. Refs #666. --- copilot/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot/CHANGELOG b/copilot/CHANGELOG index edb13dcd5..7b69ed049 100644 --- a/copilot/CHANGELOG +++ b/copilot/CHANGELOG @@ -1,4 +1,5 @@ -2025-08-21 +2025-09-07 + * Version bump (4.5.1). (#666) * Add hello world example for FPGA. (#657) 2025-07-07 From da44685dc2bbecd5f363ddf89b6b175385897474 Mon Sep 17 00:00:00 2001 From: Ryan Scott Date: Mon, 3 Nov 2025 06:28:53 -0500 Subject: [PATCH 0983/1222] copilot-bluespec: Flip direction of interface inputs and outputs in Bluespec. Refs #677. The current Bluespec backend leads to Verilog code that requires manual manipulations in order to work correctly. Specifically, Copilot externs, which are inputs to the Copilot monitoring system, are treated as _outputs_ in Verilog, and Copilot triggers, which can be considered outputs of the monitoring system, are treated as _inputs_. This order of inputs and outputs is the opposite what we would like users to work with, and of what other backends generate (e.g., C99). This commit updates the internals of `copilot-bluespec` to flip the order in which generated Bluespec module interfaces declare their inputs and outputs. A module interface now represents each Copilot extern as a method of type ` -> Action` (where `` is the type of the extern), as this type directly translates to a Verilog input. Moreover, a module interface now represents trigger arguments as interface methods of type `_i`, where each `_i` is the type of each trigger argument. Each `_i` directly translates to a Verilog output. In addition to changing the module interface definitions, this commit also changes the generated modules that instantiate the new interfaces. One of the more notable changes is that all extern values are stored as a Bluespec `Wire` in the module internals, as using `Wire`s leads to compact Verilog code without adding any user-visible inputs or outputs. Every time a value is read from an extern, the corresponding `Wire` must be read from, which means that several parts of the module internals have been updated to reference these `Wire`s. --- .../src/Copilot/Compile/Bluespec/CodeGen.hs | 155 +++++++++++++++--- .../src/Copilot/Compile/Bluespec/Expr.hs | 5 +- .../src/Copilot/Compile/Bluespec/Name.hs | 21 ++- 3 files changed, 149 insertions(+), 32 deletions(-) diff --git a/copilot-bluespec/src/Copilot/Compile/Bluespec/CodeGen.hs b/copilot-bluespec/src/Copilot/Compile/Bluespec/CodeGen.hs index 6d9fde04d..859c73dec 100644 --- a/copilot-bluespec/src/Copilot/Compile/Bluespec/CodeGen.hs +++ b/copilot-bluespec/src/Copilot/Compile/Bluespec/CodeGen.hs @@ -14,12 +14,17 @@ module Copilot.Compile.Bluespec.CodeGen -- * Stream generators , mkGenFun + -- * External streams + , mkExtWireDecln + -- * Monitor processing , mkStepRule + , mkExtRule , mkTriggerRule -- * Module interface specifications , mkSpecIfcFields + , mkSpecIfcRulesFields ) where -- External imports @@ -48,7 +53,17 @@ mkGenFun name expr ty = [] where nameId = BS.mkId BS.NoPos $ fromString $ lowercaseName name - def = BS.CClause [] [] (transExpr expr) + def = BS.CClause [] [] (transExpr expr) + +-- | Bind a @Wire@ variable using @mkBypassWire@. +mkExtWireDecln :: String -> Type a -> BS.CStmt +mkExtWireDecln name ty = + BS.CSBindT + (BS.CPVar (BS.mkId BS.NoPos (fromString (wireName name)))) + Nothing + [] + (BS.CQType [] (tWire `BS.TAp` transType ty)) + (BS.CVar (BS.mkId BS.NoPos "mkBypassWire")) -- | Bind a buffer variable and initialise it with the stream buffer. mkBuffDecln :: forall a. Id -> Type a -> [a] -> [BS.CStmt] @@ -133,44 +148,124 @@ mkAccessDecln sId ty xs = -- | Define fields for a module interface containing a specification's trigger -- functions and external variables. -mkSpecIfcFields :: [Trigger] -> [External] -> [BS.CField] -mkSpecIfcFields triggers exts = +mkSpecIfcFields :: [UniqueTrigger] -> [External] -> [BS.CField] +mkSpecIfcFields uniqueTriggers exts = + concatMap mkTriggerFields uniqueTriggers ++ map mkExtField exts + where + -- trigger_guard :: Bool + -- trigger_arg0 :: arg_ty_0 + -- ... + -- trigger_arg(n-1) :: arg_ty_(n-1) + mkTriggerFields :: UniqueTrigger -> [BS.CField] + mkTriggerFields (UniqueTrigger uniqueName (Trigger _name _ args)) = + triggerGuardField : triggerArgFields + where + triggerGuardField :: BS.CField + triggerGuardField = mkField (guardName uniqueName) [] BS.tBool + + triggerArgFields :: [BS.CField] + triggerArgFields = + zipWith + (\(UExpr arg _) argName -> mkField argName [] (transType arg)) + args + (argNames uniqueName) + + -- ext :: ty -> Action + mkExtField :: External -> BS.CField + mkExtField (External name ty) = + mkField + name + [ BS.PIPrefixStr "" + , BS.PIArgNames [BS.mkId BS.NoPos $ fromString $ lowercaseName name] + ] + (BS.tArrow `BS.TAp` transType ty `BS.TAp` BS.tAction) + +-- | Define fields for a module interface containing the actions to perform for +-- a specification's trigger functions and external variables. +mkSpecIfcRulesFields :: [Trigger] -> [External] -> [BS.CField] +mkSpecIfcRulesFields triggers exts = map mkTriggerField triggers ++ map mkExtField exts where - -- trigger :: args_1 -> ... -> args_n -> Action + -- trigger_action :: arg_ty_0 -> ... -> arg_ty_(n-1) -> Action mkTriggerField :: Trigger -> BS.CField mkTriggerField (Trigger name _ args) = - mkField name $ - foldr - (\(UExpr arg _) res -> BS.tArrow `BS.TAp` transType arg `BS.TAp` res) - BS.tAction - args + mkField (actionName name) [] triggerFieldType + where + triggerFieldType :: BS.CType + triggerFieldType = foldr addArgType BS.tAction args - -- ext :: Reg ty + addArgType :: UExpr -> BS.CType -> BS.CType + addArgType (UExpr arg _) res = + BS.tArrow `BS.TAp` transType arg `BS.TAp` res + + -- ext_action :: ActionValue ty mkExtField :: External -> BS.CField mkExtField (External name ty) = - mkField name $ tReg `BS.TAp` transType ty + mkField (actionName name) [] (BS.tActionValue `BS.TAp` transType ty) + +-- | Define a rule for an external stream that performs an action on the most +-- recently computed value from the stream. +mkExtRule :: External -> BS.CRule +mkExtRule (External name _) = + -- rules + -- "ext": when True ==> + -- action + -- extVal <- ifcRules.ext_action + -- ifc.ext extVal + BS.CRule + [] + (Just $ cLit $ BS.LString name) + [BS.CQFilter $ BS.CCon BS.idTrue []] + (BS.Caction BS.NoPos [callExtAction, callExt]) + where + ifcArgId = BS.mkId BS.NoPos $ fromString ifcArgName + ifcRulesArgId = BS.mkId BS.NoPos $ fromString ifcRulesArgName + + extActionId = BS.mkId BS.NoPos $ fromString $ actionName name + extId = BS.mkId BS.NoPos $ fromString name + extValId = BS.mkId BS.NoPos $ fromString $ name ++ "Val" --- | Define a rule for a trigger function. + -- extVal <- ifcRules.ext_action + callExtAction :: BS.CStmt + callExtAction = + BS.CSBind + (BS.CPVar extValId) + Nothing + [] + (BS.CSelect (BS.CVar ifcRulesArgId) extActionId) + + -- ifc.ext extVal + callExt :: BS.CStmt + callExt = + BS.CSExpr Nothing $ + BS.CApply (BS.CSelect (BS.CVar ifcArgId) extId) [BS.CVar extValId] + +-- | Define a rule for a trigger function that performs an action when the rule +-- fires. mkTriggerRule :: UniqueTrigger -> BS.CRule mkTriggerRule (UniqueTrigger uniqueName (Trigger name _ args)) = + -- rules + -- "trigger": when ifc.trigger_guard ==> + -- ifcRules.trigger_action ifc.trigger_arg0 BS.CRule [] (Just $ cLit $ BS.LString uniqueName) [ BS.CQFilter $ - BS.CVar $ BS.mkId BS.NoPos $ - fromString $ guardName uniqueName + BS.CSelect + (BS.CVar ifcArgId) + (BS.mkId BS.NoPos $ fromString $ guardName uniqueName) ] - (BS.CApply nameExpr args') + (BS.CApply actionNameExpr args') where - ifcArgId = BS.mkId BS.NoPos $ fromString ifcArgName + ifcArgId = BS.mkId BS.NoPos $ fromString ifcArgName + ifcRulesArgId = BS.mkId BS.NoPos $ fromString ifcRulesArgName -- Note that we use 'name' here instead of 'uniqueName', as 'name' is the -- name of the actual external function. - nameId = BS.mkId BS.NoPos $ fromString $ lowercaseName name - nameExpr = BS.CSelect (BS.CVar ifcArgId) nameId + actionNameId = BS.mkId BS.NoPos $ fromString $ actionName name + actionNameExpr = BS.CSelect (BS.CVar ifcRulesArgId) actionNameId args' = take (length args) (map argCall (argNames uniqueName)) - argCall = BS.CVar . BS.mkId BS.NoPos . fromString + argCall = BS.CSelect (BS.CVar ifcArgId) . BS.mkId BS.NoPos . fromString -- | Writes the @step@ rule that updates all streams. mkStepRule :: [Stream] -> Maybe BS.CRule @@ -233,19 +328,20 @@ mkStructDecln x = -- Derive a Bits instance so that we can put this struct in a Reg [BS.CTypeclass BS.idBits] where - structId = BS.mkId BS.NoPos $ fromString $ uppercaseName $ typeName x + structId = BS.mkId BS.NoPos $ fromString $ uppercaseName $ typeName x structFields = map mkStructField $ toValues x mkStructField :: Value a -> BS.CField mkStructField (Value ty field) = - mkField (fieldName field) (transType ty) + mkField (fieldName field) [] (transType ty) --- | Write a field of a struct or interface, along with its type. -mkField :: String -> BS.CType -> BS.CField -mkField name ty = +-- | Write a field of a struct or interface, along with its pragmas and type +-- signature. +mkField :: String -> [BS.IfcPragma] -> BS.CType -> BS.CField +mkField name pragmas ty = BS.CField { BS.cf_name = BS.mkId BS.NoPos $ fromString $ lowercaseName name - , BS.cf_pragmas = Nothing + , BS.cf_pragmas = Just pragmas , BS.cf_type = BS.CQType [] ty , BS.cf_default = [] , BS.cf_orig_type = Nothing @@ -260,3 +356,12 @@ tReg = BS.TCon $ , BS.tcon_sort = BS.TIstruct (BS.SInterface []) [BS.id_write BS.NoPos, BS.id_read BS.NoPos] } + +-- | The @Wire@ Bluespec type. +tWire :: BS.CType +tWire = BS.TCon $ + BS.TyCon + { BS.tcon_name = BS.mkId BS.NoPos "Wire" + , BS.tcon_kind = Just (BS.Kfun BS.KStar BS.KStar) + , BS.tcon_sort = BS.TItype 0 tReg + } diff --git a/copilot-bluespec/src/Copilot/Compile/Bluespec/Expr.hs b/copilot-bluespec/src/Copilot/Compile/Bluespec/Expr.hs index c4978aef5..7297fad2f 100644 --- a/copilot-bluespec/src/Copilot/Compile/Bluespec/Expr.hs +++ b/copilot-bluespec/src/Copilot/Compile/Bluespec/Expr.hs @@ -51,11 +51,8 @@ transExpr (Drop _ amount sid) = [BS.CLit $ BS.CLiteral BS.NoPos index] transExpr (ExternVar _ name _) = - let ifcArgId = BS.mkId BS.NoPos $ fromString ifcArgName in BS.CSelect - (BS.CSelect - (BS.CVar ifcArgId) - (BS.mkId BS.NoPos $ fromString $ lowercaseName name)) + (BS.CVar $ BS.mkId BS.NoPos $ fromString $ wireName name) (BS.id_read BS.NoPos) transExpr (Label _ _ e) = transExpr e -- ignore label diff --git a/copilot-bluespec/src/Copilot/Compile/Bluespec/Name.hs b/copilot-bluespec/src/Copilot/Compile/Bluespec/Name.hs index dbc714a3b..19b78ca90 100644 --- a/copilot-bluespec/src/Copilot/Compile/Bluespec/Name.hs +++ b/copilot-bluespec/src/Copilot/Compile/Bluespec/Name.hs @@ -1,9 +1,11 @@ -- | Naming of variables and functions in Bluespec. module Copilot.Compile.Bluespec.Name - ( argNames + ( actionName + , argNames , generatorName , guardName , ifcArgName + , ifcRulesArgName , indexName , lowercaseName , specIfcName @@ -13,6 +15,7 @@ module Copilot.Compile.Bluespec.Name , streamElemName , streamName , uppercaseName + , wireName ) where -- External imports @@ -41,11 +44,14 @@ specTypesPkgName prefix = prefix ++ "Types" streamElemName :: Id -> Int -> String streamElemName sId n = streamName sId ++ "_" ++ show n --- | The name of the variable of type @Ifc@. This is used to select --- trigger functions and external variables. +-- | The name of a variable of type @Ifc@. ifcArgName :: String ifcArgName = "ifc" +-- | The name of a variable of type @RulesIfc@. +ifcRulesArgName :: String +ifcRulesArgName = "ifcRules" + -- | Create a Bluespec name that must start with an uppercase letter (e.g., a -- struct or interface name). If the supplied name already begins with an -- uppercase letter, this function returns the name unchanged. Otherwise, this @@ -86,6 +92,15 @@ generatorName sId = streamName sId ++ "_gen" guardName :: String -> String guardName name = lowercaseName name ++ "_guard" +-- | Turn the name of a trigger of external stream into the name of a method +-- that performs a Bluespec @Action@. +actionName :: String -> String +actionName name = lowercaseName name ++ "_action" + +-- | Turn the name of an external stream into a Bluespec @Wire@. +wireName :: String -> String +wireName name = lowercaseName name ++ "_wire" + -- | Turn a trigger name into a an trigger argument name. argName :: String -> Int -> String argName name n = lowercaseName name ++ "_arg" ++ show n From c3543283a9af6720dc86067999042f30d0fbd33d Mon Sep 17 00:00:00 2001 From: Ryan Scott Date: Mon, 3 Nov 2025 06:29:25 -0500 Subject: [PATCH 0984/1222] copilot-bluespec: Update Copilot.Compile.Bluespec.Compile to reflect new input/output order. Refs #677. The current Bluespec backend leads to Verilog code that requires manual manipulations in order to work correctly. Specifically, Copilot externs, which are inputs to the Copilot monitoring system, are treated as _outputs_ in Verilog, and Copilot triggers, which can be considered outputs of the monitoring system, are treated as _inputs_. This order of inputs and outputs is the opposite what we would like users to work with, and of what other backends generate (e.g., C99). A prior commit has updated the internals of `copilot-bluespec` to invert the order in which Verilog inputs and outputs are declared. This commit adapts the top-level code in `Copilot.Compile.Bluespec.Compile` accordingly. In particular, the `compileWith` function now generates a `.bs` file that defines two module interfaces: one interface that contains the core methods that will comprise the generated Verilog code, and another interface that helps automate the process of defining a `Module Empty` value that is more suitable for software simulation purposes. Previously, `compileWith` generated a separate `Ifc.bs` file that contained nothing but the module interface in isolation so that it could be used separately from the interface's `Module` definition. This distinction no longer makes as much sense, as in the new design, as (1) there are now multiple interfaces, and (2) it is unlikely that the interfaces are not particularly useful without having the `Module` definitions to accompany them. As such, this commit now omits generating a `Ifc.bs` file, instead opting to generate the interfaces as part of `.bs`. --- .../src/Copilot/Compile/Bluespec/Compile.hs | 293 ++++++++++++------ .../src/Copilot/Compile/Bluespec/Name.hs | 5 + 2 files changed, 195 insertions(+), 103 deletions(-) diff --git a/copilot-bluespec/src/Copilot/Compile/Bluespec/Compile.hs b/copilot-bluespec/src/Copilot/Compile/Bluespec/Compile.hs index c4701eaf7..5343fd6a1 100644 --- a/copilot-bluespec/src/Copilot/Compile/Bluespec/Compile.hs +++ b/copilot-bluespec/src/Copilot/Compile/Bluespec/Compile.hs @@ -57,13 +57,11 @@ compileWith bsSettings prefix spec | otherwise = do let typesBsFile = render $ pPrint $ compileTypesBS bsSettings prefix spec - ifcBsFile = render $ pPrint $ compileIfcBS bsSettings prefix spec bsFile = render $ pPrint $ compileBS bsSettings prefix spec let dir = bluespecSettingsOutputDirectory bsSettings createDirectoryIfMissing True dir writeFile (dir specTypesPkgName prefix ++ ".bs") typesBsFile - writeFile (dir specIfcPkgName prefix ++ ".bs") ifcBsFile writeFile (dir "bs_fp.c") copilotBluespecFloatingPointC writeFile (dir "BluespecFP.bsv") copilotBluespecFloatingPointBSV writeFile (dir prefix ++ ".bs") bsFile @@ -93,32 +91,8 @@ compile :: String -> Spec -> IO () compile = compileWith mkDefaultBluespecSettings -- | Generate a @.bs@ file from a 'Spec'. This is the main payload of --- the Bluespec backend. --- --- The generated Bluespec file will import a handful of files from the standard --- library, as well as the following generated files: --- --- * @Ifc.bs@, which defines the interface containing the trigger --- functions and external variables. --- --- * @Types.bs@, which defines any structs used in the 'Spec'. --- --- It will also generate a @mk :: Module Ifc -> Module Empty@ --- function, which defines the module structure for this 'Spec'. The --- @mk@ function has the following structure: --- --- * First, bind the argument of type @Module Ifc@ so that trigger --- functions can be invoked and external variables can be used. --- --- * Next, declare stream buffers and indices. --- --- * Next, declare generator functions for streams, accessor functions for --- streams, and guard functions for triggers. --- --- * Next, declare rules for each trigger function. --- --- * Finally, declare a single rule that updates the stream buffers and --- indices. +-- the Bluespec backend. See the @copilot-bluespec/DESIGN.md@ document for a +-- high-level description of what this file contains. compileBS :: BluespecSettings -> String -> Spec -> BS.CPackage compileBS _bsSettings prefix spec = BS.CPackage @@ -126,53 +100,157 @@ compileBS _bsSettings prefix spec = (Right []) (stdLibImports ++ genImports) [] - [moduleDef] + [ ifcDef + , mkModuleDefPragma + , mkModuleDef + , ifcRulesDef + , mkModuleRulesDef + , addModuleRulesDef + ] [] where -- import Types - -- import Ifc genImports :: [BS.CImport] genImports = [ BS.CImpId False $ BS.mkId BS.NoPos $ fromString $ specTypesPkgName prefix - , BS.CImpId False $ BS.mkId BS.NoPos $ fromString - $ specIfcPkgName prefix , BS.CImpId False $ BS.mkId BS.NoPos "BluespecFP" ] - moduleDef :: BS.CDefn - moduleDef = BS.CValueSign $ - BS.CDef - (BS.mkId BS.NoPos $ fromString $ "mk" ++ prefix) - -- :: Module Ifc -> Module Empty - (BS.CQType - [] - (BS.tArrow - `BS.TAp` (BS.tModule `BS.TAp` ifcTy) - `BS.TAp` (BS.tModule `BS.TAp` emptyTy))) - [ BS.CClause [BS.CPVar ifcModId] [] $ - BS.Cmodule BS.NoPos $ - BS.CMStmt - (BS.CSBind (BS.CPVar ifcArgId) Nothing [] (BS.CVar ifcModId)) - : map BS.CMStmt mkGlobals ++ - [ BS.CMStmt $ BS.CSletrec genFuns - , BS.CMrules $ BS.Crules [] rules - ] - ] + -- interface Ifc {-# always_ready, always_enabled #-} = + -- ... + ifcDef :: BS.CDefn + ifcDef = BS.Cstruct + True + (BS.SInterface [BS.PIAlwaysRdy, BS.PIAlwaysEnabled]) + (BS.IdK ifcId) + [] -- No type variables + ifcFields + [] -- No derived instances - ifcArgId = BS.mkId BS.NoPos $ fromString ifcArgName - ifcModId = BS.mkId BS.NoPos "ifcMod" + -- {-# properties mkFibs = { verilog } #-} + mkModuleDefPragma :: BS.CDefn + mkModuleDefPragma = BS.CPragma $ BS.Pproperties mkModuleDefId [BS.PPverilog] - rules :: [BS.CRule] - rules = map mkTriggerRule uniqueTriggers ++ maybeToList (mkStepRule streams) + -- mk :: Module Ifc + -- mk = + -- module + -- ... + mkModuleDef :: BS.CDefn + mkModuleDef = BS.CValueSign $ + BS.CDef + mkModuleDefId + (BS.CQType [] (BS.tModule `BS.TAp` ifcTy)) + [ BS.CClause [] [] $ + BS.Cmodule BS.NoPos $ + wireGlobalStmts ++ genFunStmts ++ ruleIfcStmts + ] + where + wireGlobalStmts :: [BS.CMStmt] + wireGlobalStmts = map BS.CMStmt (mkExtWires ++ mkGlobals) + + genFunStmts :: [BS.CMStmt] + genFunStmts = + -- language-bluespec's pretty-printer will error if it encounters a + -- CSletrec with an empty list of definitions, so avoid generating a + -- CSletrec if there are no streams. + [ BS.CMStmt $ BS.CSletrec genFuns | not (null genFuns) ] + + ruleIfcStmts :: [BS.CMStmt] + ruleIfcStmts = + [ BS.CMrules $ BS.Crules [] $ maybeToList $ mkStepRule streams + , BS.CMinterface $ BS.Cinterface BS.NoPos (Just ifcId) ifcMethodImpls + ] + + -- interface RulesIfc = + -- ... + ifcRulesDef :: BS.CDefn + ifcRulesDef = + BS.Cstruct + True + (BS.SInterface []) + (BS.IdK ifcRulesId) + [] -- No type variables + ifcRulesFields + [] -- No derived instances + + -- mkRules :: Ifc -> RulesIfc -> Rules + -- mkRules ifc ifcRules = + -- rules + -- ... + mkModuleRulesDef :: BS.CDefn + mkModuleRulesDef = + BS.CValueSign $ + BS.CDef + mkModuleRulesDefId + (BS.CQType [] mkModuleRulesType) + [ BS.CClause + (map BS.CPVar [ifcArgId, ifcRulesArgId]) + [] + (BS.Crules [] moduleRules) + ] + where + -- Ifc -> RulesIfc -> Rules + mkModuleRulesType :: BS.CType + mkModuleRulesType = + BS.tArrow `BS.TAp` ifcTy `BS.TAp` + (BS.tArrow `BS.TAp` ifcRulesTy `BS.TAp` BS.tRules) + + -- rules + -- ... + moduleRules :: [BS.CRule] + moduleRules = map mkTriggerRule uniqueTriggers ++ map mkExtRule exts + + -- addRules :: Ifc -> RulesIfc -> Module Empty + -- addRules ifc ifcRules = addRules (mkRules ifc ifcRules) + addModuleRulesDef :: BS.CDefn + addModuleRulesDef = + BS.CValueSign $ + BS.CDef + addModuleRulesDefId + (BS.CQType [] addModuleRulesType) + [ BS.CClause + (map BS.CPVar [ifcArgId, ifcRulesArgId]) + [] + addModuleRulesExpr + ] + where + -- Ifc -> RulesIfc -> Module Empty + addModuleRulesType :: BS.CType + addModuleRulesType = + BS.tArrow `BS.TAp` ifcTy `BS.TAp` + (BS.tArrow `BS.TAp` ifcRulesTy `BS.TAp` + (BS.tModule `BS.TAp` emptyTy)) + + -- addRules (mkRules ifc ifcRules) + addModuleRulesExpr :: BS.CExpr + addModuleRulesExpr = + BS.CApply + (BS.CVar (BS.idAddRules BS.NoPos)) + [BS.CApply + (BS.CVar mkModuleRulesDefId) + (map BS.CVar [ifcArgId, ifcRulesArgId])] + + mkModuleDefId = + BS.mkId BS.NoPos $ fromString $ "mk" ++ prefix + mkModuleRulesDefId = + BS.mkId BS.NoPos $ fromString $ "mk" ++ prefix ++ "Rules" + addModuleRulesDefId = + BS.mkId BS.NoPos $ fromString $ "add" ++ prefix ++ "Rules" streams = specStreams spec triggers = specTriggers spec uniqueTriggers = mkUniqueTriggers triggers exts = gatherExts streams triggers + -- Remove duplicates due to multiple guards for the same trigger. + triggersNoDups = nubBy compareTrigger triggers + + ifcArgId = BS.mkId BS.NoPos $ fromString ifcArgName + ifcRulesArgId = BS.mkId BS.NoPos $ fromString ifcRulesArgName + ifcId = BS.mkId BS.NoPos $ fromString $ specIfcName prefix - ifcFields = mkSpecIfcFields triggers exts + ifcFields = mkSpecIfcFields uniqueTriggers exts ifcTy = BS.TCon (BS.TyCon { BS.tcon_name = ifcId , BS.tcon_kind = Just BS.KStar @@ -181,12 +259,31 @@ compileBS _bsSettings prefix spec = (map BS.cf_name ifcFields) }) + ifcRulesId = BS.mkId BS.NoPos $ fromString $ specIfcRulesName prefix + ifcRulesFields = mkSpecIfcRulesFields triggersNoDups exts + + ifcRulesTy = + BS.TCon $ + BS.TyCon + { BS.tcon_name = ifcRulesId + , BS.tcon_kind = Just BS.KStar + , BS.tcon_sort = + BS.TIstruct (BS.SInterface []) (map BS.cf_name ifcRulesFields) + } + emptyTy = BS.TCon (BS.TyCon { BS.tcon_name = BS.idEmpty , BS.tcon_kind = Just BS.KStar , BS.tcon_sort = BS.TIstruct (BS.SInterface []) [] }) + -- Bind @Wire@ variables for each extern stream. + mkExtWires :: [BS.CStmt] + mkExtWires = map extWireStmt exts + where + extWireStmt :: External -> BS.CStmt + extWireStmt (External name ty) = mkExtWireDecln name ty + -- Make buffer and index declarations for streams. mkGlobals :: [BS.CStmt] mkGlobals = concatMap buffDecln streams ++ map indexDecln streams @@ -194,11 +291,9 @@ compileBS _bsSettings prefix spec = buffDecln (Stream sId buff _ ty) = mkBuffDecln sId ty buff indexDecln (Stream sId _ _ _ ) = mkIndexDecln sId - -- Make generator functions, including trigger arguments. + -- Make generator functions for streams. genFuns :: [BS.CDefl] - genFuns = map accessDecln streams - ++ map streamGen streams - ++ concatMap triggerGen uniqueTriggers + genFuns = map accessDecln streams ++ map streamGen streams where accessDecln :: Stream -> BS.CDefl accessDecln (Stream sId buff _ ty) = mkAccessDecln sId ty buff @@ -206,56 +301,48 @@ compileBS _bsSettings prefix spec = streamGen :: Stream -> BS.CDefl streamGen (Stream sId _ expr ty) = mkGenFun (generatorName sId) expr ty - triggerGen :: UniqueTrigger -> [BS.CDefl] - triggerGen (UniqueTrigger uniqueName (Trigger _name guard args)) = - guardDef : argDefs + -- Make interface methods for @Ifc@. + ifcMethodImpls :: [BS.CDefl] + ifcMethodImpls = + concatMap triggerMethodImpls uniqueTriggers + ++ map extMethodImpl exts + where + -- interface + -- ext val = ext_wire := val + extMethodImpl :: External -> BS.CDefl + extMethodImpl (External name _) = + BS.CLValue extMethodId [extMethodClause] [] + where + extMethodId = BS.mkId BS.NoPos (fromString name) + valId = BS.mkId BS.NoPos "val" + + -- ext val = ext_wire := val + extMethodClause :: BS.CClause + extMethodClause = + BS.CClause + [BS.CPVar valId] + [] + (BS.Cwrite + BS.NoPos + (BS.CVar (BS.mkId BS.NoPos (fromString (wireName name)))) + (BS.CVar valId)) + + -- interface + -- trig_guard = ... + -- trig_arg0 = ... + -- ... + -- trig_arg(n-1) = ... + triggerMethodImpls :: UniqueTrigger -> [BS.CDefl] + triggerMethodImpls uniqueTrigger = guardDef : argDefs where + UniqueTrigger uniqueName (Trigger _name guard args) = uniqueTrigger + guardDef = mkGenFun (guardName uniqueName) guard Bool argDefs = map argGen (zip (argNames uniqueName) args) argGen :: (String, UExpr) -> BS.CDefl argGen (argName, UExpr ty expr) = mkGenFun argName expr ty --- | Generate a @Ifc.bs@ file from a 'Spec'. This contains the --- definition of the @Ifc@ interface, which declares the types of all --- trigger functions and external variables. This is put in a separate file so --- that larger applications can use it separately. -compileIfcBS :: BluespecSettings -> String -> Spec -> BS.CPackage -compileIfcBS _bsSettings prefix spec = - BS.CPackage - ifcPkgId - (Right []) - (stdLibImports ++ genImports) - [] - [ifcDef] - [] - where - -- import Types - genImports :: [BS.CImport] - genImports = - [ BS.CImpId False $ BS.mkId BS.NoPos $ fromString - $ specTypesPkgName prefix - ] - - ifcId = BS.mkId BS.NoPos $ fromString $ specIfcName prefix - ifcPkgId = BS.mkId BS.NoPos $ fromString $ specIfcPkgName prefix - ifcFields = mkSpecIfcFields triggers exts - - streams = specStreams spec - exts = gatherExts streams triggers - - -- Remove duplicates due to multiple guards for the same trigger. - triggers = nubBy compareTrigger (specTriggers spec) - - ifcDef :: BS.CDefn - ifcDef = BS.Cstruct - True - (BS.SInterface []) - (BS.IdK ifcId) - [] -- No type variables - ifcFields - [] -- No derived instances - -- | Generate a @Types.bs@ file from a 'Spec'. This declares the types -- of any structs used by the Copilot specification. This is put in a separate -- file so that larger applications can more easily substitute their own struct diff --git a/copilot-bluespec/src/Copilot/Compile/Bluespec/Name.hs b/copilot-bluespec/src/Copilot/Compile/Bluespec/Name.hs index 19b78ca90..ebb87f298 100644 --- a/copilot-bluespec/src/Copilot/Compile/Bluespec/Name.hs +++ b/copilot-bluespec/src/Copilot/Compile/Bluespec/Name.hs @@ -10,6 +10,7 @@ module Copilot.Compile.Bluespec.Name , lowercaseName , specIfcName , specIfcPkgName + , specIfcRulesName , specTypesPkgName , streamAccessorName , streamElemName @@ -35,6 +36,10 @@ specIfcName prefix = uppercaseName (specIfcPkgName prefix) specIfcPkgName :: String -> String specIfcPkgName prefix = prefix ++ "Ifc" +-- | Turn a specification name into the name of its rules-specific interface. +specIfcRulesName :: String -> String +specIfcRulesName prefix = uppercaseName (prefix ++ "RulesIfc") + -- | Turn a specification name into the name of the package that declares its -- struct types. specTypesPkgName :: String -> String From e5536e49a2ebb9e7377b912932eb7662d668ec8e Mon Sep 17 00:00:00 2001 From: Ryan Scott Date: Mon, 3 Nov 2025 06:30:12 -0500 Subject: [PATCH 0985/1222] copilot-bluespec: Update test suite to match new input/output order. Refs #677. The current Bluespec backend leads to Verilog code that requires manual manipulations in order to work correctly. Specifically, Copilot externs, which are inputs to the Copilot monitoring system, are treated as _outputs_ in Verilog, and Copilot triggers, which can be considered outputs of the monitoring system, are treated as _inputs_. This order of inputs and outputs is the opposite what we would like users to work with, and of what other backends generate (e.g., C99). A prior commit has updated the internals of `copilot-bluespec` to invert the order in which Verilog inputs and outputs are declared. This commit updates the test suite to work with the new design. In addition to changing the code to reflect the new order of inputs and outputs, this commit also updates the names of some internal variables from "`input`" to "`input1`". This change is necessary because "`input`" is a reserved keyword in Verilog, and giving a Bluespec interface method the same name as a reserved Verilog keyword becomes an error when the interface is used in the result type of a synthesized module. --- .../tests/Test/Copilot/Compile/Bluespec.hs | 45 ++++++++----------- 1 file changed, 19 insertions(+), 26 deletions(-) diff --git a/copilot-bluespec/tests/Test/Copilot/Compile/Bluespec.hs b/copilot-bluespec/tests/Test/Copilot/Compile/Bluespec.hs index ee99c6e75..c6319fafa 100644 --- a/copilot-bluespec/tests/Test/Copilot/Compile/Bluespec.hs +++ b/copilot-bluespec/tests/Test/Copilot/Compile/Bluespec.hs @@ -157,18 +157,15 @@ testRun = once $ ioProperty $ do [ "package Top where" , "" , "import CopilotTest" - , "import CopilotTestIfc" , "import CopilotTestTypes" , "" - , "copilotTestIfc :: Module CopilotTestIfc" - , "copilotTestIfc =" - , " module" - , " interface" - , " nop :: Action" - , " nop = return ()" - , "" , "mkTop :: Module Empty" - , "mkTop = mkCopilotTest copilotTestIfc" + , "mkTop =" + , " module" + , " copilotTestMod <- mkCopilotTest" + , " addCopilotTestRules copilotTestMod $" + , " interface CopilotTestRulesIfc" + , " nop_action = return ()" ] writeFile "Top.bs" bluespecProgram @@ -293,7 +290,7 @@ mkRegressionTest1 op haskellFun vals = t1 = typeOf t2 = typeOf - varName = "input" + varName = "input1" -- | Test the behavior of a binary operation (an @'Op2' a b c@ value) against -- its expected behavior (as a Haskell function of type @[a] -> [b] -> [c]@) @@ -762,7 +759,7 @@ mkTestCase1 genO gen = do t1 = typeOf t2 = typeOf - varName = "input" + varName = "input1" -- | Generate test cases for expressions that behave like binary functions. mkTestCase2 :: (Typed a, Typed b, Typed c) @@ -1016,24 +1013,25 @@ testRunCompareArgBluespecProgram proxy inputs outputType = unlines $ , "import Vector" , "" , "import CopilotTest" - , "import CopilotTestIfc" , "import CopilotTestTypes" , "" ] ++ inputVecDecls ++ [ "" - , "copilotTestIfc :: Module CopilotTestIfc" - , "copilotTestIfc =" + , "mkTop :: Module Empty" + , "mkTop =" , " module" + , " copilotTestMod <- mkCopilotTest" ] ++ inputRegs ++ [ " i :: Reg (Bit 64) <- mkReg 0" , " ready :: Reg Bool <- mkReg False" - , " interface" - , " printBack :: " ++ outputType ++ " -> Action" - , " printBack output = $display " ++ printBackDisplayArgs - , " when ready" , "" + , " addCopilotTestRules copilotTestMod $" + , " interface CopilotTestRulesIfc" + , " printBack_action :: " ++ outputType ++ " -> Action" + , " printBack_action output = $display " ++ printBackDisplayArgs + , " when ready" ] ++ inputMethods ++ [ "" @@ -1043,9 +1041,6 @@ testRunCompareArgBluespecProgram proxy inputs outputType = unlines $ ++ inputUpdates ++ [ " i := i + 1" , " ready := True" - , "" - , "mkTop :: Module Empty" - , "mkTop = mkCopilotTest copilotTestIfc" ] where printBackDisplayArgs :: String @@ -1070,11 +1065,9 @@ testRunCompareArgBluespecProgram proxy inputs outputType = unlines $ inputMethods :: [String] inputMethods = - concatMap - (\(bluespecType, varName, regName, _inputVecName, _inputVals) -> - [ " " ++ varName ++ " :: Reg (" ++ bluespecType ++ ")" - , " " ++ varName ++ " = " ++ regName - ]) + map + (\(_bluespecType, varName, regName, _inputVecName, _inputVals) -> + " " ++ varName ++ "_action = return " ++ regName) vars inputUpdates :: [String] From 3114a448fd3837051bfb35ed5a38a7cc7db0a391 Mon Sep 17 00:00:00 2001 From: Ryan Scott Date: Mon, 3 Nov 2025 06:30:28 -0500 Subject: [PATCH 0986/1222] copilot-bluespec: Update DESIGN.md to reflect new input/output order. Refs #677. The current Bluespec backend leads to Verilog code that requires manual manipulations in order to work correctly. Specifically, Copilot externs, which are inputs to the Copilot monitoring system, are treated as _outputs_ in Verilog, and Copilot triggers, which can be considered outputs of the monitoring system, are treated as _inputs_. This order of inputs and outputs is the opposite what we would like users to work with, and of what other backends generate (e.g., C99). A prior commit has updated the internals of `copilot-bluespec` to invert the order in which Verilog inputs and outputs are declared. This commit updates the prose in the `DESIGN.md` document to reflect the new design. The new design is just different enough from the old one that it made sense to completely rewrite certain portions of the document. One of the more notable changes is that there are now separate sections about running the generated Verilog code on hardware versus simulating the generated code in software, as these are distinct use cases that require separate discussion. --- copilot-bluespec/DESIGN.md | 799 ++++++++++++++++++++++++------------- 1 file changed, 527 insertions(+), 272 deletions(-) diff --git a/copilot-bluespec/DESIGN.md b/copilot-bluespec/DESIGN.md index dffb607ac..b5a07dd31 100644 --- a/copilot-bluespec/DESIGN.md +++ b/copilot-bluespec/DESIGN.md @@ -5,7 +5,7 @@ compiles a Copilot specification to a Bluespec program. We assume that you already have some familiarity with core Copilot concepts such as streams, triggers, externs, etc. -## Bluespec overview +# Bluespec overview Bluespec is a high-level hardware design language (HDL). Bluespec comes with a compiler, `bsc`, as well as its own simulator, which allows users to run @@ -25,7 +25,7 @@ Bluespec SystemVerilog. This is primarily because BH's Haskell-like syntax is a closer fit to how Copilot is structured, which makes the design of the compiler simpler. -## A small example +# A small example To get a sense for how `copilot-bluespec` works, let us compile a simple Copilot specification down to Bluespec. Our specification will declare a stream @@ -67,224 +67,309 @@ are: 2. The call to `compile "Fibs" spec'` in `main`. This will compile the Copilot specification to a Bluespec program named `Fibs.bs`. -Running this program will generate five files[^1]: +Running this program will generate four files[^1]: [^1]: The actual code in these files is machine-generated and somewhat difficult to read. We have cleaned up the code slightly to make it easier to understand. -* `FibsTypes.bs`: If the Copilot specification contains any structs, then this - file will contain the corresponding Bluespec struct definitions. The - specification does not contain any structs, so this file is mostly empty: +### `Fibs.bs` - ```bluespec - package FibsTypes where +This defines the majority of the Bluespec code needed to implement a monitor: - import FloatingPoint - import Vector - ``` +```bluespec +package Fibs where - Later in this document, we will see a different example that makes use of - structs. Note that the syntax used here is much like in Haskell, with a - notable difference being that Bluespec uses the `package` keyword instead of - `module`. +import FloatingPoint +import Vector -* `FibsIfc.bs`: This file defines a _module interface_ `FibsIfc`, whose methods - correspond to the names of the triggers in the Copilot spec: +import FibsTypes +import BluespecFP - ```bluespec - package FibsIfc where +interface FibsIfc {-# always_ready, always_enabled #-} = + even_guard :: Bool + even_arg0 :: UInt 32 + odd_guard :: Bool + odd_arg0 :: UInt 32 - import FloatingPoint - import Vector +{-# properties mkFibs = { verilog } #-} +mkFibs :: Module FibsIfc +mkFibs = + module + s0_0 :: Reg (UInt 32) <- mkReg 1 + s0_1 :: Reg (UInt 32) <- mkReg 1 + let s0 :: Vector.Vector 2 (Reg (UInt 32)) + s0 = update (update newVector 0 s0_0) 1 s0_1 + s0_idx :: Reg (Bit 64) <- mkReg 0 - import FibsTypes + let s0_get :: Bit 64 -> UInt 32 + s0_get x = (select s0 ((s0_idx + x) % 2))._read - interface FibsIfc = - even :: UInt 32 -> Action - odd :: UInt 32 -> Action - ``` + s0_gen :: UInt 32 + s0_gen = s0_get 0 + s0_get 1 - An interface like `FibsIfc` can be thought of as a special form of data type - that describes how a module (a hardware object) interacts with the - surrounding environment. In order for an application to make use of a Copilot - monitor, it must instantiate `FibsIfc`'s methods. Each method takes a `UInt - 32` (an unsigned 32-bit integer) as an argument and return an `Action`, which - is the Bluespec type for expressions that act on the state of the circuit (at - circuit execution time). Possible `Action`s include reading from and writing - to registers, as well as printing messages. + rules + "step": when True ==> + action + select s0 s0_idx := s0_gen + s0_idx := (s0_idx + 1) % 2 - We will see an example of how to instantiate `FibsIfc` later. + interface FibsIfc + even_guard :: Bool + even_guard = + (s0_get 0 % 2) == 0 -* `Fibs.bs`: This file defines a `mkFibs` function, which orchestrates - everything in the generated Bluespec monitor: + even_arg0 :: UInt 32 + even_arg0 = s0_get 0 - ```bluespec - package Fibs where + odd_guard :: Bool + odd_guard = + not (s0_get 0 % 2 == 0) - import FloatingPoint - import Vector + odd_arg0 :: UInt 32 + odd_arg0 = s0_get 0 - import FibsTypes - import FibsIfc - import BluespecFP +interface FibsRulesIfc = + even_action :: UInt 32 -> Action + odd_action :: UInt 32 -> Action - mkFibs :: Module FibsIfc -> Module Empty - mkFibs ifcMod = - module - ifc <- ifcMod +mkFibsRules :: FibsIfc -> FibsRulesIfc -> Rules +mkFibsRules ifc ifcRules = + rules + "even": when ifc.even_guard ==> + ifcRules.even_action ifc.even_arg0 - s0_0 :: Reg (UInt 32) <- mkReg 1 - s0_1 :: Reg (UInt 32) <- mkReg 1 - let s0 :: Vector 2 (Reg (UInt 32)) - s0 = update (update newVector 0 s0_0) 1 s0_1 - s0_idx :: Reg (Bit 64) <- mkReg 0 + "odd": when ifc.odd_guard ==> + ifcRules.odd_action ifc.odd_arg0 - let s0_get :: Bit 64 -> UInt 32 - s0_get x = (select s0 ((s0_idx + x) % 2))._read +addFibsRules :: FibsIfc -> FibsRulesIfc -> Module Empty +addFibsRules ifc ifcRules = addRules (mkFibsRules ifc ifcRules) +``` - s0_gen :: UInt 32 - s0_gen = s0_get 0 + s0_get 1 +Those familiar with Haskell will likely recognize much of the syntax used here, +although it has some minor differences (e.g., using the `package` keyword +instead of `module`, which means something else in Bluespec). We will go into +the parts of the syntax that are unique to Bluespec as they come up. + +The `Fibs.bs` file consists of five definitions: + +1. `FibsIfc`, which is a _module interface_. An interface like `FibsIfc` can be + thought of as a special form of data type that describes how a module (a + hardware object) interacts with the surrounding environment. In order for an + application to make use of a Copilot monitor, it must instantiate + `FibsIfc`'s methods. We will see an example of how to instantiate `FibsIfc` + momentarily. + + The methods of `FibsIfc` correspond to the names of the triggers in the + Copilot spec. Each trigger has a corresponding _guard_ method, which always + has the type `Bool`, and an _argument_ method for each argument that the + trigger accepts, which has a type corresponding to the type of the argument. + We will see how these work in more detail shortly. For now, think of these + methods as being the "outputs" of the monitor program. + +2. `mkFibs`, which returns a module of type `Module FibsIfc`. A module can be + thought of as a generator of hardware objects. The module uses the `FibsIfc` + interface, which indicates that the implementation of the module + instantiates all of the methods in `FibsIfc`. If you squint, you'll + recognize bits and pieces of the original Copilot spec, such as the part + that checks for even stream elements in `even_guard`. We will go over the + individual definitions used in the implementation of `mkFibs` later. + + Note `mkFibs`'s use of the `module` and `action` keywords. These can be + thought of as specialized versions of Haskell's `do`-notation, where + `module` denotes the `Module` monad, and `action` denotes the `ActionValue` + monad. (Note that `Action` is an alias for `ActionValue ()`.) The `Module` + monad describes how to elaborate the structure of a module, whereas the + `ActionValue` monad describes the behavior of a circuit at execution time. + + Another piece of syntax that is unique to Bluespec modules is the `rules` + keyword, which denote rules that may or may not be run on each clock cycle + of the hardware. This particular module only has a single rule, named + `step`, which updates some internal state used by the module. That internal + state is then used to define the values that the interface methods return. + The `when True` part of the rule indicates that it always runs on every + clock cycle. + +3. `FibsRulesIfc` is another module interface, with one method for each of the + Copilot spec's triggers. Each method takes arguments corresponding to the + types of the triggers' arguments and returns a value of type `Action`. As + the name `FibsRulesIfcs` suggests, these methods are intended to be used to + build up rule definitions, and we will see an example of this shortly. + + As an aside, you may be wondering why there are two different interfaces + that each have methods corresponding to the Copilot spec's trigger + functions. Why not just have a single interface instead? The short answer to + this question is that these interfaces are intended for different use cases: + modules that instantiate `FibsRulesIfc` are intended for simulation, whereas + modules that instantiate `FibsIfc` are intended for Verilog code generation. + For a longer answer to this question, see the "Generating Verilog code" + section below. + +4. `mkFibsRules`, a function which takes two values that instantiate the + `FibsIfc` and `FibsRulesIfc` interfaces and returns a `Rules` value. A value + of type `Rules` is just a set of rules, which can be passed around in + Bluespec like any other value. + + `mkFibsRules` defines two rules, one for each trigger function in the + original Copilot spec. Unlike the `step` rule seen earlier, these rules may + not be run on every clock cycle. Specifically, the `even` rule will only run + if the `ifc.even_guard` expression returns `True` on a given clock cycle, + and the `odd` rule will only run if `ifc.odd_guard` returns `True` on a + given clock cycle. If one of these rules are run, then they will invoke the + corresponding method from the `FibsRulesIfc` interface, passing in the + corresponding `*_arg` method(s) from the `FibsIfc`. + +5. `addFibsRules`, a function which is very similar to `mkFibsRules`, except + that it has the return type `Module Empty` instead of `Rules`. All that + `addFibsRules` does is invoke `mkFibsRules` and then pass it to Bluespec's + `addRules` function, which actually adds the rules to a module. This is a + convenience that allows users to quickly define a full Bluespec module that + is suitable for simulation purposes (see the "Simulating Bluespec code" + section below). + + Note that the module that this returns instantiates the `Empty` interface. + `Empty` is a standard interface with no methods at all, and `Empty` is + typically used in top-level Bluespec modules that act as entrypoints to + simulation. + +### `FibsTypes.bs` + +If the Copilot specification contained any structs, then the generated +`FibsTypes.bs` file would contain the corresponding Bluespec struct +definitions. The specification in `Fibs.hs` does not contain any structs, so +this file is mostly empty: - even_guard :: Bool - even_guard = - (s0_get 0 % 2) == 0 +```bluespec +package FibsTypes where - odd_guard :: Bool - odd_guard = - not (s0_get 0 % 2 == 0) +import FloatingPoint +import Vector +``` - rules - "even": when even_guard ==> - ifc.even (s0_get 0) +Later in this document, we will see a different example that makes use of +structs. - "odd:": when odd_guard ==> - ifc.odd (s0_get 0) +### `BluespecFP.bsv` - "step": when True ==> - action - select s0 s0_idx := s0_gen - s0_idx := (s0_idx + 1) % 2 - ``` +This is a collection of floating-point operations that leverage BDPI +(Bluespec's foreign-function interface). We will omit the full contents of this +file for brevity, but it will look something like this: - `mkFibs` returns a module, which can be thought of as a generator of hardware - objects. `mkFibs` takes a `FibsIfc` module as an argument and returns another - module, which is parameterized by `Empty`. `Empty` is a standard interface - with no methods, and `Empty` is typically used in top-level modules that act - as program entrypoints. +```bluespec +import FloatingPoint::*; - Note that the `module` and `action` keywords can be thought of as specialized - versions of Haskell's `do`-notation, where `module` denotes the `Module` - monad, and `action` denotes the `ActionValue` monad. (Note that `Action` is - an alias for `ActionValue ()`.) The `Monad` monad describes how to elaborate - the structure of a module, whereas the `ActionValue` monad describes the - behavior of a circuit at execution time. - -* `BluespecFP.bsv`: A collection of floating-point operations that leverage BDPI - (Bluespec's foreign-function interface). We will omit the full contents of - this file for brevity, but it will look something like this: - - ```bluespec - import FloatingPoint::*; - - import "BDPI" function Float bs_fp_expf (Float x); - import "BDPI" function Double bs_fp_exp (Double x); - import "BDPI" function Float bs_fp_logf (Float x); - import "BDPI" function Double bs_fp_log (Double x); - ... - ``` +import "BDPI" function Float bs_fp_expf (Float x); +import "BDPI" function Double bs_fp_exp (Double x); +import "BDPI" function Float bs_fp_logf (Float x); +import "BDPI" function Double bs_fp_log (Double x); +... +``` - For more information on what this file does, see the "Floating-point numbers" - section below. +For more information on what this file does, see the "Floating-point numbers" +section below. -* `bs_fp.c`: A collection of floating-point operations implemented in C. These - functions are imported via BDPI in `BluespecFP.bsv`. We will omit the full - contents of this file for brevity, but it will look something like this: +### `bs_fp.c` - ```bluespec - #include +A collection of floating-point operations implemented in C. These functions are +imported via BDPI in `BluespecFP.bsv`. We will omit the full contents of this +file for brevity, but it will look something like this: - union ui_float { - unsigned int i; - float f; - }; +```bluespec +#include - union ull_double { - unsigned long long i; - double f; - }; +union ui_float { + unsigned int i; + float f; +}; - unsigned int bs_fp_expf(unsigned int x) { - ... - } +union ull_double { + unsigned long long i; + double f; +}; - unsigned long long bs_fp_exp(unsigned long long x) { - ... - } +unsigned int bs_fp_expf(unsigned int x) { + ... +} - unsigned int bs_fp_logf(unsigned int x) { - ... - } +unsigned long long bs_fp_exp(unsigned long long x) { + ... +} - unsigned long long bs_fp_log(unsigned long long x) { - ... - } +unsigned int bs_fp_logf(unsigned int x) { + ... +} +unsigned long long bs_fp_log(unsigned long long x) { ... - ``` +} + +... +``` + +For more information on what this file does, see the "Floating-point numbers" +section below. + +## Using the generated Bluespec code + +What do we do with the Bluespec code after generating it? The answer to this +question ultimately depends on your intended use case. Sometimes, it can be +useful to just simulate the Bluespec code in software, which we can do with a +variety of hardware simulators. In other use cases, it can be more useful to +directly synthesize code that can be embedded in real hardware. We will review +each of these workflows below. + +### Simulating Bluespec code - For more information on what this file does, see the "Floating-point numbers" - section below. +Hardware simulation allows us to model the behavior of hardware without +actually needing access to physical hardware to do so. There are a number of +different simulators out there, such as Bluespec's own Bluesim simulator, as +well as Verilog-specific simulators such as Verilator and Icarus Verilog +(`iverilog`). We will be using Bluesim throughout this section, as it is +already bundled with each installation of Bluespec. -In a larger application, a Copilot user would instantiate `mkFibs` with a -`FibsIfc` module that describes what should happen when the `even` and `odd` -triggers fire. `FibsIfc` contains everything that the user must supply; -everything else is handled within the module that `mkFibs` returns. +Suppose we have a Bluespec program that we want to monitor with Copilot. This +program will likely have a top-level module (typically of type `Module Empty`), +and it is the role of the program's developer to decide what action the program +should take whenever the monitor fires a trigger. In a full hardware setting, +these actions might constitute something like blinking an LED or displaying a +message on a seven-segment display. For simulation purposes, however, we can +approximate this behavior by doing something simpler (e.g., printing messages +to standard output on the terminal). -Here is an example of a larger application might look like: +Here is an example of a program that uses the Copilot-generated `Fibs.bs` +monitor shown above: ```bluespec package Top where import Fibs -import FibsIfc import FibsTypes -fibsIfc :: Module FibsIfc -fibsIfc = - module - interface - even x = - $display "Even Fibonacci number: %0d" x - - odd x = - $display "Odd Fibonacci number: %0d" x - mkTop :: Module Empty -mkTop = mkFibs fibsIfc +mkTop = + module + fibsMod <- mkFibs + addFibsRules fibsMod $ + interface FibsRulesIfc + even_action x = + $display "Even Fibonacci number: %0d" x + + odd_action x = + $display "Odd Fibonacci number: %0d" x ``` `mkTop` is the top-level module that we will use as a program entrypoint. The -only interesting thing that it does is instantiate `mkFibs` with a custom -`FibsIfc`, where `even` and `odd` are defined to display a custom message -whenever an even or odd Fibonacci number is encountered, respectively. +only interesting thing that it does is create a `FibsIfc` module internally +(using `mkFibs`) and then define the actions to take when the `even` or `odd` +triggers fire. These actions are defined by the implementations of the +`even_action` and `odd_action` methods, respectively, which print custom +messages to standard output. -We can run `mkTop` by using Bluespec's simulator like so: +We can run `mkTop` by using Bluesim like so: ``` $ bsc -sim -g mkTop -u Top.bs -checking package dependencies -compiling Top.bs -code generation for mkTop starts -Elaborated module file created: mkTop.ba -All packages are up to date. - $ bsc -sim -e mkTop -o mkTop.exe bs_fp.c -Bluesim object created: mkTop.{h,o} -Bluesim object created: model_mkTop.{h,o} -Simulation shared library created: mkTop.exe.so -Simulation executable created: mkTop.exe - $ ./mkTop.exe -m 10 Odd Fibonacci number: 1 Odd Fibonacci number: 1 @@ -304,6 +389,94 @@ the values of registers do not become ready until after the reset signal is enabled. Because all of the rules depend on registers, none of them will fire until the second clock cycle or later. +### Generating Verilog code + +Generating code that is suitable for hardware is a somewhat different problem +than generating code that is suitable for simulation. Many types of hardware +(e.g., FPGAs) require specific hardware description languages in order to +synthesize hardware circuits, such as Verilog or VHDL. Bluespec supports +compiling to Verilog, so we will be focusing on that in this section. + +A typical Verilog module has a number of _signals_ that represent the paths +into a circuit (called _inputs_), within a circuit (called _wires_), and +outside of the circuit (called _outputs_). The generated Bluespec code seen +above has been carefully designed such that the triggers in the Copilot spec +compile directly to Verilog outputs. (Copilot also has a notion of external +streams that compile to Verilog inputs; see the "External streams" section for +more on this.) + +Unlike the simulation use case, generating Verilog code does not make use of +the `FibsRulesIfc` interface at all, as this is a convenience that is only +provided to make simulation easier. Instead, we compile the `mkFibs` module +directly to Verilog: + +``` +$ bsc -verilog -g mkFibs -u Fibs.bs +``` + +This generates a Verilog module `mkFibs.v` that looks like the following: + +```verilog +module mkFibs(CLK, + RST_N, + + even_guard, + + even_arg0, + + odd_guard, + + odd_arg0); + input CLK; + input RST_N; + + // value method even_guard + output even_guard; + + // value method even_arg0 + output [31 : 0] even_arg0; + + // value method odd_guard + output odd_guard; + + // value method odd_arg0 + output [31 : 0] odd_arg0; + + ... + +endmodule // mkFibs +``` + +We show only a subset of the generated Verilog code to highlight the inputs and +outputs. There are two inputs corresponding to the `CLK` (clock) and `RST_N` +(reset) signals, which are generated for all Copilot monitors, regardless of +what the underlying spec is. The outputs correspond to the methods of the +`FibsIfc` interface. For instance, the signal in the `even_guard` output +indicates whether the `even` trigger fires on a given clock cycle or not, and +the value in the `even_arg0` output indicates what argument was passed to the +trigger on that clock cycle. These outputs can then be hooked up to another +part of a hardware circuit (e.g., LEDs) that can respond to these values as +needed. + +In general, if a Bluespec interface has a method of type `t` (where `t` is a +non-monadic type), then that method will be compiled to a Verilog output. If a +method has type `t -> Action`, however, then that method will be compiled to a +Verilog input instead. This is a key reason why it is necessary to separate +`FibsIfc` from `FibsRulesIfc`. If we compiled a `Module FibsRulesIfc` to +Verilog, then the triggers would become inputs, not outputs! + +(As a side note: the generated Bluespec code also employs various other tricks +to get the compiled Verilog code to look the way it does. For instance, note +the `{-# properties mkFibs = { verilog } #-}` pragma above `mkFibs`, which +instructs the Bluespec compiler to synthesize Verilog code for it. Also note +the `{-# always_ready, always_enabled #-}` attributes used in `FibsIfc`, which +ensure that the generated Verilog code does not contain unwanted "ready" or +"enabled" signals as inputs.) + +For a more in-depth tutorial on how to use the generated Verilog code on an +actual FPGA, see [this +tutorial](https://github.com/Copilot-Language/copilot/blob/master/copilot/examples/fpga/HelloWorld/README.md). + ## Streams Much like in `copilot-c99`, `copilot-bluespec` translates each stream @@ -352,8 +525,8 @@ In order to access an element of a stream, we make use of the `s0_get` function: ```bluespec - let s0_get :: Bit 64 -> UInt 32 - s0_get x = (select s0 ((s0_idx + x) % 2))._read + let s0_get :: Bit 64 -> UInt 32 + s0_get x = (select s0 ((s0_idx + x) % 2))._read ``` This will use `s0_idx` and an offset `x` to compute which `Reg` in the `Vector` @@ -362,48 +535,43 @@ to read from. ## Rules The _rules_ govern what actions are performed during each cycle. There are -three actions in the `Fibs.hs` example: +three actions in the `Fibs.bs` example above: one in `mkFibs`: ```bluespec rules - "even": when even_guard ==> - ifc.even (s0_get 0) + "step": when True ==> + action + select s0 s0_idx := s0_gen + s0_idx := (s0_idx + 1) % 2 +``` + +And two more in `mkFibsRules`: - "odd:": when odd_guard ==> - ifc.odd (s0_get 0) +```bluespec + rules + "even": when ifc.even_guard ==> + ifcRules.even_action ifc.even_arg0 - "step": when True ==> do - select s0 s0_idx := s0_gen - s0_idx := (s0_idx + 1) % 2 + "odd": when ifc.odd_guard ==> + ifcRules.odd_action ifc.odd_arg0 ``` Each rule consists of three parts: -1. A label (e.g., `"even"`) that uniquely identifies the rule within the +1. A label (e.g., `"step"`) that uniquely identifies the rule within the module. 2. An explicit condition, which is a boolean expression of the form `when ==> ...`. In order for a rule to fire on a given clock cycle, its explicit condition `` must hold. -3. A rule body (e.g., `ifc.even (s0_get 0)`), which describes what action the - rule performs if it fires on a given clock cycle. +3. A rule body (of type `Action`), which describes what action the rule + performs if it fires on a given clock cycle. In the example above, the `"even"` and `"odd"` rules govern the behavior of the triggers in the Copilot specification. These rules will only fire if -`even_guard` or `odd_guard` hold, and if they fire, they will call the `even` -or `odd` method of `FibsIfcs`, respectively. The definitions of `even_guard` -and `odd_guard` are: - -```bluespec - even_guard :: Bool - even_guard = - (s0_get 0 % 2) == 0 - - odd_guard :: Bool - odd_guard = - not (s0_get 0 % 2 == 0) -``` +`even_guard` or `odd_guard` hold, and if they fire, they will call the +`even_action` or `odd_action` method of `FibsRulesIfc`, respectively. The `"step"` rule is the heart of the Copilot specification, and it always runs on each clock cycle. `"step"` does two things: @@ -412,8 +580,8 @@ on each clock cycle. `"step"` does two things: which is defined like so: ```bluespec - s0_gen :: UInt 32 - s0_gen = s0_get 0 + s0_get 1 + s0_gen :: UInt 32 + s0_gen = s0_get 0 + s0_get 1 ``` 2. It increments `s0_idx`, making sure to wrap around to `0` if its value @@ -433,27 +601,28 @@ however. Recall the definitions of the three rules in the example program above: ```bluespec - rules - "even": when even_guard ==> - ifc.even (s0_get 0) +"step": when True ==> + action + select s0 s0_idx := s0_gen + s0_idx := (s0_idx + 1) % 2 - "odd:": when odd_guard ==> - ifc.odd (s0_get 0) +"even": when ifc.even_guard ==> + ifcRules.even_action ifc.even_arg0 - "step": when True ==> do - select s0 s0_idx := s0_gen - s0_idx := (s0_idx + 1) % 2 +"odd": when ifc.odd_guard ==> + ifcRules.odd_action ifc.odd_arg0 ``` If this were a language like C, then the order in which the rules appear would -have an effect on the runtime semantics of the program, as the behavior of -`s0_get` (used in the `"even"` and `"odd"` rules) depends on the current value -of `s0` and `s0_idx`. In Bluespec, however, the order of these rules do _not_ -matter. The `"step"` rule performs side effects of updating the value of `s0` -and `s0_idx`, but these effects are performed in a single, atomic transaction -at the end of the clock cycle. This means that the values of `s0` and `s0_idx` -that `s0_get` sees will always match their values at the start of the clock -cycle, regardless of what order Bluespec uses to invoke the rules. +have an effect on the runtime semantics of the program, as the values that +`even_arg0` and `odd_arg0` return (used in the `"even"` and `"odd"` rules) +depends on the current value of `s0` and `s0_idx`. In Bluespec, however, the +order of these rules do _not_ matter. The `"step"` rule performs side effects +of updating the value of `s0` and `s0_idx`, but these effects are performed in +a single, atomic transaction at the end of the clock cycle. This means that the +values of `s0` and `s0_idx` that `s0_get` sees will always match their values +at the start of the clock cycle, regardless of what order Bluespec uses to +invoke the rules. Because the Bluespec compiler can pick whatever rule order it wishes to, this can impact the order in which `$display` output is presented. This doesn't @@ -466,8 +635,11 @@ specified. ## External streams The example above sampled data from a stream that was defined within the -Copilot specification. To see what happens when a specification uses an -external stream, let's make one small change to the example: +Copilot specification. Copilot also features a notion of _external_ streams, +which sample data from the surrounding environment. (For instance, one could +populate an external stream with data read from a sensor in a real-world +application.) To see what happens when a specification uses an external stream, +let's make one small change to the example above: ```diff fibs :: Stream Word32 @@ -476,68 +648,117 @@ external stream, let's make one small change to the example: ``` Now let's re-run the example and inspect the resulting Bluespec program. There -are two notable changes worth commenting on. The first change is in -`FibsIfc.bs`: +are several notable changes worth commenting on. The first change is in the +definition of the `FibsIfc` interface: ```bluespec -package FibsIfc where +interface FibsIfc {-# always_ready, always_enabled #-} = + even_guard :: Bool + even_arg0 :: UInt 32 + odd_guard :: Bool + odd_arg0 :: UInt 32 + fibs :: UInt 32 -> Action {-# prefixs = "", arg_names = [fibs] #-} +``` -import FloatingPoint -import Vector +This time, there is an additional `fibs` method of type `UInt 32 -> Action`. +This type is carefully chosen such that when `FibsIfc` is compiled to Verilog, +`fibs` will be represented as an input to the Verilog module, which intuitively +matches how external streams are used in Copilot itself. (Also note the +attributes to the right of the type signature, which ensure that the generated +Verilog input has precisely the name "`fibs`".) -import FibsTypes +The next change is in `mkFibs`, which demonstrates how the `fibs` method is +instantiated: + +```bluespec +{-# properties mkFibs = { verilog } #-} +mkFibs :: Module FibsIfc +mkFibs = + module + fibs_wire :: Wire (UInt 32) <- mkBypassWire + + interface FibsIfc + even_guard :: Bool + even_guard = + (fibs_wire._read % 2) == 0 + + even_arg0 :: UInt 32 + even_arg0 = fibs_wire._read -interface FibsIfc = - even :: UInt 32 -> Action - odd :: UInt 32 -> Action - fibs :: Reg (UInt 32) + odd_guard :: Bool + odd_guard = + not (fibs_wire._read % 2 == 0) + + odd_arg0 :: UInt 32 + odd_arg0 = fibs_wire._read + + fibs val = fibs_wire := val ``` -This time, the `FibsIfc` interface has an additional `fibs` method of type `Reg -(UInt 32)`. This register corresponds to the external stream that we just -defined, and it is the responsibility of the application which instantiates -`FibsIfc` to dictate what values should be written to the register. +This looks quite a bit different! Let's go over what has changed: -The second change is in `Fibs.bs`: +* There are no longer any registers to hold internal state, nor is there a + `"step"` rule that updates the registers. These registers were ultimately + used in service of maintaining the ring buffers that comprised the definition + of the `fibs` stream that was defined within Copilot. Now that `fibs` is an + external stream, none of the ring buffer machinery is needed anymore. -```bluespec -package Fibs where + (Note that this is not an all-or-nothing proposition, as it is possible to + have a Copilot spec that combines defined-within-Copilot streams and external + streams.) -import FloatingPoint -import Vector +* There is a new piece of internal state: the `fibs_wire` `Wire`. Moreover, + all places where `s0_get 0` was called before have now been replaced with + `fibs_wire._read`. A `Wire` is essentially a special type of register that + compiles to more compact Verilog code. -import FibsTypes -import FibsIfc +* Finally, there is now an implementation of the `fibs` method, which writes + the supplied value to `fibs_wire`. This is what allows other methods to see + the most recently sampled value in the `fibs` external stream. -mkFibs :: Module FibsIfc -> Module Empty -mkFibs ifcMod = - module - ifc <- ifcMod +The next change is in the definition of `FibsRulesIfc`, which has also gained +another method corresponding to the `fibs` external stream: - let even_guard :: Bool - even_guard = - (ifc.fibs._read % 2) == 0 +```bluespec +interface FibsRulesIfc = + even_action :: UInt 32 -> Action + odd_action :: UInt 32 -> Action + fibs_action :: ActionValue (UInt 32) +``` - odd_guard :: Bool - odd_guard = - not (ifc.fibs._read % 2 == 0) +Unlike `even_action` and `odd_action`, which denote an action for _consuming_ a +value, the type of `fibs_action` (`ActionValue (UInt 32)`) denotes how to +_produce_ a value. This makes sense, since the application being monitored +ultimately has to be the source of the values that populate the external +stream. The implementation of the `fibs_action` method is where this population +happens. - rules - "even": when even_guard ==> - ifc.even ifc.fibs._read +Finally, the definition of `mkFibsRules` now implements a `"fibs"` rule: - "odd:": when odd_guard ==> - ifc.odd ifc.fibs._read +```bluespec +mkFibsRules :: FibsIfc -> FibsRulesIfc -> Rules +mkFibsRules ifc ifcRules = + rules + "even": when ifc.even_guard ==> + ifcRules.even_action ifc.even_arg0 + + "odd": when ifc.odd_guard ==> + ifcRules.odd_action ifc.odd_arg0 + + "fibs": when Prelude.True ==> + action + fibsVal <- ifcRules.fibs_action + ifc.fibs fibsVal ``` -This time, the only stream that is referenced is `ifc.fibs`. As a consequence, -the `s0` stream, the `s0_idx` index, and the `"step"` rule are no longer -necessary, making the code considerably simpler. +This new rule produces a external value using `ifcRules.fibs_action` and then +feeds it to `ifc.fibs` as an input. + +### Simulating Bluespec code involving external streams -The flip side to having the generated code be simpler is that the application -which uses `mkFibs` must now do additional work to specify what the value of -`ifc.fibs` is. For example, we can port the behavior of the previous version -of the program like so: +Let's update our example from the "Simulating Bluespec code" section to +accommodate `fibs` becoming an external stream. Here is an example of what a +`Top.bs` application might look like: ```bluespec package Top where @@ -545,11 +766,10 @@ package Top where import Vector import Fibs -import FibsIfc import FibsTypes -fibsIfc :: Module FibsIfc -fibsIfc = +mkTop :: Module Empty +mkTop = module s0_0 :: Reg (UInt 32) <- mkReg 1 s0_1 :: Reg (UInt 32) <- mkReg 1 @@ -563,38 +783,73 @@ fibsIfc = s0_gen :: UInt 32 s0_gen = s0_get 0 + s0_get 1 - fibs_impl :: Reg (UInt 32) <- mkReg 1 + fibsMod <- mkFibs - interface - even x = - $display "Even Fibonacci number: %0d" x + addFibsRules fibsMod $ + interface FibsRulesIfc + even_action x = + $display "Even Fibonacci number: %0d" x - odd x = - $display "Odd Fibonacci number: %0d" x + odd_action x = + $display "Odd Fibonacci number: %0d" x - fibs = fibs_impl + fibs_action = return (s0_get 0) rules - "fibs": when True ==> - fibs_impl := s0_get 1 - "step": when True ==> action select s0 s0_idx := s0_gen s0_idx := (s0_idx + 1) % 2 +``` -mkTop :: Module Empty -mkTop = mkFibs fibsIfc +Note that all of the code involving registers and the `"step"` rule now lives +in `Top.bs`, as it is now the responsibility of the application to produce the +values for the `fibs` stream. There is also now an implementation of the +`fibs_action` method that returns the most recently computed Fibonacci number +on each clock cycle. + +### Generating Verilog code involving external streams + +Compiling the new version of `mkFibs` to Verilog produces a `mkFibs.v` file +that looks like the following: + +```verilog +module mkFibs(CLK, + RST_N, + + even_guard, + + even_arg0, + + odd_guard, + + odd_arg0, + + fibs); + input CLK; + input RST_N; + + // value method even_guard + output even_guard; + + // value method even_arg0 + output [31 : 0] even_arg0; + + // value method odd_guard + output odd_guard; + + // value method odd_arg0 + output [31 : 0] odd_arg0; + + // action method fibs + input [31 : 0] fibs; + + ... + +endmodule // mkFibs ``` -The code involving `s0`, `s0_idx`, and the `"step"` rule is exactly as before. -The only notable difference is that we create an additional `fibs_impl` -register, declare `fibs = fibs_impl` when instantiating the `FibsIfc` -interface, and declare an additional `"fibs"` rule to update the value of -`fibs_impl` on each clock cycle. Note that we always set the value of -`fibs_impl` to be `s0_get 1`, which corresponds to the most recently computed -Fibonacci number. If we set `fibs_impl` to be `s0_get 0` instead, then -`fibs_impl` would lag behind by one cycle. (Try it.) +As expected, the only notable change is that there is now a `fibs` input. # Notes From dab5669f4459bcea5a624b4357c46552c8f40c49 Mon Sep 17 00:00:00 2001 From: Ryan Scott Date: Mon, 3 Nov 2025 06:55:48 -0500 Subject: [PATCH 0987/1222] copilot-bluespec: Document changes in CHANGELOG. Refs #677. --- copilot-bluespec/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-bluespec/CHANGELOG b/copilot-bluespec/CHANGELOG index e7472493b..17c30d99e 100644 --- a/copilot-bluespec/CHANGELOG +++ b/copilot-bluespec/CHANGELOG @@ -1,3 +1,6 @@ +2025-11-03 + * Flip direction of interface inputs and outputs in Bluespec. (#677) + 2025-09-07 * Version bump (4.5.1). (#666) From de6c50a5fbad1bf73971c2a77b52073ae94d4077 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 7 Nov 2025 22:12:29 -0800 Subject: [PATCH 0988/1222] copilot-core: Version bump (4.6). Refs #679. --- copilot-core/copilot-core.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot-core/copilot-core.cabal b/copilot-core/copilot-core.cabal index 78e2d5808..6c18d6ca3 100644 --- a/copilot-core/copilot-core.cabal +++ b/copilot-core/copilot-core.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-core -version: 4.5.1 +version: 4.6 synopsis: An intermediate representation for Copilot. description: Intermediate representation for Copilot. From 60779af32db12faec753518a8e266b7ab4874280 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 7 Nov 2025 22:12:29 -0800 Subject: [PATCH 0989/1222] copilot-bluespec: Version bump (4.6). Refs #679. --- copilot-bluespec/copilot-bluespec.cabal | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/copilot-bluespec/copilot-bluespec.cabal b/copilot-bluespec/copilot-bluespec.cabal index f62cb2432..975868aca 100644 --- a/copilot-bluespec/copilot-bluespec.cabal +++ b/copilot-bluespec/copilot-bluespec.cabal @@ -1,6 +1,6 @@ cabal-version : >= 1.10 name : copilot-bluespec -version : 4.5.1 +version : 4.6 synopsis : A compiler for Copilot targeting FPGAs. description : This package is a back-end from Copilot to FPGAs in Bluespec. @@ -44,8 +44,8 @@ library , filepath >= 1.4 && < 1.6 , pretty >= 1.1.2 && < 1.2 - , copilot-core >= 4.5.1 && < 4.6 - , language-bluespec >= 0.1 && < 0.2 + , copilot-core >= 4.6 && < 4.7 + , language-bluespec >= 0.1 && < 0.2 exposed-modules : Copilot.Compile.Bluespec From 95f3bcc5c5af02d4952033951cfa1610a1b0122d Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 7 Nov 2025 22:12:29 -0800 Subject: [PATCH 0990/1222] copilot-c99: Version bump (4.6). Refs #679. --- copilot-c99/copilot-c99.cabal | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/copilot-c99/copilot-c99.cabal b/copilot-c99/copilot-c99.cabal index b33f4e5bc..e5efd5f24 100644 --- a/copilot-c99/copilot-c99.cabal +++ b/copilot-c99/copilot-c99.cabal @@ -1,6 +1,6 @@ cabal-version : >= 1.10 name : copilot-c99 -version : 4.5.1 +version : 4.6 synopsis : A compiler for Copilot targeting C99. description : This package is a back-end from Copilot to C. @@ -45,7 +45,7 @@ library , mtl >= 2.2 && < 2.4 , pretty >= 1.1 && < 1.2 - , copilot-core >= 4.5.1 && < 4.6 + , copilot-core >= 4.6 && < 4.7 , language-c99 >= 0.2.0 && < 0.3 , language-c99-simple >= 0.3 && < 0.4 From 19497c5192b9d17c36a2b9ea6e7adec76246e424 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 7 Nov 2025 22:12:29 -0800 Subject: [PATCH 0991/1222] copilot-prettyprinter: Version bump (4.6). Refs #679. --- copilot-prettyprinter/copilot-prettyprinter.cabal | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/copilot-prettyprinter/copilot-prettyprinter.cabal b/copilot-prettyprinter/copilot-prettyprinter.cabal index a5acd909f..0f413f63d 100644 --- a/copilot-prettyprinter/copilot-prettyprinter.cabal +++ b/copilot-prettyprinter/copilot-prettyprinter.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-prettyprinter -version: 4.5.1 +version: 4.6 synopsis: A prettyprinter of Copilot Specifications. description: A prettyprinter of Copilot specifications. @@ -45,7 +45,7 @@ library base >= 4.9 && < 5, pretty >= 1.0 && < 1.2, - copilot-core >= 4.5.1 && < 4.6 + copilot-core >= 4.6 && < 4.7 exposed-modules: From 67d4d52610534e3192881fec42d47c241b306e2a Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 7 Nov 2025 22:12:29 -0800 Subject: [PATCH 0992/1222] copilot-interpreter: Version bump (4.6). Refs #679. --- copilot-interpreter/copilot-interpreter.cabal | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/copilot-interpreter/copilot-interpreter.cabal b/copilot-interpreter/copilot-interpreter.cabal index b6b2c4fe7..e8b9fad4f 100644 --- a/copilot-interpreter/copilot-interpreter.cabal +++ b/copilot-interpreter/copilot-interpreter.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-interpreter -version: 4.5.1 +version: 4.6 synopsis: Interpreter for Copilot. description: Interpreter for Copilot. @@ -44,7 +44,7 @@ library base >= 4.9 && < 5, pretty >= 1.0 && < 1.2, - copilot-core >= 4.5.1 && < 4.6 + copilot-core >= 4.6 && < 4.7 exposed-modules: From 1b67a69a58ed80b78bfdc0712f1aa094d051bbd2 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 7 Nov 2025 22:12:29 -0800 Subject: [PATCH 0993/1222] copilot-theorem: Version bump (4.6). Refs #679. --- copilot-theorem/copilot-theorem.cabal | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/copilot-theorem/copilot-theorem.cabal b/copilot-theorem/copilot-theorem.cabal index 86bb1c68c..b830f91a6 100644 --- a/copilot-theorem/copilot-theorem.cabal +++ b/copilot-theorem/copilot-theorem.cabal @@ -14,7 +14,7 @@ description: . -version : 4.5.1 +version : 4.6 license : BSD3 license-file : LICENSE maintainer : Ivan Perez @@ -62,8 +62,8 @@ library , xml >= 1.3 && < 1.4 , what4 >= 1.3 && < 1.8 - , copilot-core >= 4.5.1 && < 4.6 - , copilot-prettyprinter >= 4.5.1 && < 4.6 + , copilot-core >= 4.6 && < 4.7 + , copilot-prettyprinter >= 4.6 && < 4.7 exposed-modules : Copilot.Theorem , Copilot.Theorem.Prove From f57879372d0fc41625a30152e452f79ce7eec3eb Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 7 Nov 2025 22:12:29 -0800 Subject: [PATCH 0994/1222] copilot-language: Version bump (4.6). Refs #679. --- copilot-language/copilot-language.cabal | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/copilot-language/copilot-language.cabal b/copilot-language/copilot-language.cabal index 7d02c0bfc..543a11770 100644 --- a/copilot-language/copilot-language.cabal +++ b/copilot-language/copilot-language.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-language -version: 4.5.1 +version: 4.6 synopsis: A Haskell-embedded DSL for monitoring hard real-time distributed systems. description: @@ -42,9 +42,9 @@ library , data-reify >= 0.6 && < 0.7 , mtl >= 2.0 && < 3 - , copilot-core >= 4.5.1 && < 4.6 - , copilot-interpreter >= 4.5.1 && < 4.6 - , copilot-theorem >= 4.5.1 && < 4.6 + , copilot-core >= 4.6 && < 4.7 + , copilot-interpreter >= 4.6 && < 4.7 + , copilot-theorem >= 4.6 && < 4.7 exposed-modules: Copilot.Language , Copilot.Language.Operators.BitWise From 55f945cc71aabdf1d64f01dc2f588e6917ef6d44 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 7 Nov 2025 22:12:29 -0800 Subject: [PATCH 0995/1222] copilot-libraries: Version bump (4.6). Refs #679. --- copilot-libraries/copilot-libraries.cabal | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/copilot-libraries/copilot-libraries.cabal b/copilot-libraries/copilot-libraries.cabal index 3402b5296..9b17524f4 100644 --- a/copilot-libraries/copilot-libraries.cabal +++ b/copilot-libraries/copilot-libraries.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-libraries -version: 4.5.1 +version: 4.6 synopsis: Libraries for the Copilot language. description: Libraries for the Copilot language. @@ -41,7 +41,7 @@ library , containers >= 0.4 && < 0.8 , mtl >= 2.0 && < 2.4 , parsec >= 2.0 && < 3.2 - , copilot-language >= 4.5.1 && < 4.6 + , copilot-language >= 4.6 && < 4.7 exposed-modules: Copilot.Library.Libraries From 0233d7ef064bff68a4bca4d29d4df3248739738a Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 7 Nov 2025 22:12:29 -0800 Subject: [PATCH 0996/1222] copilot-verifier: Version bump (4.6). Refs #679. --- copilot-verifier/copilot-verifier.cabal | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/copilot-verifier/copilot-verifier.cabal b/copilot-verifier/copilot-verifier.cabal index 808ac3823..9c6bed8d5 100644 --- a/copilot-verifier/copilot-verifier.cabal +++ b/copilot-verifier/copilot-verifier.cabal @@ -1,6 +1,6 @@ Cabal-version: 2.2 Name: copilot-verifier -Version: 4.5.1 +Version: 4.6 Author: Galois Inc. Maintainer: rscott@galois.com Copyright: (c) Galois, Inc 2021-2024 @@ -45,9 +45,9 @@ common bldflags bv-sized >= 1.0.0 && < 1.1, bytestring, containers >= 0.5.9.0, - copilot-c99 >= 4.5.1 && < 4.6, - copilot-core >= 4.5.1 && < 4.6, - copilot-theorem >= 4.5.1 && < 4.6, + copilot-c99 >= 4.6 && < 4.7, + copilot-core >= 4.6 && < 4.7, + copilot-theorem >= 4.6 && < 4.7, crucible >= 0.7.1 && < 0.8, crucible-llvm >= 0.7 && < 0.8, crux >= 0.7.1 && < 0.8, @@ -80,10 +80,10 @@ library copilot-verifier-examples hs-source-dirs: examples build-depends: case-insensitive, - copilot >= 4.5.1 && < 4.6, - copilot-language >= 4.5.1 && < 4.6, - copilot-libraries >= 4.5.1 && < 4.6, - copilot-prettyprinter >= 4.5.1 && < 4.6, + copilot >= 4.6 && < 4.7, + copilot-language >= 4.6 && < 4.7, + copilot-libraries >= 4.6 && < 4.7, + copilot-prettyprinter >= 4.6 && < 4.7, copilot-verifier exposed-modules: Copilot.Verifier.Examples From e14f76cff149540e9df1d2467b8f47530ac8f19a Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 7 Nov 2025 22:12:29 -0800 Subject: [PATCH 0997/1222] copilot-visualizer: Version bump (4.6). Refs #679. --- copilot-visualizer/copilot-visualizer.cabal | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/copilot-visualizer/copilot-visualizer.cabal b/copilot-visualizer/copilot-visualizer.cabal index c88f26f1f..6afd9070a 100644 --- a/copilot-visualizer/copilot-visualizer.cabal +++ b/copilot-visualizer/copilot-visualizer.cabal @@ -1,6 +1,6 @@ cabal-version: >= 1.10 name: copilot-visualizer -version: 4.5.1 +version: 4.6 synopsis: Visualizer for Copilot. description: Visualizer for Copilot. @@ -65,10 +65,10 @@ library text >= 1.2.3.1 && < 2.2, websockets >= 0.12.7 && < 0.14, - copilot >= 4.5.1 && < 4.6, - copilot-core >= 4.5.1 && < 4.6, - copilot-interpreter >= 4.5.1 && < 4.6, - copilot-language >= 4.5.1 && < 4.6 + copilot >= 4.6 && < 4.7, + copilot-core >= 4.6 && < 4.7, + copilot-interpreter >= 4.6 && < 4.7, + copilot-language >= 4.6 && < 4.7 exposed-modules: @@ -121,7 +121,7 @@ executable tikz-example build-depends: base >= 4.9 && < 5, - copilot >= 4.5.1 && < 4.6, + copilot >= 4.6 && < 4.7, copilot-visualizer if flag(examples) From 46fe80db107aa4267c131e152005ef9ed8f1543c Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 7 Nov 2025 22:12:29 -0800 Subject: [PATCH 0998/1222] copilot: Version bump (4.6). Refs #679. --- copilot/copilot.cabal | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/copilot/copilot.cabal b/copilot/copilot.cabal index a15dd5cf3..f52eecc4e 100644 --- a/copilot/copilot.cabal +++ b/copilot/copilot.cabal @@ -1,5 +1,5 @@ name: copilot -version: 4.5.1 +version: 4.6 cabal-version: >= 1.10 license: BSD3 license-file: LICENSE @@ -52,12 +52,12 @@ library , directory >= 1.3 && < 1.4 , filepath >= 1.4 && < 1.6 - , copilot-core >= 4.5.1 && < 4.6 - , copilot-theorem >= 4.5.1 && < 4.6 - , copilot-language >= 4.5.1 && < 4.6 - , copilot-libraries >= 4.5.1 && < 4.6 - , copilot-c99 >= 4.5.1 && < 4.6 - , copilot-prettyprinter >= 4.5.1 && < 4.6 + , copilot-core >= 4.6 && < 4.7 + , copilot-theorem >= 4.6 && < 4.7 + , copilot-language >= 4.6 && < 4.7 + , copilot-libraries >= 4.6 && < 4.7 + , copilot-c99 >= 4.6 && < 4.7 + , copilot-prettyprinter >= 4.6 && < 4.7 exposed-modules: Language.Copilot, Language.Copilot.Main From c0d4bedeb7facdcaa4c1757f359866b0f5bad900 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 7 Nov 2025 22:13:01 -0800 Subject: [PATCH 0999/1222] copilot-core: Document changes in CHANGELOG. Refs #679. --- copilot-core/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-core/CHANGELOG b/copilot-core/CHANGELOG index 62e89d1ef..b0b94a732 100644 --- a/copilot-core/CHANGELOG +++ b/copilot-core/CHANGELOG @@ -1,3 +1,6 @@ +2025-11-07 + * Version bump (4.6). (#679) + 2025-09-07 * Version bump (4.5.1). (#666) From bc9cf505dfd905599628f89db79e701e3085a44b Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 7 Nov 2025 22:13:01 -0800 Subject: [PATCH 1000/1222] copilot-bluespec: Document changes in CHANGELOG. Refs #679. --- copilot-bluespec/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot-bluespec/CHANGELOG b/copilot-bluespec/CHANGELOG index 17c30d99e..5365300c1 100644 --- a/copilot-bluespec/CHANGELOG +++ b/copilot-bluespec/CHANGELOG @@ -1,4 +1,5 @@ -2025-11-03 +2025-11-07 + * Version bump (4.6). (#679) * Flip direction of interface inputs and outputs in Bluespec. (#677) 2025-09-07 From d3fd856ebd79436ac7cb22a5c8bbe40e7c307ece Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 7 Nov 2025 22:13:01 -0800 Subject: [PATCH 1001/1222] copilot-c99: Document changes in CHANGELOG. Refs #679. --- copilot-c99/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-c99/CHANGELOG b/copilot-c99/CHANGELOG index e5f0b606d..8b7be6866 100644 --- a/copilot-c99/CHANGELOG +++ b/copilot-c99/CHANGELOG @@ -1,3 +1,6 @@ +2025-11-07 + * Version bump (4.6). (#679) + 2025-09-07 * Version bump (4.5.1). (#666) From d6a6578c1de9a32bd1f85d99b011e726a3e81976 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 7 Nov 2025 22:13:01 -0800 Subject: [PATCH 1002/1222] copilot-prettyprinter: Document changes in CHANGELOG. Refs #679. --- copilot-prettyprinter/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-prettyprinter/CHANGELOG b/copilot-prettyprinter/CHANGELOG index 73ca7c5bf..26b0500ad 100644 --- a/copilot-prettyprinter/CHANGELOG +++ b/copilot-prettyprinter/CHANGELOG @@ -1,3 +1,6 @@ +2025-11-07 + * Version bump (4.6). (#679) + 2025-09-07 * Version bump (4.5.1). (#666) From 5fe6665070954cce96796966a0dfaeab8f92cf37 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 7 Nov 2025 22:13:01 -0800 Subject: [PATCH 1003/1222] copilot-interpreter: Document changes in CHANGELOG. Refs #679. --- copilot-interpreter/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-interpreter/CHANGELOG b/copilot-interpreter/CHANGELOG index e819c4162..c6f5b6cbf 100644 --- a/copilot-interpreter/CHANGELOG +++ b/copilot-interpreter/CHANGELOG @@ -1,3 +1,6 @@ +2025-11-07 + * Version bump (4.6). (#679) + 2025-09-07 * Version bump (4.5.1). (#666) From 43e71617bf485f8c0357a36b1e64474ad9e8e70c Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 7 Nov 2025 22:13:01 -0800 Subject: [PATCH 1004/1222] copilot-theorem: Document changes in CHANGELOG. Refs #679. --- copilot-theorem/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-theorem/CHANGELOG b/copilot-theorem/CHANGELOG index 621417e73..463ef02c0 100644 --- a/copilot-theorem/CHANGELOG +++ b/copilot-theorem/CHANGELOG @@ -1,3 +1,6 @@ +2025-11-07 + * Version bump (4.6). (#679) + 2025-09-07 * Version bump (4.5.1). (#666) * Remove unused function Copilot.Theorem.Misc.SExpr.parseSExpr. (#661) From da3de0a79182d300f67df8f34c74ca5c5470efd6 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 7 Nov 2025 22:13:01 -0800 Subject: [PATCH 1005/1222] copilot-language: Document changes in CHANGELOG. Refs #679. --- copilot-language/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-language/CHANGELOG b/copilot-language/CHANGELOG index ed8ebbebb..c22426298 100644 --- a/copilot-language/CHANGELOG +++ b/copilot-language/CHANGELOG @@ -1,3 +1,6 @@ +2025-11-07 + * Version bump (4.6). (#679) + 2025-09-07 * Version bump (4.5.1). (#666) From c3d752f32f6cc5559f0103e59f73c0ed794f66a4 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 7 Nov 2025 22:13:01 -0800 Subject: [PATCH 1006/1222] copilot-libraries: Document changes in CHANGELOG. Refs #679. --- copilot-libraries/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-libraries/CHANGELOG b/copilot-libraries/CHANGELOG index 5d4323d7f..6f6a6a6bd 100644 --- a/copilot-libraries/CHANGELOG +++ b/copilot-libraries/CHANGELOG @@ -1,3 +1,6 @@ +2025-11-07 + * Version bump (4.6). (#679) + 2025-09-07 * Version bump (4.5.1). (#666) From e09c1b44dfb8accee4aedb5d4505bd9a568503fb Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 7 Nov 2025 22:13:01 -0800 Subject: [PATCH 1007/1222] copilot-verifier: Document changes in CHANGELOG. Refs #679. --- copilot-verifier/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-verifier/CHANGELOG b/copilot-verifier/CHANGELOG index e8b89e276..e4b2f9542 100644 --- a/copilot-verifier/CHANGELOG +++ b/copilot-verifier/CHANGELOG @@ -1,3 +1,6 @@ +2025-11-07 + * Version bump (4.6). (#679) + 2025-09-07 * Version bump (4.5.1). (#666) From 17c7ca00d6fc5220e585bf395d238fe84f2a0941 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 7 Nov 2025 22:13:01 -0800 Subject: [PATCH 1008/1222] copilot-visualizer: Document changes in CHANGELOG. Refs #679. --- copilot-visualizer/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-visualizer/CHANGELOG b/copilot-visualizer/CHANGELOG index cf9f151fb..2dbe2a7ae 100644 --- a/copilot-visualizer/CHANGELOG +++ b/copilot-visualizer/CHANGELOG @@ -1,3 +1,6 @@ +2025-11-07 + * Version bump (4.6). (#679) + 2025-09-07 * Version bump (4.5.1). (#666) * Relax version constraint on `ogma-extra`. (#645) From 0c5e4477c917061b2ff11ffae07467eb725bd5d2 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 7 Nov 2025 22:13:01 -0800 Subject: [PATCH 1009/1222] copilot: Document changes in CHANGELOG. Refs #679. --- copilot/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot/CHANGELOG b/copilot/CHANGELOG index 7b69ed049..11069c98a 100644 --- a/copilot/CHANGELOG +++ b/copilot/CHANGELOG @@ -1,3 +1,6 @@ +2025-11-07 + * Version bump (4.6). (#679) + 2025-09-07 * Version bump (4.5.1). (#666) * Add hello world example for FPGA. (#657) From 031223d9cc94453c8cbccd43397b741c0592855d Mon Sep 17 00:00:00 2001 From: Chris Hathhorn Date: Tue, 14 Oct 2025 13:23:49 -0500 Subject: [PATCH 1010/1222] copilot-bluespec: Disable test suite via newly added manual cabal flag. Refs #673. The copilot-bluespec package requires bsc (the Bluespec compiler) to be installed in order to run its test suite, but the builders that Hackage uses to run uploaded packages' test suites do not have bsc installed, causing Hackage to spuriously claim that copilot-bluespec's tests are failing. This commit adds a cabal flag `test-bluespec` intended to enable tests that require the Bluespec compiler (`bsc`) to run. The default behavior of `cabal test` (with no flags) is now to not build the testsuite, preventing spurious test failures from appearing in Hackage reports. To enable building the testsuite, use: `cabal test -f test-bluespec`. --- copilot-bluespec/copilot-bluespec.cabal | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/copilot-bluespec/copilot-bluespec.cabal b/copilot-bluespec/copilot-bluespec.cabal index 975868aca..40ed30938 100644 --- a/copilot-bluespec/copilot-bluespec.cabal +++ b/copilot-bluespec/copilot-bluespec.cabal @@ -34,6 +34,11 @@ source-repository head type: git location: https://github.com/Copilot-Language/copilot-bluespec.git +flag test-bluespec + description: Enable tests that require the Bluespec compiler (bsc) + default: False + manual: True + library default-language : Haskell2010 hs-source-dirs : src @@ -98,3 +103,8 @@ test-suite tests ghc-options: -Wall + + if flag(test-bluespec) + buildable: True + else + buildable: False From 03fc7d4059d762641c8fccc9076533dca626aa63 Mon Sep 17 00:00:00 2001 From: Chris Hathhorn Date: Thu, 4 Dec 2025 15:58:18 -0600 Subject: [PATCH 1011/1222] copilot-bluespec: Document changes in CHANGELOG. Refs #673. --- copilot-bluespec/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-bluespec/CHANGELOG b/copilot-bluespec/CHANGELOG index 5365300c1..931319a86 100644 --- a/copilot-bluespec/CHANGELOG +++ b/copilot-bluespec/CHANGELOG @@ -1,3 +1,6 @@ +2025-12-04 + * Disable test suite via newly added manual cabal flag. (#673) + 2025-11-07 * Version bump (4.6). (#679) * Flip direction of interface inputs and outputs in Bluespec. (#677) From a6f182f4d12e13c610db9318806ce9e6cd6fd62e Mon Sep 17 00:00:00 2001 From: Trevor Kann Date: Fri, 19 Dec 2025 11:06:37 -0500 Subject: [PATCH 1012/1222] copilot-bluespec: Fix translation of constant floating-point values. Refs #696. copilot-bluespec generates syntactically invalid Bluespec code for special floating-point values, such as negative zero, infinity, and NaN values. For instance, it compiles infinity values to Infinity, which is not a valid Bluespec floating-point value. This patch modifies the function (`constFP`) that translates constant floating point values from Copilot to Bluespec so that it correctly handles special cases such as infs, NaNs, and -0.0. --- copilot-bluespec/copilot-bluespec.cabal | 2 + .../src/Copilot/Compile/Bluespec/Expr.hs | 61 +++++++++++++++++-- 2 files changed, 58 insertions(+), 5 deletions(-) diff --git a/copilot-bluespec/copilot-bluespec.cabal b/copilot-bluespec/copilot-bluespec.cabal index 40ed30938..4e1dabc07 100644 --- a/copilot-bluespec/copilot-bluespec.cabal +++ b/copilot-bluespec/copilot-bluespec.cabal @@ -47,6 +47,8 @@ library build-depends : base >= 4.9 && < 5 , directory >= 1.3 && < 1.4 , filepath >= 1.4 && < 1.6 + , fp-ieee >= 0.1.0 && < 0.2 + , ieee754 >= 0.8.0 && < 0.9 , pretty >= 1.1.2 && < 1.2 , copilot-core >= 4.6 && < 4.7 diff --git a/copilot-bluespec/src/Copilot/Compile/Bluespec/Expr.hs b/copilot-bluespec/src/Copilot/Compile/Bluespec/Expr.hs index 7297fad2f..39ff1ad22 100644 --- a/copilot-bluespec/src/Copilot/Compile/Bluespec/Expr.hs +++ b/copilot-bluespec/src/Copilot/Compile/Bluespec/Expr.hs @@ -17,6 +17,8 @@ import Data.Foldable (foldl') import Data.String (IsString (..)) import qualified Language.Bluespec.Classic.AST as BS import qualified Language.Bluespec.Classic.AST.Builtin.Ids as BS +import Numeric.Floating.IEEE.NaN (isSignaling, setPayloadSignaling, setPayload, getPayload) +import GHC.Float (double2Float, castFloatToWord32, castDoubleToWord64) -- Internal imports: Copilot import Copilot.Core @@ -611,14 +613,63 @@ constInt ty i -- | Translate a Copilot floating-point literal into a Bluespec expression. constFP :: Type ty -> Double -> BS.CExpr constFP ty d + -- Bluespec internally represents all IEEE floating-point values as structs + -- so special symbols have to be called for constructing special values, + -- e.g. NaN, inf, and -0.0. See + -- https://github.com/B-Lang-org/bsc/blob/main/src/Libraries/Base3-Math/FloatingPoint.bsv#L441 + | isInfinite d = BS.CApply + (BS.CVar $ BS.mkId BS.NoPos "infinity") + [ if d < 0 + then BS.CCon BS.idTrue [] + else BS.CCon BS.idFalse [] + ] + + | isNaN d = let + cexpr = BS.CHasType + ( BS.CLit $ BS.CLiteral BS.NoPos $ BS.LInt $ + BS.IntLit Nothing 10 cval + ) + ( BS.CQType [] $ BS.TCon $ + BS.TyCon + (BS.mkId BS.NoPos ctype) + Nothing + BS.TIabstract + ) + cval = case ty of + Float -> fromIntegral $ + castFloatToWord32 $ uncastDoubleNaNToFloat d + Double -> fromIntegral $ + castDoubleToWord64 d + _ -> impossible "constFP" "copilot-bluespec" + ctype = case ty of + Float -> "Bit 32" + Double -> "Bit 64" + _ -> impossible "constFP" "copilot-bluespec" + in BS.CApply (BS.CVar $ BS.mkId BS.NoPos "unpack") [cexpr] + | d == 0 = BS.CApply + (BS.CVar $ BS.mkId BS.NoPos "zero") + [ if isNegativeZero d + then BS.CCon BS.idTrue [] + else BS.CCon BS.idFalse [] + ] + | d > 0 = withTypeAnnotation ty $ cLit $ BS.LReal d -- Bluespec intentionally does not support negative literal syntax (e.g., -- -42.5), so we must create negative floating-point literals using the -- `negate` function. - | d >= 0 = withTypeAnnotation ty $ cLit $ BS.LReal d - | otherwise = withTypeAnnotation ty $ - BS.CApply - (BS.CVar $ BS.idNegateAt BS.NoPos) - [cLit $ BS.LReal $ negate d] + | otherwise = withTypeAnnotation ty $ + BS.CApply + (BS.CVar $ BS.idNegateAt BS.NoPos) + [cLit $ BS.LReal $ negate d] + +-- Because NaNs are specially placed as bit-representations by `constfp` and `constfp` requires Doubles as inputs, +-- we need to convert NaN doubles safely into NaN floats. GHC Double2Float does not preserve signal nor payload +-- internals of NaNs so in this case we need a special conversion. +uncastDoubleNaNToFloat :: Double -> Float +uncastDoubleNaNToFloat nan = if (isSignaling nan) + then (setPayloadSignaling payload) + else (setPayload payload) + where + payload = double2Float $ getPayload nan -- | Create a Bluespec expression consisting of a literal. cLit :: BS.Literal -> BS.CExpr From f69f8db70774f78580985797ae6dd67cb864e414 Mon Sep 17 00:00:00 2001 From: Trevor Kann Date: Fri, 19 Dec 2025 14:37:39 -0500 Subject: [PATCH 1013/1222] copilot-bluespec: Document changes in CHANGELOG. Refs #696. --- copilot-bluespec/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot-bluespec/CHANGELOG b/copilot-bluespec/CHANGELOG index 931319a86..168d3ac98 100644 --- a/copilot-bluespec/CHANGELOG +++ b/copilot-bluespec/CHANGELOG @@ -1,5 +1,6 @@ -2025-12-04 +2025-12-19 * Disable test suite via newly added manual cabal flag. (#673) + * Fix translation of constant floating-point values. (#696) 2025-11-07 * Version bump (4.6). (#679) From 4980c6d21dd5aa840a4b78d21286588d56aa6b66 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Wed, 7 Jan 2026 23:30:19 +0000 Subject: [PATCH 1014/1222] copilot-theorem: Relax version constraints on containers, random. Refs #603. In order to keep Copilot effectively working in the current Haskell ecosystem, as well as new versions of GHC, we need to extend the versions of dependencies that Copilot can be installed with. For example, containers has seen release 0.8, but copilot-language, copilot-libraries and copilot-theorem need versions strictly lower than 0.8. The same is true for random, of which we depend on versions prior to 1.3 but version 1.3 has been released. This commit relaxes the version constraints on containers and random for the copilot-theorem package. --- copilot-theorem/copilot-theorem.cabal | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/copilot-theorem/copilot-theorem.cabal b/copilot-theorem/copilot-theorem.cabal index b830f91a6..5ae6a507f 100644 --- a/copilot-theorem/copilot-theorem.cabal +++ b/copilot-theorem/copilot-theorem.cabal @@ -48,7 +48,7 @@ library build-depends : base >= 4.9 && < 5 , bimap (>= 0.3 && < 0.4) || (>= 0.5 && < 0.6) , bv-sized >= 1.0.2 && < 1.1 - , containers >= 0.4 && < 0.8 + , containers >= 0.4 && < 0.9 , data-default >= 0.7 && < 0.9 , directory >= 1.3 && < 1.4 , libBF >= 0.6.2 && < 0.7 @@ -57,7 +57,7 @@ library , parameterized-utils >= 2.1.1 && < 2.2 , pretty >= 1.0 && < 1.2 , process >= 1.6 && < 1.7 - , random >= 1.1 && < 1.3 + , random >= 1.1 && < 1.4 , transformers >= 0.5 && < 0.7 , xml >= 1.3 && < 1.4 , what4 >= 1.3 && < 1.8 From b315eb7d10c90214f7f2e8e9484f4361f5f5c9d2 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Wed, 7 Jan 2026 23:32:47 +0000 Subject: [PATCH 1015/1222] copilot-language: Relax version constraint on containers. Refs #603. In order to keep Copilot effectively working in the current Haskell ecosystem, as well as new versions of GHC, we need to extend the versions of dependencies that Copilot can be installed with. For example, containers has seen release 0.8, but copilot-language, copilot-libraries and copilot-theorem need versions strictly lower than 0.8. The same is true for random, of which we depend on versions prior to 1.3 but version 1.3 has been released. This commit relaxes the version constraint on containers for the copilot-language package. --- copilot-language/copilot-language.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot-language/copilot-language.cabal b/copilot-language/copilot-language.cabal index 543a11770..fac90f5e2 100644 --- a/copilot-language/copilot-language.cabal +++ b/copilot-language/copilot-language.cabal @@ -38,7 +38,7 @@ library build-depends: base >= 4.9 && < 5 , array >= 0.5 && < 0.6 - , containers >= 0.4 && < 0.8 + , containers >= 0.4 && < 0.9 , data-reify >= 0.6 && < 0.7 , mtl >= 2.0 && < 3 From 4721684bd3564aa972e768c785b7c57045dad7d8 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Wed, 7 Jan 2026 23:32:45 +0000 Subject: [PATCH 1016/1222] copilot-libraries: Relax version constraint on containers. Refs #603. In order to keep Copilot effectively working in the current Haskell ecosystem, as well as new versions of GHC, we need to extend the versions of dependencies that Copilot can be installed with. For example, containers has seen release 0.8, but copilot-language, copilot-libraries and copilot-theorem need versions strictly lower than 0.8. The same is true for random, of which we depend on versions prior to 1.3 but version 1.3 has been released. This commit relaxes the version constraint on containers for the copilot-libraries package. --- copilot-libraries/copilot-libraries.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot-libraries/copilot-libraries.cabal b/copilot-libraries/copilot-libraries.cabal index 9b17524f4..70fe91cc8 100644 --- a/copilot-libraries/copilot-libraries.cabal +++ b/copilot-libraries/copilot-libraries.cabal @@ -38,7 +38,7 @@ library build-depends: base >= 4.9 && < 5 - , containers >= 0.4 && < 0.8 + , containers >= 0.4 && < 0.9 , mtl >= 2.0 && < 2.4 , parsec >= 2.0 && < 3.2 , copilot-language >= 4.6 && < 4.7 From ba8668c38f2ce60f521641f3043e2dafcbf1e0c0 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Wed, 7 Jan 2026 23:34:18 +0000 Subject: [PATCH 1017/1222] copilot: Relax version constraint on optparse-applicative. Refs #603. In order to keep Copilot effectively working in the current Haskell ecosystem, as well as new versions of GHC, we need to extend the versions of dependencies that Copilot can be installed with. For example, containers has seen release 0.8, but copilot-language, copilot-libraries and copilot-theorem need versions strictly lower than 0.8. The same is true for random, of which we depend on versions prior to 1.3 but version 1.3 has been released. This commit relaxes the version constraint on optparse-applicative for the copilot package. --- copilot/copilot.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot/copilot.cabal b/copilot/copilot.cabal index f52eecc4e..d9179eb46 100644 --- a/copilot/copilot.cabal +++ b/copilot/copilot.cabal @@ -48,7 +48,7 @@ library -fno-warn-orphans build-depends: base >= 4.9 && < 5 - , optparse-applicative >= 0.14 && < 0.19 + , optparse-applicative >= 0.14 && < 0.20 , directory >= 1.3 && < 1.4 , filepath >= 1.4 && < 1.6 From ecd8a9379c77b209a0a2947530fd7d4e9f977cca Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Wed, 7 Jan 2026 23:34:38 +0000 Subject: [PATCH 1018/1222] copilot-theorem: Document changes in CHANGELOG. Refs #603. --- copilot-theorem/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-theorem/CHANGELOG b/copilot-theorem/CHANGELOG index 463ef02c0..1c12b51d7 100644 --- a/copilot-theorem/CHANGELOG +++ b/copilot-theorem/CHANGELOG @@ -1,3 +1,6 @@ +2026-01-07 + * Relax version constraint on containers, random. (#603) + 2025-11-07 * Version bump (4.6). (#679) From 2d1b722094da6fc27b3b695f9e673191c5ec6104 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Wed, 7 Jan 2026 23:35:28 +0000 Subject: [PATCH 1019/1222] copilot-language: Document changes in CHANGELOG. Refs #603. --- copilot-language/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-language/CHANGELOG b/copilot-language/CHANGELOG index c22426298..d6e10102b 100644 --- a/copilot-language/CHANGELOG +++ b/copilot-language/CHANGELOG @@ -1,3 +1,6 @@ +2026-01-07 + * Relax version constraint on containers. (#603) + 2025-11-07 * Version bump (4.6). (#679) From 3894bac73251f19699148fa15c304d5fc5b869c2 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Wed, 7 Jan 2026 23:35:47 +0000 Subject: [PATCH 1020/1222] copilot-libraries: Document changes in CHANGELOG. Refs #603. --- copilot-libraries/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-libraries/CHANGELOG b/copilot-libraries/CHANGELOG index 6f6a6a6bd..bc67991ff 100644 --- a/copilot-libraries/CHANGELOG +++ b/copilot-libraries/CHANGELOG @@ -1,3 +1,6 @@ +2026-01-07 + * Relax version constraint on containers. (#603) + 2025-11-07 * Version bump (4.6). (#679) From c24a34c88cb1dbaf619ee533717aceaff591f732 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Wed, 7 Jan 2026 23:36:10 +0000 Subject: [PATCH 1021/1222] copilot: Document changes in CHANGELOG. Refs #603. --- copilot/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot/CHANGELOG b/copilot/CHANGELOG index 11069c98a..759fda729 100644 --- a/copilot/CHANGELOG +++ b/copilot/CHANGELOG @@ -1,3 +1,6 @@ +2026-01-07 + * Relax version constraint on optparse-applicative. (#603) + 2025-11-07 * Version bump (4.6). (#679) From 9b80035ba4c91d911320b0d6b3891eeec248edfa Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 8 Jan 2026 00:42:15 +0000 Subject: [PATCH 1022/1222] copilot-core: Version bump (4.6.1). Refs #705. --- copilot-core/copilot-core.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot-core/copilot-core.cabal b/copilot-core/copilot-core.cabal index 6c18d6ca3..336db0f26 100644 --- a/copilot-core/copilot-core.cabal +++ b/copilot-core/copilot-core.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-core -version: 4.6 +version: 4.6.1 synopsis: An intermediate representation for Copilot. description: Intermediate representation for Copilot. From ebc8e6f5885ae8ca78dc48aa7d3dfdeca2cd50e9 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 8 Jan 2026 00:42:15 +0000 Subject: [PATCH 1023/1222] copilot-interpreter: Version bump (4.6.1). Refs #705. --- copilot-interpreter/copilot-interpreter.cabal | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/copilot-interpreter/copilot-interpreter.cabal b/copilot-interpreter/copilot-interpreter.cabal index e8b9fad4f..7395226ab 100644 --- a/copilot-interpreter/copilot-interpreter.cabal +++ b/copilot-interpreter/copilot-interpreter.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-interpreter -version: 4.6 +version: 4.6.1 synopsis: Interpreter for Copilot. description: Interpreter for Copilot. @@ -44,7 +44,7 @@ library base >= 4.9 && < 5, pretty >= 1.0 && < 1.2, - copilot-core >= 4.6 && < 4.7 + copilot-core >= 4.6.1 && < 4.7 exposed-modules: From f151430beb695ecdb18448e132c28750c6a2c76e Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 8 Jan 2026 00:42:15 +0000 Subject: [PATCH 1024/1222] copilot-prettyprinter: Version bump (4.6.1). Refs #705. --- copilot-prettyprinter/copilot-prettyprinter.cabal | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/copilot-prettyprinter/copilot-prettyprinter.cabal b/copilot-prettyprinter/copilot-prettyprinter.cabal index 0f413f63d..b303db95f 100644 --- a/copilot-prettyprinter/copilot-prettyprinter.cabal +++ b/copilot-prettyprinter/copilot-prettyprinter.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-prettyprinter -version: 4.6 +version: 4.6.1 synopsis: A prettyprinter of Copilot Specifications. description: A prettyprinter of Copilot specifications. @@ -45,7 +45,7 @@ library base >= 4.9 && < 5, pretty >= 1.0 && < 1.2, - copilot-core >= 4.6 && < 4.7 + copilot-core >= 4.6.1 && < 4.7 exposed-modules: From 37c261677e01c42a1d01ea07d99c3988ec9bcc5c Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 8 Jan 2026 00:42:38 +0000 Subject: [PATCH 1025/1222] copilot-bluespec: Version bump (4.6.1). Refs #705. --- copilot-bluespec/copilot-bluespec.cabal | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/copilot-bluespec/copilot-bluespec.cabal b/copilot-bluespec/copilot-bluespec.cabal index 4e1dabc07..b727af7fa 100644 --- a/copilot-bluespec/copilot-bluespec.cabal +++ b/copilot-bluespec/copilot-bluespec.cabal @@ -1,6 +1,6 @@ cabal-version : >= 1.10 name : copilot-bluespec -version : 4.6 +version : 4.6.1 synopsis : A compiler for Copilot targeting FPGAs. description : This package is a back-end from Copilot to FPGAs in Bluespec. @@ -51,8 +51,8 @@ library , ieee754 >= 0.8.0 && < 0.9 , pretty >= 1.1.2 && < 1.2 - , copilot-core >= 4.6 && < 4.7 - , language-bluespec >= 0.1 && < 0.2 + , copilot-core >= 4.6.1 && < 4.7 + , language-bluespec >= 0.1 && < 0.2 exposed-modules : Copilot.Compile.Bluespec From bf1135bdc9cb3100612c74262f4f94b9ba7a1570 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 8 Jan 2026 00:42:15 +0000 Subject: [PATCH 1026/1222] copilot-c99: Version bump (4.6.1). Refs #705. --- copilot-c99/copilot-c99.cabal | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/copilot-c99/copilot-c99.cabal b/copilot-c99/copilot-c99.cabal index e5efd5f24..40407cec2 100644 --- a/copilot-c99/copilot-c99.cabal +++ b/copilot-c99/copilot-c99.cabal @@ -1,6 +1,6 @@ cabal-version : >= 1.10 name : copilot-c99 -version : 4.6 +version : 4.6.1 synopsis : A compiler for Copilot targeting C99. description : This package is a back-end from Copilot to C. @@ -45,7 +45,7 @@ library , mtl >= 2.2 && < 2.4 , pretty >= 1.1 && < 1.2 - , copilot-core >= 4.6 && < 4.7 + , copilot-core >= 4.6.1 && < 4.7 , language-c99 >= 0.2.0 && < 0.3 , language-c99-simple >= 0.3 && < 0.4 From abfa7f1ad896e7d266ecc3b1c1ca023b9869dd1e Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 8 Jan 2026 00:42:15 +0000 Subject: [PATCH 1027/1222] copilot-theorem: Version bump (4.6.1). Refs #705. --- copilot-theorem/copilot-theorem.cabal | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/copilot-theorem/copilot-theorem.cabal b/copilot-theorem/copilot-theorem.cabal index 5ae6a507f..173e90eca 100644 --- a/copilot-theorem/copilot-theorem.cabal +++ b/copilot-theorem/copilot-theorem.cabal @@ -14,7 +14,7 @@ description: . -version : 4.6 +version : 4.6.1 license : BSD3 license-file : LICENSE maintainer : Ivan Perez @@ -62,8 +62,8 @@ library , xml >= 1.3 && < 1.4 , what4 >= 1.3 && < 1.8 - , copilot-core >= 4.6 && < 4.7 - , copilot-prettyprinter >= 4.6 && < 4.7 + , copilot-core >= 4.6.1 && < 4.7 + , copilot-prettyprinter >= 4.6.1 && < 4.7 exposed-modules : Copilot.Theorem , Copilot.Theorem.Prove From 5e88c77759e3d39ec4e43893bff49b718322729a Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 8 Jan 2026 00:42:15 +0000 Subject: [PATCH 1028/1222] copilot-language: Version bump (4.6.1). Refs #705. --- copilot-language/copilot-language.cabal | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/copilot-language/copilot-language.cabal b/copilot-language/copilot-language.cabal index fac90f5e2..0b65b5798 100644 --- a/copilot-language/copilot-language.cabal +++ b/copilot-language/copilot-language.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-language -version: 4.6 +version: 4.6.1 synopsis: A Haskell-embedded DSL for monitoring hard real-time distributed systems. description: @@ -42,9 +42,9 @@ library , data-reify >= 0.6 && < 0.7 , mtl >= 2.0 && < 3 - , copilot-core >= 4.6 && < 4.7 - , copilot-interpreter >= 4.6 && < 4.7 - , copilot-theorem >= 4.6 && < 4.7 + , copilot-core >= 4.6.1 && < 4.7 + , copilot-interpreter >= 4.6.1 && < 4.7 + , copilot-theorem >= 4.6.1 && < 4.7 exposed-modules: Copilot.Language , Copilot.Language.Operators.BitWise From e0bae5fcdd3c198561b76b261f2a955c4fbe8f91 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 8 Jan 2026 00:42:15 +0000 Subject: [PATCH 1029/1222] copilot-libraries: Version bump (4.6.1). Refs #705. --- copilot-libraries/copilot-libraries.cabal | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/copilot-libraries/copilot-libraries.cabal b/copilot-libraries/copilot-libraries.cabal index 70fe91cc8..c864c9cda 100644 --- a/copilot-libraries/copilot-libraries.cabal +++ b/copilot-libraries/copilot-libraries.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-libraries -version: 4.6 +version: 4.6.1 synopsis: Libraries for the Copilot language. description: Libraries for the Copilot language. @@ -41,7 +41,7 @@ library , containers >= 0.4 && < 0.9 , mtl >= 2.0 && < 2.4 , parsec >= 2.0 && < 3.2 - , copilot-language >= 4.6 && < 4.7 + , copilot-language >= 4.6.1 && < 4.7 exposed-modules: Copilot.Library.Libraries From 3cd60d0c69fc89e52315be4bc0e0788f767c00d4 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 8 Jan 2026 00:42:38 +0000 Subject: [PATCH 1030/1222] copilot-verifier: Version bump (4.6.1). Refs #705. --- copilot-verifier/copilot-verifier.cabal | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/copilot-verifier/copilot-verifier.cabal b/copilot-verifier/copilot-verifier.cabal index 9c6bed8d5..f77ebfcaf 100644 --- a/copilot-verifier/copilot-verifier.cabal +++ b/copilot-verifier/copilot-verifier.cabal @@ -1,6 +1,6 @@ Cabal-version: 2.2 Name: copilot-verifier -Version: 4.6 +Version: 4.6.1 Author: Galois Inc. Maintainer: rscott@galois.com Copyright: (c) Galois, Inc 2021-2024 @@ -45,9 +45,9 @@ common bldflags bv-sized >= 1.0.0 && < 1.1, bytestring, containers >= 0.5.9.0, - copilot-c99 >= 4.6 && < 4.7, - copilot-core >= 4.6 && < 4.7, - copilot-theorem >= 4.6 && < 4.7, + copilot-c99 >= 4.6.1 && < 4.7, + copilot-core >= 4.6.1 && < 4.7, + copilot-theorem >= 4.6.1 && < 4.7, crucible >= 0.7.1 && < 0.8, crucible-llvm >= 0.7 && < 0.8, crux >= 0.7.1 && < 0.8, @@ -80,10 +80,10 @@ library copilot-verifier-examples hs-source-dirs: examples build-depends: case-insensitive, - copilot >= 4.6 && < 4.7, - copilot-language >= 4.6 && < 4.7, - copilot-libraries >= 4.6 && < 4.7, - copilot-prettyprinter >= 4.6 && < 4.7, + copilot >= 4.6.1 && < 4.7, + copilot-language >= 4.6.1 && < 4.7, + copilot-libraries >= 4.6.1 && < 4.7, + copilot-prettyprinter >= 4.6.1 && < 4.7, copilot-verifier exposed-modules: Copilot.Verifier.Examples From d119ebc92046eade34010753ebfb397ab506d52a Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 8 Jan 2026 00:42:38 +0000 Subject: [PATCH 1031/1222] copilot-visualizer: Version bump (4.6.1). Refs #705. --- copilot-visualizer/copilot-visualizer.cabal | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/copilot-visualizer/copilot-visualizer.cabal b/copilot-visualizer/copilot-visualizer.cabal index 6afd9070a..c481a8d00 100644 --- a/copilot-visualizer/copilot-visualizer.cabal +++ b/copilot-visualizer/copilot-visualizer.cabal @@ -1,6 +1,6 @@ cabal-version: >= 1.10 name: copilot-visualizer -version: 4.6 +version: 4.6.1 synopsis: Visualizer for Copilot. description: Visualizer for Copilot. @@ -65,10 +65,10 @@ library text >= 1.2.3.1 && < 2.2, websockets >= 0.12.7 && < 0.14, - copilot >= 4.6 && < 4.7, - copilot-core >= 4.6 && < 4.7, - copilot-interpreter >= 4.6 && < 4.7, - copilot-language >= 4.6 && < 4.7 + copilot >= 4.6.1 && < 4.7, + copilot-core >= 4.6.1 && < 4.7, + copilot-interpreter >= 4.6.1 && < 4.7, + copilot-language >= 4.6.1 && < 4.7 exposed-modules: @@ -121,7 +121,7 @@ executable tikz-example build-depends: base >= 4.9 && < 5, - copilot >= 4.6 && < 4.7, + copilot >= 4.6.1 && < 4.7, copilot-visualizer if flag(examples) From 1e0f4f0dbeb1f72fa1cfad59e5ab25e8ea09888e Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 8 Jan 2026 00:42:15 +0000 Subject: [PATCH 1032/1222] copilot: Version bump (4.6.1). Refs #705. --- copilot/copilot.cabal | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/copilot/copilot.cabal b/copilot/copilot.cabal index d9179eb46..66304a0f8 100644 --- a/copilot/copilot.cabal +++ b/copilot/copilot.cabal @@ -1,5 +1,5 @@ name: copilot -version: 4.6 +version: 4.6.1 cabal-version: >= 1.10 license: BSD3 license-file: LICENSE @@ -52,12 +52,12 @@ library , directory >= 1.3 && < 1.4 , filepath >= 1.4 && < 1.6 - , copilot-core >= 4.6 && < 4.7 - , copilot-theorem >= 4.6 && < 4.7 - , copilot-language >= 4.6 && < 4.7 - , copilot-libraries >= 4.6 && < 4.7 - , copilot-c99 >= 4.6 && < 4.7 - , copilot-prettyprinter >= 4.6 && < 4.7 + , copilot-core >= 4.6.1 && < 4.7 + , copilot-theorem >= 4.6.1 && < 4.7 + , copilot-language >= 4.6.1 && < 4.7 + , copilot-libraries >= 4.6.1 && < 4.7 + , copilot-c99 >= 4.6.1 && < 4.7 + , copilot-prettyprinter >= 4.6.1 && < 4.7 exposed-modules: Language.Copilot, Language.Copilot.Main From eb078b9b0737e3b63dd1e86120b663d35321622c Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 8 Jan 2026 00:47:38 +0000 Subject: [PATCH 1033/1222] copilot-core: Document changes in CHANGELOG. Refs #705. --- copilot-core/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-core/CHANGELOG b/copilot-core/CHANGELOG index b0b94a732..c00db088a 100644 --- a/copilot-core/CHANGELOG +++ b/copilot-core/CHANGELOG @@ -1,3 +1,6 @@ +2026-01-07 + * Version bump (4.6.1). (#705) + 2025-11-07 * Version bump (4.6). (#679) From 86b8eaf38be1665d0f9057477be4dd390d228d87 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 8 Jan 2026 00:47:38 +0000 Subject: [PATCH 1034/1222] copilot-interpreter: Document changes in CHANGELOG. Refs #705. --- copilot-interpreter/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-interpreter/CHANGELOG b/copilot-interpreter/CHANGELOG index c6f5b6cbf..1827da72f 100644 --- a/copilot-interpreter/CHANGELOG +++ b/copilot-interpreter/CHANGELOG @@ -1,3 +1,6 @@ +2026-01-07 + * Version bump (4.6.1). (#705) + 2025-11-07 * Version bump (4.6). (#679) From bf0230aa301e8e7ac53d2549bb78e85a92306340 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 8 Jan 2026 00:47:38 +0000 Subject: [PATCH 1035/1222] copilot-prettyprinter: Document changes in CHANGELOG. Refs #705. --- copilot-prettyprinter/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-prettyprinter/CHANGELOG b/copilot-prettyprinter/CHANGELOG index 26b0500ad..ed0b61ad9 100644 --- a/copilot-prettyprinter/CHANGELOG +++ b/copilot-prettyprinter/CHANGELOG @@ -1,3 +1,6 @@ +2026-01-07 + * Version bump (4.6.1). (#705) + 2025-11-07 * Version bump (4.6). (#679) From f9116e0d85352c495ab80f8b7c419805d2f154e9 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 8 Jan 2026 00:47:38 +0000 Subject: [PATCH 1036/1222] copilot-bluespec: Document changes in CHANGELOG. Refs #705. --- copilot-bluespec/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot-bluespec/CHANGELOG b/copilot-bluespec/CHANGELOG index 168d3ac98..9235a2a27 100644 --- a/copilot-bluespec/CHANGELOG +++ b/copilot-bluespec/CHANGELOG @@ -1,4 +1,5 @@ -2025-12-19 +2026-01-07 + * Version bump (4.6.1). (#705) * Disable test suite via newly added manual cabal flag. (#673) * Fix translation of constant floating-point values. (#696) From 7b603c8443a6ffc6e7a065d63fe6c163d8fdbce4 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 8 Jan 2026 00:47:38 +0000 Subject: [PATCH 1037/1222] copilot-c99: Document changes in CHANGELOG. Refs #705. --- copilot-c99/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-c99/CHANGELOG b/copilot-c99/CHANGELOG index 8b7be6866..7a2ef8da6 100644 --- a/copilot-c99/CHANGELOG +++ b/copilot-c99/CHANGELOG @@ -1,3 +1,6 @@ +2026-01-07 + * Version bump (4.6.1). (#705) + 2025-11-07 * Version bump (4.6). (#679) From c5ce39c23ffe2b3505b8aa555f89d7a16c98d033 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 8 Jan 2026 00:47:38 +0000 Subject: [PATCH 1038/1222] copilot-theorem: Document changes in CHANGELOG. Refs #705. --- copilot-theorem/CHANGELOG | 1 + 1 file changed, 1 insertion(+) diff --git a/copilot-theorem/CHANGELOG b/copilot-theorem/CHANGELOG index 1c12b51d7..f3dd23d68 100644 --- a/copilot-theorem/CHANGELOG +++ b/copilot-theorem/CHANGELOG @@ -1,4 +1,5 @@ 2026-01-07 + * Version bump (4.6.1). (#705) * Relax version constraint on containers, random. (#603) 2025-11-07 From 4df4f0a79f626bbe6ce57201fcb9ab047db61906 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 8 Jan 2026 00:47:38 +0000 Subject: [PATCH 1039/1222] copilot-language: Document changes in CHANGELOG. Refs #705. --- copilot-language/CHANGELOG | 1 + 1 file changed, 1 insertion(+) diff --git a/copilot-language/CHANGELOG b/copilot-language/CHANGELOG index d6e10102b..eca064537 100644 --- a/copilot-language/CHANGELOG +++ b/copilot-language/CHANGELOG @@ -1,4 +1,5 @@ 2026-01-07 + * Version bump (4.6.1). (#705) * Relax version constraint on containers. (#603) 2025-11-07 From ac295eab915564213978e62251a6ae8afec1eb12 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 8 Jan 2026 00:47:38 +0000 Subject: [PATCH 1040/1222] copilot-libraries: Document changes in CHANGELOG. Refs #705. --- copilot-libraries/CHANGELOG | 1 + 1 file changed, 1 insertion(+) diff --git a/copilot-libraries/CHANGELOG b/copilot-libraries/CHANGELOG index bc67991ff..6ae010b91 100644 --- a/copilot-libraries/CHANGELOG +++ b/copilot-libraries/CHANGELOG @@ -1,4 +1,5 @@ 2026-01-07 + * Version bump (4.6.1). (#705) * Relax version constraint on containers. (#603) 2025-11-07 From e650b743bd33490bd2c96d61b18a2491cc05e3f9 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 8 Jan 2026 00:47:38 +0000 Subject: [PATCH 1041/1222] copilot-verifier: Document changes in CHANGELOG. Refs #705. --- copilot-verifier/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-verifier/CHANGELOG b/copilot-verifier/CHANGELOG index e4b2f9542..ca8740289 100644 --- a/copilot-verifier/CHANGELOG +++ b/copilot-verifier/CHANGELOG @@ -1,3 +1,6 @@ +2026-01-07 + * Version bump (4.6.1). (#705) + 2025-11-07 * Version bump (4.6). (#679) From 2d69e9b62ee33de1672b4f20b3a2806803373239 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 8 Jan 2026 00:47:38 +0000 Subject: [PATCH 1042/1222] copilot-visualizer: Document changes in CHANGELOG. Refs #705. --- copilot-visualizer/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-visualizer/CHANGELOG b/copilot-visualizer/CHANGELOG index 2dbe2a7ae..85bc41739 100644 --- a/copilot-visualizer/CHANGELOG +++ b/copilot-visualizer/CHANGELOG @@ -1,3 +1,6 @@ +2026-01-07 + * Version bump (4.6.1). (#705) + 2025-11-07 * Version bump (4.6). (#679) From 62940d9d984fc37a90becfc573e8ff5f2df10019 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 8 Jan 2026 00:47:38 +0000 Subject: [PATCH 1043/1222] copilot: Document changes in CHANGELOG. Refs #705. --- copilot/CHANGELOG | 1 + 1 file changed, 1 insertion(+) diff --git a/copilot/CHANGELOG b/copilot/CHANGELOG index 759fda729..15678af71 100644 --- a/copilot/CHANGELOG +++ b/copilot/CHANGELOG @@ -1,4 +1,5 @@ 2026-01-07 + * Version bump (4.6.1). (#705) * Relax version constraint on optparse-applicative. (#603) 2025-11-07 From ed06e9754abfe88eb827f03921d8caf342ec3ff6 Mon Sep 17 00:00:00 2001 From: Chris Hathhorn Date: Tue, 14 Oct 2025 13:30:30 -0500 Subject: [PATCH 1044/1222] copilot-c99: Raise error when compiling empty array or struct. Refs #695. Copilot allows defining empty arrays (i.e., values of type Array 0) and empty structs (i.e., structs with no fields), but using empty arrays or structs in C99 is undefined behavior. Moreover, copilot-c99 will often crash if you attempt to compile a Copilot specification that uses an empty array or struct. This commit raises an appropriate error when attempting to translate a zero-length array or a struct with no fields to C99. Previously, Copilot would either crash with a confusing error or silently translate the offending spec to invalid C99. --- copilot-c99/src/Copilot/Compile/C99/Error.hs | 19 ++++++++++++++++++- copilot-c99/src/Copilot/Compile/C99/Expr.hs | 17 +++++++++++++---- copilot-c99/src/Copilot/Compile/C99/Type.hs | 10 +++++++--- 3 files changed, 38 insertions(+), 8 deletions(-) diff --git a/copilot-c99/src/Copilot/Compile/C99/Error.hs b/copilot-c99/src/Copilot/Compile/C99/Error.hs index f42c794de..8ab2de608 100644 --- a/copilot-c99/src/Copilot/Compile/C99/Error.hs +++ b/copilot-c99/src/Copilot/Compile/C99/Error.hs @@ -5,7 +5,10 @@ -- -- Custom functions to report error messages to users. module Copilot.Compile.C99.Error - ( impossible ) + ( impossible + , errorEmptyStruct + , errorZeroLengthArray + ) where -- | Report an error due to a bug in Copilot. @@ -18,3 +21,17 @@ impossible function package = ++ ". Please file an issue at " ++ "https://github.com/Copilot-Language/copilot/issues" ++ " or email the maintainers at " + +-- | Report an error when attempting to compile a zero-length array to C99. +-- C99 does not support zero-length arrays, so Copilot cannot compile +-- specifications that use them. +errorZeroLengthArray :: a +errorZeroLengthArray = + error "copilot-c99: Cannot compile zero-length arrays to C99.\n" + +-- | Report an error when attempting to compile an empty struct to C99. +-- C99 does not support empty structs, so Copilot cannot compile +-- specifications that use them. +errorEmptyStruct :: a +errorEmptyStruct = + error "copilot-c99: Cannot compile empty structs to C99.\n" diff --git a/copilot-c99/src/Copilot/Compile/C99/Expr.hs b/copilot-c99/src/Copilot/Compile/C99/Expr.hs index 14e129be9..fec731fbf 100644 --- a/copilot-c99/src/Copilot/Compile/C99/Expr.hs +++ b/copilot-c99/src/Copilot/Compile/C99/Expr.hs @@ -18,7 +18,7 @@ import Copilot.Core ( Array, Expr (..), Field (..), Op1 (..), Op2 (..), arrayElems, toValues, typeLength, typeSize ) -- Internal imports -import Copilot.Compile.C99.Error ( impossible ) +import Copilot.Compile.C99.Error ( impossible, errorEmptyStruct, errorZeroLengthArray ) import Copilot.Compile.C99.Name ( exCpyName, streamAccessorName ) import Copilot.Compile.C99.Type ( transLocalVarDeclType, transType, transTypeName ) @@ -371,14 +371,23 @@ constFieldInit (Value ty (Field val)) = C.InitItem Nothing $ constInit ty val -- | Transform a Copilot Struct, based on the struct fields, into a list of C99 -- initializer values. +-- +-- Raises an error if the struct is empty, as C99 does not support structs with +-- no fields. constStruct :: [Value a] -> NonEmpty.NonEmpty C.InitItem -constStruct val = NonEmpty.fromList $ map constFieldInit val +constStruct val = case val of + [] -> errorEmptyStruct + _ -> NonEmpty.fromList $ map constFieldInit val -- | Transform a Copilot Array, based on the element values and their type, -- into a list of C99 initializer values. +-- +-- Raises an error if the array is empty, as C99 does not support zero-length +-- arrays. constArray :: Type a -> [a] -> NonEmpty.NonEmpty C.InitItem -constArray ty = - NonEmpty.fromList . map (C.InitItem Nothing . constInit ty) +constArray ty xs = case xs of + [] -> errorZeroLengthArray + _ -> NonEmpty.fromList $ map (C.InitItem Nothing . constInit ty) xs -- | Explicitly cast a C99 value to a type. explicitTy :: Type a -> C.Expr -> C.Expr diff --git a/copilot-c99/src/Copilot/Compile/C99/Type.hs b/copilot-c99/src/Copilot/Compile/C99/Type.hs index 78777617b..525fccea9 100644 --- a/copilot-c99/src/Copilot/Compile/C99/Type.hs +++ b/copilot-c99/src/Copilot/Compile/C99/Type.hs @@ -12,7 +12,9 @@ module Copilot.Compile.C99.Type import qualified Language.C99.Simple as C -- Internal imports: Copilot -import Copilot.Core ( Type (..), typeLength, typeName ) +import Copilot.Core ( Struct (..), Type (..), typeLength, + typeName ) +import Copilot.Compile.C99.Error ( errorEmptyStruct, errorZeroLengthArray ) -- | Translate a Copilot type to a C99 type. transType :: Type a -> C.Type @@ -28,10 +30,12 @@ transType ty = case ty of Word64 -> C.TypeSpec $ C.TypedefName "uint64_t" Float -> C.TypeSpec C.Float Double -> C.TypeSpec C.Double - Array ty' -> C.Array (transType ty') len + Array ty' | typeLength ty == 0 -> errorZeroLengthArray + | otherwise -> C.Array (transType ty') len where len = Just $ C.LitInt $ fromIntegral $ typeLength ty - Struct s -> C.TypeSpec $ C.Struct (typeName s) + Struct s | null (toValues s) -> errorEmptyStruct + | otherwise -> C.TypeSpec $ C.Struct (typeName s) -- | Translate a Copilot type to a valid (local) variable declaration C99 type. -- From dc96eacc8caaa07e298d695dbfe8c5b3f3acce01 Mon Sep 17 00:00:00 2001 From: Chris Hathhorn Date: Mon, 16 Feb 2026 22:21:14 -0600 Subject: [PATCH 1045/1222] copilot-c99: Test for error when compiling empty array or struct. Refs #695. Copilot allows defining empty arrays (i.e., values of type Array 0) and empty structs (i.e., structs with no fields), but using empty arrays or structs in C99 is undefined behavior. Moreover, copilot-c99 will often crash if you attempt to compile a Copilot specification that uses an empty array or struct. A prior commit introduced a solution for this problem that makes the C99 backend detect these undesired struct or array types. This commit adds a test to check that attempting to compile specs containing zero-length arrays or empty structs to C99 raises an appropriate error. --- copilot-c99/tests/Test/Copilot/Compile/C99.hs | 69 ++++++++++++++++++- 1 file changed, 66 insertions(+), 3 deletions(-) diff --git a/copilot-c99/tests/Test/Copilot/Compile/C99.hs b/copilot-c99/tests/Test/Copilot/Compile/C99.hs index 60276e870..b02fc23ae 100644 --- a/copilot-c99/tests/Test/Copilot/Compile/C99.hs +++ b/copilot-c99/tests/Test/Copilot/Compile/C99.hs @@ -8,10 +8,11 @@ module Test.Copilot.Compile.C99 -- External imports import Control.Arrow ((&&&)) -import Control.Exception (IOException, catch) -import Control.Monad (when) +import Control.Exception (ErrorCall (..), IOException, catch, + try) +import Control.Monad (unless, when) import Data.Bits (Bits, complement) -import Data.List (intercalate) +import Data.List (intercalate, isSubsequenceOf) import Data.Type.Equality (testEquality) import Data.Typeable (Proxy (..), (:~:) (Refl)) import GHC.TypeLits (KnownNat, natVal) @@ -24,7 +25,9 @@ import System.Posix.Temp (mkdtemp) import System.Process (callProcess, readProcess) import System.Random (Random) import Test.Framework (Test, testGroup) +import Test.Framework.Providers.HUnit (testCase) import Test.Framework.Providers.QuickCheck2 (testProperty) +import Test.HUnit (Assertion, assertFailure) import Test.QuickCheck (Arbitrary, Gen, Property, arbitrary, choose, elements, forAll, forAllBlind, frequency, @@ -50,6 +53,7 @@ tests = , testProperty "Compile specification in custom dir" testCompileCustomDir , testProperty "Run specification" testRun , testProperty "Run and compare results" testRunCompare + , testCase "Reject empty arrays and structs" testRejectEmpties ] -- * Individual tests @@ -137,6 +141,65 @@ testCompileCustomDir = ioProperty $ do args = [] +data Empty = Empty + +instance Struct Empty where + typeName _ = "" + toValues _ = [] + +instance Typed Empty where + typeOf = Struct Empty + +-- | Test that compiling a spec with an empty array or struct raises an error. +-- C99 does not support zero-length arrays or structs without fields, so Copilot +-- should report an error during compilation. +testRejectEmpties :: Assertion +testRejectEmpties = do + tmpDir <- getTemporaryDirectory + setCurrentDirectory tmpDir + + r1 <- try (compile "copilot_test" $ spec t1) :: IO (Either ErrorCall ()) + unless (isErrZeroArray r1) $ assertFailure "Const zero-length array" + + r2 <- try (compile "copilot_test" $ spec t2) :: IO (Either ErrorCall ()) + unless (isErrZeroArray r2) $ assertFailure "Extern zero-length array" + + r3 <- try (compile "copilot_test" $ spec t3) :: IO (Either ErrorCall ()) + unless (isErrEmptyStruct r3) $ assertFailure "Const empty struct" + + r4 <- try (compile "copilot_test" $ spec t4) :: IO (Either ErrorCall ()) + unless (isErrEmptyStruct r4) $ assertFailure "Extern empty struct" + + where + + spec a = Spec streams observers (triggers a) properties + + streams = [] + observers = [] + triggers a = [ Trigger "trig" (Const Bool True) a ] + properties = [] + + t1 = [ UExpr arrTy (Const arrTy (array [])) ] + t2 = [ UExpr arrTy (ExternVar arrTy "arrs" Nothing) ] + t3 = [ UExpr structTy (Const structTy Empty) ] + t4 = [ UExpr structTy (ExternVar structTy "structs" Nothing) ] + + arrTy :: Type (Array 0 Bool) + arrTy = Array Bool + + structTy :: Type Empty + structTy = Struct Empty + + isErrZeroArray :: Either ErrorCall a -> Bool + isErrZeroArray e = case e of + Left (ErrorCall msg) -> "zero-length array" `isSubsequenceOf` msg + _ -> False + + isErrEmptyStruct :: Either ErrorCall a -> Bool + isErrEmptyStruct e = case e of + Left (ErrorCall msg) -> "empty struct" `isSubsequenceOf` msg + _ -> False + -- | Test compiling a spec and running the resulting program. -- -- The actual behavior is ignored. From a0126958b9899c2c26ae7907aa66a6aad17e6750 Mon Sep 17 00:00:00 2001 From: Chris Hathhorn Date: Mon, 16 Feb 2026 22:28:22 -0600 Subject: [PATCH 1046/1222] copilot-c99: Document changes in CHANGELOG. Refs #695. --- copilot-c99/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-c99/CHANGELOG b/copilot-c99/CHANGELOG index 7a2ef8da6..7e5b7d15d 100644 --- a/copilot-c99/CHANGELOG +++ b/copilot-c99/CHANGELOG @@ -1,3 +1,6 @@ +2026-02-16 + * Raise error when compiling empty arrays or structs. (#695) + 2026-01-07 * Version bump (4.6.1). (#705) From b1e21ae35dcae6fb9fda63e462ae11bd411cec90 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 7 Mar 2026 22:56:55 -0800 Subject: [PATCH 1047/1222] copilot-verifier: Relax version constraints on what4. Refs #716. In order to keep Copilot effectively working in the current Haskell ecosystem, as well as new versions of GHC, we need to extend the versions of dependencies that Copilot can be installed with. For example, ogma-extra has seen release 1.12, but copilot-visualizer needs versions strictly lower than 1.10. This commit relaxes the version constrains on `what4` for the `copilot-verifier` package. --- copilot-verifier/copilot-verifier.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot-verifier/copilot-verifier.cabal b/copilot-verifier/copilot-verifier.cabal index f77ebfcaf..691216ecc 100644 --- a/copilot-verifier/copilot-verifier.cabal +++ b/copilot-verifier/copilot-verifier.cabal @@ -62,7 +62,7 @@ common bldflags text, transformers, vector, - what4 >= 1.6.1 && < 1.7 + what4 >= 1.6.1 && < 1.8 library import: bldflags From e740fdd1e8babf2b1136b603cde4a9361a75b2d4 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 7 Mar 2026 22:57:14 -0800 Subject: [PATCH 1048/1222] copilot-visualizer: Relax version constraints on ogma-extra. Refs #716. In order to keep Copilot effectively working in the current Haskell ecosystem, as well as new versions of GHC, we need to extend the versions of dependencies that Copilot can be installed with. For example, ogma-extra has seen release 1.12, but copilot-visualizer needs versions strictly lower than 1.10. This commit relaxes the version constrains on `ogma-extra` for the `copilot-visualizer` package. --- copilot-visualizer/copilot-visualizer.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot-visualizer/copilot-visualizer.cabal b/copilot-visualizer/copilot-visualizer.cabal index c481a8d00..a8b3b9511 100644 --- a/copilot-visualizer/copilot-visualizer.cabal +++ b/copilot-visualizer/copilot-visualizer.cabal @@ -61,7 +61,7 @@ library filepath >= 1.4.2 && < 1.6, hint >= 0.9.0 && < 1.10, pretty >= 1.0 && < 1.2, - ogma-extra >= 1.6.0 && < 1.10, + ogma-extra >= 1.6.0 && < 1.13, text >= 1.2.3.1 && < 2.2, websockets >= 0.12.7 && < 0.14, From 2fa1c2d93071b941fecd10400b68a36b6a4280e0 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 7 Mar 2026 23:01:07 -0800 Subject: [PATCH 1049/1222] copilot-verifier: Document changes in CHANGELOG. Refs #716. --- copilot-verifier/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-verifier/CHANGELOG b/copilot-verifier/CHANGELOG index ca8740289..ec8c2c738 100644 --- a/copilot-verifier/CHANGELOG +++ b/copilot-verifier/CHANGELOG @@ -1,3 +1,6 @@ +2026-03-07 + * Relax version constraints on what4. (#716) + 2026-01-07 * Version bump (4.6.1). (#705) From e3a02223f273ae89b6616fac7c4ac33994346be8 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 7 Mar 2026 23:01:40 -0800 Subject: [PATCH 1050/1222] copilot-visualizer: Document changes in CHANGELOG. Refs #716. --- copilot-visualizer/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-visualizer/CHANGELOG b/copilot-visualizer/CHANGELOG index 85bc41739..3bbc45cc2 100644 --- a/copilot-visualizer/CHANGELOG +++ b/copilot-visualizer/CHANGELOG @@ -1,3 +1,6 @@ +2026-03-07 + * Relax version constraints on ogma-extra. (#716) + 2026-01-07 * Version bump (4.6.1). (#705) From de96e47d79e1c26ab0424c159d91e235dac337a7 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 7 Mar 2026 19:59:22 -0800 Subject: [PATCH 1051/1222] copilot-core: Version bump (4.7). Refs #714. --- copilot-core/copilot-core.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot-core/copilot-core.cabal b/copilot-core/copilot-core.cabal index 336db0f26..6d99e77d6 100644 --- a/copilot-core/copilot-core.cabal +++ b/copilot-core/copilot-core.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-core -version: 4.6.1 +version: 4.7 synopsis: An intermediate representation for Copilot. description: Intermediate representation for Copilot. From ad0d904a089ac7c5c63d09aead59aab32d3adbda Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 7 Mar 2026 19:59:22 -0800 Subject: [PATCH 1052/1222] copilot-bluespec: Version bump (4.7). Refs #714. --- copilot-bluespec/copilot-bluespec.cabal | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/copilot-bluespec/copilot-bluespec.cabal b/copilot-bluespec/copilot-bluespec.cabal index b727af7fa..3ac0839cf 100644 --- a/copilot-bluespec/copilot-bluespec.cabal +++ b/copilot-bluespec/copilot-bluespec.cabal @@ -1,6 +1,6 @@ cabal-version : >= 1.10 name : copilot-bluespec -version : 4.6.1 +version : 4.7 synopsis : A compiler for Copilot targeting FPGAs. description : This package is a back-end from Copilot to FPGAs in Bluespec. @@ -51,8 +51,8 @@ library , ieee754 >= 0.8.0 && < 0.9 , pretty >= 1.1.2 && < 1.2 - , copilot-core >= 4.6.1 && < 4.7 - , language-bluespec >= 0.1 && < 0.2 + , copilot-core >= 4.7 && < 4.8 + , language-bluespec >= 0.1 && < 0.2 exposed-modules : Copilot.Compile.Bluespec From fb6b1821826bd8f961af141cc391f779f7efcfe8 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 7 Mar 2026 19:59:22 -0800 Subject: [PATCH 1053/1222] copilot-c99: Version bump (4.7). Refs #714. --- copilot-c99/copilot-c99.cabal | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/copilot-c99/copilot-c99.cabal b/copilot-c99/copilot-c99.cabal index 40407cec2..0567e9416 100644 --- a/copilot-c99/copilot-c99.cabal +++ b/copilot-c99/copilot-c99.cabal @@ -1,6 +1,6 @@ cabal-version : >= 1.10 name : copilot-c99 -version : 4.6.1 +version : 4.7 synopsis : A compiler for Copilot targeting C99. description : This package is a back-end from Copilot to C. @@ -45,7 +45,7 @@ library , mtl >= 2.2 && < 2.4 , pretty >= 1.1 && < 1.2 - , copilot-core >= 4.6.1 && < 4.7 + , copilot-core >= 4.7 && < 4.8 , language-c99 >= 0.2.0 && < 0.3 , language-c99-simple >= 0.3 && < 0.4 From 7710ae216956eb372e9a3d667a39d5ac32ffd1e8 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 7 Mar 2026 19:59:22 -0800 Subject: [PATCH 1054/1222] copilot-prettyprinter: Version bump (4.7). Refs #714. --- copilot-prettyprinter/copilot-prettyprinter.cabal | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/copilot-prettyprinter/copilot-prettyprinter.cabal b/copilot-prettyprinter/copilot-prettyprinter.cabal index b303db95f..f6f5fcc57 100644 --- a/copilot-prettyprinter/copilot-prettyprinter.cabal +++ b/copilot-prettyprinter/copilot-prettyprinter.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-prettyprinter -version: 4.6.1 +version: 4.7 synopsis: A prettyprinter of Copilot Specifications. description: A prettyprinter of Copilot specifications. @@ -45,7 +45,7 @@ library base >= 4.9 && < 5, pretty >= 1.0 && < 1.2, - copilot-core >= 4.6.1 && < 4.7 + copilot-core >= 4.7 && < 4.8 exposed-modules: From 750f585d516dfec7bb1ae25c26ce0d3cfe196595 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 7 Mar 2026 19:59:22 -0800 Subject: [PATCH 1055/1222] copilot-interpreter: Version bump (4.7). Refs #714. --- copilot-interpreter/copilot-interpreter.cabal | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/copilot-interpreter/copilot-interpreter.cabal b/copilot-interpreter/copilot-interpreter.cabal index 7395226ab..9ef09f117 100644 --- a/copilot-interpreter/copilot-interpreter.cabal +++ b/copilot-interpreter/copilot-interpreter.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-interpreter -version: 4.6.1 +version: 4.7 synopsis: Interpreter for Copilot. description: Interpreter for Copilot. @@ -44,7 +44,7 @@ library base >= 4.9 && < 5, pretty >= 1.0 && < 1.2, - copilot-core >= 4.6.1 && < 4.7 + copilot-core >= 4.7 && < 4.8 exposed-modules: From 41194365d25a1eac86a3e8cbfdd563f85084dae7 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 7 Mar 2026 19:59:22 -0800 Subject: [PATCH 1056/1222] copilot-theorem: Version bump (4.7). Refs #714. --- copilot-theorem/copilot-theorem.cabal | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/copilot-theorem/copilot-theorem.cabal b/copilot-theorem/copilot-theorem.cabal index 173e90eca..f8b4ff57e 100644 --- a/copilot-theorem/copilot-theorem.cabal +++ b/copilot-theorem/copilot-theorem.cabal @@ -14,7 +14,7 @@ description: . -version : 4.6.1 +version : 4.7 license : BSD3 license-file : LICENSE maintainer : Ivan Perez @@ -62,8 +62,8 @@ library , xml >= 1.3 && < 1.4 , what4 >= 1.3 && < 1.8 - , copilot-core >= 4.6.1 && < 4.7 - , copilot-prettyprinter >= 4.6.1 && < 4.7 + , copilot-core >= 4.7 && < 4.8 + , copilot-prettyprinter >= 4.7 && < 4.8 exposed-modules : Copilot.Theorem , Copilot.Theorem.Prove From 65ef8e6332b2f5bf2ccb2ccbc318ddfda416b060 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 7 Mar 2026 19:59:22 -0800 Subject: [PATCH 1057/1222] copilot-language: Version bump (4.7). Refs #714. --- copilot-language/copilot-language.cabal | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/copilot-language/copilot-language.cabal b/copilot-language/copilot-language.cabal index 0b65b5798..740bb2b8c 100644 --- a/copilot-language/copilot-language.cabal +++ b/copilot-language/copilot-language.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-language -version: 4.6.1 +version: 4.7 synopsis: A Haskell-embedded DSL for monitoring hard real-time distributed systems. description: @@ -42,9 +42,9 @@ library , data-reify >= 0.6 && < 0.7 , mtl >= 2.0 && < 3 - , copilot-core >= 4.6.1 && < 4.7 - , copilot-interpreter >= 4.6.1 && < 4.7 - , copilot-theorem >= 4.6.1 && < 4.7 + , copilot-core >= 4.7 && < 4.8 + , copilot-interpreter >= 4.7 && < 4.8 + , copilot-theorem >= 4.7 && < 4.8 exposed-modules: Copilot.Language , Copilot.Language.Operators.BitWise From 0133c62e635713ec46f19cc04a7d42f6b798128e Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 7 Mar 2026 19:59:22 -0800 Subject: [PATCH 1058/1222] copilot-libraries: Version bump (4.7). Refs #714. --- copilot-libraries/copilot-libraries.cabal | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/copilot-libraries/copilot-libraries.cabal b/copilot-libraries/copilot-libraries.cabal index c864c9cda..e194daf78 100644 --- a/copilot-libraries/copilot-libraries.cabal +++ b/copilot-libraries/copilot-libraries.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-libraries -version: 4.6.1 +version: 4.7 synopsis: Libraries for the Copilot language. description: Libraries for the Copilot language. @@ -38,10 +38,10 @@ library build-depends: base >= 4.9 && < 5 - , containers >= 0.4 && < 0.9 - , mtl >= 2.0 && < 2.4 - , parsec >= 2.0 && < 3.2 - , copilot-language >= 4.6.1 && < 4.7 + , containers >= 0.4 && < 0.9 + , mtl >= 2.0 && < 2.4 + , parsec >= 2.0 && < 3.2 + , copilot-language >= 4.7 && < 4.8 exposed-modules: Copilot.Library.Libraries From 3d9d882fcd9922aa4880d02bfc7b70c36a8cfa41 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 7 Mar 2026 19:59:22 -0800 Subject: [PATCH 1059/1222] copilot-verifier: Version bump (4.7). Refs #714. --- copilot-verifier/copilot-verifier.cabal | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/copilot-verifier/copilot-verifier.cabal b/copilot-verifier/copilot-verifier.cabal index 691216ecc..c7bf36a10 100644 --- a/copilot-verifier/copilot-verifier.cabal +++ b/copilot-verifier/copilot-verifier.cabal @@ -1,6 +1,6 @@ Cabal-version: 2.2 Name: copilot-verifier -Version: 4.6.1 +Version: 4.7 Author: Galois Inc. Maintainer: rscott@galois.com Copyright: (c) Galois, Inc 2021-2024 @@ -45,9 +45,9 @@ common bldflags bv-sized >= 1.0.0 && < 1.1, bytestring, containers >= 0.5.9.0, - copilot-c99 >= 4.6.1 && < 4.7, - copilot-core >= 4.6.1 && < 4.7, - copilot-theorem >= 4.6.1 && < 4.7, + copilot-c99 >= 4.7 && < 4.8, + copilot-core >= 4.7 && < 4.8, + copilot-theorem >= 4.7 && < 4.8, crucible >= 0.7.1 && < 0.8, crucible-llvm >= 0.7 && < 0.8, crux >= 0.7.1 && < 0.8, @@ -80,10 +80,10 @@ library copilot-verifier-examples hs-source-dirs: examples build-depends: case-insensitive, - copilot >= 4.6.1 && < 4.7, - copilot-language >= 4.6.1 && < 4.7, - copilot-libraries >= 4.6.1 && < 4.7, - copilot-prettyprinter >= 4.6.1 && < 4.7, + copilot >= 4.7 && < 4.8, + copilot-language >= 4.7 && < 4.8, + copilot-libraries >= 4.7 && < 4.8, + copilot-prettyprinter >= 4.7 && < 4.8, copilot-verifier exposed-modules: Copilot.Verifier.Examples From c59f73ce7f29c6ab7e420b65f09b0fb41ce47110 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 7 Mar 2026 19:59:22 -0800 Subject: [PATCH 1060/1222] copilot-visualizer: Version bump (4.7). Refs #714. --- copilot-visualizer/copilot-visualizer.cabal | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/copilot-visualizer/copilot-visualizer.cabal b/copilot-visualizer/copilot-visualizer.cabal index a8b3b9511..0500c1b43 100644 --- a/copilot-visualizer/copilot-visualizer.cabal +++ b/copilot-visualizer/copilot-visualizer.cabal @@ -1,6 +1,6 @@ cabal-version: >= 1.10 name: copilot-visualizer -version: 4.6.1 +version: 4.7 synopsis: Visualizer for Copilot. description: Visualizer for Copilot. @@ -65,10 +65,10 @@ library text >= 1.2.3.1 && < 2.2, websockets >= 0.12.7 && < 0.14, - copilot >= 4.6.1 && < 4.7, - copilot-core >= 4.6.1 && < 4.7, - copilot-interpreter >= 4.6.1 && < 4.7, - copilot-language >= 4.6.1 && < 4.7 + copilot >= 4.7 && < 4.8, + copilot-core >= 4.7 && < 4.8, + copilot-interpreter >= 4.7 && < 4.8, + copilot-language >= 4.7 && < 4.8 exposed-modules: @@ -121,7 +121,7 @@ executable tikz-example build-depends: base >= 4.9 && < 5, - copilot >= 4.6.1 && < 4.7, + copilot >= 4.7 && < 4.8, copilot-visualizer if flag(examples) From ff624408e746be0de496c4bd8b95d8976b909744 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 7 Mar 2026 19:59:22 -0800 Subject: [PATCH 1061/1222] copilot: Version bump (4.7). Refs #714. --- copilot/copilot.cabal | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/copilot/copilot.cabal b/copilot/copilot.cabal index 66304a0f8..68ff811ec 100644 --- a/copilot/copilot.cabal +++ b/copilot/copilot.cabal @@ -1,5 +1,5 @@ name: copilot -version: 4.6.1 +version: 4.7 cabal-version: >= 1.10 license: BSD3 license-file: LICENSE @@ -52,12 +52,12 @@ library , directory >= 1.3 && < 1.4 , filepath >= 1.4 && < 1.6 - , copilot-core >= 4.6.1 && < 4.7 - , copilot-theorem >= 4.6.1 && < 4.7 - , copilot-language >= 4.6.1 && < 4.7 - , copilot-libraries >= 4.6.1 && < 4.7 - , copilot-c99 >= 4.6.1 && < 4.7 - , copilot-prettyprinter >= 4.6.1 && < 4.7 + , copilot-core >= 4.7 && < 4.8 + , copilot-theorem >= 4.7 && < 4.8 + , copilot-language >= 4.7 && < 4.8 + , copilot-libraries >= 4.7 && < 4.8 + , copilot-c99 >= 4.7 && < 4.8 + , copilot-prettyprinter >= 4.7 && < 4.8 exposed-modules: Language.Copilot, Language.Copilot.Main From 58a46b16c9aa34e452f2b5e1d732aff17aa8f87f Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 7 Mar 2026 20:00:57 -0800 Subject: [PATCH 1062/1222] copilot-core: Document changes in CHANGELOG. Refs #714. --- copilot-core/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-core/CHANGELOG b/copilot-core/CHANGELOG index c00db088a..671e39ef6 100644 --- a/copilot-core/CHANGELOG +++ b/copilot-core/CHANGELOG @@ -1,3 +1,6 @@ +2026-03-07 + * Version bump (4.7). (#714) + 2026-01-07 * Version bump (4.6.1). (#705) From 1da71446819d71af33b469a9d1475500e3125231 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 7 Mar 2026 20:00:57 -0800 Subject: [PATCH 1063/1222] copilot-bluespec: Document changes in CHANGELOG. Refs #714. --- copilot-bluespec/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-bluespec/CHANGELOG b/copilot-bluespec/CHANGELOG index 9235a2a27..9072a0a43 100644 --- a/copilot-bluespec/CHANGELOG +++ b/copilot-bluespec/CHANGELOG @@ -1,3 +1,6 @@ +2026-03-07 + * Version bump (4.7). (#714) + 2026-01-07 * Version bump (4.6.1). (#705) * Disable test suite via newly added manual cabal flag. (#673) From 186daf5724c48f38100d9efbaaf5dd1dbafa816f Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 7 Mar 2026 20:00:57 -0800 Subject: [PATCH 1064/1222] copilot-c99: Document changes in CHANGELOG. Refs #714. --- copilot-c99/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot-c99/CHANGELOG b/copilot-c99/CHANGELOG index 7e5b7d15d..856d51497 100644 --- a/copilot-c99/CHANGELOG +++ b/copilot-c99/CHANGELOG @@ -1,4 +1,5 @@ -2026-02-16 +2026-03-07 + * Version bump (4.7). (#714) * Raise error when compiling empty arrays or structs. (#695) 2026-01-07 From 3149bcc1ab290f0281fc23bb23367aec974793fd Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 7 Mar 2026 20:00:57 -0800 Subject: [PATCH 1065/1222] copilot-prettyprinter: Document changes in CHANGELOG. Refs #714. --- copilot-prettyprinter/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-prettyprinter/CHANGELOG b/copilot-prettyprinter/CHANGELOG index ed0b61ad9..efa6ccf51 100644 --- a/copilot-prettyprinter/CHANGELOG +++ b/copilot-prettyprinter/CHANGELOG @@ -1,3 +1,6 @@ +2026-03-07 + * Version bump (4.7). (#714) + 2026-01-07 * Version bump (4.6.1). (#705) From e5b1bc27c302d663b5ebb94e2f76ab675b6311df Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 7 Mar 2026 20:00:57 -0800 Subject: [PATCH 1066/1222] copilot-interpreter: Document changes in CHANGELOG. Refs #714. --- copilot-interpreter/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-interpreter/CHANGELOG b/copilot-interpreter/CHANGELOG index 1827da72f..c2920d179 100644 --- a/copilot-interpreter/CHANGELOG +++ b/copilot-interpreter/CHANGELOG @@ -1,3 +1,6 @@ +2026-03-07 + * Version bump (4.7). (#714) + 2026-01-07 * Version bump (4.6.1). (#705) From 0ee707328bf1b4996208af713931b08a503fc913 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 7 Mar 2026 20:00:57 -0800 Subject: [PATCH 1067/1222] copilot-theorem: Document changes in CHANGELOG. Refs #714. --- copilot-theorem/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-theorem/CHANGELOG b/copilot-theorem/CHANGELOG index f3dd23d68..4aaf2cf97 100644 --- a/copilot-theorem/CHANGELOG +++ b/copilot-theorem/CHANGELOG @@ -1,3 +1,6 @@ +2026-03-07 + * Version bump (4.7). (#714) + 2026-01-07 * Version bump (4.6.1). (#705) * Relax version constraint on containers, random. (#603) From 680467e4a8a74a33c169b421801ddbe5b23f6259 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 7 Mar 2026 20:00:57 -0800 Subject: [PATCH 1068/1222] copilot-language: Document changes in CHANGELOG. Refs #714. --- copilot-language/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-language/CHANGELOG b/copilot-language/CHANGELOG index eca064537..4751f7061 100644 --- a/copilot-language/CHANGELOG +++ b/copilot-language/CHANGELOG @@ -1,3 +1,6 @@ +2026-03-07 + * Version bump (4.7). (#714) + 2026-01-07 * Version bump (4.6.1). (#705) * Relax version constraint on containers. (#603) From 9d3605a597bcdf130d3f9ec291681d21a2dcc2a5 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 7 Mar 2026 20:00:57 -0800 Subject: [PATCH 1069/1222] copilot-libraries: Document changes in CHANGELOG. Refs #714. --- copilot-libraries/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-libraries/CHANGELOG b/copilot-libraries/CHANGELOG index 6ae010b91..171b9b7d7 100644 --- a/copilot-libraries/CHANGELOG +++ b/copilot-libraries/CHANGELOG @@ -1,3 +1,6 @@ +2026-03-07 + * Version bump (4.7). (#714) + 2026-01-07 * Version bump (4.6.1). (#705) * Relax version constraint on containers. (#603) From 7d651deafe18dec7f88516040e91841f16df010a Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 7 Mar 2026 20:00:57 -0800 Subject: [PATCH 1070/1222] copilot-verifier: Document changes in CHANGELOG. Refs #714. --- copilot-verifier/CHANGELOG | 1 + 1 file changed, 1 insertion(+) diff --git a/copilot-verifier/CHANGELOG b/copilot-verifier/CHANGELOG index ec8c2c738..049ec2243 100644 --- a/copilot-verifier/CHANGELOG +++ b/copilot-verifier/CHANGELOG @@ -1,4 +1,5 @@ 2026-03-07 + * Version bump (4.7). (#714) * Relax version constraints on what4. (#716) 2026-01-07 From b4f0c279c1a6b5f288f865d830303fd37ca7a58f Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 7 Mar 2026 20:00:57 -0800 Subject: [PATCH 1071/1222] copilot-visualizer: Document changes in CHANGELOG. Refs #714. --- copilot-visualizer/CHANGELOG | 1 + 1 file changed, 1 insertion(+) diff --git a/copilot-visualizer/CHANGELOG b/copilot-visualizer/CHANGELOG index 3bbc45cc2..402ec34d5 100644 --- a/copilot-visualizer/CHANGELOG +++ b/copilot-visualizer/CHANGELOG @@ -1,4 +1,5 @@ 2026-03-07 + * Version bump (4.7). (#714) * Relax version constraints on ogma-extra. (#716) 2026-01-07 From cdbcdac2f56db48cac22ee0ef225b0396c2a4929 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 7 Mar 2026 20:00:57 -0800 Subject: [PATCH 1072/1222] copilot: Document changes in CHANGELOG. Refs #714. --- copilot/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot/CHANGELOG b/copilot/CHANGELOG index 15678af71..dd34bc70f 100644 --- a/copilot/CHANGELOG +++ b/copilot/CHANGELOG @@ -1,3 +1,6 @@ +2026-03-07 + * Version bump (4.7). (#714) + 2026-01-07 * Version bump (4.6.1). (#705) * Relax version constraint on optparse-applicative. (#603) From 9743faef83ea8d04722c1a215410b71968ab3340 Mon Sep 17 00:00:00 2001 From: Trevor Kann Date: Fri, 19 Dec 2025 12:06:37 -0500 Subject: [PATCH 1073/1222] copilot-bluespec: Fix translation of special Float values to Bluespec. Refs #697. `copilot-bluespec`'s translation from Copilot to Bluespec up-casts `Float` values to `Double` values using the `realToFrac` function. `realToFrac` incorrectly handles special floating-point values such as negative zero, infinity, and NaN values, causing `copilot-bluespec` to generate the wrong `Float` values on the Bluespec end. This commit removes the use of `realToFrac` in favor of an alternative approach based on `GHC.Float.float2Double`, which correctly handles most special floating-point values. A notable exception is NaN values, as `float2Double` does not reliably preserve the payload of a NaN value. As such, we include a special case for NaN values that takes care to preserve payloads. Co-authored-by: Ryan Scott --- .../src/Copilot/Compile/Bluespec/Expr.hs | 18 ++++++++++++++++-- 1 file changed, 16 insertions(+), 2 deletions(-) diff --git a/copilot-bluespec/src/Copilot/Compile/Bluespec/Expr.hs b/copilot-bluespec/src/Copilot/Compile/Bluespec/Expr.hs index 39ff1ad22..2b71b3957 100644 --- a/copilot-bluespec/src/Copilot/Compile/Bluespec/Expr.hs +++ b/copilot-bluespec/src/Copilot/Compile/Bluespec/Expr.hs @@ -18,7 +18,7 @@ import Data.String (IsString (..)) import qualified Language.Bluespec.Classic.AST as BS import qualified Language.Bluespec.Classic.AST.Builtin.Ids as BS import Numeric.Floating.IEEE.NaN (isSignaling, setPayloadSignaling, setPayload, getPayload) -import GHC.Float (double2Float, castFloatToWord32, castDoubleToWord64) +import GHC.Float (double2Float, castFloatToWord32, castDoubleToWord64, float2Double) -- Internal imports: Copilot import Copilot.Core @@ -535,7 +535,7 @@ constTy ty = Word16 -> constInt ty . toInteger Word32 -> constInt ty . toInteger Word64 -> constInt ty . toInteger - Float -> constFP ty . realToFrac + Float -> constFP ty . nanSafeFloat2Double Double -> constFP ty -- Translating a Copilot array literal to a Bluespec Vector is somewhat @@ -563,6 +563,20 @@ constTy ty = , constTy ty'' val )) (toValues v)) + where + -- Convert a Float to a Double. This function takes care to preserve + -- special floating-point values, such as negative zero, infinity, and NaN + -- values. + nanSafeFloat2Double :: Float -> Double + nanSafeFloat2Double x + -- float2Double does not preserve the payloads of NaN values, so we + -- include special cases for translating NaNs. + | isNaN x && isSignaling x = setPayloadSignaling payload + | isNaN x = setPayload payload + | otherwise = float2Double x + where + payload :: Double + payload = float2Double $ getPayload x -- | Transform a list of Copilot Core expressions of a given 'Type' into a -- Bluespec @Vector@ expression. From caafd778b32a0ca2ed6638daee8e008f403a6261 Mon Sep 17 00:00:00 2001 From: Trevor Kann Date: Fri, 19 Dec 2025 14:23:42 -0500 Subject: [PATCH 1074/1222] copilot-theorem: Handle special Float values correctly for counterexamples. Refs #697. `copilot-theorem`'s counterexample-reporting machinery up-casts `Float` values to `Double` values using the `realToFrac` function. `realToFrac` incorrectly handles special floating-point values such as negative zero, infinity, and NaN values, causing `copilot-theorem` to generate incorrect counterexamples when these special values are involved. This commit removes the use of `realToFrac` in favor of an alternative approach based on `GHC.Float.double2Float`, which correctly handles most special floating-point values. A notable exception is NaN values, as `double2Float` does not reliably preserve the payload of a NaN value. As such, we include a special case for NaN values that takes care to preserve payloads. Co-authored-by: Ryan Scott --- copilot-theorem/copilot-theorem.cabal | 1 + copilot-theorem/src/Copilot/Theorem/What4.hs | 19 +++++++++++++++++-- 2 files changed, 18 insertions(+), 2 deletions(-) diff --git a/copilot-theorem/copilot-theorem.cabal b/copilot-theorem/copilot-theorem.cabal index f8b4ff57e..87f53807f 100644 --- a/copilot-theorem/copilot-theorem.cabal +++ b/copilot-theorem/copilot-theorem.cabal @@ -51,6 +51,7 @@ library , containers >= 0.4 && < 0.9 , data-default >= 0.7 && < 0.9 , directory >= 1.3 && < 1.4 + , fp-ieee >= 0.1 && < 0.2 , libBF >= 0.6.2 && < 0.7 , mtl >= 2.0 && < 2.4 , panic >= 0.4.0 && < 0.5 diff --git a/copilot-theorem/src/Copilot/Theorem/What4.hs b/copilot-theorem/src/Copilot/Theorem/What4.hs index 51ed6e8ff..97e55a852 100644 --- a/copilot-theorem/src/Copilot/Theorem/What4.hs +++ b/copilot-theorem/src/Copilot/Theorem/What4.hs @@ -77,8 +77,9 @@ import Data.Parameterized.NatRepr import Data.Parameterized.Nonce import Data.Parameterized.Some import qualified Data.Parameterized.Vector as V -import GHC.Float (castWord32ToFloat, castWord64ToDouble) +import GHC.Float (castWord32ToFloat, castWord64ToDouble, double2Float) import LibBF (BigFloat, bfToDouble, pattern NearEven) +import Numeric.Floating.IEEE.NaN (getPayload, isSignaling, setPayload, setPayloadSignaling) import qualified Panic as Panic import Copilot.Theorem.What4.Translate @@ -707,7 +708,7 @@ valFromExpr ge xe = case xe of XFloat e -> Some . CopilotValue CT.Float <$> iFloatGroundEval WFP.SingleFloatRepr e - (realToFrac . fst . bfToDouble NearEven) + (nanSafeDoubleToFloat . fst . bfToDouble NearEven) fromRational (castWord32ToFloat . fromInteger . BV.asUnsigned) XDouble e -> @@ -757,3 +758,17 @@ valFromExpr ge xe = case xe of WB.FloatIEEERepr -> ieeeK <$> WG.groundEval ge e WB.FloatRealRepr -> realK <$> WG.groundEval ge e WB.FloatUninterpretedRepr -> uninterpK <$> WG.groundEval ge e + + -- Convert a Double to a Float. This function takes care to preserve + -- special floating-point values, such as negative zero, infinity, and NaN + -- values. + nanSafeDoubleToFloat :: Double -> Float + nanSafeDoubleToFloat x + -- double2Float does not preserve the payloads of NaN values, so we + -- include a special case for translating NaNs. + | isNaN x && isSignaling x = setPayloadSignaling payload + | isNaN x = setPayload payload + | otherwise = double2Float x + where + payload :: Float + payload = double2Float $ getPayload x From b2d81f6b64ffcb6a0e5e445736c7a8aae36f1f5d Mon Sep 17 00:00:00 2001 From: Trevor Kann Date: Tue, 31 Mar 2026 09:53:19 -0400 Subject: [PATCH 1075/1222] copilot-bluespec: Document changes in CHANGELOG. Refs #697. Co-authored-by: Ryan Scott --- copilot-bluespec/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-bluespec/CHANGELOG b/copilot-bluespec/CHANGELOG index 9072a0a43..c0ab51bc1 100644 --- a/copilot-bluespec/CHANGELOG +++ b/copilot-bluespec/CHANGELOG @@ -1,3 +1,6 @@ +2026-03-31 + * Fix translation of special Float values to Bluespec. (#697) + 2026-03-07 * Version bump (4.7). (#714) From 6e2fed247bbf8b1a878306b8c0227c3629266ffb Mon Sep 17 00:00:00 2001 From: Trevor Kann Date: Tue, 31 Mar 2026 09:56:01 -0400 Subject: [PATCH 1076/1222] copilot-theorem: Document changes in CHANGELOG. Refs #697. Co-authored-by: Ryan Scott --- copilot-theorem/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-theorem/CHANGELOG b/copilot-theorem/CHANGELOG index 4aaf2cf97..2f521a853 100644 --- a/copilot-theorem/CHANGELOG +++ b/copilot-theorem/CHANGELOG @@ -1,3 +1,6 @@ +2026-03-31 + * Handle special Float values correctly for counterexamples. (#697) + 2026-03-07 * Version bump (4.7). (#714) From c854b5ff70a1ef99bf34137a186fe63a6ad5eb6a Mon Sep 17 00:00:00 2001 From: Chris Hathhorn Date: Tue, 31 Mar 2026 11:46:52 -0500 Subject: [PATCH 1077/1222] copilot-theorem: Update examples to compile with copilot-theorem >= 3.0. Refs #692. Some example programs in the copilot-theorem/example subdirectory have bitrotted, as they depend on a Copilot.Theorem.Prover.Z3 module that is no longer included in copilot-theorem.cabal (as of 6a67d89). Attempting to build any of these examples results in compilation failures. This commit fixes the examples so they will compile using the current version of copilot-theorem. --- copilot-theorem/examples/BoyerMoore.hs | 4 ++-- copilot-theorem/examples/Grey.hs | 6 +++--- copilot-theorem/examples/Incr.hs | 4 ++-- copilot-theorem/examples/SerialBoyerMoore.hs | 6 +++--- copilot-theorem/examples/SphericalWCV.hs | 6 +++--- copilot-theorem/examples/WCV.hs | 6 +++--- 6 files changed, 16 insertions(+), 16 deletions(-) diff --git a/copilot-theorem/examples/BoyerMoore.hs b/copilot-theorem/examples/BoyerMoore.hs index d4cebf638..47fe790af 100644 --- a/copilot-theorem/examples/BoyerMoore.hs +++ b/copilot-theorem/examples/BoyerMoore.hs @@ -5,7 +5,7 @@ module BoyerMoore where import Copilot.Language hiding (length) import Copilot.Theorem -import Copilot.Theorem.Prover.Z3 +import Copilot.Theorem.Prover.SMT (debug, def, induction, z3) import Copilot.Core.Type @@ -71,7 +71,7 @@ spec = do maj = majorityVote ss induct :: Proof Universal -induct = induction def { nraNLSat = False, debug = False } +induct = induction def { debug = False } z3 -- | Initial value for a given type. -- diff --git a/copilot-theorem/examples/Grey.hs b/copilot-theorem/examples/Grey.hs index 9a1ca4319..91500ba1a 100644 --- a/copilot-theorem/examples/Grey.hs +++ b/copilot-theorem/examples/Grey.hs @@ -4,7 +4,7 @@ module Grey where import Copilot.Language import Copilot.Theorem -import Copilot.Theorem.Prover.Z3 +import Copilot.Theorem.Prover.SMT (Options (..), def, induction, kInduction, z3) import Prelude () import Data.String (fromString) @@ -32,7 +32,7 @@ spec = do r = extern "reset" Nothing induct :: Proof Universal -induct = induction def { nraNLSat = False, debug = False } +induct = induction def { debug = False } z3 kinduct :: Word32 -> Proof Universal -kinduct k = kInduction def { nraNLSat = False, startK = k, maxK = k, debug = False } +kinduct k = kInduction def { startK = k, maxK = k, debug = False } z3 diff --git a/copilot-theorem/examples/Incr.hs b/copilot-theorem/examples/Incr.hs index 3c39a008d..dd6ccdc42 100644 --- a/copilot-theorem/examples/Incr.hs +++ b/copilot-theorem/examples/Incr.hs @@ -4,7 +4,7 @@ import Prelude () import Copilot.Language import Copilot.Theorem -import Copilot.Theorem.Prover.Z3 +import Copilot.Theorem.Prover.SMT (debug, def, induction, z3) spec = do bounds <- prop "bounds" (forAll $ x < 255) @@ -16,4 +16,4 @@ spec = do x = [2] ++ (1 + x) induct :: Proof Universal -induct = induction def { nraNLSat = False, debug = True } +induct = induction def { debug = True } z3 diff --git a/copilot-theorem/examples/SerialBoyerMoore.hs b/copilot-theorem/examples/SerialBoyerMoore.hs index 5f0d42092..eb858a6a6 100644 --- a/copilot-theorem/examples/SerialBoyerMoore.hs +++ b/copilot-theorem/examples/SerialBoyerMoore.hs @@ -4,7 +4,7 @@ module SerialBoyerMoore where import Copilot.Language import Copilot.Theorem -import Copilot.Theorem.Prover.Z3 +import Copilot.Theorem.Prover.SMT (Options (..), def, induction, kInduction, z3) import Prelude () import Data.String (fromString) @@ -56,7 +56,7 @@ spec = do (p, s, j) = majority input induct :: Proof Universal -induct = induction def { nraNLSat = False, debug = False } +induct = induction def { debug = False } z3 kinduct :: Word32 -> Proof Universal -kinduct k = kInduction def { nraNLSat = False, startK = k, maxK = k, debug = False } +kinduct k = kInduction def { startK = k, maxK = k, debug = False } z3 diff --git a/copilot-theorem/examples/SphericalWCV.hs b/copilot-theorem/examples/SphericalWCV.hs index 74b899583..06d203adf 100644 --- a/copilot-theorem/examples/SphericalWCV.hs +++ b/copilot-theorem/examples/SphericalWCV.hs @@ -8,7 +8,7 @@ import Prelude () import Copilot.Language import Copilot.Language.Reify import Copilot.Theorem -import Copilot.Theorem.Prover.Z3 +import Copilot.Theorem.Prover.SMT (debug, def, onlySat, onlyValidity, z3) import qualified Copilot.Language.Operators.Propositional as P @@ -241,7 +241,7 @@ localConvexity = do theorem "6" (P.not (forAll $ locallyConvex tau)) arithSat arith :: Proof Universal -arith = onlyValidity def { nraNLSat = True, debug = False } +arith = onlyValidity def { debug = False } z3 arithSat :: Proof Existential -arithSat = onlySat def { nraNLSat = True, debug = False } +arithSat = onlySat def { debug = False } z3 diff --git a/copilot-theorem/examples/WCV.hs b/copilot-theorem/examples/WCV.hs index 62c27f287..c0f267c68 100644 --- a/copilot-theorem/examples/WCV.hs +++ b/copilot-theorem/examples/WCV.hs @@ -5,7 +5,7 @@ import Prelude () import Copilot.Language import Copilot.Language.Reify import Copilot.Theorem -import Copilot.Theorem.Prover.Z3 +import Copilot.Theorem.Prover.SMT (debug, def, onlySat, onlyValidity, z3) import qualified Copilot.Language.Operators.Propositional as P @@ -165,7 +165,7 @@ localConvexity = do theorem "6" (P.not (forAll $ locallyConvex tau)) arithSat arith :: Proof Universal -arith = onlyValidity def { nraNLSat = True, debug = False } +arith = onlyValidity def { debug = False } z3 arithSat :: Proof Existential -arithSat = onlySat def { nraNLSat = True, debug = False } +arithSat = onlySat def { debug = False } z3 From 579b124a56146f563e620ca9df5d9b1c70640a84 Mon Sep 17 00:00:00 2001 From: Chris Hathhorn Date: Tue, 31 Mar 2026 12:31:53 -0500 Subject: [PATCH 1078/1222] copilot-theorem: Document changes in CHANGELOG. Refs #692. --- copilot-theorem/CHANGELOG | 1 + 1 file changed, 1 insertion(+) diff --git a/copilot-theorem/CHANGELOG b/copilot-theorem/CHANGELOG index 2f521a853..909643531 100644 --- a/copilot-theorem/CHANGELOG +++ b/copilot-theorem/CHANGELOG @@ -1,5 +1,6 @@ 2026-03-31 * Handle special Float values correctly for counterexamples. (#697) + * Update examples to compile with copilot-theorem >= 3.0. (#692) 2026-03-07 * Version bump (4.7). (#714) From a4126bbed39662575daf0fd4ecdca80ce7476ffb Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 18 May 2025 04:45:39 +0000 Subject: [PATCH 1079/1222] copilot-libraries: Add stream analysis module. Refs #726. There is a need to have in Copilot a module that includes stream and spec analysis functions. Such functions have been useful in other projects, and they could be added as part of Copilot's standard library so that they are available to all users. This commit adds a new module that provides functions to determine if a stream is always true or always false. --- copilot-libraries/copilot-libraries.cabal | 3 ++- .../src/Copilot/Library/Analysis.hs | 23 +++++++++++++++++++ 2 files changed, 25 insertions(+), 1 deletion(-) create mode 100644 copilot-libraries/src/Copilot/Library/Analysis.hs diff --git a/copilot-libraries/copilot-libraries.cabal b/copilot-libraries/copilot-libraries.cabal index e194daf78..145887314 100644 --- a/copilot-libraries/copilot-libraries.cabal +++ b/copilot-libraries/copilot-libraries.cabal @@ -44,7 +44,8 @@ library , copilot-language >= 4.7 && < 4.8 exposed-modules: - Copilot.Library.Libraries + Copilot.Library.Analysis + , Copilot.Library.Libraries , Copilot.Library.Clocks , Copilot.Library.LTL , Copilot.Library.PTLTL diff --git a/copilot-libraries/src/Copilot/Library/Analysis.hs b/copilot-libraries/src/Copilot/Library/Analysis.hs new file mode 100644 index 000000000..240addd7c --- /dev/null +++ b/copilot-libraries/src/Copilot/Library/Analysis.hs @@ -0,0 +1,23 @@ +-- | Formally analyze streams. +module Copilot.Library.Analysis + ( triviallyTrue + , triviallyFalse + ) + where + +-- External imports. +import Prelude hiding (not) + +-- Internal imports. +import Copilot.Language (Stream, forAll, not) +import Copilot.Language.Spec (Prop, Universal) + +-- | Property that captures whether a stream is trivially true, meaning that +-- there is no way to make it false. +triviallyTrue :: Stream Bool -> Prop Universal +triviallyTrue = forAll + +-- | Property that captures whether a stream is trivially false, meaning that +-- there is no way to make it true. +triviallyFalse :: Stream Bool -> Prop Universal +triviallyFalse = triviallyTrue . not From fb249d239ed3722b1cbe03e2c6be86e112a2afb4 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 7 May 2026 20:28:02 -0700 Subject: [PATCH 1080/1222] copilot-libraries: Document changes in CHANGELOG. Refs #726. --- copilot-libraries/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-libraries/CHANGELOG b/copilot-libraries/CHANGELOG index 171b9b7d7..49779ea56 100644 --- a/copilot-libraries/CHANGELOG +++ b/copilot-libraries/CHANGELOG @@ -1,3 +1,6 @@ +2026-05-07 + * Add stream analysis module. (#726) + 2026-03-07 * Version bump (4.7). (#714) From 4b5225ee46f9d1ab2c832a043c5ccc7b73c5377f Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 7 May 2026 23:59:55 -0700 Subject: [PATCH 1081/1222] copilot-libraries: Add state machine module. Refs #728. There is a need to have in Copilot a module that implements state machines. Such functions have been useful in other projects, and they could be added as part of Copilot's standard library so that they are available to all users. This commit adds a state machine module that enables simulating a state machine using simple notation to describe the state machine. --- copilot-libraries/copilot-libraries.cabal | 1 + .../src/Copilot/Library/StateMachines.hs | 45 +++++++++++++++++++ 2 files changed, 46 insertions(+) create mode 100644 copilot-libraries/src/Copilot/Library/StateMachines.hs diff --git a/copilot-libraries/copilot-libraries.cabal b/copilot-libraries/copilot-libraries.cabal index 145887314..e59ff32f8 100644 --- a/copilot-libraries/copilot-libraries.cabal +++ b/copilot-libraries/copilot-libraries.cabal @@ -49,6 +49,7 @@ library , Copilot.Library.Clocks , Copilot.Library.LTL , Copilot.Library.PTLTL + , Copilot.Library.StateMachines , Copilot.Library.Statistics , Copilot.Library.RegExp , Copilot.Library.Utils diff --git a/copilot-libraries/src/Copilot/Library/StateMachines.hs b/copilot-libraries/src/Copilot/Library/StateMachines.hs new file mode 100644 index 000000000..37121b1a0 --- /dev/null +++ b/copilot-libraries/src/Copilot/Library/StateMachines.hs @@ -0,0 +1,45 @@ +{-# LANGUAGE ScopedTypeVariables #-} +-- | Simulate state machines using streams. +module Copilot.Library.StateMachines where + +import Copilot.Language (Stream, Typed, constant, ifThenElse, (&&), (++), (==)) +import Prelude hiding ((&&), (++), (==)) + +-- | A definition of a state machine where some elements are defined +-- as streams. +-- +-- A state machine is defined by an initial state, a final state, a no +-- transition stream (true when tere is no input coming in), a list of +-- transitions, and a bad state. +type StateMachine a = (a, a, Stream Bool, [(a, Stream Bool, a)], a) + +-- | Produce a stream that, at any given time, contains the current state of +-- the state machine. +stateMachine :: forall a . (Eq a, Typed a) => StateMachine a -> Stream a +stateMachine (initial, final, noInputData, transitions, bad) = state + where + state = ifThenElses transitions + previousState = [initial] ++ state + + ifThenElses :: [(a, Stream Bool, a)] -> Stream a + ifThenElses [] = + ifThenElse (previousState == constant final && noInputData) + (constant final) + (constant bad) + + ifThenElses ((s1, i, s2):ss) = + ifThenElse + (previousState == constant s1 && i) + (constant s2) + (ifThenElses ss) + +-- | Produce a stream that, at any given time, contains the current state of +-- the state machine as the numeric representation of an enum. +stateMachineEnum :: (Eq b, Typed b, Num b, Enum a) + => StateMachine a + -> Stream b +stateMachineEnum (initial, final, noInputData, transitions, bad) = + stateMachine (fe initial, fe final, noInputData, transitionsE, fe bad) + where + transitionsE = map (\(s1, t, s2) -> (fe s1, t, fe s2)) transitions + fe = fromIntegral . fromEnum From 32704d9c8ebb7bbed0a8c7d4a5bc9aeb15554079 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 7 May 2026 23:59:55 -0700 Subject: [PATCH 1082/1222] copilot-libraries: Document changes in CHANGELOG. Refs #728. --- copilot-libraries/CHANGELOG | 1 + 1 file changed, 1 insertion(+) diff --git a/copilot-libraries/CHANGELOG b/copilot-libraries/CHANGELOG index 49779ea56..745bb1b6b 100644 --- a/copilot-libraries/CHANGELOG +++ b/copilot-libraries/CHANGELOG @@ -1,5 +1,6 @@ 2026-05-07 * Add stream analysis module. (#726) + * Add state machine module. (#728) 2026-03-07 * Version bump (4.7). (#714) From 2d3d84540473667029e696be9b42c19c2fe1d565 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 7 May 2026 23:59:48 -0700 Subject: [PATCH 1083/1222] copilot-core: Version bump (4.7.1). Refs #730. --- copilot-core/copilot-core.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot-core/copilot-core.cabal b/copilot-core/copilot-core.cabal index 6d99e77d6..ee463977c 100644 --- a/copilot-core/copilot-core.cabal +++ b/copilot-core/copilot-core.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-core -version: 4.7 +version: 4.7.1 synopsis: An intermediate representation for Copilot. description: Intermediate representation for Copilot. From 8cb85bbdd90e983572e673de469de4673d46f3dc Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 7 May 2026 23:59:48 -0700 Subject: [PATCH 1084/1222] copilot-bluespec: Version bump (4.7.1). Refs #730. --- copilot-bluespec/copilot-bluespec.cabal | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/copilot-bluespec/copilot-bluespec.cabal b/copilot-bluespec/copilot-bluespec.cabal index 3ac0839cf..ffaadaca2 100644 --- a/copilot-bluespec/copilot-bluespec.cabal +++ b/copilot-bluespec/copilot-bluespec.cabal @@ -1,6 +1,6 @@ cabal-version : >= 1.10 name : copilot-bluespec -version : 4.7 +version : 4.7.1 synopsis : A compiler for Copilot targeting FPGAs. description : This package is a back-end from Copilot to FPGAs in Bluespec. @@ -51,8 +51,8 @@ library , ieee754 >= 0.8.0 && < 0.9 , pretty >= 1.1.2 && < 1.2 - , copilot-core >= 4.7 && < 4.8 - , language-bluespec >= 0.1 && < 0.2 + , copilot-core >= 4.7.1 && < 4.8 + , language-bluespec >= 0.1 && < 0.2 exposed-modules : Copilot.Compile.Bluespec From 7818e6c1404f62e3bcff10eca35983320746758e Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 7 May 2026 23:59:48 -0700 Subject: [PATCH 1085/1222] copilot-c99: Version bump (4.7.1). Refs #730. --- copilot-c99/copilot-c99.cabal | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/copilot-c99/copilot-c99.cabal b/copilot-c99/copilot-c99.cabal index 0567e9416..d9802bd42 100644 --- a/copilot-c99/copilot-c99.cabal +++ b/copilot-c99/copilot-c99.cabal @@ -1,6 +1,6 @@ cabal-version : >= 1.10 name : copilot-c99 -version : 4.7 +version : 4.7.1 synopsis : A compiler for Copilot targeting C99. description : This package is a back-end from Copilot to C. @@ -45,7 +45,7 @@ library , mtl >= 2.2 && < 2.4 , pretty >= 1.1 && < 1.2 - , copilot-core >= 4.7 && < 4.8 + , copilot-core >= 4.7.1 && < 4.8 , language-c99 >= 0.2.0 && < 0.3 , language-c99-simple >= 0.3 && < 0.4 From 4b1fa514a3a6f3185fdda5bcaacbd6cecb609478 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 7 May 2026 23:59:48 -0700 Subject: [PATCH 1086/1222] copilot-prettyprinter: Version bump (4.7.1). Refs #730. --- copilot-prettyprinter/copilot-prettyprinter.cabal | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/copilot-prettyprinter/copilot-prettyprinter.cabal b/copilot-prettyprinter/copilot-prettyprinter.cabal index f6f5fcc57..c40511c43 100644 --- a/copilot-prettyprinter/copilot-prettyprinter.cabal +++ b/copilot-prettyprinter/copilot-prettyprinter.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-prettyprinter -version: 4.7 +version: 4.7.1 synopsis: A prettyprinter of Copilot Specifications. description: A prettyprinter of Copilot specifications. @@ -45,7 +45,7 @@ library base >= 4.9 && < 5, pretty >= 1.0 && < 1.2, - copilot-core >= 4.7 && < 4.8 + copilot-core >= 4.7.1 && < 4.8 exposed-modules: From 7752221d3e0be7414bf915bd2bbc401464acffef Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 7 May 2026 23:59:48 -0700 Subject: [PATCH 1087/1222] copilot-interpreter: Version bump (4.7.1). Refs #730. --- copilot-interpreter/copilot-interpreter.cabal | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/copilot-interpreter/copilot-interpreter.cabal b/copilot-interpreter/copilot-interpreter.cabal index 9ef09f117..0303bf17b 100644 --- a/copilot-interpreter/copilot-interpreter.cabal +++ b/copilot-interpreter/copilot-interpreter.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-interpreter -version: 4.7 +version: 4.7.1 synopsis: Interpreter for Copilot. description: Interpreter for Copilot. @@ -44,7 +44,7 @@ library base >= 4.9 && < 5, pretty >= 1.0 && < 1.2, - copilot-core >= 4.7 && < 4.8 + copilot-core >= 4.7.1 && < 4.8 exposed-modules: From 02defe133e9e2ce434b542eeedd4e7ba01e543e4 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 7 May 2026 23:59:48 -0700 Subject: [PATCH 1088/1222] copilot-theorem: Version bump (4.7.1). Refs #730. --- copilot-theorem/copilot-theorem.cabal | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/copilot-theorem/copilot-theorem.cabal b/copilot-theorem/copilot-theorem.cabal index 87f53807f..cd9d2e00e 100644 --- a/copilot-theorem/copilot-theorem.cabal +++ b/copilot-theorem/copilot-theorem.cabal @@ -14,7 +14,7 @@ description: . -version : 4.7 +version : 4.7.1 license : BSD3 license-file : LICENSE maintainer : Ivan Perez @@ -63,8 +63,8 @@ library , xml >= 1.3 && < 1.4 , what4 >= 1.3 && < 1.8 - , copilot-core >= 4.7 && < 4.8 - , copilot-prettyprinter >= 4.7 && < 4.8 + , copilot-core >= 4.7.1 && < 4.8 + , copilot-prettyprinter >= 4.7.1 && < 4.8 exposed-modules : Copilot.Theorem , Copilot.Theorem.Prove From 8eac0cac7a0bb24082f0a137c7da0ea5845889ce Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 7 May 2026 23:59:48 -0700 Subject: [PATCH 1089/1222] copilot-language: Version bump (4.7.1). Refs #730. --- copilot-language/copilot-language.cabal | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/copilot-language/copilot-language.cabal b/copilot-language/copilot-language.cabal index 740bb2b8c..2cfab8eb8 100644 --- a/copilot-language/copilot-language.cabal +++ b/copilot-language/copilot-language.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-language -version: 4.7 +version: 4.7.1 synopsis: A Haskell-embedded DSL for monitoring hard real-time distributed systems. description: @@ -42,9 +42,9 @@ library , data-reify >= 0.6 && < 0.7 , mtl >= 2.0 && < 3 - , copilot-core >= 4.7 && < 4.8 - , copilot-interpreter >= 4.7 && < 4.8 - , copilot-theorem >= 4.7 && < 4.8 + , copilot-core >= 4.7.1 && < 4.8 + , copilot-interpreter >= 4.7.1 && < 4.8 + , copilot-theorem >= 4.7.1 && < 4.8 exposed-modules: Copilot.Language , Copilot.Language.Operators.BitWise From dad3ad411fce1d1db711fb9be0ffff7722557d94 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 7 May 2026 23:59:48 -0700 Subject: [PATCH 1090/1222] copilot-libraries: Version bump (4.7.1). Refs #730. --- copilot-libraries/copilot-libraries.cabal | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/copilot-libraries/copilot-libraries.cabal b/copilot-libraries/copilot-libraries.cabal index e59ff32f8..85b117f63 100644 --- a/copilot-libraries/copilot-libraries.cabal +++ b/copilot-libraries/copilot-libraries.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-libraries -version: 4.7 +version: 4.7.1 synopsis: Libraries for the Copilot language. description: Libraries for the Copilot language. @@ -41,7 +41,7 @@ library , containers >= 0.4 && < 0.9 , mtl >= 2.0 && < 2.4 , parsec >= 2.0 && < 3.2 - , copilot-language >= 4.7 && < 4.8 + , copilot-language >= 4.7.1 && < 4.8 exposed-modules: Copilot.Library.Analysis From 9af5f1194a388f79e2a80b73e660b7b518ab2461 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 7 May 2026 23:59:48 -0700 Subject: [PATCH 1091/1222] copilot-verifier: Version bump (4.7.1). Refs #730. --- copilot-verifier/copilot-verifier.cabal | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/copilot-verifier/copilot-verifier.cabal b/copilot-verifier/copilot-verifier.cabal index c7bf36a10..339892ec9 100644 --- a/copilot-verifier/copilot-verifier.cabal +++ b/copilot-verifier/copilot-verifier.cabal @@ -1,6 +1,6 @@ Cabal-version: 2.2 Name: copilot-verifier -Version: 4.7 +Version: 4.7.1 Author: Galois Inc. Maintainer: rscott@galois.com Copyright: (c) Galois, Inc 2021-2024 @@ -45,9 +45,9 @@ common bldflags bv-sized >= 1.0.0 && < 1.1, bytestring, containers >= 0.5.9.0, - copilot-c99 >= 4.7 && < 4.8, - copilot-core >= 4.7 && < 4.8, - copilot-theorem >= 4.7 && < 4.8, + copilot-c99 >= 4.7.1 && < 4.8, + copilot-core >= 4.7.1 && < 4.8, + copilot-theorem >= 4.7.1 && < 4.8, crucible >= 0.7.1 && < 0.8, crucible-llvm >= 0.7 && < 0.8, crux >= 0.7.1 && < 0.8, @@ -80,10 +80,10 @@ library copilot-verifier-examples hs-source-dirs: examples build-depends: case-insensitive, - copilot >= 4.7 && < 4.8, - copilot-language >= 4.7 && < 4.8, - copilot-libraries >= 4.7 && < 4.8, - copilot-prettyprinter >= 4.7 && < 4.8, + copilot >= 4.7.1 && < 4.8, + copilot-language >= 4.7.1 && < 4.8, + copilot-libraries >= 4.7.1 && < 4.8, + copilot-prettyprinter >= 4.7.1 && < 4.8, copilot-verifier exposed-modules: Copilot.Verifier.Examples From a932329dec110e8d0ed00893c33b649f879df311 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 7 May 2026 23:59:48 -0700 Subject: [PATCH 1092/1222] copilot-visualizer: Version bump (4.7.1). Refs #730. --- copilot-visualizer/copilot-visualizer.cabal | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/copilot-visualizer/copilot-visualizer.cabal b/copilot-visualizer/copilot-visualizer.cabal index 0500c1b43..5e8735ea4 100644 --- a/copilot-visualizer/copilot-visualizer.cabal +++ b/copilot-visualizer/copilot-visualizer.cabal @@ -1,6 +1,6 @@ cabal-version: >= 1.10 name: copilot-visualizer -version: 4.7 +version: 4.7.1 synopsis: Visualizer for Copilot. description: Visualizer for Copilot. @@ -65,10 +65,10 @@ library text >= 1.2.3.1 && < 2.2, websockets >= 0.12.7 && < 0.14, - copilot >= 4.7 && < 4.8, - copilot-core >= 4.7 && < 4.8, - copilot-interpreter >= 4.7 && < 4.8, - copilot-language >= 4.7 && < 4.8 + copilot >= 4.7.1 && < 4.8, + copilot-core >= 4.7.1 && < 4.8, + copilot-interpreter >= 4.7.1 && < 4.8, + copilot-language >= 4.7.1 && < 4.8 exposed-modules: From 4df77d15f74ea237c08e957ab52ec3f954cbdaed Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 7 May 2026 23:59:48 -0700 Subject: [PATCH 1093/1222] copilot: Version bump (4.7.1). Refs #730. --- copilot/copilot.cabal | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/copilot/copilot.cabal b/copilot/copilot.cabal index 68ff811ec..ace61023d 100644 --- a/copilot/copilot.cabal +++ b/copilot/copilot.cabal @@ -1,5 +1,5 @@ name: copilot -version: 4.7 +version: 4.7.1 cabal-version: >= 1.10 license: BSD3 license-file: LICENSE @@ -52,12 +52,12 @@ library , directory >= 1.3 && < 1.4 , filepath >= 1.4 && < 1.6 - , copilot-core >= 4.7 && < 4.8 - , copilot-theorem >= 4.7 && < 4.8 - , copilot-language >= 4.7 && < 4.8 - , copilot-libraries >= 4.7 && < 4.8 - , copilot-c99 >= 4.7 && < 4.8 - , copilot-prettyprinter >= 4.7 && < 4.8 + , copilot-core >= 4.7.1 && < 4.8 + , copilot-theorem >= 4.7.1 && < 4.8 + , copilot-language >= 4.7.1 && < 4.8 + , copilot-libraries >= 4.7.1 && < 4.8 + , copilot-c99 >= 4.7.1 && < 4.8 + , copilot-prettyprinter >= 4.7.1 && < 4.8 exposed-modules: Language.Copilot, Language.Copilot.Main From df290fb3f4945c3b8a0283d612f9299ff4f84007 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 7 May 2026 23:59:48 -0700 Subject: [PATCH 1094/1222] copilot-core: Document changes in CHANGELOG. Refs #730. --- copilot-core/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-core/CHANGELOG b/copilot-core/CHANGELOG index 671e39ef6..4a019a359 100644 --- a/copilot-core/CHANGELOG +++ b/copilot-core/CHANGELOG @@ -1,3 +1,6 @@ +2026-05-07 + * Version bump (4.7.1). (#730) + 2026-03-07 * Version bump (4.7). (#714) From 4c5a53a6c53882fe57f3efb1dd6b8095abb7fbf7 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 7 May 2026 23:59:48 -0700 Subject: [PATCH 1095/1222] copilot-bluespec: Document changes in CHANGELOG. Refs #730. --- copilot-bluespec/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot-bluespec/CHANGELOG b/copilot-bluespec/CHANGELOG index c0ab51bc1..63ea6878b 100644 --- a/copilot-bluespec/CHANGELOG +++ b/copilot-bluespec/CHANGELOG @@ -1,4 +1,5 @@ -2026-03-31 +2026-05-07 + * Version bump (4.7.1). (#730) * Fix translation of special Float values to Bluespec. (#697) 2026-03-07 From 77b3a64b58554751393eeb200f467a495e41a922 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 7 May 2026 23:59:48 -0700 Subject: [PATCH 1096/1222] copilot-c99: Document changes in CHANGELOG. Refs #730. --- copilot-c99/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-c99/CHANGELOG b/copilot-c99/CHANGELOG index 856d51497..74c6c1dd4 100644 --- a/copilot-c99/CHANGELOG +++ b/copilot-c99/CHANGELOG @@ -1,3 +1,6 @@ +2026-05-07 + * Version bump (4.7.1). (#730) + 2026-03-07 * Version bump (4.7). (#714) * Raise error when compiling empty arrays or structs. (#695) From d1943d58127e39f62a365065f877adf34b3a3b12 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 7 May 2026 23:59:48 -0700 Subject: [PATCH 1097/1222] copilot-prettyprinter: Document changes in CHANGELOG. Refs #730. --- copilot-prettyprinter/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-prettyprinter/CHANGELOG b/copilot-prettyprinter/CHANGELOG index efa6ccf51..a8e6d3e12 100644 --- a/copilot-prettyprinter/CHANGELOG +++ b/copilot-prettyprinter/CHANGELOG @@ -1,3 +1,6 @@ +2026-05-07 + * Version bump (4.7.1). (#730) + 2026-03-07 * Version bump (4.7). (#714) From 00b1fa10a39c967935844275ad054f0baa8b034b Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 7 May 2026 23:59:48 -0700 Subject: [PATCH 1098/1222] copilot-interpreter: Document changes in CHANGELOG. Refs #730. --- copilot-interpreter/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-interpreter/CHANGELOG b/copilot-interpreter/CHANGELOG index c2920d179..53984488e 100644 --- a/copilot-interpreter/CHANGELOG +++ b/copilot-interpreter/CHANGELOG @@ -1,3 +1,6 @@ +2026-05-07 + * Version bump (4.7.1). (#730) + 2026-03-07 * Version bump (4.7). (#714) From c09bb16c44ea425544192f21d88225b9f1339711 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 7 May 2026 23:59:48 -0700 Subject: [PATCH 1099/1222] copilot-theorem: Document changes in CHANGELOG. Refs #730. --- copilot-theorem/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot-theorem/CHANGELOG b/copilot-theorem/CHANGELOG index 909643531..03facaf36 100644 --- a/copilot-theorem/CHANGELOG +++ b/copilot-theorem/CHANGELOG @@ -1,4 +1,5 @@ -2026-03-31 +2026-05-07 + * Version bump (4.7.1). (#730) * Handle special Float values correctly for counterexamples. (#697) * Update examples to compile with copilot-theorem >= 3.0. (#692) From d1547de8018afe6469b6b3afd0d15e65ea32c1b2 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 7 May 2026 23:59:48 -0700 Subject: [PATCH 1100/1222] copilot-language: Document changes in CHANGELOG. Refs #730. --- copilot-language/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-language/CHANGELOG b/copilot-language/CHANGELOG index 4751f7061..069d20f5d 100644 --- a/copilot-language/CHANGELOG +++ b/copilot-language/CHANGELOG @@ -1,3 +1,6 @@ +2026-05-07 + * Version bump (4.7.1). (#730) + 2026-03-07 * Version bump (4.7). (#714) From 3b6e1b2d68177346ce6af788dbc82bc9fd60b3e6 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 7 May 2026 23:59:48 -0700 Subject: [PATCH 1101/1222] copilot-libraries: Document changes in CHANGELOG. Refs #730. --- copilot-libraries/CHANGELOG | 1 + 1 file changed, 1 insertion(+) diff --git a/copilot-libraries/CHANGELOG b/copilot-libraries/CHANGELOG index 745bb1b6b..19b510a63 100644 --- a/copilot-libraries/CHANGELOG +++ b/copilot-libraries/CHANGELOG @@ -1,4 +1,5 @@ 2026-05-07 + * Version bump (4.7.1). (#730) * Add stream analysis module. (#726) * Add state machine module. (#728) From 2c11c9b25101bd57a7b317eaf9d9ae5b8190905c Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 7 May 2026 23:59:48 -0700 Subject: [PATCH 1102/1222] copilot-verifier: Document changes in CHANGELOG. Refs #730. --- copilot-verifier/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-verifier/CHANGELOG b/copilot-verifier/CHANGELOG index 049ec2243..a2b4dd530 100644 --- a/copilot-verifier/CHANGELOG +++ b/copilot-verifier/CHANGELOG @@ -1,3 +1,6 @@ +2026-05-07 + * Version bump (4.7.1). (#730) + 2026-03-07 * Version bump (4.7). (#714) * Relax version constraints on what4. (#716) From 9921f52eacd65f310438cef2f170f01ae42bb1f6 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 7 May 2026 23:59:48 -0700 Subject: [PATCH 1103/1222] copilot-visualizer: Document changes in CHANGELOG. Refs #730. --- copilot-visualizer/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-visualizer/CHANGELOG b/copilot-visualizer/CHANGELOG index 402ec34d5..0735d51ab 100644 --- a/copilot-visualizer/CHANGELOG +++ b/copilot-visualizer/CHANGELOG @@ -1,3 +1,6 @@ +2026-05-07 + * Version bump (4.7.1). (#730) + 2026-03-07 * Version bump (4.7). (#714) * Relax version constraints on ogma-extra. (#716) From fce6bdfb3104aadd8af9eb978dfb2b9a75b82aca Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 7 May 2026 23:59:48 -0700 Subject: [PATCH 1104/1222] copilot: Document changes in CHANGELOG. Refs #730. --- copilot/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot/CHANGELOG b/copilot/CHANGELOG index dd34bc70f..f58dd30e6 100644 --- a/copilot/CHANGELOG +++ b/copilot/CHANGELOG @@ -1,3 +1,6 @@ +2026-05-07 + * Version bump (4.7.1). (#730) + 2026-03-07 * Version bump (4.7). (#714) From 5de4a7bb82e9671b7961b8b0b4c222e0738a1bc3 Mon Sep 17 00:00:00 2001 From: Chris Hathhorn Date: Tue, 9 Jun 2026 13:53:43 -0500 Subject: [PATCH 1105/1222] copilot-theorem: Extend range of versions of Kind2. Refs #734. In order to keep Copilot effectively working in the current software ecosystem, we need to extend the versions of dependencies that Copilot can be installed with. kind2 has seen release 2.3.0, but copilot-theorem requires kind2 0.7.2. This commit updates the copilot-theorem Kind2 native-format backend to produce output targeting modern releases of Kind2. It has been tested with Kind2 v2.3, the latest at the time of this commit. --- copilot-theorem/copilot-theorem.cabal | 2 +- .../src/Copilot/Theorem/Kind2/AST.hs | 51 +++++-- .../src/Copilot/Theorem/Kind2/Output.hs | 117 +++++++++------ .../src/Copilot/Theorem/Kind2/PrettyPrint.hs | 49 ++++-- .../src/Copilot/Theorem/Kind2/Prover.hs | 16 +- .../src/Copilot/Theorem/Kind2/Translate.hs | 140 +++++------------- 6 files changed, 196 insertions(+), 179 deletions(-) diff --git a/copilot-theorem/copilot-theorem.cabal b/copilot-theorem/copilot-theorem.cabal index cd9d2e00e..1c809e3c9 100644 --- a/copilot-theorem/copilot-theorem.cabal +++ b/copilot-theorem/copilot-theorem.cabal @@ -51,6 +51,7 @@ library , containers >= 0.4 && < 0.9 , data-default >= 0.7 && < 0.9 , directory >= 1.3 && < 1.4 + , extra >= 1.7 && < 1.9 , fp-ieee >= 0.1 && < 0.2 , libBF >= 0.6.2 && < 0.7 , mtl >= 2.0 && < 2.4 @@ -60,7 +61,6 @@ library , process >= 1.6 && < 1.7 , random >= 1.1 && < 1.4 , transformers >= 0.5 && < 0.7 - , xml >= 1.3 && < 1.4 , what4 >= 1.3 && < 1.8 , copilot-core >= 4.7.1 && < 4.8 diff --git a/copilot-theorem/src/Copilot/Theorem/Kind2/AST.hs b/copilot-theorem/src/Copilot/Theorem/Kind2/AST.hs index e69cda8d0..efd493a6d 100644 --- a/copilot-theorem/src/Copilot/Theorem/Kind2/AST.hs +++ b/copilot-theorem/src/Copilot/Theorem/Kind2/AST.hs @@ -1,27 +1,54 @@ {-# LANGUAGE Safe #-} --- | Abstract syntax tree of Kind2 files. +-- | Abstract syntax tree of Kind2 native input files. +-- +-- This represents the native transition system input format supported by +-- Kind2 1.0 and newer (@--input_format native@), in which a file is a +-- sequence of @define-node@ forms, each declaring a state transition system +-- by means of an initial state predicate and a transition relation predicate. +-- The last node defined in a file is the top system analyzed by Kind2, and +-- the properties to check are attached to it. +-- +-- The native input format is largely undocumented, and Kind2's user +-- documentation only covers its Lustre frontend. The best available +-- references for the native format are the parser in the Kind2 sources +-- ([nativeInput.ml] +-- (https://github.com/kind2-mc/kind2/blob/v3.0.0/src/nativeInput.ml)), +-- which includes a sketch of the grammar in a comment near the end of the +-- file) and the example file +-- [two_counters.kind2] +-- (https://github.com/kind2-mc/kind2/blob/develop/examples/two_counters.kind2). module Copilot.Theorem.Kind2.AST where --- | A file is a sequence of predicates and propositions. +-- | A file is a sequence of node definitions, together with a distinguished +-- top node and a series of propositions about the top node. +-- +-- Kind2 analyzes the last node defined in a file as the top system, so the +-- top node is always printed after all the other nodes. data File = File - { filePreds :: [PredDef] - , fileProps :: [Prop] } + { fileNodes :: [Node] -- ^ Nodes other than the top node, in dependency + -- order (a node may only refer to nodes defined + -- before it). + , fileTopNode :: Node -- ^ The top node, which the propositions are + -- attached to. + , fileProps :: [Prop] -- ^ Propositions about the top node. + } -- | A proposition is defined by a term. data Prop = Prop { propName :: String , propTerm :: Term } --- | A predicate definition. -data PredDef = PredDef - { predId :: String -- ^ Identifier for the predicate. - , predStateVars :: [StateVarDef] -- ^ Variables identifying the states in the - -- underlying state transition system. - , predInit :: Term -- ^ Predicate that holds for initial +-- | A node definition. +data Node = Node + { nodeId :: String -- ^ Identifier for the node. + , nodeStateVars :: [StateVarDef] -- ^ Variables identifying the states in + -- the underlying state transition system. + , nodeInit :: Term -- ^ Predicate that holds for initial -- states. - , predTrans :: Term -- ^ Predicate that holds for two states, if - -- there is state transition between them. + , nodeTrans :: Term -- ^ Predicate that holds for two states, + -- if there is a state transition between + -- them. } -- | A definition of a state variable. diff --git a/copilot-theorem/src/Copilot/Theorem/Kind2/Output.hs b/copilot-theorem/src/Copilot/Theorem/Kind2/Output.hs index f80b8170b..8a1d29c28 100644 --- a/copilot-theorem/src/Copilot/Theorem/Kind2/Output.hs +++ b/copilot-theorem/src/Copilot/Theorem/Kind2/Output.hs @@ -4,66 +4,97 @@ -- | Parse output of Kind2. module Copilot.Theorem.Kind2.Output (parseOutput) where -import Text.XML.Light hiding (findChild) -import Copilot.Theorem.Prove as P -import Data.Maybe (fromJust) +import Data.List.Extra (isInfixOf, splitOn, stripInfix, trim) +import Data.Maybe (mapMaybe) + +import Copilot.Theorem.Prove as P import qualified Copilot.Core as C import qualified Copilot.Theorem.Misc.Error as Err -simpleName s = QName s Nothing Nothing - -- | Parse output of Kind2. +-- +-- The output is expected to be in XML format, as produced by Kind2's @-xml@ +-- flag and documented at +-- . +-- Note that this function does not parse the output as XML: when given a +-- system in the native transition system format, Kind2 produces output that +-- is not always well-formed XML (e.g., counterexamples to invariant +-- properties cannot be printed for systems in that format -- the +-- counterexample printing functions in Kind2's @src/inputSystem.ml@ fail with +-- an internal error for native input -- and Kind2 reports the error in the +-- middle of the XML output). Instead, this function looks for the +-- @\@ tag for the given property and extracts the answers in the +-- @\@ tags it contains. parseOutput :: String -- ^ Property whose validity is being checked. -> C.Prop -- ^ The property's quantifier. -> String -- ^ XML output of Kind2 -> P.Output -parseOutput propId propQuantifier xml = fromJust $ do - root <- parseXMLDoc xml - case findAnswer . findPropTag $ root of - "valid" -> case propQuantifier of - -- We encode a universally quantified property P as - -- ∀x.P(x) in Kind2, so the original property is valid - -- iff the Kind2 property is valid. - C.Forall {} -> return (Output Valid []) - -- We encode an existentially quantified property P as - -- ¬(∀x.¬(P(x))) in Kind2, so the original property is - -- invalid iff the Kind2 property is valid. - C.Exists {} -> return (Output Invalid []) - "falsifiable" -> case propQuantifier of - -- We encode a universally quantified property P as - -- ∀x.P(x) in Kind2, so the original property is invalid - -- iff the Kind2 property is invalid. - C.Forall {} -> return (Output Invalid []) - -- We encode an existentially quantified property P as - -- ¬(∀x.¬(P(x))) in Kind2, so the original property is - -- valid iff the Kind2 property is invalid. - C.Exists {} -> return (Output Valid []) - s -> err $ "Unrecognized status : " ++ s +parseOutput propId propQuantifier xml + | "valid" `elem` answers = quantified (Output Valid []) + (Output Invalid []) + | "falsifiable" `elem` answers = quantified (Output Invalid []) + (Output Valid []) + | "unknown" `elem` answers = Output Unknown [] + | null answers = err $ "Answer for property " ++ propId ++ " not found" + | otherwise = err $ "Unrecognized status : " ++ unwords answers where - searchForRuntimeError = undefined + -- Pick an output based on the quantifier of the property. The first + -- argument is returned when the property Kind2 was asked about is valid, + -- and the second one when it is invalid. + -- + -- We encode a universally quantified property P as ∀x.P(x) in Kind2, so + -- the original property is valid iff the Kind2 property is valid. + -- + -- We encode an existentially quantified property P as ¬(∀x.¬(P(x))) in + -- Kind2, so the original property is valid iff the Kind2 property is + -- invalid. + quantified ifValid ifInvalid = case propQuantifier of + C.Forall {} -> ifValid + C.Exists {} -> ifInvalid + + -- All the answers reported for the property, in the order in which they + -- appear in the output. A conclusive answer (valid or falsifiable), if + -- any, takes precedence over inconclusive (unknown) ones, which Kind2 may + -- also report when the analysis terminates without an answer for all + -- properties. + answers = mapMaybe answerText + $ filter isRightProperty + $ propertyElems xml - findPropTag root = - let rightElement elt = - qName (elName elt) == "Property" - && lookupAttr (simpleName "name") (elAttribs elt) - == Just propId - in case filterChildren rightElement root of - tag : _ -> tag - _ -> err $ "Tag for property " ++ propId ++ " not found" + -- Substrings of the output following a @\ - case onlyText (elContent answTag) of - answ : _ -> cdData answ - _ -> err "Invalid 'Answer' attribute" - _ -> err "Attribute 'Answer' not found" + -- True if the given property element has the name of the property this + -- function looks for. + isRightProperty elem' = + ("name=\"" ++ escapeAttr propId ++ "\"") `isInfixOf` openingTag + where + openingTag = takeWhile (/= '>') elem' + + -- The contents of the first @\@ tag in the given element, if + -- any. + answerText elem' = do + (_, rest) <- stripInfix "" rest + let answer = trim $ takeWhile (/= '<') rest' + if null answer then Nothing else Just answer err :: forall a . String -> a err msg = Err.fatal $ "Parse error while reading the Kind2 XML output : \n" ++ msg ++ "\n\n" ++ xml + +-- | Escape a string for use as an XML attribute value. +escapeAttr :: String -> String +escapeAttr = concatMap escapeChar + where + escapeChar '&' = "&" + escapeChar '<' = "<" + escapeChar '>' = ">" + escapeChar '"' = """ + escapeChar c = [c] diff --git a/copilot-theorem/src/Copilot/Theorem/Kind2/PrettyPrint.hs b/copilot-theorem/src/Copilot/Theorem/Kind2/PrettyPrint.hs index 6851d46fa..92d158a1c 100644 --- a/copilot-theorem/src/Copilot/Theorem/Kind2/PrettyPrint.hs +++ b/copilot-theorem/src/Copilot/Theorem/Kind2/PrettyPrint.hs @@ -1,6 +1,8 @@ {-# LANGUAGE Safe #-} --- | Pretty print a Kind2 file defining predicates and propositions. +-- | Pretty print a Kind2 file defining nodes and propositions, in the native +-- transition system input format supported by Kind2 1.0 and newer (see +-- "Copilot.Theorem.Kind2.AST" for pointers to references on the format). module Copilot.Theorem.Kind2.PrettyPrint ( prettyPrint ) where import Copilot.Theorem.Misc.SExpr @@ -15,6 +17,14 @@ type SSExpr = SExpr String -- | Reserved keyword prime. kwPrime = "prime" +-- | Dummy position attached to the properties of the file. +-- +-- Kind2 requires a position (in the format @file:row-col@) for properties +-- declared with the @:user@ source annotation, and reports that position back +-- in its output. +propPosition :: String +propPosition = "copilot:1-1" + -- | Pretty print a Kind2 file. prettyPrint :: File -> String prettyPrint = @@ -29,30 +39,41 @@ shouldIndent (List [Atom a, Atom _]) = a `notElem` [kwPrime] shouldIndent _ = True -- | Convert a file into a sequence of expressions. +-- +-- The top node is printed last, since Kind2 analyzes the last node of the +-- file as the top system. The properties of the file are attached to it. ppFile :: File -> [SSExpr] -ppFile (File preds props) = map ppPredDef preds ++ ppProps props +ppFile (File nodes top props) = + map (`ppNode` []) nodes ++ [ppNode top (ppProps props)] --- | Convert a sequence of propositions into command to check each of them. +-- | Convert a sequence of propositions into a props field. ppProps :: [Prop] -> [SSExpr] -ppProps ps = [ node "check-prop" [ list $ map ppProp ps ] ] +ppProps [] = [] +ppProps ps = [ node "props" [ list $ map ppProp ps ] ] -- | Convert a proposition into an expression. ppProp :: Prop -> SSExpr -ppProp (Prop n t) = list [atom n, ppTerm t] +ppProp (Prop n t) = list [atom n, ppTerm t, atom ":user", atom propPosition] --- | Convert a predicate into an expression. -ppPredDef :: PredDef -> SSExpr -ppPredDef pd = - list [ atom "define-pred" - , atom (predId pd) - , list . map ppStateVarDef . predStateVars $ pd - , node "init" [ppTerm $ predInit pd] - , node "trans" [ppTerm $ predTrans pd] ] +-- | Convert a node, together with optional extra fields, into an expression. +ppNode :: Node -> [SSExpr] -> SSExpr +ppNode n extraFields = + list $ [ atom "define-node" + , atom (nodeId n) + , list . map ppStateVarDef . nodeStateVars $ n + , node "init" [ppTerm $ nodeInit n] + , node "trans" [ppTerm $ nodeTrans n] ] + ++ extraFields -- | Convert a state variable definition into an expression. ppStateVarDef :: StateVarDef -> SSExpr ppStateVarDef svd = - list [atom (varId svd), ppType (varType svd)] + list $ [atom (varId svd), ppType (varType svd)] + ++ map ppStateVarFlag (varFlags svd) + +-- | Convert a state variable option into an expression. +ppStateVarFlag :: StateVarFlag -> SSExpr +ppStateVarFlag FConst = atom ":const" -- | Convert a type into an expression. ppType :: Type -> SSExpr diff --git a/copilot-theorem/src/Copilot/Theorem/Kind2/Prover.hs b/copilot-theorem/src/Copilot/Theorem/Kind2/Prover.hs index 4bb52322e..a79ede4f6 100644 --- a/copilot-theorem/src/Copilot/Theorem/Kind2/Prover.hs +++ b/copilot-theorem/src/Copilot/Theorem/Kind2/Prover.hs @@ -28,7 +28,8 @@ import qualified Copilot.Theorem.TransSys as TS -- | Options for Kind2 data Options = Options { bmcMax :: Int -- ^ Upper bound on the number of unrolling that base and - -- step will perform. A value of 0 means /unlimited/. + -- step will perform (passed to Kind2 via its + -- @--unroll_max@ option). A value of 0 means /unlimited/. } -- | Default options with unlimited unrolling for base and step. @@ -41,7 +42,10 @@ data ProverST = ProverST -- | A prover backend based on Kind2. -- --- The executable @kind2@ must exist and its location be in the @PATH@. +-- The executable @kind2@ must exist and its location be in the @PATH@. Kind2 +-- version 1.0 or newer is required: the native input format and the +-- command-line options this prover uses were introduced in Kind2 1.0, and +-- remain supported as of Kind2 3.0. kind2Prover :: Options -> Prover kind2Prover opts = Prover { proverName = "Kind2" @@ -50,24 +54,22 @@ kind2Prover opts = Prover , closeProver = const $ return () } kind2Prog = "kind2" -kind2BaseOptions = ["--input-format", "native", "-xml"] +kind2BaseOptions = ["--input_format", "native", "-xml"] askKind2 :: ProverST -> [PropId] -> [PropId] -> IO Output askKind2 (ProverST opts spec) assumptions toCheck = do - let kind2Input = prettyPrint . toKind2 Inlined assumptions toCheck $ spec + let kind2Input = prettyPrint . toKind2 assumptions toCheck $ spec (tempName, tempHandle) <- openTempFile "." "out" "kind" hPutStr tempHandle kind2Input hClose tempHandle let kind2Options = - kind2BaseOptions ++ ["--bmc_max", show $ bmcMax opts, tempName] + kind2BaseOptions ++ ["--unroll_max", show $ bmcMax opts, tempName] (_, output, _) <- readProcessWithExitCode kind2Prog kind2Options "" - putStrLn kind2Input - removeFile tempName let propId = head toCheck diff --git a/copilot-theorem/src/Copilot/Theorem/Kind2/Translate.hs b/copilot-theorem/src/Copilot/Theorem/Kind2/Translate.hs index 123f6ed64..d59aaae24 100644 --- a/copilot-theorem/src/Copilot/Theorem/Kind2/Translate.hs +++ b/copilot-theorem/src/Copilot/Theorem/Kind2/Translate.hs @@ -1,68 +1,44 @@ -{-# LANGUAGE GADTs #-} -{-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE Safe #-} -{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE Safe #-} -- | Convert modular transition systems ('TransSys') into Kind2 file -- specifications. module Copilot.Theorem.Kind2.Translate ( toKind2 - , Style (..) ) where import Copilot.Theorem.TransSys import qualified Copilot.Theorem.Kind2.AST as K -import Control.Exception.Base (assert) - import Data.Function (on) import Data.Maybe (fromJust) -import Data.List (sort, sortBy) -import Data.Map (Map, (!)) +import Data.List (partition, sort, sortBy) +import Data.Map ((!)) import qualified Data.Map as Map import qualified Data.Bimap as Bimap --- The following properties MUST hold for the given transition system : --- * Nodes are sorted by topological order --- * Nodes are `completed`, which means the dependency graph is transitive --- and each node imports all the local variables of its dependencies --- - -type DepGraph = Map NodeId [NodeId] - --- | Style of the Kind2 files produced: modular (with multiple separate nodes), --- or all inlined (with only one node). --- --- In the modular style, the graph is simplified to remove cycles by collapsing --- all nodes participating in a strongly connected components. --- --- In the inlined style, the structure of the modular transition system is --- discarded and the graph is first turned into a /non-modular transition/ --- /system/ with only one node, which can be then converted into a Kind2 file. -data Style = Inlined | Modular - -- | Produce a Kind2 file that checks the properties specified. -toKind2 :: Style -- ^ Style of the file (modular or inlined). - -> [PropId] -- ^ Assumptions +toKind2 :: [PropId] -- ^ Assumptions -> [PropId] -- ^ Properties to be checked -> TransSys -- ^ Modular transition system holding the system spec -> K.File -toKind2 style assumptions checkedProps spec = - addAssumptions spec assumptions - $ trSpec (complete spec') predCallsGraph assumptions checkedProps +toKind2 assumptions checkedProps spec = + addAssumptions spec' assumptions $ trSpec spec' checkedProps where - predCallsGraph = specDependenciesGraph spec' - spec' = case style of - Inlined -> inline spec - Modular -> removeCycles spec + spec' = inline spec -trSpec :: TransSys -> DepGraph -> [PropId] -> [PropId] -> K.File -trSpec spec predCallsGraph _assumptions checkedProps = K.File preds props +trSpec :: TransSys -> [PropId] -> K.File +trSpec spec checkedProps = K.File otherNodes topNode props where - preds = map (trNode spec predCallsGraph) (specNodes spec) + (topNode, otherNodes) = + case partition ((== specTopNodeId spec) . K.nodeId) nodes of + ([top], others) -> (top, others) + _ -> error $ "Kind2.Translate: top node " + ++ specTopNodeId spec ++ " not found" + nodes = map (trNode spec) (specNodes spec) props = map trProp $ filter ((`elem` checkedProps) . fst) $ Map.toList $ Map.map fst $ specProps spec @@ -70,37 +46,30 @@ trSpec spec predCallsGraph _assumptions checkedProps = K.File preds props trProp :: (PropId, ExtVar) -> K.Prop trProp (pId, var) = K.Prop pId (trVar . extVarLocalPart $ var) -trNode :: TransSys -> DepGraph -> Node -> K.PredDef -trNode spec predCallsGraph node = - K.PredDef { K.predId, K.predStateVars, K.predInit, K.predTrans } - where - predId = nodeId node - predStateVars = gatherPredStateVars spec node - predInit = mkConj $ initLocals node - ++ map (trExpr False) (nodeConstrs node) - ++ predCalls True spec predCallsGraph node - predTrans = mkConj $ transLocals node - ++ map (trExpr True) (nodeConstrs node) - ++ predCalls False spec predCallsGraph node - +trNode :: TransSys -> Node -> K.Node +trNode spec node = K.Node + { K.nodeId = nodeId node + , K.nodeStateVars = gatherPredStateVars spec node + , K.nodeInit = mkConj $ initLocals node + ++ map (trExpr False) (nodeConstrs node) + , K.nodeTrans = mkConj $ transLocals node + ++ map (trExpr True) (nodeConstrs node) + } + +-- | Add the assumptions to the top node of the file by conjoining the +-- corresponding property variables to its initial state and transition +-- relation predicates. addAssumptions :: TransSys -> [PropId] -> K.File -> K.File -addAssumptions spec assumptions (K.File {K.filePreds, K.fileProps}) = - K.File (changeTail aux filePreds) fileProps +addAssumptions spec assumptions file = + file { K.fileTopNode = aux (K.fileTopNode file) } where - changeTail f (reverse -> l) = case l of - [] -> error "impossible" - x : xs -> reverse $ f x : xs - - aux pred = - let init' = mkConj ( K.predInit pred : map K.StateVar vars ) - trans' = mkConj ( K.predTrans pred : map K.PrimedStateVar vars ) - in pred { K.predInit = init', K.predTrans = trans' } + aux node = + let init' = mkConj ( K.nodeInit node : map K.StateVar vars ) + trans' = mkConj ( K.nodeTrans node : map K.PrimedStateVar vars ) + in node { K.nodeInit = init', K.nodeTrans = trans' } - vars = - let bindings = nodeImportedVars (specTopNode spec) - toExtVar a = fst $ fromJust $ Map.lookup a $ specProps spec - toTopVar (ExtVar nId v) = assert (nId == specTopNodeId spec) v - in map (varName . toTopVar . toExtVar) assumptions + toExtVar a = fst $ fromJust $ Map.lookup a $ specProps spec + vars = map (varName . extVarLocalPart . toExtVar) assumptions -- The ordering really matters here because the variables -- have to be given in this order in a pred call @@ -169,39 +138,6 @@ transLocals node = Expr e -> [mkEquality (trPrimedVar v) (trExpr True e)] Constrs cs -> map (trExpr True) cs -predCalls :: Bool -> TransSys -> DepGraph -> Node -> [K.Term] -predCalls isInitCall spec predCallsGraph node = - map mkCall toCall - where - nid = nodeId node - toCall = predCallsGraph ! nid - nodesMap = Map.fromList [(nodeId n, n) | n <- specNodes spec] - - nodeLocals n = - map (ExtVar n) . sort . Map.keys - . nodeLocalVars $ (nodesMap ! n) - - mkCall callee - | isInitCall = - K.PredApp callee K.Init (argsSeq trVar) - | otherwise = - K.PredApp callee K.Trans (argsSeq trVar ++ argsSeq trPrimedVar) - where - - calleeLocals = nodeLocals callee - calleeImported = - (concatMap nodeLocals . sort . nodeDependencies) $ nodesMap ! callee - - localAlias trVarF ev = - case Bimap.lookupR ev $ nodeImportedVars node of - Nothing -> error $ - "This spec is not complete : " - ++ show ev ++ " should be imported in " ++ nid - Just v -> trVarF v - - argsSeq trVarF = - map (localAlias trVarF) (calleeLocals ++ calleeImported) - trExpr :: Bool -> Expr t -> K.Term trExpr primed = tr where From 8258eb4968490d46bcb651c870b64d73398c7adb Mon Sep 17 00:00:00 2001 From: Chris Hathhorn Date: Mon, 22 Jun 2026 14:26:39 -0500 Subject: [PATCH 1106/1222] copilot-theorem: Update README for Kind2 backend changes. Refs #734. In order to keep Copilot effectively working in the current software ecosystem, we need to extend the versions of dependencies that Copilot can be installed with. kind2 has seen release 2.3.0, but copilot-theorem requires kind2 0.7.2. This commit updates copilot-theorem's README to reflect updates required to the Kind2 backend for supporting newer versions of Kind2 (e.g., the renaming Kind2's "--bmc_max" flag to "--unroll_max"). --- copilot-theorem/README.md | 40 +++++++++++++++++++++++++-------------- 1 file changed, 26 insertions(+), 14 deletions(-) diff --git a/copilot-theorem/README.md b/copilot-theorem/README.md index 64cce8995..47a4b6081 100644 --- a/copilot-theorem/README.md +++ b/copilot-theorem/README.md @@ -31,7 +31,8 @@ properties on Copilot programs. It includes: * The *copilot-core* and *copilot-prettyprinter* Haskell libraries * The *Yices2* SMT-solver: `yices-smt2` must be in your `$PATH` * The *Z3* SMT-solver: `z3` must be in your `$PATH` -* The *Kind2* model checker: `kind2` must be in your `$PATH` +* The *Kind2* model checker (version 1.0 or newer): `kind2` must be in your + `$PATH` To build it, just install the Copilot library as described in the top-level README. @@ -87,7 +88,9 @@ configuration. The *Kind2* prover uses the model checker with the same name, from the University of Iowa. It translates the Copilot specification into a *modular transition system* (the Kind2 native format) and then calls the `kind2` -executable. +executable. Kind2 version 1.0 or newer is required: the native input format +and the command-line options used by this prover were introduced in Kind2 +1.0, and remain supported as of Kind2 3.0. It is provided by the `Copilot.Theorem.Kind2` module, which exports a `kind2Prover :: Options -> Prover` where the `Options` type is defined as @@ -95,7 +98,7 @@ It is provided by the `Copilot.Theorem.Kind2` module, which exports a `kind2Prov ```haskell data Options = Options { bmcMax :: Int } ``` -and where `bmcMax` corresponds to the `--bmc_max` option of *kind2* and is +and where `bmcMax` corresponds to the `--unroll_max` option of *kind2* and is equivalent to the `maxK` option of the K-Induction prover. Its default value is 0, which stands for infinity. @@ -335,11 +338,16 @@ process. The transition system obtained by the `TransSys.Translate` module is perfectly consistent. However, it can't be directly translated into the *Kind2 native -file format*. Indeed, it is natural to bind each node to a predicate but the -Kind2 file format requires that each predicate only uses previously defined -predicates. However, some nodes in our transition system could be mutually -recursive. Therefore, the goal of the `removeCycles :: Spec -> Spec` function, -defined in `TransSys.Transform`, is to remove such dependency cycles. +file format*. The native input format of Kind2 (version 1.0 and newer) does +not support predicate calls inside the initial state and transition relation +predicates of a node, so the modular structure of the transition system cannot +be expressed directly in it. Therefore, the system is first turned into an +equivalent non-modular transition system with only one node by the +`inline :: Spec -> Spec` function, defined in `TransSys.Transform`: +```haskell +inline :: Spec -> Spec +inline spec = mergeNodes [nodeId n | n <- specNodes spec] spec +``` This function relies on the `mergeNodes :: [NodeId] -> Spec -> Spec` function, whose signature is self-explicit. The latter solves name conflicts by using the @@ -516,10 +524,14 @@ in the Kind2 SMT solver. #### Displaying counterexamples Counterexamples are not displayed with the Kind2 prover because Kind2 doesn't -support XML output of counterexamples. If the last feature is provided, it -should be easy to implement displaying of counterexamples in *copilot-theorem*. -For this, we recommend keeping some information about *observers* in -`TransSys.Spec` and to add one variable per observer in the Kind2 output file. +support the output of counterexamples for systems expressed in its native input +format (the counterexample printing functions in Kind2's +[`src/inputSystem.ml`](https://github.com/kind2-mc/kind2/blob/v3.0.0/src/inputSystem.ml) +fail with an internal error for native input). If Kind2 adds this feature, it +should be easy to implement displaying of counterexamples in +*copilot-theorem*. For this, we recommend keeping some information about +*observers* in `TransSys.Spec` and to add one variable per observer in the +Kind2 output file. #### Bad handling of non-linear operators and external functions @@ -569,14 +581,14 @@ architecture of Kind2. It is true that the code of `TransSys` is quite complex. In fact, it would be really straightforward to produce a flattened transition system and then a -Kind2 file with just a single *top* predicate. In fact, It would be as easy as +Kind2 file with just a single *top* node. In fact, It would be as easy as producing an *IL* specification. To be honest, I'm not sure producing a modular *Kind2* output is worth the complexity added. It's especially true at the time I write this in the sense that: -* Each predicate introduced is used only one time (which is true because +* Each node introduced is used only one time (which is true because Copilot doesn't handle functions or parameterized streams like Lustre does and everything is inlined during the reification process). * A similar form of structure could be obtained from a flattened Kind2 native From b8ff2fbaa16abac1441d172fa557e727d4380e66 Mon Sep 17 00:00:00 2001 From: Chris Hathhorn Date: Tue, 9 Jun 2026 13:54:17 -0500 Subject: [PATCH 1107/1222] copilot-theorem: Document changes in CHANGELOG. Refs #734. --- copilot-theorem/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-theorem/CHANGELOG b/copilot-theorem/CHANGELOG index 03facaf36..fd4dea25b 100644 --- a/copilot-theorem/CHANGELOG +++ b/copilot-theorem/CHANGELOG @@ -1,3 +1,6 @@ +2026-06-09 + * Extend range of versions of Kind2. (#734) + 2026-05-07 * Version bump (4.7.1). (#730) * Handle special Float values correctly for counterexamples. (#697) From 423e4bd95130c1148a0a8ab826d732892ee25468 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 7 Jul 2026 23:20:12 -0700 Subject: [PATCH 1108/1222] copilot-core: Version bump (4.8). Refs #745. --- copilot-core/copilot-core.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot-core/copilot-core.cabal b/copilot-core/copilot-core.cabal index ee463977c..541cad1e3 100644 --- a/copilot-core/copilot-core.cabal +++ b/copilot-core/copilot-core.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-core -version: 4.7.1 +version: 4.8 synopsis: An intermediate representation for Copilot. description: Intermediate representation for Copilot. From 068fb4dd5f9f4be6457b722666674fd8d1ee0ad4 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 7 Jul 2026 23:20:12 -0700 Subject: [PATCH 1109/1222] copilot-bluespec: Version bump (4.8). Refs #745. --- copilot-bluespec/copilot-bluespec.cabal | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/copilot-bluespec/copilot-bluespec.cabal b/copilot-bluespec/copilot-bluespec.cabal index ffaadaca2..2cff39b37 100644 --- a/copilot-bluespec/copilot-bluespec.cabal +++ b/copilot-bluespec/copilot-bluespec.cabal @@ -1,6 +1,6 @@ cabal-version : >= 1.10 name : copilot-bluespec -version : 4.7.1 +version : 4.8 synopsis : A compiler for Copilot targeting FPGAs. description : This package is a back-end from Copilot to FPGAs in Bluespec. @@ -51,8 +51,8 @@ library , ieee754 >= 0.8.0 && < 0.9 , pretty >= 1.1.2 && < 1.2 - , copilot-core >= 4.7.1 && < 4.8 - , language-bluespec >= 0.1 && < 0.2 + , copilot-core >= 4.8 && < 4.9 + , language-bluespec >= 0.1 && < 0.2 exposed-modules : Copilot.Compile.Bluespec From e89270da21a828c45ddb39d73c02931f4973ffa2 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 7 Jul 2026 23:20:12 -0700 Subject: [PATCH 1110/1222] copilot-c99: Version bump (4.8). Refs #745. --- copilot-c99/copilot-c99.cabal | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/copilot-c99/copilot-c99.cabal b/copilot-c99/copilot-c99.cabal index d9802bd42..d3defea3f 100644 --- a/copilot-c99/copilot-c99.cabal +++ b/copilot-c99/copilot-c99.cabal @@ -1,6 +1,6 @@ cabal-version : >= 1.10 name : copilot-c99 -version : 4.7.1 +version : 4.8 synopsis : A compiler for Copilot targeting C99. description : This package is a back-end from Copilot to C. @@ -45,7 +45,7 @@ library , mtl >= 2.2 && < 2.4 , pretty >= 1.1 && < 1.2 - , copilot-core >= 4.7.1 && < 4.8 + , copilot-core >= 4.8 && < 4.9 , language-c99 >= 0.2.0 && < 0.3 , language-c99-simple >= 0.3 && < 0.4 From 2d8b28ad156c1546b39aa8cbef83468ba3c545b4 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 7 Jul 2026 23:20:12 -0700 Subject: [PATCH 1111/1222] copilot-prettyprinter: Version bump (4.8). Refs #745. --- copilot-prettyprinter/copilot-prettyprinter.cabal | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/copilot-prettyprinter/copilot-prettyprinter.cabal b/copilot-prettyprinter/copilot-prettyprinter.cabal index c40511c43..393ae9b37 100644 --- a/copilot-prettyprinter/copilot-prettyprinter.cabal +++ b/copilot-prettyprinter/copilot-prettyprinter.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-prettyprinter -version: 4.7.1 +version: 4.8 synopsis: A prettyprinter of Copilot Specifications. description: A prettyprinter of Copilot specifications. @@ -45,7 +45,7 @@ library base >= 4.9 && < 5, pretty >= 1.0 && < 1.2, - copilot-core >= 4.7.1 && < 4.8 + copilot-core >= 4.8 && < 4.9 exposed-modules: From 792d6d9bff09ecec03538e7d82e72779c7596397 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 7 Jul 2026 23:20:12 -0700 Subject: [PATCH 1112/1222] copilot-interpreter: Version bump (4.8). Refs #745. --- copilot-interpreter/copilot-interpreter.cabal | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/copilot-interpreter/copilot-interpreter.cabal b/copilot-interpreter/copilot-interpreter.cabal index 0303bf17b..255d0400d 100644 --- a/copilot-interpreter/copilot-interpreter.cabal +++ b/copilot-interpreter/copilot-interpreter.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-interpreter -version: 4.7.1 +version: 4.8 synopsis: Interpreter for Copilot. description: Interpreter for Copilot. @@ -44,7 +44,7 @@ library base >= 4.9 && < 5, pretty >= 1.0 && < 1.2, - copilot-core >= 4.7.1 && < 4.8 + copilot-core >= 4.8 && < 4.9 exposed-modules: From bce90b0d81f566d61a0b4e136e4f2ee480217823 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 7 Jul 2026 23:20:12 -0700 Subject: [PATCH 1113/1222] copilot-theorem: Version bump (4.8). Refs #745. --- copilot-theorem/copilot-theorem.cabal | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/copilot-theorem/copilot-theorem.cabal b/copilot-theorem/copilot-theorem.cabal index 1c809e3c9..28127ebd0 100644 --- a/copilot-theorem/copilot-theorem.cabal +++ b/copilot-theorem/copilot-theorem.cabal @@ -14,7 +14,7 @@ description: . -version : 4.7.1 +version : 4.8 license : BSD3 license-file : LICENSE maintainer : Ivan Perez @@ -63,8 +63,8 @@ library , transformers >= 0.5 && < 0.7 , what4 >= 1.3 && < 1.8 - , copilot-core >= 4.7.1 && < 4.8 - , copilot-prettyprinter >= 4.7.1 && < 4.8 + , copilot-core >= 4.8 && < 4.9 + , copilot-prettyprinter >= 4.8 && < 4.9 exposed-modules : Copilot.Theorem , Copilot.Theorem.Prove From 40b284454e23c9c15963eeba2447e9e6f9c0ea55 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 7 Jul 2026 23:20:12 -0700 Subject: [PATCH 1114/1222] copilot-language: Version bump (4.8). Refs #745. --- copilot-language/copilot-language.cabal | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/copilot-language/copilot-language.cabal b/copilot-language/copilot-language.cabal index 2cfab8eb8..ca5232a8c 100644 --- a/copilot-language/copilot-language.cabal +++ b/copilot-language/copilot-language.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-language -version: 4.7.1 +version: 4.8 synopsis: A Haskell-embedded DSL for monitoring hard real-time distributed systems. description: @@ -42,9 +42,9 @@ library , data-reify >= 0.6 && < 0.7 , mtl >= 2.0 && < 3 - , copilot-core >= 4.7.1 && < 4.8 - , copilot-interpreter >= 4.7.1 && < 4.8 - , copilot-theorem >= 4.7.1 && < 4.8 + , copilot-core >= 4.8 && < 4.9 + , copilot-interpreter >= 4.8 && < 4.9 + , copilot-theorem >= 4.8 && < 4.9 exposed-modules: Copilot.Language , Copilot.Language.Operators.BitWise From 27e4a4988ae552850ac4c9227a74fc682af14482 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 7 Jul 2026 23:20:12 -0700 Subject: [PATCH 1115/1222] copilot-libraries: Version bump (4.8). Refs #745. --- copilot-libraries/copilot-libraries.cabal | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/copilot-libraries/copilot-libraries.cabal b/copilot-libraries/copilot-libraries.cabal index 85b117f63..dd96c07d4 100644 --- a/copilot-libraries/copilot-libraries.cabal +++ b/copilot-libraries/copilot-libraries.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-libraries -version: 4.7.1 +version: 4.8 synopsis: Libraries for the Copilot language. description: Libraries for the Copilot language. @@ -41,7 +41,7 @@ library , containers >= 0.4 && < 0.9 , mtl >= 2.0 && < 2.4 , parsec >= 2.0 && < 3.2 - , copilot-language >= 4.7.1 && < 4.8 + , copilot-language >= 4.8 && < 4.9 exposed-modules: Copilot.Library.Analysis From 766bf4f787fde14e88d6cf32e1e28c848b7b93c0 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 7 Jul 2026 23:20:12 -0700 Subject: [PATCH 1116/1222] copilot-verifier: Version bump (4.8). Refs #745. --- copilot-verifier/copilot-verifier.cabal | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/copilot-verifier/copilot-verifier.cabal b/copilot-verifier/copilot-verifier.cabal index 339892ec9..aed3a0f10 100644 --- a/copilot-verifier/copilot-verifier.cabal +++ b/copilot-verifier/copilot-verifier.cabal @@ -1,6 +1,6 @@ Cabal-version: 2.2 Name: copilot-verifier -Version: 4.7.1 +Version: 4.8 Author: Galois Inc. Maintainer: rscott@galois.com Copyright: (c) Galois, Inc 2021-2024 @@ -45,9 +45,9 @@ common bldflags bv-sized >= 1.0.0 && < 1.1, bytestring, containers >= 0.5.9.0, - copilot-c99 >= 4.7.1 && < 4.8, - copilot-core >= 4.7.1 && < 4.8, - copilot-theorem >= 4.7.1 && < 4.8, + copilot-c99 >= 4.8 && < 4.9, + copilot-core >= 4.8 && < 4.9, + copilot-theorem >= 4.8 && < 4.9, crucible >= 0.7.1 && < 0.8, crucible-llvm >= 0.7 && < 0.8, crux >= 0.7.1 && < 0.8, @@ -80,10 +80,10 @@ library copilot-verifier-examples hs-source-dirs: examples build-depends: case-insensitive, - copilot >= 4.7.1 && < 4.8, - copilot-language >= 4.7.1 && < 4.8, - copilot-libraries >= 4.7.1 && < 4.8, - copilot-prettyprinter >= 4.7.1 && < 4.8, + copilot >= 4.8 && < 4.9, + copilot-language >= 4.8 && < 4.9, + copilot-libraries >= 4.8 && < 4.9, + copilot-prettyprinter >= 4.8 && < 4.9, copilot-verifier exposed-modules: Copilot.Verifier.Examples From cb850da8408028c9628697e87c7c81ef6a385e81 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 7 Jul 2026 23:20:12 -0700 Subject: [PATCH 1117/1222] copilot-visualizer: Version bump (4.8). Refs #745. --- copilot-visualizer/copilot-visualizer.cabal | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/copilot-visualizer/copilot-visualizer.cabal b/copilot-visualizer/copilot-visualizer.cabal index 5e8735ea4..1bd88608a 100644 --- a/copilot-visualizer/copilot-visualizer.cabal +++ b/copilot-visualizer/copilot-visualizer.cabal @@ -1,6 +1,6 @@ cabal-version: >= 1.10 name: copilot-visualizer -version: 4.7.1 +version: 4.8 synopsis: Visualizer for Copilot. description: Visualizer for Copilot. @@ -65,10 +65,10 @@ library text >= 1.2.3.1 && < 2.2, websockets >= 0.12.7 && < 0.14, - copilot >= 4.7.1 && < 4.8, - copilot-core >= 4.7.1 && < 4.8, - copilot-interpreter >= 4.7.1 && < 4.8, - copilot-language >= 4.7.1 && < 4.8 + copilot >= 4.8 && < 4.9, + copilot-core >= 4.8 && < 4.9, + copilot-interpreter >= 4.8 && < 4.9, + copilot-language >= 4.8 && < 4.9 exposed-modules: From 2eabea860dbc45ec2b6f406d6484a15f854e6762 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 7 Jul 2026 23:20:12 -0700 Subject: [PATCH 1118/1222] copilot: Version bump (4.8). Refs #745. --- copilot/copilot.cabal | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/copilot/copilot.cabal b/copilot/copilot.cabal index ace61023d..85dd95ab0 100644 --- a/copilot/copilot.cabal +++ b/copilot/copilot.cabal @@ -1,5 +1,5 @@ name: copilot -version: 4.7.1 +version: 4.8 cabal-version: >= 1.10 license: BSD3 license-file: LICENSE @@ -52,12 +52,12 @@ library , directory >= 1.3 && < 1.4 , filepath >= 1.4 && < 1.6 - , copilot-core >= 4.7.1 && < 4.8 - , copilot-theorem >= 4.7.1 && < 4.8 - , copilot-language >= 4.7.1 && < 4.8 - , copilot-libraries >= 4.7.1 && < 4.8 - , copilot-c99 >= 4.7.1 && < 4.8 - , copilot-prettyprinter >= 4.7.1 && < 4.8 + , copilot-core >= 4.8 && < 4.9 + , copilot-theorem >= 4.8 && < 4.9 + , copilot-language >= 4.8 && < 4.9 + , copilot-libraries >= 4.8 && < 4.9 + , copilot-c99 >= 4.8 && < 4.9 + , copilot-prettyprinter >= 4.8 && < 4.9 exposed-modules: Language.Copilot, Language.Copilot.Main From 254abaa94f82bc8fd0b7b05d047c197f6c5c55d3 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 7 Jul 2026 23:21:58 -0700 Subject: [PATCH 1119/1222] copilot-core: Document changes in CHANGELOG. Refs #745. --- copilot-core/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-core/CHANGELOG b/copilot-core/CHANGELOG index 4a019a359..e37d60585 100644 --- a/copilot-core/CHANGELOG +++ b/copilot-core/CHANGELOG @@ -1,3 +1,6 @@ +2026-07-07 + * Version bump (4.8). (#745) + 2026-05-07 * Version bump (4.7.1). (#730) From 88d7cf5abd9b1ff4171ca9635e5549bffddb2749 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 7 Jul 2026 23:21:58 -0700 Subject: [PATCH 1120/1222] copilot-bluespec: Document changes in CHANGELOG. Refs #745. --- copilot-bluespec/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-bluespec/CHANGELOG b/copilot-bluespec/CHANGELOG index 63ea6878b..1145b7a83 100644 --- a/copilot-bluespec/CHANGELOG +++ b/copilot-bluespec/CHANGELOG @@ -1,3 +1,6 @@ +2026-07-07 + * Version bump (4.8). (#745) + 2026-05-07 * Version bump (4.7.1). (#730) * Fix translation of special Float values to Bluespec. (#697) From ad9bce157314386f729048cdc9143414f40be55a Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 7 Jul 2026 23:21:58 -0700 Subject: [PATCH 1121/1222] copilot-c99: Document changes in CHANGELOG. Refs #745. --- copilot-c99/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-c99/CHANGELOG b/copilot-c99/CHANGELOG index 74c6c1dd4..ba43b631d 100644 --- a/copilot-c99/CHANGELOG +++ b/copilot-c99/CHANGELOG @@ -1,3 +1,6 @@ +2026-07-07 + * Version bump (4.8). (#745) + 2026-05-07 * Version bump (4.7.1). (#730) From 310c80ddf67e8dc10401da6a305189e54ba91575 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 7 Jul 2026 23:21:58 -0700 Subject: [PATCH 1122/1222] copilot-prettyprinter: Document changes in CHANGELOG. Refs #745. --- copilot-prettyprinter/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-prettyprinter/CHANGELOG b/copilot-prettyprinter/CHANGELOG index a8e6d3e12..7ffd6c90d 100644 --- a/copilot-prettyprinter/CHANGELOG +++ b/copilot-prettyprinter/CHANGELOG @@ -1,3 +1,6 @@ +2026-07-07 + * Version bump (4.8). (#745) + 2026-05-07 * Version bump (4.7.1). (#730) From e27694855d0c8a8ff6aa6ca1c106615da9266509 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 7 Jul 2026 23:21:58 -0700 Subject: [PATCH 1123/1222] copilot-interpreter: Document changes in CHANGELOG. Refs #745. --- copilot-interpreter/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-interpreter/CHANGELOG b/copilot-interpreter/CHANGELOG index 53984488e..d97f4575e 100644 --- a/copilot-interpreter/CHANGELOG +++ b/copilot-interpreter/CHANGELOG @@ -1,3 +1,6 @@ +2026-07-07 + * Version bump (4.8). (#745) + 2026-05-07 * Version bump (4.7.1). (#730) From f45759c245e82df5095071acf926b41bf046f514 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 7 Jul 2026 23:21:58 -0700 Subject: [PATCH 1124/1222] copilot-theorem: Document changes in CHANGELOG. Refs #745. --- copilot-theorem/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot-theorem/CHANGELOG b/copilot-theorem/CHANGELOG index fd4dea25b..ec8dafd5a 100644 --- a/copilot-theorem/CHANGELOG +++ b/copilot-theorem/CHANGELOG @@ -1,4 +1,5 @@ -2026-06-09 +2026-07-07 + * Version bump (4.8). (#745) * Extend range of versions of Kind2. (#734) 2026-05-07 From d67b8c87f752bc326d270801cad35c3afdde1ac7 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 7 Jul 2026 23:21:58 -0700 Subject: [PATCH 1125/1222] copilot-language: Document changes in CHANGELOG. Refs #745. --- copilot-language/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-language/CHANGELOG b/copilot-language/CHANGELOG index 069d20f5d..b162f316a 100644 --- a/copilot-language/CHANGELOG +++ b/copilot-language/CHANGELOG @@ -1,3 +1,6 @@ +2026-07-07 + * Version bump (4.8). (#745) + 2026-05-07 * Version bump (4.7.1). (#730) From 2fddcea36646277ce88ce1f1719144156019b64e Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 7 Jul 2026 23:21:58 -0700 Subject: [PATCH 1126/1222] copilot-libraries: Document changes in CHANGELOG. Refs #745. --- copilot-libraries/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-libraries/CHANGELOG b/copilot-libraries/CHANGELOG index 19b510a63..b09286048 100644 --- a/copilot-libraries/CHANGELOG +++ b/copilot-libraries/CHANGELOG @@ -1,3 +1,6 @@ +2026-07-07 + * Version bump (4.8). (#745) + 2026-05-07 * Version bump (4.7.1). (#730) * Add stream analysis module. (#726) From d081479e1d86a9fc7479cb233d5c2b84b2c3ff17 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 7 Jul 2026 23:21:58 -0700 Subject: [PATCH 1127/1222] copilot-verifier: Document changes in CHANGELOG. Refs #745. --- copilot-verifier/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-verifier/CHANGELOG b/copilot-verifier/CHANGELOG index a2b4dd530..81d2534f7 100644 --- a/copilot-verifier/CHANGELOG +++ b/copilot-verifier/CHANGELOG @@ -1,3 +1,6 @@ +2026-07-07 + * Version bump (4.8). (#745) + 2026-05-07 * Version bump (4.7.1). (#730) From 8d17366634029cb76a13d0a42f0622cf168a9192 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 7 Jul 2026 23:21:58 -0700 Subject: [PATCH 1128/1222] copilot-visualizer: Document changes in CHANGELOG. Refs #745. --- copilot-visualizer/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-visualizer/CHANGELOG b/copilot-visualizer/CHANGELOG index 0735d51ab..e4a74c508 100644 --- a/copilot-visualizer/CHANGELOG +++ b/copilot-visualizer/CHANGELOG @@ -1,3 +1,6 @@ +2026-07-07 + * Version bump (4.8). (#745) + 2026-05-07 * Version bump (4.7.1). (#730) From 88a6761537c5d7ae0b0efcd48e6ce59bcae22788 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 7 Jul 2026 23:21:58 -0700 Subject: [PATCH 1129/1222] copilot: Document changes in CHANGELOG. Refs #745. --- copilot/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot/CHANGELOG b/copilot/CHANGELOG index f58dd30e6..f46d51f91 100644 --- a/copilot/CHANGELOG +++ b/copilot/CHANGELOG @@ -1,3 +1,6 @@ +2026-07-07 + * Version bump (4.8). (#745) + 2026-05-07 * Version bump (4.7.1). (#730) From ab2f6a50d4e9ef08e0f27d03275cacb329051f8f Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 7 Sep 2026 22:41:08 -0700 Subject: [PATCH 1130/1222] copilot: Disable secure mode in Cabal in Travis CI. Refs #753. CI is failing during the Haskell setup step with the following error: ``` /root.json does not have enough signatures signed with the appropriate keys ``` It is possible to circumvent this error by configuring Cabal to not operate in secure mode. This commit modifies the Travis CI script to disable secure mode when connecting to Hackage. To be able to modify the settings for that repository, we first have Cabal create a default configuration file. --- .travis.yml | 2 ++ 1 file changed, 2 insertions(+) diff --git a/.travis.yml b/.travis.yml index c7c69118d..f157c7aa8 100644 --- a/.travis.yml +++ b/.travis.yml @@ -26,6 +26,8 @@ before_install: - export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$PATH - cabal --version - echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo '?')]" + - cabal user-config init + - sed -i -e "s;-- \(secure.\) True;\1 False;g" ${HOME}/.cabal/config - travis_retry cabal update - git submodule update --remote From 9d6b38cf42822ae0301e193842eb7b6184280d6c Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 8 Sep 2026 06:25:27 +0000 Subject: [PATCH 1131/1222] copilot: Document changes in CHANGELOG. Refs #753. --- copilot/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot/CHANGELOG b/copilot/CHANGELOG index f46d51f91..d497447c5 100644 --- a/copilot/CHANGELOG +++ b/copilot/CHANGELOG @@ -1,3 +1,6 @@ +2026-09-07 + * Disable secure mode in Cabal in Travis CI. (#753) + 2026-07-07 * Version bump (4.8). (#745) From 68c299123faeb92ece2223b90394da7ab7d03945 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 23 Aug 2026 19:02:15 +0000 Subject: [PATCH 1132/1222] copilot-visualizer: Fix inconsistent version bounds for `copilot` in Cabal file. Refs #749. The cabal file of `copilot-visualizer` lists inconsistent version bounds for the package `copilot`. Specifically, it depends on `copilot` versions from 4.8 to, but not including, 4.9 for the visualizer library, and from 4.7 up to, but not including, 4.8 for the `gui-example` executable. This prevents the example from being compiled against the same version of the library. This commit fixes the version bounds on `copilot` in the `gui-example` executable so that they match the version bounds applied to the `copilot-visualizer` library. --- copilot-visualizer/copilot-visualizer.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot-visualizer/copilot-visualizer.cabal b/copilot-visualizer/copilot-visualizer.cabal index 1bd88608a..4284c9886 100644 --- a/copilot-visualizer/copilot-visualizer.cabal +++ b/copilot-visualizer/copilot-visualizer.cabal @@ -121,7 +121,7 @@ executable tikz-example build-depends: base >= 4.9 && < 5, - copilot >= 4.7 && < 4.8, + copilot >= 4.8 && < 4.9, copilot-visualizer if flag(examples) From b58fab18c8065aa1311e053809d9f7befe78ab2b Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 23 Aug 2026 19:05:39 +0000 Subject: [PATCH 1133/1222] copilot-visualizer: Document changes in CHANGELOG. Refs #749. --- copilot-visualizer/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-visualizer/CHANGELOG b/copilot-visualizer/CHANGELOG index e4a74c508..5e16e81f4 100644 --- a/copilot-visualizer/CHANGELOG +++ b/copilot-visualizer/CHANGELOG @@ -1,3 +1,6 @@ +2026-08-23 + * Fix inconsistent version bounds for `copilot` in Cabal file. (#749) + 2026-07-07 * Version bump (4.8). (#745) From c191a7365122492eef4cfbc7ae722d76eea97cc4 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 7 May 2026 23:59:33 -0700 Subject: [PATCH 1134/1222] copilot-bluespec: Replace tab in CHANGELOG. Refs #755. The CHANGELOG of the `copilot-bluespec` package contains a tab character. Per our style guide, we should not use tabs anywhere in code, READMEs or CHANGELOGs, unless strictly necessary. This commit replaces a tab in the CHANGELOG of `copilot-bluespec` with spaces. --- copilot-bluespec/CHANGELOG | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot-bluespec/CHANGELOG b/copilot-bluespec/CHANGELOG index 1145b7a83..f47fdd362 100644 --- a/copilot-bluespec/CHANGELOG +++ b/copilot-bluespec/CHANGELOG @@ -11,7 +11,7 @@ 2026-01-07 * Version bump (4.6.1). (#705) * Disable test suite via newly added manual cabal flag. (#673) - * Fix translation of constant floating-point values. (#696) + * Fix translation of constant floating-point values. (#696) 2025-11-07 * Version bump (4.6). (#679) From 181d8033634c91cb747ef3b59c57dded2d3fbc04 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 7 May 2026 23:59:33 -0700 Subject: [PATCH 1135/1222] copilot-bluespec: Document changes in CHANGELOG. Refs #755. --- copilot-bluespec/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-bluespec/CHANGELOG b/copilot-bluespec/CHANGELOG index f47fdd362..29e143842 100644 --- a/copilot-bluespec/CHANGELOG +++ b/copilot-bluespec/CHANGELOG @@ -1,3 +1,6 @@ +2026-08-22 + * Replace tab in CHANGELOG. (#755) + 2026-07-07 * Version bump (4.8). (#745) From ddeb5985817a0be1a75df8e9c7aa1215e4b19db1 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 30 Jul 2026 23:08:01 -0700 Subject: [PATCH 1136/1222] copilot-visualizer: Relax version constraints on `ogma-extra`. Refs #757. In order to keep Copilot effectively working in the current Haskell ecosystem, as well as new versions of GHC, we need to extend the versions of dependencies that Copilot can be installed with. The package `ogma-extra` has seen release 1.15 and will soon see release 1.16, but `copilot-visualizer` depend on versions prior to 1.13. This commit relaxes the version constrains on `ogma-extra` for the `copilot-visualizer` package. --- copilot-visualizer/copilot-visualizer.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot-visualizer/copilot-visualizer.cabal b/copilot-visualizer/copilot-visualizer.cabal index 4284c9886..bb523bfc3 100644 --- a/copilot-visualizer/copilot-visualizer.cabal +++ b/copilot-visualizer/copilot-visualizer.cabal @@ -61,7 +61,7 @@ library filepath >= 1.4.2 && < 1.6, hint >= 0.9.0 && < 1.10, pretty >= 1.0 && < 1.2, - ogma-extra >= 1.6.0 && < 1.13, + ogma-extra >= 1.6.0 && < 1.17, text >= 1.2.3.1 && < 2.2, websockets >= 0.12.7 && < 0.14, From 0743773609d47c3a0070e627239c5596ccd2f2d8 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 30 Jul 2026 23:10:12 -0700 Subject: [PATCH 1137/1222] copilot-visualizer: Document changes in CHANGELOG. Refs #757. --- copilot-visualizer/CHANGELOG | 1 + 1 file changed, 1 insertion(+) diff --git a/copilot-visualizer/CHANGELOG b/copilot-visualizer/CHANGELOG index 5e16e81f4..5c358e534 100644 --- a/copilot-visualizer/CHANGELOG +++ b/copilot-visualizer/CHANGELOG @@ -1,5 +1,6 @@ 2026-08-23 * Fix inconsistent version bounds for `copilot` in Cabal file. (#749) + * Relax version constraints on `ogma-extra`. (#757) 2026-07-07 * Version bump (4.8). (#745) From 0f1ebfc759daaaf27a01dc3f5b4fc25cda8ddca9 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 21 Aug 2026 19:20:54 -0700 Subject: [PATCH 1138/1222] copilot-theorem: Remove unnecessary extension. Refs #733. The module `copilot-theorem:Copilot.Theorem.What4.Translate` enables the language extension `PatternSynonyms` unnecessarily. Nothing in the module requires that extension and it should continue to compile without it. Per our style guide to remove unused code and minimize extensions, this extension should be removed from that module. This commit removes the unnecessary extension from the `copilot-theorem:Copilot.Theorem.What4.Translate` module. --- copilot-theorem/src/Copilot/Theorem/What4/Translate.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/copilot-theorem/src/Copilot/Theorem/What4/Translate.hs b/copilot-theorem/src/Copilot/Theorem/What4/Translate.hs index cef4829ee..00edf8744 100644 --- a/copilot-theorem/src/Copilot/Theorem/What4/Translate.hs +++ b/copilot-theorem/src/Copilot/Theorem/What4/Translate.hs @@ -2,7 +2,6 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} From a26633e64929c8f19d0cb922e9acb39a07460c61 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 21 Aug 2026 20:12:01 -0700 Subject: [PATCH 1139/1222] copilot-theorem: Document changes in CHANGELOG. Refs #733. --- copilot-theorem/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-theorem/CHANGELOG b/copilot-theorem/CHANGELOG index ec8dafd5a..140644e06 100644 --- a/copilot-theorem/CHANGELOG +++ b/copilot-theorem/CHANGELOG @@ -1,3 +1,6 @@ +2026-08-21 + * Remove unnecessary extension. (#733) + 2026-07-07 * Version bump (4.8). (#745) * Extend range of versions of Kind2. (#734) From 2489e6a227824dadd57bdccd9899600a1a02bf26 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 7 Sep 2026 10:06:17 -0700 Subject: [PATCH 1140/1222] copilot-core: Version bump (4.8.1). Refs #760. --- copilot-core/copilot-core.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot-core/copilot-core.cabal b/copilot-core/copilot-core.cabal index 541cad1e3..57f92d703 100644 --- a/copilot-core/copilot-core.cabal +++ b/copilot-core/copilot-core.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-core -version: 4.8 +version: 4.8.1 synopsis: An intermediate representation for Copilot. description: Intermediate representation for Copilot. From 1456edb773725a174066f731f86191e672fb4b14 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 7 Sep 2026 10:06:17 -0700 Subject: [PATCH 1141/1222] copilot-bluespec: Version bump (4.8.1). Refs #760. --- copilot-bluespec/copilot-bluespec.cabal | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/copilot-bluespec/copilot-bluespec.cabal b/copilot-bluespec/copilot-bluespec.cabal index 2cff39b37..e8f29e4d7 100644 --- a/copilot-bluespec/copilot-bluespec.cabal +++ b/copilot-bluespec/copilot-bluespec.cabal @@ -1,6 +1,6 @@ cabal-version : >= 1.10 name : copilot-bluespec -version : 4.8 +version : 4.8.1 synopsis : A compiler for Copilot targeting FPGAs. description : This package is a back-end from Copilot to FPGAs in Bluespec. @@ -51,7 +51,7 @@ library , ieee754 >= 0.8.0 && < 0.9 , pretty >= 1.1.2 && < 1.2 - , copilot-core >= 4.8 && < 4.9 + , copilot-core >= 4.8.1 && < 4.9 , language-bluespec >= 0.1 && < 0.2 exposed-modules : Copilot.Compile.Bluespec From 2cc9ce1a0750c42e27636f032272231c32b8f99c Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 7 Sep 2026 10:06:17 -0700 Subject: [PATCH 1142/1222] copilot-c99: Version bump (4.8.1). Refs #760. --- copilot-c99/copilot-c99.cabal | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/copilot-c99/copilot-c99.cabal b/copilot-c99/copilot-c99.cabal index d3defea3f..ea2e233dc 100644 --- a/copilot-c99/copilot-c99.cabal +++ b/copilot-c99/copilot-c99.cabal @@ -1,6 +1,6 @@ cabal-version : >= 1.10 name : copilot-c99 -version : 4.8 +version : 4.8.1 synopsis : A compiler for Copilot targeting C99. description : This package is a back-end from Copilot to C. @@ -45,7 +45,7 @@ library , mtl >= 2.2 && < 2.4 , pretty >= 1.1 && < 1.2 - , copilot-core >= 4.8 && < 4.9 + , copilot-core >= 4.8.1 && < 4.9 , language-c99 >= 0.2.0 && < 0.3 , language-c99-simple >= 0.3 && < 0.4 From 80b8ed216fd791cf4c23efd1f14affbdea5b511e Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 7 Sep 2026 10:06:17 -0700 Subject: [PATCH 1143/1222] copilot-prettyprinter: Version bump (4.8.1). Refs #760. --- copilot-prettyprinter/copilot-prettyprinter.cabal | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/copilot-prettyprinter/copilot-prettyprinter.cabal b/copilot-prettyprinter/copilot-prettyprinter.cabal index 393ae9b37..d6c2bcc11 100644 --- a/copilot-prettyprinter/copilot-prettyprinter.cabal +++ b/copilot-prettyprinter/copilot-prettyprinter.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-prettyprinter -version: 4.8 +version: 4.8.1 synopsis: A prettyprinter of Copilot Specifications. description: A prettyprinter of Copilot specifications. @@ -45,7 +45,7 @@ library base >= 4.9 && < 5, pretty >= 1.0 && < 1.2, - copilot-core >= 4.8 && < 4.9 + copilot-core >= 4.8.1 && < 4.9 exposed-modules: From 6c233a078660e35ce9d9acc0b485b0f793430d11 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 7 Sep 2026 10:06:17 -0700 Subject: [PATCH 1144/1222] copilot-interpreter: Version bump (4.8.1). Refs #760. --- copilot-interpreter/copilot-interpreter.cabal | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/copilot-interpreter/copilot-interpreter.cabal b/copilot-interpreter/copilot-interpreter.cabal index 255d0400d..538237a10 100644 --- a/copilot-interpreter/copilot-interpreter.cabal +++ b/copilot-interpreter/copilot-interpreter.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-interpreter -version: 4.8 +version: 4.8.1 synopsis: Interpreter for Copilot. description: Interpreter for Copilot. @@ -44,7 +44,7 @@ library base >= 4.9 && < 5, pretty >= 1.0 && < 1.2, - copilot-core >= 4.8 && < 4.9 + copilot-core >= 4.8.1 && < 4.9 exposed-modules: From ac3e269d6669d890adf5e9a456c691d7bb3451fd Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 7 Sep 2026 10:06:17 -0700 Subject: [PATCH 1145/1222] copilot-theorem: Version bump (4.8.1). Refs #760. --- copilot-theorem/copilot-theorem.cabal | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/copilot-theorem/copilot-theorem.cabal b/copilot-theorem/copilot-theorem.cabal index 28127ebd0..cf3e8c44c 100644 --- a/copilot-theorem/copilot-theorem.cabal +++ b/copilot-theorem/copilot-theorem.cabal @@ -14,7 +14,7 @@ description: . -version : 4.8 +version : 4.8.1 license : BSD3 license-file : LICENSE maintainer : Ivan Perez @@ -63,8 +63,8 @@ library , transformers >= 0.5 && < 0.7 , what4 >= 1.3 && < 1.8 - , copilot-core >= 4.8 && < 4.9 - , copilot-prettyprinter >= 4.8 && < 4.9 + , copilot-core >= 4.8.1 && < 4.9 + , copilot-prettyprinter >= 4.8.1 && < 4.9 exposed-modules : Copilot.Theorem , Copilot.Theorem.Prove From 54f48abbf4de3d99c7bf7c761a56294ecde8a6ce Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 7 Sep 2026 10:06:17 -0700 Subject: [PATCH 1146/1222] copilot-language: Version bump (4.8.1). Refs #760. --- copilot-language/copilot-language.cabal | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/copilot-language/copilot-language.cabal b/copilot-language/copilot-language.cabal index ca5232a8c..b30c29db6 100644 --- a/copilot-language/copilot-language.cabal +++ b/copilot-language/copilot-language.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-language -version: 4.8 +version: 4.8.1 synopsis: A Haskell-embedded DSL for monitoring hard real-time distributed systems. description: @@ -42,9 +42,9 @@ library , data-reify >= 0.6 && < 0.7 , mtl >= 2.0 && < 3 - , copilot-core >= 4.8 && < 4.9 - , copilot-interpreter >= 4.8 && < 4.9 - , copilot-theorem >= 4.8 && < 4.9 + , copilot-core >= 4.8.1 && < 4.9 + , copilot-interpreter >= 4.8.1 && < 4.9 + , copilot-theorem >= 4.8.1 && < 4.9 exposed-modules: Copilot.Language , Copilot.Language.Operators.BitWise From 163025363de77403c37c86cbf8663d6bae22766b Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 7 Sep 2026 10:06:17 -0700 Subject: [PATCH 1147/1222] copilot-libraries: Version bump (4.8.1). Refs #760. --- copilot-libraries/copilot-libraries.cabal | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/copilot-libraries/copilot-libraries.cabal b/copilot-libraries/copilot-libraries.cabal index dd96c07d4..aa5c8e61b 100644 --- a/copilot-libraries/copilot-libraries.cabal +++ b/copilot-libraries/copilot-libraries.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-libraries -version: 4.8 +version: 4.8.1 synopsis: Libraries for the Copilot language. description: Libraries for the Copilot language. @@ -41,7 +41,7 @@ library , containers >= 0.4 && < 0.9 , mtl >= 2.0 && < 2.4 , parsec >= 2.0 && < 3.2 - , copilot-language >= 4.8 && < 4.9 + , copilot-language >= 4.8.1 && < 4.9 exposed-modules: Copilot.Library.Analysis From 512df9749adaefa13cbdf61c0974775458a6d6de Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 7 Sep 2026 10:06:17 -0700 Subject: [PATCH 1148/1222] copilot-verifier: Version bump (4.8.1). Refs #760. --- copilot-verifier/copilot-verifier.cabal | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/copilot-verifier/copilot-verifier.cabal b/copilot-verifier/copilot-verifier.cabal index aed3a0f10..4052ee006 100644 --- a/copilot-verifier/copilot-verifier.cabal +++ b/copilot-verifier/copilot-verifier.cabal @@ -1,6 +1,6 @@ Cabal-version: 2.2 Name: copilot-verifier -Version: 4.8 +Version: 4.8.1 Author: Galois Inc. Maintainer: rscott@galois.com Copyright: (c) Galois, Inc 2021-2024 @@ -45,9 +45,9 @@ common bldflags bv-sized >= 1.0.0 && < 1.1, bytestring, containers >= 0.5.9.0, - copilot-c99 >= 4.8 && < 4.9, - copilot-core >= 4.8 && < 4.9, - copilot-theorem >= 4.8 && < 4.9, + copilot-c99 >= 4.8.1 && < 4.9, + copilot-core >= 4.8.1 && < 4.9, + copilot-theorem >= 4.8.1 && < 4.9, crucible >= 0.7.1 && < 0.8, crucible-llvm >= 0.7 && < 0.8, crux >= 0.7.1 && < 0.8, @@ -80,10 +80,10 @@ library copilot-verifier-examples hs-source-dirs: examples build-depends: case-insensitive, - copilot >= 4.8 && < 4.9, - copilot-language >= 4.8 && < 4.9, - copilot-libraries >= 4.8 && < 4.9, - copilot-prettyprinter >= 4.8 && < 4.9, + copilot >= 4.8.1 && < 4.9, + copilot-language >= 4.8.1 && < 4.9, + copilot-libraries >= 4.8.1 && < 4.9, + copilot-prettyprinter >= 4.8.1 && < 4.9, copilot-verifier exposed-modules: Copilot.Verifier.Examples From c9b995ff5de9a0c717ee683a7016d81db47cfe5f Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 7 Sep 2026 10:06:17 -0700 Subject: [PATCH 1149/1222] copilot-visualizer: Version bump (4.8.1). Refs #760. --- copilot-visualizer/copilot-visualizer.cabal | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/copilot-visualizer/copilot-visualizer.cabal b/copilot-visualizer/copilot-visualizer.cabal index bb523bfc3..3b1d539eb 100644 --- a/copilot-visualizer/copilot-visualizer.cabal +++ b/copilot-visualizer/copilot-visualizer.cabal @@ -1,6 +1,6 @@ cabal-version: >= 1.10 name: copilot-visualizer -version: 4.8 +version: 4.8.1 synopsis: Visualizer for Copilot. description: Visualizer for Copilot. @@ -65,10 +65,10 @@ library text >= 1.2.3.1 && < 2.2, websockets >= 0.12.7 && < 0.14, - copilot >= 4.8 && < 4.9, - copilot-core >= 4.8 && < 4.9, - copilot-interpreter >= 4.8 && < 4.9, - copilot-language >= 4.8 && < 4.9 + copilot >= 4.8.1 && < 4.9, + copilot-core >= 4.8.1 && < 4.9, + copilot-interpreter >= 4.8.1 && < 4.9, + copilot-language >= 4.8.1 && < 4.9 exposed-modules: @@ -121,7 +121,7 @@ executable tikz-example build-depends: base >= 4.9 && < 5, - copilot >= 4.8 && < 4.9, + copilot >= 4.8.1 && < 4.9, copilot-visualizer if flag(examples) From 0719333a6df5eb0414876cd9e5eb0671f87f6db9 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 7 Sep 2026 10:06:17 -0700 Subject: [PATCH 1150/1222] copilot: Version bump (4.8.1). Refs #760. --- copilot/copilot.cabal | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/copilot/copilot.cabal b/copilot/copilot.cabal index 85dd95ab0..5fa90035e 100644 --- a/copilot/copilot.cabal +++ b/copilot/copilot.cabal @@ -1,5 +1,5 @@ name: copilot -version: 4.8 +version: 4.8.1 cabal-version: >= 1.10 license: BSD3 license-file: LICENSE @@ -52,12 +52,12 @@ library , directory >= 1.3 && < 1.4 , filepath >= 1.4 && < 1.6 - , copilot-core >= 4.8 && < 4.9 - , copilot-theorem >= 4.8 && < 4.9 - , copilot-language >= 4.8 && < 4.9 - , copilot-libraries >= 4.8 && < 4.9 - , copilot-c99 >= 4.8 && < 4.9 - , copilot-prettyprinter >= 4.8 && < 4.9 + , copilot-core >= 4.8.1 && < 4.9 + , copilot-theorem >= 4.8.1 && < 4.9 + , copilot-language >= 4.8.1 && < 4.9 + , copilot-libraries >= 4.8.1 && < 4.9 + , copilot-c99 >= 4.8.1 && < 4.9 + , copilot-prettyprinter >= 4.8.1 && < 4.9 exposed-modules: Language.Copilot, Language.Copilot.Main From 69468e7f7b3b05a18faafe8822befa442d92f755 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 7 Sep 2026 10:09:38 -0700 Subject: [PATCH 1151/1222] copilot-core: Document changes in CHANGELOG. Refs #760. --- copilot-core/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-core/CHANGELOG b/copilot-core/CHANGELOG index e37d60585..1ccbf7db4 100644 --- a/copilot-core/CHANGELOG +++ b/copilot-core/CHANGELOG @@ -1,3 +1,6 @@ +2026-09-07 + * Version bump (4.8.1). (#760) + 2026-07-07 * Version bump (4.8). (#745) From a0c12ad617d16b3f6f532b9785da90ffd6d01134 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 7 Sep 2026 10:09:38 -0700 Subject: [PATCH 1152/1222] copilot-bluespec: Document changes in CHANGELOG. Refs #760. --- copilot-bluespec/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot-bluespec/CHANGELOG b/copilot-bluespec/CHANGELOG index 29e143842..3b655c5ac 100644 --- a/copilot-bluespec/CHANGELOG +++ b/copilot-bluespec/CHANGELOG @@ -1,4 +1,5 @@ -2026-08-22 +2026-09-07 + * Version bump (4.8.1). (#760) * Replace tab in CHANGELOG. (#755) 2026-07-07 From 1e8c8be5c72c5fd3f69e51a21941309fc0e4f9bd Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 7 Sep 2026 10:09:38 -0700 Subject: [PATCH 1153/1222] copilot-c99: Document changes in CHANGELOG. Refs #760. --- copilot-c99/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-c99/CHANGELOG b/copilot-c99/CHANGELOG index ba43b631d..2caf70ef2 100644 --- a/copilot-c99/CHANGELOG +++ b/copilot-c99/CHANGELOG @@ -1,3 +1,6 @@ +2026-09-07 + * Version bump (4.8.1). (#760) + 2026-07-07 * Version bump (4.8). (#745) From 8f84c7646e09f5defee92f52b968db8cfe4c25fc Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 7 Sep 2026 10:09:38 -0700 Subject: [PATCH 1154/1222] copilot-prettyprinter: Document changes in CHANGELOG. Refs #760. --- copilot-prettyprinter/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-prettyprinter/CHANGELOG b/copilot-prettyprinter/CHANGELOG index 7ffd6c90d..799783ce8 100644 --- a/copilot-prettyprinter/CHANGELOG +++ b/copilot-prettyprinter/CHANGELOG @@ -1,3 +1,6 @@ +2026-09-07 + * Version bump (4.8.1). (#760) + 2026-07-07 * Version bump (4.8). (#745) From 6ad1e513408324257feb1a2da43e87db074dccaf Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 7 Sep 2026 10:09:38 -0700 Subject: [PATCH 1155/1222] copilot-interpreter: Document changes in CHANGELOG. Refs #760. --- copilot-interpreter/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-interpreter/CHANGELOG b/copilot-interpreter/CHANGELOG index d97f4575e..3e396d8d4 100644 --- a/copilot-interpreter/CHANGELOG +++ b/copilot-interpreter/CHANGELOG @@ -1,3 +1,6 @@ +2026-09-07 + * Version bump (4.8.1). (#760) + 2026-07-07 * Version bump (4.8). (#745) From 5659bf71213834c601e771c739164c8b2c90f307 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 7 Sep 2026 10:09:38 -0700 Subject: [PATCH 1156/1222] copilot-theorem: Document changes in CHANGELOG. Refs #760. --- copilot-theorem/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot-theorem/CHANGELOG b/copilot-theorem/CHANGELOG index 140644e06..251b49484 100644 --- a/copilot-theorem/CHANGELOG +++ b/copilot-theorem/CHANGELOG @@ -1,4 +1,5 @@ -2026-08-21 +2026-09-07 + * Version bump (4.8.1). (#760) * Remove unnecessary extension. (#733) 2026-07-07 From 3f21a9b5ef73203a3f53b7f943e0195f5792dfc8 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 7 Sep 2026 10:09:38 -0700 Subject: [PATCH 1157/1222] copilot-language: Document changes in CHANGELOG. Refs #760. --- copilot-language/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-language/CHANGELOG b/copilot-language/CHANGELOG index b162f316a..49162ceb0 100644 --- a/copilot-language/CHANGELOG +++ b/copilot-language/CHANGELOG @@ -1,3 +1,6 @@ +2026-09-07 + * Version bump (4.8.1). (#760) + 2026-07-07 * Version bump (4.8). (#745) From 2dee7e0dd00a063cce8a6338e9f696581131da3e Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 7 Sep 2026 10:09:38 -0700 Subject: [PATCH 1158/1222] copilot-libraries: Document changes in CHANGELOG. Refs #760. --- copilot-libraries/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-libraries/CHANGELOG b/copilot-libraries/CHANGELOG index b09286048..0e8dcc83f 100644 --- a/copilot-libraries/CHANGELOG +++ b/copilot-libraries/CHANGELOG @@ -1,3 +1,6 @@ +2026-09-07 + * Version bump (4.8.1). (#760) + 2026-07-07 * Version bump (4.8). (#745) From 0206d92bc80463455a973ee57654ecf8dad1d2a0 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 7 Sep 2026 10:09:38 -0700 Subject: [PATCH 1159/1222] copilot-verifier: Document changes in CHANGELOG. Refs #760. --- copilot-verifier/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-verifier/CHANGELOG b/copilot-verifier/CHANGELOG index 81d2534f7..1dec1cfd0 100644 --- a/copilot-verifier/CHANGELOG +++ b/copilot-verifier/CHANGELOG @@ -1,3 +1,6 @@ +2026-09-07 + * Version bump (4.8.1). (#760) + 2026-07-07 * Version bump (4.8). (#745) From 5ce32a8d4c0b9a968c284c325e16b30872cc2985 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 7 Sep 2026 10:09:38 -0700 Subject: [PATCH 1160/1222] copilot-visualizer: Document changes in CHANGELOG. Refs #760. --- copilot-visualizer/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot-visualizer/CHANGELOG b/copilot-visualizer/CHANGELOG index 5c358e534..9d772eca0 100644 --- a/copilot-visualizer/CHANGELOG +++ b/copilot-visualizer/CHANGELOG @@ -1,4 +1,5 @@ -2026-08-23 +2026-09-07 + * Version bump (4.8.1). (#760) * Fix inconsistent version bounds for `copilot` in Cabal file. (#749) * Relax version constraints on `ogma-extra`. (#757) From 1f26417f9a83d12f1d0236ffa4dce5c7907506eb Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 7 Sep 2026 10:09:38 -0700 Subject: [PATCH 1161/1222] copilot: Document changes in CHANGELOG. Refs #760. --- copilot/CHANGELOG | 1 + 1 file changed, 1 insertion(+) diff --git a/copilot/CHANGELOG b/copilot/CHANGELOG index d497447c5..a838b070a 100644 --- a/copilot/CHANGELOG +++ b/copilot/CHANGELOG @@ -1,4 +1,5 @@ 2026-09-07 + * Version bump (4.8.1). (#760) * Disable secure mode in Cabal in Travis CI. (#753) 2026-07-07 From 06c31d052cdbc4be7507b9b041b48ecdbb6354b4 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 11 Oct 2026 08:38:45 -0700 Subject: [PATCH 1162/1222] copilot-core: Force evaluation of `Proxy` value in `Copilot.Core.Type.Array`. Refs #767. The module `copilot-core:Copilot.Core.Type.Array` achieves less than full coverage in the two of the three main categories used by `hpc`, namely "Top Level Definitions" and "Expressions". For the former, only 4 out of 6 definitions are covered, and for the latter, only 47 out of 48. To make Copilot ready for use in future missions, we want to achieve maximum coverage possible. The lower coverage of "Expressions" is due to a `Proxy` value not being forced in a call to `natVal`, which only needs the type-level information for the `Proxy` being provided. This commit modifies the code of `copilot-core:Copilot.Core.Type.Array` to force the evaluation of a `Proxy` value being passed to `natVal`. Specifically, it uses `($!)`, which achieves the evaluation of the value at the point where it is being used, making `hpc` mark it as evaluated. Other alternatives (e.g., use of `seq`, use of `Proxy#`) either do not achieve the desired effect or require more extensive changes and the use of language extensions. --- copilot-core/src/Copilot/Core/Type/Array.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot-core/src/Copilot/Core/Type/Array.hs b/copilot-core/src/Copilot/Core/Type/Array.hs index b11e8949b..07c10ba31 100644 --- a/copilot-core/src/Copilot/Core/Type/Array.hs +++ b/copilot-core/src/Copilot/Core/Type/Array.hs @@ -37,7 +37,7 @@ array xs | datalen == typelen = Array xs | otherwise = error errmsg where datalen = length xs - typelen = fromIntegral $ natVal (Proxy :: Proxy n) + typelen = fromIntegral $ natVal $! (Proxy :: Proxy n) errmsg = "Length of data (" ++ show datalen ++ ") does not match length of type (" ++ show typelen ++ ")." From fa1d30a20a222d551c37a22be7203f71c2a1263e Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 11 Oct 2026 08:39:08 -0700 Subject: [PATCH 1163/1222] copilot-core: Test default functions in `Show` instance for `Array`. Refs #767. The module `copilot-core:Copilot.Core.Type.Array` achieves less than full coverage in the two of the three main categories used by `hpc`, namely "Top Level Definitions" and "Expressions". For the former, only 4 out of 6 definitions are covered, and for the latter, only 47 out of 48. To make Copilot ready for use in future missions, we want to achieve maximum coverage possible. The module `copilot-core:Copilot.Core.Type.Array` includes an instance of the class `Show` for the type `Array`. That instance implicitly declares `showList` and `showsPrec`, set to their default values per the class definition. However, there is no guarantee that the definitions are correct for this specific instance, and `hpc` marks them as not covered unless we explicitly test them, affecting the "Top Level Definitions" score for this library. This commit adds two tests for functions that are implicitly set to their default definitions in the `Show` instance for `Array`. --- .../tests/Test/Copilot/Core/Type/Array.hs | 20 +++++++++++++++++-- 1 file changed, 18 insertions(+), 2 deletions(-) diff --git a/copilot-core/tests/Test/Copilot/Core/Type/Array.hs b/copilot-core/tests/Test/Copilot/Core/Type/Array.hs index e070f138b..0af0ffae9 100644 --- a/copilot-core/tests/Test/Copilot/Core/Type/Array.hs +++ b/copilot-core/tests/Test/Copilot/Core/Type/Array.hs @@ -11,8 +11,9 @@ import Test.Framework (Test, testGroup) import Test.Framework.Providers.QuickCheck2 (testProperty) import Test.QuickCheck (Gen, Property, arbitrary, chooseInt, expectFailure, forAll, - getNegative, getNonNegative, oneof, - property, vector, vectorOf) + getNegative, getNonNegative, + listOf, oneof, property, vector, + vectorOf) -- Internal imports: library modules being tested import Copilot.Core.Type.Array (Array, array, arrayElems, arrayUpdate) @@ -31,6 +32,10 @@ tests = testArrayElemsFail , testProperty "Show for arrays" testShowArray + , testProperty "showsPrec for arrays" + testShowsPrecArray + , testProperty "showList for arrays" + testShowListArray , testProperty "arrayElems (arrayUpdate x i v) !! i == v" (testArrayUpdateElem (Proxy :: Proxy 5)) , testProperty "arrayUpdate x i ((arrayElems x) !! i) == x" @@ -70,6 +75,17 @@ testShowArray :: Property testShowArray = forAll (vector 3) $ \l -> property $ show (array l :: Array 3 Int64) == show (l :: [Int64]) +-- | Test 'Show.showsPrec' for 'Array's. +testShowsPrecArray :: Property +testShowsPrecArray = forAll (getNonNegative <$> arbitrary) $ \prec -> + forAll (vector 3) $ \l -> property $ + showsPrec prec (array l :: Array 3 Int64) "" == show (l :: [Int64]) + +-- | Test 'Show.showList' for 'Array's. +testShowListArray :: Property +testShowListArray = forAll (listOf $ vector 3) $ \l -> property $ + showList (map array l :: [Array 3 Int64]) "" == show (l :: [[Int64]]) + -- | Test that updating an array updates the element appropriately (if we -- project that element we get the value we put in). testArrayUpdateElem :: forall n . KnownNat n => Proxy n -> Property From 34cc90741e8b792d8f55ad7e875a3bdcffe4a122 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 11 Oct 2026 17:16:56 -0700 Subject: [PATCH 1164/1222] copilot-core: Document changes in CHANGELOG. Refs #767. --- copilot-core/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-core/CHANGELOG b/copilot-core/CHANGELOG index 1ccbf7db4..33cf7c007 100644 --- a/copilot-core/CHANGELOG +++ b/copilot-core/CHANGELOG @@ -1,3 +1,6 @@ +2026-10-11 + * Increase test coverage for `Copilot.Core.Type.Array`. (#767) + 2026-09-07 * Version bump (4.8.1). (#760) From ae91b9ad23ddf0f9313ae9f6e3f5d9352969dfb6 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 12 Oct 2026 09:08:19 -0700 Subject: [PATCH 1165/1222] copilot-core: Fix errors in the documentation of `Copilot.Core.Spec`. Refs #769. The Haddock documentation associated to the type `copilot-core:Copilot.Core.Spec.Stream` contains two grammatical errors. The first is the incorrect use of "in" in the sentence "A stream in an infinite succession of values", which causes the sentence to have no verb, and the second is the use of `Stream` in the second paragraph with no article. To make documentation most useful and in compliance with our style guide, the documentation should have no typos or grammatical errors. This commit fixes both grammatical errors in the documentation of `copilot-core:Copilot.Core.Spec.Stream`, as well as a grammatical error in the top-level documentation of the same module. --- copilot-core/src/Copilot/Core/Spec.hs | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/copilot-core/src/Copilot/Core/Spec.hs b/copilot-core/src/Copilot/Core/Spec.hs index 6614d0621..e8972c928 100644 --- a/copilot-core/src/Copilot/Core/Spec.hs +++ b/copilot-core/src/Copilot/Core/Spec.hs @@ -11,9 +11,9 @@ -- and their handling functions, or streams to observe, or a theorem that must -- be proved. -- --- In order to be executed, high-level Copilot Language Spec must be turned --- into Copilot Core's 'Spec'. This module defines the low-level Copilot Core --- representations for Specs and the main types of element in a spec. +-- In order to be executed, a high-level Copilot Language @Spec@ must be +-- turned into a Copilot Core 'Spec'. This module defines the low-level Copilot +-- Core representation for 'Spec' and the main types of element in a spec. module Copilot.Core.Spec ( Stream (..) , Observer (..) @@ -32,9 +32,9 @@ import Data.Typeable (Typeable) import Copilot.Core.Expr (Expr, Id, Name, UExpr) import Copilot.Core.Type (Type, Typed) --- | A stream in an infinite succession of values of the same type. +-- | A stream is an infinite succession of values of the same type. -- --- Stream can carry different types of data. Boolean streams play a special +-- Streams can carry different types of data. Boolean streams play a special -- role: they are used by other parts (e.g., 'Trigger') to detect when the -- properties being monitored are violated. data Stream = forall a . (Typeable a, Typed a) => Stream From ae2dfdb87f54b2288b5e95147830a203bf344382 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 12 Oct 2026 09:09:50 -0700 Subject: [PATCH 1166/1222] copilot-core: Document changes in CHANGELOG. Refs #769. --- copilot-core/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot-core/CHANGELOG b/copilot-core/CHANGELOG index 33cf7c007..9e45e6c5b 100644 --- a/copilot-core/CHANGELOG +++ b/copilot-core/CHANGELOG @@ -1,5 +1,6 @@ -2026-10-11 +2026-10-12 * Increase test coverage for `Copilot.Core.Type.Array`. (#767) + * Fix errors in the documentation of `Copilot.Core.Spec`. (#769) 2026-09-07 * Version bump (4.8.1). (#760) From d567a73e4f00f126b9ed49b7b6065240fa120014 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 12 Oct 2026 10:12:14 -0700 Subject: [PATCH 1167/1222] copilot-core: Replace tab in CHANGELOG. Refs #772. Several files across the codebase contain tabs, including the `DESIGN.md` file in `copilot-bluespec`, the `CHANGELOG` for `copilot-core`, and the `Eval` module in `copilot-interpreter`. Per our style guide, we should not use tabs anywhere in code, READMEs or CHANGELOGs, unless strictly necessary. This commit replaces a tab in the CHANGELOG of `copilot-core` with spaces. --- copilot-core/CHANGELOG | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot-core/CHANGELOG b/copilot-core/CHANGELOG index 9e45e6c5b..755a52efa 100644 --- a/copilot-core/CHANGELOG +++ b/copilot-core/CHANGELOG @@ -1,5 +1,5 @@ 2026-10-12 - * Increase test coverage for `Copilot.Core.Type.Array`. (#767) + * Increase test coverage for `Copilot.Core.Type.Array`. (#767) * Fix errors in the documentation of `Copilot.Core.Spec`. (#769) 2026-09-07 From 8f59941cd05980f4c9f4cf8ae77e821e5e1cb03e Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 12 Oct 2026 10:13:31 -0700 Subject: [PATCH 1168/1222] copilot-bluespec: Replace tabs in `DESIGN.md`. Refs #772. Several files across the codebase contain tabs, including the `DESIGN.md` file in `copilot-bluespec`, the `CHANGELOG` for `copilot-core`, and the `Eval` module in `copilot-interpreter`. Per our style guide, we should not use tabs anywhere in code, READMEs or CHANGELOGs, unless strictly necessary. This commit replaces tabs in the `DESIGN.md` document of `copilot-bluespec` with spaces. --- copilot-bluespec/DESIGN.md | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/copilot-bluespec/DESIGN.md b/copilot-bluespec/DESIGN.md index b5a07dd31..6cf5cd610 100644 --- a/copilot-bluespec/DESIGN.md +++ b/copilot-bluespec/DESIGN.md @@ -418,15 +418,15 @@ This generates a Verilog module `mkFibs.v` that looks like the following: ```verilog module mkFibs(CLK, - RST_N, + RST_N, - even_guard, + even_guard, - even_arg0, + even_arg0, - odd_guard, + odd_guard, - odd_arg0); + odd_arg0); input CLK; input RST_N; @@ -815,17 +815,17 @@ that looks like the following: ```verilog module mkFibs(CLK, - RST_N, + RST_N, - even_guard, + even_guard, - even_arg0, + even_arg0, - odd_guard, + odd_guard, - odd_arg0, + odd_arg0, - fibs); + fibs); input CLK; input RST_N; From de586c06d696053c7d7e5fdd70d99a220aac32c8 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 12 Oct 2026 10:12:42 -0700 Subject: [PATCH 1169/1222] copilot-interpreter: Replace tab in `Copilot.Interpret.Eval`. Refs #772. Several files across the codebase contain tabs, including the `DESIGN.md` file in `copilot-bluespec`, the `CHANGELOG` for `copilot-core`, and the `Eval` module in `copilot-interpreter`. Per our style guide, we should not use tabs anywhere in code, READMEs or CHANGELOGs, unless strictly necessary. This commit replaces a tab in the module `copilot-interpreter:Copilot.Interpret.Eval` with spaces. --- copilot-interpreter/src/Copilot/Interpret/Eval.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot-interpreter/src/Copilot/Interpret/Eval.hs b/copilot-interpreter/src/Copilot/Interpret/Eval.hs index 462b5853e..9543806c9 100644 --- a/copilot-interpreter/src/Copilot/Interpret/Eval.hs +++ b/copilot-interpreter/src/Copilot/Interpret/Eval.hs @@ -19,7 +19,7 @@ module Copilot.Interpret.Eval import Copilot.Core (Expr (..), Field (..), Id, Name, Observer (..), Op1 (..), Op2 (..), Op3 (..), Spec, Stream (..), Trigger (..), Type (..), UExpr (..), Value (..), - arrayElems, arrayUpdate, specObservers, + arrayElems, arrayUpdate, specObservers, specStreams, specTriggers, updateField) import Copilot.Interpret.Error (badUsage) From 9835d834d41bdcea5abc4f83c214af88635c8e0a Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 12 Oct 2026 10:33:19 -0700 Subject: [PATCH 1170/1222] copilot-core: Document changes in CHANGELOG. Refs #772. --- copilot-core/CHANGELOG | 1 + 1 file changed, 1 insertion(+) diff --git a/copilot-core/CHANGELOG b/copilot-core/CHANGELOG index 755a52efa..8ffeafc40 100644 --- a/copilot-core/CHANGELOG +++ b/copilot-core/CHANGELOG @@ -1,6 +1,7 @@ 2026-10-12 * Increase test coverage for `Copilot.Core.Type.Array`. (#767) * Fix errors in the documentation of `Copilot.Core.Spec`. (#769) + * Replace tab in CHANGELOG. (#772) 2026-09-07 * Version bump (4.8.1). (#760) From 1e34f7b0f1e7aadff87c5f77f8ef5042c3e70930 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 12 Oct 2026 10:33:30 -0700 Subject: [PATCH 1171/1222] copilot-bluespec: Document changes in CHANGELOG. Refs #772. --- copilot-bluespec/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-bluespec/CHANGELOG b/copilot-bluespec/CHANGELOG index 3b655c5ac..aa122183f 100644 --- a/copilot-bluespec/CHANGELOG +++ b/copilot-bluespec/CHANGELOG @@ -1,3 +1,6 @@ +2026-10-12 + * Replace tabs in `DESIGN.md`. (#772) + 2026-09-07 * Version bump (4.8.1). (#760) * Replace tab in CHANGELOG. (#755) From d00808a471e635c470444edcaaa89478ee9fb0c9 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 12 Oct 2026 10:33:39 -0700 Subject: [PATCH 1172/1222] copilot-interpreter: Document changes in CHANGELOG. Refs #772. --- copilot-interpreter/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-interpreter/CHANGELOG b/copilot-interpreter/CHANGELOG index 3e396d8d4..1b88d8eb7 100644 --- a/copilot-interpreter/CHANGELOG +++ b/copilot-interpreter/CHANGELOG @@ -1,3 +1,6 @@ +2026-10-12 + * Replace tab in `Copilot.Interpreter.Eval`. (#772) + 2026-09-07 * Version bump (4.8.1). (#760) From cfb8974ddb668f047b026241faa50011ed2c5411 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 12 Oct 2026 10:18:43 -0700 Subject: [PATCH 1173/1222] copilot: Adjust Travis CI script to flag presence of tabs as an error. Refs #774. The current CI settings do not detect if tabs have been introduced in source code, documentation or CHANGELOGs. That lack of automation makes the accidental introduction of tabs in the code more likely, especially by new users who have not yet configured their editor to replace tabs with spaces. To facilitate keeping Copilot conformant with the style guide, we want to automatically detect when tabs are introduced and warn users accordingly. This commit modifies the Travis CI script to stop with an error if any code, Cabal files, documentation or CHANGELOGs contain any tabs. --- .travis.yml | 3 +++ 1 file changed, 3 insertions(+) diff --git a/.travis.yml b/.travis.yml index f157c7aa8..de3f14bb5 100644 --- a/.travis.yml +++ b/.travis.yml @@ -32,6 +32,9 @@ before_install: - git submodule update --remote script: + # Fail if the code, Cabal files, documentation or CHANGELOGs contain tabs. + - if grep -rP '\t' --include='*.hs' --include='*.cabal' --include='*.md' --include='CHANGELOG' . ; then exit 1; fi + # We explicitly install all libraries so that they are exposed and we can use # them for tests (e.g., with runhaskell). There is no harm in doing this # instead of installing just copilot. From 74a4e39b4e258767a9cea632b0b72e14c44319ee Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 12 Oct 2026 10:34:18 -0700 Subject: [PATCH 1174/1222] copilot: Document changes in CHANGELOG. Refs #774. --- copilot/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot/CHANGELOG b/copilot/CHANGELOG index a838b070a..e7b1e3700 100644 --- a/copilot/CHANGELOG +++ b/copilot/CHANGELOG @@ -1,3 +1,6 @@ +2026-10-12 + * Adjust Travis CI script to flag presence of tabs as an error. (#774) + 2026-09-07 * Version bump (4.8.1). (#760) * Disable secure mode in Cabal in Travis CI. (#753) From 73c31d9de618cb99dd0dfafb47b9db34fec02fa7 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 12 Oct 2026 13:54:30 -0700 Subject: [PATCH 1175/1222] copilot-bluespec: Remove trailing spaces. Refs #775. The module `copilot-bluespec:Copilot.Compile.Bluespec.Expr` contains trailing spaces. It's best to remove them, since those are automatically removed by many editors, leading to PRs containing changes unrelated to the main issues being addressed. In compliance with our coding standard, trailing space should be removed. This commit removes all trailing spaces from `copilot-bluespec:Copilot.Compile.Bluespec.Expr`. --- .../src/Copilot/Compile/Bluespec/Expr.hs | 46 +++++++++---------- 1 file changed, 23 insertions(+), 23 deletions(-) diff --git a/copilot-bluespec/src/Copilot/Compile/Bluespec/Expr.hs b/copilot-bluespec/src/Copilot/Compile/Bluespec/Expr.hs index 2b71b3957..84a9ffe7a 100644 --- a/copilot-bluespec/src/Copilot/Compile/Bluespec/Expr.hs +++ b/copilot-bluespec/src/Copilot/Compile/Bluespec/Expr.hs @@ -627,43 +627,43 @@ constInt ty i -- | Translate a Copilot floating-point literal into a Bluespec expression. constFP :: Type ty -> Double -> BS.CExpr constFP ty d - -- Bluespec internally represents all IEEE floating-point values as structs + -- Bluespec internally represents all IEEE floating-point values as structs -- so special symbols have to be called for constructing special values, -- e.g. NaN, inf, and -0.0. See -- https://github.com/B-Lang-org/bsc/blob/main/src/Libraries/Base3-Math/FloatingPoint.bsv#L441 - | isInfinite d = BS.CApply - (BS.CVar $ BS.mkId BS.NoPos "infinity") + | isInfinite d = BS.CApply + (BS.CVar $ BS.mkId BS.NoPos "infinity") [ if d < 0 - then BS.CCon BS.idTrue [] + then BS.CCon BS.idTrue [] else BS.CCon BS.idFalse [] ] - - | isNaN d = let - cexpr = BS.CHasType + + | isNaN d = let + cexpr = BS.CHasType ( BS.CLit $ BS.CLiteral BS.NoPos $ BS.LInt $ BS.IntLit Nothing 10 cval ) - ( BS.CQType [] $ BS.TCon $ - BS.TyCon - (BS.mkId BS.NoPos ctype) - Nothing + ( BS.CQType [] $ BS.TCon $ + BS.TyCon + (BS.mkId BS.NoPos ctype) + Nothing BS.TIabstract ) - cval = case ty of - Float -> fromIntegral $ + cval = case ty of + Float -> fromIntegral $ castFloatToWord32 $ uncastDoubleNaNToFloat d - Double -> fromIntegral $ + Double -> fromIntegral $ castDoubleToWord64 d _ -> impossible "constFP" "copilot-bluespec" - ctype = case ty of + ctype = case ty of Float -> "Bit 32" Double -> "Bit 64" _ -> impossible "constFP" "copilot-bluespec" in BS.CApply (BS.CVar $ BS.mkId BS.NoPos "unpack") [cexpr] - | d == 0 = BS.CApply - (BS.CVar $ BS.mkId BS.NoPos "zero") - [ if isNegativeZero d - then BS.CCon BS.idTrue [] + | d == 0 = BS.CApply + (BS.CVar $ BS.mkId BS.NoPos "zero") + [ if isNegativeZero d + then BS.CCon BS.idTrue [] else BS.CCon BS.idFalse [] ] | d > 0 = withTypeAnnotation ty $ cLit $ BS.LReal d @@ -676,13 +676,13 @@ constFP ty d [cLit $ BS.LReal $ negate d] -- Because NaNs are specially placed as bit-representations by `constfp` and `constfp` requires Doubles as inputs, --- we need to convert NaN doubles safely into NaN floats. GHC Double2Float does not preserve signal nor payload +-- we need to convert NaN doubles safely into NaN floats. GHC Double2Float does not preserve signal nor payload -- internals of NaNs so in this case we need a special conversion. uncastDoubleNaNToFloat :: Double -> Float -uncastDoubleNaNToFloat nan = if (isSignaling nan) - then (setPayloadSignaling payload) +uncastDoubleNaNToFloat nan = if (isSignaling nan) + then (setPayloadSignaling payload) else (setPayload payload) - where + where payload = double2Float $ getPayload nan -- | Create a Bluespec expression consisting of a literal. From 78cdf022d05c422358782bcf19fe210d5d69188b Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 12 Oct 2026 14:04:03 -0700 Subject: [PATCH 1176/1222] copilot-bluespec: Document changes in CHANGELOG. Refs #775. --- copilot-bluespec/CHANGELOG | 1 + 1 file changed, 1 insertion(+) diff --git a/copilot-bluespec/CHANGELOG b/copilot-bluespec/CHANGELOG index aa122183f..b3cc16e04 100644 --- a/copilot-bluespec/CHANGELOG +++ b/copilot-bluespec/CHANGELOG @@ -1,5 +1,6 @@ 2026-10-12 * Replace tabs in `DESIGN.md`. (#772) + * Remove trailing spaces. (#775) 2026-09-07 * Version bump (4.8.1). (#760) From 64912e909a1023d252e2196eba881fd1e66907dc Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 12 Oct 2026 18:29:33 -0700 Subject: [PATCH 1177/1222] copilot: Adjust Travis CI script to flag trailing space as an error. Refs #777. The current CI settings do not detect if trailing space has been introduced in source code, documentation or CHANGELOGs. That lack of automation makes the accidental introduction of trailing space in the code more likely, especially by new users who have not yet configured their editor to automatically remove trailing spaces. To facilitate keeping Copilot conformant with the style guide, we want to automatically detect when trailing spaces are introduced and warn users accordingly. This commit modifies the Travis CI script to stop with an error if any non-binary files contain any trailing spaces. --- .travis.yml | 3 +++ 1 file changed, 3 insertions(+) diff --git a/.travis.yml b/.travis.yml index de3f14bb5..6cf023165 100644 --- a/.travis.yml +++ b/.travis.yml @@ -32,6 +32,9 @@ before_install: - git submodule update --remote script: + # Fail if the any non-binary files contain trailing spaces. + - if grep -nIHre ' \+$' * ; then exit 1; fi + # Fail if the code, Cabal files, documentation or CHANGELOGs contain tabs. - if grep -rP '\t' --include='*.hs' --include='*.cabal' --include='*.md' --include='CHANGELOG' . ; then exit 1; fi From 177982b2d4cd653774ceb8fae714126f6a4ce3c9 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 12 Oct 2026 18:32:05 -0700 Subject: [PATCH 1178/1222] copilot: Document changes in CHANGELOG. Refs #777. --- copilot/CHANGELOG | 1 + 1 file changed, 1 insertion(+) diff --git a/copilot/CHANGELOG b/copilot/CHANGELOG index e7b1e3700..f28d79c55 100644 --- a/copilot/CHANGELOG +++ b/copilot/CHANGELOG @@ -1,5 +1,6 @@ 2026-10-12 * Adjust Travis CI script to flag presence of tabs as an error. (#774) + * Adjust Travis CI script to flag trailing space as an error. (#777) 2026-09-07 * Version bump (4.8.1). (#760) From 2a04a921cff2f492323512fbd9bf6ade6172a7af Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 15 Oct 2026 22:14:33 -0700 Subject: [PATCH 1179/1222] copilot: Use "into" instead of "in" when indicating movement in README. Refs #779. The README contains several typos, missing commas, issues with capitalization, and poor wording in some sentences. For example, Copilot is written as `Copilot` in some places, but `copilot` in others, even when referring to the project (as opposed to the library). The sentence "It read temperature as a byte", which accompanies a code example, is grammatically incorrect. To make the README useful and easy to read, we should fix all syntactic and grammatical errors wherever possible. This commit replaces a use of "in" with "into" after a verb that denotes movement or change with direction, which improves the style of the sentence. --- copilot/README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot/README.md b/copilot/README.md index 893d6a933..a1f7fd875 100644 --- a/copilot/README.md +++ b/copilot/README.md @@ -7,7 +7,7 @@ Copilot is a runtime verification framework for hard real-time systems. Programs can be interpreted for testing, or translated into C99 code to be -incorporated in a project or standalone application. The C99 code generated +incorporated into a project or standalone application. The C99 code generated is constant in memory and time, making it suitable for systems with hard real-time requirements. From e76d6534a876d71075d885678c019bf6d2f7cd93 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 15 Oct 2026 22:13:31 -0700 Subject: [PATCH 1180/1222] copilot: Add missing article in README. Refs #779. The README contains several typos, missing commas, issues with capitalization, and poor wording in some sentences. For example, Copilot is written as `Copilot` in some places, but `copilot` in others, even when referring to the project (as opposed to the library). The sentence "It read temperature as a byte", which accompanies a code example, is grammatically incorrect. To make the README useful and easy to read, we should fix all syntactic and grammatical errors wherever possible. This commit adds a missing article in a sentence, part of the list of features of Copilot, which is grammatically more correct and reads better. --- copilot/README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot/README.md b/copilot/README.md index a1f7fd875..2d8d4ed5a 100644 --- a/copilot/README.md +++ b/copilot/README.md @@ -26,7 +26,7 @@ real-time requirements. - Produce hard real-time C99 runtime monitors that run in constant memory and time. -- Catch errors in specifications early using expressive static type system. +- Catch errors in specifications early using an expressive static type system. - Prove properties about specifications using theorem proving extensions. From e351df801b08221074bb0a65d407b279c86b4faf Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 15 Oct 2026 22:14:49 -0700 Subject: [PATCH 1181/1222] copilot: Add missing comma in README. Refs #779. The README contains several typos, missing commas, issues with capitalization, and poor wording in some sentences. For example, Copilot is written as `Copilot` in some places, but `copilot` in others, even when referring to the project (as opposed to the library). The sentence "It read temperature as a byte", which accompanies a code example, is grammatically incorrect. To make the README useful and easy to read, we should fix all syntactic and grammatical errors wherever possible. This commit adds a comma after the introductory phrase "to use Copilot". --- copilot/README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot/README.md b/copilot/README.md index 2d8d4ed5a..49bb8358c 100644 --- a/copilot/README.md +++ b/copilot/README.md @@ -98,7 +98,7 @@ ghci> ghci> Leaving GHCi. ### Other Linux distributions On other Linux distributions or older Debian-based distributions, to use -Copilot you must install a Haskell compiler (GHC) and the package manager +Copilot, you must install a Haskell compiler (GHC) and the package manager Cabal. We currently support all versions of GHC from 8.6.5 to modern versions (9.10 as of this writing). You can install the toolchain using [ghcup](https://www.haskell.org/ghcup/) or, if you are on Debian/Ubuntu, From 73a3444671661c9e83410f8c18aab671c55421ed Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 15 Oct 2026 22:14:58 -0700 Subject: [PATCH 1182/1222] copilot: Add missing comma in README. Refs #779. The README contains several typos, missing commas, issues with capitalization, and poor wording in some sentences. For example, Copilot is written as `Copilot` in some places, but `copilot` in others, even when referring to the project (as opposed to the library). The sentence "It read temperature as a byte", which accompanies a code example, is grammatically incorrect. To make the README useful and easy to read, we should fix all syntactic and grammatical errors wherever possible. This commit adds a comma after the introductory phrase "To use Copilot". --- copilot/README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot/README.md b/copilot/README.md index 49bb8358c..0cebe449d 100644 --- a/copilot/README.md +++ b/copilot/README.md @@ -129,7 +129,7 @@ ghci> ghci> Leaving GHCi. ## Mac installation [(Back to top)](#table-of-contents) -To use Copilot you must have a Haskell compiler (GHC) and the package manager +To use Copilot, you must have a Haskell compiler (GHC) and the package manager Cabal. We currently support all versions of GHC from 8.6.5 to modern versions (9.6 as of this writing). You can install the toolchain using [ghcup](https://www.haskell.org/ghcup/), as well as with Homebrew: From c05161555f1714d1d913ebabde3e87c1373c75fb Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Wed, 14 Oct 2026 20:21:00 -0700 Subject: [PATCH 1183/1222] copilot: Fix spelling of Travis CI in README. Refs #779. The README contains several typos, missing commas, issues with capitalization, and poor wording in some sentences. For example, Copilot is written as `Copilot` in some places, but `copilot` in others, even when referring to the project (as opposed to the library). The sentence "It read temperature as a byte", which accompanies a code example, is grammatically incorrect. To make the README useful and easy to read, we should fix all syntactic and grammatical errors wherever possible. This commit fixes the spelling of "Travis CI". --- copilot/README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot/README.md b/copilot/README.md index 0cebe449d..03ffcf650 100644 --- a/copilot/README.md +++ b/copilot/README.md @@ -162,7 +162,7 @@ ghci> ghci> Leaving GHCi. Feel free to open an issue if you are unable to install Copilot following these instructions. -There is a TravisCI file at the root of the repository that may help with +There is a Travis CI file at the root of the repository that may help with troubleshooting the installation. Our issues often include comments with Dockerfiles listing the steps necessary to install Copilot from scratch. From cc42fd662cd6a423f37ffadd892d9c349e5dad5d Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 15 Oct 2026 22:13:37 -0700 Subject: [PATCH 1184/1222] copilot: Fix discrepancy between pronoun and verb in README. Refs #779. The README contains several typos, missing commas, issues with capitalization, and poor wording in some sentences. For example, Copilot is written as `Copilot` in some places, but `copilot` in others, even when referring to the project (as opposed to the library). The sentence "It read temperature as a byte", which accompanies a code example, is grammatically incorrect. To make the README useful and easy to read, we should fix all syntactic and grammatical errors wherever possible. This commit fixes a discrepancy between the number of the pronoun in a sentence ("It") and the verb ("read"). It also adds an article accmpanying temperature, since there is no marker suggesting it refers specifically to the global C variable by that name. --- copilot/README.md | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/copilot/README.md b/copilot/README.md index 03ffcf650..ec2c3723b 100644 --- a/copilot/README.md +++ b/copilot/README.md @@ -176,8 +176,9 @@ of the main repository. ```haskell -- This example implements a simple home heating system. The system heats --- when the temperature gets too low, and stops when it is high enough. It read --- temperature as a byte (range -50C to 100C) and translates this to Celsius. +-- when the temperature gets too low, and stops when it is high enough. It +-- reads the temperature as a byte (range -50C to 100C) and translates it to +-- Celsius. module Heater where From f32cf04d3e4b9af0ea875c1402b476061143aaa2 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 15 Oct 2026 22:18:34 -0700 Subject: [PATCH 1185/1222] copilot: Fix capitalization of Copilot in README. Refs #779. The README contains several typos, missing commas, issues with capitalization, and poor wording in some sentences. For example, Copilot is written as `Copilot` in some places, but `copilot` in others, even when referring to the project (as opposed to the library). The sentence "It read temperature as a byte", which accompanies a code example, is grammatically incorrect. To make the README useful and easy to read, we should fix all syntactic and grammatical errors wherever possible. This commit fixes the capitalization of Copilot referring to the project. --- copilot/README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot/README.md b/copilot/README.md index ec2c3723b..66060e7ca 100644 --- a/copilot/README.md +++ b/copilot/README.md @@ -239,7 +239,7 @@ does not constitute any form of endorsement._ built using NASA's Core Flight System or the Robot Operating System (ROS 2). - [arduino-copilot](https://hackage.haskell.org/package/arduino-copilot) - facilitates building copilot applications that run on Arduino. + facilitates building Copilot applications that run on Arduino. - [sketch-frp-copilot](https://hackage.haskell.org/package/sketch-frp-copilot) extends Copilot with an FRP-like interface. From 5d879d850d14d1e8c263cffa6a2759bdd68f7a35 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 15 Oct 2026 22:18:43 -0700 Subject: [PATCH 1186/1222] copilot: Fix capitalization of Copilot in README. Refs #779. The README contains several typos, missing commas, issues with capitalization, and poor wording in some sentences. For example, Copilot is written as `Copilot` in some places, but `copilot` in others, even when referring to the project (as opposed to the library). The sentence "It read temperature as a byte", which accompanies a code example, is grammatically incorrect. To make the README useful and easy to read, we should fix all syntactic and grammatical errors wherever possible. This commit fixes the capitalization of Copilot referring to the project. --- copilot/README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot/README.md b/copilot/README.md index 66060e7ca..7332fd7da 100644 --- a/copilot/README.md +++ b/copilot/README.md @@ -245,7 +245,7 @@ does not constitute any form of endorsement._ extends Copilot with an FRP-like interface. - [zephyr-copilot](https://hackage.haskell.org/package/zephyr-copilot) - facilitates building copilot applications that run on boards supported by the + facilitates building Copilot applications that run on boards supported by the Zephyr project. # Documentation From dc3ac33be460111f241e3bec7d3870c791f5e173 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Wed, 14 Oct 2026 20:27:36 -0700 Subject: [PATCH 1187/1222] copilot: Add missing comma in README. Refs #779. The README contains several typos, missing commas, issues with capitalization, and poor wording in some sentences. For example, Copilot is written as `Copilot` in some places, but `copilot` in others, even when referring to the project (as opposed to the library). The sentence "It read temperature as a byte", which accompanies a code example, is grammatically incorrect. To make the README useful and easy to read, we should fix all syntactic and grammatical errors wherever possible. This commit adds a missing comma after an introductory adverb. --- copilot/README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot/README.md b/copilot/README.md index 7332fd7da..536665d87 100644 --- a/copilot/README.md +++ b/copilot/README.md @@ -391,5 +391,5 @@ https://github.com/Copilot-Language/copilot/graphs/contributors We are grateful for NASA Contract NNL08AD13T to Galois, Inc. and the National Institute of Aerospace, which partially supported this work. -Additionally NASA Langley contracts 80LARC17C0004 and NNL09AA00A supported +Additionally, NASA Langley contracts 80LARC17C0004 and NNL09AA00A supported further development of Copilot. From 12024c6efe5d80bb09d52eebfb78d23b8536a4ee Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Thu, 15 Oct 2026 22:12:30 -0700 Subject: [PATCH 1188/1222] copilot: Document changes in CHANGELOG. Refs #779. --- copilot/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot/CHANGELOG b/copilot/CHANGELOG index f28d79c55..4758ed15b 100644 --- a/copilot/CHANGELOG +++ b/copilot/CHANGELOG @@ -1,6 +1,7 @@ -2026-10-12 +2026-10-15 * Adjust Travis CI script to flag presence of tabs as an error. (#774) * Adjust Travis CI script to flag trailing space as an error. (#777) + * Update README to correct typos and improve readability. (#779) 2026-09-07 * Version bump (4.8.1). (#760) From 7c2cbbd99c2bf3d476c2b493f0127a61252a4566 Mon Sep 17 00:00:00 2001 From: Kaveh Zare Date: Fri, 16 Oct 2026 13:30:21 -0500 Subject: [PATCH 1189/1222] copilot-core: Fix comments for two tests in `Test.Copilot.Core.Type`. Refs #781. The Haddock comments that accompany the properties `testUpdateStruct` and `testUpdateStruct`, included in the test module `copilot-core:Test.Copilot.Core.Type` are incorrect. The comments indicate that the properties test showing a struct, when they are related to updates instead. All Haddock comments should correctly document the functionality implemented in Copilot. This commit fixes the Haddock comments for the aforementioned test properties. --- copilot-core/tests/Test/Copilot/Core/Type.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/copilot-core/tests/Test/Copilot/Core/Type.hs b/copilot-core/tests/Test/Copilot/Core/Type.hs index 9f9cb6d5e..128cdea67 100644 --- a/copilot-core/tests/Test/Copilot/Core/Type.hs +++ b/copilot-core/tests/Test/Copilot/Core/Type.hs @@ -350,7 +350,7 @@ testShowStruct = forAll arbitrary $ \k1 -> forAll arbitrary $ \k2 -> show (S (Field k1) (Field k2)) == "" --- | Test showing a struct. +-- | Test updating a struct. testUpdateStruct :: Property testUpdateStruct = forAll arbitrary $ \k1 -> @@ -364,7 +364,7 @@ testUpdateStruct = where unField (Field x) = x --- | Test showing a struct. +-- | Test updating a struct (should fail). testUpdateStructFail :: Property testUpdateStructFail = expectFailure $ forAll arbitrary $ \k1 -> From 54f18ef8b755704082929a374ab8700c61eaeb9c Mon Sep 17 00:00:00 2001 From: Kaveh Zare Date: Fri, 16 Oct 2026 13:35:12 -0500 Subject: [PATCH 1190/1222] copilot-core: Document changes in CHANGELOG. Refs #781. --- copilot-core/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot-core/CHANGELOG b/copilot-core/CHANGELOG index 8ffeafc40..ad519557c 100644 --- a/copilot-core/CHANGELOG +++ b/copilot-core/CHANGELOG @@ -1,7 +1,8 @@ -2026-10-12 +2026-10-16 * Increase test coverage for `Copilot.Core.Type.Array`. (#767) * Fix errors in the documentation of `Copilot.Core.Spec`. (#769) * Replace tab in CHANGELOG. (#772) + * Fix comments for two tests in `Test.Copilot.Core.Type`. (#781) 2026-09-07 * Version bump (4.8.1). (#760) From 570cda7fa751149911d0e69f6ab1d9a57b48ccb2 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 17 Oct 2026 08:20:18 -0700 Subject: [PATCH 1191/1222] copilot-core: Fix typo in Haddock comment of test property. Refs #783. The Haddock comment for the property `copilot-core:Test.Copilot.Core.Type.testTypeLength2` states that it tests "that the length of an multi-dimensional array is as expected", which is grammatically incorrect. To make documentation most useful and in compliance with our style guide, the documentation should have no typos or grammatical errors. This commit fixes the aforementioned typo. --- copilot-core/tests/Test/Copilot/Core/Type.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot-core/tests/Test/Copilot/Core/Type.hs b/copilot-core/tests/Test/Copilot/Core/Type.hs index 128cdea67..979f87d88 100644 --- a/copilot-core/tests/Test/Copilot/Core/Type.hs +++ b/copilot-core/tests/Test/Copilot/Core/Type.hs @@ -165,7 +165,7 @@ testTypeLength1 = property $ typeLength a == 3 a :: Type (Array 3 Int8) a = Array Int8 --- | Test that the length of an multi-dimensional array is as expected. +-- | Test that the length of a multi-dimensional array is as expected. testTypeLength2 :: Property testTypeLength2 = property $ typeLength a == 3 where From 7c9c43fe28bd2cf4d311547fcadf372c646f134e Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 18 Oct 2026 09:28:29 -0700 Subject: [PATCH 1192/1222] copilot-core: Document changes in CHANGELOG. Refs #783. --- copilot-core/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot-core/CHANGELOG b/copilot-core/CHANGELOG index ad519557c..b2d405f95 100644 --- a/copilot-core/CHANGELOG +++ b/copilot-core/CHANGELOG @@ -1,8 +1,9 @@ -2026-10-16 +2026-10-17 * Increase test coverage for `Copilot.Core.Type.Array`. (#767) * Fix errors in the documentation of `Copilot.Core.Spec`. (#769) * Replace tab in CHANGELOG. (#772) * Fix comments for two tests in `Test.Copilot.Core.Type`. (#781) + * Fix typo in Haddock comment of test property. (#783) 2026-09-07 * Version bump (4.8.1). (#760) From 6046703392ad20ea306b16ab03a7d604a68c0af6 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 17 Oct 2026 08:30:23 -0700 Subject: [PATCH 1193/1222] copilot-core: Fix test to use `typeSize` instead of `typeLength`. Refs #784. The test property `copilot-core:Test.Copilot.Core.Type.testTypeSize1` claims, in its name, in the Haddock comment that accompanies it, and in the property description as part of the property group, that it tests `typeSize`. However, its implementation tests `typeLength`. The property should test the function it is expected to be testing. This commit modifies `copilot-core:Test.Copilot.Core.Type.testTypeSize1` to use `typeSize` instead of `typeLength`. --- copilot-core/tests/Test/Copilot/Core/Type.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot-core/tests/Test/Copilot/Core/Type.hs b/copilot-core/tests/Test/Copilot/Core/Type.hs index 979f87d88..47d8c5940 100644 --- a/copilot-core/tests/Test/Copilot/Core/Type.hs +++ b/copilot-core/tests/Test/Copilot/Core/Type.hs @@ -174,7 +174,7 @@ testTypeLength2 = property $ typeLength a == 3 -- | Test that the size of an array is as expected. testTypeSize1 :: Property -testTypeSize1 = property $ typeLength a == 3 +testTypeSize1 = property $ typeSize a == 3 where a :: Type (Array 3 Int8) a = Array Int8 From 1aac617ad5ac27e167ff755e5905c1b0e1c507e6 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 18 Oct 2026 11:43:35 -0700 Subject: [PATCH 1194/1222] copilot-core: Document changes in CHANGELOG. Refs #784. --- copilot-core/CHANGELOG | 1 + 1 file changed, 1 insertion(+) diff --git a/copilot-core/CHANGELOG b/copilot-core/CHANGELOG index b2d405f95..c8a3f790d 100644 --- a/copilot-core/CHANGELOG +++ b/copilot-core/CHANGELOG @@ -4,6 +4,7 @@ * Replace tab in CHANGELOG. (#772) * Fix comments for two tests in `Test.Copilot.Core.Type`. (#781) * Fix typo in Haddock comment of test property. (#783) + * Fix test to use `typeSize` instead of `typeLength` (#784). 2026-09-07 * Version bump (4.8.1). (#760) From 5c32631cb72d51ce8b91802f58b840e2f482d05f Mon Sep 17 00:00:00 2001 From: James Todd Gloyd Date: Fri, 23 Oct 2026 20:54:08 +0000 Subject: [PATCH 1195/1222] copilot-libraries: Add random stream generation module. Refs #766. Copilot does not currently contain any capability to produce a random stream of values. Randomization is useful for a lot of applications, from testing to fault injection. To make Copilot more versatile and useful for the use cases we want to support, we want to add a module to `copilot-libraries` with randomization primitives. This commit adds a new module that provides functions to produce random streams of different types and with different properties. --- copilot-libraries/copilot-libraries.cabal | 1 + .../src/Copilot/Library/Random.hs | 145 ++++++++++++++++++ 2 files changed, 146 insertions(+) create mode 100644 copilot-libraries/src/Copilot/Library/Random.hs diff --git a/copilot-libraries/copilot-libraries.cabal b/copilot-libraries/copilot-libraries.cabal index aa5c8e61b..b34020a57 100644 --- a/copilot-libraries/copilot-libraries.cabal +++ b/copilot-libraries/copilot-libraries.cabal @@ -51,6 +51,7 @@ library , Copilot.Library.PTLTL , Copilot.Library.StateMachines , Copilot.Library.Statistics + , Copilot.Library.Random , Copilot.Library.RegExp , Copilot.Library.Utils , Copilot.Library.Voting diff --git a/copilot-libraries/src/Copilot/Library/Random.hs b/copilot-libraries/src/Copilot/Library/Random.hs new file mode 100644 index 000000000..d4828e12b --- /dev/null +++ b/copilot-libraries/src/Copilot/Library/Random.hs @@ -0,0 +1,145 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +-- | +-- Basic pseudo-random number generation. +-- +-- Information on performance of a selection of pseudo-random number generation +-- algorithms, including those implemented below, can be found at: +-- https://prng.di.unimi.it/ +-- +-- Important: these pseudo-random number generators are NOT cryptographically +-- secure generators. +module Copilot.Library.Random + ( randomW32 + , randomW64 + , boundedRandomIntegral + , proportionalRandomBool + , weightedRandomSelection + ) + where + +-- External imports +import Copilot.Language (Array, Stream, Typed, Word32, Word64, arrayElems, + constant, mod, mux, (!), (++), (.<<.), (.>>.), (.^.), + (<), (<=)) +import GHC.TypeLits (KnownNat, type (<=)) +import Prelude hiding (mod, (++), (<), (<=)) + +-- | Given two Word32 seeds, produce a pseudo-random stream of Word32 numbers, +-- which has a period of 2^32 - 1. Neither of the seeds should be zero, since +-- the underlying randomization algorithm maps zero to itself. +-- +-- This function uses an Xorshift+ algorithm. +randomW32 :: Word32 -> Word32 -> Stream Word32 +randomW32 0 _ = error "randomW32: seed cannot be zero." +randomW32 _ 0 = error "randomW32: seed cannot be zero." +randomW32 seed1 seed2 = s1 + s2 + + where + + s1 :: Stream Word32 + s1 = [seed1] ++ (xorshift32 s1) + + s2 :: Stream Word32 + s2 = [seed2] ++ (xorshift32 s2) + + -- This is a simple implementation of an Xorshift algorithm + xorshift32 :: Stream Word32 -> Stream Word32 + xorshift32 x1 = x4 -- Note: 0 maps to itself with this + where + x4 = x3 .^. (x3 .<<. (5 :: Stream Word32)) + x3 = x2 .^. (x2 .>>. (17 :: Stream Word32)) + x2 = x1 .^. (x1 .<<. (13 :: Stream Word32)) + +-- | Given two Word64 seeds, produce a pseudo-random stream of Word64 numbers, +-- which has a period of 2^128 - 1. Neither of the seeds should be zero, as +-- doing so will negatively impact the quality of the randomness. +-- +-- This function uses an Xorshiftrplus algorithm. +randomW64 :: Word64 -> Word64 -> Stream Word64 +randomW64 0 _ = error "randomW64: seed cannot be zero." +randomW64 _ 0 = error "randomW64: seed cannot be zero." +randomW64 seed1 seed2 = x + + where + + s0 :: Stream Word64 + s0 = [seed1] ++ s1 + + s1 :: Stream Word64 + s1 = [seed2] ++ (x + s1) + + x :: Stream Word64 + x = xorshiftr128plus s0 s1 + + xorshiftr128plus :: Stream Word64 -> Stream Word64 -> Stream Word64 + xorshiftr128plus x1 y = x4 + where + x4 = x3 .^. y + x3 = x2 .^. (x2 .>>. (17 :: Stream Word64)) + x2 = x1 .^. (x1 .<<. (23 :: Stream Word64)) + +-- | Given a stream of random integral numbers, a minimum value, and a maximum +-- value, produce a stream of random values greater than or equal to the +-- minimum and less than the maximum value, i.e., [@mN@, @mX@). +boundedRandomIntegral :: (Typed a, Integral a) + => Stream a -> a -> a -> Stream a +boundedRandomIntegral gen mN mX = (gen `mod` constant (mX - mN)) + constant mN + +-- | Given a stream of random integral numbers and two integers defining the +-- numerator and denominator of a rational probability, produce a boolean +-- stream that is randomly @True@ with the given probability. That is to say, +-- given a numerator @n@ and denominator @d@, then, over a sufficiently large +-- sample size, the resulting stream @s@ is @True@ @n@ out of @d@ times. +proportionalRandomBool :: (Typed a, Integral a) + => Stream a -> a -> a -> Stream Bool +proportionalRandomBool gen n d = (gen `mod` constant d) < constant n + +-- | Given a stream of random integral numbers, an array of values, and an +-- equal length array of weights, produce a stream of random values from the +-- given array with probabilities proportional to the given weights. +weightedRandomSelection :: forall a b s + . (KnownNat s, s <= MaxWord32, Typed a, Typed b, + Integral a, Bounded a) + => Stream a -> Array s b -> Array s a -> Stream b +weightedRandomSelection gen values weights + | overflow + = error "weightedRandomSelection: sum of weights overflows type" + + | signedType + = error "weightedRandomSelection: type of weights array must be unsigned" + + | otherwise + = constant values ! idx + + where + + -- Check if cumulativeSum decreases at any point. For unsigned integral + -- types, a decreasing element in this cumulative sequence corresponds to + -- an overflow. + overflow = or (zipWith (>) cumulativeSum (drop 1 cumulativeSum)) + + signedType = 0 > (minBound :: a) + + idx :: Stream Word32 + idx = countLeq cumulativeSum (gen `mod` constant totalSum) + + countLeq :: [a] -> Stream a -> Stream Word32 + countLeq xs v = sum [ mux (constant x <= v) 1 0 | x <- xs ] + -- ^ get number of elements in @xs@ less than or equal to @v@. + -- For non-decreasing @xs@, this is equal to the index of the first + -- element greater than @v@. + + cumulativeSum :: [a] + cumulativeSum = scanl1 (+) (arrayElems weights) + + totalSum :: a + totalSum = last cumulativeSum + +-- | Type-level representation of the upper bound on an unsigned 32-bit +-- integer. +type MaxWord32 = 4294967295 -- 2^32 - 1 From 39548759d483719d4554bf8cd2e21adf5a8b21aa Mon Sep 17 00:00:00 2001 From: James Todd Gloyd Date: Fri, 23 Oct 2026 21:04:47 +0000 Subject: [PATCH 1196/1222] copilot-libraries: Document changes in CHANGELOG. Refs #766. --- copilot-libraries/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-libraries/CHANGELOG b/copilot-libraries/CHANGELOG index 0e8dcc83f..b95a2cd3f 100644 --- a/copilot-libraries/CHANGELOG +++ b/copilot-libraries/CHANGELOG @@ -1,3 +1,6 @@ +2026-10-23 + * Add random stream generation module. (#766) + 2026-09-07 * Version bump (4.8.1). (#760) From e6d4b6450f8c90247d7d9f5b105d1cbb9217901d Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 8 May 2026 14:56:02 +0000 Subject: [PATCH 1197/1222] copilot: Add Github Actions workflow file. Refs #790. CI jobs are being automatically cancelled by Travis CI mid-build. Travis CI is reporting the plan as being out of credits, when the organization have plenty of credits to run jobs to completion. This commit adds a Github Actions workflow file that replicates the steps executed by Travis CI. --- .github/workflows/build.yml | 66 +++++++++++++++++++++++++++++++++++++ 1 file changed, 66 insertions(+) create mode 100644 .github/workflows/build.yml diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml new file mode 100644 index 000000000..21e929e6c --- /dev/null +++ b/.github/workflows/build.yml @@ -0,0 +1,66 @@ +name: build + +# Trigger the workflow on push or pull request +on: + - pull_request + - push + +jobs: + cabal: + name: ${{ matrix.os }} / ghc ${{ matrix.ghc }} / cabal ${{ matrix.cabal }} + runs-on: ${{ matrix.os }} + strategy: + matrix: + os: [ubuntu-26.04] + cabal: ["2.4", "3.2", "3.4"] + ghc: + - "8.6.5" + - "8.8.4" + - "8.10.4" + - "9.0.1" + + steps: + + - uses: haskell-actions/setup@main + id: setup-haskell-cabal + name: Setup Haskell + continue-on-error: true + with: + ghc-version: ${{ matrix.ghc }} + cabal-version: ${{ matrix.cabal }} + + - name: Prepare environment + run: | + echo "$HOME/.ghcup/bin" >> $GITHUB_PATH + echo "$HOME/.cabal/bin" >> $GITHUB_PATH + sed -i -e "s;-- \(secure.\) True;\1 False;g" $HOME/.cabal/config + cabal update + + - uses: actions/checkout@v7 + + - name: Install dependencies + run: | + sudo apt-get install -y cppcheck z3 + + - name: Format check + run: | + # Fail if the any non-binary files contain trailing spaces. + if grep -nIHre ' \+$' * ; then exit 1; fi + + # Fail if the code, Cabal files, documentation or CHANGELOGs contain tabs. + if grep -rP '\t' --include='*.hs' --include='*.cabal' --include='*.md' --include='CHANGELOG' . ; then exit 1; fi + + - name: Install copilot + run: | + cabal v2-install --lib copilot/ copilot-core/ copilot-c99/ copilot-language/ copilot-libraries/ copilot-theorem/ copilot-interpreter/ copilot-prettyprinter/ + + - name: Test packages + if: matrix.ghc == '8.10.4' + run: | + cabal v2-test -j1 copilot-core/ copilot-language/ copilot-interpreter/ copilot-c99/ copilot-theorem/ copilot-libraries/ + + - name: Check cpp + if: matrix.ghc == '8.10.4' + run: | + export GHC_ENVIRONMENT=~/.ghc/x86_64-linux-8.10.4/environments/default + runhaskell copilot/examples/Heater.hs; cppcheck --force --addon=misra.py --suppress=misra-c2012-14.4 --error-exitcode=2 heater.c From a39952269a8545c7e71002b53f632336794c4be3 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Fri, 8 May 2026 14:56:13 +0000 Subject: [PATCH 1198/1222] copilot: Remove Travis CI file. Refs #790. CI jobs are being automatically cancelled by Travis CI mid-build. Travis CI is reporting the plan as being out of credits, when the organization have plenty of credits to run jobs to completion. A prior commit added a Github Actions workflow file that replicates the steps executed by Travis CI, thus making the Travis CI setup redundant. This commit removes the Travis CI script from the repository. --- .travis.yml | 58 ----------------------------------------------------- 1 file changed, 58 deletions(-) delete mode 100644 .travis.yml diff --git a/.travis.yml b/.travis.yml deleted file mode 100644 index 6cf023165..000000000 --- a/.travis.yml +++ /dev/null @@ -1,58 +0,0 @@ -# dist should be at least focal because we need cppcheck >= 1.88. -dist: focal - -# NB: don't set `language: haskell` here - -# The following enables several GHC versions to be tested; often it's enough to -# test only against the last release in a major GHC version. Feel free to omit -# lines listings versions you don't need/want testing for. -env: - - CABALVER=2.4 GHCVER=8.6.5 - - CABALVER=3.2 GHCVER=8.8.4 - - CABALVER=3.2 GHCVER=8.10.4 - - CABALVER=3.4 GHCVER=9.0.1 -# - CABALVER=head GHCVER=head # see section about GHC HEAD snapshots - -# Note: the distinction between `before_install` and `install` is not important. -before_install: - - travis_retry sudo add-apt-repository -y ppa:hvr/ghc - - travis_retry sudo apt-get update - - travis_retry sudo apt-get install cabal-install-$CABALVER ghc-$GHCVER # see note about happy/alex - - # We install z3 and cppcheck only for the tests, since they are not needed - # for normal compilation. - - if [ "${GHCVER}" == "8.10.4" ]; then travis_retry sudo apt-get install --yes z3 cppcheck; fi - - - export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$PATH - - cabal --version - - echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo '?')]" - - cabal user-config init - - sed -i -e "s;-- \(secure.\) True;\1 False;g" ${HOME}/.cabal/config - - travis_retry cabal update - - git submodule update --remote - -script: - # Fail if the any non-binary files contain trailing spaces. - - if grep -nIHre ' \+$' * ; then exit 1; fi - - # Fail if the code, Cabal files, documentation or CHANGELOGs contain tabs. - - if grep -rP '\t' --include='*.hs' --include='*.cabal' --include='*.md' --include='CHANGELOG' . ; then exit 1; fi - - # We explicitly install all libraries so that they are exposed and we can use - # them for tests (e.g., with runhaskell). There is no harm in doing this - # instead of installing just copilot. - - travis_wait 30 cabal v2-install --lib copilot copilot-core copilot-c99 copilot-language copilot-libraries copilot-theorem copilot-interpreter copilot-prettyprinter - - # Run tests only on GHC 8.10.4 - # - # Only libraries with tests are listed below or the v2-test command fails. - # - # Testing copilot-theorem and copilot-libraries requires z3. See above - # conditional installation, and keep GHC version numbers in both places in - # sync. - - if [ "${GHCVER}" == "8.10.4" ]; then cabal v2-test -j1 copilot-core copilot-language copilot-interpreter copilot-c99 copilot-theorem copilot-libraries; fi - - # Check that the code produced by Copilot complies with MISRA C 2012. We - # explicitly make cppcheck produce a non-zero exit code on non-compliance - # with the standard to make the CI build fail. - - if [ "${GHCVER}" == "8.10.4" ]; then runhaskell copilot/examples/Heater.hs; cppcheck --force --addon=misra.py --suppress=misra-c2012-14.4 --error-exitcode=2 heater.c; fi From b0e6e698ded581bdb49c7d7e0ac6196e39cab2b8 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 7 Nov 2026 21:01:56 +0000 Subject: [PATCH 1199/1222] copilot: Replace Travis CI badge with Github Actions badge in README. Refs #790. CI jobs are being automatically cancelled by Travis CI mid-build. Travis CI is reporting the plan as being out of credits, when the organization have plenty of credits to run jobs to completion. Prior commits replaced the Travis CI-based setup with one based on Github Actions. This commit updates the Travis CI build status badge in the `README.md` to reflect the build status of the `master` branch on Github Actions, and to point to the corresponding workflow file. --- copilot/README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot/README.md b/copilot/README.md index 536665d87..63a2459ef 100644 --- a/copilot/README.md +++ b/copilot/README.md @@ -2,7 +2,7 @@ # Copilot -[![Build Status](https://api.travis-ci.com/Copilot-Language/copilot.svg?branch=master)](https://app.travis-ci.com/github/Copilot-Language/copilot) +[![Build Status](https://github.com/Copilot-Language/copilot/actions/workflows/build.yml/badge.svg?branch=master)](https://github.com/Copilot-Language/copilot/actions/workflows/build.yml) [![Version on Hackage](https://img.shields.io/hackage/v/copilot.svg)](https://hackage.haskell.org/package/copilot) Copilot is a runtime verification framework for hard real-time systems. From 701880b127fadd9d94f9f8c73ec44ba791d42775 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 7 Nov 2026 21:27:02 +0000 Subject: [PATCH 1200/1222] copilot: Document changes in CHANGELOG. Refs #790. --- copilot/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot/CHANGELOG b/copilot/CHANGELOG index 4758ed15b..c350ec33a 100644 --- a/copilot/CHANGELOG +++ b/copilot/CHANGELOG @@ -1,7 +1,8 @@ -2026-10-15 +2026-11-07 * Adjust Travis CI script to flag presence of tabs as an error. (#774) * Adjust Travis CI script to flag trailing space as an error. (#777) * Update README to correct typos and improve readability. (#779) + * Replace Travis CI with Github Actions. (#790) 2026-09-07 * Version bump (4.8.1). (#760) From 1a137a86d5a8459750d3092e28679cb326e868d2 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 7 Nov 2026 17:38:42 -0800 Subject: [PATCH 1201/1222] copilot-core: Version bump (4.8.2). Refs #792. --- copilot-core/copilot-core.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/copilot-core/copilot-core.cabal b/copilot-core/copilot-core.cabal index 57f92d703..288399a9c 100644 --- a/copilot-core/copilot-core.cabal +++ b/copilot-core/copilot-core.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-core -version: 4.8.1 +version: 4.8.2 synopsis: An intermediate representation for Copilot. description: Intermediate representation for Copilot. From c666b71483eaf5889f53fa82d588d991bc123e35 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 7 Nov 2026 17:38:42 -0800 Subject: [PATCH 1202/1222] copilot-bluespec: Version bump (4.8.2). Refs #792. --- copilot-bluespec/copilot-bluespec.cabal | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/copilot-bluespec/copilot-bluespec.cabal b/copilot-bluespec/copilot-bluespec.cabal index e8f29e4d7..1d8f7b3af 100644 --- a/copilot-bluespec/copilot-bluespec.cabal +++ b/copilot-bluespec/copilot-bluespec.cabal @@ -1,6 +1,6 @@ cabal-version : >= 1.10 name : copilot-bluespec -version : 4.8.1 +version : 4.8.2 synopsis : A compiler for Copilot targeting FPGAs. description : This package is a back-end from Copilot to FPGAs in Bluespec. @@ -51,7 +51,7 @@ library , ieee754 >= 0.8.0 && < 0.9 , pretty >= 1.1.2 && < 1.2 - , copilot-core >= 4.8.1 && < 4.9 + , copilot-core >= 4.8.2 && < 4.9 , language-bluespec >= 0.1 && < 0.2 exposed-modules : Copilot.Compile.Bluespec From fd210f80474c58044014aaa8bf5014aeffa1ef16 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 7 Nov 2026 17:38:42 -0800 Subject: [PATCH 1203/1222] copilot-c99: Version bump (4.8.2). Refs #792. --- copilot-c99/copilot-c99.cabal | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/copilot-c99/copilot-c99.cabal b/copilot-c99/copilot-c99.cabal index ea2e233dc..7e1e3d17a 100644 --- a/copilot-c99/copilot-c99.cabal +++ b/copilot-c99/copilot-c99.cabal @@ -1,6 +1,6 @@ cabal-version : >= 1.10 name : copilot-c99 -version : 4.8.1 +version : 4.8.2 synopsis : A compiler for Copilot targeting C99. description : This package is a back-end from Copilot to C. @@ -45,7 +45,7 @@ library , mtl >= 2.2 && < 2.4 , pretty >= 1.1 && < 1.2 - , copilot-core >= 4.8.1 && < 4.9 + , copilot-core >= 4.8.2 && < 4.9 , language-c99 >= 0.2.0 && < 0.3 , language-c99-simple >= 0.3 && < 0.4 From c2b0269f9838f21e08e040e4bcb39635fd683eb0 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 7 Nov 2026 17:38:42 -0800 Subject: [PATCH 1204/1222] copilot-prettyprinter: Version bump (4.8.2). Refs #792. --- copilot-prettyprinter/copilot-prettyprinter.cabal | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/copilot-prettyprinter/copilot-prettyprinter.cabal b/copilot-prettyprinter/copilot-prettyprinter.cabal index d6c2bcc11..35c5c7d7c 100644 --- a/copilot-prettyprinter/copilot-prettyprinter.cabal +++ b/copilot-prettyprinter/copilot-prettyprinter.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-prettyprinter -version: 4.8.1 +version: 4.8.2 synopsis: A prettyprinter of Copilot Specifications. description: A prettyprinter of Copilot specifications. @@ -45,7 +45,7 @@ library base >= 4.9 && < 5, pretty >= 1.0 && < 1.2, - copilot-core >= 4.8.1 && < 4.9 + copilot-core >= 4.8.2 && < 4.9 exposed-modules: From d17de87e12bc1a7ba2f4bf4e26ec83e03d768c81 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 7 Nov 2026 17:38:42 -0800 Subject: [PATCH 1205/1222] copilot-interpreter: Version bump (4.8.2). Refs #792. --- copilot-interpreter/copilot-interpreter.cabal | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/copilot-interpreter/copilot-interpreter.cabal b/copilot-interpreter/copilot-interpreter.cabal index 538237a10..60152a66a 100644 --- a/copilot-interpreter/copilot-interpreter.cabal +++ b/copilot-interpreter/copilot-interpreter.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-interpreter -version: 4.8.1 +version: 4.8.2 synopsis: Interpreter for Copilot. description: Interpreter for Copilot. @@ -44,7 +44,7 @@ library base >= 4.9 && < 5, pretty >= 1.0 && < 1.2, - copilot-core >= 4.8.1 && < 4.9 + copilot-core >= 4.8.2 && < 4.9 exposed-modules: From 8e714c714950405f568b5e2ebb2f1a3e15ebc04e Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 7 Nov 2026 17:38:42 -0800 Subject: [PATCH 1206/1222] copilot-theorem: Version bump (4.8.2). Refs #792. --- copilot-theorem/copilot-theorem.cabal | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/copilot-theorem/copilot-theorem.cabal b/copilot-theorem/copilot-theorem.cabal index cf3e8c44c..da29f566a 100644 --- a/copilot-theorem/copilot-theorem.cabal +++ b/copilot-theorem/copilot-theorem.cabal @@ -14,7 +14,7 @@ description: . -version : 4.8.1 +version : 4.8.2 license : BSD3 license-file : LICENSE maintainer : Ivan Perez @@ -63,8 +63,8 @@ library , transformers >= 0.5 && < 0.7 , what4 >= 1.3 && < 1.8 - , copilot-core >= 4.8.1 && < 4.9 - , copilot-prettyprinter >= 4.8.1 && < 4.9 + , copilot-core >= 4.8.2 && < 4.9 + , copilot-prettyprinter >= 4.8.2 && < 4.9 exposed-modules : Copilot.Theorem , Copilot.Theorem.Prove From 1f67ea0f33b69c775f25dd21d48c540d95e0ac45 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 7 Nov 2026 17:38:42 -0800 Subject: [PATCH 1207/1222] copilot-language: Version bump (4.8.2). Refs #792. --- copilot-language/copilot-language.cabal | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/copilot-language/copilot-language.cabal b/copilot-language/copilot-language.cabal index b30c29db6..40ba65f2c 100644 --- a/copilot-language/copilot-language.cabal +++ b/copilot-language/copilot-language.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-language -version: 4.8.1 +version: 4.8.2 synopsis: A Haskell-embedded DSL for monitoring hard real-time distributed systems. description: @@ -42,9 +42,9 @@ library , data-reify >= 0.6 && < 0.7 , mtl >= 2.0 && < 3 - , copilot-core >= 4.8.1 && < 4.9 - , copilot-interpreter >= 4.8.1 && < 4.9 - , copilot-theorem >= 4.8.1 && < 4.9 + , copilot-core >= 4.8.2 && < 4.9 + , copilot-interpreter >= 4.8.2 && < 4.9 + , copilot-theorem >= 4.8.2 && < 4.9 exposed-modules: Copilot.Language , Copilot.Language.Operators.BitWise From c97769b18999b8be9b673726817123466bf1c4e9 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 7 Nov 2026 17:38:42 -0800 Subject: [PATCH 1208/1222] copilot-libraries: Version bump (4.8.2). Refs #792. --- copilot-libraries/copilot-libraries.cabal | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/copilot-libraries/copilot-libraries.cabal b/copilot-libraries/copilot-libraries.cabal index b34020a57..6e18aba84 100644 --- a/copilot-libraries/copilot-libraries.cabal +++ b/copilot-libraries/copilot-libraries.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: copilot-libraries -version: 4.8.1 +version: 4.8.2 synopsis: Libraries for the Copilot language. description: Libraries for the Copilot language. @@ -41,7 +41,7 @@ library , containers >= 0.4 && < 0.9 , mtl >= 2.0 && < 2.4 , parsec >= 2.0 && < 3.2 - , copilot-language >= 4.8.1 && < 4.9 + , copilot-language >= 4.8.2 && < 4.9 exposed-modules: Copilot.Library.Analysis From dabb5562b912ae11074e2db5a3610c5a9c296bb6 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 7 Nov 2026 17:38:42 -0800 Subject: [PATCH 1209/1222] copilot-verifier: Version bump (4.8.2). Refs #792. --- copilot-verifier/copilot-verifier.cabal | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/copilot-verifier/copilot-verifier.cabal b/copilot-verifier/copilot-verifier.cabal index 4052ee006..bcf1061bf 100644 --- a/copilot-verifier/copilot-verifier.cabal +++ b/copilot-verifier/copilot-verifier.cabal @@ -1,6 +1,6 @@ Cabal-version: 2.2 Name: copilot-verifier -Version: 4.8.1 +Version: 4.8.2 Author: Galois Inc. Maintainer: rscott@galois.com Copyright: (c) Galois, Inc 2021-2024 @@ -45,9 +45,9 @@ common bldflags bv-sized >= 1.0.0 && < 1.1, bytestring, containers >= 0.5.9.0, - copilot-c99 >= 4.8.1 && < 4.9, - copilot-core >= 4.8.1 && < 4.9, - copilot-theorem >= 4.8.1 && < 4.9, + copilot-c99 >= 4.8.2 && < 4.9, + copilot-core >= 4.8.2 && < 4.9, + copilot-theorem >= 4.8.2 && < 4.9, crucible >= 0.7.1 && < 0.8, crucible-llvm >= 0.7 && < 0.8, crux >= 0.7.1 && < 0.8, @@ -80,10 +80,10 @@ library copilot-verifier-examples hs-source-dirs: examples build-depends: case-insensitive, - copilot >= 4.8.1 && < 4.9, - copilot-language >= 4.8.1 && < 4.9, - copilot-libraries >= 4.8.1 && < 4.9, - copilot-prettyprinter >= 4.8.1 && < 4.9, + copilot >= 4.8.2 && < 4.9, + copilot-language >= 4.8.2 && < 4.9, + copilot-libraries >= 4.8.2 && < 4.9, + copilot-prettyprinter >= 4.8.2 && < 4.9, copilot-verifier exposed-modules: Copilot.Verifier.Examples From a9847388d62d2b725acf1c521ce5b31efc9af989 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 7 Nov 2026 17:38:42 -0800 Subject: [PATCH 1210/1222] copilot-visualizer: Version bump (4.8.2). Refs #792. --- copilot-visualizer/copilot-visualizer.cabal | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/copilot-visualizer/copilot-visualizer.cabal b/copilot-visualizer/copilot-visualizer.cabal index 3b1d539eb..34d2289bd 100644 --- a/copilot-visualizer/copilot-visualizer.cabal +++ b/copilot-visualizer/copilot-visualizer.cabal @@ -1,6 +1,6 @@ cabal-version: >= 1.10 name: copilot-visualizer -version: 4.8.1 +version: 4.8.2 synopsis: Visualizer for Copilot. description: Visualizer for Copilot. @@ -65,10 +65,10 @@ library text >= 1.2.3.1 && < 2.2, websockets >= 0.12.7 && < 0.14, - copilot >= 4.8.1 && < 4.9, - copilot-core >= 4.8.1 && < 4.9, - copilot-interpreter >= 4.8.1 && < 4.9, - copilot-language >= 4.8.1 && < 4.9 + copilot >= 4.8.2 && < 4.9, + copilot-core >= 4.8.2 && < 4.9, + copilot-interpreter >= 4.8.2 && < 4.9, + copilot-language >= 4.8.2 && < 4.9 exposed-modules: @@ -121,7 +121,7 @@ executable tikz-example build-depends: base >= 4.9 && < 5, - copilot >= 4.8.1 && < 4.9, + copilot >= 4.8.2 && < 4.9, copilot-visualizer if flag(examples) From 82d2e07f507e688a8ab5415a9b469787f84fa904 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 7 Nov 2026 17:38:42 -0800 Subject: [PATCH 1211/1222] copilot: Version bump (4.8.2). Refs #792. --- copilot/copilot.cabal | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/copilot/copilot.cabal b/copilot/copilot.cabal index 5fa90035e..00a495e3f 100644 --- a/copilot/copilot.cabal +++ b/copilot/copilot.cabal @@ -1,5 +1,5 @@ name: copilot -version: 4.8.1 +version: 4.8.2 cabal-version: >= 1.10 license: BSD3 license-file: LICENSE @@ -52,12 +52,12 @@ library , directory >= 1.3 && < 1.4 , filepath >= 1.4 && < 1.6 - , copilot-core >= 4.8.1 && < 4.9 - , copilot-theorem >= 4.8.1 && < 4.9 - , copilot-language >= 4.8.1 && < 4.9 - , copilot-libraries >= 4.8.1 && < 4.9 - , copilot-c99 >= 4.8.1 && < 4.9 - , copilot-prettyprinter >= 4.8.1 && < 4.9 + , copilot-core >= 4.8.2 && < 4.9 + , copilot-theorem >= 4.8.2 && < 4.9 + , copilot-language >= 4.8.2 && < 4.9 + , copilot-libraries >= 4.8.2 && < 4.9 + , copilot-c99 >= 4.8.2 && < 4.9 + , copilot-prettyprinter >= 4.8.2 && < 4.9 exposed-modules: Language.Copilot, Language.Copilot.Main From 9a6a2d4ebc52fa54fb7f090624c44b7ca6c8797e Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 7 Nov 2026 17:41:22 -0800 Subject: [PATCH 1212/1222] copilot-core: Document changes in CHANGELOG. Refs #792. --- copilot-core/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot-core/CHANGELOG b/copilot-core/CHANGELOG index c8a3f790d..033129dbc 100644 --- a/copilot-core/CHANGELOG +++ b/copilot-core/CHANGELOG @@ -1,4 +1,5 @@ -2026-10-17 +2026-11-07 + * Version bump (4.8.2). (#792) * Increase test coverage for `Copilot.Core.Type.Array`. (#767) * Fix errors in the documentation of `Copilot.Core.Spec`. (#769) * Replace tab in CHANGELOG. (#772) From 8511f4801141ff2773a1787cb9d51e97e6523b33 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 7 Nov 2026 17:41:22 -0800 Subject: [PATCH 1213/1222] copilot-bluespec: Document changes in CHANGELOG. Refs #792. --- copilot-bluespec/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot-bluespec/CHANGELOG b/copilot-bluespec/CHANGELOG index b3cc16e04..b5130fa0b 100644 --- a/copilot-bluespec/CHANGELOG +++ b/copilot-bluespec/CHANGELOG @@ -1,4 +1,5 @@ -2026-10-12 +2026-11-07 + * Version bump (4.8.2). (#792) * Replace tabs in `DESIGN.md`. (#772) * Remove trailing spaces. (#775) From 3096f9356cc298409b2c2beb909f5cbdff38458b Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 7 Nov 2026 17:41:22 -0800 Subject: [PATCH 1214/1222] copilot-c99: Document changes in CHANGELOG. Refs #792. --- copilot-c99/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-c99/CHANGELOG b/copilot-c99/CHANGELOG index 2caf70ef2..b53dcc838 100644 --- a/copilot-c99/CHANGELOG +++ b/copilot-c99/CHANGELOG @@ -1,3 +1,6 @@ +2026-11-07 + * Version bump (4.8.2). (#792) + 2026-09-07 * Version bump (4.8.1). (#760) From c8e5d846f393ff4c60c079c510a6e4ca3cbb7ec3 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 7 Nov 2026 17:41:22 -0800 Subject: [PATCH 1215/1222] copilot-prettyprinter: Document changes in CHANGELOG. Refs #792. --- copilot-prettyprinter/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-prettyprinter/CHANGELOG b/copilot-prettyprinter/CHANGELOG index 799783ce8..bbe715c47 100644 --- a/copilot-prettyprinter/CHANGELOG +++ b/copilot-prettyprinter/CHANGELOG @@ -1,3 +1,6 @@ +2026-11-07 + * Version bump (4.8.2). (#792) + 2026-09-07 * Version bump (4.8.1). (#760) From 3b79a5b0213f85ca0dd3a904afa474a00f9562d3 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 7 Nov 2026 17:41:22 -0800 Subject: [PATCH 1216/1222] copilot-interpreter: Document changes in CHANGELOG. Refs #792. --- copilot-interpreter/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot-interpreter/CHANGELOG b/copilot-interpreter/CHANGELOG index 1b88d8eb7..55cdec51c 100644 --- a/copilot-interpreter/CHANGELOG +++ b/copilot-interpreter/CHANGELOG @@ -1,4 +1,5 @@ -2026-10-12 +2026-11-07 + * Version bump (4.8.2). (#792) * Replace tab in `Copilot.Interpreter.Eval`. (#772) 2026-09-07 From c6dcc87d50db4d3d33ecc7755d4fc4476413401c Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 7 Nov 2026 17:41:22 -0800 Subject: [PATCH 1217/1222] copilot-theorem: Document changes in CHANGELOG. Refs #792. --- copilot-theorem/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-theorem/CHANGELOG b/copilot-theorem/CHANGELOG index 251b49484..0207c5446 100644 --- a/copilot-theorem/CHANGELOG +++ b/copilot-theorem/CHANGELOG @@ -1,3 +1,6 @@ +2026-11-07 + * Version bump (4.8.2). (#792) + 2026-09-07 * Version bump (4.8.1). (#760) * Remove unnecessary extension. (#733) From 184eaeaa68300f3a303cb92d678ead8ae89acc2b Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 7 Nov 2026 17:41:22 -0800 Subject: [PATCH 1218/1222] copilot-language: Document changes in CHANGELOG. Refs #792. --- copilot-language/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-language/CHANGELOG b/copilot-language/CHANGELOG index 49162ceb0..4aacc9e2e 100644 --- a/copilot-language/CHANGELOG +++ b/copilot-language/CHANGELOG @@ -1,3 +1,6 @@ +2026-11-07 + * Version bump (4.8.2). (#792) + 2026-09-07 * Version bump (4.8.1). (#760) From 1efa2d78fd4f4d40cadd36e0721b9020806cc202 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 7 Nov 2026 17:41:22 -0800 Subject: [PATCH 1219/1222] copilot-libraries: Document changes in CHANGELOG. Refs #792. --- copilot-libraries/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/copilot-libraries/CHANGELOG b/copilot-libraries/CHANGELOG index b95a2cd3f..f84c75a48 100644 --- a/copilot-libraries/CHANGELOG +++ b/copilot-libraries/CHANGELOG @@ -1,4 +1,5 @@ -2026-10-23 +2026-11-07 + * Version bump (4.8.2). (#792) * Add random stream generation module. (#766) 2026-09-07 From 090ff4e6dd4914cd10497452de6970d23f84c5b5 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 7 Nov 2026 17:41:22 -0800 Subject: [PATCH 1220/1222] copilot-verifier: Document changes in CHANGELOG. Refs #792. --- copilot-verifier/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-verifier/CHANGELOG b/copilot-verifier/CHANGELOG index 1dec1cfd0..c69ccd708 100644 --- a/copilot-verifier/CHANGELOG +++ b/copilot-verifier/CHANGELOG @@ -1,3 +1,6 @@ +2026-11-07 + * Version bump (4.8.2). (#792) + 2026-09-07 * Version bump (4.8.1). (#760) From 11c0601e795f40db74538cc0d52c41f2810ebdf3 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 7 Nov 2026 17:41:22 -0800 Subject: [PATCH 1221/1222] copilot-visualizer: Document changes in CHANGELOG. Refs #792. --- copilot-visualizer/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/copilot-visualizer/CHANGELOG b/copilot-visualizer/CHANGELOG index 9d772eca0..b578bedb9 100644 --- a/copilot-visualizer/CHANGELOG +++ b/copilot-visualizer/CHANGELOG @@ -1,3 +1,6 @@ +2026-11-07 + * Version bump (4.8.2). (#792) + 2026-09-07 * Version bump (4.8.1). (#760) * Fix inconsistent version bounds for `copilot` in Cabal file. (#749) From 8049dbb1e8aea3b123ca54be5a285bd1950ea2c6 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 7 Nov 2026 17:41:22 -0800 Subject: [PATCH 1222/1222] copilot: Document changes in CHANGELOG. Refs #792. --- copilot/CHANGELOG | 1 + 1 file changed, 1 insertion(+) diff --git a/copilot/CHANGELOG b/copilot/CHANGELOG index c350ec33a..8b691705e 100644 --- a/copilot/CHANGELOG +++ b/copilot/CHANGELOG @@ -1,4 +1,5 @@ 2026-11-07 + * Version bump (4.8.2). (#792) * Adjust Travis CI script to flag presence of tabs as an error. (#774) * Adjust Travis CI script to flag trailing space as an error. (#777) * Update README to correct typos and improve readability. (#779)