7540821 · rowtype-yoga/purescript-native

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

Fail early when 'bind' is brought into scope inside 'do' (#2547)

* Fix #1253, fail early when 'bind' is brought into scope inside 'do' * Add test for 'let'

commit754082115291a23e066b0a1d64c65f7cdaef129f authorPhil Freeman <paf31@cantab.net> dateSun 8 Jan 2017, 10:30 (10 years ago) parent07bb952

5 files changed+32−1

compare with golang

unifiedsplit

examples/failing/BindInDo-2.purs+9 examples/failing/BindInDo.purs+9 src/Language/PureScript/AST/Declarations.hs+1 src/Language/PureScript/Errors.hs+5 src/Language/PureScript/Sugar/DoNotation.hs+8−1

examples/failing/BindInDo-2.pursnew file+9

@@ -0,0 +1,9 @@

1+-- @shouldFailWith CannotUseBindWithDo

2+module Main where

4+import Prelude

6+foo = do

7+ let bind = 42

8+ x <- [4, 5, 6]

9+ pure x

examples/failing/BindInDo.pursnew file+9

@@ -0,0 +1,9 @@

1+-- @shouldFailWith CannotUseBindWithDo

2+module Main where

4+import Prelude

6+foo = do

7+ bind <- [1,2,3]

8+ x <- [4, 5, 6]

9+ pure x

src/Language/PureScript/AST/Declarations.hs+1

@@ -138,6 +138,7 @@ data SimpleErrorMessage

138138 | CannotGeneralizeRecursiveFunction Ident Type

139139 | CannotDeriveNewtypeForData (ProperName 'TypeName)

140140 | ExpectedWildcard (ProperName 'TypeName)

141+ | CannotUseBindWithDo

141142 deriving (Show)

142143

143144-- | Error message hints, providing more detailed information about failure.

src/Language/PureScript/Errors.hs+5

@@ -172,6 +172,7 @@ errorCode em = case unwrapErrorMessage em of

172172 CannotGeneralizeRecursiveFunction{} -> "CannotGeneralizeRecursiveFunction"

173173 CannotDeriveNewtypeForData{} -> "CannotDeriveNewtypeForData"

174174 ExpectedWildcard{} -> "ExpectedWildcard"

175+ CannotUseBindWithDo{} -> "CannotUseBindWithDo"

175176

176177-- |

177178-- A stack trace for an error

@@ -880,6 +881,10 @@ prettyPrintSingleError (PPEOptions codeColor full level showDocs) e = flip evalS

880881 paras [ line $ "Expected a type wildcard (_) when deriving an instance for " <> markCode (runProperName tyName) <> "."

881882 ]

882883

884+ renderSimpleErrorMessage CannotUseBindWithDo =

885+ paras [ line $ "The name " <> markCode "bind" <> " cannot be brought into scope in a do notation block, since do notation uses the same name."

886+ ]

887+

883888 renderHint :: ErrorMessageHint -> Box.Box -> Box.Box

884889 renderHint (ErrorUnifyingTypes t1 t2) detail =

885890 paras [ detail

src/Language/PureScript/Sugar/DoNotation.hs+8−1

@@ -9,7 +9,6 @@ import Prelude.Compat

99import Control.Monad.Error.Class (MonadError(..))

1010import Control.Monad.Supply.Class

1111

12−

1312import Language.PureScript.AST

1413import Language.PureScript.Crash

1514import Language.PureScript.Errors

@@ -49,6 +48,8 @@ desugarDo d =

4948 return $ App (App bind val) (Abs (Left (Ident C.__unused)) rest')

5049 go [DoNotationBind _ _] = throwError . errorMessage $ InvalidDoBind

5150 go (DoNotationBind NullBinder val : rest) = go (DoNotationValue val : rest)

51+ go (DoNotationBind b _ : _) | Ident C.bind `elem` binderNames b =

52+ throwError . errorMessage $ CannotUseBindWithDo

5253 go (DoNotationBind (VarBinder ident) val : rest) = do

5354 rest' <- go rest

5455 return $ App (App bind val) (Abs (Left ident) rest')

@@ -58,6 +59,12 @@ desugarDo d =

5859 return $ App (App bind val) (Abs (Left ident) (Case [Var (Qualified Nothing ident)] [CaseAlternative [binder] (Right rest')]))

5960 go [DoNotationLet _] = throwError . errorMessage $ InvalidDoLet

6061 go (DoNotationLet ds : rest) = do

62+ let checkBind :: Declaration -> m ()

63+ checkBind (ValueDeclaration (Ident name) _ _ _)

64+ | name == C.bind = throwError . errorMessage $ CannotUseBindWithDo

65+ checkBind (PositionedDeclaration pos _ decl) = rethrowWithPosition pos (checkBind decl)

66+ checkBind _ = pure ()

67+ mapM_ checkBind ds

6168 rest' <- go rest

6269 return $ Let ds rest'

6370 go (PositionedDoNotationElement pos com el : rest) = rethrowWithPosition pos $ PositionedValue pos com <$> go (el : rest)