[make type synonym expansion rename local binders when expanding synonyms
John Meacham <john@repetae.net>**20060214070636] hunk ./FrontEnd/TypeSynonyms.hs 19
+import Util.UniqueMonad
hunk ./FrontEnd/TypeSynonyms.hs 57
-evalTypeSyms (TypeSynonyms tmap) t = eval [] t where
+evalTypeSyms (TypeSynonyms tmap) t = execUniqT 1 (eval [] t) where
hunk ./FrontEnd/TypeSynonyms.hs 61
-            warn sl "type-synonym-partialap" ("Partially applied typesym:" <+> show n <+> "need" <+> show (- excess) <+> "more arguments.")
+            lift $ warn sl "type-synonym-partialap" ("Partially applied typesym:" <+> show n <+> "need" <+> show (- excess) <+> "more arguments.")
hunk ./FrontEnd/TypeSynonyms.hs 64
-            eval (drop (length args) stack) (subst (Map.fromList [(a,s) | a <- args | s <- stack]) t)
+            st <- subst (Map.fromList [(a,s) | a <- args | s <- stack]) t
+            eval (drop (length args) stack) st
hunk ./FrontEnd/TypeSynonyms.hs 74
-    subst sm (HsTyForall vs t) = HsTyForall vs  t { hsQualTypeType =  subst (foldr ($) sm (map (\v m -> Map.delete (hsTyVarBindName v) m) vs)) (hsQualTypeType t) }
-    subst sm (HsTyVar n) | Just v <- Map.lookup n sm = v
-    subst sm t = runIdentity $ mapHsTypeHsType (return . subst sm) t
+    subst sm (HsTyForall vs t) = do
+        ns <- mapM (const newUniq) vs
+        let nvs = [ (hsTyVarBindName v,v { hsTyVarBindName = hsNameIdent_u (hsIdentString_u (++ ('@':show n))) (hsTyVarBindName v)})| (n,v) <- zip ns vs ]
+            nsm = Map.fromList [ (v,HsTyVar $ hsTyVarBindName t)| (v,t) <- nvs] `Map.union` sm
+        t' <- substqt nsm t
+        return $ HsTyForall (snds nvs)  t'
+    subst sm (HsTyExists vs t) = do
+        ns <- mapM (const newUniq) vs
+        let nvs = [ (hsTyVarBindName v,v { hsTyVarBindName = hsNameIdent_u (hsIdentString_u (++ ('@':show n))) (hsTyVarBindName v)})| (n,v) <- zip ns vs ]
+            nsm = Map.fromList [ (v,HsTyVar $ hsTyVarBindName t)| (v,t) <- nvs] `Map.union` sm
+        t' <- substqt nsm t
+        return $ HsTyExists (snds nvs)  t'
+    subst (sm::(Map.Map HsName HsType))  (HsTyVar n) | Just v <- Map.lookup n sm = return v
+    subst sm t = mapHsTypeHsType (subst sm) t
+    substqt sm qt@HsUnQualType { hsQualTypeType = t } = do
+        t' <- subst sm t
+        return qt { hsQualTypeType = t'}
+    substqt sm qt@HsQualType { hsQualTypeContext = ps, hsQualTypeType = t } = do
+        t' <- subst sm t
+        let ps' = [ case Map.lookup n sm of Just (HsTyVar n') -> (c,n') ; _ -> (c,n) | (c,n) <- ps ]
+        return qt { hsQualTypeType = t', hsQualTypeContext = ps' }