(arg_prefix, arg_ids)
| isVanillaDataCon data_con -- Instantiate from commmon base
= ([], mkTemplateLocalsNum arg_base (dataConInstOrigArgTys data_con res_tys))
- | otherwise
+ | otherwise -- The case pattern binds type variables, which are used
+ -- in the types of the arguments of the pattern
= (dc_tyvars ++ mkTemplateLocalsNum arg_base (mkPredTys dc_theta),
mkTemplateLocalsNum arg_base' dc_arg_tys)
(dc_tyvars, dc_theta, dc_arg_tys, _, _) = dataConSig data_con
arg_base' = arg_base + length dc_theta
- unpack_base = arg_base' + length dc_theta
+ unpack_base = arg_base' + length dc_arg_tys
uniqs = map mkBuiltinUnique [unpack_base..]
the_arg_id = assoc "mkRecordSelId:mk_alt" (field_lbls `zip` arg_ids) field_label
-------------------------------------------------------
repC :: LConDecl Name -> DsM (Core TH.ConQ)
-repC (L loc (ConDecl con [] (L _ []) details))
+repC (L loc (ConDecl con expl [] (L _ []) details ResTyH98))
= do { con1 <- lookupLOcc con ; -- See note [Binders and occurrences]
repConstr con1 details }
-repC (L loc (ConDecl con tvs (L cloc ctxt) details))
+repC (L loc (ConDecl con expl tvs (L cloc ctxt) details ResTyH98))
= do { addTyVarBinds tvs $ \bndrs -> do {
- c' <- repC (L loc (ConDecl con [] (L cloc []) details));
+ c' <- repC (L loc (ConDecl con expl [] (L cloc []) details ResTyH98));
ctxt' <- repContext ctxt;
bndrs' <- coreList nameTyConName bndrs;
rep2 forallCName [unC bndrs', unC ctxt', unC c']
}
}
-repC (L loc con_decl)
+repC (L loc con_decl) -- GADTs
= putSrcSpanDs loc $
do { dsWarn (hang ds_msg 4 (ppr con_decl))
; return (panic "DsMeta:repC") }
mk_con loc con = L loc $ mk_nlcon con
where
+ -- Can't handle GADTs yet
mk_nlcon con = case con of
NormalC c strtys
- -> ConDecl (L loc (cName c)) noExistentials (noContext loc)
- (PrefixCon (map mk_arg strtys))
+ -> ConDecl (L loc (cName c)) Explicit noExistentials (noContext loc)
+ (PrefixCon (map mk_arg strtys)) ResTyH98
RecC c varstrtys
- -> ConDecl (L loc (cName c)) noExistentials (noContext loc)
- (RecCon (map mk_id_arg varstrtys))
+ -> ConDecl (L loc (cName c)) Explicit noExistentials (noContext loc)
+ (RecCon (map mk_id_arg varstrtys)) ResTyH98
InfixC st1 c st2
- -> ConDecl (L loc (cName c)) noExistentials (noContext loc)
- (InfixCon (mk_arg st1) (mk_arg st2))
+ -> ConDecl (L loc (cName c)) Explicit noExistentials (noContext loc)
+ (InfixCon (mk_arg st1) (mk_arg st2)) ResTyH98
ForallC tvs ctxt (ForallC tvs' ctxt' con')
-> mk_nlcon (ForallC (tvs ++ tvs') (ctxt ++ ctxt') con')
ForallC tvs ctxt con' -> case mk_nlcon con' of
- ConDecl l [] (L _ []) x ->
- ConDecl l (cvt_tvs loc tvs) (cvt_context loc ctxt) x
+ ConDecl l _ [] (L _ []) x ResTyH98 ->
+ ConDecl l Explicit (cvt_tvs loc tvs) (cvt_context loc ctxt) x ResTyH98
c -> panic "ForallC: Can't happen"
mk_arg (IsStrict, ty) = L loc $ HsBangTy HsStrict (cvtType loc ty)
mk_arg (NotStrict, ty) = cvtType loc ty