Re: Top Level TWI's again was Re: [Haskell] Re: Parameterized Show

2004-11-25 Thread Adrian Hey
On Wednesday 24 Nov 2004 11:50 am, Keean Schupke wrote:
 There is no problem getting multiple copies of the channels... I take it
 you are not familiar with the internals of OSs

IME there is no uniformity wrt OS internals, and I can't claim to be
familiar with them all. It's also fairly safe to assume that I know
nothing about the internals of your OS.

In any case, this is irrelevant to the scenario I originally posited.
Remember I wrote:
 What if there is no OS or device driver?
---^

I.E. A typicial embedded environment (though it's common to use OSs
here too, but the main reason for that is inadequacy of C). So all
you have to work with is one complete, type safe, Haskell program,
and the metal. In this scenario the only initialisation that's
done prior to running main is initialisation of the Haskell rts.

That said, the approach you outline below is workable and AFAICS
immune to the problems I was talking about. But you've introduced
an artificial distinction between OS and application to do this
and as a result..

* Made comms between application and hardware really awkward IMO
* Sacrificed type safety in these comms I think.

 (I have written a small
 OS myself, complete with real device drivers)... The OS is started at
 boot, it initialises its own state, then it forks the device drivers, then
 it forks user processes (simplified but adequate).

 Lets design a small Haskell OS, the OS has the handles for the device
 driver.
 The program MUST be passed the channels to the OS (there is no other
 way)... These channels allow other channels to be opened, they would be
 like the master device.

 main :: Chan CMD - Chan RSP - IO ()
 main cmd rsp = do
writeChan cmd (OpenDevice devname)
h - readChan rsp
case h of
   (OpenOK in out) - do
 writeCan out  (DeviceWriteString hello)
 status - readChan in
   _ - error could not open device

 Here you can see that we could try and open the device again, however the
 OS would either multiplex or serialize the device depending on type.

So you've gone for the third approach I identified, but with a slight
variation. You've wrapped all the separate device drivers into a single
uber device driver (world driver?) and called it the operating system.
I think this approach has it's pros and cons, but you're right that it
does solve the problem. But my original monosyllabic summary of MHO re.
this approach still applies I'm afraid.

Regards
--
Adrian Hey
 







___
Haskell mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/haskell


Re: Top Level TWI's again was Re: [Haskell] Re: Parameterized Show

2004-11-24 Thread Adrian Hey
On Tuesday 23 Nov 2004 9:29 am, Keean Schupke wrote:
 Is this a joke?

No.

 Seriously if you writing the OS in haskell this is trivial,
 you fork a thread using forkIO at system boot to maintain the driver,
 all 'processes' communicate to the thread using channels, the thread
 maintains local state (an IORef, or just a peramiter used recursively)

 myDriver :: (Chan in,Chan out) - State - IO State
 myDriver (in,out) state = do
-- read commands from in
-- process commands
-- reply on out
myDriver (in,out) new_state

How does this solve the problem we're talking about (namely preventing
the accidental creation of multiple processes all of which believe they
are the device driver for a particular unique resource)?

I take it we can't expose myDriver to the world at large, so what the
world at large sees must be just the unique channels to communicate
with one myDriver (which is forked only once somewhere outside main).
I can think of three ways of allowing the world at large to see the
channels.

1- Have them as top level TWI's. I guess you're not in favour of that.
2- Have getChannels :: IO (Chan in,Chan out) instead. But this buys you
   no extra safety, and there's still the problem of how to implement
   getChannels if we're not allowed top level TWI's.
3- Have the in and out channels of this and every other periheral passed
   as an explicit argument to the user main. Yuk!, highly unmodular IMO,
   not mention having the type of main depend on what devices were available.  

Again it would seem an appropriate implementation of getChannels would
be a top level ..

getChannels - oneShot $ do inChan  - newChan
outChan - newChan
forkIO $ myDriver (inChan,outChan) state0
return (inChan,outChan)

But of course this is so evil it's not worth further consideration :-)

Regards
--
Adrian Hey

___
Haskell mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/haskell


Re: Top Level TWI's again was Re: [Haskell] Re: Parameterized Show

2004-11-24 Thread Adrian Hey
On Tuesday 23 Nov 2004 9:39 am, Lennart Augustsson wrote:
 I find it hard to argue these things in the abstract.  Could you
 post us a (simplified) signature for a module where you are
 using top level variables?  Maybe that way I can be convinced
 that you need them.  Or vice versa. :)

Nope, sorry, been down this route once before and I'm sick of these
arguments. Fortunately (having just had time for a quick scan of
John Meachams post) it seems JM has done an excellent job of this
already. (So argue with him, I'm taking the day off :-) 

Regards
--
Adrian Hey

___
Haskell mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/haskell


Re: Top Level TWI's again was Re: [Haskell] Re: Parameterized Show

2004-11-24 Thread Lennart Augustsson
Adrian Hey wrote:
On Tuesday 23 Nov 2004 9:39 am, Lennart Augustsson wrote:
I find it hard to argue these things in the abstract.  Could you
post us a (simplified) signature for a module where you are
using top level variables?  Maybe that way I can be convinced
that you need them.  Or vice versa. :)

Nope, sorry, been down this route once before and I'm sick of these
arguments. Fortunately (having just had time for a quick scan of
John Meachams post) it seems JM has done an excellent job of this
already. (So argue with him, I'm taking the day off :-) 
Enjoy your day off!  I guess we will both remain unconvinced. :)
-- Lennart
___
Haskell mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/haskell


Re: Top Level TWI's again was Re: [Haskell] Re: Parameterized Show

2004-11-24 Thread Lennart Augustsson
Adrian Hey wrote:
On Tuesday 23 Nov 2004 9:29 am, Keean Schupke wrote:
   myDriver :: (Chan in,Chan out) - State - IO State
   myDriver (in,out) state = do
  -- read commands from in
  -- process commands
  -- reply on out
  myDriver (in,out) new_state

How does this solve the problem we're talking about (namely preventing
the accidental creation of multiple processes all of which believe they
are the device driver for a particular unique resource)?
So do you agree with me that the protection against two drivers
opening the same device does not belong in the driver code?
(Because if it sits there I could mistakenly have another driver
open the same device.)
-- Lennart
___
Haskell mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/haskell


Re: Top Level TWI's again was Re: [Haskell] Re: Parameterized Show

2004-11-24 Thread Keean Schupke
There is no problem getting multiple copies of the channels... I take it
you are not familiar with the internals of OSs (I have written a small
OS myself, complete with real device drivers)... The OS is started at
boot, it initialises its own state, then it forks the device drivers, then
it forks user processes (simplified but adequate).
Lets design a small Haskell OS, the OS has the handles for the device 
driver.
The program MUST be passed the channels to the OS (there is no other way)...
These channels allow other channels to be opened, they would be like the
master device.

   main :: Chan CMD - Chan RSP - IO ()
   main cmd rsp = do
  writeChan cmd (OpenDevice devname)
  h - readChan rsp
  case h of
 (OpenOK in out) - do
   writeCan out  (DeviceWriteString hello)
   status - readChan in
 _ - error could not open device
Here you can see that we could try and open the device again, however the
OS would either multiplex or serialize the device depending on type.
   Keean.
Adrian Hey wrote:
On Tuesday 23 Nov 2004 9:29 am, Keean Schupke wrote:
 

Is this a joke?
   

No.
 

Seriously if you writing the OS in haskell this is trivial,
you fork a thread using forkIO at system boot to maintain the driver,
all 'processes' communicate to the thread using channels, the thread
maintains local state (an IORef, or just a peramiter used recursively)
   myDriver :: (Chan in,Chan out) - State - IO State
   myDriver (in,out) state = do
  -- read commands from in
  -- process commands
  -- reply on out
  myDriver (in,out) new_state
   

How does this solve the problem we're talking about (namely preventing
the accidental creation of multiple processes all of which believe they
are the device driver for a particular unique resource)?
I take it we can't expose myDriver to the world at large, so what the
world at large sees must be just the unique channels to communicate
with one myDriver (which is forked only once somewhere outside main).
I can think of three ways of allowing the world at large to see the
channels.
1- Have them as top level TWI's. I guess you're not in favour of that.
2- Have getChannels :: IO (Chan in,Chan out) instead. But this buys you
  no extra safety, and there's still the problem of how to implement
  getChannels if we're not allowed top level TWI's.
3- Have the in and out channels of this and every other periheral passed
  as an explicit argument to the user main. Yuk!, highly unmodular IMO,
  not mention having the type of main depend on what devices were available.  

Again it would seem an appropriate implementation of getChannels would
be a top level ..
getChannels - oneShot $ do inChan  - newChan
   outChan - newChan
   forkIO $ myDriver (inChan,outChan) state0
   return (inChan,outChan)
But of course this is so evil it's not worth further consideration :-)
Regards
--
Adrian Hey
___
Haskell mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/haskell
 

___
Haskell mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/haskell


Re: Top Level TWI's again was Re: [Haskell] Re: Parameterized Show

2004-11-23 Thread Adrian Hey
On Monday 22 Nov 2004 6:27 pm, Lennart Augustsson wrote:

 Personally, I can't believe I hear people arguing for global variables.

Oh dear, here we go again. I repeat, AFAIK nobody who wants a solution to
this problem is advocating the use of global variables, though it's
true that the proposal under discussion would enable their creation if
folk chose to be that foolish.

For some reason it seems to have been left entirely up to me alone
to defend the case for *top level* (not global!) mutable data structures.
But I know I'm not the only one who wants a solution of some kind.
Off the top of my head I can think of many others who've expressed
the same desire at one time or another. I won't name names because
I might be misrepresenting their views, but if you think they're
all incompetent lazy Haskell programmers eager too shoot themselves
in the foot because they just don't understand monadic IO, then you
should think again. 

As for me, I strongly object to having any further consideration of
this problem or the proposed solutions being kicked into the long grass
by ill-considered knee jerk reactions of horror (or ridicule) concerning
global variables.

 As for openDevice, if a device should only allow a single open I would
 assume this is part of the device driver in the operating system?
 (I know this is shifting blame.  But I think it shifts it to where it
 belongs.  In the OS there will be an open flag per device.)

IOW there is no possible sound solution in Haskell. I think that's
a problem for a general purpose programming language. What if
there is no OS or device driver? Shouldn't people reasonably expect
to be able to write their own device driver in a general purpose
programming language?

Regards
--
Adrian Hey


___
Haskell mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/haskell


Re: Top Level TWI's again was Re: [Haskell] Re: Parameterized Show

2004-11-23 Thread Adrian Hey
On Monday 22 Nov 2004 11:26 am, Keean Schupke wrote:
 Adrian Hey wrote:
 Just repeating this again and again doesn't make it any more true.

 Ditto... I for one think the best solution is to use the language as
 intended and pass the values as function arguments.

I guess you mean the usual handle based approach, but this makes no
sense at all for a Haskell interface to some *unique* stateful resource
(eg. a piece of raw hardware or badly designed C library). The handle
is a completely redundant argument to all interface functions (there's no
need identify which thing is being referenced because there is only one).

Furthermore it still leaves you with the problem ensuring that users
don't use whatever openUniqueThing routine that creates and initialises
the state multiple times to end up with two or more different TWIs which
are all trying to reflect state changes in the same unique resource.
AFAICS the only way of preventing this requires the use of top level
mutable state, so this solution is a non-solution (the only safe way
of using this solution still leaves you with the original problem).
Of course this problem could be solved quite simply with a top level..

 userOpenUniqueThing - oneShot openUniqueThing

Unfortunately this is not an option because it creates a top level MVar
(and so it must be evil).

The only thing to be said in favour of the handle based approach is
that forcing users to get the state handle does ensure that any
necessary external initialisation has been performed prior to using
the resource. But there are other ways to do this too (like prefixing
every exported interface function with userInit instead of exporting
userInit itself).

 As pointed out
 on this list - the only possible situation where you cannot do this is
 when interfacing to a badly written C library.

This is one situation, but certainly not the only possible one. You have
the same problem with interfacing to any unique stateful resource (or
even if you have a multiple but finite supply of these resources). 

 This is true - but only because unsafePerformIO exists. Without it
 World is simply a value passed via the IO Monad.

Huh? Top level TWIs are just part of the initial world state (as seen
by main). We can argue about whether or not they are needed, but their
existence surely doesn't make the situation any worse than it already
is.

 I would ask an alternative question - is it possible to live without
 unsafePerformIO?

Not at present.

 I have never needed to use it!

I have a feeling that those folk who think they don't need it are
those who enjoy the luxury of doing all their IO via pre-supplied
Haskell user friendly libraries and haven't given much thought
to how these libraries actually work or how they could be
implemented in Haskell if they didn't already exist (without using
the unsafePerformIO hack of course). 

Regards
--
Adrian Hey

___
Haskell mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/haskell


Re: Top Level TWI's again was Re: [Haskell] Re: Parameterized Show

2004-11-23 Thread Adrian Hey
On Monday 22 Nov 2004 4:03 pm, Benjamin Franksen wrote:
 This is getting ridiculous. At least two workable alternatives have been
 presented:

 - C wrapper (especially if your library is doing FFI anyway)
 - OS named semaphores

Neither of these alternatives is a workable general solution.
There are several significant problems with both, but by far
the most significant problem (at least if you believe that top
level mutable state is evil) is that they both rely on the use
of top level mutable state. If this is evil it is surely just as
evil in C or OS supplied resources as it is in Haskell.

The fact that one solution requires the use of a completely different
programming language and the other requires the use of a library which
could not be implemented in Haskell (not without using unsafePerformIO
anyway) must be telling us that there something that's just plain missing
from Haskell. IMO this is not a very satisfactory situation for a language
that's advertised as general purpose.

 Further, as for evidence or credible justification for the my claim, you
 can gather it from the numerous real-life examples I gave, and which you
 chose to ignore or at least found not worthy of any comment.

I have no idea what examples you're talking about. Did you post any code?
If so, I must have missed it for some reason. Perhaps your're refering
to your elimination of unsafePerformIO from a library you were writing.
It's not really possible to comment on the significance of you being
able to eliminate top level mutable state in this case without knowing
why you were using it in the first place. 

 Of course,
 these examples are only annecdotal but I think this is better than a
 completely artificial requirement (like your oneShot).

Being able to avoid the use of top level mutable state sometimes (or even
quite often) is not proof that it's unnecessary, especially when nobody
(other than yourself presumably) knows why you were using it in the first
place. However, the existance of just one real world example where it does
appear unavoidable is pretty convincing evidence to the contrary IMO.
It may yet prove to be avoidable, but nobody has managed to show that and
I certainly can't think of a way.

 You have been asked more than once to present a *real-life* example to
 illustrate that

 (a) global variables are necessary (and not just convenient),
 (b) both above mentioned alternatives are indeed unworkable.

I knew this would happen. I was asked to provide an example and I *did*.
I gave the simplest possible example I had of the more general problem,
and now this whole thread has consisted of either repeated denials of
the reality of even this simple problem (something you've just done again)
or protracted discussions over various half baked non-solutions to
this one particular problem (such as those you identify above) without
seeing the real underlying general problem.

(See my response to Keaan) You have the same basic problem when dealing
with any unique stateful resource. Even the state handle passing solution
that I believe yourself, Keaan and Lennart would advocate is unsafe
without using top level mutable state one way or another (a problem that
could be fixed quite easily by using oneShot at the top level I might add).

  You have yet to
  explain how you propose to deal with stdout etc..

 I see absolutely no reason why stdxxx must or should be top-level mutable
 objects. They can and should be treated in the same way as environment and
 command line arguments, i.e.

 getArgs :: IO [String]
 getEnv :: String - IO String
 getStdin, getStdout, getStderr :: IO Handle

 Note that (just like environment and command line arguments) these handles
 may refer to completely different things on different program runs.

Sure, Peter Simons suggested the same thing. I have no great objection,
but why do this? I mean what extra safety does this buy you? Anybody can
still get at stdout and write anything they like to it.

The only difference is that instead of writing..

 do ...
foo stdout
...

..they now have to write..

 do ...
stdout - getStdout
foo stdout
...

I don't see why the former should be regarded as a source of great evil
which is somehow eliminated by the latter.

Regards
--
Adrian Hey
___
Haskell mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/haskell


Re: Top Level TWI's again was Re: [Haskell] Re: Parameterized Show

2004-11-23 Thread Keean Schupke
Is this a joke? Seriously if you writing the OS in haskell this is trivial,
you fork a thread using forkIO at system boot to maintain the driver,
all 'processes' communicate to the thread using channels, the thread
maintains local state (an IORef, or just a peramiter used recursively)
   myDriver :: (Chan in,Chan out) - State - IO State
   myDriver (in,out) state = do
  -- read commands from in
  -- process commands
  -- reply on out
  myDriver (in,out) new_state
   Keean.
Adrian Hey wrote:
IOW there is no possible sound solution in Haskell. I think that's
a problem for a general purpose programming language. What if
there is no OS or device driver? Shouldn't people reasonably expect
to be able to write their own device driver in a general purpose
programming language?
Regards
--
Adrian Hey
___
Haskell mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/haskell
 

___
Haskell mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/haskell


Re: Top Level TWI's again was Re: [Haskell] Re: Parameterized Show

2004-11-23 Thread Lennart Augustsson
Adrian Hey wrote:
As for openDevice, if a device should only allow a single open I would
assume this is part of the device driver in the operating system?
(I know this is shifting blame.  But I think it shifts it to where it
belongs.  In the OS there will be an open flag per device.)

IOW there is no possible sound solution in Haskell. I think that's
a problem for a general purpose programming language. What if
there is no OS or device driver? Shouldn't people reasonably expect
to be able to write their own device driver in a general purpose
programming language?
I find it hard to argue these things in the abstract.  Could you
post us a (simplified) signature for a module where you are
using top level variables?  Maybe that way I can be convinced
that you need them.  Or vice versa. :)
If there's no OS nor driver you are free to do what you like, so
I claim you can do without top level variables.
I've written plenty of device drivers in C for NetBSD.  They (almost)
never use top level mutable variables (except to control debugging
level).  If you use top level variables it always bites you in the end.
On some occasions I started with using top level mutables (like keeping
a free list of transfer descriptors), but in the end I always had to
change them to be local to some other piece of state.  (I didn't
change because of purity reasons, but out of necessity.)  So my aversion
for top level mutables does not stem from Haskell alone.
-- Lennart
___
Haskell mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/haskell


Re: Top Level TWI's again was Re: [Haskell] Re: Parameterized Show

2004-11-23 Thread Keean Schupke
Adrian Hey wrote:
I guess you mean the usual handle based approach, but this makes no
sense at all for a Haskell interface to some *unique* stateful resource
(eg. a piece of raw hardware or badly designed C library). The handle
is a completely redundant argument to all interface functions (there's no
need identify which thing is being referenced because there is only one).
 

Hopefully my last post laid the raw hardware device example
to rest... It really is not necessary if coding a 'pure haskell'
driver for some hardware as part of a Haskell OS. If the OS
is not in Haskell your second example reduces to your first,
if the OS is not serialising devices access we are just
talking about interfacing with a badly written C library again.
This is one situation, but certainly not the only possible one. You have
the same problem with interfacing to any unique stateful resource (or
even if you have a multiple but finite supply of these resources).
No you don't... Most devices have registers, those registers contain
values, you can inspect those values to see if the device has been
initialised. You can then write a guard on the initialisation that really
checks if the device has (or hasn't) been initialised rather than rely 
on some
'shadow' copies in RAM.

Huh? Top level TWIs are just part of the initial world state (as seen
by main). We can argue about whether or not they are needed, but their
existence surely doesn't make the situation any worse than it already
is.
 

The IO monad passes its state around, it is just hidden. This is not
like implicit parameters. So main is _passed_ RealWorld as an
argument, and returns RealWorld, just like the state monad:
   data State a = State (s - (s,a))
Hides the passing of the state...
I have a feeling that those folk who think they don't need it are
those who enjoy the luxury of doing all their IO via pre-supplied
Haskell user friendly libraries and haven't given much thought
to how these libraries actually work or how they could be
implemented in Haskell if they didn't already exist (without using
the unsafePerformIO hack of course). 
 

No, if that were the case I would be suggesting we can do
without unsafeInterleaveIO... but unfortunately it seems
necessary to me.
   Keean.
___
Haskell mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/haskell


Re: Top Level TWI's again was Re: [Haskell] Re: Parameterized Show

2004-11-23 Thread Benjamin Franksen
On Tuesday 23 November 2004 10:39, Keean Schupke wrote:
 Adrian Hey wrote:
 This is one situation, but certainly not the only possible one. You have
 the same problem with interfacing to any unique stateful resource (or
 even if you have a multiple but finite supply of these resources).

 No you don't... Most devices have registers, those registers contain
 values, you can inspect those values to see if the device has been
 initialised. You can then write a guard on the initialisation that really
 checks if the device has (or hasn't) been initialised rather than rely
 on some
 'shadow' copies in RAM.

Alas, unfortunately not every device is designed in this way (I can give 
examples if you want). Adrian is right in that there is not only badly 
designed C libraries but also badly designed hardware!

Ben
-- 
Top level things with identity are evil.-- Lennart Augustsson
___
Haskell mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/haskell


Re: Top Level TWI's again was Re: [Haskell] Re: Parameterized Show

2004-11-23 Thread Benjamin Franksen
On Tuesday 23 November 2004 09:10, Adrian Hey wrote:
 On Monday 22 Nov 2004 6:27 pm, Lennart Augustsson wrote:
  Personally, I can't believe I hear people arguing for global variables.

 Oh dear, here we go again. I repeat, AFAIK nobody who wants a solution to
 this problem is advocating the use of global variables

I don't understand the difference between a global variable

(C code, outside main): int var = 0;

and a top-level thing with identity

(proposed Haskell code, outside main): var - newIORef 0

AFAIK, global in C (or any other imperative language) means the same as 
top-level in Haskell.

Ben
-- 
Ceterum censeo: Global variabes are evil.
___
Haskell mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/haskell


Re: Top Level TWI's again was Re: [Haskell] Re: Parameterized Show

2004-11-23 Thread Keean Schupke
Okay - but then you can keep state in haskell by using a driver thread
and channels like in the example I posted. I guess I should have said
it is best practice to check the real state rather than a (possibly wrong)
copy.
   Keean.
Benjamin Franksen wrote:
On Tuesday 23 November 2004 10:39, Keean Schupke wrote:
 

Adrian Hey wrote:
   

This is one situation, but certainly not the only possible one. You have
the same problem with interfacing to any unique stateful resource (or
even if you have a multiple but finite supply of these resources).
 

No you don't... Most devices have registers, those registers contain
values, you can inspect those values to see if the device has been
initialised. You can then write a guard on the initialisation that really
checks if the device has (or hasn't) been initialised rather than rely
on some
'shadow' copies in RAM.
   

Alas, unfortunately not every device is designed in this way (I can give 
examples if you want). Adrian is right in that there is not only badly 
designed C libraries but also badly designed hardware!

Ben
 

___
Haskell mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/haskell


Re: [Haskell-cafe] Re: Top Level TWI's again was Re: [Haskell] Re: Parameterized Show

2004-11-23 Thread Keean Schupke
Can a C function be pure? I guess it can... The trouble is you cannot 
proove its
pure?

But - why would you want to use a pure C function. The chances of any useful
C library function being pure are slim - and the performance of GHC in some
of the benchmarks shows that there is hardly any speed advantage (for a pure
function)...
   Keean.
Benjamin Franksen wrote:
On Monday 22 November 2004 23:22, Keean Schupke wrote:
 

It seems to me that as unsafePerformIO is not in the standard and only
implemented on some
compilers/interpreters, that you limit the portability of code by using
it, and that it is best avoided. Also as any safe use of unsafePerformIO
can be refactored to not use it I could
certainly live without it.
   

With one exception: If a foreign function (e.g. from a C library) is really 
pure, then I see no way to tell that to the compiler other than using 
unsafePerformIO. IIRC, unsafePerformIO is in the standard FFI libraries.

Ben
 

___
Haskell-Cafe mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] Re: Top Level TWI's again was Re: [Haskell] Re: Parameterized Show

2004-11-23 Thread Graham Klyne
I think this is a useful debate, because it touches on how Haskell meets 
real-world programming needs, so I shall continue in that spirit...

At 22:22 22/11/04 +, Keean Schupke wrote:
Obviously without knowing the details I am speculating, but would it not 
be possible
to do a first pass of the XML and build a list of files to read (a pure 
function) this returns
its result to the IO monad where the files are read and concatenated 
together, and passed
to a second (pure functional) processing function. If written well this 
can take advantage
of lazy execution, so both functions end up running concurrently.
In an ideal world, it is certainly possible to separate the pure and 
non-pure aspects of the code, and do something like you suggest.  But my 
position was that I was working with an existing codebase (HaXml) which had 
not been structured with this requirement in mind, and I absolutely did not 
want to start from scratch (as it was, I was forced into some substantial 
refactoring).  This was one case where, in order to get any result at all 
with the time/effort available to me, I needed to hide the I/OI within an 
otherwise pure function.

Yes, there are better ways but, being a Bear of Very Little Brain, I have 
to work with the tools, intellectual and otherwise, that are at my 
disposal.  Most software is not built in the optimum fashion, or even 
anything close to it.  I would suggest that one of the challenges for 
functional programming is to maker it easy to do the right thing.  I came 
to functional programming with quite a strong bias to make it work for me, 
inspired many years ago by John Backus' famous paper, and a presentation by 
David Turner about KRC, and a few other things.  Many programmers I've 
spoken to who have tried functional programing have given up on it because 
it's too hard.

It seems to me that as unsafePerformIO is not in the standard and only 
implemented on some
compilers/interpreters, that you limit the portability of code by using 
it, and that it is best avoided. Also as any safe use of unsafePerformIO 
can be refactored to not use it I could
certainly live without it.
Well, I am concerned about portability.  I insist on using Hugs when many 
people use just GHC, and one of the reasons is that I don't want to get 
locked into one compiler's extensions.  But sometimes it is necessary to 
use extensions:  there are many features of Haskell-98++ that are almost 
essential (IMO) to practical software development.  Including, I think, 
unsafePerformIO (on rare occasions).  My touchstone is that I'll use 
language extensions when I have to, provided they are supported by both 
Hugs and GHC.

What's my point in all this?  I supposed it might be summed up as: The 
best is the enemy of the good.

#g
--
Graham Klyne wrote:
[Switching to Haskell-cafe]
I have used it once, with reservations, but at the time I didn't have the 
time/energy to find a better solution.  (The occasion of its use was 
accessing external entities within an XML parser;  by making the 
assumption that the external entities do not change within any context in 
which results from a program are compared, I was able to satisfy the 
proof obligation of not causing or being sensitive to side effects.)

The reason this was important to me is that I wanted to be able to use 
the parser from code that was not visibly in the IO monad.  For me, 
treating Web data transformations as pure functions is one of the 
attractions of using Haskell.

(Since doing that, I had an idea that I might be able to parameterize the 
entity processing code on some Monad, and use either an Identity monad or 
IO depending on the actual requirements.  This way, I could keep pure XML 
processing out of the IO monad, but use IO when IO was needed.)

In short:  I think it's usually possible to avoid using unsafePerformIO, 
but I'd be reluctant to cede it altogether, if only for sometimes 
quick-and-dirty pragmatic reasons.

#g

Graham Klyne
For email:
http://www.ninebynine.org/#Contact

Graham Klyne
For email:
http://www.ninebynine.org/#Contact
___
Haskell-Cafe mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] Re: Top Level TWI's again was Re: [Haskell] Re: Parameterized Show

2004-11-23 Thread Keean Schupke
Off topic, but interesting, Someone else keeps quoting this at me... I 
prefer Knuth - paraphrased as I cant remember the quote - The best 
software projects are the ones where the source code has been lost about 
half way through the development and started from scratch.

The point is programmers start by exploring a problem space without 
understanding it. Poor programmers just accept the first solution they 
put down. Good programmers re-implement. Great programmers have a sixth 
sense of when things are about to get ugly, and start again (and the 
better you are the less you actually have to implement before you 
realise things can be refactored for the better)...

Graham Klyne wrote:
What's my point in all this?  I supposed it might be summed up as: 
The best is the enemy of the good.

#g
--

___
Haskell-Cafe mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Re: Top Level TWI's again was Re: [Haskell] Re: Parameterized Show

2004-11-23 Thread Glynn Clements

Keean Schupke wrote:

 Can a C function be pure? I guess it can... The trouble is you cannot 
 proove its
 pure?
 
 But - why would you want to use a pure C function.

Because it already exists? E.g. most BLAS/LAPACK functions are pure;
should they be re-written in Haskell?

[Yes, I know that BLAS/LAPACK are written in Fortran, but I don't
think that changes the argument. The resulting object code (which is
what you would actually be using) wouldn't be significantly different
if they were written in C.]

-- 
Glynn Clements [EMAIL PROTECTED]
___
Haskell-Cafe mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Re: Top Level TWI's again was Re: [Haskell] Re: Parameterized Show

2004-11-23 Thread Conor McBride
Keean Schupke wrote:
Can a C function be pure? I guess it can... The trouble is you cannot 
proove its
pure?
A C function might have no observable side effects, even if it operates
destructively over its own private data structures. It mightn't be too
hard to establish a sound test for this sort of purity (the one we have
already is sound; it always says no; some improvement may be possible).
Clearly completeness is too much to hope for.
But - why would you want to use a pure C function. The chances of any 
useful C library function being pure are slim - and the performance of
 GHC in some of the benchmarks shows that there is hardly any speed
 advantage (for a pure function)...
What about the other benchmarks? There are plenty of operations where
programmers can do a neater job than compilers at deciding that a given
data structure is known only to one consumer and can therefore be
manipulated destructively, recycled aggressively etc. I know modern
recycling is marvellous, but reduced consumption is better, isn't it?
The C functions I'm thinking of are the output from Hofmann co's
LFPL compiler: pure *linear* functional programs which run in the heap
they were born with. There are potential speed gains too: the knowledge
that you don't need to keep the original input means that you can
operate deep inside it in constant time, at the cost of maintaining
some extra pointers. (Does anybody know of a linear type system which
allows this? Basically, a list xs contains a pointer to its tail, so
holding a tail-pointer for xs would be a duplicate reference: problem.
But perhaps it's ok for the holder of xs also to hold its tail-pointer.)
This stuff isn't really my thing, but I'm an interested spectator.
These programs aren't funny interactive hard-drive-formatting things,
so they're probably irrelevant to this particular argument. Nonetheless,
they're hard to write efficiently in functional programming languages as
we know them. They're hard to write safely in C, but sometimes we just
get fed up with knowing useful stuff that we can't tell the compiler.
Is uniqueness worth a second look?
Conor
--
http://www.cs.rhul.ac.uk/~conor  for one more week
___
Haskell-Cafe mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Re: Top Level TWI's again was Re: [Haskell] Re: Parameterized Show

2004-11-23 Thread Keean Schupke
Have you looked at Linear Aliasing, the type system used for TAL (typed 
assembly
language)... one would assume that if a C compiler which compiles to TAL 
were
produces, then you could proove purity?

Keean.
Conor McBride wrote:
Keean Schupke wrote:
Can a C function be pure? I guess it can... The trouble is you cannot 
proove its
pure?

A C function might have no observable side effects, even if it operates
destructively over its own private data structures. It mightn't be too
hard to establish a sound test for this sort of purity (the one we have
already is sound; it always says no; some improvement may be possible).
Clearly completeness is too much to hope for.
But - why would you want to use a pure C function. The chances of any 
useful C library function being pure are slim - and the performance of
 GHC in some of the benchmarks shows that there is hardly any speed
 advantage (for a pure function)...
What about the other benchmarks? There are plenty of operations where
programmers can do a neater job than compilers at deciding that a given
data structure is known only to one consumer and can therefore be
manipulated destructively, recycled aggressively etc. I know modern
recycling is marvellous, but reduced consumption is better, isn't it?
The C functions I'm thinking of are the output from Hofmann co's
LFPL compiler: pure *linear* functional programs which run in the heap
they were born with. There are potential speed gains too: the knowledge
that you don't need to keep the original input means that you can
operate deep inside it in constant time, at the cost of maintaining
some extra pointers. (Does anybody know of a linear type system which
allows this? Basically, a list xs contains a pointer to its tail, so
holding a tail-pointer for xs would be a duplicate reference: problem.
But perhaps it's ok for the holder of xs also to hold its tail-pointer.)
This stuff isn't really my thing, but I'm an interested spectator.
These programs aren't funny interactive hard-drive-formatting things,
so they're probably irrelevant to this particular argument. Nonetheless,
they're hard to write efficiently in functional programming languages as
we know them. They're hard to write safely in C, but sometimes we just
get fed up with knowing useful stuff that we can't tell the compiler.
Is uniqueness worth a second look?
Conor
--
http://www.cs.rhul.ac.uk/~conor  for one more week

___
Haskell-Cafe mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Re: Top Level TWI's again was Re: [Haskell] Re: Parameterized Show

2004-11-23 Thread Keean Schupke
Glynn Clements wrote:
I thought these libraries did have some global state, like choosing
which solver is used... In which case treating them as pure could
be dangerous...
   Keean.
Keean Schupke wrote:
 

Can a C function be pure? I guess it can... The trouble is you cannot 
proove its
pure?

But - why would you want to use a pure C function.
   

Because it already exists? E.g. most BLAS/LAPACK functions are pure;
should they be re-written in Haskell?
[Yes, I know that BLAS/LAPACK are written in Fortran, but I don't
think that changes the argument. The resulting object code (which is
what you would actually be using) wouldn't be significantly different
if they were written in C.]
 

___
Haskell-Cafe mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Re: Top Level TWI's again was Re: [Haskell] Re: Parameterized Show

2004-11-23 Thread Benjamin Franksen
On Tuesday 23 November 2004 10:03, you wrote:
 But - why would you want to use a pure C function. The chances of any
 useful C library function being pure are slim - and the performance of GHC
 in some of the benchmarks shows that there is hardly any speed advantage

The typical case (for me) is a foreign library exporting mostly non-pure 
routines, but with one or two pure functions among them.

But as has been stated already, unsafePerformIO is not needed in this case.

BTW, if you reply to the list anyway, don't reply to me in person. Otherwise I 
get everything duplicated (and it goes onto the wrong folder ;-).

Ben
-- 
Top level things with identity are evil.-- Lennart Augustsson
___
Haskell-Cafe mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Re: Top Level TWI's again was Re: [Haskell] Re: Parameterized Show

2004-11-23 Thread David Roundy
On Mon, Nov 22, 2004 at 08:32:33PM +, Graham Klyne wrote:
 [Switching to Haskell-cafe]
 
 At 11:26 22/11/04 +, you wrote:
 I would ask an alternative question - is it possible to live without
 unsafePerformIO? I have never needed to use it!

There are plenty of non-IO reasons to use unsafePerformIO, for which it is
essential.  If you want to write haskell code that uses a pointer
(allocated possibly via an FFI C routine), it has to be in the IO monad.
If you know that this pointer doesn't access memory that'll be changed at
random (or by other routines), you can (and *should*) safely use
unsafePerformIO.

Also, if you're interested in using weak pointers (for example, to do
memoization), you'll almost certainly need to use unsafePerformIO.  Again,
the result can, and should, be encapsulated, so the module that uses
unsafePerformIO exports only pure functions (unless of course, there are
any that actually perform IO).
-- 
David Roundy
http://www.darcs.net
___
Haskell-Cafe mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Re: Top Level TWI's again was Re: [Haskell] Re: Parameterized Show

2004-11-23 Thread Keean Schupke
David Roundy wrote:
There are plenty of non-IO reasons to use unsafePerformIO, for which it is
essential.  If you want to write haskell code that uses a pointer
(allocated possibly via an FFI C routine), it has to be in the IO monad.
If you know that this pointer doesn't access memory that'll be changed at
random (or by other routines), you can (and *should*) safely use
unsafePerformIO.
 

Does it? cant you just declare:
import foreign ccall somefn somefn :: Ptr Double - Ptr Double
Also, if you're interested in using weak pointers (for example, to do
memoization), you'll almost certainly need to use unsafePerformIO.  Again,
the result can, and should, be encapsulated, so the module that uses
unsafePerformIO exports only pure functions (unless of course, there are
any that actually perform IO).
 

Don't know about this one, got a short example?
   Keean.
___
Haskell-Cafe mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Re: Top Level TWI's again was Re: [Haskell] Re: Parameterized Show

2004-11-23 Thread David Roundy
On Tue, Nov 23, 2004 at 01:51:24PM +, Keean Schupke wrote:
 David Roundy wrote:
 
 There are plenty of non-IO reasons to use unsafePerformIO, for which it is
 essential.  If you want to write haskell code that uses a pointer
 (allocated possibly via an FFI C routine), it has to be in the IO monad.
 If you know that this pointer doesn't access memory that'll be changed at
 random (or by other routines), you can (and *should*) safely use
 unsafePerformIO.
 
 Does it? cant you just declare:
 
 import foreign ccall somefn somefn :: Ptr Double - Ptr Double

Right, but if you want to access the contents of that pointer in haskell,
you have to use the IO monad.  True, in principle you could write a pointer
dereferencing function in C:

import foreign ccall readarray readarray :: Ptr Double - Int - Double

but that hardly seems like either an efficient or elegant way of getting
around the fact that haskell can't read pointers outside the IO monad.
Also, of course, this readarray function written in C is no safer than
using unsafePerformIO with peekArray.

In case you're wondering, peekArray needs to be in the IO monad because
there's no guarantee that the memory pointed to by the Ptr is constant--it
may even be a pointer to an mmapped file, in which case it could change
value independently of the program's execution.

 Also, if you're interested in using weak pointers (for example, to do
 memoization), you'll almost certainly need to use unsafePerformIO.  Again,
 the result can, and should, be encapsulated, so the module that uses
 unsafePerformIO exports only pure functions (unless of course, there are
 any that actually perform IO).

 Don't know about this one, got a short example?

I have a long and complicated example...

http://abridgegame.org/cgi-bin/darcs.cgi/darcs/AntiMemo.lhs?c=annotate

This is complicated because it's doing antimemoization rather than
memoization, and being backwards it's a bit trickier.  But it *is* an
example of a module that exports only pure functions, and couldn't be
written without unsafePerformIO (and does no IO).
-- 
David Roundy
http://www.darcs.net
___
Haskell-Cafe mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] Re: Top Level TWI's again was Re: [Haskell] Re: Parameterized Show

2004-11-23 Thread Graham Klyne
At 10:02 23/11/04 +, you wrote:
Off topic, but interesting,
Sure... that's why its in 'cafe, right?
Someone else keeps quoting this at me... I prefer Knuth - paraphrased as I 
cant remember the quote - The best software projects are the ones where 
the source code has been lost about half way through the development and 
started from scratch.

The point is programmers start by exploring a problem space without 
understanding it. Poor programmers just accept the first solution they put 
down. Good programmers re-implement. Great programmers have a sixth sense 
of when things are about to get ugly, and start again (and the better you 
are the less you actually have to implement before you realise things can 
be refactored for the better)...

Graham Klyne wrote:
What's my point in all this?  I supposed it might be summed up as: The 
best is the enemy of the good.
Hmmm... I take your point, and I think my attempted pithy summary missed 
its intended target.  What I was trying to convey was a sense that a great 
language has to let merely average (or worse) programmers do a halfway 
decent job.  There aren't enough great programmers to go round.

And even great programmers sometimes have to work with someone else's 
codebase (which even if written by a great programmer may have had diffent 
goals in mind).

(FWIW, I think Python is a language that scores pretty highly on this count.)
#g

Graham Klyne
For email:
http://www.ninebynine.org/#Contact
___
Haskell-Cafe mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/haskell-cafe


Top Level TWI's again was Re: [Haskell] Re: Parameterized Show

2004-11-22 Thread Adrian Hey
On Friday 19 Nov 2004 2:27 pm, Benjamin Franksen wrote:
 Implicit parameters are evil, agreed. Their deficiencies should be added
 as a warning to the docs (with many exclamation marks). 

Well I dunno. Maybe whatever's currently wrong with them can be fixed up.
But I can't say they're something I've ever felt a need for.

But it's ironic that some folk advocate the use of this (mis?)feature as
a solution to the (so-called) global variables problem. I don't like
this idea at all, but at least they recognise that there is a problem. 

 But toplevel
 things with identity (TWI) are evil as well, *especially* if they are
 easy to use.

Just repeating this again and again doesn't make it any more true. Neither
you or any of the other nay-sayers have provided any evidence or credible
justification for this assertion, nor have any of you provided any workable
alternative for even the simplest example. Lennart has yet to explain how he
proposes to implement his supposedly safer openDevice. You have yet to
explain how you propose to deal with stdout etc..

BTW, top level TWI's are easy to create anyway, via the *unsound*
unsafePerformIO hack. The evil here not their existance, it is the
unsoundness of their creation mechanism. Given that in the absence of
anything better folk are going to continue to use this (because it
really is necessary sometimes), objecting to the provision of a sound
alternative is just silly. This is the militant denial I was talking
about.

And of course there's one top level TWI that none of us can live
without. I am refering to the unique and stateful world that is
implicitly referenced by all IO operations (with the possible
exception of those operations I would like to put in the SafeIO
monad). So is this evil too? Perhaps it is, but if so, I'd like to
know how you propose to live without it and what purpose the IO monad
would serve in such a situation.

Regards
--
Adrian Hey

___
Haskell mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/haskell


Re: Top Level TWI's again was Re: [Haskell] Re: Parameterized Show

2004-11-22 Thread Keean Schupke
Adrian Hey wrote:
Just repeating this again and again doesn't make it any more true.
Ditto... I for one think the best solution is to use the language as
intended and pass the values as function arguments. As pointed out
on this list - the only possible situation where you cannot do this is
when interfacing to a badly written C library. In which case do your
one-shot initialisation in C, as you will be importing foreign functions
anyway.
Neither
you or any of the other nay-sayers have provided any evidence or credible
justification for this assertion, nor have any of you provided any workable
alternative for even the simplest example. Lennart has yet to explain how he
proposes to implement his supposedly safer openDevice. You have yet to
explain how you propose to deal with stdout etc..
 

openDevice would use OS semaphores (like the namedSem library
I posted to the cafe) - the OS is the only thing that can deal with
device driver initialisations. Infact the OS driver should multiplex single
access devices such that access is serialised. I guess stdin, stdout etc
should be passed to main as arguments like you would any other
file handle. Although if file handles are simply Ints, then there is nothing
wrong with having:
stdin = 0
stdout = 1
stderr = 2
In this case they are not IO actions anyway.
And of course there's one top level TWI that none of us can live
without. I am refering to the unique and stateful world that is
implicitly referenced by all IO operations (with the possible
exception of those operations I would like to put in the SafeIO
monad). So is this evil too? Perhaps it is, but if so, I'd like to
know how you propose to live without it and what purpose the IO monad
would serve in such a situation.
 

This is true - but only because unsafePerformIO exists. Without it
World is simply a value passed via the IO Monad.
I would ask an alternative question - is it possible to live without
unsafePerformIO? I have never needed to use it!
Keean
___
Haskell mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/haskell


Re: Top Level TWI's again was Re: [Haskell] Re: Parameterized Show

2004-11-22 Thread John Velman
On Mon, Nov 22, 2004 at 07:27:44PM +0100, Lennart Augustsson wrote:
 
[snip]
 I admit there are proper uses of global variables, but they are very
 rare.  You have not convinced me you have one.
 
   -- Lennart

It's with some trepidation I bring a problem as a total newbie, but I've
been obsessed with this and hung up on it ever since I decided a couple of
weeks ago to learn Haskell by using it.

Some brief background:

A while back I decided I wanted a simple 'concept mapping' program that
would work the way I work instead of the way someone else works.  I
envisioned a GUI with a canvas and an entry box (TK/tcl).  I type a
concept name into the entry box, and it shows up on the canvas (initially
in a slightly randomized position), in a box, with a unique sequenced
identifier.  The identifier is also used as a canvas tag for the item.
Similar input for relations between concepts.   I think that's enough
description for now.

Initially, I started programming this with PerlTK, but that effort was
interrupted for a few weeks.  When I got back to it, I decided to do it in
Python instead. But that effort also got interrupted for a few weeks.
Before I got back to it, I ran across some material on Haskell I've had in
my files for a few years, and decided that I'd use this as a vehicle to
actually learn Haskell.   (This all sounds a bit unfocused, and it is:  I'm
retired, sometimes describe myself as an ex mathematician or an ex-PhD
having spent years in the aerospace industry instead of academia.  Anyway,
I have both the luxury and lack of focus of no deadlines, no pressure to
publish.  I hope to use Haskell to further my main hobby of knowledge
representation.)

In perl, my labels/tags were very easy:

In the initialization code:

 my @taglist = ();
 my $nextag = a;

and in the callback for the entry box:

push(@taglist,$nextag);
$nextag++;

(With the starting tag of a  this results in a,z,aa,ab,...)

Also, ultimately, I want to be able to save  my work and restart
the next day (say) picking up the tags where I left off.

I'm darned if I can see how to do this in a callback without a global
variables (and references from other callbacks, by the way).

In looking for a method, I've discovered that Haskell is a lot richer than
I thought (or learned when I tinkered with it back in the late '90s ).
I've found out about (but don't know how to use properly) implicit
parameters, linear implicit parameters, unsafePerformIO, safe and sound
implementation of polymorphic heap with references and updates (Oleg
Kiselyov, (http://www.haskell.org/pipermail/haskell/2003-June/011939.html),
implicit configurations, phantom types, ...

I've also found warnings against many of these.  I'm inclined to try the
unsafePerformIO route as being the simplest, and most commonly used, even
though perhaps the least haskell-ish.  I like implicit configurations, but
couldn't begin to say I understand them yet, and it's a bit heavy for a
novice.

In a nutshell:

   I want to use the old value of a tag to compute the new value, in a
   callback, 
   
   I want to access the tag from other callbacks, and
   
   I want to the value to a mutable list from within the callback.
   
I'd certainly be interested in doing without global variables, and would
appreciate any advice.

(By the way, I'm using Linux, and so far it looks like HTk is my choice for
the GUI interface.)

Best,

John Velman
___
Haskell mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/haskell


Re: Top Level TWI's again was Re: [Haskell] Re: Parameterized Show

2004-11-22 Thread Axel Simon
On Mon, 2004-11-22 at 23:34, John Velman wrote:

 In a nutshell:
 
I want to use the old value of a tag to compute the new value, in a
callback, 

I want to access the tag from other callbacks, and

I want to the value to a mutable list from within the callback.

 I'd certainly be interested in doing without global variables, and would
 appreciate any advice.

For GUI programming you don't need global variables. You can partially
apply all those values to the callback that are necessary. In
particular, those values can be MVars or IORefs which are like pointers
to a value (i.e. you can modify them). For example to draw a bit of
graphics:

  canvas - drawingAreaNew
  text - canvas `widgetCreateLayout` Hello World.
  canvas `onExpose` updateCanvas canvas text

where the function updateCanvas takes 3 arguments:

updateCanvas :: DrawingArea - PangoLayout - Event - IO Bool
updateCanvas canvas text (Expose { area=rect }) = do


 (By the way, I'm using Linux, and so far it looks like HTk is my choice for
 the GUI interface.)

I don't know if HTk is still maintained. The most popular GUI toolkit is
wxHaskell now; if you're only developing on Unix then gtk2hs might be a
choice.

Axel.



___
Haskell mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/haskell


[Haskell-cafe] Re: Top Level TWI's again was Re: [Haskell] Re: Parameterized Show

2004-11-22 Thread Graham Klyne
[Switching to Haskell-cafe]
At 11:26 22/11/04 +, you wrote:
I would ask an alternative question - is it possible to live without
unsafePerformIO? I have never needed to use it!
I have used it once, with reservations, but at the time I didn't have the 
time/energy to find a better solution.  (The occasion of its use was 
accessing external entities within an XML parser;  by making the assumption 
that the external entities do not change within any context in which 
results from a program are compared, I was able to satisfy the proof 
obligation of not causing or being sensitive to side effects.)

The reason this was important to me is that I wanted to be able to use the 
parser from code that was not visibly in the IO monad.  For me, treating 
Web data transformations as pure functions is one of the attractions of 
using Haskell.

(Since doing that, I had an idea that I might be able to parameterize the 
entity processing code on some Monad, and use either an Identity monad or 
IO depending on the actual requirements.  This way, I could keep pure XML 
processing out of the IO monad, but use IO when IO was needed.)

In short:  I think it's usually possible to avoid using unsafePerformIO, 
but I'd be reluctant to cede it altogether, if only for sometimes 
quick-and-dirty pragmatic reasons.

#g

Graham Klyne
For email:
http://www.ninebynine.org/#Contact
___
Haskell-Cafe mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] Re: Top Level TWI's again was Re: [Haskell] Re: Parameterized Show

2004-11-22 Thread Keean Schupke
Obviously without knowing the details I am speculating, but would it not 
be possible
to do a first pass of the XML and build a list of files to read (a pure 
function) this returns
its result to the IO monad where the files are read and concatenated 
together, and passed
to a second (pure functional) processing function. If written well this 
can take advantage
of lazy execution, so both functions end up running concurrently.

It seems to me that as unsafePerformIO is not in the standard and only 
implemented on some
compilers/interpreters, that you limit the portability of code by using 
it, and that it is best avoided. Also as any safe use of unsafePerformIO 
can be refactored to not use it I could
certainly live without it.

   Keean.
Graham Klyne wrote:
[Switching to Haskell-cafe]
I have used it once, with reservations, but at the time I didn't have 
the time/energy to find a better solution.  (The occasion of its use 
was accessing external entities within an XML parser;  by making the 
assumption that the external entities do not change within any context 
in which results from a program are compared, I was able to satisfy 
the proof obligation of not causing or being sensitive to side 
effects.)

The reason this was important to me is that I wanted to be able to use 
the parser from code that was not visibly in the IO monad.  For me, 
treating Web data transformations as pure functions is one of the 
attractions of using Haskell.

(Since doing that, I had an idea that I might be able to parameterize 
the entity processing code on some Monad, and use either an Identity 
monad or IO depending on the actual requirements.  This way, I could 
keep pure XML processing out of the IO monad, but use IO when IO was 
needed.)

In short:  I think it's usually possible to avoid using 
unsafePerformIO, but I'd be reluctant to cede it altogether, if only 
for sometimes quick-and-dirty pragmatic reasons.

#g

Graham Klyne
For email:
http://www.ninebynine.org/#Contact
___
Haskell-Cafe mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Re: Top Level TWI's again was Re: [Haskell] Re: Parameterized Show

2004-11-22 Thread Benjamin Franksen
On Monday 22 November 2004 23:22, Keean Schupke wrote:
 It seems to me that as unsafePerformIO is not in the standard and only
 implemented on some
 compilers/interpreters, that you limit the portability of code by using
 it, and that it is best avoided. Also as any safe use of unsafePerformIO
 can be refactored to not use it I could
 certainly live without it.

With one exception: If a foreign function (e.g. from a C library) is really 
pure, then I see no way to tell that to the compiler other than using 
unsafePerformIO. IIRC, unsafePerformIO is in the standard FFI libraries.

Ben
-- 
Top level things with identity are evil.-- Lennart Augustsson
___
Haskell-Cafe mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/haskell-cafe