Uncurry for n-ary functions

后端 未结 2 1167
自闭症患者
自闭症患者 2021-01-06 02:32

I have a type level numbers

data Z   deriving Typeable
data S n deriving Typeable

and n-ary functions (code from fixed-vector package)

相关标签:
2条回答
  • 2021-01-06 02:59

    You can do this without any type classes by constructing a datatype which can represent the type Nat on the data level:

    data Nat = Z | S Nat
    
    type family   Fn (n :: Nat) a b
    type instance Fn Z     a b = b
    type instance Fn (S n) a b = a -> Fn n a b
    
    type family   Add (n :: Nat) (m :: Nat) :: Nat
    type instance Add Z          m = m
    type instance Add (S n)      m = S (Add n m)
    
    newtype Fun n a b = Fun { unFun :: Fn n a b }
    
    data SNat (n :: Nat) where 
      SZ :: SNat Z
      SS :: SNat n -> SNat (S n)
    
    uncurryN :: forall n m a b . SNat n -> Fun (Add n m) a b -> Fun n a (Fun m a b) 
    uncurryN SZ f = Fun f
    uncurryN (SS (n :: SNat n')) g = Fun (\x -> unFun (uncurryN n (Fun (unFun g x)) :: Fun n' a (Fun m a b)))
    

    If you don't like explicitly mentioning the n parameter, thats ok since you can always go back and forth between a function which takes an parameter as a type class and which takes a parameter as data:

    class SingI (a :: k) where
      type Sing :: k -> * 
      sing :: Sing a
    
    instance SingI Z where 
      type Sing = SNat
      sing = SZ
    
    instance SingI n => SingI (S n) where
      type Sing = SNat
      sing = SS sing 
    
    toNatSing :: (SNat n -> t) -> (SingI n => t)
    toNatSing f = f sing 
    
    fromNatSing :: (SingI n => t) -> (SNat n -> t)
    fromNatSing f SZ = f 
    fromNatSing f (SS n) = fromNatSing f n 
    
    uncurryN' :: SingI n => Fun (Add n m) a b -> Fun n a (Fun m a b) 
    uncurryN' = toNatSing uncurryN
    
    0 讨论(0)
  • 2021-01-06 03:15

    This required a bit of care in unwrapping/rewrapping the Fun newtype. I also exploited the DataKinds extension.

    {-# LANGUAGE DataKinds, KindSignatures, TypeFamilies, 
        MultiParamTypeClasses, ScopedTypeVariables, FlexibleInstances #-}
    {-# OPTIONS -Wall #-}
    
    -- | Type-level naturals.
    data Nat = Z | S Nat
    
    -- | Type family for n-ary functions.
    type family   Fn (n :: Nat) a b
    type instance Fn Z     a b = b
    type instance Fn (S n) a b = a -> Fn n a b
    
    -- | Addition.
    type family   Add (n :: Nat) (m :: Nat) :: Nat
    type instance Add Z          m = m
    type instance Add (S n)      m = S (Add n m)
    
    -- | Newtype wrapper which is used to make 'Fn' injective.
    newtype Fun n a b = Fun { unFun :: Fn n a b }
    
    class UncurryN (n :: Nat) (m :: Nat) a b where
        uncurryN :: Fun (Add n m) a b -> Fun n a (Fun m a b)
    
    instance UncurryN Z m a b where
        uncurryN g = Fun g
    
    instance UncurryN n m a b => UncurryN (S n) m a b where
        uncurryN g = Fun (\x -> unFun (uncurryN (Fun (unFun g x)) :: Fun n a (Fun m a b)))
    
    {- An expanded equivalent with more signatures:
    
    instance UncurryN n m a b => UncurryN (S n) m a b where
        uncurryN g = let f :: a -> Fn n a (Fun m a b)
                         f x = let h :: Fun (Add n m) a b
                                   h = Fun ((unFun g :: Fn (Add (S n) m) a b) x)
                               in unFun (uncurryN h :: Fun n a (Fun m a b))
                         in Fun f
    -}
    
    0 讨论(0)
提交回复
热议问题