Fix #9062.
authorRichard Eisenberg <eir@cis.upenn.edu>
Tue, 10 Jun 2014 19:33:18 +0000 (15:33 -0400)
committerRichard Eisenberg <eir@cis.upenn.edu>
Wed, 11 Jun 2014 13:27:42 +0000 (09:27 -0400)
Removed (pprEqPred (coercionKind co)) in favor of
(pprType (coercionType co)).

Also had to make "~R#" a *symbolic* identifier and BuiltInSyntax
to squelch prefix notation and module prefixes in output. These
changes are both sensible independent of #9062.

compiler/basicTypes/OccName.lhs
compiler/coreSyn/CoreUtils.lhs
compiler/coreSyn/PprCore.lhs
compiler/prelude/TysPrim.lhs
compiler/types/OptCoercion.lhs
compiler/types/Type.lhs
compiler/types/TypeRep.lhs
testsuite/tests/roles/should_compile/Roles13.stderr

index 28aeff8..087298f 100644 (file)
@@ -898,9 +898,12 @@ isLexConSym cs                             -- Infix type or data constructors
   | otherwise         = startsConSym (headFS cs)
 
 isLexVarSym fs                         -- Infix identifiers e.g. "+"
+  | fs == (fsLit "~R#") = True
+  | otherwise
   = case (if nullFS fs then [] else unpackFS fs) of
       [] -> False
       (c:cs) -> startsVarSym c && all isVarSymChar cs
+        -- See Note [Classification of generated names]
 
 -------------
 startsVarSym, startsVarId, startsConSym, startsConId :: Char -> Bool
index 6f21c4e..3bf07fe 100644 (file)
@@ -217,7 +217,7 @@ mkCast expr co
 --    if to_ty `eqType` from_ty
 --    then expr
 --    else
-        WARN(not (from_ty `eqType` exprType expr), text "Trying to coerce" <+> text "(" <> ppr expr $$ text "::" <+> ppr (exprType expr) <> text ")" $$ ppr co $$ pprEqPred (coercionKind co))
+        WARN(not (from_ty `eqType` exprType expr), text "Trying to coerce" <+> text "(" <> ppr expr $$ text "::" <+> ppr (exprType expr) <> text ")" $$ ppr co $$ ppr (coercionType co))
          (Cast expr co)
 \end{code}
 
index 35c0630..f86a911 100644 (file)
@@ -121,7 +121,7 @@ ppr_expr add_par (Cast expr co)
                if gopt Opt_SuppressCoercions dflags
                then ptext (sLit "...")
                else parens $
-                        sep [ppr co, dcolon <+> pprEqPred (coercionKind co)]
+                        sep [ppr co, dcolon <+> ppr (coercionType co)]
 
 
 ppr_expr add_par expr@(Lam _ _)
index 0547c91..de151fd 100644 (file)
@@ -159,7 +159,15 @@ mkPrimTc fs unique tycon
   = mkWiredInName gHC_PRIM (mkTcOccFS fs) 
                  unique
                  (ATyCon tycon)        -- Relevant TyCon
-                 UserSyntax            -- None are built-in syntax
+                 UserSyntax
+
+mkBuiltInPrimTc :: FastString -> Unique -> TyCon -> Name
+mkBuiltInPrimTc fs unique tycon
+  = mkWiredInName gHC_PRIM (mkTcOccFS fs) 
+                 unique
+                 (ATyCon tycon)        -- Relevant TyCon
+                 BuiltInSyntax
+
 
 charPrimTyConName, intPrimTyConName, int32PrimTyConName, int64PrimTyConName, wordPrimTyConName, word32PrimTyConName, word64PrimTyConName, addrPrimTyConName, floatPrimTyConName, doublePrimTyConName, statePrimTyConName, proxyPrimTyConName, realWorldTyConName, arrayPrimTyConName, arrayArrayPrimTyConName, smallArrayPrimTyConName, byteArrayPrimTyConName, mutableArrayPrimTyConName, mutableByteArrayPrimTyConName, mutableArrayArrayPrimTyConName, smallMutableArrayPrimTyConName, mutVarPrimTyConName, mVarPrimTyConName, tVarPrimTyConName, stablePtrPrimTyConName, stableNamePrimTyConName, bcoPrimTyConName, weakPrimTyConName, threadIdPrimTyConName, eqPrimTyConName, eqReprPrimTyConName, voidPrimTyConName :: Name
 charPrimTyConName            = mkPrimTc (fsLit "Char#") charPrimTyConKey charPrimTyCon
@@ -176,7 +184,7 @@ statePrimTyConName            = mkPrimTc (fsLit "State#") statePrimTyConKey stat
 voidPrimTyConName             = mkPrimTc (fsLit "Void#") voidPrimTyConKey voidPrimTyCon
 proxyPrimTyConName            = mkPrimTc (fsLit "Proxy#") proxyPrimTyConKey proxyPrimTyCon
 eqPrimTyConName               = mkPrimTc (fsLit "~#") eqPrimTyConKey eqPrimTyCon
-eqReprPrimTyConName           = mkPrimTc (fsLit "~R#") eqReprPrimTyConKey eqReprPrimTyCon
+eqReprPrimTyConName           = mkBuiltInPrimTc (fsLit "~R#") eqReprPrimTyConKey eqReprPrimTyCon
 realWorldTyConName            = mkPrimTc (fsLit "RealWorld") realWorldTyConKey realWorldTyCon
 arrayPrimTyConName           = mkPrimTc (fsLit "Array#") arrayPrimTyConKey arrayPrimTyCon
 byteArrayPrimTyConName       = mkPrimTc (fsLit "ByteArray#") byteArrayPrimTyConKey byteArrayPrimTyCon
index 12787b2..dc7ab78 100644 (file)
@@ -88,8 +88,8 @@ opt_co env sym co
  = pprTrace "opt_co {" (ppr sym <+> ppr co $$ ppr env) $
    co1 `seq`
    pprTrace "opt_co done }" (ppr co1) $
-   (WARN( not same_co_kind, ppr co  <+> dcolon <+> pprEqPred (Pair s1 t1)
-                         $$ ppr co1 <+> dcolon <+> pprEqPred (Pair s2 t2) )
+   (WARN( not same_co_kind, ppr co  <+> dcolon <+> ppr (coercionType co)
+                         $$ ppr co1 <+> dcolon <+> ppr (coercionType co1) )
     WARN( not (coreEqCoercion co1 simple_result),
            (text "env=" <+> ppr env) $$
            (text "input=" <+> ppr co) $$
index 13ceb44..0e93c96 100644 (file)
@@ -130,7 +130,7 @@ module Type (
         -- * Pretty-printing
         pprType, pprParendType, pprTypeApp, pprTyThingCategory, pprTyThing,
         pprTvBndr, pprTvBndrs, pprForAll, pprUserForAll, pprSigmaType,
-        pprEqPred, pprTheta, pprThetaArrowTy, pprClassPred,
+        pprTheta, pprThetaArrowTy, pprClassPred,
         pprKind, pprParendKind, pprSourceTyCon,
 
         -- * Tidying type related things up for printing
index 2a38a5d..c93a653 100644 (file)
@@ -39,7 +39,7 @@ module TypeRep (
         -- Pretty-printing
        pprType, pprParendType, pprTypeApp, pprTvBndr, pprTvBndrs,
        pprTyThing, pprTyThingCategory, pprSigmaType,
-       pprEqPred, pprTheta, pprForAll, pprUserForAll,
+       pprTheta, pprForAll, pprUserForAll,
         pprThetaArrowTy, pprClassPred,
         pprKind, pprParendKind, pprTyLit, suppressKinds,
        TyPrec(..), maybeParen, pprTcApp, 
@@ -82,7 +82,6 @@ import CoAxiom
 import PrelNames
 import Outputable
 import FastString
-import Pair
 import Util
 import DynFlags
 
@@ -515,18 +514,6 @@ pprKind, pprParendKind :: Kind -> SDoc
 pprKind       = pprType
 pprParendKind = pprParendType
 
-------------------
-pprEqPred :: Pair Type -> SDoc
--- NB: Maybe move to Coercion? It's only called after coercionKind anyway. 
-pprEqPred (Pair ty1 ty2) 
-  = sep [ ppr_type FunPrec ty1
-        , nest 2 (ptext (sLit "~#"))
-        , ppr_type FunPrec ty2]
-    -- Precedence looks like (->) so that we get
-    --    Maybe a ~ Bool
-    --    (a->a) ~ Bool
-    -- Note parens on the latter!
-
 ------------
 pprClassPred :: Class -> [Type] -> SDoc
 pprClassPred clas tys = pprTypeApp (classTyCon clas) tys
index 647e59b..b0dda24 100644 (file)
@@ -13,8 +13,7 @@ Roles13.convert =
   `cast` (<Roles13.Wrap Roles13.Age>_R
           -> Roles13.NTCo:Wrap[0] Roles13.NTCo:Age[0]
           :: (Roles13.Wrap Roles13.Age -> Roles13.Wrap Roles13.Age)
-               ~#
-             (Roles13.Wrap Roles13.Age -> GHC.Types.Int))
+             ~R# (Roles13.Wrap Roles13.Age -> GHC.Types.Int))