git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Fix optimizer issues after splitting up Monad.
00169a0Phil Freeman
examples/passing/Superclasses3.purs+1−1
compare with golang
unifiedsplit
@@ -7,7 +7,7 @@ import Control.Monad.Eff
7class (Monad m) <= MonadWriter w m where
7class (Monad m) <= MonadWriter w m where
8 tell :: w -> m {}
8 tell :: w -> m {}
9
9
10−testFunctor :: forall m. (Monad m) => m Number -> m Number
10+testFunctor :: forall m. (Applicative m) => m Number -> m Number
11testFunctor n = (+) 1 <$> n
11testFunctor n = (+) 1 <$> n
12
12
13test :: forall w m. (Monad m, MonadWriter w m) => w -> m {}
13test :: forall w m. (Monad m, MonadWriter w m) => w -> m {}
prelude/prelude.purs+16−16
@@ -371,19 +371,19 @@ module Control.Monad.Eff where
371
371
372 foreign import data Eff :: # ! -> * -> *
372 foreign import data Eff :: # ! -> * -> *
373
373
374− foreign import retEff "function retEff(a) {\
374+ foreign import returnE "function returnE(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) {\
375+ \ return function() {\
382− \ return function() {\
376+ \ return a;\
383− \ return f(a())();\
384− \ };\
385 \ };\
377 \ };\
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
386+ \}" :: forall e a b. Eff e a -> (a -> Eff e b) -> Eff e b
387
387
388 type Pure a = forall e. Eff e a
388 type Pure a = forall e. Eff e a
389
389
@@ -398,13 +398,13 @@ module Control.Monad.Eff where
398 (<*>) = ap
398 (<*>) = ap
399
399
400 instance applicativeEff :: Applicative (Eff e) where
400 instance applicativeEff :: Applicative (Eff e) where
401− pure = return
401+ pure = returnE
402
402
403− instance bindEffInstance :: Bind (Eff e) where
403+ instance bindEff :: Bind (Eff e) where
404− (>>=) = bindEff
404+ (>>=) = bindE
405
405
406 instance monadEff :: Monad (Eff e) where
406 instance monadEff :: Monad (Eff e) where
407− return = retEff
407+ return = returnE
408
408
409 foreign import untilE "function untilE(f) {\
409 foreign import untilE "function untilE(f) {\
410 \ return function() {\
410 \ return function() {\
src/Language/PureScript/Constants.hs+3
@@ -146,6 +146,9 @@ pokeSTArray = "pokeSTArray"
146monadEffDictionary :: String
146monadEffDictionary :: String
147monadEffDictionary = "monadEff"
147monadEffDictionary = "monadEff"
148
148
149+bindEffDictionary :: String
150+bindEffDictionary = "bindEff"
151+
149numNumber :: String
152numNumber :: String
150numNumber = "numNumber"
153numNumber = "numNumber"
151
154
src/Language/PureScript/Optimizer/MagicDo.hs+7−7
@@ -74,10 +74,10 @@ magicDo' = everywhere (mkT undo) . everywhere' (mkT convert)
74 JSApp (JSFunction Nothing [] (JSBlock [ JSWhile (JSApp arg1 []) (JSBlock [ JSApp arg2 [] ]), JSReturn (JSObjectLiteral []) ])) []
74 JSApp (JSFunction Nothing [] (JSBlock [ JSWhile (JSApp arg1 []) (JSBlock [ JSApp arg2 [] ]), JSReturn (JSObjectLiteral []) ])) []
75 convert other = other
75 convert other = other
76 -- Check if an expression represents a monomorphic call to >>= for the Eff monad
76 -- 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
78 isBind _ = False
78 isBind _ = False
79 -- Check if an expression represents a monomorphic call to return for the Eff monad
79 -- 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
81 isReturn _ = False
81 isReturn _ = False
82 -- Check if an expression represents the polymorphic >>= function
82 -- Check if an expression represents the polymorphic >>= function
83 isBindPoly (JSAccessor prop (JSAccessor prelude (JSVar _ps))) | prelude == C.prelude &&
83 isBindPoly (JSAccessor prop (JSAccessor prelude (JSVar _ps))) | prelude == C.prelude &&
@@ -101,11 +101,11 @@ magicDo' = everywhere (mkT undo) . everywhere' (mkT convert)
101 name == name' = True
101 name == name' = True
102 isEffFunc _ _ = False
102 isEffFunc _ _ = False
103 -- Check if an expression represents the Monad Eff dictionary
103 -- Check if an expression represents the Monad Eff dictionary
104− isEffDict (JSApp (JSVar ident) [JSObjectLiteral []]) | ident == C.monadEffDictionary = True
104+ isEffDict name (JSApp (JSVar ident) [JSObjectLiteral []]) | ident == name = True
105− isEffDict (JSApp (JSAccessor prop (JSAccessor eff (JSVar _ps))) [JSObjectLiteral []]) | eff == C.eff &&
105+ isEffDict name (JSApp (JSAccessor prop (JSAccessor eff (JSVar _ps))) [JSObjectLiteral []]) | eff == C.eff &&
106− _ps == C._ps &&
106+ _ps == C._ps &&
107− prop == C.monadEffDictionary = True
107+ prop == name = True
108− isEffDict _ = False
108+ isEffDict _ _ = False
109 -- Remove __do function applications which remain after desugaring
109 -- Remove __do function applications which remain after desugaring
110 undo :: JS -> JS
110 undo :: JS -> JS
111 undo (JSReturn (JSApp (JSFunction (Just ident) [] body) [])) | ident == fnName = body
111 undo (JSReturn (JSApp (JSFunction (Just ident) [] body) [])) | ident == fnName = body