Re: Exceptions are too return values!

1998-06-16 Thread Fergus Henderson

On 15-Jun-1998, Peter White peter@galois wrote:
 
 On June 15, Fergus Henderson writes
 
  As noted earlier, things like heap overflow, and stack overflow 
  are different from other kinds of exceptions.  They can't be modelled
  using the domain-theoretic semantics.  Rather, they reflect the failure
  of the operational semantics to accurately reflect the domain-theoretic
  semantics.  Thus the treatment of these exceptions may need to be
  different to the treatment of ordinary exceptions.
 
 One of the advertisements of Haskell is that you can reason
 about your program, by performing mathematical proofs about
 the program. Haskell has gone a long way to incorporating IO
 and stateful computations in such a way that you still get
 referential transparency, and you can still reason about programs.
 If the operational semantics fails to reflect, the domain-theoretic
 semantics, then it would appear that the ability to reason about
 the programs dissappears.

This is not the case here.  The reason is that although the operational
semantics are not complete w.r.t. the denotational (domain-theoretic)
semantics, they are sound.  That is, you can't use the denotational semantics
to prove that your program won't get a heap overflow; but you can use them
to prove that if your program doesn't get a resource failure like that,
then it will compute the right answer.

If you want to reason about resource limits, then you need to use
an operational semantics, not the denotational semantics.

 I think it is a requirement upon a
 Haskell implementation to preserve the independence of threads
 by "localizing" the resources to the threads, such that each thread
 can predict by itself, independently of any other thread, whether
 its resources will be sufficient.

I don't think this is desirable in the general case.
I think it would be useful to *allow* threads to reserve
resources, but often it is difficult to predict in advance
exactly how much each thread will use, and frequently it
is better to deal with resource failures when they arise.

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





Re: Exceptions are too return values!

1998-06-16 Thread Fergus Henderson

On 15-Jun-1998, Fergus Henderson [EMAIL PROTECTED] wrote:
 On 12-Jun-1998, Scott Turner [EMAIL PROTECTED] wrote:
  At 14:40 1998-06-10 +0100, you wrote:
  
  Here's a reasonable design for exceptions in Haskell:
  
  * handle :: (String - IO a) - IO a - IO a
  
  You probably realized more quickly than I how this
  can leak exceptions.
 ...
  Is this considered a drawback?
 
 This kind of exception handling can "leak" exceptions, but not in the
 way you described.
...
  What I mean is
  
  main = do quotient - handle (const (return 0)) (return (0 / 0)
   -- Looks plausible
   -- but the exception isn't raised yet.
print quotient -- Here the expression 0/0 is evaluated
   -- and the exception is raised with no handler.
 
 This is not correct.  This example would print out `0' rather than raising
 an uncaught division by zero exception.

I'm afraid I must retract those statements.  Scott Turner was quite correct,
and I was mistaken.  My apologies!

As Scott pointed out to me in personal email, SLPJ's definition of `handle'

  | * handle :: (String - IO a) - IO a - IO a
  |   (handle h a) tries to perform the action a.
  |   If doing so delivers a set of exceptional values then
  |   apply the exception handler h to the string that names
  |   one of them.  It is not defined which of the exceptional
  |   values is picked.

means that it only catches exceptional values in the I/O action,
not exceptional values in the return value.

Regarding Scott's question

 Is this considered a drawback?

my answer is still much the same -- yes, it's a drawback,
but I'd place the blame more on laziness than exception handling.
I consider it only a minor drawback, since the "leakage" can be
avoided if you use a version of `handle' which is strict in the return
value, e.g.

strict_handle handler action = handle handler strict_action where
strict_action = do value - action
   seq value return value
   -- or with `hyper_seq' instead of `seq'

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





Re: Exceptions are too return values!

1998-06-15 Thread Fergus Henderson

On 12-Jun-1998, Scott Turner [EMAIL PROTECTED] wrote:
 At 14:40 1998-06-10 +0100, you wrote:
 
 Here's a reasonable design for exceptions in Haskell:
 
 * handle :: (String - IO a) - IO a - IO a
 
 You probably realized more quickly than I how this
 can leak exceptions.
...
 Is this considered a drawback?

This kind of exception handling can "leak" exceptions, but not in the
way you described.  Yes, this is a drawback, but it's not nearly as big
a drawback it would be if exceptions could leak in the way you were
talking about.  Furthermore, the leakage seems to be inherent to lazy
evaluation, so I'd consider it a drawback of lazy evaluation rather than
a drawback of exception handling.  The user can avoid such leakage,
so long as they're willing to lose some laziness. 

Details below.

 What I mean is
 
 main = do quotient - handle (const (return 0)) (return (0 / 0)
  -- Looks plausible
  -- but the exception isn't raised yet.
   print quotient -- Here the expression 0/0 is evaluated
  -- and the exception is raised with no handler.

This is not correct.  This example would print out `0' rather than raising
an uncaught division by zero exception.

The reason is basically that the handler is established lazily too.
When `print' evaluates its argument, first the handler is
established, then 0/0 is evaluated, then the handler catches
the exception and returns 0.

This may not have been obvious from SLPJ's original description,
but if your consider the domain-theoretic semantics, it has to be
this way.  SLPJ's original description was as follows:

 | * handle :: (String - IO a) - IO a - IO a
 |   (handle h a) tries to perform the action a.
 |   If doing so delivers a set of exceptional values then
 |   apply the exception handler h to the string that names
 |   one of them.  It is not defined which of the exceptional
 |   values is picked.

The result of performing the action `return (0 / 0)'
is a (singleton) set of exceptional values, so the effect
of `handle (const (return 0)) (return (0 / 0))' must be
to apply `const (return 0)' to one of those values,
which in turn has the same effect as `return 0'.
The fact that this is all evaluated lazily doesn't change
the semantics.

If you want to understand the operational semantics in more detail,
then it may perhaps be clearer if you look at my implementation of his `handle'
using `ndset_handle' and `ndset_choose', since that breaks things up into
smaller pieces, seperating out the exception handling from the
nondeterministic choice.  But probably the simplest way of seeing it is
to look at the domain-theoretic semantics as outlined above.

So, your example is not a problem.  However, it is true that this kind
of exception handling does in a certain sense "leak" exceptions.  This
is because `handle' only catches exceptions that occur during the
evaluation of the top level of the value, it doesn't catch exceptions
that occur duing evaluation of the sub-components.
For instance, if we just modify your example slightly,
then we get an example where exceptions really do "leak" out:

main = do list - handle (const (return [])) (return [0 / 0])
  print list

This example will print "[" and then throw an uncaught division by zero
exception.

In order to avoid this, the user needs to force strict

main = do list - handle (const (return [])) (return e) `hyperseq` e
  where e = return [0 / 0]
  print list

Here `hyperseq' is a function that is like `seq' except
that it forces complete evaluation, not just evaluation to WHNF
(weak head normal form).

class HyperEval a where
hyperstrict :: (a - b) - a - b
hyperseq :: a - b - b
hyperstrict f x = x `hyperseq` f x

instance HyperEval a = HyperEval [a] where
[] `hyperseq` val = val
(x:xs) `hyperseq` val = x `hyperseq` (xs `hyperseq` val)

If we use a version of `handle' where the handler is the second argument
rather than the first (a good idea, IMHO!), then the example could be
written slighly more elegantly, using `hyperstrict' rather than `hyperseq',
as either

main = do list - hyperstrict handle (return [0/0]) (const (return []))
  print list

or if you prefer

main = do list - (return [0/0])
`hyperstrict handle` (const (return []))
  print list

P.S.  Is there any reason why something like `HyperEval'
isn't built in to Haskell, or at least include in the
Haskell Library report?  Is there any implementation-specific
precedent for something like this in say ghc?

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





Re: Exceptions are too return values!

1998-06-15 Thread Fergus Henderson

On 13-Jun-1998, Peter White peter@galois wrote:
 
 I wonder if there is another issue relating potential nondeterminism
 of exceptions to the independence of threads. It is supposed to be
 the case that two different threads have behavioral independence, so
 that an implementation could run the threads in any order, interleave
 their execution in any way, and the two threads would still give the
 same results.

Well, that depends on whether you want parallelism, or concurrency.
If you just want parallelism, i.e. you're just using threads to
improve performance, then yes, the order of interleaving should
not affect the results.  But if you're using concurrency, then this
isn't necessarily true -- the order of interleaving may affect the
results, and this may be exactly what you want.

 Take the case of a heap overflow exception.

As noted earlier, things like heap overflow, and stack overflow 
are different from other kinds of exceptions.  They can't be modelled
using the domain-theoretic semantics.  Rather, they reflect the failure
of the operational semantics to accurately reflect the domain-theoretic
semantics.  Thus the treatment of these exceptions may need to be
different to the treatment of ordinary exceptions.

In particular, instead of

data MaybeException a = OK a | GotException (NDSet Exception)
ndset_catch :: a - MaybeException a

you need something like

data ResourceFailure = StackOverFlow | HeapOverFlow | ...
data MaybeResourceFailure a = Computed (MaybeException a)
| Failed ResourceFailure
ndset_catch_all :: a - NDSet MaybeFailure

Timeouts may also be considered as resource failures.  Interrupt
handlers could also be considered as exceptions or resource failures,
but I think is probably nicer to consider them as forms of
concurrency.

 Suppose the two threads
 demand more memory than is provided in the computer. One of the two
 threads will hit a heap overflow exception. In order to have the
 implementation guarantee thread independence, the heap overflow of
 one thread cannot depend upon the memory consumption of the other
 thread. If there is a dependence, then one thread can determine the
 behaviour of the other thread by choosing to consume memory on the
 heap or not.

If you're worried about covert communication channels, then yes, you
have to worry about things like this.  But generally covert communication
channels are not an issue.  So in general it's enough to say that
whether or not you get a HeapOverflow resource failure is nondeterministic.

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





Re: Exceptions are too return values!

1998-06-15 Thread Alastair Reid


 On Mon, 15 Jun 1998, Fergus Henderson wrote:
 
  P.S.  Is there any reason why something like `HyperEval'
  isn't built in to Haskell, or at least include in the
  Haskell Library report?  Is there any implementation-specific
  precedent for something like this in say ghc?

Dave Tweed [EMAIL PROTECTED] added:
 I'd like to second this. It would have been very useful in some of the
 stuff I've written, particularly since (understandably enough) when using
 newtype you can't put ! annotations within the data-type.

I believe this is what the derive program (available from Glasgow's web site)
was originally developed for.


-- 
Alastair Reid  Yale Haskell Project Hacker
[EMAIL PROTECTED]  http://WWW.CS.Yale.EDU/homes/reid-alastair/






[Fwd: Re: Exceptions are too return values!]

1998-06-15 Thread Noel

--3E1737327A
Content-Type: text/plain; charset="us-ascii"

Alastair Reid wrote:

 I believe this is what the derive program (available from Glasgow's web site)
 was originally developed for.

Hi,
I'm the implementor of the software formerly known as 'Derive`, and
would just make a few points.

1. I've been threatened with legal action from Soft Warehouse Inc. for
infringing their trademark "DERIVE".  The full details are at 
http://www.dcs.gla.ac.uk/~nww/Derive/derivehome.html
In summary I'm not allowed to refer to my software using that name, and
must also inform others to do the same.

2. The software formerly known as 'Derive' was a little project written
during the first year of my PhD. Although it originates from Glasgow,
one should not assume it enjoys the same level of robustness or support
as other Glasgow FP tools.

3. Personally, I think that there is a need for a type-sensitive
preprocessor for Haskell.  Extending the derivable classes was the
motivating example, but there are other applications.  The software
formerly known as Derive is a first attempt at this.  I think it is time
for someone to develop this idea properly into a robust system. 
However, due to my PhD I don't have time for this.  

regards
noel.

-- 
Noel Winstanley
Dept of Computing Science
University of Glasgow
http://www.dcs.gla.ac.uk/~nww/   
mailto:[EMAIL PROTECTED]

--3E1737327A
Content-type: message/rfc822

Return-Path: [EMAIL PROTECTED]
Delivery-Date: Mon, 15 Jun 1998 14:58:59 +0100
Received: from dcs.gla.ac.uk 
  by vanuata.dcs.gla.ac.uk   
  id [EMAIL PROTECTED]; Mon, 15 Jun 1998 14:57:05 +0100
Old-Received: from easter.dcs.gla.ac.uk.dcs.gla.ac.uk (actually host easter)   
  by vanuata with SMTP DCS (MMTA) with ESMTP;  Mon, 15 Jun 1998
   
  14:56:57 +0100
Old-Received: by easter.dcs.gla.ac.uk.dcs.gla.ac.uk (8.8.5/Dumb)id OAA00405; 
  Mon, 15 Jun 1998 14:56:55 +0100
Old-Received: from haggis.cs.yale.edu (actually host HAGGIS.AI.CS.YALE.EDU)   
  by vanuata with SMTP (MMTA) with ESMTP;  Mon, 15 Jun 1998 
14:39:41   
  +0100
Old-Received: from haggis.cs.yale.edu (reid@localhost [127.0.0.1])  by 
  haggis.cs.yale.edu (8.8.7/8.8.7) with ESMTP  
   
  id JAA27815;  Mon, 15 Jun 1998 09:37:53 -0400
Message-Id: [EMAIL PROTECTED]
To: Dave Tweed [EMAIL PROTECTED]
cc: [EMAIL PROTECTED]
Subject: Re: Exceptions are too return values! 
In-reply-to: Your message of "Mon, 15 Jun 1998 10:03:18 BST." 
Pine.SGI.3.96.980615095746.2241B-10@neon 
Sender: [EMAIL PROTECTED]
Precedence: bulk   

8Qxd$QC/sdeK{93/{KA]T@gir{b8(rd5/zL85UcsTGty!z9Nx%Z+0e193YVEXFcWdM.]+uyVYA6 
WNNn]tdh-oQ]/#\R;Vts^}W]a%+%VqSEAu
Date: Mon, 15 Jun 1998 09:37:52 -0300
From: Alastair Reid [EMAIL PROTECTED]
Resent-Date:  Mon, 15 Jun 1998 14:57:05 +0100
Resent-From: [EMAIL PROTECTED]
Resent-To: [EMAIL PROTECTED]
MIME-Version: 1.0
Content-Type: text/plain; charset="us-ascii"





 On Mon, 15 Jun 1998, Fergus Henderson wrote:
 
  P.S.  Is there any reason why something like `HyperEval'
  isn't built in to Haskell, or at least include in the
  Haskell Library report?  Is there any implementation-specific
  precedent for something like this in say ghc?

Dave Tweed [EMAIL PROTECTED] added:
 I'd like to second this. It would have been very useful in some of the
 stuff I've written, particularly since (understandably enough) when using
 newtype you can't put ! annotations within the data-type.

I believe this is what the derive program (available from Glasgow's web site)
was originally developed for.


-- 
Alastair Reid  Yale Haskell Project Hacker
[EMAIL PROTECTED]  http://WWW.CS.Yale.EDU/homes/reid-alastair/



--3E1737327A--





Re: Exceptions are too return values!

1998-06-14 Thread Hans Aberg

  Here is an input on the exception handling question:

  In (pseudo) C++, one can write
try { ... }
catch (A) { if (C) then handle_it else rethrow }
But in a functional language it would be more reasonable to write
if (C) then catch(A) { handle_it }
or something like that, and let the compiler rewrite it to the C++
construction above (the latter which has the advantage that the handling
points are known in advance).

  Then this could be generalized: If f contains the handling of exceptions
E_1, ..., E_k, then f(x) rewrites to
catch (E_1, ..., E_k) { f(x), rethrow if not caught }
Then f(x) is only computed if needed because it handles the exception, but
it also ensures that the exception is handled if f has the capacity to do
so.

  I am not sure how this idea would work out in a functional language, but
this would be a part of the analysis one would have to do when implementing
exceptions.

  Hans Aberg
  * Email: Hans Aberg mailto:[EMAIL PROTECTED]
  * Home Page: http://www.matematik.su.se/~haberg/
  * AMS member listing: http://www.ams.org/cml/






Re: Exceptions are too return values!

1998-06-12 Thread Hans Aberg

At 10:50 +1000 98/06/12, Fergus Henderson wrote:
Infinities are probably best treated as a seperate issue.
That is, infinities should not correspond to exceptions.
If you have a type which supports infinities, then 1/0 should return
infinity, not raise an exception.  Conversely, if you want 1/0 to not
raise an exception, then your type should support infinities.

  I think it is best to let 1/0 throw an exception "divide-by-zero" -- then
this can be used to build types that support infinities (like projective
spaces).

  Hans Aberg
  * Email: Hans Aberg mailto:[EMAIL PROTECTED]
  * Home Page: http://www.matematik.su.se/~haberg/
  * AMS member listing: http://www.ams.org/cml/






Re: Exceptions are too return values!

1998-06-12 Thread Scott Turner

At 14:40 1998-06-10 +0100, you wrote:

Here's a reasonable design for exceptions in Haskell:

* handle :: (String - IO a) - IO a - IO a

You probably realized more quickly than I how this
can leak exceptions.  What I mean is

main = do quotient - handle (const (return 0)) (return (0 / 0)
 -- Looks plausible
 -- but the exception isn't raised yet.
  print quotient -- Here the expression 0/0 is evaluated
 -- and the exception is raised with no handler.

Is this considered a drawback?

--
Scott Turner
[EMAIL PROTECTED]   http://www.ma.ultranet.com/~pkturner





Re: Exceptions are too return values!

1998-06-10 Thread Dave Tweed

On Tue, 9 Jun 1998, Mariano Suarez Alvarez wrote:

 In a typed language, a function *cannot* be applied to something outside
 its domain. That's the whole point!

That represents a certain degree of idealisation though? E.g., sqrt _as a
(single valued) mathematical function_ has domain R^{=0}. Certainly I
could define a constructed datatype which is exactly this set. But if I
want to use machine floats the natural type is Float-Float. Type classes
don't appear to help because a condition for type (i.e., set) membership
like (=0) can't in general be decided at compile time. So I seem to be
faced with the fact that my argument type is a superset of the domain, and
I have to either check at run time or prove that only elements of the
domain will ever actually turn up.

Types catch lots of errors, but by no means all of them. (Presumably
similar examples can occur by, e.g., defining size balanced trees as Tr a
= Nd a (Tr a) (Tr a) | Lf which doesn't guarantee that a type-checking
expression is necessarily size-balanced.)

Or am I missing a terribly obvious point? 

cheers, dave

email: [EMAIL PROTECTED]   "Taught the wife some html. __Bad
www.cs.bris.ac.uk/~tweed/pi.htm   move__." -- Alan Cox
work tel: not available  





RE: Exceptions are too return values!

1998-06-10 Thread Karlsson Kent - keka

It's nice to have SOME way of handling exceptions, but...

 The implementation does not keep sets of exceptional values,
 of course.  It simply propagates the first one it trips
 over to the nearest enclosing handler.

One argument that can be made in favour of a generalised more IEEE-like
mechanism is that it is usually such a pain to handle an exception that
propagates like this that one most often does not bother to handle it
properly (i.e. try to continue with the task, which is usually the best
thing to do; user hitting 'break' or 'esc' excepted, but those are not
'exceptions' in this sense).  And in many cases, using some reasonable
'continuation value' (which have already been specified and widely
implemented for f.p. arithmetic) and a set of notes on exceptions that
have occurred, is sufficient and gives a nicer behaviour of the program.

Say that the application is to produce a simple function curve, for a
function given as argument, so only the type is known and no other
properties.  Say that it does this by computing a list of pairs later to
be turned into a nice-looking graph.  Say also that overflows occur, or
out-of-domain-errors occur.  Having these errors propagate up to an IO
monad or similar for handling, then having to restart, in the handler,
the graph calculation at the appropriate place is much more difficult to
handle (and is likely not to be done, or to be done in a buggy way) than
just plodding on as if (nearly) nothing out of the ordinary happened.  I
don't think that this situation is so exotic that one can safely ignore
it.  Indeed this behaviour has been specified as the default behaviour
for IEEE f.p.  And it is usually better to let the application continue
as normal, as long as no very critical error has occurred.  (Note that
not even divide-by-zero is considered critical in the IEEE world. It
does not even return a NaN, unless the numerator is also zero (or a
NaN).)

What one would need to do to obtain this, not that I'm suggesting it
very strongly, would be to generalise the IEEE model of exceptions from
f.p. arithmetic to values in general, including adding
Not-a-Proper-Value (NaPV) values to each non-f.p. datatype.  

A value of Haskell type T can be
 one of the values we know and love 
   (bottom, or constructor, or function,
depending on T),
   or NaPV (except for f.p. datatypes
which already have NaN values)

AND, implicitly,  it has a set of exception values
(this set is bottom if the value part is bottom).

Strict operations would propagate exceptions and NaPV values.
Certain predefined functions would be allowed to "read", or "replace"
the exception set part, something like:

add_exceptions :: a - Exceptions - a

where the Exceptions would be built into the result, and

read_and_clear_exceptions :: a - (a - Exceptions - b) - b

where the function argument would be given the value with cleared
Exceptions part, and as a second argument, the given Exceptions part.
And all is purely functional... (Unless I missed something.)

Yes, I have been ignoring performance issues.  Generating and keeping
Exceptions values around everywhere can be very taxing.  It would be
helpful to have an easy way of saying that the Exceptions part need not
be built-into the value (effectively clearing it, though the proper
Exceptions are propagated), changing the underlying datatype and
delaying the building-in.  It still may not be easy to get this very
efficient.  Indeed in the imperative (and IEEE arithmetic)world it is
never built-in, but one has one exceptions value per thread 'on the
side' (limited to arithmetic exceptions). (One such value per process is
not sufficient these days when multi-threaded processes are used.)

/kent k





Re: Exceptions are too return values!

1998-06-09 Thread Mariano Suarez Alvarez

On Mon, 8 Jun 1998, S. Alexander Jacobson wrote:

 1. it is not logically consistent to treat exceptions as return values

A function cannot do anything but return a value, can it? 

 For example, suppose that we define a new function:
 
  foo' a b = a + b -- foo' is strict in its arguments
 
 Our intuition is that foo' is commutative.  foo' a b = foo' b a.
 But that turns out not to be true when you have exceptions.

That's the problem with intuitions: they can be wrong...  
Anyhow, if one is to have exceptions procteting +, I don't think that
commutativity of foo' is reasonable: to handle exceptions, you have to do
checks, and that you can only do in one order or another. 

 Take x and y from before,
 
  z = foo' x' y'
 
 What is the value of z? Haskell does not promise to evaluate arguments in
 any particular order so, depending on implementation, z may be either
 Exception DivideByZero or Exception NotFactorialDomain -1.  

Actually, using a monad to manage exceptions you can (maybe, have to) 
choose a definite order of evaluation of non-exceptionality-conditions. 

 Truly exceptional conditions are those that truly are outside of the
 domain of the function being evaluated. e.g. factorial -1
 The VALUE of (factorial -1) is not an exception.  Neither is the value of
 (factorial (1 `div` 0)).
 When a function is passed bad arguments, it is not meaningful (from a
 functional perspective) to have it return a value.

In a typed language, a function *cannot* be applied to something outside
its domain. That's the whole point!

 The value of a function over arguments outside its domain is undefined.
 When such an event occurs, the logically consistent behavior is to exit
 function evaluation and tell the caller what was wrong with the
 arguments passed (to the extent it is possible to do).

One can rightfully argue that, if one is willing to consider bottom (which
is a value we cannot test for!) a return value, which we are, considering
an exception a return value is *very* consistent. 
 
-- m

---
Mariano Suarez Alvarez  The introduction of
Departamento de Matematica   numbers as coordinates
Universidad Nacional de Rosario [...] is an act of violence
Pellegrini 250  A. Weyl
2000 Rosario - Argentina
e-mail: [EMAIL PROTECTED]
---





Re: Exceptions are too return values!

1998-06-09 Thread Alex Ferguson


Alex Jacobson:
 Ooops, I forgot to remove the "and".  Anyway, my point is that 
 1. it is not logically consistent to treat exceptions as return values
 2. as an implementation matter it violates laziness to do so

OK, now I follow.  And diagree. ;-)  On your second point first:
I'm not sure what you mean by "violates laziness"; it would be true
to say that adding exceptional return values in a given way might
well reduce the laziness of the program; but this can always be
obviated, given sufficient care.


  Using error-monad syntax might be a bit more palatable, but amounts to
  essentially the same thing.  Alternatively, you can define HOFs to
  "lift" an n-ary function to an exception-propagating equivalent:

 That is what I did with my Exception version 2 syntax.
 The problem is that doing this lifting ends up being non-lazy.

You're right, it alters the strictness of the program.  But one can
recover the original behaviour by delaying/eliminating the pattern-match,
though I again I agree this is a pain.


 You could argue that this problem is an artifact of the Haskell syntax and
 that we could add Exceptions to the Thunk to achieve the desired result
 (treating exceptions as return values).

I don't think I would, though!  (If I understand what you mean by this.)
The "problem" is an artifact of wanting to keep the language referentially
transparent, which a built-in throw/catch scheme of the sort you
suggest would scupper.


 Our intuition is that foo' is commutative.  foo' a b = foo' b a.
 But that turns out not to be true when you have exceptions.

That's true.  And it remains true _however_ one treats exceptions.
There's no way around that in general, I'm afraid, and I'll cite you
assorted papers on Observable Sequentiality if you really want the
grubby details.


 But the real point here is that Exceptions are, by definition, results
 that are outside the domain of the function being evaluated.  Treating
 exceptions as algebraic types may be comforting, but what you are really
 doing in that case is extending the domain of your function

Effectively, yes.  From a domain theory PoV, this is all that one could
possibly ever do, in fact ('error' included).


 -- and there are limits to how far you can go with that.

These being?


 Truly exceptional conditions are those that truly are outside of the
 domain of the function being evaluated. e.g. factorial -1
 The VALUE of (factorial -1) is not an exception.  Neither is the value of
 (factorial (1 `div` 0)).
 When a function is passed bad arguments, it is not meaningful (from a
 functional perspective) to have it return a value.
 The value of a function over arguments outside its domain is undefined.
 When such an event occurs, the logically consistent behavior is to exit
 function evaluation and tell the caller what was wrong with the
 arguments passed (to the extent it is possible to do).

I don't find this argument at all compelling.  If a value is "truly
outside the domain of the function being evaluated", then don't pass
it to it!  This may seem glib, but I do believe that its better SE
practice in general.  If there are exceptional conditions in "the world",
or if determining a sufficient precondition is not practicable, then I
repeat my advice concerning exceptional return values, a necessary evil
though they might be.


 Right now that means using the error function.  I am just saying that
 error isn't really enough for a production quality language.

Agreed.

 Does this make more sense?

It makes perfect sense, but I think that having exceptions as a language
mechanism in Haskell is not realistic or viable, for the reasons I
outlined before.  I don't pretend that the alternatives are trivial,
or even necessarily very pleasant-looking -- just that they're necessary.

Slainte,
Alex.