[project @ 2000-08-17 15:00:13 by simonmar]

unboxing strict fields, bug #1:

	desugaring a record pattern used the
	rep args rather than the original args when
	expanding the pattern into a ConPat.

diff --git a/ghc/compiler/basicTypes/DataCon.lhs b/ghc/compiler/basicTypes/DataCon.lhs
index be1cf56..0419228 100644 (file)
--- a/ghc/compiler/basicTypes/DataCon.lhs
+++ b/ghc/compiler/basicTypes/DataCon.lhs
@@ -9,7 +9,7 @@ module DataCon (
        ConTag, fIRST_TAG,
        mkDataCon,
        dataConRepType, dataConSig, dataConName, dataConTag, dataConTyCon,
-       dataConArgTys, dataConOrigArgTys,
+       dataConArgTys, dataConOrigArgTys, dataConInstOrigArgTys,
        dataConRepArgTys, dataConTheta,
        dataConFieldLabels, dataConStrictMarks, 
        dataConSourceArity, dataConRepArity,
@@ -28,7 +28,6 @@ module DataCon (
 import {-# SOURCE #-} Subst( substTy, mkTyVarSubst )
 
 import CmdLineOpts     ( opt_DictsStrict )
-import TysPrim
 import Type            ( Type, ThetaType, TauType, ClassContext,
                          mkForAllTys, mkFunTys, mkTyConApp, 
                          mkTyVarTys, mkDictTys,
@@ -46,7 +45,6 @@ import Outputable
 import Unique          ( Unique, Uniquable(..) )
 import CmdLineOpts     ( opt_UnboxStrictFields )
 import PprType         ()      -- Instances
-import UniqSet
 import Maybes          ( maybeToBool )
 import Maybe
 import Util            ( assoc )
@@ -357,7 +355,15 @@ dataConArgTys (MkData {dcRepArgTys = arg_tys, dcTyVars = tyvars,
                       dcExTyVars = ex_tyvars}) inst_tys
  = map (substTy (mkTyVarSubst (tyvars ++ ex_tyvars) inst_tys)) arg_tys
 
-dataConTheta (MkData {dcTheta = theta}) = theta
+dataConTheta :: DataCon -> ClassContext
+dataConTheta dc = dcTheta dc
+
+-- And the same deal for the original arg tys:
+
+dataConInstOrigArgTys :: DataCon -> [Type] -> [Type]
+dataConInstOrigArgTys (MkData {dcOrigArgTys = arg_tys, dcTyVars = tyvars, 
+                      dcExTyVars = ex_tyvars}) inst_tys
+ = map (substTy (mkTyVarSubst (tyvars ++ ex_tyvars) inst_tys)) arg_tys
 \end{code}
 
 These two functions get the real argument types of the constructor,

diff --git a/ghc/compiler/deSugar/Match.lhs b/ghc/compiler/deSugar/Match.lhs
index 9a18871..5fd2b0d 100644 (file)
--- a/ghc/compiler/deSugar/Match.lhs
+++ b/ghc/compiler/deSugar/Match.lhs
@@ -21,7 +21,7 @@ import DsMonad
 import DsGRHSs         ( dsGRHSs )
 import DsUtils
 import Id              ( idType, recordSelectorFieldLabel, Id )
-import DataCon         ( dataConFieldLabels, dataConArgTys )
+import DataCon         ( dataConFieldLabels, dataConInstOrigArgTys )
 import MatchCon                ( matchConFamily )
 import MatchLit                ( matchLiterals )
 import PrelInfo                ( pAT_ERROR_ID )
@@ -466,7 +466,7 @@ tidy1 v (RecPat data_con pat_ty ex_tvs dicts rpats) match_result
 
        -- Boring stuff to find the arg-tys of the constructor
     (_, inst_tys, _) = splitAlgTyConApp pat_ty
-    con_arg_tys'     = dataConArgTys data_con (inst_tys ++ mkTyVarTys ex_tvs)
+    con_arg_tys'     = dataConInstOrigArgTys data_con (inst_tys ++ mkTyVarTys ex_tvs)
     tagged_arg_tys   = con_arg_tys' `zip` (dataConFieldLabels data_con)
 
        -- mk_pat picks a WildPat of the appropriate type for absent fields,