X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FbasicTypes%2FDataCon.lhs;h=e5a624fe29d54cf2f1df38025c59e192f62c5bee;hb=08652e67c4d5d9a40687f93c286021a867c1bca0;hp=0c6e3c57200d8f94c9e6d1691100b38af8875de3;hpb=6a05ec5ef5373f61b7f9f5bdc344483417fa801b;p=ghc-hetmet.git diff --git a/compiler/basicTypes/DataCon.lhs b/compiler/basicTypes/DataCon.lhs index 0c6e3c5..e5a624f 100644 --- a/compiler/basicTypes/DataCon.lhs +++ b/compiler/basicTypes/DataCon.lhs @@ -338,19 +338,21 @@ data DataCon dcRepTyCon :: TyCon, -- Result tycon, T dcRepType :: Type, -- Type of the constructor - -- forall a x y. (a:=:(x,y), Ord x) => x -> y -> MkT a + -- forall a x y. (a:=:(x,y), x~y, Ord x) => + -- x -> y -> T a -- (this is *not* of the constructor wrapper Id: -- see Note [Data con representation] below) -- Notice that the existential type parameters come *second*. -- Reason: in a case expression we may find: - -- case (e :: T t) of { MkT b (d:Ord b) (x:t) (xs:[b]) -> ... } + -- case (e :: T t) of + -- MkT x y co1 co2 (d:Ord x) (v:r) (w:F s) -> ... -- It's convenient to apply the rep-type of MkT to 't', to get - -- forall b. Ord b => ... + -- forall x y. (t:=:(x,y), x~y, Ord x) => x -> y -> T t -- and use that to check the pattern. Mind you, this is really only - -- use in CoreLint. + -- used in CoreLint. - -- Finally, the curried worker function that corresponds to the constructor + -- The curried worker function that corresponds to the constructor: -- It doesn't have an unfolding; the code generator saturates these Ids -- and allocates a real constructor when it finds one. -- @@ -376,7 +378,7 @@ data DataConIds -- The 'Nothing' case of DCIds is important -- Not only is this efficient, -- but it also ensures that the wrapper is replaced - -- by the worker (becuase it *is* the worker) + -- by the worker (because it *is* the worker) -- even when there are no args. E.g. in -- f (:) x -- the (:) *is* the worker. @@ -676,7 +678,7 @@ dataConInstArgTys dc@(MkData {dcRepArgTys = rep_arg_tys, dcUnivTyVars = univ_tvs, dcEqSpec = eq_spec, dcExTyVars = ex_tvs}) inst_tys = ASSERT2 ( length univ_tvs == length inst_tys - , ptext SLIT("dataConInstArgTys") <+> ppr dc $$ ppr univ_tvs $$ ppr inst_tys) + , ptext (sLit "dataConInstArgTys") <+> ppr dc $$ ppr univ_tvs $$ ppr inst_tys) ASSERT2 ( null ex_tvs && null eq_spec, ppr dc ) map (substTyWith univ_tvs inst_tys) rep_arg_tys @@ -691,7 +693,7 @@ dataConInstOrigArgTys dc@(MkData {dcOrigArgTys = arg_tys, dcUnivTyVars = univ_tvs, dcExTyVars = ex_tvs}) inst_tys = ASSERT2( length tyvars == length inst_tys - , ptext SLIT("dataConInstOrigArgTys") <+> ppr dc $$ ppr tyvars $$ ppr inst_tys ) + , ptext (sLit "dataConInstOrigArgTys") <+> ppr dc $$ ppr tyvars $$ ppr inst_tys ) map (substTyWith tyvars inst_tys) arg_tys where tyvars = univ_tvs ++ ex_tvs @@ -706,7 +708,7 @@ dataConInstOrigDictsAndArgTys dc@(MkData {dcOrigArgTys = arg_tys, dcUnivTyVars = univ_tvs, dcExTyVars = ex_tvs}) inst_tys = ASSERT2( length tyvars == length inst_tys - , ptext SLIT("dataConInstOrigDictsAndArgTys") <+> ppr dc $$ ppr tyvars $$ ppr inst_tys ) + , ptext (sLit "dataConInstOrigDictsAndArgTys") <+> ppr dc $$ ppr tyvars $$ ppr inst_tys ) map (substTyWith tyvars inst_tys) (mkPredTys dicts ++ arg_tys) where tyvars = univ_tvs ++ ex_tvs