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
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
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
= 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)