c4fd309 · rowtype-yoga/purescript-native

git.iko.soy/rowtype-yoga/purescript-native

Add optimizations for binary and unary operators

commitc4fd3093dd22ee5bffd0c2b9cf68a63930dcd1b8 authorPhil Freeman <paf31@cantab.net> dateMon 3 Feb 2014, 20:57 (13 years ago) parent041e4ea

5 files changed+87−14

compare with golang

unifiedsplit

psc/Main.hs+5−1 psci/Main.hs+1−1 src/Language/PureScript/CodeGen/Optimize.hs+75−10 src/Language/PureScript/Options.hs+5−1 tests/Main.hs+1−1

psc/Main.hs+5−1

@@ -90,8 +90,12 @@ runMain :: Term Bool

9090runMain = value $ flag $ (optInfo [ "run-main" ])

9191 { optDoc = "Generate code to run the main method in the Main module." }

9292

93+noOpts :: Term Bool

94+noOpts = value $ flag $ (optInfo [ "no-opts" ])

95+ { optDoc = "Skip the optimization phase." }

96+

9397options :: Term P.Options

94−options = P.Options <$> tco <*> performRuntimeTypeChecks <*> magicDo <*> runMain

98+options = P.Options <$> tco <*> performRuntimeTypeChecks <*> magicDo <*> runMain <*> noOpts

9599

96100stdInOrInputFiles :: FilePath -> Term (Maybe [FilePath])

97101stdInOrInputFiles prelude = combine <$> useStdIn <*> (not <$> noPrelude) <*> inputFiles

psci/Main.hs+1−1

@@ -35,7 +35,7 @@ getPreludeFilename :: IO FilePath

3535getPreludeFilename = Paths.getDataFileName "libraries/prelude/prelude.purs"

3636

3737options :: P.Options

38−options = P.Options True False True True

38+options = P.Options True False True True True

3939

4040completion :: [P.Module] -> CompletionFunc IO

4141completion ms = completeWord Nothing " \t\n\r" findCompletions

src/Language/PureScript/CodeGen/Optimize.hs+75−10

@@ -27,7 +27,9 @@

2727--

2828-- * Inlining variables

2929--

30−-- * Inline Prelude.($)

30+-- * Inline Prelude.($), Prelude.(++), Prelude.(!!)

31+--

32+-- * Inlining primitive Javascript operators

3133--

3234-----------------------------------------------------------------------------

3335

@@ -45,13 +47,14 @@ import Language.PureScript.Options

4547import Language.PureScript.CodeGen.Common (identToJs)

4648import Language.PureScript.Sugar.TypeClasses

4749 (mkDictionaryValueName)

48−import Language.PureScript.Types (Type(..))

50+import Language.PureScript.Types

4951

5052-- |

5153-- Apply a series of optimizer passes to simplified Javascript code

5254--

5355optimize :: Options -> JS -> JS

54−optimize opts = untilFixedPoint $ applyAll

56+optimize opts | optionsNoOptimizations opts = id

57+ | otherwise = untilFixedPoint $ applyAll

5558 [ collapseNestedBlocks

5659 , tco opts

5760 , magicDo opts

@@ -59,7 +62,10 @@ optimize opts = untilFixedPoint $ applyAll

5962 , unThunk

6063 , etaConvert

6164 , inlineVariables

62− , inlineDollar ]

65+ , inlineOperator "$" $ \f x -> JSApp f [x]

66+ , inlineOperator "!!" $ flip JSIndexer

67+ , inlineOperator "++" $ JSBinary Add

68+ , inlineCommonOperators ]

6369

6470applyAll :: [a -> a] -> a -> a

6571applyAll = foldl1 (.)

@@ -293,12 +299,71 @@ collapseNestedBlocks = everywhere (mkT collapse)

293299 go (JSBlock sts) = sts

294300 go s = [s]

295301

296−inlineDollar :: JS -> JS

297−inlineDollar = everywhere (mkT convert)

302+inlineOperator :: String -> (JS -> JS -> JS) -> JS -> JS

303+inlineOperator op f = everywhere (mkT convert)

298304 where

299305 convert :: JS -> JS

300− convert (JSApp (JSApp dollar [f]) [x]) | isDollar dollar = JSApp f [x]

306+ convert (JSApp (JSApp op [x]) [y]) | isOp op = f x y

301307 convert other = other

302− isDollar (JSAccessor "$dollar" (JSVar "Prelude")) = True

303− isDollar (JSIndexer (JSStringLiteral "$") (JSVar "Prelude")) = True

304− isDollar _ = False

308+ isOp (JSAccessor longForm (JSVar "Prelude")) | longForm == identToJs (Op op) = True

309+ isOp (JSIndexer (JSStringLiteral op') (JSVar "Prelude")) | op == op' = True

310+ isOp _ = False

311+

312+inlineCommonOperators :: JS -> JS

313+inlineCommonOperators = applyAll

314+ [ binary "+" "Num" tyNumber Add

315+ , binary "-" "Num" tyNumber Subtract

316+ , binary "*" "Num" tyNumber Multiply

317+ , binary "/" "Num" tyNumber Divide

318+ , binary "%" "Num" tyNumber Modulus

319+ , unary "negate" "Num" tyNumber Negate

320+

321+ , binary "<" "Ord" tyNumber LessThan

322+ , binary ">" "Ord" tyNumber GreaterThan

323+ , binary "<=" "Ord" tyNumber LessThanOrEqualTo

324+ , binary ">=" "Ord" tyNumber GreaterThanOrEqualTo

325+

326+ , binary "==" "Eq" tyNumber EqualTo

327+ , binary "/=" "Eq" tyNumber NotEqualTo

328+ , binary "==" "Eq" tyString EqualTo

329+ , binary "/=" "Eq" tyString NotEqualTo

330+ , binary "==" "Eq" tyBoolean EqualTo

331+ , binary "/=" "Eq" tyBoolean NotEqualTo

332+

333+ , binary "<<" "Bits" tyNumber ShiftLeft

334+ , binary ">>" "Bits" tyNumber ShiftRight

335+ , binary ">>>" "Bits" tyNumber ZeroFillShiftRight

336+ , binary "&" "Bits" tyNumber BitwiseAnd

337+ , binary "|" "Bits" tyNumber BitwiseOr

338+ , binary "^" "Bits" tyNumber BitwiseXor

339+ , unary "complement" "Bits" tyNumber BitwiseNot

340+

341+ , binary "&&" "BoolLike" tyBoolean And

342+ , binary "||" "BoolLike" tyBoolean Or

343+ , unary "not" "BoolLike" tyBoolean Not

344+ ]

345+ where

346+ binary :: String -> String -> Type -> BinaryOperator -> JS -> JS

347+ binary opString className classTy op = everywhere (mkT convert)

348+ where

349+ convert :: JS -> JS

350+ convert (JSApp (JSApp (JSApp fn [dict]) [x]) [y]) | isOp fn && isOpDict className classTy dict = JSBinary op x y

351+ convert other = other

352+ isOp (JSAccessor longForm (JSVar "Prelude")) | longForm == identToJs (Op opString) = True

353+ isOp (JSIndexer (JSStringLiteral op') (JSVar "Prelude")) | opString == op' = True

354+ isOp _ = False

355+ unary :: String -> String -> Type -> UnaryOperator -> JS -> JS

356+ unary fnName className classTy op = everywhere (mkT convert)

357+ where

358+ convert :: JS -> JS

359+ convert (JSApp (JSApp fn [dict]) [x]) | isOp fn && isOpDict className classTy dict = JSUnary op x

360+ convert other = other

361+ isOp (JSAccessor fnName' (JSVar "Prelude")) | fnName' == fnName = True

362+ isOp _ = False

363+ isOpDict className ty (JSAccessor prop (JSVar "Prelude")) | prop == dictName = True

364+ where

365+ Right (Ident dictName) = mkDictionaryValueName

366+ (ModuleName (ProperName "Prelude"))

367+ (Qualified (Just (ModuleName (ProperName "Prelude"))) (ProperName className))

368+ ty

369+ isOpDict _ _ _ = False

src/Language/PureScript/Options.hs+5−1

@@ -35,10 +35,14 @@ data Options = Options {

3535 -- Check the type of Main.main and generate its code

3636 --

3737 , optionsRunMain :: Bool

38+ -- |

39+ -- Skip all optimizations

40+ --

41+ , optionsNoOptimizations :: Bool

3842 } deriving Show

3943

4044-- |

4145-- Default compiler options

4246--

4347defaultOptions :: Options

44−defaultOptions = Options False False False False

48+defaultOptions = Options False False False False False

tests/Main.hs+1−1

@@ -66,7 +66,7 @@ assertCompiles :: FilePath -> IO ()

6666assertCompiles inputFile = do

6767 putStrLn $ "assert " ++ inputFile ++ " compiles successfully"

6868 prelude <- preludeFilename

69− assert (P.defaultOptions { P.optionsRunMain = True }) [prelude, inputFile] $ either (return . Just) $ \js -> do

69+ assert (P.defaultOptions { P.optionsRunMain = True, P.optionsNoOptimizations = True }) [prelude, inputFile] $ either (return . Just) $ \js -> do

7070 args <- getArgs

7171 if "--run-js" `elem` args

7272 then do