diff options
| author | Arnaud Spiwack <arnaud.spiwack@tweag.io> | 2020-09-23 12:20:46 +0200 |
|---|---|---|
| committer | Ben Gamari <ben@smart-cactus.org> | 2020-09-29 11:41:25 -0400 |
| commit | edfa896e6c2ddc89b4cd6b1d659237fe3d2efc57 (patch) | |
| tree | c63b27441a7fff0f70f38998b61fb9797608966e | |
| parent | ebcc09687b8d84daf00987a466834a20a9831e7b (diff) | |
| download | haskell-edfa896e6c2ddc89b4cd6b1d659237fe3d2efc57.tar.gz | |
Pattern guards BindStmt always use multiplicity Many
Fixes #18439 .
The rhs of the pattern guard was consumed with multiplicity one, while
the pattern assumed it was Many. We use Many everywhere instead.
This is behaviour consistent with that of `case` expression. See #18738.
(cherry picked from commit 2707c4eae4cf99e6da2709e128f560d91e468357)
4 files changed, 21 insertions, 1 deletions
diff --git a/compiler/GHC/Tc/Gen/Match.hs b/compiler/GHC/Tc/Gen/Match.hs index ee428cbc42..c092ec9883 100644 --- a/compiler/GHC/Tc/Gen/Match.hs +++ b/compiler/GHC/Tc/Gen/Match.hs @@ -388,7 +388,14 @@ tcGuardStmt _ (BodyStmt _ guard _ _) res_ty thing_inside ; return (BodyStmt boolTy guard' noSyntaxExpr noSyntaxExpr, thing) } tcGuardStmt ctxt (BindStmt _ pat rhs) res_ty thing_inside - = do { (rhs', rhs_ty) <- tcInferRhoNC rhs + = do { -- The Many on the next line and the unrestricted on the line after + -- are linked. These must be the same multiplicity. Consider + -- x <- rhs -> u + -- + -- The multiplicity of x in u must be the same as the multiplicity at + -- which the rhs has been consumed. When solving #18738, we want these + -- two multiplicity to still be the same. + (rhs', rhs_ty) <- tcScalingUsage Many $ tcInferRhoNC rhs -- Stmt has a context already ; (pat', thing) <- tcCheckPat_O (StmtCtxt ctxt) (lexprCtOrigin rhs) pat (unrestricted rhs_ty) $ diff --git a/testsuite/tests/linear/should_fail/LinearPatternGuardWildcard.hs b/testsuite/tests/linear/should_fail/LinearPatternGuardWildcard.hs new file mode 100644 index 0000000000..be837fd80b --- /dev/null +++ b/testsuite/tests/linear/should_fail/LinearPatternGuardWildcard.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE LinearTypes #-} +module LinearPatternGuardWildcard where + +-- See #18439 + +unsafeConsume :: a #-> () +unsafeConsume x | _ <- x = () diff --git a/testsuite/tests/linear/should_fail/LinearPatternGuardWildcard.stderr b/testsuite/tests/linear/should_fail/LinearPatternGuardWildcard.stderr new file mode 100644 index 0000000000..466ad41862 --- /dev/null +++ b/testsuite/tests/linear/should_fail/LinearPatternGuardWildcard.stderr @@ -0,0 +1,5 @@ + +LinearPatternGuardWildcard.hs:7:15: error: + • Couldn't match type ‘'Many’ with ‘'One’ + arising from multiplicity of ‘x’ + • In an equation for ‘unsafeConsume’: unsafeConsume x | _ <- x = () diff --git a/testsuite/tests/linear/should_fail/all.T b/testsuite/tests/linear/should_fail/all.T index 67906053dc..941966673c 100644 --- a/testsuite/tests/linear/should_fail/all.T +++ b/testsuite/tests/linear/should_fail/all.T @@ -27,3 +27,4 @@ test('LinearPolyType', expect_broken([436, broken_multiplicity_syntax]), compile test('LinearBottomMult', normal, compile_fail, ['']) test('LinearSequenceExpr', normal, compile_fail, ['']) test('LinearIf', normal, compile_fail, ['']) +test('LinearPatternGuardWildcard', normal, compile_fail, ['']) |