Module header tidyup, phase 1

[ghc-hetmet.git] / compiler / deSugar / Check.lhs

diff --git a/compiler/deSugar/Check.lhs b/compiler/deSugar/Check.lhs
index 0b2dc08..15fcf39 100644 (file)
--- a/compiler/deSugar/Check.lhs
+++ b/compiler/deSugar/Check.lhs
@@ -1,36 +1,31 @@
 %
+% (c) The University of Glasgow 2006
 % (c) The GRASP/AQUA Project, Glasgow University, 1997-1998
 %
 % Author: Juan J. Quintela    <quintela@krilin.dc.fi.udc.es>
-\section{Module @Check@ in @deSugar@}
 
 \begin{code}
-
-
 module Check ( check , ExhaustivePat ) where
 
+#include "HsVersions.h"
 
 import HsSyn           
-import TcHsSyn         ( hsLPatType, mkVanillaTuplePat )
-import TcType          ( tcTyConAppTyCon )
-import DsUtils         ( EquationInfo(..), MatchResult(..), 
-                         CanItFail(..), firstPat )
-import MatchLit                ( tidyLitPat, tidyNPat )
-import Id              ( Id, idType )
-import DataCon         ( DataCon, dataConTyCon, dataConOrigArgTys, dataConFieldLabels )
-import Name             ( Name, mkInternalName, getOccName, isDataSymOcc,
-                         getName, mkVarOccFS )
+import TcHsSyn
+import TcType
+import DsUtils
+import MatchLit
+import Id
+import DataCon
+import Name
 import TysWiredIn
-import PrelNames       ( unboundKey )
-import TyCon            ( tyConDataCons, tupleTyConBoxity, isTupleTyCon )
-import BasicTypes      ( Boxity(..) )
-import SrcLoc          ( noSrcLoc, Located(..), unLoc, noLoc )
+import PrelNames
+import TyCon
+import BasicTypes
+import SrcLoc
 import UniqSet
-import Util             ( takeList, splitAtList, notNull )
+import Util
 import Outputable
 import FastString
-
-#include "HsVersions.h"
 \end{code}
 
 This module performs checks about if one list of equations are:
@@ -151,7 +146,7 @@ untidy b (L loc p) = L loc (untidy' b p)
 
 untidy_con (PrefixCon pats) = PrefixCon (map untidy_pars pats) 
 untidy_con (InfixCon p1 p2) = InfixCon  (untidy_pars p1) (untidy_pars p2)
-untidy_con (RecCon bs)      = RecCon    [(f,untidy_pars p) | (f,p) <- bs]
+untidy_con (RecCon bs)      = RecCon    [ HsRecField f (untidy_pars p) d | HsRecField f p d <- bs ]
 
 pars :: NeedPars -> WarningPat -> Pat Name
 pars True p = ParPat p
@@ -438,12 +433,12 @@ mb_neg (Just _) v = -v
 get_unused_cons :: [Pat Id] -> [DataCon]
 get_unused_cons used_cons = unused_cons
      where
-       (ConPatOut { pat_ty = ty }) = head used_cons
-       ty_con                = tcTyConAppTyCon ty              -- Newtype observable
-       all_cons                      = tyConDataCons ty_con
-       used_cons_as_id               = map (\ (ConPatOut{ pat_con = L _ d}) -> d) used_cons
-       unused_cons                   = uniqSetToList
-                (mkUniqSet all_cons `minusUniqSet` mkUniqSet used_cons_as_id) 
+       (ConPatOut { pat_con = l_con, pat_ty = ty }) = head used_cons
+       ty_con         = dataConTyCon (unLoc l_con)     -- Newtype observable
+       all_cons        = tyConDataCons ty_con
+       used_cons_as_id = map (\ (ConPatOut{ pat_con = L _ d}) -> d) used_cons
+       unused_cons     = uniqSetToList
+                        (mkUniqSet all_cons `minusUniqSet` mkUniqSet used_cons_as_id) 
 
 all_vars :: [Pat Id] -> Bool
 all_vars []             = True
@@ -623,7 +618,7 @@ simplify_pat pat@(WildPat gt) = pat
 simplify_pat (VarPat id)      = WildPat (idType id) 
 simplify_pat (VarPatOut id _) = WildPat (idType id)    -- Ignore the bindings
 simplify_pat (ParPat p)       = unLoc (simplify_lpat p)
-simplify_pat (LazyPat p)      = WildPat (hsPatType p)  -- For overlap and exhaustiveness checking
+simplify_pat (LazyPat p)      = WildPat (hsLPatType p) -- For overlap and exhaustiveness checking
                                                        -- purposes, a ~pat is like a wildcard
 simplify_pat (BangPat p)      = unLoc (simplify_lpat p)
 simplify_pat (AsPat id p)     = unLoc (simplify_lpat p)
@@ -675,6 +670,8 @@ simplify_pat (DictPat dicts methods)
        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 
+
 -----------------
 simplify_con con (PrefixCon ps)   = PrefixCon (map simplify_lpat ps)
 simplify_con con (InfixCon p1 p2) = PrefixCon [simplify_lpat p1, simplify_lpat p2]
@@ -685,7 +682,7 @@ simplify_con con (RecCon fs)
   where
      -- pad out all the missing fields with WildPats.
     field_pats = map (\ f -> (f, nlWildPat)) (dataConFieldLabels con)
-    all_pats = foldr (\ (id,p) acc -> insertNm (getName (unLoc id)) p acc)
+    all_pats = foldr (\(HsRecField id p _) acc -> insertNm (getName (unLoc id)) p acc)
                     field_pats fs
        
     insertNm nm p [] = [(nm,p)]