copilot-core-3.19.1/0000755000000000000000000000000014616626042012401 5ustar0000000000000000copilot-core-3.19.1/README.md0000644000000000000000000000262314616626042013663 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 The core language, which efficiently represents Copilot expressions. The core is only of interest to implementers wishing to add a new back-end to Copilot. Copilot is a runtime verification framework written in Haskell. It allows the user to write programs in a simple but powerful way using a stream-based approach. 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-core can be found on [Hackage](https://hackage.haskell.org/package/copilot-core). 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-core/LICENSE). copilot-core-3.19.1/LICENSE0000644000000000000000000000263614616626042013415 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-core-3.19.1/Setup.hs0000644000000000000000000000005614616626042014036 0ustar0000000000000000import Distribution.Simple main = defaultMain copilot-core-3.19.1/CHANGELOG0000644000000000000000000001237214616626042013620 0ustar00000000000000002024-05-07 * Version bump (3.19.1). (#512) 2024-03-07 * Version bump (3.19). (#504) * Remove deprecated functions in Copilot.Core.Type and Copilot.Core.Type.Array. (#500) * Increase test coverage. (#502) 2024-01-07 * Version bump (3.18.1). (#493) 2024-01-07 * Version bump (3.18). (#487) 2023-11-07 * Version bump (3.17). (#466) * Compliance with style guide. (#457) 2023-09-07 * Version bump (3.16.1). (#455) 2023-07-07 * Version bump (3.16). (#448) 2023-05-07 * Version bump (3.15). (#438) * Remove Copilot.Core.Type.Equality. (#427) * Remove Copilot.Core.PrettyPrint. (#426) 2023-03-07 * Version bump (3.14). (#422) * Remove Copilot.Core.PrettyDot. (#409) * Fix formatting error in CHANGELOG. (#414) * Remove module space Copilot.Core.Interpret. (#410) * Remove unused definitions from Copilot.Core.Type.Array. (#411) 2023-01-07 * Version bump (3.13). (#406) * Implement missing cases of type equality for arrays and structs. (#400) * Remove Copilot.Core.External. (#391) * Fix bug in definition of simpleType for Int8. (#393) * Hide module Copilot.Core.Type.Show. (#392) 2022-11-07 * Version bump (3.12). (#389) * Deprecate Copilot.Core.PrettyPrinter. (#383) * Replace uses of Copilot.Core.Type.Equality with definitions from base:Data.Type.Equality; deprecate Copilot.Core.Type.Equality. (#379) * Compliance with style guide. (#332) 2022-09-07 * Version bump (3.11). (#376) * Deprecate Copilot.Core.PrettyDot. (#359) * Remove Copilot.Core.Type.Dynamic. (#360) * Split copilot-interpreter into separate library. (#361) * Deprecate unused classes, functions from Array module. (#369) 2022-07-07 * Version bump (3.10). (#356) * Fix error in test case generation; enable CLI args in tests. (#337) * Remove unnecessary dependencies from Cabal package. (#324) * Deprecate Copilot.Core.External. (#322) * Remove duplicated compiler option. (#328) * Hide type Copilot.Core.Type.Show.ShowWit. (#348) * Deprecate Copilot.Core.Type.Show. (#330) * Update repo info in cabal file. (#333) 2022-05-06 * Version bump (3.9). (#320) * Compliance with style guide (partial). (#316) * Hide module Copilot.Core.Interpret.Render. (#303) * Remove Copilot.Core.Type.Dynamic.fromDynF,toDynF. (#301) * Hide module Copilot.Core.Error. (#300) * Remove Copilot.Core.Type.Uninitialized. (#302) * Remove Copilot.Core.Expr.Tag. (#304) 2022-03-07 * Version bump (3.8). (#298) * Replaces uses of the internal Dynamic with base:Data.Dynamic. (#266) * Mark package as uncurated to avoid modification. (#288) 2022-01-07 * Version bump (3.7). (#287) * Make imports explicit, reorganize imports. (#277) * Remove Copilot.Core.Type.Read. (#286) * Remove Copilot.Core.Type.Eq. (#285) * Remove Copilot.Core.Locals. (#284) * Deprecate Copilot.Core.Type.Show.ShowWit. (#283) * Remove Copilot.Core.Type.Show.showWit. (#282) 2021-11-07 * Version bump (3.6). (#264) * Deprecate Copilot.Core.Type.Dynamic.toDynF and fromDynF. (#269) * Deprecate copilot-core:Copilot.Core.Type.Uninitialized. (#270) * Deprecate export of copilot-core:Copilot.Core.Interpret.Render. (#268) * Replace uses of copilot-core's error reporting functions. (#267) * Introduce new ops atan2, ceiling, floor. (#246) * Add initial support for unit testing. (#256) * Deprecate unused type. (#260) * Remove deprecated module. (#250) * Fix outdated/broken links. (#252) 2021-08-19 * Version bump (3.5). (#247) * Update travis domain in README. (#222) * Remove commented code. (#15) * Update official maintainer. (#236) * Update source repo location. (#241) * Add I. Perez to author list. (#243) 2021-07-07 * Version bump (3.4). (#231) * Deprecated `Copilot.Core.Locals`. (#141) * Deprecated `Copilot.Core.Type.Read` module. (#144) * Deprecated `showWit`. (#140) * Deprecated `Copilot.Core.Type.Eq`. (#143) * Remove unused module `Copilot.Core.StructMarshal`. (#139) 2021-05-07 * Version bump (3.3). (#217) * Fix URL in bug-reports field in cabal file. (#215) * Deprecate unused module Copilot.Core.MakeTags. (#142) * Deprecate unused functions in Copilot.Core.PrettyDot. (#137) 2021-03-05 * Version bump (3.2.1). (#136) * Completed the documentation. (#145) 2020-12-06 Ivan Perez * Version bump (3.2). * Fixed implementation of tysize for n-dimensional arrays. (#147). * Removed sorting of interpreter output (#148). * Minor documentation fixes (#149, #151). * Credits: @fdedden. 2019-11-22 Ivan Perez * Version bump (3.1). * Eliminate random modules and generators (#157). * Updated contact information for 'impossible' error (#154). * Implement missing pretty printer for Index operator (#155). copilot-core-3.19.1/copilot-core.cabal0000644000000000000000000000366714616626042016000 0ustar0000000000000000cabal-version: >=1.10 name: copilot-core version: 3.19.1 synopsis: An intermediate representation for Copilot. description: Intermediate representation for Copilot. . Copilot is a stream (i.e., infinite lists) domain-specific language (DSL) in Haskell that compiles into embedded C. Copilot contains an interpreter, multiple back-end compilers, and other verification tools. . A tutorial, examples, and other information are available at . author: Frank Dedden, Lee Pike, Robin Morisset, Alwyn Goodloe, Sebastian Niller, Nis Nordbyop Wegmann, Ivan Perez license: BSD3 license-file: LICENSE maintainer: Ivan Perez homepage: https://copilot-language.github.io bug-reports: https://github.com/Copilot-Language/copilot/issues stability: Experimental category: Language, Embedded build-type: Simple extra-source-files: README.md, CHANGELOG x-curation: uncurated source-repository head type: git location: https://github.com/Copilot-Language/copilot.git subdir: copilot-core library default-language: Haskell2010 hs-source-dirs: src ghc-options: -Wall -fno-warn-orphans build-depends: base >= 4.9 && < 5 exposed-modules: Copilot.Core Copilot.Core.Expr Copilot.Core.Operators Copilot.Core.Spec Copilot.Core.Type Copilot.Core.Type.Array test-suite unit-tests type: exitcode-stdio-1.0 main-is: Main.hs other-modules: Test.Extra Test.Copilot.Core.Type Test.Copilot.Core.Type.Array build-depends: base , HUnit , QuickCheck , test-framework , test-framework-hunit , test-framework-quickcheck2 , copilot-core hs-source-dirs: tests default-language: Haskell2010 ghc-options: -Wall copilot-core-3.19.1/tests/0000755000000000000000000000000014616626042013543 5ustar0000000000000000copilot-core-3.19.1/tests/Main.hs0000644000000000000000000000072314616626042014765 0ustar0000000000000000-- | Test copilot-core. module Main where -- External imports import Test.Framework (Test, defaultMain) -- Internal library modules being tested import qualified Test.Copilot.Core.Type import qualified Test.Copilot.Core.Type.Array -- | Run all unit tests on copilot-core. main :: IO () main = defaultMain tests -- | All unit tests in copilot-core. tests :: [Test.Framework.Test] tests = [ Test.Copilot.Core.Type.tests , Test.Copilot.Core.Type.Array.tests ] copilot-core-3.19.1/tests/Test/0000755000000000000000000000000014616626042014462 5ustar0000000000000000copilot-core-3.19.1/tests/Test/Extra.hs0000644000000000000000000000227314616626042016105 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-core-3.19.1/tests/Test/Copilot/0000755000000000000000000000000014616626042016073 5ustar0000000000000000copilot-core-3.19.1/tests/Test/Copilot/Core/0000755000000000000000000000000014616626042016763 5ustar0000000000000000copilot-core-3.19.1/tests/Test/Copilot/Core/Type.hs0000644000000000000000000002515314616626042020246 0ustar0000000000000000{-# LANGUAGE DataKinds #-} -- | Test copilot-core:Copilot.Core.Type. module Test.Copilot.Core.Type where -- External imports import Data.Int (Int16, Int32, Int64, Int8) import Data.Maybe (isJust) import Data.Type.Equality (testEquality) import Data.Word (Word16, Word32, Word64, Word8) import Test.Framework (Test, testGroup) import Test.Framework.Providers.QuickCheck2 (testProperty) import Test.QuickCheck (Gen, Property, arbitrary, elements, expectFailure, forAll, forAllBlind, property, shuffle, (==>)) -- Internal imports: library modules being tested import Copilot.Core.Type (Field (..), SimpleType (..), Struct (..), Type (..), Typed, UType (..), Value (..), accessorName, fieldName, simpleType, typeLength, typeOf, typeSize) import Copilot.Core.Type.Array (Array) -- | All unit tests for copilot-core:Copilot.Core.Type. tests :: Test.Framework.Test tests = testGroup "Copilot.Core.Type" [ testProperty "simpleType preserves inequality" testSimpleTypesInequality , testProperty "reflexivity of equality of simple types" testSimpleTypesEqualityReflexive , testProperty "symmetry of equality of simple types" testSimpleTypesEqualitySymmetric , testProperty "transitivity of equality of simple types" testSimpleTypesEqualityTransitive , testProperty "uniqueness of equality of simple types" testSimpleTypesEqualityUniqueness , testProperty "typeLength matches array size for 1-dimensional arrays" testTypeLength1 , testProperty "typeLength matches array size for 2-dimensional arrays" testTypeLength2 , testProperty "typeSize matches full array size for 1-dimensional arrays" testTypeSize1 , testProperty "typeSize matches full array size for 2-dimensional arrays" testTypeSize2 , testProperty "equality of types" testUTypesEqualitySymmetric , testProperty "equality of utype" testUTypesEq , testProperty "inequality of utype" testUTypesInequality , testProperty "inequality of utype via typeOf" testUTypesTypeOfInequality , testProperty "fieldName matches field name (positive)" testFieldNameOk , testProperty "fieldName matches field name (negative)" testFieldNameFail , testProperty "Show field name" testShowField , testProperty "Show struct" testShowStruct , testProperty "accessorName matches field name (positive)" testAccessorNameOk , testProperty "accessorName matches field name (negative)" testAccessorNameFail , testProperty "typeName matches struct type name (positive)" testTypeNameOk , testProperty "typeName matches struct type name (negative)" testTypeNameFail ] -- | Test that the function simpleTypes preserves inequality, that is, it -- returns different values for different types. This test is limited; we do -- not test structs or arrays. testSimpleTypesInequality :: Property testSimpleTypesInequality = forAllBlind twoDiffTypes $ \(t1, t2) -> t1 /= t2 where twoDiffTypes :: Gen (SimpleType, SimpleType) twoDiffTypes = do shuffled <- shuffle diffTypes case shuffled of (t1:t2:_) -> return (t1, t2) _ -> return (SBool, SBool) -- | A list of types that should all be different. diffTypes :: [SimpleType] diffTypes = [ simpleType Bool , simpleType Int8 , simpleType Int16 , simpleType Int32 , simpleType Int64 , simpleType Word8 , simpleType Word16 , simpleType Word32 , simpleType Word64 , simpleType Float , simpleType Double , simpleType (Array Int8 :: Type (Array 3 Int8)) , simpleType (Struct (S (Field 0))) ] -- | Test that the equality relation for simple types is reflexive. testSimpleTypesEqualityReflexive :: Property testSimpleTypesEqualityReflexive = forAllBlind (elements simpleTypes) $ \t -> t == t -- | Test that the equality relation for simple types is symmetric. testSimpleTypesEqualitySymmetric :: Property testSimpleTypesEqualitySymmetric = forAllBlind (elements simpleTypes) $ \t1 -> forAllBlind (elements simpleTypes) $ \t2 -> t1 == t2 ==> t2 == t1 -- | Test that the equality relation for simple types is transitive. testSimpleTypesEqualityTransitive :: Property testSimpleTypesEqualityTransitive = forAllBlind (elements simpleTypes) $ \t1 -> forAllBlind (elements simpleTypes) $ \t2 -> forAllBlind (elements simpleTypes) $ \t3 -> (t1 == t2 && t2 == t3) ==> (t1 == t3) -- | Test that each type is only equal to itself. testSimpleTypesEqualityUniqueness :: Property testSimpleTypesEqualityUniqueness = forAllBlind (shuffle simpleTypes) $ \(t:ts) -> notElem t ts -- | Simple types tested. simpleTypes :: [SimpleType] simpleTypes = [ SBool , SInt8 , SInt16 , SInt32 , SInt64 , SWord8 , SWord16 , SWord32 , SWord64 , SFloat , SDouble , SStruct , SArray Int8 , SArray Int16 ] -- | Test that the length of an array is as expected. testTypeLength1 :: Property testTypeLength1 = property $ typeLength a == 3 where a :: Type (Array 3 Int8) a = Array Int8 -- | Test that the length of an multi-dimensional array is as expected. testTypeLength2 :: Property testTypeLength2 = property $ typeLength a == 3 where a :: Type (Array 3 (Array 12 Int8)) a = Array (Array Int8) -- | Test that the size of an array is as expected. testTypeSize1 :: Property testTypeSize1 = property $ typeLength a == 3 where a :: Type (Array 3 Int8) a = Array Int8 -- | Test that the size of a multi-dimensional array is as expected (flattens -- the array). testTypeSize2 :: Property testTypeSize2 = property $ typeSize a == 36 where a :: Type (Array 3 (Array 12 Int8)) a = Array (Array Int8) -- | Test that equality is symmetric for UTypes via testEquality. testUTypesEqualitySymmetric :: Property testUTypesEqualitySymmetric = forAllBlind (elements utypes) $ \(UType t1) -> isJust (testEquality t1 t1) -- | Test that testEquality implies equality for UTypes. testUTypesEq :: Property testUTypesEq = forAllBlind (elements utypes) $ \t@(UType t1) -> isJust (testEquality t1 t1) ==> t == t -- | Test that any two different UTypes are not equal. -- -- This function pre-selects two UTypes from a list of different UTypes, which -- guarantees that they will be different. testUTypesInequality :: Property testUTypesInequality = forAllBlind twoDiffTypes $ \(t1, t2) -> t1 /= t2 where twoDiffTypes :: Gen (UType, UType) twoDiffTypes = do shuffled <- shuffle utypes case shuffled of (t1:t2:_) -> return (t1, t2) _ -> return (UType Bool, UType Bool) -- | Different UTypes. utypes :: [UType] utypes = [ UType Bool , UType Int8 , UType Int16 , UType Int32 , UType Int64 , UType Word8 , UType Word16 , UType Word32 , UType Word64 , UType Float , UType Double , UType a , UType b , UType c ] where a :: Type (Array 3 Int8) a = Array Int8 b :: Type (Array 4 Int8) b = Array Int8 c :: Type S c = Struct (S (Field 0)) -- | Test that any two different UTypes are not equal. -- -- This function pre-selects two UTypes from a list of different UTypes built -- via the function typeOf, which guarantees that they will be different. testUTypesTypeOfInequality :: Property testUTypesTypeOfInequality = forAllBlind twoDiffTypes $ \(t1@(UType t1'), t2@(UType t2')) -> -- The seqs are important: otherwise, the coverage goes down drastically -- because the typeOf function is not really executed. t1' `seq` t2' `seq` t1 /= t2 where twoDiffTypes :: Gen (UType, UType) twoDiffTypes = do shuffled <- shuffle uTypesTypeOf case shuffled of (t1:t2:_) -> t1 `seq` t2 `seq` return (t1, t2) _ -> return (UType Bool, UType Bool) -- | Different UTypes, produced by using the function typeOf. uTypesTypeOf :: [UType] uTypesTypeOf = [ UType (typeOf :: Type Bool) , UType (typeOf :: Type Int8) , UType (typeOf :: Type Int16) , UType (typeOf :: Type Int32) , UType (typeOf :: Type Int64) , UType (typeOf :: Type Word8) , UType (typeOf :: Type Word16) , UType (typeOf :: Type Word32) , UType (typeOf :: Type Word64) , UType (typeOf :: Type Float) , UType (typeOf :: Type Double) , UType (typeOf :: Type (Array 3 Int8)) , UType (typeOf :: Type S) ] -- | Test the fieldName function (should succeed). testFieldNameOk :: Property testFieldNameOk = forAll arbitrary $ \k -> fieldName (s1 (S (Field k))) == s1FieldName where s1FieldName = "field" -- | Test the fieldName function (should fail). testFieldNameFail :: Property testFieldNameFail = expectFailure $ property $ fieldName (s1 sampleS) == s1FieldName where sampleS = S (Field 0) s1FieldName = "Field" -- | Test showing a field of a struct. testShowField :: Property testShowField = forAll arbitrary $ \k -> show (s1 (S (Field k))) == ("field:" ++ show k) -- | Test showing a struct. testShowStruct :: Property testShowStruct = forAll arbitrary $ \k -> show (S (Field k)) == "" -- | Test the accessorName of a field of a struct (should succeed). testAccessorNameOk :: Property testAccessorNameOk = property $ accessorName s1 == s1FieldName where s1FieldName = "field" -- | Test the accessorName of a field of a struct (should fail). testAccessorNameFail :: Property testAccessorNameFail = expectFailure $ property $ accessorName s1 == s1FieldName where s1FieldName = "Field" -- | Test the typeName of a struct (should succeed). testTypeNameOk :: Property testTypeNameOk = property $ typeName sampleS == s1TypeName where sampleS :: S sampleS = S (Field 0) s1TypeName :: String s1TypeName = "S" -- | Test the typeName of a struct (should fail). testTypeNameFail :: Property testTypeNameFail = expectFailure $ property $ typeName sampleS == s1TypeName where sampleS :: S sampleS = S (Field 0) s1TypeName :: String s1TypeName = "s" -- | Auxiliary struct defined for testing purposes. data S = S { s1 :: Field "field" Int8 } instance Struct S where typeName _ = "S" toValues s = [ Value Int8 (s1 s) ] instance Typed S where typeOf = Struct (S (Field 0)) copilot-core-3.19.1/tests/Test/Copilot/Core/Type/0000755000000000000000000000000014616626042017704 5ustar0000000000000000copilot-core-3.19.1/tests/Test/Copilot/Core/Type/Array.hs0000644000000000000000000000442214616626042021320 0ustar0000000000000000{-# LANGUAGE DataKinds #-} {-# LANGUAGE ScopedTypeVariables #-} -- | Test copilot-core:Copilot.Core.Type.Array. module Test.Copilot.Core.Type.Array where -- External imports import Data.Int (Int64) import Data.Proxy (Proxy (..)) import GHC.TypeNats (KnownNat, natVal) import Test.Framework (Test, testGroup) import Test.Framework.Providers.QuickCheck2 (testProperty) import Test.QuickCheck (Gen, Property, arbitrary, expectFailure, forAll, property, vector, vectorOf) -- Internal imports: library modules being tested import Copilot.Core.Type.Array (Array, array, arrayElems) -- | All unit tests for copilot-core:Copilot.Core.Array. tests :: Test.Framework.Test tests = testGroup "Copilot.Core.Type.Array" [ testProperty "arrayElems . array (identity; 0)" (testArrayElemsLeft (Proxy :: Proxy 0)) , testProperty "arrayElems . array (identity; 5)" (testArrayElemsLeft (Proxy :: Proxy 5)) , testProperty "arrayElems . array (identity; 200)" (testArrayElemsLeft (Proxy :: Proxy 200)) , testProperty "array of incorrect length" testArrayElemsFail , testProperty "Show for arrays" testShowArray ] -- * Individual tests -- | Test that building an array from a list and extracting the elements with -- the function 'arrayElems' will result in the same list. testArrayElemsLeft :: forall n . KnownNat n => Proxy n -> Property testArrayElemsLeft len = forAll xsInt64 $ \ls -> let array' :: Array n Int64 array' = array ls in arrayElems array' == ls where -- Generator for lists of Int64 of known length. xsInt64 :: Gen [Int64] xsInt64 = vectorOf (fromIntegral (natVal len)) arbitrary -- | Test that arrays cannot be properly evaluated if their length does not -- match their type. testArrayElemsFail :: Property testArrayElemsFail = expectFailure $ forAll (vector 3) $ \l -> let v = array l :: Array 4 Int64 in arrayElems v == l -- | Test show for arrays. testShowArray :: Property testShowArray = forAll (vector 3) $ \l -> property $ show (array l :: Array 3 Int64) == show (l :: [Int64]) copilot-core-3.19.1/src/0000755000000000000000000000000014616626042013170 5ustar0000000000000000copilot-core-3.19.1/src/Copilot/0000755000000000000000000000000014616626042014601 5ustar0000000000000000copilot-core-3.19.1/src/Copilot/Core.hs0000644000000000000000000000240514616626042016026 0ustar0000000000000000{-# LANGUAGE Safe #-} -- | -- Description: Intermediate representation for Copilot specifications. -- Copyright: (c) 2011 National Institute of Aerospace / Galois, Inc. -- -- The following articles might also be useful: -- -- * Carette, Jacques and Kiselyov, Oleg and Shan, Chung-chieh, -- \"/Finally tagless, partially evaluated: Tagless staged/ -- /interpreters for simpler typed languages/\", -- Journal of Functional Programming vol. 19, p. 509-543, 2009. -- -- * Guillemette, Louis-Julien and Monnier, Stefan, -- \"/Type-Safe Code Transformations in Haskell/\", -- Electronic Notes in Theoretical Computer Science vol. 174, p. 23-39, 2007. -- -- For examples of how to traverse a Copilot specification see -- the source code of the interpreter (@copilot-interpreter@) -- and the pretty-printer (@copilot-prettyprinter@). module Copilot.Core ( module Copilot.Core.Expr , module Copilot.Core.Operators , module Copilot.Core.Spec , module Copilot.Core.Type , module Copilot.Core.Type.Array , module Data.Int , module Data.Word ) where -- External imports import Data.Int import Data.Word -- Internal imports import Copilot.Core.Expr import Copilot.Core.Operators import Copilot.Core.Spec import Copilot.Core.Type import Copilot.Core.Type.Array copilot-core-3.19.1/src/Copilot/Core/0000755000000000000000000000000014616626042015471 5ustar0000000000000000copilot-core-3.19.1/src/Copilot/Core/Operators.hs0000644000000000000000000000672414616626042020014 0ustar0000000000000000{-# LANGUAGE GADTs #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE Safe #-} -- | -- Description: Internal representation of Copilot operators. -- Copyright: (c) 2011 National Institute of Aerospace / Galois, Inc. module Copilot.Core.Operators ( Op1 (..) , Op2 (..) , Op3 (..) ) where -- External imports import Data.Bits (Bits) import Data.Word (Word32) import GHC.TypeLits (KnownSymbol) -- Internal imports import Copilot.Core.Type (Field (..), Type (..)) import Copilot.Core.Type.Array (Array) -- | Unary operators. data Op1 a b where -- Boolean operators. Not :: Op1 Bool Bool -- Numeric operators. Abs :: Num a => Type a -> Op1 a a Sign :: Num a => Type a -> Op1 a a -- Fractional operators. Recip :: Fractional a => Type a -> Op1 a a -- Floating operators. Exp :: Floating a => Type a -> Op1 a a Sqrt :: Floating a => Type a -> Op1 a a Log :: Floating a => Type a -> Op1 a a Sin :: Floating a => Type a -> Op1 a a Tan :: Floating a => Type a -> Op1 a a Cos :: Floating a => Type a -> Op1 a a Asin :: Floating a => Type a -> Op1 a a Atan :: Floating a => Type a -> Op1 a a Acos :: Floating a => Type a -> Op1 a a Sinh :: Floating a => Type a -> Op1 a a Tanh :: Floating a => Type a -> Op1 a a Cosh :: Floating a => Type a -> Op1 a a Asinh :: Floating a => Type a -> Op1 a a Atanh :: Floating a => Type a -> Op1 a a Acosh :: Floating a => Type a -> Op1 a a -- RealFrac operators Ceiling :: RealFrac a => Type a -> Op1 a a Floor :: RealFrac a => Type a -> Op1 a a -- Bitwise operators. BwNot :: Bits a => Type a -> Op1 a a -- Casting operator. Cast :: (Integral a, Num b) => Type a -> Type b -> Op1 a b -- ^ Casting operator. -- Struct operator. GetField :: KnownSymbol s => Type a -> Type b -> (a -> Field s b) -> Op1 a b -- ^ Projection of a struct field. -- | Binary operators. data Op2 a b c where -- Boolean operators. And :: Op2 Bool Bool Bool Or :: Op2 Bool Bool Bool -- Numeric operators. Add :: Num a => Type a -> Op2 a a a Sub :: Num a => Type a -> Op2 a a a Mul :: Num a => Type a -> Op2 a a a -- Integral operators. Mod :: Integral a => Type a -> Op2 a a a Div :: Integral a => Type a -> Op2 a a a -- Fractional operators. Fdiv :: Fractional a => Type a -> Op2 a a a -- Floating operators. Pow :: Floating a => Type a -> Op2 a a a Logb :: Floating a => Type a -> Op2 a a a -- RealFloat operators. Atan2 :: RealFloat a => Type a -> Op2 a a a -- Equality operators. Eq :: Eq a => Type a -> Op2 a a Bool Ne :: Eq a => Type a -> Op2 a a Bool -- Relational operators. Le :: Ord a => Type a -> Op2 a a Bool Ge :: Ord a => Type a -> Op2 a a Bool Lt :: Ord a => Type a -> Op2 a a Bool Gt :: Ord a => Type a -> Op2 a a Bool -- Bitwise operators. BwAnd :: Bits a => Type a -> Op2 a a a BwOr :: Bits a => Type a -> Op2 a a a BwXor :: Bits a => Type a -> Op2 a a a BwShiftL :: (Bits a, Integral b) => Type a -> Type b -> Op2 a b a BwShiftR :: (Bits a, Integral b) => Type a -> Type b -> Op2 a b a -- Array operator. Index :: Type (Array n t) -> Op2 (Array n t) Word32 t -- ^ Array access/projection of an array element. -- | Ternary operators. data Op3 a b c d where -- Conditional operator. Mux :: Type a -> Op3 Bool a a a copilot-core-3.19.1/src/Copilot/Core/Type.hs0000644000000000000000000001711014616626042016746 0ustar0000000000000000{-# LANGUAGE DataKinds #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE Safe #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} -- | -- Description: Typing for Core. -- Copyright: (c) 2011 National Institute of Aerospace / Galois, Inc. -- -- All expressions and streams in Core are accompanied by a representation of -- the types of the underlying expressions used or carried by the streams. -- This information is needed by the compiler to generate code, since it must -- initialize variables and equivalent representations for those types in -- the target languages. module Copilot.Core.Type ( Type (..) , Typed (..) , UType (..) , SimpleType (..) , typeSize , typeLength , Value (..) , toValues , Field (..) , typeName , Struct , fieldName , accessorName ) where -- External imports import Data.Int (Int16, Int32, Int64, Int8) import Data.List (intercalate) import Data.Proxy (Proxy (..)) import Data.Type.Equality as DE import Data.Typeable (Typeable, eqT, typeRep) import Data.Word (Word16, Word32, Word64, Word8) import GHC.TypeLits (KnownNat, KnownSymbol, Symbol, natVal, sameNat, symbolVal) -- Internal imports import Copilot.Core.Type.Array (Array) -- | The value of that is a product or struct, defined as a constructor with -- several fields. class Struct a where -- | Returns the name of struct in the target language. typeName :: a -> String -- | Transforms all the struct's fields into a list of values. toValues :: a -> [Value a] -- | The field of a struct, together with a representation of its type. data Value a = forall s t . (Typeable t, KnownSymbol s, Show t) => Value (Type t) (Field s t) -- | A field in a struct. The name of the field is a literal at the type -- level. data Field (s :: Symbol) t = Field t -- | Extract the name of a field. fieldName :: forall s t . KnownSymbol s => Field s t -> String fieldName _ = symbolVal (Proxy :: Proxy s) -- | Extract the name of an accessor (a function that returns a field of a -- struct). accessorName :: forall a s t . (Struct a, KnownSymbol s) => (a -> Field s t) -> String accessorName _ = symbolVal (Proxy :: Proxy s) instance (KnownSymbol s, Show t) => Show (Field s t) where show f@(Field v) = fieldName f ++ ":" ++ show v instance {-# OVERLAPPABLE #-} (Typed t, Struct t) => Show t where show t = "<" ++ fields ++ ">" where fields = intercalate "," $ map showfield (toValues t) showfield (Value _ field) = show field -- | A Type representing the types of expressions or values handled by -- Copilot Core. -- -- Note that both arrays and structs use dependently typed features. In the -- former, the length of the array is part of the type. In the latter, the -- names of the fields are part of the type. data Type :: * -> * where Bool :: Type Bool Int8 :: Type Int8 Int16 :: Type Int16 Int32 :: Type Int32 Int64 :: Type Int64 Word8 :: Type Word8 Word16 :: Type Word16 Word32 :: Type Word32 Word64 :: Type Word64 Float :: Type Float Double :: Type Double Array :: forall n t . ( KnownNat n , Typed t ) => Type t -> Type (Array n t) Struct :: (Typed a, Struct a) => a -> Type a -- | Return the length of an array from its type typeLength :: forall n t . KnownNat n => Type (Array n t) -> Int typeLength _ = fromIntegral $ natVal (Proxy :: Proxy n) -- | Return the total (nested) size of an array from its type typeSize :: forall n t . KnownNat n => Type (Array n t) -> Int typeSize ty@(Array ty'@(Array _)) = typeLength ty * typeSize ty' typeSize ty@(Array _ ) = typeLength ty instance TestEquality Type where testEquality Bool Bool = Just DE.Refl testEquality Int8 Int8 = Just DE.Refl testEquality Int16 Int16 = Just DE.Refl testEquality Int32 Int32 = Just DE.Refl testEquality Int64 Int64 = Just DE.Refl testEquality Word8 Word8 = Just DE.Refl testEquality Word16 Word16 = Just DE.Refl testEquality Word32 Word32 = Just DE.Refl testEquality Word64 Word64 = Just DE.Refl testEquality Float Float = Just DE.Refl testEquality Double Double = Just DE.Refl testEquality (Array t1) (Array t2) = testArrayEquality t1 t2 where testArrayEquality :: forall n1 a1 n2 a2. (KnownNat n1, KnownNat n2) => Type a1 -> Type a2 -> Maybe (Array n1 a1 :~: Array n2 a2) testArrayEquality ty1 ty2 | Just DE.Refl <- sameNat (Proxy :: Proxy n1) (Proxy :: Proxy n2) , Just DE.Refl <- testEquality ty1 ty2 = Just DE.Refl | otherwise = Nothing testEquality (Struct _) (Struct _) = eqT testEquality _ _ = Nothing -- | A simple, monomorphic representation of types that facilitates putting -- variables in heterogeneous lists and environments in spite of their types -- being different. data SimpleType where SBool :: SimpleType SInt8 :: SimpleType SInt16 :: SimpleType SInt32 :: SimpleType SInt64 :: SimpleType SWord8 :: SimpleType SWord16 :: SimpleType SWord32 :: SimpleType SWord64 :: SimpleType SFloat :: SimpleType SDouble :: SimpleType SArray :: Type t -> SimpleType SStruct :: SimpleType -- | Type equality, used to help type inference. -- This instance is necessary, otherwise the type of SArray can't be inferred. instance Eq SimpleType where SBool == SBool = True SInt8 == SInt8 = True SInt16 == SInt16 = True SInt32 == SInt32 = True SInt64 == SInt64 = True SWord8 == SWord8 = True SWord16 == SWord16 = True SWord32 == SWord32 = True SWord64 == SWord64 = True SFloat == SFloat = True SDouble == SDouble = True (SArray t1) == (SArray t2) | Just DE.Refl <- testEquality t1 t2 = True | otherwise = False SStruct == SStruct = True _ == _ = False -- | A typed expression, from which we can obtain the two type representations -- used by Copilot: 'Type' and 'SimpleType'. class (Show a, Typeable a) => Typed a where typeOf :: Type a simpleType :: Type a -> SimpleType simpleType _ = SStruct instance Typed Bool where typeOf = Bool simpleType _ = SBool instance Typed Int8 where typeOf = Int8 simpleType _ = SInt8 instance Typed Int16 where typeOf = Int16 simpleType _ = SInt16 instance Typed Int32 where typeOf = Int32 simpleType _ = SInt32 instance Typed Int64 where typeOf = Int64 simpleType _ = SInt64 instance Typed Word8 where typeOf = Word8 simpleType _ = SWord8 instance Typed Word16 where typeOf = Word16 simpleType _ = SWord16 instance Typed Word32 where typeOf = Word32 simpleType _ = SWord32 instance Typed Word64 where typeOf = Word64 simpleType _ = SWord64 instance Typed Float where typeOf = Float simpleType _ = SFloat instance Typed Double where typeOf = Double simpleType _ = SDouble instance (Typeable t, Typed t, KnownNat n) => Typed (Array n t) where typeOf = Array typeOf simpleType (Array t) = SArray t -- | A untyped type (no phantom type). data UType = forall a . Typeable a => UType { uTypeType :: Type a } instance Eq UType where UType ty1 == UType ty2 = typeRep ty1 == typeRep ty2 copilot-core-3.19.1/src/Copilot/Core/Spec.hs0000644000000000000000000000447714616626042016733 0ustar0000000000000000{-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE Safe #-} -- | -- Copyright: (c) 2011 National Institute of Aerospace / Galois, Inc. -- -- Copilot specifications constitute the main declaration of Copilot modules. -- -- A specification normally contains the association between streams to monitor -- and their handling functions, or streams to observe, or a theorem that must -- be proved. -- -- In order to be executed, high-level Copilot Language Spec must be turned -- into Copilot Core's 'Spec'. This module defines the low-level Copilot Core -- representations for Specs and the main types of element in a spec.. module Copilot.Core.Spec ( Stream (..) , Observer (..) , Trigger (..) , Spec (..) , Property (..) ) where -- External imports import Data.Typeable (Typeable) -- Internal imports import Copilot.Core.Expr (Expr, Id, Name, UExpr) import Copilot.Core.Type (Type, Typed) -- | A stream in an infinite succession of values of the same type. -- -- Stream can carry different types of data. Boolean streams play a special -- role: they are used by other parts (e.g., 'Trigger') to detect when the -- properties being monitored are violated. data Stream = forall a . (Typeable a, Typed a) => Stream { streamId :: Id , streamBuffer :: [a] , streamExpr :: Expr a , streamExprType :: Type a } -- | An observer, representing a stream that we observe during interpretation -- at every sample. data Observer = forall a . Typeable a => Observer { observerName :: Name , observerExpr :: Expr a , observerExprType :: Type a } -- | A trigger, representing a function we execute when a boolean stream becomes -- true at a sample. data Trigger = Trigger { triggerName :: Name , triggerGuard :: Expr Bool , triggerArgs :: [UExpr] } -- | A property, representing a boolean stream that is existentially or -- universally quantified over time. data Property = Property { propertyName :: Name , propertyExpr :: Expr Bool } -- | A Copilot specification is a list of streams, together with monitors on -- these streams implemented as observers, triggers or properties. data Spec = Spec { specStreams :: [Stream] , specObservers :: [Observer] , specTriggers :: [Trigger] , specProperties :: [Property] } copilot-core-3.19.1/src/Copilot/Core/Expr.hs0000644000000000000000000000375114616626042016751 0ustar0000000000000000{-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE Safe #-} -- | -- Description: Internal representation of Copilot stream expressions. -- Copyright: (c) 2011 National Institute of Aerospace / Galois, Inc. module Copilot.Core.Expr ( Id , Name , Expr (..) , UExpr (..) , DropIdx ) where -- External imports import Data.Typeable (Typeable) import Data.Word (Word32) -- Internal imports import Copilot.Core.Operators (Op1, Op2, Op3) import Copilot.Core.Type (Type) -- | A stream identifier. type Id = Int -- | A name of a trigger, an external variable, or an external function. type Name = String -- | An index for the drop operator. type DropIdx = Word32 -- | Internal representation of Copilot stream expressions. -- -- The Core representation mimics the high-level Copilot stream, but the Core -- representation contains information about the types of elements in the -- stream. data Expr a where Const :: Typeable a => Type a -> a -> Expr a Drop :: Typeable a => Type a -> DropIdx -> Id -> Expr a Local :: Typeable a => Type a -> Type b -> Name -> Expr a -> Expr b -> Expr b Var :: Typeable a => Type a -> Name -> Expr a ExternVar :: Typeable a => Type a -> Name -> Maybe [a] -> Expr a Op1 :: Typeable a => Op1 a b -> Expr a -> Expr b Op2 :: (Typeable a, Typeable b) => Op2 a b c -> Expr a -> Expr b -> Expr c Op3 :: (Typeable a, Typeable b, Typeable c) => Op3 a b c d -> Expr a -> Expr b -> Expr c -> Expr d Label :: Typeable a => Type a -> String -> Expr a -> Expr a -- | A untyped expression that carries the information about the type of the -- expression as a value, as opposed to exposing it at type level (using an -- existential). data UExpr = forall a . Typeable a => UExpr { uExprType :: Type a , uExprExpr :: Expr a } copilot-core-3.19.1/src/Copilot/Core/Type/0000755000000000000000000000000014616626042016412 5ustar0000000000000000copilot-core-3.19.1/src/Copilot/Core/Type/Array.hs0000644000000000000000000000256314616626042020032 0ustar0000000000000000{-# LANGUAGE DataKinds #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE Safe #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} -- | -- Copyright: (c) 2011 National Institute of Aerospace / Galois, Inc. -- -- Implementation of an array that uses type literals to store length. No -- explicit indexing is used for the input data. Supports arbitrary nesting of -- arrays. module Copilot.Core.Type.Array ( Array , array , arrayElems ) where -- External imports import Data.Proxy (Proxy (..)) import GHC.TypeLits (KnownNat, Nat, natVal) -- | Implementation of an array that uses type literals to store length. data Array (n :: Nat) t where Array :: [t] -> Array n t instance Show t => Show (Array n t) where show (Array xs) = show xs -- | Smart array constructor that only type checks if the length of the given -- list matches the length of the array at type level. array :: forall n t. KnownNat n => [t] -> Array n t array xs | datalen == typelen = Array xs | otherwise = error errmsg where datalen = length xs typelen = fromIntegral $ natVal (Proxy :: Proxy n) errmsg = "Length of data (" ++ show datalen ++ ") does not match length of type (" ++ show typelen ++ ")." -- | Return the elements of an array. arrayElems :: Array n a -> [a] arrayElems (Array xs) = xs