Haddockify 'IE'.

[ghc-hetmet.git] / compiler / iface / BuildTyCl.lhs

diff --git a/compiler/iface/BuildTyCl.lhs b/compiler/iface/BuildTyCl.lhs
index 8459edf..296b430 100644 (file)
--- a/compiler/iface/BuildTyCl.lhs
+++ b/compiler/iface/BuildTyCl.lhs
@@ -39,22 +39,23 @@ import Data.List
 ------------------------------------------------------
 buildSynTyCon :: Name -> [TyVar] 
               -> SynTyConRhs 
+             -> Kind                   -- Kind of the RHS
              -> Maybe (TyCon, [Type])  -- family instance if applicable
               -> TcRnIf m n TyCon
 
-buildSynTyCon tc_name tvs rhs@(OpenSynTyCon rhs_ki _) _
+buildSynTyCon tc_name tvs rhs@(OpenSynTyCon {}) rhs_kind _
   = let
-      kind = mkArrowKinds (map tyVarKind tvs) rhs_ki
+      kind = mkArrowKinds (map tyVarKind tvs) rhs_kind
     in
     return $ mkSynTyCon tc_name kind tvs rhs NoParentTyCon
     
-buildSynTyCon tc_name tvs rhs@(SynonymTyCon rhs_ty) mb_family
+buildSynTyCon tc_name tvs rhs@(SynonymTyCon {}) rhs_kind mb_family
   = do { -- We need to tie a knot as the coercion of a data instance depends
         -- on the instance representation tycon and vice versa.
        ; tycon <- fixM (\ tycon_rec -> do 
         { parent <- mkParentInfo mb_family tc_name tvs tycon_rec
         ; let { tycon   = mkSynTyCon tc_name kind tvs rhs parent
-              ; kind    = mkArrowKinds (map tyVarKind tvs) (typeKind rhs_ty)
+              ; kind    = mkArrowKinds (map tyVarKind tvs) rhs_kind
               }
          ; return tycon
          })
@@ -147,13 +148,16 @@ mkNewTyConRhs tycon_name tycon con
         -- non-recursive newtypes
     all_coercions = True
     tvs    = tyConTyVars tycon
-    rhs_ty = ASSERT(not (null (dataConInstOrigDictsAndArgTys con (mkTyVarTys tvs)))) 
-            -- head (dataConInstOrigArgTys con (mkTyVarTys tvs))
-            head (dataConInstOrigDictsAndArgTys con (mkTyVarTys tvs))
+    inst_con_ty = applyTys (dataConUserType con) (mkTyVarTys tvs)
+    rhs_ty = ASSERT( isFunTy inst_con_ty ) funArgTy inst_con_ty
        -- Instantiate the data con with the 
        -- type variables from the tycon
-       -- NB: a newtype DataCon has no existentials; hence the
-       --     call to dataConInstOrigArgTys has the right type args
+       -- NB: a newtype DataCon has a type that must look like
+       --        forall tvs.  <arg-ty> -> T tvs
+       -- Note that we *can't* use dataConInstOrigArgTys here because
+       -- the newtype arising from   class Foo a => Bar a where {}
+       -- has a single argument (Foo a) that is a *type class*, so
+       -- dataConInstOrigArgTys returns [].
 
     etad_tvs :: [TyVar]        -- Matched lazily, so that mkNewTypeCoercion can
     etad_rhs :: Type   -- return a TyCon without pulling on rhs_ty