Re: [Haskell-cafe] Numerical methods in Haskell

2006-02-20 Thread Bjorn Lisper
I finally got some time to answer Simon's posting:

Simon P-J:
| Between google searching and looking through the activity
| report, I take it that no one has really developed serious
| libraries for matrix manipulations, diff eqs, etc.
| 
| Are there any practical reasons for this or is it just a
| matter of the haskell community being small and there not
| being many people interested in something so specialized?

The latter I think, but it's just the sort of thing that a functional
language should be good at.  Two other difficulties

(a) It's hard to compete with existing libraries.  The obvious thing is
not to compete; instead, just call them.  But somehow that doesn't seem
to be as motivating.  Perhaps some bindings exist though?

Hard to compete, yes. But on the other hand, the rewards can be high.
Numerical library code (especially matrix libraries) tends to be highly
optimized for the hardware architecture at hand. As a consequence a small
change in, say, the cache architecture, might require a thorough rewrite of
the library code to regain high utilisation of the hardware. This is since
languages like Fortran and C force you to code so close to the hardware. A
high-level language, with good optimizing compilation, would make also
library code more portable across hardware architectures. N.b. these
optimizations are non-trivial to say the least.

(b) A concern about efficiency, because numerical computation is
typically an area where people really care about how many instructions
you take.  It's a legitimate concern, but I don't think that it'll turn
out to be justified.  With unboxed arrays, and/or calling external
libraries for the inner loops -- and the potential for aggressive fusion
and/or parallelism, there is plenty of upward potential.  I also want to
work on nested data parallelism (a la NESL, and NEPAL) which fits right
in here.

The number of instructions is only one side of the coin. For
high-performance computing, memory issues are at least as important: both
the amount of memory used (e.g., will the computation fit into memory at
all), and how the memory hierarchy is utilized (caches, TLB:s, virtual
memory, ...). This is a really sweet spot of functional languages, and
laziness adds to it.

On the other hand, the increased abstraction of functional languages gives
an optimizing compiler larger freedom to reorder computations and choose
memory layouts of data structures like matrices. This is potentially very
useful, since optimizing for memory hierarchy utilization typically involves
both data layout and order of memory accesses. However, to achieve a good
result, the compiler must be able to predict a great deal of the computing
and the memory usage. For instance, dynamic memory handling of numeric data
structures will surely kill any serious attempt to predict the cache
behavior. To achieve good optimizing compilation, we need either very good
program analyses, or a library of recursion patterns or templates for
which the compiler knows how to allocate memory statically and order the
computations well, or possibly both.

Some encouraging examples: Sven-Bodo Scholz has achieved very good
performance for the restricted functional matrix language SAC, using
optimizations for cache. My former student Peter Drakenberg invented a
restricted functional matrix language, with analyses to infer matrix sizes
statically, and sharing analysis, to find opportunities to allocate memory
statically and update in-place. He also got some good experimental figures.
This leads me to believe that compilers in more general languages could do
something similar, by recognizing certain patterns or through advanced
program analyses.  However, both these languages are strict, and I am not
sure at all how to do this in a lazy language.

In any case, this is nontrivial compiler work and considerable research
efforts would be needed. Unfortunately, I don't see how to fund such
research, since the high-performance computing community largely seems to
have given up on functional languages since the demise of the data-flow
languages.

I'd love to see a little community of matrix manipulators spinning up.  

Yes. There might me a niche for high-level numerical coding, somehwere where
MATLAB is today. MATLAB isn't exactly blazingly fast, still very widespread.
On the other hand, MATLAB is already in that niche. The question to answer
is what advantages a functional language like Haskell could offer in this
niche. We need to come up with these answers, and then convince enough
people outside our own community.

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


RE: [Haskell-cafe] library sort

2006-02-20 Thread Simon Peyton-Jones
Strangely, Hoogle isn't easy to find at haskell.org.  I'm not sure where
the best place to add a link would be: perhaps near the top of the
libraries-and-tools page?  It's all wikified now, so would someone like
to add it somewhere appropriate?

Simon

| -Original Message-
| From: [EMAIL PROTECTED]
[mailto:[EMAIL PROTECTED] On Behalf Of
| Radu Grigore
| Sent: 17 February 2006 14:11
| To: Haskell Cafe
| Subject: Re: [Haskell-cafe] library sort
| 
| On 2/16/06, Jared Updike [EMAIL PROTECTED] wrote:
|  If you need an easier way to search the Haskell APIs, use Hoogle:
| 
| Hoogle is very nice. Thanks to everyone who answered my question about
| finding a sort library function.
| 
| --
| regards,
|   radu
| http://rgrig.blogspot.com/
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Constructor classes implementation

2006-02-20 Thread Daniel Fischer
Am Freitag, 17. Februar 2006 03:34 schrieb Sean Seefried:
 Hey all,

 If you're interested in an implementation of constructor classes
 (type classes which can take constructors as arguments; already
 implemented in Haskell) please see:

 http://www.cse.unsw.edu.au/~sseefried/code.html

 This should help understanding the paper by Mark P. Jones called A
 system of constructor classes: overloading and implicit higher-order
 polymorphism much easier.

 The implementation not only infers the type but also prints out a
 trace of the derivation tree for the syntax directed rules.

 Cheers,

 Sean

 p.s. If you find any bugs, please let me know.

Re bugs:

1. printGamma [] would print an unmotivated  }, as witnessed by
typeInf [] term14.

2. the case
unify (ConT c) (AppT t1 t2)
is missing.

3. too many shadowed bindings, this is always dangerous, I believe

4. I'm not sure, the datatypes are appropriate; as far as I know, expressions 
have a type and not a kind, which is what the use of the same Var type for 
Type and Exp entails. 

I have only just glimpsed at Jones' paper, so I don't yet see, what this type 
inference algorithm (quite nice, btw) has to do with constructor classes. If 
I still don't after reading it, I'll come back to ask.

Cheers,
Daniel

-- 

In My Egotistical Opinion, most people's C programs should be
indented six feet downward and covered with dirt.
-- Blair P. Houghton

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


Re: [Haskell-cafe] Numerical methods in Haskell

2006-02-20 Thread David Roundy
On Mon, Feb 20, 2006 at 11:47:49AM +0100, Bjorn Lisper wrote:
 (a) It's hard to compete with existing libraries.  The obvious thing is
 not to compete; instead, just call them.  But somehow that doesn't seem
 to be as motivating.  Perhaps some bindings exist though?
 
 Hard to compete, yes. But on the other hand, the rewards can be high.
 Numerical library code (especially matrix libraries) tends to be highly
 optimized for the hardware architecture at hand. As a consequence a small
 change in, say, the cache architecture, might require a thorough rewrite of
 the library code to regain high utilisation of the hardware. This is since
 languages like Fortran and C force you to code so close to the hardware. A
 high-level language, with good optimizing compilation, would make also
 library code more portable across hardware architectures. N.b. these
 optimizations are non-trivial to say the least.

The only particularly relevant numerical libraries today (atlas and fftw)
already do far better optimization than any compiler is going to acheive,
and in the case of fftw can respond to changes in memory configuration at
runtime.  In both cases they're written in ANSI C (although the C code for
fftw is written by an OCaml program... or at least some dialect of ML).  In
order to take advantage of cache behavior properly, it's necesary to allow
adjustments in the actual algorithm used, which isn't something that a
clever compiler is likely to accomplish.

Which is to say that while I'd love native Haskell code to run incredibly
fast, noone can compete with atlas or fftw when writing in any other
language either, unless they're willing to do either runtime or
compile-time (or coding-time) timings on the actual machine on which the
code will run.  There really is no reason to try to compete with these
libraries.  Unless, I suppose, your interest is in writing libraries...

fwiw, atlas takes close to a day to compile on my machine, since it spends
so long performing timings of various algorithms with various parameters.
I don't want my haskell compiler to take that long to compile *anything*.
-- 
David Roundy
http://www.darcs.net
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Numerical methods in Haskell

2006-02-20 Thread Bjorn Lisper
David Roundy:
On Mon, Feb 20, 2006 at 11:47:49AM +0100, Bjorn Lisper wrote:
 (a) It's hard to compete with existing libraries.  The obvious thing is
 not to compete; instead, just call them.  But somehow that doesn't seem
 to be as motivating.  Perhaps some bindings exist though?
 
 Hard to compete, yes. But on the other hand, the rewards can be high.
 Numerical library code (especially matrix libraries) tends to be highly
 optimized for the hardware architecture at hand. As a consequence a small
 change in, say, the cache architecture, might require a thorough rewrite of
 the library code to regain high utilisation of the hardware. This is since
 languages like Fortran and C force you to code so close to the hardware. A
 high-level language, with good optimizing compilation, would make also
 library code more portable across hardware architectures. N.b. these
 optimizations are non-trivial to say the least.

The only particularly relevant numerical libraries today (atlas and fftw)
already do far better optimization than any compiler is going to acheive,
and in the case of fftw can respond to changes in memory configuration at
runtime.  In both cases they're written in ANSI C (although the C code for
fftw is written by an OCaml program... or at least some dialect of ML).  In
order to take advantage of cache behavior properly, it's necesary to allow
adjustments in the actual algorithm used, which isn't something that a
clever compiler is likely to accomplish.

That's a valid point. You may want to change, e.g., the size of blocks in a
block-oriented matrix algorithm to match the cache. This will, in general,
require the use of algebraic laws like associativity and commutativity,
which are not valid for floating-point arithmetics and thus can change the
numerical behaviour, so a compiler shouldn't fiddle around with them unless
under strict control of the programmer. Interestingly, the language invented
by my aforementioned former PhD student contains a nondeterministic matrix
decomposition primitive, which allows the partitioning of a matrix into a
fixed number of blocks, but where block sizes can vary. This is exactly to
let the programmer give an optimizing compiler this degree of freedom when
deemed safe. Alas, he never got around to any serious experiments with this
feature.

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


Re: [Haskell-cafe] Haskell as scripting language?

2006-02-20 Thread Henning Thielemann

On Wed, 15 Feb 2006, Marc Weber wrote:

 Is there a way to use haskell as scripting language in
 a) your own project?
 b) other projects such as vim (beeing written in C)?

For German readers, I put an example of a scripting task on that Wiki:

http://www.wikiservice.at/dse/wiki.cgi?SpracheHaskell/Skripte

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


Re: [Haskell-cafe] module for probability distributions

2006-02-20 Thread Henning Thielemann


On Thu, 16 Feb 2006, Matthias Fischmann wrote:


I wrote a module for sampling arbitrary probability distribution, so
far including normal (gaussian) and uniform.

  http://www.wiwi.hu-berlin.de/~fis/code/

For those who need something like this: feel free to take it, it's BSD.
For those who feel like growing their karma:

 - There are a few questions in the code (marked with 'XXX').

 - There are probably far better way to do this.  I am eager to
   learn.

 - There is probably a better implementation out there already.
   Please point me to it.


In HaskellDSP there are some routines for generating random numbers with 
specific distributions:

 http://haskelldsp.sourceforge.net/doc/index.html

e.g.
 http://haskelldsp.sourceforge.net/doc/Numeric.Random.Distribution.Gamma.html
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] getChar + System.Cmd.system + threads causes hangups

2006-02-20 Thread Einar Karttunen
Hello

Using system or any variant of it from System.Process
seems broken in multithreaded environments. This
example will fail with and without -threaded.

When run the program will print hello: start and
then freeze. After pressing enter (the first getChar)
System.Cmd.system will complete, but without that
it will freeze for all eternity.

What is the best way to fix this? I could use System.Posix,
but that would lose windows portablity which is needed.


import Control.Concurrent
import System.Cmd

main = do forkIO (threadDelay 10  hello)
  getChar
  getChar

hello = do putStrLn hello: start
   system echo hello world!
   putStrLn hello: done


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


Re: [Haskell-cafe] HaXml: ampersand in attribute value

2006-02-20 Thread Graham Klyne
Lennart Augustsson wrote:
 But speaking of HaXml bugs, I'm pretty sure HaXml doesn't handle
 % correctly.  It seem to treat % specially everywhere, but I think
 it is only special inside DTDs.  I have many XML files produced by
 other tools that the HaXml parser fails to process because of this.

Indeed.  This is an area that I found required a fair amount of work on the
version of HaXML I was playing with, some time ago.

The change log at the end of:
http://www.ninebynine.org/Software/HaskellUtils/HaXml-1.12/src/Text/XML/HaXml/Lex.hs
has some clues to what I had to do.  Notably:
[[
-- Revision 1.12  2004/06/04 21:59:13  graham
-- Wortk-in-progress:  creating intermediate filter to handle parameter
-- entity replacement.  Separated common features from parse module.
-- Created new module based on simplified use of parsing utilities
-- to dtect and substitute PEs.  The result is a modifed token sequence
-- passed to the main XML parser.
]]

The parameter entity filter is defined by:
http://www.ninebynine.org/Software/HaskellUtils/HaXml-1.12/src/Text/XML/HaXml/SubstitutePE.hs

The parameter and entity entity handling aspect of the code was not pretty, due
mainly to the somewhat quirky nature of XML syntax, especially concerning
parameter and general entities.

#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] HaXml: ampersand in attribute value

2006-02-20 Thread Graham Klyne
Malcolm Wallace wrote:
 Lennart Augustsson wrote:
 But speaking of HaXml bugs, I'm pretty sure HaXml doesn't handle
 % correctly.  It seem to treat % specially everywhere, but I think
 it is only special inside DTDs.  I have many XML files produced by
 other tools that the HaXml parser fails to process because of this.
 
 I believe I fixed at least one bug to do with % characters around
 version 1.14.  But that is the development branch in darcs, not formally
 released yet.  Nevertheless, if you know of such bugs, do report them;
 even better if you can send a small test case.

Malcolm,

Did you come across the HaXml test harness I created based on a subset of W3C
conformance tests?

http://www.ninebynine.org/Software/HaskellUtils/HaXml-1.12/test/

This covers all the parameter entity problems I fixed some time ago.

#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] getChar + System.Cmd.system + threads causes hangups

2006-02-20 Thread Einar Karttunen
Here is a version that works fine:


myRawSystem cmd args = do 
(inP, outP, errP, pid) - runInteractiveProcess cmd args Nothing Nothing
hClose inP
os - pGetContents outP
es - pGetContents errP
ec - waitForProcess pid
case ec of
  ExitSuccess   - return ()
  ExitFailure e -
  do hPutStrLn stderr (Running process ++unwords (cmd:args)++ FAILED 
(++show e++))
 hPutStrLn stderr os
 hPutStrLn stderr es
 hPutStrLn stderr (Raising error...)
 fail Running external command failed

pGetContents h = do
mv - newEmptyMVar
let put [] = putMVar mv []
put xs = last xs `seq` putMVar mv xs
forkIO (hGetContents h = put)
takeMVar mv

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


Re: [Haskell-cafe] HaXml: ampersand in attribute value

2006-02-20 Thread Malcolm Wallace
Graham Klyne [EMAIL PROTECTED] wrote:

 Did you come across the HaXml test harness I created based on a subset
 of W3C conformance tests?
 http://www.ninebynine.org/Software/HaskellUtils/HaXml-1.12/test/
 This covers all the parameter entity problems I fixed some time ago.

Indeed, and an excellent resource.  I have been wondering how to merge
it back into my version of HaXml ever since.

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


RE: [Haskell-cafe] building ghc on win with gcc of cygwin, without cygwin1.dll (-mno-cygwin flag) ?

2006-02-20 Thread Simon Peyton-Jones
| Googling around I've found that there exists the -mno-cygwin flag
which
| you can use to not include this lib.. So would it might be possible to
| get a ghc build not using cygwin.dll with just cygwin ?

I don't know.  It sounds plausible.  But we only have enough resource to
maintain one route for building GHC on Windows.  We'd be delighted if
other folk were engaged enough to push other routes through and make
them work.

Another route we don't have, but which in principle is definitely
feasible is to compile GHC using Cygwin for Cygwin.  The advantage would
be that the resulting GHC would have a working Posix library.  The
disadvantage is that programs it compiles would require Cygwin to run.

Anyway, it's up for grabs.  Please grab away!  We need more
Windows-savvy expertise on GHC.

Simon

| -Original Message-
| From: [EMAIL PROTECTED]
[mailto:[EMAIL PROTECTED] On Behalf Of Marc
| Weber
| Sent: 12 February 2006 04:45
| To: haskell-cafe@haskell.org
| Subject: [Haskell-cafe] building ghc on win with gcc of cygwin,without
cygwin1.dll (-mno-cygwin flag)
| ?
| 
| Hi.. I've found the nice documentation about building ghc on
| haskell.org/ghc - documentation.
| There is one chapter (#1) about C compilers and environments to use:
| Either  MSYS or cywin   and
| gcc of MinGW because gcc of cygwin will link to cygwin1.dll by default
| which may change and therefore can brake your apps.
| Googling around I've found that there exists the -mno-cygwin flag
which
| you can use to not include this lib.. So would it might be possible to
| get a ghc build not using cygwin.dll with just cygwin ?
| I haven't read anything about that in those docs.
| 
| Or does this flag simply include cygwin.dll within your apps
(statically
| linked) ?
| 
| #1
:http://www.haskell.org/ghc/docs/latest/html/building/platforms.html#ghc
-cygwin
| 
| Marc
| ___
| Haskell-Cafe mailing list
| Haskell-Cafe@haskell.org
| http://www.haskell.org/mailman/listinfo/haskell-cafe
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] haskell programming guidelines

2006-02-20 Thread Christian Maeder

Hi,

haskell admits many programming styles and I find it important that 
several developers of a prject agree on a certain style to ease code review.


I've set up guidelines (still as plain text) for our (hets) project in

http://www.informatik.uni-bremen.de/agbkb/forschung/formal_methods/CoFI/hets/src-distribution/versions/HetCATS/docs/Programming-Guidelines.txt

These were inspired by C programming guidelines, 
http://haskell.org/hawiki/ThingsToAvoid and the problems I came across 
myself.


It like to get comments or proposals for our or other haskell 
grogramming guidelines.


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


Re: [Haskell-cafe] haskell programming guidelines

2006-02-20 Thread Henning Thielemann


On Mon, 20 Feb 2006, Christian Maeder wrote:


I've set up guidelines (still as plain text) for our (hets) project in

http://www.informatik.uni-bremen.de/agbkb/forschung/formal_methods/CoFI/hets/src-distribution/versions/HetCATS/docs/Programming-Guidelines.txt


It seems we share the preference for 'case', 'let', 'map', 'filter' and 
'fold'. :-)


I prefer a definite choice between all_lower_case_with_underscore and 
camelCase identifier style.


'you should probably'  -- should probably what?

Is the function size restriction still sensible for Haskell? I think 
Haskell functions should be at most a few lines, but not one or two 
screenfuls of text.


formJust - fromJust


These were inspired by C programming guidelines, 
http://haskell.org/hawiki/ThingsToAvoid and the problems I came across 
myself.


It like to get comments or proposals for our or other haskell grogramming 
guidelines.


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


Re: [Haskell-cafe] haskell programming guidelines

2006-02-20 Thread Robert Dockins


On Feb 20, 2006, at 12:48 PM, Christian Maeder wrote:

Hi,

haskell admits many programming styles and I find it important that  
several developers of a prject agree on a certain style to ease  
code review.


I've set up guidelines (still as plain text) for our (hets) project in

http://www.informatik.uni-bremen.de/agbkb/forschung/formal_methods/ 
CoFI/hets/src-distribution/versions/HetCATS/docs/Programming- 
Guidelines.txt


These were inspired by C programming guidelines, http://haskell.org/ 
hawiki/ThingsToAvoid and the problems I came across myself.


It like to get comments or proposals for our or other haskell  
grogramming guidelines.


I personally disagree with your preference for custom datatypes with  
a value representing failure to lifting types with Maybe.  I tend to  
like using the Maybe monad for composing large partial functions from  
smaller ones, but your suggestion makes that impossible.  Also, if  
you bake in your failure case into your datatype, you can't use the  
type system to differentiate explicitly partial functions (which use  
Maybe X), from ones that are not expected to be partial (which just  
use X).  Final point, using Maybe gives you an easy route to go to  
Either String X or some other richer monad to represent failure.




Rob Dockins

Speak softly and drive a Sherman tank.
Laugh hard; it's a long way to the bank.
  -- TMBG


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


Re: [Haskell-cafe] haskell programming guidelines

2006-02-20 Thread Robert Dockins


On Feb 20, 2006, at 2:26 PM, Henning Thielemann wrote:

On Mon, 20 Feb 2006, Robert Dockins wrote:

I personally disagree with your preference for custom datatypes  
with a value representing failure to lifting types with Maybe.


I understood that part of the guidelines as a pleading for Maybe.


Humm.  Well clearly I read it the opposite way.  I suppose that means  
that whatever technique is being recommended should be put forth with  
more clarity ;-)




Rob Dockins

Speak softly and drive a Sherman tank.
Laugh hard; it's a long way to the bank.
  -- TMBG


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


[Haskell-cafe] Re: Unexpected results with simple IO

2006-02-20 Thread Maurício
  I'm also using GHC 6.4.1 and rxvt v2.7.10. The problem does occur in 
compiled code, but everything is OK in ghci!

  hFlush stdout did solve the problem, as expected.
  I've just started using rxvt. If you have tips on how to make ghci 
work well with rxvt, please share them with me (for instance, how to set 
the top arrow to repeat the last line, instead of moving the cursor one 
live above. I don't understand very well how those applications handle 
keyboard).


  Best,
  Maurício

Emil Axelsson wrote:

What version of GHC are you using?
Your code works for me in rxvt in Cygwin, with GHC 6.4.1. But I remember 
having that same problem earlier (in some earlier GHC version, so it may 
be fixed by now).


The solution was to run hFlush after each putStr, like so:

  import System.IO (hFlush, stdout)

  do putStr ...
 hHlush stdout
 ...

If I remember correctly, the problem only occurred in GHCi and Hugs -- 
not when compiling the code.


/ Emil



Maurício skrev:

  You're right... I was running the example in rxvt, in cygwin. Now I 
tried in Windows command shell and it works.


  Thanks,
  Maurício

Cale Gibbard wrote:


That doesn't happen for me at all, it works just fine. Maybe it's
something wrong with your terminal? You could possibly try playing
with the buffering settings on stdout, using hSetBuffering in
System.IO.

 - Cale

On 17/02/06, Maurício [EMAIL PROTECTED] wrote:


  Dear Haskell users,

  I have a problem using IO. The small test program below asks the user
to guess from a list of random numbers between 1 and 10. Everything
works well excepts for one problem: all the messages (Guess a
number..., Right... and Wrong...) are printed after the program
finishes, i.e., I have to use it blind. I'm afraid I misunderstand
something important about lazyness or monads... What am I doing wrong?

  Thanks,
  Maurício

module Main where
import Random

main = do
   r_gen - getStdGen --random generator
   let r_list = (randomRs (1,10) r_gen) --random list
   guess_loop (r_list)

guess_loop (r:r_others) = do
   putStrLn Guess a number between 1 and 10:
   n - readLn
   if n==r
  then do
 putStrLn Right! :)
 return ()
  else do
 putStrLn Wrong... :(
 guess_loop r_others

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



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


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


Re: [Haskell-cafe] haskell programming guidelines

2006-02-20 Thread Donald Bruce Stewart
maeder:
 Hi,
 
 haskell admits many programming styles and I find it important that 
 several developers of a prject agree on a certain style to ease code review.
 
 I've set up guidelines (still as plain text) for our (hets) project in

Perhas you'd like to put up a Style page on thew new Haskell wiki,
perhaps under the Idioms category?

You could take some hints from the old style page, 
http://www.haskell.org/hawiki/HaskellStyle

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


Re: [Haskell-cafe] Lazy read

2006-02-20 Thread John Meacham
On Thu, Feb 16, 2006 at 11:28:08PM +, Malcolm Wallace wrote:
 Essentially, rather than having an indication of success/failure in the
 type system, using the Maybe or Either types, you are asking to return
 the typed value itself, with no wrapper, but perhaps some hidden bottoms
 buried inside.  One could certainly define such a parsing set-up, but
 there are no standard ones I know of.  The attraction of lazy parsing
 is obvious, but there is a cost in terms of safety.

Yeah, I have thought about the best way to do this before, something
like all combinators by default being irrefutable meaning they always
succeed perhaps placing bottoms in the structure, with a specific 'try'
like in parsec that will let you try a path and backtrack locally. I was
thinking something like a continuation based error monad where the
error continuation was 'bottom' unless overridden locally, but I never
could get the types to work out quite right. perhaps rank-n types or
following the process outlined in the parallel parsing combinators paper
will afford a better result.

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] haskell programming guidelines

2006-02-20 Thread John Meacham
There is a more straightforward way to get localized error messages
rather than using 'maybe' and hand-writing an appropriate error, and
that is to rely on irrefutable bindings.

f x = ... y ... where
Just y = Map.lookup x theMap

now if the lookup fails you automatically get an error message pointing
to the exact line number of the failure. or if the failure message of
the routine is more important than the source location you can do

f x = ... y ... where
Identity y = Map.lookup x theMap

it is anoying you have to make a choice between these two possibilities,
but this can be mitigated with CPP magic or the SRCLOC_ANNOTATE pragma.

John

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


[Haskell-cafe] Re: Code completion? (IDE)?

2006-02-20 Thread Stefan Monnier
 vim7 has introduced omni-completion... So I'm interested wether there
 are any projects which support any kind of completion.?

 I have been working on some code completion support for EclipseFP. It
 is right now in a really infant stage, but it at least is something.

 Just take a look at the latest integration build that you are able to find at

 http://eclipsefp.sourceforge.net/download

Could you describe the general approach taken?

I'd like to see something like that added to Emacs's haskell-mode as well,
and I expect a fair bit of the work can be done on the Haskell side and thus
shared among editors.


Stefan

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


[Haskell-cafe] Re: Associated Type Synonyms question

2006-02-20 Thread Martin Sulzmann
Stefan Wehr writes:
  Martin Sulzmann [EMAIL PROTECTED] wrote::
  
   Stefan Wehr writes:
[...]
Manuel (Chakravarty) and I agree that it should be possible to
constrain associated type synonyms in the context of class
definitions. Your example shows that this feature is actually
needed. I will integrate it into phrac within the next few days.

  
   By possible you mean this extension won't break any
   of the existing ATS inference results?
  
  Yes, although we didn't go through all the proofs.
  
   You have to be very careful otherwise you'll loose decidability.
  
  Do you have something concrete in mind or is this a more general
  advice?
  

I'm afraid, I think there's a real issue.
Here's the AT version of Example 15 from Understanding FDs via CHRs

  class D a
  class F a where
   type T a
  instance F [a] where
   type T [a] = [[a]]   
  instance (D (T a), F a) = D [a]
^^^
type function appears in type class

Type inference (i.e. constraint solving) for D [a] will not terminate.
Roughly,

  D [[a]]
--_instance  D (T [a]), F [a])
--_type function D [[a]], F [a]
and so on

Will this also happen if type functions appear in superclasses?
Let's see. Consider

 class C a
 class F a where
   type T a
 instance F [a] where
   type T [a] = [[[a]]]
 class C (T a) = D a
 ^
type function appears in superclass context
 instance D [a] = C [[a]] -- satisfies Ross Paterson's Termination Conditions

Consider

  D [a]
--_superclassC (T [a]), D [a]
--_type function C [[[a]]], D [a]
--_instance  D [[a]], D [a]
and so on


My point:

- The type functions are obviously terminating, e.g.
  type T [a] = [[a]] clearly terminates.
- It's the devious interaction between instances/superclasss
  and type function which causes the type class program
  not to terminate.


Is there a possible fix? Here's a guess.

For each type definition in the AT case

type T t1 = t2

(or improvement rule in the FD case

rule T1 t1 a == a=t2

BTW, any sufficient restriction which applies to the FD
case can be lifted to the AT case and vice versa!)

we demand that the number of constructors in t2
is strictly smaller than the in t1
(plus some of the other usual definitions).
Then,

type T [a] = [[a]]

although terminating, is not legal anymore.

Then, there might be some hope to recover termination
(I've briefly sketched a proof and termination may
indeed hold but I'm not 100% convinced yet).

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


Re: [Haskell-cafe] Re: Unexpected results with simple IO

2006-02-20 Thread Emil Axelsson
Unfortunately, I don't know how to make the arrow keys work in rxvt. I'm not the 
right person to ask about such things...

I don't think it's possible (unless GHC is built for Cygwin, or something).
Does anybody else know?

I use an alias

  alias ghciW='cmd /c start ghci'

That way I can start GHCi in a new DOS window from rxvt. I usually want two 
windows anyway -- one for the interactive session and one to compile other modules.


/ Emil



Maurício skrev:
  I'm also using GHC 6.4.1 and rxvt v2.7.10. The problem does occur in 
compiled code, but everything is OK in ghci!

  hFlush stdout did solve the problem, as expected.
  I've just started using rxvt. If you have tips on how to make ghci 
work well with rxvt, please share them with me (for instance, how to set 
the top arrow to repeat the last line, instead of moving the cursor one 
live above. I don't understand very well how those applications handle 
keyboard).


  Best,
  Maurício

Emil Axelsson wrote:

What version of GHC are you using?
Your code works for me in rxvt in Cygwin, with GHC 6.4.1. But I 
remember having that same problem earlier (in some earlier GHC 
version, so it may be fixed by now).


The solution was to run hFlush after each putStr, like so:

  import System.IO (hFlush, stdout)

  do putStr ...
 hHlush stdout
 ...

If I remember correctly, the problem only occurred in GHCi and Hugs -- 
not when compiling the code.


/ Emil



Maurício skrev:

  You're right... I was running the example in rxvt, in cygwin. Now I 
tried in Windows command shell and it works.


  Thanks,
  Maurício

Cale Gibbard wrote:


That doesn't happen for me at all, it works just fine. Maybe it's
something wrong with your terminal? You could possibly try playing
with the buffering settings on stdout, using hSetBuffering in
System.IO.

 - Cale

On 17/02/06, Maurício [EMAIL PROTECTED] wrote:


  Dear Haskell users,

  I have a problem using IO. The small test program below asks the 
user

to guess from a list of random numbers between 1 and 10. Everything
works well excepts for one problem: all the messages (Guess a
number..., Right... and Wrong...) are printed after the program
finishes, i.e., I have to use it blind. I'm afraid I misunderstand
something important about lazyness or monads... What am I doing wrong?

  Thanks,
  Maurício

module Main where
import Random

main = do
   r_gen - getStdGen --random generator
   let r_list = (randomRs (1,10) r_gen) --random list
   guess_loop (r_list)

guess_loop (r:r_others) = do
   putStrLn Guess a number between 1 and 10:
   n - readLn
   if n==r
  then do
 putStrLn Right! :)
 return ()
  else do
 putStrLn Wrong... :(
 guess_loop r_others

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



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


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

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