X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Ftypes%2FType.lhs;h=455c6cb4e07f72d6ddcf2f4d88c8252a25a915db;hb=557947d3f93e11285e36423ddb08d859af60ab47;hp=95f22c282103ad94dcd69151bfd85176347138b9;hpb=9af77fa423926fbda946b31e174173d0ec5ebac8;p=ghc-hetmet.git

diff --git a/ghc/compiler/types/Type.lhs b/ghc/compiler/types/Type.lhs
index 95f22c2..455c6cb 100644
--- a/ghc/compiler/types/Type.lhs
+++ b/ghc/compiler/types/Type.lhs
@@ -18,11 +18,6 @@ module Type (
 	isTypeKind, isAnyTypeKind,
 	funTyCon,
 
-        usageKindCon,					-- :: KX
-        usageTypeKind,					-- :: KX
-        usOnceTyCon, usManyTyCon,			-- :: $
-        usOnce, usMany,					-- :: $
-
         -- exports from this module:
         hasMoreBoxityInfo, defaultKind,
 
@@ -65,7 +60,7 @@ module Type (
 	tidyTopType,   tidyPred,
 
 	-- Comparison
-	eqType, eqKind, eqUsage, 
+	eqType, eqKind, 
 
 	-- Seq
 	seqType, seqTypes
@@ -85,12 +80,12 @@ import {-# SOURCE #-}	PprType( pprType )	-- Only called in debug messages
 import {-# SOURCE #-}   Subst  ( substTyWith )
 
 -- friends:
-import Var	( TyVar, tyVarKind, tyVarName, setTyVarName )
+import Var	( Id, TyVar, tyVarKind, tyVarName, setTyVarName )
 import VarEnv
 import VarSet
 
 import Name	( NamedThing(..), mkInternalName, tidyOccName )
-import Class	( classTyCon )
+import Class	( Class, classTyCon )
 import TyCon	( TyCon, isRecursiveTyCon, isPrimTyCon,
 		  isUnboxedTupleTyCon, isUnLiftedTyCon,
 		  isFunTyCon, isNewTyCon, newTyConRep,
@@ -104,7 +99,7 @@ import CmdLineOpts	( opt_DictsStrict )
 import SrcLoc		( noSrcLoc )
 import PrimRep		( PrimRep(..) )
 import Unique		( Uniquable(..) )
-import Util		( mapAccumL, seqList, lengthIs )
+import Util		( mapAccumL, seqList, lengthIs, snocView )
 import Outputable
 import UniqSet		( sizeUniqSet )		-- Should come via VarSet
 import Maybe		( isJust )
@@ -224,14 +219,11 @@ splitAppTy_maybe :: Type -> Maybe (Type, Type)
 splitAppTy_maybe (FunTy ty1 ty2)   = Just (TyConApp funTyCon [ty1], ty2)
 splitAppTy_maybe (AppTy ty1 ty2)   = Just (ty1, ty2)
 splitAppTy_maybe (NoteTy _ ty)     = splitAppTy_maybe ty
-splitAppTy_maybe (SourceTy p)        = splitAppTy_maybe (sourceTypeRep p)
-splitAppTy_maybe (TyConApp tc [])  = Nothing
-splitAppTy_maybe (TyConApp tc tys) = split tys []
-			    where
-			       split [ty2]    acc = Just (TyConApp tc (reverse acc), ty2)
-			       split (ty:tys) acc = split tys (ty:acc)
-
-splitAppTy_maybe other	     	  = Nothing
+splitAppTy_maybe (SourceTy p)      = splitAppTy_maybe (sourceTypeRep p)
+splitAppTy_maybe (TyConApp tc tys) = case snocView tys of
+					Nothing -> Nothing
+					Just (tys',ty') -> Just (TyConApp tc tys', ty')
+splitAppTy_maybe other	     	   = Nothing
 
 splitAppTy :: Type -> (Type, Type)
 splitAppTy ty = case splitAppTy_maybe ty of
@@ -243,7 +235,7 @@ splitAppTys ty = split ty ty []
   where
     split orig_ty (AppTy ty arg)        args = split ty ty (arg:args)
     split orig_ty (NoteTy _ ty)         args = split orig_ty ty args
-    split orig_ty (SourceTy p)            args = split orig_ty (sourceTypeRep p) args
+    split orig_ty (SourceTy p)          args = split orig_ty (sourceTypeRep p) args
     split orig_ty (FunTy ty1 ty2)       args = ASSERT( null args )
 					       (TyConApp funTyCon [], [ty1,ty2])
     split orig_ty (TyConApp tc tc_args) args = (TyConApp tc [], tc_args ++ args)
@@ -490,17 +482,18 @@ applyTy (ForAllTy tv ty) arg = substTyWith [tv] [arg] ty
 applyTy other		 arg = panic "applyTy"
 
 applyTys :: Type -> [Type] -> Type
-applyTys fun_ty arg_tys
+applyTys orig_fun_ty arg_tys
  = substTyWith tvs arg_tys ty
  where
-   (mu, tvs, ty) = split fun_ty arg_tys
+   (tvs, ty) = split orig_fun_ty arg_tys
    
-   split fun_ty               []         = (Nothing, [], fun_ty)
+   split fun_ty               []         = ([], fun_ty)
    split (NoteTy _ fun_ty)    args       = split fun_ty args
    split (SourceTy p)	      args       = split (sourceTypeRep p) args
    split (ForAllTy tv fun_ty) (arg:args) = case split fun_ty args of
-						  (mu, tvs, ty) -> (mu, tv:tvs, ty)
+						  (tvs, ty) -> (tv:tvs, ty)
    split other_ty             args       = panic "applyTys"
+	-- No show instance for Type yet
 \end{code}
 
 
@@ -852,7 +845,6 @@ I don't think this is harmful, but it's soemthing to watch out for.
 \begin{code}
 eqType t1 t2 = eq_ty emptyVarEnv t1 t2
 eqKind  = eqType	-- No worries about looking 
-eqUsage = eqType	-- through source types for these two
 
 -- Look through Notes
 eq_ty env (NoteTy _ t1)       t2	  	  = eq_ty env t1 t2