-- | 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.String (IsString, fromString)
import Data.Text (Text)
import qualified Data.Text as T

import Language.PureScript.Names (ModuleName)
import Language.PureScript.PSString (PSString)
import Language.PureScript.CoreImp.AST
import Language.PureScript.CoreImp.Optimizer.Common
import Language.PureScript.AST (SourceSpan(..))
import qualified Language.PureScript.Constants.Prelude 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. IsString a => a
C.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 AST
fn [AST
dict])
    | [(ModuleName, PSString)] -> AST -> Bool
isDict' [forall a. IsString a => (ModuleName, a)
semiringNumber, forall a. IsString a => (ModuleName, a)
semiringInt] AST
dict Bool -> Bool -> Bool
&& (ModuleName, PSString) -> AST -> Bool
isDict (ModuleName, PSString)
fnZero AST
fn = Maybe SourceSpan -> Either Integer Double -> AST
NumericLiteral Maybe SourceSpan
ss (forall a b. a -> Either a b
Left Integer
0)
    | [(ModuleName, PSString)] -> AST -> Bool
isDict' [forall a. IsString a => (ModuleName, a)
semiringNumber, forall a. IsString a => (ModuleName, a)
semiringInt] AST
dict Bool -> Bool -> Bool
&& (ModuleName, PSString) -> AST -> Bool
isDict (ModuleName, PSString)
fnOne AST
fn = Maybe SourceSpan -> Either Integer Double -> AST
NumericLiteral Maybe SourceSpan
ss (forall a b. a -> Either a b
Left Integer
1)
    | (ModuleName, PSString) -> AST -> Bool
isDict forall a. IsString a => (ModuleName, a)
boundedBoolean AST
dict Bool -> Bool -> Bool
&& (ModuleName, PSString) -> AST -> Bool
isDict (ModuleName, PSString)
fnBottom AST
fn = Maybe SourceSpan -> Bool -> AST
BooleanLiteral Maybe SourceSpan
ss Bool
False
    | (ModuleName, PSString) -> AST -> Bool
isDict forall a. IsString a => (ModuleName, a)
boundedBoolean AST
dict Bool -> Bool -> Bool
&& (ModuleName, PSString) -> AST -> Bool
isDict (ModuleName, PSString)
fnTop AST
fn = Maybe SourceSpan -> Bool -> AST
BooleanLiteral Maybe SourceSpan
ss Bool
True
  convert (App Maybe SourceSpan
ss (AST -> AST
expander -> App Maybe SourceSpan
_ AST
fn [AST
dict]) [AST
x])
    | (ModuleName, PSString) -> AST -> Bool
isDict forall a. IsString a => (ModuleName, a)
ringInt AST
dict Bool -> Bool -> Bool
&& (ModuleName, PSString) -> AST -> Bool
isDict (ModuleName, PSString)
fnNegate AST
fn = 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
_ AST
fn [AST
dict]) [AST
x]) [AST
y])
    | (ModuleName, PSString) -> AST -> Bool
isDict forall a. IsString a => (ModuleName, a)
semiringInt AST
dict Bool -> Bool -> Bool
&& (ModuleName, PSString) -> AST -> Bool
isDict (ModuleName, PSString)
fnAdd AST
fn = Maybe SourceSpan -> BinaryOperator -> AST -> AST -> AST
intOp Maybe SourceSpan
ss BinaryOperator
Add AST
x AST
y
    | (ModuleName, PSString) -> AST -> Bool
isDict forall a. IsString a => (ModuleName, a)
semiringInt AST
dict Bool -> Bool -> Bool
&& (ModuleName, PSString) -> AST -> Bool
isDict (ModuleName, PSString)
fnMultiply AST
fn = Maybe SourceSpan -> BinaryOperator -> AST -> AST -> AST
intOp Maybe SourceSpan
ss BinaryOperator
Multiply AST
x AST
y
    | (ModuleName, PSString) -> AST -> Bool
isDict forall a. IsString a => (ModuleName, a)
ringInt AST
dict Bool -> Bool -> Bool
&& (ModuleName, PSString) -> AST -> Bool
isDict (ModuleName, PSString)
fnSubtract AST
fn = Maybe SourceSpan -> BinaryOperator -> AST -> AST -> AST
intOp Maybe SourceSpan
ss BinaryOperator
Subtract AST
x AST
y
  convert AST
other = AST
other
  fnZero :: (ModuleName, PSString)
fnZero = (ModuleName
C.DataSemiring, forall a. IsString a => a
C.zero)
  fnOne :: (ModuleName, PSString)
fnOne = (ModuleName
C.DataSemiring, forall a. IsString a => a
C.one)
  fnBottom :: (ModuleName, PSString)
fnBottom = (ModuleName
C.DataBounded, forall a. IsString a => a
C.bottom)
  fnTop :: (ModuleName, PSString)
fnTop = (ModuleName
C.DataBounded, forall a. IsString a => a
C.top)
  fnAdd :: (ModuleName, PSString)
fnAdd = (ModuleName
C.DataSemiring, forall a. IsString a => a
C.add)
  fnMultiply :: (ModuleName, PSString)
fnMultiply = (ModuleName
C.DataSemiring, forall a. IsString a => a
C.mul)
  fnSubtract :: (ModuleName, PSString)
fnSubtract = (ModuleName
C.DataRing, forall a. IsString a => a
C.sub)
  fnNegate :: (ModuleName, PSString)
fnNegate = (ModuleName
C.DataRing, forall a. IsString a => a
C.negate)
  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. IsString a => (ModuleName, a)
semiringNumber forall a. IsString a => (ModuleName, a)
opAdd BinaryOperator
Add
  , (ModuleName, PSString)
-> (ModuleName, PSString) -> BinaryOperator -> AST -> AST
binary forall a. IsString a => (ModuleName, a)
semiringNumber forall a. IsString a => (ModuleName, a)
opMul BinaryOperator
Multiply

  , (ModuleName, PSString)
-> (ModuleName, PSString) -> BinaryOperator -> AST -> AST
binary forall a. IsString a => (ModuleName, a)
ringNumber forall a. IsString a => (ModuleName, a)
opSub BinaryOperator
Subtract
  , (ModuleName, PSString)
-> (ModuleName, PSString) -> UnaryOperator -> AST -> AST
unary  forall a. IsString a => (ModuleName, a)
ringNumber forall a. IsString a => (ModuleName, a)
opNegate UnaryOperator
Negate

  , (ModuleName, PSString)
-> (ModuleName, PSString) -> BinaryOperator -> AST -> AST
binary forall a. IsString a => (ModuleName, a)
euclideanRingNumber forall a. IsString a => (ModuleName, a)
opDiv BinaryOperator
Divide

  , (ModuleName, PSString)
-> (ModuleName, PSString) -> BinaryOperator -> AST -> AST
binary forall a. IsString a => (ModuleName, a)
eqNumber forall a. IsString a => (ModuleName, a)
opEq BinaryOperator
EqualTo
  , (ModuleName, PSString)
-> (ModuleName, PSString) -> BinaryOperator -> AST -> AST
binary forall a. IsString a => (ModuleName, a)
eqNumber forall a. IsString a => (ModuleName, a)
opNotEq BinaryOperator
NotEqualTo
  , (ModuleName, PSString)
-> (ModuleName, PSString) -> BinaryOperator -> AST -> AST
binary forall a. IsString a => (ModuleName, a)
eqInt forall a. IsString a => (ModuleName, a)
opEq BinaryOperator
EqualTo
  , (ModuleName, PSString)
-> (ModuleName, PSString) -> BinaryOperator -> AST -> AST
binary forall a. IsString a => (ModuleName, a)
eqInt forall a. IsString a => (ModuleName, a)
opNotEq BinaryOperator
NotEqualTo
  , (ModuleName, PSString)
-> (ModuleName, PSString) -> BinaryOperator -> AST -> AST
binary forall a. IsString a => (ModuleName, a)
eqString forall a. IsString a => (ModuleName, a)
opEq BinaryOperator
EqualTo
  , (ModuleName, PSString)
-> (ModuleName, PSString) -> BinaryOperator -> AST -> AST
binary forall a. IsString a => (ModuleName, a)
eqString forall a. IsString a => (ModuleName, a)
opNotEq BinaryOperator
NotEqualTo
  , (ModuleName, PSString)
-> (ModuleName, PSString) -> BinaryOperator -> AST -> AST
binary forall a. IsString a => (ModuleName, a)
eqChar forall a. IsString a => (ModuleName, a)
opEq BinaryOperator
EqualTo
  , (ModuleName, PSString)
-> (ModuleName, PSString) -> BinaryOperator -> AST -> AST
binary forall a. IsString a => (ModuleName, a)
eqChar forall a. IsString a => (ModuleName, a)
opNotEq BinaryOperator
NotEqualTo
  , (ModuleName, PSString)
-> (ModuleName, PSString) -> BinaryOperator -> AST -> AST
binary forall a. IsString a => (ModuleName, a)
eqBoolean forall a. IsString a => (ModuleName, a)
opEq BinaryOperator
EqualTo
  , (ModuleName, PSString)
-> (ModuleName, PSString) -> BinaryOperator -> AST -> AST
binary forall a. IsString a => (ModuleName, a)
eqBoolean forall a. IsString a => (ModuleName, a)
opNotEq BinaryOperator
NotEqualTo

  , (ModuleName, PSString)
-> (ModuleName, PSString) -> BinaryOperator -> AST -> AST
binary forall a. IsString a => (ModuleName, a)
ordBoolean forall a. IsString a => (ModuleName, a)
opLessThan BinaryOperator
LessThan
  , (ModuleName, PSString)
-> (ModuleName, PSString) -> BinaryOperator -> AST -> AST
binary forall a. IsString a => (ModuleName, a)
ordBoolean forall a. IsString a => (ModuleName, a)
opLessThanOrEq BinaryOperator
LessThanOrEqualTo
  , (ModuleName, PSString)
-> (ModuleName, PSString) -> BinaryOperator -> AST -> AST
binary forall a. IsString a => (ModuleName, a)
ordBoolean forall a. IsString a => (ModuleName, a)
opGreaterThan BinaryOperator
GreaterThan
  , (ModuleName, PSString)
-> (ModuleName, PSString) -> BinaryOperator -> AST -> AST
binary forall a. IsString a => (ModuleName, a)
ordBoolean forall a. IsString a => (ModuleName, a)
opGreaterThanOrEq BinaryOperator
GreaterThanOrEqualTo
  , (ModuleName, PSString)
-> (ModuleName, PSString) -> BinaryOperator -> AST -> AST
binary forall a. IsString a => (ModuleName, a)
ordChar forall a. IsString a => (ModuleName, a)
opLessThan BinaryOperator
LessThan
  , (ModuleName, PSString)
-> (ModuleName, PSString) -> BinaryOperator -> AST -> AST
binary forall a. IsString a => (ModuleName, a)
ordChar forall a. IsString a => (ModuleName, a)
opLessThanOrEq BinaryOperator
LessThanOrEqualTo
  , (ModuleName, PSString)
-> (ModuleName, PSString) -> BinaryOperator -> AST -> AST
binary forall a. IsString a => (ModuleName, a)
ordChar forall a. IsString a => (ModuleName, a)
opGreaterThan BinaryOperator
GreaterThan
  , (ModuleName, PSString)
-> (ModuleName, PSString) -> BinaryOperator -> AST -> AST
binary forall a. IsString a => (ModuleName, a)
ordChar forall a. IsString a => (ModuleName, a)
opGreaterThanOrEq BinaryOperator
GreaterThanOrEqualTo
  , (ModuleName, PSString)
-> (ModuleName, PSString) -> BinaryOperator -> AST -> AST
binary forall a. IsString a => (ModuleName, a)
ordInt forall a. IsString a => (ModuleName, a)
opLessThan BinaryOperator
LessThan
  , (ModuleName, PSString)
-> (ModuleName, PSString) -> BinaryOperator -> AST -> AST
binary forall a. IsString a => (ModuleName, a)
ordInt forall a. IsString a => (ModuleName, a)
opLessThanOrEq BinaryOperator
LessThanOrEqualTo
  , (ModuleName, PSString)
-> (ModuleName, PSString) -> BinaryOperator -> AST -> AST
binary forall a. IsString a => (ModuleName, a)
ordInt forall a. IsString a => (ModuleName, a)
opGreaterThan BinaryOperator
GreaterThan
  , (ModuleName, PSString)
-> (ModuleName, PSString) -> BinaryOperator -> AST -> AST
binary forall a. IsString a => (ModuleName, a)
ordInt forall a. IsString a => (ModuleName, a)
opGreaterThanOrEq BinaryOperator
GreaterThanOrEqualTo
  , (ModuleName, PSString)
-> (ModuleName, PSString) -> BinaryOperator -> AST -> AST
binary forall a. IsString a => (ModuleName, a)
ordNumber forall a. IsString a => (ModuleName, a)
opLessThan BinaryOperator
LessThan
  , (ModuleName, PSString)
-> (ModuleName, PSString) -> BinaryOperator -> AST -> AST
binary forall a. IsString a => (ModuleName, a)
ordNumber forall a. IsString a => (ModuleName, a)
opLessThanOrEq BinaryOperator
LessThanOrEqualTo
  , (ModuleName, PSString)
-> (ModuleName, PSString) -> BinaryOperator -> AST -> AST
binary forall a. IsString a => (ModuleName, a)
ordNumber forall a. IsString a => (ModuleName, a)
opGreaterThan BinaryOperator
GreaterThan
  , (ModuleName, PSString)
-> (ModuleName, PSString) -> BinaryOperator -> AST -> AST
binary forall a. IsString a => (ModuleName, a)
ordNumber forall a. IsString a => (ModuleName, a)
opGreaterThanOrEq BinaryOperator
GreaterThanOrEqualTo
  , (ModuleName, PSString)
-> (ModuleName, PSString) -> BinaryOperator -> AST -> AST
binary forall a. IsString a => (ModuleName, a)
ordString forall a. IsString a => (ModuleName, a)
opLessThan BinaryOperator
LessThan
  , (ModuleName, PSString)
-> (ModuleName, PSString) -> BinaryOperator -> AST -> AST
binary forall a. IsString a => (ModuleName, a)
ordString forall a. IsString a => (ModuleName, a)
opLessThanOrEq BinaryOperator
LessThanOrEqualTo
  , (ModuleName, PSString)
-> (ModuleName, PSString) -> BinaryOperator -> AST -> AST
binary forall a. IsString a => (ModuleName, a)
ordString forall a. IsString a => (ModuleName, a)
opGreaterThan BinaryOperator
GreaterThan
  , (ModuleName, PSString)
-> (ModuleName, PSString) -> BinaryOperator -> AST -> AST
binary forall a. IsString a => (ModuleName, a)
ordString forall a. IsString a => (ModuleName, a)
opGreaterThanOrEq BinaryOperator
GreaterThanOrEqualTo

  , (ModuleName, PSString)
-> (ModuleName, PSString) -> BinaryOperator -> AST -> AST
binary forall a. IsString a => (ModuleName, a)
semigroupString forall a. IsString a => (ModuleName, a)
opAppend BinaryOperator
Add

  , (ModuleName, PSString)
-> (ModuleName, PSString) -> BinaryOperator -> AST -> AST
binary forall a. IsString a => (ModuleName, a)
heytingAlgebraBoolean forall a. IsString a => (ModuleName, a)
opConj BinaryOperator
And
  , (ModuleName, PSString)
-> (ModuleName, PSString) -> BinaryOperator -> AST -> AST
binary forall a. IsString a => (ModuleName, a)
heytingAlgebraBoolean forall a. IsString a => (ModuleName, a)
opDisj BinaryOperator
Or
  , (ModuleName, PSString)
-> (ModuleName, PSString) -> UnaryOperator -> AST -> AST
unary  forall a. IsString a => (ModuleName, a)
heytingAlgebraBoolean forall a. IsString a => (ModuleName, a)
opNot UnaryOperator
Not

  , ModuleName -> PSString -> BinaryOperator -> AST -> AST
binary' ModuleName
C.DataIntBits forall a. IsString a => a
C.or BinaryOperator
BitwiseOr
  , ModuleName -> PSString -> BinaryOperator -> AST -> AST
binary' ModuleName
C.DataIntBits forall a. IsString a => a
C.and BinaryOperator
BitwiseAnd
  , ModuleName -> PSString -> BinaryOperator -> AST -> AST
binary' ModuleName
C.DataIntBits forall a. IsString a => a
C.xor BinaryOperator
BitwiseXor
  , ModuleName -> PSString -> BinaryOperator -> AST -> AST
binary' ModuleName
C.DataIntBits forall a. IsString a => a
C.shl BinaryOperator
ShiftLeft
  , ModuleName -> PSString -> BinaryOperator -> AST -> AST
binary' ModuleName
C.DataIntBits forall a. IsString a => a
C.shr BinaryOperator
ShiftRight
  , ModuleName -> PSString -> BinaryOperator -> AST -> AST
binary' ModuleName
C.DataIntBits forall a. IsString a => a
C.zshr BinaryOperator
ZeroFillShiftRight
  , ModuleName -> PSString -> UnaryOperator -> AST -> AST
unary'  ModuleName
C.DataIntBits forall a. IsString a => a
C.complement UnaryOperator
BitwiseNot

  , (AST -> Bool) -> (AST -> AST -> AST) -> AST -> AST
inlineNonClassFunction ((ModuleName, PSString) -> AST -> Bool
isModFnWithDict (ModuleName
C.DataArray, forall a. IsString a => a
C.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 -> Text -> Int -> AST -> AST
mkEffFn ModuleName
C.ControlMonadEffUncurried forall a. IsString a => a
C.mkEffFn Int
i, ModuleName -> Text -> Int -> AST -> AST
runEffFn ModuleName
C.ControlMonadEffUncurried forall a. IsString a => a
C.runEffFn Int
i ] ] forall a. [a] -> [a] -> [a]
++
  [ AST -> AST
fn | Int
i <- [Int
0..Int
10], AST -> AST
fn <- [ ModuleName -> Text -> Int -> AST -> AST
mkEffFn ModuleName
C.EffectUncurried forall a. IsString a => a
C.mkEffectFn Int
i, ModuleName -> Text -> Int -> AST -> AST
runEffFn ModuleName
C.EffectUncurried forall a. IsString a => a
C.runEffectFn Int
i ] ] forall a. [a] -> [a] -> [a]
++
  [ AST -> AST
fn | Int
i <- [Int
0..Int
10], AST -> AST
fn <- [ ModuleName -> Text -> Int -> AST -> AST
mkEffFn ModuleName
C.ControlMonadSTUncurried forall a. IsString a => a
C.mkSTFn Int
i, ModuleName -> Text -> Int -> AST -> AST
runEffFn ModuleName
C.ControlMonadSTUncurried forall a. IsString a => a
C.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)
fns 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
_ AST
fn [AST
dict']) [AST
x]) [AST
y]) | (ModuleName, PSString) -> AST -> Bool
isDict (ModuleName, PSString)
dict AST
dict' Bool -> Bool -> Bool
&& (ModuleName, PSString) -> AST -> Bool
isDict (ModuleName, PSString)
fns AST
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
moduleName PSString
opString BinaryOperator
op = AST -> AST
convert where
    convert :: AST -> AST
    convert :: AST -> AST
convert (App Maybe SourceSpan
ss (App Maybe SourceSpan
_ AST
fn [AST
x]) [AST
y]) | (ModuleName, PSString) -> AST -> Bool
isDict (ModuleName
moduleName, PSString
opString) AST
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)
dicts (ModuleName, PSString)
fns UnaryOperator
op = AST -> AST
convert where
    convert :: AST -> AST
    convert :: AST -> AST
convert (App Maybe SourceSpan
ss (AST -> AST
expander -> App Maybe SourceSpan
_ AST
fn [AST
dict']) [AST
x]) | (ModuleName, PSString) -> AST -> Bool
isDict (ModuleName, PSString)
dicts AST
dict' Bool -> Bool -> Bool
&& (ModuleName, PSString) -> AST -> Bool
isDict (ModuleName, PSString)
fns AST
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
moduleName PSString
fnName UnaryOperator
op = AST -> AST
convert where
    convert :: AST -> AST
    convert :: AST -> AST
convert (App Maybe SourceSpan
ss AST
fn [AST
x]) | (ModuleName, PSString) -> AST -> Bool
isDict (ModuleName
moduleName, PSString
fnName) AST
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
-> Text
-> (Maybe SourceSpan
    -> Maybe SourceSpan -> Maybe SourceSpan -> [Text] -> AST -> AST)
-> Int
-> AST
-> AST
mkFn' ModuleName
C.DataFunctionUncurried forall a. IsString a => a
C.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 -> Text -> Int -> AST -> AST
  mkEffFn :: ModuleName -> Text -> Int -> AST -> AST
mkEffFn ModuleName
modName Text
fnName = ModuleName
-> Text
-> (Maybe SourceSpan
    -> Maybe SourceSpan -> Maybe SourceSpan -> [Text] -> AST -> AST)
-> Int
-> AST
-> AST
mkFn' ModuleName
modName Text
fnName 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 -> Text -> (Maybe SourceSpan -> Maybe SourceSpan -> Maybe SourceSpan -> [Text] -> AST -> AST) -> Int -> AST -> AST
  mkFn' :: ModuleName
-> Text
-> (Maybe SourceSpan
    -> Maybe SourceSpan -> Maybe SourceSpan -> [Text] -> AST -> AST)
-> Int
-> AST
-> AST
mkFn' ModuleName
modName Text
fnName 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
_ AST
mkFnN [Function Maybe SourceSpan
s1 Maybe Text
Nothing [Text
_] (Block Maybe SourceSpan
s2 [Return Maybe SourceSpan
s3 AST
js])]) | ModuleName -> Text -> Int -> AST -> Bool
isNFn ModuleName
modName Text
fnName Int
0 AST
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
modName Text
fnName 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 AST
mkFnN [AST
fn]) | ModuleName -> Text -> Int -> AST -> Bool
isNFn ModuleName
modName Text
fnName Int
n AST
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 -> Text -> Int -> AST -> Bool
  isNFn :: ModuleName -> Text -> Int -> AST -> Bool
isNFn ModuleName
expectMod Text
prefix Int
n (ModuleAccessor Maybe SourceSpan
_ ModuleName
modName PSString
name) | ModuleName
modName forall a. Eq a => a -> a -> Bool
== ModuleName
expectMod =
    PSString
name forall a. Eq a => a -> a -> Bool
== forall a. IsString a => String -> a
fromString (Text -> String
T.unpack Text
prefix forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
n)
  isNFn ModuleName
_ Text
_ Int
_ AST
_ = Bool
False

  runFn :: Int -> AST -> AST
  runFn :: Int -> AST -> AST
runFn = ModuleName
-> Text
-> (Maybe SourceSpan -> AST -> [AST] -> AST)
-> Int
-> AST
-> AST
runFn' ModuleName
C.DataFunctionUncurried forall a. IsString a => a
C.runFn Maybe SourceSpan -> AST -> [AST] -> AST
App

  runEffFn :: ModuleName -> Text -> Int -> AST -> AST
  runEffFn :: ModuleName -> Text -> Int -> AST -> AST
runEffFn ModuleName
modName Text
fnName = ModuleName
-> Text
-> (Maybe SourceSpan -> AST -> [AST] -> AST)
-> Int
-> AST
-> AST
runFn' ModuleName
modName Text
fnName 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 -> Text -> (Maybe SourceSpan -> AST -> [AST] -> AST) -> Int -> AST -> AST
  runFn' :: ModuleName
-> Text
-> (Maybe SourceSpan -> AST -> [AST] -> AST)
-> Int
-> AST
-> AST
runFn' ModuleName
modName Text
runFnName 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 AST
runFnN [AST
fn]) | ModuleName -> Text -> Int -> AST -> Bool
isNFn ModuleName
modName Text
runFnName Int
n AST
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
m, PSString
op) (App Maybe SourceSpan
_ (ModuleAccessor Maybe SourceSpan
_ ModuleName
m' PSString
op') [Var Maybe SourceSpan
_ Text
_]) =
    ModuleName
m forall a. Eq a => a -> a -> Bool
== ModuleName
m' Bool -> Bool -> Bool
&& PSString
op forall a. Eq a => a -> a -> Bool
== PSString
op'
  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
_ AST
fn [AST
dict']) [AST
x]) [AST
y]) [AST
z])
    | AST -> AST -> Bool
isFnCompose AST
dict' AST
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]]
    | AST -> AST -> Bool
isFnComposeFlipped AST
dict' AST
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
_ AST
fn [AST
dict']) [AST]
_) [AST]
_)
    | AST -> AST -> Bool
isFnCompose AST
dict' AST
fn Bool -> Bool -> Bool
|| AST -> AST -> Bool
isFnComposeFlipped AST
dict' AST
fn = 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
_ AST
fn [AST
dict']) [AST
x]) [AST
y])
    | AST -> AST -> Bool
isFnCompose AST
dict' AST
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
    | AST -> AST -> Bool
isFnComposeFlipped AST
dict' AST
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]

  isFnCompose :: AST -> AST -> Bool
  isFnCompose :: AST -> AST -> Bool
isFnCompose AST
dict' AST
fn = (ModuleName, PSString) -> AST -> Bool
isDict forall a. IsString a => (ModuleName, a)
semigroupoidFn AST
dict' Bool -> Bool -> Bool
&& (ModuleName, PSString) -> AST -> Bool
isDict forall a. IsString a => (ModuleName, a)
fnCompose AST
fn

  isFnComposeFlipped :: AST -> AST -> Bool
  isFnComposeFlipped :: AST -> AST -> Bool
isFnComposeFlipped AST
dict' AST
fn = (ModuleName, PSString) -> AST -> Bool
isDict forall a. IsString a => (ModuleName, a)
semigroupoidFn AST
dict' Bool -> Bool -> Bool
&& (ModuleName, PSString) -> AST -> Bool
isDict forall a. IsString a => (ModuleName, a)
fnComposeFlipped AST
fn

  fnCompose :: forall a. IsString a => (ModuleName, a)
  fnCompose :: forall a. IsString a => (ModuleName, a)
fnCompose = (ModuleName
C.ControlSemigroupoid, forall a. IsString a => a
C.compose)

  fnComposeFlipped :: forall a. IsString a => (ModuleName, a)
  fnComposeFlipped :: forall a. IsString a => (ModuleName, a)
fnComposeFlipped = (ModuleName
C.ControlSemigroupoid, forall a. IsString a => a
C.composeFlipped)

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
_ AST
fn [AST
dict]) [AST
x]) | (ModuleName, PSString) -> AST -> Bool
isDict forall a. IsString a => (ModuleName, a)
categoryFn AST
dict Bool -> Bool -> Bool
&& (ModuleName, PSString) -> AST -> Bool
isDict forall a. IsString a => (ModuleName, a)
fnIdentity AST
fn = AST
x
  convert AST
other = AST
other

  fnIdentity :: forall a. IsString a => (ModuleName, a)
  fnIdentity :: forall a. IsString a => (ModuleName, a)
fnIdentity = (ModuleName
C.ControlCategory, forall a. IsString a => a
C.identity)

inlineUnsafeCoerce :: AST -> AST
inlineUnsafeCoerce :: AST -> AST
inlineUnsafeCoerce = (AST -> AST) -> AST -> AST
everywhereTopDown AST -> AST
convert where
  convert :: AST -> AST
convert (App Maybe SourceSpan
_ (ModuleAccessor Maybe SourceSpan
_ ModuleName
C.UnsafeCoerce PSString
unsafeCoerceFn) [ AST
comp ])
    | PSString
unsafeCoerceFn forall a. Eq a => a -> a -> Bool
== forall a. IsString a => a
C.unsafeCoerceFn
    = 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 (ModuleAccessor Maybe SourceSpan
_ ModuleName
C.PartialUnsafe PSString
unsafePartial) [ AST
comp ])
    | PSString
unsafePartial forall a. Eq a => a -> a -> Bool
== forall a. IsString a => a
C.unsafePartial
    -- 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. IsString a => a
C.undefined ]
  convert AST
other = AST
other

semiringNumber :: forall a. IsString a => (ModuleName, a)
semiringNumber :: forall a. IsString a => (ModuleName, a)
semiringNumber = (ModuleName
C.DataSemiring, forall a. IsString a => a
C.semiringNumber)

semiringInt :: forall a. IsString a => (ModuleName, a)
semiringInt :: forall a. IsString a => (ModuleName, a)
semiringInt = (ModuleName
C.DataSemiring, forall a. IsString a => a
C.semiringInt)

ringNumber :: forall a. IsString a => (ModuleName, a)
ringNumber :: forall a. IsString a => (ModuleName, a)
ringNumber = (ModuleName
C.DataRing, forall a. IsString a => a
C.ringNumber)

ringInt :: forall a. IsString a => (ModuleName, a)
ringInt :: forall a. IsString a => (ModuleName, a)
ringInt = (ModuleName
C.DataRing, forall a. IsString a => a
C.ringInt)

euclideanRingNumber :: forall a. IsString a => (ModuleName, a)
euclideanRingNumber :: forall a. IsString a => (ModuleName, a)
euclideanRingNumber = (ModuleName
C.DataEuclideanRing, forall a. IsString a => a
C.euclideanRingNumber)

eqNumber :: forall a. IsString a => (ModuleName, a)
eqNumber :: forall a. IsString a => (ModuleName, a)
eqNumber = (ModuleName
C.DataEq, forall a. IsString a => a
C.eqNumber)

eqInt :: forall a. IsString a => (ModuleName, a)
eqInt :: forall a. IsString a => (ModuleName, a)
eqInt = (ModuleName
C.DataEq, forall a. IsString a => a
C.eqInt)

eqString :: forall a. IsString a => (ModuleName, a)
eqString :: forall a. IsString a => (ModuleName, a)
eqString = (ModuleName
C.DataEq, forall a. IsString a => a
C.eqString)

eqChar :: forall a. IsString a => (ModuleName, a)
eqChar :: forall a. IsString a => (ModuleName, a)
eqChar = (ModuleName
C.DataEq, forall a. IsString a => a
C.eqChar)

eqBoolean :: forall a. IsString a => (ModuleName, a)
eqBoolean :: forall a. IsString a => (ModuleName, a)
eqBoolean = (ModuleName
C.DataEq, forall a. IsString a => a
C.eqBoolean)

ordBoolean :: forall a. IsString a => (ModuleName, a)
ordBoolean :: forall a. IsString a => (ModuleName, a)
ordBoolean = (ModuleName
C.DataOrd, forall a. IsString a => a
C.ordBoolean)

ordNumber :: forall a. IsString a => (ModuleName, a)
ordNumber :: forall a. IsString a => (ModuleName, a)
ordNumber = (ModuleName
C.DataOrd, forall a. IsString a => a
C.ordNumber)

ordInt :: forall a. IsString a => (ModuleName, a)
ordInt :: forall a. IsString a => (ModuleName, a)
ordInt = (ModuleName
C.DataOrd, forall a. IsString a => a
C.ordInt)

ordString :: forall a. IsString a => (ModuleName, a)
ordString :: forall a. IsString a => (ModuleName, a)
ordString = (ModuleName
C.DataOrd, forall a. IsString a => a
C.ordString)

ordChar :: forall a. IsString a => (ModuleName, a)
ordChar :: forall a. IsString a => (ModuleName, a)
ordChar = (ModuleName
C.DataOrd, forall a. IsString a => a
C.ordChar)

semigroupString :: forall a. IsString a => (ModuleName, a)
semigroupString :: forall a. IsString a => (ModuleName, a)
semigroupString = (ModuleName
C.DataSemigroup, forall a. IsString a => a
C.semigroupString)

boundedBoolean :: forall a. IsString a => (ModuleName, a)
boundedBoolean :: forall a. IsString a => (ModuleName, a)
boundedBoolean = (ModuleName
C.DataBounded, forall a. IsString a => a
C.boundedBoolean)

heytingAlgebraBoolean :: forall a. IsString a => (ModuleName, a)
heytingAlgebraBoolean :: forall a. IsString a => (ModuleName, a)
heytingAlgebraBoolean = (ModuleName
C.DataHeytingAlgebra, forall a. IsString a => a
C.heytingAlgebraBoolean)

semigroupoidFn :: forall a. IsString a => (ModuleName, a)
semigroupoidFn :: forall a. IsString a => (ModuleName, a)
semigroupoidFn = (ModuleName
C.ControlSemigroupoid, forall a. IsString a => a
C.semigroupoidFn)

categoryFn :: forall a. IsString a => (ModuleName, a)
categoryFn :: forall a. IsString a => (ModuleName, a)
categoryFn = (ModuleName
C.ControlCategory, forall a. IsString a => a
C.categoryFn)

opAdd :: forall a. IsString a => (ModuleName, a)
opAdd :: forall a. IsString a => (ModuleName, a)
opAdd = (ModuleName
C.DataSemiring, forall a. IsString a => a
C.add)

opMul :: forall a. IsString a => (ModuleName, a)
opMul :: forall a. IsString a => (ModuleName, a)
opMul = (ModuleName
C.DataSemiring, forall a. IsString a => a
C.mul)

opEq :: forall a. IsString a => (ModuleName, a)
opEq :: forall a. IsString a => (ModuleName, a)
opEq = (ModuleName
C.DataEq, forall a. IsString a => a
C.eq)

opNotEq :: forall a. IsString a => (ModuleName, a)
opNotEq :: forall a. IsString a => (ModuleName, a)
opNotEq = (ModuleName
C.DataEq, forall a. IsString a => a
C.notEq)

opLessThan :: forall a. IsString a => (ModuleName, a)
opLessThan :: forall a. IsString a => (ModuleName, a)
opLessThan = (ModuleName
C.DataOrd, forall a. IsString a => a
C.lessThan)

opLessThanOrEq :: forall a. IsString a => (ModuleName, a)
opLessThanOrEq :: forall a. IsString a => (ModuleName, a)
opLessThanOrEq = (ModuleName
C.DataOrd, forall a. IsString a => a
C.lessThanOrEq)

opGreaterThan :: forall a. IsString a => (ModuleName, a)
opGreaterThan :: forall a. IsString a => (ModuleName, a)
opGreaterThan = (ModuleName
C.DataOrd, forall a. IsString a => a
C.greaterThan)

opGreaterThanOrEq :: forall a. IsString a => (ModuleName, a)
opGreaterThanOrEq :: forall a. IsString a => (ModuleName, a)
opGreaterThanOrEq = (ModuleName
C.DataOrd, forall a. IsString a => a
C.greaterThanOrEq)

opAppend :: forall a. IsString a => (ModuleName, a)
opAppend :: forall a. IsString a => (ModuleName, a)
opAppend = (ModuleName
C.DataSemigroup, forall a. IsString a => a
C.append)

opSub :: forall a. IsString a => (ModuleName, a)
opSub :: forall a. IsString a => (ModuleName, a)
opSub = (ModuleName
C.DataRing, forall a. IsString a => a
C.sub)

opNegate :: forall a. IsString a => (ModuleName, a)
opNegate :: forall a. IsString a => (ModuleName, a)
opNegate = (ModuleName
C.DataRing, forall a. IsString a => a
C.negate)

opDiv :: forall a. IsString a => (ModuleName, a)
opDiv :: forall a. IsString a => (ModuleName, a)
opDiv = (ModuleName
C.DataEuclideanRing, forall a. IsString a => a
C.div)

opConj :: forall a. IsString a => (ModuleName, a)
opConj :: forall a. IsString a => (ModuleName, a)
opConj = (ModuleName
C.DataHeytingAlgebra, forall a. IsString a => a
C.conj)

opDisj :: forall a. IsString a => (ModuleName, a)
opDisj :: forall a. IsString a => (ModuleName, a)
opDisj = (ModuleName
C.DataHeytingAlgebra, forall a. IsString a => a
C.disj)

opNot :: forall a. IsString a => (ModuleName, a)
opNot :: forall a. IsString a => (ModuleName, a)
opNot = (ModuleName
C.DataHeytingAlgebra, forall a. IsString a => a
C.not)