Re: [Haskell-cafe] Existentially-quantified constructors, Eq and Show

2005-12-07 Thread Bulat Ziganshin
Hello Joel,

Thursday, December 08, 2005, 1:12:07 AM, you wrote:

JR> Is there a less verbose way of doing this:

data (Show a, Eq a) => State a
 = Start
 | Stop
 | State a
   deriving (Show, Eq)



-- 
Best regards,
 Bulatmailto:[EMAIL PROTECTED]



___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Verbosity of imperative code (was: Learning Haskell)

2005-12-07 Thread Tomasz Zielonka
On Wed, Dec 07, 2005 at 09:11:44PM +, Robin Green wrote:
> On Wednesday 07 December 2005 20:19, you wrote:
> > On Wed, Dec 07, 2005 at 07:47:46PM +, Robin Green wrote:
> > > > Some day you may thank for this verbosity, because it encourages
> > > > you do program in a purely functional way making your program more
> > > > friendly for SMP execution.
> > >
> > > You are mistaken. The verbosity is necessary if you want "visual"
> > > referential transparency, but not necessary if you only want pure
> > > functional programming. Only the latter is helpful for optimisability. I
> > > am hoping to write a paper on this topic.
> >
> > I am afraid I don't understand.
> 
> Let's say you want to write a function
> 
> seqPair :: (Monad m) => (m a, m b) -> m (a, b)
> 
> which returns a computation which does the left computation followed by the 
> right computation (i.e. it's like the sequence function, but for pairs 
> instead of lists).
> 
> In Haskell you could write this as:
> 
> seqPair mx my = do
>   x <- mx
>   y <- my
>   return (x, y)
> 
> However, wouldn't it be nice if we could write something like (warning: 
> hypothetical syntax)

I'm not sure. I wouldn't be the first one to jump with joy if it was
allowed :-)

> seqPair $= (,)
> 
> or (the slightly less cryptic version)
> 
> seqPair x y $= (x, y)

Wouldn't they be different, the first one forcing (,) to WHNF (NOP), and
the second one forcing x and y to WHNF?

Would you want seqPair written with $= to still have a type involving
the Monad class?

> This is not referentially transparent because it is not equivalent to
> 
> seqPair x y $= swap (y, x) where swap (a, b) = (b, a)
> 
> (can you see why not?)

Only guessing, because I am not sure what $= is supposed to do, but
is it because y would be evaluated before x? I can't find anything wrong
with it, besides the strange semantics of $=.

Anyway, I didn't think my initial statement was so controversial.
I even said "may", not "will".

Best regards
Tomasz

-- 
I am searching for a programmer who is good at least in some of
[Haskell, ML, C++, Linux, FreeBSD, math] for work in Warsaw, Poland
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] Mixing C++ and Haskell, OpenSSL thread safety, and using mmap

2005-12-07 Thread Branimir Maksimovic
I wrotted some messages on fa.haskell newsgroup but then I've figured that 
people

actually read mailing lists :)
So this is digest of mine recent messages on this newsgroup.

First I want to say about OpenSSL thread safety. It is not thread safe by 
default.
Who wants to import and use OpenSLL functions with FFI, have to set locking 
hooks for it,
or else spurious  crashes with useless stack trace will result. Higher level 
of concurrency,

more likely crash will happen.
Since this hooks are called by C, it is easer to setup mutexes in C module, 
then call Haskell

main function from it.
details:
http://www.openssl.org/docs/crypto/threads.html

Second I've successfully linked Haskell and C++ with threaded run time.
Well, I'm planning to use Haskell in C++ programs and to call
Haskell functions from C++ and vice versa.
So far I've tried some small test programs and it seems works ok.
If I launch threads from C++ then call Haskell I have to
link with -threaded flag as Haskell run time complains about
entering functions unsafelly without it.
Also I have another question about hs_add_root.
Is this neccessary? I've tried with and without call to
this function and everything seems to work same way.
That means I don't notice any difference. I ask this because
if for example I have lot of Haskell modules do I need to call
hs_add_root for every and each one?
This is just a small example that works both on linux and windows,
(I have different C++ versions but Haskell module is same).
Haskell makes and frees array of pointers to CStrings (char**)
from argument that is CString(char*). Error checking and handling
is intentionally left out for now.
I would appreciate any critics about it, as I've started
to learn language one month ago, but have professional experience since 92
in other languages, specially C++.

-- Haskell module
module MakeWords where
import Foreign
import Foreign.C.String
import Foreign.Storable
import Foreign.Ptr
import Foreign.Marshal.Array
foreign export ccall makeWords :: CString -> IO (Ptr CString)
foreign export ccall freeWords :: Ptr CString -> IO ()

makeWords :: CString -> IO (Ptr CString)
makeWords cs = do let lst = words $ unsafePerformIO $ peekCString cs
   p <-  mallocArray0 $ length lst
   makeWords' lst p
   return (p)

makeWords' :: [String] -> Ptr CString -> IO ()
makeWords' [] p = do poke p nullPtr
makeWords' (s:strs) p = do poke p $ unsafePerformIO $ newCString s
 makeWords' strs (plusPtr p $ sizeOf p)


freeWords :: Ptr CString -> IO ()
freeWords p = do freeWords' p
 free p

freeWords' :: Ptr CString -> IO ()
freeWords' p = if nullPtr /= (unsafePerformIO $ peek p)
   then do free $ unsafePerformIO $ peek p
   freeWords' $ plusPtr p $ sizeOf p
   else return ()
-- end Haskell module

// C++, windows version
#include 
#ifdef __GLASGOW_HASKELL__
#include "makeWords_stub.h"
#endif
#include 
#include 
#include 
using namespace std;

class Mutex{
public:
Mutex(){ InitializeCriticalSection(&s); }
~Mutex(){ DeleteCriticalSection(&s); }
void acquire(){ EnterCriticalSection(&s); }
void release(){ LeaveCriticalSection(&s); }
private:
Mutex(const Mutex&);
Mutex& operator=(const Mutex&);
CRITICAL_SECTION s;
}m;

DWORD WINAPI tf(LPVOID arg)
{
for(int i=0;i<10;++i)
{
  const char** p = (const char**)makeWords(arg?arg:(void*)"boring 
default");

  const char** q = p;
  if(!(i%1))
  {
   m.acquire();
   while(*q){ cout<<*q++<<' '; }
   cout

Re: [Haskell-cafe] Existentially-quantified constructors, Eq and Show

2005-12-07 Thread John Meacham
On Wed, Dec 07, 2005 at 10:12:07PM +, Joel Reymont wrote:
> data State a
> = Start
> | Stop
> | (Show a, Eq a) => State a

you arn't using existential types here. an example with an existential
type would be (in ghc syntax)

> data forall a . State
> = Start
> | Stop
> | (Show a, Eq a) => State a

note that what makes it existential is that 'a' does not appear as an
argument to State, but rather is bound by the 'forall'.
so if the above is what you want, then I believe you have the shortest
way but you can add some rules to DrIFT if you want to do so
automatically.

if you are okay with a being an argument then

> data State a
> = Start
> | Stop
> | State a
>deriving(Show,Eq)

will do what you want I believe.

John

PS. many, including me, feel 'forall' is a misnomer there and should be
the keyword 'exists' instead. so just read 'foralls' that come _before_
the type name as 'exists' in your head and it will make more sense.

John

-- 
John Meacham - ⑆repetae.net⑆john⑈ 
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Existentially-quantified constructors, Eq and Show

2005-12-07 Thread Greg Buchholz
Joel Reymont wrote:
> Folks,
> 
> Is there a less verbose way of doing this:
> 
> data State a
> = Start
> | Stop
> | (Show a, Eq a) => State a
>

   I'm curious, what is the difference between the above and...

data State a = Start 
 | Stop  
 | State a  deriving (Show, Eq)
 
...Does it give better error messages at compile time or something?


Thanks,

Greg Buchholz
 
  
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Can't Haskell catch upwith Clean's uniqueness typing?

2005-12-07 Thread John Meacham
On Wed, Dec 07, 2005 at 04:38:19PM +0300, Bulat Ziganshin wrote:
> may be, John Meacham can say something about it? his JHC compiler uses
> region analysis to avoid garbage collection - may be these techniques
> has something in common?

By the time jhc makes any decisions regarding memory management, the
code has already been transformed into a first order, strict, imperative
language (but with stronger types than normal and in a monad) so I am
not sure how much they would have in common.

But there definitely are higher level optimizations that achieve similar
things, update avoidance being a particular one as it collects pretty
much exactly the info we want, when a node will only be referenced once.
GHC has some very advanced algorithms for this sort of thing and I
believe from first glance they will do a better job than the clean
system. 

The update analysis info in jhc is not propegated all the way to the
back end, the grin compiler does do a separate analysis to recapture
this type of info after various transformations. I found it somewhat
tricky to maintain the annotations all the way through various
optimizations so I recalculate it (and perhaps get better results on the
simpler program).

However figuring out a way to propagate  that info would be vital if we
wanted user supplied region annotations, which several papers have said
can be very beneficial. It is not clear at all what they would look like
in a lazy language though since your run-time stack does not follow your
program structure. (I'm open to ideas...)

John

-- 
John Meacham - ⑆repetae.net⑆john⑈ 
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] Existentially-quantified constructors, Eq and Show

2005-12-07 Thread Joel Reymont

Folks,

Is there a less verbose way of doing this:

data State a
= Start
| Stop
| (Show a, Eq a) => State a

instance Eq a => Eq (State a) where
(State a) == (State b) = a == b
Start == Start = True
Stop == Stop = True

instance Show a => Show (State a) where
show (State a) = show a
show Start = "Start"
show Stop = "Stop"

Thanks, Joel

--
http://wagerlabs.com/





___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] Re: Verbosity of imperative code

2005-12-07 Thread Scherrer, Chad

> On Tue, Dec 06, 2005 at 10:58:45PM +0300, Bulat Ziganshin wrote:
> > the third-priority problem is language itself. in particular, i hate
> > Haskell school of imperative manipulations:
> > 
> > x' <- readIORef x
> > y' <- readIORef y
> > writeIORef z (x'*y')

Here's a way to make some of this less messy:

class PlusEq a b m | a -> m where
(+=) :: a -> b -> m ()

instance (Num a) => PlusEq (IORef a) a IO where
xRef += y = do x <- readIORef xRef
   writeIORef xRef (x + y)

instance (Num a) => PlusEq (IORef a) (IORef a) IO where
xRef += yRef = do y <- readIORef yRef
  xRef += y

Then instead of 

do x <- xRef
   y <- yRef
   writeIORef yRef (x + y)

you can just say y += x. I've started on an InPlace module to do things
like this in general.

-Chad Scherrer
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Verbosity of imperative code (was: Learning Haskell)

2005-12-07 Thread Robin Green
On Wednesday 07 December 2005 21:11, Robin Green wrote:
> seqPair :: (Monad m) => (m a, m b) -> m (a, b)

Sorry, that line should read:

seqPair :: (Monad m) => m a -> m b -> m (a, b)

-- 
Robin
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Verbosity of imperative code (was: Learning Haskell)

2005-12-07 Thread J. Garrett Morris
On 12/7/05, Robin Green <[EMAIL PROTECTED]> wrote:
> Let's say you want to write a function
>
> seqPair :: (Monad m) => (m a, m b) -> m (a, b)
>
> which returns a computation which does the left computation followed by the
> right computation (i.e. it's like the sequence function, but for pairs
> instead of lists).

In this case, I believe it is as simple as

import Control.Monad (liftM2)

seqPair = liftM2 (,)

 /g

--
We have lingered in the chambers of the sea 
By sea-girls wreathed with seaweed red and brown
Till human voices wake us, and we drown.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Learning Haskell

2005-12-07 Thread Wolfgang Jeltsch
Am Mittwoch, 7. Dezember 2005 20:53 schrieb Sebastian Sylvan:
> [...]

> It may make it harder for people to grasp the difference between an
> IORef and a regular value though...

And this might be a big problem.  It reminds me of languages which do a lot of 
automatic type conversion, including automatically converting strings to 
integers and the like.  The intention might be to make the programmers life 
easier but I think in the long run it makes it harder.

In my opinion, it's a good thing if a language forces the programmer to see 
different things as different things and not mix apples with pears.
 
> /S

/W
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Can't Haskell catch up with Clean's uniqueness typing?

2005-12-07 Thread haskell-cafe . mail . zooloo

- Original Message -
From: "Sebastian Sylvan - [EMAIL PROTECTED]"
Sent: Wednesday, December 07, 2005 8:36 PM
>
> > Maybe you'd be interested in Hacle?
> >
> >   http://www-users.cs.york.ac.uk/~mfn/hacle/

Yep, I am. :) I've discovered it a while ago.

> >
> >   " The aim was to develop a translator which is capable of reading in any
> >given Haskell'98 program and writing out a semantically equivalent Clean
> >one. Why? To investigate the suitability of the Clean compiler for
> >compiling Haskell programs, i.e.  Can the Clean compiler, in combination
> >with this tool, produce faster executables than existing Haskell
> >compilers? "
>
> That looks interesting. I wonder what the results mean =)
>
> It could be that Clean and Haskell are roughly equivalent in speed
> (modulo som variance), or it could mean that GHC is great at
> optimizing Haskell code, but in certain cases uniqueness typing (among
> other things?) gives so much benifits that it outweights GHC's
> optimization.

Just a side note (please, correct me if I'm wrong): Hacle does not even make 
use of uniqueness typing (apart from *World
and *File), so any benefits are due to other differences, like, inferred 
strictness.


Regards,

zooloo




-- 
No virus found in this outgoing message.
Checked by AVG Free Edition.
Version: 7.1.371 / Virus Database: 267.13.12/192 - Release Date: 05.12.2005

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Verbosity of imperative code (was: Learning Haskell)

2005-12-07 Thread Robin Green
On Wednesday 07 December 2005 20:19, you wrote:
> On Wed, Dec 07, 2005 at 07:47:46PM +, Robin Green wrote:
> > > Some day you may thank for this verbosity, because it encourages
> > > you do program in a purely functional way making your program more
> > > friendly for SMP execution.
> >
> > You are mistaken. The verbosity is necessary if you want "visual"
> > referential transparency, but not necessary if you only want pure
> > functional programming. Only the latter is helpful for optimisability. I
> > am hoping to write a paper on this topic.
>
> I am afraid I don't understand.

Let's say you want to write a function

seqPair :: (Monad m) => (m a, m b) -> m (a, b)

which returns a computation which does the left computation followed by the 
right computation (i.e. it's like the sequence function, but for pairs 
instead of lists).

In Haskell you could write this as:

seqPair mx my = do
x <- mx
y <- my
return (x, y)

However, wouldn't it be nice if we could write something like (warning: 
hypothetical syntax)

seqPair $= (,)

or (the slightly less cryptic version)

seqPair x y $= (x, y)

This is not referentially transparent because it is not equivalent to

seqPair x y $= swap (y, x) where swap (a, b) = (b, a)

(can you see why not?)

But it _is_ semantically equivalent to the first definition I gave, which is 
functionally pure, so it is also functionally pure (at least, when you 
consider it as a "black box").
-- 
Robin
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Learning Haskell

2005-12-07 Thread Tomasz Zielonka
On Wed, Dec 07, 2005 at 07:47:46PM +, Robin Green wrote:
> > Some day you may thank for this verbosity, because it encourages
> > you do program in a purely functional way making your program more
> > friendly for SMP execution.
> 
> You are mistaken. The verbosity is necessary if you want "visual" referential 
> transparency, but not necessary if you only want pure functional programming. 
> Only the latter is helpful for optimisability. I am hoping to write a paper 
> on this topic.

I am afraid I don't understand.

PS. "I am after two hot beers" warning :-)

Best regards
Tomasz

-- 
I am searching for a programmer who is good at least in some of
[Haskell, ML, C++, Linux, FreeBSD, math] for work in Warsaw, Poland
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Can't Haskell catch up with Clean's uniqueness typing?

2005-12-07 Thread haskell-cafe . mail . zooloo
On Wed, Dec 07, 2005 at 05:59:55PM +0100, [EMAIL PROTECTED] wrote:
> > I liked the concept of UT in Clean, but I haven't ever got comfortable
> > with using it to write real programs.
> 
> Clean-like _explicit_ uniqueness typing is not what I'm asking for in Haskell.

So you want implicit, automatically inferred uniqueness typing -
something that would be even more fragile and sensitive then current
Haskell's space problems arising from laziness? ;-)

> It might be possible to get extremely fast code out of ghc, but as an
> overall impression, it's not easy, whilst Clean sort of gives it for
> granted (well, struggeling with wrongly assigned uniqueness attributes
> aside).

Well, C sort of gives it for granted too, because it is very difficult
to write inefficient, simple, specification-like code. I want to be able
to write simple and elegant code, even if it is inefficient!

Best regards
Tomasz

-- 
I am searching for a programmer who is good at least in some of
[Haskell, ML, C++, Linux, FreeBSD, math] for work in Warsaw, Poland
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Learning Haskell

2005-12-07 Thread Sebastian Sylvan
On 12/7/05, Robin Green <[EMAIL PROTECTED]> wrote:
> On Wednesday 07 December 2005 19:35, Tomasz Zielonka wrote:
> > On Tue, Dec 06, 2005 at 10:58:45PM +0300, Bulat Ziganshin wrote:
> > > the third-priority problem is language itself. in particular, i hate
> > > Haskell school of imperative manipulations:
> > >
> > > x' <- readIORef x
> > > y' <- readIORef y
> > > writeIORef z (x'*y')
> >
> > Some day you may thank for this verbosity, because it encourages
> > you do program in a purely functional way making your program more
> > friendly for SMP execution.
>
> You are mistaken. The verbosity is necessary if you want "visual" referential
> transparency, but not necessary if you only want pure functional programming.
> Only the latter is helpful for optimisability. I am hoping to write a paper
> on this topic.
>

I probably wouldn't mind some syntax along the lines of

-- x,y :: IOref a
x := y

translated to

v <- readIORef y
writeIORef x y

and

-- x :: IOref a , y :: a
x := y

translated to

writeIORef x y


Of course it should carry over to STM (TVar) and ST etc. Maybe even
allow the right-hand-side to have type "IO a" and make "Num a => IORef
a" instances in Num to allow expressions like

x := y + z

Where x, y and z are IORefs or regular values.

As long as the result of := (or any numeric operators involving
IORefs) is always an IO computation it's still safe.

It may make it harder for people to grasp the difference between an
IORef and a regular value though...

/S


--
Sebastian Sylvan
+46(0)736-818655
UIN: 44640862
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Learning Haskell

2005-12-07 Thread Robin Green
On Wednesday 07 December 2005 19:35, Tomasz Zielonka wrote:
> On Tue, Dec 06, 2005 at 10:58:45PM +0300, Bulat Ziganshin wrote:
> > the third-priority problem is language itself. in particular, i hate
> > Haskell school of imperative manipulations:
> >
> > x' <- readIORef x
> > y' <- readIORef y
> > writeIORef z (x'*y')
>
> Some day you may thank for this verbosity, because it encourages
> you do program in a purely functional way making your program more
> friendly for SMP execution.

You are mistaken. The verbosity is necessary if you want "visual" referential 
transparency, but not necessary if you only want pure functional programming. 
Only the latter is helpful for optimisability. I am hoping to write a paper 
on this topic.

Regards,
-- 
Robin
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Learning Haskell

2005-12-07 Thread Tomasz Zielonka
On Tue, Dec 06, 2005 at 10:58:45PM +0300, Bulat Ziganshin wrote:
> the third-priority problem is language itself. in particular, i hate
> Haskell school of imperative manipulations:
> 
> x' <- readIORef x
> y' <- readIORef y
> writeIORef z (x'*y')

Some day you may thank for this verbosity, because it encourages
you do program in a purely functional way making your program more
friendly for SMP execution.

> i already sayed about lacking of OOP features.

Besides Haskell I also write in C++, and there I haven't yet found a
good use for deep subtyping hierarchies. Most of my class hierarchies
consist of a single abstract root and a group of concrete children.
These kind of OO is easily expressible even in Haskell 98.

> another weakness against Erlang and scripting languages is their more
> dynamic character which sometimes is more appropriate,

Then use those scripting languages! I don't want Haskell's semantics
to be "whatever is appropriate in this context".

Best regards
Tomasz

-- 
I am searching for a programmer who is good at least in some of
[Haskell, ML, C++, Linux, FreeBSD, math] for work in Warsaw, Poland
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Can't Haskell catch up with Clean's uniqueness typing?

2005-12-07 Thread Sebastian Sylvan
On 12/7/05, Greg Buchholz <[EMAIL PROTECTED]> wrote:
> [EMAIL PROTECTED] wrote:
> > It might be possible to get extremely fast code out of ghc, but as an 
> > overall
> > impression, it's not easy, whilst Clean sort of gives it for granted (well,
> > struggeling with wrongly assigned uniqueness attributes aside).
>
> 
>
> > programs generated by ghc generally need multiples of time and space of the
> > Clean version, even though the latter is, in many cases, a nearly literal
> > translation from Haskell.
>
> Maybe you'd be interested in Hacle?
>
>   http://www-users.cs.york.ac.uk/~mfn/hacle/
>
>   " The aim was to develop a translator which is capable of reading in any
>given Haskell'98 program and writing out a semantically equivalent Clean
>one. Why? To investigate the suitability of the Clean compiler for
>compiling Haskell programs, i.e.  Can the Clean compiler, in combination
>with this tool, produce faster executables than existing Haskell
>compilers? "

That looks interesting. I wonder what the results mean =)

It could be that Clean and Haskell are roughly equivalent in speed
(modulo som variance), or it could mean that GHC is great at
optimizing Haskell code, but in certain cases uniqueness typing (among
other things?) gives so much benifits that it outweights GHC's
optimization.
It definatly means that there are cases where GHC could improve significantly.

Nevertheless, Haskell speed is definatly a big issue for many. It is a
general purpose language, after all, and that makes speed important.
For "single-purpose" languages like, say, php it's not as important
(because you're not going to write, say, a game engine in php for
reasons other than speed).

Haskell is certainly better now than it used to be, but there's plenty
of room for improvement.


/S

--
Sebastian Sylvan
+46(0)736-818655
UIN: 44640862
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Can't Haskell catch up with Clean's uniqueness typing?

2005-12-07 Thread Greg Buchholz
[EMAIL PROTECTED] wrote:
> It might be possible to get extremely fast code out of ghc, but as an overall
> impression, it's not easy, whilst Clean sort of gives it for granted (well,
> struggeling with wrongly assigned uniqueness attributes aside).



> programs generated by ghc generally need multiples of time and space of the
> Clean version, even though the latter is, in many cases, a nearly literal
> translation from Haskell.

Maybe you'd be interested in Hacle?

  http://www-users.cs.york.ac.uk/~mfn/hacle/

  " The aim was to develop a translator which is capable of reading in any
   given Haskell'98 program and writing out a semantically equivalent Clean
   one. Why? To investigate the suitability of the Clean compiler for
   compiling Haskell programs, i.e.  Can the Clean compiler, in combination
   with this tool, produce faster executables than existing Haskell
   compilers? "


Greg Buchholz
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Can't Haskell catch up with Clean's uniqueness typing?

2005-12-07 Thread haskell-cafe . mail . zooloo


- Original Message -
From: "Tomasz Zielonka - [EMAIL PROTECTED]"
Sent: Tuesday, December 06, 2005 9:18 PM


>
> We can get similar performance from Haskell using various features of
> GHC (unboxed arrays, mutable arrays, ST monad, soon SMP, etc) and one
> can argue that they are even nicer.
>
> I liked the concept of UT in Clean, but I haven't ever got comfortable
> with using it to write real programs.
>


Clean-like _explicit_ uniqueness typing is not what I'm asking for in Haskell.

>
> I think the biggest obstacle is that almost nobody asks for it.
> Well, you asked, but how much Haskell code did you write to be
> sure that you really need it?
>


Indeed, my own experience is too limited to really compare. However, the latest 
ghc survey,

http://haskell.org/ghc/survey2005-summary.html

suggests that "Performance of compiled code" is a top issue to others, too. OC, 
this involves various aspects, with memory
usage being only one of them.


It might be possible to get extremely fast code out of ghc, but as an overall 
impression, it's not easy, whilst Clean sort
of gives it for granted (well, struggeling with wrongly assigned uniqueness 
attributes aside).


In the debian shootout,

http://shootout.alioth.debian.org/benchmark.php?test=all&lang=ghc&lang2=clean,

programs generated by ghc generally need multiples of time and space of the 
Clean version, even though the latter is, in
many cases, a nearly literal translation from Haskell.

I know, all this is not representative. Anyway, it may serve as motivation for 
my question (or suggestion).


Regards,

zooloo



-- 
No virus found in this outgoing message.
Checked by AVG Free Edition.
Version: 7.1.371 / Virus Database: 267.13.12/192 - Release Date: 05.12.2005

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Learning Haskell

2005-12-07 Thread Jimmie Houchin
I want to thank all who provided insight and understanding to my 
inquiry. This has been a very nice and helpful community.


I look forward to the progress Haskell makes.

I do a lot of text processing. I currently have a few million files and 
4-6gb of data to process. I need excellent string support.


It seems for me at this present time and with my knowledge and time 
constraints that Python will be the practical choice.


I will continue to slowly work my way through the tutorials and expand 
my understanding. Maybe someday Haskell and I will converge at a place 
where I am more capable and it is more ready for me.


Until that day I wish all of you the best and may Haskell grow, mature 
and prosper in its acceptance, libraries and community.


I think that as more practical applications such as darcs are produced 
that Haskell's mindshare will grow.


Again, Thanks.

Jimmie
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Can't Haskell catch up with Clean's uniqueness typing?

2005-12-07 Thread haskell-cafe . mail . zooloo

- Original Message -
From: "Jan-Willem Maessen - [EMAIL PROTECTED]"
Sent: Wednesday, December 07, 2005 2:21 PM
>
> Wearing my "Fortress language designer" hat, we've given serious
> thought to these techniques for very large arrays.  Copying such
> structures is terribly expensive, or even impossible (imagine copying
> a 1PB array).

That's slightly beyond the size of arrays I am currently dealing with. ;) I can 
see that in-place updating is of utmost
importance in such cases.

However, I was actually thinking of something the Clean people call "garbage 
collection at compile time", which, as far as
I can see, involves no runtime overhead at all (Clean Language Report 2.1, 
section 9.1. -
ftp://ftp.cs.kun.nl/pub/Clean/Clean20/doc/CleanLangRep.2.1.pdf).

I don't quite see why it should be necessary to specify uniqueness attributes 
explicitely (as it mostly is in Clean), if
the type checker knows the coercion laws better than me, anyway. Hence, my 
question about automatically deriving
uniqueness properties of tokens, to the greatest extent safely feasible at 
compile time. (Sorry, if this is all trivial
and already implemented in ghc. As indicated, I am merely learning Haskell, and 
I haven't spent any mentionable time yet
to understand compiler intestines.)


Regards,

zooloo



-- 
No virus found in this outgoing message.
Checked by AVG Free Edition.
Version: 7.1.371 / Virus Database: 267.13.12/192 - Release Date: 05.12.2005

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Learning Haskell

2005-12-07 Thread Wolfgang Jeltsch
Am Dienstag, 6. Dezember 2005 20:58 schrieb Bulat Ziganshin:
> [...]

> i already sayed about lacking of OOP features.

This is the old discussion again.  Do we need OOP features?  Or do we want to 
avoid OOP features?  I would like to avoid them.  Maybe I have not enough 
experience with situations where they are helpful but maybe there exist 
better alternatives.

> another weakness against Erlang and scripting languages is their more
> dynamic character which sometimes is more appropriate, especially in
> scripting, web pages and other applets

What do you mean with "more dynamic"?  More dynamic typing?  Where is this 
important?  By the way, I'm thinking about a web development framework where 
static typing is essential for enforcing certain restrictions and consistency 
conditions.  Currently, I cannot see where dynamic typing would help for web 
programming but this does not mean that there aren't such situations.

Best wishes,
Wolfgang
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Can't Haskell catch up with Clean's uniqueness typing?

2005-12-07 Thread Wolfgang Jeltsch
Am Mittwoch, 7. Dezember 2005 14:21 schrieb Jan-Willem Maessen:
> [...]

> The principle obstacles are the same as for any reference counting scheme:
> It imposes more run-time overhead than GC does, unless the data structures
> involved are large.

Why?  I think the point with uniqueness typing/analysis is that this is done 
at *compile-time*.

> [...]

Best wishes,
Wolfgang
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re[4]: [Haskell-cafe] What's a thread doing / Erlang-style processes / Message passing

2005-12-07 Thread Bulat Ziganshin
Hello Joel,

Tuesday, December 06, 2005, 8:30:32 PM, you wrote:

JR> Assuming I typed events like that I think I would need a typed sink  
JR> for them as well. I only have one sink for the events and that is my  
JR> message queue.

i don't understand you. remember that i'm not native English speaker :)

JR> I expect users to want User X, User Y, User Z within  
JR> the same module and that's why I used Dynamic.

if you can define all these datatags (X, Y and Z) in one type then you
can use pattern matching:

data UserEvent = X ... | Y ... | Z ...

if not - then can't. of course, you can use this "subtyping trick"
several times, but it is not very interesting:

data Event a = ... | User a
data UserEvent1 a = X ... | User2 a
data UserEvent2 a = Y ... | User3 a

send chan (User $ User2 $ Y)  -- type of expression inside brackets is
"Event (UserEvent1 (UserEvent2 a))", where a is unspecified


or you can define

data Event a b c = ... | User1 a | User2 b | User3 c

but this is also bad :(


you can also use classes, but Dynamic actually does the same, and this
gives you no ability to do pattern-matching



-- 
Best regards,
 Bulatmailto:[EMAIL PROTECTED]



___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re[2]: [Haskell-cafe] Can't Haskell catch upwith Clean's uniqueness typing?

2005-12-07 Thread Bulat Ziganshin
Hello Robert,

Wednesday, December 07, 2005, 2:19:22 AM, you wrote:

>> In Clean, you can (and often are required to) assign uniqueness attributes
>> to some parts of a function's type signature. The extended type checker
>> ensures that none of those parts is referred to more than once during a
>> single run of the program. Based on this guarantee, a function does not
>> have to allocate new memory at all to store a unique result but can
>> overwrite the unique arguments in place.
>>
>> My question is - and this might better suit to Haskell -, can't uniqueness
>> be inferred (and exploited) automatically in many cases?

RD> Yes, probably.  There is a technique called sharing analysis that attempts 
to 
RD> determine when a datastructure is only referenced once (ie, NOT shared).  
If 
RD> you can prove a datastructure node is not shared then you can reuse it 
RD> destructively.

may be, John Meacham can say something about it? his JHC compiler uses
region analysis to avoid garbage collection - may be these techniques
has something in common?

-- 
Best regards,
 Bulatmailto:[EMAIL PROTECTED]



___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re[2]: [Haskell-cafe] Connecting to a running process (REPL)

2005-12-07 Thread Bulat Ziganshin
Hello Tomasz,

Tuesday, December 06, 2005, 11:01:45 PM, you wrote:

>> Is there a good standard way of supplying a read-eval prompt in a
>> program?

TZ> Some time ago I was thinking about implementing a Haskell telnet
TZ> server module, but now I think that this would be a difficult
TZ> solution for a simple problem.

is that any better than just having one of threads running this
read-eval loop? :)  possibly on specially allocated console, if
the program itself make some screen i/o


-- 
Best regards,
 Bulatmailto:[EMAIL PROTECTED]



___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Can't Haskell catch up with Clean's uniqueness typing?

2005-12-07 Thread David Roundy
On Wed, Dec 07, 2005 at 08:21:42AM -0500, Jan-Willem Maessen wrote:
> Yes, this could be done.  The principle obstacles are the same as for any
> reference counting scheme: It imposes more run-time overhead than GC
> does, unless the data structures involved are large.  Let me repeat that:
> accurate up-to-the-moment reference counting is dramatically slower than
> GC.  Techniques exist to make ref counting fast, but they all require the
> equivalent of a full stack walk in order to get an accurate count.

For strict functions, does ghc do optimizations like this automatically?
i.e. can it statically count references and avoid allocation of
intermediates?
-- 
David Roundy
http://www.darcs.net
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re[2]: [Haskell-cafe] Learning Haskell

2005-12-07 Thread Bulat Ziganshin
Hello Wolfgang,

Tuesday, December 06, 2005, 10:16:08 PM, you wrote:

>> so, in my feel, Haskell is better in areas where there is no standard
>> quick-and-dirty solutions and all languages are in equal conditions,
>> but it can't compete with Visual Basic in user interfaces, Erlang in
>> distributed processing, and Python in scripting

WJ> Well, I would say that this has nothing to do with the language as such but 
WJ> with a current lack of certain libraries.  I even think that with 
appropriate 
WJ> libraries, Haskell will often have advantages over the existing solutions.

of course, the main problem is libraries. the second problem is
frameworks (like Delphi, which i also love). the third-priority problem
is language itself. in particular, i hate Haskell school of imperative
manipulations:

x' <- readIORef x
y' <- readIORef y
writeIORef z (x'*y')

i already sayed about lacking of OOP features. another weakness
against Erlang and scripting languages is their more dynamic
character which sometimes is more appropriate, especially in
scripting, web pages and other applets


-- 
Best regards,
 Bulatmailto:[EMAIL PROTECTED]



___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Can't Haskell catch up with Clean's uniqueness typing?

2005-12-07 Thread Jan-Willem Maessen


On Dec 6, 2005, at 9:17 AM, [EMAIL PROTECTED] wrote:


Hi all,

being occupied with learning both languages, I'm getting curious if  
Haskell couldn't achieve most of the performance gains
resulting from uniqueness typing in Clean by *automatically*  
determining the reference count of arguments wherever
possible and subsequently allowing them to be physically replaced  
immediately by (the corresponding part of) the
function's result. Are there any principal obstacles, or *could*  
this be done, or *is* this even done already, e. g. in

ghc?


Yes, this could be done.  The principle obstacles are the same as for  
any reference counting scheme: It imposes more run-time overhead than  
GC does, unless the data structures involved are large.  Let me  
repeat that: accurate up-to-the-moment reference counting is  
dramatically slower than GC.  Techniques exist to make ref counting  
fast, but they all require the equivalent of a full stack walk in  
order to get an accurate count.


That said, clever techniques (like 1-bit ref counting) are available  
that will get 80% of what is desired.  1-bit reference counting keeps  
a single bit which says either "this is certainly the only reference"  
or "other references may exist".  The bit can be kept in the pointer  
itself.  There's still run-time overhead, though---the bit must be  
masked on each pointer dereference.


Wearing my "Fortress language designer" hat, we've given serious  
thought to these techniques for very large arrays.  Copying such  
structures is terribly expensive, or even impossible (imagine copying  
a 1PB array).  I'd think hard before I used them for, say, cons cells.


Shae: All this is very, very different from eager / optimistic  
evaluation.


-Jan-Willem Maessen

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] Haskell and other languages (was: Learning Haskell)

2005-12-07 Thread Graham Klyne
Jimmie Houchin wrote:
> Haskell looks like a very interesting language. I am only so-so with
> Python and I thought that maybe if instead of spending sufficient time
> to get proficient with Python, I could invest a similar time (more or
> less) and get reasonably (pragmatically speaking) proficient with
> Haskell. I know I may never understand the theory and maths behind the
> design, but I believe I can appreciate the design and be a decent user
> of the tools it provides.

FWIW, I learned Haskell a couple of years ago, having previously programmed in
Python and (many) other languages.  Recently, I've been using Python for a
project (the choice being determined by both technical and non-technical
issues), and find my Python programming style is now heavily influenced (for the
better, I hope ;-) by my Haskell programming experience.

A drawback of using Haskell is the limited availability of support libraries,
although many people here are working hard to improve that situation.  I'm doing
Python work with a web application framework (Turbogears - in the same general
space as Ruby/Rails, but different), and as yet I don't see anything like it in
Haskell.  It would be great to see a lightweight "full stack" web application
framework for Haskell:  I believe many of the pieces exist, and Haskell could be
a supremely effective language for tying them together.

#g

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

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Learning Haskell

2005-12-07 Thread Ketil Malde

Jimmie Houchin <[EMAIL PROTECTED]> writes:

> I have been perusing the haskell.org site and reading some of the
> tutorials. I just didn't want to expend lots of time just to find out
> that my math skills were woefully inadequate. I am grateful to learn
> that I can continue pursuing Haskell.

Lots of people have answered, so I'll just add one point: use the
community!  Lots of people are quite enthusiastic, so if you get
stuck, or have questions, post to this or one of the other mailing
lists, or try the #haskell IRC channel on FreeNode.

-k
-- 
If I haven't seen further, it is by standing in the footprints of giants

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe