-- | This module performs basic inlining of known functions
module Language.PureScript.CoreImp.Optimizer.Inliner
  ( inlineVariables
  , inlineCommonValues
  , inlineCommonOperators
  , inlineFnComposition
  , inlineFnIdentity
  , inlineUnsafeCoerce
  , inlineUnsafePartial
  , etaConvert
  , unThunk
  , evaluateIifes
  ) where

import Prelude

import Control.Monad.Supply.Class (MonadSupply, freshName)

import Data.Either (rights)
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import qualified Data.Text as T

import Language.PureScript.Names (ModuleName)
import Language.PureScript.PSString (PSString, mkString)
import Language.PureScript.CoreImp.AST
import Language.PureScript.CoreImp.Optimizer.Common
import Language.PureScript.AST (SourceSpan(..))
import qualified Language.PureScript.Constants.Libs as C
import qualified Language.PureScript.Constants.Prim as C

-- TODO: Potential bug:
-- Shouldn't just inline this case: { var x = 0; x.toFixed(10); }
-- Needs to be: { 0..toFixed(10); }
-- Probably needs to be fixed in pretty-printer instead.
shouldInline :: AST -> Bool
shouldInline :: AST -> Bool
shouldInline (Var Maybe SourceSpan
_ Text
_) = Bool
True
shouldInline (ModuleAccessor Maybe SourceSpan
_ ModuleName
_ PSString
_) = Bool
True
shouldInline (NumericLiteral Maybe SourceSpan
_ Either Integer Double
_) = Bool
True
shouldInline (StringLiteral Maybe SourceSpan
_ PSString
_) = Bool
True
shouldInline (BooleanLiteral Maybe SourceSpan
_ Bool
_) = Bool
True
shouldInline (Indexer Maybe SourceSpan
_ AST
index AST
val) = AST -> Bool
shouldInline AST
index Bool -> Bool -> Bool
&& AST -> Bool
shouldInline AST
val
shouldInline AST
_ = Bool
False

etaConvert :: AST -> AST
etaConvert :: AST -> AST
etaConvert = (AST -> AST) -> AST -> AST
everywhere AST -> AST
convert
  where
  convert :: AST -> AST
  convert :: AST -> AST
convert (Block Maybe SourceSpan
ss [Return Maybe SourceSpan
_ (App Maybe SourceSpan
_ (Function Maybe SourceSpan
_ Maybe Text
Nothing [Text]
idents block :: AST
block@(Block Maybe SourceSpan
_ [AST]
body)) [AST]
args)])
    | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all AST -> Bool
shouldInline [AST]
args Bool -> Bool -> Bool
&&
      Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((AST -> AST -> Bool
`isRebound` AST
block) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe SourceSpan -> Text -> AST
Var forall a. Maybe a
Nothing) [Text]
idents) Bool -> Bool -> Bool
&&
      Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (AST -> AST -> Bool
`isRebound` AST
block) [AST]
args)
      = Maybe SourceSpan -> [AST] -> AST
Block Maybe SourceSpan
ss (forall a b. (a -> b) -> [a] -> [b]
map ([(Text, AST)] -> AST -> AST
replaceIdents (forall a b. [a] -> [b] -> [(a, b)]
zip [Text]
idents [AST]
args)) [AST]
body)
  convert (Function Maybe SourceSpan
_ Maybe Text
Nothing [] (Block Maybe SourceSpan
_ [Return Maybe SourceSpan
_ (App Maybe SourceSpan
_ AST
fn [])])) = AST
fn
  convert AST
js = AST
js

unThunk :: AST -> AST
unThunk :: AST -> AST
unThunk = (AST -> AST) -> AST -> AST
everywhere AST -> AST
convert
  where
  convert :: AST -> AST
  convert :: AST -> AST
convert (Block Maybe SourceSpan
ss []) = Maybe SourceSpan -> [AST] -> AST
Block Maybe SourceSpan
ss []
  convert (Block Maybe SourceSpan
ss [AST]
jss) =
    case forall a. [a] -> a
last [AST]
jss of
      Return Maybe SourceSpan
_ (App Maybe SourceSpan
_ (Function Maybe SourceSpan
_ Maybe Text
Nothing [] (Block Maybe SourceSpan
_ [AST]
body)) []) -> Maybe SourceSpan -> [AST] -> AST
Block Maybe SourceSpan
ss forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
init [AST]
jss forall a. [a] -> [a] -> [a]
++ [AST]
body
      AST
_ -> Maybe SourceSpan -> [AST] -> AST
Block Maybe SourceSpan
ss [AST]
jss
  convert AST
js = AST
js

evaluateIifes :: AST -> AST
evaluateIifes :: AST -> AST
evaluateIifes = (AST -> AST) -> AST -> AST
everywhere AST -> AST
convert
  where
  convert :: AST -> AST
  convert :: AST -> AST
convert (App Maybe SourceSpan
_ (Function Maybe SourceSpan
_ Maybe Text
Nothing [] (Block Maybe SourceSpan
_ [Return Maybe SourceSpan
_ AST
ret])) []) = AST
ret
  convert (App Maybe SourceSpan
_ (Function Maybe SourceSpan
_ Maybe Text
Nothing [Text]
idents (Block Maybe SourceSpan
_ [Return Maybe SourceSpan
ss AST
ret])) [])
    | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Text -> AST -> Bool
`isReassigned` AST
ret) [Text]
idents) = [(Text, AST)] -> AST -> AST
replaceIdents (forall a b. (a -> b) -> [a] -> [b]
map (, Maybe SourceSpan -> Text -> AST
Var Maybe SourceSpan
ss forall a. (Eq a, IsString a) => a
C.S_undefined) [Text]
idents) AST
ret
  convert AST
js = AST
js

inlineVariables :: AST -> AST
inlineVariables :: AST -> AST
inlineVariables = (AST -> AST) -> AST -> AST
everywhere forall a b. (a -> b) -> a -> b
$ ([AST] -> [AST]) -> AST -> AST
removeFromBlock [AST] -> [AST]
go
  where
  go :: [AST] -> [AST]
  go :: [AST] -> [AST]
go [] = []
  go (VariableIntroduction Maybe SourceSpan
_ Text
var (Just (InitializerEffects
_, AST
js)) : [AST]
sts)
    | AST -> Bool
shouldInline AST
js Bool -> Bool -> Bool
&& Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Text -> AST -> Bool
isReassigned Text
var) [AST]
sts) Bool -> Bool -> Bool
&& Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (AST -> AST -> Bool
isRebound AST
js) [AST]
sts) Bool -> Bool -> Bool
&& Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Text -> AST -> Bool
isUpdated Text
var) [AST]
sts) =
      [AST] -> [AST]
go (forall a b. (a -> b) -> [a] -> [b]
map (Text -> AST -> AST -> AST
replaceIdent Text
var AST
js) [AST]
sts)
  go (AST
s:[AST]
sts) = AST
s forall a. a -> [a] -> [a]
: [AST] -> [AST]
go [AST]
sts

inlineCommonValues :: (AST -> AST) -> AST -> AST
inlineCommonValues :: (AST -> AST) -> AST -> AST
inlineCommonValues AST -> AST
expander = (AST -> AST) -> AST -> AST
everywhere AST -> AST
convert
  where
  convert :: AST -> AST
  convert :: AST -> AST
convert (AST -> AST
expander -> App Maybe SourceSpan
ss (Ref (ModuleName, PSString)
fn) [Ref (ModuleName, PSString)
dict])
    | (ModuleName, PSString)
dict forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [forall a. (Eq a, IsString a) => (ModuleName, a)
C.P_semiringNumber, forall a. (Eq a, IsString a) => (ModuleName, a)
C.P_semiringInt], (ModuleName, PSString)
C.P_zero <- (ModuleName, PSString)
fn = Maybe SourceSpan -> Either Integer Double -> AST
NumericLiteral Maybe SourceSpan
ss (forall a b. a -> Either a b
Left Integer
0)
    | (ModuleName, PSString)
dict forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [forall a. (Eq a, IsString a) => (ModuleName, a)
C.P_semiringNumber, forall a. (Eq a, IsString a) => (ModuleName, a)
C.P_semiringInt], (ModuleName, PSString)
C.P_one <- (ModuleName, PSString)
fn = Maybe SourceSpan -> Either Integer Double -> AST
NumericLiteral Maybe SourceSpan
ss (forall a b. a -> Either a b
Left Integer
1)
    | (ModuleName, PSString)
C.P_boundedBoolean <- (ModuleName, PSString)
dict, (ModuleName, PSString)
C.P_bottom <- (ModuleName, PSString)
fn = Maybe SourceSpan -> Bool -> AST
BooleanLiteral Maybe SourceSpan
ss Bool
False
    | (ModuleName, PSString)
C.P_boundedBoolean <- (ModuleName, PSString)
dict, (ModuleName, PSString)
C.P_top <- (ModuleName, PSString)
fn = Maybe SourceSpan -> Bool -> AST
BooleanLiteral Maybe SourceSpan
ss Bool
True
  convert (App Maybe SourceSpan
ss (AST -> AST
expander -> App Maybe SourceSpan
_ (Ref (ModuleName, PSString)
C.P_negate) [Ref (ModuleName, PSString)
C.P_ringInt]) [AST
x])
    = Maybe SourceSpan -> BinaryOperator -> AST -> AST -> AST
Binary Maybe SourceSpan
ss BinaryOperator
BitwiseOr (Maybe SourceSpan -> UnaryOperator -> AST -> AST
Unary Maybe SourceSpan
ss UnaryOperator
Negate AST
x) (Maybe SourceSpan -> Either Integer Double -> AST
NumericLiteral Maybe SourceSpan
ss (forall a b. a -> Either a b
Left Integer
0))
  convert (App Maybe SourceSpan
ss (App Maybe SourceSpan
_ (AST -> AST
expander -> App Maybe SourceSpan
_ (Ref (ModuleName, PSString)
fn) [Ref (ModuleName, PSString)
dict]) [AST
x]) [AST
y])
    | (ModuleName, PSString)
C.P_semiringInt <- (ModuleName, PSString)
dict, (ModuleName, PSString)
C.P_add <- (ModuleName, PSString)
fn = Maybe SourceSpan -> BinaryOperator -> AST -> AST -> AST
intOp Maybe SourceSpan
ss BinaryOperator
Add AST
x AST
y
    | (ModuleName, PSString)
C.P_semiringInt <- (ModuleName, PSString)
dict, (ModuleName, PSString)
C.P_mul <- (ModuleName, PSString)
fn = Maybe SourceSpan -> BinaryOperator -> AST -> AST -> AST
intOp Maybe SourceSpan
ss BinaryOperator
Multiply AST
x AST
y
    | (ModuleName, PSString)
C.P_ringInt <- (ModuleName, PSString)
dict, (ModuleName, PSString)
C.P_sub <- (ModuleName, PSString)
fn = Maybe SourceSpan -> BinaryOperator -> AST -> AST -> AST
intOp Maybe SourceSpan
ss BinaryOperator
Subtract AST
x AST
y
  convert AST
other = AST
other
  intOp :: Maybe SourceSpan -> BinaryOperator -> AST -> AST -> AST
intOp Maybe SourceSpan
ss BinaryOperator
op AST
x AST
y = Maybe SourceSpan -> BinaryOperator -> AST -> AST -> AST
Binary Maybe SourceSpan
ss BinaryOperator
BitwiseOr (Maybe SourceSpan -> BinaryOperator -> AST -> AST -> AST
Binary Maybe SourceSpan
ss BinaryOperator
op AST
x AST
y) (Maybe SourceSpan -> Either Integer Double -> AST
NumericLiteral Maybe SourceSpan
ss (forall a b. a -> Either a b
Left Integer
0))

inlineCommonOperators :: (AST -> AST) -> AST -> AST
inlineCommonOperators :: (AST -> AST) -> AST -> AST
inlineCommonOperators AST -> AST
expander = (AST -> AST) -> AST -> AST
everywhereTopDown forall a b. (a -> b) -> a -> b
$ forall a. [a -> a] -> a -> a
applyAll forall a b. (a -> b) -> a -> b
$
  [ (ModuleName, PSString)
-> (ModuleName, PSString) -> BinaryOperator -> AST -> AST
binary forall a. (Eq a, IsString a) => (ModuleName, a)
C.P_semiringNumber forall a. (Eq a, IsString a) => (ModuleName, a)
C.P_add BinaryOperator
Add
  , (ModuleName, PSString)
-> (ModuleName, PSString) -> BinaryOperator -> AST -> AST
binary forall a. (Eq a, IsString a) => (ModuleName, a)
C.P_semiringNumber forall a. (Eq a, IsString a) => (ModuleName, a)
C.P_mul BinaryOperator
Multiply

  , (ModuleName, PSString)
-> (ModuleName, PSString) -> BinaryOperator -> AST -> AST
binary forall a. (Eq a, IsString a) => (ModuleName, a)
C.P_ringNumber forall a. (Eq a, IsString a) => (ModuleName, a)
C.P_sub BinaryOperator
Subtract
  , (ModuleName, PSString)
-> (ModuleName, PSString) -> UnaryOperator -> AST -> AST
unary  forall a. (Eq a, IsString a) => (ModuleName, a)
C.P_ringNumber forall a. (Eq a, IsString a) => (ModuleName, a)
C.P_negate UnaryOperator
Negate

  , (ModuleName, PSString)
-> (ModuleName, PSString) -> BinaryOperator -> AST -> AST
binary forall a. (Eq a, IsString a) => (ModuleName, a)
C.P_euclideanRingNumber forall a. (Eq a, IsString a) => (ModuleName, a)
C.P_div BinaryOperator
Divide

  , (ModuleName, PSString)
-> (ModuleName, PSString) -> BinaryOperator -> AST -> AST
binary forall a. (Eq a, IsString a) => (ModuleName, a)
C.P_eqNumber forall a. (Eq a, IsString a) => (ModuleName, a)
C.P_eq BinaryOperator
EqualTo
  , (ModuleName, PSString)
-> (ModuleName, PSString) -> BinaryOperator -> AST -> AST
binary forall a. (Eq a, IsString a) => (ModuleName, a)
C.P_eqNumber forall a. (Eq a, IsString a) => (ModuleName, a)
C.P_notEq BinaryOperator
NotEqualTo
  , (ModuleName, PSString)
-> (ModuleName, PSString) -> BinaryOperator -> AST -> AST
binary forall a. (Eq a, IsString a) => (ModuleName, a)
C.P_eqInt forall a. (Eq a, IsString a) => (ModuleName, a)
C.P_eq BinaryOperator
EqualTo
  , (ModuleName, PSString)
-> (ModuleName, PSString) -> BinaryOperator -> AST -> AST
binary forall a. (Eq a, IsString a) => (ModuleName, a)
C.P_eqInt forall a. (Eq a, IsString a) => (ModuleName, a)
C.P_notEq BinaryOperator
NotEqualTo
  , (ModuleName, PSString)
-> (ModuleName, PSString) -> BinaryOperator -> AST -> AST
binary forall a. (Eq a, IsString a) => (ModuleName, a)
C.P_eqString forall a. (Eq a, IsString a) => (ModuleName, a)
C.P_eq BinaryOperator
EqualTo
  , (ModuleName, PSString)
-> (ModuleName, PSString) -> BinaryOperator -> AST -> AST
binary forall a. (Eq a, IsString a) => (ModuleName, a)
C.P_eqString forall a. (Eq a, IsString a) => (ModuleName, a)
C.P_notEq BinaryOperator
NotEqualTo
  , (ModuleName, PSString)
-> (ModuleName, PSString) -> BinaryOperator -> AST -> AST
binary forall a. (Eq a, IsString a) => (ModuleName, a)
C.P_eqChar forall a. (Eq a, IsString a) => (ModuleName, a)
C.P_eq BinaryOperator
EqualTo
  , (ModuleName, PSString)
-> (ModuleName, PSString) -> BinaryOperator -> AST -> AST
binary forall a. (Eq a, IsString a) => (ModuleName, a)
C.P_eqChar forall a. (Eq a, IsString a) => (ModuleName, a)
C.P_notEq BinaryOperator
NotEqualTo
  , (ModuleName, PSString)
-> (ModuleName, PSString) -> BinaryOperator -> AST -> AST
binary forall a. (Eq a, IsString a) => (ModuleName, a)
C.P_eqBoolean forall a. (Eq a, IsString a) => (ModuleName, a)
C.P_eq BinaryOperator
EqualTo
  , (ModuleName, PSString)
-> (ModuleName, PSString) -> BinaryOperator -> AST -> AST
binary forall a. (Eq a, IsString a) => (ModuleName, a)
C.P_eqBoolean forall a. (Eq a, IsString a) => (ModuleName, a)
C.P_notEq BinaryOperator
NotEqualTo

  , (ModuleName, PSString)
-> (ModuleName, PSString) -> BinaryOperator -> AST -> AST
binary forall a. (Eq a, IsString a) => (ModuleName, a)
C.P_ordBoolean forall a. (Eq a, IsString a) => (ModuleName, a)
C.P_lessThan BinaryOperator
LessThan
  , (ModuleName, PSString)
-> (ModuleName, PSString) -> BinaryOperator -> AST -> AST
binary forall a. (Eq a, IsString a) => (ModuleName, a)
C.P_ordBoolean forall a. (Eq a, IsString a) => (ModuleName, a)
C.P_lessThanOrEq BinaryOperator
LessThanOrEqualTo
  , (ModuleName, PSString)
-> (ModuleName, PSString) -> BinaryOperator -> AST -> AST
binary forall a. (Eq a, IsString a) => (ModuleName, a)
C.P_ordBoolean forall a. (Eq a, IsString a) => (ModuleName, a)
C.P_greaterThan BinaryOperator
GreaterThan
  , (ModuleName, PSString)
-> (ModuleName, PSString) -> BinaryOperator -> AST -> AST
binary forall a. (Eq a, IsString a) => (ModuleName, a)
C.P_ordBoolean forall a. (Eq a, IsString a) => (ModuleName, a)
C.P_greaterThanOrEq BinaryOperator
GreaterThanOrEqualTo
  , (ModuleName, PSString)
-> (ModuleName, PSString) -> BinaryOperator -> AST -> AST
binary forall a. (Eq a, IsString a) => (ModuleName, a)
C.P_ordChar forall a. (Eq a, IsString a) => (ModuleName, a)
C.P_lessThan BinaryOperator
LessThan
  , (ModuleName, PSString)
-> (ModuleName, PSString) -> BinaryOperator -> AST -> AST
binary forall a. (Eq a, IsString a) => (ModuleName, a)
C.P_ordChar forall a. (Eq a, IsString a) => (ModuleName, a)
C.P_lessThanOrEq BinaryOperator
LessThanOrEqualTo
  , (ModuleName, PSString)
-> (ModuleName, PSString) -> BinaryOperator -> AST -> AST
binary forall a. (Eq a, IsString a) => (ModuleName, a)
C.P_ordChar forall a. (Eq a, IsString a) => (ModuleName, a)
C.P_greaterThan BinaryOperator
GreaterThan
  , (ModuleName, PSString)
-> (ModuleName, PSString) -> BinaryOperator -> AST -> AST
binary forall a. (Eq a, IsString a) => (ModuleName, a)
C.P_ordChar forall a. (Eq a, IsString a) => (ModuleName, a)
C.P_greaterThanOrEq BinaryOperator
GreaterThanOrEqualTo
  , (ModuleName, PSString)
-> (ModuleName, PSString) -> BinaryOperator -> AST -> AST
binary forall a. (Eq a, IsString a) => (ModuleName, a)
C.P_ordInt forall a. (Eq a, IsString a) => (ModuleName, a)
C.P_lessThan BinaryOperator
LessThan
  , (ModuleName, PSString)
-> (ModuleName, PSString) -> BinaryOperator -> AST -> AST
binary forall a. (Eq a, IsString a) => (ModuleName, a)
C.P_ordInt forall a. (Eq a, IsString a) => (ModuleName, a)
C.P_lessThanOrEq BinaryOperator
LessThanOrEqualTo
  , (ModuleName, PSString)
-> (ModuleName, PSString) -> BinaryOperator -> AST -> AST
binary forall a. (Eq a, IsString a) => (ModuleName, a)
C.P_ordInt forall a. (Eq a, IsString a) => (ModuleName, a)
C.P_greaterThan BinaryOperator
GreaterThan
  , (ModuleName, PSString)
-> (ModuleName, PSString) -> BinaryOperator -> AST -> AST
binary forall a. (Eq a, IsString a) => (ModuleName, a)
C.P_ordInt forall a. (Eq a, IsString a) => (ModuleName, a)
C.P_greaterThanOrEq BinaryOperator
GreaterThanOrEqualTo
  , (ModuleName, PSString)
-> (ModuleName, PSString) -> BinaryOperator -> AST -> AST
binary forall a. (Eq a, IsString a) => (ModuleName, a)
C.P_ordNumber forall a. (Eq a, IsString a) => (ModuleName, a)
C.P_lessThan BinaryOperator
LessThan
  , (ModuleName, PSString)
-> (ModuleName, PSString) -> BinaryOperator -> AST -> AST
binary forall a. (Eq a, IsString a) => (ModuleName, a)
C.P_ordNumber forall a. (Eq a, IsString a) => (ModuleName, a)
C.P_lessThanOrEq BinaryOperator
LessThanOrEqualTo
  , (ModuleName, PSString)
-> (ModuleName, PSString) -> BinaryOperator -> AST -> AST
binary forall a. (Eq a, IsString a) => (ModuleName, a)
C.P_ordNumber forall a. (Eq a, IsString a) => (ModuleName, a)
C.P_greaterThan BinaryOperator
GreaterThan
  , (ModuleName, PSString)
-> (ModuleName, PSString) -> BinaryOperator -> AST -> AST
binary forall a. (Eq a, IsString a) => (ModuleName, a)
C.P_ordNumber forall a. (Eq a, IsString a) => (ModuleName, a)
C.P_greaterThanOrEq BinaryOperator
GreaterThanOrEqualTo
  , (ModuleName, PSString)
-> (ModuleName, PSString) -> BinaryOperator -> AST -> AST
binary forall a. (Eq a, IsString a) => (ModuleName, a)
C.P_ordString forall a. (Eq a, IsString a) => (ModuleName, a)
C.P_lessThan BinaryOperator
LessThan
  , (ModuleName, PSString)
-> (ModuleName, PSString) -> BinaryOperator -> AST -> AST
binary forall a. (Eq a, IsString a) => (ModuleName, a)
C.P_ordString forall a. (Eq a, IsString a) => (ModuleName, a)
C.P_lessThanOrEq BinaryOperator
LessThanOrEqualTo
  , (ModuleName, PSString)
-> (ModuleName, PSString) -> BinaryOperator -> AST -> AST
binary forall a. (Eq a, IsString a) => (ModuleName, a)
C.P_ordString forall a. (Eq a, IsString a) => (ModuleName, a)
C.P_greaterThan BinaryOperator
GreaterThan
  , (ModuleName, PSString)
-> (ModuleName, PSString) -> BinaryOperator -> AST -> AST
binary forall a. (Eq a, IsString a) => (ModuleName, a)
C.P_ordString forall a. (Eq a, IsString a) => (ModuleName, a)
C.P_greaterThanOrEq BinaryOperator
GreaterThanOrEqualTo

  , (ModuleName, PSString)
-> (ModuleName, PSString) -> BinaryOperator -> AST -> AST
binary forall a. (Eq a, IsString a) => (ModuleName, a)
C.P_semigroupString forall a. (Eq a, IsString a) => (ModuleName, a)
C.P_append BinaryOperator
Add

  , (ModuleName, PSString)
-> (ModuleName, PSString) -> BinaryOperator -> AST -> AST
binary forall a. (Eq a, IsString a) => (ModuleName, a)
C.P_heytingAlgebraBoolean forall a. (Eq a, IsString a) => (ModuleName, a)
C.P_conj BinaryOperator
And
  , (ModuleName, PSString)
-> (ModuleName, PSString) -> BinaryOperator -> AST -> AST
binary forall a. (Eq a, IsString a) => (ModuleName, a)
C.P_heytingAlgebraBoolean forall a. (Eq a, IsString a) => (ModuleName, a)
C.P_disj BinaryOperator
Or
  , (ModuleName, PSString)
-> (ModuleName, PSString) -> UnaryOperator -> AST -> AST
unary  forall a. (Eq a, IsString a) => (ModuleName, a)
C.P_heytingAlgebraBoolean forall a. (Eq a, IsString a) => (ModuleName, a)
C.P_not UnaryOperator
Not

  , (ModuleName, PSString) -> BinaryOperator -> AST -> AST
binary' forall a. (Eq a, IsString a) => (ModuleName, a)
C.P_or BinaryOperator
BitwiseOr
  , (ModuleName, PSString) -> BinaryOperator -> AST -> AST
binary' forall a. (Eq a, IsString a) => (ModuleName, a)
C.P_and BinaryOperator
BitwiseAnd
  , (ModuleName, PSString) -> BinaryOperator -> AST -> AST
binary' forall a. (Eq a, IsString a) => (ModuleName, a)
C.P_xor BinaryOperator
BitwiseXor
  , (ModuleName, PSString) -> BinaryOperator -> AST -> AST
binary' forall a. (Eq a, IsString a) => (ModuleName, a)
C.P_shl BinaryOperator
ShiftLeft
  , (ModuleName, PSString) -> BinaryOperator -> AST -> AST
binary' forall a. (Eq a, IsString a) => (ModuleName, a)
C.P_shr BinaryOperator
ShiftRight
  , (ModuleName, PSString) -> BinaryOperator -> AST -> AST
binary' forall a. (Eq a, IsString a) => (ModuleName, a)
C.P_zshr BinaryOperator
ZeroFillShiftRight
  , (ModuleName, PSString) -> UnaryOperator -> AST -> AST
unary'  forall a. (Eq a, IsString a) => (ModuleName, a)
C.P_complement UnaryOperator
BitwiseNot

  , (AST -> Bool) -> (AST -> AST -> AST) -> AST -> AST
inlineNonClassFunction ((ModuleName, PSString) -> AST -> Bool
isModFnWithDict forall a. (Eq a, IsString a) => (ModuleName, a)
C.P_unsafeIndex) forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip (Maybe SourceSpan -> AST -> AST -> AST
Indexer forall a. Maybe a
Nothing)
  ] forall a. [a] -> [a] -> [a]
++
  [ AST -> AST
fn | Int
i <- [Int
0..Int
10], AST -> AST
fn <- [ Int -> AST -> AST
mkFn Int
i, Int -> AST -> AST
runFn Int
i ] ] forall a. [a] -> [a] -> [a]
++
  [ AST -> AST
fn | Int
i <- [Int
0..Int
10], AST -> AST
fn <- [ (ModuleName, PSString) -> Int -> AST -> AST
mkEffFn forall a. (Eq a, IsString a) => (ModuleName, a)
C.P_mkEffFn Int
i, (ModuleName, PSString) -> Int -> AST -> AST
runEffFn forall a. (Eq a, IsString a) => (ModuleName, a)
C.P_runEffFn Int
i ] ] forall a. [a] -> [a] -> [a]
++
  [ AST -> AST
fn | Int
i <- [Int
0..Int
10], AST -> AST
fn <- [ (ModuleName, PSString) -> Int -> AST -> AST
mkEffFn forall a. (Eq a, IsString a) => (ModuleName, a)
C.P_mkEffectFn Int
i, (ModuleName, PSString) -> Int -> AST -> AST
runEffFn forall a. (Eq a, IsString a) => (ModuleName, a)
C.P_runEffectFn Int
i ] ] forall a. [a] -> [a] -> [a]
++
  [ AST -> AST
fn | Int
i <- [Int
0..Int
10], AST -> AST
fn <- [ (ModuleName, PSString) -> Int -> AST -> AST
mkEffFn forall a. (Eq a, IsString a) => (ModuleName, a)
C.P_mkSTFn Int
i, (ModuleName, PSString) -> Int -> AST -> AST
runEffFn forall a. (Eq a, IsString a) => (ModuleName, a)
C.P_runSTFn Int
i ] ]
  where
  binary :: (ModuleName, PSString) -> (ModuleName, PSString) -> BinaryOperator -> AST -> AST
  binary :: (ModuleName, PSString)
-> (ModuleName, PSString) -> BinaryOperator -> AST -> AST
binary (ModuleName, PSString)
dict (ModuleName, PSString)
fn BinaryOperator
op = AST -> AST
convert where
    convert :: AST -> AST
    convert :: AST -> AST
convert (App Maybe SourceSpan
ss (App Maybe SourceSpan
_ (AST -> AST
expander -> App Maybe SourceSpan
_ (Ref (ModuleName, PSString)
fn') [Ref (ModuleName, PSString)
dict']) [AST
x]) [AST
y]) | (ModuleName, PSString)
dict forall a. Eq a => a -> a -> Bool
== (ModuleName, PSString)
dict', (ModuleName, PSString)
fn forall a. Eq a => a -> a -> Bool
== (ModuleName, PSString)
fn' = Maybe SourceSpan -> BinaryOperator -> AST -> AST -> AST
Binary Maybe SourceSpan
ss BinaryOperator
op AST
x AST
y
    convert AST
other = AST
other
  binary' :: (ModuleName, PSString) -> BinaryOperator -> AST -> AST
  binary' :: (ModuleName, PSString) -> BinaryOperator -> AST -> AST
binary' (ModuleName, PSString)
fn BinaryOperator
op = AST -> AST
convert where
    convert :: AST -> AST
    convert :: AST -> AST
convert (App Maybe SourceSpan
ss (App Maybe SourceSpan
_ (Ref (ModuleName, PSString)
fn') [AST
x]) [AST
y]) | (ModuleName, PSString)
fn forall a. Eq a => a -> a -> Bool
== (ModuleName, PSString)
fn' = Maybe SourceSpan -> BinaryOperator -> AST -> AST -> AST
Binary Maybe SourceSpan
ss BinaryOperator
op AST
x AST
y
    convert AST
other = AST
other
  unary :: (ModuleName, PSString) -> (ModuleName, PSString) -> UnaryOperator -> AST -> AST
  unary :: (ModuleName, PSString)
-> (ModuleName, PSString) -> UnaryOperator -> AST -> AST
unary (ModuleName, PSString)
dict (ModuleName, PSString)
fn UnaryOperator
op = AST -> AST
convert where
    convert :: AST -> AST
    convert :: AST -> AST
convert (App Maybe SourceSpan
ss (AST -> AST
expander -> App Maybe SourceSpan
_ (Ref (ModuleName, PSString)
fn') [Ref (ModuleName, PSString)
dict']) [AST
x]) | (ModuleName, PSString)
dict forall a. Eq a => a -> a -> Bool
== (ModuleName, PSString)
dict', (ModuleName, PSString)
fn forall a. Eq a => a -> a -> Bool
== (ModuleName, PSString)
fn' = Maybe SourceSpan -> UnaryOperator -> AST -> AST
Unary Maybe SourceSpan
ss UnaryOperator
op AST
x
    convert AST
other = AST
other
  unary' :: (ModuleName, PSString) -> UnaryOperator -> AST -> AST
  unary' :: (ModuleName, PSString) -> UnaryOperator -> AST -> AST
unary' (ModuleName, PSString)
fn UnaryOperator
op = AST -> AST
convert where
    convert :: AST -> AST
    convert :: AST -> AST
convert (App Maybe SourceSpan
ss (Ref (ModuleName, PSString)
fn') [AST
x]) | (ModuleName, PSString)
fn forall a. Eq a => a -> a -> Bool
== (ModuleName, PSString)
fn' = Maybe SourceSpan -> UnaryOperator -> AST -> AST
Unary Maybe SourceSpan
ss UnaryOperator
op AST
x
    convert AST
other = AST
other

  mkFn :: Int -> AST -> AST
  mkFn :: Int -> AST -> AST
mkFn = (ModuleName, PSString)
-> (Maybe SourceSpan
    -> Maybe SourceSpan -> Maybe SourceSpan -> [Text] -> AST -> AST)
-> Int
-> AST
-> AST
mkFn' forall a. (Eq a, IsString a) => (ModuleName, a)
C.P_mkFn forall a b. (a -> b) -> a -> b
$ \Maybe SourceSpan
ss1 Maybe SourceSpan
ss2 Maybe SourceSpan
ss3 [Text]
args AST
js ->
    Maybe SourceSpan -> Maybe Text -> [Text] -> AST -> AST
Function Maybe SourceSpan
ss1 forall a. Maybe a
Nothing [Text]
args (Maybe SourceSpan -> [AST] -> AST
Block Maybe SourceSpan
ss2 [Maybe SourceSpan -> AST -> AST
Return Maybe SourceSpan
ss3 AST
js])

  mkEffFn :: (ModuleName, PSString) -> Int -> AST -> AST
  mkEffFn :: (ModuleName, PSString) -> Int -> AST -> AST
mkEffFn (ModuleName, PSString)
mkFn_ = (ModuleName, PSString)
-> (Maybe SourceSpan
    -> Maybe SourceSpan -> Maybe SourceSpan -> [Text] -> AST -> AST)
-> Int
-> AST
-> AST
mkFn' (ModuleName, PSString)
mkFn_ forall a b. (a -> b) -> a -> b
$ \Maybe SourceSpan
ss1 Maybe SourceSpan
ss2 Maybe SourceSpan
ss3 [Text]
args AST
js ->
    Maybe SourceSpan -> Maybe Text -> [Text] -> AST -> AST
Function Maybe SourceSpan
ss1 forall a. Maybe a
Nothing [Text]
args (Maybe SourceSpan -> [AST] -> AST
Block Maybe SourceSpan
ss2 [Maybe SourceSpan -> AST -> AST
Return Maybe SourceSpan
ss3 (Maybe SourceSpan -> AST -> [AST] -> AST
App Maybe SourceSpan
ss3 AST
js [])])

  mkFn' :: (ModuleName, PSString) -> (Maybe SourceSpan -> Maybe SourceSpan -> Maybe SourceSpan -> [Text] -> AST -> AST) -> Int -> AST -> AST
  mkFn' :: (ModuleName, PSString)
-> (Maybe SourceSpan
    -> Maybe SourceSpan -> Maybe SourceSpan -> [Text] -> AST -> AST)
-> Int
-> AST
-> AST
mkFn' (ModuleName, PSString)
mkFn_ Maybe SourceSpan
-> Maybe SourceSpan -> Maybe SourceSpan -> [Text] -> AST -> AST
res Int
0 = AST -> AST
convert where
    convert :: AST -> AST
    convert :: AST -> AST
convert (App Maybe SourceSpan
_ (Ref (ModuleName, PSString)
mkFnN) [Function Maybe SourceSpan
s1 Maybe Text
Nothing [Text
_] (Block Maybe SourceSpan
s2 [Return Maybe SourceSpan
s3 AST
js])]) | (ModuleName, PSString) -> Int -> (ModuleName, PSString) -> Bool
isNFn (ModuleName, PSString)
mkFn_ Int
0 (ModuleName, PSString)
mkFnN =
      Maybe SourceSpan
-> Maybe SourceSpan -> Maybe SourceSpan -> [Text] -> AST -> AST
res Maybe SourceSpan
s1 Maybe SourceSpan
s2 Maybe SourceSpan
s3 [] AST
js
    convert AST
other = AST
other
  mkFn' (ModuleName, PSString)
mkFn_ Maybe SourceSpan
-> Maybe SourceSpan -> Maybe SourceSpan -> [Text] -> AST -> AST
res Int
n = AST -> AST
convert where
    convert :: AST -> AST
    convert :: AST -> AST
convert orig :: AST
orig@(App Maybe SourceSpan
ss (Ref (ModuleName, PSString)
mkFnN) [AST
fn]) | (ModuleName, PSString) -> Int -> (ModuleName, PSString) -> Bool
isNFn (ModuleName, PSString)
mkFn_ Int
n (ModuleName, PSString)
mkFnN =
      case Int -> [Text] -> AST -> Maybe ([Text], [AST])
collectArgs Int
n [] AST
fn of
        Just ([Text]
args, [Return Maybe SourceSpan
ss' AST
ret]) -> Maybe SourceSpan
-> Maybe SourceSpan -> Maybe SourceSpan -> [Text] -> AST -> AST
res Maybe SourceSpan
ss Maybe SourceSpan
ss Maybe SourceSpan
ss' [Text]
args AST
ret
        Maybe ([Text], [AST])
_ -> AST
orig
    convert AST
other = AST
other
    collectArgs :: Int -> [Text] -> AST -> Maybe ([Text], [AST])
    collectArgs :: Int -> [Text] -> AST -> Maybe ([Text], [AST])
collectArgs Int
1 [Text]
acc (Function Maybe SourceSpan
_ Maybe Text
Nothing [Text
oneArg] (Block Maybe SourceSpan
_ [AST]
js)) | forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
acc forall a. Eq a => a -> a -> Bool
== Int
n forall a. Num a => a -> a -> a
- Int
1 = forall a. a -> Maybe a
Just (forall a. [a] -> [a]
reverse (Text
oneArg forall a. a -> [a] -> [a]
: [Text]
acc), [AST]
js)
    collectArgs Int
m [Text]
acc (Function Maybe SourceSpan
_ Maybe Text
Nothing [Text
oneArg] (Block Maybe SourceSpan
_ [Return Maybe SourceSpan
_ AST
ret])) = Int -> [Text] -> AST -> Maybe ([Text], [AST])
collectArgs (Int
m forall a. Num a => a -> a -> a
- Int
1) (Text
oneArg forall a. a -> [a] -> [a]
: [Text]
acc) AST
ret
    collectArgs Int
_ [Text]
_   AST
_ = forall a. Maybe a
Nothing

  isNFn :: (ModuleName, PSString) -> Int -> (ModuleName, PSString) -> Bool
  isNFn :: (ModuleName, PSString) -> Int -> (ModuleName, PSString) -> Bool
isNFn (ModuleName, PSString)
prefix Int
n (ModuleName, PSString)
fn = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Semigroup a => a -> a -> a
<> Text -> PSString
mkString (String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Int
n)) (ModuleName, PSString)
prefix forall a. Eq a => a -> a -> Bool
== (ModuleName, PSString)
fn

  runFn :: Int -> AST -> AST
  runFn :: Int -> AST -> AST
runFn = (ModuleName, PSString)
-> (Maybe SourceSpan -> AST -> [AST] -> AST) -> Int -> AST -> AST
runFn' forall a. (Eq a, IsString a) => (ModuleName, a)
C.P_runFn Maybe SourceSpan -> AST -> [AST] -> AST
App

  runEffFn :: (ModuleName, PSString) -> Int -> AST -> AST
  runEffFn :: (ModuleName, PSString) -> Int -> AST -> AST
runEffFn (ModuleName, PSString)
runFn_ = (ModuleName, PSString)
-> (Maybe SourceSpan -> AST -> [AST] -> AST) -> Int -> AST -> AST
runFn' (ModuleName, PSString)
runFn_ forall a b. (a -> b) -> a -> b
$ \Maybe SourceSpan
ss AST
fn [AST]
acc ->
    Maybe SourceSpan -> Maybe Text -> [Text] -> AST -> AST
Function Maybe SourceSpan
ss forall a. Maybe a
Nothing [] (Maybe SourceSpan -> [AST] -> AST
Block Maybe SourceSpan
ss [Maybe SourceSpan -> AST -> AST
Return Maybe SourceSpan
ss (Maybe SourceSpan -> AST -> [AST] -> AST
App Maybe SourceSpan
ss AST
fn [AST]
acc)])

  runFn' :: (ModuleName, PSString) -> (Maybe SourceSpan -> AST -> [AST] -> AST) -> Int -> AST -> AST
  runFn' :: (ModuleName, PSString)
-> (Maybe SourceSpan -> AST -> [AST] -> AST) -> Int -> AST -> AST
runFn' (ModuleName, PSString)
runFn_ Maybe SourceSpan -> AST -> [AST] -> AST
res Int
n = AST -> AST
convert where
    convert :: AST -> AST
    convert :: AST -> AST
convert AST
js = forall a. a -> Maybe a -> a
fromMaybe AST
js forall a b. (a -> b) -> a -> b
$ Int -> [AST] -> AST -> Maybe AST
go Int
n [] AST
js

    go :: Int -> [AST] -> AST -> Maybe AST
    go :: Int -> [AST] -> AST -> Maybe AST
go Int
0 [AST]
acc (App Maybe SourceSpan
ss (Ref (ModuleName, PSString)
runFnN) [AST
fn]) | (ModuleName, PSString) -> Int -> (ModuleName, PSString) -> Bool
isNFn (ModuleName, PSString)
runFn_ Int
n (ModuleName, PSString)
runFnN Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Int
length [AST]
acc forall a. Eq a => a -> a -> Bool
== Int
n =
      forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Maybe SourceSpan -> AST -> [AST] -> AST
res Maybe SourceSpan
ss AST
fn [AST]
acc
    go Int
m [AST]
acc (App Maybe SourceSpan
_ AST
lhs [AST
arg]) = Int -> [AST] -> AST -> Maybe AST
go (Int
m forall a. Num a => a -> a -> a
- Int
1) (AST
arg forall a. a -> [a] -> [a]
: [AST]
acc) AST
lhs
    go Int
_ [AST]
_   AST
_ = forall a. Maybe a
Nothing

  inlineNonClassFunction :: (AST -> Bool) -> (AST -> AST -> AST) -> AST -> AST
  inlineNonClassFunction :: (AST -> Bool) -> (AST -> AST -> AST) -> AST -> AST
inlineNonClassFunction AST -> Bool
p AST -> AST -> AST
f = AST -> AST
convert where
    convert :: AST -> AST
    convert :: AST -> AST
convert (App Maybe SourceSpan
_ (App Maybe SourceSpan
_ AST
op' [AST
x]) [AST
y]) | AST -> Bool
p AST
op' = AST -> AST -> AST
f AST
x AST
y
    convert AST
other = AST
other

  isModFnWithDict :: (ModuleName, PSString) -> AST -> Bool
  isModFnWithDict :: (ModuleName, PSString) -> AST -> Bool
isModFnWithDict (ModuleName, PSString)
fn (App Maybe SourceSpan
_ (Ref (ModuleName, PSString)
fn') [Var Maybe SourceSpan
_ Text
_]) = (ModuleName, PSString)
fn forall a. Eq a => a -> a -> Bool
== (ModuleName, PSString)
fn'
  isModFnWithDict (ModuleName, PSString)
_ AST
_ = Bool
False

-- (f <<< g $ x) = f (g x)
-- (f <<< g)     = \x -> f (g x)
inlineFnComposition :: forall m. MonadSupply m => (AST -> AST) -> AST -> m AST
inlineFnComposition :: forall (m :: * -> *). MonadSupply m => (AST -> AST) -> AST -> m AST
inlineFnComposition AST -> AST
expander = forall (m :: * -> *). Monad m => (AST -> m AST) -> AST -> m AST
everywhereTopDownM AST -> m AST
convert
  where
  convert :: AST -> m AST
  convert :: AST -> m AST
convert (App Maybe SourceSpan
s1 (App Maybe SourceSpan
s2 (App Maybe SourceSpan
_ (AST -> AST
expander -> App Maybe SourceSpan
_ (Ref (ModuleName, PSString)
fn) [Ref (ModuleName, PSString)
C.P_semigroupoidFn]) [AST
x]) [AST
y]) [AST
z])
    | (ModuleName, PSString)
C.P_compose <- (ModuleName, PSString)
fn = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Maybe SourceSpan -> AST -> [AST] -> AST
App Maybe SourceSpan
s1 AST
x [Maybe SourceSpan -> AST -> [AST] -> AST
App Maybe SourceSpan
s2 AST
y [AST
z]]
    | (ModuleName, PSString)
C.P_composeFlipped <- (ModuleName, PSString)
fn = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Maybe SourceSpan -> AST -> [AST] -> AST
App Maybe SourceSpan
s2 AST
y [Maybe SourceSpan -> AST -> [AST] -> AST
App Maybe SourceSpan
s1 AST
x [AST
z]]
  convert app :: AST
app@(App Maybe SourceSpan
ss (App Maybe SourceSpan
_ (AST -> AST
expander -> App Maybe SourceSpan
_ (Ref (ModuleName, PSString)
fn) [Ref (ModuleName, PSString)
C.P_semigroupoidFn]) [AST]
_) [AST]
_)
    | (ModuleName, PSString)
fn forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [forall a. (Eq a, IsString a) => (ModuleName, a)
C.P_compose, forall a. (Eq a, IsString a) => (ModuleName, a)
C.P_composeFlipped] = Maybe SourceSpan -> [Either AST (Text, AST)] -> Text -> AST
mkApps Maybe SourceSpan
ss forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AST -> m [Either AST (Text, AST)]
goApps AST
app forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *). MonadSupply m => m Text
freshName
  convert AST
other = forall (m :: * -> *) a. Monad m => a -> m a
return AST
other

  mkApps :: Maybe SourceSpan -> [Either AST (Text, AST)] -> Text -> AST
  mkApps :: Maybe SourceSpan -> [Either AST (Text, AST)] -> Text -> AST
mkApps Maybe SourceSpan
ss [Either AST (Text, AST)]
fns Text
a = Maybe SourceSpan -> AST -> [AST] -> AST
App Maybe SourceSpan
ss (Maybe SourceSpan -> Maybe Text -> [Text] -> AST -> AST
Function Maybe SourceSpan
ss forall a. Maybe a
Nothing [] (Maybe SourceSpan -> [AST] -> AST
Block Maybe SourceSpan
ss forall a b. (a -> b) -> a -> b
$ [AST]
vars forall a. Semigroup a => a -> a -> a
<> [Maybe SourceSpan -> AST -> AST
Return forall a. Maybe a
Nothing AST
comp])) []
    where
    vars :: [AST]
vars = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Maybe SourceSpan -> Text -> Maybe (InitializerEffects, AST) -> AST
VariableIntroduction Maybe SourceSpan
ss) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. (InitializerEffects
UnknownEffects, )) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. [Either a b] -> [b]
rights [Either AST (Text, AST)]
fns
    comp :: AST
comp = Maybe SourceSpan -> Maybe Text -> [Text] -> AST -> AST
Function Maybe SourceSpan
ss forall a. Maybe a
Nothing [Text
a] (Maybe SourceSpan -> [AST] -> AST
Block Maybe SourceSpan
ss [Maybe SourceSpan -> AST -> AST
Return forall a. Maybe a
Nothing AST
apps])
    apps :: AST
apps = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Either AST (Text, AST)
fn AST
acc -> Maybe SourceSpan -> AST -> [AST] -> AST
App Maybe SourceSpan
ss (Either AST (Text, AST) -> AST
mkApp Either AST (Text, AST)
fn) [AST
acc]) (Maybe SourceSpan -> Text -> AST
Var Maybe SourceSpan
ss Text
a) [Either AST (Text, AST)]
fns

  mkApp :: Either AST (Text, AST) -> AST
  mkApp :: Either AST (Text, AST) -> AST
mkApp = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ \(Text
name, AST
arg) -> Maybe SourceSpan -> Text -> AST
Var (AST -> Maybe SourceSpan
getSourceSpan AST
arg) Text
name

  goApps :: AST -> m [Either AST (Text, AST)]
  goApps :: AST -> m [Either AST (Text, AST)]
goApps (App Maybe SourceSpan
_ (App Maybe SourceSpan
_ (AST -> AST
expander -> App Maybe SourceSpan
_ (Ref (ModuleName, PSString)
fn) [Ref (ModuleName, PSString)
C.P_semigroupoidFn]) [AST
x]) [AST
y])
    | (ModuleName, PSString)
C.P_compose <- (ModuleName, PSString)
fn = forall a. Monoid a => a -> a -> a
mappend forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AST -> m [Either AST (Text, AST)]
goApps AST
x forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AST -> m [Either AST (Text, AST)]
goApps AST
y
    | (ModuleName, PSString)
C.P_composeFlipped <- (ModuleName, PSString)
fn = forall a. Monoid a => a -> a -> a
mappend forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AST -> m [Either AST (Text, AST)]
goApps AST
y forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AST -> m [Either AST (Text, AST)]
goApps AST
x
  goApps app :: AST
app@App {} = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,AST
app) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadSupply m => m Text
freshName
  goApps AST
other = forall (f :: * -> *) a. Applicative f => a -> f a
pure [forall a b. a -> Either a b
Left AST
other]

inlineFnIdentity :: (AST -> AST) -> AST -> AST
inlineFnIdentity :: (AST -> AST) -> AST -> AST
inlineFnIdentity AST -> AST
expander = (AST -> AST) -> AST -> AST
everywhereTopDown AST -> AST
convert
  where
  convert :: AST -> AST
  convert :: AST -> AST
convert (App Maybe SourceSpan
_ (AST -> AST
expander -> App Maybe SourceSpan
_ (Ref (ModuleName, PSString)
C.P_identity) [Ref (ModuleName, PSString)
C.P_categoryFn]) [AST
x]) = AST
x
  convert AST
other = AST
other

inlineUnsafeCoerce :: AST -> AST
inlineUnsafeCoerce :: AST -> AST
inlineUnsafeCoerce = (AST -> AST) -> AST -> AST
everywhereTopDown AST -> AST
convert where
  convert :: AST -> AST
convert (App Maybe SourceSpan
_ (Ref (ModuleName, PSString)
C.P_unsafeCoerce) [ AST
comp ]) = AST
comp
  convert AST
other = AST
other

inlineUnsafePartial :: AST -> AST
inlineUnsafePartial :: AST -> AST
inlineUnsafePartial = (AST -> AST) -> AST -> AST
everywhereTopDown AST -> AST
convert where
  convert :: AST -> AST
convert (App Maybe SourceSpan
ss (Ref (ModuleName, PSString)
C.P_unsafePartial) [ AST
comp ])
    -- Apply to undefined here, the application should be optimized away
    -- if it is safe to do so
    = Maybe SourceSpan -> AST -> [AST] -> AST
App Maybe SourceSpan
ss AST
comp [ Maybe SourceSpan -> Text -> AST
Var Maybe SourceSpan
ss forall a. (Eq a, IsString a) => a
C.S_undefined ]
  convert AST
other = AST
other