module Language.PureScript.Optimizer.Inliner (
inlineVariables,
inlineOperator,
inlineCommonOperators,
etaConvert,
unThunk,
evaluateIifes
) where
import Data.Generics
import Language.PureScript.CodeGen.JS.AST
import Language.PureScript.CodeGen.Common (identToJs)
import Language.PureScript.Optimizer.Common
import Language.PureScript.Names
import qualified Language.PureScript.Constants as C
shouldInline :: JS -> Bool
shouldInline (JSVar _) = True
shouldInline (JSNumericLiteral _) = True
shouldInline (JSStringLiteral _) = True
shouldInline (JSBooleanLiteral _) = True
shouldInline (JSAccessor _ val) = shouldInline val
shouldInline (JSIndexer index val) = shouldInline index && shouldInline val
shouldInline _ = False
etaConvert :: JS -> JS
etaConvert = everywhere (mkT convert)
where
convert :: JS -> JS
convert (JSBlock [JSReturn (JSApp (JSFunction Nothing idents block@(JSBlock body)) args)])
| all shouldInline args &&
not (any (`isRebound` block) (map JSVar idents)) &&
not (any (`isRebound` block) args)
= JSBlock (replaceIdents (zip idents args) body)
convert js = js
unThunk :: JS -> JS
unThunk = everywhere (mkT convert)
where
convert :: JS -> JS
convert (JSBlock [JSReturn (JSApp (JSFunction Nothing [] (JSBlock body)) [])]) = JSBlock body
convert js = js
evaluateIifes :: JS -> JS
evaluateIifes = everywhere (mkT convert)
where
convert :: JS -> JS
convert (JSApp (JSFunction Nothing [] (JSBlock [JSReturn ret])) []) = ret
convert js = js
inlineVariables :: JS -> JS
inlineVariables = everywhere (mkT $ removeFromBlock go)
where
go :: [JS] -> [JS]
go [] = []
go (JSVariableIntroduction var (Just js) : sts)
| shouldInline js && not (isReassigned var sts) && not (isRebound js sts) && not (isUpdated var sts) =
go (replaceIdent var js sts)
go (s:sts) = s : go sts
inlineOperator :: String -> (JS -> JS -> JS) -> JS -> JS
inlineOperator op f = everywhere (mkT convert)
where
convert :: JS -> JS
convert (JSApp (JSApp op' [x]) [y]) | isOp op' = f x y
convert other = other
isOp (JSAccessor longForm (JSAccessor prelude (JSVar _ps))) | prelude == C.prelude &&
_ps == C._ps &&
longForm == identToJs (Op op) = True
isOp (JSIndexer (JSStringLiteral op') (JSAccessor prelude (JSVar _ps))) | prelude == C.prelude &&
_ps == C._ps &&
op == op' = True
isOp _ = False
inlineCommonOperators :: JS -> JS
inlineCommonOperators = applyAll
[ binary C.numNumber (C.+) Add
, binary C.numNumber (C.-) Subtract
, binary C.numNumber (C.*) Multiply
, binary C.numNumber (C./) Divide
, binary C.numNumber (C.%) Modulus
, unary C.numNumber C.negate Negate
, binary C.ordNumber (C.<) LessThan
, binary C.ordNumber (C.>) GreaterThan
, binary C.ordNumber (C.<=) LessThanOrEqualTo
, binary C.ordNumber (C.>=) GreaterThanOrEqualTo
, binary C.eqNumber (C.==) EqualTo
, binary C.eqNumber (C./=) NotEqualTo
, binary C.eqString (C.==) EqualTo
, binary C.eqString (C./=) NotEqualTo
, binary C.eqBoolean (C.==) EqualTo
, binary C.eqBoolean (C./=) NotEqualTo
, binary C.semigroupString (C.++) Add
, binaryFunction C.bitsNumber C.shl ShiftLeft
, binaryFunction C.bitsNumber C.shr ShiftRight
, binaryFunction C.bitsNumber C.zshr ZeroFillShiftRight
, binary C.bitsNumber (C.&) BitwiseAnd
, binary C.bitsNumber C.bar BitwiseOr
, binary C.bitsNumber (C.^) BitwiseXor
, unary C.bitsNumber C.complement BitwiseNot
, binary C.boolLikeBoolean (C.&&) And
, binary C.boolLikeBoolean (C.||) Or
, unary C.boolLikeBoolean C.not Not
]
where
binary :: String -> String -> BinaryOperator -> JS -> JS
binary dictName opString op = everywhere (mkT convert)
where
convert :: JS -> JS
convert (JSApp (JSApp (JSApp fn [dict]) [x]) [y]) | isOp fn && isOpDict dictName dict = JSBinary op x y
convert other = other
isOp (JSAccessor longForm (JSAccessor prelude (JSVar _))) | prelude == C.prelude &&
longForm == identToJs (Op opString) = True
isOp (JSIndexer (JSStringLiteral op') (JSAccessor prelude (JSVar _ps))) | prelude == C.prelude &&
_ps == C._ps &&
opString == op' = True
isOp _ = False
binaryFunction :: String -> String -> BinaryOperator -> JS -> JS
binaryFunction dictName fnName op = everywhere (mkT convert)
where
convert :: JS -> JS
convert (JSApp (JSApp (JSApp fn [dict]) [x]) [y]) | isOp fn && isOpDict dictName dict = JSBinary op x y
convert other = other
isOp (JSAccessor fnName' (JSAccessor prelude (JSVar _ps))) | prelude == C.prelude &&
_ps == C._ps &&
fnName == fnName' = True
isOp _ = False
unary :: String -> String -> UnaryOperator -> JS -> JS
unary dictName fnName op = everywhere (mkT convert)
where
convert :: JS -> JS
convert (JSApp (JSApp fn [dict]) [x]) | isOp fn && isOpDict dictName dict = JSUnary op x
convert other = other
isOp (JSAccessor fnName' (JSAccessor prelude (JSVar _ps))) | prelude == C.prelude &&
_ps == C._ps &&
fnName' == fnName = True
isOp _ = False
isOpDict dictName (JSApp (JSAccessor prop (JSAccessor prelude (JSVar _ps))) [JSObjectLiteral []]) | prelude == C.prelude &&
_ps == C._ps &&
prop == dictName = True
isOpDict _ _ = False