Commit 74b27e20 authored by David Himmelstrup's avatar David Himmelstrup
Browse files

Remove the unused HsExpr constructor DictPat

parent 00b6d256
......@@ -608,7 +608,7 @@ has_nplusk_pat (PArrPat ps _) = any has_nplusk_lpat ps
has_nplusk_pat (LazyPat p) = False -- Why?
has_nplusk_pat (BangPat p) = has_nplusk_lpat p -- I think
has_nplusk_pat (ConPatOut { pat_args = ps }) = any has_nplusk_lpat (hsConArgs ps)
has_nplusk_pat p = False -- VarPat, VarPatOut, WildPat, LitPat, NPat, TypePat, DictPat
has_nplusk_pat p = False -- VarPat, VarPatOut, WildPat, LitPat, NPat, TypePat
simplify_lpat :: LPat Id -> LPat Id
simplify_lpat p = fmap simplify_pat p
......@@ -661,15 +661,6 @@ simplify_pat (NPat lit mb_neg eq lit_ty) = tidyNPat lit mb_neg eq lit_ty
simplify_pat (NPlusKPat id hslit hsexpr1 hsexpr2)
= WildPat (idType (unLoc id))
simplify_pat (DictPat dicts methods)
= case num_of_d_and_ms of
0 -> simplify_pat (TuplePat [] Boxed unitTy)
1 -> simplify_pat (head dict_and_method_pats)
_ -> simplify_pat (mkVanillaTuplePat (map noLoc dict_and_method_pats) Boxed)
where
num_of_d_and_ms = length dicts + length methods
dict_and_method_pats = map VarPat (dicts ++ methods)
simplify_pat (CoPat co pat ty) = simplify_pat pat
-----------------
......
......@@ -447,15 +447,6 @@ tidy1 v (TuplePat pats boxity ty)
arity = length pats
tuple_ConPat = mkPrefixConPat (tupleCon boxity arity) pats ty
tidy1 v (DictPat dicts methods)
= case num_of_d_and_ms of
0 -> tidy1 v (TuplePat [] Boxed unitTy)
1 -> tidy1 v (unLoc (head dict_and_method_pats))
_ -> tidy1 v (mkVanillaTuplePat dict_and_method_pats Boxed)
where
num_of_d_and_ms = length dicts + length methods
dict_and_method_pats = map nlVarPat (dicts ++ methods)
-- LitPats: we *might* be able to replace these w/ a simpler form
tidy1 v (LitPat lit)
= returnDs (idDsWrapper, tidyLitPat lit)
......
......@@ -125,11 +125,6 @@ data Pat id
| SigPatOut (LPat id) -- Pattern with a type signature
Type
------------ Dictionary patterns (translation only) ---------------
| DictPat -- Used when destructing Dictionaries with an explicit case
[id] -- Superclass dicts
[id] -- Methods
------------ Pattern coercions (translation only) ---------------
| CoPat HsWrapper -- If co::t1 -> t2, p::t2,
-- then (CoPat co p) :: t1
......@@ -211,9 +206,6 @@ pprPat (TypePat ty) = ptext SLIT("{|") <> ppr ty <> ptext SLIT("|}")
pprPat (CoPat co pat _) = parens (pprHsWrapper (ppr pat) co)
pprPat (SigPatIn pat ty) = ppr pat <+> dcolon <+> ppr ty
pprPat (SigPatOut pat ty) = ppr pat <+> dcolon <+> ppr ty
pprPat (DictPat ds ms) = parens (sep [ptext SLIT("{-dict-}"),
brackets (interpp'SP ds),
brackets (interpp'SP ms)])
pprUserCon c (InfixCon p1 p2) = ppr p1 <+> ppr c <+> ppr p2
pprUserCon c details = ppr c <+> pprConArgs details
......@@ -305,7 +297,6 @@ isConPat (ConPatOut {}) = True
isConPat (ListPat {}) = True
isConPat (PArrPat {}) = True
isConPat (TuplePat {}) = True
isConPat (DictPat ds ms) = (length ds + length ms) > 1
isConPat other = False
isSigPat (SigPatIn _ _) = True
......@@ -359,6 +350,5 @@ isIrrefutableHsPat pat
go1 (NPlusKPat _ _ _ _) = False
go1 (TypePat _) = panic "isIrrefutableHsPat: type pattern"
go1 (DictPat _ _) = panic "isIrrefutableHsPat: type pattern"
\end{code}
......@@ -393,8 +393,6 @@ collectl (L l pat) bndrs
go (SigPatIn pat _) = collectl pat bndrs
go (SigPatOut pat _) = collectl pat bndrs
go (TypePat ty) = bndrs
go (DictPat ids1 ids2) = map noLoc ids1 ++ map noLoc ids2
++ bndrs
go (CoPat _ pat ty) = collectl (noLoc pat) bndrs
\end{code}
......
......@@ -86,11 +86,6 @@ hsPatType (SigPatOut pat ty) = ty
hsPatType (NPat lit _ _ ty) = ty
hsPatType (NPlusKPat id _ _ _) = idType (unLoc id)
hsPatType (CoPat _ _ ty) = ty
hsPatType (DictPat ds ms) = case (ds ++ ms) of
[] -> unitTy
[d] -> idType d
ds -> mkTupleTy Boxed (length ds) (map idType ds)
hsLitType :: HsLit -> TcType
hsLitType (HsChar c) = charTy
......@@ -751,11 +746,6 @@ zonk_pat env (NPlusKPat (L loc n) lit e1 e2)
; e2' <- zonkExpr env e2
; return (extendZonkEnv1 env n', NPlusKPat (L loc n') lit' e1' e2') }
zonk_pat env (DictPat ds ms)
= do { ds' <- zonkIdBndrs env ds
; ms' <- zonkIdBndrs env ms
; return (extendZonkEnv env (ds' ++ ms'), DictPat ds' ms') }
zonk_pat env (CoPat co_fn pat ty)
= do { (env', co_fn') <- zonkCoFn env co_fn
; (env'', pat') <- zonkPat env' (noLoc pat)
......
......@@ -471,7 +471,7 @@ tc_pat pstate pat@(NPlusKPat (L nm_loc name) lit ge minus) pat_ty thing_inside
; res <- tcExtendIdEnv1 name bndr_id (thing_inside pstate)
; returnM (NPlusKPat (L nm_loc bndr_id) lit' ge' minus', [], res) }
tc_pat _ _other_pat _ _ = panic "tc_pat" -- DictPat, ConPatOut, SigPatOut, VarPatOut
tc_pat _ _other_pat _ _ = panic "tc_pat" -- ConPatOut, SigPatOut, VarPatOut
\end{code}
......
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