What is the preferred alternative to Fin from Idris in Haskell

前端 未结 2 2069
我在风中等你
我在风中等你 2021-02-20 06:20

I would like to have a type which can contain values 0 to n, where n lives on the type level.

I was trying something like:

import GHC.TypeLits
import Da         


        
2条回答
  •  小蘑菇
    小蘑菇 (楼主)
    2021-02-20 07:16

    rampion suggested pattern synonyms, and I agreed, but it is admittedly not entirely trivial to work out how to structure their signatures properly. Thus I figured I'd write a proper answer to give the full code.

    First, the usual boilerplate:

    {-# LANGUAGE DataKinds #-}
    {-# LANGUAGE PatternSynonyms #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE GADTs #-}
    {-# LANGUAGE KindSignatures #-}
    {-# LANGUAGE ViewPatterns #-}
    {-# LANGUAGE StandaloneDeriving #-}
    {-# LANGUAGE Trustworthy #-}
    
    module FakeFin (Nat (..), Fin (FZ, FS), FinView (..), viewFin) where
    import Numeric.Natural
    import Unsafe.Coerce
    

    Now the basic types:

    data Nat = Z | S Nat
    
    -- Fin *must* be exported abstractly (or placed in an Unsafe
    -- module). Users can use its constructor to implement
    -- unsafeCoerce!
    newtype Fin (n :: Nat) = Fin Natural
    deriving instance Show (Fin n)
    

    It is much easier to work via a view type rather than directly, so let's define one:

    data FinView n where
      VZ :: FinView ('S n)
      VS :: !(Fin n) -> FinView ('S n)
    deriving instance Show (FinView n)
    

    It is important to note that we could have defined FinView using explicit equality constraints, because we will have to think in those terms to give correct pattern signatures:

    data FinView n where
      VZ :: n ~ 'S m => FinView n
      VS :: n ~ 'S m => !(Fin m) -> FinView n
    

    Now the actual view function:

    viewFin :: Fin n -> FinView n
    viewFin (Fin 0) = unsafeCoerce VZ
    viewFin (Fin n) = unsafeCoerce (VS (Fin (n - 1)))
    

    The pattern signatures precisely mirror the signatures of the FinView constructors.

    pattern FZ :: () => n ~ 'S m => Fin n
    pattern FZ <- (viewFin -> VZ) where
      FZ = Fin 0
    
    pattern FS :: () => n ~ 'S m => Fin m -> Fin n
    pattern FS m <- (viewFin -> VS m) where
      FS (Fin m) = Fin (1 + m)
    
    -- Let GHC know that users need only match on `FZ` and `FS`.
    -- This pragma only works for GHC 8.2 (and presumably future
    -- versions).
    {-# COMPLETE FZ, FS #-}
    

    For completeness (because it took me rather more effort to write this than I expected), here's one way to write unsafeCoerce if this module accidentally exports the Fin data constructor. I imagine there are probably simpler ways.

    import Data.Type.Equality
    
    type family YahF n a b where
      YahF 'Z a _ = a
      YahF _ _ b = b
    
    newtype Yah n a b = Yah (YahF n a b)
    
    {-# NOINLINE finZBad #-}
    finZBad :: 'Z :~: n -> Fin n -> a -> b
    finZBad pf q =
      case q of
        FZ -> blah (trans pf Refl)
        FS _ -> blah (trans pf Refl)
      where
        blah :: forall a b m. 'Z :~: 'S m -> a -> b
        blah pf2 a = getB pf2 (Yah a)
    
        {-# NOINLINE getB #-}
        getB :: n :~: 'S m -> Yah n a b -> b
        getB Refl (Yah b) = b
    
    myUnsafeCoerce :: a -> b
    myUnsafeCoerce = finZBad Refl (Fin 0)
    

    finZBad is where all the action happens, but it doesn't do anything remotely improper! If someone really gives us a non-bottom value of type Fin 'Z, then something has already gone terribly wrong. The explicit type equality evidence here is necessary because if GHC sees code wanting 'Z ~ 'S m, it will simply reject it out of hand; GHC doesn't really like hypothetical reasoning in constraints. The NOINLINE annotations are necessary because GHC's simplifier itself uses type information; handling evidence of things it knows very well are impossible confuses it terribly, with extremely arbitrary results. So we block it up and successfully implement The Evil Function.

提交回复
热议问题