From: simonpj <unknown>
Date: Thu, 23 May 2002 15:49:07 +0000 (+0000)
Subject: [project @ 2002-05-23 15:49:07 by simonpj]
X-Git-Tag: Approx_11550_changesets_converted~2019
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=8911f9eaec0b082228104ca92100f2714f5da061;p=ghc-hetmet.git

[project @ 2002-05-23 15:49:07 by simonpj]
Bug-fix for validity checking of type synonyms
---

diff --git a/ghc/compiler/typecheck/TcMType.lhs b/ghc/compiler/typecheck/TcMType.lhs
index 9fbeb46..38d44c2 100644
--- a/ghc/compiler/typecheck/TcMType.lhs
+++ b/ghc/compiler/typecheck/TcMType.lhs
@@ -730,18 +730,36 @@ check_tau_type rank ubx_tup ty@(FunTy arg_ty res_ty)
 check_tau_type rank ubx_tup (AppTy ty1 ty2)
   = check_arg_type ty1 `thenTc_` check_arg_type ty2
 
-check_tau_type rank ubx_tup (NoteTy note ty)
-  = check_tau_type rank ubx_tup ty
+check_tau_type rank ubx_tup (NoteTy (SynNote syn) ty)
 	-- Synonym notes are built only when the synonym is 
 	-- saturated (see Type.mkSynTy)
-	-- Not checking the 'note' part allows us to instantiate a synonym
-	-- defn with a for-all type, or with a partially-applied type synonym,
-	-- but that seems OK too
+  = doptsTc Opt_GlasgowExts			`thenNF_Tc` \ gla_exts ->
+    (if gla_exts then
+	-- If -fglasgow-exts then don't check the 'note' part.
+	-- This  allows us to instantiate a synonym defn with a 
+	-- for-all type, or with a partially-applied type synonym.
+	-- 	e.g.   type T a b = a
+	--	       type S m   = m ()
+	--	       f :: S (T Int)
+	-- Here, T is partially applied, so it's illegal in H98.
+	-- But if you expand S first, then T we get just 
+	--	       f :: Int
+	-- which is fine.
+	returnTc ()
+    else
+	-- For H98, do check the un-expanded part
+	check_tau_type rank ubx_tup syn		
+    )						`thenTc_`
+
+    check_tau_type rank ubx_tup ty
+
+check_tau_type rank ubx_tup (NoteTy other_note ty)
+  = check_tau_type rank ubx_tup ty
 
 check_tau_type rank ubx_tup ty@(TyConApp tc tys)
   | isSynTyCon tc	
   = 	-- NB: Type.mkSynTy builds a TyConApp (not a NoteTy) for an unsaturated
-	-- synonym application, leaving it to checkValidType (i.e. right here
+	-- synonym application, leaving it to checkValidType (i.e. right here)
 	-- to find the error
     checkTc syn_arity_ok arity_msg	`thenTc_`
     mapTc_ check_arg_type tys