express-0.1.3: Dynamically-typed expressions involving applications and variables.

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

Data.Express.Canon

Description

Utilities for canonicalizing Exprs with variables.

Synopsis

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 Exprs.

> 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]
> canonicalVariations $ ii -+- jj
[i + j :: Int]

Behaviour is undefined when applying this function to expressions already containing variables.

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 Exprs 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.