Commit 3517c53d authored by chak@cse.unsw.edu.au.'s avatar chak@cse.unsw.edu.au.
Browse files

Template Haskell: make reify aware of type families

- Reifying a type family returns a TH family declaration
- Reifying a data constructor from a data instance attributes that
  constructor to the family (not the representation tycon)
- Ideally, we should have facilities to reify all type/data instances of a 
  given family (and the same for instances of a class).  I haven't added that
  here as it involves some API design.
parent 283e8585
......@@ -15,9 +15,11 @@ module DataCon (
-- ** Type deconstruction
dataConRepType, dataConSig, dataConFullSig,
dataConName, dataConIdentity, dataConTag, dataConTyCon, dataConUserType,
dataConName, dataConIdentity, dataConTag, dataConTyCon,
dataConOrigTyCon, dataConUserType,
dataConUnivTyVars, dataConExTyVars, dataConAllTyVars,
dataConEqSpec, eqSpecPreds, dataConEqTheta, dataConDictTheta, dataConStupidTheta,
dataConEqSpec, eqSpecPreds, dataConEqTheta, dataConDictTheta,
dataConStupidTheta,
dataConInstArgTys, dataConOrigArgTys, dataConOrigResTy,
dataConInstOrigArgTys, dataConRepArgTys,
dataConFieldLabels, dataConFieldType,
......@@ -563,6 +565,14 @@ dataConTag = dcTag
dataConTyCon :: DataCon -> TyCon
dataConTyCon = dcRepTyCon
-- | The original type constructor used in the definition of this data
-- constructor. In case of a data family instance, that will be the family
-- type constructor.
dataConOrigTyCon :: DataCon -> TyCon
dataConOrigTyCon dc
| Just (tc, _) <- tyConFamInst_maybe (dcRepTyCon dc) = tc
| otherwise = dcRepTyCon dc
-- | The representation type of the data constructor, i.e. the sort
-- type that will represent values of this type at runtime
dataConRepType :: DataCon -> Type
......
......@@ -883,7 +883,9 @@ reifyThing (AGlobal (ADataCon dc))
= do { let name = dataConName dc
; ty <- reifyType (idType (dataConWrapId dc))
; fix <- reifyFixity name
; return (TH.DataConI (reifyName name) ty (reifyName (dataConTyCon dc)) fix) }
; return (TH.DataConI (reifyName name) ty
(reifyName (dataConOrigTyCon dc)) fix)
}
reifyThing (ATcId {tct_id = id, tct_type = ty})
= do { ty1 <- zonkTcType ty -- Make use of all the info we have, even
......@@ -902,13 +904,22 @@ reifyThing (AThing {}) = panic "reifyThing AThing"
------------------------------
reifyTyCon :: TyCon -> TcM TH.Info
reifyTyCon tc
| isFunTyCon tc = return (TH.PrimTyConI (reifyName tc) 2 False)
| isPrimTyCon tc = return (TH.PrimTyConI (reifyName tc) (tyConArity tc) (isUnLiftedTyCon tc))
| isFunTyCon tc
= return (TH.PrimTyConI (reifyName tc) 2 False)
| isPrimTyCon tc
= return (TH.PrimTyConI (reifyName tc) (tyConArity tc) (isUnLiftedTyCon tc))
| isOpenTyCon tc
= let flavour = reifyFamFlavour tc
tvs = tyConTyVars tc
in
return (TH.TyConI $
TH.FamilyD flavour (reifyName tc) (reifyTyVars tvs))
| isSynTyCon tc
= do { let (tvs, rhs) = synTyConDefn tc
; rhs' <- reifyType rhs
; return (TH.TyConI $
TH.TySynD (reifyName tc) (reifyTyVars tvs) rhs') }
TH.TySynD (reifyName tc) (reifyTyVars tvs) rhs')
}
reifyTyCon tc
= do { cxt <- reifyCxt (tyConStupidTheta tc)
......@@ -940,7 +951,7 @@ reifyDataCon tys dc
else
return (TH.NormalC name (stricts `zip` arg_tys)) }
| otherwise
= failWithTc (ptext (sLit "Can't reify a non-Haskell-98 data constructor:")
= failWithTc (ptext (sLit "Can't reify a GADT data constructor:")
<+> quotes (ppr dc))
------------------------------
......@@ -977,6 +988,12 @@ reifyCxt = mapM reifyPred
reifyFunDep :: ([TyVar], [TyVar]) -> TH.FunDep
reifyFunDep (xs, ys) = TH.FunDep (map reifyName xs) (map reifyName ys)
reifyFamFlavour :: TyCon -> TH.FamFlavour
reifyFamFlavour tc | isOpenSynTyCon tc = TH.TypeFam
| isOpenTyCon tc = TH.DataFam
| otherwise
= panic "TcSplice.reifyFamFlavour: not a type family"
reifyTyVars :: [TyVar] -> [TH.Name]
reifyTyVars = map reifyName
......
Supports Markdown
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