speculate-0.2.6: discovery of properties about Haskell functions

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

Test.Speculate.Expr.Match

Contents

Description

This module is part of Speculate.

Matching expressions.

Synopsis

Documentation

type Binds = [(String, Expr)] Source #

Assigning

fill :: Expr -> [Expr] -> Expr Source #

Fill holes in an expression. Silently skips holes that are not of the right type. Silently discard remaining expressions.

assign :: String -> Expr -> Expr -> Expr Source #

Assign all occurences of a variable in an expression.

Examples in pseudo-Haskell:

assign "x" (10) (x + y) = (10 + y)
assign "y" (y + z) ((x + y) + (y + z)) = (x + (y + z)) + ((y + z) + z)

This respects the type (won't change occurrences of a similarly named variable of a different type).

assigning :: Expr -> Binds -> Expr Source #

Assign all occurrences of several variables in an expression.

For single variables, this works as assign:

x + y `assigning` [("x",10)] = (10 + y)
((x + y) + (y + z)) `assigning` [("y",y+z)] = (x + (y + z)) + ((y + z) + z)

Note this is not equivalent to foldr (uncurry assign). Variables inside expressions being assigned will not be assigned.

sub :: Expr -> Expr -> Expr -> Expr Source #

Substitute matching subexpressios.

sub (x + y) 0 ((x + y) + z) == (0 + z) sub (x + y) 0 (x + (y + z)) == (x + (y + z))

renameBy :: (String -> String) -> Expr -> Expr Source #

Primeify variable names in an expression.

renameBy (++ "'") (x + y) = (x' + y')
renameBy (++ "'") (y + (z + x)) = (y' + (z' + x'))
renameBy (++ "1") abs x = abs x1
renameBy (++ "2") abs (x + y) = abs (x2 + y2)

Note this will affect holes!

Matching

match :: Expr -> Expr -> Maybe Binds Source #

List matches if possible

0 + 1       `match` x + y       = Just [x=0, y=1]
0 + (1 + 2) `match` x + y       = Just [x=0, y=1 + 2]
0 + (1 + 2) `match` x + (y + y) = Nothing
(x + x) + (1 + 2) `match` x + (y + y) = Nothing

match2 :: (Expr, Expr) -> (Expr, Expr) -> Maybe Binds Source #

List matches of pairs of expressions if possible

(0,1)   `match2` (x,y)   = Just [x=0, y=1]
(0,1+2) `match2` (x,y+y) = Nothing

matchWith :: Binds -> Expr -> Expr -> Maybe Binds Source #

List matches with preexisting bindings:

0 + 1 `matchWith [(x,0)]` x + y = Just [x=0, y=1]
0 + 1 `matchWith [(x,1)]` x + y = Nothing