[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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 ->