-- |
-- Module      : Conjure.Expr
-- Copyright   : (c) 2021 Rudy Matela
-- License     : 3-Clause BSD  (see the file LICENSE)
-- Maintainer  : Rudy Matela <rudy@matela.com.br>
--
-- This internal module reexports 'Data.Express' along with a few other
-- utilities.
{-# LANGUAGE CPP #-}
module Conjure.Expr
  ( module Data.Express
  , module Data.Express.Fixtures

  , funToVar
  , recursexpr
  , apparentlyTerminates
  , mayNotEvaluateArgument
  , applicationOld
  , compareSimplicity
  , ifFor

  , module Conjure.Utils
  )
where

import Conjure.Utils

import Data.Express
import Data.Express.Fixtures hiding ((-==-))

-- | /O(n)/.
-- Compares the simplicity of two 'Expr's.
-- An expression /e1/ is /strictly simpler/ than another expression /e2/
-- if the first of the following conditions to distingish between them is:
--
-- 1. /e1/ is smaller in size\/length than /e2/,
--    e.g.: @x + y < x + (y + z)@;
--
-- 2. or, /e1/ has less variable occurrences than /e2/,
--
-- 3. or, /e1/ has fewer distinct constants than /e2/,
--    e.g.: @1 + 1 < 0 + 1@.
--
-- They're otherwise considered of equal complexity,
-- e.g.: @x + y@ and @y + z@.
--
-- > > (xx -+- yy) `compareComplexity` (xx -+- (yy -+- zz))
-- > LT
--
-- > > (xx -+- yy) `compareComplexity` (xx -+- xx)
-- > EQ
--
-- > > (xx -+- xx) `compareComplexity` (one -+- xx)
-- > GT
--
-- > > (one -+- one) `compareComplexity` (zero -+- one)
-- > LT
--
-- > > (xx -+- yy) `compareComplexity` (yy -+- zz)
-- > EQ
--
-- > > (zero -+- one) `compareComplexity` (one -+- zero)
-- > EQ
compareSimplicity :: Expr -> Expr -> Ordering
compareSimplicity :: Expr -> Expr -> Ordering
compareSimplicity  =  (Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Int -> Int -> Ordering)
-> (Expr -> Int) -> Expr -> Expr -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` [Expr] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Expr] -> Int) -> (Expr -> [Expr]) -> Expr -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> [Expr]
values)
                   (Expr -> Expr -> Ordering)
-> (Expr -> Expr -> Ordering) -> Expr -> Expr -> Ordering
forall a. Semigroup a => a -> a -> a
<> (Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Int -> Int -> Ordering)
-> (Expr -> Int) -> Expr -> Expr -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` [Expr] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Expr] -> Int) -> (Expr -> [Expr]) -> Expr -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> [Expr]
vars)
                   (Expr -> Expr -> Ordering)
-> (Expr -> Expr -> Ordering) -> Expr -> Expr -> Ordering
forall a. Semigroup a => a -> a -> a
<> (Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Int -> Int -> Ordering)
-> (Expr -> Int) -> Expr -> Expr -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` [Expr] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Expr] -> Int) -> (Expr -> [Expr]) -> Expr -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> [Expr]
nubConsts)

-- | Makes the function in an application a variable
funToVar :: Expr -> Expr
funToVar :: Expr -> Expr
funToVar (Expr
ef :$ Expr
ex)  =  Expr -> Expr
funToVar Expr
ef Expr -> Expr -> Expr
:$ Expr
ex
funToVar ef :: Expr
ef@(Value String
nm Dynamic
_)  =  String
nm String -> Expr -> Expr
`varAsTypeOf` Expr
ef

-- | Expands recursive calls on an expression
--   until the given size limit is reached.
--
-- > > recursexpr 6 (ff xx) (ff xx)
-- > f x :: Int
--
-- > > recursexpr 6 (ff xx) (one -+- ff xx)
-- > 1 + (1 + (1 + (1 + f x))) :: Int
--
-- > > recursexpr 6 (ff xx) (if' pp one (xx -*- ff xx))
-- > (if p then 1 else x * (if p then 1 else x * f x)) :: Int
--
-- > > recursexpr 6 (ff xx) (if' pp one (xx -*- ff (gg xx)))
-- > (if p then 1 else x * (if p then 1 else g x * f (g (g x)))) :: Int
recursexpr :: Int -> Expr -> Expr -> Expr
recursexpr :: Int -> Expr -> Expr -> Expr
recursexpr Int
sz Expr
epat  =  Expr -> Expr
re
  where
  err :: a
err  =  String -> a
forall a. HasCallStack => String -> a
error String
"recursexpr: pattern must contain an application of variables"
  (Expr
erf:[Expr]
vs)  =  Expr -> [Expr]
unfoldApp Expr
epat
  re :: Expr -> Expr
re Expr
e' | Bool -> Bool
not ((Expr -> Bool) -> [Expr] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Expr -> Bool
isVar (Expr
erfExpr -> [Expr] -> [Expr]
forall a. a -> [a] -> [a]
:[Expr]
vs))  =  Expr
forall a. a
err
        | Expr
e Expr -> Expr -> Bool
forall a. Eq a => a -> a -> Bool
== Expr
e' Bool -> Bool -> Bool
|| Expr -> Int
size Expr
e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
sz    =  Expr
e
        | Bool
otherwise                 =  Expr -> Expr
re Expr
e
    where
    e :: Expr
e  =  Expr -> Expr
re1 Expr
e'
    re1 :: Expr -> Expr
re1 Expr
e  =  case Expr -> [Expr]
unfoldApp Expr
e of
              [Expr
e]                  -> Expr
e
              (Expr
ef:[Expr]
exs) | Expr
ef Expr -> Expr -> Bool
forall a. Eq a => a -> a -> Bool
== Expr
erf -> Expr
e' Expr -> [(Expr, Expr)] -> Expr
//- [Expr] -> [Expr] -> [(Expr, Expr)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Expr]
vs [Expr]
exs
                       | Bool
otherwise -> [Expr] -> Expr
foldApp ((Expr -> Expr) -> [Expr] -> [Expr]
forall a b. (a -> b) -> [a] -> [b]
map Expr -> Expr
re1 (Expr
efExpr -> [Expr] -> [Expr]
forall a. a -> [a] -> [a]
:[Expr]
exs))

-- recursive call _only_ under an if
-- future-work: guess short-circuit operators

-- | Checks if the given recursive call apparently terminates.
--   The first argument indicates the functional variable indicating the
--   recursive call.
--
-- > > apparentlyTerminates ffE (ff xx)
-- > False
--
-- > > apparentlyTerminates ffE (if' pp zero (ff xx))
-- > True
--
-- This function only allows recursion in the else clause:
--
-- > > apparentlyTerminates ffE (if' pp (ff xx) zero)
-- > False
--
-- Of course, recursive calls as the condition are not allowed:
--
-- > > apparentlyTerminates ffE (if' (odd' (ff xx)) zero zero)
-- > False
apparentlyTerminates :: Expr -> Expr -> Bool
apparentlyTerminates :: Expr -> Expr -> Bool
apparentlyTerminates Expr
eRecursiveCall  =  Expr -> Bool
at
  where
  at :: Expr -> Bool
at (Expr
e1 :$ Expr
e2)  =  (Expr -> Bool
mayNotEvaluateArgument Expr
e1 Bool -> Bool -> Bool
|| Expr -> Bool
at Expr
e2) Bool -> Bool -> Bool
&& Expr -> Bool
at Expr
e1
  at Expr
e  =  Expr
e Expr -> Expr -> Bool
forall a. Eq a => a -> a -> Bool
/= Expr
eRecursiveCall

-- | Checks if the given functional expression may refrain from evaluating its
--   next argument.
--
--
-- > > mayNotEvaluateArgument (plus :$ xx)
-- > False
--
-- > > mayNotEvaluateArgument (andE :$ pp)
-- > True
--
-- This returns false for non-funcional value even if it involves an
-- application which may not evaluate its argument.
--
-- > > mayNotEvaluateArgument (andE :$ pp :$ qq)
-- > False
--
-- This currently works by checking if the function is an if, '&&' or '||'.
mayNotEvaluateArgument :: Expr -> Bool
mayNotEvaluateArgument :: Expr -> Bool
mayNotEvaluateArgument (Value String
"if" Dynamic
ce :$ Expr
_ :$ Expr
_)  =  Bool
True
mayNotEvaluateArgument (Value String
"&&" Dynamic
ce :$ Expr
_)       =  Bool
True
mayNotEvaluateArgument (Value String
"||" Dynamic
ce :$ Expr
_)       =  Bool
True
mayNotEvaluateArgument Expr
_                          =  Bool
False

applicationOld :: Expr -> [Expr] -> Maybe Expr
applicationOld :: Expr -> [Expr] -> Maybe Expr
applicationOld Expr
ff [Expr]
es  =  Expr -> Maybe Expr
appn Expr
ff
  where
  appn :: Expr -> Maybe Expr
appn Expr
ff
    | Expr -> Bool
isFun Expr
ff   =  case [Expr
e | Just (Expr
_ :$ Expr
e) <- ((Expr -> Maybe Expr) -> [Expr] -> [Maybe Expr]
forall a b. (a -> b) -> [a] -> [b]
map (Expr
ff Expr -> Expr -> Maybe Expr
$$)) [Expr]
es] of
                    [] -> Maybe Expr
forall a. Maybe a
Nothing  -- could not find type representative in es
                    (Expr
e:[Expr]
_) -> Expr -> Maybe Expr
appn (Expr
ff Expr -> Expr -> Expr
:$ Expr -> Expr
holeAsTypeOf Expr
e)
    | Bool
otherwise  =  Expr -> Maybe Expr
forall a. a -> Maybe a
Just Expr
ff

-- | Creates an if 'Expr' of the type of the given proxy.
--
-- > > ifFor (undefined :: Int)
-- > if :: Bool -> Int -> Int -> Int
--
-- > > ifFor (undefined :: String)
-- > if :: Bool -> [Char] -> [Char] -> [Char]
--
-- You need to provide this as part of your building blocks on the background
-- if you want recursive functions to be considered and produced.
ifFor :: Typeable a => a -> Expr
ifFor :: a -> Expr
ifFor a
a  =  String -> (Bool -> a -> a -> a) -> Expr
forall a. Typeable a => String -> a -> Expr
value String
"if" (\Bool
p a
x a
y -> if Bool
p then a
x else a
y a -> a -> a
forall a. a -> a -> a
`asTypeOf` a
a)