[commit: ghc] wip/generalized-arrow: Hi (38de61e)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/generalized-arrow
Link       : http://ghc.haskell.org/trac/ghc/changeset/38de61e0c07cabfe05f1ade34409516054c1ffd0/ghc

>---------------------------------------------------------------

commit 38de61e0c07cabfe05f1ade34409516054c1ffd0
Author: Ben Gamari <ben at smart-cactus.org>
Date:   Fri Mar 25 13:04:39 2016 +0100

    Hi


>---------------------------------------------------------------

38de61e0c07cabfe05f1ade34409516054c1ffd0
 compiler/types/Type.hs | 71 +++++++++++++++++++++++++++++++++++---------------
 1 file changed, 50 insertions(+), 21 deletions(-)

diff --git a/compiler/types/Type.hs b/compiler/types/Type.hs
index 7354b16..c516664 100644
--- a/compiler/types/Type.hs
+++ b/compiler/types/Type.hs
@@ -657,10 +657,10 @@ repSplitAppTy_maybe :: Type -> Maybe (Type,Type)
 -- ^ Does the AppTy split as in 'splitAppTy_maybe', but assumes that
 -- any Core view stuff is already done
 repSplitAppTy_maybe (ForAllTy (Anon ty1) ty2)
-  | Just rep1 <- tyRuntimeRep_maybe ty1
-  , Just rep2 <- tyRuntimeRep_maybe ty2 = Just (TyConApp funTyCon [rep1, rep2, ty1], ty2)
-  | otherwise                           = pprPanic "repSplitAppTy_maybe" (ppr ty1 $$ ppr ty2)
-repSplitAppTy_maybe (AppTy ty1 ty2)     = Just (ty1, ty2)
+  | Just rep1 <- kindRuntimeRep_maybe ty1
+  , Just rep2 <- kindRuntimeRep_maybe ty2 = Just (TyConApp funTyCon [rep1, rep2, ty1], ty2)
+  | otherwise                             = pprPanic "repSplitAppTy_maybe" (ppr ty1 $$ ppr ty2)
+repSplitAppTy_maybe (AppTy ty1 ty2)       = Just (ty1, ty2)
 repSplitAppTy_maybe (TyConApp tc tys)
   | mightBeUnsaturatedTyCon tc || tys `lengthExceeds` tyConArity tc
   , Just (tys', ty') <- snocView tys
@@ -674,11 +674,11 @@ tcRepSplitAppTy_maybe :: Type -> Maybe (Type,Type)
 -- ^ Does the AppTy split as in 'tcSplitAppTy_maybe', but assumes that
 -- any coreView stuff is already done. Refuses to look through (c => t)
 tcRepSplitAppTy_maybe (ForAllTy (Anon ty1) ty2)
-  | isConstraintKind (typeKind ty1)     = Nothing  -- See Note [Decomposing fat arrow c=>t]
-  | Just rep1 <- tyRuntimeRep_maybe ty1
-  , Just rep2 <- tyRuntimeRep_maybe ty2 = Just (TyConApp funTyCon [rep1, rep2, ty1], ty2)
-  | otherwise                           = pprPanic "repSplitAppTy_maybe" (ppr ty1 $$ ppr ty2)
-tcRepSplitAppTy_maybe (AppTy ty1 ty2)   = Just (ty1, ty2)
+  | isConstraintKind (typeKind ty1)       = Nothing  -- See Note [Decomposing fat arrow c=>t]
+  | Just rep1 <- kindRuntimeRep_maybe ty1
+  , Just rep2 <- kindRuntimeRep_maybe ty2 = Just (TyConApp funTyCon [rep1, rep2, ty1], ty2)
+  | otherwise                             = pprPanic "repSplitAppTy_maybe" (ppr ty1 $$ ppr ty2)
+tcRepSplitAppTy_maybe (AppTy ty1 ty2)     = Just (ty1, ty2)
 tcRepSplitAppTy_maybe (TyConApp tc tys)
   | mightBeUnsaturatedTyCon tc || tys `lengthExceeds` tyConArity tc
   , Just (tys', ty') <- snocView tys
@@ -709,11 +709,11 @@ splitAppTys ty = split ty ty []
         in
         (TyConApp tc tc_args1, tc_args2 ++ args)
     split _   (ForAllTy (Anon ty1) ty2) args
-      | Just rep1 <- tyRuntimeRep_maybe ty1
-      , Just rep2 <- tyRuntimeRep_maybe ty2  = ASSERT( null args )
-                                               (TyConApp funTyCon [], [ty1,ty2])
-      | otherwise                            = pprPanic "splitAppTys" (ppr ty1 $$ ppr ty2 $$ ppr args)
-    split orig_ty _                     args = (orig_ty, args)
+      | Just rep1 <- kindRuntimeRep_maybe ty1
+      , Just rep2 <- kindRuntimeRep_maybe ty2 = ASSERT( null args )
+                                               (TyConApp funTyCon [], [rep1, rep2, ty1, ty2])
+      | otherwise                             = pprPanic "splitAppTys" (ppr ty1 $$ ppr ty2 $$ ppr args)
+    split orig_ty _                     args  = (orig_ty, args)
 
 -- | Like 'splitAppTys', but doesn't look through type synonyms
 repSplitAppTys :: Type -> (Type, [Type])
@@ -727,10 +727,12 @@ repSplitAppTys ty = split ty []
         in
         (TyConApp tc tc_args1, tc_args2 ++ args)
     split (ForAllTy (Anon ty1) ty2) args
-      | Just rep1 <- tyRuntimeRep_maybe ty1
-      , Just rep2 <- tyRuntimeRep_maybe ty2= ASSERT( null args )
-                                           (TyConApp funTyCon [], [ty1, ty2])
-      | otherwise                          = pprPanic "repSplitAppTys" (ppr ty1 $$ ppr ty2 $$ ppr args)
+      | Just rep1 <- kindRuntimeRep_maybe ty1
+      , Just rep2 <- kindRuntimeRep_maybe ty2 =
+            ASSERT( null args )
+            (TyConApp funTyCon [], [rep1, rep2, ty1, ty2])
+      | otherwise                             =
+            pprPanic "repSplitAppTys" (ppr ty1 $$ ppr ty2 $$ ppr args)
     split ty args = (ty, args)
 
 {-
@@ -803,7 +805,30 @@ pprUserTypeErrorTy ty =
                                 FunTy
                                 ~~~~~
 
-Function types are represented with (ForAllTy (Anon ...) ...)
+Note [Function types]
+~~~~~~~~~~~~~~~~~~~~~
+
+Functions (e.g. Int -> Char) are can be thought of as being applications
+of funTyCon (known in Haskell surface syntax as (->)),
+
+    (->) :: forall (r1 :: RuntimeRep) (r2 :: RuntimeRep)
+                   (a :: TYPE r1) (b :: Type r2).
+            a -> b -> *
+
+However, for efficiency's sake we represent saturated applications of (->)
+with ForAllTy. For instance, the type,
+
+    (->) r1 r2 a b
+
+is equivalent to,
+
+    ForAllTy (Anon a) b
+
+Note how the RuntimeReps are implied in the ForAllTy representation. For this
+reason we must be careful when recontructing the TyConApp representation (see,
+for instance, splitTyConApp_maybe).
+
+See #11714.
 -}
 
 isFunTy :: Type -> Bool
@@ -1003,6 +1028,10 @@ tyRuntimeRep ty
   | Just rep <- tyRuntimeRep_maybe ty = rep
   | otherwise                         = pprPanic "tyRuntimeRep" (ppr ty)
 
+-- | If given a type @a :: TYPE (rr :: RuntimeRep)@ then returns @Just rr at .
+kindRuntimeRep_maybe :: Type -> Maybe Type
+kindRuntimeRep_maybe = tyRuntimeRep_maybe . typeKind
+
 -- | Attempts to tease a type apart into a type constructor and the application
 -- of a number of arguments to that constructor. Panics if that is not possible.
 -- See also 'splitTyConApp_maybe'
@@ -1022,8 +1051,8 @@ splitTyConApp_maybe ty                           = repSplitTyConApp_maybe ty
 repSplitTyConApp_maybe :: Type -> Maybe (TyCon, [Type])
 repSplitTyConApp_maybe (TyConApp tc tys)         = Just (tc, tys)
 repSplitTyConApp_maybe (ForAllTy (Anon arg) res)
-  | Just rep1 <- tyRuntimeRep_maybe arg
-  , Just rep2 <- tyRuntimeRep_maybe res          = Just (funTyCon, [rep1, rep2, arg, res])
+  | Just rep1 <- kindRuntimeRep_maybe arg
+  , Just rep2 <- kindRuntimeRep_maybe res        = Just (funTyCon, [rep1, rep2, arg, res])
   | otherwise                                    = pprPanic "repSplitTyConApp_maybe" (ppr arg $$ ppr res)
 repSplitTyConApp_maybe _                         = Nothing