39347bf · rowtype-yoga/purescript-native

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

Merge pull request #1167 from purescript/1166

Fix 1166, Use bind instead of >>= in do desugaring

commit39347bf38b67dd32f62334217a3380e4c7591d9b authorPhil Freeman <paf31@cantab.net> dateFri 19 Jun 2015, 08:20 (11 years ago) parent6e267af 585d34a

10 files changed+25−19

compare with golang

unifiedsplit

examples/passing/Do.purs+2−2 examples/passing/MonadState.purs+1−1 examples/passing/NewtypeEff.purs+1−1 examples/passing/RebindableSyntax.purs+2−2 examples/passing/Superclasses3.purs+1−1 examples/passing/TypeClasses.purs+3−3 src/Language/PureScript/CodeGen/JS/Optimizer/MagicDo.hs+2−2 src/Language/PureScript/Constants.hs+3 src/Language/PureScript/Sugar/DoNotation.hs+3−3 tests/prelude/Prelude.purs+7−4

examples/passing/Do.purs+2−2

@@ -16,8 +16,8 @@ instance applicativeMaybe :: Applicative Maybe where

1616 pure = Just

1717

1818instance bindMaybe :: Bind Maybe where

19− (>>=) Nothing _ = Nothing

20− (>>=) (Just a) f = f a

19+ bind Nothing _ = Nothing

20+ bind (Just a) f = f a

2121

2222instance monadMaybe :: Prelude.Monad Maybe

2323

examples/passing/MonadState.purs+1−1

@@ -22,7 +22,7 @@ instance applicativeState :: Applicative (State s) where

2222 pure a = State $ \s -> Tuple s a

2323

2424instance bindState :: Bind (State s) where

25− (>>=) f g = State $ \s -> case runState s f of

25+ bind f g = State $ \s -> case runState s f of

2626 Tuple s1 a -> runState s1 (g a)

2727

2828instance monadState :: Monad (State s)

examples/passing/NewtypeEff.purs+1−1

@@ -19,7 +19,7 @@ instance applicativeT :: Applicative T where

1919 pure t = T (pure t)

2020

2121instance bindT :: Bind T where

22− (>>=) (T t) f = T (t >>= \x -> runT (f x))

22+ bind (T t) f = T (t >>= \x -> runT (f x))

2323

2424instance monadT :: Monad T

2525

examples/passing/RebindableSyntax.purs+2−2

@@ -9,7 +9,7 @@ example1 = do

99 " for"

1010 " Semigroup"

1111 where

12− (>>=) x f = x <> f unit

12+ bind x f = x <> f unit

1313

1414(*>) :: forall f a b. (Apply f) => f a -> f b -> f b

1515(*>) fa fb = const id <$> fa <*> fb

@@ -32,7 +32,7 @@ example2 = do

3232 Const " for"

3333 Const " Apply"

3434 where

35− (>>=) x f = x *> f unit

35+ bind x f = x *> f unit

3636

3737main = do

3838 Debug.Trace.trace example1

examples/passing/Superclasses3.purs+1−1

@@ -31,7 +31,7 @@ instance applicativeMTrace :: Applicative MTrace where

3131 pure = MTrace <<< return

3232

3333instance bindMTrace :: Bind MTrace where

34− (>>=) m f = MTrace (runMTrace m >>= (runMTrace <<< f))

34+ bind m f = MTrace (runMTrace m >>= (runMTrace <<< f))

3535

3636instance monadMTrace :: Monad MTrace

3737

examples/passing/TypeClasses.purs+3−3

@@ -31,7 +31,7 @@ instance applicativeData :: Applicative Data where

3131 pure = Data

3232

3333instance bindData :: Bind Data where

34− (>>=) (Data a) f = f a

34+ bind (Data a) f = f a

3535

3636instance monadData :: Monad Data

3737

@@ -47,8 +47,8 @@ instance applicativeMaybe :: Applicative Maybe where

4747 pure = Just

4848

4949instance bindMaybe :: Bind Maybe where

50− (>>=) Nothing _ = Nothing

51− (>>=) (Just a) f = f a

50+ bind Nothing _ = Nothing

51+ bind (Just a) f = f a

5252

5353instance monadMaybe :: Monad Maybe

5454

src/Language/PureScript/CodeGen/JS/Optimizer/MagicDo.hs+2−2

@@ -81,8 +81,8 @@ magicDo' = everywhereOnJS undo . everywhereOnJSTopDown convert

8181 isPure (JSApp purePoly [effDict]) | isPurePoly purePoly && isEffDict C.applicativeEffDictionary effDict = True

8282 isPure _ = False

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

84− isBindPoly (JSAccessor prop (JSVar prelude)) = prelude == C.prelude && prop == identToJs (Op (C.>>=))

85− isBindPoly (JSIndexer (JSStringLiteral bind) (JSVar prelude)) = prelude == C.prelude && bind == (C.>>=)

84+ isBindPoly (JSAccessor prop (JSVar prelude)) = prelude == C.prelude && (prop `elem` map identToJs [Ident C.bind, Op (C.>>=)])

85+ isBindPoly (JSIndexer (JSStringLiteral bind) (JSVar prelude)) = prelude == C.prelude && (bind `elem` [C.bind, (C.>>=)])

8686 isBindPoly _ = False

8787 -- Check if an expression represents the polymorphic return function

8888 isRetPoly (JSAccessor returnEscaped (JSVar prelude)) = prelude == C.prelude && returnEscaped == C.returnEscaped

src/Language/PureScript/Constants.hs+3

@@ -71,6 +71,9 @@ module Language.PureScript.Constants where

7171(||) :: String

7272(||) = "||"

7373

74+bind :: String

75+bind = "bind"

76+

7477unsafeIndex :: String

7578unsafeIndex = "unsafeIndex"

7679

src/Language/PureScript/Sugar/DoNotation.hs+3−3

@@ -10,7 +10,7 @@

1010--

1111-- |

1212-- This module implements the desugaring pass which replaces do-notation statements with

13−-- appropriate calls to (>>=) from the Prelude.Monad type class.

13+-- appropriate calls to bind from the Prelude.Monad type class.

1414--

1515-----------------------------------------------------------------------------

1616

@@ -32,7 +32,7 @@ import Control.Monad.Error.Class (MonadError(..))

3232import Control.Monad.Supply.Class

3333

3434-- |

35−-- Replace all @DoNotationBind@ and @DoNotationValue@ constructors with applications of the Prelude.(>>=) function,

35+-- Replace all @DoNotationBind@ and @DoNotationValue@ constructors with applications of the Prelude.bind function,

3636-- and all @DoNotationLet@ constructors with let expressions.

3737--

3838desugarDoModule :: forall m. (Applicative m, MonadSupply m, MonadError MultipleErrors m) => Module -> m Module

@@ -45,7 +45,7 @@ desugarDo d =

4545 in f d

4646 where

4747 bind :: Expr

48− bind = Var (Qualified Nothing (Op (C.>>=)))

48+ bind = Var (Qualified Nothing (Ident (C.bind)))

4949

5050 replace :: Expr -> m Expr

5151 replace (Do els) = go els

tests/prelude/Prelude.purs+7−4

@@ -17,7 +17,7 @@ module Prelude

1717 , Functor, (<$>), (<#>), void

1818 , Apply, (<*>)

1919 , Applicative, pure, liftA1

20− , Bind, (>>=)

20+ , Bind, bind, (>>=)

2121 , Monad, return, liftM1, ap

2222 , Semigroup, (<>), (++)

2323 , Semiring, (+), zero, (*), one

@@ -127,12 +127,15 @@ module Prelude

127127 liftA1 f a = pure f <*> a

128128

129129 infixl 1 >>=

130+

131+ (>>=) :: forall m a b. (Bind m) => m a -> (a -> m b) -> m b

132+ (>>=) = bind

130133

131134 class (Apply m) <= Bind m where

132− (>>=) :: forall a b. m a -> (a -> m b) -> m b

135+ bind :: forall a b. m a -> (a -> m b) -> m b

133136

134137 instance bindArr :: Bind ((->) r) where

135− (>>=) m f x = f (m x) x

138+ bind m f x = f (m x) x

136139

137140 class (Applicative m, Bind m) <= Monad m

138141

@@ -585,7 +588,7 @@ module Control.Monad.Eff

585588 pure = returnE

586589

587590 instance bindEff :: Bind (Eff e) where

588− (>>=) = bindE

591+ bind = bindE

589592

590593 instance monadEff :: Monad (Eff e)

591594