A question about run-time errors when class members are undefined

Philippa Cowderoy flippa at flippac.org
Sat Oct 6 03:33:18 UTC 2018


You're implicitly arguing that no language should have support for 
declaring informal intentions. That's rather more controversial than you 
might think and it's worth separating out as a subject.

The fact you cheerfully talk about making return and bind inherently 
related via superclass constraints is pretty suggestive. Away from 
monads, there are a lot of other uses for return-like behaviour that 
have a different (if often-related) set of laws. Which is exactly why 
many people want them to be completely separate superclasses of Monad. 
It's only when they're used to form a monad that those extra laws show 
up. Which no, Haskell can't enforce, but there's a big difference 
between "this breaks because seq in a partial language weirds things" 
and "this would be broken in a total setting too". What happens when I 
legitimately want both operations but a different set of laws, and don't 
want my stuff being passed to things that reasonably expect the monad 
laws to hold?

Asking a researcher who's producing actual results "what's the point?" 
is more than a little inflammatory, too. Helium is not accountable to us.


On 06/10/2018 04:18, Anthony Clayden wrote:
>
> On Sat, 6 Oct 2018 at 9:47 AM, Petr Pudlák <redirect at vodafone.co.nz 
> <mailto:redirect at vodafone.co.nz>> wrote:
>
>
>     IIRC one of the arguments against having many separate classes is
>     that a class is not a just set of methods, it's also the relations
>     between them,
>
>
> Hi Petr, I was talking about splitting out Haskell's current class 
> hierarchy as a step towards doing away with classes altogether. If 
> your language insists on methods being held in classes, that's just 
> tedious bureacracy to invent class names.
>
> The relations between classes (including between single-method 
> classes) can be captured through superclass constraints. For example, 
> in the Haskell 2010 report
>
> class (Eq a, Show a) => Num a where ...
>
>     such as the important laws between `return` and `>>=`. And then
>     for example a class with just `return` doesn't give any
>     information what `return x` means or what should be its properties.
>
>
> Then make Bind a superclass constraint on `return` (or vice versa, or 
> both ways).
>
> Just as the laws for Num's methods are defined in terms of equality
>
> x + negate x == fromInteger 0          -- for example
>
> Talking about laws is a red herring: you can't declare the laws/the 
> compiler doesn't enforce them or rely on them in any way. Indeed the 
> Lensaholics seem to take pleasure in building lenses that break the 
> (van Laarhoven) laws.
>
>
>
>     That said, one of really painful points of Haskell is that
>     refactoring a hierarchy of type-classes means breaking all the
>     code that implements them. This was also one of the main reasons
>     why reason making Applicative a superclass of Monad took so long.
>     It'd be much nicer to design type-classes in such a way that an
>     implementation doesn't have to really care about the exact hierarchy.
>
>
> Yes that's what I was saying. Unfortunately for Haskell's Num class, I 
> think it's just too hard. So a new language has an opportunity to 
> avoid that. If OTOH Helium wants to slavishly follow Haskell, I'm 
> wondering what is the point of Helium.
>
> With Applicative, IIRC, refactoring had to wait until we got 
> Constraint kinds and type families that could produce them. Would 
> Helium want to put all that into a language aimed at beginners?
>
>
>      For example, in Haskell we could have
>
>     class (Return m, Bind m) => Monad m where
>
>     without any methods specified. But instances of `Monad` should be
>     only such types for which `return` and `>>=` satisfy the monad laws.
>
>
> First: what does "satisfy the xxx laws" mean? The Haskell report and 
> GHC's Prelude documentation state a bunch of laws; and it's a good 
> discipline to write down laws if you're creating a class; but it's 
> only documentation. Arguably IO, the most commonly used Monad, breaks 
> the Monad laws in rather serious ways because it imposes sequence of 
> execution; and it would be unfit for purpose if it were pure/lazy 
> function application.
>
> Then: what do you think a language could do to detect if some instance 
> satisfies the laws? (Even supposing you could declare them.)
>
>
>     And this would distinguish them from types that have both `Return`
>     and `Bind` instances, but don't satisfy the laws.
>
>
> You could have distinct classes/distinct operators. Oh, but then `do` 
> dotation would break.
>
>
>     Unfortunately I'm not sure if there is a good solution for
>     achieving both these directions.
>
>
> I don't think there's any solution for achieving "satisfy the xxx laws".
>
>
> AntC
>
>
>     čt 4. 10. 2018 v 3:56 odesílatel Anthony Clayden
>     <anthony_clayden at clear.net.nz
>     <mailto:anthony_clayden at clear.net.nz>> napsal:
>
>         > We are adding classes and instances to Helium.
>
>         > We wondered about the aspect that it is allowed to have a class instance
>
>         > of which not all fields have a piece of code/value associated with them, ...
>
>         I have a suggestion for that. But first let me understand where you're going with Helium. Are you aiming to slavishly reproduce Haskell's classes/instances, or is this a chance for a rethink?
>
>         Will you want to include associated types and associated datatypes in the classes? Note those are just syntactic sugar for top-level type families and data families. It does aid readability to put them within the class.
>
>         I would certainly rethink the current grouping of methods into classes. Number purists have long wanted to split class Num into Additive vs Multiplicative. (Additive would be a superclass of Multiplicative.) For the Naturals perhaps we want Presburger arithmetic then Additive just contains (+), with `negate` certainly in a different class, perhaps (-) subtract also in a dedicated class. Also there's people wanting Monads with just `bind` not `return`. But restructuring the Prelude classes/methods is just too hard with all that legacy code. Even though you should be able to do:
>
>         class (Additive a, Subtractive a, Negative a, Multiplicative a, Divisive a) => Num a
>
>         Note there's a lot of classes with a single method, and that seems to be an increasing trend. Historically it wasn't so easy in Haskell to do that superclass constraints business; if it had been perhaps there would be more classes with a single method. Then there's some disadvantages to classes holding multiple methods:
>
>         * the need to provide an overloading for every method, even though it may not make sense
>
>            (or suffer a run-time error, as you say)
>
>         * the inability to 'fine tune' methods for a specific datatype [**]
>
>         * an internal compiler/object code cost of passing a group of methods in a dictionary as tuple
>
>            (as apposed to directly selecting a single method)
>
>         [**] Nats vs Integrals vs Fractionals for `Num`; and (this will be controversial, but ...) Some people want to/some languages do use (+) for concatenating Strings/lists. But the other methods in `Num` don't make any sense.
>
>         If all your classes have a single method, the class name would seem to be superfluous, and the class/instance decl syntax seems too verbose.
>
>         So here's a suggestion. I'll need to illustrate with some definite syntax, but there's nothing necessary about it. (I'll borrow the Explicit Type Application `@`.) To give an instance overloading for method `show` or (==)
>
>         show @Int = primShowInt                     -- in effect pattern matching on the type
>
>         (==) @Int = primEqInt                       -- so see showList below
>
>         That is: I'm giving an overloading for those methods on type `Int`. How do I declare those methods are overloadable? In their signature:
>
>         show @a :: a -> String                      -- compare show :: Show a => a -> String
>
>         (==) @a :: a -> a -> Bool
>
>         Non-overladable functions don't have `@a` to the left of `::`.
>
>         How do I show that a class has a superclass constraint? That is: a method has a supermethod constraint, we'll still use `=>`:
>
>         show @a :: showsPrec @a => a -> String      -- supermethod constraint
>
>         show @[a] :: show a => [a] -> String        -- instance decl, because not bare a, with constraint =>
>
>         show @[a] xss = showList xss
>
>         (*) @a :: (+) @a => a -> a -> a
>
>         Is this idea completely off the wall? Take a look at Wadler's original 1988 memo introducing what became type classes.
>         http://homepages.inf.ed.ac.uk/wadler/papers/class-letter/class-letter.txt
>
>         It reviews several possible designs, but not all those possibilities made it into his paper (with Stephen Blott) later in 1988/January 1989. In particular look at Section 1's 'Simple overloading'. It's what I'm suggesting above (modulo a bit of syntax). At the end of Section 1, Wadler rejects this design because of "potential blow-ups". But he should have pushed the idea a bit further. Perhaps he was scared to allow function/method names into type signatures? (I've already sneaked that in above with constraints.) These days Haskell is getting more relaxed about namespaces: the type `@`pplication exactly allows type names appearing in terms. So to counter his example, the programmer writes:
>
>         square x = x * x                             -- no explicit signature given
>
>         square :: (*) @a => a -> a                   -- signature inferred, because (*) is overloaded
>
>         rms = sqrt . square                          -- no explicit signature
>
>         rms :: sqrt @a => a -> a                     -- signature inferred
>
>         Note the inferred signature for `rms` doesn't need `(*) @a` even though it's inferred from `square`. Because (*) is a supermethod of `sqrt`. `sqrt` might also have other supermethods, that amount to `Floating`.
>
>         > ... a run-time error results.
>         >
>         > Does anyone know of a rationale for this choice, since it seems rather unhaskell-like.
>
>
>         If you allow default method implementations (in the class, as
>         Cale points out), then I guess you have to allow instance
>         decls that don't mention all the methods. I think there should
>         at least be a warning if there's no default method. Also
>         beware the default method might have a more specific
>         signature, which means it can't be applied for some particular
>         instance.
>
>         Altogether, I'd say, the culprit is the strong bias in early
>         Haskell to bunch methods together into classes. These days
>         with Haskell's richer/more fine-tuned typeclass features: what
>         do typeclasses do that can't be done more precisely at method
>         level -- indeed that would _better_ be done at method level?
>
>
>         AntC
>         _______________________________________________
>         Haskell-prime mailing list
>         Haskell-prime at haskell.org <mailto:Haskell-prime at haskell.org>
>         http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-prime
>
>
>
> _______________________________________________
> Haskell-prime mailing list
> Haskell-prime at haskell.org
> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-prime

-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/haskell-prime/attachments/20181006/979173c6/attachment-0001.html>


More information about the Haskell-prime mailing list