Copyright | (c) 2016-2017 Rudy Matela |
---|---|
License | 3-Clause BSD (see the file LICENSE) |
Maintainer | Rudy Matela <[email protected]> |
Safe Haskell | None |
Language | Haskell2010 |
Test.Speculate.Expr.Match
Description
This module is part of Speculate.
Matching expressions.
- type Binds = [(String, Expr)]
- fill :: Expr -> [Expr] -> Expr
- assign :: String -> Expr -> Expr -> Expr
- assigning :: Expr -> Binds -> Expr
- sub :: Expr -> Expr -> Expr -> Expr
- renameBy :: (String -> String) -> Expr -> Expr
- match :: Expr -> Expr -> Maybe Binds
- match2 :: (Expr, Expr) -> (Expr, Expr) -> Maybe Binds
- matchWith :: Binds -> Expr -> Expr -> Maybe Binds
- unify :: Expr -> Expr -> Maybe Expr
- unification :: Expr -> Expr -> Maybe Binds
- isInstanceOf :: Expr -> Expr -> Bool
- hasInstanceOf :: Expr -> Expr -> Bool
- isCanonInstanceOf :: Expr -> Expr -> Bool
- hasCanonInstanceOf :: Expr -> Expr -> Bool
Documentation
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