Commit 45cfe651 authored by Simon Peyton Jones's avatar Simon Peyton Jones

Small refactor in desugar of pattern matching

In reviewing Phab:D4968 for Trac #15385 I saw a small
but simple refactor to avoid unnecessary work in the
desugarer.

This patch just arranges to call
   matchSinglePatVar v ...
rather than
   matchSinglePat (Var v) ...

The more specialised function already existed, as
   match_single_pat_var

I also added more comments about decideBangHood
parent f265008f
......@@ -901,7 +901,7 @@ dsDo stmts
= do { body <- goL stmts
; rhs' <- dsLExpr rhs
; var <- selectSimpleMatchVarL pat
; match <- matchSinglePat (Var var) (StmtCtxt DoExpr) pat
; match <- matchSinglePatVar var (StmtCtxt DoExpr) pat
res1_ty (cantFailMatchResult body)
; match_code <- handle_failure pat match fail_op
; dsSyntaxExpr bind_op [rhs', Lam var match_code] }
......
......@@ -621,7 +621,7 @@ dsMcBindStmt :: LPat GhcTc
dsMcBindStmt pat rhs' bind_op fail_op res1_ty stmts
= do { body <- dsMcStmts stmts
; var <- selectSimpleMatchVarL pat
; match <- matchSinglePat (Var var) (StmtCtxt DoExpr) pat
; match <- matchSinglePatVar var (StmtCtxt DoExpr) pat
res1_ty (cantFailMatchResult body)
; match_code <- handle_failure pat match fail_op
; dsSyntaxExpr bind_op [rhs', Lam var match_code] }
......
......@@ -104,6 +104,9 @@ instance Outputable DsMatchContext where
data EquationInfo
= EqnInfo { eqn_pats :: [Pat GhcTc], -- The patterns for an eqn
-- NB: We have /already/ applied decideBangHood to
-- these patterns. See Note [decideBangHood] in DsUtils
eqn_rhs :: MatchResult } -- What to do after match
instance Outputable EquationInfo where
......
......@@ -97,6 +97,7 @@ otherwise, make one up.
-}
selectSimpleMatchVarL :: LPat GhcTc -> DsM Id
-- Postcondition: the returned Id has an Internal Name
selectSimpleMatchVarL pat = selectMatchVar (unLoc pat)
-- (selectMatchVars ps tys) chooses variables of type tys
......@@ -116,9 +117,11 @@ selectSimpleMatchVarL pat = selectMatchVar (unLoc pat)
-- And nowadays we won't, because the (x::Int) will be wrapped in a CoPat
selectMatchVars :: [Pat GhcTc] -> DsM [Id]
-- Postcondition: the returned Ids have Internal Names
selectMatchVars ps = mapM selectMatchVar ps
selectMatchVar :: Pat GhcTc -> DsM Id
-- Postcondition: the returned Id has an Internal Name
selectMatchVar (BangPat _ pat) = selectMatchVar (unLoc pat)
selectMatchVar (LazyPat _ pat) = selectMatchVar (unLoc pat)
selectMatchVar (ParPat _ pat) = selectMatchVar (unLoc pat)
......@@ -128,9 +131,8 @@ selectMatchVar (AsPat _ var _) = return (unLoc var)
selectMatchVar other_pat = newSysLocalDsNoLP (hsPatType other_pat)
-- OK, better make up one...
{-
Note [Localise pattern binders]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
{- Note [Localise pattern binders]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Consider module M where
[Just a] = e
After renaming it looks like
......@@ -166,6 +168,7 @@ In fact, even CoreSubst.simplOptExpr will do this, and simpleOptExpr
runs on the output of the desugarer, so all is well by the end of
the desugaring pass.
See also Note [MatchIds] in Match.hs
************************************************************************
* *
......@@ -903,13 +906,38 @@ mkBinaryTickBox ixT ixF e = do
-- *******************************************************************
{- Note [decideBangHood]
~~~~~~~~~~~~~~~~~~~~~~~~
With -XStrict we may make /outermost/ patterns more strict.
E.g.
let (Just x) = e in ...
==>
let !(Just x) = e in ...
and
f x = e
==>
f !x = e
This adjustment is done by decideBangHood,
* Just before constructing an EqnInfo, in Match
(matchWrapper and matchSinglePat)
* When desugaring a pattern-binding in DsBinds.dsHsBind
Note that it is /not/ done recursively. See the -XStrict
spec in the user manual.
Specifically:
~pat => pat -- when -XStrict (even if pat = ~pat')
!pat => !pat -- always
pat => !pat -- when -XStrict
pat => pat -- otherwise
-}
-- | Use -XStrict to add a ! or remove a ~
--
-- Examples:
-- ~pat => pat -- when -XStrict (even if pat = ~pat')
-- !pat => !pat -- always
-- pat => !pat -- when -XStrict
-- pat => pat -- otherwise
-- See Note [decideBangHood]
decideBangHood :: DynFlags
-> LPat GhcTc -- ^ Original pattern
-> LPat GhcTc -- Pattern with bang if necessary
......
......@@ -9,7 +9,8 @@ The @match@ function
{-# LANGUAGE CPP #-}
{-# LANGUAGE TypeFamilies #-}
module Match ( match, matchEquations, matchWrapper, matchSimply, matchSinglePat ) where
module Match ( match, matchEquations, matchWrapper, matchSimply
, matchSinglePat, matchSinglePatVar ) where
#include "HsVersions.h"
......@@ -152,6 +153,8 @@ is the scrutinee(s) of the match. The desugared expression may
sometimes use that Id in a local binding or as a case binder. So it
should not have an External name; Lint rejects non-top-level binders
with External names (Trac #13043).
See also Note [Localise pattern binders] in DsUtils
-}
type MatchId = Id -- See Note [Match Ids]
......@@ -728,7 +731,7 @@ matchWrapper ctxt mb_scr (MG { mg_alts = L _ matches
; match_result <- addDictsDs dicts $ -- See Note [Type and Term Equality Propagation]
addTmCsDs tm_cs $ -- See Note [Type and Term Equality Propagation]
dsGRHSs ctxt grhss rhs_ty
; return (EqnInfo { eqn_pats = upats, eqn_rhs = match_result}) }
; return (EqnInfo { eqn_pats = upats, eqn_rhs = match_result}) }
mk_eqn_info _ (L _ (XMatch _)) = panic "matchWrapper"
handleWarnings = if isGenerated origin
......@@ -777,7 +780,7 @@ matchSimply scrut hs_ctx pat result_expr fail_expr = do
matchSinglePat :: CoreExpr -> HsMatchContext Name -> LPat GhcTc
-> Type -> MatchResult -> DsM MatchResult
-- matchSinglePat ensures that the scrutinee is a variable
-- and then calls matchSinglePatVar
--
-- matchSinglePat does not warn about incomplete patterns
-- Used for things like [ e | pat <- stuff ], where
......@@ -785,17 +788,17 @@ matchSinglePat :: CoreExpr -> HsMatchContext Name -> LPat GhcTc
matchSinglePat (Var var) ctx pat ty match_result
| not (isExternalName (idName var))
= match_single_pat_var var ctx pat ty match_result
= matchSinglePatVar var ctx pat ty match_result
matchSinglePat scrut hs_ctx pat ty match_result
= do { var <- selectSimpleMatchVarL pat
; match_result' <- match_single_pat_var var hs_ctx pat ty match_result
; match_result' <- matchSinglePatVar var hs_ctx pat ty match_result
; return (adjustMatchResult (bindNonRec var scrut) match_result') }
match_single_pat_var :: Id -- See Note [Match Ids]
-> HsMatchContext Name -> LPat GhcTc
-> Type -> MatchResult -> DsM MatchResult
match_single_pat_var var ctx pat ty match_result
matchSinglePatVar :: Id -- See Note [Match Ids]
-> HsMatchContext Name -> LPat GhcTc
-> Type -> MatchResult -> DsM MatchResult
matchSinglePatVar var ctx pat ty match_result
= ASSERT2( isInternalName (idName var), ppr var )
do { dflags <- getDynFlags
; locn <- getSrcSpanDs
......
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