-- |
-- Module      : Data.Express.Triexpr
-- Copyright   : (c) 2019-2021 Rudy Matela
-- License     : 3-Clause BSD  (see the file LICENSE)
-- Maintainer  : Rudy Matela <rudy@matela.com.br>
--
-- This module is part of Express.
--
-- An __experimental__ data structure for matching 'Expr's.
--
-- __Warning (1):__
-- Take care when importing this module,
-- the interface is experimental
-- and may change at every minor version.
--
-- __Warning (2):__
-- YMMV:
-- Do not expect this to be faster than manually matching in a list,
-- provisional experiments show that it can be slower depending
-- on the set of expressions being matched.
--
-- This module should be imported qualified
-- as it exports definitions called
-- 'map', 'lookup', 'toList', 'fromList', 'insert' and 'empty':
--
-- > import Data.Express.Triexpr (Triexpr)
-- > import qualified Data.Express.Triexpr as T
module Data.Express.Triexpr
  ( Triexpr (..)
  , empty
  , unit
  , merge
  , insert
  , toList
  , fromList
  , map
  , lookup
  )
where

import Data.Express.Core
import Data.Express.Match
import Data.Maybe
import Prelude hiding (map, lookup)

-- | A trie of 'Expr's.
--
-- In the representation,
-- 'Nothing' matches an App and 'Just' 'Expr' an expression.
data Triexpr a = Triexpr [(Maybe Expr, Either (Triexpr a) (Expr,a))]
  deriving (Triexpr a -> Triexpr a -> Bool
forall a. Eq a => Triexpr a -> Triexpr a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Triexpr a -> Triexpr a -> Bool
$c/= :: forall a. Eq a => Triexpr a -> Triexpr a -> Bool
== :: Triexpr a -> Triexpr a -> Bool
$c== :: forall a. Eq a => Triexpr a -> Triexpr a -> Bool
Eq, Triexpr a -> Triexpr a -> Bool
Triexpr a -> Triexpr a -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a}. Ord a => Eq (Triexpr a)
forall a. Ord a => Triexpr a -> Triexpr a -> Bool
forall a. Ord a => Triexpr a -> Triexpr a -> Ordering
forall a. Ord a => Triexpr a -> Triexpr a -> Triexpr a
min :: Triexpr a -> Triexpr a -> Triexpr a
$cmin :: forall a. Ord a => Triexpr a -> Triexpr a -> Triexpr a
max :: Triexpr a -> Triexpr a -> Triexpr a
$cmax :: forall a. Ord a => Triexpr a -> Triexpr a -> Triexpr a
>= :: Triexpr a -> Triexpr a -> Bool
$c>= :: forall a. Ord a => Triexpr a -> Triexpr a -> Bool
> :: Triexpr a -> Triexpr a -> Bool
$c> :: forall a. Ord a => Triexpr a -> Triexpr a -> Bool
<= :: Triexpr a -> Triexpr a -> Bool
$c<= :: forall a. Ord a => Triexpr a -> Triexpr a -> Bool
< :: Triexpr a -> Triexpr a -> Bool
$c< :: forall a. Ord a => Triexpr a -> Triexpr a -> Bool
compare :: Triexpr a -> Triexpr a -> Ordering
$ccompare :: forall a. Ord a => Triexpr a -> Triexpr a -> Ordering
Ord, Int -> Triexpr a -> ShowS
forall a. Show a => Int -> Triexpr a -> ShowS
forall a. Show a => [Triexpr a] -> ShowS
forall a. Show a => Triexpr a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Triexpr a] -> ShowS
$cshowList :: forall a. Show a => [Triexpr a] -> ShowS
show :: Triexpr a -> String
$cshow :: forall a. Show a => Triexpr a -> String
showsPrec :: Int -> Triexpr a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Triexpr a -> ShowS
Show)

-- | An empty 'Triexpr'.
empty :: Triexpr a
empty :: forall a. Triexpr a
empty  =  forall a. [(Maybe Expr, Either (Triexpr a) (Expr, a))] -> Triexpr a
Triexpr []

-- | Constructs a 'Triexpr' encoding a single expression.
unit :: Expr -> a -> Triexpr a
unit :: forall a. Expr -> a -> Triexpr a
unit Expr
e a
x  =  forall a. Expr -> Either (Triexpr a) (Expr, a) -> Triexpr a
u Expr
e (forall a b. b -> Either a b
Right (Expr
e,a
x))
  where
  u :: Expr -> (Either (Triexpr a) (Expr,a)) -> Triexpr a
  u :: forall a. Expr -> Either (Triexpr a) (Expr, a) -> Triexpr a
u (Expr
e1 :$ Expr
e2) Either (Triexpr a) (Expr, a)
et  =  forall a. [(Maybe Expr, Either (Triexpr a) (Expr, a))] -> Triexpr a
Triexpr [(forall a. Maybe a
Nothing, forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall a. Expr -> Either (Triexpr a) (Expr, a) -> Triexpr a
u Expr
e1 forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall a. Expr -> Either (Triexpr a) (Expr, a) -> Triexpr a
u Expr
e2 Either (Triexpr a) (Expr, a)
et)]
  u Expr
e          Either (Triexpr a) (Expr, a)
et  =  forall a. [(Maybe Expr, Either (Triexpr a) (Expr, a))] -> Triexpr a
Triexpr [(forall a. a -> Maybe a
Just Expr
e,  Either (Triexpr a) (Expr, a)
et)]

-- | Merges two 'Triexpr's.
merge :: Triexpr a -> Triexpr a -> Triexpr a
merge :: forall a. Triexpr a -> Triexpr a -> Triexpr a
merge (Triexpr [(Maybe Expr, Either (Triexpr a) (Expr, a))]
ms1) (Triexpr [(Maybe Expr, Either (Triexpr a) (Expr, a))]
ms2)  =  forall a. [(Maybe Expr, Either (Triexpr a) (Expr, a))] -> Triexpr a
Triexpr forall a b. (a -> b) -> a -> b
$ forall {a} {a} {b}.
Ord a =>
[(a, Either (Triexpr a) b)]
-> [(a, Either (Triexpr a) b)] -> [(a, Either (Triexpr a) b)]
m [(Maybe Expr, Either (Triexpr a) (Expr, a))]
ms1 [(Maybe Expr, Either (Triexpr a) (Expr, a))]
ms2
  where
  m :: [(a, Either (Triexpr a) b)]
-> [(a, Either (Triexpr a) b)] -> [(a, Either (Triexpr a) b)]
m [] [(a, Either (Triexpr a) b)]
ms  =  [(a, Either (Triexpr a) b)]
ms
  m [(a, Either (Triexpr a) b)]
ms []  =  [(a, Either (Triexpr a) b)]
ms
  m ((a
e1,Either (Triexpr a) b
mt1):[(a, Either (Triexpr a) b)]
ms1) ((a
e2,Either (Triexpr a) b
mt2):[(a, Either (Triexpr a) b)]
ms2)  =  case forall a. Ord a => a -> a -> Ordering
compare a
e1 a
e2 of
    Ordering
LT -> (a
e1,Either (Triexpr a) b
mt1) forall a. a -> [a] -> [a]
: [(a, Either (Triexpr a) b)]
-> [(a, Either (Triexpr a) b)] -> [(a, Either (Triexpr a) b)]
m [(a, Either (Triexpr a) b)]
ms1 ((a
e2,Either (Triexpr a) b
mt2)forall a. a -> [a] -> [a]
:[(a, Either (Triexpr a) b)]
ms2)
    Ordering
GT -> (a
e2,Either (Triexpr a) b
mt2) forall a. a -> [a] -> [a]
: [(a, Either (Triexpr a) b)]
-> [(a, Either (Triexpr a) b)] -> [(a, Either (Triexpr a) b)]
m ((a
e1,Either (Triexpr a) b
mt1)forall a. a -> [a] -> [a]
:[(a, Either (Triexpr a) b)]
ms1) [(a, Either (Triexpr a) b)]
ms2
    Ordering
EQ -> case (Either (Triexpr a) b
mt1,Either (Triexpr a) b
mt2) of
          (Left Triexpr a
t1, Left Triexpr a
t2) -> (a
e1, forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Triexpr a
t1 forall a. Triexpr a -> Triexpr a -> Triexpr a
`merge` Triexpr a
t2) forall a. a -> [a] -> [a]
: [(a, Either (Triexpr a) b)]
-> [(a, Either (Triexpr a) b)] -> [(a, Either (Triexpr a) b)]
m [(a, Either (Triexpr a) b)]
ms1 [(a, Either (Triexpr a) b)]
ms2
          (Either (Triexpr a) b
_,Either (Triexpr a) b
_) -> (a
e1,Either (Triexpr a) b
mt1) forall a. a -> [a] -> [a]
: (a
e2,Either (Triexpr a) b
mt2) forall a. a -> [a] -> [a]
: [(a, Either (Triexpr a) b)]
-> [(a, Either (Triexpr a) b)] -> [(a, Either (Triexpr a) b)]
m [(a, Either (Triexpr a) b)]
ms1 [(a, Either (Triexpr a) b)]
ms2

-- | Inserts an 'Expr' into a 'Triexpr'.
insert :: Expr -> a -> Triexpr a -> Triexpr a
insert :: forall a. Expr -> a -> Triexpr a -> Triexpr a
insert Expr
e a
x Triexpr a
t  =  forall a. Expr -> a -> Triexpr a
unit Expr
e a
x forall a. Triexpr a -> Triexpr a -> Triexpr a
`merge` Triexpr a
t

-- | List all 'Expr' stored in a 'Triexpr' along with their associated values.
toList :: Triexpr a -> [(Expr, a)]
toList :: forall a. Triexpr a -> [(Expr, a)]
toList (Triexpr [(Maybe Expr, Either (Triexpr a) (Expr, a))]
ms)  =  forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall {a} {a}. (a, Either (Triexpr a) (Expr, a)) -> [(Expr, a)]
to [(Maybe Expr, Either (Triexpr a) (Expr, a))]
ms
  where
  to :: (a, Either (Triexpr a) (Expr, a)) -> [(Expr, a)]
to (a
_, Right (Expr, a)
ex)  =  [(Expr, a)
ex]
  to (a
_, Left Triexpr a
t)  =  forall a. Triexpr a -> [(Expr, a)]
toList Triexpr a
t

-- | Constructs a 'Triexpr' form a list of key 'Expr's and associated values.
fromList :: [(Expr, a)] -> Triexpr a
fromList :: forall a. [(Expr, a)] -> Triexpr a
fromList  =  forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Expr -> a -> Triexpr a -> Triexpr a
insert) forall a. Triexpr a
empty

-- | Maps a function to the stored values in a 'Triexpr'.
map :: (a -> b) -> Triexpr a -> Triexpr b
map :: forall a b. (a -> b) -> Triexpr a -> Triexpr b
map a -> b
f (Triexpr [(Maybe Expr, Either (Triexpr a) (Expr, a))]
ms)  =  forall a. [(Maybe Expr, Either (Triexpr a) (Expr, a))] -> Triexpr a
Triexpr [(Maybe Expr
ex, forall a c b d. (a -> c) -> (b -> d) -> Either a b -> Either c d
mapEither (forall a b. (a -> b) -> Triexpr a -> Triexpr b
map a -> b
f) (forall a b c. (a -> b) -> (c, a) -> (c, b)
mapSnd a -> b
f) Either (Triexpr a) (Expr, a)
eth) | (Maybe Expr
ex, Either (Triexpr a) (Expr, a)
eth) <- [(Maybe Expr, Either (Triexpr a) (Expr, a))]
ms]
  where
  mapEither :: (a -> c) -> (b -> d) -> Either a b -> Either c d
  mapEither :: forall a c b d. (a -> c) -> (b -> d) -> Either a b -> Either c d
mapEither a -> c
f b -> d
g (Left a
x)   =  forall a b. a -> Either a b
Left (a -> c
f a
x)
  mapEither a -> c
f b -> d
g (Right b
y)  =  forall a b. b -> Either a b
Right (b -> d
g b
y)
  mapSnd :: (a -> b) -> (c,a) -> (c,b)
  mapSnd :: forall a b c. (a -> b) -> (c, a) -> (c, b)
mapSnd a -> b
f (c
x,a
y)  =  (c
x, a -> b
f a
y)

-- | Performs a lookup in a 'Triexpr'.
lookup :: Expr -> Triexpr a -> [ (Expr, [(Expr,Expr)], a) ]
lookup :: forall a. Expr -> Triexpr a -> [(Expr, [(Expr, Expr)], a)]
lookup Expr
e Triexpr a
t  =  [(Expr
e, [(Expr, Expr)]
bs, a
x) | ([(Expr, Expr)]
bs, Right (Expr
e,a
x)) <- forall a.
Maybe Expr
-> Triexpr a
-> [(Expr, Expr)]
-> [([(Expr, Expr)], Either (Triexpr a) (Expr, a))]
look (forall a. a -> Maybe a
Just Expr
e) Triexpr a
t []]
  where
  look :: Maybe Expr -> Triexpr a -> [(Expr, Expr)] -> [([(Expr,Expr)], Either (Triexpr a) (Expr,a))]
  look :: forall a.
Maybe Expr
-> Triexpr a
-> [(Expr, Expr)]
-> [([(Expr, Expr)], Either (Triexpr a) (Expr, a))]
look Maybe Expr
Nothing  t :: Triexpr a
t@(Triexpr [(Maybe Expr, Either (Triexpr a) (Expr, a))]
ms) [(Expr, Expr)]
bs  =  [([(Expr, Expr)]
bs, Either (Triexpr a) (Expr, a)
mt) | (Maybe Expr
Nothing, Either (Triexpr a) (Expr, a)
mt) <- [(Maybe Expr, Either (Triexpr a) (Expr, a))]
ms]
  look (Just Expr
e) t :: Triexpr a
t@(Triexpr [(Maybe Expr, Either (Triexpr a) (Expr, a))]
ms) [(Expr, Expr)]
bs  =  [([(Expr, Expr)]
bs', Either (Triexpr a) (Expr, a)
mt) | (Just Expr
e', Either (Triexpr a) (Expr, a)
mt) <- [(Maybe Expr, Either (Triexpr a) (Expr, a))]
ms, [(Expr, Expr)]
bs' <- forall a. Maybe a -> [a]
maybeToList ([(Expr, Expr)] -> Expr -> Expr -> Maybe [(Expr, Expr)]
matchWith [(Expr, Expr)]
bs Expr
e Expr
e')]
                                   forall a. [a] -> [a] -> [a]
++ [([(Expr, Expr)], Either (Triexpr a) (Expr, a))
r | Expr
e1 :$ Expr
e2 <- [Expr
e]
                                         , ([(Expr, Expr)]
bs1, Left Triexpr a
t1) <- forall a.
Maybe Expr
-> Triexpr a
-> [(Expr, Expr)]
-> [([(Expr, Expr)], Either (Triexpr a) (Expr, a))]
look forall a. Maybe a
Nothing Triexpr a
t [(Expr, Expr)]
bs
                                         , ([(Expr, Expr)]
bs2, Left Triexpr a
t2) <- forall a.
Maybe Expr
-> Triexpr a
-> [(Expr, Expr)]
-> [([(Expr, Expr)], Either (Triexpr a) (Expr, a))]
look (forall a. a -> Maybe a
Just Expr
e1) Triexpr a
t1 [(Expr, Expr)]
bs1
                                         , ([(Expr, Expr)], Either (Triexpr a) (Expr, a))
r              <- forall a.
Maybe Expr
-> Triexpr a
-> [(Expr, Expr)]
-> [([(Expr, Expr)], Either (Triexpr a) (Expr, a))]
look (forall a. a -> Maybe a
Just Expr
e2) Triexpr a
t2 [(Expr, Expr)]
bs2]