[GHC] #14255: Type-indexed type fingerprints

[GHC]

#14255: Type-indexed type fingerprints
-------------------------------------+-------------------------------------
        Reporter:  dfeuer            |                Owner:  (none)
            Type:  feature request   |               Status:  new
        Priority:  normal            |            Milestone:
       Component:  Core Libraries    |              Version:  8.2.1
      Resolution:                    |             Keywords:  Typeable
Operating System:  Unknown/Multiple  |         Architecture:
                                     |  Unknown/Multiple
 Type of failure:  None/Unknown      |            Test Case:
      Blocked By:                    |             Blocking:
 Related Tickets:                    |  Differential Rev(s):
       Wiki Page:                    |
-------------------------------------+-------------------------------------

Comment (by dfeuer):

 Just so I don't lose the idea, we can implement a `Typeable`-alike for
 such fingerprints that leverages the existing `Typeable` infrastructure
 but avoids the cost of manipulating any more `TypeRep`s than necessary:

 {{{#!hs
 data FingerprintIx (a :: k)

 appFingerprintIx :: forall j k (f :: j -> k) (x :: j).
        FingerprintIx f -> FingerprintIx x -> FingerprintIx (f x)
 appFingerprintIx _ _ = undefined

 funFingerprintIx :: forall r1 r2 (arg :: TYPE r1) (res :: TYPE r2).
        FingerprintIx arg -> FingerprintIx res -> FingerprintIx (arg ->
 res)
 funFingerprintIx _ _ = undefined

 foo :: TypeRep a -> FingerprintIx a
 foo _ = undefined

 class HasFingerprintIx (a :: k) where
   fpi :: FingerprintIx a

 data Expr where
   Base :: Expr
   FunE :: Expr -> Expr -> Expr
   AppE :: Expr -> Expr -> Expr

 type family From (a :: k) :: Expr where
   From (a -> b) = 'FunE (From a) (From b)
   From (f x) = 'AppE (From f) (From x)
   From x = 'Base

 class HasFingerprintIx' (e :: Expr) (a :: k) where
   fpi' :: FingerprintIx a
 instance Typeable a => HasFingerprintIx' 'Base a where
   fpi' = foo typeRep
 instance    (HasFingerprintIx' e1 f, HasFingerprintIx' e2 x)
          => HasFingerprintIx' ('AppE e1 e2) ((f :: j -> k) x) where
   fpi' = appFingerprintIx (fpi' @_ @e1) (fpi' @_ @e2)
 instance    (HasFingerprintIx' e1 arg, HasFingerprintIx' e2 res)
          => HasFingerprintIx' ('FunE e1 e2)
                     ((arg :: TYPE r1) -> (res :: TYPE r2)) where
   fpi' = funFingerprintIx (fpi' @_ @e1) (fpi' @_ @e2)

 instance (e ~ From a, HasFingerprintIx' e a) => HasFingerprintIx (a :: k)
 where
   fpi = fpi' @_ @e
 }}}

-- 
Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/14255#comment:5>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler