copilot-libraries-4.3/0000755000000000000000000000000014762717306013206 5ustar0000000000000000copilot-libraries-4.3/README.md0000644000000000000000000000257414762717306014475 0ustar0000000000000000[![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 User-supplied libraries for Copilot, including linear-temporal logic, fault-tolerant voting, regular expressions, etc. 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-libraries can be found on [Hackage](https://hackage.haskell.org/package/copilot-libraries). 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-libraries/LICENSE). copilot-libraries-4.3/LICENSE0000644000000000000000000000263614762717306014222 0ustar00000000000000002009 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. copilot-libraries-4.3/Setup.hs0000644000000000000000000000005514762717306014642 0ustar0000000000000000import Distribution.Simple main = defaultMaincopilot-libraries-4.3/CHANGELOG0000644000000000000000000000515614762717306014427 0ustar00000000000000002025-03-07 * Version bump (4.3). (#604) * Remove deprecated function Copilot.Library.Utils.(!!). (#599) 2025-01-07 * Version bump (4.2). (#577) * Bump upper version constraint on containers. (#570) 2024-11-07 * Version bump (4.1). (#561) * Standardize changelog format. (#550) 2024-09-07 * Version bump (4.0). (#532) * Rename operator to avoid name clash. (#36) 2024-07-07 * Version bump (3.20). (#522) 2024-05-07 * Version bump (3.19.1). (#512) 2024-03-07 * Version bump (3.19). (#504) 2024-01-07 * Version bump (3.18.1). (#493) 2024-01-07 * Version bump (3.18). (#487) * Introduce testing infrastructure for Copilot.Library. (#475) * Replace uses of forall with forAll. (#470) 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) * Prevent the majority function from generating unused local variables. (#408) 2023-07-07 * Version bump (3.16). (#448) 2023-05-07 * Version bump (3.15). (#438) 2023-03-07 * Version bump (3.14). (#422) 2023-01-07 * Version bump (3.13). (#406) 2022-11-07 * Version bump (3.12). (#389) 2022-09-07 * Version bump (3.11). (#376) 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) * Update repo info in cabal file. (#333) 2022-05-06 * Version bump (3.9). (#320) * Compliance with style guide (partial). (#316) 2022-03-07 * Version bump (3.8). (#298) * Mark package as uncurated to avoid modification. (#288) 2022-01-07 * Version bump (3.7). (#287) 2021-11-07 * Version bump (3.6). (#264) * Improve documentation of LTL module. (#131) * Fix outdated/broken links. (#252) 2021-08-19 * Version bump (3.5). (#247) * Update travis domain in README. (#222) * Update official maintainer. (#236) * Update source repo location. (#241) * Add I. Perez to author list. (#243) 2021-07-07 * Version bump (3.4). (#231) 2021-05-07 * Version bump (3.3). (#217) 2021-03-07 * Version bump (3.2.1). (#126) * Completed the documentation. (#127) 2020-12-06 * Version bump (3.2). (#65) * Update description, bug-reports, homepage fields in cabal file. (#129) 2019-11-22 * Version bump (3.1). (#46) copilot-libraries-4.3/copilot-libraries.cabal0000644000000000000000000000440314762717306017616 0ustar0000000000000000cabal-version: >=1.10 name: copilot-libraries version: 4.3 synopsis: Libraries for the Copilot language. description: Libraries for the Copilot language. . 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 . license: BSD3 license-file: LICENSE author: Frank Dedden, Lee Pike, Robin Morisset, Alwyn Goodloe, Sebastian Niller, Nis Nordby Wegmann, Ivan Perez 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-libraries library default-language: Haskell2010 hs-source-dirs: src build-depends: base >= 4.9 && < 5 , containers >= 0.4 && < 0.8 , mtl >= 2.0 && < 2.4 , parsec >= 2.0 && < 3.2 , copilot-language >= 4.3 && < 4.4 exposed-modules: Copilot.Library.Libraries , Copilot.Library.Clocks , Copilot.Library.LTL , Copilot.Library.PTLTL , Copilot.Library.Statistics , Copilot.Library.RegExp , Copilot.Library.Utils , Copilot.Library.Voting , Copilot.Library.Stacks , Copilot.Library.MTL 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 copilot-libraries-4.3/tests/0000755000000000000000000000000014762717306014350 5ustar0000000000000000copilot-libraries-4.3/tests/Main.hs0000644000000000000000000000060014762717306015564 0ustar0000000000000000-- | 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 ] copilot-libraries-4.3/tests/Test/0000755000000000000000000000000014762717306015267 5ustar0000000000000000copilot-libraries-4.3/tests/Test/Extra.hs0000644000000000000000000004676214762717306016725 0ustar0000000000000000-- 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, 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 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 $ Copilot.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 copilot-libraries-4.3/tests/Test/Copilot/0000755000000000000000000000000014762717306016700 5ustar0000000000000000copilot-libraries-4.3/tests/Test/Copilot/Library/0000755000000000000000000000000014762717306020304 5ustar0000000000000000copilot-libraries-4.3/tests/Test/Copilot/Library/PTLTL.hs0000644000000000000000000000435014762717306021541 0ustar0000000000000000-- | 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 copilot-libraries-4.3/src/0000755000000000000000000000000014762717306013775 5ustar0000000000000000copilot-libraries-4.3/src/Copilot/0000755000000000000000000000000014762717306015406 5ustar0000000000000000copilot-libraries-4.3/src/Copilot/Library/0000755000000000000000000000000014762717306017012 5ustar0000000000000000copilot-libraries-4.3/src/Copilot/Library/LTL.hs0000644000000000000000000000767414762717306020017 0ustar0000000000000000-- | -- Module: LTL -- Description: Bounded Linear Temporal Logic (LTL) operators -- Copyright: (c) 2011 National Institute of Aerospace / Galois, Inc. -- -- Bounded Linear Temporal Logic (LTL) operators. For a bound @n@, a property -- @p@ holds if it holds on the next @n@ transitions (between periods). If -- @n == 0@, then the trace includes only the current period. For example, -- -- @ -- eventually 3 p -- @ -- -- holds if @p@ holds at least once every four periods (3 transitions). -- -- /Interface:/ See @Examples/LTLExamples.hs@ in the -- . -- -- You can embed an LTL specification within a Copilot specification using the -- form: -- -- @ -- operator spec -- @ -- -- For some properties, stream dependencies may not allow their specification. -- In particular, you cannot determine the "future" value of an external -- variable. -- -- Formulas defined with this module require that predicates have enough -- history, which is only true if they have an append directly in front of -- them. This results in a limited ability to nest applications of temporal -- operators, since simple application of pointwise combinators (e.g., @always -- n1 (p ==> eventually n2 p2)@) will hinder Copilot's ability to determine -- that there is enough of a buffer to carry out the necessary drops to look -- into the future. -- -- In general, the "Copilot.Library.PTLTL" library is probably more useful. {-# LANGUAGE NoImplicitPrelude #-} module Copilot.Library.LTL ( next, eventually, always, until, release ) where import Copilot.Language import Copilot.Library.Utils -- | Property @s@ holds at the next period. For example: -- -- @ -- 0 1 2 3 4 5 6 7 -- s => F F F T F F T F ... -- next s => F F T F F T F ... -- @ -- Note: @s@ must have sufficient history to 'drop' a value from it. 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: -- -- @ -- 0 1 2 3 4 5 6 7 -- s => T T T F T T T T ... -- p => T F F F T T ... -- @ -- -- Note: @s@ must have sufficient history to 'drop' @n@ values from it. 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 -- generated: -- -- @ -- s => F F F T F F F T ... -- p => F T T T F T T T ... -- @ -- -- Note: @s@ must have sufficient history to 'drop' @n@ values from it. eventually :: ( Integral a ) => a -- ^ 'n' -> Stream Bool -- ^ 's' -> 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. -- -- Note: Both argument streams must have sufficient history to 'drop' @n@ -- values from them. 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 ] ] -- | @release n s0 s1@ means that either @always n s1@, or @s1@ holds up to and -- including the period at which @s0@ becomes true. -- -- Note: Both argument streams must have sufficient history to 'drop' @n@ -- values from them. 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 ] ] copilot-libraries-4.3/src/Copilot/Library/Utils.hs0000644000000000000000000001455714762717306020462 0ustar0000000000000000-- | -- Module: Utils -- Description: Utility bounded-list functions (e.g., folds, scans, etc.) -- Copyright: (c) 2011 National Institute of Aerospace / Galois, Inc. -- -- Utility bounded-list functions (e.g., folds, scans, etc.) module Copilot.Library.Utils ( -- * Functions similar to the Prelude functions on lists take, tails, cycle, -- ** Folds nfoldl, nfoldl1, nfoldr, nfoldr1, -- ** Scans nscanl, nscanr, nscanl1, nscanr1, -- ** Indexing case', (!!!)) where import Copilot.Language import qualified Prelude as P -- | Given a stream, produce an infinite list of streams dropping an increasing -- number of elements of the given stream. For example, for a given stream @s@, -- the expression @tails s@ is equal to @[ drop 0 s, drop 1 s, drop 2 s, ...]@. -- 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 -- @[ drop 0 s, drop 1 s]@. take :: ( Integral a, Typed b ) => a -> Stream b -> [ Stream b ] take n s = P.take ( fromIntegral n ) $ tails s -- | Given a number, a function on streams, and two streams, fold from the left -- the function over the finite list of tails of the second stream (up to the -- given number). nfoldl :: ( Typed a, Typed b ) => Int -> ( Stream a -> Stream b -> Stream a ) -> Stream a -> Stream b -> Stream a nfoldl n f e s = foldl f e $ take n s -- | Given a number, a function on streams, and two streams, fold from the left -- the function over the finite list of tails of the second stream (up to the -- given number). -- -- This function differs from 'nfoldl' in that it does not require an initial -- accumulator and it assumes the argument number @n@ is positive. nfoldl1 :: ( Typed a ) => Int -> ( Stream a -> Stream a -> Stream a ) -> Stream a -> Stream a nfoldl1 n f s = foldl1 f $ take n s -- | Given a number, a function on streams, and two streams, fold from the -- right the function over the finite list of tails of the second stream (up to -- the given number). nfoldr :: ( Typed a, Typed b ) => Int -> ( Stream a -> Stream b -> Stream b ) -> Stream b -> Stream a -> Stream b nfoldr n f e s = foldr f e $ take n s -- | Given a number, a function on streams, and two streams, fold from the -- right the function over the finite list of tails of the second stream (up to -- the given number). -- -- This function differs from 'nfoldr' in that it does not require an initial -- accumulator and it assumes the argument number @n@ is positive. nfoldr1 :: ( Typed a ) => Int -> ( Stream a -> Stream a -> Stream a ) -> Stream a -> Stream a nfoldr1 n f s = foldr1 f $ take n s -- | Given a number, a function on streams, and two streams, fold from the left -- the function over the finite list of tails of the second stream (up to the -- given number). -- -- This function differs from 'nfoldl' in that it returns the intermediate -- results as well. nscanl :: ( Typed a, Typed b ) => Int -> ( Stream a -> Stream b -> Stream a ) -> Stream a -> Stream b -> [ Stream a ] nscanl n f e s = scanl f e $ take n s -- | Given a number, a function on streams, and two streams, fold from the -- right the function over the finite list of tails of the second stream (up to -- the given number). -- -- This function differs from 'nfoldr' in that it returns the intermediate -- results as well. nscanr :: ( Typed a ) => Int -> ( Stream a -> Stream b -> Stream b ) -> Stream b -> Stream a -> [ Stream b ] nscanr n f e s = scanr f e $ take n s -- | Given a number, a function on streams, and two streams, fold from the left -- the function over the finite list of tails of the second stream (up to the -- given number). -- -- This function assumes the number of elements to scan is positive, and it -- also returns the intermediate results. nscanl1 :: ( Typed a ) => Int -> ( Stream a -> Stream a -> Stream a ) -> Stream a -> [ Stream a ] nscanl1 n f s = scanl1 f $ take n s -- | Given a number, a function on streams, and two streams, fold from the -- right the function over the finite list of tails of the second stream (up to -- the given number). -- -- This function assumes the number of elements to scan is positive, and it -- also returns the intermediate results. nscanr1 :: ( Typed a ) => Int -> ( Stream a -> Stream a -> Stream 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) case' :: ( Typed a ) => [ Stream Bool ] -> [ Stream a ] -> Stream a case' predicates alternatives = let case'' [] ( default' : _ ) = default' case'' ( p : ps ) ( a : as ) = mux p a ( case'' ps as ) case'' _ _ = badUsage $ "in case' in Utils library: " P.++ "length of alternatives list is not " 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 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 -- | Cycle a list to form an infinite stream. cycle :: ( Typed a ) => [ a ] -> Stream a cycle ls = cycle' where cycle' = ls ++ cycle' copilot-libraries-4.3/src/Copilot/Library/RegExp.hs0000644000000000000000000003760514762717306020553 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} -- | -- Module: RegExp -- Description: Regular expression library -- Copyright: (c) 2011 National Institute of Aerospace / Galois, Inc. -- -- A regular expression library. -- -- For an example, see -- module Copilot.Library.RegExp ( copilotRegexp, copilotRegexpB ) where import Text.ParserCombinators.Parsec ( optional, (<|>), string, char, between, GenParser, many, choice, CharParser , optionMaybe, chainr1, chainr, many1, digit, letter, eof, parse , SourceName ) import Data.Int import Data.Word import Data.List import Data.Char import Data.Maybe import Control.Monad.State ( evalState, get, modify ) import qualified Copilot.Language as C -- | The symbols in a regular expression. -- -- 'Any' is any value of type @t@ (matches any symbol, the "point" character in -- a regular expression). data Sym t = Any | Sym t deriving ( Eq, Ord, Show ) -- | A symbol's value can occur multiple times in a regular expression, e.g. -- "t(tfft)*". A running number "symbolNum" is used to make all symbols in a -- regular expression unique. data NumSym t = NumSym { symbolNum :: Maybe NumT , symbol :: Sym t } deriving ( Eq, Show ) type NumT = Int -- | The regular expression data type. -- -- For our use, regular expressions describing a language with no words are not -- supported since empty languages would not match anything and just yield a -- Copilot stream of constant false values. data RegExp t = REpsilon | RSymbol ( NumSym t ) | ROr ( RegExp t ) ( RegExp t ) | RConcat ( RegExp t ) ( RegExp t ) | RStar ( RegExp t ) deriving Show -- | Parsers for single characters. lquote, rquote, lparen, rparen, star, plus, qmark, point, minus, nondigit :: CharParser () Char lquote = char '<' rquote = char '>' lparen = char '(' rparen = char ')' star = char '*' plus = char '+' qmark = char '?' point = char '.' minus = char '-' nondigit = char '_' <|> letter -- | A "followedBy" combinator for parsing, parses p, then p' and returns the -- result of p. followedBy :: GenParser tok () a -> GenParser tok () b -> 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 -> GenParser tok () String cPrefix p p' = p >>= \ c -> fmap ( c : ) p' -- | Parsing a string @p'@ with the character @p@ as an optional prefix, return -- the result with the optional prefix. optCPrefix p p' = optionMaybe p >>= \ r -> case r of Nothing -> p' Just c -> fmap ( c : ) p' -- | "case insensitive". Take one argument of type string, parses for the -- string in a case insensitive manner and yields the parsed string (preserving -- its case). 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 term :: ( SymbolParser t ) => GenParser Char () ( RegExp t ) term = chainr factor opConcat REpsilon factor :: ( SymbolParser t ) => GenParser Char () ( RegExp t ) factor = opSuffix factor' factor' :: ( SymbolParser t ) => GenParser Char () ( RegExp t ) factor' = between lparen rparen regexp <|> anySym <|> parseSym -- | Parses the "." - point character used to match any symbol. 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 ) <|> ( ci "f" >> optional ( ci "alse" ) >> return False ) <|> ( string "1" >> return True ) <|> ( string "0" >> return False ) ; return $ RSymbol ( NumSym Nothing $ Sym truth ) } parseWordSym :: ( Integral t ) => GenParser Char () ( RegExp t ) parseWordSym = do { num <- between lquote rquote $ many1 digit ; return . RSymbol . NumSym Nothing . Sym $ fromIntegral ( read num :: Integer ) } parseIntSym :: ( Integral t ) => GenParser Char () ( RegExp t ) parseIntSym = do { num <- between lquote rquote $ optCPrefix minus ( many1 digit ) ; return . RSymbol . NumSym Nothing . Sym $ 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 ) ; return . RSymbol . NumSym Nothing . Sym $ P pStream } instance SymbolParser Word8 where parseSym = parseWordSym instance SymbolParser Word16 where parseSym = parseWordSym instance SymbolParser Word32 where parseSym = parseWordSym instance SymbolParser Word64 where parseSym = parseWordSym instance SymbolParser Int8 where parseSym = parseIntSym instance SymbolParser Int16 where parseSym = parseIntSym instance SymbolParser Int32 where parseSym = parseIntSym instance SymbolParser Int64 where parseSym = parseIntSym instance SymbolParser P where parseSym = parsePSym opOr :: GenParser Char () ( RegExp t -> RegExp t -> RegExp t ) opOr = char '|' >> return ROr opConcat :: GenParser Char () ( RegExp t -> RegExp t -> RegExp t ) opConcat = return RConcat opSuffix :: GenParser Char () ( RegExp t ) -> GenParser Char () ( RegExp t ) opSuffix r = do subexp <- r suffixes <- many $ choice [ star, plus, qmark ] let transform rexp suffix = case suffix of '*' -> RStar rexp '+' -> RConcat rexp ( RStar rexp ) '?' -> ROr rexp REpsilon other -> C.badUsage ("in Regular Expression library: " ++ "unhandled operator: " ++ show other) return $ foldl transform subexp suffixes parser :: ( SymbolParser t ) => GenParser Char () ( RegExp t ) parser = regexp `followedBy` eof hasEpsilon :: RegExp t -> Bool hasEpsilon REpsilon = True hasEpsilon ( RSymbol _ ) = False 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 ] first ( ROr r1 r2 ) = first r1 ++ first r2 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 _ = [] follow ( RSymbol _ ) _ = [] follow ( ROr r1 r2 ) sNr = follow r1 sNr ++ follow r2 sNr follow ( RConcat r1 r2 ) sNr = follow r1 sNr ++ follow r2 sNr ++ if sNr `elem` last' r1 then first r2 else [] 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 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 enumSyms rexp = evalState ( enumSyms' rexp ) 0 where enumSyms' ( RSymbol s ) = do num <- get modify ( + 1 ) return $ RSymbol s { symbolNum = Just num } enumSyms' ( ROr r1 r2 ) = do r1' <- enumSyms' r1 r2' <- enumSyms' r2 return $ ROr r1' r2' enumSyms' ( RConcat r1 r2 ) = do r1' <- enumSyms' r1 r2' <- enumSyms' r2 return $ RConcat r1' r2' enumSyms' ( RStar r ) = do r' <- enumSyms' r return $ RStar r' 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 = let symbols = getSymbols rexp first' = first rexp start = [ True ] C.++ C.false preceding' numSym = let ps = preceding rexp numSym s = if numSym `elem` first' then [ start ] else [] in s ++ [ streams !! i | i <- map ( fromJust . symbolNum ) ps ] matchesInput numSym = case symbol numSym of Any -> C.true Sym t -> inStream C.== C.constant t transitions numSym ps = matchesInput numSym C.&& ( foldl ( C.|| ) C.false ps ) stream numSym = let ps = preceding' numSym init_ = C.constant $ numSym `elem` first' in C.mux reset ( [ False ] C.++ matchesInput numSym C.&& init_ ) ( [ False ] C.++ transitions numSym ps ) streams = map stream symbols outStream = foldl ( C.|| ) start streams in outStream -- | Regular expression matching over an arbitrary stream copilotRegexp :: ( C.Typed t, SymbolParser t, Eq t ) => C.Stream t -- ^ The stream to monitor. -> SourceName -- ^ The regular expression. -> C.Stream Bool -- ^ A stream indicating when to reset the -- monitor. -> C.Stream Bool copilotRegexp inStream rexp reset = case parse parser rexp rexp of Left err -> C.badUsage ("parsing regular exp: " ++ show err) Right rexp' -> let nrexp = enumSyms rexp' in if hasFinitePath nrexp then C.badUsage $ concat [ "The regular expression contains a finite path " , "which is something that will fail to match " , "since we do not have a distinct end-of-input " , "symbol on infinite streams." ] else if hasEpsilon nrexp then C.badUsage $ concat [ "The regular expression matches a language " , "that contains epsilon. This cannot be handled " , "on infinite streams, since we do not have " , "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 = let symbols = getSymbols rexp first' = first rexp start = [ True ] C.++ C.false preceding' numSym = let ps = preceding rexp numSym s = if numSym `elem` first' then [ start ] else [] in s ++ [ streams !! i | i <- map ( fromJust . symbolNum ) ps ] lookup' a l = case lookup a l of Nothing -> C.badUsage ("boolean stream " ++ a ++ " is not defined") Just s -> s matchesInput numSym = case symbol numSym of Any -> C.true Sym t -> lookup' ( getName t ) propositions transitions numSym ps = matchesInput numSym C.&& ( foldl ( C.|| ) C.false ps ) stream numSym = let ps = preceding' numSym init_ = C.constant $ numSym `elem` first' in C.mux reset ( [ False ] C.++ matchesInput numSym C.&& init_ ) ( [ False ] C.++ transitions numSym ps ) streams = map stream symbols outStream = foldl ( C.|| ) start streams in outStream -- | Regular expression matching over a collection of boolean streams. -- -- Regular expressions can contain symbols, which are expanded to match -- specific streams. -- -- For example, the regular expression: -- -- @ -- "\(\)+" -- @ -- -- would match if you provide a map (association list) that assigns, to the -- symbol @"s0"@, a stream that is true at the first sample, and to @"s1"@, a -- stream that is true at every sample after the first sample. copilotRegexpB :: SourceName -- ^ Regular expression -> [ ( StreamName, C.Stream Bool ) ] -- ^ A table with the -- stream associated to -- each symbol. -> C.Stream Bool -- ^ A stream indicating -- when to reset the -- monitor. -> C.Stream Bool copilotRegexpB rexp propositions reset = case parse parser rexp rexp of Left err -> C.badUsage ("parsing regular exp: " ++ show err) Right rexp' -> let nrexp = enumSyms rexp' in if hasFinitePath nrexp then C.badUsage $ concat [ "The regular expression contains a finite path " , "which is something that will fail to match " , "since we do not have a distinct end-of-input " , "symbol on infinite streams." ] else if hasEpsilon nrexp then C.badUsage $ concat [ "The regular expression matches a language " , "that contains epsilon. This cannot be handled " , "on infinite streams, since we do not have " , "a distinct end-of-input symbol." ] else regexp2CopilotNFAB nrexp propositions reset copilot-libraries-4.3/src/Copilot/Library/Stacks.hs0000644000000000000000000000744614762717306020611 0ustar0000000000000000-- | -- 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 -- three input streams: -- -- * a pop signal which pops off the stack when true, -- * a push signal which pushes the value from the push stream onto the stack when true, -- * a push stream. -- The resultant stream is the top value of the stack. -- -- 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 -- @ -- -- 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. {-# LANGUAGE NoImplicitPrelude #-} module Copilot.Library.Stacks ( stack, stack' ) where import Copilot.Language -- | Stack stream in which the pop signal has precedence over the push signal -- in case both are true in the same tick stack :: (Integral a, Typed b) => a -- ^ Depth -> b -- ^ Start value -> Stream Bool -- ^ Pop signal -> Stream Bool -- ^ Push signal -> Stream b -- ^ Push stream -> Stream b -- ^ Stack top stack depth startValue popSignal pushSignal pushValue = let depth' = fromIntegral depth startValue' = constant startValue stackValue pushValue' popValue' = let stackValue' = [ startValue ] ++ mux popSignal popValue' ( mux pushSignal pushValue' stackValue' ) in stackValue' toStack l = let toStack' _ [] = startValue' toStack' prev ( sv : svs ) = let current = sv prev ( toStack' current svs ) in current in toStack' pushValue l in toStack $ replicate depth' stackValue -- | Stack stream in which the push signal has precedence over the pop signal -- in case both are true in the same tick stack' :: (Integral a, Typed b) => a -- ^ Depth -> b -- ^ Start value -> Stream Bool -- ^ Pop signal -> Stream Bool -- ^ Push signal -> Stream b -- ^ Push stream -> Stream b -- ^ Stack top stack' depth startValue popSignal pushSignal pushValue = let depth' = fromIntegral depth startValue' = constant startValue stackValue pushValue' popValue' = let stackValue' = [ startValue ] ++ mux pushSignal pushValue' ( mux popSignal popValue' stackValue' ) in stackValue' toStack l = let toStack' _ [] = startValue' toStack' prev ( sv : svs ) = let current = sv prev ( toStack' current svs ) in current in toStack' pushValue l in toStack $ replicate depth' stackValue copilot-libraries-4.3/src/Copilot/Library/Clocks.hs0000644000000000000000000000646714762717306020601 0ustar0000000000000000-- | -- Module: Clocks -- Description: Clocks based on a base period and phase -- Copyright: (c) 2011 National Institute of Aerospace / Galois, Inc. -- -- This library generates new clocks based on a base period and phase. -- -- = Example Usage -- -- Also see @examples/Clock.hs@ in the -- . -- -- @ -- 'clk' ( 'period' 3 ) ( 'phase' 1 ) -- @ -- -- is equivalent to a stream of values like: -- -- @ -- cycle [False, True, False] -- @ -- -- that generates a stream of values -- -- @ -- False True False False True False False True False ... -- 0 1 2 3 4 5 6 7 8 -- @ -- -- That is true every 3 ticks (the period) starting on the 1st tick (the phase). {-# LANGUAGE NoImplicitPrelude #-} module Copilot.Library.Clocks ( clk, clk1, period, phase ) where import Prelude () import qualified Prelude as P import Copilot.Language data ( Integral a ) => Period a = Period a data ( Integral a ) => Phase a = Phase a -- | Constructor for a 'Period'. Note that period must be greater than 0. period :: ( Integral a ) => a -> Period a period = Period -- | Constructor for a 'Phase'. Note that phase must be greater than or equal -- to 0, and must be less than the period. phase :: ( Integral a ) => a -> Phase a phase = Phase -- | Generate a clock that counts every @n@ ticks, starting at tick @m@, by -- using an array of size @n@. clk :: ( Integral a ) => Period a -- ^ Period @n@ of clock -> 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' -- | 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 ) => Period a -- ^ Period @n@ of clock -> Phase a -- ^ Phase @m@ of clock -> Stream Bool -- ^ Clock signal - 'True' on clock ticks, 'False' otherwise clk1 ( Period period' ) ( Phase phase' ) = if period' P.< 1 then badUsage ( "clk1: clock period must be 1 or greater" ) else if phase' P.< 0 then badUsage ( "clk1: clock phase must be 0 or greater" ) else if phase' P.>= period' then badUsage ( "clk1: clock phase must be less than period") else let counter = [ P.fromInteger 0 ] ++ mux ( counter /= ( constant $ period' P.- 1 ) ) ( counter P.+ 1 ) ( 0 ) in counter == fromIntegral phase' copilot-libraries-4.3/src/Copilot/Library/PTLTL.hs0000644000000000000000000000243014762717306020244 0ustar0000000000000000-- | -- Module: PTLTL -- Description: Past-Time Linear-Temporal Logic -- Copyright: (c) 2011 National Institute of Aerospace / Galois, Inc. -- -- Provides past-time linear-temporal logic (ptLTL operators). -- -- /Interface:/ See @Examples/PTLTLExamples.hs@ in the -- . -- -- You can embed a ptLTL specification within a Copilot specification using -- the form: -- -- @ -- operator stream -- @ {-# LANGUAGE NoImplicitPrelude #-} module Copilot.Library.PTLTL ( since, alwaysBeen, eventuallyPrev, previous ) where import Prelude () import Copilot.Language -- | Did @s@ hold in the previous period? 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 -- | 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)) copilot-libraries-4.3/src/Copilot/Library/Voting.hs0000644000000000000000000000743614762717306020626 0ustar0000000000000000-- | -- Module: Voting -- Description: Implementation of the Boyer-Moore Majority Vote Algorithm -- Copyright: (c) 2011 National Institute of Aerospace / Galois, Inc. -- -- This is an implementation of the Boyer-Moore Majority Vote Algorithm for -- Copilot, which solves the majority vote problem in linear time and constant -- memory in two passes. 'majority' implements the first pass, and 'aMajority' -- the second pass. For details of the Boyer-Moore Majority Vote Algorithm see -- the following papers: -- -- * -- -- * -- -- In addition, and -- explain -- a form of this code in section 4. -- -- For instance, with four streams passed to 'majority', and the candidate stream -- then passed to 'aMajority': -- -- @ -- vote1: vote2: vote3: vote4: majority: aMajority: -- 0 0 0 0 0 true -- 1 0 0 0 0 true -- 1 1 0 0 1 false -- 1 1 1 0 1 true -- 1 1 1 1 1 true -- @ -- -- For other examples, see @examples/Voting.hs@ in the -- . {-# LANGUAGE RebindableSyntax #-} module Copilot.Library.Voting ( majority, aMajority ) where import Copilot.Language import qualified Prelude as P -- | Majority vote first pass: choosing a candidate. majority :: (P.Eq a, Typed a) => [Stream a] -- ^ Vote streams -> Stream a -- ^ Candidate stream majority [] = badUsage "majority: empty list not allowed" majority (x:xs) = majority' xs x 1 -- Alternate syntax of local bindings. majority' :: (P.Eq a, Typed a) => [Stream a] -> Stream a -> Stream Word32 -> Stream a majority' [] can _ = can majority' (x:xs) can cnt = local (cnt == 0) inZero where inZero zero = local (if zero then x else can) inCan where 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' -- | Majority vote second pass: checking that a candidate indeed has more than -- half the votes. aMajority :: (P.Eq a, Typed a) => [Stream a] -- ^ Vote streams -> Stream a -- ^ Candidate stream -> Stream Bool -- ^ True if candidate holds majority aMajority [] _ = badUsage "aMajority: empty list not allowed" aMajority xs can = let cnt = aMajority' 0 xs can in (cnt * 2) > fromIntegral (length xs) aMajority' :: (P.Eq a, Typed a) => Stream Word32 -> [Stream a] -> Stream a -> Stream Word32 aMajority' cnt [] _ = cnt aMajority' cnt (x:xs) can = local (if x == can then cnt+1 else cnt) $ \ cnt' -> aMajority' cnt' xs can copilot-libraries-4.3/src/Copilot/Library/MTL.hs0000644000000000000000000001775214762717306020016 0ustar0000000000000000-- | -- Description: Metric Temporal Logic (MTL) over a discrete time domain. -- -- Metric Temporal Logic (MTL) over a discrete time domain consisting of -- sampled time values. -- -- The operators in this module receive two additional arguments: a clock -- stream @clk@, indicating the current time, and a distance between samples -- @dist@. For the purposes of explaining the MTL aspects, we ignore those -- arguments. If you are using streams for which you can treat time as a -- discrete increasing number, you can safely assume that the clock is a -- counter (i.e., @[0, 1, 2,...]@, which can be defined by the stream @counter -- = [0] ++ counter@) and the distance between samples is @1@. module Copilot.Library.MTL ( eventually, eventuallyPrev, always, alwaysBeen, until, release, since, Copilot.Library.MTL.trigger, matchingUntil, matchingRelease, matchingSince, matchingTrigger ) where import Copilot.Language import qualified Prelude as P import Copilot.Library.Utils -- It is necessary to provide a positive number of time units -- dist to each function, where the distance between the times -- of any two adjacent clock samples is no less than dist -- | Eventually true in the future, within the time bounds specified. -- -- @eventually l u clk dist s@ is true at time @t@ if and only if @s@ is true -- at some time @t'@, where @(t + l) <= t' <= (t + u)@. eventually :: ( Typed a, Integral a ) => a -> a -> Stream a -> a -> Stream Bool -> Stream Bool eventually l u clk dist s = res clk s $ (u `P.div` dist) + 1 where mins = clk + (constant l) maxes = clk + (constant u) res _ _ 0 = false res c s k = c <= maxes && ((mins <= c && s) || nextRes c s k) nextRes c s k = res (drop 1 c) (drop 1 s) (k - 1) -- | True at some point in the past within the time bounds specified. -- -- @eventuallyPrev l u clk dist s@ is true at time @t@ if and only if @s@ is -- true at some time @t'@, where @(t - u) <= t' <= (t - l)@. eventuallyPrev :: ( Typed a, Integral a ) => a -> a -> Stream a -> a -> Stream Bool -> Stream Bool eventuallyPrev l u clk dist s = res clk s $ (u `P.div` dist) + 1 where mins = clk - (constant u) maxes = clk - (constant l) res _ _ 0 = false res c s k = mins <= c && ((c <= maxes && s) || nextRes c s k) nextRes c s k = res ([0] ++ c) ([False] ++ s) (k - 1) -- | Always true in the future, within the time bounds specified. -- -- @always l u clk dist s@ is true at time @t@ iff @s@ is true at all times -- @t'@ where @(t + l) <= t' <= (t + u)@. always :: ( Typed a, Integral a ) => a -> a -> Stream a -> a -> Stream Bool -> Stream Bool always l u clk dist s = res clk s $ (u `P.div` dist) + 1 where mins = clk + (constant l) maxes = clk + (constant u) res _ _ 0 = true res c s k = c > maxes || ((mins <= c ==> s) && nextRes c s k) nextRes c s k = res (drop 1 c) (drop 1 s) (k - 1) -- | Always true in the past, within the time bounds specified. -- -- @alwaysBeen l u clk dist s@ is true at time @t@ iff @s@ is true at all times -- @t'@ where @(t - u) <= t' <= (t - l)@. alwaysBeen :: ( Typed a, Integral a ) => a -> a -> Stream a -> a -> Stream Bool -> Stream Bool alwaysBeen l u clk dist s = res clk s $ (u `P.div` dist) + 1 where mins = clk - (constant u) maxes = clk - (constant l) res _ _ 0 = true res c s k = c < mins || ((c <= maxes ==> s) && nextRes c s k) nextRes c s k = res ([0] ++ c) ([True] ++ s) (k - 1) -- | True until another stream is true, within the time bounds specified. -- -- @until l u clk dist s0 s1@ is true at time @t@ iff there exists a @d@, with -- @l <= d <= u@, such that @s1@ is true at time @(t + d)@, and for all times -- @t'@ with @t <= t' < t + d@, @s0@ is true at those times. until :: ( Typed a, Integral a ) => a -> a -> Stream a -> a -> Stream Bool -> Stream Bool -> Stream Bool until l u clk dist s0 s1 = res clk s0 s1 $ (u `P.div` dist) + 1 where mins = clk + (constant l) maxes = clk + (constant u) res _ _ _ 0 = false res c s s' k = c <= maxes && ((mins <= c && s') || (s && nextRes c s s' k)) nextRes c s s' k = res (drop 1 c) (drop 1 s) (drop 1 s') (k - 1) -- | True since another stream became true, within the time bounds specified. -- -- @since l u clk dist s0 s1@ is true at time @t@ iff there exists a @d@, with -- @l <= d <= u@, such that @s1@ is true at time @(t - d)@, and for all times -- @t'@ with @t - d < t' <= t@, @s0@ is true at those times. since :: ( Typed a, Integral a ) => a -> a -> Stream a -> a -> Stream Bool -> Stream Bool -> Stream Bool since l u clk dist s0 s1 = res clk s0 s1 $ (u `P.div` dist) + 1 where mins = clk - (constant u) maxes = clk - (constant l) res _ _ _ 0 = false res c s s' k = mins <= c && ((c <= maxes && s') || (s && nextRes c s s' k)) nextRes c s s' k = res ([0] ++ c) ([True] ++ s) ([False] ++ s') (k - 1) -- | True if a stream is true until another one releases it. -- -- @release l u clk dist s0 s1@ is true at time @t@ iff for all @d@ with @l <= -- d <= u@ where there is a sample at time @(t + d)@, @s1@ is true at time @(t -- + d)@, or @s0@ has a true sample at some time @t'@ with @t <= t' < t + d@. release :: ( Typed a, Integral a ) => a -> a -> Stream a -> a -> Stream Bool -> Stream Bool -> Stream Bool release l u clk dist s0 s1 = (mins > clk || clk > maxes || s1) && (res (drop 1 clk) s0 (drop 1 s1) $ u `P.div` dist) where mins = clk + (constant l) maxes = clk + (constant u) res _ _ _ 0 = true res c s s' k = s || ((mins > c || c > maxes || s') && nextRes c s s' k) nextRes c s s' k = res (drop 1 c) (drop 1 s) (drop 1 s') (k - 1) -- | True if a stream is true until another one releases it. -- -- Trigger: True at time @t@ iff for all @d@ with @l <= d <= u@ where there is -- a sample at time @(t - d)@, @s1@ is true at time @(t - d)@, or @s0@ has a -- true sample at some time @t'@ with @t - d < t' <= t@. trigger :: ( Typed a, Integral a ) => a -> a -> Stream a -> a -> Stream Bool -> Stream Bool -> Stream Bool trigger l u clk dist s0 s1 = (mins > clk || clk > maxes || s1) && (res ([0] ++ clk) s0 ([True] ++ s1) $ u `P.div` dist) where mins = clk - (constant u) maxes = clk - (constant l) res _ _ _ 0 = true res c s s' k = s || ((mins > c || c > maxes || s') && nextRes c s s' k) nextRes c s s' k = res ([0] ++ c) ([False] ++ s) ([True] ++ s') (k - 1) -- Matching Variants -- | Matching Until: Same semantics as @until@, except with both @s1@ and @s0@ -- needing to hold at time @(t + d)@ instead of just @s1@. matchingUntil :: ( Typed a, Integral a ) => a -> a -> Stream a -> a -> Stream Bool -> Stream Bool -> Stream Bool matchingUntil l u clk dist s0 s1 = res clk s0 s1 $ (u `P.div` dist) + 1 where mins = clk + (constant l) maxes = clk + (constant u) res _ _ _ 0 = false res c s s' k = c <= maxes && s && ((mins <= c && s') || nextRes c s s' k) nextRes c s s' k = res (drop 1 c) (drop 1 s) (drop 1 s') (k - 1) -- | Matching Since: Same semantics as @since@, except with both @s1@ and @s0@ -- needing to hold at time @(t - d)@ instead of just @s1@. matchingSince :: ( Typed a, Integral a ) => a -> a -> Stream a -> a -> Stream Bool -> Stream Bool -> Stream Bool matchingSince l u clk dist s0 s1 = since l u clk dist s0 (s0 && s1) -- | Matching Release: Same semantics as @release@, except with @s1@ or @s0@ -- needing to hold at time @(t + d)@ instead of just @s1@. matchingRelease :: ( Typed a, Integral a ) => a -> a -> Stream a -> a -> Stream Bool -> Stream Bool -> Stream Bool matchingRelease l u clk dist s0 s1 = res clk s0 s1 $ (u `P.div` dist) + 1 where mins = clk + (constant l) maxes = clk + (constant u) res _ _ _ 0 = true res c s s' k = s || ((mins > c || c > maxes || s') && nextRes c s s' k) nextRes c s s' k = res (drop 1 c) (drop 1 s) (drop 1 s') (k - 1) -- | Matching Trigger: Same semantics as @trigger@, except with @s1@ or @s0@ -- needing to hold at time @(t - d)@ instead of just @s1@. matchingTrigger :: ( Typed a, Integral a ) => a -> a -> Stream a -> a -> Stream Bool -> Stream Bool -> Stream Bool matchingTrigger l u clk dist s0 s1 = Copilot.Library.MTL.trigger l u clk dist s0 (s0 || s1) copilot-libraries-4.3/src/Copilot/Library/Libraries.hs0000644000000000000000000000160714762717306021266 0ustar0000000000000000-- | -- Module: Libraries -- Description: Main import module for libraries -- Copyright: (c) 2011 National Institute of Aerospace / Galois, Inc. -- -- This is a convenience module that re-exports a useful subset of modules from -- @copilot-library@. Not all modules are exported due to name clashes (e.g., -- in temporal logics implementations). module Copilot.Library.Libraries ( module Copilot.Library.Clocks , module Copilot.Library.LTL , module Copilot.Library.PTLTL , module Copilot.Library.Statistics , module Copilot.Library.RegExp , module Copilot.Library.Utils , module Copilot.Library.Voting , module Copilot.Library.Stacks ) where import Copilot.Library.Clocks import Copilot.Library.LTL import Copilot.Library.PTLTL import Copilot.Library.Statistics import Copilot.Library.RegExp import Copilot.Library.Utils import Copilot.Library.Voting import Copilot.Library.Stacks copilot-libraries-4.3/src/Copilot/Library/Statistics.hs0000644000000000000000000000261614762717306021505 0ustar0000000000000000-- | -- Module: Statistics -- Description: Basic bounded statistics -- Copyright: (c) 2011 National Institute of Aerospace / Galois, Inc. -- -- Basic bounded statistics. In the following, a bound @n@ is given stating -- the number of periods over which to compute the statistic (@n == 1@ computes -- it only over the current period). {-# LANGUAGE NoImplicitPrelude #-} module Copilot.Library.Statistics ( max, min, sum, mean, meanNow ) where import Copilot.Language import Copilot.Library.Utils -- | Summation. sum :: ( Typed a, Num a, Eq a ) => Int -> Stream a -> Stream a 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 -- | 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 -- | Mean value. @n@ must not overflow -- for word size @a@ for streams over which computation is peformed. mean :: ( Typed a, Eq a, Fractional a ) => Int -> Stream a -> Stream a 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 [] = badUsage "list of arguments to meanNow must be nonempty" meanNow ls = ( foldl1 (+) ls ) `div` ( fromIntegral $ length ls )