projects
/
ghc-hetmet.git
/ commitdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
| commitdiff |
tree
raw
|
patch
|
inline
| side by side (parent:
281fbc8
)
Fixed warnings in deSugar/MatchCon, except for incomplete pattern matches
author
Twan van Laarhoven
<twanvl@gmail.com>
Sun, 3 Feb 2008 21:04:02 +0000
(21:04 +0000)
committer
Twan van Laarhoven
<twanvl@gmail.com>
Sun, 3 Feb 2008 21:04:02 +0000
(21:04 +0000)
compiler/deSugar/MatchCon.lhs
patch
|
blob
|
history
diff --git
a/compiler/deSugar/MatchCon.lhs
b/compiler/deSugar/MatchCon.lhs
index
8a8e49c
..
3baa966
100644
(file)
--- a/
compiler/deSugar/MatchCon.lhs
+++ b/
compiler/deSugar/MatchCon.lhs
@@
-6,7
+6,7
@@
Pattern-matching constructors
\begin{code}
Pattern-matching constructors
\begin{code}
-{-# OPTIONS -w #-}
+{-# OPTIONS -fno-warn-incomplete-patterns #-}
-- The above warning supression flag is a temporary kludge.
-- While working on this module you are encouraged to remove it and fix
-- any warnings in the module. See
-- The above warning supression flag is a temporary kludge.
-- While working on this module you are encouraged to remove it and fix
-- any warnings in the module. See
@@
-15,6
+15,8
@@
Pattern-matching constructors
module MatchCon ( matchConFamily ) where
module MatchCon ( matchConFamily ) where
+-- XXX This define is a bit of a hack, and should be done more nicely
+#define FAST_STRING_NOT_NEEDED 1
#include "HsVersions.h"
import {-# SOURCE #-} Match ( match )
#include "HsVersions.h"
import {-# SOURCE #-} Match ( match )
@@
-29,6
+31,7
@@
import DsMonad
import DsUtils
import Util ( takeList )
import Id
import DsUtils
import Util ( takeList )
import Id
+import Var (TyVar)
import SrcLoc
import Outputable
\end{code}
import SrcLoc
import Outputable
\end{code}
@@
-93,6
+96,10
@@
matchConFamily (var:vars) ty groups
= do { alts <- mapM (matchOneCon vars ty) groups
; return (mkCoAlgCaseMatchResult var ty alts) }
= do { alts <- mapM (matchOneCon vars ty) groups
; return (mkCoAlgCaseMatchResult var ty alts) }
+matchOneCon :: [Id]
+ -> Type
+ -> [EquationInfo]
+ -> DsM (DataCon, [TyVar], MatchResult)
matchOneCon vars ty (eqn1 : eqns) -- All eqns for a single constructor
= do { (wraps, eqns') <- mapAndUnzipM shift (eqn1:eqns)
; arg_vars <- selectMatchVars (take (dataConSourceArity con1)
matchOneCon vars ty (eqn1 : eqns) -- All eqns for a single constructor
= do { (wraps, eqns') <- mapAndUnzipM shift (eqn1:eqns)
; arg_vars <- selectMatchVars (take (dataConSourceArity con1)
@@
-128,9
+135,9
@@
conArgPats :: DataCon
-- are probably never looked at anyway
-> HsConDetails (LPat Id) (HsRecFields Id (LPat Id))
-> [Pat Id]
-- are probably never looked at anyway
-> HsConDetails (LPat Id) (HsRecFields Id (LPat Id))
-> [Pat Id]
-conArgPats data_con arg_tys (PrefixCon ps) = map unLoc ps
-conArgPats data_con arg_tys (InfixCon p1 p2) = [unLoc p1, unLoc p2]
-conArgPats data_con arg_tys (RecCon (HsRecFields rpats _))
+conArgPats _data_con _arg_tys (PrefixCon ps) = map unLoc ps
+conArgPats _data_con _arg_tys (InfixCon p1 p2) = [unLoc p1, unLoc p2]
+conArgPats data_con arg_tys (RecCon (HsRecFields rpats _))
| null rpats
= -- Special case for C {}, which can be used for
-- a constructor that isn't declared to have
| null rpats
= -- Special case for C {}, which can be used for
-- a constructor that isn't declared to have