grisette-0.5.0.0: Symbolic evaluation as a library
Copyright(c) Sirui Lu 2021-2023
LicenseBSD-3-Clause (see the LICENSE file)
Maintainersiruilu@cs.washington.edu
StabilityExperimental
PortabilityGHC only
Safe HaskellTrustworthy
LanguageHaskell2010

Grisette.Internal.Core.Data.Class.CEGISSolver

Description

 
Synopsis

Note for the examples

The examples assumes that the z3 solver is available in PATH.

Generic CEGIS interface

type SynthesisConstraintFun input = Int -> input -> IO SymBool Source #

Synthesis constraint function.

The first argument is the iteration number, for angelic programs, you can use it to instantiate the angelic variables in the program.

The second argument is the counter-example generated by the verifier.

The synthesizer will try to find a program that is true for all the synthesis constraints.

data VerifierResult input exception Source #

The result of the verifier.

type StatefulVerifierFun state input exception = state -> Model -> IO (state, VerifierResult input exception) Source #

The verifier function.

The first argument is the state of the verifier.

The second argument is the candidate model proposed by the synthesizer.

data CEGISResult exception Source #

The result of the CEGIS procedure.

Instances

Instances details
Show exception => Show (CEGISResult exception) Source # 
Instance details

Defined in Grisette.Internal.Core.Data.Class.CEGISSolver

Methods

showsPrec :: Int -> CEGISResult exception -> ShowS #

show :: CEGISResult exception -> String #

showList :: [CEGISResult exception] -> ShowS #

genericCEGIS Source #

Arguments

:: ConfigurableSolver config handle 
=> config

Configuration of the solver.

-> SymBool

The initial synthesis constraint.

-> SynthesisConstraintFun input

The synthesis constraint function.

-> verifierState

The initial state of the verifier.

-> StatefulVerifierFun verifierState input exception

The verifier function.

-> IO ([input], CEGISResult exception) 

Generic CEGIS procedure.

The CEGIS procedure will try to find a model that satisfies the initial synthesis constraint, and satisfies all the inputs generated by the verifier.

CEGIS interfaces with pre/post conditions

data CEGISCondition Source #

The condition for CEGIS to solve.

The first argument is the pre-condition, and the second argument is the post-condition.

The CEGIS procedures would try to find a model for the formula

\[ \forall P. (\exists I. \mathrm{pre}(P, I)) \wedge (\forall I. \mathrm{pre}(P, I)\implies \mathrm{post}(P, I)) \]

In program synthesis tasks, \(P\) is the symbolic constants in the symbolic program, and \(I\) is the input. The pre-condition is used to restrict the search space of the program. The procedure would only return programs that meets the pre-conditions on every possible inputs, and there are at least one possible input. The post-condition is used to specify the desired program behaviors.

cegisPostCond :: SymBool -> CEGISCondition Source #

Construct a CEGIS condition with only a post-condition. The pre-condition would be set to true, meaning that all programs in the program space are allowed.

cegisPrePost :: SymBool -> SymBool -> CEGISCondition Source #

Construct a CEGIS condition with both pre- and post-conditions.

cegisMultiInputs :: (EvaluateSym input, ExtractSymbolics input, ConfigurableSolver config handle) => config -> [input] -> (input -> CEGISCondition) -> IO ([input], CEGISResult SolvingFailure) Source #

CEGIS with multiple (possibly symbolic) inputs. Solves the following formula (see CEGISCondition for details).

\[ \forall P. (\exists I\in\mathrm{inputs}. \mathrm{pre}(P, I)) \wedge (\forall I\in\mathrm{inputs}. \mathrm{pre}(P, I)\implies \mathrm{post}(P, I)) \]

For simpler queries, where the inputs are representable by a single symbolic value, you may want to use cegis or cegisExcept instead. We have an example for the cegis call.

cegis Source #

Arguments

:: (ConfigurableSolver config handle, EvaluateSym inputs, ExtractSymbolics inputs, SEq inputs) 
=> config

The configuration of the solver

-> inputs

Initial symbolic inputs. The solver will try to find a program that works on all the inputs representable by it (see CEGISCondition).

-> (inputs -> CEGISCondition)

The condition for the solver to solve. All the symbolic constants that are not in the inputs will be considered as part of the symbolic program.

-> IO ([inputs], CEGISResult SolvingFailure)

The counter-examples generated during the CEGIS loop, and the model found by the solver.

CEGIS with a single symbolic input to represent a set of inputs.

The following example tries to find the value of c such that for all positive x, x * c && c -2. The c .> -2 clause is used to make the solution unique.

>>> :set -XOverloadedStrings
>>> let [x,c] = ["x","c"] :: [SymInteger]
>>> cegis (precise z3) x (\x -> cegisPrePost (x .> 0) (x * c .< 0 .&& c .> -2))
(...,CEGISSuccess (Model {c -> -1 :: Integer}))

cegisExcept :: (UnionWithExcept t u e v, PlainUnion u, Functor u, EvaluateSym inputs, ExtractSymbolics inputs, ConfigurableSolver config handle, SEq inputs) => config -> inputs -> (Either e v -> CEGISCondition) -> (inputs -> t) -> IO ([inputs], CEGISResult SolvingFailure) Source #

CEGIS for symbolic programs with error handling, using a single symbolic input to represent a set of inputs.

cegisExcept is particularly useful when custom error types are used. With cegisExcept, you define how the errors are interpreted to the CEGIS conditions after the symbolic evaluation. This could increase the readability and modularity of the code.

The following example tries to find the value of c such that for all positive x, x * c && c -2. The c .> -2 assertion is used to make the solution unique.

>>> :set -XOverloadedStrings
>>> let [x,c] = ["x","c"] :: [SymInteger]
>>> import Control.Monad.Except
>>> :{
  res :: SymInteger -> ExceptT VerificationConditions UnionM ()
  res x = do
    symAssume $ x .> 0
    symAssert $ x * c .< 0
    symAssert $ c .> -2
:}
>>> :{
  translation (Left AssumptionViolation) = cegisPrePost (con False) (con True)
  translation (Left AssertionViolation) = cegisPostCond (con False)
  translation _ = cegisPostCond (con True)
:}
>>> cegisExcept (precise z3) x translation res
([...],CEGISSuccess (Model {c -> -1 :: Integer}))

cegisExceptStdVC :: (UnionWithExcept t u VerificationConditions (), PlainUnion u, Monad u, EvaluateSym inputs, ExtractSymbolics inputs, ConfigurableSolver config handle, SEq inputs) => config -> inputs -> (inputs -> t) -> IO ([inputs], CEGISResult SolvingFailure) Source #

CEGIS for symbolic programs with error handling, using a single symbolic input to represent a set of inputs. This function saves the efforts to implement the translation function for the standard error type VerificationConditions, and the standard result type ().

This function translates assumption violations to failed pre-conditions, and translates assertion violations to failed post-conditions. The () result will not fail any conditions.

The following example tries to find the value of c such that for all positive x, x * c && c -2. The c .> -2 assertion is used to make the solution unique.

>>> :set -XOverloadedStrings
>>> let [x,c] = ["x","c"] :: [SymInteger]
>>> import Control.Monad.Except
>>> :{
  res :: SymInteger -> ExceptT VerificationConditions UnionM ()
  res x = do
    symAssume $ x .> 0
    symAssert $ x * c .< 0
    symAssert $ c .> -2
:}
>>> cegisExceptStdVC (precise z3) x res
([...],CEGISSuccess (Model {c -> -1 :: Integer}))

cegisExceptVC :: (UnionWithExcept t u e v, PlainUnion u, Monad u, EvaluateSym inputs, ExtractSymbolics inputs, ConfigurableSolver config handle, SEq inputs) => config -> inputs -> (Either e v -> u (Either VerificationConditions ())) -> (inputs -> t) -> IO ([inputs], CEGISResult SolvingFailure) Source #

CEGIS for symbolic programs with error handling, using a single symbolic input to represent a set of inputs.

The errors should be translated to assertion or assumption violations.

cegisExceptMultiInputs :: (ConfigurableSolver config handle, EvaluateSym inputs, ExtractSymbolics inputs, UnionWithExcept t u e v, PlainUnion u, Monad u) => config -> [inputs] -> (Either e v -> CEGISCondition) -> (inputs -> t) -> IO ([inputs], CEGISResult SolvingFailure) Source #

CEGIS for symbolic programs with error handling, using multiple (possibly symbolic) inputs to represent a set of inputs.

cegisExceptStdVCMultiInputs :: (ConfigurableSolver config handle, EvaluateSym inputs, ExtractSymbolics inputs, UnionWithExcept t u VerificationConditions (), PlainUnion u, Monad u) => config -> [inputs] -> (inputs -> t) -> IO ([inputs], CEGISResult SolvingFailure) Source #

CEGIS for symbolic programs with error handling, using multiple (possibly symbolic) inputs to represent a set of inputs. This function saves the efforts to implement the translation function for the standard error type VerificationConditions, and the standard result type ().

This function translates assumption violations to failed pre-conditions, and translates assertion violations to failed post-conditions. The () result will not fail any conditions.

cegisExceptVCMultiInputs :: (ConfigurableSolver config handle, EvaluateSym inputs, ExtractSymbolics inputs, UnionWithExcept t u e v, PlainUnion u, Monad u) => config -> [inputs] -> (Either e v -> u (Either VerificationConditions ())) -> (inputs -> t) -> IO ([inputs], CEGISResult SolvingFailure) Source #

CEGIS for symbolic programs with error handling, using multiple (possibly symbolic) inputs to represent a set of inputs.

The errors should be translated to assertion or assumption violations.

cegisForAll Source #

Arguments

:: (ExtractSymbolics forallInput, ConfigurableSolver config handle) 
=> config 
-> forallInput

A symbolic value. All the symbolic constants in the value are treated as for-all variables.

-> CEGISCondition 
-> IO ([Model], CEGISResult SolvingFailure)

First output are the counter-examples for all the for-all variables, and the second output is the model for all other variables if CEGIS succeeds.

CEGIS with a single symbolic input to represent a set of inputs.

The following example tries to find the value of c such that for all positive x, x * c && c -2. The c .> -2 clause is used to make the solution unique.

>>> :set -XOverloadedStrings
>>> let [x,c] = ["x","c"] :: [SymInteger]
>>> cegisForAll (precise z3) x $ cegisPrePost (x .> 0) (x * c .< 0 .&& c .> -2)
(...,CEGISSuccess (Model {c -> -1 :: Integer}))

cegisForAllExcept :: (UnionWithExcept t u e v, PlainUnion u, Functor u, EvaluateSym inputs, ExtractSymbolics inputs, ConfigurableSolver config handle, SEq inputs) => config -> inputs -> (Either e v -> CEGISCondition) -> t -> IO ([Model], CEGISResult SolvingFailure) Source #

CEGIS for symbolic programs with error handling, with a forall variable.

See cegisForAll and cegisExcept.

cegisForAllExceptStdVC :: (UnionWithExcept t u VerificationConditions (), PlainUnion u, Monad u, EvaluateSym inputs, ExtractSymbolics inputs, ConfigurableSolver config handle, SEq inputs) => config -> inputs -> t -> IO ([Model], CEGISResult SolvingFailure) Source #

CEGIS for symbolic programs with error handling, with a forall variable.

See cegisForAll and cegisExceptStdVC.

cegisForAllExceptVC :: (UnionWithExcept t u e v, PlainUnion u, Monad u, EvaluateSym inputs, ExtractSymbolics inputs, ConfigurableSolver config handle, SEq inputs) => config -> inputs -> (Either e v -> u (Either VerificationConditions ())) -> t -> IO ([Model], CEGISResult SolvingFailure) Source #

CEGIS for symbolic programs with error handling, with a forall variable.

See cegisForAll and cegisExceptVC.