RE: Blocking I/O FIFOs

2000-05-12 Thread Simon Marlow

 Thu, 11 May 2000 06:39:10 -0700, Simon Marlow 
 [EMAIL PROTECTED] pisze:
 
  The solution, if you're interested, is to open the file in blocking
  mode and set O_NONBLOCK later on with an fcntl().
 
 It means that waiting for the writer blocks the whole program, right?

Yes, and that's another weird thing.  The reader blocks, even though the
file descriptor is set to non-blocking mode.

I think the only recommendation is "don't use FIFOs" - I'm considering
backing out the fix now.  A Unix domain socket provides the same facilities
and has reasonable semantics.

Cheers,
Simon




Re: Blocking I/O FIFOs

2000-05-12 Thread Volker Stolz

On Fri, May 12, 2000 at 02:51:21AM -0700, Simon Marlow wrote:
 I think the only recommendation is "don't use FIFOs" - I'm considering
 backing out the fix now.  A Unix domain socket provides the same facilities
 and has reasonable semantics.

...though it isn´t the same as a FIFO as you you can´t simply
call openFile on it, you´d have to use the module Socket again.

Hm, I need a way of getting network connections into a Hugs-version of my
current ghc-only program (because of "import Socket"). So I thought I´d
just write a ghc-program which does the nework-stuff and writes to FIFOs
that Hugs *can* read, this wrapper could even be replaced by C or Java.

I can´t think of any other way of doing this (except by some really
evil things like file-spooling and busy-waiting/polling lock-files).

Any suggestions of solving my problem will be appreciated.
-- 
Volker Stolz * [EMAIL PROTECTED] * PGP




RE: Blocking I/O FIFOs

2000-05-12 Thread Simon Marlow

 It is certainly better after a fix, at least for 
 single-threaded programs
 which work perfectly.
 
 With native threads (BTW, are they expected to work soon?) it 
 would work
 well too.

Perhaps... but pthreads emulated in user-space would suffer from the same
problems as GHC, because they have to use non-blocking I/O.

 An inefficient solution is to fork a process that will block 
 and then feed
 us through a pipe. Probably too bad to make it built-in, but at least
 should work if somebody desperately needs the functionality.
 
 I would be surprised if POSIX overlooked this case. BTW, are POSIX
 standards available for free?

According to the POSIX book I have (Lewine; POSIX Programmer's Guide):

"When attempting to read from any empty pipe or FIFO:
- if no process has the pipe open for writing, zero is
  returned to indicate end-of-file"

so the behaviour where the first read blocks until a process opens the FIFO
for writing seems to be a non-standard extension, but one which works on
both Linux  Solaris.

Opening the FIFO in non-blocking mode gives the POSIX semantics.  But the
POSIX semantics aren't useful: there's no way to open a FIFO and wait for a
writing process to come along, since select() doesn't work.  This is
probably the reason for the non-standard semantics of Linux  Solaris.

Cheers,
Simon




Re: Blocking I/O FIFOs

2000-05-12 Thread Marcin 'Qrczak' Kowalczyk

Testing under Linux showed that after opening a fifo with O_NONBLOCK
we should call select on it before read: it will not say we can read
from it until another process opens it for writing.

And when another process opens it for writing and closes without
writing anything, select says we should read and read returns 0.
Everything fine.

So after opening a fifo we should simply mark the thread as blocked
on read, and the present select mechanism will do the job.

Is it really that simple?

-- 
 __("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: Evolving a consensu

2000-05-12 Thread Ketil Malde

Simon Peyton-Jones [EMAIL PROTECTED] writes:

 The Haskell committee [...]
   there *is* no Haskell committee!

Fnord!

   * You can offer it for inclusion in hslibs/, an evolving
   collection of libraries that are distributed with
   GHC and Hugs

Perhaps we could organize a network archive, after the model of CTAN,
CPAN, et al?  Seems these are quite successful.

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




Re: deriving Functor

2000-05-12 Thread Koen Claessen

Kuncak wrote:

 | Why don't we have "deriving Functor" in Haskell?

Tom Pledger answered:

 | I don't know how significant this is, but types
 | declared as Functor instances have kind (*-*),
 | whereas types with any derived instances have kind *.

This might be the historical reason why Functor i not
derived in Haskell, because when it was decided what classes
were derivable, there did not exist any constructor classes.

But, it is very much possible to make a deriving
Functor. The people doing `polytypic' or `generic'
programming have shown this.

The question is of course, where to stop? There are so many
other classes which are also derivable. The Only Good
Solution would be for the Haskell programmer to make her/his
own deriving extensions.

The (or at least, my) hope is that there will be an
extension to Haskell soon (called "Generic Haskell") which
will make this easy to do. There already is a preprocessor
that does similar things, called "PolyP".

Regards,
Koen.

References:

http://www.cs.chalmers.se/~patrikj/poly/
http://www.students.cs.uu.nl/people/jwit/GenericHaskell.html

--
Koen Claessen http://www.cs.chalmers.se/~koen 
phone:+46-31-772 5424  e-mail:[EMAIL PROTECTED]
-
Chalmers University of Technology, Gothenburg, Sweden





RE: deriving Functor

2000-05-12 Thread Simon Peyton-Jones

| The (or at least, my) hope is that there will be an
| extension to Haskell soon (called "Generic Haskell") which
| will make this easy to do. 

Indeed, Ralf Hinze and I are working on a Haskell workshop
paper on this very topic, and I hope that a summer intern,
Andrei Serjantov, will be able to do at least a prototype implementation
in GHC.  

Briefly, the idea is this.  Haskell classes can contain 
default methods, which say what code to use in an instance
decl if the programmer doesn't supply any code.  The trouble is
that these default methods are pretty weak: if you give an instance
declaration with *no* type-specific code you typically have a pretty
useless instance.

We plan to let the programmer write *generic* default methods
in the class decl, using the approach Ralf described in his '99 
Haskell workshop paper.  Then you can say 'instance C T' to
make T an instance of C, supplying no T-specific code, because
the generic code will do the business.  Of course, you can also
over-ride some or all of the methods when you give an instance
decl.

This seems like a nice way to integrated generic programming
with Haskell's existing type system.   18 days to go -- must get
writing.

Is anyone else working on Generic Haskell.

Simon




RE: deriving Functor

2000-05-12 Thread Johan Jeuring

Is anyone else working on Generic Haskell.

Yes, I have an MSc student (Jan de Wit) who will work on Generic Haskell,
and I expect more people will start working on it in Utrecht later this year.

Johan




Re: why sample argument. Improved example

2000-05-12 Thread Rob MacAulay

Marcin 'Qrczak' Kowalczyk wrote:

 Haskell's type system is powerful, but cannot express anything at
 compile time. Very dynamic domains must be represented as runtime
 objects, i.e. values. These values and elements of those domains have
 carefully designed types, because Haskell is statically typed and
 requires certain discipline in this respect, but types themselves
 are not sufficient to determine domains.
 
 This is an opposite approach than I presented in the previous mail.
 Classes are not the appropriate tool for modelling domains of a
 sufficiently advanced algebra system.
 

If I understand correctly, you propose a system where Domains are 
record types, whose fields are functions corresponding to 
operations in the Domain.

Maple uses this technique. There is a package called "Gauss" 
which sets up domains in this manner. The documentation 
indicates that it was inspired by Axiom (originally Scratchpad), so 
that probably uses the same technique.

To be honest, I have always felt that this was a bit clumsy, and I 
was hoping that Haskell would provide a more elegant solution, 
though I am less sure of this now! However, I am only a naive user 
both of CA packages and Haskell, so I cant offer any other 
constructive criticisms.

Rob MacAulay

Rob MacAulay  Vulcan Asic___
email : [EMAIL PROTECTED]   \|/
http  : www.vulcanasic.com\   |###/
Tel   +[44] 1763 247624  (direct)  \  |##/
Tel   +[44] 1763 248163  (office)   \ |#/
Fax   +[44] 1763 241291  \|/




classes and algebra

2000-05-12 Thread Jerzy Karczmarczuk

Rob MacAulay quoting M. Kowalczyk:

  Classes are not the appropriate tool for modelling domains of a
  sufficiently advanced algebra system.

 If I understand correctly, you propose a system where Domains are
 record types, whose fields are functions corresponding to
 operations in the Domain.

 Maple uses this technique. There is a package called "Gauss"
 which sets up domains in this manner. ...

 To be honest, I have always felt that this was a bit clumsy, and I
 was hoping that Haskell would provide a more elegant solution,
 though I am less sure of this now!


I thought that Gauss is more or less dead, because it integrated
very badly with the rest of Maple. The Waterloo team wanted to
introduce the domain/categories in a more clean way. 


Axiom and Magma of course use all that. But if you really want to
see some details, to look at the OO code full of dynamic bindings,
but trying to resolve things statically, and to see what is
considered as really needed by an active CA community, you should
look at MuPAD, which is free (there is a Windows commercial
bellsAndWhistles version also) and decently documented. There are
there things I love, and things I personally hate, such as lack
of lexical closures, which makes it difficult to construct our
favourite HO functional algorithms (they might have changed
something in the last version, but I doubt it. I tried once
to implement some of my lazy numerical stuff in MuPAD, and I had
very severe difficulties).

A "Category" is a *property* of a data structure, not its clas-
sification to a class (domain). I would compare Domains here to
classes in Python. Haskell is worlds apart. It might provide for
a more elegant solution, and although I share with Rob the
doubts about it, I am sure that some offspring of Haskell might
make the life of mathematically oriented people more sweet.

[Unless - which is 3.1416 times more probable - the conceptors
of popular CA systems recognize finally the importance of HO
functional techniques, of laziness, etc., and most people trying
to use Haskell for mathematically oriented manipulations will
leave this ship and move elsewhere.]


Jerzy Karczmarczuk
Caen, France




Fuzzy.hs

2000-05-12 Thread Wilhelm B. Kloke

Hi,

I am trying to reproduce the fuzzy oscillator example by Jan Skibinski.
( http://www.numeric-quest.com/haskell/Fuzzy_oscillator.html )
I am having problems to compile the module Fuzzy.hs. As I am
just in an early learning stage, I need help to understand the error.

hugs98 e.g. says:

Reading file "/usr/local/share/hugs/lib/Prelude.hs":
Reading file "Fuzzy_oscillator.lhs":
Reading file "Fuzzy.hs":
Type checking  
ERROR "Fuzzy.hs" (line 76): Cannot build superclass instance
*** Instance: Num (a - b)
*** Context supplied: Num b
*** Required superclass : Show (a - b)

Similar with hbc:

Errors:
"Fuzzy.hs", line 0, [76] Instance context does not imply class context (Prelude.Show 
b, Prelude.Show c) = Prelude.Show (b - c), Prelude.Show in (Num c) = Num (b - c)

nhc98 and ghc4.06 show a different message:

Fuzzy.hs:188: Variable not in scope: `fromInt'

Perhaps this error masks the same problem in these compilers.
Do you have any hint ready?




Re: Fuzzy.hs

2000-05-12 Thread Jan Skibinski



On Fri, 12 May 2000, Wilhelm B. Kloke wrote:

 Hi,
 
 I am trying to reproduce the fuzzy oscillator example by Jan Skibinski.
 ( http://www.numeric-quest.com/haskell/Fuzzy_oscillator.html )
 I am having problems to compile the module Fuzzy.hs. As I am
 just in an early learning stage, I need help to understand the error.
 
 hugs98 e.g. says:
 
 Reading file "/usr/local/share/hugs/lib/Prelude.hs":
 Reading file "Fuzzy_oscillator.lhs":
 Reading file "Fuzzy.hs":
 Type checking  
 ERROR "Fuzzy.hs" (line 76): Cannot build superclass instance
 *** Instance: Num (a - b)
 *** Context supplied: Num b
 *** Required superclass : Show (a - b)
[...]

This subject was already discussed in thread
"Show class on ADT with functions" (original
message by Mike Jones, 2000.05.05). Few answers
were given.

Fuzzy.hs was written long time ago by Warwick
researchers. Similarly, my Fuzzy_oscillator.lhs
is 1.5 years old. I do not have any idea as yet 
why Fuzzy used to work with old versions of Hugs.

If someone from Warwick reads these messages
the chance is that they will fix Fuzzy.hs.
If not, I can only promise to look into things and
provide patches for Fuzzy to assure that
Fuzzy_oscillator works again. It needed the face
lift anyway due to the replacement of Gif module 
by the newer GD module.

Jan











Re: more detailed explanation about forall in Haskell

2000-05-12 Thread Frank Atanassow

Claus Reinke writes:
[nice exposition of C-H correspondence  state threads]

 The main caveat is the insistence on constructive proofs (in the classical
  logic most of us tend to learn, there is this favourite proof technique: if
  I assume that xs don't exist, I am led to a contradiction, so xs have to
  exist, even if I haven't seen any of them yet - this is not acceptable in
  constructive logics).
  
  [haven't read the papers on a correspondence for classical logic yet, but
  I assume they exist, for otherwise I would contradict Frank Atanassow ;-]

Here's a nice example, which you alluded to.  Reading | as `or' and ~ as
`not', a|~a is a theorem of classical logic but not intuitionistic logic. By
definition, ~a = a-_|_ (falsum). A proof of this proposition is given by the
term

  /\ a - \\(m::a|n::a-Void) - [n] (\x - [m] x)-- /\ is big-lambda

"[m] t" and "\\m::a - t" are new term forms. They throw and catch
continuations, where a continuation accepting values of type a is something of
type a - Void. Void is the empty type, so this means that a continuation is a
something like a function which never returns.

"[m] t" takes a term t :: a, and yields a term of type Void with a fresh free
variable m :: a-Void. You can think of [m] t as meaning, "throw value t at
continuation m". When this gets reduced, the current context is discarded and
execution proceeds from m, with t as input.

"\\" is usually written with Greek letter `mu'. In "\\m::a - t", the term t
must be of type Void and possess a free variable m :: a-Void; the result is a
term of type a, in which m is now bound. You can think of "\\m::a - t" as
meaning, "catch a value v thrown to continuation m and return v as the
result". Note that since t has type Void, it must always throw something and
can never return normally. (In case of conflicts, which value gets caught
depends of course on the reduction order.)

"\\(m::a|n::b) - t" is a pattern-matching variation on the mu-binder. t is
again of type Void, but the result is of type a|b. The meaning is that it
catches values thrown to either continuation, injects it into the sum, and
then returns it. (There is also variant "[m|n] t" of the "[m] t" syntax, but
we don't need it.)

So what does our term

  /\a - \\(m::a|n::a-Void) - [n] (\x - [m] x)

mean? Well, when it gets reduced, it remembers its calling context and
associates it with m and n. Then it initially returns (by throwing it at n) to
that context the closure (\x-[m]x)::a-Void which gets injected into the
right summand. Execution proceeds, and if at any point this closure ever gets
applied to some value v, then the original context is magically restored, but
this time with v injected into the left summand. So this is an example of the
time-travelling effect you get with multiply-invoked continuations (because we
can consider that there is only one continuation of type a|a-Void.)

Incidentally, the reason you need a special form for continuation
"application" is that I glossed over a technical detail concerning whether to
take ~a or a-Void as primitive. At least in the lambda-mu calculus, you're
not allowed, actually, to write "f x" if f::A-Void for any A; you have to use
"[f] x". I forget the details.

-- 
Frank Atanassow, Dept. of Computer Science, Utrecht University
Padualaan 14, PO Box 80.089, 3508 TB Utrecht, Netherlands
Tel +31 (030) 253-1012, Fax +31 (030) 251-3791





Re: Fuzzy.hs

2000-05-12 Thread Malcolm Wallace

 nhc98 and ghc4.06 show a different message:
 
 Fuzzy.hs:188: Variable not in scope: `fromInt'

The function "fromInt" is not part of Haskell'98.  Replace its sole use
with "fromIntegral", and the module compiles just fine with nhc98.

Regards,
Malcolm





PhD Scholarships Available

2000-05-12 Thread Phil Trinder

The Department of Computing and Electrical Engineering at 
Heriot-Watt University, in Edinburgh, Scotland has a number 
of EPSRC PhD Studentships available for UK and EU nationals 
to undertake research in Functional Programming. The 
department has a very active group working on parallel 
functional programming, type theory and rewriting.

Candidates should hold or expect to hold a good honours degree or the
equivalent.

Further information about research interests is available from 
http://www.cee.hw.ac.uk/Research/dependable_index.html
or for further details and application forms contact:

Phil Trinder
Department of Computing and Electrical Engineering
Heriot Watt University
Riccarton
Edinburgh, EH14 4AS

E-mail: [EMAIL PROTECTED]
Teleph: +44 (0)131 451 3435
Depart: +44 (0)131 451 3328
Fasmly: +44 (0)131 451 3327
Intrnt: www:http://www.cee.hw.ac.uk/~trinder

--- End Forwarded Message ---


--
Phil Trinder
Department of Computing and Electrical Engineering
Heriot Watt University
Riccarton
Edinburgh, EH14 4AS

E-mail: [EMAIL PROTECTED]
Teleph: +44 (0)131 451 3435
Depart: +44 (0)131 451 3328
Fasmly: +44 (0)131 451 3327
Intrnt: www:http://www.cee.hw.ac.uk/~trinder





type synonyms and monads

2000-05-12 Thread Thomas Harke

Hi all,

Why is it that type synonyms can't be made class instances?
I suspect there's a good reason, but I can't figure it out.

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.

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

The older I get, the faster I was




Re: more detailed explanation about forall in Haskell

2000-05-12 Thread Marcin 'Qrczak' Kowalczyk

Fri, 12 May 2000 00:42:52 +0200, Jan Brosius [EMAIL PROTECTED] pisze:

   newSTRef :: a - ST s (STRef s a)
   readSTRef :: STRef s a - ST s a
 and
 
 f:: STRef s a - STRef s a
 f v = runST( newSTRef v = \w - readSTRef w)
 
 Let's start
 
 v has type   STRef s a

...for "s" and "a" coming from the instantiation of a polymorphic
function "f". Yes.

 newSTRef v has type   ST s (STRef s (STRef s a))
 (THIS is of the form  ST s (STRef s T(s))

No. It has the type
ST s1 (STRef s1 (STRef s a))
where "s1" is free (thus can be later generalized over) and "s" and
"a" come from the environment inside "f" (thus are monomorphic).

It would have the type you wrote if "v" was created in this thread.

   Now   forall s1. ( ST s1 T(s))  IMPLIES   forall s . ( ST s T(s) )
 
  It does not. And I have already told why, a few e-mails ago.
 
 IT DOES  : that is a well known rule of forall  (forall x,y . alpha(x.y) =
 forall x. alpha(x,x) )

I see no "forall s" in the left type.

  When you use runST, you don't always know if the type given for "s"
  will be instantiated to a type variable or not. Being a type variable
  is not a property of a type.
 
 I can only say here : ???

runST':: ST s Int - Int
runST' x = ...

Inside the body of runST' "x" has the type "ST s Int", with "s"
taken from the environment.

When runST' will be later applied to a value of the type "ST s Int"
with "s" free, "x" will have the type "ST s Int" with nothing more
known about "s". (If runST was applied to this value directly, it
would be OK.)

When runST' will be applied to a value of the type "ST RealWorld Int",
"x" will have the type "ST RealWorld Int".

But you have to compile runST' _now_, and decide whether the first
argument of ST from the type of "x" is a type variable.

Haskell does not have this problem. It does not ever check if a type
is a type variable, but if it is a _free_ type variable, i.e. one
that can be generalized over.

runST':: forall s. ST s Int - Int
runST' x = runST x
   
Should it compile with your type of runST?

 function runST are fullfilled . So ("my") runST will work.

Now I write
len :: Int
len = runST' (liftM length (readFile "foo") :: ST RealWorld Int)
which creates a global value of type Int which changes in time. Oops!

-- 
 __("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: Fuzzy.hs

2000-05-12 Thread Jan Skibinski



On Fri, 12 May 2000, Malcolm Wallace wrote:

  nhc98 and ghc4.06 show a different message:
  
  Fuzzy.hs:188: Variable not in scope: `fromInt'
 
 The function "fromInt" is not part of Haskell'98.  Replace its sole use
 with "fromIntegral", and the module compiles just fine with nhc98.
 
 Regards,
 Malcolm
 

Until original Fuzzy.hs is upgraded I will temporarily host
its modified version in Fuzzy_oscillator directory. See:
www.numeric-quest.com/haskell/oscillator/Fuzzy_oscillator.html

Two changes were required: the first is mentioned by Malcolm
(for Nhc and Ghc) and the second relates to Show (for Hugs).

I upgraded Fuzzy_oscillator (upgraded reference to
the original location of Fuzzy.hs, importing GD
instead of Gif, regenerated pictures in PNG format,
changes to plotting functions) and GD modules as
well. The latter had the same "fromInt" problem.
Function "fromInt" is still being accepted by Hugs98
though.

Jan
 
   





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