From edfa896e6c2ddc89b4cd6b1d659237fe3d2efc57 Mon Sep 17 00:00:00 2001 From: Arnaud Spiwack Date: Wed, 23 Sep 2020 12:20:46 +0200 Subject: 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) --- compiler/GHC/Tc/Gen/Match.hs | 9 ++++++++- testsuite/tests/linear/should_fail/LinearPatternGuardWildcard.hs | 7 +++++++ .../tests/linear/should_fail/LinearPatternGuardWildcard.stderr | 5 +++++ testsuite/tests/linear/should_fail/all.T | 1 + 4 files changed, 21 insertions(+), 1 deletion(-) create mode 100644 testsuite/tests/linear/should_fail/LinearPatternGuardWildcard.hs create mode 100644 testsuite/tests/linear/should_fail/LinearPatternGuardWildcard.stderr 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, ['']) -- cgit v1.2.1