-- | 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 Data.Text qualified as T

import Language.PureScript.Names (ModuleName)
import Language.PureScript.PSString (PSString, mkString)
import Language.PureScript.CoreImp.AST (AST(..), BinaryOperator(..), InitializerEffects(..), UnaryOperator(..), everywhere, everywhereTopDown, everywhereTopDownM, getSourceSpan)
import Language.PureScript.CoreImp.Optimizer.Common (pattern Ref, applyAll, isReassigned, isRebound, isUpdated, removeFromBlock, replaceIdent, replaceIdents)
import Language.PureScript.AST (SourceSpan(..))
import Language.PureScript.Constants.Libs qualified as C
import Language.PureScript.Constants.Prim qualified 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