constructor name clashes

Brandon Michael Moore brandon at its.caltech.edu
Wed Oct 8 14:40:50 EDT 2003


On Wed, 8 Oct 2003 Ben_Yu at asc.aon.com wrote:

> Hi, all.
>
> I'm a newbie to Haskell so please bear with me if my questions sound silly.
>
> In coding Haskell, I feel very inconvenient that the name of data
> constructors for different types have to be different.
>
> Also, when declaring named fields of a type, such as
> data Data1 = Data1{ok1::Bool}
> data Data2 = Data2{ok2::Bool}
> the field names for different type also have to be unique.
>
> Isn't that annoying? Keeping all the names unique is no easy task in my
> opinion. Wouldn't it be nice if we can have something similar to structure
> fields in C? Or maybe this is already present and I'm just being ignorant?

There has been a lot of work on a real record system, but none has made it
into GHC. HUGS has TREX, which is based on row variable polymorphism and
seems fairly powerful. O'Haskell does something based on subtyping IIRC.
The big problem is being expressing functions that add or remove fields
from a record. If you are just interested in fetching or setting fields
you can use type classes:

data A = A Int String --A {foo::Int, bar::String}
data B = B Bool --B {foo::Bool}

class HasFooField t a | t -> a where
  foo :: t -> a
  updateFoo :: t -> a -> t

instance HasFooField A Int where
  foo (A f _) = f
  updateFoo (A _ b) v = A v b

instance HasFooField B Bool where
  foo (B b) = b
  updateFoo (B _) v = B v

You could probably do something with template haskell that would
generate all the instances for you, but you would still need to import
the classes from somewhere.

$(struct [d[data A = A1 {foo::Int, bar::String} | A2 {foo::Int} ]])
$(struct [d[data B = B {foo::Bool} ]])

There was talk about compiler support for a system like this, and I think
the main obstacle is convincing somebody to do it, which mostly means
demonstrating that it's useful, because there's no interesting theory
here. It also makes code a bit slower, but fields are not that common
so it shouldn't be much of an issue.

Do we really lose that much to the name overloading restrictions?

The only use I can think of for records used as big bags of tagged values
is for passing configuration options to complicated libaries, or getting
back a bunch of values from something like parsec's token parser
generator. This isn't very common, because usually any powerful function
in Haskell is build from a layer of smaller functions that made the final
function ridiculously easy to write. If this is true for some library, the
author can either write gobs of boring option handling code that tries to
expose some fraction of this power, or just extend their export list a bit
and give the user the primitives to play with themselves.

I don't think constructor name clashes come up that often either. There
are a few names like Leaf or Empty that you want to use all the time
if you are defining trees and things, but that's more playing around with
trivial data structures than writing real code. Two cases I've run into
are successive program representations in a compiler (everything from
raw tokens though Core has an "if"), and using having an exploded
representation of a type as the fixpoint of a functior for interesting
recursion scheme uses, and a normal version so I can avoid the tagging.

It would probably be feasible to figure out which constructor you mean
in a function like

desugar :: ASTSyntax -> M IntermediateSyntax
desugar (IF c t e) = If (f c) (f t) (f e)
desugar (ListComprehension head gens) = desugarListComp head gens
...
...

But other cases are much harder (and probably much less sensible).
How do you infer a type for something like this?

f (C x) = case x of (C x) -> case x of (C x) -> case x (C x) -> x

I think the typing rules would have to be based on something other than
unification and generalization like the rest of the type system, and would
probably introduce all sorts of annoying restrictions about how you are
allowed to use constructors, or how to resolve the type.


Brandon

> I know that we can use modules to introduce name spaces. But still, this is
> quite cumbersome.
>
> Thanks!
>
> Ben.
>
>
>
> This message is intended only for the addressee and may contain information
> that is confidential or privileged. Unauthorized use is strictly prohibited
> and may be unlawful. If you are not the intended recipient, or the person
> responsible for delivering to the intended recipient, you should not read,
> copy, disclose or otherwise use this message, except for the purpose of
> delivery to the addressee. If you have received this email in error, please
> delete and advise us immediately.
>
>
> _______________________________________________
> Haskell mailing list
> Haskell at haskell.org
> http://www.haskell.org/mailman/listinfo/haskell
>
>



More information about the Haskell-Cafe mailing list