copilot-language-4.3/0000755000000000000000000000000014762717303013012 5ustar0000000000000000copilot-language-4.3/README.md0000644000000000000000000000314314762717303014272 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 Copilot-language contains the actual embedded domain specific language that Copilot provides to its users. It comes with a series of basic operators and functionality, typically enough for most applications. Extended functionality is provided by the [copilot-libraries](https://github.com/Copilot-Language/copilot/tree/master/copilot-libraries) module. 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-language can be found on [Hackage](https://hackage.haskell.org/package/copilot-language). 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-language/LICENSE). copilot-language-4.3/LICENSE0000644000000000000000000000263614762717303014026 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-language-4.3/Setup.hs0000644000000000000000000000005514762717303014446 0ustar0000000000000000import Distribution.Simple main = defaultMaincopilot-language-4.3/CHANGELOG0000644000000000000000000001007614762717303014230 0ustar00000000000000002025-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.(.!!). (#599) 2025-01-07 * Version bump (4.2). (#577) * Bump upper version constraint on containers. (#570) 2024-11-07 * Version bump (4.1). (#561) * Reject duplicate externs in properties and theorems. (#536) * Standardize changelog format. (#550) 2024-09-07 * Version bump (4.0). (#532) * Add support for array updates. (#36) 2024-07-07 * Version bump (3.20). (#522) * Remove deprecated function Copilot.Language.Spec.forall. (#518) * Add support for struct field updates. (#520) 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) * Add type annotation to help type inference engine. (#469) * Rename forall to forAll. (#470) 2023-11-07 * Version bump (3.17). (#466) 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) 2023-05-07 * Version bump (3.15). (#438) * Remove outdated comment about pretty-printer. (#428) 2023-03-07 * Version bump (3.14). (#422) * Remove function Copilot.Language.prettyPrint. (#412) * Adjust to work with GHC 9.4. (#423) 2023-01-07 * Version bump (3.13). (#406) 2022-11-07 * Version bump (3.12). (#389) * Use pretty-printer from copilot-prettyprinter. (#383) 2022-09-07 * Version bump (3.11). (#376) * 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) * 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) * Compliance with style guide (partial). (#316) 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) * Bring back externF. (#261) 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) * Fix outdated/broken links. (#252) 2021-08-19 * Version bump (3.5). (#247) * Update travis domain in README. (#222) * Remove ghc-prim dependency from copilot-language. (#220) * Remove commented code. (#15) * Deprecate structArg. (#111) * Update source repo location. (#241) * Deprecate module Copilot. (#107) * Add I. Perez to author list. (#243) 2021-07-07 * Version bump (3.4). (#231) 2021-05-07 * Version bump (3.3). (#217) * Remove unused type. (#110) * Deprecate funArg. (#109) * Update contact details in error message. (#108) 2021-03-07 * Version bump (3.2.1). (#106) * Completed the documentation. (#112) 2020-05-07 * 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 * Version bump (3.1). (#46) * Remove ExternFun. (#118) copilot-language-4.3/copilot-language.cabal0000644000000000000000000000674214762717303017241 0ustar0000000000000000cabal-version: >=1.10 name: copilot-language version: 4.3 synopsis: A Haskell-embedded DSL for monitoring hard real-time distributed systems. description: The concrete syntax 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 . 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-language library default-language: Haskell2010 hs-source-dirs: src build-depends: base >= 4.9 && < 5 , array >= 0.5 && < 0.6 , containers >= 0.4 && < 0.8 , 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 exposed-modules: Copilot.Language , Copilot.Language.Operators.BitWise , Copilot.Language.Operators.Boolean , Copilot.Language.Operators.Propositional , Copilot.Language.Operators.Cast , Copilot.Language.Operators.Constant , Copilot.Language.Operators.Eq , Copilot.Language.Operators.Extern , Copilot.Language.Operators.Integral , Copilot.Language.Operators.Local , Copilot.Language.Operators.Label , Copilot.Language.Operators.Mux , 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 , Copilot.Language.Stream , Copilot.Language.Spec other-modules: Copilot.Language.Analyze , Copilot.Language.Interpret , System.Mem.StableName.Dynamic , System.Mem.StableName.Map , Copilot.Language.Error ghc-options: -Wall test-suite unit-tests type: exitcode-stdio-1.0 main-is: Main.hs other-modules: Test.Copilot.Language.Reify Test.Extra build-depends: base , HUnit , QuickCheck , pretty , test-framework , test-framework-hunit , test-framework-quickcheck2 , copilot-core , copilot-interpreter , copilot-language hs-source-dirs: tests default-language: Haskell2010 ghc-options: -Wall copilot-language-4.3/tests/0000755000000000000000000000000014762717303014154 5ustar0000000000000000copilot-language-4.3/tests/Main.hs0000644000000000000000000000057714762717303015405 0ustar0000000000000000-- | Test copilot-language. module Main where -- External imports import Test.Framework (Test, defaultMain) -- Internal imports import qualified Test.Copilot.Language.Reify -- | Run all unit tests on copilot-language. main :: IO () main = defaultMain tests -- | All unit tests in copilot-language. tests :: [Test.Framework.Test] tests = [ Test.Copilot.Language.Reify.tests ] copilot-language-4.3/tests/Test/0000755000000000000000000000000014762717303015073 5ustar0000000000000000copilot-language-4.3/tests/Test/Extra.hs0000644000000000000000000000227314762717303016516 0ustar0000000000000000-- | 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 copilot-language-4.3/tests/Test/Copilot/0000755000000000000000000000000014762717303016504 5ustar0000000000000000copilot-language-4.3/tests/Test/Copilot/Language/0000755000000000000000000000000014762717303020227 5ustar0000000000000000copilot-language-4.3/tests/Test/Copilot/Language/Reify.hs0000644000000000000000000007225214762717303021651 0ustar0000000000000000{-# 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.Bits (Bits, complement, shiftL, shiftR, 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, arbitrary, chooseInt, elements, forAll, forAllShow, frequency, oneof, suchThat) 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 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 (Spec, observer) import Copilot.Language.Stream (Stream) import qualified Copilot.Language.Stream as Copilot -- Internal imports: functions needed to test after reification 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-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)) , 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)) ] -- ** 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 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) ] -- | 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) ] -- | 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) -- | 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) -- | 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) ] -- | 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 <*> 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 -> (Copilot.constant 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 (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 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 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) => 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 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) => 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) => Gen ( Stream t -> Stream t -> Stream t , [t] -> [t] -> [t] ) arbitraryFloatingOp2 = elements [ ((**), zipWith (**)) , (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) => 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) ] -- | 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 -- 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. -- -- 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 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 copilot-language-4.3/src/0000755000000000000000000000000014762717303013601 5ustar0000000000000000copilot-language-4.3/src/System/0000755000000000000000000000000014762717303015065 5ustar0000000000000000copilot-language-4.3/src/System/Mem/0000755000000000000000000000000014762717303015603 5ustar0000000000000000copilot-language-4.3/src/System/Mem/StableName/0000755000000000000000000000000014762717303017616 5ustar0000000000000000copilot-language-4.3/src/System/Mem/StableName/Map.hs0000644000000000000000000000605214762717303020672 0ustar0000000000000000-- Most of this code is taken from 'http://github.com/ekmett/stable-maps'. {-# LANGUAGE Safe #-} module System.Mem.StableName.Map ( Map(..) , empty , null , singleton , member , notMember , insert , insertWith , insertWith' , lookup , find , findWithDefault ) where import qualified Prelude import Prelude hiding (lookup, null) import System.Mem.StableName.Dynamic import qualified Data.IntMap as IntMap import Data.IntMap (IntMap) import Copilot.Language.Error (impossible) data Map a = Map { getMap :: IntMap [(DynStableName, a)] , getSize :: Int } empty :: Map a empty = Map IntMap.empty 0 null :: Map a -> Bool null (Map m _) = IntMap.null m singleton :: DynStableName -> a -> Map a singleton k v = Map (IntMap.singleton (hashDynStableName k) [(k,v)]) 1 member :: DynStableName -> Map a -> Bool member k m = case lookup k m of Nothing -> False Just _ -> True notMember :: DynStableName -> Map a -> Bool notMember k m = not $ member k m insert :: DynStableName -> a -> Map a -> Map a insert k v Map { getMap = mp , getSize = sz } = Map (IntMap.insertWith (++) (hashDynStableName k) [(k,v)] mp) (sz + 1) -- | /O(log n)/. Insert with a function for combining the new value and old value. -- @'insertWith' f key value mp@ -- will insert the pair (key, value) into @mp@ if the key does not exist -- in the map. If the key does exist, the function will insert the pair -- @(key, f new_value old_value)@ insertWith :: (a -> a -> a) -> DynStableName -> a -> Map a -> Map a insertWith f k v Map { getMap = mp , getSize = sz } = Map (IntMap.insertWith go (hashDynStableName k) [(k,v)] mp) (sz + 1) where go _ ((k',v'):kvs) | k == k' = (k', f v v') : kvs | otherwise = (k',v') : go undefined kvs go _ [] = [] -- | Same as 'insertWith', but with the combining function applied strictly. insertWith' :: (a -> a -> a) -> DynStableName -> a -> Map a -> Map a insertWith' f k v Map { getMap = mp , getSize = sz } = Map (IntMap.insertWith go (hashDynStableName k) [(k,v)] mp) (sz + 1) where go _ ((k',v'):kvs) | k == k' = let v'' = f v v' in v'' `seq` (k', v'') : kvs | otherwise = (k', v') : go undefined kvs go _ [] = [] -- | /O(log n)/. Lookup the value at a key in the map. -- -- The function will return the corresponding value as a @('Just' value)@ -- or 'Nothing' if the key isn't in the map. lookup :: DynStableName -> Map v -> Maybe v lookup k (Map m _) = do pairs <- IntMap.lookup (hashDynStableName k) m Prelude.lookup k pairs find :: DynStableName -> Map v -> v find k m = case lookup k m of Nothing -> impossible "find" "copilot-language" Just x -> x -- | /O(log n)/. The expression @('findWithDefault' def k map)@ returns -- the value at key @k@ or returns the default value @def@ -- when the key is not in the map. findWithDefault :: v -> DynStableName -> Map v -> v findWithDefault dflt k m = maybe dflt id $ lookup k m copilot-language-4.3/src/System/Mem/StableName/Dynamic.hs0000644000000000000000000000141114762717303021533 0ustar0000000000000000-- Copyright © 2011 National Institute of Aerospace / Galois, Inc. {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE Safe #-} module System.Mem.StableName.Dynamic ( DynStableName(..) , hashDynStableName , makeDynStableName ) where import System.Mem.StableName (StableName, eqStableName, makeStableName, hashStableName) data DynStableName = forall a . DynStableName (StableName a) makeDynStableName :: a -> IO DynStableName makeDynStableName x = do stn <- makeStableName x return (DynStableName stn) hashDynStableName :: DynStableName -> Int hashDynStableName (DynStableName sn) = hashStableName sn instance Eq DynStableName where DynStableName sn1 == DynStableName sn2 = eqStableName sn1 sn2 copilot-language-4.3/src/Copilot/0000755000000000000000000000000014762717303015212 5ustar0000000000000000copilot-language-4.3/src/Copilot/Language.hs0000644000000000000000000000407614762717303017300 0ustar0000000000000000-- Copyright © 2011 National Institute of Aerospace / Galois, Inc. -- | Main Copilot language export file. -- -- This is mainly a meta-module that re-exports most definitions in this -- library. {-# LANGUAGE Safe #-} module Copilot.Language ( module Data.Int , module Data.Word , module Copilot.Core , module Copilot.Core.Type , module Copilot.Core.Type.Array , module Copilot.Language.Error , module Copilot.Language.Interpret , module Copilot.Language.Operators.Boolean , module Copilot.Language.Operators.Cast , module Copilot.Language.Operators.Constant , module Copilot.Language.Operators.Eq , module Copilot.Language.Operators.Extern , module Copilot.Language.Operators.Local , module Copilot.Language.Operators.Label , module Copilot.Language.Operators.Integral , module Copilot.Language.Operators.Mux , module Copilot.Language.Operators.Ord , module Copilot.Language.Operators.Temporal , module Copilot.Language.Operators.BitWise , module Copilot.Language.Operators.Array , module Copilot.Language.Operators.Struct , module Copilot.Language.Prelude , Spec , Stream , observer , trigger , arg , prop , theorem , forAll , exists ) where import Data.Int hiding (Int) import Data.Word import Copilot.Core (Name, Typed) import Copilot.Core.Type import Copilot.Core.Type.Array import Copilot.Language.Error import Copilot.Language.Interpret import Copilot.Language.Operators.Boolean import Copilot.Language.Operators.Cast import Copilot.Language.Operators.Constant import Copilot.Language.Operators.Eq import Copilot.Language.Operators.Extern import Copilot.Language.Operators.Integral import Copilot.Language.Operators.Local import Copilot.Language.Operators.Label import Copilot.Language.Operators.Mux import Copilot.Language.Operators.Ord import Copilot.Language.Operators.Temporal import Copilot.Language.Operators.BitWise import Copilot.Language.Operators.Array import Copilot.Language.Operators.Struct import Copilot.Language.Reify import Copilot.Language.Prelude import Copilot.Language.Spec import Copilot.Language.Stream (Stream) copilot-language-4.3/src/Copilot/Language/0000755000000000000000000000000014762717303016735 5ustar0000000000000000copilot-language-4.3/src/Copilot/Language/Error.hs0000644000000000000000000000161614762717303020366 0ustar0000000000000000-- Copyright © 2011 National Institute of Aerospace / Galois, Inc. {-# LANGUAGE Safe #-} -- | Custom functions to report error messages to users. module Copilot.Language.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 copilot-language-4.3/src/Copilot/Language/Analyze.hs0000644000000000000000000003346514762717303020707 0ustar0000000000000000-- Copyright © 2011 National Institute of Aerospace / Galois, Inc. {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE Safe #-} {-# LANGUAGE ScopedTypeVariables #-} -- | Copilot specification sanity check. module Copilot.Language.Analyze ( AnalyzeException (..) , analyze ) where import Copilot.Core (DropIdx) 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 import Data.Typeable import System.Mem.StableName.Dynamic import System.Mem.StableName.Map (Map(..)) 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 = DropAppliedToNonAppend | DropIndexOverflow | ReferentialCycle | DropMaxViolation | NestedArray | TooMuchRecursion | InvalidField | DifferentTypes String | Redeclared String | BadNumberOfArgs String | BadFunctionArgType String deriving Typeable -- | Show instance that prints a detailed message for each kind of exception. instance Show AnalyzeException where show DropAppliedToNonAppend = badUsage $ "Drop applied to non-append operation!" show DropIndexOverflow = badUsage $ "Drop index overflow!" show ReferentialCycle = badUsage $ "Referential cycle!" show DropMaxViolation = badUsage $ "Maximum drop violation (" ++ show (maxBound :: DropIdx) ++ ")!" 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 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 $ "The external symbol \'" ++ name ++ "\' has been declared to have two different types!" show (Redeclared name) = badUsage $ "The external symbol \'" ++ name ++ "\' has been redeclared to be a different symbol (e.g., a variable and an array, or a variable and a funciton symbol, etc.)." show (BadNumberOfArgs name) = badUsage $ "The function symbol \'" ++ name ++ "\' has been redeclared to have different number of arguments." show (BadFunctionArgType name) = badUsage $ "The function symbol \'" ++ name ++ "\' has been redeclared to an argument with different types." -- | 'Exception' instance so we can throw and catch 'AnalyzeExcetion's. instance Exception AnalyzeException -- | Max level of recursion supported. Any level above this constant -- will result in a 'TooMuchRecursion' exception. 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'. analyze :: Spec' a -> IO () analyze spec = do refStreams <- newIORef M.empty mapM_ (analyzeTrigger refStreams) (triggers $ runSpec spec) mapM_ (analyzeObserver refStreams) (observers $ runSpec spec) mapM_ (analyzeProperty refStreams) (properties $ runSpec spec) 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'. analyzeTrigger :: IORef Env -> Trigger -> IO () analyzeTrigger refStreams (Trigger _ e0 args) = analyzeExpr refStreams e0 >> mapM_ analyzeTriggerArg args where 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 _ 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 | SeenArr | SeenStruct -- | Analyze a Copilot stream and report any errors detected. -- -- This function can fail with one of the exceptions in 'AnalyzeException'. analyzeExpr :: IORef Env -> Stream a -> IO () analyzeExpr refStreams s = do b <- mapCheck refStreams when b (throw TooMuchRecursion) go NoExtern M.empty s where go :: SeenExtern -> Env -> Stream b -> IO () go seenExt nodes e0 = do dstn <- makeDynStableName e0 assertNotVisited e0 dstn nodes let nodes' = M.insert dstn () nodes case e0 of Append _ _ e -> analyzeAppend refStreams dstn e () analyzeExpr Const _ -> return () Drop k e1 -> analyzeDrop (fromIntegral k) e1 Extern _ _ -> return () Local e f -> go seenExt nodes' e >> go seenExt nodes' (f (Var "dummy")) Var _ -> return () Op1 _ e -> go seenExt nodes' e Op2 _ e1 e2 -> go seenExt nodes' e1 >> go seenExt nodes' e2 Op3 _ e1 e2 e3 -> go seenExt nodes' e1 >> go seenExt nodes' e2 >> 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 -- represents a name that has already been visited. assertNotVisited :: Stream a -> DynStableName -> Env -> IO () assertNotVisited (Append _ _ _) _ _ = return () assertNotVisited _ dstn nodes = case M.lookup dstn nodes of 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 -> (IORef Env -> Stream a -> IO b) -> IO b analyzeAppend refStreams dstn e b f = do streams <- readIORef refStreams case M.lookup dstn streams of Just () -> return b Nothing -> 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 -- append, or if the length of the drop is larger than that of the subsequent -- append. analyzeDrop :: Int -> Stream a -> IO () analyzeDrop k (Append xs _ _) | k >= length xs = throw DropIndexOverflow | k > fromIntegral (maxBound :: DropIdx) = throw DropMaxViolation | 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 -- external to have two different types. data ExternEnv = ExternEnv { externVarEnv :: [(String, C.SimpleType)] , externArrEnv :: [(String, C.SimpleType)] , externStructEnv :: [(String, C.SimpleType)] , externStructArgs :: [(String, [C.SimpleType])] } -- | Make sure external variables, functions, arrays, and structs are correctly -- typed. analyzeExts :: ExternEnv -> IO () analyzeExts ExternEnv { externVarEnv = vars , externArrEnv = arrs , externStructEnv = datastructs , externStructArgs = struct_args } = do findDups vars arrs findDups vars datastructs findDups arrs datastructs conflictingTypes vars conflictingTypes arrs funcArgCheck struct_args where findDups :: [(String, a)] -> [(String, b)] -> IO () findDups ls0 ls1 = mapM_ (\(name,_) -> dup name) ls0 where dup nm = mapM_ ( \(name',_) -> if name' == nm then throw (Redeclared nm) else return () ) ls1 conflictingTypes :: [(String, C.SimpleType)] -> IO () conflictingTypes ls = let grps = groupByPred ls in mapM_ sameType grps where sameType :: [(String, C.SimpleType)] -> IO () sameType grp = foldCheck check grp check name c0 c1 = if c0 == c1 then return (name,c0) -- a dummy---we -- discard the result else throw (DifferentTypes name) funcArgCheck :: [(String, [C.SimpleType])] -> IO () funcArgCheck ls = let grps = groupByPred ls in mapM_ argCheck grps where argCheck :: [(String, [C.SimpleType])] -> IO () argCheck grp = foldCheck check grp check name args0 args1 = if length args0 == length args1 then if args0 == args1 then return (name,args0) -- a dummy---we discard the -- result else throw (BadFunctionArgType name) else throw (BadNumberOfArgs name) groupByPred :: [(String, a)] -> [[(String, a)]] groupByPred = groupBy (\(n0,_) (n1,_) -> n0 == n1) foldCheck :: (String -> a -> a -> IO (String, a)) -> [(String, a)] -> IO () foldCheck check grp = foldM_ ( \(name, c0) (_, c1) -> check name c0 c1) (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 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 observerExts env (Observer _ stream) = collectExts refStreams stream env triggerExts :: ExternEnv -> Trigger -> IO ExternEnv triggerExts env (Trigger _ guard args) = do env' <- collectExts refStreams guard env foldM (\env'' (Arg arg_) -> collectExts refStreams arg_ env'') env' args propertyExts :: ExternEnv -> Property -> IO ExternEnv 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 -- | Obtain all the externs in a stream. collectExts :: C.Typed a => IORef Env -> Stream a -> ExternEnv -> IO ExternEnv collectExts refStreams stream_ env_ = do b <- mapCheck refStreams when b (throw TooMuchRecursion) go M.empty env_ stream_ where go :: Env -> ExternEnv -> Stream b -> IO ExternEnv go nodes env stream = do dstn <- makeDynStableName stream assertNotVisited stream dstn nodes case stream of Append _ _ e -> analyzeAppend refStreams dstn e env (\refs str -> collectExts refs str env) Const _ -> return env Drop _ e1 -> go nodes env e1 Extern name _ -> let ext = ( name, getSimpleType stream ) in return env { externVarEnv = ext : externVarEnv env } Local e _ -> go nodes env e Var _ -> return env Op1 _ e -> go nodes env e Op2 _ e1 e2 -> do env' <- go nodes env e1 go nodes env' e2 Op3 _ e1 e2 e3 -> do env' <- go nodes env e1 env'' <- go nodes env' e2 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) copilot-language-4.3/src/Copilot/Language/Stream.hs0000644000000000000000000001502014762717303020522 0ustar0000000000000000-- Copyright © 2011 National Institute of Aerospace / Galois, Inc. -- | Abstract syntax for streams and operators. {-# LANGUAGE GADTs #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE Safe #-} module Copilot.Language.Stream ( Stream (..) , Copilot.Language.Stream.ceiling , Copilot.Language.Stream.floor , Copilot.Language.Stream.atan2 ) where import Copilot.Core (Typed, typeOf) import qualified Copilot.Core as Core 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 -- step-wise (e.g., 'Op1') or temporal transformations (e.g., 'Append', 'Drop') -- to streams, or by combining existing streams to form new streams (e.g., -- 'Op2', 'Op3'). data Stream :: * -> * where Append :: Typed a => [a] -> Maybe (Stream Bool) -> Stream a -> Stream a Const :: Typed a => a -> Stream a Drop :: Typed a => Int -> Stream a -> Stream a Extern :: Typed a => String -> Maybe [a] -> Stream a Local :: (Typed a, Typed b) => Stream a -> (Stream a -> Stream b) -> Stream b Var :: Typed a => String -> Stream a Op1 :: (Typed a, Typed b) => Core.Op1 a b -> Stream a -> Stream b Op2 :: (Typed a, Typed b, Typed c) => Core.Op2 a b c -> Stream a -> Stream b -> Stream c Op3 :: (Typed a, Typed b, Typed c, Typed d) => Core.Op3 a b c d -> Stream a -> Stream b -> Stream c -> Stream d Label :: Typed a => String -> Stream a -> Stream a -- | 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 (Const x) + (Const y) = Const (x + y) (Const 0) + y = y x + (Const 0) = x x + y = Op2 (Core.Add typeOf) x y (Const x) - (Const y) = Const (x - y) x - (Const 0) = x x - y = Op2 (Core.Sub typeOf) x y (Const x) * (Const y) = Const (x * y) (Const 0) * _ = Const 0 _ * (Const 0) = Const 0 (Const 1) * y = y x * (Const 1) = x x * y = Op2 (Core.Mul typeOf) x y abs (Const x) = Const (abs x) abs x = Op1 (Core.Abs typeOf) x signum (Const x) = Const (signum x) signum x = Op1 (Core.Sign typeOf) x fromInteger = Const . fromInteger -- | Streams carrying fractional numbers are instances of 'Fractional', and you can -- apply to them the 'Fractional' functions, point-wise. -- XXX we may not want to precompute these if they're constants if someone is -- relying on certain floating-point behavior. instance (Typed a, P.Eq a, Fractional a) => Fractional (Stream a) where (/) = Op2 (Core.Fdiv typeOf) recip (Const x) = Const (recip x) recip x = Op1 (Core.Recip typeOf) x fromRational = Const . fromRational -- | Streams carrying floating point numbers are instances of 'Floating', and -- you can apply to them the 'Floating' functions, point-wise. -- XXX we may not want to precompute these if they're constants if someone is -- relying on certain floating-point behavior. instance (Typed a, Eq a, Floating a) => Floating (Stream a) where pi = Const pi exp = Op1 (Core.Exp typeOf) sqrt = Op1 (Core.Sqrt typeOf) log = Op1 (Core.Log typeOf) (**) = Op2 (Core.Pow typeOf) logBase = Op2 (Core.Logb typeOf) sin = Op1 (Core.Sin typeOf) tan = Op1 (Core.Tan typeOf) cos = Op1 (Core.Cos typeOf) asin = Op1 (Core.Asin typeOf) atan = Op1 (Core.Atan typeOf) acos = Op1 (Core.Acos typeOf) sinh = Op1 (Core.Sinh typeOf) tanh = Op1 (Core.Tanh typeOf) cosh = Op1 (Core.Cosh typeOf) asinh = Op1 (Core.Asinh typeOf) 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 -- two streams of the same type. Use a casting function to convert the result -- to an intergral type of your choice. -- -- Note that the result can be too big (or, if negative, too small) for that -- type (see the man page of @ceil@ for details), so you must check that the -- value fits in the desired integral type before casting it. -- -- This definition clashes with one in 'RealFrac' in Haskell's Prelude, -- re-exported from @Language.Copilot@, so you need to import this module -- qualified to use this function. ceiling :: (Typed a, RealFrac a) => Stream a -> Stream a ceiling = Op1 (Core.Ceiling typeOf) -- | Point-wise application of @floor@ to a stream. -- -- Unlike the Haskell variant of this function, this variant takes and returns -- two streams of the same type. Use a casting function to convert the result -- to an intergral type of your choice. -- -- Note that the result can be too big (or, if negative, too small) for that -- type (see the man page of @floor@ for details), so you must check that the -- value fits in the desired integral type before casting it. -- -- This definition clashes with one in 'RealFrac' in Haskell's Prelude, -- re-exported from @Language.Copilot@, so you need to import this module -- qualified to use this function. 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 -- stream, @atan2@ computes the angle of the vector from @(0, 0)@ to the point -- @(x, y)@. -- -- This definition clashes with one in 'RealFloat' in Haskell's Prelude, -- re-exported from @Language.Copilot@, so you need to import this module -- qualified to use this function. atan2 :: (Typed a, RealFloat a) => Stream a -> Stream a -> Stream a atan2 = Op2 (Core.Atan2 typeOf) copilot-language-4.3/src/Copilot/Language/Reify.hs0000644000000000000000000001636314762717303020360 0ustar0000000000000000-- Copyright © 2011 National Institute of Aerospace / Galois, Inc. -- | Transform a Copilot Language specification into a Copilot Core -- specification. {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE Safe #-} module Copilot.Language.Reify ( reify ) where import qualified Copilot.Core as Core 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 (..)) import Copilot.Theorem.Prove import Prelude hiding (id) import Data.IORef 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. reify :: Spec' a -> IO Core.Spec reify spec = do analyze spec let trigs = triggers $ runSpec spec let obsvs = observers $ runSpec spec let props = properties $ runSpec spec let thms = reverse $ theorems $ runSpec spec refMkId <- newIORef 0 refVisited <- newIORef M.empty refMap <- newIORef [] coreTriggers <- mapM (mkTrigger refMkId refVisited refMap) trigs coreObservers <- mapM (mkObserver refMkId refVisited refMap) obsvs coreProperties <- mapM (mkProperty refMkId refVisited refMap) $ props ++ (map fst thms) coreStreams <- readIORef refMap let cspec = Core.Spec { Core.specStreams = reverse coreStreams , Core.specObservers = coreObservers , Core.specTriggers = coreTriggers , Core.specProperties = coreProperties } results <- sequence $ zipWith (prove cspec) (map (\(Property n _,_) -> n) thms) $ map snd thms unless (and results) $ putStrLn "Warning: failed to check some proofs." return cspec -- | Transform a Copilot observer specification into a Copilot Core -- observer specification. {-# INLINE mkObserver #-} mkObserver :: IORef Int -> IORef (Map Core.Id) -> IORef [Core.Stream] -> Observer -> IO Core.Observer mkObserver refMkId refStreams refMap (Observer name e) = do w <- mkExpr refMkId refStreams refMap e return Core.Observer { Core.observerName = name , Core.observerExpr = w , Core.observerExprType = typeOf } -- | Transform a Copilot trigger specification into a Copilot Core -- trigger specification. {-# INLINE mkTrigger #-} mkTrigger :: IORef Int -> IORef (Map Core.Id) -> IORef [Core.Stream] -> Trigger -> IO Core.Trigger mkTrigger refMkId refStreams refMap (Trigger name guard args) = do w1 <- mkExpr refMkId refStreams refMap guard args' <- mapM mkTriggerArg args return Core.Trigger { Core.triggerName = name , Core.triggerGuard = w1 , Core.triggerArgs = args' } where mkTriggerArg :: Arg -> IO Core.UExpr mkTriggerArg (Arg e) = 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 #-} mkProperty :: IORef Int -> IORef (Map Core.Id) -> IORef [Core.Stream] -> Property -> IO Core.Property mkProperty refMkId refStreams refMap (Property name p) = do p' <- mkProp refMkId refStreams refMap p return Core.Property { Core.propertyName = name , 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 #-} mkExpr :: Typed a => IORef Int -> IORef (Map Core.Id) -> IORef [Core.Stream] -> Stream a -> IO (Core.Expr a) mkExpr refMkId refStreams refMap = go where go :: Typed a => Stream a -> IO (Core.Expr a) go e0 = case e0 of ------------------------------------------------------ Append _ _ _ -> do s <- mkStream refMkId refStreams refMap e0 return $ Core.Drop typeOf 0 s ------------------------------------------------------ Drop k e1 -> case e1 of Append _ _ _ -> do s <- mkStream refMkId refStreams refMap e1 return $ Core.Drop typeOf (fromIntegral k) s _ -> impossible "mkExpr" "copilot-language" ------------------------------------------------------ Const x -> return $ Core.Const typeOf x ------------------------------------------------------ Local e f -> do id <- mkId refMkId let cs = "local_" ++ show id w1 <- go e w2 <- go (f (Var cs)) return $ Core.Local typeOf typeOf cs w1 w2 ------------------------------------------------------ Label s e -> do w <- go e return $ Core.Label typeOf s w ------------------------------------------------------ Var cs -> return $ Core.Var typeOf cs ------------------------------------------------------ Extern cs mXs -> return $ Core.ExternVar typeOf cs mXs ------------------------------------------------------ Op1 op e -> do w <- go e return $ Core.Op1 op w ------------------------------------------------------ Op2 op e1 e2 -> do w1 <- go e1 w2 <- go e2 return $ Core.Op2 op w1 w2 ------------------------------------------------------ Op3 op e1 e2 e3 -> do w1 <- go e1 w2 <- go e2 w3 <- go e3 return $ Core.Op3 op w1 w2 w3 ------------------------------------------------------ mkFunArg :: Arg -> IO Core.UExpr mkFunArg (Arg e) = do w <- mkExpr refMkId refStreams refMap e return $ Core.UExpr typeOf w mkStrArg :: (Core.Name, Arg) -> IO (Core.Name, Core.UExpr) mkStrArg (name, Arg e) = do 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 #-} mkStream :: Typed a => IORef Int -> IORef (Map Core.Id) -> IORef [Core.Stream] -> Stream a -> IO Id mkStream refMkId refStreams refMap e0 = do dstn <- makeDynStableName e0 let Append buf _ e = e0 -- avoids warning mk <- haveVisited dstn case mk of Just id_ -> return id_ Nothing -> addToVisited dstn buf e where {-# INLINE haveVisited #-} haveVisited :: DynStableName -> IO (Maybe Int) haveVisited dstn = do tab <- readIORef refStreams return (M.lookup dstn tab) {-# INLINE addToVisited #-} addToVisited :: Typed a => DynStableName -> [a] -> Stream a -> IO Id addToVisited dstn buf e = do id <- mkId refMkId modifyIORef refStreams (M.insert dstn id) w <- mkExpr refMkId refStreams refMap e modifyIORef refMap $ (:) Core.Stream { Core.streamId = id , Core.streamBuffer = buf , Core.streamExpr = w , Core.streamExprType = typeOf } return id -- | Create a fresh, unused 'Id'. mkId :: IORef Int -> IO Id mkId refMkId = atomicModifyIORef refMkId $ \ n -> (succ n, n) copilot-language-4.3/src/Copilot/Language/Prelude.hs0000644000000000000000000000070714762717303020675 0ustar0000000000000000-- Copyright © 2011 National Institute of Aerospace / Galois, Inc. -- | Reexports 'Prelude' from package "base" hiding identifiers redefined by -- Copilot. {-# LANGUAGE Safe #-} module Copilot.Language.Prelude ( module Prelude ) where import Prelude hiding ( (++) , (==), (/=) , div, mod , (<=), (>=), (<), (>) , (&&) , (^) , (||) , const , drop , not , mod , until , sum , max , min , (!!) , cycle , take ) copilot-language-4.3/src/Copilot/Language/Interpret.hs0000644000000000000000000000303714762717303021250 0ustar0000000000000000-- Copyright (c) 2011 National Institute of Aerospace / Galois, Inc. -- | 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 -- other uses a format that may be easier for humans to read. {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE Safe #-} module Copilot.Language.Interpret ( csv , interpret ) where import qualified Copilot.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 () 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. -- -- Compared to 'csv', this function is slower but the output may be more -- readable. interpret :: Integer -> Spec -> IO () interpret = interpret' I.Table -- | Simulate a number of steps of a given specification, printing the results -- in the format specified. interpret' :: I.Format -> Integer -> Spec -> IO () interpret' format i spec = do coreSpec <- reify spec putStrLn $ I.interpret format (fromIntegral i) coreSpec copilot-language-4.3/src/Copilot/Language/Spec.hs0000644000000000000000000001514714762717303020173 0ustar0000000000000000-- Copyright © 2011 National Institute of Aerospace / Galois, Inc. {-# LANGUAGE GADTs #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE Safe #-} -- | Copilot specifications consistute 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 -- be proved. -- -- In order to be executed, 'Spec's must be turned into Copilot Core (see -- 'Reify') and either simulated or converted into C99 code to be executed. module Copilot.Language.Spec ( Spec, Spec' , runSpec , SpecItem , Observer (..) , observer, observers , Trigger (..) , trigger, triggers , arg , Arg(..) , Property (..) , Prop (..) , prop, properties , theorem, theorems , forAll , exists , extractProp , Universal, Existential ) where import Prelude hiding (not) import Control.Monad.Writer import Copilot.Core (Typed) import qualified Copilot.Core as Core import Copilot.Language.Stream import Copilot.Theorem.Prove -- | A specification is a list of declarations of triggers, observers, -- properties and theorems. -- -- Specifications are normally declared in monadic style, for example: -- -- @ -- monitor1 :: Stream Bool -- monitor1 = [False] ++ not monitor1 -- -- counter :: Stream Int32 -- counter = [0] ++ not counter -- -- spec :: Spec -- spec = do -- trigger "handler_1" monitor1 [] -- trigger "handler_2" (counter > 10) [arg counter] -- @ type Spec = Writer [SpecItem] () -- | An action in a specification (e.g., a declaration) that returns a value that -- 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 -- specifications or monitors, and is merely related to the monad defined by a -- 'Spec' runSpec :: Spec' a -> [SpecItem] runSpec = execWriter -- | Filter a list of spec items to keep only the observers. observers :: [SpecItem] -> [Observer] observers = foldr lets' [] where lets' e ls = case e of ObserverItem l -> l : ls _ -> ls -- | Filter a list of spec items to keep only the triggers. triggers :: [SpecItem] -> [Trigger] triggers = foldr triggers' [] where triggers' e ls = case e of TriggerItem t -> t : ls _ -> ls -- | Filter a list of spec items to keep only the properties. properties :: [SpecItem] -> [Property] properties = foldr properties' [] where properties' e ls = case e of PropertyItem p -> p : ls _ -> ls -- | Filter a list of spec items to keep only the theorems. theorems :: [SpecItem] -> [(Property, UProof)] theorems = foldr theorems' [] where theorems' e ls = case e of TheoremItem p -> p : ls _ -> ls -- | An item of a Copilot specification. data SpecItem = ObserverItem Observer | TriggerItem Trigger | 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. observer :: Typed a => String -- ^ Name used to identify the stream monitored in the -- output produced during interpretation. -> Stream a -- ^ The stream being monitored. -> 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. trigger :: String -- ^ Name of the handler to be called. -> Stream Bool -- ^ The stream used as the guard for the trigger. -> [Arg] -- ^ List of arguments to the handler. -> 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 -> Prop a -> Property -- | A proposition, representing the quantification of a boolean streams over -- time. 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 -- | Existential quantification of boolean streams over time. 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 -- | A proposition, representing a boolean stream that is existentially or -- universally quantified over time, as part of a specification. -- -- 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 e] >> return (PropRef name) -- | A theorem, or proposition together with a proof. -- -- 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 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 -- provide additional information to monitor handlers in order to address -- property violations. At any given point (e.g., when the trigger must be -- called due to a violation), the arguments passed using 'arg' will contain -- 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 copilot-language-4.3/src/Copilot/Language/Operators/0000755000000000000000000000000014762717303020713 5ustar0000000000000000copilot-language-4.3/src/Copilot/Language/Operators/Extern.hs0000644000000000000000000001111214762717303022510 0ustar0000000000000000-- Copyright © 2011 National Institute of Aerospace / Galois, Inc. -- | Primitives to build streams connected to external variables. {-# LANGUAGE Safe #-} module Copilot.Language.Operators.Extern ( extern , externB , externW8 , externW16 , externW32 , externW64 , externI8 , externI16 , externI32 , externI64 , externF , externD ) where import Copilot.Core (Typed) 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 -- given as second argument does not constrain the type of the values carried -- by the stream, this primitive stream building function will match any stream -- of any type, which is potentially dangerous if the global variable mentioned -- has a different type. We rely on the compiler used with the generated code -- to detect type errors of this kind. extern :: Typed a => String -- ^ Name of the global variable to make accessible. -> Maybe [a] -- ^ Values to be used exclusively for testing/simulation. -> 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. -> Maybe [Bool] -- ^ Values to be used exclusively for -- testing/simulation. -> Stream Bool externB = extern -- | Create a stream carrying values of type Word8, populated by an external -- global variable. externW8 :: String -- ^ Name of the global variable to make accessible. -> Maybe [Word8] -- ^ Values to be used exclusively for -- testing/simulation. -> Stream Word8 externW8 = extern -- | Create a stream carrying values of type Word16, populated by an external -- global variable. externW16 :: String -- ^ Name of the global variable to make accessible. -> Maybe [Word16] -- ^ Values to be used exclusively for -- testing/simulation. -> Stream Word16 externW16 = extern -- | Create a stream carrying values of type Word32, populated by an external -- global variable. externW32 :: String -- ^ Name of the global variable to make accessible. -> Maybe [Word32] -- ^ Values to be used exclusively for -- testing/simulation. -> Stream Word32 externW32 = extern -- | Create a stream carrying values of type Word64, populated by an external -- global variable. externW64 :: String -- ^ Name of the global variable to make accessible. -> Maybe [Word64] -- ^ Values to be used exclusively for -- testing/simulation. -> Stream Word64 externW64 = extern -- | Create a stream carrying values of type Int8, populated by an external -- global variable. externI8 :: String -- ^ Name of the global variable to make accessible. -> Maybe [Int8] -- ^ Values to be used exclusively for testing/simulation. -> Stream Int8 externI8 = extern -- | Create a stream carrying values of type Int16, populated by an external -- global variable. externI16 :: String -- ^ Name of the global variable to make accessible. -> Maybe [Int16] -- ^ Values to be used exclusively for testing/simulation. -> Stream Int16 externI16 = extern -- | Create a stream carrying values of type Int32, populated by an external -- global variable. externI32 :: String -- ^ Name of the global variable to make accessible. -> Maybe [Int32] -- ^ Values to be used exclusively for testing/simulation. -> Stream Int32 externI32 = extern -- | Create a stream carrying values of type Int64, populated by an external -- global variable. externI64 :: String -- ^ Name of the global variable to make accessible. -> Maybe [Int64] -- ^ Values to be used exclusively for testing/simulation. -> 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. -> Maybe [Double] -- ^ Values to be used exclusively for testing/simulation. -> Stream Double externD = extern copilot-language-4.3/src/Copilot/Language/Operators/Struct.hs0000644000000000000000000000724514762717303022543 0ustar0000000000000000{-# 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. -- -- 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 ( Projectable(..) , (#) , (##) ) where import Copilot.Core.Type import Copilot.Core.Operators import Copilot.Language.Operators.Projection 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 -- example, if a struct of type @T@ has two fields, @t1@ of type @Int@ and @t2@ -- 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 f, Typed t, Typed s, Struct s) => Stream s -> (s -> Field f t) -> Stream t (#) s f = Op1 (GetField typeOf typeOf f) s -- | 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 (s -> Field f t) t (##) = ProjectionS -- | Update a stream of structs. -- 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)) copilot-language-4.3/src/Copilot/Language/Operators/Array.hs0000644000000000000000000000640014762717303022325 0ustar0000000000000000{-# 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 (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 ((!!)) -- | 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 -- | 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)) copilot-language-4.3/src/Copilot/Language/Operators/Propositional.hs0000644000000000000000000000167414762717303024121 0ustar0000000000000000-- Copyright © 2011 National Institute of Aerospace / Galois, Inc. {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE Safe #-} -- | Implement negation over quantified extensions of boolean streams. -- -- For details, see 'Prop'. module Copilot.Language.Operators.Propositional (not) where import Prelude (($)) import Copilot.Language.Spec (Prop (..)) 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. not :: a -> b -- | Negation of an existentially quantified proposition. instance Negatable (Prop Existential) (Prop Universal) where not (Exists p) = Forall $ B.not p -- | Negation of a universally quantified proposition. instance Negatable (Prop Universal) (Prop Existential) where not (Forall p) = Exists $ B.not p copilot-language-4.3/src/Copilot/Language/Operators/Constant.hs0000644000000000000000000000475014762717303023046 0ustar0000000000000000-- Copyright © 2011 National Institute of Aerospace / Galois, Inc. {-# LANGUAGE Safe #-} -- | Primitives to build constant streams. module Copilot.Language.Operators.Constant ( constant , constB , constW8 , constW16 , constW32 , constW64 , constI8 , constI16 , constI32 , constI64 , constF , constD ) where import Copilot.Core (Typed) 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 constB = constant -- | Create a constant stream carrying values of type 'Word8' that is equal to -- the given argument, at any point in time. constW8 :: Word8 -> Stream Word8 constW8 = constant -- | Create a constant stream carrying values of type 'Word16' that is equal to -- the given argument, at any point in time. constW16 :: Word16 -> Stream Word16 constW16 = constant -- | Create a constant stream carrying values of type 'Word32' that is equal to -- the given argument, at any point in time. constW32 :: Word32 -> Stream Word32 constW32 = constant -- | Create a constant stream carrying values of type 'Word64' that is equal to -- the given argument, at any point in time. constW64 :: Word64 -> Stream Word64 constW64 = constant -- | Create a constant stream carrying values of type 'Int8' that is equal to -- the given argument, at any point in time. constI8 :: Int8 -> Stream Int8 constI8 = constant -- | Create a constant stream carrying values of type 'Int16' that is equal to -- the given argument, at any point in time. constI16 :: Int16 -> Stream Int16 constI16 = constant -- | Create a constant stream carrying values of type 'Int32' that is equal to -- the given argument, at any point in time. constI32 :: Int32 -> Stream Int32 constI32 = constant -- | Create a constant stream carrying values of type 'Int64' that is equal to -- the given argument, at any point in time. constI64 :: Int64 -> Stream Int64 constI64 = constant -- | Create a constant stream carrying values of type 'Float' that is equal to -- the given argument, at any point in time. constF :: Float -> Stream Float constF = constant -- | Create a constant stream carrying values of type 'Double' that is equal to -- the given argument, at any point in time. constD :: Double -> Stream Double constD = constant copilot-language-4.3/src/Copilot/Language/Operators/Mux.hs0000644000000000000000000000205014762717303022015 0ustar0000000000000000-- Copyright © 2011 National Institute of Aerospace / Galois, Inc. {-# LANGUAGE Safe #-} -- | Pick values from one of two streams, depending whether a condition is true -- or false. module Copilot.Language.Operators.Mux ( mux , ifThenElse ) where import Copilot.Core (Typed, typeOf) import qualified Copilot.Core as Core 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). -- -- Produce a stream that, at any point in time, if the value of the first -- stream at that point is true, contains the value in the second stream at -- that time, otherwise it contains the value in the third stream. ifThenElse :: Typed a => Stream Bool -> Stream a -> Stream a -> Stream a ifThenElse = mux copilot-language-4.3/src/Copilot/Language/Operators/Boolean.hs0000644000000000000000000000320114762717303022622 0ustar0000000000000000-- Copyright © 2011 National Institute of Aerospace / Galois, Inc. {-# LANGUAGE Safe #-} -- | Boolean operators applied point-wise to streams. module Copilot.Language.Operators.Boolean ( (&&) , (||) , not , true , false , xor , (==>) ) where import qualified Copilot.Core as Core import Copilot.Language.Prelude 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 -- | A stream that contains the constant value 'False'. false :: Stream Bool false = constant False infixr 4 && -- | Apply the and ('&&') operator to two boolean streams, point-wise. (&&) :: Stream Bool -> Stream Bool -> Stream Bool (Const False) && _ = false _ && (Const False) = false (Const True) && y = y x && (Const True) = x x && y = Op2 Core.And x y infixr 4 || -- | Apply the or ('||') operator to two boolean streams, point-wise. (||) :: Stream Bool -> Stream Bool -> Stream Bool (Const True) || _ = true _ || (Const True) = true (Const False) || y = y x || (Const False) = x x || y = Op2 Core.Or x y -- | Negate all the values in a boolean stream. not :: Stream Bool -> Stream Bool not (Const c) = (Const $ P.not c) not x = Op1 Core.Not x -- | Apply the exclusive-or ('xor') operator to two boolean streams, -- point-wise. xor :: Stream Bool -> Stream Bool -> Stream Bool 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 copilot-language-4.3/src/Copilot/Language/Operators/Temporal.hs0000644000000000000000000000240114762717303023027 0ustar0000000000000000-- Copyright © 2011 National Institute of Aerospace / Galois, Inc. {-# LANGUAGE Safe #-} -- | Temporal stream transformations. module Copilot.Language.Operators.Temporal ( (++) , drop ) where import Copilot.Core (Typed) import Copilot.Language.Prelude import Copilot.Language.Stream import Prelude () infixr 1 ++ -- | Prepend a fixed number of samples to a stream. -- -- The elements to be appended at the beginning of the stream must be limited, -- that is, the list must have finite length. -- -- Prepending elements to a stream may increase the memory requirements of the -- generated programs (which now must hold the same number of elements in -- memory for future processing). (++) :: Typed a => [a] -> Stream a -> Stream a (++) = (`Append` Nothing) -- | Drop a number of samples from a stream. -- -- The elements must be realizable at the present time to be able to drop -- elements. For most kinds of streams, you cannot drop elements without -- prepending an equal or greater number of elements to them first, as it -- could result in undefined samples. drop :: Typed a => Int -> Stream a -> Stream a drop 0 s = s drop _ ( Const j ) = Const j drop i ( Drop j s ) = Drop (fromIntegral i + j) s drop i s = Drop (fromIntegral i) s copilot-language-4.3/src/Copilot/Language/Operators/Eq.hs0000644000000000000000000000202014762717303021606 0ustar0000000000000000-- Copyright © 2011 National Institute of Aerospace / Galois, Inc. {-# LANGUAGE Safe #-} -- | Equality applied point-wise on streams. module Copilot.Language.Operators.Eq ( (==) , (/=) ) where import Copilot.Core (Typed, typeOf) import qualified Copilot.Core as Core 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 -- argument streams contain the same value at that point in time. (==) :: (P.Eq a, Typed a) => Stream a -> Stream a -> Stream Bool (Const x) == (Const y) = Const (x P.== y) x == y = Op2 (Core.Eq typeOf) x y -- | Compare two streams point-wise for inequality. -- -- The output stream contains the value True at a point in time if both -- argument streams contain different values at that point in time. (/=) :: (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 copilot-language-4.3/src/Copilot/Language/Operators/Cast.hs0000644000000000000000000002234314762717303022145 0ustar0000000000000000-- Copyright © 2011 National Institute of Aerospace / Galois, Inc. {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE Safe #-} -- | Type-safe casting operators. module Copilot.Language.Operators.Cast ( cast, unsafeCast, Cast, UnsafeCast ) where import qualified Copilot.Core.Operators as C import Copilot.Core.Type 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 -- | Perform a safe cast from @Stream a@ to @Stream b@. cast :: (Typed a, Typed b) => Stream a -> Stream b -- | Class to capture casting between types for which casting may be unsafe -- and/or result in a loss of precision or information. 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 -- | Cast a boolean stream to a stream of numbers, producing 1 if the -- value at a point in time is 'True', and 0 otherwise. instance Cast Bool Word8 where cast = castBool -- | Cast a boolean stream to a stream of numbers, producing 1 if the -- value at a point in time is 'True', and 0 otherwise. instance Cast Bool Word16 where cast = castBool -- | Cast a boolean stream to a stream of numbers, producing 1 if the -- value at a point in time is 'True', and 0 otherwise. instance Cast Bool Word32 where cast = castBool -- | Cast a boolean stream to a stream of numbers, producing 1 if the -- value at a point in time is 'True', and 0 otherwise. instance Cast Bool Word64 where cast = castBool -- | Cast a boolean stream to a stream of numbers, producing 1 if the -- value at a point in time is 'True', and 0 otherwise. instance Cast Bool Int8 where cast = castBool -- | Cast a boolean stream to a stream of numbers, producing 1 if the -- value at a point in time is 'True', and 0 otherwise. instance Cast Bool Int16 where cast = castBool -- | Cast a boolean stream to a stream of numbers, producing 1 if the -- value at a point in time is 'True', and 0 otherwise. instance Cast Bool Int32 where cast = castBool -- | Cast a boolean stream to a stream of numbers, producing 1 if the -- value at a point in time is 'True', and 0 otherwise. 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 -- | Cast number to bigger type. instance Cast Word8 Word16 where cast = castIntegral -- | Cast number to bigger type. instance Cast Word8 Word32 where cast = castIntegral -- | Cast number to bigger type. instance Cast Word8 Word64 where cast = castIntegral -- | Cast number to bigger type. instance Cast Word8 Int16 where cast = castIntegral -- | Cast number to bigger type. instance Cast Word8 Int32 where cast = castIntegral -- | Cast number to bigger type. instance Cast Word8 Int64 where cast = castIntegral -- | Identity casting. instance Cast Word16 Word16 where cast = castIntegral -- | Cast number to bigger type. instance Cast Word16 Word32 where cast = castIntegral -- | Cast number to bigger type. instance Cast Word16 Word64 where cast = castIntegral -- | Cast number to bigger type. instance Cast Word16 Int32 where cast = castIntegral -- | Cast number to bigger type. instance Cast Word16 Int64 where cast = castIntegral -- | Identity casting. instance Cast Word32 Word32 where cast = castIntegral -- | Cast number to bigger type. instance Cast Word32 Word64 where cast = castIntegral -- | Cast number to bigger type. 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 -- | Cast number to bigger type. instance Cast Int8 Int16 where cast = castIntegral -- | Cast number to bigger type. instance Cast Int8 Int32 where cast = castIntegral -- | Cast number to bigger type. instance Cast Int8 Int64 where cast = castIntegral -- | Identity casting. instance Cast Int16 Int16 where cast = castIntegral -- | Cast number to bigger type. instance Cast Int16 Int32 where cast = castIntegral -- | Cast number to bigger type. instance Cast Int16 Int64 where cast = castIntegral -- | Identity casting. instance Cast Int32 Int32 where cast = castIntegral -- | Cast number to bigger type. instance Cast Int32 Int64 where cast = castIntegral -- | Identity casting. instance Cast Int64 Int64 where cast = castIntegral -- | Unsafe downcasting to smaller sizes. instance UnsafeCast Word64 Word32 where unsafeCast = castIntegral -- | Unsafe downcasting to smaller sizes. instance UnsafeCast Word64 Word16 where unsafeCast = castIntegral -- | Unsafe downcasting to smaller sizes. instance UnsafeCast Word64 Word8 where unsafeCast = castIntegral -- | Unsafe downcasting to smaller sizes. instance UnsafeCast Word32 Word16 where unsafeCast = castIntegral -- | Unsafe downcasting to smaller sizes. instance UnsafeCast Word32 Word8 where unsafeCast = castIntegral -- | Unsafe downcasting to smaller sizes. instance UnsafeCast Word16 Word8 where unsafeCast = castIntegral -- | Unsafe downcasting to smaller sizes. instance UnsafeCast Int64 Int32 where unsafeCast = castIntegral -- | Unsafe downcasting to smaller sizes. instance UnsafeCast Int64 Int16 where unsafeCast = castIntegral -- | Unsafe downcasting to smaller sizes. instance UnsafeCast Int64 Int8 where unsafeCast = castIntegral -- | Unsafe downcasting to smaller sizes. instance UnsafeCast Int32 Int16 where unsafeCast = castIntegral -- | Unsafe downcasting to smaller sizes. instance UnsafeCast Int32 Int8 where unsafeCast = castIntegral -- | Unsafe downcasting to smaller sizes. instance UnsafeCast Int16 Int8 where unsafeCast = castIntegral -- | Unsafe signed integer promotion to floating point values. instance UnsafeCast Int64 Float where unsafeCast = castIntegral -- | Unsafe signed integer promotion to floating point values. instance UnsafeCast Int32 Float where unsafeCast = castIntegral -- | Unsafe signed integer promotion to floating point values. instance UnsafeCast Int16 Float where unsafeCast = castIntegral -- | Unsafe signed integer promotion to floating point values. instance UnsafeCast Int8 Float where unsafeCast = castIntegral -- | Unsafe signed integer promotion to floating point values. instance UnsafeCast Int64 Double where unsafeCast = castIntegral -- | Unsafe signed integer promotion to floating point values. instance UnsafeCast Int32 Double where unsafeCast = castIntegral -- | Unsafe signed integer promotion to floating point values. instance UnsafeCast Int16 Double where unsafeCast = castIntegral -- | Unsafe signed integer promotion to floating point values. instance UnsafeCast Int8 Double where unsafeCast = castIntegral -- | Unsafe unsigned integer promotion to floating point values. instance UnsafeCast Word64 Float where unsafeCast = castIntegral -- | Unsafe unsigned integer promotion to floating point values. instance UnsafeCast Word32 Float where unsafeCast = castIntegral -- | Unsafe unsigned integer promotion to floating point values. instance UnsafeCast Word16 Float where unsafeCast = castIntegral -- | Unsafe unsigned integer promotion to floating point values. instance UnsafeCast Word8 Float where unsafeCast = castIntegral -- | Unsafe unsigned integer promotion to floating point values. instance UnsafeCast Word64 Double where unsafeCast = castIntegral -- | Unsafe unsigned integer promotion to floating point values. instance UnsafeCast Word32 Double where unsafeCast = castIntegral -- | Unsafe unsigned integer promotion to floating point values. instance UnsafeCast Word16 Double where unsafeCast = castIntegral -- | Unsafe unsigned integer promotion to floating point values. instance UnsafeCast Word8 Double where unsafeCast = castIntegral -- | Cast from unsigned numbers to signed numbers. instance UnsafeCast Word64 Int64 where unsafeCast = castIntegral -- | Cast from unsigned numbers to signed numbers. instance UnsafeCast Word32 Int32 where unsafeCast = castIntegral -- | Cast from unsigned numbers to signed numbers. instance UnsafeCast Word16 Int16 where unsafeCast = castIntegral -- | Cast from unsigned numbers to signed numbers. instance UnsafeCast Word8 Int8 where unsafeCast = castIntegral -- | Signed to unsigned casting. instance UnsafeCast Int64 Word64 where unsafeCast = castIntegral -- | Signed to unsigned casting. instance UnsafeCast Int32 Word32 where unsafeCast = castIntegral -- | Signed to unsigned casting. instance UnsafeCast Int16 Word16 where unsafeCast = castIntegral -- | Signed to unsigned casting. instance UnsafeCast Int8 Word8 where unsafeCast = castIntegral copilot-language-4.3/src/Copilot/Language/Operators/Local.hs0000644000000000000000000000176614762717303022313 0ustar0000000000000000-- 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 sharing, to detect when -- the same stream is being used in multiple places in a specification and -- avoid recomputing it unnecessarily. {-# LANGUAGE Safe #-} module Copilot.Language.Operators.Local ( local ) where import Copilot.Core (Typed) import Copilot.Language.Stream (Stream (..)) -- | Let expressions. -- -- Create a stream that results from applying a stream to a function on -- streams. Standard usage would be similar to Haskell's let. See the -- following example, where @stream1@, @stream2@ and @s@ are all streams -- carrying values of some numeric type: -- -- @ -- expression = local (stream1 + stream2) $ \\s -> -- (s >= 0 && s <= 10) -- @ local :: (Typed a, Typed b) => Stream a -> (Stream a -> Stream b) -> Stream b local = Local copilot-language-4.3/src/Copilot/Language/Operators/Integral.hs0000644000000000000000000000362614762717303023023 0ustar0000000000000000-- Copyright © 2011 National Institute of Aerospace / Galois, Inc. -- | Integral class operators applied point-wise on streams. {-# LANGUAGE Safe #-} module Copilot.Language.Operators.Integral ( div , mod , (^) ) where 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 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 _ `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) = 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 -- | Apply a limited form of exponentiation (@^@) to two streams, point-wise. -- -- Either the first stream must be the constant 2, or the second must be a -- constant stream. (^) :: (Typed a, Typed b, P.Num a, B.Bits a, P.Integral b) => Stream a -> Stream b -> Stream a (Const 0) ^ (Const 0) = Const 1 (Const 0) ^ x = Op3 (Core.Mux typeOf) (Op2 (Core.Eq typeOf) x 0) (1) (0) (Const 1) ^ _ = Const 1 (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) _ ^ _ = 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.)" copilot-language-4.3/src/Copilot/Language/Operators/BitWise.hs0000644000000000000000000000346714762717303022627 0ustar0000000000000000-- Copyright © 2011 National Institute of Aerospace / Galois, Inc. {-# LANGUAGE CPP #-} {-# LANGUAGE Safe #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -- | Bitwise operators applied on streams, pointwise. module Copilot.Language.Operators.BitWise ( Bits ((.&.), complement, (.|.)) , (.^.) , (.<<.) , (.>>.) ) where 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. -- -- Only the methods '.&.', 'complement', '.|.' and 'xor' are defined. instance (Typed a, Bits a) => Bits (Stream a) where (.&.) = Op2 (Core.BwAnd typeOf) complement = Op1 (Core.BwNot typeOf) (.|.) = Op2 (Core.BwOr typeOf) xor = Op2 (Core.BwXor typeOf) shiftL = P.error "shiftL undefined, for left-shifting use .<<." shiftR = P.error "shiftR undefined, for right-shifting use .>>." rotate = P.error "tbd: rotate" bitSize = P.error "tbd: bitSize" bitSizeMaybe = P.error "tbd: bitSizeMaybe" isSigned = P.error "tbd: issigned" testBit = P.error "tbd: testBit" 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) => Stream a -> Stream b -> Stream a (.<<.) = Op2 (Core.BwShiftL typeOf typeOf) -- | Shifting values of a stream to the right. (.>>.) :: (Bits a, Typed a, Typed b, P.Integral b) => Stream a -> Stream b -> Stream a (.>>.) = Op2 (Core.BwShiftR typeOf typeOf) copilot-language-4.3/src/Copilot/Language/Operators/Projection.hs0000644000000000000000000000271114762717303023364 0ustar0000000000000000{-# 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 copilot-language-4.3/src/Copilot/Language/Operators/Label.hs0000644000000000000000000000143714762717303022273 0ustar0000000000000000-- Copyright © 2011 National Institute of Aerospace / Galois, Inc. -- | Label a stream with additional information. {-# LANGUAGE Safe #-} module Copilot.Language.Operators.Label ( label ) where 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). -- -- Semantically, a labelled stream is just the stream inside it. The use of -- label should not affect the observable behavior of the monitor, and how it -- is used in the code generated is a decision specific to each backend. label :: (Typed a) => String -> Stream a -> Stream a label = Label copilot-language-4.3/src/Copilot/Language/Operators/Ord.hs0000644000000000000000000000376514762717303022006 0ustar0000000000000000-- Copyright © 2011 National Institute of Aerospace / Galois, Inc. {-# LANGUAGE Safe #-} -- | Comparison operators applied point-wise on streams. module Copilot.Language.Operators.Ord ( (<=) , (>=) , (<) , (>) ) where import Copilot.Core (Typed, typeOf) import qualified Copilot.Core as Core 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 -- element in the first stream is smaller or equal than the element in -- the second stream at that point in time, and False otherwise. (<=) :: (P.Ord a, Typed a) => Stream a -> Stream a -> Stream Bool (Const x) <= (Const y) = Const (x P.<= y) x <= y = Op2 (Core.Le typeOf) x y -- | Compare two streams point-wise for order. -- -- The output stream contains the value True at a point in time if the -- element in the first stream is greater or equal than the element in -- the second stream at that point in time, and False otherwise. (>=) :: (P.Ord a, Typed a) => Stream a -> Stream a -> Stream Bool (Const x) >= (Const y) = Const (x P.>= y) x >= y = Op2 (Core.Ge typeOf) x y -- | Compare two streams point-wise for order. -- -- The output stream contains the value True at a point in time if the -- element in the first stream is smaller than the element in the second stream -- at that point in time, and False otherwise. (<) :: (P.Ord a, Typed a) => Stream a -> Stream a -> Stream Bool (Const x) < (Const y) = Const (x P.< y) x < y = Op2 (Core.Lt typeOf) x y -- | Compare two streams point-wise for order. -- -- The output stream contains the value True at a point in time if the element -- in the first stream is greater than the element in the second stream at that -- point in time, and False otherwise. (>) :: (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