From: simonpj <unknown>
Date: Wed, 3 Apr 2002 09:45:16 +0000 (+0000)
Subject: [project @ 2002-04-03 09:45:14 by simonpj]
X-Git-Tag: Approx_11550_changesets_converted~2182
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=f2f40c0fd667bf83aab71cce188bd3ccc2096e7f;p=ghc-hetmet.git

[project @ 2002-04-03 09:45:14 by simonpj]
-----------------------------
	Put existential tyvars second
	[fixes ParsecPerm lint error]
	-----------------------------

In an existential data constr:

	data Eq a => T a = forall b. Ord b => MkT a [b]

the type of MkT is

	MkT :: forall a b . Ord b => a -> [b] -> MkT a

Note that the existential tyvars (b in this case) come *after*
the "ordinary" tyvars.

I had switched this around earlier in the week, but I'm putting
it back (and fixing a bug) because I found it really works better second.

Reason: in a case expression we may find:
	case (e :: T t) of { MkT b (d:Ord b) (x:t) (xs:[b]) -> ... }
It's convenient to apply the rep-type of MkT to 't', to get
	forall b. Ord b => ...
and use that to check the pattern.  Mind you, this is really only
use in CoreLint.
---

diff --git a/ghc/compiler/basicTypes/DataCon.lhs b/ghc/compiler/basicTypes/DataCon.lhs
index 6ba6096..73e4845 100644
--- a/ghc/compiler/basicTypes/DataCon.lhs
+++ b/ghc/compiler/basicTypes/DataCon.lhs
@@ -118,13 +118,18 @@ data DataCon
 	--	data Eq a => T a = forall b. Ord b => MkT a [b]
 
 	dcRepType   :: Type,	-- Type of the constructor
-				-- 	forall b a . Ord b => a -> [b] -> MkT a
+				-- 	forall a b . Ord b => a -> [b] -> MkT a
 				-- (this is *not* of the constructor wrapper Id:
 				--  see notes after this data type declaration)
 				--
-				-- Notice that the existential type parameters come
-				-- *first*.  It doesn't really matter provided we are
-				-- consistent.
+	-- Notice that the existential type parameters come *second*.  
+	-- Reason: in a case expression we may find:
+	--	case (e :: T t) of { MkT b (d:Ord b) (x:t) (xs:[b]) -> ... }
+	-- It's convenient to apply the rep-type of MkT to 't', to get
+	--	forall b. Ord b => ...
+	-- and use that to check the pattern.  Mind you, this is really only
+	-- use in CoreLint.
+
 
 	-- The next six fields express the type of the constructor, in pieces
 	-- e.g.
@@ -295,7 +300,7 @@ mkDataCon name arg_stricts fields
     (rep_arg_stricts, rep_arg_tys) = computeRep real_stricts real_arg_tys
 
     tag = assoc "mkDataCon" (tyConDataCons tycon `zip` [fIRST_TAG..]) con
-    ty  = mkForAllTys (ex_tyvars ++ tyvars)
+    ty  = mkForAllTys (tyvars ++ ex_tyvars)
 	              (mkFunTys rep_arg_tys result_ty)
 		-- NB: the existential dict args are already in rep_arg_tys
 
@@ -371,7 +376,7 @@ dataConArgTys :: DataCon
 
 dataConArgTys (MkData {dcRepArgTys = arg_tys, dcTyVars = tyvars,
 		       dcExTyVars = ex_tyvars}) inst_tys
- = map (substTyWith (ex_tyvars ++ tyvars) inst_tys) arg_tys
+ = map (substTyWith (tyvars ++ ex_tyvars) inst_tys) arg_tys
 
 dataConTheta :: DataCon -> ThetaType
 dataConTheta dc = dcStupidTheta dc
@@ -384,7 +389,7 @@ dataConExistentialTyVars dc = dcExTyVars dc
 dataConInstOrigArgTys :: DataCon -> [Type] -> [Type]
 dataConInstOrigArgTys (MkData {dcOrigArgTys = arg_tys, dcTyVars = tyvars,
 		       dcExTyVars = ex_tyvars}) inst_tys
- = map (substTyWith (ex_tyvars ++ tyvars) inst_tys) arg_tys
+ = map (substTyWith (tyvars ++ ex_tyvars) inst_tys) arg_tys
 \end{code}
 
 These two functions get the real argument types of the constructor,
diff --git a/ghc/compiler/basicTypes/MkId.lhs b/ghc/compiler/basicTypes/MkId.lhs
index e37848f..f5f19b6 100644
--- a/ghc/compiler/basicTypes/MkId.lhs
+++ b/ghc/compiler/basicTypes/MkId.lhs
@@ -299,7 +299,7 @@ mkDataConWrapId data_con
 			       (map varToCoreExpr (all_tyvars ++ reverse rep_ids))
 
     (tyvars, _, ex_tyvars, ex_theta, orig_arg_tys, tycon) = dataConSig data_con
-    all_tyvars   = ex_tyvars ++ tyvars
+    all_tyvars   = tyvars ++ ex_tyvars
 
     ex_dict_tys  = mkPredTys ex_theta
     all_arg_tys  = ex_dict_tys ++ orig_arg_tys
diff --git a/ghc/compiler/coreSyn/CoreLint.lhs b/ghc/compiler/coreSyn/CoreLint.lhs
index dbb8787..433d343 100644
--- a/ghc/compiler/coreSyn/CoreLint.lhs
+++ b/ghc/compiler/coreSyn/CoreLint.lhs
@@ -436,6 +436,7 @@ lintCoreAlt scrut_ty alt@(DataAlt con, args, rhs)
 	-- Scrutinee type must be a tycon applicn; checked by caller
 	-- This code is remarkably compact considering what it does!
 	-- NB: args must be in scope here so that the lintCoreArgs line works.
+	-- NB: relies on existential type args coming *after* ordinary type args
     case splitTyConApp scrut_ty of { (tycon, tycon_arg_tys) ->
 	lintTyApps (dataConRepType con) tycon_arg_tys	`thenL` \ con_type ->
 	lintCoreArgs con_type (map mk_arg args)		`thenL` \ con_result_ty ->
diff --git a/ghc/compiler/typecheck/Inst.lhs b/ghc/compiler/typecheck/Inst.lhs
index 6b25d8a..ef9c99a 100644
--- a/ghc/compiler/typecheck/Inst.lhs
+++ b/ghc/compiler/typecheck/Inst.lhs
@@ -372,15 +372,15 @@ tcInstDataCon orig data_con
 	     -- We generate constraints for the stupid theta even when 
 	     -- pattern matching (as the Report requires)
     in
-    tcInstTyVars VanillaTv (ex_tvs ++ tvs)	`thenNF_Tc` \ (all_tvs', ty_args', tenv) ->
+    tcInstTyVars VanillaTv (tvs ++ ex_tvs)	`thenNF_Tc` \ (all_tvs', ty_args', tenv) ->
     let
 	stupid_theta' = substTheta tenv stupid_theta
 	ex_theta'     = substTheta tenv ex_theta
 	arg_tys'      = map (substTy tenv) arg_tys
 
-	n_ex_tvs  = length ex_tvs
-	ex_tvs'   = take n_ex_tvs all_tvs'
-	result_ty = mkTyConApp tycon (drop n_ex_tvs ty_args')
+	n_normal_tvs  = length tvs
+	ex_tvs'       = drop n_normal_tvs all_tvs'
+	result_ty     = mkTyConApp tycon (take n_normal_tvs ty_args')
     in
     newDicts orig stupid_theta'	`thenNF_Tc` \ stupid_dicts ->
     newDicts orig ex_theta'	`thenNF_Tc` \ ex_dicts ->