[Haskell-cafe] Consistency issue with type level numeric literals

Iavor Diatchki iavor.diatchki at gmail.com
Wed Jan 1 21:47:09 UTC 2014


Hello,

Yep, in 7.8 these are actually built-in constructors (which are not open
families) so if you try to define a custom instance you get an error about
an illegal instance for a closed type family.

Happy new year!
Iavor
On Dec 30, 2013 6:23 AM, "Simon Peyton-Jones" <simonpj at microsoft.com> wrote:

>  Iavor
>
>
>
> Shouldn’t (+) be a closed type family (now that we have such things)?
> Then the user couldn’t give new instances.
>
>
>
> Simon
>
>
>
> *From:* Haskell-Cafe [mailto:haskell-cafe-bounces at haskell.org] *On Behalf
> Of *Iavor Diatchki
> *Sent:* 29 December 2013 18:30
> *To:* oleg at okmij.org
> *Cc:* Haskell Cafe
> *Subject:* Re: [Haskell-cafe] Consistency issue with type level numeric
> literals
>
>
>
> Hi Oleg,
>
>
>
> yes, this is a bug, you are not supposed to define custom instances for
> the built-in operators.  I just left it open until we hook in the solver.
>
>
>
> Happy holidays,
>
> -Iavor
>
>
>
> On Sat, Dec 28, 2013 at 12:54 AM, <oleg at okmij.org> wrote:
>
>
> GHC 7.6.3 has quite convenient type-level numeric literals. We can use
> numbers like 1 and 2 in types. However, using the type level numeral
> has been quite a bit of a challenge, illustrated, for example, by
> the following SO question.
>
>
> http://stackoverflow.com/questions/20809998/type-level-nats-with-literals-and-an-injective-successor
>
> It seems the challenge has the reason: the type level numerals and
> their operations provided in GHC.TypeLits have a consistency
> issue. The following code demonstrates the issue: it constructs two
> distinct values of the type Sing 2. Singletons aren't singletons.
>
> {-# LANGUAGE KindSignatures #-}
> {-# LANGUAGE DataKinds #-}
> {-# LANGUAGE ScopedTypeVariables #-}
> {-# LANGUAGE TypeOperators #-}
> {-# LANGUAGE TypeFamilies #-}
> {-# LANGUAGE GADTs #-}
> {-# LANGUAGE PolyKinds #-}
>
> module NotSing where
>
> import GHC.TypeLits
>
> -- GHC strangely enough lets us define instances for (+)
> type instance 1 + 1 = 0
> type instance 0 + 1 = 2
>
> -- A singular representative of 1::Nat
> s1 :: Sing 1
> s1 = withSing id
>
> -- A singular representative of 2::Nat
> s2 :: Sing 2
> s2 = withSing id
>
> is2 :: IsZero 0
> is2 = IsSucc s1
>
> tran :: IsZero 0 -> Sing 2
> tran (IsSucc x) = case isZero x of
>                    IsSucc y -> case isZero y of
>                                 IsZero -> x
>
> -- Another singular representative of 2::Nat
> -- A singular representative of 2::Nat
> s2' :: Sing 2
> s2' = tran is2
>
>
> {-
> *NotSing> s2
> 2
> *NotSing> s2'
> 1
> -}
>
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-Cafe at haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe
>
>
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20140101/8795cb33/attachment.html>


More information about the Haskell-Cafe mailing list