Copyright | (c) 2019-2024 Rudy Matela |
---|---|
License | 3-Clause BSD (see the file LICENSE) |
Maintainer | Rudy Matela <rudy@matela.com.br> |
Safe Haskell | Safe-Inferred |
Language | Haskell2010 |
Utilities for canonicalizing Expr
s with variables.
Synopsis
- canonicalize :: Expr -> Expr
- canonicalizeWith :: (Expr -> [String]) -> Expr -> Expr
- canonicalization :: Expr -> [(Expr, Expr)]
- canonicalizationWith :: (Expr -> [String]) -> Expr -> [(Expr, Expr)]
- isCanonical :: Expr -> Bool
- isCanonicalWith :: (Expr -> [String]) -> Expr -> Bool
- canonicalVariations :: Expr -> [Expr]
- mostGeneralCanonicalVariation :: Expr -> Expr
- mostSpecificCanonicalVariation :: Expr -> Expr
- fastCanonicalVariations :: Expr -> [Expr]
- fastMostGeneralVariation :: Expr -> Expr
- fastMostSpecificVariation :: Expr -> Expr
Documentation
canonicalize :: Expr -> Expr Source #
Canonicalizes an Expr
so that variable names appear in order.
Variable names are taken from the preludeNameInstances
.
> canonicalize (xx -+- yy) x + y :: Int
> canonicalize (yy -+- xx) x + y :: Int
> canonicalize (xx -+- xx) x + x :: Int
> canonicalize (yy -+- yy) x + x :: Int
Constants are untouched:
> canonicalize (jj -+- (zero -+- abs' ii)) x + (y + abs y) :: Int
This also works for variable functions:
> canonicalize (gg yy -+- ff xx -+- gg xx) (f x + g y) + f y :: Int
canonicalizeWith :: (Expr -> [String]) -> Expr -> Expr Source #
Like canonicalize
but allows customization
of the list of variable names.
(cf. lookupNames
, variableNamesFromTemplate
)
> canonicalizeWith (const ["i","j","k","l",...]) (xx -+- yy) i + j :: Int
The argument Expr
of the argument function allows
to provide a different list of names for different types:
> let namesFor e > | typ e == typeOf (undefined::Char) = variableNamesFromTemplate "c1" > | typ e == typeOf (undefined::Int) = variableNamesFromTemplate "i" > | otherwise = variableNamesFromTemplate "x"
> canonicalizeWith namesFor ((xx -+- ord' dd) -+- (ord' cc -+- yy)) (i + ord c1) + (ord c2 + j) :: Int
canonicalization :: Expr -> [(Expr, Expr)] Source #
Return a canonicalization of an Expr
that makes variable names appear in order
using names
as provided by preludeNameInstances
.
By using //-
it can canonicalize
Expr
s.
> canonicalization (gg yy -+- ff xx -+- gg xx) [ (x :: Int, y :: Int) , (f :: Int -> Int, g :: Int -> Int) , (y :: Int, x :: Int) , (g :: Int -> Int, f :: Int -> Int) ]
> canonicalization (yy -+- xx -+- yy) [ (x :: Int, y :: Int) , (y :: Int, x :: Int) ]
canonicalizationWith :: (Expr -> [String]) -> Expr -> [(Expr, Expr)] Source #
Like canonicalization
but allows customization
of the list of variable names.
(cf. lookupNames
, variableNamesFromTemplate
)
isCanonical :: Expr -> Bool Source #
Returns whether an Expr
is canonical:
if applying canonicalize
is an identity
using names
as provided by preludeNameInstances
.
isCanonicalWith :: (Expr -> [String]) -> Expr -> Bool Source #
Like isCanonical
but allows specifying
the list of variable names.
canonicalVariations :: Expr -> [Expr] Source #
Returns all canonical variations of an Expr
by filling holes with variables.
Where possible, variations are listed
from most general to least general.
> canonicalVariations $ i_ [x :: Int]
> canonicalVariations $ i_ -+- i_ [ x + y :: Int , x + x :: Int ]
> canonicalVariations $ i_ -+- i_ -+- i_ [ (x + y) + z :: Int , (x + y) + x :: Int , (x + y) + y :: Int , (x + x) + y :: Int , (x + x) + x :: Int ]
> canonicalVariations $ i_ -+- ord' c_ [x + ord c :: Int]
> canonicalVariations $ i_ -+- i_ -+- ord' c_ [ (x + y) + ord c :: Int , (x + x) + ord c :: Int ]
> canonicalVariations $ i_ -+- i_ -+- length' (c_ -:- unit c_) [ (x + y) + length (c:d:"") :: Int , (x + y) + length (c:c:"") :: Int , (x + x) + length (c:d:"") :: Int , (x + x) + length (c:c:"") :: Int ]
In an expression without holes this functions just returns a singleton list with the expression itself:
> canonicalVariations $ val (0 :: Int) [0 :: Int]
> canonicalVariations $ ord' bee [ord 'b' :: Int]
When applying this to expressions already containing variables clashes are avoided and these variables are not touched:
> canonicalVariations $ i_ -+- ii -+- jj -+- i_ [ x + i + j + y :: Int , x + i + j + y :: Int ]
> canonicalVariations $ ii -+- jj [i + j :: Int]
> canonicalVariations $ xx -+- i_ -+- i_ -+- length' (c_ -:- unit c_) -+- yy [ (((x + z) + x') + length (c:d:"")) + y :: Int , (((x + z) + x') + length (c:c:"")) + y :: Int , (((x + z) + z) + length (c:d:"")) + y :: Int , (((x + z) + z) + length (c:c:"")) + y :: Int ]
mostGeneralCanonicalVariation :: Expr -> Expr Source #
Returns the most general canonical variation of an Expr
by filling holes with variables.
> mostGeneralCanonicalVariation $ i_ x :: Int
> mostGeneralCanonicalVariation $ i_ -+- i_ x + y :: Int
> mostGeneralCanonicalVariation $ i_ -+- i_ -+- i_ (x + y) + z :: Int
> mostGeneralCanonicalVariation $ i_ -+- ord' c_ x + ord c :: Int
> mostGeneralCanonicalVariation $ i_ -+- i_ -+- ord' c_ (x + y) + ord c :: Int
> mostGeneralCanonicalVariation $ i_ -+- i_ -+- length' (c_ -:- unit c_) (x + y) + length (c:d:"") :: Int
In an expression without holes this functions just returns the given expression itself:
> mostGeneralCanonicalVariation $ val (0 :: Int) 0 :: Int
> mostGeneralCanonicalVariation $ ord' bee ord 'b' :: Int
This function is the same as taking the head
of canonicalVariations
but a bit faster.
mostSpecificCanonicalVariation :: Expr -> Expr Source #
Returns the most specific canonical variation of an Expr
by filling holes with variables.
> mostSpecificCanonicalVariation $ i_ x :: Int
> mostSpecificCanonicalVariation $ i_ -+- i_ x + x :: Int
> mostSpecificCanonicalVariation $ i_ -+- i_ -+- i_ (x + x) + x :: Int
> mostSpecificCanonicalVariation $ i_ -+- ord' c_ x + ord c :: Int
> mostSpecificCanonicalVariation $ i_ -+- i_ -+- ord' c_ (x + x) + ord c :: Int
> mostSpecificCanonicalVariation $ i_ -+- i_ -+- length' (c_ -:- unit c_) (x + x) + length (c:c:"") :: Int
In an expression without holes this functions just returns the given expression itself:
> mostSpecificCanonicalVariation $ val (0 :: Int) 0 :: Int
> mostSpecificCanonicalVariation $ ord' bee ord 'b' :: Int
This function is the same as taking the last
of canonicalVariations
but a bit faster.
fastCanonicalVariations :: Expr -> [Expr] Source #
A faster version of canonicalVariations
that
disregards name clashes across different types.
Results are confusing to the user
but fine for Express which differentiates
between variables with the same name but different types.
Without applying canonicalize
, the following Expr
may seem to have only one variable:
> fastCanonicalVariations $ i_ -+- ord' c_ [x + ord x :: Int]
Where in fact it has two, as the second x
has a different type.
Applying canonicalize
disambiguates:
> map canonicalize . fastCanonicalVariations $ i_ -+- ord' c_ [x + ord c :: Int]
This function is useful when resulting Expr
s are
not intended to be presented to the user
but instead to be used by another function.
It is simply faster to skip the step where clashes are resolved.
fastMostGeneralVariation :: Expr -> Expr Source #
A faster version of mostGeneralCanonicalVariation
that disregards name clashes across different types.
Consider using mostGeneralCanonicalVariation
instead.
The same caveats of fastCanonicalVariations
do apply here.
fastMostSpecificVariation :: Expr -> Expr Source #
A faster version of mostSpecificCanonicalVariation
that disregards name clashes across different types.
Consider using mostSpecificCanonicalVariation
instead.
The same caveats of fastCanonicalVariations
do apply here.