Re: Show, Eq not necessary for Num [Was: Revamping the numeric classes]

2001-02-09 Thread Ketil Malde

Brian Boutel [EMAIL PROTECTED] writes:

 The fact that equality can be trivially defined as bottom does not imply
 that it should be a superclass of Num, it only explains that there is an
 ugly way of working around the problem.

 There is nothing trivial or ugly about a definition that reflects
 reality and bottoms only where equality is undefined.

I think there is.  If I design a class and derive it from Num with
(==) is bottom, I am allowed to apply to it functions requiring a Num
argument, but I have no guarantee it will work.

The implementor of that function can change its internals (to use
(==)), and suddenly my previously working program is non-terminating. 
If I defined (==) to give a run time error, it'd be a bit better, but
I'd much prefer the compiler to tell me about this in advance.

 Of course, if you do not need to apply equality to your "numeric" type
 then having to define it is a waste of time, but consider this:

It's not about "needing to apply", but about finding a reasonable
definition. 

 - Having a class hierarchy at all (or making any design decision)
 implies compromise.

I think the argument is that we should move Eq and Show *out* of the
Num hierarchy.  Less hierarchy - less compromise.

 - The current hierarchy (and its predecessors) represent a reasonable
 compromise that meets most needs.

Obviously a lot of people seem to think we could find compromises that
are more reasonable.

 - Users have a choice: either work within the class hierarchy and
 accept the pain of having to define things you don't need in order
 to get the things that come for free,

Isn't it a good idea to reduce the amount of pain?

 or omit the instance declarations and work outside the hierarchy. In
 that case you will not be able to use the overloaded operator
 symbols of the class, but that is just a matter of concrete syntax,
 and ultimately unimportant.

I don't think syntax is unimportant.

-kzm
-- 
If I haven't seen further, it is by standing in the footprints of giants

___
Haskell-Cafe mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/haskell-cafe



In hoc signo vinces (Was: Revamping the numeric classes)

2001-02-09 Thread Jerzy Karczmarczuk

Marcin 'Qrczak' Kowalczyk wrote:


 JK Now, signum and abs seem to be quite distincts beasts. Signum seem
 JK to require Ord (and a generic zero...).
 
 Signum doesn't require Ord.
 signum z = z / abs z
 for complex numbers.

Thank you, I know. And I ignore it. Calling "signum" the result of
a vector normalization (on the gauss plane in this case) is something
I don't really appreciate, and I wonder why this definition infiltrated
the prelude. Just because it conforms to the "normal" definition of
signum for reals?

Again, a violation of the orthogonality principle. Needing division
just to define signum. And of course a completely different approach
do define the signum of integers. Or of polynomials...


Jerzy Karczmarczuk

___
Haskell-Cafe mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/haskell-cafe



Re: Revamping the numeric HUMAN ATTITUDE

2001-02-09 Thread Jerzy Karczmarczuk

Brian Boutel wrote:
 
 William Lee Irwin III wrote:
 
 
  The Standard Prelude serves its purpose well and accommodates the
  largest cross-section of users. Perhaps a Geek Prelude could
  accommodate the few of us who do need these sorts of schenanigans.
 
 
 
 Amen.


Aha.
And we will have The Prole, normal users who can live with incomplete,
sometimes contradictory math, and The Inner Party of those who know
The Truth?

Would you agree that your children be taught at primary school some
dubious matter because "they won't need the real stuff".

I would agree having a minimal standard Prelude which is incomplete.
But it should be sane, should avoid confusion of categories and
useless/harmful dependencies.

Methodologically and pedagogically it seems a bit risky.
Technically it may be awkward. It will require the compiler and
the standard libraries almost completely independent of each other. 
This is not the case now.

BTW. what is a schenanigan? Is it by definition someething consumed
by Geeks? Is the usage of Vector Spaces restricted to those few
Geeks who can't live without schenanigans?

Jerzy Karczmarczuk

PS.

For some time I follow the discussion on some newsgroups dealing with
computer graphics, imagery, game programming, etc. I noticed a curious,
strong influence of people who shout loudly:

 "Math?! You don't need it really. Don't waste your time on it!
  Don't waste your time on cute algorithms, they will be slow as
  hell. Learn assembler, "C", MMX instructions, learn DirectX APIs,
  forget this silly geometric speculations. Behave *normally*, as
  a *normal* computer user, not as a speculative mathematician!"

And I noticed that REGULARLY, 1 - 4 times a week some freshmen ask
over and over again such questions:
1. How to rotate a vector in 3D?
2. How to zoom an image?
3. What is a quaternion, and why some people hate them so much?
4. How to compute a trajectory if I know the force acting on the
   object.

To summarize: people who don't use and don't need math always feel
right to discourage others to give to it an adequate importance.
It is not they who will suffer from badly constructed math layer
of a language, or from badly taught math concepts, so they don't
care too much.

___
Haskell-Cafe mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/haskell-cafe



Re: Show, Eq not necessary for Num [Was: Revamping the numeric c

2001-02-09 Thread Marcin 'Qrczak' Kowalczyk

Fri, 9 Feb 2001 11:48:33 -0500, Dylan Thurston [EMAIL PROTECTED] pisze:

   class (Show a, Read a, Eq a) = Comfortable a
   instance (Show a, Read a, Eq a) = Comfortable a 

 Why isn't it legal?

Because in Haskell 98 instance's head must be of the form of a type
constructor applied to type variables. Here it's a type variable.

 I just tried it, and Hugs accepted it, with or without extensions.

My Hugs does not accept it without extensions.

ghc does not accept it by default. ghc -fglasgow-exts accepts an
instance's head which is a type constructor applied to some other
types than just type variables (e.g. instance Foo [Char]), and
-fallow-undecidable-instances lets it accept the above too.

I forgot that it can make context reduction infinite unless the
compiler does extra checking to prevent this. I guess that making it
legal keeps the type system decidable, only compilers would have to
introduce some extra checks.

Try the following module:


module Test where

class Foo a where foo :: a
class Bar a where bar :: a
class Baz a where baz :: a

instance Foo a = Bar a where bar = foo
instance Bar a = Baz a where baz = bar
instance Baz a = Foo a where foo = baz

f = foo


Both hugs -98 and ghc -fglasgow-exts -fallow-undecidable-instances
reach their limits of context reduction steps.

-- 
 __("  Marcin Kowalczyk * [EMAIL PROTECTED] http://qrczak.ids.net.pl/
 \__/
  ^^  SYGNATURA ZASTPCZA
QRCZAK


___
Haskell-Cafe mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/haskell-cafe



Re: 'Convertible' class?

2001-02-09 Thread Dylan Thurston

On Fri, Feb 09, 2001 at 12:05:09PM -0500, Dylan Thurston wrote:
 On Thu, Feb 08, 2001 at 04:06:24AM +, Marcin 'Qrczak' Kowalczyk wrote:
  You can put Num a in some instance's context, but you can't
  put Convertible Integer a. It's because instance contexts must
  constrain only type variables, which ensures that context reduction
  terminates (but is sometimes overly restrictive). There is ghc's
  flag -fallow-undecidable-instances which relaxes this restriction,
  at the cost of undecidability.
 
 Ah!  Thanks for reminding me; I've been using Hugs, which allows these
 instances.  Is there no way to relax this restriction while
 maintaining undecidability?

After looking up the Jones-Jones-Meijer paper and thinking about it
briefly, it seems to me that the troublesome cases (when "reducing" a
context gives a more complicated context) can only happen with type
constructructors, and not with simple types.  Would this work?  I.e.,
if every element of an instance context is required to be of the form
  C a_1 ... a_n,
with each a_i either a type variable or a simple type, is type
checking decidable?  (Probably I'm missing something.)

If this isn't allowed, one could still work around the problem:
  class (Convertible Integer a) = ConvertibleFromInteger a
at the cost of sticking in nuisance instance declarations.

Note that this problem arises a lot.  E.g., suppose I have
  class (Field k, Additive v) = VectorSpace k v ...
and then I want to talk about vector spaces over Float.

Best,
Dylan Thurston

___
Haskell-Cafe mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/haskell-cafe



Re: In hoc signo vinces (Was: Revamping the numeric classes)

2001-02-09 Thread William Lee Irwin III

Fri, 09 Feb 2001 10:52:39 +, Jerzy Karczmarczuk pisze:
 Again, a violation of the orthogonality principle. Needing division
 just to define signum. And of course a completely different approach
 do define the signum of integers. Or of polynomials...

On Fri, Feb 09, 2001 at 07:19:21PM +, Marcin 'Qrczak' Kowalczyk wrote:
 So what? That's why it's a class method and not a plain function with
 a single definition.
 
 Multiplication of matrices is implemented differently than
 multiplication of integers. Why don't you call it a violation of the
 orthogonality principle (whatever it is)?

Matrix rings actually manage to expose the inappropriateness of signum
and abs' definitions and relationships to Num very well:

class  (Eq a, Show a) = Num a  where
(+), (-), (*)   :: a - a - a
negate  :: a - a
abs, signum :: a - a
fromInteger :: Integer - a
fromInt :: Int - a -- partain: Glasgow extension

Pure arithmetic ((+), (-), (*), negate) works just fine.

But there are no good injections to use for fromInteger or fromInt,
the type of abs is wrong if it's going to be a norm, and it's not
clear that signum makes much sense.

So we have two totally inappropriate operations (fromInteger and
fromInt), one operation which has the wrong type (abs), and an operation
which doesn't have well-defined meaning (signum) on matrices. If
we want people doing graphics or linear algebraic computations to
be able to go about their business with their code looking like
ordinary arithmetic, this is, perhaps, a real concern.

I believe that these applications are widespread enough to be concerned
about how the library design affects their aesthetics.


Cheers,
Bill
-- 
craving Weak coffee is only fit for lemmas.
--

___
Haskell-Cafe mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/haskell-cafe



Re: Show, Eq not necessary for Num [Was: Revamping the numeric classes]

2001-02-09 Thread Brian Boutel

Ketil Malde wrote:
 
 Brian Boutel [EMAIL PROTECTED] writes:
 
  - Having a class hierarchy at all (or making any design decision)
  implies compromise.
 
 I think the argument is that we should move Eq and Show *out* of the
 Num hierarchy.  Less hierarchy - less compromise.


Can you demonstrate a revised hierarchy without Eq? What would happen to
Ord, and the numeric classes that require Eq because they need signum? 


 
  - The current hierarchy (and its predecessors) represent a reasonable
  compromise that meets most needs.
 
 Obviously a lot of people seem to think we could find compromises that
 are more reasonable.

I would put this differently. "A particular group of people want to
change the language to make it more convenient for their special
interests."

 
  - Users have a choice: either work within the class hierarchy and
  accept the pain of having to define things you don't need in order
  to get the things that come for free,
 
 Isn't it a good idea to reduce the amount of pain?

Not always.

 
  or omit the instance declarations and work outside the hierarchy. In
  that case you will not be able to use the overloaded operator
  symbols of the class, but that is just a matter of concrete syntax,
  and ultimately unimportant.
 
 I don't think syntax is unimportant.


I wrote that *concrete* syntax is ultimately unimportant, not *syntax*.
There is a big difference. In particular, *lexical syntax*, the choice
of marks on paper used to represent a language element, is not
important, although it does give rise to arguments, as do all mattters
of taste and style.

Thre are not enough usable operator symbols to go round, so they get
overloaded. Mathematicians have overloaded common symbols like (+) and
(*) for concepts that have may some affinity with addition and
multiplication in arithmetic, but which are actually quite different.
That's fine, because, in context, expert human readers can distinguish
what is meant. From a software engineering point of view, though, such
free overloading is dangerous, because readers may assume, incorrectly,
that an operator has properties that are typically associated with
operators using that symbol. This may not matter in a private world
where the program writer is the only person who will see and use the
code, and no mission-critial decisions depend on the results, but it
should not be the fate of Haskell to be confined to such use.

Haskell could have allowed free ad hoc overloading, but one of the first
major decisions made by the Haskell Committee in 1988 was not to do so.
Instead, it adopted John Hughes' proposal to introduce type classes to
control overloading. A symbol could only be overloaded if the whole of a
group of related symbols (the Class) was overloaded with it, and the
class hierarchy provided an even stronger constraint by restricting
overloading of the class operators to cases where other classes,
intended to be closely related, were also overloaded. This tended to
ensure that the new type at which the classes were overloaded had strong
resemblences to the standard types. Simplifying the hierarchy weakens
these constraints and so should be approached with extreme caution. Of
course, the details of the classes and the hierarchy have changed over
the years - there is, always has been and always will be pressure to
make changes to meet particular needs - but the essence is still there,
and the essence is of a general-purpose language, not a domain-specific
language for some branches of mathematics.

A consequence of this is that certain uses of overloaded symbols are
inconvenient, because they are too far from the mainstream intended
meaning. If you have such a use, and you want to write in Haskell, you
have to choose other lexical symbols to represent your operators. You
make your choice.

--brian

___
Haskell-Cafe mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/haskell-cafe



Re: Haskell Implemetors Meeting

2001-02-09 Thread John Meacham

Another Haskell - Haskell transformation tool which I always thought
would be useful (and perhaps exists?) would be a Haskell de-moduleizer.
Basically it would take a Haskell program and follow its imports and
spit out a single monolithic Haskell module. My first thought is that
this should be able to be done by prepending the module name to every
symbol (making sure the up/lowercases come out right of course) in each
module and then appending them to one another. 

Why would I want this? curiosity mainly. performance perhaps. There is
much more oprotunity to optimize if seperate compilation need not be
taken into account. It would be interesting to see what could be done
when not worrying about it. It would allow experimentation with
non-seperate compilation compilers by allowing them to compile more
stuff 'out-of-the-box'. Also it may be that performance is so important
that one may want seperate compilation while developing, but when the
final product is produced it might be worth the day it takes to compile
to get a crazy-optimized product. This could also be done
incrementally, unchanging subsystems (like GUI libraries) could be combined
this way for speed while your app code is linked normally for
development reasons 

John


-- 
--
John Meacham   http://www.ugcs.caltech.edu/~john/
California Institute of Technology, Alum.  [EMAIL PROTECTED]
--

___
Haskell-Cafe mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/haskell-cafe



Re: Instances of multiple classes at once

2001-02-09 Thread Fergus Henderson

On 08-Feb-2001, Dylan Thurston [EMAIL PROTECTED] wrote:
 On Thu, Feb 08, 2001 at 09:41:56PM +1100, Fergus Henderson wrote:
  One point that needs to be  resolved is the interaction with default methods.
  Consider
  
  class foo a where
  f :: ...
  f = ...
  f2 :: ...
  f2 = ...
  
  class (foo a) = bar a where
  b :: ...
   
  instance bar T where
  -- no definitions for f or f2
  b = 42
  
  Should this define an instance for `foo T'?
  (I think not.)
 
 Whyever not?

Because too much Haskell code uses classes where the methods are
defined in terms of each other:

class Foo a where
-- you should define either f or f2
f :: ...
f = ... f2 ...
f2 :: ...
f2 = ... f ...

 Because there is no textual mention of class Foo in the
 instance for Bar?

Right, and because allowing the compiler to automatically generate
instances for class Foo without the programmer having considered
whether those instances are OK is too dangerous.

 Think about the case of a superclass with no methods;
 wouldn't you want to allow automatic instances in this case?

Yes.

I think Marcin has a better idea: 

| So maybe there should be a way to specify that default definitions
| are cyclic and some of them must be defined?

-- 
Fergus Henderson [EMAIL PROTECTED]  |  "I have always known that the pursuit
|  of excellence is a lethal habit"
WWW: http://www.cs.mu.oz.au/~fjh  | -- the last words of T. S. Garp.

___
Haskell-Cafe mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/haskell-cafe



Re: Revamping the numeric classes

2001-02-09 Thread Fergus Henderson

On 08-Feb-2001, Marcin 'Qrczak' Kowalczyk [EMAIL PROTECTED] wrote:
 
 I don't like the idea of treating the case "no explicit definitions
 were given because all have default definitions which are OK"
 differently than "some explicit definitions were given".

I don't really like it that much either, but...

 When there is a superclass, it must have an instance defined, so if
 we permit such thing at all, I would let it implicitly define all
 superclass instances not defined explicitly, or something like that.
 At least when all methods have default definitions. Yes, I know that
 they can be mutually recursive and thus all will be bottoms...

... that is the problem I was trying to solve.

 So maybe there should be a way to specify that default definitions
 are cyclic and some of them must be defined?

I agree 100%.

 It is usually written in comments anyway, because it is not immediately
 visible in the definitions.

Yes.  Much better to make it part of the language, so that the compiler
can check it.

 (now any method definition
 can be omitted even if it has no default!),

Yeah, that one really sucks.

-- 
Fergus Henderson [EMAIL PROTECTED]  |  "I have always known that the pursuit
|  of excellence is a lethal habit"
WWW: http://www.cs.mu.oz.au/~fjh  | -- the last words of T. S. Garp.

___
Haskell-Cafe mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/haskell-cafe



Re: Show, Eq not necessary for Num [Was: Revamping the numeric classes]

2001-02-09 Thread Fergus Henderson

On 09-Feb-2001, Brian Boutel [EMAIL PROTECTED] wrote:
 Patrik Jansson wrote:
 
  The fact that equality can be trivially defined as bottom does not imply
  that it should be a superclass of Num, it only explains that there is an
  ugly way of working around the problem.
...
 
 There is nothing trivial or ugly about a definition that reflects
 reality and bottoms only where equality is undefined.

I disagree.  Haskell is a statically typed language, and having errors
which could easily be detected at compile instead being deferred to
run time is ugly in a statically typed language.

-- 
Fergus Henderson [EMAIL PROTECTED]  |  "I have always known that the pursuit
|  of excellence is a lethal habit"
WWW: http://www.cs.mu.oz.au/~fjh  | -- the last words of T. S. Garp.

___
Haskell-Cafe mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/haskell-cafe



Re: Show, Eq not necessary for Num [Was: Revamping the numeric classes]

2001-02-09 Thread Marcin 'Qrczak' Kowalczyk

Sat, 10 Feb 2001 14:09:59 +1300, Brian Boutel [EMAIL PROTECTED] pisze:

 Can you demonstrate a revised hierarchy without Eq? What would happen to
 Ord, and the numeric classes that require Eq because they need signum? 

signum doesn't require Eq. You can use signum without having Eq, and
you can sometimes define signum without having Eq (e.g. on functions).
Sometimes you do require (==) to define signum, but it has nothing to
do with superclasses.

-- 
 __("  Marcin Kowalczyk * [EMAIL PROTECTED] http://qrczak.ids.net.pl/
 \__/
  ^^  SYGNATURA ZASTPCZA
QRCZAK


___
Haskell-Cafe mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/haskell-cafe