Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
GHC
Commits
74b27e20
Commit
74b27e20
authored
Jun 18, 2007
by
David Himmelstrup
Browse files
Remove the unused HsExpr constructor DictPat
parent
00b6d256
Changes
6
Hide whitespace changes
Inline
Side-by-side
compiler/deSugar/Check.lhs
View file @
74b27e20
...
...
@@ -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
-----------------
...
...
compiler/deSugar/Match.lhs
View file @
74b27e20
...
...
@@ -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)
...
...
compiler/hsSyn/HsPat.lhs
View file @
74b27e20
...
...
@@ -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}
compiler/hsSyn/HsUtils.lhs
View file @
74b27e20
...
...
@@ -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}
...
...
compiler/typecheck/TcHsSyn.lhs
View file @
74b27e20
...
...
@@ -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)
...
...
compiler/typecheck/TcPat.lhs
View file @
74b27e20
...
...
@@ -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}
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment