[commit: ghc] wip/ttypeable: Fix recursive fingerprints (06ede7f)

[git at git.haskell.org]

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

On branch  : wip/ttypeable
Link       : http://ghc.haskell.org/trac/ghc/changeset/06ede7f4ce148fdda5ec5f8a24f8f7f5ca3fa7cd/ghc

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

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

    Fix recursive fingerprints


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

06ede7f4ce148fdda5ec5f8a24f8f7f5ca3fa7cd
 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 7a3344e..bb2bcc2 100644
--- a/libraries/base/Data/Typeable/Internal.hs
+++ b/libraries/base/Data/Typeable/Internal.hs
@@ -429,11 +429,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
@@ -442,10 +451,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
@@ -454,7 +463,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)