-- |
-- Module      : Data.Express.Match
-- Copyright   : (c) 2019-2024 Rudy Matela
-- License     : 3-Clause BSD  (see the file LICENSE)
-- Maintainer  : Rudy Matela <rudy@matela.com.br>
--
-- Utilities for matching 'Expr's with 'var'iables.
module Data.Express.Match
  ( match
  , matchWith
  , isInstanceOf
  , hasInstanceOf
  , isSubexprOf
  , encompasses
  )
where

import Data.Express.Core
import Data.Express.Utils

-- |
-- Given two expressions, returns a 'Just' list of matches
-- of subexpressions of the first expressions
-- to variables in the second expression.
-- Returns 'Nothing' when there is no match.
--
-- > > let zero = val (0::Int)
-- > > let one  = val (1::Int)
-- > > let xx   = var "x" (undefined :: Int)
-- > > let yy   = var "y" (undefined :: Int)
-- > > let e1 -+- e2  =  value "+" ((+)::Int->Int->Int) :$ e1 :$ e2
--
-- > > (zero -+- one) `match` (xx -+- yy)
-- > Just [(y :: Int,1 :: Int),(x :: Int,0 :: Int)]
--
-- > > (zero -+- (one -+- two)) `match` (xx -+- yy)
-- > Just [(y :: Int,1 + 2 :: Int),(x :: Int,0 :: Int)]
--
-- > > (zero -+- (one -+- two)) `match` (xx -+- (yy -+- yy))
-- > Nothing
--
-- In short:
--
-- >           (zero -+- one) `match` (xx -+- yy)           =  Just [(xx,zero), (yy,one)]
-- > (zero -+- (one -+- two)) `match` (xx -+- yy)           =  Just [(xx,zero), (yy,one-+-two)]
-- > (zero -+- (one -+- two)) `match` (xx -+- (yy -+- yy))  =  Nothing
match :: Expr -> Expr -> Maybe [(Expr,Expr)]
match :: Expr -> Expr -> Maybe [(Expr, Expr)]
match  =  [(Expr, Expr)] -> Expr -> Expr -> Maybe [(Expr, Expr)]
matchWith []

-- |
-- Like 'match' but allowing predefined bindings.
--
-- > matchWith [(xx,zero)] (zero -+- one) (xx -+- yy)  =  Just [(xx,zero), (yy,one)]
-- > matchWith [(xx,one)]  (zero -+- one) (xx -+- yy)  =  Nothing
matchWith :: [(Expr,Expr)] -> Expr -> Expr -> Maybe [(Expr,Expr)]
matchWith :: [(Expr, Expr)] -> Expr -> Expr -> Maybe [(Expr, Expr)]
matchWith [(Expr, Expr)]
bs Expr
e1' Expr
e2'  =  Expr -> Expr -> [(Expr, Expr)] -> Maybe [(Expr, Expr)]
m Expr
e1' Expr
e2' [(Expr, Expr)]
bs
  where
  m :: Expr -> Expr -> [(Expr,Expr)] -> Maybe [(Expr,Expr)]
  m :: Expr -> Expr -> [(Expr, Expr)] -> Maybe [(Expr, Expr)]
m (Expr
f1 :$ Expr
x1) (Expr
f2 :$ Expr
x2)             =  Expr -> Expr -> [(Expr, Expr)] -> Maybe [(Expr, Expr)]
m Expr
f1 Expr
f2 ([(Expr, Expr)] -> Maybe [(Expr, Expr)])
-> ([(Expr, Expr)] -> Maybe [(Expr, Expr)])
-> [(Expr, Expr)]
-> Maybe [(Expr, Expr)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Expr -> Expr -> [(Expr, Expr)] -> Maybe [(Expr, Expr)]
m Expr
x1 Expr
x2
  m Expr
e1 Expr
e2
    | Expr -> Bool
isVar Expr
e2 Bool -> Bool -> Bool
&& Expr -> Maybe TypeRep
mtyp Expr
e1 Maybe TypeRep -> Maybe TypeRep -> Bool
forall a. Eq a => a -> a -> Bool
== Expr -> Maybe TypeRep
mtyp Expr
e2  =  (Expr, Expr) -> [(Expr, Expr)] -> Maybe [(Expr, Expr)]
updateAssignments (Expr
e2,Expr
e1)
    | Expr
e1 Expr -> Expr -> Bool
forall a. Eq a => a -> a -> Bool
== Expr
e2                        =  [(Expr, Expr)] -> Maybe [(Expr, Expr)]
forall a. a -> Maybe a
Just
    | Bool
otherwise                       =  Maybe [(Expr, Expr)] -> [(Expr, Expr)] -> Maybe [(Expr, Expr)]
forall a b. a -> b -> a
const Maybe [(Expr, Expr)]
forall a. Maybe a
Nothing

updateAssignments :: (Expr,Expr) -> [(Expr,Expr)] -> Maybe [(Expr,Expr)]
updateAssignments :: (Expr, Expr) -> [(Expr, Expr)] -> Maybe [(Expr, Expr)]
updateAssignments (Expr
e,Expr
e')  =  \[(Expr, Expr)]
bs ->
  case Expr -> [(Expr, Expr)] -> Maybe Expr
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Expr
e [(Expr, Expr)]
bs of
  Maybe Expr
Nothing  -> [(Expr, Expr)] -> Maybe [(Expr, Expr)]
forall a. a -> Maybe a
Just ((Expr
e,Expr
e')(Expr, Expr) -> [(Expr, Expr)] -> [(Expr, Expr)]
forall a. a -> [a] -> [a]
:[(Expr, Expr)]
bs)
  Just Expr
e'' -> if Expr
e'' Expr -> Expr -> Bool
forall a. Eq a => a -> a -> Bool
== Expr
e'
              then [(Expr, Expr)] -> Maybe [(Expr, Expr)]
forall a. a -> Maybe a
Just [(Expr, Expr)]
bs
              else Maybe [(Expr, Expr)]
forall a. Maybe a
Nothing

-- |
-- Given two 'Expr's,
-- checks if the first expression
-- is an instance of the second
-- in terms of variables.
-- (cf. 'encompasses', 'hasInstanceOf')
--
-- > > let zero = val (0::Int)
-- > > let one  = val (1::Int)
-- > > let xx   = var "x" (undefined :: Int)
-- > > let yy   = var "y" (undefined :: Int)
-- > > let e1 -+- e2  =  value "+" ((+)::Int->Int->Int) :$ e1 :$ e2
--
-- >  one `isInstanceOf` one   =  True
-- >   xx `isInstanceOf` xx    =  True
-- >   yy `isInstanceOf` xx    =  True
-- > zero `isInstanceOf` xx    =  True
-- >   xx `isInstanceOf` zero  =  False
-- >  one `isInstanceOf` zero  =  False
-- >   (xx -+- (yy -+- xx)) `isInstanceOf`   (xx -+- yy)  =  True
-- >   (yy -+- (yy -+- xx)) `isInstanceOf`   (xx -+- yy)  =  True
-- > (zero -+- (yy -+- xx)) `isInstanceOf` (zero -+- yy)  =  True
-- >  (one -+- (yy -+- xx)) `isInstanceOf` (zero -+- yy)  =  False
isInstanceOf :: Expr -> Expr -> Bool
Expr
e1 isInstanceOf :: Expr -> Expr -> Bool
`isInstanceOf` Expr
e2  =  Maybe [(Expr, Expr)] -> Bool
forall a. Maybe a -> Bool
isJust (Maybe [(Expr, Expr)] -> Bool) -> Maybe [(Expr, Expr)] -> Bool
forall a b. (a -> b) -> a -> b
$ Expr
e1 Expr -> Expr -> Maybe [(Expr, Expr)]
`match` Expr
e2


-- |
-- Given two 'Expr's,
-- checks if the first expression
-- encompasses the second expression
-- in terms of variables.
--
-- This is equivalent to flipping the arguments of 'isInstanceOf'.
--
-- > zero `encompasses` xx    =  False
-- >   xx `encompasses` zero  =  True
encompasses :: Expr -> Expr -> Bool
encompasses :: Expr -> Expr -> Bool
encompasses  =  (Expr -> Expr -> Bool) -> Expr -> Expr -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Expr -> Expr -> Bool
isInstanceOf


-- |
-- Checks if any of the subexpressions of the first argument 'Expr'
-- is an instance of the second argument 'Expr'.
hasInstanceOf :: Expr -> Expr -> Bool
Expr
e1 hasInstanceOf :: Expr -> Expr -> Bool
`hasInstanceOf` Expr
e2  =  (Expr -> Bool) -> [Expr] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Expr -> Expr -> Bool
`isInstanceOf` Expr
e2) (Expr -> [Expr]
subexprs Expr
e1)

-- | /O(n^2)/.
-- Checks if an 'Expr' is a subexpression of another.
--
-- > > (xx -+- yy) `isSubexprOf` (zz -+- (xx -+- yy))
-- > True
--
-- > > (xx -+- yy) `isSubexprOf` abs' (yy -+- xx)
-- > False
--
-- > > xx `isSubexprOf` yy
-- > False
isSubexprOf :: Expr -> Expr -> Bool
isSubexprOf :: Expr -> Expr -> Bool
isSubexprOf Expr
e  =  (Expr
e Expr -> [Expr] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem`) ([Expr] -> Bool) -> (Expr -> [Expr]) -> Expr -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> [Expr]
subexprs