ANNOUNCE: nhc98-1.16

2003-03-09 Thread Malcolm Wallace
nhc98-1.16
--
http://www.haskell.org/nhc98

We announce a new release, 1.16, of the Haskell compiler nhc98, with the
following new features and bugfixes of note.

 *  nhc98 once again builds on Windows (Cygwin) with ghc.

 *  nhc98 now works correctly in the presence of gcc-3.x.

 *  A large subset of the 'base' package of hierarchical
libraries is now included in the build.

 *  The primitive FFI mechanism has been updated to match
the latest official spec, and the full Foreign
libraries are also included (in hierarchical form).

 *  The library function List.sortBy now uses a stable
O(n log n) mergesort.

 *  Numerous other small fixes, including revisions to the
Haskell'98 standard.

 *  The website is now hosted at haskell.org

 *  Our CVS repository is also now hosted at cvs.haskell.org


Regards,
 The nhc98 team at York

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


Re: data vs. newtype, abstractly

2003-03-09 Thread Koen Claessen
Hal Daume III wrote:

 | there is a difference between
 |
 |   (N undefined) `seq` ()
 |
 | and
 |
 |   (D undefined) `seq` ()

The question stated without its constructor. My guess is
no.

/K

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


Re: data vs. newtype, abstractly

2003-03-09 Thread John Meacham
my guess is no too. An informal argument to that: imagine the
datatype is abstract and no functions which act on it are exported
.call it 'Type'. since there are no non-bottom values of this type that
are exported, the only way to create them is with bottom as in:

(undefined :: Type) (or an equivalant)

which is equivalant for a newtype (N undefined :: Type) 
and for a data (undefined :: Type)

note that there is no way to create the (D undefined) which is what lets
you observe the difference. therefore you cannot tell the difference...
Just my line of thought which led to saying 'no', interpret it as you
will.
John

On Sun, Mar 09, 2003 at 12:58:49PM +0100, Koen Claessen wrote:
 Hal Daume III wrote:
 
  | there is a difference between
  |
  |   (N undefined) `seq` ()
  |
  | and
  |
  |   (D undefined) `seq` ()
 
 The question stated without its constructor. My guess is
 no.
 
 /K
 
 ___
 Haskell mailing list
 [EMAIL PROTECTED]
 http://www.haskell.org/mailman/listinfo/haskell
 

-- 
---
John Meacham - California Institute of Technology, Alum. - [EMAIL PROTECTED]
---
___
Haskell mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/haskell


broken Research Letters link

2003-03-09 Thread b . i . mills
 ``Algebraic Conversions'', A mathematical paper introducing
 a generalisation of homomorphism of universal algebras.
 In Research Letters in the Information and Mathematical
 Sciences Vol 2, May 2001. (pub by Massey University New Zealand).
 see also, \verb|http://www.massey.ac.nz/~wwiims/rlims|

This web link is broken.

My apologies ...

http://iims.massey.ac.nz/research/letters/volume2number1/02mills.pdf

will get you there. I tested it just now, it works fine. 

Regards,

Bruce.


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


Re: data vs. newtype, abstractly

2003-03-09 Thread Dean Herington
On Sun, 9 Mar 2003, Hal Daume III wrote:

 well, yes, but if you export:
 
 mkN :: Int - N
 mkD :: Int - D
 
 or something like that, then they'll still bea ble to tell the difference,
 right?

Well, yes, but I don't.  In fact the type in question is an MVar which my
abstraction ensures is always defined.

My question came up in the context of describing such an abstract type for
users of the type.  Like many others, I like to include actual Haskell
code where appropriate in the documentation.  It didn't seem right to
commit there to either `data` or `newtype`.  Perhaps I'll use:

type Foo a  -- abstract

Does that disturb anyone?  Any other ideas?

Dean

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


RE: palm?

2003-03-09 Thread Tony Sloane
John Meacham wrote:
 This may be an intractable goal, but is any project out there
anywhere
 close to a working haskell 98(ish) implementation for the Palm
Pilot?

 There would probably have to be some compromises, like 16 bit Ints
and
 perhaps some other restrictions, but i don't think its impossible to
get
 some sort of lazy implementation to work on such a resource starved
 architecture so has anyone given it a shot?

Here at Macquarie University we have done some work on this.  Matthew
Tarnawsky  ported the nhc98 runtime to the Palm as part of his 2002
honours project working with myself and Dom Verity.  With this port
it's possible to compile programs on a desktop machine and load the
bytecode onto a Palm for execution.  There is a limited interface to
the Palm GUI libraries.

Having said that, there is much to be done.  The current
implementation has only been lightly tested and there are a number of
design decisions that we want to revisit, particularly relating to how
garbage collection works.  We are starting to port the work to a
recent version of nhc98 and are looking at some of these questions.

We hope to have something for others to play with in a few months.
Stay tuned to this list for an announcement.

Cheers,
Tony Sloane

--
Senior Lecturer
Dept of Computing, Macquarie University
Sydney, Australia

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


Re: data vs. newtype, abstractly

2003-03-09 Thread Tom Pledger
Dean Herington writes:
 :
 | My question came up in the context of describing such an abstract type for
 | users of the type.  Like many others, I like to include actual Haskell
 | code where appropriate in the documentation.  It didn't seem right to
 | commit there to either `data` or `newtype`.  Perhaps I'll use:
 | 
 | type Foo a  -- abstract
 | 
 | Does that disturb anyone?  Any other ideas?

That's pretty close to Haddock's approach.

For example, see newtype N4 in http://www.haskell.org/haddock/Test.hs :

An abstract newtype - we show this one as data rather than
 newtype because the difference isn't visible to the programmer
 for an abstract type.

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


Re: Persistant (as in on disk) data

2003-03-09 Thread diatchki
hello,

 I'm not convinced that the binary library should natively support
 cyclic data.  I think that if saying:

   print x

 would not terminate, then there's no reason that

   puts bh x

 should terminate.  I like to think of puts as a binary version of
 print.  (That is, of course, unless the instance writer for the
 Binary/Show instances of the type of x is smart enough to not keep
 writing the same thing over and over again.)  I would challenge the
 interested party to write a Show instance of String which wouldn't loop
 indefinitely on repeat 'x'.
well, it is your choice to think of it as you like, but this is not what
my original mail was about.  i think the ability to make data persistant
is a useful one and it should be as transperant to the programmer as
possible.  when i write something like:
ones = 1 : ones

i don't think of printing infinately many ones in memory and i don't see
why i should start thinking of it that way just because i want to make the
object persistant. after all, one can think of the disk as a verys low
memory.

 If the user has some cyclic data structure and they want to be able to
 write it in binary form, it should be on their shoulders to do it
 correctly, not on the library's.
why is that?  i thought the whole point of having nice tools is that you
don't need to write mindless stuff and concentrate on the important bits
of your program. i don't have to worry much about sharing and cyclic data
when i program in Haskell (i.e. it just happens), why should i suddenly
start to worry about that if i want to make something persistant across
executions of my program.


 So essentially, I believe 'deriving Binary' should work identically to
 'deriving Show', except using a binary rep instead of a string rep.
something like that could be useful, but with drift and the atrem library
one can already do some of that.  and the aterm library is a reasonably
portable way to represent terms.  this is definately not what i had in
mind in my original post.

 it in Haskell, as presumbably sharing is not observable from within
 the  language.  this is why the deriving bit seems essential - the
 compiler  can perform some magic.

 I assume you mean something like:

   let x = ...some really large structure...
   y = [x,x]
   in  puts bh y

 then the size of what is written is |x+c| not |2x| for some small c?  If
 so, then I don't believe this can be implemented in the language; it
 would have to be in the compiler.
this is what i meant by compiler magic.

 I see this as unlikely of happening
 because it would mean that all compilers would have to implement this
 identically and some might not handle sharing the same manner.
different implementations do not need to implement sharing in the same
way.  they need to understand a common format.  i am not saying designing
such a format is easy, in fact things like:
nats = 0 : map (+1) nats
seem tricky as they involve functions.  but persitance is useful.

in fact as a beginning i was hoping for something that works in say GHC,
and won't be too hard to implement.  actually i thought it might already
exist, but i guess not.

bye
iavor




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


FFI Tutorial / Examples

2003-03-09 Thread Matthew Donadio
Hi all,

I may be being a bit dense about this, but I am having some trouble
understanding how to use FFI, especially with respect to interfacing
Haskell lists/arrays to C arrays.

For example, say I have the C functions

void foo (double *input, double *output, int N);
double bar (double *input, int N);

and I want to create an FFI interface and have the resulting type
signatures be

 foo :: Array Int Double - Array Int Double
 bar :: Array Int Double - Double

where the bounds of the arrays are (0,N-1), and both foo and bar are
pure.  I read through the FFI docs, but I am still confused about how to
do this.  Can anyone point me to an FFI tutorial, or some examples? I
have a feeling that once I see some examples using lists and arrays that
things will fall into place.

Thanks.

-- 
Matthew Donadio ([EMAIL PROTECTED])
___
Haskell mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/haskell


Re: palm?

2003-03-09 Thread M. Parker
What about a port to Windows CE (i.e., for Pocket PC's). Or even better yet, 
hugs for Pocket PC!

-Matt

On Sunday 09 March 2003 11:27 pm, Tony Sloane wrote:
 John Meacham wrote:
  This may be an intractable goal, but is any project out there

 anywhere

  close to a working haskell 98(ish) implementation for the Palm

 Pilot?

  There would probably have to be some compromises, like 16 bit Ints

 and

  perhaps some other restrictions, but i don't think its impossible to

 get

  some sort of lazy implementation to work on such a resource starved
  architecture so has anyone given it a shot?

 Here at Macquarie University we have done some work on this.  Matthew
 Tarnawsky  ported the nhc98 runtime to the Palm as part of his 2002
 honours project working with myself and Dom Verity.  With this port
 it's possible to compile programs on a desktop machine and load the
 bytecode onto a Palm for execution.  There is a limited interface to
 the Palm GUI libraries.

 Having said that, there is much to be done.  The current
 implementation has only been lightly tested and there are a number of
 design decisions that we want to revisit, particularly relating to how
 garbage collection works.  We are starting to port the work to a
 recent version of nhc98 and are looking at some of these questions.

 We hope to have something for others to play with in a few months.
 Stay tuned to this list for an announcement.

 Cheers,
 Tony Sloane

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


Fw: palm?

2003-03-09 Thread Kenny Lu Zhuo Ming

- Original Message - 
From: Tony Sloane [EMAIL PROTECTED]
To: Kenny Lu Zhuo Ming [EMAIL PROTECTED]
Sent: Monday, March 10, 2003 11:13 AM
Subject: RE: palm?


 Hi Kenny,
 
  How about PocketPC? any porting is done on that?
 
 No, we have not done any work on Haskell on the PocketPC platform.
 
 Tony
__
Do You Yahoo!?
Promote your business from just $5 a month!
http://sg.biztools.yahoo.com
___
Haskell mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/haskell


GHC Error Message.

2003-03-09 Thread Mansour Al-Mutairi



Hi,

Could someone please explain to me why the 
following error message happen:

When I load the following code into GHC I get an 
error message:

code:
---
data AParser String = AP 
{apapply::([String]-[(String,[String])])}

instance Monad AParser where return 
v = AP (\inp - 
[(v,inp)]) (AP p) = f = AP (\inp - 
concat [ apapply (f v) inp1 | (v,inp1) - p inp])

---

error:

---
 Inferred type is less polymorphic than 
expected Quantified type variable 
`b' is unified with another quantified type variable `a' 
When trying to generalise the type inferred for 
`=' Signature 
type: forall a1 
b1. 
AParser a1 - (a1 - AParser b1) - AParser 
b1 Type to generalise: forall a1 
b1. 
AParser a1 - (a1 - AParser b1) - AParser b1 In 
the instance declaration for `Monad AParser'Failed, modules loaded: 
none.

---

But when I create thetype synonym
type Stack = [String]
data AParser String = AP {apapply::(Stack - [(String,Stack)])}

and use Stack instead of [String], GHC does not complain???

Thanks.
Mansour.


Alternatives to finalization

2003-03-09 Thread Nick Name
As the result of a conversation on haskell-gui, I have tried to
implement the disallocation of resources when a stream is garbage
collected.

To explain myself:

I have a function

f :: IO [a]

which returns a lazy stream after allocating some resource to feed it
(say installing a callback).

I wish that the resource could be disallocated when it's no longer used.
I did the obvious implementation with Weak.addFinalizer; results are
encouraging but not completely satisfying; the scheme I used is:

f = do
allocateResource
l - makeTheStream
addFinalizer l (disallocateResource)
return l

The problem is that if no memory is allocated, no garbage collection
happens; of course finalization is not guaranteed, as the manual states.

Another alternative is to make f return an esplicit close stream
action:

f :: IO ([a],IO ())

Is anyone willing to explain me other alternatives if there are, or to
tell me that there aren't?

Thanks for attention

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