extrapolate-0.4.1: generalize counter-examples of test properties

Copyright(c) 2017-2019 Rudy Matela
License3-Clause BSD (see the file LICENSE)
MaintainerRudy Matela <rudy@matela.com.br>
Safe HaskellNone
LanguageHaskell2010

Test.Extrapolate.Generalization

Description

This module is part of Extrapolate, a library for generalization of counter-examples.

This defines utilities for unconditional generalization.

You are probably better off importing Test.Extrapolate.

Synopsis

Documentation

counterExampleGeneralizations :: (Expr -> [Expr]) -> Expr -> [Expr] Source #

Given boolean expression representing a counter-example, returns all possible unconditional generalizations.

If more than one generalization is returned, they are _not_ instances of one another. (cf. isInstanceOf) All according to a given function that lists ground expressions.

> counterExampleGeneralizations (groundsFor not) false
[]
> counterExampleGeneralizations (groundsFor not) (false -&&- true)
[False && p :: Bool]
> counterExampleGeneralizations (groundsFor not) (false -||- true)
[]
> counterExampleGeneralizations (groundsFor not) (false -/=- false)
[p /= p :: Bool]
> counterExampleGeneralizations (groundsFor not) (false -&&- true -&&- false)
[ (False && _) && _ :: Bool
, p && False :: Bool
]

candidateGeneralizations :: (Expr -> Bool) -> Expr -> [Expr] Source #

Returns candidate generalizations for an expression. (cf. candidateHoleGeneralizations)

This takes a function that returns whether to generalize a given subexpression.

> import Data.Express.Fixtures
> candidateGeneralizations (\e -> typ e == typ one) (one -+- two)
[ _ :: Int
, _ + _ :: Int
, x + x :: Int
, _ + 2 :: Int
, 1 + _ :: Int
]
> candidateGeneralizations (const True) (one -+- two)
[ _ :: Int
, _ _ :: Int
, _ _ _ :: Int
, _ x x :: Int
, _ 1 _ :: Int
, _ + _ :: Int
, x + x :: Int
, _ 2 :: Int
, _ _ 2 :: Int
, _ 1 2 :: Int
, _ + 2 :: Int
, 1 + _ :: Int
]

fastCandidateGeneralizations :: (Expr -> Bool) -> Expr -> [Expr] Source #

Like candidateGeneralizations but faster because result is not canonicalized. Variable names will be repeated across different types.

candidateHoleGeneralizations :: (Expr -> Bool) -> Expr -> [Expr] Source #

Returns candidate generalizations for an expression by replacing values with holes. (cf. candidateGeneralizations)

> import Data.Express.Fixtures
> candidateHoleGeneralizations (\e -> typ e == typ one) (one -+- two)
[ _ :: Int
, _ + _ :: Int
, _ + 2 :: Int
, 1 + _ :: Int
]
> candidateHoleGeneralizations (const True) (one -+- two)
[ _ :: Int
, _ _ :: Int
, _ _ _ :: Int
, _ 1 _ :: Int
, _ + _ :: Int
, _ 2 :: Int
, _ _ 2 :: Int
, _ 1 2 :: Int
, _ + 2 :: Int
, 1 + _ :: Int
]