Commit 8fceaa0d authored by Jonathan D.K. Gibbons's avatar Jonathan D.K. Gibbons

Address MR comments for change to NonEmpty lists in matching code.

parent 7840e900
Pipeline #14265 failed with stages
in 101 minutes and 51 seconds
......@@ -294,7 +294,7 @@ mkCoAlgCaseMatchResult
-> MatchResult
mkCoAlgCaseMatchResult var ty match_alts
| isNewtype -- Newtype case; use a let
= ASSERT( null (NEL.tail match_alts) && null (tail arg_ids1) )
= ASSERT( null match_alts_tail && null (tail arg_ids1) )
mkCoLetMatchResult (NonRec arg_id1 newtype_rhs) match_result1
| otherwise
......@@ -305,8 +305,8 @@ mkCoAlgCaseMatchResult var ty match_alts
-- [Interesting: because of GADTs, we can't rely on the type of
-- the scrutinised Id to be sufficiently refined to have a TyCon in it]
alt1@MkCaseAlt{ alt_bndrs = arg_ids1, alt_result = match_result1 }
= NEL.head match_alts
alt1@MkCaseAlt{ alt_bndrs = arg_ids1, alt_result = match_result1 } :| match_alts_tail
= match_alts
-- Stuff for newtype
arg_id1 = ASSERT( notNull arg_ids1 ) head arg_ids1
var_ty = idType var
......
......@@ -7,6 +7,7 @@ The @match@ function
-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE MonadComprehensions #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}
......@@ -163,18 +164,18 @@ See also Note [Localise pattern binders] in DsUtils
type MatchId = Id -- See Note [Match Ids]
match
:: [MatchId] -- ^ Variables rep\'ing the exprs we\'re matching with. See Note [Match Ids]
-> Type -- ^ Type of the case expression
-> [EquationInfo] -- ^ Info about patterns, etc. (type synonym below)
-> DsM MatchResult -- ^ Desugared result!
match :: [MatchId] -- ^ Variables rep\'ing the exprs we\'re matching with. See Note [Match Ids]
-> Type -- ^ Type of the case expression
-> [EquationInfo] -- ^ Info about patterns, etc. (type synonym below)
-> DsM MatchResult -- ^ Desugared result!
match [] ty eqns
= ASSERT2( not (null eqns), ppr ty )
return (foldr1 combineMatchResults match_results)
where
match_results = flip fmap eqns $ \eqn ->
ASSERT( null (eqn_pats eqn) ) (eqn_rhs eqn)
match_results = [ ASSERT( null (eqn_pats eqn) )
eqn_rhs eqn
| eqn <- eqns ]
match (v:vs) ty eqns -- Eqns *can* be empty
= ASSERT2( all (isInternalName . idName) vars, ppr vars )
......@@ -219,7 +220,7 @@ match (v:vs) ty eqns -- Eqns *can* be empty
where eqns' = NEL.toList eqns
ne l = case NEL.nonEmpty l of
Just nel -> nel
Nothing -> panic "Should be impossible since input was non-empty"
Nothing -> pprPanic "match match_group" $ text "Empty result should be impossible since input was non-empty"
-- FIXME: we should also warn about view patterns that should be
-- commoned up but are not
......@@ -896,7 +897,8 @@ groupEquations :: DynFlags -> [EquationInfo] -> [NonEmpty (PatGroup, EquationInf
-- (b) none of the gi are empty
-- The ordering of equations is unchanged
groupEquations dflags eqns
= NEL.groupBy same_gp $ flip fmap eqns $ \eqn -> (patGroup dflags (firstPat eqn), eqn)
= NEL.groupBy same_gp $ [(patGroup dflags (firstPat eqn), eqn) | eqn <- eqns]
-- comprehension on NonEmpty
where
same_gp :: (PatGroup,EquationInfo) -> (PatGroup,EquationInfo) -> Bool
(pg1,_) `same_gp` (pg2,_) = pg1 `sameGroup` pg2
......
......@@ -420,9 +420,9 @@ matchLiterals (var :| vars) ty sub_groups
}
where
match_group :: NonEmpty EquationInfo -> DsM (Literal, MatchResult)
match_group eqns
match_group eqns@(firstEqn :| _)
= do { dflags <- getDynFlags
; let LitPat _ hs_lit = firstPat (NEL.head eqns)
; let LitPat _ hs_lit = firstPat firstEqn
; match_result <- match vars ty (NEL.toList $ shiftEqns eqns)
; return (hsLitKey dflags hs_lit, match_result) }
......
......@@ -822,7 +822,7 @@ instance (Outputable a) => Outputable [a] where
ppr xs = brackets (fsep (punctuate comma (map ppr xs)))
instance (Outputable a) => Outputable (NonEmpty a) where
ppr xs = brackets (fsep (punctuate comma (map ppr $ NEL.toList xs)))
ppr = ppr . NEL.toList
instance (Outputable a) => Outputable (Set a) where
ppr s = braces (fsep (punctuate comma (map ppr (Set.toList s))))
......
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