00169a0 · rowtype-yoga/purescript-native

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

Fix optimizer issues after splitting up Monad.

commit00169a01e167fd85bf0104da36a175c45f962c0c authorPhil Freeman <paf31@cantab.net> dateMon 7 Apr 2014, 20:04 (13 years ago) parent7783302

4 files changed+27−24

compare with golang

unifiedsplit

examples/passing/Superclasses3.purs+1−1 prelude/prelude.purs+16−16 src/Language/PureScript/Constants.hs+3 src/Language/PureScript/Optimizer/MagicDo.hs+7−7

examples/passing/Superclasses3.purs+1−1

@@ -7,7 +7,7 @@ import Control.Monad.Eff

77class (Monad m) <= MonadWriter w m where

88 tell :: w -> m {}

10−testFunctor :: forall m. (Monad m) => m Number -> m Number

10+testFunctor :: forall m. (Applicative m) => m Number -> m Number

1111testFunctor n = (+) 1 <$> n

1212

1313test :: forall w m. (Monad m, MonadWriter w m) => w -> m {}

prelude/prelude.purs+16−16

@@ -371,19 +371,19 @@ module Control.Monad.Eff where

371371

372372 foreign import data Eff :: # ! -> * -> *

373373

374− foreign import retEff "function retEff(a) {\

375− \ return function() {\

376− \ return a;\

377− \ };\

378− \}" :: forall e a. a -> Eff e a

379−

380− foreign import bindEff "function bindEff(a) {\

381− \ return function(f) {\

382− \ return function() {\

383− \ return f(a())();\

384− \ };\

374+ foreign import returnE "function returnE(a) {\

375+ \ return function() {\

376+ \ return a;\

385377 \ };\

386− \}" :: forall e a b. Eff e a -> (a -> Eff e b) -> Eff e b

378+ \}" :: forall e a. a -> Eff e a

379+

380+ foreign import bindE "function bindE(a) {\

381+ \ return function(f) {\

382+ \ return function() {\

383+ \ return f(a())();\

384+ \ };\

385+ \ };\

386+ \}" :: forall e a b. Eff e a -> (a -> Eff e b) -> Eff e b

387387

388388 type Pure a = forall e. Eff e a

389389

@@ -398,13 +398,13 @@ module Control.Monad.Eff where

398398 (<*>) = ap

399399

400400 instance applicativeEff :: Applicative (Eff e) where

401− pure = return

401+ pure = returnE

402402

403− instance bindEffInstance :: Bind (Eff e) where

404− (>>=) = bindEff

403+ instance bindEff :: Bind (Eff e) where

404+ (>>=) = bindE

405405

406406 instance monadEff :: Monad (Eff e) where

407− return = retEff

407+ return = returnE

408408

409409 foreign import untilE "function untilE(f) {\

410410 \ return function() {\

src/Language/PureScript/Constants.hs+3

@@ -146,6 +146,9 @@ pokeSTArray = "pokeSTArray"

146146monadEffDictionary :: String

147147monadEffDictionary = "monadEff"

148148

149+bindEffDictionary :: String

150+bindEffDictionary = "bindEff"

151+

149152numNumber :: String

150153numNumber = "numNumber"

151154

src/Language/PureScript/Optimizer/MagicDo.hs+7−7

@@ -74,10 +74,10 @@ magicDo' = everywhere (mkT undo) . everywhere' (mkT convert)

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

7575 convert other = other

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

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

77+ isBind (JSApp bindPoly [effDict]) | isBindPoly bindPoly && isEffDict C.bindEffDictionary effDict = True

7878 isBind _ = False

7979 -- Check if an expression represents a monomorphic call to return for the Eff monad

80− isReturn (JSApp retPoly [effDict]) | isRetPoly retPoly && isEffDict effDict = True

80+ isReturn (JSApp retPoly [effDict]) | isRetPoly retPoly && isEffDict C.monadEffDictionary effDict = True

8181 isReturn _ = False

8282 -- Check if an expression represents the polymorphic >>= function

8383 isBindPoly (JSAccessor prop (JSAccessor prelude (JSVar _ps))) | prelude == C.prelude &&

@@ -101,11 +101,11 @@ magicDo' = everywhere (mkT undo) . everywhere' (mkT convert)

101101 name == name' = True

102102 isEffFunc _ _ = False

103103 -- Check if an expression represents the Monad Eff dictionary

104− isEffDict (JSApp (JSVar ident) [JSObjectLiteral []]) | ident == C.monadEffDictionary = True

105− isEffDict (JSApp (JSAccessor prop (JSAccessor eff (JSVar _ps))) [JSObjectLiteral []]) | eff == C.eff &&

106− _ps == C._ps &&

107− prop == C.monadEffDictionary = True

108− isEffDict _ = False

104+ isEffDict name (JSApp (JSVar ident) [JSObjectLiteral []]) | ident == name = True

105+ isEffDict name (JSApp (JSAccessor prop (JSAccessor eff (JSVar _ps))) [JSObjectLiteral []]) | eff == C.eff &&

106+ _ps == C._ps &&

107+ prop == name = True

108+ isEffDict _ _ = False

109109 -- Remove __do function applications which remain after desugaring

110110 undo :: JS -> JS

111111 undo (JSReturn (JSApp (JSFunction (Just ident) [] body) [])) | ident == fnName = body