[project @ 2001-06-25 14:36:04 by simonpj]

[ghc-hetmet.git] / ghc / compiler / types / Generics.lhs

diff --git a/ghc/compiler/types/Generics.lhs b/ghc/compiler/types/Generics.lhs
index 44fd27a..41a5660 100644 (file)
--- a/ghc/compiler/types/Generics.lhs
+++ b/ghc/compiler/types/Generics.lhs
@@ -7,19 +7,19 @@ module Generics ( mkTyConGenInfo, mkGenericRhs,
 import RnHsSyn         ( RenamedHsExpr )
 import HsSyn           ( HsExpr(..), InPat(..), mkSimpleMatch )
 
-import Type             ( Type, isUnLiftedType, applyTys, tyVarsOfType, tyVarsOfTypes,
+import Type             ( Type, isUnLiftedType, tyVarsOfType, tyVarsOfTypes,
                          mkTyVarTys, mkForAllTys, mkTyConApp, 
                          mkFunTy, isTyVarTy, getTyVar_maybe,
-                         splitSigmaTy, splitTyConApp_maybe, funTyCon
+                         funTyCon
                        )
-
+import TcType          ( tcSplitTyConApp_maybe, tcSplitSigmaTy, tcSplitSigmaTy )
 import DataCon          ( DataCon, dataConOrigArgTys, dataConWrapId, dataConId, isExistentialDataCon )
 
 import TyCon            ( TyCon, tyConTyVars, tyConDataConsIfAvailable, 
                          tyConGenInfo, isNewTyCon, newTyConRep, isBoxedTupleTyCon
                        )
 import Name            ( Name, mkSysLocalName )
-import CoreSyn          ( mkLams, Expr(..), CoreExpr, AltCon(..), Note(..),
+import CoreSyn          ( mkLams, Expr(..), CoreExpr, AltCon(..), 
                          mkConApp, Alt, mkTyApps, mkVarApps )
 import BasicTypes       ( EP(..), Boxity(..) )
 import Var              ( TyVar )
@@ -36,7 +36,6 @@ import CoreUnfold       ( mkTopUnfolding )
 
 import Unique          ( mkBuiltinUnique )
 import SrcLoc          ( builtinSrcLoc )
-import Maybes          ( expectJust )
 import Outputable 
 
 #include "HsVersions.h"
@@ -187,7 +186,7 @@ validGenericInstanceType :: Type -> Bool
   --   f {| a + Int |}
 
 validGenericInstanceType inst_ty
-  = case splitTyConApp_maybe inst_ty of
+  = case tcSplitTyConApp_maybe inst_ty of
        Just (tycon, tys) ->  all isTyVarTy tys && tycon `elem` genericTyCons
        Nothing           ->  False
 
@@ -202,12 +201,12 @@ validGenericMethodType :: Type -> Bool
 validGenericMethodType ty 
   = valid tau
   where
-    (local_tvs, _, tau) = splitSigmaTy ty
+    (local_tvs, _, tau) = tcSplitSigmaTy ty
 
     valid ty
       | isTyVarTy ty    = True
       | no_tyvars_in_ty        = True
-      | otherwise      = case splitTyConApp_maybe ty of
+      | otherwise      = case tcSplitTyConApp_maybe ty of
                                Just (tc,tys) -> valid_tycon tc && all valid tys
                                Nothing       -> False
       where
@@ -266,7 +265,7 @@ mkTyConGenInfo tycon [from_name, to_name]
 
     (from_fn, to_fn, rep_ty) 
        | isNewTyCon tycon
-       = ( mkLams tyvars $ Lam x  $ Note (Coerce newrep_ty tycon_ty) (Var x),
+       = ( mkLams tyvars $ Lam x  $ Var x,
            Var (dataConWrapId the_datacon),
            newrep_ty )
 
@@ -281,7 +280,7 @@ mkTyConGenInfo tycon [from_name, to_name]
            ----------------------
            --  Newtypes only
     [the_datacon]  = datacons
-    newrep_ty = applyTys (expectJust "mkGenTyConInfo" (newTyConRep tycon)) tyvar_tys
+    (_, newrep_ty) = newTyConRep tycon
        
            ----------------------
            --  Non-newtypes only
@@ -340,13 +339,6 @@ mk_sum_stuff i tyvars datacons
        where
          datacon_app = mkTyApps (Var (dataConWrapId datacon)) rep_tys
 
-
--- This constructs the c_of datatype from a DataCon and a Type
--- The identity function at the moment.
-cOfConstr :: DataCon -> Type -> Type
-cOfConstr y z = z
-
-
 ----------------------------------------------------
 --     Dealing with products
 ----------------------------------------------------
@@ -470,11 +462,11 @@ mkGenericRhs sel_id tyvar tycon
 
         -- Takes out the ForAll and the Class restrictions 
         -- in front of the type of the method.
-       (_,_,op_ty) = splitSigmaTy (idType sel_id)
+       (_,_,op_ty) = tcSplitSigmaTy (idType sel_id)
 
         -- Do it again!  This deals with the case where the method type 
        -- is polymorphic -- see notes above
-       (local_tvs,_,final_ty) = splitSigmaTy op_ty
+       (local_tvs,_,final_ty) = tcSplitSigmaTy op_ty
 
        -- Now we probably have a tycon in front
         -- of us, quite probably a FunTyCon.
@@ -495,7 +487,7 @@ generate_bimap env@(tv,ep,local_tvs) ty
        Just tv1 |  tv == tv1 -> ep                             -- The class tyvar
                 |  otherwise -> ASSERT( tv1 `elem` local_tvs)  -- One of the polymorphic tyvars of the method
                                 idEP   
-       Nothing  -> bimapApp env (splitTyConApp_maybe ty)
+       Nothing  -> bimapApp env (tcSplitTyConApp_maybe ty)
 
 -------------------
 bimapApp :: EPEnv -> Maybe (TyCon, [Type]) -> EP RenamedHsExpr