A family of types (++) is defined; any way to prove that (vs ++ us) ~ '[] implies (vs ~' []) and (us ~ '[])?

Definition:

type family (xs :: [*]) ++ (ys :: [*]) where
  '[] ++ ys = ys
  (x ': xs) ++ ys = x ': (xs ++ ys)

      

I have a GADT, sort of like

data Foo :: [*] -> * -> * where
  Foo0 :: a -> Foo '[] a
  Foo1 :: Foo '[a] a
  Foo2 :: Foo vs a -> Foo us a -> Foo (vs ++ us) a

      

And I want to do something like

test :: Foo '[] Int -> Int
test (Foo0 x) = x
test (Foo2 x y) = test x + test y

      

But I cannot use test

on x

or y

, because x ~ Foo '[] Int

u y ~ Foo '[] Int

must be proven. But what I want to say is that this is supported by the fact vs ++ us ~ '[]

that individual is vs

both us

of x

and of y

necessity '[]

.

Is there a way to do this with type families, or perhaps switch to a multiple class parameter approach using frameworks?

Thank!

+3


source to share


2 answers


Don't touch the green smile!

The presence of "green slugs" functions in the return types of constructors is a danger sign.



The simplest workaround is to generalize test

and then instantiate:

gtest :: Foo xs Int -> Int
gtest (Foo0 x) = x
gtest (Foo2 x y) = gtest x + gtest y

test :: Foo '[] Int -> Int
test = gtest

      

+6


source


You can add two types of families to serve as inverters ++

, and without loss of generality, add them as constraints on the Foo2 constructor. Through these reverse type families, the GHC will be able to infer exactly what you ask of it.

Here's an example implementation CutX

and CutY

such that r ~ a ++ b

<=> a ~ CutY r b

<=> b ~ CutX r a

.



type family (xs :: [*]) ++ (ys :: [*]) where
  '[] ++ ys = ys
  (x ': xs) ++ ys = x ': (xs ++ ys)

type family CutX (rs :: [*]) (xs :: [*]) where
    CutX '[] xs = '[]
    CutX rs '[] = rs
    CutX (r ': rs) (x ': xs) = CutX rs xs

type family ZipWithConst (xs :: [*]) (ys :: [*]) where
    ZipWithConst '[] ys = '[]
    ZipWithConst xs '[] = '[]
    ZipWithConst (x ': xs) (y ': ys) = y ': ZipWithConst xs ys

type CutY rs ys = ZipWithConst rs (CutX rs ys)

data Foo :: [*] -> * -> * where
  Foo0 :: a -> Foo '[] a
  Foo1 :: Foo '[a] a
  Foo2 :: (rs ~ (vs ++ us), us ~ CutX rs vs, vs ~ CutY rs us) => Foo vs a -> Foo us a -> Foo rs a

      

+4


source







All Articles