git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Add optimizations for binary and unary operators
c4fd309Phil Freeman
psc/Main.hs+5−1
compare with golang
unifiedsplit
@@ -90,8 +90,12 @@ runMain :: Term Bool
90runMain = value $ flag $ (optInfo [ "run-main" ])
90runMain = value $ flag $ (optInfo [ "run-main" ])
91 { optDoc = "Generate code to run the main method in the Main module." }
91 { optDoc = "Generate code to run the main method in the Main module." }
92
92
93+noOpts :: Term Bool
94+noOpts = value $ flag $ (optInfo [ "no-opts" ])
95+ { optDoc = "Skip the optimization phase." }
96+
93options :: Term P.Options
97options :: Term P.Options
94−options = P.Options <$> tco <*> performRuntimeTypeChecks <*> magicDo <*> runMain
98+options = P.Options <$> tco <*> performRuntimeTypeChecks <*> magicDo <*> runMain <*> noOpts
95
99
96stdInOrInputFiles :: FilePath -> Term (Maybe [FilePath])
100stdInOrInputFiles :: FilePath -> Term (Maybe [FilePath])
97stdInOrInputFiles prelude = combine <$> useStdIn <*> (not <$> noPrelude) <*> inputFiles
101stdInOrInputFiles prelude = combine <$> useStdIn <*> (not <$> noPrelude) <*> inputFiles
psci/Main.hs+1−1
@@ -35,7 +35,7 @@ getPreludeFilename :: IO FilePath
35getPreludeFilename = Paths.getDataFileName "libraries/prelude/prelude.purs"
35getPreludeFilename = Paths.getDataFileName "libraries/prelude/prelude.purs"
36
36
37options :: P.Options
37options :: P.Options
38−options = P.Options True False True True
38+options = P.Options True False True True True
39
39
40completion :: [P.Module] -> CompletionFunc IO
40completion :: [P.Module] -> CompletionFunc IO
41completion ms = completeWord Nothing " \t\n\r" findCompletions
41completion ms = completeWord Nothing " \t\n\r" findCompletions
src/Language/PureScript/CodeGen/Optimize.hs+75−10
@@ -27,7 +27,9 @@
27--
27--
28-- * Inlining variables
28-- * Inlining variables
29--
29--
30−-- * Inline Prelude.($)
30+-- * Inline Prelude.($), Prelude.(++), Prelude.(!!)
31+--
32+-- * Inlining primitive Javascript operators
31--
33--
32-----------------------------------------------------------------------------
34-----------------------------------------------------------------------------
33
35
@@ -45,13 +47,14 @@ import Language.PureScript.Options
45import Language.PureScript.CodeGen.Common (identToJs)
47import Language.PureScript.CodeGen.Common (identToJs)
46import Language.PureScript.Sugar.TypeClasses
48import Language.PureScript.Sugar.TypeClasses
47 (mkDictionaryValueName)
49 (mkDictionaryValueName)
48−import Language.PureScript.Types (Type(..))
50+import Language.PureScript.Types
49
51
50-- |
52-- |
51-- Apply a series of optimizer passes to simplified Javascript code
53-- Apply a series of optimizer passes to simplified Javascript code
52--
54--
53optimize :: Options -> JS -> JS
55optimize :: Options -> JS -> JS
56+optimize opts | optionsNoOptimizations opts = id
54−optimize opts = untilFixedPoint $ applyAll
57+ | otherwise = untilFixedPoint $ applyAll
55 [ collapseNestedBlocks
58 [ collapseNestedBlocks
56 , tco opts
59 , tco opts
57 , magicDo opts
60 , magicDo opts
@@ -59,7 +62,10 @@ optimize opts = untilFixedPoint $ applyAll
59 , unThunk
62 , unThunk
60 , etaConvert
63 , etaConvert
61 , inlineVariables
64 , inlineVariables
62− , inlineDollar ]
65+ , inlineOperator "$" $ \f x -> JSApp f [x]
66+ , inlineOperator "!!" $ flip JSIndexer
67+ , inlineOperator "++" $ JSBinary Add
68+ , inlineCommonOperators ]
63
69
64applyAll :: [a -> a] -> a -> a
70applyAll :: [a -> a] -> a -> a
65applyAll = foldl1 (.)
71applyAll = foldl1 (.)
@@ -293,12 +299,71 @@ collapseNestedBlocks = everywhere (mkT collapse)
293 go (JSBlock sts) = sts
299 go (JSBlock sts) = sts
294 go s = [s]
300 go s = [s]
295
301
296−inlineDollar :: JS -> JS
302+inlineOperator :: String -> (JS -> JS -> JS) -> JS -> JS
297−inlineDollar = everywhere (mkT convert)
303+inlineOperator op f = everywhere (mkT convert)
298 where
304 where
299 convert :: JS -> JS
305 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
301 convert other = other
307 convert other = other
302− isDollar (JSAccessor "$dollar" (JSVar "Prelude")) = True
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
303− isDollar (JSIndexer (JSStringLiteral "$") (JSVar "Prelude")) = 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
304− isDollar _ = False
369+ isOpDict _ _ _ = False
src/Language/PureScript/Options.hs+5−1
@@ -35,10 +35,14 @@ data Options = Options {
35 -- Check the type of Main.main and generate its code
35 -- Check the type of Main.main and generate its code
36 --
36 --
37 , optionsRunMain :: Bool
37 , optionsRunMain :: Bool
38+ -- |
39+ -- Skip all optimizations
40+ --
41+ , optionsNoOptimizations :: Bool
38 } deriving Show
42 } deriving Show
39
43
40-- |
44-- |
41-- Default compiler options
45-- Default compiler options
42--
46--
43defaultOptions :: Options
47defaultOptions :: 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 ()
66assertCompiles inputFile = do
66assertCompiles inputFile = do
67 putStrLn $ "assert " ++ inputFile ++ " compiles successfully"
67 putStrLn $ "assert " ++ inputFile ++ " compiles successfully"
68 prelude <- preludeFilename
68 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
70 args <- getArgs
70 args <- getArgs
71 if "--run-js" `elem` args
71 if "--run-js" `elem` args
72 then do
72 then do