- (tycon_name, _, _, _) = getClassDeclSysNames name_list
- clas = mkClass class_name tyvars fds
- sc_theta sc_sel_ids op_items
- tycon
-
- tycon = mkClassTyCon tycon_name class_kind tyvars
- argvrcs dict_con
- clas -- Yes! It's a dictionary
- flavour
- is_rec
- -- A class can be recursive, and in the case of newtypes
- -- this matters. For example
- -- class C a where { op :: C b => a -> b -> Int }
- -- Because C has only one operation, it is represented by
- -- a newtype, and it should be a *recursive* newtype.
- -- [If we don't make it a recursive newtype, we'll expand the
- -- newtype like a synonym, but that will lead toan inifinite type
-
- ClassDetails sc_theta sc_sel_ids op_items dict_con = lookupNameEnv_NF rec_details class_name
-
- class_kind = lookupNameEnv_NF kenv class_name
- tyvars = mkTyClTyVars class_kind tyvar_names
- argvrcs = lookupWithDefaultFM rec_vrcs bogusVrcs tycon
-
- flavour = case dataConOrigArgTys dict_con of
- -- The tyvars in the datacon are the same as in the class
- [rep_ty] -> NewTyCon rep_ty
- other -> DataTyCon
-
- -- We can find the functional dependencies right away,
- -- and it is vital to do so. Why? Because in the next pass
- -- we check for ambiguity in all the type signatures, and we
- -- need the functional dependcies to be done by then
- fds = [(map lookup xs, map lookup ys) | (xs,ys) <- fundeps]
- tyvar_env = mkNameEnv [(varName tv, tv) | tv <- tyvars]
- lookup = lookupNameEnv_NF tyvar_env
-
-bogusVrcs = panic "Bogus tycon arg variances"
-\end{code}
-
-\begin{code}
-mkNewTyConRep :: TyCon -- The original type constructor
- -> Type -- Chosen representation type
- -- (guaranteed not to be another newtype)
-
--- Find the representation type for this newtype TyCon
---
--- The non-recursive newtypes are easy, because they look transparent
--- to splitTyConApp_maybe, but recursive ones really are represented as
--- TyConApps (see TypeRep).
---
--- The trick is to to deal correctly with recursive newtypes
--- such as newtype T = MkT T
-
-mkNewTyConRep tc
- = go [] tc
- where
- -- Invariant: tc is a NewTyCon
- -- tcs have been seen before
- go tcs tc
- | tc `elem` tcs = unitTy
- | otherwise
- = let
- rep_ty = head (dataConOrigArgTys (head (tyConDataCons tc)))
- in
- case splitTyConApp_maybe rep_ty of
- Nothing -> rep_ty
- Just (tc', tys) | not (isNewTyCon tc') -> rep_ty
- | otherwise -> go1 (tc:tcs) tc' tys
-
- go1 tcs tc tys = substTyWith (tyConTyVars tc) tys (go tcs tc)