├── .gitignore ├── .travis.yml ├── README.md ├── cabal.project ├── copilot-c99 ├── CHANGELOG ├── LICENSE ├── README.md ├── Setup.hs ├── copilot-c99.cabal ├── src │ └── Copilot │ │ └── Compile │ │ ├── C99.hs │ │ └── C99 │ │ ├── CodeGen.hs │ │ ├── Compile.hs │ │ ├── Error.hs │ │ ├── Expr.hs │ │ ├── External.hs │ │ ├── Name.hs │ │ ├── Representation.hs │ │ ├── Settings.hs │ │ └── Type.hs └── tests │ ├── Main.hs │ └── Test │ └── Copilot │ └── Compile │ └── C99.hs ├── copilot-core ├── CHANGELOG ├── LICENSE ├── README.md ├── Setup.hs ├── copilot-core.cabal ├── src │ └── Copilot │ │ ├── Core.hs │ │ └── Core │ │ ├── Expr.hs │ │ ├── Operators.hs │ │ ├── Spec.hs │ │ ├── Type.hs │ │ └── Type │ │ └── Array.hs └── tests │ ├── Main.hs │ └── Test │ ├── Copilot │ └── Core │ │ ├── Type.hs │ │ └── Type │ │ └── Array.hs │ └── Extra.hs ├── copilot-interpreter ├── CHANGELOG ├── LICENSE ├── README.md ├── Setup.hs ├── copilot-interpreter.cabal ├── src │ └── Copilot │ │ ├── Interpret.hs │ │ └── Interpret │ │ ├── Error.hs │ │ ├── Eval.hs │ │ └── Render.hs └── tests │ ├── Main.hs │ └── Test │ ├── Copilot │ └── Interpret │ │ └── Eval.hs │ └── Extra.hs ├── copilot-language ├── CHANGELOG ├── LICENSE ├── README.md ├── Setup.hs ├── copilot-language.cabal ├── src │ ├── Copilot │ │ ├── Language.hs │ │ └── Language │ │ │ ├── Analyze.hs │ │ │ ├── Error.hs │ │ │ ├── Interpret.hs │ │ │ ├── Operators │ │ │ ├── Array.hs │ │ │ ├── BitWise.hs │ │ │ ├── Boolean.hs │ │ │ ├── Cast.hs │ │ │ ├── Constant.hs │ │ │ ├── Eq.hs │ │ │ ├── Extern.hs │ │ │ ├── Integral.hs │ │ │ ├── Label.hs │ │ │ ├── Local.hs │ │ │ ├── Mux.hs │ │ │ ├── Ord.hs │ │ │ ├── Projection.hs │ │ │ ├── Propositional.hs │ │ │ ├── Struct.hs │ │ │ └── Temporal.hs │ │ │ ├── Prelude.hs │ │ │ ├── Reify.hs │ │ │ ├── Spec.hs │ │ │ └── Stream.hs │ └── System │ │ └── Mem │ │ └── StableName │ │ ├── Dynamic.hs │ │ └── Map.hs └── tests │ ├── Main.hs │ └── Test │ ├── Copilot │ └── Language │ │ └── Reify.hs │ └── Extra.hs ├── copilot-libraries ├── CHANGELOG ├── LICENSE ├── README.md ├── Setup.hs ├── copilot-libraries.cabal ├── src │ └── Copilot │ │ └── Library │ │ ├── Clocks.hs │ │ ├── LTL.hs │ │ ├── Libraries.hs │ │ ├── MTL.hs │ │ ├── PTLTL.hs │ │ ├── RegExp.hs │ │ ├── Stacks.hs │ │ ├── Statistics.hs │ │ ├── Utils.hs │ │ └── Voting.hs └── tests │ ├── Main.hs │ └── Test │ ├── Copilot │ └── Library │ │ └── PTLTL.hs │ └── Extra.hs ├── copilot-prettyprinter ├── CHANGELOG ├── LICENSE ├── README.md ├── Setup.hs ├── copilot-prettyprinter.cabal └── src │ └── Copilot │ ├── PrettyPrint.hs │ └── PrettyPrint │ ├── Error.hs │ └── Type.hs ├── copilot-theorem ├── CHANGELOG ├── LICENSE ├── README.md ├── Setup.hs ├── copilot-theorem.cabal ├── doc │ └── talk.pdf ├── examples │ ├── BoyerMoore.hs │ ├── Grey.hs │ ├── Incr.hs │ ├── SerialBoyerMoore.hs │ ├── SphericalWCV.hs │ ├── Trig.hs │ └── WCV.hs ├── src │ └── Copilot │ │ ├── Theorem.hs │ │ └── Theorem │ │ ├── IL.hs │ │ ├── IL │ │ ├── PrettyPrint.hs │ │ ├── Spec.hs │ │ ├── Transform.hs │ │ └── Translate.hs │ │ ├── Kind2.hs │ │ ├── Kind2 │ │ ├── AST.hs │ │ ├── Output.hs │ │ ├── PrettyPrint.hs │ │ ├── Prover.hs │ │ └── Translate.hs │ │ ├── Misc │ │ ├── Error.hs │ │ ├── SExpr.hs │ │ └── Utils.hs │ │ ├── Prove.hs │ │ ├── Prover │ │ ├── Backend.hs │ │ ├── SMT.hs │ │ ├── SMTIO.hs │ │ ├── SMTLib.hs │ │ ├── TPTP.hs │ │ └── Z3.hs │ │ ├── Tactics.hs │ │ ├── TransSys.hs │ │ ├── TransSys │ │ ├── Cast.hs │ │ ├── Invariants.hs │ │ ├── Operators.hs │ │ ├── PrettyPrint.hs │ │ ├── Renaming.hs │ │ ├── Spec.hs │ │ ├── Transform.hs │ │ ├── Translate.hs │ │ └── Type.hs │ │ ├── What4.hs │ │ └── What4 │ │ └── Translate.hs └── tests │ ├── Main.hs │ └── Test │ └── Copilot │ └── Theorem │ └── What4.hs └── copilot ├── CHANGELOG ├── LICENSE ├── README.md ├── Setup.hs ├── copilot.cabal ├── examples ├── AddMult.hs ├── Array.hs ├── Cast.hs ├── Clock.hs ├── Counter.hs ├── Engine.hs ├── Heater.hs ├── Structs.hs ├── StructsUpdateField.hs ├── Voting.hs ├── WCV.hs └── what4 │ ├── Arithmetic.hs │ ├── ArithmeticCounterExamples.hs │ ├── Arrays.hs │ ├── Propositional.hs │ └── Structs.hs ├── runtest └── src └── Language ├── Copilot.hs └── Copilot └── Main.hs /.gitignore: -------------------------------------------------------------------------------- 1 | dist 2 | dist-* 3 | cabal-dev 4 | *.o 5 | *.hi 6 | *.chi 7 | *.chs.h 8 | *.dyn_o 9 | *.dyn_hi 10 | .hpc 11 | .hsenv 12 | .cabal-sandbox/ 13 | cabal.sandbox.config 14 | *.prof 15 | *.aux 16 | *.hp 17 | *.eventlog 18 | .stack-work/ 19 | cabal.project.local 20 | cabal.project.local~ 21 | .HTF/ 22 | .ghc.environment.* 23 | copilot-profiling 24 | .DS_Store 25 | .log 26 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | # dist should be at least focal because we need cppcheck >= 1.88. 2 | dist: focal 3 | 4 | # NB: don't set `language: haskell` here 5 | 6 | # The following enables several GHC versions to be tested; often it's enough to 7 | # test only against the last release in a major GHC version. Feel free to omit 8 | # lines listings versions you don't need/want testing for. 9 | env: 10 | - CABALVER=2.4 GHCVER=8.6.5 11 | - CABALVER=3.2 GHCVER=8.8.4 12 | - CABALVER=3.2 GHCVER=8.10.4 13 | - CABALVER=3.4 GHCVER=9.0.1 14 | # - CABALVER=head GHCVER=head # see section about GHC HEAD snapshots 15 | 16 | # Note: the distinction between `before_install` and `install` is not important. 17 | before_install: 18 | - travis_retry sudo add-apt-repository -y ppa:hvr/ghc 19 | - travis_retry sudo apt-get update 20 | - travis_retry sudo apt-get install cabal-install-$CABALVER ghc-$GHCVER # see note about happy/alex 21 | 22 | # We install z3 and cppcheck only for the tests, since they are not needed 23 | # for normal compilation. 24 | - if [ "${GHCVER}" == "8.10.4" ]; then travis_retry sudo apt-get install --yes z3 cppcheck; fi 25 | 26 | - export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$PATH 27 | - cabal --version 28 | - echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo '?')]" 29 | - travis_retry cabal update 30 | - git submodule update --remote 31 | 32 | script: 33 | # We explicitly install all libraries so that they are exposed and we can use 34 | # them for tests (e.g., with runhaskell). There is no harm in doing this 35 | # instead of installing just copilot. 36 | - travis_wait 30 cabal v2-install --lib copilot copilot-core copilot-c99 copilot-language copilot-libraries copilot-theorem copilot-interpreter copilot-prettyprinter 37 | 38 | # Run tests only on GHC 8.10.4 39 | # 40 | # Only libraries with tests are listed below or the v2-test command fails. 41 | # 42 | # Testing copilot-theorem and copilot-libraries requires z3. See above 43 | # conditional installation, and keep GHC version numbers in both places in 44 | # sync. 45 | - if [ "${GHCVER}" == "8.10.4" ]; then cabal v2-test -j1 copilot-core copilot-language copilot-interpreter copilot-c99 copilot-theorem copilot-libraries; fi 46 | 47 | # Check that the code produced by Copilot complies with MISRA C 2012. We 48 | # explicitly make cppcheck produce a non-zero exit code on non-compliance 49 | # with the standard to make the CI build fail. 50 | - if [ "${GHCVER}" == "8.10.4" ]; then runhaskell copilot/examples/Heater.hs; cppcheck --force --addon=misra.py --suppress=misra-c2012-14.4 --error-exitcode=2 heater.c; fi 51 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | copilot/README.md -------------------------------------------------------------------------------- /cabal.project: -------------------------------------------------------------------------------- 1 | packages: 2 | */*.cabal 3 | -------------------------------------------------------------------------------- /copilot-c99/LICENSE: -------------------------------------------------------------------------------- 1 | 2009 2 | BSD3 License terms 3 | 4 | Redistribution and use in source and binary forms, with or without 5 | modification, are permitted provided that the following conditions 6 | are met: 7 | 8 | Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | Redistributions in binary form must reproduce the above copyright 12 | notice, this list of conditions and the following disclaimer in the 13 | documentation and/or other materials provided with the distribution. 14 | 15 | Neither the name of the developers nor the names of its contributors 16 | may be used to endorse or promote products derived from this software 17 | without specific prior written permission. 18 | 19 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 20 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 21 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 22 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR 23 | CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, 24 | EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, 25 | PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR 26 | PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF 27 | LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING 28 | NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 29 | SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 30 | -------------------------------------------------------------------------------- /copilot-c99/README.md: -------------------------------------------------------------------------------- 1 | [![Build Status](https://travis-ci.com/Copilot-Language/copilot.svg?branch=master)](https://app.travis-ci.com/github/Copilot-Language/copilot) 2 | 3 | # Copilot: a stream DSL 4 | Copilot-c99 implements a C99 backend for Copilot, producing high quality code 5 | suitable for hard realtime applications. 6 | 7 | Copilot is a runtime verification framework written in Haskell. It allows the 8 | user to write programs in a simple but powerful way using a stream-based 9 | approach. 10 | 11 | Programs can be interpreted for testing, or translated C99 code to be 12 | incorporated in a project, or as a standalone application. The C99 backend 13 | ensures us that the output is constant in memory and time, making it suitable 14 | for systems with hard realtime requirements. 15 | 16 | 17 | ## Installation 18 | Copilot-c99 can be found on 19 | [Hackage](https://hackage.haskell.org/package/copilot-c99). It is typically 20 | only installed as part of the complete Copilot distribution. For installation 21 | instructions, please refer to the [Copilot 22 | website](https://copilot-language.github.io). 23 | 24 | 25 | ## Further information 26 | For further information, install instructions and documentation, please visit 27 | the Copilot website: 28 | [https://copilot-language.github.io](https://copilot-language.github.io) 29 | 30 | 31 | ## License 32 | Copilot is distributed under the BSD-3-Clause license, which can be found 33 | [here](https://raw.githubusercontent.com/Copilot-Language/copilot/master/copilot-c99/LICENSE). 34 | -------------------------------------------------------------------------------- /copilot-c99/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain -------------------------------------------------------------------------------- /copilot-c99/copilot-c99.cabal: -------------------------------------------------------------------------------- 1 | cabal-version : >= 1.10 2 | name : copilot-c99 3 | version : 4.4 4 | synopsis : A compiler for Copilot targeting C99. 5 | description : 6 | This package is a back-end from Copilot to C. 7 | . 8 | Copilot is a stream (i.e., infinite lists) domain-specific language (DSL) in 9 | Haskell that compiles into embedded C. Copilot contains an interpreter, 10 | multiple back-end compilers, and other verification tools. 11 | . 12 | A tutorial, examples, and other information are available at 13 | . 14 | 15 | license : BSD3 16 | license-file : LICENSE 17 | maintainer : Ivan Perez 18 | homepage : https://copilot-language.github.io 19 | bug-reports : https://github.com/Copilot-Language/copilot/issues 20 | stability : Experimental 21 | category : Language, Embedded 22 | build-type : Simple 23 | extra-source-files : README.md 24 | , CHANGELOG 25 | 26 | author : Frank Dedden 27 | , Alwyn Goodloe 28 | , Ivan Perez 29 | 30 | x-curation: uncurated 31 | 32 | source-repository head 33 | type: git 34 | location: https://github.com/Copilot-Language/copilot.git 35 | subdir: copilot-c99 36 | 37 | library 38 | default-language : Haskell2010 39 | hs-source-dirs : src 40 | 41 | ghc-options : -Wall 42 | build-depends : base >= 4.9 && < 5 43 | , directory >= 1.3 && < 1.4 44 | , filepath >= 1.4 && < 1.6 45 | , mtl >= 2.2 && < 2.4 46 | , pretty >= 1.1 && < 1.2 47 | 48 | , copilot-core >= 4.4 && < 4.5 49 | , language-c99 >= 0.2.0 && < 0.3 50 | , language-c99-simple >= 0.3 && < 0.4 51 | 52 | exposed-modules : Copilot.Compile.C99 53 | 54 | other-modules : Copilot.Compile.C99.Expr 55 | , Copilot.Compile.C99.Type 56 | , Copilot.Compile.C99.Error 57 | , Copilot.Compile.C99.Name 58 | , Copilot.Compile.C99.CodeGen 59 | , Copilot.Compile.C99.External 60 | , Copilot.Compile.C99.Compile 61 | , Copilot.Compile.C99.Settings 62 | , Copilot.Compile.C99.Representation 63 | 64 | test-suite unit-tests 65 | type: 66 | exitcode-stdio-1.0 67 | 68 | main-is: 69 | Main.hs 70 | 71 | other-modules: 72 | Test.Copilot.Compile.C99 73 | 74 | build-depends: 75 | base 76 | , directory 77 | , HUnit 78 | , QuickCheck 79 | , pretty 80 | , process 81 | , random 82 | , test-framework 83 | , test-framework-hunit 84 | , test-framework-quickcheck2 85 | , unix 86 | 87 | , copilot-core 88 | , copilot-c99 89 | 90 | hs-source-dirs: 91 | tests 92 | 93 | default-language: 94 | Haskell2010 95 | 96 | ghc-options: 97 | -Wall 98 | -------------------------------------------------------------------------------- /copilot-c99/src/Copilot/Compile/C99.hs: -------------------------------------------------------------------------------- 1 | -- | Compile Copilot specifications to C99 code. 2 | module Copilot.Compile.C99 3 | ( compile 4 | , compileWith 5 | , CSettings(..) 6 | , mkDefaultCSettings 7 | ) where 8 | 9 | -- Internal imports 10 | import Copilot.Compile.C99.Compile ( compile, compileWith ) 11 | import Copilot.Compile.C99.Settings ( CSettings (..), mkDefaultCSettings ) 12 | -------------------------------------------------------------------------------- /copilot-c99/src/Copilot/Compile/C99/Error.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE Safe #-} 2 | 3 | -- | 4 | -- Copyright: (c) 2011 National Institute of Aerospace / Galois, Inc. 5 | -- 6 | -- Custom functions to report error messages to users. 7 | module Copilot.Compile.C99.Error 8 | ( impossible ) 9 | where 10 | 11 | -- | Report an error due to a bug in Copilot. 12 | impossible :: String -- ^ Name of the function in which the error was detected. 13 | -> String -- ^ Name of the package in which the function is located. 14 | -> a 15 | impossible function package = 16 | error $ "Impossible error in function " 17 | ++ function ++ ", in package " ++ package 18 | ++ ". Please file an issue at " 19 | ++ "https://github.com/Copilot-Language/copilot/issues" 20 | ++ " or email the maintainers at " 21 | -------------------------------------------------------------------------------- /copilot-c99/src/Copilot/Compile/C99/External.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ExistentialQuantification #-} 2 | 3 | -- | Represent information about externs needed in the generation of C99 code 4 | -- for stream declarations and triggers. 5 | module Copilot.Compile.C99.External 6 | ( External(..) 7 | , gatherExts 8 | ) 9 | where 10 | 11 | -- External imports 12 | import Data.List (unionBy) 13 | 14 | -- Internal imports: Copilot 15 | import Copilot.Core ( Expr (..), Stream (..), Trigger (..), Type, UExpr (..) ) 16 | 17 | -- Internal imports 18 | import Copilot.Compile.C99.Name ( exCpyName ) 19 | 20 | -- | Representation of external variables. 21 | data External = forall a. External 22 | { extName :: String 23 | , extCpyName :: String 24 | , extType :: Type a 25 | } 26 | 27 | -- | Collect all external variables from the streams and triggers. 28 | -- 29 | -- Although Copilot specifications can contain also properties and theorems, 30 | -- the C99 backend currently only generates code for streams and triggers. 31 | gatherExts :: [Stream] -> [Trigger] -> [External] 32 | gatherExts streams triggers = streamsExts `extUnion` triggersExts 33 | where 34 | streamsExts = foldr (extUnion . streamExts) mempty streams 35 | triggersExts = foldr (extUnion . triggerExts) mempty triggers 36 | 37 | streamExts :: Stream -> [External] 38 | streamExts (Stream _ _ expr _) = exprExts expr 39 | 40 | triggerExts :: Trigger -> [External] 41 | triggerExts (Trigger _ guard args) = guardExts `extUnion` argExts 42 | where 43 | guardExts = exprExts guard 44 | argExts = concatMap uExprExts args 45 | 46 | uExprExts :: UExpr -> [External] 47 | uExprExts (UExpr _ expr) = exprExts expr 48 | 49 | exprExts :: Expr a -> [External] 50 | exprExts (Local _ _ _ e1 e2) = exprExts e1 `extUnion` exprExts e2 51 | exprExts (ExternVar ty name _) = [External name (exCpyName name) ty] 52 | exprExts (Op1 _ e) = exprExts e 53 | exprExts (Op2 _ e1 e2) = exprExts e1 `extUnion` exprExts e2 54 | exprExts (Op3 _ e1 e2 e3) = exprExts e1 `extUnion` exprExts e2 55 | `extUnion` exprExts e3 56 | exprExts (Label _ _ e) = exprExts e 57 | exprExts _ = [] 58 | 59 | -- | Union over lists of External, we solely base the equality on the 60 | -- extName's. 61 | extUnion :: [External] -> [External] -> [External] 62 | extUnion = unionBy (\a b -> extName a == extName b) 63 | -------------------------------------------------------------------------------- /copilot-c99/src/Copilot/Compile/C99/Name.hs: -------------------------------------------------------------------------------- 1 | -- | Naming of variables and functions in C. 2 | module Copilot.Compile.C99.Name 3 | ( argNames 4 | , argTempNames 5 | , exCpyName 6 | , generatorName 7 | , generatorOutputArgName 8 | , guardName 9 | , indexName 10 | , streamAccessorName 11 | , streamName 12 | ) 13 | where 14 | 15 | -- External imports: Copilot 16 | import Copilot.Core (Id) 17 | 18 | -- | Turn a stream id into a suitable C variable name. 19 | streamName :: Id -> String 20 | streamName sId = "s" ++ show sId 21 | 22 | -- | Turn a stream id into the global varname for indices. 23 | indexName :: Id -> String 24 | indexName sId = streamName sId ++ "_idx" 25 | 26 | -- | Turn a stream id into the name of its accessor function 27 | streamAccessorName :: Id -> String 28 | streamAccessorName sId = streamName sId ++ "_get" 29 | 30 | -- | Add a postfix for copies of external variables the name. 31 | exCpyName :: String -> String 32 | exCpyName name = name ++ "_cpy" 33 | 34 | -- | Turn stream id into name of its generator function. 35 | generatorName :: Id -> String 36 | generatorName sId = streamName sId ++ "_gen" 37 | 38 | -- | Turn stream id into name of its output argument array. 39 | generatorOutputArgName :: Id -> String 40 | generatorOutputArgName sId = streamName sId ++ "_output" 41 | 42 | -- | Turn the name of a trigger into a guard generator. 43 | guardName :: String -> String 44 | guardName name = name ++ "_guard" 45 | 46 | -- | Turn a trigger name into a trigger argument name. 47 | argName :: String -> Int -> String 48 | argName name n = name ++ "_arg" ++ show n 49 | 50 | -- | Turn a handler function name into a name for a temporary variable for a 51 | -- handler argument. 52 | argTempName :: String -> Int -> String 53 | argTempName name n = name ++ "_arg_temp" ++ show n 54 | 55 | -- | Enumerate all argument names based on trigger name. 56 | argNames :: String -> [String] 57 | argNames base = map (argName base) [0..] 58 | 59 | -- | Enumerate all temporary variable names based on handler function name. 60 | argTempNames :: String -> [String] 61 | argTempNames base = map (argTempName base) [0..] 62 | -------------------------------------------------------------------------------- /copilot-c99/src/Copilot/Compile/C99/Representation.hs: -------------------------------------------------------------------------------- 1 | -- | C99 backend specific versions of selected `Copilot.Core` datatypes. 2 | module Copilot.Compile.C99.Representation 3 | ( UniqueTrigger (..) 4 | , UniqueTriggerId 5 | , mkUniqueTriggers 6 | ) 7 | where 8 | 9 | import Copilot.Core ( Trigger (..) ) 10 | 11 | -- | Internal unique name for a trigger. 12 | type UniqueTriggerId = String 13 | 14 | -- | A `Copilot.Core.Trigger` with an unique name. 15 | data UniqueTrigger = UniqueTrigger UniqueTriggerId Trigger 16 | 17 | -- | Given a list of triggers, make their names unique. 18 | mkUniqueTriggers :: [Trigger] -> [UniqueTrigger] 19 | mkUniqueTriggers ts = zipWith mkUnique ts [0..] 20 | where 21 | mkUnique t@(Trigger name _ _) n = UniqueTrigger (name ++ "_" ++ show n) t 22 | -------------------------------------------------------------------------------- /copilot-c99/src/Copilot/Compile/C99/Settings.hs: -------------------------------------------------------------------------------- 1 | -- | Settings used by the code generator to customize the code. 2 | module Copilot.Compile.C99.Settings 3 | ( CSettings(..) 4 | , mkDefaultCSettings 5 | ) 6 | where 7 | 8 | -- | Settings used to customize the code generated. 9 | data CSettings = CSettings 10 | { cSettingsStepFunctionName :: String 11 | , cSettingsOutputDirectory :: FilePath 12 | } 13 | 14 | -- | Default settings with a step function called @step@. 15 | mkDefaultCSettings :: CSettings 16 | mkDefaultCSettings = CSettings "step" "." 17 | -------------------------------------------------------------------------------- /copilot-c99/src/Copilot/Compile/C99/Type.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE GADTs #-} 2 | 3 | -- | Translate Copilot Core expressions and operators to C99. 4 | module Copilot.Compile.C99.Type 5 | ( transType 6 | , transLocalVarDeclType 7 | , transTypeName 8 | ) 9 | where 10 | 11 | -- External imports 12 | import qualified Language.C99.Simple as C 13 | 14 | -- Internal imports: Copilot 15 | import Copilot.Core ( Type (..), typeLength, typeName ) 16 | 17 | -- | Translate a Copilot type to a C99 type. 18 | transType :: Type a -> C.Type 19 | transType ty = case ty of 20 | Bool -> C.TypeSpec $ C.TypedefName "bool" 21 | Int8 -> C.TypeSpec $ C.TypedefName "int8_t" 22 | Int16 -> C.TypeSpec $ C.TypedefName "int16_t" 23 | Int32 -> C.TypeSpec $ C.TypedefName "int32_t" 24 | Int64 -> C.TypeSpec $ C.TypedefName "int64_t" 25 | Word8 -> C.TypeSpec $ C.TypedefName "uint8_t" 26 | Word16 -> C.TypeSpec $ C.TypedefName "uint16_t" 27 | Word32 -> C.TypeSpec $ C.TypedefName "uint32_t" 28 | Word64 -> C.TypeSpec $ C.TypedefName "uint64_t" 29 | Float -> C.TypeSpec C.Float 30 | Double -> C.TypeSpec C.Double 31 | Array ty' -> C.Array (transType ty') len 32 | where 33 | len = Just $ C.LitInt $ fromIntegral $ typeLength ty 34 | Struct s -> C.TypeSpec $ C.Struct (typeName s) 35 | 36 | -- | Translate a Copilot type to a valid (local) variable declaration C99 type. 37 | -- 38 | -- If the type denotes an array, translate it to a pointer to whatever the 39 | -- array holds. This special case is needed when the type is used for a local 40 | -- variable declaration. We treat global variables differently (we generate 41 | -- list initializers). 42 | transLocalVarDeclType :: Type a -> C.Type 43 | transLocalVarDeclType (Array ty') = C.Ptr $ transType ty' 44 | transLocalVarDeclType ty = transType ty 45 | 46 | -- | Translate a Copilot type intro a C typename 47 | transTypeName :: Type a -> C.TypeName 48 | transTypeName ty = C.TypeName $ transType ty 49 | -------------------------------------------------------------------------------- /copilot-c99/tests/Main.hs: -------------------------------------------------------------------------------- 1 | -- | Test copilot-c99. 2 | module Main where 3 | 4 | -- External imports 5 | import Test.Framework (Test, defaultMain) 6 | 7 | -- Internal library modules being tested 8 | import qualified Test.Copilot.Compile.C99 9 | 10 | -- | Run all unit tests on copilot-c99. 11 | main :: IO () 12 | main = defaultMain tests 13 | 14 | -- | All unit tests in copilot-c99. 15 | tests :: [Test.Framework.Test] 16 | tests = 17 | [ Test.Copilot.Compile.C99.tests 18 | ] 19 | -------------------------------------------------------------------------------- /copilot-core/LICENSE: -------------------------------------------------------------------------------- 1 | 2009 2 | BSD3 License terms 3 | 4 | Redistribution and use in source and binary forms, with or without 5 | modification, are permitted provided that the following conditions 6 | are met: 7 | 8 | Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | Redistributions in binary form must reproduce the above copyright 12 | notice, this list of conditions and the following disclaimer in the 13 | documentation and/or other materials provided with the distribution. 14 | 15 | Neither the name of the developers nor the names of its contributors 16 | may be used to endorse or promote products derived from this software 17 | without specific prior written permission. 18 | 19 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 20 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 21 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 22 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR 23 | CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, 24 | EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, 25 | PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR 26 | PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF 27 | LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING 28 | NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 29 | SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 30 | -------------------------------------------------------------------------------- /copilot-core/README.md: -------------------------------------------------------------------------------- 1 | [![Build Status](https://travis-ci.com/Copilot-Language/copilot.svg?branch=master)](https://app.travis-ci.com/github/Copilot-Language/copilot) 2 | 3 | # Copilot: a stream DSL 4 | The core language, which efficiently represents Copilot expressions. The core 5 | is only of interest to implementers wishing to add a new back-end to Copilot. 6 | 7 | Copilot is a runtime verification framework written in Haskell. It allows the 8 | user to write programs in a simple but powerful way using a stream-based 9 | approach. 10 | 11 | Programs can be interpreted for testing, or translated C99 code to be 12 | incorporated in a project, or as a standalone application. The C99 backend 13 | ensures us that the output is constant in memory and time, making it suitable 14 | for systems with hard realtime requirements. 15 | 16 | 17 | ## Installation 18 | Copilot-core can be found on 19 | [Hackage](https://hackage.haskell.org/package/copilot-core). It is typically 20 | only installed as part of the complete Copilot distribution. For installation 21 | instructions, please refer to the [Copilot 22 | website](https://copilot-language.github.io). 23 | 24 | 25 | ## Further information 26 | For further information, install instructions and documentation, please visit 27 | the Copilot website: 28 | [https://copilot-language.github.io](https://copilot-language.github.io) 29 | 30 | 31 | ## License 32 | Copilot is distributed under the BSD-3-Clause license, which can be found 33 | [here](https://raw.githubusercontent.com/Copilot-Language/copilot/master/copilot-core/LICENSE). 34 | -------------------------------------------------------------------------------- /copilot-core/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /copilot-core/copilot-core.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: >=1.10 2 | name: copilot-core 3 | version: 4.4 4 | synopsis: An intermediate representation for Copilot. 5 | description: 6 | Intermediate representation for Copilot. 7 | . 8 | Copilot is a stream (i.e., infinite lists) domain-specific language (DSL) in 9 | Haskell that compiles into embedded C. Copilot contains an interpreter, 10 | multiple back-end compilers, and other verification tools. 11 | . 12 | A tutorial, examples, and other information are available at 13 | . 14 | 15 | author: Frank Dedden, Lee Pike, Robin Morisset, Alwyn Goodloe, 16 | Sebastian Niller, Nis Nordbyop Wegmann, Ivan Perez 17 | license: BSD3 18 | license-file: LICENSE 19 | maintainer: Ivan Perez 20 | homepage: https://copilot-language.github.io 21 | bug-reports: https://github.com/Copilot-Language/copilot/issues 22 | stability: Experimental 23 | category: Language, Embedded 24 | build-type: Simple 25 | extra-source-files: README.md, CHANGELOG 26 | 27 | x-curation: uncurated 28 | 29 | source-repository head 30 | type: git 31 | location: https://github.com/Copilot-Language/copilot.git 32 | subdir: copilot-core 33 | 34 | library 35 | 36 | default-language: Haskell2010 37 | 38 | hs-source-dirs: src 39 | 40 | ghc-options: 41 | -Wall 42 | -fno-warn-orphans 43 | 44 | build-depends: 45 | base >= 4.9 && < 5 46 | 47 | exposed-modules: 48 | 49 | Copilot.Core 50 | Copilot.Core.Expr 51 | Copilot.Core.Operators 52 | Copilot.Core.Spec 53 | Copilot.Core.Type 54 | Copilot.Core.Type.Array 55 | 56 | test-suite unit-tests 57 | type: 58 | exitcode-stdio-1.0 59 | 60 | main-is: 61 | Main.hs 62 | 63 | other-modules: 64 | Test.Extra 65 | Test.Copilot.Core.Type 66 | Test.Copilot.Core.Type.Array 67 | 68 | build-depends: 69 | base 70 | , HUnit 71 | , QuickCheck 72 | , test-framework 73 | , test-framework-hunit 74 | , test-framework-quickcheck2 75 | 76 | , copilot-core 77 | 78 | hs-source-dirs: 79 | tests 80 | 81 | default-language: 82 | Haskell2010 83 | 84 | ghc-options: 85 | -Wall 86 | -------------------------------------------------------------------------------- /copilot-core/src/Copilot/Core.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE Safe #-} 2 | 3 | -- | 4 | -- Description: Intermediate representation for Copilot specifications. 5 | -- Copyright: (c) 2011 National Institute of Aerospace / Galois, Inc. 6 | -- 7 | -- The following articles might also be useful: 8 | -- 9 | -- * Carette, Jacques and Kiselyov, Oleg and Shan, Chung-chieh, 10 | -- \"/Finally tagless, partially evaluated: Tagless staged/ 11 | -- /interpreters for simpler typed languages/\", 12 | -- Journal of Functional Programming vol. 19, p. 509-543, 2009. 13 | -- 14 | -- * Guillemette, Louis-Julien and Monnier, Stefan, 15 | -- \"/Type-Safe Code Transformations in Haskell/\", 16 | -- Electronic Notes in Theoretical Computer Science vol. 174, p. 23-39, 2007. 17 | -- 18 | -- For examples of how to traverse a Copilot specification see 19 | -- the source code of the interpreter (@copilot-interpreter@) 20 | -- and the pretty-printer (@copilot-prettyprinter@). 21 | module Copilot.Core 22 | ( module Copilot.Core.Expr 23 | , module Copilot.Core.Operators 24 | , module Copilot.Core.Spec 25 | , module Copilot.Core.Type 26 | , module Copilot.Core.Type.Array 27 | , module Data.Int 28 | , module Data.Word 29 | ) 30 | where 31 | 32 | -- External imports 33 | import Data.Int 34 | import Data.Word 35 | 36 | -- Internal imports 37 | import Copilot.Core.Expr 38 | import Copilot.Core.Operators 39 | import Copilot.Core.Spec 40 | import Copilot.Core.Type 41 | import Copilot.Core.Type.Array 42 | -------------------------------------------------------------------------------- /copilot-core/src/Copilot/Core/Expr.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ExistentialQuantification #-} 2 | {-# LANGUAGE GADTs #-} 3 | {-# LANGUAGE Safe #-} 4 | 5 | -- | 6 | -- Description: Internal representation of Copilot stream expressions. 7 | -- Copyright: (c) 2011 National Institute of Aerospace / Galois, Inc. 8 | module Copilot.Core.Expr 9 | ( Id 10 | , Name 11 | , Expr (..) 12 | , UExpr (..) 13 | , DropIdx 14 | ) 15 | where 16 | 17 | -- External imports 18 | import Data.Typeable (Typeable) 19 | import Data.Word (Word32) 20 | 21 | -- Internal imports 22 | import Copilot.Core.Operators (Op1, Op2, Op3) 23 | import Copilot.Core.Type (Type) 24 | 25 | -- | A stream identifier. 26 | type Id = Int 27 | 28 | -- | A name of a trigger, an external variable, or an external function. 29 | type Name = String 30 | 31 | -- | An index for the drop operator. 32 | type DropIdx = Word32 33 | 34 | -- | Internal representation of Copilot stream expressions. 35 | -- 36 | -- The Core representation mimics the high-level Copilot stream, but the Core 37 | -- representation contains information about the types of elements in the 38 | -- stream. 39 | data Expr a where 40 | Const :: Typeable a 41 | => Type a -> a -> Expr a 42 | 43 | Drop :: Typeable a 44 | => Type a -> DropIdx -> Id -> Expr a 45 | 46 | Local :: Typeable a 47 | => Type a -> Type b -> Name -> Expr a -> Expr b -> Expr b 48 | 49 | Var :: Typeable a 50 | => Type a -> Name -> Expr a 51 | 52 | ExternVar :: Typeable a 53 | => Type a -> Name -> Maybe [a] -> Expr a 54 | 55 | Op1 :: Typeable a 56 | => Op1 a b -> Expr a -> Expr b 57 | 58 | Op2 :: (Typeable a, Typeable b) 59 | => Op2 a b c -> Expr a -> Expr b -> Expr c 60 | 61 | Op3 :: (Typeable a, Typeable b, Typeable c) 62 | => Op3 a b c d -> Expr a -> Expr b -> Expr c -> Expr d 63 | 64 | Label :: Typeable a 65 | => Type a -> String -> Expr a -> Expr a 66 | 67 | -- | A untyped expression that carries the information about the type of the 68 | -- expression as a value, as opposed to exposing it at type level (using an 69 | -- existential). 70 | data UExpr = forall a . Typeable a => UExpr 71 | { uExprType :: Type a 72 | , uExprExpr :: Expr a 73 | } 74 | {-# DEPRECATED uExprType, uExprExpr "These fields are deprecated in Copilot 4.2. Use pattern matching instead." #-} 75 | -------------------------------------------------------------------------------- /copilot-core/src/Copilot/Core/Spec.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ExistentialQuantification #-} 2 | {-# LANGUAGE GADTs #-} 3 | {-# LANGUAGE Safe #-} 4 | 5 | -- | 6 | -- Copyright: (c) 2011 National Institute of Aerospace / Galois, Inc. 7 | -- 8 | -- Copilot specifications constitute the main declaration of Copilot modules. 9 | -- 10 | -- A specification normally contains the association between streams to monitor 11 | -- and their handling functions, or streams to observe, or a theorem that must 12 | -- be proved. 13 | -- 14 | -- In order to be executed, high-level Copilot Language Spec must be turned 15 | -- into Copilot Core's 'Spec'. This module defines the low-level Copilot Core 16 | -- representations for Specs and the main types of element in a spec. 17 | module Copilot.Core.Spec 18 | ( Stream (..) 19 | , Observer (..) 20 | , Trigger (..) 21 | , Spec (..) 22 | , Property (..) 23 | , Prop (..) 24 | , extractProp 25 | ) 26 | where 27 | 28 | -- External imports 29 | import Data.Typeable (Typeable) 30 | 31 | -- Internal imports 32 | import Copilot.Core.Expr (Expr, Id, Name, UExpr) 33 | import Copilot.Core.Type (Type, Typed) 34 | 35 | -- | A stream in an infinite succession of values of the same type. 36 | -- 37 | -- Stream can carry different types of data. Boolean streams play a special 38 | -- role: they are used by other parts (e.g., 'Trigger') to detect when the 39 | -- properties being monitored are violated. 40 | data Stream = forall a . (Typeable a, Typed a) => Stream 41 | { streamId :: Id 42 | , streamBuffer :: [a] 43 | , streamExpr :: Expr a 44 | , streamExprType :: Type a 45 | } 46 | 47 | -- | An observer, representing a stream that we observe during interpretation 48 | -- at every sample. 49 | data Observer = forall a . Typeable a => Observer 50 | { observerName :: Name 51 | , observerExpr :: Expr a 52 | , observerExprType :: Type a 53 | } 54 | 55 | -- | A trigger, representing a function we execute when a boolean stream becomes 56 | -- true at a sample. 57 | data Trigger = Trigger 58 | { triggerName :: Name 59 | , triggerGuard :: Expr Bool 60 | , triggerArgs :: [UExpr] 61 | } 62 | 63 | -- | A property, representing a boolean stream that is existentially or 64 | -- universally quantified over time. 65 | data Property = Property 66 | { propertyName :: Name 67 | , propertyProp :: Prop 68 | } 69 | 70 | -- | A proposition, representing a boolean stream that is existentially or 71 | -- universally quantified over time. 72 | data Prop 73 | = Forall (Expr Bool) 74 | | Exists (Expr Bool) 75 | 76 | -- | Extract the underlying stream from a quantified proposition. 77 | -- 78 | -- Think carefully before using this function, as this function will remove the 79 | -- quantifier from a proposition. Universally quantified streams usually require 80 | -- separate treatment from existentially quantified ones, so carelessly using 81 | -- this function to remove quantifiers can result in hard-to-spot soundness 82 | -- bugs. 83 | extractProp :: Prop -> Expr Bool 84 | extractProp (Forall e) = e 85 | extractProp (Exists e) = e 86 | 87 | -- | A Copilot specification is a list of streams, together with monitors on 88 | -- these streams implemented as observers, triggers or properties. 89 | data Spec = Spec 90 | { specStreams :: [Stream] 91 | , specObservers :: [Observer] 92 | , specTriggers :: [Trigger] 93 | , specProperties :: [Property] 94 | } 95 | -------------------------------------------------------------------------------- /copilot-core/src/Copilot/Core/Type/Array.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE GADTs #-} 3 | {-# LANGUAGE Safe #-} 4 | {-# LANGUAGE ScopedTypeVariables #-} 5 | {-# LANGUAGE TypeFamilies #-} 6 | {-# LANGUAGE TypeOperators #-} 7 | 8 | -- | 9 | -- Copyright: (c) 2011 National Institute of Aerospace / Galois, Inc. 10 | -- 11 | -- Implementation of an array that uses type literals to store length. No 12 | -- explicit indexing is used for the input data. Supports arbitrary nesting of 13 | -- arrays. 14 | module Copilot.Core.Type.Array 15 | ( Array 16 | , array 17 | , arrayElems 18 | , arrayUpdate 19 | ) 20 | where 21 | 22 | -- External imports 23 | import Data.Proxy (Proxy (..)) 24 | import GHC.TypeLits (KnownNat, Nat, natVal, type(-)) 25 | 26 | -- | Implementation of an array that uses type literals to store length. 27 | data Array (n :: Nat) t where 28 | Array :: [t] -> Array n t 29 | 30 | instance Show t => Show (Array n t) where 31 | show (Array xs) = show xs 32 | 33 | -- | Smart array constructor that only type checks if the length of the given 34 | -- list matches the length of the array at type level. 35 | array :: forall n t. KnownNat n => [t] -> Array n t 36 | array xs | datalen == typelen = Array xs 37 | | otherwise = error errmsg 38 | where 39 | datalen = length xs 40 | typelen = fromIntegral $ natVal (Proxy :: Proxy n) 41 | errmsg = "Length of data (" ++ show datalen ++ 42 | ") does not match length of type (" ++ show typelen ++ ")." 43 | 44 | -- | Return the elements of an array. 45 | arrayElems :: Array n a -> [a] 46 | arrayElems (Array xs) = xs 47 | 48 | -- | Update element of array to given element. 49 | -- 50 | -- PRE: the second argument denotes a valid index in the array. 51 | arrayUpdate :: Array n a -> Int -> a -> Array n a 52 | arrayUpdate (Array []) _ _ = error errMsg 53 | where 54 | errMsg = "copilot-core: arrayUpdate: Attempt to update empty array" 55 | 56 | arrayUpdate (Array (x:xs)) 0 y = Array (y:xs) 57 | 58 | arrayUpdate (Array (x:xs)) n y = 59 | arrayAppend x (arrayUpdate (Array xs) (n - 1) y) 60 | where 61 | -- | Append to an array while preserving length information at the type 62 | -- level. 63 | arrayAppend :: a -> Array (n - 1) a -> Array n a 64 | arrayAppend x (Array xs) = Array (x:xs) 65 | -------------------------------------------------------------------------------- /copilot-core/tests/Main.hs: -------------------------------------------------------------------------------- 1 | -- | Test copilot-core. 2 | module Main where 3 | 4 | -- External imports 5 | import Test.Framework (Test, defaultMain) 6 | 7 | -- Internal library modules being tested 8 | import qualified Test.Copilot.Core.Type 9 | import qualified Test.Copilot.Core.Type.Array 10 | 11 | -- | Run all unit tests on copilot-core. 12 | main :: IO () 13 | main = defaultMain tests 14 | 15 | -- | All unit tests in copilot-core. 16 | tests :: [Test.Framework.Test] 17 | tests = 18 | [ Test.Copilot.Core.Type.tests 19 | , Test.Copilot.Core.Type.Array.tests 20 | ] 21 | -------------------------------------------------------------------------------- /copilot-core/tests/Test/Extra.hs: -------------------------------------------------------------------------------- 1 | -- | Auxiliary testing helper functions. 2 | module Test.Extra where 3 | 4 | -- External imports 5 | import Control.Arrow ((***)) 6 | 7 | -- * Function application 8 | 9 | -- | Apply a tuple with two functions to a tuple of arguments. 10 | apply1 :: (a1 -> b1, a2 -> b2) -- ^ Pair with functions 11 | -> (a1, a2) -- ^ Pair with arguments 12 | -> (b1, b2) -- ^ Pair with results 13 | apply1 = uncurry (***) 14 | 15 | -- | Apply a tuple with two functions on two arguments to their tupled 16 | -- arguments. 17 | apply2 :: (a1 -> b1 -> c1, a2 -> b2 -> c2) -- ^ Pair with functions 18 | -> (a1, a2) -- ^ Pair with first arguments 19 | -> (b1, b2) -- ^ Pair with second arguments 20 | -> (c1, c2) -- ^ Pair with results 21 | apply2 fs = apply1 . apply1 fs 22 | 23 | -- | Apply a tuple with two functions on three arguments to their tupled 24 | -- arguments. 25 | apply3 :: (a1 -> b1 -> c1 -> d1, a2 -> b2 -> c2 -> d2) 26 | -- ^ Pair with functions 27 | -> (a1, a2) -- ^ Pair with first arguments 28 | -> (b1, b2) -- ^ Pair with second arguments 29 | -> (c1, c2) -- ^ Pair with third arguments 30 | -> (d1, d2) -- ^ Pair with results 31 | apply3 fs = apply2 . apply1 fs 32 | -------------------------------------------------------------------------------- /copilot-interpreter/CHANGELOG: -------------------------------------------------------------------------------- 1 | 2025-05-07 2 | * Version bump (4.4). (#618) 3 | 4 | 2025-03-07 5 | * Version bump (4.3). (#604) 6 | 7 | 2025-01-07 8 | * Version bump (4.2). (#577) 9 | 10 | 2024-11-07 11 | * Version bump (4.1). (#561) 12 | 13 | 2024-09-07 14 | * Version bump (4.0). (#532) 15 | * Add support for array updates. (#36) 16 | 17 | 2024-07-07 18 | * Version bump (3.20). (#522) 19 | * Add support for struct field updates. (#520) 20 | 21 | 2024-05-07 22 | * Version bump (3.19.1). (#512) 23 | 24 | 2024-03-07 25 | * Version bump (3.19). (#504) 26 | 27 | 2024-01-07 28 | * Version bump (3.18.1). (#493) 29 | 30 | 2024-01-07 31 | * Version bump (3.18). (#487) 32 | 33 | 2023-11-07 34 | * Version bump (3.17). (#466) 35 | * Replace uses of deprecated functions. (#457) 36 | 37 | 2023-09-07 38 | * Version bump (3.16.1). (#455) 39 | 40 | 2023-07-07 41 | * Version bump (3.16). (#448) 42 | 43 | 2023-05-07 44 | * Version bump (3.15). (#438) 45 | 46 | 2023-03-07 47 | * Version bump (3.14). (#422) 48 | 49 | 2023-01-07 50 | * Version bump (3.13). (#406) 51 | 52 | 2022-11-07 53 | * Version bump (3.12). (#389) 54 | * Use pretty-printer from copilot-prettyprinter. (#383) 55 | 56 | 2022-09-07 57 | * Version bump (3.11). (#376) 58 | * Split copilot-interpreter into separate library. (#361) 59 | -------------------------------------------------------------------------------- /copilot-interpreter/LICENSE: -------------------------------------------------------------------------------- 1 | 2009 2 | BSD3 License terms 3 | 4 | Redistribution and use in source and binary forms, with or without 5 | modification, are permitted provided that the following conditions 6 | are met: 7 | 8 | Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | Redistributions in binary form must reproduce the above copyright 12 | notice, this list of conditions and the following disclaimer in the 13 | documentation and/or other materials provided with the distribution. 14 | 15 | Neither the name of the developers nor the names of its contributors 16 | may be used to endorse or promote products derived from this software 17 | without specific prior written permission. 18 | 19 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 20 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 21 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 22 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR 23 | CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, 24 | EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, 25 | PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR 26 | PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF 27 | LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING 28 | NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 29 | SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 30 | -------------------------------------------------------------------------------- /copilot-interpreter/README.md: -------------------------------------------------------------------------------- 1 | [![Build Status](https://travis-ci.com/Copilot-Language/copilot.svg?branch=master)](https://app.travis-ci.com/github/Copilot-Language/copilot) 2 | 3 | # Copilot: a stream DSL 4 | The interpreter, which evaluates Copilot specifications and prints 5 | their results over time. 6 | 7 | Copilot is a runtime verification framework written in Haskell. It allows the 8 | user to write programs in a simple but powerful way using a stream-based 9 | approach. 10 | 11 | Programs can be interpreted for testing (with the library copilot-interpreter), 12 | or translated C99 code to be incorporated in a project, or as a standalone 13 | application. The C99 backend ensures us that the output is constant in memory 14 | and time, making it suitable for systems with hard realtime requirements. 15 | 16 | ## Installation 17 | Copilot-interpreter can be found on 18 | [Hackage](https://hackage.haskell.org/package/copilot-interpreter). It is typically 19 | only installed as part of the complete Copilot distribution. For installation 20 | instructions, please refer to the [Copilot 21 | website](https://copilot-language.github.io). 22 | 23 | ## Further information 24 | For further information, install instructions and documentation, please visit 25 | the Copilot website: 26 | [https://copilot-language.github.io](https://copilot-language.github.io) 27 | 28 | ## License 29 | Copilot is distributed under the BSD-3-Clause license, which can be found 30 | [here](https://raw.githubusercontent.com/Copilot-Language/copilot/master/copilot-interpreter/LICENSE). 31 | -------------------------------------------------------------------------------- /copilot-interpreter/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /copilot-interpreter/copilot-interpreter.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: >=1.10 2 | name: copilot-interpreter 3 | version: 4.4 4 | synopsis: Interpreter for Copilot. 5 | description: 6 | Interpreter for Copilot. 7 | . 8 | Copilot is a stream (i.e., infinite lists) domain-specific language (DSL) in 9 | Haskell that compiles into embedded C. Copilot contains an interpreter, 10 | multiple back-end compilers, and other verification tools. 11 | . 12 | A tutorial, examples, and other information are available at 13 | . 14 | 15 | author: Frank Dedden, Lee Pike, Robin Morisset, Alwyn Goodloe, 16 | Sebastian Niller, Nis Nordbyop Wegmann, Ivan Perez 17 | license: BSD3 18 | license-file: LICENSE 19 | maintainer: Ivan Perez 20 | homepage: https://copilot-language.github.io 21 | bug-reports: https://github.com/Copilot-Language/copilot/issues 22 | stability: Experimental 23 | category: Language, Embedded 24 | build-type: Simple 25 | extra-source-files: README.md, CHANGELOG 26 | 27 | x-curation: uncurated 28 | 29 | source-repository head 30 | type: git 31 | location: https://github.com/Copilot-Language/copilot.git 32 | subdir: copilot-interpreter 33 | 34 | library 35 | 36 | default-language: Haskell2010 37 | 38 | hs-source-dirs: src 39 | 40 | ghc-options: 41 | -Wall 42 | 43 | build-depends: 44 | base >= 4.9 && < 5, 45 | pretty >= 1.0 && < 1.2, 46 | 47 | copilot-core >= 4.4 && < 4.5 48 | 49 | exposed-modules: 50 | 51 | Copilot.Interpret 52 | Copilot.Interpret.Eval 53 | 54 | other-modules: 55 | 56 | Copilot.Interpret.Error 57 | Copilot.Interpret.Render 58 | 59 | test-suite unit-tests 60 | type: 61 | exitcode-stdio-1.0 62 | 63 | main-is: 64 | Main.hs 65 | 66 | other-modules: 67 | Test.Extra 68 | Test.Copilot.Interpret.Eval 69 | 70 | build-depends: 71 | base 72 | , QuickCheck 73 | , pretty 74 | , test-framework 75 | , test-framework-quickcheck2 76 | 77 | , copilot-core 78 | , copilot-interpreter 79 | , copilot-prettyprinter 80 | 81 | hs-source-dirs: 82 | tests 83 | 84 | default-language: 85 | Haskell2010 86 | 87 | ghc-options: 88 | -Wall 89 | -------------------------------------------------------------------------------- /copilot-interpreter/src/Copilot/Interpret.hs: -------------------------------------------------------------------------------- 1 | -- Copyright © 2011 National Institute of Aerospace / Galois, Inc. 2 | 3 | -- | An interpreter for Copilot specifications. 4 | 5 | {-# LANGUAGE Safe #-} 6 | 7 | module Copilot.Interpret 8 | ( Format (..) 9 | , interpret 10 | ) where 11 | 12 | import Copilot.Core 13 | import Copilot.Interpret.Eval 14 | import Copilot.Interpret.Render 15 | 16 | -- | Output format for the results of a Copilot spec interpretation. 17 | data Format = Table | CSV 18 | 19 | -- | Interpret a Copilot specification. 20 | interpret :: Format -- ^ Format to be used for the output. 21 | -> Int -- ^ Number of steps to interpret. 22 | -> Spec -- ^ Specification to interpret. 23 | -> String 24 | interpret format k spec = 25 | case format of 26 | Table -> renderAsTable e 27 | CSV -> renderAsCSV e 28 | where 29 | e = eval Haskell k spec 30 | -------------------------------------------------------------------------------- /copilot-interpreter/src/Copilot/Interpret/Error.hs: -------------------------------------------------------------------------------- 1 | -- Copyright © 2011 National Institute of Aerospace / Galois, Inc. 2 | 3 | {-# LANGUAGE Safe #-} 4 | 5 | -- | Custom functions to report error messages to users. 6 | module Copilot.Interpret.Error 7 | ( badUsage ) where 8 | 9 | -- | Report an error due to an error detected by Copilot (e.g., user error). 10 | badUsage :: String -- ^ Description of the error. 11 | -> a 12 | badUsage msg = error $ "Copilot error: " ++ msg 13 | -------------------------------------------------------------------------------- /copilot-interpreter/tests/Main.hs: -------------------------------------------------------------------------------- 1 | -- | Test copilot-core. 2 | module Main where 3 | 4 | -- External imports 5 | import Test.Framework (Test, defaultMain) 6 | 7 | -- Internal library modules being tested 8 | import qualified Test.Copilot.Interpret.Eval 9 | 10 | -- | Run all unit tests on copilot-core. 11 | main :: IO () 12 | main = defaultMain tests 13 | 14 | -- | All unit tests in copilot-core. 15 | tests :: [Test.Framework.Test] 16 | tests = 17 | [ Test.Copilot.Interpret.Eval.tests 18 | ] 19 | -------------------------------------------------------------------------------- /copilot-interpreter/tests/Test/Extra.hs: -------------------------------------------------------------------------------- 1 | -- | Auxiliary testing helper functions. 2 | module Test.Extra where 3 | 4 | -- External imports 5 | import Control.Arrow ((***)) 6 | 7 | -- * Function application 8 | 9 | -- | Apply a tuple with two functions to a tuple of arguments. 10 | apply1 :: (a1 -> b1, a2 -> b2) -- ^ Pair with functions 11 | -> (a1, a2) -- ^ Pair with arguments 12 | -> (b1, b2) -- ^ Pair with results 13 | apply1 = uncurry (***) 14 | 15 | -- | Apply a tuple with two functions on two arguments to their tupled 16 | -- arguments. 17 | apply2 :: (a1 -> b1 -> c1, a2 -> b2 -> c2) -- ^ Pair with functions 18 | -> (a1, a2) -- ^ Pair with first arguments 19 | -> (b1, b2) -- ^ Pair with second arguments 20 | -> (c1, c2) -- ^ Pair with results 21 | apply2 fs = apply1 . apply1 fs 22 | 23 | -- | Apply a tuple with two functions on three arguments to their tupled 24 | -- arguments. 25 | apply3 :: (a1 -> b1 -> c1 -> d1, a2 -> b2 -> c2 -> d2) 26 | -- ^ Pair with functions 27 | -> (a1, a2) -- ^ Pair with first arguments 28 | -> (b1, b2) -- ^ Pair with second arguments 29 | -> (c1, c2) -- ^ Pair with third arguments 30 | -> (d1, d2) -- ^ Pair with results 31 | apply3 fs = apply2 . apply1 fs 32 | -------------------------------------------------------------------------------- /copilot-language/LICENSE: -------------------------------------------------------------------------------- 1 | 2009 2 | BSD3 License terms 3 | 4 | Redistribution and use in source and binary forms, with or without 5 | modification, are permitted provided that the following conditions 6 | are met: 7 | 8 | Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | Redistributions in binary form must reproduce the above copyright 12 | notice, this list of conditions and the following disclaimer in the 13 | documentation and/or other materials provided with the distribution. 14 | 15 | Neither the name of the developers nor the names of its contributors 16 | may be used to endorse or promote products derived from this software 17 | without specific prior written permission. 18 | 19 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 20 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 21 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 22 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR 23 | CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, 24 | EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, 25 | PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR 26 | PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF 27 | LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING 28 | NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 29 | SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 30 | -------------------------------------------------------------------------------- /copilot-language/README.md: -------------------------------------------------------------------------------- 1 | [![Build Status](https://travis-ci.com/Copilot-Language/copilot.svg?branch=master)](https://app.travis-ci.com/github/Copilot-Language/copilot) 2 | 3 | # Copilot: a stream DSL 4 | Copilot-language contains the actual embedded domain specific language that 5 | Copilot provides to its users. It comes with a series of basic operators and 6 | functionality, typically enough for most applications. Extended functionality 7 | is provided by the 8 | [copilot-libraries](https://github.com/Copilot-Language/copilot/tree/master/copilot-libraries) 9 | module. 10 | 11 | Copilot is a runtime verification framework written in Haskell. It allows the 12 | user to write programs in a simple but powerful way using a stream-based 13 | approach. 14 | 15 | Programs can be interpreted for testing, or translated C99 code to be 16 | incorporated in a project, or as a standalone application. The C99 backend 17 | ensures us that the output is constant in memory and time, making it suitable 18 | for systems with hard realtime requirements. 19 | 20 | 21 | ## Installation 22 | Copilot-language can be found on 23 | [Hackage](https://hackage.haskell.org/package/copilot-language). It is typically 24 | only installed as part of the complete Copilot distribution. For installation 25 | instructions, please refer to the [Copilot 26 | website](https://copilot-language.github.io). 27 | 28 | 29 | ## Further information 30 | For further information, install instructions and documentation, please visit 31 | the Copilot website: 32 | [https://copilot-language.github.io](https://copilot-language.github.io) 33 | 34 | 35 | ## License 36 | Copilot is distributed under the BSD-3-Clause license, which can be found 37 | [here](https://raw.githubusercontent.com/Copilot-Language/copilot/master/copilot-language/LICENSE). 38 | -------------------------------------------------------------------------------- /copilot-language/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain -------------------------------------------------------------------------------- /copilot-language/copilot-language.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: >=1.10 2 | name: copilot-language 3 | version: 4.4 4 | synopsis: A Haskell-embedded DSL for monitoring hard real-time 5 | distributed systems. 6 | description: 7 | The concrete syntax for Copilot. 8 | . 9 | Copilot is a stream (i.e., infinite lists) domain-specific language (DSL) in 10 | Haskell that compiles into embedded C. Copilot contains an interpreter, 11 | multiple back-end compilers, and other verification tools. 12 | . 13 | A tutorial, examples, and other information are available at 14 | . 15 | 16 | license: BSD3 17 | license-file: LICENSE 18 | author: Frank Dedden, Lee Pike, Robin Morisset, Alwyn Goodloe, 19 | Sebastian Niller, Nis Nordby Wegmann, Ivan Perez 20 | maintainer: Ivan Perez 21 | homepage: https://copilot-language.github.io 22 | bug-reports: https://github.com/Copilot-Language/copilot/issues 23 | stability: Experimental 24 | category: Language, Embedded 25 | build-type: Simple 26 | extra-source-files: README.md, CHANGELOG 27 | 28 | x-curation: uncurated 29 | 30 | source-repository head 31 | type: git 32 | location: https://github.com/Copilot-Language/copilot.git 33 | subdir: copilot-language 34 | 35 | library 36 | default-language: Haskell2010 37 | hs-source-dirs: src 38 | build-depends: base >= 4.9 && < 5 39 | 40 | , array >= 0.5 && < 0.6 41 | , containers >= 0.4 && < 0.8 42 | , data-reify >= 0.6 && < 0.7 43 | , mtl >= 2.0 && < 3 44 | 45 | , copilot-core >= 4.4 && < 4.5 46 | , copilot-interpreter >= 4.4 && < 4.5 47 | , copilot-theorem >= 4.4 && < 4.5 48 | 49 | exposed-modules: Copilot.Language 50 | , Copilot.Language.Operators.BitWise 51 | , Copilot.Language.Operators.Boolean 52 | , Copilot.Language.Operators.Propositional 53 | , Copilot.Language.Operators.Cast 54 | , Copilot.Language.Operators.Constant 55 | , Copilot.Language.Operators.Eq 56 | , Copilot.Language.Operators.Extern 57 | , Copilot.Language.Operators.Integral 58 | , Copilot.Language.Operators.Local 59 | , Copilot.Language.Operators.Label 60 | , Copilot.Language.Operators.Mux 61 | , Copilot.Language.Operators.Ord 62 | , Copilot.Language.Operators.Temporal 63 | , Copilot.Language.Operators.Array 64 | , Copilot.Language.Operators.Projection 65 | , Copilot.Language.Operators.Struct 66 | , Copilot.Language.Prelude 67 | , Copilot.Language.Reify 68 | , Copilot.Language.Stream 69 | , Copilot.Language.Spec 70 | other-modules: Copilot.Language.Analyze 71 | , Copilot.Language.Interpret 72 | , System.Mem.StableName.Dynamic 73 | , System.Mem.StableName.Map 74 | , Copilot.Language.Error 75 | ghc-options: 76 | -Wall 77 | 78 | test-suite unit-tests 79 | type: 80 | exitcode-stdio-1.0 81 | 82 | main-is: 83 | Main.hs 84 | 85 | other-modules: 86 | Test.Copilot.Language.Reify 87 | Test.Extra 88 | 89 | build-depends: 90 | base 91 | , HUnit 92 | , QuickCheck 93 | , pretty 94 | , test-framework 95 | , test-framework-hunit 96 | , test-framework-quickcheck2 97 | 98 | , copilot-core 99 | , copilot-interpreter 100 | , copilot-language 101 | 102 | hs-source-dirs: 103 | tests 104 | 105 | default-language: 106 | Haskell2010 107 | 108 | ghc-options: 109 | -Wall 110 | -------------------------------------------------------------------------------- /copilot-language/src/Copilot/Language.hs: -------------------------------------------------------------------------------- 1 | -- Copyright © 2011 National Institute of Aerospace / Galois, Inc. 2 | 3 | -- | Main Copilot language export file. 4 | -- 5 | -- This is mainly a meta-module that re-exports most definitions in this 6 | -- library. 7 | 8 | {-# LANGUAGE Safe #-} 9 | 10 | module Copilot.Language 11 | ( module Data.Int 12 | , module Data.Word 13 | , module Copilot.Core 14 | , module Copilot.Core.Type 15 | , module Copilot.Core.Type.Array 16 | , module Copilot.Language.Error 17 | , module Copilot.Language.Interpret 18 | , module Copilot.Language.Operators.Boolean 19 | , module Copilot.Language.Operators.Cast 20 | , module Copilot.Language.Operators.Constant 21 | , module Copilot.Language.Operators.Eq 22 | , module Copilot.Language.Operators.Extern 23 | , module Copilot.Language.Operators.Local 24 | , module Copilot.Language.Operators.Label 25 | , module Copilot.Language.Operators.Integral 26 | , module Copilot.Language.Operators.Mux 27 | , module Copilot.Language.Operators.Ord 28 | , module Copilot.Language.Operators.Temporal 29 | , module Copilot.Language.Operators.BitWise 30 | , module Copilot.Language.Operators.Array 31 | , module Copilot.Language.Operators.Struct 32 | , module Copilot.Language.Prelude 33 | , Spec 34 | , Stream 35 | , observer 36 | , trigger 37 | , arg 38 | , prop 39 | , theorem 40 | , forAll 41 | , exists 42 | ) where 43 | 44 | import Data.Int hiding (Int) 45 | import Data.Word 46 | import Copilot.Core (Name, Typed) 47 | import Copilot.Core.Type 48 | import Copilot.Core.Type.Array 49 | import Copilot.Language.Error 50 | import Copilot.Language.Interpret 51 | import Copilot.Language.Operators.Boolean 52 | import Copilot.Language.Operators.Cast 53 | import Copilot.Language.Operators.Constant 54 | import Copilot.Language.Operators.Eq 55 | import Copilot.Language.Operators.Extern 56 | import Copilot.Language.Operators.Integral 57 | import Copilot.Language.Operators.Local 58 | import Copilot.Language.Operators.Label 59 | import Copilot.Language.Operators.Mux 60 | import Copilot.Language.Operators.Ord 61 | import Copilot.Language.Operators.Temporal 62 | import Copilot.Language.Operators.BitWise 63 | import Copilot.Language.Operators.Array 64 | import Copilot.Language.Operators.Struct 65 | import Copilot.Language.Reify 66 | import Copilot.Language.Prelude 67 | import Copilot.Language.Spec 68 | import Copilot.Language.Stream (Stream) 69 | -------------------------------------------------------------------------------- /copilot-language/src/Copilot/Language/Error.hs: -------------------------------------------------------------------------------- 1 | -- Copyright © 2011 National Institute of Aerospace / Galois, Inc. 2 | 3 | {-# LANGUAGE Safe #-} 4 | 5 | -- | Custom functions to report error messages to users. 6 | module Copilot.Language.Error 7 | ( impossible 8 | , badUsage ) where 9 | 10 | -- | Report an error due to a bug in Copilot. 11 | impossible :: String -- ^ Name of the function in which the error was detected. 12 | -> String -- ^ Name of the package in which the function is located. 13 | -> a 14 | impossible function package = 15 | error $ "Impossible error in function " 16 | ++ function ++ ", in package " ++ package 17 | ++ ". Please file an issue at " 18 | ++ "https://github.com/Copilot-Language/copilot/issues" 19 | ++ "or email the maintainers at " 20 | 21 | -- | Report an error due to an error detected by Copilot (e.g., user error). 22 | badUsage :: String -- ^ Description of the error. 23 | -> a 24 | badUsage msg = error $ "Copilot error: " ++ msg 25 | -------------------------------------------------------------------------------- /copilot-language/src/Copilot/Language/Interpret.hs: -------------------------------------------------------------------------------- 1 | -- Copyright (c) 2011 National Institute of Aerospace / Galois, Inc. 2 | 3 | -- | This module implements two interpreters, which may be used to simulate or 4 | -- execute Copilot specifications on a computer to understand their behavior to 5 | -- debug possible errors. 6 | -- 7 | -- The interpreters included vary in how the present the results to the user. 8 | -- One of them uses a format (csv) that may be more machine-readable, while the 9 | -- other uses a format that may be easier for humans to read. 10 | 11 | {-# LANGUAGE FlexibleInstances #-} 12 | {-# LANGUAGE GADTs #-} 13 | {-# LANGUAGE Safe #-} 14 | 15 | module Copilot.Language.Interpret 16 | ( csv 17 | , interpret 18 | ) where 19 | 20 | import qualified Copilot.Interpret as I 21 | 22 | import Copilot.Language.Spec (Spec) 23 | import Copilot.Language.Reify 24 | 25 | -- | Simulate a number of steps of a given specification, printing the results 26 | -- in a table in comma-separated value (CSV) format. 27 | csv :: Integer -> Spec -> IO () 28 | csv i spec = do 29 | putStrLn "Note: CSV format does not output observers." 30 | interpret' I.CSV i spec 31 | 32 | -- | Simulate a number of steps of a given specification, printing the results 33 | -- in a table in readable format. 34 | -- 35 | -- Compared to 'csv', this function is slower but the output may be more 36 | -- readable. 37 | interpret :: Integer -> Spec -> IO () 38 | interpret = interpret' I.Table 39 | 40 | -- | Simulate a number of steps of a given specification, printing the results 41 | -- in the format specified. 42 | interpret' :: I.Format -> Integer -> Spec -> IO () 43 | interpret' format i spec = do 44 | coreSpec <- reify spec 45 | putStrLn $ I.interpret format (fromIntegral i) coreSpec 46 | -------------------------------------------------------------------------------- /copilot-language/src/Copilot/Language/Operators/Array.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleInstances #-} 2 | {-# LANGUAGE MultiParamTypeClasses #-} 3 | {-# LANGUAGE Safe #-} 4 | {-# LANGUAGE TypeFamilies #-} 5 | -- The following warning is disabled due to a necessary instance of Projectable 6 | -- defined in this module. 7 | {-# OPTIONS_GHC -fno-warn-orphans #-} 8 | 9 | -- | Combinators to deal with streams carrying arrays. 10 | module Copilot.Language.Operators.Array 11 | ( (!) 12 | , (!!) 13 | , (=:) 14 | , (=$) 15 | ) where 16 | 17 | import Copilot.Core (Array, Op2 (Index), 18 | Op3 (UpdateArray), Typed, typeOf) 19 | import Copilot.Language.Operators.Projection (Projectable(..)) 20 | import Copilot.Language.Stream (Stream (..)) 21 | 22 | import Data.Word (Word32) 23 | import GHC.TypeLits (KnownNat) 24 | import Prelude hiding ((!!)) 25 | 26 | -- | Create a stream that carries an element of an array in another stream. 27 | -- 28 | -- This function implements a projection of the element of an array at a given 29 | -- position, over time. For example, if @s@ is a stream of type @Stream (Array 30 | -- '5 Word8)@, then @s ! 3@ has type @Stream Word8@ and contains the 3rd 31 | -- element (starting from zero) of the arrays in @s@ at any point in time. 32 | (!) :: (KnownNat n, Typed t) 33 | => Stream (Array n t) -> Stream Word32 -> Stream t 34 | arr ! n = Op2 (Index typeOf) arr n 35 | 36 | -- | Pair a stream with an element accessor, without applying it to obtain the 37 | -- value of the element. 38 | -- 39 | -- This function is needed to refer to an element accessor when the goal is to 40 | -- update the element value, not just to read it. 41 | (!!) :: Stream (Array n t) 42 | -> Stream Word32 43 | -> Projection (Array n t) (Stream Word32) t 44 | (!!) = ProjectionA 45 | 46 | -- | Update a stream of arrays. 47 | 48 | -- This is an orphan instance; we suppress the warning that GHC would 49 | -- normally produce with a GHC option at the top. 50 | instance (KnownNat n, Typed t) => Projectable (Array n t) (Stream Word32) t where 51 | 52 | -- | A projection of an element of a stream of arrays. 53 | data Projection (Array n t) (Stream Word32) t = 54 | ProjectionA (Stream (Array n t)) (Stream Word32) 55 | 56 | -- | Create a stream where an element of an array has been updated with 57 | -- values from another stream. 58 | -- 59 | -- For example, if an array has two elements of type @Int32@, and @s@ is a 60 | -- stream of such array type (@Stream (Array 2 Int32)@), and $v0$ is a stream 61 | -- of type @Int32@, then @s !! 0 =: v0@ has type @Stream (Array 2 Int32)@ and 62 | -- contains arrays where the value of the first element of each array is that 63 | -- of @v0@ at each point in time, and the value of the second element in the 64 | -- array is the same it had in @s@. 65 | (=:) (ProjectionA s ix) v = Op3 (UpdateArray typeOf) s ix v 66 | 67 | -- | Create a stream where an element of an array has been updated by 68 | -- applying a stream function to it. 69 | -- 70 | -- For example, if an array has two elements of type @Int32@, and @s@ is a 71 | -- stream of such array type (@Stream (Array 2 Int32)@), and $f$ is function 72 | -- of type @Stream Int32 -> Stream Int32@, then @s !! 0 =$ f@ has type 73 | -- @Stream (Array 2 Int32)@ and contains arrays where the value of the first 74 | -- element of each array is that of @f (s ! 0)@ at each point in time, and 75 | -- the value of the second element in the array is the same it had in @s@. 76 | (=$) (ProjectionA s ix) op = Op3 (UpdateArray typeOf) s ix (op (s ! ix)) 77 | -------------------------------------------------------------------------------- /copilot-language/src/Copilot/Language/Operators/BitWise.hs: -------------------------------------------------------------------------------- 1 | -- Copyright © 2011 National Institute of Aerospace / Galois, Inc. 2 | 3 | {-# LANGUAGE CPP #-} 4 | {-# LANGUAGE Safe #-} 5 | 6 | {-# OPTIONS_GHC -fno-warn-orphans #-} 7 | 8 | -- | Bitwise operators applied on streams, pointwise. 9 | module Copilot.Language.Operators.BitWise 10 | ( Bits ((.&.), complement, (.|.)) 11 | , (.^.) 12 | , (.<<.) 13 | , (.>>.) 14 | ) where 15 | 16 | import Copilot.Core (Typed, typeOf) 17 | import qualified Copilot.Core as Core 18 | import Copilot.Language.Stream 19 | import qualified Prelude as P 20 | 21 | #if MIN_VERSION_base(4,17,0) 22 | import Data.Bits hiding ((.>>.), (.<<.)) 23 | #else 24 | import Data.Bits 25 | #endif 26 | 27 | -- | Instance of the 'Bits' class for 'Stream's. 28 | -- 29 | -- Only the methods '.&.', 'complement', '.|.' and 'xor' are defined. 30 | instance (Typed a, Bits a) => Bits (Stream a) where 31 | (.&.) = Op2 (Core.BwAnd typeOf) 32 | complement = Op1 (Core.BwNot typeOf) 33 | (.|.) = Op2 (Core.BwOr typeOf) 34 | xor = Op2 (Core.BwXor typeOf) 35 | shiftL = P.error "shiftL undefined, for left-shifting use .<<." 36 | shiftR = P.error "shiftR undefined, for right-shifting use .>>." 37 | rotate = P.error "tbd: rotate" 38 | bitSize = P.error "tbd: bitSize" 39 | bitSizeMaybe = P.error "tbd: bitSizeMaybe" 40 | isSigned = P.error "tbd: issigned" 41 | testBit = P.error "tbd: testBit" 42 | bit = P.error "tbd: bit" 43 | popCount = P.error "tbd: popCount" 44 | 45 | #if !MIN_VERSION_base(4,17,0) 46 | -- | See 'xor'. 47 | (.^.) :: Bits a => a -> a -> a 48 | (.^.) = xor -- Avoid redefinition of the Operators.Boolean xor 49 | #endif 50 | 51 | -- | Shifting values of a stream to the left. 52 | (.<<.) :: (Bits a, Typed a, Typed b, P.Integral b) 53 | => Stream a -> Stream b -> Stream a 54 | (.<<.) = Op2 (Core.BwShiftL typeOf typeOf) 55 | 56 | -- | Shifting values of a stream to the right. 57 | (.>>.) :: (Bits a, Typed a, Typed b, P.Integral b) 58 | => Stream a -> Stream b -> Stream a 59 | (.>>.) = Op2 (Core.BwShiftR typeOf typeOf) 60 | -------------------------------------------------------------------------------- /copilot-language/src/Copilot/Language/Operators/Boolean.hs: -------------------------------------------------------------------------------- 1 | -- Copyright © 2011 National Institute of Aerospace / Galois, Inc. 2 | 3 | {-# LANGUAGE Safe #-} 4 | 5 | -- | Boolean operators applied point-wise to streams. 6 | module Copilot.Language.Operators.Boolean 7 | ( (&&) 8 | , (||) 9 | , not 10 | , true 11 | , false 12 | , xor 13 | , (==>) 14 | ) where 15 | 16 | import qualified Copilot.Core as Core 17 | import Copilot.Language.Prelude 18 | import Copilot.Language.Operators.Constant (constant) 19 | import Copilot.Language.Stream 20 | import qualified Prelude as P 21 | 22 | -- | A stream that contains the constant value 'True'. 23 | true :: Stream Bool 24 | true = constant True 25 | 26 | -- | A stream that contains the constant value 'False'. 27 | false :: Stream Bool 28 | false = constant False 29 | 30 | infixr 4 && 31 | 32 | -- | Apply the and ('&&') operator to two boolean streams, point-wise. 33 | (&&) :: Stream Bool -> Stream Bool -> Stream Bool 34 | (Const False) && _ = false 35 | _ && (Const False) = false 36 | (Const True) && y = y 37 | x && (Const True) = x 38 | x && y = Op2 Core.And x y 39 | 40 | infixr 4 || 41 | 42 | -- | Apply the or ('||') operator to two boolean streams, point-wise. 43 | (||) :: Stream Bool -> Stream Bool -> Stream Bool 44 | (Const True) || _ = true 45 | _ || (Const True) = true 46 | (Const False) || y = y 47 | x || (Const False) = x 48 | x || y = Op2 Core.Or x y 49 | 50 | -- | Negate all the values in a boolean stream. 51 | not :: Stream Bool -> Stream Bool 52 | not (Const c) = (Const $ P.not c) 53 | not x = Op1 Core.Not x 54 | 55 | -- | Apply the exclusive-or ('xor') operator to two boolean streams, 56 | -- point-wise. 57 | xor :: Stream Bool -> Stream Bool -> Stream Bool 58 | xor x y = ( not x && y ) || ( x && not y ) 59 | 60 | -- | Apply the implication ('==>') operator to two boolean streams, point-wise. 61 | (==>) :: Stream Bool -> Stream Bool -> Stream Bool 62 | x ==> y = not x || y 63 | -------------------------------------------------------------------------------- /copilot-language/src/Copilot/Language/Operators/Constant.hs: -------------------------------------------------------------------------------- 1 | -- Copyright © 2011 National Institute of Aerospace / Galois, Inc. 2 | 3 | {-# LANGUAGE Safe #-} 4 | 5 | -- | Primitives to build constant streams. 6 | module Copilot.Language.Operators.Constant 7 | ( constant 8 | , constB 9 | , constW8 10 | , constW16 11 | , constW32 12 | , constW64 13 | , constI8 14 | , constI16 15 | , constI32 16 | , constI64 17 | , constF 18 | , constD 19 | ) where 20 | 21 | import Copilot.Core (Typed) 22 | import Copilot.Language.Stream 23 | 24 | import Data.Word 25 | import Data.Int 26 | 27 | -- | Create a constant stream that is equal to the given argument, at any 28 | -- point in time. 29 | constant :: Typed a => a -> Stream a 30 | constant = Const 31 | 32 | -- | Create a constant stream carrying values of type 'Bool' that is equal to 33 | -- the given argument, at any point in time. 34 | constB :: Bool -> Stream Bool 35 | constB = constant 36 | 37 | -- | Create a constant stream carrying values of type 'Word8' that is equal to 38 | -- the given argument, at any point in time. 39 | constW8 :: Word8 -> Stream Word8 40 | constW8 = constant 41 | 42 | -- | Create a constant stream carrying values of type 'Word16' that is equal to 43 | -- the given argument, at any point in time. 44 | constW16 :: Word16 -> Stream Word16 45 | constW16 = constant 46 | 47 | -- | Create a constant stream carrying values of type 'Word32' that is equal to 48 | -- the given argument, at any point in time. 49 | constW32 :: Word32 -> Stream Word32 50 | constW32 = constant 51 | 52 | -- | Create a constant stream carrying values of type 'Word64' that is equal to 53 | -- the given argument, at any point in time. 54 | constW64 :: Word64 -> Stream Word64 55 | constW64 = constant 56 | 57 | -- | Create a constant stream carrying values of type 'Int8' that is equal to 58 | -- the given argument, at any point in time. 59 | constI8 :: Int8 -> Stream Int8 60 | constI8 = constant 61 | 62 | -- | Create a constant stream carrying values of type 'Int16' that is equal to 63 | -- the given argument, at any point in time. 64 | constI16 :: Int16 -> Stream Int16 65 | constI16 = constant 66 | 67 | -- | Create a constant stream carrying values of type 'Int32' that is equal to 68 | -- the given argument, at any point in time. 69 | constI32 :: Int32 -> Stream Int32 70 | constI32 = constant 71 | 72 | -- | Create a constant stream carrying values of type 'Int64' that is equal to 73 | -- the given argument, at any point in time. 74 | constI64 :: Int64 -> Stream Int64 75 | constI64 = constant 76 | 77 | -- | Create a constant stream carrying values of type 'Float' that is equal to 78 | -- the given argument, at any point in time. 79 | constF :: Float -> Stream Float 80 | constF = constant 81 | 82 | -- | Create a constant stream carrying values of type 'Double' that is equal to 83 | -- the given argument, at any point in time. 84 | constD :: Double -> Stream Double 85 | constD = constant 86 | -------------------------------------------------------------------------------- /copilot-language/src/Copilot/Language/Operators/Eq.hs: -------------------------------------------------------------------------------- 1 | -- Copyright © 2011 National Institute of Aerospace / Galois, Inc. 2 | 3 | {-# LANGUAGE Safe #-} 4 | 5 | -- | Equality applied point-wise on streams. 6 | module Copilot.Language.Operators.Eq 7 | ( (==) 8 | , (/=) 9 | ) where 10 | 11 | import Copilot.Core (Typed, typeOf) 12 | import qualified Copilot.Core as Core 13 | import Copilot.Language.Prelude 14 | import Copilot.Language.Stream 15 | import qualified Prelude as P 16 | 17 | -- | Compare two streams point-wise for equality. 18 | -- 19 | -- The output stream contains the value True at a point in time if both 20 | -- argument streams contain the same value at that point in time. 21 | (==) :: (P.Eq a, Typed a) => Stream a -> Stream a -> Stream Bool 22 | (Const x) == (Const y) = Const (x P.== y) 23 | x == y = Op2 (Core.Eq typeOf) x y 24 | 25 | -- | Compare two streams point-wise for inequality. 26 | -- 27 | -- The output stream contains the value True at a point in time if both 28 | -- argument streams contain different values at that point in time. 29 | (/=) :: (P.Eq a, Typed a) => Stream a -> Stream a -> Stream Bool 30 | (Const x) /= (Const y) = Const (x P./= y) 31 | x /= y = Op2 (Core.Ne typeOf) x y 32 | -------------------------------------------------------------------------------- /copilot-language/src/Copilot/Language/Operators/Integral.hs: -------------------------------------------------------------------------------- 1 | -- Copyright © 2011 National Institute of Aerospace / Galois, Inc. 2 | 3 | -- | Integral class operators applied point-wise on streams. 4 | 5 | {-# LANGUAGE Safe #-} 6 | 7 | module Copilot.Language.Operators.Integral 8 | ( div 9 | , mod 10 | , (^) 11 | ) where 12 | 13 | import Copilot.Core (Typed, typeOf) 14 | import qualified Copilot.Core as Core 15 | import qualified Copilot.Language.Error as Err 16 | import Copilot.Language.Operators.BitWise ((.<<.)) 17 | import Copilot.Language.Stream 18 | 19 | import qualified Data.Bits as B 20 | import qualified Prelude as P 21 | import Data.List (foldl', replicate) 22 | 23 | -- | Apply the 'Prelude.div' operation to two streams, point-wise. 24 | div :: (Typed a, P.Integral a) => Stream a -> Stream a -> Stream a 25 | (Const 0) `div` _ = Const 0 26 | _ `div` (Const 0) = Err.badUsage "in div: division by zero." 27 | x `div` (Const 1) = x 28 | x `div` y = Op2 (Core.Div typeOf) x y 29 | 30 | -- | Apply the 'Prelude.mod' operation to two streams, point-wise. 31 | mod :: (Typed a, P.Integral a) => Stream a -> Stream a -> Stream a 32 | _ `mod` (Const 0) = Err.badUsage "in mod: division by zero." 33 | (Const 0) `mod` _ = (Const 0) 34 | (Const x) `mod` (Const y) = Const (x `P.mod` y) 35 | x `mod` y = Op2 (Core.Mod typeOf) x y 36 | 37 | -- | Apply a limited form of exponentiation (@^@) to two streams, point-wise. 38 | -- 39 | -- Either the first stream must be the constant 2, or the second must be a 40 | -- constant stream. 41 | (^) :: (Typed a, Typed b, P.Num a, B.Bits a, P.Integral b) 42 | => Stream a -> Stream b -> Stream a 43 | (Const 0) ^ (Const 0) = Const 1 44 | (Const 0) ^ x = Op3 (Core.Mux typeOf) (Op2 (Core.Eq typeOf) x 0) (1) (0) 45 | (Const 1) ^ _ = Const 1 46 | (Const x) ^ (Const y) = Const (x P.^ y) 47 | (Const 2) ^ y = (Const 1) .<<. y 48 | x ^ (Const y) = foldl' ((P.*)) (Const 1) (replicate (P.fromIntegral y) x) 49 | _ ^ _ = 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.)" 50 | -------------------------------------------------------------------------------- /copilot-language/src/Copilot/Language/Operators/Label.hs: -------------------------------------------------------------------------------- 1 | -- Copyright © 2011 National Institute of Aerospace / Galois, Inc. 2 | 3 | -- | Label a stream with additional information. 4 | 5 | {-# LANGUAGE Safe #-} 6 | 7 | module Copilot.Language.Operators.Label 8 | ( label 9 | ) where 10 | 11 | import Copilot.Core (Typed) 12 | import Copilot.Language.Stream (Stream (..)) 13 | 14 | -- | This function allows you to label a stream with a tag, which can be used 15 | -- by different backends to provide additional information either in error 16 | -- messages or in the generated code (e.g., for traceability purposes). 17 | -- 18 | -- Semantically, a labelled stream is just the stream inside it. The use of 19 | -- label should not affect the observable behavior of the monitor, and how it 20 | -- is used in the code generated is a decision specific to each backend. 21 | label :: (Typed a) => String -> Stream a -> Stream a 22 | label = Label 23 | -------------------------------------------------------------------------------- /copilot-language/src/Copilot/Language/Operators/Local.hs: -------------------------------------------------------------------------------- 1 | -- Copyright © 2011 National Institute of Aerospace / Galois, Inc. 2 | 3 | -- | Let expressions. 4 | -- 5 | -- Although Copilot is a DSL embedded in Haskell and Haskell does support let 6 | -- expressions, we want Copilot to be able to implement sharing, to detect when 7 | -- the same stream is being used in multiple places in a specification and 8 | -- avoid recomputing it unnecessarily. 9 | 10 | {-# LANGUAGE Safe #-} 11 | 12 | module Copilot.Language.Operators.Local 13 | ( local 14 | ) where 15 | 16 | import Copilot.Core (Typed) 17 | import Copilot.Language.Stream (Stream (..)) 18 | 19 | -- | Let expressions. 20 | -- 21 | -- Create a stream that results from applying a stream to a function on 22 | -- streams. Standard usage would be similar to Haskell's let. See the 23 | -- following example, where @stream1@, @stream2@ and @s@ are all streams 24 | -- carrying values of some numeric type: 25 | -- 26 | -- @ 27 | -- expression = local (stream1 + stream2) $ \\s -> 28 | -- (s >= 0 && s <= 10) 29 | -- @ 30 | local :: (Typed a, Typed b) => Stream a -> (Stream a -> Stream b) -> Stream b 31 | local = Local 32 | -------------------------------------------------------------------------------- /copilot-language/src/Copilot/Language/Operators/Mux.hs: -------------------------------------------------------------------------------- 1 | -- Copyright © 2011 National Institute of Aerospace / Galois, Inc. 2 | 3 | {-# LANGUAGE Safe #-} 4 | 5 | -- | Pick values from one of two streams, depending whether a condition is true 6 | -- or false. 7 | module Copilot.Language.Operators.Mux 8 | ( mux 9 | , ifThenElse 10 | ) where 11 | 12 | import Copilot.Core (Typed, typeOf) 13 | import qualified Copilot.Core as Core 14 | import Copilot.Language.Prelude 15 | import Copilot.Language.Stream 16 | import Prelude () 17 | 18 | -- | Convenient synonym for 'ifThenElse'. 19 | mux :: Typed a => Stream Bool -> Stream a -> Stream a -> Stream a 20 | mux (Const True) t _ = t 21 | mux (Const False) _ f = f 22 | mux b t f = Op3 (Core.Mux typeOf) b t f 23 | 24 | -- | If-then-else applied point-wise to three streams (a condition stream, a 25 | -- then-branch stream, and an else-branch stream). 26 | -- 27 | -- Produce a stream that, at any point in time, if the value of the first 28 | -- stream at that point is true, contains the value in the second stream at 29 | -- that time, otherwise it contains the value in the third stream. 30 | ifThenElse :: Typed a => Stream Bool -> Stream a -> Stream a -> Stream a 31 | ifThenElse = mux 32 | -------------------------------------------------------------------------------- /copilot-language/src/Copilot/Language/Operators/Ord.hs: -------------------------------------------------------------------------------- 1 | -- Copyright © 2011 National Institute of Aerospace / Galois, Inc. 2 | 3 | {-# LANGUAGE Safe #-} 4 | 5 | -- | Comparison operators applied point-wise on streams. 6 | module Copilot.Language.Operators.Ord 7 | ( (<=) 8 | , (>=) 9 | , (<) 10 | , (>) 11 | ) where 12 | 13 | import Copilot.Core (Typed, typeOf) 14 | import qualified Copilot.Core as Core 15 | import Copilot.Language.Prelude 16 | import Copilot.Language.Stream 17 | import qualified Prelude as P 18 | 19 | -- | Compare two streams point-wise for order. 20 | -- 21 | -- The output stream contains the value True at a point in time if the 22 | -- element in the first stream is smaller or equal than the element in 23 | -- the second stream at that point in time, and False otherwise. 24 | (<=) :: (P.Ord a, Typed a) => Stream a -> Stream a -> Stream Bool 25 | (Const x) <= (Const y) = Const (x P.<= y) 26 | x <= y = Op2 (Core.Le typeOf) x y 27 | 28 | -- | Compare two streams point-wise for order. 29 | -- 30 | -- The output stream contains the value True at a point in time if the 31 | -- element in the first stream is greater or equal than the element in 32 | -- the second stream at that point in time, and False otherwise. 33 | (>=) :: (P.Ord a, Typed a) => Stream a -> Stream a -> Stream Bool 34 | (Const x) >= (Const y) = Const (x P.>= y) 35 | x >= y = Op2 (Core.Ge typeOf) x y 36 | 37 | -- | Compare two streams point-wise for order. 38 | -- 39 | -- The output stream contains the value True at a point in time if the 40 | -- element in the first stream is smaller than the element in the second stream 41 | -- at that point in time, and False otherwise. 42 | (<) :: (P.Ord a, Typed a) => Stream a -> Stream a -> Stream Bool 43 | (Const x) < (Const y) = Const (x P.< y) 44 | x < y = Op2 (Core.Lt typeOf) x y 45 | 46 | -- | Compare two streams point-wise for order. 47 | -- 48 | -- The output stream contains the value True at a point in time if the element 49 | -- in the first stream is greater than the element in the second stream at that 50 | -- point in time, and False otherwise. 51 | (>) :: (P.Ord a, Typed a) => Stream a -> Stream a -> Stream Bool 52 | (Const x) > (Const y) = Const (x P.> y) 53 | x > y = Op2 (Core.Gt typeOf) x y 54 | -------------------------------------------------------------------------------- /copilot-language/src/Copilot/Language/Operators/Projection.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleInstances #-} 2 | {-# LANGUAGE FunctionalDependencies #-} 3 | {-# LANGUAGE TypeFamilies #-} 4 | -- | Interface to access portions of a larger data structure. 5 | -- 6 | -- Default operations to access elements from structs and arrays (e.g., a field 7 | -- of a struct, an element of an array) allow obtaining the values of those 8 | -- elements, but not modifying. 9 | -- 10 | -- This module defines a common interface to manipulate portions of a larger 11 | -- data structure. We define the interface in a generic way, using a type 12 | -- class with two operations: one to set the value of the sub-element, and 13 | -- one to update the value of such element applying a stream function. 14 | module Copilot.Language.Operators.Projection 15 | ( Projectable (..) ) 16 | where 17 | 18 | import Copilot.Language.Stream (Stream) 19 | 20 | infixl 8 =: 21 | infixl 8 =$ 22 | 23 | -- | Common interface to manipulate portions of a larger data structure. 24 | -- 25 | -- A projectable d s t means that it is possible to manipulate a sub-element s 26 | -- of type t carried in a stream of type d. 27 | class Projectable d s t | d s -> t where 28 | 29 | -- | Unapplied projection or element access on a type. 30 | data Projection d s t 31 | 32 | -- | Modify the value of a sub-element of a type in a stream of elements 33 | -- of that type. 34 | (=:) :: Projection d s t -> Stream t -> Stream d 35 | 36 | -- | Update the value of a sub-element of a type in a stream of elements of 37 | -- that type, by applying a function on streams. 38 | (=$) :: Projection d s t -> (Stream t -> Stream t) -> Stream d 39 | -------------------------------------------------------------------------------- /copilot-language/src/Copilot/Language/Operators/Propositional.hs: -------------------------------------------------------------------------------- 1 | -- Copyright © 2011 National Institute of Aerospace / Galois, Inc. 2 | 3 | {-# LANGUAGE FlexibleInstances #-} 4 | {-# LANGUAGE GADTs #-} 5 | {-# LANGUAGE MultiParamTypeClasses #-} 6 | {-# LANGUAGE Safe #-} 7 | 8 | -- | Implement negation over quantified extensions of boolean streams. 9 | -- 10 | -- For details, see 'Prop'. 11 | module Copilot.Language.Operators.Propositional (not) where 12 | 13 | import Prelude (($)) 14 | 15 | import Copilot.Language.Spec (Prop (..)) 16 | import qualified Copilot.Language.Operators.Boolean as B 17 | 18 | import Copilot.Theorem 19 | 20 | -- | A proposition that can be negated. 21 | class Negatable a b where 22 | -- | Negate a proposition. 23 | not :: a -> b 24 | 25 | -- | Negation of an existentially quantified proposition. 26 | instance Negatable (Prop Existential) (Prop Universal) where 27 | not (Exists p) = Forall $ B.not p 28 | 29 | -- | Negation of a universally quantified proposition. 30 | instance Negatable (Prop Universal) (Prop Existential) where 31 | not (Forall p) = Exists $ B.not p 32 | -------------------------------------------------------------------------------- /copilot-language/src/Copilot/Language/Operators/Struct.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleInstances #-} 2 | {-# LANGUAGE MultiParamTypeClasses #-} 3 | {-# LANGUAGE Safe #-} 4 | {-# LANGUAGE TypeFamilies #-} 5 | -- The following warning is disabled due to a necessary instance of Projectable 6 | -- defined in this module. 7 | {-# OPTIONS_GHC -fno-warn-orphans #-} 8 | 9 | -- | Combinators to deal with streams carrying structs. 10 | -- 11 | -- We support two kinds of operations on structs: reading the fields of structs 12 | -- and modifying the fields of structs. 13 | -- 14 | -- To obtain the values of field @x@ of a struct @s@, you can just write: 15 | -- 16 | -- @ 17 | -- expr = s # x 18 | -- @ 19 | -- 20 | -- If you want to update it, use instead a double hash to refer to the field. 21 | -- You can either update the field: 22 | -- 23 | -- @ 24 | -- expr = s ## x =: 75 25 | -- @ 26 | -- 27 | -- To update it by applying a function to it, for example, the function that 28 | -- updates a stream by one unit, just do: 29 | -- 30 | -- @ 31 | -- expr = s ## x =$ (+1) 32 | -- @ 33 | module Copilot.Language.Operators.Struct 34 | ( Projectable(..) 35 | , (#) 36 | , (##) 37 | ) where 38 | 39 | import Copilot.Core.Type 40 | import Copilot.Core.Operators 41 | import Copilot.Language.Operators.Projection 42 | import Copilot.Language.Stream (Stream (..)) 43 | 44 | import GHC.TypeLits (KnownSymbol) 45 | 46 | -- | Create a stream that carries a field of a struct in another stream. 47 | -- 48 | -- This function implements a projection of a field of a struct over time. For 49 | -- example, if a struct of type @T@ has two fields, @t1@ of type @Int@ and @t2@ 50 | -- of type @Word8@, and @s@ is a stream of type @Stream T@, then @s # t2@ has 51 | -- type @Stream Word8@ and contains the values of the @t2@ field of the structs 52 | -- in @s@ at any point in time. 53 | (#) :: (KnownSymbol f, Typed t, Typed s, Struct s) 54 | => Stream s -> (s -> Field f t) -> Stream t 55 | (#) s f = Op1 (GetField typeOf typeOf f) s 56 | 57 | -- | Pair a stream with a field accessor, without applying it to obtain the 58 | -- value of the field. 59 | -- 60 | -- This function is needed to refer to a field accessor when the goal is to 61 | -- update the field value, not just to read it. 62 | (##) :: (KnownSymbol f, Typed t, Typed s, Struct s) 63 | => Stream s -> (s -> Field f t) -> Projection s (s -> Field f t) t 64 | (##) = ProjectionS 65 | 66 | -- | Update a stream of structs. 67 | 68 | -- This is an orphan instance; we suppress the warning that GHC would 69 | -- normally produce with a GHC option at the top. 70 | instance (KnownSymbol f, Typed s, Typed t, Struct s) 71 | => Projectable s (s -> Field f t) t 72 | where 73 | 74 | -- | A projection of a field of a stream of structs. 75 | data Projection s (s -> Field f t) t = ProjectionS (Stream s) (s -> Field f t) 76 | 77 | -- | Create a stream where the field of a struct has been updated with values 78 | -- from another stream. 79 | -- 80 | -- For example, if a struct of type @T@ has two fields, @t1@ of type @Int32@ 81 | -- and @t2@ of type @Word8@, and @s@ is a stream of type @Stream T@, and 82 | -- $sT1$ is a stream of type @Int32@ then @s ## t2 =: sT1@ has type @Stream 83 | -- T@ and contains structs where the value of @t1@ is that of @sT1@ and the 84 | -- value of @t2@ is the value that the same field had in @s@, at any point in 85 | -- time. 86 | (=:) (ProjectionS s f) v = Op2 (UpdateField typeOf typeOf f) s v 87 | 88 | -- | Create a stream where the field of a struct has been updated by applying 89 | -- a function to it. 90 | -- 91 | -- For example, if a struct of type @T@ has two fields, @t1@ of type @Int32@ 92 | -- and @t2@ of type @Word8@, and @s@ is a stream of type @Stream T@, and $f$ 93 | -- is a function from @Stream Int32 -> Stream Int32@ then @s ## t2 =$ f@ has 94 | -- type @Stream T@ and contains structs where the value of @t1@ is that of 95 | -- @f@ applied to the original value of @t1@ in @s@, and the value of @t2@ is 96 | -- the value that the same field had in @s@, at any point in time. 97 | (=$) (ProjectionS s f) op = Op2 (UpdateField typeOf typeOf f) s (op (s # f)) 98 | -------------------------------------------------------------------------------- /copilot-language/src/Copilot/Language/Operators/Temporal.hs: -------------------------------------------------------------------------------- 1 | -- Copyright © 2011 National Institute of Aerospace / Galois, Inc. 2 | 3 | {-# LANGUAGE Safe #-} 4 | 5 | -- | Temporal stream transformations. 6 | module Copilot.Language.Operators.Temporal 7 | ( (++) 8 | , drop 9 | ) where 10 | 11 | import Copilot.Core (Typed) 12 | import Copilot.Language.Prelude 13 | import Copilot.Language.Stream 14 | import Prelude () 15 | 16 | infixr 1 ++ 17 | 18 | -- | Prepend a fixed number of samples to a stream. 19 | -- 20 | -- The elements to be appended at the beginning of the stream must be limited, 21 | -- that is, the list must have finite length. 22 | -- 23 | -- Prepending elements to a stream may increase the memory requirements of the 24 | -- generated programs (which now must hold the same number of elements in 25 | -- memory for future processing). 26 | (++) :: Typed a => [a] -> Stream a -> Stream a 27 | (++) = (`Append` Nothing) 28 | 29 | -- | Drop a number of samples from a stream. 30 | -- 31 | -- The elements must be realizable at the present time to be able to drop 32 | -- elements. For most kinds of streams, you cannot drop elements without 33 | -- prepending an equal or greater number of elements to them first, as it 34 | -- could result in undefined samples. 35 | drop :: Typed a => Int -> Stream a -> Stream a 36 | drop 0 s = s 37 | drop _ ( Const j ) = Const j 38 | drop i ( Drop j s ) = Drop (fromIntegral i + j) s 39 | drop i s = Drop (fromIntegral i) s 40 | -------------------------------------------------------------------------------- /copilot-language/src/Copilot/Language/Prelude.hs: -------------------------------------------------------------------------------- 1 | -- Copyright © 2011 National Institute of Aerospace / Galois, Inc. 2 | 3 | -- | Reexports 'Prelude' from package "base" hiding identifiers redefined by 4 | -- Copilot. 5 | 6 | {-# LANGUAGE Safe #-} 7 | 8 | module Copilot.Language.Prelude 9 | ( module Prelude 10 | ) where 11 | 12 | import Prelude hiding 13 | ( (++) 14 | , (==), (/=) 15 | , div, mod 16 | , (<=), (>=), (<), (>) 17 | , (&&) 18 | , (^) 19 | , (||) 20 | , const 21 | , drop 22 | , not 23 | , mod 24 | , until 25 | , sum 26 | , max 27 | , min 28 | , (!!) 29 | , cycle 30 | , take 31 | ) 32 | -------------------------------------------------------------------------------- /copilot-language/src/System/Mem/StableName/Dynamic.hs: -------------------------------------------------------------------------------- 1 | -- Copyright © 2011 National Institute of Aerospace / Galois, Inc. 2 | 3 | {-# LANGUAGE ExistentialQuantification #-} 4 | {-# LANGUAGE Safe #-} 5 | 6 | module System.Mem.StableName.Dynamic 7 | ( DynStableName(..) 8 | , hashDynStableName 9 | , makeDynStableName 10 | ) where 11 | 12 | import System.Mem.StableName (StableName, eqStableName, makeStableName, 13 | hashStableName) 14 | 15 | data DynStableName = forall a . DynStableName (StableName a) 16 | 17 | makeDynStableName :: a -> IO DynStableName 18 | makeDynStableName x = 19 | do 20 | stn <- makeStableName x 21 | return (DynStableName stn) 22 | 23 | hashDynStableName :: DynStableName -> Int 24 | hashDynStableName (DynStableName sn) = hashStableName sn 25 | 26 | instance Eq DynStableName where 27 | DynStableName sn1 == DynStableName sn2 = eqStableName sn1 sn2 28 | -------------------------------------------------------------------------------- /copilot-language/src/System/Mem/StableName/Map.hs: -------------------------------------------------------------------------------- 1 | -- Most of this code is taken from 'http://github.com/ekmett/stable-maps'. 2 | 3 | {-# LANGUAGE Safe #-} 4 | 5 | module System.Mem.StableName.Map 6 | ( Map(..) 7 | , empty 8 | , null 9 | , singleton 10 | , member 11 | , notMember 12 | , insert 13 | , insertWith 14 | , insertWith' 15 | , lookup 16 | , find 17 | , findWithDefault 18 | ) where 19 | 20 | import qualified Prelude 21 | import Prelude hiding (lookup, null) 22 | import System.Mem.StableName.Dynamic 23 | import qualified Data.IntMap as IntMap 24 | import Data.IntMap (IntMap) 25 | 26 | import Copilot.Language.Error (impossible) 27 | 28 | data Map a = Map { getMap :: IntMap [(DynStableName, a)] 29 | , getSize :: Int } 30 | 31 | empty :: Map a 32 | empty = Map IntMap.empty 0 33 | 34 | null :: Map a -> Bool 35 | null (Map m _) = IntMap.null m 36 | 37 | singleton :: DynStableName -> a -> Map a 38 | singleton k v = 39 | Map (IntMap.singleton (hashDynStableName k) [(k,v)]) 1 40 | 41 | member :: DynStableName -> Map a -> Bool 42 | member k m = case lookup k m of 43 | Nothing -> False 44 | Just _ -> True 45 | 46 | notMember :: DynStableName -> Map a -> Bool 47 | notMember k m = not $ member k m 48 | 49 | insert :: DynStableName -> a -> Map a -> Map a 50 | insert k v Map { getMap = mp 51 | , getSize = sz } 52 | = Map (IntMap.insertWith (++) (hashDynStableName k) [(k,v)] mp) 53 | (sz + 1) 54 | 55 | -- | /O(log n)/. Insert with a function for combining the new value and old value. 56 | -- @'insertWith' f key value mp@ 57 | -- will insert the pair (key, value) into @mp@ if the key does not exist 58 | -- in the map. If the key does exist, the function will insert the pair 59 | -- @(key, f new_value old_value)@ 60 | insertWith :: (a -> a -> a) -> DynStableName -> a -> Map a -> Map a 61 | insertWith f k v Map { getMap = mp 62 | , getSize = sz } 63 | = Map (IntMap.insertWith go (hashDynStableName k) [(k,v)] mp) 64 | (sz + 1) 65 | where 66 | go _ ((k',v'):kvs) 67 | | k == k' = (k', f v v') : kvs 68 | | otherwise = (k',v') : go undefined kvs 69 | go _ [] = [] 70 | 71 | -- | Same as 'insertWith', but with the combining function applied strictly. 72 | insertWith' :: (a -> a -> a) -> DynStableName -> a -> Map a -> Map a 73 | insertWith' f k v Map { getMap = mp 74 | , getSize = sz } 75 | = Map (IntMap.insertWith go (hashDynStableName k) [(k,v)] mp) 76 | (sz + 1) 77 | where 78 | go _ ((k',v'):kvs) 79 | | k == k' = let v'' = f v v' in v'' `seq` (k', v'') : kvs 80 | | otherwise = (k', v') : go undefined kvs 81 | go _ [] = [] 82 | 83 | -- | /O(log n)/. Lookup the value at a key in the map. 84 | -- 85 | -- The function will return the corresponding value as a @('Just' value)@ 86 | -- or 'Nothing' if the key isn't in the map. 87 | lookup :: DynStableName -> Map v -> Maybe v 88 | lookup k (Map m _) = do 89 | pairs <- IntMap.lookup (hashDynStableName k) m 90 | Prelude.lookup k pairs 91 | 92 | find :: DynStableName -> Map v -> v 93 | find k m = case lookup k m of 94 | Nothing -> impossible "find" "copilot-language" 95 | Just x -> x 96 | 97 | -- | /O(log n)/. The expression @('findWithDefault' def k map)@ returns 98 | -- the value at key @k@ or returns the default value @def@ 99 | -- when the key is not in the map. 100 | findWithDefault :: v -> DynStableName -> Map v -> v 101 | findWithDefault dflt k m = maybe dflt id $ lookup k m 102 | -------------------------------------------------------------------------------- /copilot-language/tests/Main.hs: -------------------------------------------------------------------------------- 1 | -- | Test copilot-language. 2 | module Main where 3 | 4 | -- External imports 5 | import Test.Framework (Test, defaultMain) 6 | 7 | -- Internal imports 8 | import qualified Test.Copilot.Language.Reify 9 | 10 | -- | Run all unit tests on copilot-language. 11 | main :: IO () 12 | main = defaultMain tests 13 | 14 | -- | All unit tests in copilot-language. 15 | tests :: [Test.Framework.Test] 16 | tests = 17 | [ Test.Copilot.Language.Reify.tests 18 | ] 19 | -------------------------------------------------------------------------------- /copilot-language/tests/Test/Extra.hs: -------------------------------------------------------------------------------- 1 | -- | Auxiliary testing helper functions. 2 | module Test.Extra where 3 | 4 | -- External imports 5 | import Control.Arrow ((***)) 6 | 7 | -- * Function application 8 | 9 | -- | Apply a tuple with two functions to a tuple of arguments. 10 | apply1 :: (a1 -> b1, a2 -> b2) -- ^ Pair with functions 11 | -> (a1, a2) -- ^ Pair with arguments 12 | -> (b1, b2) -- ^ Pair with results 13 | apply1 = uncurry (***) 14 | 15 | -- | Apply a tuple with two functions on two arguments to their tupled 16 | -- arguments. 17 | apply2 :: (a1 -> b1 -> c1, a2 -> b2 -> c2) -- ^ Pair with functions 18 | -> (a1, a2) -- ^ Pair with first arguments 19 | -> (b1, b2) -- ^ Pair with second arguments 20 | -> (c1, c2) -- ^ Pair with results 21 | apply2 fs = apply1 . apply1 fs 22 | 23 | -- | Apply a tuple with two functions on three arguments to their tupled 24 | -- arguments. 25 | apply3 :: (a1 -> b1 -> c1 -> d1, a2 -> b2 -> c2 -> d2) 26 | -- ^ Pair with functions 27 | -> (a1, a2) -- ^ Pair with first arguments 28 | -> (b1, b2) -- ^ Pair with second arguments 29 | -> (c1, c2) -- ^ Pair with third arguments 30 | -> (d1, d2) -- ^ Pair with results 31 | apply3 fs = apply2 . apply1 fs 32 | -------------------------------------------------------------------------------- /copilot-libraries/CHANGELOG: -------------------------------------------------------------------------------- 1 | 2025-05-07 2 | * Version bump (4.4). (#618) 3 | 4 | 2025-03-07 5 | * Version bump (4.3). (#604) 6 | * Remove deprecated function Copilot.Library.Utils.(!!). (#599) 7 | 8 | 2025-01-07 9 | * Version bump (4.2). (#577) 10 | * Bump upper version constraint on containers. (#570) 11 | 12 | 2024-11-07 13 | * Version bump (4.1). (#561) 14 | * Standardize changelog format. (#550) 15 | 16 | 2024-09-07 17 | * Version bump (4.0). (#532) 18 | * Rename operator to avoid name clash. (#36) 19 | 20 | 2024-07-07 21 | * Version bump (3.20). (#522) 22 | 23 | 2024-05-07 24 | * Version bump (3.19.1). (#512) 25 | 26 | 2024-03-07 27 | * Version bump (3.19). (#504) 28 | 29 | 2024-01-07 30 | * Version bump (3.18.1). (#493) 31 | 32 | 2024-01-07 33 | * Version bump (3.18). (#487) 34 | * Introduce testing infrastructure for Copilot.Library. (#475) 35 | * Replace uses of forall with forAll. (#470) 36 | 37 | 2023-11-07 38 | * Version bump (3.17). (#466) 39 | 40 | 2023-09-07 41 | * Version bump (3.16.1). (#455) 42 | * Fix semantics of since in Copilot.Library.PTLTL. (#443) 43 | * Prevent the majority function from generating unused local variables. 44 | (#408) 45 | 46 | 2023-07-07 47 | * Version bump (3.16). (#448) 48 | 49 | 2023-05-07 50 | * Version bump (3.15). (#438) 51 | 52 | 2023-03-07 53 | * Version bump (3.14). (#422) 54 | 55 | 2023-01-07 56 | * Version bump (3.13). (#406) 57 | 58 | 2022-11-07 59 | * Version bump (3.12). (#389) 60 | 61 | 2022-09-07 62 | * Version bump (3.11). (#376) 63 | 64 | 2022-07-07 65 | * Version bump (3.10). (#356) 66 | * Remove unnecessary dependencies from Cabal package. (#327) 67 | * Remove duplicated compiler option. (#328) 68 | * Relax version bounds of dependencies. (#335) 69 | * Update repo info in cabal file. (#333) 70 | 71 | 2022-05-06 72 | * Version bump (3.9). (#320) 73 | * Compliance with style guide (partial). (#316) 74 | 75 | 2022-03-07 76 | * Version bump (3.8). (#298) 77 | * Mark package as uncurated to avoid modification. (#288) 78 | 79 | 2022-01-07 80 | * Version bump (3.7). (#287) 81 | 82 | 2021-11-07 83 | * Version bump (3.6). (#264) 84 | * Improve documentation of LTL module. (#131) 85 | * Fix outdated/broken links. (#252) 86 | 87 | 2021-08-19 88 | * Version bump (3.5). (#247) 89 | * Update travis domain in README. (#222) 90 | * Update official maintainer. (#236) 91 | * Update source repo location. (#241) 92 | * Add I. Perez to author list. (#243) 93 | 94 | 2021-07-07 95 | * Version bump (3.4). (#231) 96 | 97 | 2021-05-07 98 | * Version bump (3.3). (#217) 99 | 100 | 2021-03-07 101 | * Version bump (3.2.1). (#126) 102 | * Completed the documentation. (#127) 103 | 104 | 2020-12-06 105 | * Version bump (3.2). (#65) 106 | * Update description, bug-reports, homepage fields in cabal file. (#129) 107 | 108 | 2019-11-22 109 | * Version bump (3.1). (#46) 110 | -------------------------------------------------------------------------------- /copilot-libraries/LICENSE: -------------------------------------------------------------------------------- 1 | 2009 2 | BSD3 License terms 3 | 4 | Redistribution and use in source and binary forms, with or without 5 | modification, are permitted provided that the following conditions 6 | are met: 7 | 8 | Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | Redistributions in binary form must reproduce the above copyright 12 | notice, this list of conditions and the following disclaimer in the 13 | documentation and/or other materials provided with the distribution. 14 | 15 | Neither the name of the developers nor the names of its contributors 16 | may be used to endorse or promote products derived from this software 17 | without specific prior written permission. 18 | 19 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 20 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 21 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 22 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR 23 | CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, 24 | EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, 25 | PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR 26 | PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF 27 | LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING 28 | NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 29 | SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 30 | -------------------------------------------------------------------------------- /copilot-libraries/README.md: -------------------------------------------------------------------------------- 1 | [![Build Status](https://travis-ci.com/Copilot-Language/copilot.svg?branch=master)](https://app.travis-ci.com/github/Copilot-Language/copilot) 2 | 3 | # Copilot: a stream DSL 4 | User-supplied libraries for Copilot, including linear-temporal logic, 5 | fault-tolerant voting, regular expressions, etc. 6 | 7 | Copilot is a runtime verification framework written in Haskell. It allows the 8 | user to write programs in a simple but powerful way using a stream-based 9 | approach. 10 | 11 | Programs can be interpreted for testing, or translated C99 code to be 12 | incorporated in a project, or as a standalone application. The C99 backend 13 | ensures us that the output is constant in memory and time, making it suitable 14 | for systems with hard realtime requirements. 15 | 16 | 17 | ## Installation 18 | Copilot-libraries can be found on 19 | [Hackage](https://hackage.haskell.org/package/copilot-libraries). It is typically 20 | only installed as part of the complete Copilot distribution. For installation 21 | instructions, please refer to the [Copilot 22 | website](https://copilot-language.github.io). 23 | 24 | 25 | ## Further information 26 | For further information, install instructions and documentation, please visit 27 | the Copilot website: 28 | [https://copilot-language.github.io](https://copilot-language.github.io) 29 | 30 | 31 | ## License 32 | Copilot is distributed under the BSD-3-Clause license, which can be found 33 | [here](https://raw.githubusercontent.com/Copilot-Language/copilot/master/copilot-libraries/LICENSE). 34 | -------------------------------------------------------------------------------- /copilot-libraries/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain -------------------------------------------------------------------------------- /copilot-libraries/copilot-libraries.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: >=1.10 2 | name: copilot-libraries 3 | version: 4.4 4 | synopsis: Libraries for the Copilot language. 5 | description: 6 | Libraries for the Copilot language. 7 | . 8 | Copilot is a stream (i.e., infinite lists) domain-specific language (DSL) in 9 | Haskell that compiles into embedded C. Copilot contains an interpreter, 10 | multiple back-end compilers, and other verification tools. 11 | . 12 | A tutorial, examples, and other information are available at 13 | . 14 | 15 | license: BSD3 16 | license-file: LICENSE 17 | author: Frank Dedden, Lee Pike, Robin Morisset, Alwyn Goodloe, 18 | Sebastian Niller, Nis Nordby Wegmann, Ivan Perez 19 | maintainer: Ivan Perez 20 | homepage: https://copilot-language.github.io 21 | bug-reports: https://github.com/Copilot-Language/copilot/issues 22 | stability: Experimental 23 | category: Language, Embedded 24 | build-type: Simple 25 | extra-source-files: README.md, CHANGELOG 26 | 27 | x-curation: uncurated 28 | 29 | source-repository head 30 | type: git 31 | location: https://github.com/Copilot-Language/copilot.git 32 | subdir: copilot-libraries 33 | 34 | library 35 | default-language: Haskell2010 36 | 37 | hs-source-dirs: src 38 | 39 | build-depends: base >= 4.9 && < 5 40 | 41 | , containers >= 0.4 && < 0.8 42 | , mtl >= 2.0 && < 2.4 43 | , parsec >= 2.0 && < 3.2 44 | , copilot-language >= 4.4 && < 4.5 45 | 46 | exposed-modules: 47 | Copilot.Library.Libraries 48 | , Copilot.Library.Clocks 49 | , Copilot.Library.LTL 50 | , Copilot.Library.PTLTL 51 | , Copilot.Library.Statistics 52 | , Copilot.Library.RegExp 53 | , Copilot.Library.Utils 54 | , Copilot.Library.Voting 55 | , Copilot.Library.Stacks 56 | , Copilot.Library.MTL 57 | 58 | ghc-options: 59 | -Wall 60 | 61 | test-suite unit-tests 62 | type: 63 | exitcode-stdio-1.0 64 | 65 | main-is: 66 | Main.hs 67 | 68 | other-modules: 69 | Test.Copilot.Library.PTLTL 70 | Test.Extra 71 | 72 | build-depends: 73 | base 74 | , QuickCheck 75 | , test-framework 76 | , test-framework-quickcheck2 77 | 78 | , copilot-interpreter 79 | , copilot-language 80 | , copilot-libraries 81 | , copilot-theorem 82 | 83 | hs-source-dirs: 84 | tests 85 | 86 | default-language: 87 | Haskell2010 88 | 89 | ghc-options: 90 | -Wall 91 | -------------------------------------------------------------------------------- /copilot-libraries/src/Copilot/Library/Clocks.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Module: Clocks 3 | -- Description: Clocks based on a base period and phase 4 | -- Copyright: (c) 2011 National Institute of Aerospace / Galois, Inc. 5 | -- 6 | -- This library generates new clocks based on a base period and phase. 7 | -- 8 | -- = Example Usage 9 | -- 10 | -- Also see @examples/Clock.hs@ in the 11 | -- . 12 | -- 13 | -- @ 14 | -- 'clk' ( 'period' 3 ) ( 'phase' 1 ) 15 | -- @ 16 | -- 17 | -- is equivalent to a stream of values like: 18 | -- 19 | -- @ 20 | -- cycle [False, True, False] 21 | -- @ 22 | -- 23 | -- that generates a stream of values 24 | -- 25 | -- @ 26 | -- False True False False True False False True False ... 27 | -- 0 1 2 3 4 5 6 7 8 28 | -- @ 29 | -- 30 | -- That is true every 3 ticks (the period) starting on the 1st tick (the phase). 31 | 32 | {-# LANGUAGE NoImplicitPrelude #-} 33 | 34 | module Copilot.Library.Clocks 35 | ( clk, clk1, period, phase ) where 36 | 37 | import Prelude () 38 | import qualified Prelude as P 39 | import Copilot.Language 40 | 41 | data ( Integral a ) => Period a = Period a 42 | data ( Integral a ) => Phase a = Phase a 43 | 44 | -- | Constructor for a 'Period'. Note that period must be greater than 0. 45 | period :: ( Integral a ) => a -> Period a 46 | period = Period 47 | 48 | -- | Constructor for a 'Phase'. Note that phase must be greater than or equal 49 | -- to 0, and must be less than the period. 50 | phase :: ( Integral a ) => a -> Phase a 51 | phase = Phase 52 | 53 | -- | Generate a clock that counts every @n@ ticks, starting at tick @m@, by 54 | -- using an array of size @n@. 55 | clk :: ( Integral a ) => 56 | Period a -- ^ Period @n@ of clock 57 | -> Phase a -- ^ Phase @m@ of clock 58 | -> Stream Bool -- ^ Clock signal - 'True' on clock ticks, 'False' otherwise 59 | clk ( Period period' ) ( Phase phase' ) = clk' 60 | where 61 | clk' = if period' P.< 1 then 62 | badUsage ( "clk: clock period must be 1 or greater" ) 63 | else if phase' P.< 0 then 64 | badUsage ( "clk: clock phase must be 0 or greater" ) 65 | else if phase' P.>= period' then 66 | badUsage ( "clk: clock phase must be less than period") 67 | else replicate ( fromIntegral phase' ) False 68 | P.++ True : replicate 69 | ( fromIntegral 70 | $ period' P.- phase' P.- 1 ) False 71 | ++ clk' 72 | 73 | -- | This follows the same convention as 'clk', but uses a counter variable of 74 | -- integral type /a/ rather than an array. 75 | clk1 :: ( Integral a, Typed a ) => 76 | Period a -- ^ Period @n@ of clock 77 | -> Phase a -- ^ Phase @m@ of clock 78 | -> Stream Bool -- ^ Clock signal - 'True' on clock ticks, 'False' otherwise 79 | clk1 ( Period period' ) ( Phase phase' ) = 80 | if period' P.< 1 then 81 | badUsage ( "clk1: clock period must be 1 or greater" ) 82 | else if phase' P.< 0 then 83 | badUsage ( "clk1: clock phase must be 0 or greater" ) 84 | else if phase' P.>= period' then 85 | badUsage ( "clk1: clock phase must be less than period") 86 | else 87 | let counter = [ P.fromInteger 0 ] 88 | ++ mux ( counter /= ( constant $ 89 | period' P.- 1 ) ) 90 | ( counter P.+ 1 ) 91 | ( 0 ) 92 | in counter == fromIntegral phase' 93 | -------------------------------------------------------------------------------- /copilot-libraries/src/Copilot/Library/Libraries.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Module: Libraries 3 | -- Description: Main import module for libraries 4 | -- Copyright: (c) 2011 National Institute of Aerospace / Galois, Inc. 5 | -- 6 | -- This is a convenience module that re-exports a useful subset of modules from 7 | -- @copilot-library@. Not all modules are exported due to name clashes (e.g., 8 | -- in temporal logics implementations). 9 | 10 | module Copilot.Library.Libraries ( 11 | module Copilot.Library.Clocks 12 | , module Copilot.Library.LTL 13 | , module Copilot.Library.PTLTL 14 | , module Copilot.Library.Statistics 15 | , module Copilot.Library.RegExp 16 | , module Copilot.Library.Utils 17 | , module Copilot.Library.Voting 18 | , module Copilot.Library.Stacks 19 | ) where 20 | 21 | import Copilot.Library.Clocks 22 | import Copilot.Library.LTL 23 | import Copilot.Library.PTLTL 24 | import Copilot.Library.Statistics 25 | import Copilot.Library.RegExp 26 | import Copilot.Library.Utils 27 | import Copilot.Library.Voting 28 | import Copilot.Library.Stacks 29 | -------------------------------------------------------------------------------- /copilot-libraries/src/Copilot/Library/PTLTL.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Module: PTLTL 3 | -- Description: Past-Time Linear-Temporal Logic 4 | -- Copyright: (c) 2011 National Institute of Aerospace / Galois, Inc. 5 | -- 6 | -- Provides past-time linear-temporal logic (ptLTL operators). 7 | -- 8 | -- /Interface:/ See @Examples/PTLTLExamples.hs@ in the 9 | -- . 10 | -- 11 | -- You can embed a ptLTL specification within a Copilot specification using 12 | -- the form: 13 | -- 14 | -- @ 15 | -- operator stream 16 | -- @ 17 | 18 | {-# LANGUAGE NoImplicitPrelude #-} 19 | 20 | module Copilot.Library.PTLTL 21 | ( since, alwaysBeen, eventuallyPrev, previous ) where 22 | 23 | import Prelude () 24 | import Copilot.Language 25 | 26 | -- | Did @s@ hold in the previous period? 27 | previous :: Stream Bool -> Stream Bool 28 | previous s = [ False ] ++ s 29 | 30 | -- | Has @s@ always held (up to and including the current state)? 31 | alwaysBeen :: Stream Bool -> Stream Bool 32 | alwaysBeen s = s && tmp 33 | where 34 | tmp = [ True ] ++ s && tmp 35 | 36 | -- | Did @s@ hold at some time in the past (including the current state)? 37 | eventuallyPrev :: Stream Bool -> Stream Bool 38 | eventuallyPrev s = s || tmp 39 | where 40 | tmp = [ False ] ++ s || tmp 41 | 42 | -- | Is there a time when @s2@ holds and after which @s1@ continuously holds? 43 | since :: Stream Bool -> Stream Bool -> Stream Bool 44 | since s1 s2 = eventuallyPrev (s2 ==> (alwaysBeen s1)) 45 | -------------------------------------------------------------------------------- /copilot-libraries/src/Copilot/Library/Statistics.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Module: Statistics 3 | -- Description: Basic bounded statistics 4 | -- Copyright: (c) 2011 National Institute of Aerospace / Galois, Inc. 5 | -- 6 | -- Basic bounded statistics. In the following, a bound @n@ is given stating 7 | -- the number of periods over which to compute the statistic (@n == 1@ computes 8 | -- it only over the current period). 9 | 10 | {-# LANGUAGE NoImplicitPrelude #-} 11 | 12 | module Copilot.Library.Statistics 13 | ( max, min, sum, mean, meanNow ) where 14 | 15 | import Copilot.Language 16 | import Copilot.Library.Utils 17 | 18 | -- | Summation. 19 | sum :: ( Typed a, Num a, Eq a ) => Int -> Stream a -> Stream a 20 | sum n s = nfoldl1 n (+) s 21 | 22 | -- | Maximum value. 23 | max :: ( Typed a, Ord a ) => Int -> Stream a -> Stream a 24 | max n s = nfoldl1 n largest s 25 | where 26 | largest = \ x y -> mux ( x >= y ) x y 27 | 28 | -- | Minimum value. 29 | min :: ( Typed a, Ord a ) => Int -> Stream a -> Stream a 30 | min n s = nfoldl1 n smallest s 31 | where 32 | smallest = \ x y -> mux ( x <= y ) x y 33 | 34 | -- | Mean value. @n@ must not overflow 35 | -- for word size @a@ for streams over which computation is peformed. 36 | mean :: ( Typed a, Eq a, Fractional a ) => Int -> Stream a -> Stream a 37 | mean n s = ( sum n s ) / ( fromIntegral n ) 38 | 39 | -- | Mean value over the current set of streams passed in. 40 | meanNow :: ( Typed a, Integral a ) => [ Stream a ] -> Stream a 41 | meanNow [] = 42 | badUsage "list of arguments to meanNow must be nonempty" 43 | meanNow ls = ( foldl1 (+) ls ) `div` ( fromIntegral $ length ls ) 44 | -------------------------------------------------------------------------------- /copilot-libraries/src/Copilot/Library/Voting.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Module: Voting 3 | -- Description: Implementation of the Boyer-Moore Majority Vote Algorithm 4 | -- Copyright: (c) 2011 National Institute of Aerospace / Galois, Inc. 5 | -- 6 | -- This is an implementation of the Boyer-Moore Majority Vote Algorithm for 7 | -- Copilot, which solves the majority vote problem in linear time and constant 8 | -- memory in two passes. 'majority' implements the first pass, and 'aMajority' 9 | -- the second pass. For details of the Boyer-Moore Majority Vote Algorithm see 10 | -- the following papers: 11 | -- 12 | -- * 13 | -- 14 | -- * 15 | -- 16 | -- In addition, and 17 | -- explain 18 | -- a form of this code in section 4. 19 | -- 20 | -- For instance, with four streams passed to 'majority', and the candidate stream 21 | -- then passed to 'aMajority': 22 | -- 23 | -- @ 24 | -- vote1: vote2: vote3: vote4: majority: aMajority: 25 | -- 0 0 0 0 0 true 26 | -- 1 0 0 0 0 true 27 | -- 1 1 0 0 1 false 28 | -- 1 1 1 0 1 true 29 | -- 1 1 1 1 1 true 30 | -- @ 31 | -- 32 | -- For other examples, see @examples/Voting.hs@ in the 33 | -- . 34 | 35 | {-# LANGUAGE RebindableSyntax #-} 36 | 37 | module Copilot.Library.Voting 38 | ( majority, aMajority ) where 39 | 40 | import Copilot.Language 41 | import qualified Prelude as P 42 | 43 | -- | Majority vote first pass: choosing a candidate. 44 | majority :: (P.Eq a, Typed a) => 45 | [Stream a] -- ^ Vote streams 46 | -> Stream a -- ^ Candidate stream 47 | majority [] = badUsage "majority: empty list not allowed" 48 | majority (x:xs) = majority' xs x 1 49 | 50 | -- Alternate syntax of local bindings. 51 | majority' :: (P.Eq a, Typed a) 52 | => [Stream a] -> Stream a -> Stream Word32 -> Stream a 53 | majority' [] can _ = can 54 | majority' (x:xs) can cnt = 55 | local (cnt == 0) inZero 56 | where 57 | inZero zero = local (if zero then x else can) inCan 58 | where 59 | inCan can' = 60 | -- We include a special case for when `xs` is empty that immediately 61 | -- returns `can'`. We could omit this special case without changing the 62 | -- final result, but this has the downside that `local` would bind a 63 | -- local variable that would go unused in `inCnt`. (Note that `inCnt` 64 | -- recursively invokes `majority'`, which doesn't use its last argument 65 | -- if the list of vote streams is empty.) These unused local variables 66 | -- would result in C code that triggers compiler warnings. 67 | case xs of 68 | [] -> can' 69 | _ -> local (if zero || x == can then cnt+1 else cnt-1) inCnt 70 | where 71 | inCnt cnt' = majority' xs can' cnt' 72 | 73 | -- | Majority vote second pass: checking that a candidate indeed has more than 74 | -- half the votes. 75 | aMajority :: (P.Eq a, Typed a) => 76 | [Stream a] -- ^ Vote streams 77 | -> Stream a -- ^ Candidate stream 78 | -> Stream Bool -- ^ True if candidate holds majority 79 | aMajority [] _ = badUsage "aMajority: empty list not allowed" 80 | aMajority xs can = 81 | let 82 | cnt = aMajority' 0 xs can 83 | in 84 | (cnt * 2) > fromIntegral (length xs) 85 | 86 | aMajority' :: (P.Eq a, Typed a) 87 | => Stream Word32 -> [Stream a] -> Stream a -> Stream Word32 88 | aMajority' cnt [] _ = cnt 89 | aMajority' cnt (x:xs) can = 90 | local (if x == can then cnt+1 else cnt) $ \ cnt' -> 91 | aMajority' cnt' xs can 92 | -------------------------------------------------------------------------------- /copilot-libraries/tests/Main.hs: -------------------------------------------------------------------------------- 1 | -- | Test copilot-libraries. 2 | module Main where 3 | 4 | -- External imports 5 | import Test.Framework (Test, defaultMain) 6 | 7 | -- Internal imports 8 | import qualified Test.Copilot.Library.PTLTL 9 | 10 | -- | Run all unit tests on copilot-libraries. 11 | main :: IO () 12 | main = defaultMain tests 13 | 14 | -- | All unit tests in copilot-libraries. 15 | tests :: [Test.Framework.Test] 16 | tests = 17 | [ Test.Copilot.Library.PTLTL.tests 18 | ] 19 | -------------------------------------------------------------------------------- /copilot-libraries/tests/Test/Copilot/Library/PTLTL.hs: -------------------------------------------------------------------------------- 1 | -- | Test copilot-libraries:Copilot.Library.PTLTL 2 | module Test.Copilot.Library.PTLTL 3 | (tests) 4 | where 5 | 6 | -- External imports 7 | import Test.Framework (Test, testGroup) 8 | import Test.Framework.Providers.QuickCheck2 (testProperty) 9 | import Test.QuickCheck (Gen, Property) 10 | 11 | -- External imports: Copilot 12 | import Copilot.Language (extern) 13 | import qualified Copilot.Language.Operators.Boolean as Copilot 14 | import Copilot.Language.Stream (Stream) 15 | import Copilot.Theorem.What4 (SatResult (..)) 16 | 17 | -- Internal imports: auxiliary functions 18 | import Test.Extra (arbitraryBoolExpr, testWithInterpreter, testWithTheorem) 19 | 20 | -- Internal imports: Modules being tested 21 | import Copilot.Library.PTLTL (eventuallyPrev, previous) 22 | 23 | -- * Constants 24 | 25 | -- | Unit tests for copilot-libraries:Copilot.Library.PTLTL. 26 | tests :: Test.Framework.Test 27 | tests = 28 | testGroup "Copilot.Library.PTLTL" 29 | [ testProperty "previous x ==> eventuallyPrev x (theorem)" 30 | testProvePreviousEventually 31 | , testProperty "previous x ==> eventuallyPrev x (interpreter)" 32 | testCheckPreviousEventually 33 | ] 34 | 35 | -- * Individual tests 36 | 37 | -- | Test that Z3 is able to prove the following expression valid: 38 | -- @ 39 | -- previous x ==> eventuallyPrev x 40 | -- @ 41 | testProvePreviousEventually :: Property 42 | testProvePreviousEventually = testWithTheorem pair 43 | where 44 | pair :: Gen (Stream Bool, SatResult) 45 | pair = pure (stream, expectation) 46 | 47 | stream :: Stream Bool 48 | stream = 49 | previous boolStream Copilot.==> eventuallyPrev boolStream 50 | where 51 | boolStream = extern "x" Nothing 52 | 53 | expectation :: SatResult 54 | expectation = Valid 55 | 56 | -- | Test that the following stream is always true: 57 | -- @ 58 | -- previous x ==> eventuallyPrev x 59 | -- @ 60 | testCheckPreviousEventually :: Property 61 | testCheckPreviousEventually = testWithInterpreter pair 62 | where 63 | pair :: Gen (Stream Bool, [Bool]) 64 | pair = do 65 | -- We discard the expectation from the expression; the temporal formula 66 | -- holds at all times regardless. 67 | boolStream <- fst <$> arbitraryBoolExpr 68 | let prop = previous boolStream Copilot.==> eventuallyPrev boolStream 69 | return (prop, expectation) 70 | 71 | expectation :: [Bool] 72 | expectation = repeat True 73 | -------------------------------------------------------------------------------- /copilot-prettyprinter/CHANGELOG: -------------------------------------------------------------------------------- 1 | 2025-05-07 2 | * Version bump (4.4). (#618) 3 | 4 | 2025-03-07 5 | * Version bump (4.3). (#604) 6 | * Update pretty-printing to handle Props. (#254) 7 | 8 | 2025-01-07 9 | * Version bump (4.2). (#577) 10 | * Remove uses of Copilot.Core.Expr.UExpr.uExprExpr. (#565) 11 | 12 | 2024-11-07 13 | * Version bump (4.1). (#561) 14 | 15 | 2024-09-07 16 | * Version bump (4.0). (#532) 17 | * Add support for pretty-printing struct update expressions. (#526) 18 | * Add support for pretty-printing array update expressions. (#36) 19 | 20 | 2024-07-07 21 | * Version bump (3.20). (#522) 22 | 23 | 2024-05-07 24 | * Version bump (3.19.1). (#512) 25 | 26 | 2024-03-07 27 | * Version bump (3.19). (#504) 28 | 29 | 2024-01-07 30 | * Version bump (3.18.1). (#493) 31 | 32 | 2024-01-07 33 | * Version bump (3.18). (#487) 34 | 35 | 2023-11-07 36 | * Version bump (3.17). (#466) 37 | 38 | 2023-11-05 39 | * Replace uses of deprecated functions. (#457) 40 | 41 | 2023-09-07 42 | * Version bump (3.16.1). (#455) 43 | 44 | 2023-07-07 45 | * Version bump (3.16). (#448) 46 | 47 | 2023-05-07 48 | * Version bump (3.15). (#438) 49 | 50 | 2023-03-07 51 | * Version bump (3.14). (#422) 52 | 53 | 2023-01-07 54 | * Version bump (3.13). (#406) 55 | 56 | 2022-11-07 57 | * Version bump (3.12). (#389) 58 | * Create new library for pretty-printer. (#383) 59 | -------------------------------------------------------------------------------- /copilot-prettyprinter/LICENSE: -------------------------------------------------------------------------------- 1 | 2009 2 | BSD3 License terms 3 | 4 | Redistribution and use in source and binary forms, with or without 5 | modification, are permitted provided that the following conditions 6 | are met: 7 | 8 | Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | Redistributions in binary form must reproduce the above copyright 12 | notice, this list of conditions and the following disclaimer in the 13 | documentation and/or other materials provided with the distribution. 14 | 15 | Neither the name of the developers nor the names of its contributors 16 | may be used to endorse or promote products derived from this software 17 | without specific prior written permission. 18 | 19 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 20 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 21 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 22 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR 23 | CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, 24 | EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, 25 | PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR 26 | PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF 27 | LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING 28 | NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 29 | SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 30 | -------------------------------------------------------------------------------- /copilot-prettyprinter/README.md: -------------------------------------------------------------------------------- 1 | [![Build Status](https://travis-ci.com/Copilot-Language/copilot.svg?branch=master)](https://app.travis-ci.com/github/Copilot-Language/copilot) 2 | 3 | # Copilot: a stream DSL 4 | Copilot-prettyprinter implements a pretty-printer of Copilot Core 5 | specifications. 6 | 7 | Copilot is a runtime verification framework written in Haskell. It allows the 8 | user to write programs in a simple but powerful way using a stream-based 9 | approach. 10 | 11 | Programs can be interpreted for testing, or translated C99 code to be 12 | incorporated in a project, or as a standalone application. The C99 backend 13 | ensures us that the output is constant in memory and time, making it suitable 14 | for systems with hard realtime requirements. 15 | 16 | 17 | ## Installation 18 | Copilot-prettyprinter can be found on 19 | [Hackage](https://hackage.haskell.org/package/copilot-prettyprinter). It is 20 | typically only installed as part of the complete Copilot distribution. For 21 | installation instructions, please refer to the [Copilot 22 | website](https://copilot-language.github.io). 23 | 24 | 25 | ## Further information 26 | For further information, install instructions and documentation, please visit 27 | the Copilot website: 28 | [https://copilot-language.github.io](https://copilot-language.github.io) 29 | 30 | 31 | ## License 32 | Copilot is distributed under the BSD-3-Clause license, which can be found 33 | [here](https://raw.githubusercontent.com/Copilot-Language/copilot/master/copilot-prettyprinter/LICENSE). 34 | -------------------------------------------------------------------------------- /copilot-prettyprinter/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /copilot-prettyprinter/copilot-prettyprinter.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: >=1.10 2 | name: copilot-prettyprinter 3 | version: 4.4 4 | synopsis: A prettyprinter of Copilot Specifications. 5 | description: 6 | A prettyprinter of Copilot specifications. 7 | . 8 | Copilot is a stream (i.e., infinite lists) domain-specific language (DSL) in 9 | Haskell that compiles into embedded C. Copilot contains an interpreter, 10 | multiple back-end compilers, and other verification tools. 11 | . 12 | A tutorial, examples, and other information are available at 13 | . 14 | 15 | author: Frank Dedden, Lee Pike, Robin Morisset, Alwyn Goodloe, 16 | Sebastian Niller, Nis Nordbyop Wegmann, Ivan Perez 17 | license: BSD3 18 | license-file: LICENSE 19 | maintainer: Ivan Perez 20 | homepage: https://copilot-language.github.io 21 | bug-reports: https://github.com/Copilot-Language/copilot/issues 22 | stability: Experimental 23 | category: Language, Embedded 24 | build-type: Simple 25 | extra-source-files: README.md, CHANGELOG 26 | 27 | x-curation: uncurated 28 | 29 | source-repository head 30 | type: git 31 | location: https://github.com/Copilot-Language/copilot.git 32 | subdir: copilot-prettyprinter 33 | 34 | library 35 | 36 | default-language: Haskell2010 37 | 38 | hs-source-dirs: src 39 | 40 | ghc-options: 41 | -Wall 42 | -fno-warn-orphans 43 | 44 | build-depends: 45 | base >= 4.9 && < 5, 46 | pretty >= 1.0 && < 1.2, 47 | 48 | copilot-core >= 4.4 && < 4.5 49 | 50 | exposed-modules: 51 | 52 | Copilot.PrettyPrint 53 | 54 | other-modules: 55 | 56 | Copilot.PrettyPrint.Error 57 | Copilot.PrettyPrint.Type 58 | -------------------------------------------------------------------------------- /copilot-prettyprinter/src/Copilot/PrettyPrint/Error.hs: -------------------------------------------------------------------------------- 1 | -- Copyright © 2011 National Institute of Aerospace / Galois, Inc. 2 | 3 | {-# LANGUAGE Safe #-} 4 | 5 | -- | Custom functions to report error messages to users. 6 | module Copilot.PrettyPrint.Error 7 | ( impossible 8 | , badUsage ) where 9 | 10 | -- | Report an error due to a bug in Copilot. 11 | impossible :: String -- ^ Name of the function in which the error was detected. 12 | -> String -- ^ Name of the package in which the function is located. 13 | -> a 14 | impossible function package = 15 | error $ "\"Impossible\" error in function " 16 | ++ function ++ ", in package " ++ package 17 | ++ ". Please file an issue at " 18 | ++ "https://github.com/Copilot-Language/copilot/issues" 19 | ++ "or email the maintainers at " 20 | 21 | -- | Report an error due to an error detected by Copilot (e.g., user error). 22 | badUsage :: String -- ^ Description of the error. 23 | -> a 24 | badUsage msg = error $ "Copilot error: " ++ msg 25 | -------------------------------------------------------------------------------- /copilot-prettyprinter/src/Copilot/PrettyPrint/Type.hs: -------------------------------------------------------------------------------- 1 | -- Copyright © 2011 National Institute of Aerospace / Galois, Inc. 2 | 3 | {-# LANGUAGE ExistentialQuantification #-} 4 | {-# LANGUAGE GADTs #-} 5 | {-# LANGUAGE Safe #-} 6 | 7 | -- | Show Copilot Core types and typed values. 8 | module Copilot.PrettyPrint.Type 9 | ( showWithType 10 | , ShowType(..) 11 | , showType 12 | ) where 13 | 14 | import Copilot.Core.Type 15 | 16 | -- Are we proving equivalence with a C backend, in which case we want to show 17 | -- Booleans as '0' and '1'. 18 | 19 | -- | Target language for showing a typed value. Used to adapt the 20 | -- representation of booleans. 21 | data ShowType = C | Haskell 22 | 23 | -- | Show a value. The representation depends on the type and the target 24 | -- language. Booleans are represented differently depending on the backend. 25 | showWithType :: ShowType -> Type a -> a -> String 26 | showWithType showT t x = 27 | case showT of 28 | C -> case t of 29 | Bool -> if x then "1" else "0" 30 | _ -> sw 31 | Haskell -> case t of 32 | Bool -> if x then "true" else "false" 33 | _ -> sw 34 | where 35 | sw = case showWit t of 36 | ShowWit -> show x 37 | 38 | -- | Show Copilot Core type. 39 | showType :: Type a -> String 40 | showType t = 41 | case t of 42 | Bool -> "Bool" 43 | Int8 -> "Int8" 44 | Int16 -> "Int16" 45 | Int32 -> "Int32" 46 | Int64 -> "Int64" 47 | Word8 -> "Word8" 48 | Word16 -> "Word16" 49 | Word32 -> "Word32" 50 | Word64 -> "Word64" 51 | Float -> "Float" 52 | Double -> "Double" 53 | Array t -> "Array " ++ showType t 54 | Struct t -> "Struct" 55 | 56 | -- * Auxiliary show instance 57 | 58 | -- | Witness datatype for showing a value, used by 'showWithType'. 59 | data ShowWit a = Show a => ShowWit 60 | 61 | -- | Turn a type into a show witness. 62 | showWit :: Type a -> ShowWit a 63 | showWit t = 64 | case t of 65 | Bool -> ShowWit 66 | Int8 -> ShowWit 67 | Int16 -> ShowWit 68 | Int32 -> ShowWit 69 | Int64 -> ShowWit 70 | Word8 -> ShowWit 71 | Word16 -> ShowWit 72 | Word32 -> ShowWit 73 | Word64 -> ShowWit 74 | Float -> ShowWit 75 | Double -> ShowWit 76 | Array t -> ShowWit 77 | Struct t -> ShowWit 78 | -------------------------------------------------------------------------------- /copilot-theorem/LICENSE: -------------------------------------------------------------------------------- 1 | 2009 2 | BSD3 License terms 3 | 4 | Redistribution and use in source and binary forms, with or without 5 | modification, are permitted provided that the following conditions 6 | are met: 7 | 8 | Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | Redistributions in binary form must reproduce the above copyright 12 | notice, this list of conditions and the following disclaimer in the 13 | documentation and/or other materials provided with the distribution. 14 | 15 | Neither the name of the developers nor the names of its contributors 16 | may be used to endorse or promote products derived from this software 17 | without specific prior written permission. 18 | 19 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 20 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 21 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 22 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR 23 | CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, 24 | EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, 25 | PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR 26 | PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF 27 | LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING 28 | NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 29 | SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 30 | -------------------------------------------------------------------------------- /copilot-theorem/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /copilot-theorem/doc/talk.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Copilot-Language/copilot/1b03ab511e7a5c269beef2284ae9c4dc548128a1/copilot-theorem/doc/talk.pdf -------------------------------------------------------------------------------- /copilot-theorem/examples/BoyerMoore.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE RebindableSyntax #-} 2 | {-# LANGUAGE ScopedTypeVariables #-} 3 | 4 | module BoyerMoore where 5 | 6 | import Copilot.Language hiding (length) 7 | import Copilot.Theorem 8 | import Copilot.Theorem.Prover.Z3 9 | 10 | import Copilot.Core.Type 11 | 12 | import Prelude () 13 | import Control.Monad (forM_) 14 | import Data.String (fromString) 15 | 16 | import qualified Prelude as P 17 | import qualified Data.List as L 18 | 19 | length :: [a] -> Stream Word8 20 | length l = constant (fromInteger $ L.genericLength l) 21 | 22 | arbitraryCst :: forall a . (Typed a) => String -> Stream a 23 | arbitraryCst s = c 24 | where 25 | t :: Stream Word8 26 | t = [0] ++ (1 + t) 27 | i :: Stream a 28 | i = extern s Nothing 29 | c = if t == 0 then i else [uninitialized (typeOf :: Type a)] ++ c 30 | 31 | majorityVote :: forall a . (Typed a, Eq a) => [Stream a] -> Stream a 32 | majorityVote [] = error "empty list" 33 | majorityVote (x : xs) = aux x 1 xs 34 | where 35 | aux :: Stream a -> Stream Word8 -> [Stream a] -> Stream a 36 | aux p _s [] = p 37 | aux p s (l : ls) = 38 | local (if s == 0 then l else p) $ \p' -> 39 | local (if s == 0 || l == p then s + 1 else s - 1) $ \s' -> 40 | aux p' s' ls 41 | 42 | okWith :: 43 | forall a . (Typed a, Eq a) => 44 | Stream a -> [Stream a] -> Stream a -> Stream Bool 45 | 46 | okWith a l maj = (a /= maj) ==> ((2 * count a l) <= length l) 47 | where 48 | count :: Stream a -> [Stream a] -> Stream Word8 49 | count _e [] = 0 50 | count e (x : xs) = (if x == e then 1 else 0) + count e xs 51 | 52 | spec = do 53 | forM_ (zip [1..] ss) $ \(k :: Int, s) -> 54 | observer ((P.++) "s" (show k)) s 55 | observer "maj" maj 56 | 57 | i1 <- prop "i1" (forAll $ s1 == 1 && s2 == 1 && s3 == 1 && s4 == 1) 58 | theorem "r1" (forAll $ maj == 1) $ assume i1 >> induct 59 | theorem "OK" (forAll $ okWith (arbitraryCst "n") ss maj) induct 60 | 61 | where 62 | s1 = externW8 "s1" (Just $ repeat 1) 63 | s2 = externW8 "s2" (Just $ repeat 3) 64 | s3 = externW8 "s3" (Just $ repeat 1) 65 | s4 = externW8 "s4" (Just $ repeat 1) 66 | s5 = externW8 "s5" (Just $ repeat 2) 67 | s6 = externW8 "s6" (Just $ repeat 2) 68 | s7 = externW8 "s7" (Just $ repeat 1) 69 | ss = [s1, s2, s3, s4, s5, s6, s7] 70 | 71 | maj = majorityVote ss 72 | 73 | induct :: Proof Universal 74 | induct = induction def { nraNLSat = False, debug = False } 75 | 76 | -- | Initial value for a given type. 77 | -- 78 | -- Does not support structs or arrays. 79 | uninitialized :: Type a -> a 80 | uninitialized t = 81 | case t of 82 | Bool -> False 83 | Int8 -> 0 84 | Int16 -> 0 85 | Int32 -> 0 86 | Int64 -> 0 87 | Word8 -> 0 88 | Word16 -> 0 89 | Word32 -> 0 90 | Word64 -> 0 91 | Float -> 0 92 | Double -> 0 93 | -------------------------------------------------------------------------------- /copilot-theorem/examples/Grey.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE RebindableSyntax #-} 2 | 3 | module Grey where 4 | 5 | import Copilot.Language 6 | import Copilot.Theorem 7 | import Copilot.Theorem.Prover.Z3 8 | 9 | import Prelude () 10 | import Data.String (fromString) 11 | 12 | intCounter :: Stream Bool -> Stream Word64 13 | intCounter reset = time 14 | where 15 | time = if reset then 0 16 | else [0] ++ if time == 3 then 0 else time + 1 17 | 18 | greyTick :: Stream Bool -> Stream Bool 19 | greyTick reset = a && b 20 | where 21 | a = (not reset) && ([False] ++ not b) 22 | b = (not reset) && ([False] ++ a) 23 | 24 | spec = do 25 | theorem "iResetOk" (forAll $ r ==> (ic == 0)) induct 26 | theorem "eqCounters" (forAll $ it == gt) $ kinduct 3 27 | 28 | where 29 | ic = intCounter r 30 | it = ic == 2 31 | gt = greyTick r 32 | r = extern "reset" Nothing 33 | 34 | induct :: Proof Universal 35 | induct = induction def { nraNLSat = False, debug = False } 36 | 37 | kinduct :: Word32 -> Proof Universal 38 | kinduct k = kInduction def { nraNLSat = False, startK = k, maxK = k, debug = False } 39 | -------------------------------------------------------------------------------- /copilot-theorem/examples/Incr.hs: -------------------------------------------------------------------------------- 1 | module Incr where 2 | 3 | import Prelude () 4 | import Copilot.Language 5 | 6 | import Copilot.Theorem 7 | import Copilot.Theorem.Prover.Z3 8 | 9 | spec = do 10 | bounds <- prop "bounds" (forAll $ x < 255) 11 | theorem "gt1" (forAll $ x > 1) (assume bounds >> induct) 12 | theorem "neq0" (forAll $ x /= 0) (assume bounds >> induct) 13 | 14 | where 15 | x :: Stream Word8 16 | x = [2] ++ (1 + x) 17 | 18 | induct :: Proof Universal 19 | induct = induction def { nraNLSat = False, debug = True } 20 | -------------------------------------------------------------------------------- /copilot-theorem/examples/SerialBoyerMoore.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE RebindableSyntax #-} 2 | 3 | module SerialBoyerMoore where 4 | 5 | import Copilot.Language 6 | import Copilot.Theorem 7 | import Copilot.Theorem.Prover.Z3 8 | 9 | import Prelude () 10 | import Data.String (fromString) 11 | 12 | conj :: [Stream Bool] -> Stream Bool 13 | conj = foldl (&&) true 14 | 15 | disj :: [Stream Bool] -> Stream Bool 16 | disj = foldl (||) false 17 | 18 | forAllCst :: Typed a => [a] -> (Stream a -> Stream Bool) -> Stream Bool 19 | forAllCst l f = conj $ map (f . constant) l 20 | 21 | existsCst :: Typed a => [a] -> (Stream a -> Stream Bool) -> Stream Bool 22 | existsCst l f = disj $ map (f . constant) l 23 | 24 | allowed :: [Word64] 25 | allowed = [1, 2] 26 | 27 | majority :: Stream Word64 -> (Stream Word64, Stream Word64, Stream Bool) 28 | majority l = (p, s, j) 29 | where 30 | p = [0] ++ if s <= 0 then l else p 31 | s = [0] ++ if (p == l) || (s <= 0) then s + 1 else s - 1 32 | 33 | k = [0] ++ (1 + k) 34 | 35 | count m = cnt 36 | where 37 | cnt = [0] ++ if l == m then cnt + 1 else cnt 38 | 39 | j = forAllCst allowed $ \m -> 40 | local (count m) $ \cnt -> 41 | let j0 = (m /= p) ==> ((s + 2 * cnt) <= k) 42 | j1 = (m == p) ==> ((2 * cnt) <= (s + k)) 43 | in j0 && j1 44 | 45 | spec = do 46 | observer "i" input 47 | observer "p" p 48 | observer "s" s 49 | observer "j" j 50 | 51 | inRange <- prop "inRange" (forAll $ input < 3) 52 | theorem "J" (forAll j) $ assume inRange >> induct 53 | 54 | where 55 | input = externW64 "in" (Just [1, 1, 2, 1, 2, 2, 1, 2, 2, 1, 2, 1]) 56 | (p, s, j) = majority input 57 | 58 | induct :: Proof Universal 59 | induct = induction def { nraNLSat = False, debug = False } 60 | 61 | kinduct :: Word32 -> Proof Universal 62 | kinduct k = kInduction def { nraNLSat = False, startK = k, maxK = k, debug = False } 63 | -------------------------------------------------------------------------------- /copilot-theorem/examples/Trig.hs: -------------------------------------------------------------------------------- 1 | module Trig where 2 | 3 | import Prelude () 4 | 5 | import Copilot.Language 6 | import qualified Copilot.Language.Operators.Propositional as P 7 | import Copilot.Language.Spec 8 | 9 | import Copilot.Theorem 10 | import Copilot.Theorem.Prover.SMT 11 | 12 | import Copilot.Language.Reify 13 | 14 | import Control.Monad (void) 15 | 16 | theorem_ a b c = void $ theorem a b c 17 | 18 | arith :: Proof Universal 19 | arith = onlyValidity def { debug = False } dReal 20 | 21 | arithSat :: Proof Existential 22 | arithSat = onlySat def { debug = False } dReal 23 | 24 | (~=) :: Stream Double -> Stream Double -> Stream Bool 25 | a ~= b = abs (a - b) < 0.001 26 | 27 | spec = do 28 | bounds <- prop "bounds" (forAll $ bounds) 29 | 30 | -- dReal/metit fails this one. 31 | -- theorem "dist_eq" (forAll $ d1 ~= d2) 32 | -- $ assume bounds >> arith 33 | theorem_ "2sin" (forAll $ (2 * (sin x)) <= 3) 34 | $ assume bounds >> arith 35 | theorem_ "sin_cos" (forAll $ ((sin x) ** 2 + (cos x) ** 2) ~= 1) 36 | $ assume bounds >> arith 37 | theorem_ "sin_cos_pi" ( forAll $ ((sin x) ** 2 + (cos $ x + pi) ** 2) ~= 1) 38 | $ assume bounds >> arith 39 | theorem_ "sin_2pi" ( forAll $ (sin x) ~= (sin $ x + 2 * pi)) 40 | $ assume bounds >> arith 41 | theorem_ "cos_2pi" ( forAll $ (cos x) ~= (cos $ x + 2 * pi)) 42 | $ assume bounds >> arith 43 | theorem_ "sin_eq_cos_pi2" ( forAll $ (sin x) ~= (cos $ x - (pi/2))) 44 | $ assume bounds >> arith 45 | theorem_ "x^2_2" ( forAll $ (x ** 2 + 1) >= x) 46 | $ assume bounds >> arith 47 | theorem_ "sqrt_x" ( forAll $ (x > 2) ==> ((sqrt x) < x)) 48 | $ assume bounds >> arith 49 | 50 | theorem_ "x = y" (P.not $ forAll $ x == y) 51 | $ assume bounds >> arithSat 52 | theorem_ "sin_cos_3" (P.not $ forAll $ ((sin x) ** 2 + (cos $ x + 3) ** 2) ~= 1) 53 | $ assume bounds >> arithSat 54 | theorem_ "sin_pi" (P.not $ forAll $ (sin x) ~= (sin $ x + pi)) 55 | $ assume bounds >> arithSat 56 | theorem_ "sin_eq_cos_3" (P.not $ forAll $ (sin x) ~= (cos $ x - (3/2))) 57 | $ assume bounds >> arithSat 58 | theorem_ "sin_eq_cos" (P.not $ forAll $ (sin x) ~= (cos x)) 59 | $ assume bounds >> arithSat 60 | 61 | where 62 | x = externD "x" Nothing 63 | y = externD "y" Nothing 64 | lat1 = externD "lat1" Nothing 65 | lon1 = externD "lon1" Nothing 66 | lat2 = externD "lat2" Nothing 67 | lon2 = externD "lon2" Nothing 68 | 69 | b = 100 70 | bounds = lat1 < b && lat1 > (-b) 71 | && lat2 < b && lat2 > (-b) 72 | && lon1 < b && lon1 > (-b) 73 | && lon2 < b && lon2 > (-b) 74 | && x < b && x > (-b) 75 | && y < b && y > (-b) 76 | 77 | d1 = acos ((sin lat1) * (sin lat2) + (cos lat1) * (cos lat2) * (cos (lon1 - lon2))) 78 | d2 = 2 * asin (sqrt ( 79 | (sin ((lat1 - lat2)/2)) ** 2 + (cos lat1) * (cos lat2) * ((sin ((lon1 - lon2)/2)) ** 2))) 80 | -------------------------------------------------------------------------------- /copilot-theorem/src/Copilot/Theorem.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE Safe #-} 2 | 3 | -- | Highly automated proof techniques are a necessary step for the widespread 4 | -- adoption of formal methods in the software industry. Moreover, it could 5 | -- provide a partial answer to one of its main issue which is scalability. 6 | -- 7 | -- Copilot-theorem is a Copilot library aimed at checking automatically some 8 | -- safety properties on Copilot programs. It includes: 9 | -- 10 | -- * A prover producing native inputs for the Kind2 model checker. 11 | -- 12 | -- * A What4 backend that uses SMT solvers to prove safety properties. 13 | 14 | module Copilot.Theorem 15 | ( module X 16 | , Proof 17 | , PropId, PropRef 18 | , Universal, Existential 19 | ) where 20 | 21 | import Copilot.Theorem.Tactics as X 22 | import Copilot.Theorem.Prove 23 | -------------------------------------------------------------------------------- /copilot-theorem/src/Copilot/Theorem/IL.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE Safe #-} 2 | 3 | -- | Each prover first translates the Copilot specification into an 4 | -- intermediate representation best suited for model checking. 5 | -- 6 | -- This module and the ones in the same namespace implement the IL format. A 7 | -- Copilot program is translated into a list of quantifier-free equations over 8 | -- integer sequences, implicitly universally quantified by a free variable n. 9 | -- Each sequence roughly corresponds to a stream. 10 | 11 | module Copilot.Theorem.IL (module X) where 12 | 13 | import Copilot.Theorem.IL.Spec as X 14 | import Copilot.Theorem.IL.Translate as X 15 | import Copilot.Theorem.IL.Transform as X 16 | import Copilot.Theorem.IL.PrettyPrint as X 17 | -------------------------------------------------------------------------------- /copilot-theorem/src/Copilot/Theorem/IL/PrettyPrint.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE GADTs #-} 2 | {-# LANGUAGE NamedFieldPuns #-} 3 | {-# LANGUAGE Safe #-} 4 | 5 | -- | This module implements a pretty printer for the IL format, an intermediate 6 | -- representation used in copilot-theorem to facilitate model checking. 7 | module Copilot.Theorem.IL.PrettyPrint (prettyPrint, printConstraint) where 8 | 9 | import Copilot.Theorem.IL.Spec 10 | import Text.PrettyPrint.HughesPJ 11 | import qualified Data.Map as Map 12 | 13 | import Prelude hiding ((<>)) 14 | 15 | -- | Pretty print an IL specification. 16 | prettyPrint :: IL -> String 17 | prettyPrint = render . ppSpec 18 | 19 | -- | Pretty print an IL constraint expression. 20 | printConstraint :: Expr -> String 21 | printConstraint = render . ppExpr 22 | 23 | indent = nest 4 24 | emptyLine = text "" 25 | 26 | ppSpec :: IL -> Doc 27 | ppSpec (IL { modelInit, modelRec, properties }) = 28 | text "MODEL INIT" 29 | $$ indent (foldr (($$) . ppExpr) empty modelInit) $$ emptyLine 30 | $$ text "MODEL REC" 31 | $$ indent (foldr (($$) . ppExpr) empty modelRec) $$ emptyLine 32 | $$ text "PROPERTIES" 33 | $$ indent (Map.foldrWithKey (\k -> ($$) . ppProp k) 34 | empty properties ) 35 | 36 | ppProp :: PropId -> ([Expr], Expr) -> Doc 37 | ppProp id (as, c) = (foldr (($$) . ppExpr) empty as) 38 | $$ quotes (text id) <+> colon <+> ppExpr c 39 | 40 | ppSeqDescr :: SeqDescr -> Doc 41 | ppSeqDescr (SeqDescr id ty) = text id <+> colon <+> ppType ty 42 | 43 | ppVarDescr :: VarDescr -> Doc 44 | ppVarDescr (VarDescr id ret args) = 45 | text id 46 | <+> colon 47 | <+> (hsep . punctuate (space <> text "->" <> space) $ map ppType args) 48 | <+> text "->" 49 | <+> ppType ret 50 | 51 | ppType :: Type -> Doc 52 | ppType = text . show 53 | 54 | ppExpr :: Expr -> Doc 55 | ppExpr (ConstB v) = text . show $ v 56 | ppExpr (ConstR v) = text . show $ v 57 | ppExpr (ConstI _ v) = text . show $ v 58 | 59 | ppExpr (Ite _ c e1 e2) = 60 | text "if" <+> ppExpr c 61 | <+> text "then" <+> ppExpr e1 62 | <+> text "else" <+> ppExpr e2 63 | 64 | ppExpr (Op1 _ op e) = ppOp1 op <+> ppExpr e 65 | 66 | ppExpr (Op2 _ op e1 e2) = 67 | ppExpr e1 <+> ppOp2 op <+> ppExpr e2 68 | 69 | ppExpr (SVal _ s i) = text s <> brackets (ppSeqIndex i) 70 | 71 | ppExpr (FunApp _ name args) = 72 | text name <> parens (hsep . punctuate (comma <> space) $ map ppExpr args) 73 | 74 | ppSeqIndex :: SeqIndex -> Doc 75 | ppSeqIndex (Var i) 76 | | i == 0 = text "n" 77 | | i < 0 = text "n" <+> text "-" <+> integer (-i) 78 | | otherwise = text "n" <+> text "+" <+> integer i 79 | 80 | ppSeqIndex (Fixed i) = integer i 81 | 82 | ppOp1 :: Op1 -> Doc 83 | ppOp1 = text . show 84 | 85 | ppOp2 :: Op2 -> Doc 86 | ppOp2 = text . show 87 | -------------------------------------------------------------------------------- /copilot-theorem/src/Copilot/Theorem/IL/Transform.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE LambdaCase #-} 2 | {-# LANGUAGE Safe #-} 3 | 4 | -- | Simplify IL expressions by partly evaluating operations on booleans. 5 | module Copilot.Theorem.IL.Transform ( bsimpl ) where 6 | 7 | import Copilot.Theorem.IL.Spec 8 | 9 | -- | Simplify IL expressions by partly evaluating operations on booleans, 10 | -- eliminating some boolean literals. 11 | -- 12 | -- For example, an if-then-else in which the condition is literally the 13 | -- constant True or the constant False can be reduced to an operation without 14 | -- choice in which the appropriate branch of the if-then-else is used instead. 15 | bsimpl :: Expr -> Expr 16 | bsimpl = until (\x -> bsimpl' x == x) bsimpl' 17 | where 18 | bsimpl' = \case 19 | Ite _ (ConstB True) e _ -> bsimpl' e 20 | Ite _ (ConstB False) _ e -> bsimpl' e 21 | Ite t c e1 e2 -> Ite t (bsimpl' c) (bsimpl' e1) (bsimpl' e2) 22 | 23 | Op1 _ Not (Op1 _ Not e) -> bsimpl' e 24 | Op1 _ Not (ConstB True) -> ConstB False 25 | Op1 _ Not (ConstB False) -> ConstB True 26 | Op1 t o e -> Op1 t o (bsimpl' e) 27 | 28 | Op2 _ Or e (ConstB False) -> bsimpl' e 29 | Op2 _ Or (ConstB False) e -> bsimpl' e 30 | Op2 _ Or _ (ConstB True) -> ConstB True 31 | Op2 _ Or (ConstB True) _ -> ConstB True 32 | 33 | Op2 _ And _ (ConstB False) -> ConstB False 34 | Op2 _ And (ConstB False) _ -> ConstB False 35 | Op2 _ And e (ConstB True) -> bsimpl' e 36 | Op2 _ And (ConstB True) e -> bsimpl' e 37 | 38 | Op2 _ Eq e (ConstB False) -> bsimpl' (Op1 Bool Not e) 39 | Op2 _ Eq (ConstB False) e -> bsimpl' (Op1 Bool Not e) 40 | Op2 _ Eq e (ConstB True) -> bsimpl' e 41 | Op2 _ Eq (ConstB True) e -> bsimpl' e 42 | 43 | Op2 t o e1 e2 -> Op2 t o (bsimpl' e1) (bsimpl' e2) 44 | 45 | FunApp t f args -> FunApp t f (map bsimpl' args) 46 | 47 | e -> e 48 | -------------------------------------------------------------------------------- /copilot-theorem/src/Copilot/Theorem/Kind2.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE Safe #-} 2 | 3 | -- | Copilot backend for the SMT 4 | -- based model checker. 5 | 6 | module Copilot.Theorem.Kind2 (module X) where 7 | 8 | import Copilot.Theorem.Kind2.AST as X 9 | import Copilot.Theorem.Kind2.Translate as X 10 | import Copilot.Theorem.Kind2.PrettyPrint as X 11 | import Copilot.Theorem.Kind2.Prover as X 12 | -------------------------------------------------------------------------------- /copilot-theorem/src/Copilot/Theorem/Kind2/AST.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE Safe #-} 2 | 3 | -- | Abstract syntax tree of Kind2 files. 4 | module Copilot.Theorem.Kind2.AST where 5 | 6 | -- | A file is a sequence of predicates and propositions. 7 | data File = File 8 | { filePreds :: [PredDef] 9 | , fileProps :: [Prop] } 10 | 11 | -- | A proposition is defined by a term. 12 | data Prop = Prop 13 | { propName :: String 14 | , propTerm :: Term } 15 | 16 | -- | A predicate definition. 17 | data PredDef = PredDef 18 | { predId :: String -- ^ Identifier for the predicate. 19 | , predStateVars :: [StateVarDef] -- ^ Variables identifying the states in the 20 | -- underlying state transition system. 21 | , predInit :: Term -- ^ Predicate that holds for initial 22 | -- states. 23 | , predTrans :: Term -- ^ Predicate that holds for two states, if 24 | -- there is state transition between them. 25 | } 26 | 27 | -- | A definition of a state variable. 28 | data StateVarDef = StateVarDef 29 | { varId :: String -- ^ Name of the variable. 30 | , varType :: Type -- ^ Type of the variable. 31 | , varFlags :: [StateVarFlag] } -- ^ Flags for the variable. 32 | 33 | -- | Types used in Kind2 files to represent Copilot types. 34 | -- 35 | -- The Kind2 backend provides functions to, additionally, constrain the range 36 | -- of numeric values depending on their Copilot type ('Int8', 'Int16', etc.). 37 | data Type = Int | Real | Bool 38 | 39 | -- | Possible flags for a state variable. 40 | data StateVarFlag = FConst 41 | 42 | -- | Type of the predicate, either belonging to an initial state or a pair of 43 | -- states with a transition. 44 | data PredType = Init | Trans 45 | 46 | -- | Datatype to describe a term in the Kind language. 47 | data Term = 48 | ValueLiteral String 49 | | PrimedStateVar String 50 | | StateVar String 51 | | FunApp String [Term] 52 | | PredApp String PredType [Term] 53 | -------------------------------------------------------------------------------- /copilot-theorem/src/Copilot/Theorem/Kind2/Output.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE RankNTypes #-} 2 | {-# LANGUAGE Safe #-} 3 | 4 | -- | Parse output of Kind2. 5 | module Copilot.Theorem.Kind2.Output (parseOutput) where 6 | 7 | import Text.XML.Light hiding (findChild) 8 | import Copilot.Theorem.Prove as P 9 | import Data.Maybe (fromJust) 10 | 11 | import qualified Copilot.Core as C 12 | 13 | import qualified Copilot.Theorem.Misc.Error as Err 14 | 15 | simpleName s = QName s Nothing Nothing 16 | 17 | -- | Parse output of Kind2. 18 | parseOutput :: String -- ^ Property whose validity is being checked. 19 | -> C.Prop -- ^ The property's quantifier. 20 | -> String -- ^ XML output of Kind2 21 | -> P.Output 22 | parseOutput propId propQuantifier xml = fromJust $ do 23 | root <- parseXMLDoc xml 24 | case findAnswer . findPropTag $ root of 25 | "valid" -> case propQuantifier of 26 | -- We encode a universally quantified property P as 27 | -- ∀x.P(x) in Kind2, so the original property is valid 28 | -- iff the Kind2 property is valid. 29 | C.Forall {} -> return (Output Valid []) 30 | -- We encode an existentially quantified property P as 31 | -- ¬(∀x.¬(P(x))) in Kind2, so the original property is 32 | -- invalid iff the Kind2 property is valid. 33 | C.Exists {} -> return (Output Invalid []) 34 | "falsifiable" -> case propQuantifier of 35 | -- We encode a universally quantified property P as 36 | -- ∀x.P(x) in Kind2, so the original property is invalid 37 | -- iff the Kind2 property is invalid. 38 | C.Forall {} -> return (Output Invalid []) 39 | -- We encode an existentially quantified property P as 40 | -- ¬(∀x.¬(P(x))) in Kind2, so the original property is 41 | -- valid iff the Kind2 property is invalid. 42 | C.Exists {} -> return (Output Valid []) 43 | s -> err $ "Unrecognized status : " ++ s 44 | 45 | where 46 | 47 | searchForRuntimeError = undefined 48 | 49 | findPropTag root = 50 | let rightElement elt = 51 | qName (elName elt) == "Property" 52 | && lookupAttr (simpleName "name") (elAttribs elt) 53 | == Just propId 54 | in case filterChildren rightElement root of 55 | tag : _ -> tag 56 | _ -> err $ "Tag for property " ++ propId ++ " not found" 57 | 58 | findAnswer tag = 59 | case findChildren (simpleName "Answer") tag of 60 | answTag : _ -> 61 | case onlyText (elContent answTag) of 62 | answ : _ -> cdData answ 63 | _ -> err "Invalid 'Answer' attribute" 64 | _ -> err "Attribute 'Answer' not found" 65 | 66 | err :: forall a . String -> a 67 | err msg = Err.fatal $ 68 | "Parse error while reading the Kind2 XML output : \n" 69 | ++ msg ++ "\n\n" ++ xml 70 | -------------------------------------------------------------------------------- /copilot-theorem/src/Copilot/Theorem/Kind2/PrettyPrint.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE Safe #-} 2 | 3 | -- | Pretty print a Kind2 file defining predicates and propositions. 4 | module Copilot.Theorem.Kind2.PrettyPrint ( prettyPrint ) where 5 | 6 | import Copilot.Theorem.Misc.SExpr 7 | import qualified Copilot.Theorem.Misc.SExpr as SExpr 8 | import Copilot.Theorem.Kind2.AST 9 | 10 | import Data.List (intercalate) 11 | 12 | -- | A tree of expressions, in which the leafs are strings. 13 | type SSExpr = SExpr String 14 | 15 | -- | Reserved keyword prime. 16 | kwPrime = "prime" 17 | 18 | -- | Pretty print a Kind2 file. 19 | prettyPrint :: File -> String 20 | prettyPrint = 21 | intercalate "\n\n" 22 | . map (SExpr.toString shouldIndent id) 23 | . ppFile 24 | 25 | -- | Define the indentation policy of the S-Expressions 26 | shouldIndent :: SSExpr -> Bool 27 | shouldIndent (Atom _) = False 28 | shouldIndent (List [Atom a, Atom _]) = a `notElem` [kwPrime] 29 | shouldIndent _ = True 30 | 31 | -- | Convert a file into a sequence of expressions. 32 | ppFile :: File -> [SSExpr] 33 | ppFile (File preds props) = map ppPredDef preds ++ ppProps props 34 | 35 | -- | Convert a sequence of propositions into command to check each of them. 36 | ppProps :: [Prop] -> [SSExpr] 37 | ppProps ps = [ node "check-prop" [ list $ map ppProp ps ] ] 38 | 39 | -- | Convert a proposition into an expression. 40 | ppProp :: Prop -> SSExpr 41 | ppProp (Prop n t) = list [atom n, ppTerm t] 42 | 43 | -- | Convert a predicate into an expression. 44 | ppPredDef :: PredDef -> SSExpr 45 | ppPredDef pd = 46 | list [ atom "define-pred" 47 | , atom (predId pd) 48 | , list . map ppStateVarDef . predStateVars $ pd 49 | , node "init" [ppTerm $ predInit pd] 50 | , node "trans" [ppTerm $ predTrans pd] ] 51 | 52 | -- | Convert a state variable definition into an expression. 53 | ppStateVarDef :: StateVarDef -> SSExpr 54 | ppStateVarDef svd = 55 | list [atom (varId svd), ppType (varType svd)] 56 | 57 | -- | Convert a type into an expression. 58 | ppType :: Type -> SSExpr 59 | ppType Int = atom "Int" 60 | ppType Real = atom "Real" 61 | ppType Bool = atom "Bool" 62 | 63 | -- | Convert a term into an expression. 64 | ppTerm :: Term -> SSExpr 65 | ppTerm (ValueLiteral c) = atom c 66 | ppTerm (PrimedStateVar v) = list [atom kwPrime, atom v] 67 | ppTerm (StateVar v) = atom v 68 | ppTerm (FunApp f args) = node f $ map ppTerm args 69 | ppTerm (PredApp p t args) = node (p ++ "." ++ ext) $ map ppTerm args 70 | where 71 | ext = case t of 72 | Init -> "init" 73 | Trans -> "trans" 74 | -------------------------------------------------------------------------------- /copilot-theorem/src/Copilot/Theorem/Kind2/Prover.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE LambdaCase #-} 2 | {-# LANGUAGE Trustworthy #-} 3 | 4 | -- | A prover backend based on Kind2. 5 | module Copilot.Theorem.Kind2.Prover 6 | ( module Data.Default 7 | , Options (..) 8 | , kind2Prover 9 | ) where 10 | 11 | import Copilot.Theorem.Prove 12 | import Copilot.Theorem.Kind2.Output 13 | import Copilot.Theorem.Kind2.PrettyPrint 14 | import Copilot.Theorem.Kind2.Translate 15 | 16 | -- It seems [IO.openTempFile] doesn't work on Mac OSX 17 | import System.IO hiding (openTempFile) 18 | import Copilot.Theorem.Misc.Utils (openTempFile) 19 | 20 | import System.Process 21 | 22 | import System.Directory 23 | import Data.Default 24 | import qualified Data.Map as Map 25 | 26 | import qualified Copilot.Theorem.Misc.Error as Err 27 | import qualified Copilot.Theorem.TransSys as TS 28 | 29 | -- | Options for Kind2 30 | data Options = Options 31 | { bmcMax :: Int -- ^ Upper bound on the number of unrolling that base and 32 | -- step will perform. A value of 0 means /unlimited/. 33 | } 34 | 35 | -- | Default options with unlimited unrolling for base and step. 36 | instance Default Options where 37 | def = Options { bmcMax = 0 } 38 | 39 | data ProverST = ProverST 40 | { options :: Options 41 | , transSys :: TS.TransSys } 42 | 43 | -- | A prover backend based on Kind2. 44 | -- 45 | -- The executable @kind2@ must exist and its location be in the @PATH@. 46 | kind2Prover :: Options -> Prover 47 | kind2Prover opts = Prover 48 | { proverName = "Kind2" 49 | , startProver = return . ProverST opts . TS.translate 50 | , askProver = askKind2 51 | , closeProver = const $ return () } 52 | 53 | kind2Prog = "kind2" 54 | kind2BaseOptions = ["--input-format", "native", "-xml"] 55 | 56 | askKind2 :: ProverST -> [PropId] -> [PropId] -> IO Output 57 | askKind2 (ProverST opts spec) assumptions toCheck = do 58 | 59 | let kind2Input = prettyPrint . toKind2 Inlined assumptions toCheck $ spec 60 | 61 | (tempName, tempHandle) <- openTempFile "." "out" "kind" 62 | hPutStr tempHandle kind2Input 63 | hClose tempHandle 64 | 65 | let kind2Options = 66 | kind2BaseOptions ++ ["--bmc_max", show $ bmcMax opts, tempName] 67 | 68 | (_, output, _) <- readProcessWithExitCode kind2Prog kind2Options "" 69 | 70 | putStrLn kind2Input 71 | 72 | removeFile tempName 73 | 74 | let propId = head toCheck 75 | propQuantifier = case Map.lookup propId (TS.specProps spec) of 76 | Just (_, quantifier) -> 77 | quantifier 78 | Nothing -> 79 | Err.impossible $ 80 | "askKind2: " ++ propId ++ " not in specProps" 81 | return $ parseOutput propId propQuantifier output 82 | -------------------------------------------------------------------------------- /copilot-theorem/src/Copilot/Theorem/Misc/Error.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE Safe #-} 2 | 3 | -- | Custom functions to report error messages to users. 4 | module Copilot.Theorem.Misc.Error 5 | ( badUse 6 | , impossible 7 | , impossible_ 8 | , fatal 9 | ) where 10 | 11 | -- | Tag used with error messages to help users locate the component that 12 | -- failed or reports the error. 13 | errorHeader :: String 14 | errorHeader = "[Copilot-kind ERROR] " 15 | 16 | -- | Report an error due to an error detected by Copilot (e.g., user error). 17 | badUse :: String -- ^ Description of the error. 18 | -> a 19 | badUse s = error $ errorHeader ++ s 20 | 21 | -- | Report an error due to a bug in Copilot. 22 | impossible :: String -- ^ Error information to attach to the message. 23 | -> a 24 | impossible s = error $ errorHeader ++ "Unexpected internal error : " ++ s 25 | 26 | -- | Report an error due to a bug in Copilot. 27 | impossible_ :: a 28 | impossible_ = error $ errorHeader ++ "Unexpected internal error" 29 | 30 | -- | Report an unrecoverable error (e.g., incorrect format). 31 | fatal :: String -> a 32 | fatal = error 33 | -------------------------------------------------------------------------------- /copilot-theorem/src/Copilot/Theorem/Misc/SExpr.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleInstances #-} 2 | {-# LANGUAGE Safe #-} 3 | 4 | -- | A representation for structured expression trees, with support for pretty 5 | -- printing and for parsing. 6 | module Copilot.Theorem.Misc.SExpr where 7 | 8 | import Text.ParserCombinators.Parsec 9 | import Text.PrettyPrint.HughesPJ as PP hiding (char, Str) 10 | 11 | import Control.Monad 12 | 13 | -- | A structured expression is either an atom, or a sequence of expressions, 14 | -- where the first in the sequence denotes the tag or label of the tree. 15 | data SExpr a = Atom a 16 | | List [SExpr a] 17 | 18 | -- | Empty string expression. 19 | blank = Atom "" 20 | 21 | -- | Atomic expression constructor. 22 | atom = Atom -- s 23 | 24 | -- | Empty expression (empty list). 25 | unit = List [] -- () 26 | 27 | -- | Single expression. 28 | singleton a = List [Atom a] -- (s) 29 | 30 | -- | Sequence of expressions. 31 | list = List -- (ss) 32 | 33 | -- | Sequence of expressions with a root or main note, and a series of 34 | -- additional expressions or arguments. 35 | node a l = List (Atom a : l) -- (s ss) 36 | 37 | -- A straightforward string representation for 'SExpr's of Strings that 38 | -- parenthesizes lists of expressions. 39 | instance Show (SExpr String) where 40 | show = PP.render . show' 41 | where 42 | show' (Atom s) = text s 43 | show' (List ts) = parens . hsep . map show' $ ts 44 | 45 | -- More advanced printing with some basic indentation 46 | 47 | -- | Indent by a given number. 48 | indent = nest 1 49 | 50 | -- | Pretty print a structured expression as a String. 51 | toString :: (SExpr a -> Bool) -- ^ True if an expression should be indented. 52 | -> (a -> String) -- ^ Pretty print the value inside as 'SExpr'. 53 | -> SExpr a -- ^ Root of 'SExpr' tree. 54 | -> String 55 | toString shouldIndent printAtom expr = 56 | PP.render (toDoc shouldIndent printAtom expr) 57 | 58 | -- | Pretty print a structured expression as a 'Doc', or set of layouts. 59 | toDoc :: (SExpr a -> Bool) -- ^ True if an expression should be indented. 60 | -> (a -> String) -- ^ Pretty print the value inside as 'SExpr'. 61 | -> SExpr a -- ^ Root of 'SExpr' tree. 62 | -> Doc 63 | toDoc shouldIndent printAtom expr = case expr of 64 | Atom a -> text (printAtom a) 65 | List l -> parens (foldl renderItem empty l) 66 | 67 | where 68 | renderItem doc s 69 | | shouldIndent s = 70 | doc $$ indent (toDoc shouldIndent printAtom s) 71 | | otherwise = 72 | doc <+> toDoc shouldIndent printAtom s 73 | 74 | -- | Parser for strings of characters separated by spaces into a structured 75 | -- tree. 76 | -- 77 | -- Parentheses are interpreted as grouping elements, that is, defining a 78 | -- 'List', which may be empty. 79 | parser :: GenParser Char st (SExpr String) 80 | parser = 81 | choice [try unitP, nodeP, leafP] 82 | 83 | where 84 | symbol = oneOf "!#$%&|*+-/:<=>?@^_~." 85 | lonelyStr = many1 (alphaNum <|> symbol) 86 | 87 | unitP = string "()" >> return unit 88 | 89 | leafP = atom <$> lonelyStr 90 | 91 | nodeP = do void $ char '(' 92 | spaces 93 | st <- sepBy parser spaces 94 | spaces 95 | void $ char ')' 96 | return $ List st 97 | 98 | -- | Parser for strings of characters separated by spaces into a structured 99 | -- tree. 100 | -- 101 | -- Parentheses are interpreted as grouping elements, that is, defining a 102 | -- 'List', which may be empty. 103 | parseSExpr :: String -> Maybe (SExpr String) 104 | parseSExpr str = case parse parser "" str of 105 | Left s -> error (show s) -- Nothing 106 | Right t -> Just t 107 | -------------------------------------------------------------------------------- /copilot-theorem/src/Copilot/Theorem/Misc/Utils.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE Trustworthy #-} 2 | 3 | -- | Utility / auxiliary functions. 4 | module Copilot.Theorem.Misc.Utils 5 | ( isSublistOf, nub', nubBy', nubEq 6 | , openTempFile 7 | ) where 8 | 9 | import Data.Function (on) 10 | import Data.List (groupBy, sortBy, group, sort) 11 | 12 | import Control.Applicative ((<$>)) 13 | import Control.Monad 14 | 15 | import qualified Data.Set as Set 16 | 17 | import System.IO hiding (openTempFile) 18 | import System.Random 19 | import System.Directory 20 | 21 | -- | True if the given list is a subset of the second list, when both are 22 | -- considered as sets. 23 | isSublistOf :: Ord a => [a] -> [a] -> Bool 24 | isSublistOf = Set.isSubsetOf `on` Set.fromList 25 | 26 | -- | True if both lists contain the same elements, when both are considered as 27 | -- sets. 28 | nubEq :: Ord a => [a] -> [a] -> Bool 29 | nubEq = (==) `on` Set.fromList 30 | 31 | -- | Remove duplicates from a list. 32 | -- 33 | -- This is an efficient version of 'Data.List.nub' that works for lists with a 34 | -- stronger constraint on the type (i.e., 'Ord', as opposed of 35 | -- 'Data.List.nub''s 'Eq' constraint). 36 | nub' :: Ord a => [a] -> [a] 37 | nub' = map head . group . sort 38 | 39 | -- | Variant of 'nub'' parameterized by the comparison function. 40 | nubBy' :: (a -> a -> Ordering) -> [a] -> [a] 41 | nubBy' f = map head . groupBy (\x y -> f x y == EQ) . sortBy f 42 | 43 | -- | Create a temporary file and open it for writing. 44 | openTempFile :: String -- ^ Directory where the file should be created. 45 | -> String -- ^ Base name for the file (prefix). 46 | -> String -- ^ File extension. 47 | -> IO (String, Handle) 48 | openTempFile loc baseName extension = do 49 | 50 | path <- freshPath 51 | handle <- openFile path WriteMode 52 | return (path, handle) 53 | 54 | where 55 | 56 | freshPath :: IO FilePath 57 | freshPath = do 58 | path <- pathFromSuff <$> randSuff 59 | exists <- doesFileExist path 60 | if exists then freshPath else return path 61 | 62 | randSuff :: IO String 63 | randSuff = replicateM 4 $ randomRIO ('0', '9') 64 | 65 | pathFromSuff :: String -> FilePath 66 | pathFromSuff suf = loc ++ "/" ++ baseName ++ suf ++ "." ++ extension 67 | -------------------------------------------------------------------------------- /copilot-theorem/src/Copilot/Theorem/Prover/Backend.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE RankNTypes #-} 2 | {-# LANGUAGE Safe #-} 3 | 4 | -- | Backend to SMT solvers and theorem provers. 5 | -- 6 | -- This module provides three definitions: 7 | -- 8 | -- - A class ('SmtFormat') abstracting over the language used to communicate the 9 | -- desired commands to an SMT solver or theorem prover. 10 | -- 11 | -- - A class ('Backend') abstracting over the backend, which includes the name of 12 | -- the executable, any options and flags necessary, and functions to parse the 13 | -- results and close the communication. 14 | -- 15 | -- - A type ('SatResult') representing a satisfiability result communicated by 16 | -- the SMT solver or theorem prover. 17 | module Copilot.Theorem.Prover.Backend (SmtFormat(..), Backend(..), SatResult(..)) where 18 | 19 | import Copilot.Theorem.IL 20 | 21 | import System.IO 22 | 23 | -- | Format of SMT-Lib commands. 24 | class Show a => SmtFormat a where 25 | push :: a 26 | pop :: a 27 | checkSat :: a 28 | setLogic :: String -> a 29 | declFun :: String -> Type -> [Type] -> a 30 | assert :: Expr -> a 31 | 32 | -- | Backend to an SMT solver or theorem prover. 33 | data Backend a = Backend 34 | { name :: String 35 | , cmd :: String 36 | , cmdOpts :: [String] 37 | , inputTerminator :: Handle -> IO () 38 | , incremental :: Bool 39 | , logic :: String 40 | , interpret :: String -> Maybe SatResult 41 | } 42 | 43 | -- | Satisfiability result communicated by the SMT solver or theorem prover. 44 | data SatResult = Sat | Unsat | Unknown 45 | -------------------------------------------------------------------------------- /copilot-theorem/src/Copilot/Theorem/Prover/SMTLib.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleInstances #-} 2 | {-# LANGUAGE GADTs #-} 3 | {-# LANGUAGE Safe #-} 4 | 5 | -- | A backend to the SMT-Lib format, enabling to produce commands for SMT-Lib 6 | -- implementing solvers, and parse results. 7 | module Copilot.Theorem.Prover.SMTLib (SmtLib, interpret) where 8 | 9 | import Copilot.Theorem.Prover.Backend (SmtFormat (..), SatResult (..)) 10 | 11 | import Copilot.Theorem.IL 12 | import Copilot.Theorem.Misc.SExpr 13 | 14 | import Text.Printf 15 | 16 | -- | Type used to represent SMT-lib commands. 17 | -- 18 | -- Use the interface in 'SmtFormat' to create such commands. 19 | newtype SmtLib = SmtLib (SExpr String) 20 | 21 | instance Show SmtLib where 22 | show (SmtLib s) = show s 23 | 24 | smtTy :: Type -> String 25 | smtTy Bool = "Bool" 26 | smtTy Real = "Real" 27 | smtTy _ = "Int" 28 | 29 | -- | Interface for SMT-Lib conforming backends. 30 | instance SmtFormat SmtLib where 31 | push = SmtLib $ node "push" [atom "1"] 32 | pop = SmtLib $ node "pop" [atom "1"] 33 | checkSat = SmtLib $ singleton "check-sat" 34 | setLogic "" = SmtLib $ blank 35 | setLogic l = SmtLib $ node "set-logic" [atom l] 36 | declFun name retTy args = SmtLib $ 37 | node "declare-fun" [atom name, (list $ map (atom . smtTy) args), atom (smtTy retTy)] 38 | assert c = SmtLib $ node "assert" [expr c] 39 | 40 | -- | Parse a satisfiability result. 41 | interpret :: String -> Maybe SatResult 42 | interpret "sat" = Just Sat 43 | interpret "unsat" = Just Unsat 44 | interpret _ = Just Unknown 45 | 46 | expr :: Expr -> SExpr String 47 | 48 | expr (ConstB v) = atom $ if v then "true" else "false" 49 | expr (ConstI _ v) = atom $ show v 50 | expr (ConstR v) = atom $ printf "%f" v 51 | 52 | expr (Ite _ cond e1 e2) = node "ite" [expr cond, expr e1, expr e2] 53 | 54 | expr (FunApp _ funName args) = node funName $ map expr args 55 | 56 | expr (Op1 _ op e) = 57 | node smtOp [expr e] 58 | where 59 | smtOp = case op of 60 | Not -> "not" 61 | Neg -> "-" 62 | Abs -> "abs" 63 | Exp -> "exp" 64 | Sqrt -> "sqrt" 65 | Log -> "log" 66 | Sin -> "sin" 67 | Tan -> "tan" 68 | Cos -> "cos" 69 | Asin -> "asin" 70 | Atan -> "atan" 71 | Acos -> "acos" 72 | Sinh -> "sinh" 73 | Tanh -> "tanh" 74 | Cosh -> "cosh" 75 | Asinh -> "asinh" 76 | Atanh -> "atanh" 77 | Acosh -> "acosh" 78 | 79 | expr (Op2 _ op e1 e2) = 80 | node smtOp [expr e1, expr e2] 81 | where 82 | smtOp = case op of 83 | Eq -> "=" 84 | Le -> "<=" 85 | Lt -> "<" 86 | Ge -> ">=" 87 | Gt -> ">" 88 | And -> "and" 89 | Or -> "or" 90 | Add -> "+" 91 | Sub -> "-" 92 | Mul -> "*" 93 | Mod -> "mod" 94 | Fdiv -> "/" 95 | Pow -> "^" 96 | 97 | expr (SVal _ f ix) = atom $ case ix of 98 | Fixed i -> f ++ "_" ++ show i 99 | Var off -> f ++ "_n" ++ show off 100 | -------------------------------------------------------------------------------- /copilot-theorem/src/Copilot/Theorem/Prover/TPTP.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE GADTs #-} 2 | {-# LANGUAGE LambdaCase #-} 3 | {-# LANGUAGE Safe #-} 4 | 5 | -- | A backend to , enabling to produce assertions 6 | -- and to parse the results from TPTP. 7 | module Copilot.Theorem.Prover.TPTP (Tptp, interpret) where 8 | 9 | import Copilot.Theorem.Prover.Backend (SmtFormat (..), SatResult (..)) 10 | import Copilot.Theorem.IL 11 | 12 | import Data.List 13 | 14 | -- | Type used to represent TPTP expressions. 15 | -- 16 | -- Although this type implements the 'SmtFormat' interface, only 'assert' is 17 | -- actually used. 18 | data Tptp = Ax TptpExpr | Null 19 | 20 | data TptpExpr = Bin TptpExpr String TptpExpr | Un String TptpExpr 21 | | Atom String | Fun String [TptpExpr] 22 | 23 | instance Show Tptp where 24 | show (Ax e) = "fof(formula, axiom, " ++ show e ++ ")." 25 | show Null = "" 26 | 27 | instance Show TptpExpr where 28 | show (Bin e1 op e2) = "(" ++ show e1 ++ " " ++ op ++ " " ++ show e2 ++ ")" 29 | show (Un op e) = "(" ++ op ++ " " ++ show e ++ ")" 30 | show (Atom atom) = atom 31 | show (Fun name args) = name ++ "(" ++ intercalate ", " (map show args) ++ ")" 32 | 33 | instance SmtFormat Tptp where 34 | push = Null 35 | pop = Null 36 | checkSat = Null 37 | setLogic = const Null 38 | declFun = const $ const $ const Null 39 | assert c = Ax $ expr c 40 | 41 | -- | Parse a satisfiability result. 42 | interpret :: String -> Maybe SatResult 43 | interpret str 44 | | "SZS status Unsatisfiable" `isPrefixOf` str = Just Unsat 45 | | "SZS status" `isPrefixOf` str = Just Unknown 46 | | otherwise = Nothing 47 | 48 | expr :: Expr -> TptpExpr 49 | expr = \case 50 | ConstB v -> Atom $ if v then "$true" else "$false" 51 | ConstR v -> Atom $ show v 52 | ConstI _ v -> Atom $ show v 53 | 54 | Ite _ c e1 e2 -> Bin (Bin (expr c) "=>" (expr e1)) 55 | "&" (Bin (Un "~" (expr c)) "=>" (expr e2)) 56 | 57 | FunApp _ f args -> Fun f $ map expr args 58 | 59 | Op1 _ Not e -> Un (showOp1 Not) $ expr e 60 | Op1 _ Neg e -> Un (showOp1 Neg) $ expr e 61 | Op1 _ op e -> Fun (showOp1 op) [expr e] 62 | 63 | Op2 _ op e1 e2 -> Bin (expr e1) (showOp2 op) (expr e2) 64 | 65 | SVal _ f ix -> case ix of 66 | Fixed i -> Atom $ f ++ "_" ++ show i 67 | Var off -> Atom $ f ++ "_n" ++ show off 68 | 69 | showOp1 :: Op1 -> String 70 | showOp1 = \case 71 | Not -> "~" 72 | Neg -> "-" 73 | Abs -> "abs" 74 | Exp -> "exp" 75 | Sqrt -> "sqrt" 76 | Log -> "log" 77 | Sin -> "sin" 78 | Tan -> "tan" 79 | Cos -> "cos" 80 | Asin -> "arcsin" 81 | Atan -> "arctan" 82 | Acos -> "arccos" 83 | Sinh -> "sinh" 84 | Tanh -> "tanh" 85 | Cosh -> "cosh" 86 | Asinh -> "arcsinh" 87 | Atanh -> "arctanh" 88 | Acosh -> "arccosh" 89 | 90 | showOp2 :: Op2 -> String 91 | showOp2 = \case 92 | Eq -> "=" 93 | Le -> "<=" 94 | Lt -> "<" 95 | Ge -> ">=" 96 | Gt -> ">" 97 | And -> "&" 98 | Or -> "|" 99 | Add -> "+" 100 | Sub -> "-" 101 | Mul -> "*" 102 | Mod -> "mod" 103 | Fdiv -> "/" 104 | Pow -> "^" 105 | -------------------------------------------------------------------------------- /copilot-theorem/src/Copilot/Theorem/Tactics.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE Safe #-} 2 | 3 | -- | Utility functions to help write proof tactics. 4 | 5 | module Copilot.Theorem.Tactics 6 | ( instantiate, assume, admit 7 | ) where 8 | 9 | import Copilot.Theorem.Prove 10 | 11 | import Control.Monad.Writer 12 | 13 | -- | Instantiate a universal proof into an existential proof. 14 | instantiate :: Proof Universal -> Proof Existential 15 | instantiate (Proof p) = Proof p 16 | 17 | -- | Assume that a property, given by reference, holds. 18 | assume :: PropRef Universal -> Proof a 19 | assume (PropRef p) = Proof $ tell [Assume p] 20 | 21 | -- | Assume that the current goal holds. 22 | admit :: Proof a 23 | admit = Proof $ tell [Admit] 24 | -------------------------------------------------------------------------------- /copilot-theorem/src/Copilot/Theorem/TransSys.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE Safe #-} 2 | 3 | -- | Each prover first translates the Copilot specification into an 4 | -- intermediate representation best suited for model checking. 5 | -- 6 | -- This module and the ones in the same namespace implement the TransSys 7 | -- format. A Copilot program is /flattened/ and translated into a /state/ 8 | -- /transition system/. In order to keep some structure in this 9 | -- representation, the variables of this system are grouped by /nodes/, each 10 | -- node exporting and importing variables. The /Kind2 prover/ uses this format, 11 | -- which can be easily translated into the native format. 12 | module Copilot.Theorem.TransSys (module X) where 13 | 14 | import Copilot.Theorem.TransSys.Spec as X 15 | import Copilot.Theorem.TransSys.PrettyPrint as X 16 | import Copilot.Theorem.TransSys.Translate as X 17 | import Copilot.Theorem.TransSys.Transform as X 18 | -------------------------------------------------------------------------------- /copilot-theorem/src/Copilot/Theorem/TransSys/Cast.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE GADTs #-} 2 | {-# LANGUAGE RankNTypes #-} 3 | {-# LANGUAGE Safe #-} 4 | {-# LANGUAGE ScopedTypeVariables #-} 5 | 6 | -- | Casting of values with dynamic types and translating from Copilot core 7 | -- types to Copilot theorem types. 8 | 9 | module Copilot.Theorem.TransSys.Cast 10 | ( Dyn 11 | , toDyn 12 | , cast 13 | , castedType 14 | , casting 15 | ) where 16 | 17 | import Copilot.Core as C 18 | 19 | import Data.Dynamic (Dynamic(..), fromDynamic, toDyn) 20 | import GHC.Float 21 | 22 | import qualified Copilot.Theorem.TransSys.Type as K 23 | 24 | -- | Synonym for a dynamic type in Copilot core. 25 | type Dyn = Dynamic 26 | 27 | -- | Translation of a Copilot type into Copilot theorem's internal 28 | -- representation. 29 | castedType :: Type t -> K.U K.Type 30 | castedType t = case t of 31 | Bool -> K.U K.Bool 32 | Int8 -> K.U K.Integer 33 | Int16 -> K.U K.Integer 34 | Int32 -> K.U K.Integer 35 | Int64 -> K.U K.Integer 36 | Word8 -> K.U K.Integer 37 | Word16 -> K.U K.Integer 38 | Word32 -> K.U K.Integer 39 | Word64 -> K.U K.Integer 40 | Float -> K.U K.Real 41 | Double -> K.U K.Real 42 | 43 | -- | Cast a dynamic value to a given type. 44 | cast :: K.Type t -> Dyn -> t 45 | cast t v 46 | | K.Integer <- t, Just (vi :: Integer) <- _cast v = vi 47 | | K.Bool <- t, Just (vb :: Bool) <- _cast v = vb 48 | | K.Real <- t, Just (vr :: Double) <- _cast v = vr 49 | | otherwise = error "Bad type cast" 50 | 51 | -- | Apply function to a corresponding type in Copilot theorem's internal 52 | -- representation. 53 | casting :: Type t -> (forall t' . K.Type t' -> a) -> a 54 | casting t f = case castedType t of 55 | K.U K.Bool -> f K.Bool 56 | K.U K.Integer -> f K.Integer 57 | K.U K.Real -> f K.Real 58 | 59 | class Casted b where 60 | _cast :: Dyn -> Maybe b 61 | 62 | instance Casted Integer where 63 | _cast d 64 | | Just (v :: Int8) <- fromDynamic d = Just $ toInteger v 65 | | Just (v :: Int16) <- fromDynamic d = Just $ toInteger v 66 | | Just (v :: Int32) <- fromDynamic d = Just $ toInteger v 67 | | Just (v :: Int64) <- fromDynamic d = Just $ toInteger v 68 | | Just (v :: Word8) <- fromDynamic d = Just $ toInteger v 69 | | Just (v :: Word16) <- fromDynamic d = Just $ toInteger v 70 | | Just (v :: Word32) <- fromDynamic d = Just $ toInteger v 71 | | Just (v :: Word64) <- fromDynamic d = Just $ toInteger v 72 | | otherwise = Nothing 73 | 74 | instance Casted Bool where 75 | _cast d 76 | | Just (v :: Bool) <- fromDynamic d = Just v 77 | | otherwise = Nothing 78 | 79 | instance Casted Double where 80 | _cast d 81 | | Just (v :: Float) <- fromDynamic d = Just $ float2Double v 82 | | Just (v :: Double) <- fromDynamic d = Just v 83 | | otherwise = Nothing 84 | -------------------------------------------------------------------------------- /copilot-theorem/src/Copilot/Theorem/TransSys/Invariants.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_GHC -O0 #-} 2 | {-# LANGUAGE Safe #-} 3 | 4 | -- | Augment types with invariants. 5 | 6 | module Copilot.Theorem.TransSys.Invariants 7 | ( HasInvariants (..) 8 | , prop 9 | ) where 10 | 11 | -- | Type class for types with additional invariants or contraints. 12 | class HasInvariants a where 13 | 14 | invariants :: a -> [(String, Bool)] 15 | 16 | checkInvs :: a -> Bool 17 | checkInvs obj = all snd $ invariants obj 18 | 19 | -- | Creates an invariant with a description. 20 | prop :: String -> Bool -> (String, Bool) 21 | prop = (,) 22 | -------------------------------------------------------------------------------- /copilot-theorem/src/Copilot/Theorem/TransSys/PrettyPrint.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE GADTs #-} 2 | {-# LANGUAGE NamedFieldPuns #-} 3 | {-# LANGUAGE Safe #-} 4 | 5 | -- | Pretty print a TransSys specification as a Kind2/Lustre specification. 6 | module Copilot.Theorem.TransSys.PrettyPrint ( prettyPrint ) where 7 | 8 | import Copilot.Theorem.TransSys.Spec 9 | 10 | import Text.PrettyPrint.HughesPJ 11 | 12 | import qualified Data.Map as Map 13 | import qualified Data.Bimap as Bimap 14 | 15 | import Prelude hiding ((<>)) 16 | 17 | indent = nest 4 18 | emptyLine = text "" 19 | 20 | -- | Pretty print a TransSys specification as a Kind2/Lustre specification. 21 | prettyPrint :: TransSys -> String 22 | prettyPrint = render . pSpec 23 | 24 | pSpec :: TransSys -> Doc 25 | pSpec spec = items $$ props 26 | where 27 | items = foldr (($$) . pNode) empty (specNodes spec) 28 | props = text "PROPS" $$ 29 | Map.foldrWithKey (\k -> ($$) . pProp k) 30 | empty 31 | (Map.map fst (specProps spec)) 32 | 33 | pProp pId extvar = quotes (text pId) <+> text "is" <+> pExtVar extvar 34 | 35 | pType :: Type t -> Doc 36 | pType = text . show 37 | 38 | pList :: (t -> Doc) -> [t] -> Doc 39 | pList f l = brackets (hcat . punctuate (comma <> space) $ map f l) 40 | 41 | pNode :: Node -> Doc 42 | pNode n = 43 | header $$ imported $$ local $$ constrs $$ emptyLine 44 | where 45 | header = 46 | text "NODE" 47 | <+> quotes (text $ nodeId n) 48 | <+> text "DEPENDS ON" 49 | <+> pList text (nodeDependencies n) 50 | 51 | imported 52 | | Bimap.null (nodeImportedVars n) = empty 53 | | otherwise = text "IMPORTS" $$ indent 54 | (Map.foldrWithKey (\k -> ($$) . pIVar k) 55 | empty (Bimap.toMap $ nodeImportedVars n)) 56 | 57 | local 58 | | Map.null (nodeLocalVars n) = empty 59 | | otherwise = text "DEFINES" $$ indent 60 | (Map.foldrWithKey (\k -> ($$) . pLVar k) 61 | empty (nodeLocalVars n)) 62 | 63 | constrs = case nodeConstrs n of 64 | [] -> empty 65 | l -> text "WITH CONSTRAINTS" $$ 66 | foldr (($$) . pExpr) empty l 67 | 68 | pConst :: Type t -> t -> Doc 69 | pConst Integer v = text $ show v 70 | pConst Real v = text $ show v 71 | pConst Bool v = text $ show v 72 | 73 | pExtVar :: ExtVar -> Doc 74 | pExtVar (ExtVar n v) = parens (text n <+> text ":" <+> text (varName v)) 75 | 76 | pIVar :: Var -> ExtVar -> Doc 77 | pIVar v ev = 78 | pExtVar ev 79 | <+> text "as" <+> quotes (text (varName v)) 80 | 81 | pLVar :: Var -> VarDescr -> Doc 82 | pLVar l (VarDescr {varType, varDef}) = header $$ indent body 83 | where 84 | header = 85 | text (varName l) 86 | <+> text ":" 87 | <+> pType varType 88 | <+> text "=" 89 | 90 | body = case varDef of 91 | Pre val var -> 92 | pConst varType val 93 | <+> text "->" <+> text "pre" 94 | <+> text (varName var) 95 | Expr e -> pExpr e 96 | 97 | Constrs cs -> 98 | text "{" 99 | <+> (hsep . punctuate (space <> text ";" <> space)) (map pExpr cs) 100 | <+> text "}" 101 | 102 | pExpr :: Expr t -> Doc 103 | 104 | pExpr (Const t v) = pConst t v 105 | 106 | pExpr (Ite _ c e1 e2) = 107 | text "if" <+> pExpr c 108 | <+> text "then" <+> pExpr e1 109 | <+> text "else" <+> pExpr e2 110 | 111 | pExpr (Op1 _ op e) = pOp1 op <+> parens (pExpr e) 112 | 113 | pExpr (Op2 _ op e1 e2) = 114 | parens (pExpr e1) <+> pOp2 op <+> parens (pExpr e2) 115 | 116 | pExpr (VarE _ v) = text (varName v) 117 | 118 | pOp1 :: Op1 a -> Doc 119 | pOp1 = text . show 120 | 121 | pOp2 :: Op2 a b -> Doc 122 | pOp2 = text . show 123 | -------------------------------------------------------------------------------- /copilot-theorem/src/Copilot/Theorem/TransSys/Renaming.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE Safe #-} 2 | 3 | -- | A monad capable of keeping track of variable renames and of providing 4 | -- fresh names for variables. 5 | module Copilot.Theorem.TransSys.Renaming 6 | ( Renaming 7 | , addReservedName 8 | , rename 9 | , getFreshName 10 | , runRenaming 11 | , getRenamingF 12 | ) where 13 | 14 | import Copilot.Theorem.TransSys.Spec 15 | 16 | import Control.Monad.State.Lazy 17 | 18 | import Data.Maybe (fromMaybe) 19 | import Data.Map (Map) 20 | import Data.Set (Set, member) 21 | 22 | import qualified Data.Map as Map 23 | import qualified Data.Set as Set 24 | import qualified Data.List as List 25 | 26 | -- | A monad capable of keeping track of variable renames and of providing 27 | -- fresh names for variables. 28 | type Renaming = State RenamingST 29 | 30 | -- | State needed to keep track of variable renames and reserved names. 31 | data RenamingST = RenamingST 32 | { _reservedNames :: Set Var 33 | , _renaming :: Map ExtVar Var } 34 | 35 | -- | Register a name as reserved or used. 36 | addReservedName :: Var -> Renaming () 37 | addReservedName v = modify $ \st -> 38 | st {_reservedNames = Set.insert v (_reservedNames st)} 39 | 40 | -- | Produce a fresh new name based on the variable names provided. 41 | -- 42 | -- This function will try to pick a name from the given list and, if not, will 43 | -- use one of the names in the list as a basis for new names. 44 | -- 45 | -- PRE: the given list cannot be empty. 46 | getFreshName :: [Var] -> Renaming Var 47 | getFreshName vs = do 48 | usedNames <- _reservedNames <$> get 49 | let varAppend (Var s) = Var $ s ++ "_" 50 | applicants = vs ++ List.iterate varAppend (head vs) 51 | v = case dropWhile (`member` usedNames) applicants of 52 | v:_ -> v 53 | [] -> error "No more names available" 54 | addReservedName v 55 | return v 56 | 57 | -- | Map a name in the global namespace to a new variable name. 58 | rename :: NodeId -- ^ A node Id 59 | -> Var -- ^ A variable within that node 60 | -> Var -- ^ A new name for the variable 61 | -> Renaming () 62 | rename n v v' = modify $ \st -> 63 | st {_renaming = Map.insert (ExtVar n v) v' (_renaming st)} 64 | 65 | -- | Return a function that maps variables in the global namespace to their new 66 | -- names if any renaming has been registered. 67 | getRenamingF :: Renaming (ExtVar -> Var) 68 | getRenamingF = do 69 | mapping <- _renaming <$> get 70 | return $ \extv -> fromMaybe (extVarLocalPart extv) (Map.lookup extv mapping) 71 | 72 | -- | Run a computation in the 'Renaming' monad, providing a result and the 73 | -- renaming function that maps variables in the global namespace to their new 74 | -- local names. 75 | runRenaming :: Renaming a -> (a, ExtVar -> Var) 76 | runRenaming m = 77 | evalState st' (RenamingST Set.empty Map.empty) 78 | where 79 | st' = do 80 | r <- m 81 | f <- getRenamingF 82 | return (r, f) 83 | -------------------------------------------------------------------------------- /copilot-theorem/src/Copilot/Theorem/TransSys/Type.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ExistentialQuantification #-} 2 | {-# LANGUAGE GADTs #-} 3 | {-# LANGUAGE Safe #-} 4 | 5 | -- | Types suported by the modular transition systems. 6 | module Copilot.Theorem.TransSys.Type 7 | ( Type (..) 8 | , U (..) 9 | ) where 10 | 11 | import Data.Type.Equality 12 | 13 | -- | A type at both value and type level. 14 | -- 15 | -- Real numbers are mapped to 'Double's. 16 | data Type a where 17 | Bool :: Type Bool 18 | Integer :: Type Integer 19 | Real :: Type Double 20 | 21 | -- | Proofs of type equality. 22 | instance TestEquality Type where 23 | testEquality Bool Bool = Just Refl 24 | testEquality Integer Integer = Just Refl 25 | testEquality Real Real = Just Refl 26 | testEquality _ _ = Nothing 27 | 28 | -- | Unknown types. 29 | -- 30 | -- For instance, 'U Expr' is the type of an expression of unknown type 31 | data U f = forall t . U (f t) 32 | 33 | instance Show (Type t) where 34 | show Integer = "Int" 35 | show Bool = "Bool" 36 | show Real = "Real" 37 | -------------------------------------------------------------------------------- /copilot-theorem/tests/Main.hs: -------------------------------------------------------------------------------- 1 | -- | Test copilot-theorem. 2 | module Main where 3 | 4 | -- External imports 5 | import Test.Framework (Test, defaultMain) 6 | 7 | -- Internal imports 8 | import qualified Test.Copilot.Theorem.What4 9 | 10 | -- | Run all unit tests on copilot-theorem. 11 | main :: IO () 12 | main = defaultMain tests 13 | 14 | -- | All unit tests in copilot-theorem. 15 | tests :: [Test.Framework.Test] 16 | tests = 17 | [ Test.Copilot.Theorem.What4.tests 18 | ] 19 | -------------------------------------------------------------------------------- /copilot/LICENSE: -------------------------------------------------------------------------------- 1 | 2009 2 | BSD3 License terms 3 | 4 | Redistribution and use in source and binary forms, with or without 5 | modification, are permitted provided that the following conditions 6 | are met: 7 | 8 | Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | Redistributions in binary form must reproduce the above copyright 12 | notice, this list of conditions and the following disclaimer in the 13 | documentation and/or other materials provided with the distribution. 14 | 15 | Neither the name of the developers nor the names of its contributors 16 | may be used to endorse or promote products derived from this software 17 | without specific prior written permission. 18 | 19 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 20 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 21 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 22 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR 23 | CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, 24 | EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, 25 | PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR 26 | PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF 27 | LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING 28 | NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 29 | SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 30 | -------------------------------------------------------------------------------- /copilot/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /copilot/examples/AddMult.hs: -------------------------------------------------------------------------------- 1 | -- Copyright © 2019 National Institute of Aerospace / Galois, Inc. 2 | 3 | -- | Another small example that calculates a constant value using a recursive 4 | -- function. 5 | 6 | module Main where 7 | 8 | import Language.Copilot 9 | 10 | spec :: Spec 11 | spec = trigger "f" true [ arg $ mult 5 ] 12 | where 13 | mult :: Word64 -> Stream Word64 14 | mult 0 = 1 15 | mult i = constant i * mult (i-1) 16 | 17 | main :: IO () 18 | main = interpret 100 spec 19 | -------------------------------------------------------------------------------- /copilot/examples/Array.hs: -------------------------------------------------------------------------------- 1 | -- Copyright © 2019 National Institute of Aerospace / Galois, Inc. 2 | 3 | -- | This is a simple example for arrays. As a program, it does not make much 4 | -- sense, however it shows of the features of arrays nicely. 5 | 6 | -- | Enable compiler extension for type-level data, necesary for the array 7 | -- length. 8 | 9 | {-# LANGUAGE DataKinds #-} 10 | {-# LANGUAGE RebindableSyntax #-} 11 | 12 | module Main where 13 | 14 | import Language.Copilot 15 | 16 | -- Lets define an array of length 2. 17 | -- Make the buffer of the streams 3 elements long. 18 | arr :: Stream (Array 2 Bool) 19 | arr = [ array [True, False] 20 | , array [True, True] 21 | , array [False, False]] ++ arr 22 | 23 | spec :: Spec 24 | spec = do 25 | -- A trigger that fires 'func' when the first element of 'arr' is True. 26 | -- It passes the current value of arr as an argument. 27 | -- The prototype of 'func' would be: 28 | -- void func (int8_t arg[3]); 29 | trigger "func" (arr ! 0) [arg arr] 30 | 31 | -- A trigger that fires 'func2' every time. 32 | -- It passes the current value of arr as an argument, but updating the first 33 | -- element of the array to always be True. 34 | -- The prototype of 'func2' would be: 35 | -- void func2 (int8_t arg[3]); 36 | trigger "func2" true [arg (arr !! 0 =: true)] 37 | 38 | -- A trigger that fires 'func2' every time. 39 | -- It passes the current value of arr as an argument, but negating the second 40 | -- element of the array. 41 | -- The prototype of 'func3' would be: 42 | -- void func3 (int8_t arg[3]); 43 | trigger "func3" true [arg (arr !! 1 =$ not)] 44 | 45 | -- Compile the spec 46 | main :: IO () 47 | main = interpret 30 spec 48 | -------------------------------------------------------------------------------- /copilot/examples/Cast.hs: -------------------------------------------------------------------------------- 1 | -- Copyright © 2019 National Institute of Aerospace / Galois, Inc. 2 | 3 | -- | Examples of casting types. 4 | 5 | {-# LANGUAGE RebindableSyntax #-} 6 | 7 | module Main where 8 | 9 | import Language.Copilot 10 | 11 | b :: Stream Bool 12 | b = [True] ++ not b 13 | 14 | i :: Stream Int8 15 | i = cast b 16 | 17 | x :: Stream Word16 18 | x = [0] ++ x + 1 19 | 20 | y :: Stream Int32 21 | y = 1 + cast x 22 | 23 | spec :: Spec 24 | spec = trigger "trigger" true [arg y, arg i] 25 | 26 | main :: IO () 27 | main = interpret 30 spec 28 | -------------------------------------------------------------------------------- /copilot/examples/Clock.hs: -------------------------------------------------------------------------------- 1 | -- Copyright © 2019 National Institute of Aerospace / Galois, Inc. 2 | 3 | -- | Example showing usage of clocks to generate periodically recurring truth 4 | -- values. 5 | 6 | module Main where 7 | 8 | import Language.Copilot 9 | import Copilot.Library.Clocks 10 | 11 | -- | We need to force a type for the argument of `period`. 12 | p :: Word8 13 | p = 5 14 | 15 | -- | Both have the same period, but a different phase. 16 | clkStream :: Stream Bool 17 | clkStream = clk (period p) (phase 0) 18 | 19 | clkStream' :: Stream Bool 20 | clkStream' = clk (period p) (phase 2) 21 | 22 | spec :: Spec 23 | spec = do 24 | observer "clk" clkStream 25 | observer "clk'" clkStream' 26 | 27 | main :: IO () 28 | main = interpret 30 spec 29 | -------------------------------------------------------------------------------- /copilot/examples/Counter.hs: -------------------------------------------------------------------------------- 1 | -- Copyright © 2019 National Institute of Aerospace / Galois, Inc. 2 | 3 | -- | Example showing an implementation of a resettable counter. 4 | 5 | {-# LANGUAGE RebindableSyntax #-} 6 | 7 | module Main where 8 | 9 | import Language.Copilot 10 | import Copilot.Compile.C99 11 | 12 | -- A resettable counter 13 | counter :: Stream Bool -> Stream Bool -> Stream Int32 14 | counter inc reset = cnt 15 | where 16 | cnt = if reset then 0 17 | else if inc then z + 1 18 | else z 19 | z = [0] ++ cnt 20 | 21 | -- Counter that resets when it reaches 256 22 | bytecounter :: Stream Int32 23 | bytecounter = counter true reset 24 | where 25 | reset = counter true false `mod` 256 == 0 26 | 27 | spec :: Spec 28 | spec = trigger "counter" true [arg $ bytecounter] 29 | 30 | main :: IO () 31 | -- main = interpret 1280 spec 32 | main = reify spec >>= compile "counter" 33 | -------------------------------------------------------------------------------- /copilot/examples/Engine.hs: -------------------------------------------------------------------------------- 1 | -- Copyright © 2011 National Institute of Aerospace / Galois, Inc. 2 | 3 | -- | Example implementing an engine cooling control system. 4 | 5 | {-# LANGUAGE RebindableSyntax #-} 6 | 7 | module Main where 8 | 9 | import Language.Copilot 10 | import qualified Prelude as P 11 | 12 | -- If the majority of the engine temperature probes exeeds 250 degrees, then 13 | -- the cooler is engaged and remains engaged until the majority of the engine 14 | -- temperature probes drop to 250 or below. Otherwise, trigger an immediate 15 | -- shutdown of the engine. 16 | 17 | engineMonitor :: Spec 18 | engineMonitor = do 19 | trigger "shutoff" (not ok) [arg maj] 20 | 21 | where 22 | vals = [ externW8 "tmp_probe_0" two51 23 | , externW8 "tmp_probe_1" two51 24 | , externW8 "tmp_probe_2" zero] 25 | exceed = map (> 250) vals 26 | maj = majority exceed 27 | checkMaj = aMajority exceed maj 28 | ok = alwaysBeen ((maj && checkMaj) ==> extern "cooler" cooler) 29 | 30 | two51 = Just $ [251, 251] P.++ repeat (250 :: Word8) 31 | zero = Just $ repeat (0 :: Word8) 32 | cooler = Just $ [True, True] P.++ repeat False 33 | 34 | main :: IO () 35 | main = interpret 10 engineMonitor 36 | -------------------------------------------------------------------------------- /copilot/examples/Heater.hs: -------------------------------------------------------------------------------- 1 | -- Copyright 2019 National Institute of Aerospace / Galois, Inc. 2 | 3 | -- This is a simple example with basic usage. It implements a simple home 4 | -- heating system: It heats when temp gets too low, and stops when it is high 5 | -- enough. It read temperature as a byte (range -50C to 100C) and translates 6 | -- this to Celsius. 7 | 8 | module Main where 9 | 10 | import Language.Copilot 11 | import Copilot.Compile.C99 12 | 13 | import Prelude hiding ((>), (<), div) 14 | 15 | -- External temperature as a byte, range of -50C to 100C 16 | temp :: Stream Word8 17 | temp = extern "temperature" Nothing 18 | 19 | -- Calculate temperature in Celsius. 20 | -- We need to cast the Word8 to a Float. Note that it is an unsafeCast, as there 21 | -- is no direct relation between Word8 and Float. 22 | ctemp :: Stream Float 23 | ctemp = (unsafeCast temp) * (150.0 / 255.0) - 50.0 24 | 25 | spec = do 26 | -- Triggers that fire when the ctemp is too low or too high, 27 | -- pass the current ctemp as an argument. 28 | trigger "heaton" (ctemp < 18.0) [arg ctemp] 29 | trigger "heatoff" (ctemp > 21.0) [arg ctemp] 30 | 31 | -- Compile the spec 32 | main = reify spec >>= compile "heater" 33 | -------------------------------------------------------------------------------- /copilot/examples/Structs.hs: -------------------------------------------------------------------------------- 1 | -- | An example showing how specifications involving structs (in particular, 2 | -- nested structs) are compiled to C using copilot-c99. 3 | 4 | {-# LANGUAGE DataKinds #-} 5 | {-# LANGUAGE DeriveGeneric #-} 6 | 7 | module Main where 8 | 9 | import qualified Prelude as P 10 | import Control.Monad (void, forM_) 11 | import GHC.Generics (Generic) 12 | 13 | import Language.Copilot 14 | import Copilot.Compile.C99 15 | 16 | -- | Definition for `Volts`. 17 | data Volts = Volts 18 | { numVolts :: Field "numVolts" Word16 19 | , flag :: Field "flag" Bool 20 | } 21 | deriving Generic 22 | 23 | -- | `Struct` instance for `Volts`. 24 | instance Struct Volts where 25 | typeName = typeNameDefault 26 | toValues = toValuesDefault 27 | -- Note that we do not implement `updateField` here. `updateField` is only 28 | -- needed to make updates to structs work in the Copilot interpreter, and we 29 | -- do not use the interpreter in this example. (See 30 | -- `examples/StructsUpdateField.hs` for an example that does implement 31 | -- `updateField`.) 32 | 33 | -- | `Volts` instance for `Typed`. 34 | instance Typed Volts where 35 | typeOf = typeOfDefault 36 | 37 | data Battery = Battery 38 | { temp :: Field "temp" Word16 39 | , volts :: Field "volts" (Array 10 Volts) 40 | , other :: Field "other" (Array 10 (Array 5 Word32)) 41 | } 42 | deriving Generic 43 | 44 | -- | `Battery` instance for `Struct`. 45 | instance Struct Battery where 46 | typeName = typeNameDefault 47 | toValues = toValuesDefault 48 | -- Note that we do not implement `updateField` here for the same reasons as in 49 | -- the `Struct Volts` instance above. 50 | 51 | -- | `Battery` instance for `Typed`. 52 | instance Typed Battery where 53 | typeOf = typeOfDefault 54 | 55 | spec :: Spec 56 | spec = do 57 | let battery :: Stream Battery 58 | battery = extern "battery" Nothing 59 | 60 | -- Check equality, indexing into nested structs and arrays. Note that this is 61 | -- trivial by equality. 62 | trigger "equalitySameIndex" 63 | ((((battery#volts) ! 0)#numVolts) == (((battery#volts) ! 0)#numVolts)) 64 | [arg battery] 65 | 66 | -- Same as previous example, but get a different array index (so should be 67 | -- false). 68 | trigger "equalityDifferentIndices" 69 | ((((battery#other) ! 2) ! 3) == (((battery#other) ! 2) ! 4)) 70 | [arg battery] 71 | 72 | main :: IO () 73 | main = do 74 | spec' <- reify spec 75 | 76 | -- Compile the specific to C. 77 | compile "structs" spec' 78 | -------------------------------------------------------------------------------- /copilot/examples/Voting.hs: -------------------------------------------------------------------------------- 1 | -- Copyright © 2019 National Institute of Aerospace / Galois, Inc. 2 | 3 | -- | Fault-tolerant voting examples. 4 | 5 | {-# LANGUAGE RebindableSyntax #-} 6 | 7 | module Main where 8 | 9 | import Language.Copilot 10 | 11 | vote :: Spec 12 | vote = do 13 | -- majority selects element with the biggest occurance. 14 | trigger "maj" true [arg maj] 15 | 16 | -- aMajority checks if the selected element has a majority. 17 | trigger "aMaj" true [arg $ aMajority inputs maj] 18 | 19 | where 20 | maj = majority inputs 21 | 22 | -- 26 input streams to vote on 23 | inputs :: [Stream Word32] 24 | inputs = [ a, b, c, d, e, f, g, h, i, j, k, l, m 25 | , n, o, p, q, r, s, t, u, v, w, x, y, z 26 | ] 27 | a = [0] ++ a + 1 28 | b = [0] ++ b + 1 29 | c = [0] ++ c + 1 30 | d = [0] ++ d + 1 31 | e = [1] ++ e + 1 32 | f = [1] ++ f + 1 33 | g = [1] ++ g + 1 34 | h = [1] ++ h + 1 35 | i = [1] ++ i + 1 36 | j = [1] ++ j + 1 37 | k = [1] ++ k + 1 38 | l = [1] ++ l + 1 39 | m = [1] ++ m + 1 40 | n = [1] ++ n + 1 41 | o = [1] ++ o + 1 42 | p = [1] ++ p + 1 43 | q = [1] ++ q + 1 44 | r = [1] ++ r + 1 45 | s = [1] ++ s + 1 46 | t = [1] ++ t + 1 47 | u = [1] ++ u + 1 48 | v = [1] ++ v + 1 49 | w = [1] ++ w + 1 50 | x = [1] ++ x + 1 51 | y = [1] ++ y + 1 52 | z = [1] ++ z + 1 53 | 54 | main :: IO () 55 | main = interpret 30 vote 56 | -------------------------------------------------------------------------------- /copilot/examples/what4/Arithmetic.hs: -------------------------------------------------------------------------------- 1 | -- | An example showing the usage of the What4 backend in copilot-theorem for 2 | -- simple arithmetic. 3 | 4 | module Main where 5 | 6 | import qualified Prelude as P 7 | import Control.Monad (void, forM_) 8 | 9 | import Language.Copilot 10 | import Copilot.Theorem.What4 11 | 12 | spec :: Spec 13 | spec = do 14 | -- Define some external streams. Their values are not important, so external 15 | -- streams suffice. 16 | let eint8 :: Stream Int8 17 | eint8 = extern "eint8" Nothing 18 | eword8 :: Stream Word8 19 | eword8 = extern "eword8" Nothing 20 | efloat :: Stream Float 21 | efloat = extern "efloat" Nothing 22 | 23 | -- The simplest example involving numbers: equality on constant values. 24 | void $ prop "Example 1" (forAll ((constant (1 :: Int8)) == (constant 1))) 25 | 26 | -- Testing "a < a + 1". This should fail, because it isn't true. 27 | void $ prop "Example 2" (forAll (eint8 < (eint8 + 1))) 28 | 29 | -- Adding another condition to the above property to make it true. 30 | void $ prop "Example 3" (forAll ((eint8 < (eint8 + 1)) || (eint8 == 127))) 31 | 32 | -- Just like the previous example, but with words. 33 | void $ prop "Example 4" (forAll ((eword8 < (eword8 + 1)) || (eword8 == 255))) 34 | 35 | -- An example with floats. 36 | void $ prop "Example 5" (forAll ((2 * efloat) == (efloat + efloat))) 37 | 38 | -- Another example with floats. This fails, because it isn't true. 39 | void $ prop "Example 6" (forAll ((efloat + 1) /= efloat)) 40 | 41 | main :: IO () 42 | main = do 43 | spec' <- reify spec 44 | 45 | -- Use Z3 to prove the properties. 46 | results <- prove Z3 spec' 47 | 48 | -- Print the results. 49 | forM_ results $ \(nm, res) -> do 50 | putStr $ nm <> ": " 51 | case res of 52 | Valid -> putStrLn "valid" 53 | Invalid -> putStrLn "invalid" 54 | Unknown -> putStrLn "unknown" 55 | -------------------------------------------------------------------------------- /copilot/examples/what4/ArithmeticCounterExamples.hs: -------------------------------------------------------------------------------- 1 | -- | An example showing the usage of the What4 backend in copilot-theorem for 2 | -- simple arithmetic. This example uses the 'proveWithCounterExamples' function 3 | -- to demonstrate counterexamples in the event of invalid properties. 4 | 5 | module Main where 6 | 7 | import qualified Prelude as P 8 | import Control.Monad (void, forM_) 9 | import qualified Data.Map as Map 10 | 11 | import Language.Copilot 12 | import Copilot.Theorem.What4 13 | 14 | spec :: Spec 15 | spec = do 16 | -- Define some external streams. Their values are not important, so external 17 | -- streams suffice. 18 | let eint8 :: Stream Int8 19 | eint8 = extern "eint8" Nothing 20 | eword8 :: Stream Word8 21 | eword8 = extern "eword8" Nothing 22 | efloat :: Stream Float 23 | efloat = extern "efloat" Nothing 24 | 25 | -- The simplest example involving numbers: equality on constant values. 26 | void $ prop "Example 1" (forAll ((constant (1 :: Int8)) == (constant 1))) 27 | 28 | -- Testing "a < a + 1". This should fail, because it isn't true. 29 | void $ prop "Example 2" (forAll (eint8 < (eint8 + 1))) 30 | 31 | -- Adding another condition to the above property to make it true. 32 | void $ prop "Example 3" (forAll ((eint8 < (eint8 + 1)) || (eint8 == 127))) 33 | 34 | -- Just like the previous example, but with words. 35 | void $ prop "Example 4" (forAll ((eword8 < (eword8 + 1)) || (eword8 == 255))) 36 | 37 | -- An example with floats. 38 | void $ prop "Example 5" (forAll ((2 * efloat) == (efloat + efloat))) 39 | 40 | -- Another example with floats. This fails, because it isn't true. 41 | void $ prop "Example 6" (forAll ((efloat + 1) /= efloat)) 42 | 43 | main :: IO () 44 | main = do 45 | spec' <- reify spec 46 | 47 | -- Use Z3 to prove the properties. 48 | results <- proveWithCounterExample Z3 spec' 49 | 50 | -- Print the results. 51 | forM_ results $ \(nm, res) -> do 52 | putStr $ nm <> ": " 53 | case res of 54 | ValidCex -> putStrLn "valid" 55 | InvalidCex cex -> do 56 | putStrLn "invalid" 57 | putStrLn $ ppCounterExample cex 58 | UnknownCex -> putStrLn "unknown" 59 | 60 | -- | Pretty-print a counterexample for user display. 61 | ppCounterExample :: CounterExample -> String 62 | ppCounterExample cex 63 | | any P.not (baseCases cex) 64 | = if Map.null baseCaseVals 65 | then 66 | " All possible extern values during the base case(s) " P.++ 67 | "constitute a counterexample." 68 | else 69 | unlines $ 70 | " The base cases failed with the following extern values:" : 71 | map 72 | (\((name, _), val) -> " " P.++ name P.++ ": " P.++ show val) 73 | (Map.toList baseCaseVals) 74 | 75 | | P.not (inductionStep cex) 76 | = if Map.null inductionStepVals 77 | then 78 | " All possible extern values during the induction step " P.++ 79 | "constitute a counterexample." 80 | else 81 | unlines $ 82 | " The induction step failed with the following extern values:" : 83 | map 84 | (\((name, _), val) -> " " P.++ name P.++ ": " P.++ show val) 85 | (Map.toList inductionStepVals) 86 | 87 | | otherwise 88 | = error $ 89 | "ppCounterExample: " P.++ 90 | "Counterexample without failing base cases or induction step" 91 | where 92 | allExternVals = concreteExternValues cex 93 | 94 | baseCaseVals = 95 | Map.filterWithKey 96 | (\(_, offset) _ -> 97 | case offset of 98 | AbsoluteOffset {} -> True 99 | RelativeOffset {} -> False 100 | ) 101 | allExternVals 102 | 103 | inductionStepVals = 104 | Map.filterWithKey 105 | (\(_, offset) _ -> 106 | case offset of 107 | AbsoluteOffset {} -> False 108 | RelativeOffset {} -> True 109 | ) 110 | allExternVals 111 | -------------------------------------------------------------------------------- /copilot/examples/what4/Arrays.hs: -------------------------------------------------------------------------------- 1 | -- | An example showing the usage of the What4 backend in copilot-theorem for 2 | -- arrays where individual elements are updated. 3 | 4 | {-# LANGUAGE DataKinds #-} 5 | 6 | module Main where 7 | 8 | import qualified Prelude as P 9 | import Control.Monad (void, forM_) 10 | 11 | import Language.Copilot 12 | import Copilot.Theorem.What4 13 | 14 | spec :: Spec 15 | spec = do 16 | let pair :: Stream (Array 2 Int16) 17 | pair = extern "pair" Nothing 18 | 19 | -- Check equality, indexing into array and modifying the value. Note that 20 | -- this is trivial by equality. 21 | void $ prop "Example 1" $ forAll $ 22 | ((pair !! 0 =$ (+1)) ! 0) == ((pair ! 0) + 1) 23 | 24 | -- Same as previous example, but get a different array index (so should be 25 | -- false). 26 | void $ prop "Example 2" $ forAll $ 27 | ((pair !! 0 =$ (+1)) ! 1) == ((pair ! 0) + 1) 28 | 29 | main :: IO () 30 | main = do 31 | spec' <- reify spec 32 | 33 | -- Use Z3 to prove the properties. 34 | results <- prove Z3 spec' 35 | 36 | -- Print the results. 37 | forM_ results $ \(nm, res) -> do 38 | putStr $ nm <> ": " 39 | case res of 40 | Valid -> putStrLn "valid" 41 | Invalid -> putStrLn "invalid" 42 | Unknown -> putStrLn "unknown" 43 | -------------------------------------------------------------------------------- /copilot/examples/what4/Propositional.hs: -------------------------------------------------------------------------------- 1 | -- | An example showing the usage of the What4 backend in copilot-theorem for 2 | -- propositional logic on boolean streams. 3 | 4 | module Main where 5 | 6 | import qualified Prelude as P 7 | import Control.Monad (void, forM_) 8 | 9 | import Language.Copilot 10 | import Copilot.Theorem.What4 11 | 12 | spec :: Spec 13 | spec = do 14 | -- * Non-inductive propositions 15 | 16 | -- The constant value true, which is translated as the corresponding SMT 17 | -- boolean literal (and is therefore provable). 18 | void $ prop "Example 1" (forAll true) 19 | 20 | -- The constant value false, which is translated as the corresponding SMT 21 | -- boolean literal (and is therefore not provable). 22 | void $ prop "Example 2" (forAll false) 23 | 24 | -- An "a or not a" proposition which does not require any sort of inductive 25 | -- argument (but see examples 5 and 6 below for versions that do require 26 | -- induction to solve). This is easily proven. 27 | let a = [False] ++ b 28 | b = not a 29 | void $ prop "Example 3" (forAll (a || b)) 30 | 31 | -- An "a or not a" proposition using external streams, which is also provable. 32 | let a = extern "a" Nothing 33 | void $ prop "Example 4" (forAll (a || not a)) 34 | 35 | -- * Simple inductive propositions 36 | -- 37 | -- While Copilot.Theorem.What4 is not able to solve all inductive propositions 38 | -- in general (see the "Complex inductive propositions" section below), the 39 | -- following inductive propositions are simple enough that the heuristics in 40 | -- Copilot.Theorem.What4 can solve them without issue. 41 | 42 | -- An inductively defined flavor of true. 43 | let a = [True] ++ a 44 | void $ prop "Example 5" (forAll a) 45 | 46 | -- An inductively defined "a or not a" proposition (i.e., a more complex 47 | -- version of example 3 above). 48 | let a = [False] ++ b 49 | b = [True] ++ a 50 | void $ prop "Example 6" (forAll (a || b)) 51 | 52 | -- A bit more convoluted version of example 6. 53 | let a = [True, False] ++ b 54 | b = [False] ++ not (drop 1 a) 55 | void $ prop "Example 7" (forAll (a || b)) 56 | 57 | -- * Complex induction propositions 58 | -- 59 | -- The heuristics in Copilot.Theorem.What4 are not able to prove these 60 | -- inductive propositions, so these will be reported as unprovable, even 61 | -- though each proposition is actually provable. 62 | 63 | -- An inductively defined flavor of true (i.e., a more complex version of 64 | -- example 5 above). 65 | let a = [True] ++ ([True] ++ ([True] ++ a)) 66 | void $ prop "Example 8" (forAll a) 67 | 68 | -- An inductively defined "a or not a" proposition (i.e., a more complex 69 | -- version of example 6 above). 70 | let a = [False] ++ ([False] ++ ([False] ++ b)) 71 | b = [True] ++ ([True] ++ ([True] ++ a)) 72 | void $ prop "Example 9" (forAll (a || b)) 73 | 74 | main :: IO () 75 | main = do 76 | spec' <- reify spec 77 | 78 | -- Use Z3 to prove the properties. 79 | results <- prove Z3 spec' 80 | 81 | -- Print the results. 82 | forM_ results $ \(nm, res) -> do 83 | putStr $ nm <> ": " 84 | case res of 85 | Valid -> putStrLn "valid" 86 | Invalid -> putStrLn "invalid" 87 | Unknown -> putStrLn "unknown" 88 | -------------------------------------------------------------------------------- /copilot/examples/what4/Structs.hs: -------------------------------------------------------------------------------- 1 | -- | An example showing the usage of the What4 backend in copilot-theorem for 2 | -- structs and arrays. Particular focus is on nested structs. 3 | -- For general usage of structs, refer to the general structs example. 4 | 5 | {-# LANGUAGE DataKinds #-} 6 | {-# LANGUAGE DeriveGeneric #-} 7 | 8 | module Main where 9 | 10 | import qualified Prelude as P 11 | import Control.Monad (void, forM_) 12 | import GHC.Generics (Generic) 13 | 14 | import Language.Copilot 15 | import Copilot.Theorem.What4 16 | 17 | -- | Definition for `Volts`. 18 | data Volts = Volts 19 | { numVolts :: Field "numVolts" Word16 20 | , flag :: Field "flag" Bool 21 | } 22 | deriving Generic 23 | 24 | -- | `Struct` instance for `Volts`. 25 | instance Struct Volts where 26 | typeName = typeNameDefault 27 | toValues = toValuesDefault 28 | -- Note that we do not implement `updateField` here. `updateField` is only 29 | -- needed to make updates to structs work in the Copilot interpreter, and we 30 | -- do not use the interpreter in this example. (See 31 | -- `examples/StructsUpdateField.hs` for an example that does implement 32 | -- `updateField`.) 33 | 34 | -- | `Volts` instance for `Typed`. 35 | instance Typed Volts where 36 | typeOf = typeOfDefault 37 | 38 | data Battery = Battery 39 | { temp :: Field "temp" Word16 40 | , volts :: Field "volts" (Array 10 Volts) 41 | , other :: Field "other" (Array 10 (Array 5 Word32)) 42 | } 43 | deriving Generic 44 | 45 | -- | `Battery` instance for `Struct`. 46 | instance Struct Battery where 47 | typeName = typeNameDefault 48 | toValues = toValuesDefault 49 | -- Note that we do not implement `updateField` here for the same reasons as in 50 | -- the `Struct Volts` instance above. 51 | 52 | -- | `Battery` instance for `Typed`. 53 | instance Typed Battery where 54 | typeOf = typeOfDefault 55 | 56 | spec :: Spec 57 | spec = do 58 | let battery :: Stream Battery 59 | battery = extern "battery" Nothing 60 | 61 | -- Check equality, indexing into nested structs and arrays. Note that this is 62 | -- trivial by equality. 63 | void $ prop "Example 1" $ forAll $ 64 | (((battery#volts) ! 0)#numVolts) == (((battery#volts) ! 0)#numVolts) 65 | 66 | -- Same as previous example, but get a different array index (so should be 67 | -- false). 68 | void $ prop "Example 2" $ forAll $ 69 | (((battery#other) ! 2) ! 3) == (((battery#other) ! 2) ! 4) 70 | 71 | -- Update a struct field, then check it for equality. 72 | void $ prop "Example 3" $ forAll $ 73 | ((battery ## temp =$ (+1))#temp == (battery#temp + 1)) 74 | 75 | main :: IO () 76 | main = do 77 | spec' <- reify spec 78 | 79 | -- Use Z3 to prove the properties. 80 | results <- prove Z3 spec' 81 | 82 | -- Print the results. 83 | forM_ results $ \(nm, res) -> do 84 | putStr $ nm <> ": " 85 | case res of 86 | Valid -> putStrLn "valid" 87 | Invalid -> putStrLn "invalid" 88 | Unknown -> putStrLn "unknown" 89 | -------------------------------------------------------------------------------- /copilot/runtest: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | infile="$1" 4 | if [ ! -e $infile ]; then 5 | echo "File \"$infile\" does not exist." 6 | exit 1 7 | fi 8 | 9 | shift 10 | 11 | p=$(cabal exec printenv GHC_PACKAGE_PATH) 12 | 13 | GHC_PACKAGE_PATH="$p" runhaskell "$infile" $@ 14 | -------------------------------------------------------------------------------- /copilot/src/Language/Copilot.hs: -------------------------------------------------------------------------------- 1 | -- | Copilot is a stream-based runtime verification framework. Programs can be 2 | -- interpreted for testing, or translated into C99 code to be incorporated in a 3 | -- project, or as a standalone application. The C99 backend output is constant 4 | -- in memory and time, making it suitable for systems with hard realtime 5 | -- requirements. 6 | -- 7 | -- This module is the main entry point for the Copilot language. The 8 | -- expectation is that most Copilot users will only need to import this module, 9 | -- together with one of the backend modules (at present, only 10 | -- 'Copilot.Compile.C99' from the 11 | -- library is 12 | -- available). 13 | module Language.Copilot 14 | ( 15 | module Copilot.Language 16 | , module Copilot.Language.Prelude 17 | , module Copilot.Language.Reify 18 | , module Copilot.Library.Libraries 19 | 20 | , copilotMain 21 | , defaultMain 22 | ) where 23 | 24 | import Copilot.Language 25 | import Copilot.Language.Prelude 26 | import Copilot.Language.Reify 27 | import Copilot.Library.Libraries 28 | import Language.Copilot.Main 29 | -------------------------------------------------------------------------------- /copilot/src/Language/Copilot/Main.hs: -------------------------------------------------------------------------------- 1 | -- | Create Copilot executables that generate code or interpret streams and 2 | -- print the results to stdout. 3 | module Language.Copilot.Main ( copilotMain, defaultMain ) where 4 | 5 | import qualified Copilot.Core as C (Spec) 6 | import Copilot.Language (interpret) 7 | import Copilot.Language.Reify (reify) 8 | import Copilot.Language (Spec) 9 | import qualified Copilot.PrettyPrint as PP 10 | 11 | import Options.Applicative 12 | import Data.Semigroup ((<>)) 13 | import Control.Monad (when) 14 | 15 | -- | An interpreter of Copilot specifications for a given 16 | -- number of simulation steps. 17 | type Interpreter = Integer -> Spec -> IO () 18 | 19 | -- | A compiler from 20 | -- 21 | -- specifications. 22 | type Compiler = FilePath -> C.Spec -> IO () 23 | 24 | -- | A pretty printer of Copilot specifications. 25 | type Printer = Spec -> IO () 26 | 27 | -- | Command line arguments supported by all commands in 'cmdargs'. 28 | data CmdArgs = CmdArgs 29 | { aoutput :: String 30 | , acompile :: Bool 31 | , apretty :: Bool 32 | , ainterpret :: Int 33 | } 34 | 35 | -- | Command line arguments handled by the Copilot main function. 36 | cmdargs :: Parser CmdArgs 37 | cmdargs = CmdArgs 38 | <$> strOption (long "output" <> short 'o' <> value "." 39 | <> help "Output directory of C files") 40 | <*> switch (long "justrun" <> short 'c' 41 | <> help "Do NOT produce *.c and *.h files as output") 42 | <*> switch (long "print" <> short 'p' 43 | <> help "Pretty print the specification") 44 | <*> option auto (long "interpret" <> short 'i' <> value 0 45 | <> metavar "INT" <> showDefault 46 | <> help "Interpret specification and write result to output") 47 | 48 | -- | Create a main to either compile or interpret a copilot specification. 49 | -- 50 | -- This function must be provided an auxiliary function capable of compiling 51 | -- 52 | -- specifications for some target. 53 | -- 54 | -- The command line program supports four main commands: 55 | -- 56 | -- * @--output/-o@: use the given compiler to produce C code. 57 | -- 58 | -- * @--justrun/-c@: execute a dry-run, which parses and converts the 59 | -- specification to core but does not produce any output. 60 | -- 61 | -- * @--print/-p@: pretty print the specification. 62 | -- 63 | -- * @--interpret/-i NUM@: interpret the specification for a given number 64 | -- of steps. 65 | copilotMain :: Interpreter -> Printer -> Compiler -> Spec -> IO () 66 | copilotMain interp pretty comp spec = main =<< execParser opts 67 | where 68 | opts = info (cmdargs <**> helper) fullDesc 69 | 70 | main :: CmdArgs -> IO () 71 | main args = do 72 | let iters = ainterpret args 73 | when (apretty args) $ pretty spec 74 | when (iters Prelude.> 0) $ interp (fromIntegral iters) spec 75 | 76 | when (not $ acompile args) $ do 77 | spec' <- reify spec 78 | comp (aoutput args) spec' 79 | 80 | -- | Create a main function with a default interpreter and pretty printer. 81 | -- 82 | -- This function must be provided an auxiliary function capable of compiling 83 | -- 84 | -- specifications for some target. 85 | -- 86 | -- This function relies on 'copilotMain', please refer to that function for the 87 | -- command line options. 88 | defaultMain :: Compiler -> Spec -> IO () 89 | defaultMain = copilotMain interpret prettyPrint 90 | where 91 | -- Transform a high-level Copilot Language specification into a low-level 92 | -- Copilot Core specification and pretty-print it to stdout. 93 | prettyPrint :: Spec -> IO () 94 | prettyPrint e = fmap PP.prettyPrint (reify e) >>= putStr 95 | --------------------------------------------------------------------------------