[print higher rank types properly
John Meacham <john@repetae.net>**20051205112451] hunk ./DataConstructors.hs 50
+tipe (TForAll (Forall [] (_ :=> t))) = tipe t
+tipe (TForAll (Forall xs (_ :=> t))) = foldr ELam (tipe t) [ tVr n (kind k) | n <- [2..] | k <- xs ]
hunk ./DataConstructors.hs 324
-            (Forall _ (_ :=> ty)) = runIdentity $ Map.lookup nm' cm
+            Just (Forall _ (_ :=> ty)) = Map.lookup nm' cm
hunk ./DataConstructors.hs 371
-pprintTypeOfCons :: DocLike a => DataTable -> Name -> a
-pprintTypeOfCons dataTable name | Just c <- getConstructor name dataTable = pprintTypeAsHs (conType c)
-                                | otherwise = text "?"
+pprintTypeOfCons :: (Monad m,DocLike a) => DataTable -> Name -> m a
+pprintTypeOfCons dataTable name = do
+    c <- getConstructor name dataTable
+    return $ pprintTypeAsHs (conType c)
hunk ./DataConstructors.hs 396
+    f v | (e,ts@(_:_)) <- fromLam v = do
+        ts' <- mapM (newLookupName ['a'..] () . tvrIdent) ts
+        r <- f e
+        return $ fixitize (N,-3) $ pop (text "forall" <+> hsep (map char ts') <+> text ". ")  (atomize r)
hunk ./E/Pretty.hs 14
-import GenUtil
hunk ./E/Pretty.hs 146
-        (ELetRec bg e) -> fixitize (L,(-10)) $ let
+        (ELetRec bg e) -> fixitize (L,(-10)) $ atom $ let
hunk ./E/Pretty.hs 150
-        ec@(ECase { eCaseScrutinee = e, eCaseAlts = alts }) -> fixitize ((L,(-10))) $ let
+        ec@(ECase { eCaseScrutinee = e, eCaseAlts = alts }) -> fixitize ((L,(-10))) $ atom $ let
hunk ./FrontEnd/Class.hs 574
-   ct n | n == classArg =  aHsTypeToType kt instanceType
+   ct n | n == classArg =  runIdentity $ hsTypeToType kt instanceType
hunk ./FrontEnd/DataConsAssump.hs 30
+import Control.Monad.Identity
+import qualified Data.Map as Map
hunk ./FrontEnd/DataConsAssump.hs 37
-import qualified Data.Map as Map
hunk ./FrontEnd/DataConsAssump.hs 96
-bangTypeToType kt (HsBangedTy t) = aHsTypeToType kt t
-bangTypeToType kt (HsUnBangedTy t) = aHsTypeToType kt t
+bangTypeToType kt (HsBangedTy t) = runIdentity $ hsTypeToType kt t
+bangTypeToType kt (HsUnBangedTy t) = runIdentity $ hsTypeToType kt t
hunk ./FrontEnd/KindInfer.hs 15
-    aHsTypeToType,
+    hsTypeToType,
hunk ./FrontEnd/KindInfer.hs 535
+
+aHsTypeToType kt (HsTyForall vs qt) = TForAll (aHsQualTypeToScheme kt qt)
+
hunk ./FrontEnd/KindInfer.hs 565
+forallHoist (HsTyTuple ts) = HsTyTuple (map forallHoist ts)
+forallHoist (HsTyApp a b) = HsTyApp (forallHoist a) (forallHoist b)
hunk ./FrontEnd/KindInfer.hs 577
+
+
+hsTypeToType :: Monad m => KindEnv -> HsType -> m Type
+hsTypeToType kt t = return $ aHsTypeToType kt (forallHoist t)
hunk ./FrontEnd/Representation.hs 66
+           | TForAll Scheme
hunk ./FrontEnd/Representation.hs 230
+           TForAll scheme -> do
+            r <- prettyPrintSchemeM scheme
+            return $ text "(forall . " <> r <> text ")"
hunk ./FrontEnd/Representation.hs 379
-prettyPrintSchemeM (Forall _kinds qType)
-   = prettyPrintQualTypeM qType
+prettyPrintSchemeM (Forall _kinds qType) = do
+    r <- prettyPrintQualTypeM qType
+    return r
hunk ./FrontEnd/Type.hs 96
+  kind (TForAll (Forall _ (_ :=> t))) = kind t
hunk ./FrontEnd/TypeUtils.hs 18
-module TypeUtils (aHsTypeToType,
-                  aHsTypeSigToAssumps,
+module TypeUtils (aHsTypeSigToAssumps,
hunk ./Interactive.hs 84
+    ptype x | Just r <- pprintTypeOfCons dataTable x = r
hunk ./Interactive.hs 86
-    ptype x = pprintTypeOfCons dataTable x
hunk ./Unparse.hs 5
-data Unparse a = Atom a | Pre a (Unparse a) | Fix (Unparse a) a (Unparse a) !Side !Int | Atomized (Unparse a) | Fixitized  !Side !Int a
+data Unparse a = Atom a | Pre a (Unparse a) | Fix (Unparse a) a (Unparse a) !Side !Int | Atomized (Unparse a) | Fixitized  !Side !Int (Unparse a)
hunk ./Unparse.hs 18
-fixitize :: (Side,Int) -> a -> Unparse a
+fixitize :: (Side,Int) -> Unparse a -> Unparse a
hunk ./Unparse.hs 42
-    f (Fixitized s i a) = (a, FFix s i)
+    f (Fixitized s i a) = (fst $ f a, FFix s i)
hunk ./test/Forall.hs 70
+
+-- this can't be handled yet
+--data Fred = Fred (forall a . a -> a) ((forall a . (forall b . b -> a ) -> a) -> Int)
+