Commit 67398e1b authored by simonpj's avatar simonpj
Browse files

[project @ 2003-01-13 13:19:25 by simonpj]

------------------------------------
	Type signature for derived con2tag
	------------------------------------

		MERGE TO STABLE

The derived con2tag didn't have a type signature, so we got

	con2tagFoo :: a -> Int#
	con2tagFoo = \x -> getTag x

The getTag generates a case expression, so we get a polymorphic
case.  The polymorphic case simply does not work in *interpreted*
GHC 5.02.3 and as a result neither does con2tag.  Alas.

This commit fixes the problem, by giving a type signature for
con2TagFoo.  But note that getTag in interpreted GHC 5.02 will continue
to fail if used in a polymorphic context.  This problem does not arise
in the HEAD (eval/apply) so I'm going to leave it as a wont-fix bug.
parent 0862ecec
......@@ -31,7 +31,6 @@ import HsSyn ( Pat(..), HsConDetails(..), HsExpr(..), MonoBinds(..),
HsBinds(..), HsType(..), HsStmtContext(..),
unguardedRHS, mkSimpleMatch, mkMonoBind, andMonoBindList, placeHolderType
)
import PrelNames ( )
import RdrName ( RdrName, mkUnqual, nameRdrName, getRdrName )
import RdrHsSyn ( mkHsOpApp, RdrNameMonoBinds, RdrNameHsExpr, RdrNamePat, mkHsDo )
import BasicTypes ( RecFlag(..), Fixity(..), FixityDirection(..)
......@@ -54,7 +53,7 @@ import PrelNames -- Lots of Names
import PrimOp -- Lots of Names
import SrcLoc ( generatedSrcLoc, SrcLoc )
import TyCon ( TyCon, isNewTyCon, tyConDataCons, isEnumerationTyCon,
maybeTyConSingleCon, tyConFamilySize
maybeTyConSingleCon, tyConFamilySize, tyConTyVars
)
import TcType ( isUnLiftedType, tcEqType, Type )
import TysPrim ( charPrimTy, intPrimTy, wordPrimTy, addrPrimTy,
......@@ -1030,13 +1029,29 @@ gen_tag_n_con_monobind
gen_tag_n_con_monobind (rdr_name, tycon, GenCon2Tag)
| lots_of_constructors
= mk_FunMonoBind (getSrcLoc tycon) rdr_name
[([VarPat a_RDR], HsApp getTag_Expr a_Expr)]
= mk_FunMonoBind loc rdr_name [([], get_tag_rhs)]
| otherwise
= mk_FunMonoBind (getSrcLoc tycon) rdr_name (map mk_stuff (tyConDataCons tycon))
= mk_FunMonoBind loc rdr_name (map mk_stuff (tyConDataCons tycon))
where
loc = getSrcLoc tycon
-- Give a signature to the bound variable, so
-- that the case expression generated by getTag is
-- monomorphic. In the push-enter model we get better code.
get_tag_rhs = ExprWithTySig
(HsLam (mk_match loc [VarPat a_RDR]
(HsApp getTag_Expr a_Expr)
EmptyBinds))
(HsForAllTy Nothing [] con2tag_ty)
-- Nothing => implicit quantification
con2tag_ty = foldl HsAppTy (HsTyVar (getRdrName tycon))
[HsTyVar (getRdrName tv) | tv <- tyConTyVars tycon]
`HsFunTy`
HsTyVar (getRdrName intPrimTyConName)
lots_of_constructors = tyConFamilySize tycon > mAX_FAMILY_SIZE_FOR_VEC_RETURNS
mk_stuff :: DataCon -> ([RdrNamePat], RdrNameHsExpr)
......
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