[implement forall hoisting.
John Meacham <john@repetae.net>**20051205061920] hunk ./FrontEnd/KindInfer.hs 550
-aHsQualTypeToScheme kt HsQualType { hsQualTypeContext = cntxt, hsQualTypeType = HsTyForall vs qt } = aHsQualTypeToScheme kt HsQualType { hsQualTypeContext = cntxt ++ hsQualTypeHsContext qt, hsQualTypeType = hsQualTypeType qt }
-aHsQualTypeToScheme kt HsUnQualType { hsQualTypeType = t } = aHsQualTypeToScheme kt HsQualType { hsQualTypeContext = [], hsQualTypeType = t } 
+aHsQualTypeToScheme kt HsQualType { hsQualTypeContext = cntxt, hsQualTypeType = qt  } | HsTyForall vs qt' <- forallHoist qt = aHsQualTypeToScheme kt HsQualType { hsQualTypeContext = cntxt ++ hsQualTypeHsContext qt', hsQualTypeType = hsQualTypeType qt' }
+aHsQualTypeToScheme kt HsUnQualType { hsQualTypeType = t } = aHsQualTypeToScheme kt HsQualType { hsQualTypeContext = [], hsQualTypeType = t }
hunk ./FrontEnd/KindInfer.hs 556
+
+forallHoist :: HsType -> HsType
+forallHoist (HsTyForall vs qt) | HsTyForall vs' qt' <- hsQualTypeType qt  = forallHoist (HsTyForall (vs ++ vs') HsQualType { hsQualTypeType = hsQualTypeType qt', hsQualTypeContext = hsQualTypeHsContext qt ++ hsQualTypeHsContext qt' })
+forallHoist (HsTyFun a b) = case forallHoist b of
+    HsTyForall as qt -> HsTyForall as HsQualType { hsQualTypeContext = hsQualTypeHsContext qt, hsQualTypeType = HsTyFun a (hsQualTypeType qt) }
+    b' -> HsTyFun (forallHoist a) b'
+forallHoist t = t
+
hunk ./test/Forall.hs 41
---id3 :: a -> IdentityFunc
---id3 _ x = x
+id3 :: a -> IdentityFunc
+id3 _ x = x
hunk ./test/Forall.hs 44
---id4 :: a -> forall a . a -> a
---id4 _ x = x
+-- ghc does not accept the following 2 without the parens
hunk ./test/Forall.hs 46
+id4 :: a -> (forall a . a -> a)
+id4 _ x = x
+
+id5 :: a -> (forall b . (forall c . (forall d . b -> c -> d -> a)))
+id5 a _ _ _ = a
+
+id6 :: a -> (forall b . Show b => (forall d . (Eq b, Show d) => (b,d)))
+id6 = undefined