summaryrefslogtreecommitdiff
path: root/compiler/deSugar/Check.hs
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/deSugar/Check.hs')
-rw-r--r--compiler/deSugar/Check.hs61
1 files changed, 30 insertions, 31 deletions
diff --git a/compiler/deSugar/Check.hs b/compiler/deSugar/Check.hs
index ae1de7716d..d49a5c3ab8 100644
--- a/compiler/deSugar/Check.hs
+++ b/compiler/deSugar/Check.hs
@@ -675,12 +675,12 @@ truePattern = nullaryConPattern (RealDataCon trueDataCon)
-- | A fake guard pattern (True <- _) used to represent cases we cannot handle
fake_pat :: Pattern
fake_pat = PmGrd { pm_grd_pv = [truePattern]
- , pm_grd_expr = PmExprOther (EWildPat noExt) }
+ , pm_grd_expr = PmExprOther EWildPat }
{-# INLINE fake_pat #-}
-- | Check whether a guard pattern is generated by the checker (unhandled)
isFakeGuard :: [Pattern] -> PmExpr -> Bool
-isFakeGuard [PmCon { pm_con_con = RealDataCon c }] (PmExprOther (EWildPat _))
+isFakeGuard [PmCon { pm_con_con = RealDataCon c }] (PmExprOther EWildPat)
| c == trueDataCon = True
| otherwise = False
isFakeGuard _pats _e = False
@@ -723,25 +723,25 @@ mkLitPattern lit = PmLit { pm_lit_lit = PmSLit lit }
translatePat :: FamInstEnvs -> Pat GhcTc -> DsM PatVec
translatePat fam_insts pat = case pat of
- WildPat ty -> mkPmVars [ty]
- VarPat _ id -> return [PmVar (unLoc id)]
- ParPat _ p -> translatePat fam_insts (unLoc p)
- LazyPat _ _ -> mkPmVars [hsPatType pat] -- like a variable
+ WildPat ty -> mkPmVars [ty]
+ VarPat id -> return [PmVar (unLoc id)]
+ ParPat p -> translatePat fam_insts (unLoc p)
+ LazyPat _ -> mkPmVars [hsPatType pat] -- like a variable
-- ignore strictness annotations for now
- BangPat _ p -> translatePat fam_insts (unLoc p)
+ BangPat p -> translatePat fam_insts (unLoc p)
- AsPat _ lid p -> do
+ AsPat lid p -> do
-- Note [Translating As Patterns]
ps <- translatePat fam_insts (unLoc p)
let [e] = map vaToPmExpr (coercePatVec ps)
g = PmGrd [PmVar (unLoc lid)] e
return (ps ++ [g])
- SigPat _ty p -> translatePat fam_insts (unLoc p)
+ SigPatOut p _ty -> translatePat fam_insts (unLoc p)
-- See Note [Translate CoPats]
- CoPat _ wrapper p ty
+ CoPat wrapper p ty
| isIdHsWrapper wrapper -> translatePat fam_insts p
| WpCast co <- wrapper, isReflexiveCo co -> translatePat fam_insts p
| otherwise -> do
@@ -751,26 +751,26 @@ translatePat fam_insts pat = case pat of
return [xp,g]
-- (n + k) ===> x (True <- x >= k) (n <- x-k)
- NPlusKPat ty (L _ _n) _k1 _k2 _ge _minus -> mkCanFailPmPat ty
+ NPlusKPat (L _ _n) _k1 _k2 _ge _minus ty -> mkCanFailPmPat ty
-- (fun -> pat) ===> x (pat <- fun x)
- ViewPat arg_ty lexpr lpat -> do
+ ViewPat lexpr lpat arg_ty -> do
ps <- translatePat fam_insts (unLoc lpat)
-- See Note [Guards and Approximation]
case all cantFailPattern ps of
True -> do
(xp,xe) <- mkPmId2Forms arg_ty
- let g = mkGuard ps (HsApp noExt lexpr xe)
+ let g = mkGuard ps (HsApp lexpr xe)
return [xp,g]
False -> mkCanFailPmPat arg_ty
-- list
- ListPat _ ps ty Nothing -> do
+ ListPat ps ty Nothing -> do
foldr (mkListPatVec ty) [nilPattern ty]
<$> translatePatVec fam_insts (map unLoc ps)
-- overloaded list
- ListPat x lpats elem_ty (Just (pat_ty, _to_list))
+ ListPat lpats elem_ty (Just (pat_ty, _to_list))
| Just e_ty <- splitListTyConApp_maybe pat_ty
, (_, norm_elem_ty) <- normaliseType fam_insts Nominal elem_ty
-- elem_ty is frequently something like
@@ -779,7 +779,7 @@ translatePat fam_insts pat = case pat of
-- We have to ensure that the element types are exactly the same.
-- Otherwise, one may give an instance IsList [Int] (more specific than
-- the default IsList [a]) with a different implementation for `toList'
- translatePat fam_insts (ListPat x lpats e_ty Nothing)
+ translatePat fam_insts (ListPat lpats e_ty Nothing)
-- See Note [Guards and Approximation]
| otherwise -> mkCanFailPmPat pat_ty
@@ -799,27 +799,26 @@ translatePat fam_insts pat = case pat of
, pm_con_dicts = dicts
, pm_con_args = args }]
- NPat ty (L _ ol) mb_neg _eq -> translateNPat fam_insts ol mb_neg ty
+ NPat (L _ ol) mb_neg _eq ty -> translateNPat fam_insts ol mb_neg ty
- LitPat _ lit
+ LitPat lit
-- If it is a string then convert it to a list of characters
| HsString src s <- lit ->
foldr (mkListPatVec charTy) [nilPattern charTy] <$>
- translatePatVec fam_insts
- (map (LitPat noExt . HsChar src) (unpackFS s))
+ translatePatVec fam_insts (map (LitPat . HsChar src) (unpackFS s))
| otherwise -> return [mkLitPattern lit]
- PArrPat ty ps -> do
+ PArrPat ps ty -> do
tidy_ps <- translatePatVec fam_insts (map unLoc ps)
let fake_con = RealDataCon (parrFakeCon (length ps))
return [vanillaConPattern fake_con [ty] (concat tidy_ps)]
- TuplePat tys ps boxity -> do
+ TuplePat ps boxity tys -> do
tidy_ps <- translatePatVec fam_insts (map unLoc ps)
let tuple_con = RealDataCon (tupleDataCon boxity (length ps))
return [vanillaConPattern tuple_con tys (concat tidy_ps)]
- SumPat ty p alt arity -> do
+ SumPat p alt arity ty -> do
tidy_p <- translatePat fam_insts (unLoc p)
let sum_con = RealDataCon (sumDataCon alt arity)
return [vanillaConPattern sum_con ty tidy_p]
@@ -828,23 +827,23 @@ translatePat fam_insts pat = case pat of
-- Not supposed to happen
ConPatIn {} -> panic "Check.translatePat: ConPatIn"
SplicePat {} -> panic "Check.translatePat: SplicePat"
- XPat {} -> panic "Check.translatePat: XPat"
+ SigPatIn {} -> panic "Check.translatePat: SigPatIn"
-- | Translate an overloaded literal (see `tidyNPat' in deSugar/MatchLit.hs)
translateNPat :: FamInstEnvs
-> HsOverLit GhcTc -> Maybe (SyntaxExpr GhcTc) -> Type
-> DsM PatVec
-translateNPat fam_insts (OverLit (OverLitTc False ty) val _ ) mb_neg outer_ty
+translateNPat fam_insts (OverLit val False _ ty) mb_neg outer_ty
| not type_change, isStringTy ty, HsIsString src s <- val, Nothing <- mb_neg
- = translatePat fam_insts (LitPat noExt (HsString src s))
+ = translatePat fam_insts (LitPat (HsString src s))
| not type_change, isIntTy ty, HsIntegral i <- val
= translatePat fam_insts
- (LitPat noExt $ case mb_neg of
- Nothing -> HsInt noExt i
- Just _ -> HsInt noExt (negateIntegralLit i))
+ (LitPat $ case mb_neg of
+ Nothing -> HsInt def i
+ Just _ -> HsInt def (negateIntegralLit i))
| not type_change, isWordTy ty, HsIntegral i <- val
= translatePat fam_insts
- (LitPat noExt $ case mb_neg of
+ (LitPat $ case mb_neg of
Nothing -> HsWordPrim (il_text i) (il_value i)
Just _ -> let ni = negateIntegralLit i in
HsWordPrim (il_text ni) (il_value ni))
@@ -1217,7 +1216,7 @@ mkPmId ty = getUniqueM >>= \unique ->
mkPmId2Forms :: Type -> DsM (Pattern, LHsExpr GhcTc)
mkPmId2Forms ty = do
x <- mkPmId ty
- return (PmVar x, noLoc (HsVar noExt (noLoc x)))
+ return (PmVar x, noLoc (HsVar (noLoc x)))
-- ----------------------------------------------------------------------------
-- * Converting between Value Abstractions, Patterns and PmExpr
View Lorry Controller Status