Commit 6ede3554 authored by Sebastian Graf's avatar Sebastian Graf Committed by Marge Bot

Infer rho-types instead of sigma-types in guard BindStmts and TransStmts

In #17343 we saw that we didn't handle the pattern guard `!_ <-
undefined` correctly: The `undefined` was never evaluated. Indeed,
elaboration failed to insert the invisible type aruments to `undefined`.
So `undefined` was trivially a normal-form and in turn never entered.

The problem is that we used to infer a sigma-type for the RHS of the
guard, the leading qualifiers of which will never be useful in a pattern
match situation. Hence we infer a rho-type now.

Fixes #17343.
parent 19641957
Pipeline #11449 failed with stages
in 241 minutes and 23 seconds
......@@ -15,11 +15,11 @@ tcMonoExpr, tcMonoExprNC ::
-> ExpRhoType
-> TcM (LHsExpr GhcTcId)
tcInferSigma, tcInferSigmaNC ::
tcInferSigma ::
LHsExpr GhcRn
-> TcM (LHsExpr GhcTcId, TcSigmaType)
tcInferRho ::
tcInferRho, tcInferRhoNC ::
LHsExpr GhcRn
-> TcM (LHsExpr GhcTcId, TcRhoType)
......
......@@ -21,7 +21,7 @@ module TcMatches ( tcMatchesFun, tcGRHS, tcGRHSsPat, tcMatchesCase, tcMatchLambd
import GhcPrelude
import {-# SOURCE #-} TcExpr( tcSyntaxOp, tcInferSigmaNC, tcInferSigma
import {-# SOURCE #-} TcExpr( tcSyntaxOp, tcInferRhoNC, tcInferRho
, tcCheckId, tcMonoExpr, tcMonoExprNC, tcPolyExpr )
import BasicTypes (LexicalFixity(..))
......@@ -404,7 +404,7 @@ 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) <- tcInferSigmaNC rhs
= do { (rhs', rhs_ty) <- tcInferRhoNC rhs
-- Stmt has a context already
; (pat', thing) <- tcPat_O (StmtCtxt ctxt) (lexprCtOrigin rhs)
pat (mkCheckExpType rhs_ty) $
......@@ -478,7 +478,7 @@ tcLcStmt m_tc ctxt (TransStmt { trS_form = form, trS_stmts = stmts
-- passed in to tcStmtsAndThen is never looked at
; (stmts', (bndr_ids, by'))
<- tcStmtsAndThen (TransStmtCtxt ctxt) (tcLcStmt m_tc) stmts unused_ty $ \_ -> do
{ by' <- traverse tcInferSigma by
{ by' <- traverse tcInferRho by
; bndr_ids <- tcLookupLocalIds bndr_names
; return (bndr_ids, by') }
......
{-# LANGUAGE BangPatterns #-}
h :: ()
h | !_ <- undefined = ()
{-# NOINLINE h #-}
-- main is expected to crash
main = print h
T17343: Prelude.undefined
CallStack (from HasCallStack):
error, called at libraries/base/GHC/Err.hs:79:14 in base:GHC.Err
undefined, called at T17343.hs:4:5 in main:Main
......@@ -692,3 +692,4 @@ test('T17067', normal, compile, [''])
test('T17202', expect_broken(17202), compile, [''])
test('T15839a', normal, compile, [''])
test('T15839b', normal, compile, [''])
test('T17343', exit_code(1), compile_and_run, [''])
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment