Deprecate an instance

2005-05-20 Thread Jon Fairbairn
Would it be possible to extend the DEPRECATED pragma to
allow one to deprecate an instance of a class?

I was thinking about the recent discussion of APIs on
haskell-cafe, where Jérémy Bobbio complained about using
Booleans as arguments to libaray functions, preferring
instead sensibly named data constructors. It occurred to me
that by defining a class one could allow both the old
interface and a better one by using a class:

   module Main where

   -- suppose f used to be Bool -> Int -> Int, replace it
   -- with this:

   f :: Toggle t => t -> Int -> Int

   f t x = case enabled t
   of Invert -> -x
  DontInvert -> x

   data DoInvert = Invert | DontInvert

   class Toggle t where
   enabled :: t -> DoInvert

   instance Toggle DoInvert where
   enabled = id
   instance Toggle Bool where
   enabled True = Invert
   enabled False = DontInvert


but for this to be any real use, we'd have to be able to
deprecate the /instance/ Toggle Bool.

-- 
Jón Fairbairn  Jon.Fairbairn at cl.cam.ac.uk


___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


MPC with fundeps: ghc-6.2.2 vs ghc-6.4

2005-05-20 Thread Christian Maeder
Hi,

the following (reduced) example used to go through with ghc-6.2.2 but
fails with ghc-6.4. Which behaviour is correct? I compile with:

ghc -fglasgow-exts Context.hs


module Context where

class Language a
class Language a => Logic a b | a -> b
class (Language a, Logic b c, Logic d e)
=> Comorph a b c d e | a -> b, a -> d

instance (Comorph a1 b1 c1 d1 e1, Comorph a2 b2 c2 d2 e2)
=> Language (a1, a2)

instance (Comorph a1 b1 c1 d1 e1, Comorph a2 b2 c2 d2 e2)
=> Comorph (a1, a2) b1 c1 d2 e2

-- end of module

ghc-6.4 (or ghc-6.4.1) complains with:

Context.hs:11:0:
Could not deduce (Comorph a2 b2 c21 d2 e21, Comorph a1 b1 c11 d1 e11)
  from the context (Comorph a1 b1 c1 d1 e1, Comorph a2 b2 c2 d2 e2)
  arising from the superclasses of an instance declaration at
Context.hs:11:0
Probable fix:
  add (Comorph a2 b2 c21 d2 e21, Comorph a1 b1 c11 d1 e11)
  to the instance declaration superclass context
In the instance declaration for `Comorph (a1, a2) b1 c1 d2 e2'


If I replace the first instance with
"instance (Language a1, Language a2) => Language (a1, a2)"
then ghc-6.4 is happy.

Cheers Christian
___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Re: Re[2]: error in your article? about meaning of safe/unsafe in "foreign import"

2005-05-20 Thread Peter Simons
Bulat Ziganshin writes:

 PS> Since pure FFI calls don't have any side-effects, they are
 PS> always safe to be called unsafely.

 > sorry, but even pure C function can call back to Haskell world and
 > lead to GC.

Um, right. I said I didn't understand these things
completely either. Guess I was right. ;-)

___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Re[2]: error in your article? about meaning of safe/unsafe in "foreign import"

2005-05-20 Thread Bulat Ziganshin
Hello Peter,

Friday, May 20, 2005, 1:30:08 PM, you wrote:

PS> just for the record, it's not my article. Although I have the
PS> privilege of sharing a somewhat similar name with the geniuses
PS> around here, I didn't have any part in that text. ;-)

i answered your letter but wrote to Simon PJ

PS> Since pure FFI calls don't have any side-effects, they are
PS> always safe to be called unsafely.

sorry, but even pure C function can call back to Haskell world and
lead to GC. so the meaning of "IO" and "unsafe" are completely
orthogonal. moreover, 90% of called C fucntions will not call back to
Haskell, whether they in IO monad or not



-- 
Best regards,
 Bulatmailto:[EMAIL PROTECTED]



___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Re: error in your article? about meaning of safe/unsafe in "foreign import"

2005-05-20 Thread Peter Simons
Duncan Coutts writes:

 > So to sumarise the pairings:
 >   * you _must_ make a safe call to an unsafe foreign function
 >   * you _may_ make an unsafe call to a safe foreign function
 >
 > It's a contravariance :-)

I'd use a slightly different term. Declaring a function that
needs special precaution to be called as "safe", and
declaring a function that is safe to be called anytime as
"unsafe" is contra-intuitive. ;-)

Peter

___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Re: error in your article? about meaning of safe/unsafe in "foreign import"

2005-05-20 Thread Duncan Coutts
On Fri, 2005-05-20 at 11:30 +0200, Peter Simons wrote:

> Since pure FFI calls don't have any side-effects, they are
> always safe to be called unsafely. (Yes, the choice of the
> words "safe" and "unsafe" is a bit unfortunate in the standard
> here.)

To try and undo this confusion we need to recall what the safe/unsafe
are referring to. This safe/unsafe tag is used to describe both a
property of the form of the call (what degree of precaution we take in
making the call) and also a property of the thing we are calling
(whether it has side effects or can trigger callbacks into the Haskell
world).

The two uses are basically opposite:

For a C procedure that can trigger callbacks, we have to take extra
procautions when calling it, that is we have to make the call in a
"safe" way.

For a C procedure that cannot trigger callbacks, we don't have to worry
at all when calling it, that is we can omit various cleanups, locks and
checks thus doing the call in an "unsafe" way.

So to sumarise the pairings:
  * you _must_ make a safe call to an unsafe foreign function
  * you _may_ make an unsafe call to a safe foreign function

It's a contravariance :-)

Duncan

___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Re: error in your article? about meaning of safe/unsafe in "foreign import"

2005-05-20 Thread Peter Simons
Bulat,

just for the record, it's not my article. Although I have the
privilege of sharing a somewhat similar name with the geniuses
around here, I didn't have any part in that text. ;-)

You were wondering about this declaration:

 >  foreign import ccall unsafe sin :: Float -> Float

I guess you are confused by the difference between safe/unsafe
FFI calls versus pure/impure FFI calls. Which is comforting
for me, because as it happens I don't quite understand that
either. ;-) I'll try to explain what I believe I do
understand, and hope that the others on this list chime in
case I mess something up.

A pure function is one without side-effects, meaning that the
result depends only on the function arguments. Those are
surprisingly few; the C function strlen(3) for example is
_not_ pure because it depends on the fact that the memory
pointed to by the argument actually contains the string
which's length you'd like to compute. So the strlen() call
must occur in the correct order in relation to other I/O calls
like as read(), malloc(), or whatever. Thus, the signature for
strlen() would be:

strlen :: Ptr CChar -> IO CSize

The sin(3) function on the other hand is pure. It doesn't
depend on anything but the floating point value you give it,
hence in can be evaluated at any point of the program
execution, hence it doesn't need to be in the IO monad:

sin :: CFloat -> CFloat

Now, safe and unsafe calls are a different beast:

 | A safe call is less efficient, but guarantees to leave the
 | Haskell system in a state that allows callbacks from the
 | external code. In contrast, an unsafe call, while carrying
 | less overhead, must not trigger a callback into the Haskell
 | system.

The vast majority of C function you will call are unaware of
Haskell. They will not trigger anything the Haskell runtime
system needs to know about, nor will they force a part of your
Haskell program to be evaluated. Those functions can be called
unsafely, just like the definition above says.

Since pure FFI calls don't have any side-effects, they are
always safe to be called unsafely. (Yes, the choice of the
words "safe" and "unsafe" is a bit unfortunate in the standard
here.) So unless I am very mistaken, the declaration

  foreign import ccall safe sin :: Float -> Float

would work just as well as the one above does, but it would be
less efficient.

In other words, if you declare a FFI function to be called
safely, and to be called from within the IO monad, then
absolutely nothing can possibly go wrong. ;-)


 > is it possible to download sources of http server mentioned
 > in this article?

I think the (more or less) latest version is here:

  http://www.mdstud.chalmers.se/~md9ms/hws-wp/

Another somewhat extensive example for system programming in
Haskell is available here:

  http://postmaster.cryp.to/

Hope this helps.

Peter

___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Re[2]: error in your article? about meaning of safe/unsafe in "forei gn import"

2005-05-20 Thread Bulat Ziganshin
Hello Alistair,

Friday, May 20, 2005, 11:18:15 AM, you wrote:
BA> I believe the web-server mentioned became HWS:
BA>   http://cvs.sf.net/viewcvs.py/haskell-libs/libs/hws-wp/hws-wp/src/

thank you


BA> (I don't see any error/inconsistency in the two quotes; they just seem to be
BA> talking about different things. SPJ's quote is about declaring "pure" FFI
BA> functions, while the FFI quote is about enabling callbacks into Haskell
BA> code. Can you elaborate?)

but both says about meaning of "unsafe" keyword!

-- 
Best regards,
 Bulatmailto:[EMAIL PROTECTED]



___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


RE: error in your article? about meaning of safe/unsafe in "forei gn import"

2005-05-20 Thread Bayley, Alistair
> From: Bulat Ziganshin [mailto:[EMAIL PROTECTED] 
>
> and one more question: is it possible to download sources of http
> server mentioned in this article? i want to browse the code, it's no
> matter how it compiles and works

I believe the web-server mentioned became HWS:
  http://cvs.sf.net/viewcvs.py/haskell-libs/libs/hws-wp/hws-wp/src/


(I don't see any error/inconsistency in the two quotes; they just seem to be
talking about different things. SPJ's quote is about declaring "pure" FFI
functions, while the FFI quote is about enabling callbacks into Haskell
code. Can you elaborate?)

Alistair.

-
*
Confidentiality Note: The information contained in this   message, and any
attachments, may contain confidential   and/or privileged material. It is
intended solely for the   person(s) or entity to which it is addressed. Any
review,   retransmission, dissemination, or taking of any action in
reliance upon this information by persons or entities other   than the
intended recipient(s) is prohibited. If you received  this in error, please
contact the sender and delete the   material from any computer.
*

___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users