94fc8d1 · rowtype-yoga/purescript-native

git.iko.soy/rowtype-yoga/purescript-native

Aggressively inline ST computations when STRefs are only used locally. Inline whileE and untilE.

commit94fc8d13bf428d3f9c9ed8ca24d8c224dcb76a27 authorPhil Freeman <paf31@cantab.net> dateTue 11 Feb 2014, 18:00 (13 years ago) parentb58d4e5

3 files changed+73−28

compare with golang

unifiedsplit

prelude/prelude.purs+17−17 prelude/tests/Eff.purs+3−4 src/Language/PureScript/CodeGen/Optimize.hs+53−7

prelude/prelude.purs+17−17

@@ -54,11 +54,11 @@ module Prelude where

5454 instance Read Boolean where

5555 read "true" = true

5656 read _ = false

57−

57+

5858 foreign import readNumber "function readNumber(n) {\

5959 \ return parseInt(n, 10);\

6060 \}" :: String -> Number

61−

61+

6262 instance Read Number where

6363 read = readNumber

6464

@@ -369,7 +369,7 @@ module Monoid where

369369 instance Monoid String where

370370 mempty = ""

371371 (<>) = (++)

372−

372+

373373 instance Monoid [a] where

374374 mempty = []

375375 (<>) = Arrays.concat

@@ -440,11 +440,11 @@ module Maybe where

440440

441441 fromMaybe :: forall a. a -> Maybe a -> a

442442 fromMaybe a = maybe a (Prelude.id :: forall a. a -> a)

443−

443+

444444 instance Prelude.Monad Maybe where

445445 return = Just

446446 (>>=) m f = maybe Nothing f m

447−

447+

448448 instance Prelude.Applicative Maybe where

449449 pure = Just

450450 (<*>) (Just fn) x = fn <$> x

@@ -453,7 +453,7 @@ module Maybe where

453453 instance Prelude.Functor Maybe where

454454 (<$>) fn (Just x) = Just (fn x)

455455 (<$>) _ _ = Nothing

456−

456+

457457 instance (Show a) => Prelude.Show (Maybe a) where

458458 show (Just x) = "Just " ++ (show x)

459459 show Nothing = "Nothing"

@@ -467,11 +467,11 @@ module Either where

467467 either :: forall a b c. (a -> c) -> (b -> c) -> Either a b -> c

468468 either f _ (Left a) = f a

469469 either _ g (Right b) = g b

470−

470+

471471 instance Prelude.Monad (Either e) where

472472 return = Right

473473 (>>=) = either (\e _ -> Left e) (\a f -> f a)

474−

474+

475475 instance Prelude.Applicative (Either e) where

476476 pure = Right

477477 (<*>) (Left e) _ = Left e

@@ -480,7 +480,7 @@ module Either where

480480 instance Prelude.Functor (Either a) where

481481 (<$>) _ (Left x) = Left x

482482 (<$>) f (Right y) = Right (f y)

483−

483+

484484 instance (Show a, Show b) => Prelude.Show (Either a b) where

485485 show (Left x) = "Left " ++ (show x)

486486 show (Right y) = "Right " ++ (show y)

@@ -632,10 +632,10 @@ module Arrays where

632632 instance (Prelude.Show a) => Prelude.Show [a] where

633633 show [] = "[]"

634634 show (x:xs) = show x ++ " : " ++ show xs

635−

635+

636636 instance Prelude.Functor [] where

637637 (<$>) = map

638−

638+

639639 instance Prelude.Monad [] where

640640 return = singleton

641641 (>>=) = concatMap

@@ -893,7 +893,7 @@ module Math where

893893 foreign import tan "function tan(n){\

894894 \ return Math.tan(n);\

895895 \}" :: Number -> Number

896−

896+

897897 foreign import e "var e = Math.E;" :: Number

898898 foreign import ln2 "var ln2 = Math.LN2;" :: Number

899899 foreign import ln10 "var ln10 = Math.LN10;" :: Number

@@ -947,7 +947,7 @@ module Eff where

947947 \ return {};\

948948 \ };\

949949 \ };\

950− \}" :: forall e. Eff e Boolean -> Eff e {} -> Eff e {}

950+ \}" :: forall e a. Eff e Boolean -> Eff e a -> Eff e {}

951951

952952 foreign import forE "function forE(lo) {\

953953 \ return function(hi) {\

@@ -1088,18 +1088,18 @@ module ST where

10881088 foreign import modifySTRef "function modifySTRef(ref) {\

10891089 \ return function(f) {\

10901090 \ return function() {\

1091− \ ref.value = f(ref.value);\

1091+ \ return ref.value = f(ref.value);\

10921092 \ };\

10931093 \ };\

1094− \}" :: forall a h r. STRef h a -> (a -> a) -> Eff (st :: ST h | r) {}

1094+ \}" :: forall a h r. STRef h a -> (a -> a) -> Eff (st :: ST h | r) a

10951095

10961096 foreign import writeSTRef "function writeSTRef(ref) {\

10971097 \ return function(a) {\

10981098 \ return function() {\

1099− \ ref.value = a;\

1099+ \ return ref.value = a;\

11001100 \ };\

11011101 \ };\

1102− \}" :: forall a h r. STRef h a -> a -> Eff (st :: ST h | r) {}

1102+ \}" :: forall a h r. STRef h a -> a -> Eff (st :: ST h | r) a

11031103

11041104 foreign import runST "function runST(f) {\

11051105 \ return f;\

prelude/tests/Eff.purs+3−4

@@ -46,13 +46,12 @@ test7 _ = do

4646

4747test8 _ = (\_1 _2 -> {}) <$> print "Test" <*> print 8

4848

49−test9 _ = do

49+test9 _ = runST (do

5050 r <- newSTRef 1

51− untilE $ do

51+ whileE (return true) $ do

5252 n <- readSTRef r

5353 trace $ "Count " ++ show n

54− modifySTRef r $ (+) 1

55− return false

54+ modifySTRef r $ (+) 1)

5655

5756module Main where

5857

src/Language/PureScript/CodeGen/Optimize.hs+53−7

@@ -38,7 +38,8 @@ module Language.PureScript.CodeGen.Optimize (

3838) where

3939

4040import Data.Data

41−import Data.Maybe (fromMaybe)

41+import Data.List (nub)

42+import Data.Maybe (fromJust, isJust, fromMaybe)

4243import Data.Generics

4344

4445import Language.PureScript.Names

@@ -288,6 +289,12 @@ magicDo' = everywhere (mkT undo) . everywhere' (mkT convert)

288289 -- Desugar >>=

289290 convert (JSApp (JSApp bind [m]) [JSFunction Nothing [arg] (JSBlock [JSReturn ret])]) | isBind bind =

290291 JSFunction (Just fnName) [] $ JSBlock [ JSVariableIntroduction arg (Just (JSApp m [])), JSReturn (JSApp ret []) ]

292+ -- Desugar untilE

293+ convert (JSApp (JSApp f [arg]) []) | isEffFunc "untilE" f =

294+ JSApp (JSFunction Nothing [] (JSBlock [ JSWhile (JSUnary Not (JSApp arg [])) (JSBlock []), JSReturn (JSObjectLiteral []) ])) []

295+ -- Desugar whileE

296+ convert (JSApp (JSApp (JSApp f [arg1]) [arg2]) []) | isEffFunc "whileE" f =

297+ JSApp (JSFunction Nothing [] (JSBlock [ JSWhile (JSApp arg1 []) (JSBlock [ JSApp arg2 [] ]), JSReturn (JSObjectLiteral []) ])) []

291298 convert other = other

292299 -- Check if an expression represents a monomorphic call to >>= for the Eff monad

293300 isBind (JSApp bindPoly [effDict]) | isBindPoly bindPoly && isEffDict effDict = True

@@ -303,6 +310,9 @@ magicDo' = everywhere (mkT undo) . everywhere' (mkT convert)

303310 isRetPoly (JSAccessor "$return" (JSAccessor "Prelude" (JSVar "_ps"))) = True

304311 isRetPoly (JSIndexer (JSStringLiteral "return") (JSAccessor "Prelude" (JSVar "_ps"))) = True

305312 isRetPoly _ = False

313+ -- Check if an expression represents a function in the Ef module

314+ isEffFunc name (JSAccessor name' (JSAccessor "Eff" (JSVar "_ps"))) | name == name' = True

315+ isEffFunc _ _ = False

306316 -- Module names

307317 prelude = ModuleName (ProperName "Prelude")

308318 effModule = ModuleName (ProperName "Eff")

@@ -324,20 +334,56 @@ magicDo' = everywhere (mkT undo) . everywhere' (mkT convert)

324334-- Inline functions in the ST module

325335--

326336inlineST :: JS -> JS

327−inlineST = everywhere (mkT convert)

337+inlineST = everywhere (mkT convertBlock)

328338 where

329− convert (JSApp (JSApp f [arg]) []) | isSTFunc "newSTRef" f =

339+ -- Look for runST blocks and inline the STRefs there.

340+ -- If all STRefs are used in the scope of the same runST, only using { read, write, modify }STRef then

341+ -- we can be more aggressive about inlining, and actually turn STRefs into local variables.

342+ convertBlock (JSApp f [arg]) | isSTFunc "runST" f =

343+ let refs = nub . findSTRefsIn $ arg

344+ usages = findAllSTUsagesIn arg

345+ allUsagesAreLocalVars = all (\u -> let v = toVar u in isJust v && fromJust v `elem` refs) usages

346+ localVarsDoNotEscape = all (\r -> length (r `appearingIn` arg) == length (filter (\u -> let v = toVar u in v == Just r) usages)) refs

347+ in everywhere (mkT $ if allUsagesAreLocalVars then convertAggressive else convertSafe) arg

348+ convertBlock other = other

349+ -- Convert a block in a safe way, preserving object wrappers of references

350+ convertSafe (JSApp (JSApp f [arg]) []) | isSTFunc "newSTRef" f =

330351 JSObjectLiteral [("value", arg)]

331− convert (JSApp (JSApp f [ref]) []) | isSTFunc "readSTRef" f =

352+ convertSafe (JSApp (JSApp f [ref]) []) | isSTFunc "readSTRef" f =

332353 JSAccessor "value" ref

333− convert (JSApp (JSApp (JSApp f [ref]) [arg]) []) | isSTFunc "writeSTRef" f =

354+ convertSafe (JSApp (JSApp (JSApp f [ref]) [arg]) []) | isSTFunc "writeSTRef" f =

334355 JSAssignment (JSAccessor "value" ref) arg

335− convert (JSApp (JSApp (JSApp f [ref]) [func]) []) | isSTFunc "modifySTRef" f =

356+ convertSafe (JSApp (JSApp (JSApp f [ref]) [func]) []) | isSTFunc "modifySTRef" f =

336357 JSAssignment (JSAccessor "value" ref) (JSApp func [JSAccessor "value" ref])

337− convert other = other

358+ convertSafe other = other

359+ -- Convert a block in a more agressive way, unwrapping object wrappers into local variables

360+ convertAggressive (JSApp (JSApp f [arg]) []) | isSTFunc "newSTRef" f = arg

361+ convertAggressive (JSApp (JSApp f [ref]) []) | isSTFunc "readSTRef" f = ref

362+ convertAggressive (JSApp (JSApp (JSApp f [ref]) [arg]) []) | isSTFunc "writeSTRef" f = JSAssignment ref arg

363+ convertAggressive (JSApp (JSApp (JSApp f [ref]) [func]) []) | isSTFunc "modifySTRef" f = JSAssignment ref (JSApp func [ref])

364+ convertAggressive other = other

338365 -- Check if an expression represents a function in the ST module

339366 isSTFunc name (JSAccessor name' (JSAccessor "ST" (JSVar "_ps"))) | name == name' = True

340367 isSTFunc _ _ = False

368+ -- Find all ST Refs initialized in this block

369+ findSTRefsIn = everything (++) (mkQ [] isSTRef)

370+ where

371+ isSTRef (JSVariableIntroduction ident (Just (JSApp (JSApp f [arg]) []))) | isSTFunc "newSTRef" f = [ident]

372+ isSTRef _ = []

373+ -- Find all STRefs used as arguments to readSTRef, writeSTRef, modifySTRef

374+ findAllSTUsagesIn = everything (++) (mkQ [] isSTUsage)

375+ where

376+ isSTUsage (JSApp (JSApp f [ref]) []) | isSTFunc "readSTRef" f = [ref]

377+ isSTUsage (JSApp (JSApp (JSApp f [ref]) [_]) []) | isSTFunc "writeSTRef" f || isSTFunc "modifySTRef" f = [ref]

378+ isSTUsage _ = []

379+ -- Find all uses of a variable

380+ appearingIn ref = everything (++) (mkQ [] isVar)

381+ where

382+ isVar e@(JSVar v) | v == ref = [e]

383+ isVar _ = []

384+ -- Convert a JS value to a String if it is a JSVar

385+ toVar (JSVar v) = Just v

386+ toVar _ = Nothing

341387

342388collapseNestedBlocks :: JS -> JS

343389collapseNestedBlocks = everywhere (mkT collapse)