git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Basic Javascript optimizations
commit36bae691643b016445049f2f21cfa83e63337970 authorPhil Freeman <paf31@cantab.net> dateFri 1 Nov 2013, 18:16 (13 years ago) parent1afca17
7 files changed+95−36
compare with golang
unifiedsplit
purescript.cabal+16−15 src/Language/PureScript.hs+3 src/Language/PureScript/CodeGen/JS.hs+11−11 src/Language/PureScript/CodeGen/JS/AST.hs+3−3 src/Language/PureScript/Optimize.hs+55 src/Language/PureScript/Pretty/JS.hs+6−6 src/Main.hs+1−1
purescript.cabal+16−15
@@ -12,21 +12,22 @@ description: A small compile-to-JS language with extensible records and type-saf
1212category: Language
1313author: Phil Freeman <paf31@cantab.net>
1414data-dir: ""
15−
15+
1616library
1717 build-depends: base >=4 && <5, syb -any, cmdtheline -any,
1818 containers -any, mtl -any, transformers -any, parsec -any,
1919 utf8-string -any
20− exposed-modules: Language.PureScript.Pretty.JS
21− Language.PureScript.CodeGen.JS.AST Main Language.PureScript
22− Language.PureScript.Declarations Language.PureScript.Names
23− Language.PureScript.Types Language.PureScript.Values
24− Language.PureScript.Kinds Language.PureScript.Pretty
25− Language.PureScript.Pretty.Common Language.PureScript.Pretty.Values
26− Language.PureScript.Pretty.Types Language.PureScript.Pretty.Kinds
27− Language.PureScript.CodeGen Language.PureScript.CodeGen.Externs
28− Language.PureScript.CodeGen.JS Language.PureScript.CodeGen.Monad
29− Language.PureScript.Parser Language.PureScript.Parser.Common
20+ exposed-modules: Language.PureScript.Optimize
21+ Language.PureScript.Pretty.JS Language.PureScript.CodeGen.JS.AST
22+ Main Language.PureScript Language.PureScript.Declarations
23+ Language.PureScript.Names Language.PureScript.Types
24+ Language.PureScript.Values Language.PureScript.Kinds
25+ Language.PureScript.Pretty Language.PureScript.Pretty.Common
26+ Language.PureScript.Pretty.Values Language.PureScript.Pretty.Types
27+ Language.PureScript.Pretty.Kinds Language.PureScript.CodeGen
28+ Language.PureScript.CodeGen.Externs Language.PureScript.CodeGen.JS
29+ Language.PureScript.CodeGen.Monad Language.PureScript.Parser
30+ Language.PureScript.Parser.Common
3031 Language.PureScript.Parser.Declarations
3132 Language.PureScript.Parser.Types Language.PureScript.Parser.Values
3233 Language.PureScript.Parser.State Language.PureScript.Parser.Kinds
@@ -38,7 +39,7 @@ library
3839 exposed: True
3940 buildable: True
4041 hs-source-dirs: src
41−
42+
4243executable psc
4344 build-depends: base >=4 && <5, cmdtheline -any, containers -any,
4445 mtl -any, transformers -any, parsec -any, utf8-string -any,
@@ -46,8 +47,8 @@ executable psc
4647 main-is: Main.hs
4748 buildable: True
4849 hs-source-dirs: src
49− other-modules:
50−
50+ other-modules: Language.PureScript.Optimize
51+
5152test-suite tests
5253 build-depends: base >=4 && <5, syb -any, directory -any,
5354 filepath -any, containers -any, mtl -any, transformers -any,
@@ -55,4 +56,4 @@ test-suite tests
5556 type: exitcode-stdio-1.0
5657 main-is: Main.hs
5758 buildable: True
58− hs-source-dirs: tests
59+ hs-source-dirs: tests
src/Language/PureScript.hs+3
@@ -23,4 +23,7 @@ import Language.PureScript.Parser as P
2323import Language.PureScript.CodeGen as P
2424import Language.PureScript.TypeChecker as P
2525import Language.PureScript.Pretty as P
26+import Language.PureScript.Optimize as P
27+
28+
2629
src/Language/PureScript/CodeGen/JS.hs+11−11
@@ -76,21 +76,21 @@ bindersToJs binders val = do
7676binderToJs :: String -> [JS] -> Binder -> Gen [JS]
7777binderToJs varName done NullBinder = return done
7878binderToJs varName done (StringBinder str) =
79− return [JSIfElse (JSBinary EqualTo (JSVar (Ident varName)) (JSStringLiteral str)) done Nothing]
79+ return [JSIfElse (JSBinary EqualTo (JSVar (Ident varName)) (JSStringLiteral str)) (JSBlock done) Nothing]
8080binderToJs varName done (NumberBinder num) =
81− return [JSIfElse (JSBinary EqualTo (JSVar (Ident varName)) (JSNumericLiteral num)) done Nothing]
81+ return [JSIfElse (JSBinary EqualTo (JSVar (Ident varName)) (JSNumericLiteral num)) (JSBlock done) Nothing]
8282binderToJs varName done (BooleanBinder True) =
83− return [JSIfElse (JSVar (Ident varName)) done Nothing]
83+ return [JSIfElse (JSVar (Ident varName)) (JSBlock done) Nothing]
8484binderToJs varName done (BooleanBinder False) =
85− return [JSIfElse (JSUnary Not (JSVar (Ident varName))) done Nothing]
85+ return [JSIfElse (JSUnary Not (JSVar (Ident varName))) (JSBlock done) Nothing]
8686binderToJs varName done (VarBinder ident) =
8787 return (JSVariableIntroduction ident (JSVar (Ident varName)) : done)
8888binderToJs varName done (NullaryBinder ctor) =
89− return [JSIfElse (JSBinary EqualTo (JSAccessor "ctor" (JSVar (Ident varName))) (JSStringLiteral ctor)) done Nothing]
89+ return [JSIfElse (JSBinary EqualTo (JSAccessor "ctor" (JSVar (Ident varName))) (JSStringLiteral ctor)) (JSBlock done) Nothing]
9090binderToJs varName done (UnaryBinder ctor b) = do
9191 value <- fresh
9292 js <- binderToJs value done b
93− return [JSIfElse (JSBinary EqualTo (JSAccessor "ctor" (JSVar (Ident varName))) (JSStringLiteral ctor)) (JSVariableIntroduction (Ident value) (JSAccessor "value" (JSVar (Ident varName))) : js) Nothing]
93+ return [JSIfElse (JSBinary EqualTo (JSAccessor "ctor" (JSVar (Ident varName))) (JSStringLiteral ctor)) (JSBlock (JSVariableIntroduction (Ident value) (JSAccessor "value" (JSVar (Ident varName))) : js)) Nothing]
9494binderToJs varName done (ObjectBinder bs) = go done bs
9595 where
9696 go :: [JS] -> [(String, Binder)] -> Gen [JS]
@@ -102,7 +102,7 @@ binderToJs varName done (ObjectBinder bs) = go done bs
102102 return (JSVariableIntroduction (Ident propVar) (JSAccessor prop (JSVar (Ident varName))) : js)
103103binderToJs varName done (ArrayBinder bs rest) = do
104104 js <- go done rest 0 bs
105− return [JSIfElse (JSBinary cmp (JSAccessor "length" (JSVar (Ident varName))) (JSNumericLiteral (Left (fromIntegral $ length bs)))) js Nothing]
105+ return [JSIfElse (JSBinary cmp (JSAccessor "length" (JSVar (Ident varName))) (JSNumericLiteral (Left (fromIntegral $ length bs)))) (JSBlock js) Nothing]
106106 where
107107 cmp :: BinaryOperator
108108 cmp = maybe EqualTo (const GreaterThanOrEqualTo) rest
@@ -122,18 +122,18 @@ binderToJs varName done (NamedBinder ident binder) = do
122122 return (JSVariableIntroduction ident (JSVar (Ident varName)) : js)
123123binderToJs varName done (GuardedBinder cond binder) = binderToJs varName done' binder
124124 where
125− done' = [JSIfElse (valueToJs cond) done Nothing]
125+ done' = [JSIfElse (valueToJs cond) (JSBlock done) Nothing]
126126
127127statementToJs :: Statement -> JS
128128statementToJs (VariableIntroduction ident value) = JSVariableIntroduction ident (valueToJs value)
129129statementToJs (Assignment target value) = JSAssignment target (valueToJs value)
130−statementToJs (While cond sts) = JSWhile (valueToJs cond) (map statementToJs sts)
131−statementToJs (For ident start end sts) = JSFor ident (valueToJs start) (valueToJs end) (map statementToJs sts)
130+statementToJs (While cond sts) = JSWhile (valueToJs cond) (JSBlock (map statementToJs sts))
131+statementToJs (For ident start end sts) = JSFor ident (valueToJs start) (valueToJs end) (JSBlock (map statementToJs sts))
132132statementToJs (ForEach ident arr sts) = JSApp (JSAccessor "forEach" (valueToJs arr)) [JSFunction Nothing [ident] (JSBlock (map statementToJs sts))]
133133statementToJs (If ifst) = ifToJs ifst
134134 where
135135 ifToJs :: IfStatement -> JS
136− ifToJs (IfStatement cond thens elses) = JSIfElse (valueToJs cond) (map statementToJs thens) (fmap elseToJs elses)
136+ ifToJs (IfStatement cond thens elses) = JSIfElse (valueToJs cond) (JSBlock (map statementToJs thens)) (fmap elseToJs elses)
137137 elseToJs :: ElseStatement -> JS
138138 elseToJs (Else sts) = JSBlock (map statementToJs sts)
139139 elseToJs (ElseIf ifst) = ifToJs ifst
src/Language/PureScript/CodeGen/JS/AST.hs+3−3
@@ -38,8 +38,8 @@ data JS
3838 | JSBlock [JS]
3939 | JSVariableIntroduction Ident JS
4040 | JSAssignment Ident JS
41− | JSWhile JS [JS]
42− | JSFor Ident JS JS [JS]
43− | JSIfElse JS [JS] (Maybe JS)
41+ | JSWhile JS JS
42+ | JSFor Ident JS JS JS
43+ | JSIfElse JS JS (Maybe JS)
4444 | JSReturn JS
4545 | JSThrow JS deriving (Show, Data, Typeable)
src/Language/PureScript/Optimize.hsnew file+55
@@ -0,0 +1,55 @@
1+-----------------------------------------------------------------------------
2+--
3+-- Module : Language.PureScript.Optimize
4+-- Copyright : (c) Phil Freeman 2013
5+-- License : MIT
6+--
7+-- Maintainer : Phil Freeman <paf31@cantab.net>
8+-- Stability : experimental
9+-- Portability :
10+--
11+-- |
12+--
13+-----------------------------------------------------------------------------
14+
15+module Language.PureScript.Optimize (
16+ optimize
17+) where
18+
19+import Data.Data
20+import Data.Generics
21+
22+import Language.PureScript.Names
23+import Language.PureScript.CodeGen.JS.AST
24+
25+optimize :: JS -> JS
26+optimize = etaConvert . inlineVariables
27+
28+replaceIdent :: (Data d) => Ident -> JS -> d -> d
29+replaceIdent var1 js = everywhere (mkT replace)
30+ where
31+ replace (JSVar var2) | var1 == var2 = js
32+ replace js = js
33+
34+shouldInline :: JS -> Bool
35+shouldInline (JSVar _) = True
36+shouldInline (JSAccessor _ val) = shouldInline val
37+shouldInline _ = False
38+
39+inlineVariables :: JS -> JS
40+inlineVariables = everywhere (mkT removeFromBlock)
41+ where
42+ removeFromBlock :: JS -> JS
43+ removeFromBlock (JSBlock sts) = JSBlock (go sts)
44+ removeFromBlock js = js
45+ go :: [JS] -> [JS]
46+ go [] = []
47+ go (JSVariableIntroduction var js : sts) | shouldInline js = go (replaceIdent var js sts)
48+ go (s:sts) = s : go sts
49+
50+etaConvert :: JS -> JS
51+etaConvert = everywhere (mkT convert)
52+ where
53+ convert :: JS -> JS
54+ convert (JSBlock [JSReturn (JSApp (JSFunction Nothing [ident] (JSBlock body)) [arg])]) | shouldInline arg = JSBlock (replaceIdent ident arg body)
55+ convert js = js
src/Language/PureScript/Pretty/JS.hs+6−6
@@ -40,16 +40,16 @@ literals = Pattern $ A.Kleisli match
4040 match (JSVariableIntroduction ident value) = Just $ "var " ++ identToJs ident ++ " = " ++ prettyPrintJS value
4141 match (JSAssignment target value) = Just $ identToJs target ++ " = " ++ prettyPrintJS value
4242 match (JSWhile cond sts) = Just $ "while ("
43− ++ prettyPrintJS cond ++ ") { "
44− ++ intercalate "; " (map prettyPrintJS sts) ++ " }"
43+ ++ prettyPrintJS cond ++ ") "
44+ ++ prettyPrintJS sts
4545 match (JSFor ident start end sts) = Just $ "for ("
4646 ++ identToJs ident ++ " = " ++ prettyPrintJS start ++ "; "
4747 ++ identToJs ident ++ " < " ++ prettyPrintJS end ++ "; "
48− ++ identToJs ident ++ "++) { "
49− ++ intercalate "; " (map prettyPrintJS sts) ++ " }"
48+ ++ identToJs ident ++ "++) "
49+ ++ prettyPrintJS sts
5050 match (JSIfElse cond thens elses) = Just $ "if ("
51− ++ prettyPrintJS cond ++ ") { "
52− ++ intercalate "; " (map prettyPrintJS thens) ++ " }"
51+ ++ prettyPrintJS cond ++ ") "
52+ ++ prettyPrintJS thens
5353 ++ maybe "" ((" else " ++) . prettyPrintJS) elses
5454 match (JSReturn value) = Just $ "return " ++ prettyPrintJS value
5555 match (JSThrow value) = Just $ "throw " ++ prettyPrintJS value
src/Main.hs+1−1
@@ -40,7 +40,7 @@ compile inputFiles outputFile externsFile = do
4040 U.putStrLn typeError
4141 exitFailure
4242 Right (_, env) -> do
43− let js = intercalate "; " . map prettyPrintJS . concat . mapMaybe (declToJs) $ decls
43+ let js = intercalate "; " . map (prettyPrintJS . optimize) . concat . mapMaybe (declToJs) $ decls
4444 case outputFile of
4545 Just path -> U.writeFile path js
4646 Nothing -> U.putStrLn js