X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FdeSugar%2FMatchCon.lhs;h=5233d590373c50488132b36a07232505a35a5c09;hb=9f589efb688f22cb0637f9c1164dd9027b4378a3;hp=fd840e6f93b7c8e4402fa9dff89bbe788f24a134;hpb=f86fa5fd11a2847c6687ad84d579760a7a06eb8b;p=ghc-hetmet.git diff --git a/compiler/deSugar/MatchCon.lhs b/compiler/deSugar/MatchCon.lhs index fd840e6..5233d59 100644 --- a/compiler/deSugar/MatchCon.lhs +++ b/compiler/deSugar/MatchCon.lhs @@ -1,7 +1,9 @@ - +% +% (c) The University of Glasgow 2006 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 % -\section[MatchCon]{Pattern-matching constructors} + +Pattern-matching constructors \begin{code} module MatchCon ( matchConFamily ) where @@ -10,19 +12,17 @@ module MatchCon ( matchConFamily ) where import {-# SOURCE #-} Match ( match ) -import HsSyn ( Pat(..), LPat, HsConDetails(..) ) -import DsBinds ( dsLHsBinds ) -import DataCon ( DataCon, dataConInstOrigArgTys, dataConEqSpec, - dataConFieldLabels, dataConSourceArity ) -import TcType ( tcTyConAppArgs ) -import Type ( mkTyVarTys ) +import HsSyn +import DsBinds +import DataCon +import TcType +import Type import CoreSyn import DsMonad import DsUtils -import Id ( Id, idName ) -import Type ( Type ) -import SrcLoc ( unLoc, Located(..) ) +import Id +import SrcLoc import Outputable \end{code} @@ -132,7 +132,7 @@ conArgPats data_con arg_tys (RecCon rpats) -- mk_pat picks a WildPat of the appropriate type for absent fields, -- and the specified pattern for present fields mk_pat lbl arg_ty - = case [ pat | (sel_id,pat) <- rpats, idName (unLoc sel_id) == lbl] of + = case [ pat | HsRecField sel_id pat _ <- rpats, idName (unLoc sel_id) == lbl ] of (pat:pats) -> ASSERT( null pats ) unLoc pat [] -> WildPat arg_ty \end{code}