git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Inline Partial.Unsafe.unsafePartial (#2572)

* Inline Partial.Unsafe.unsafePartial * Add test * Improve example, Move inlining logic into evaluateIifes

commit3f1a50e626dd9d7f610c6094e20268e8a7fba6a9 authorPhil Freeman <paf31@cantab.net> dateFri 20 Jan 2017, 09:40 (10 years ago) parent94710ed
5 files changed+52−17
compare with golang
unifiedsplit
examples/passing/2288.purs+19 src/Language/PureScript/CodeGen/JS/Optimizer.hs+1−1 src/Language/PureScript/CodeGen/JS/Optimizer/Inliner.hs+15−4 src/Language/PureScript/CodeGen/JS/Optimizer/TCO.hs+11−12 src/Language/PureScript/Constants.hs+6
examples/passing/2288.pursnew file+19
@@ -0,0 +1,19 @@
1+module Main where
2+
3+import Prelude
4+import Control.Monad.Eff
5+import Control.Monad.Eff.Console
6+import Data.Array
7+import Data.Array.Partial as P
8+import Partial.Unsafe
9+
10+length :: forall a. Array a -> Int
11+length = go 0 where
12+ go acc arr =
13+ if null arr
14+ then acc
15+ else go (acc + 1) (unsafePartial P.tail arr)
16+
17+main = do
18+ logShow (length (1 .. 10000))
19+ log "Done"
src/Language/PureScript/CodeGen/JS/Optimizer.hs+1−1
@@ -46,7 +46,7 @@ optimize js = do
4646optimize' :: (MonadReader Options m, MonadSupply m) => JS -> m JS
4747optimize' js = do
4848 opts <- ask
49− js' <- untilFixedPoint (inlineFnComposition . tidyUp . applyAll
49+ js' <- untilFixedPoint (inlineFnComposition . inlineUnsafePartial . tidyUp . applyAll
5050 [ inlineCommonValues
5151 , inlineCommonOperators
5252 ]) js
src/Language/PureScript/CodeGen/JS/Optimizer/Inliner.hs+15−4
@@ -6,6 +6,7 @@ module Language.PureScript.CodeGen.JS.Optimizer.Inliner
66 , inlineCommonValues
77 , inlineCommonOperators
88 , inlineFnComposition
9+ , inlineUnsafePartial
910 , etaConvert
1011 , unThunk
1112 , evaluateIifes
@@ -66,6 +67,8 @@ evaluateIifes = everywhereOnJS convert
6667 where
6768 convert :: JS -> JS
6869 convert (JSApp _ (JSFunction _ Nothing [] (JSBlock _ [JSReturn _ ret])) []) = ret
70+ convert (JSApp _ (JSFunction _ Nothing idents (JSBlock _ [JSReturn ss ret])) [])
71+ | not (any (`isReassigned` ret) idents) = replaceIdents (map (, JSVar ss C.undefined) idents) ret
6972 convert js = js
7073
7174inlineVariables :: JS -> JS
@@ -249,10 +252,9 @@ inlineCommonOperators = applyAll $
249252
250253-- (f <<< g $ x) = f (g x)
251254-- (f <<< g) = \x -> f (g x)
252−inlineFnComposition :: (MonadSupply m) => JS -> m JS
253−inlineFnComposition = everywhereOnJSTopDownM convert
254− where
255− convert :: (MonadSupply m) => JS -> m JS
255+inlineFnComposition :: forall m. MonadSupply m => JS -> m JS
256+inlineFnComposition = everywhereOnJSTopDownM convert where
257+ convert :: JS -> m JS
256258 convert (JSApp s1 (JSApp s2 (JSApp _ (JSApp _ fn [dict']) [x]) [y]) [z])
257259 | isFnCompose dict' fn = return $ JSApp s1 x [JSApp s2 y [z]]
258260 | isFnComposeFlipped dict' fn = return $ JSApp s2 y [JSApp s1 x [z]]
@@ -273,6 +275,15 @@ inlineFnComposition = everywhereOnJSTopDownM convert
273275 fnComposeFlipped :: forall a b. (IsString a, IsString b) => (a, b)
274276 fnComposeFlipped = (C.controlSemigroupoid, C.composeFlipped)
275277
278+inlineUnsafePartial :: JS -> JS
279+inlineUnsafePartial = everywhereOnJSTopDown convert where
280+ convert (JSApp ss (JSIndexer _ (JSStringLiteral _ unsafePartial) (JSVar _ partialUnsafe)) [ comp ])
281+ | unsafePartial == C.unsafePartial && partialUnsafe == C.partialUnsafe
282+ -- Apply to undefined here, the application should be optimized away
283+ -- if it is safe to do so
284+ = JSApp ss comp [ JSVar ss C.undefined ]
285+ convert other = other
286+
276287semiringNumber :: forall a b. (IsString a, IsString b) => (a, b)
277288semiringNumber = (C.dataSemiring, C.semiringNumber)
278289
src/Language/PureScript/CodeGen/JS/Optimizer/TCO.hs+11−12
@@ -80,7 +80,17 @@ tco' = everywhereOnJS convert
8080 countSelfCallsUnderFunctions _ = 0
8181
8282 countSelfCallsWithFnArgs :: JS -> Int
83− countSelfCallsWithFnArgs ret = if isSelfCallWithFnArgs ident ret [] then 1 else 0
83+ countSelfCallsWithFnArgs = go [] where
84+ go acc (JSVar _ ident')
85+ | ident == ident' && any hasFunction acc = 1
86+ go acc (JSApp _ fn args) = go (args ++ acc) fn
87+ go _ _ = 0
88+
89+ hasFunction :: JS -> Bool
90+ hasFunction = getAny . everythingOnJS mappend (Any . isFunction)
91+ where
92+ isFunction JSFunction{} = True
93+ isFunction _ = False
8494
8595 toLoop :: Text -> [Text] -> JS -> JS
8696 toLoop ident allArgs js = JSBlock rootSS $
@@ -108,14 +118,3 @@ tco' = everywhereOnJS convert
108118 isSelfCall ident (JSApp _ (JSVar _ ident') _) = ident == ident'
109119 isSelfCall ident (JSApp _ fn _) = isSelfCall ident fn
110120 isSelfCall _ _ = False
111−
112− isSelfCallWithFnArgs :: Text -> JS -> [JS] -> Bool
113− isSelfCallWithFnArgs ident (JSVar _ ident') args | ident == ident' && any hasFunction args = True
114− isSelfCallWithFnArgs ident (JSApp _ fn args) acc = isSelfCallWithFnArgs ident fn (args ++ acc)
115− isSelfCallWithFnArgs _ _ _ = False
116−
117− hasFunction :: JS -> Bool
118− hasFunction = getAny . everythingOnJS mappend (Any . isFunction)
119− where
120− isFunction JSFunction{} = True
121− isFunction _ = False
src/Language/PureScript/Constants.hs+6
@@ -447,3 +447,9 @@ dataFunctionUncurried = "Data_Function_Uncurried"
447447
448448dataIntBits :: forall a. (IsString a) => a
449449dataIntBits = "Data_Int_Bits"
450+
451+partialUnsafe :: forall a. (IsString a) => a
452+partialUnsafe = "Partial_Unsafe"
453+
454+unsafePartial :: forall a. (IsString a) => a
455+unsafePartial = "unsafePartial"