Default RuntimeRep variables unless -fprint-explicit-runtime-reps

Summary:
Addresses #11549 by defaulting `RuntimeRep` variables to `PtrRepLifted`
and adding a new compiler flag `-fprint-explicit-runtime-reps` to
disable this behavior.

This is just a guess at the right way to go about this. If it's
wrong-beyond-any-hope just say so.

Test Plan: Working on a testcase

Reviewers: goldfire, austin

Subscribers: simonpj, thomie

Differential Revision: https://phabricator.haskell.org/D1961

GHC Trac Issues: #11549

10 files changed, 144 insertions, 12 deletions

diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index c8009799df..f14a36ff7e 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -387,6 +387,7 @@ data GeneralFlag
    | Opt_PrintExplicitForalls
    | Opt_PrintExplicitKinds
    | Opt_PrintExplicitCoercions
+   | Opt_PrintExplicitRuntimeReps
    | Opt_PrintEqualityRelations
    | Opt_PrintUnicodeSyntax
    | Opt_PrintExpandedSynonyms
@@ -3353,6 +3354,7 @@ fFlagsDeps = [
   flagSpec "print-explicit-foralls"           Opt_PrintExplicitForalls,
   flagSpec "print-explicit-kinds"             Opt_PrintExplicitKinds,
   flagSpec "print-explicit-coercions"         Opt_PrintExplicitCoercions,
+  flagSpec "print-explicit-runtime-reps"      Opt_PrintExplicitRuntimeReps,
   flagSpec "print-equality-relations"         Opt_PrintEqualityRelations,
   flagSpec "print-unicode-syntax"             Opt_PrintUnicodeSyntax,
   flagSpec "print-expanded-synonyms"          Opt_PrintExpandedSynonyms,
diff --git a/compiler/prelude/TysWiredIn.hs-boot b/compiler/prelude/TysWiredIn.hs-boot
index 7216d2667c..0c8ed7e4da 100644
--- a/compiler/prelude/TysWiredIn.hs-boot
+++ b/compiler/prelude/TysWiredIn.hs-boot
@@ -13,6 +13,7 @@ constraintKind :: Kind
 
 runtimeRepTyCon, vecCountTyCon, vecElemTyCon :: TyCon
 runtimeRepTy :: Type
+ptrRepLiftedTy :: Type
 
 ptrRepUnliftedDataConTyCon, vecRepDataConTyCon :: TyCon
 
diff --git a/compiler/types/TyCoRep.hs b/compiler/types/TyCoRep.hs
index 5b54e6b9fc..9686531533 100644
--- a/compiler/types/TyCoRep.hs
+++ b/compiler/types/TyCoRep.hs
@@ -135,6 +135,7 @@ import {-# SOURCE #-} Type( isPredTy, isCoercionTy, mkAppTy
 
 import {-# SOURCE #-} Coercion
 import {-# SOURCE #-} ConLike ( ConLike(..) )
+import {-# SOURCE #-} TysWiredIn ( ptrRepLiftedTy )
 
 -- friends:
 import Var
@@ -2377,9 +2378,90 @@ maybeParen ctxt_prec inner_prec pretty
   | otherwise              = parens pretty
 
 ------------------
+
+{-
+Note [Defaulting RuntimeRep variables]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+RuntimeRep variables are considered by many (most?) users to be little more than
+syntactic noise. When the notion was introduced there was a signficant and
+understandable push-back from those with pedagogy in mind, which argued that
+RuntimeRep variables would throw a wrench into nearly any teach approach since
+they appear in even the lowly ($) function's type,
+
+    ($) :: forall (w :: RuntimeRep) a (b :: TYPE w). (a -> b) -> a -> b
+
+which is significantly less readable than its non RuntimeRep-polymorphic type of
+
+    ($) :: (a -> b) -> a -> b
+
+Moreover, unboxed types don't appear all that often in run-of-the-mill Haskell
+programs, so it makes little sense to make all users pay this syntactic
+overhead.
+
+For this reason it was decided that we would hide RuntimeRep variables for now
+(see #11549). We do this by defaulting all type variables of kind RuntimeRep to
+PtrLiftedRep. This is done in a pass right before pretty-printing
+(defaultRuntimeRepVars, controlled by -fprint-explicit-runtime-reps)
+-}
+
+-- | Default 'RuntimeRep' variables to 'LiftedPtr'. e.g.
+--
+-- @
+-- ($) :: forall (r :: GHC.Types.RuntimeRep) a (b :: TYPE r).
+--        (a -> b) -> a -> b
+-- @
+--
+-- turns in to,
+--
+-- @ ($) :: forall a (b :: *). (a -> b) -> a -> b @
+--
+-- We do this to prevent RuntimeRep variables from incurring a significant
+-- syntactic overhead in otherwise simple type signatures (e.g. ($)). See
+-- Note [Defaulting RuntimeRep variables] and #11549 for further discussion.
+--
+defaultRuntimeRepVars :: Type -> Type
+defaultRuntimeRepVars = defaultRuntimeRepVars' emptyVarSet
+
+defaultRuntimeRepVars' :: TyVarSet  -- ^ the binders which we should default
+                       -> Type -> Type
+-- TODO: Eventually we should just eliminate the Type pretty-printer
+-- entirely and simply use IfaceType; this task is tracked as #11660.
+defaultRuntimeRepVars' subs (ForAllTy (Named var vis) ty)
+  | isRuntimeRepVar var                        =
+    let subs' = extendVarSet subs var
+    in defaultRuntimeRepVars' subs' ty
+  | otherwise                                  =
+    let var' = var { varType = defaultRuntimeRepVars' subs (varType var) }
+    in ForAllTy (Named var' vis) (defaultRuntimeRepVars' subs ty)
+
+defaultRuntimeRepVars' subs (ForAllTy (Anon kind) ty) =
+    ForAllTy (Anon $ defaultRuntimeRepVars' subs kind)
+             (defaultRuntimeRepVars' subs ty)
+
+defaultRuntimeRepVars' subs (TyVarTy var)
+  | var `elemVarSet` subs                      = ptrRepLiftedTy
+
+defaultRuntimeRepVars' subs (TyConApp tc args) =
+    TyConApp tc $ map (defaultRuntimeRepVars' subs) args
+
+defaultRuntimeRepVars' subs (AppTy x y)        =
+    defaultRuntimeRepVars' subs x `AppTy` defaultRuntimeRepVars' subs y
+
+defaultRuntimeRepVars' subs (CastTy ty co)     =
+    CastTy (defaultRuntimeRepVars' subs ty) co
+
+defaultRuntimeRepVars' _    other              = other
+
+eliminateRuntimeRep :: (Type -> SDoc) -> Type -> SDoc
+eliminateRuntimeRep f ty = sdocWithDynFlags $ \dflags ->
+    if gopt Opt_PrintExplicitRuntimeReps dflags
+      then f ty
+      else f (defaultRuntimeRepVars ty)
+
 pprType, pprParendType :: Type -> SDoc
-pprType       ty = ppr_type TopPrec ty
-pprParendType ty = ppr_type TyConPrec ty
+pprType       ty = eliminateRuntimeRep (ppr_type TopPrec) ty
+pprParendType ty = eliminateRuntimeRep (ppr_type TyConPrec) ty
 
 pprTyLit :: TyLit -> SDoc
 pprTyLit = ppr_tylit TopPrec
@@ -2540,7 +2622,8 @@ ppr_fun_tail (ForAllTy (Anon ty1) ty2)
 ppr_fun_tail other_ty = [ppr_type TopPrec other_ty]
 
 pprSigmaType :: Type -> SDoc
-pprSigmaType ty = sdocWithDynFlags $ \dflags -> ppr_sigma_type dflags False ty
+pprSigmaType ty = sdocWithDynFlags $ \dflags ->
+    eliminateRuntimeRep (ppr_sigma_type dflags False) ty
 
 pprUserForAll :: [TyBinder] -> SDoc
 -- Print a user-level forall; see Note [When to print foralls]
diff --git a/docs/users_guide/using.rst b/docs/users_guide/using.rst
index bcd641fb28..3d3ef34d02 100644
--- a/docs/users_guide/using.rst
+++ b/docs/users_guide/using.rst
@@ -684,6 +684,22 @@ messages and in GHCi:
         ghci> :t MkT
         MkT :: forall (k :: BOX) (a :: k). T k a
 
+.. ghc-flag:: -fprint-explicit-runtime-reps
+
+    When :ghc-flag:`-fprint-explicit-runtime-reps` is enabled, GHC prints
+    ``RuntimeRep`` type variables for runtime-representation-polymorphic types.
+    Otherwise GHC will default these to ``PtrRepLifted``. For example,
+
+    .. code-block:: none
+
+        ghci> :t ($)
+        ($) :: (a -> b) -> a -> b
+        ghci> :set -fprint-explicit-runtime-reps
+        ghci> :t ($)
+        ($)
+          :: forall (r :: GHC.Types.RuntimeRep) a (b :: TYPE r).
+             (a -> b) -> a -> b
+
 .. ghc-flag:: -fprint-explicit-coercions
 
     Using :ghc-flag:`-fprint-explicit-coercions` makes GHC print coercions in
diff --git a/testsuite/tests/dependent/ghci/T11549.script b/testsuite/tests/dependent/ghci/T11549.script
new file mode 100644
index 0000000000..5f8c500519
--- /dev/null
+++ b/testsuite/tests/dependent/ghci/T11549.script
@@ -0,0 +1,14 @@
+:set -XTypeInType
+import GHC.Exts
+
+putStrLn "-fno-print-explicit-runtime-reps"
+:set -fno-print-explicit-runtime-reps
+:ty ($)
+:kind TYPE
+:ty error
+
+putStrLn "\n-fprint-explicit-runtime-reps"
+:set -fprint-explicit-runtime-reps
+:ty ($)
+:kind TYPE
+:ty error
diff --git a/testsuite/tests/dependent/ghci/T11549.stdout b/testsuite/tests/dependent/ghci/T11549.stdout
new file mode 100644
index 0000000000..c8449ba09f
--- /dev/null
+++ b/testsuite/tests/dependent/ghci/T11549.stdout
@@ -0,0 +1,12 @@
+-fno-print-explicit-runtime-reps
+($) :: (a -> b) -> a -> b
+TYPE :: RuntimeRep -> *
+error :: GHC.Stack.Types.HasCallStack => [Char] -> a
+
+-fprint-explicit-runtime-reps
+($) :: forall (r :: RuntimeRep) a (b :: TYPE r). (a -> b) -> a -> b
+TYPE :: RuntimeRep -> *
+error
+  :: forall (r :: RuntimeRep) (a :: TYPE r).
+     GHC.Stack.Types.HasCallStack =>
+     [Char] -> a
diff --git a/testsuite/tests/dependent/ghci/all.T b/testsuite/tests/dependent/ghci/all.T
new file mode 100644
index 0000000000..6d9332adaa
--- /dev/null
+++ b/testsuite/tests/dependent/ghci/all.T
@@ -0,0 +1,3 @@
+test('T11549',
+     normal,
+     ghci_script, ['T11549.script'])
diff --git a/testsuite/tests/dependent/should_fail/TypeSkolEscape.stderr b/testsuite/tests/dependent/should_fail/TypeSkolEscape.stderr
index a4ce1e4131..963dcbb6a3 100644
--- a/testsuite/tests/dependent/should_fail/TypeSkolEscape.stderr
+++ b/testsuite/tests/dependent/should_fail/TypeSkolEscape.stderr
@@ -2,6 +2,6 @@
 TypeSkolEscape.hs:8:1: error:
     • Quantified type's kind mentions quantified type variable
       (skolem escape)
-           type: forall (v1 :: RuntimeRep) (a1 :: TYPE v1). a1
+           type: forall a1. a1
         of kind: TYPE v
     • In the type synonym declaration for ‘Bad’
diff --git a/testsuite/tests/ghci/scripts/T7627.stdout b/testsuite/tests/ghci/scripts/T7627.stdout
index ee6dfa4f10..81a360facb 100644
--- a/testsuite/tests/ghci/scripts/T7627.stdout
+++ b/testsuite/tests/ghci/scripts/T7627.stdout
@@ -28,12 +28,6 @@ instance (Monoid a, Monoid b) => Monoid (a, b)
 data (#,#) (c :: TYPE a) (d :: TYPE b) = (#,#) c d
   	-- Defined in ‘GHC.Prim’
 (,) :: a -> b -> (a, b)
-(#,#)
-  :: forall (a :: GHC.Types.RuntimeRep) (b :: GHC.Types.RuntimeRep) (c :: TYPE
-                                                                            a) (d :: TYPE b).
-     c -> d -> (# c, d #)
+(#,#) :: c -> d -> (# c, d #)
 (  ,  ) :: a -> b -> (a, b)
-(#  ,  #)
-  :: forall (a :: GHC.Types.RuntimeRep) (b :: GHC.Types.RuntimeRep) (c :: TYPE
-                                                                            a) (d :: TYPE b).
-     c -> d -> (# c, d #)
+(#  ,  #) :: c -> d -> (# c, d #)
diff --git a/utils/mkUserGuidePart/Options/Verbosity.hs b/utils/mkUserGuidePart/Options/Verbosity.hs
index 8d5ed1aa62..5aefd22600 100644
--- a/utils/mkUserGuidePart/Options/Verbosity.hs
+++ b/utils/mkUserGuidePart/Options/Verbosity.hs
@@ -33,6 +33,13 @@ verbosityOptions =
          , flagType = DynamicFlag
          , flagReverse = "-fno-print-explicit-kinds"
          }
+  , flag { flagName = "-fprint-explicit-runtime-reps"
+         , flagDescription =
+           "Print ``RuntimeRep`` variables in types which are "++
+           "runtime-representation polymorphic."
+         , flagType = DynamicFlag
+         , flagReverse = "-fno-print-explicit-runtime-reps"
+         }
   , flag { flagName = "-fprint-unicode-syntax"
          , flagDescription =
            "Use unicode syntax when printing expressions, types and kinds. " ++