Commit 29e736b7 authored by chak@cse.unsw.edu.au.'s avatar chak@cse.unsw.edu.au.
Browse files

Fix problem with selectors for GADT records with unboxed fields

Mon Sep 18 17:13:11 EDT 2006  Manuel M T Chakravarty <chak@cse.unsw.edu.au>
  * Fix problem with selectors for GADT records with unboxed fields
  Sun Aug  6 20:47:11 EDT 2006  Manuel M T Chakravarty <chak@cse.unsw.edu.au>
    * Fix problem with selectors for GADT records with unboxed fields
    Wed Aug  2 05:37:38 EDT 2006  kevind@bu.edu
parent a7bda9e6
......@@ -59,7 +59,7 @@ import TcType ( Type, ThetaType, mkDictTy, mkPredTys, mkPredTy,
isUnLiftedType, mkForAllTys, mkTyVarTy, tyVarsOfType,
tcSplitFunTys, tcSplitForAllTys, dataConsStupidTheta
)
import CoreUtils ( exprType, dataConInstPat )
import CoreUtils ( exprType, dataConOrigInstPat )
import CoreUnfold ( mkTopUnfolding, mkCompulsoryUnfolding )
import Literal ( nullAddrLit, mkStringLit )
import TyCon ( TyCon, isNewTyCon, tyConDataCons, FieldLabel,
......@@ -563,7 +563,7 @@ mkRecordSelId tycon field_label
-- in the types of the arguments of the pattern
= (ex_tvs ++ co_tvs ++ dict_vs, field_vs)
(ex_tvs, co_tvs, arg_vs) = dataConInstPat uniqs' data_con res_tys
(ex_tvs, co_tvs, arg_vs) = dataConOrigInstPat uniqs' data_con res_tys
(dict_vs, field_vs) = splitAt (length dc_theta) arg_vs
(_, pre_dc_theta, dc_arg_tys) = dataConSig data_con
......
......@@ -33,7 +33,7 @@ module CoreUtils (
-- Equality
cheapEqExpr, tcEqExpr, tcEqExprX, applyTypeToArgs, applyTypeToArg,
dataConInstPat, dataConOccInstPat
dataConOrigInstPat, dataConRepInstPat, dataConRepOccInstPat
) where
#include "HsVersions.h"
......@@ -57,7 +57,8 @@ import Literal ( hashLiteral, literalType, litIsDupable,
litIsTrivial, isZeroLit, Literal( MachLabel ) )
import DataCon ( DataCon, dataConRepArity, eqSpecPreds,
isVanillaDataCon, dataConTyCon, dataConRepArgTys,
dataConUnivTyVars, dataConExTyVars, dataConEqSpec )
dataConUnivTyVars, dataConExTyVars, dataConEqSpec,
dataConOrigArgTys )
import PrimOp ( PrimOp(..), primOpOkForSpeculation, primOpIsCheap )
import Id ( Id, idType, globalIdDetails, idNewStrictness,
mkWildId, idArity, idName, idUnfolding, idInfo,
......@@ -679,8 +680,13 @@ deepCast ty tyVars co
-- coArgs = [right (left (left co)), right (left co), right co]
coArgs = decomposeCo (length tyVars) co
-- This goes here to avoid circularity between DataCon and Id
dataConInstPat :: [Unique] -- A long enough list of uniques, at least one for each binder
-- These InstPat functions go here to avoid circularity between DataCon and Id
dataConOrigInstPat = dataConInstPat dataConOrigArgTys
dataConRepInstPat = dataConInstPat dataConRepArgTys
dataConRepOccInstPat = dataConOccInstPat dataConRepArgTys
dataConInstPat :: (DataCon -> [Type]) -- function used to find arg tys
-> [Unique] -- A long enough list of uniques, at least one for each binder
-> DataCon
-> [Type] -- Types to instantiate the universally quantified tyvars
-> ([TyVar], [CoVar], [Id]) -- Return instantiated variables
......@@ -710,8 +716,8 @@ dataConInstPat :: [Unique] -- A long enough list of uniques, at
-- ([a1'', a2'', b''],[c :: (a1',a2'):=:(a1'',a2'')],[x :: Int,y :: b''])
--
-- where the double-primed variables are created from the unique list input
dataConInstPat uniqs con inst_tys
= dataConOccInstPat uniqs occs con inst_tys
dataConInstPat arg_fun uniqs con inst_tys
= dataConOccInstPat arg_fun uniqs occs con inst_tys
where
-- dataConOccInstPat doesn't actually make use of the OccName directly for
-- existential and coercion variable binders, so it is right to just
......@@ -719,7 +725,8 @@ dataConInstPat uniqs con inst_tys
occs = mk_occs 1
mk_occs n = mkVarOcc ("ipv" ++ show n) : mk_occs (n+1)
dataConOccInstPat :: [Unique] -- A long enough list of uniques, at least one for each binder
dataConOccInstPat :: (DataCon -> [Type]) -- function used to find arg tys
-> [Unique] -- A long enough list of uniques, at least one for each binder
-> [OccName] -- An equally long list of OccNames to use
-> DataCon
-> [Type] -- Types to instantiate the universally quantified tyvars
......@@ -727,12 +734,12 @@ dataConOccInstPat :: [Unique] -- A long enough list of uniques,
-- This function actually does the job specified in the comment for
-- dataConInstPat, but uses the specified list of OccNames. This is
-- is necessary for use in e.g. tcIfaceDataAlt
dataConOccInstPat uniqs occs con inst_tys
dataConOccInstPat arg_fun uniqs occs con inst_tys
= (ex_bndrs, co_bndrs, id_bndrs)
where
univ_tvs = dataConUnivTyVars con
ex_tvs = dataConExTyVars con
arg_tys = dataConRepArgTys con
arg_tys = arg_fun con
eq_spec = dataConEqSpec con
eq_preds = eqSpecPreds eq_spec
......@@ -1161,8 +1168,7 @@ eta_expand n us expr ty
Lam lam_tv (eta_expand n us2 (App expr (Type (mkTyVarTy lam_tv))) (substTyWith [tv] [mkTyVarTy lam_tv] ty'))
where
lam_tv = mkTyVar (mkSysTvName uniq FSLIT("etaT")) (tyVarKind tv)
(uniq:us2) = us
(uniq:us2) = us
; Nothing ->
case splitFunTy_maybe ty of {
......
......@@ -35,7 +35,7 @@ import HscTypes ( ExternalPackageState(..),
emptyModDetails, lookupTypeEnv, lookupType, typeEnvIds )
import InstEnv ( Instance(..), mkImportedInstance )
import CoreSyn
import CoreUtils ( exprType, dataConOccInstPat )
import CoreUtils ( exprType, dataConRepOccInstPat )
import CoreUnfold
import CoreLint ( lintUnfolding )
import WorkWrap ( mkWrapper )
......
......@@ -45,7 +45,7 @@ import CoreUtils ( exprIsDupable, exprIsTrivial, needsCaseBinding,
exprType, exprIsHNF, findDefault, mergeAlts,
exprOkForSpeculation, exprArity,
mkCoerce, mkSCC, mkInlineMe, applyTypeToArg,
dataConInstPat
dataConRepInstPat
)
import Rules ( lookupRule )
import BasicTypes ( isMarkedStrict )
......@@ -1555,7 +1555,7 @@ simplDefault env case_bndr' imposs_cons cont (Just rhs)
do { tick (FillInCaseDefault case_bndr')
; us <- getUniquesSmpl
; let (ex_tvs, co_tvs, arg_ids) =
dataConInstPat us con inst_tys
dataConRepInstPat us con inst_tys
; let con_alt = (DataAlt con, ex_tvs ++ co_tvs ++ arg_ids, rhs)
; Just (_, alt') <- simplAlt env [] case_bndr' cont con_alt
-- The simplAlt must succeed with Just because we have
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment