git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Merge pull request #482 from purescript/multifn
8b357ffPhil Freeman
src/Language/PureScript/Constants.hs+9
@@ -141,6 +141,12 @@ peekSTArray = "peekSTArray"
141pokeSTArray :: String
141pokeSTArray :: String
142pokeSTArray = "pokeSTArray"
142pokeSTArray = "pokeSTArray"
143
143
144+mkFn :: String
145+mkFn = "mkFn"
146+
147+runFn :: String
148+runFn = "runFn"
149+
144-- Type Class Dictionary Names
150-- Type Class Dictionary Names
145
151
146monadEffDictionary :: String
152monadEffDictionary :: String
@@ -199,3 +205,6 @@ eff = "Control_Monad_Eff"
199
205
200st :: String
206st :: String
201st = "Control_Monad_ST"
207st = "Control_Monad_ST"
208+
209+dataFunction :: String
210+dataFunction = "Data_Function"
src/Language/PureScript/Optimizer/Inliner.hs+41−2
@@ -22,6 +22,8 @@ module Language.PureScript.Optimizer.Inliner (
22 evaluateIifes
22 evaluateIifes
23) where
23) where
24
24
25+import Data.Maybe (fromMaybe)
26+
25import Language.PureScript.CodeGen.JS.AST
27import Language.PureScript.CodeGen.JS.AST
26import Language.PureScript.CodeGen.Common (identToJs)
28import Language.PureScript.CodeGen.Common (identToJs)
27import Language.PureScript.Optimizer.Common
29import Language.PureScript.Optimizer.Common
@@ -88,7 +90,7 @@ inlineOperator (m, op) f = everywhereOnJS convert
88 isOp _ = False
90 isOp _ = False
89
91
90inlineCommonOperators :: JS -> JS
92inlineCommonOperators :: JS -> JS
91−inlineCommonOperators = applyAll
93+inlineCommonOperators = applyAll $
92 [ binary C.numNumber (C.+) Add
94 [ binary C.numNumber (C.+) Add
93 , binary C.numNumber (C.-) Subtract
95 , binary C.numNumber (C.-) Subtract
94 , binary C.numNumber (C.*) Multiply
96 , binary C.numNumber (C.*) Multiply
@@ -121,7 +123,8 @@ inlineCommonOperators = applyAll
121 , binary C.boolLikeBoolean (C.&&) And
123 , binary C.boolLikeBoolean (C.&&) And
122 , binary C.boolLikeBoolean (C.||) Or
124 , binary C.boolLikeBoolean (C.||) Or
123 , unary C.boolLikeBoolean C.not Not
125 , unary C.boolLikeBoolean C.not Not
124− ]
126+ ] ++
127+ [ fn | i <- [0..5], fn <- [ mkFn i, runFn i ] ]
125 where
128 where
126 binary :: String -> String -> BinaryOperator -> JS -> JS
129 binary :: String -> String -> BinaryOperator -> JS -> JS
127 binary dictName opString op = everywhereOnJS convert
130 binary dictName opString op = everywhereOnJS convert
@@ -150,3 +153,39 @@ inlineCommonOperators = applyAll
150 isOp _ = False
153 isOp _ = False
151 isOpDict dictName (JSApp (JSAccessor prop (JSVar prelude)) [JSObjectLiteral []]) = prelude == C.prelude && prop == dictName
154 isOpDict dictName (JSApp (JSAccessor prop (JSVar prelude)) [JSObjectLiteral []]) = prelude == C.prelude && prop == dictName
152 isOpDict _ _ = False
155 isOpDict _ _ = False
156+
157+ mkFn :: Int -> JS -> JS
158+ mkFn 0 = everywhereOnJS convert
159+ where
160+ convert :: JS -> JS
161+ convert (JSApp mkFnN [JSFunction Nothing [_] (JSBlock js)]) | isNFn C.mkFn 0 mkFnN =
162+ JSFunction Nothing [] (JSBlock js)
163+ convert other = other
164+ mkFn n = everywhereOnJS convert
165+ where
166+ convert :: JS -> JS
167+ convert orig@(JSApp mkFnN [fn]) | isNFn C.mkFn n mkFnN =
168+ case collectArgs n [] fn of
169+ Just (args, js) -> JSFunction Nothing args (JSBlock js)
170+ Nothing -> orig
171+ convert other = other
172+ collectArgs :: Int -> [String] -> JS -> Maybe ([String], [JS])
173+ collectArgs 1 acc (JSFunction Nothing [oneArg] (JSBlock js)) | length acc == n - 1 = Just (reverse (oneArg : acc), js)
174+ collectArgs m acc (JSFunction Nothing [oneArg] (JSBlock [JSReturn ret])) = collectArgs (m - 1) (oneArg : acc) ret
175+ collectArgs _ _ _ = Nothing
176+
177+ isNFn :: String -> Int -> JS -> Bool
178+ isNFn prefix n (JSVar name) = name == (prefix ++ show n)
179+ isNFn prefix n (JSAccessor name (JSVar dataFunction)) | dataFunction == C.dataFunction = name == (prefix ++ show n)
180+ isNFn _ _ _ = False
181+
182+ runFn :: Int -> JS -> JS
183+ runFn n = everywhereOnJS convert
184+ where
185+ convert :: JS -> JS
186+ convert js = fromMaybe js $ go n [] js
187+
188+ go :: Int -> [JS] -> JS -> Maybe JS
189+ go 0 acc (JSApp runFnN [fn]) | isNFn C.runFn n runFnN && length acc == n = Just (JSApp fn acc)
190+ go m acc (JSApp lhs [arg]) = go (m - 1) (arg : acc) lhs
191+ go _ _ _ = Nothing