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

-- |
-- CoreFn optimization pass.
--
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