module Language.PureScript.CoreFn.Optimizer (optimizeCoreFn) where
import Protolude hiding (Type, moduleName)
import Control.Monad.Supply (Supply)
import Language.PureScript.CoreFn.Ann (Ann)
import Language.PureScript.CoreFn.CSE (optimizeCommonSubexpressions)
import Language.PureScript.CoreFn.Expr (Bind, Expr(..))
import Language.PureScript.CoreFn.Module (Module(..))
import Language.PureScript.CoreFn.Traversals (everywhereOnValues)
import Language.PureScript.Constants.Libs qualified as C
optimizeCoreFn :: Module Ann -> Supply (Module Ann)
optimizeCoreFn :: Module Ann -> Supply (Module Ann)
optimizeCoreFn Module Ann
m = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\[Bind Ann]
md -> Module Ann
m {moduleDecls :: [Bind Ann]
moduleDecls = [Bind Ann]
md}) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> [Bind Ann] -> SupplyT Identity [Bind Ann]
optimizeCommonSubexpressions (forall a. Module a -> ModuleName
moduleName Module Ann
m) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Bind Ann] -> [Bind Ann]
optimizeModuleDecls forall a b. (a -> b) -> a -> b
$ forall a. Module a -> [Bind a]
moduleDecls Module Ann
m
optimizeModuleDecls :: [Bind Ann] -> [Bind Ann]
optimizeModuleDecls :: [Bind Ann] -> [Bind Ann]
optimizeModuleDecls = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map forall {a}. Bind a -> Bind a
transformBinds
where
(Bind a -> Bind a
transformBinds, Expr a -> Expr a
_, Binder a -> Binder a
_) = forall a.
(Bind a -> Bind a)
-> (Expr a -> Expr a)
-> (Binder a -> Binder a)
-> (Bind a -> Bind a, Expr a -> Expr a, Binder a -> Binder a)
everywhereOnValues forall a. a -> a
identity forall {a}. Expr a -> Expr a
transformExprs forall a. a -> a
identity
transformExprs :: Expr a -> Expr a
transformExprs
= forall {a}. Expr a -> Expr a
optimizeDataFunctionApply
optimizeDataFunctionApply :: Expr a -> Expr a
optimizeDataFunctionApply :: forall {a}. Expr a -> Expr a
optimizeDataFunctionApply Expr a
e = case Expr a
e of
(App a
a (App a
_ (Var a
_ Qualified Ident
fn) Expr a
x) Expr a
y)
| Qualified Ident
C.I_functionApply <- Qualified Ident
fn -> forall a. a -> Expr a -> Expr a -> Expr a
App a
a Expr a
x Expr a
y
| Qualified Ident
C.I_functionApplyFlipped <- Qualified Ident
fn -> forall a. a -> Expr a -> Expr a -> Expr a
App a
a Expr a
y Expr a
x
Expr a
_ -> Expr a
e