git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Merge pull request #482 from purescript/multifn

#295

commit8b357ff4f363ac67ff490a64b80b518cab615a4a authorPhil Freeman <paf31@cantab.net> dateWed 16 Jul 2014, 13:07 (12 years ago) parent12ac3278265486
2 files changed+50−2
src/Language/PureScript/Constants.hs+9 src/Language/PureScript/Optimizer/Inliner.hs+41−2
src/Language/PureScript/Constants.hs+9
@@ -141,6 +141,12 @@ peekSTArray = "peekSTArray"
141141pokeSTArray :: String
142142pokeSTArray = "pokeSTArray"
143143
144+mkFn :: String
145+mkFn = "mkFn"
146+
147+runFn :: String
148+runFn = "runFn"
149+
144150-- Type Class Dictionary Names
145151
146152monadEffDictionary :: String
@@ -199,3 +205,6 @@ eff = "Control_Monad_Eff"
199205
200206st :: String
201207st = "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 (
2222 evaluateIifes
2323) where
2424
25+import Data.Maybe (fromMaybe)
26+
2527import Language.PureScript.CodeGen.JS.AST
2628import Language.PureScript.CodeGen.Common (identToJs)
2729import Language.PureScript.Optimizer.Common
@@ -88,7 +90,7 @@ inlineOperator (m, op) f = everywhereOnJS convert
8890 isOp _ = False
8991
9092inlineCommonOperators :: JS -> JS
91−inlineCommonOperators = applyAll
93+inlineCommonOperators = applyAll $
9294 [ binary C.numNumber (C.+) Add
9395 , binary C.numNumber (C.-) Subtract
9496 , binary C.numNumber (C.*) Multiply
@@ -121,7 +123,8 @@ inlineCommonOperators = applyAll
121123 , binary C.boolLikeBoolean (C.&&) And
122124 , binary C.boolLikeBoolean (C.||) Or
123125 , unary C.boolLikeBoolean C.not Not
124− ]
126+ ] ++
127+ [ fn | i <- [0..5], fn <- [ mkFn i, runFn i ] ]
125128 where
126129 binary :: String -> String -> BinaryOperator -> JS -> JS
127130 binary dictName opString op = everywhereOnJS convert
@@ -150,3 +153,39 @@ inlineCommonOperators = applyAll
150153 isOp _ = False
151154 isOpDict dictName (JSApp (JSAccessor prop (JSVar prelude)) [JSObjectLiteral []]) = prelude == C.prelude && prop == dictName
152155 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