[commit: ghc] wip/ttypeable: Fix recursive fingerprints (42b3de3)

[git at git.haskell.org]

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

On branch  : wip/ttypeable
Link       : http://ghc.haskell.org/trac/ghc/changeset/42b3de31be95c2202cea91b92e9f111d159f39fc/ghc

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

commit 42b3de31be95c2202cea91b92e9f111d159f39fc
Author: Ben Gamari <ben at smart-cactus.org>
Date:   Wed Mar 16 11:53:01 2016 +0100

    Fix recursive fingerprints


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

42b3de31be95c2202cea91b92e9f111d159f39fc
 libraries/base/Data/Typeable/Internal.hs | 17 +++++++++++++----
 1 file changed, 13 insertions(+), 4 deletions(-)

diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs
index fc425a0..0d69f7a 100644
--- a/libraries/base/Data/Typeable/Internal.hs
+++ b/libraries/base/Data/Typeable/Internal.hs
@@ -434,11 +434,20 @@ For this reason we are forced to define their representations
 manually.
 -}
 
+-- | We can't use 'mkTrCon' here as it requires the fingerprint of the kind
+-- which is knot-tied.
+mkPrimTrCon :: forall k (a :: k). TyCon -> TypeRep k -> TypeRep a
+mkPrimTrCon tc kind = TrTyCon fpr tc kind
+  where
+    fpr_tc  = tyConFingerprint tc
+    fpr_tag = fingerprintString "prim"
+    fpr     = fingerprintFingerprints [fpr_tag, fpr_tc]
+
 mkPrimTyCon :: String -> TyCon
 mkPrimTyCon = mkTyCon "ghc-prim" "GHC.Prim"
 
 trTYPE :: TypeRep TYPE
-trTYPE = mkTrCon (mkPrimTyCon "TYPE") runtimeRep_arr_type
+trTYPE = mkPrimTrCon (mkPrimTyCon "TYPE") runtimeRep_arr_type
   where
     runtimeRep_arr :: TypeRep ((->) RuntimeRep)
     runtimeRep_arr = mkTrApp trArrow trRuntimeRep
@@ -447,10 +456,10 @@ trTYPE = mkTrCon (mkPrimTyCon "TYPE") runtimeRep_arr_type
     runtimeRep_arr_type = mkTrApp runtimeRep_arr star
 
 trRuntimeRep :: TypeRep RuntimeRep
-trRuntimeRep = mkTrCon (mkPrimTyCon "RuntimeRep") star
+trRuntimeRep = mkPrimTrCon (mkPrimTyCon "RuntimeRep") star
 
 tr'PtrRepLifted :: TypeRep 'PtrRepLifted
-tr'PtrRepLifted = mkTrCon (mkPrimTyCon "'PtrRepLifted") trRuntimeRep
+tr'PtrRepLifted = mkPrimTrCon (mkPrimTyCon "'PtrRepLifted") trRuntimeRep
 
 trTYPE'PtrRepLifted :: TypeRep (TYPE 'PtrRepLifted)
 trTYPE'PtrRepLifted = mkTrApp trTYPE tr'PtrRepLifted
@@ -459,7 +468,7 @@ trArrowTyCon :: TyCon
 trArrowTyCon = mkPrimTyCon "->"
 
 trArrow :: TypeRep (->)
-trArrow = mkTrCon trArrowTyCon star_arr_star_arr_star
+trArrow = mkPrimTrCon trArrowTyCon star_arr_star_arr_star
 
 -- Some useful aliases
 star :: TypeRep (TYPE 'PtrRepLifted)