import HscTypes
import PrelInfo
+import MkCore ( eRROR_ID )
import PrelNames
import PrimOp
import SrcLoc
where
(nullary_cons, nonnullary_cons)
| isNewTyCon tycon = ([], tyConDataCons tycon)
- | otherwise = partition isNullarySrcDataCon (tyConDataCons tycon)
+ | otherwise = partition isNullarySrcDataCon (tyConDataCons tycon)
no_nullary_cons = null nullary_cons
where (_, xc) = go co x
(yr,yc) = go co y
go co ty@(TyConApp con args)
- | isTupleTyCon con = (caseTuple (tupleTyConBoxity con) xrs,True)
- | null args = (caseTrivial,False) -- T
- | or (init xcs) = (caseWrongArg,True) -- T (..var..) ty
- | last xcs = -- T (..no var..) ty
- (caseTyApp (fst (splitAppTy ty)) (last xrs),True)
+ | not (or xcs) = (caseTrivial, False) -- Variable does not occur
+ -- At this point we know that xrs, xcs is not empty,
+ -- and at least one xr is True
+ | isTupleTyCon con = (caseTuple (tupleTyConBoxity con) xrs, True)
+ | or (init xcs) = (caseWrongArg, True) -- T (..var..) ty
+ | otherwise = -- T (..no var..) ty
+ (caseTyApp (fst (splitAppTy ty)) (last xrs), True)
where (xrs,xcs) = unzip (map (go co) args)
go co (ForAllTy v x) | v /= var && xc = (caseForAll v xr,True)
where (xr,xc) = go co x
rdr_name = con2tag_RDR tycon
sig_ty = HsCoreTy $
- mkForAllTys (tyConTyVars tycon) $
+ mkSigmaTy (tyConTyVars tycon) (tyConStupidTheta tycon) $
mkParentType tycon `mkFunTy` intPrimTy
lots_of_constructors = tyConFamilySize tycon > 8