Re: type synonyms and monads

2000-05-12 Thread Marcin 'Qrczak' Kowalczyk

Fri, 12 May 2000 11:47:11 -0600 (MDT), Thomas Harke [EMAIL PROTECTED] pisze:

 Why is it that type synonyms can't be made class instances?

It does not add any functionality (see below), and could be confusing
because it would really make the instance for the expansion of the
type synonym (with "type Z = Integer" it is indistinguislable where
you mean to use Integer or Z, so they must share instances - it is
the same type, only spelled differently).

GHC developers decided that it is more convenient than confusing and
permitted to spell type synonyms in instance definitions. I agree
with it.

 The reason I ask is that I'm finding that definitions for monads are
 obfuscated by the need for constructors and field accessors, whereas
 if type synonyms could be instances the code would be much cleared.

You don't ask for instances for type synonyms; you ask for partial
application of type synonyms.

It is indeed not permitted, and AFAIK even if it would have well
defined semantics it would make the type system undecidable.

In GHC you can use type synonyms in instance definitions, but you
must apply them to all arguments, as always, so it does not help with
the problem.

I don't know any better solution than using newtypes. You can use
generic monads defined by others, e.g. those in GHC's modules, which
have already done the dirty work.

-- 
 __("Marcin Kowalczyk * [EMAIL PROTECTED] http://qrczak.ids.net.pl/
 \__/  GCS/M d- s+:-- a23 C+++$ UL++$ P+++ L++$ E-
  ^^  W++ N+++ o? K? w(---) O? M- V? PS-- PE++ Y? PGP+ t
QRCZAK  5? X- R tv-- b+++ DI D- G+ e h! r--%++ y-





Re: type synonyms and monads

2000-05-12 Thread Thomas Harke

Thanks Marcin,

Marcin 'Qrczak' Kowalczyk wrote:

 Thomas Harke [EMAIL PROTECTED] pisze:
 
  Why is it that type synonyms can't be made class instances?
 
 It does not add any functionality (see below), and could be confusing
 because it would really make the instance for the expansion of the
 type synonym (with "type Z = Integer" it is indistinguislable where
 you mean to use Integer or Z, so they must share instances - it is
 the same type, only spelled differently).

It doesn't add functionality, in the same way using a higher-level language
doesn't add functionality that assembler doesn't have.  I believe code
can sometimes be clearer with type synonyms than with newtypes (see
far below).  I presume that there are major drawbacks which overshadow
the small advantages.

 GHC developers decided that it is more convenient than confusing and
 permitted to spell type synonyms in instance definitions. I agree
 with it.

Now I'm confused.  Do you mean I *can* do this in GHC?  But the Haskell
Report (4.3.2) says this may not be done.

  The reason I ask is that I'm finding that definitions for monads are
  obfuscated by the need for constructors and field accessors, whereas
  if type synonyms could be instances the code would be much cleared.

oops.  s/cleared/clearer/

 You don't ask for instances for type synonyms; you ask for partial
 application of type synonyms.

This I don't follow.

 It is indeed not permitted, and AFAIK even if it would have well
 defined semantics it would make the type system undecidable.

This is the sort of answer I was expecting.  Can anybody confirm this
and give a simple concrete example of a problem?

 In GHC you can use type synonyms in instance definitions, but you
 must apply them to all arguments, as always, so it does not help with
 the problem.

Again, I don't follow.  Are you saying that I'm out of luck because
instance declarations for Monad have a type variable?

 I don't know any better solution than using newtypes. You can use
 generic monads defined by others, e.g. those in GHC's modules, which
 have already done the dirty work.

Yes, but when you try to explain these generic monads things start to
get hairy.  For instance, of the following two snippets of code the
former is IMHO a lot easier to motivate/understand, basically because
the second is cluttered with constructors, field accessors and variables.

type State s a = s - (a,s)
instance Monad (State s) where
return= (,)
xm = km = (uncurry km) . xm

newtype State s a = State { runState :: s - (a,s) }
instance Monad (State s) where
   return v  = State (\ s - (v,s))
   p  = f  = State (\ s - let (r,s') = runState p s
in runState (f r) s')



-- 
Tom Harke
Dept. of Computing Science
University of Alberta

A vacuum is a hell of a lot better than some of the stuff that nature
replaces it with.
  -- Tennessee Williams




Re: type synonyms and monads

2000-05-12 Thread Sven Panne

Thomas Harke wrote:
 Marcin 'Qrczak' Kowalczyk wrote:
  [...] GHC developers decided that it is more convenient than
  confusing and permitted to spell type synonyms in instance
  definitions. I agree with it.
 Now I'm confused.  Do you mean I *can* do this in GHC?  But the
 Haskell Report (4.3.2) says this may not be done.

But GHC does it anyway (probable rationale: This doesn't break any
pure Haskell 98 programs). Perhaps it should only be allowed with
-fglasgow-exts.

  [...] You don't ask for instances for type synonyms; you ask
  for partial application of type synonyms.
 This I don't follow.

`State s´ in your example has kind * - *, not *, so it isn't a type.

  It is indeed not permitted, and AFAIK even if it would have well
  defined semantics it would make the type system undecidable.

 This is the sort of answer I was expecting.  Can anybody confirm
 this and give a simple concrete example of a problem?

See the last part of Mark Jones' mail

   http://www.mail-archive.com/haskell@haskell.org/msg05356.html

 [...] Yes, but when you try to explain these generic monads
 things start to get hairy.

Just wait until you try to explain monad transformers to mere
mortals...  :-}

 For instance, of the following two snippets of code the former
 is IMHO a lot easier to motivate/understand, basically because
 the second is cluttered with constructors, field accessors and
 variables. [ example deleted ]

But this is really a matter of taste. I'm a real friend of
variable-free definitions, but from time to time (e.g. in this
example) it's IMHO much easier to see what's going on *with*
explicit variables and the (un-)wrapping.

Cheers,
   Sven
-- 
Sven PanneTel.: +49/89/2178-2235
LMU, Institut fuer Informatik FAX : +49/89/2178-2211
LFE Programmier- und Modellierungssprachen  Oettingenstr. 67
mailto:[EMAIL PROTECTED]D-80538 Muenchen
http://www.informatik.uni-muenchen.de/~Sven.Panne