From 247fd64109002ed88c27bc5d6cfea6a71ee48cfa Mon Sep 17 00:00:00 2001 From: Manuel M T Chakravarty Date: Wed, 20 Sep 2006 17:59:18 +0000 Subject: [PATCH] Minor tidying up Mon Sep 18 17:08:30 EDT 2006 Manuel M T Chakravarty * Minor tidying up Sun Aug 6 20:30:11 EDT 2006 Manuel M T Chakravarty * Minor tidying up Tue Aug 1 08:51:40 EDT 2006 simonpj@microsoft.com --- compiler/basicTypes/DataCon.lhs | 4 ++-- compiler/basicTypes/MkId.lhs | 1 + compiler/coreSyn/CoreUtils.lhs | 6 +++--- compiler/coreSyn/PprCore.lhs | 2 +- compiler/hsSyn/HsBinds.lhs | 2 +- compiler/hsSyn/HsPat.lhs | 10 ++++++---- 6 files changed, 14 insertions(+), 11 deletions(-) diff --git a/compiler/basicTypes/DataCon.lhs b/compiler/basicTypes/DataCon.lhs index 5da66d9..af75ec9 100644 --- a/compiler/basicTypes/DataCon.lhs +++ b/compiler/basicTypes/DataCon.lhs @@ -11,7 +11,7 @@ module DataCon ( dataConRepType, dataConSig, dataConFullSig, dataConName, dataConTag, dataConTyCon, dataConUserType, dataConUnivTyVars, dataConExTyVars, dataConAllTyVars, dataConResTys, - dataConEqSpec, dataConTheta, dataConStupidTheta, + dataConEqSpec, eqSpecPreds, dataConTheta, dataConStupidTheta, dataConInstArgTys, dataConOrigArgTys, dataConInstOrigArgTys, dataConRepArgTys, dataConFieldLabels, dataConFieldType, @@ -32,7 +32,7 @@ module DataCon ( import Type ( Type, ThetaType, substTyWith, substTyVar, mkTopTvSubst, mkForAllTys, mkFunTys, mkTyConApp, mkTyVarTy, mkTyVarTys, - splitTyConApp_maybe, newTyConInstRhs, + splitTyConApp_maybe, newTyConInstRhs, mkPredTys, isStrictPred, pprType, mkPredTy ) import Coercion ( isEqPred, mkEqPred ) diff --git a/compiler/basicTypes/MkId.lhs b/compiler/basicTypes/MkId.lhs index fe05a9b..4609959 100644 --- a/compiler/basicTypes/MkId.lhs +++ b/compiler/basicTypes/MkId.lhs @@ -555,6 +555,7 @@ mkRecordSelId tycon field_label -- the context stuff; hence the arg_prefix binding below mkReboxingAlt uniqs data_con (arg_prefix ++ arg_ids) rhs where + -- TODO: this is *not* right; Orig vs Rep tys (arg_prefix, arg_ids) | isVanillaDataCon data_con -- Instantiate from commmon base = ([], mkTemplateLocalsNum arg_base (dataConInstOrigArgTys data_con res_tys)) diff --git a/compiler/coreSyn/CoreUtils.lhs b/compiler/coreSyn/CoreUtils.lhs index 1bd0acd..b5ba2a2 100644 --- a/compiler/coreSyn/CoreUtils.lhs +++ b/compiler/coreSyn/CoreUtils.lhs @@ -55,7 +55,7 @@ import Packages ( isDllName ) #endif import Literal ( hashLiteral, literalType, litIsDupable, litIsTrivial, isZeroLit, Literal( MachLabel ) ) -import DataCon ( DataCon, dataConRepArity, +import DataCon ( DataCon, dataConRepArity, eqSpecPreds, isVanillaDataCon, dataConTyCon, dataConRepArgTys, dataConUnivTyVars, dataConExTyVars, dataConEqSpec ) import PrimOp ( PrimOp(..), primOpOkForSpeculation, primOpIsCheap ) @@ -734,7 +734,7 @@ dataConOccInstPat uniqs occs con inst_tys ex_tvs = dataConExTyVars con arg_tys = dataConRepArgTys con eq_spec = dataConEqSpec con - eq_preds = [ mkEqPred (mkTyVarTy tv, ty) | (tv,ty) <- eq_spec ] + eq_preds = eqSpecPreds eq_spec n_ex = length ex_tvs n_co = length eq_spec @@ -763,7 +763,7 @@ dataConOccInstPat uniqs occs con inst_tys where new_name = mkSysTvName uniq (occNameFS occ) - co_bndrs = zipWith3 mk_co_var co_uniqs co_occs eq_preds + co_bndrs = zipWith3 mk_co_var co_uniqs co_occs eq_preds -- make value vars, instantiating types mk_id_var uniq occ ty = mkUserLocal occ uniq (inst_subst ty) noSrcLoc diff --git a/compiler/coreSyn/PprCore.lhs b/compiler/coreSyn/PprCore.lhs index 2d24aa0..fd46c41 100644 --- a/compiler/coreSyn/PprCore.lhs +++ b/compiler/coreSyn/PprCore.lhs @@ -242,7 +242,7 @@ ppr_case_pat con@(DataAlt dc) args tc = dataConTyCon dc ppr_case_pat con args - = ppr con <+> hsep (map ppr_bndr args) <+> arrow + = ppr con <+> sep (map ppr_bndr args) <+> arrow where ppr_bndr = pprBndr CaseBind diff --git a/compiler/hsSyn/HsBinds.lhs b/compiler/hsSyn/HsBinds.lhs index adf234d..40b51ca 100644 --- a/compiler/hsSyn/HsBinds.lhs +++ b/compiler/hsSyn/HsBinds.lhs @@ -318,7 +318,7 @@ data ExprCoFn -- Non-empty bindings, so that the identity coercion -- is always exactly CoHole | CoLet (LHsBinds Id) -- let binds in [] - -- (ould be nicer to be core bindings) + -- (would be nicer to be core bindings) instance Outputable ExprCoFn where ppr co_fn = pprCoFn (ptext SLIT("<>")) co_fn diff --git a/compiler/hsSyn/HsPat.lhs b/compiler/hsSyn/HsPat.lhs index ee21ee3..aa1568d 100644 --- a/compiler/hsSyn/HsPat.lhs +++ b/compiler/hsSyn/HsPat.lhs @@ -122,14 +122,16 @@ data Pat id ------------ Dictionary patterns (translation only) --------------- | DictPat -- Used when destructing Dictionaries with an explicit case - [id] -- superclass dicts - [id] -- methods + [id] -- Superclass dicts + [id] -- Methods ------------ Pattern coercions (translation only) --------------- | CoPat ExprCoFn -- If co::t1 -> t2, p::t2, -- then (CoPat co p) :: t1 - (Pat id) -- No nested location reqd - Type + (Pat id) -- Why not LPat? Ans: existing locn will do + Type + -- During desugaring a (CoPat co pat) turns into a cast with 'co' on + -- the scrutinee, followed by a match on 'pat' \end{code} HsConDetails is use both for patterns and for data type declarations -- 1.7.10.4