RE: Endangered I/O operations

2001-05-22 Thread Simon Marlow

> If you handle std{in,out,err} connectedness in other ways,  I 
> think you've
> covered 99.2% of the uses of hConnectTo. Neat idea borrowed from
> Korn & Vo's SFIO, but it hasn't proved to be all that useful.

I wasn't planning to handle connectedness at all.  Is it important, do
you think?  (I'm not against the feature, just trying to avoid feeping
creaturism...)

Cheers,
Simon

___
Glasgow-haskell-users mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users



Poll: System.exitWith behaviour

2001-05-22 Thread Simon Marlow

The current behaviour of System.exitWith doesn't really make sense in a
concurrent environment.  The current semantics is to:

  - halt the current thread

  - run all finalizers (concurrently with any other
currently running threads)

  - stop the system as soon as all finalizers have
finished.

One high-priority problem we also have is that a program which calls
System.exitWith from inside GHCi will shut down the whole system.

Here's my current proposal:

   - introduce a new exception constructor:
 ExitException ExitCode

   - System.exitWith causes (ExitException code) to be
 raised in the current thread.
 
   - If this exception propogates to the top of the thread, then
 the main thread is also sent (ExitException code).  This
 only happens for a standalone executable (ie. one which was
 started by PrelMain.mainIO).

   - If this exception propogates to the top of the main thread,
 then the system is shut down as before - all finalizers are
 run to completion, then we exit.

For GHCi, we can obviously catch the ExitException exception and
recover, and there is no main thread in this case.

An alternative is just to omit the third point and let the programmer
handle propagation of the ExitException to the main thread.  This is
somewhat consistent with our current policy of leaving these kind of
decisions up to the programmer: we currently don't implement any kind of
process hierarchy, and there is no requirement for child threads to
complete before the program exits, for example.

Cheers,
Simon

___
Glasgow-haskell-users mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users



Re: Poll: System.exitWith behaviour

2001-05-22 Thread Smelly Pooh

In reply to Simon Marlow,
>- introduce a new exception constructor:
>ExitException ExitCode
> 
>- System.exitWith causes (ExitException code) to be
>  raised in the current thread.

Not entirely relevant, in fact, barely at all but what are the odds of user
extensible Exceptions (like ML) coming into GHC and having a proper hierarchy
of exceptions integrated in the libraries?

___
Glasgow-haskell-users mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users



RE: Poll: System.exitWith behaviour

2001-05-22 Thread Simon Marlow

> In reply to Simon Marlow,
> >- introduce a new exception constructor:
> >  ExitException ExitCode
> > 
> >- System.exitWith causes (ExitException code) to be
> >  raised in the current thread.
> 
> Not entirely relevant, in fact, barely at all but what are 
> the odds of user
> extensible Exceptions (like ML) coming into GHC and having a 
> proper hierarchy
> of exceptions integrated in the libraries?

Well, we could do a proper job of extensible data types, which probably
isn't hard but is certainly a fair amount of work.  Or we could treat
Exception as a special case, like ML.  Or we could take the
Dynamic-typed exception stuff and try to use that in a general way to
provide an extensible exception type... I'm open to suggestions.

Cheers,
Simon


___
Glasgow-haskell-users mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users



Re: Endangered I/O operations

2001-05-22 Thread Sigbjorn Finne


- Original Message -
From: "Simon Marlow" <[EMAIL PROTECTED]>
To: "Sigbjorn Finne" <[EMAIL PROTECTED]>
Cc: "GHC Users Mailing List (GHC Users Mailing List)"
<[EMAIL PROTECTED]>
Sent: Tuesday, May 22, 2001 03:30
Subject: RE: Endangered I/O operations


> > If you handle std{in,out,err} connectedness in other ways,  I
> > think you've
> > covered 99.2% of the uses of hConnectTo. Neat idea borrowed from
> > Korn & Vo's SFIO, but it hasn't proved to be all that useful.
>
> I wasn't planning to handle connectedness at all.  Is it important, do
> you think?  (I'm not against the feature, just trying to avoid feeping
> creaturism...)
>

Yes, crucial I think - if stdout and stderr are connected to the same
device,
don't you want their output to be synchronised, e.g.,

main = putStr "foo" >> hPutStr stderr " bar"

should return "foo bar" on your TTY. Ditto for flushing stdout/stderr when
peeking stdin.

--sigbjorn


___
Glasgow-haskell-users mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users



Re: Poll: System.exitWith behaviour

2001-05-22 Thread Marcin 'Qrczak' Kowalczyk

Tue, 22 May 2001 15:43:45 +0100, Simon Marlow <[EMAIL PROTECTED]> pisze:

>- If this exception propogates to the top of the thread, then
>  the main thread is also sent (ExitException code).  This
>  only happens for a standalone executable (ie. one which was
>  started by PrelMain.mainIO).

This looks like a strange exception for me (i.e. the fact that it
propagates to the main thread). And it's weird to have it as an
asynchronous exception in the main thread.

I would drop this rule and let 'exitWith ExitSuccess' be the way to
commit suicide by a thread, as if it completed, which degenerates to
the Haskell 98 interpretation in a single-threaded program.

BTW, I don't quite like the fact that 'exitFailure' looks simpler than
'exitWith ExitSuccess'.

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


___
Glasgow-haskell-users mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users



Re: Poll: System.exitWith behaviour

2001-05-22 Thread Marcin 'Qrczak' Kowalczyk

Tue, 22 May 2001 17:30:39 +0100, Simon Marlow <[EMAIL PROTECTED]> pisze:

> Well, we could do a proper job of extensible data types, which
> probably isn't hard but is certainly a fair amount of work.

This would be IMHO the only right way, but I doubt that it's that
simple. For example it would be irritating that you can't extend
function definitions accepting values of extensible data types as
arguments; even (==) is problematic.

It's a pity that there is no direct translation of the OO style open
polymorphism. You can use an algebraic type, but it casts all variants
in stone; you can store extracted concrete-typed interface in function
closures, but it doesn't allow to cast down (retrieve the original,
more specific type); you can use existential quantification, with the
same limitations; you can use Dynamic, which is not nice to define
instances of, puts everything in one big bag, and doesn't provide
any hierarchy or extraction by partial matches.


I was recently thinking on a similar thing; it would not help
with exceptions though, only with MonadError-based exceptions and
extensible abstract syntax trees. The idea is to dualize my record
proposal by introducing overloaded constructors. It provides views
for free, i.e. allows having pattern matching on abstract types
with programmer-defined semantics.

Details aren't finished yet, but I imagine something like this:

data HsExp e n l p = variant -- I like layout :-)
-- The proposal doesn't eliminate the need to have type parameters
-- here and close the recursion on types later :-(
Var n
Con n
Literal l
App e e
etc.

This introduces overloaded constructors:
HsVar   :: (e > Var n) => n -> e
Con :: (e > Con n) => n -> e
Literal :: (e > Literal l) => l -> e
App :: (e > App e1 e2) => e1 -> e2 -> e
and instances:
instance HsExp e n l p > Var n
instance HsExp e n l p > Con n
instance HsExp e n l p > Literal l
instance HsExp e n l p > App e e

A class of the form 't > C t1 t2' allows to create values of type t by
applying the constructor C to values of types t1 and t2, and pattern
match on values of type t using the constructor C with arguments of
types t1 and t2.

In another module you can reuse the same constructor names (they
don't collide as long as the arity is the same). You can also inherit
constructors from other types, similarly as in my records:

data GhcExp e n l p = variant
Haskell98Exp :: HsExp e n l p
Haskell98Exp (Var, Con, Literal, App, etc.)
-- This creates forwarding instances of the appropriate
-- classes, so Var etc. can be used with GhcExp too.
-- Using the constructor Haskell98Exp expresses explicit
-- subtyping/supertyping coercions.
UnboxedTuple [e]
CCall String [e]

And you can define such instances yourself:

instance PackedString > Nil where
-- Construction:
(Nil) = nilPs -- Needs a better syntax. This *defines* Nil.

-- Pattern matching:
s | nullPs -> Nil
-- Matching failure here (because of a failed guard)
-- means that the given value is not considered Nil.

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


___
Glasgow-haskell-users mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users



Re: Poll: System.exitWith behaviour

2001-05-22 Thread Manuel M. T. Chakravarty

"Simon Marlow" <[EMAIL PROTECTED]> wrote,

> The current behaviour of System.exitWith doesn't really make sense in a
> concurrent environment.  The current semantics is to:
> 
>   - halt the current thread
> 
>   - run all finalizers (concurrently with any other
> currently running threads)
> 
>   - stop the system as soon as all finalizers have
> finished.
> 
> One high-priority problem we also have is that a program which calls
> System.exitWith from inside GHCi will shut down the whole system.
> 
> Here's my current proposal:
> 
>- introduce a new exception constructor:
>ExitException ExitCode
> 
>- System.exitWith causes (ExitException code) to be
>  raised in the current thread.
>  
>- If this exception propogates to the top of the thread, then
>  the main thread is also sent (ExitException code).  This
>  only happens for a standalone executable (ie. one which was
>  started by PrelMain.mainIO).
> 
>- If this exception propogates to the top of the main thread,
>  then the system is shut down as before - all finalizers are
>  run to completion, then we exit.
> 
> For GHCi, we can obviously catch the ExitException exception and
> recover, and there is no main thread in this case.
> 
> An alternative is just to omit the third point and let the programmer
> handle propagation of the ExitException to the main thread.  This is
> somewhat consistent with our current policy of leaving these kind of
> decisions up to the programmer: we currently don't implement any kind of
> process hierarchy, and there is no requirement for child threads to
> complete before the program exits, for example.

I think, having the third point is good, because the Haskell
report requires that 

  Computation exitWith code terminates the program,
  returning code to the program's caller.

Cheers,
Manuel

___
Glasgow-haskell-users mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users