Re: [Haskell-cafe] Why does sleep not work?

2009-02-10 Thread George Pollard
I can confirm this behaviour, on:

Linux 2.6.27-11-generic #1 SMP i686 GNU/Linux

Difference in the RTS between non-working and working:
(RTS way, rts_thr)
(RTS way, rts)

- George


signature.asc
Description: This is a digitally signed message part
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Haddock Markup

2009-02-10 Thread Wolfgang Jeltsch
Am Dienstag, 10. Februar 2009 02:56 schrieben Sie:
 On 10 Feb 2009, at 1:19 am, Wolfgang Jeltsch wrote:
  This is only true if your destination format is PDF, DVI or PS. For
  a webpage, you’ll need MathML in the end and TeX is not so good in
  producing MathML, I suppose.

 Hmm.  I find designed-for-HTML documentation horrible.

I did *not* want to argue pro “designed-for-HTML”. I wanted to argue 
contra “designed-for-PDF” and pro “designed-for-any-output-format”.

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


Re: [Haskell-cafe] Haskell and Java interaction

2009-02-10 Thread Wolfgang Jeltsch
Am Montag, 9. Februar 2009 22:58 schrieb Robert Greayer:
 I'm sure this isn't the solution you are looking for, but when I had to do
 something similar (integrate an Eclipse plugin to Haskell code) the
 simplest approach I found was to simply invoke the Haskell in a separate
 process, binding the stdin/stdout of the Haskell process to Java
 output/input streams.  Perhaps low-tech, but has worked well for me.

For communication between Haskell software and Eclipse, there is also Cohatoe 
(http://eclipsefp.sourceforge.net/cohatoe/index.html). Interally, it works 
similar to what you described, as far as I know.

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


Re: [Haskell-cafe] Painting logs to get a coloured tree

2009-02-10 Thread Joachim Breitner
Hi,

Am Montag, den 09.02.2009, 16:41 -0700 schrieb Luke Palmer:
 2009/2/9 Joachim Breitner m...@joachim-breitner.de
 Now while this works, and while ST is still somewhat pure, I'm
 wondering
 if there is no better way of expressing This piece of
 information came
 from the point in a data structure, so something else can be
 put here
 easily.
 
 You might want to look into zippers:
 http://haskell.org/haskellwiki/Zipper

I thought about Zippers, but I understand that they improve _navigating_
in a Tree-like structure, or to refrence _one_ position in a tree.

But if I would deconstruct my tree to the list of _all_ locations, with
 type Loc a = (Tree a, Cxt a)
and then run my algorithm that returns [(Loc a, Info)], it’s still not
clear to me how I can combine all of these locations to get back my
original Tree, annotated with the Info returned.

Thanks nevertheless,
Joachim


-- 
Joachim nomeata Breitner
  mail: m...@joachim-breitner.de | ICQ# 74513189 | GPG-Key: 4743206C
  JID: nome...@joachim-breitner.de | http://www.joachim-breitner.de/
  Debian Developer: nome...@debian.org


signature.asc
Description: Dies ist ein digital signierter Nachrichtenteil
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Painting logs to get a coloured tree

2009-02-10 Thread minh thu
2009/2/10 Joachim Breitner m...@joachim-breitner.de:
 Hi,

 Am Montag, den 09.02.2009, 16:41 -0700 schrieb Luke Palmer:
 2009/2/9 Joachim Breitner m...@joachim-breitner.de
 Now while this works, and while ST is still somewhat pure, I'm
 wondering
 if there is no better way of expressing This piece of
 information came
 from the point in a data structure, so something else can be
 put here
 easily.

 You might want to look into zippers:
 http://haskell.org/haskellwiki/Zipper

 I thought about Zippers, but I understand that they improve _navigating_
 in a Tree-like structure, or to refrence _one_ position in a tree.

 But if I would deconstruct my tree to the list of _all_ locations, with
 type Loc a = (Tree a, Cxt a)
 and then run my algorithm that returns [(Loc a, Info)], it's still not
 clear to me how I can combine all of these locations to get back my
 original Tree, annotated with the Info returned.

I guess I just repeat your last praragraph of your original mail but it seems
to me you can mapAccump some 'names' on the tree, process an
association list (or an IntMap) of the (name,log) then map the three
again using the result.
In spirits, it's the same thing than the STRef solution but it seems
cleaner to me.

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


Re: [Haskell-cafe] Painting logs to get a coloured tree

2009-02-10 Thread minh thu
2009/2/10 minh thu not...@gmail.com:
 2009/2/10 Joachim Breitner m...@joachim-breitner.de:
 Hi,

 Am Montag, den 09.02.2009, 16:41 -0700 schrieb Luke Palmer:
 2009/2/9 Joachim Breitner m...@joachim-breitner.de
 Now while this works, and while ST is still somewhat pure, I'm
 wondering
 if there is no better way of expressing This piece of
 information came
 from the point in a data structure, so something else can be
 put here
 easily.

 You might want to look into zippers:
 http://haskell.org/haskellwiki/Zipper

 I thought about Zippers, but I understand that they improve _navigating_
 in a Tree-like structure, or to refrence _one_ position in a tree.

 But if I would deconstruct my tree to the list of _all_ locations, with
 type Loc a = (Tree a, Cxt a)
 and then run my algorithm that returns [(Loc a, Info)], it's still not
 clear to me how I can combine all of these locations to get back my
 original Tree, annotated with the Info returned.

 I guess I just repeat your last praragraph of your original mail but it seems
 to me you can mapAccump some 'names' on the tree, process an
 association list (or an IntMap) of the (name,log) then map the three
 again using the result.
 In spirits, it's the same thing than the STRef solution but it seems
 cleaner to me.

I forgot to mention you can try to tie the knot too, using the result
of the processing in the first mapping (and then you don't need the
second one)...
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] Painting logs to get a coloured tree

2009-02-10 Thread oleg

If I understand you correctly, the problem is to annotate an already
constructed tree with arbitrary pieces of new data -- hopefully
without reconstructing the tree. Perhaps the approach used in the
FLOLAC type-checkers would be helpful. The `tree' was an expression in
lambda-calculus to type check. The new annotations are the
reconstructed types, of each node in the tree (of each
sub-expression). I wanted to annotate each sub-expression with its
reconstructed type -- without re-defining the data type of expressions
or rebuilding the tree. The expression should stay as it was, I merely
want to associate, after the fact, additional pieces of data with each
node. I also wanted the code to be pure and avoid STRefs let alone
StableNames and any IO.  Here are the files in question:

http://okmij.org/ftp/Computation/FLOLAC/TEvalNC.hs
http://okmij.org/ftp/Computation/FLOLAC/TEvalNR.hs

TEvalNC.hs is the ordinary type checker for the simply-typed lambda
calculus with constants and the fix-point. The type reconstructor
(aka, non-standard, abstract evaluator) has this type
teval :: TEnv - Term - Typ
Given the type environment and a term, it returns its inferred type
(or reports an error).

The file TEvalNR.hs returns not only the reconstructed type of the
term but also the types of all the subterms. The latter data are
returned in a `virtual' typed AST -- virtual because the original AST
is not modified and the inferred types are attached to AST nodes,
well, virtually. Generally speaking, after a simple modification teval
could be made total: it would return reconstructed types of the
subterms even if the entire term is ill-typed. That modification was
one of the exercises. The intention was to model OCaml -- which, given
a special flag, can dump the inferred types of all sub-expressions,
even if the overall type checking failed. In Emacs and vi, one can
highlight an expression or variable and see its inferred type. If the
type checking failed, one can still explore what the type checker did
manage to infer.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Painting logs to get a coloured tree

2009-02-10 Thread Joachim Breitner
Hi,

Am Dienstag, den 10.02.2009, 10:05 +0100 schrieb minh thu:
 I forgot to mention you can try to tie the knot too, using the result
 of the processing in the first mapping (and then you don't need the
 second one)...

could you elaborate who to tie that particular knot? I unfortunately, I
don’t see it.

Thanks,
Joachim

-- 
Joachim nomeata Breitner
  mail: m...@joachim-breitner.de | ICQ# 74513189 | GPG-Key: 4743206C
  JID: nome...@joachim-breitner.de | http://www.joachim-breitner.de/
  Debian Developer: nome...@debian.org


signature.asc
Description: Dies ist ein digital signierter Nachrichtenteil
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] Re: Painting logs to get a coloured tree

2009-02-10 Thread Heinrich Apfelmus
Joachim Breitner wrote:
 
 Assume you have a tree (and you can think of a real tree here), defined
 by something like this:
 
 data Tree a = Bud | Branch a Double Tree Tree
 -- | ` Lenght of this branch
 -- ` General storage field for additional information
 
 Now, I have a nice algorithm that calulates something for each branch,
 but it only works on lists of branches, so I have to cut them apart
 first, remembering their position in space, and then work on these,
 well, logs.
 
 data Point = Point Double Double
 data Log = Log Point Point
 type Info = ...
 noInfo :: Info
 
 cutTreeApart :: Tree a - [(Log, a)]
 someAlgorithm :: [(Log,a)] - [(a, Info)]
 
 Conveniently, the algorithm allows me to tag the logs with something, to
 be able to keep track at least somewhat of the logs.

 [...]
 
 Some ideas where numbering the Nodes and then using this number as the
 tag on the log, but this is not much different from using STRefs, it
 seems.

Yes, tagging the logs with their position in the tree isn't really
different from using STRefs. There are many options for representing
positions (depth/breath first numbers; paths like [L,R,L,...] etc.) but
in the end, it boils down to the same thing.

Here's an example with with numbers

annotate tree =
  thread tree (\(x:xs) - (x,xs)) . map snd
. sort (comparing fst)
. someAlgorithm . cutTreeApart
. thread tree (\n - (n, succ n)) $ (0 :: Int)
where
thread tree f x = evalState (mapM (const $ State f) tree) x


However, I would be surprised if  someAlgorithm  could not be formulated
directly on the tree or at least satisfies a few invariants like for example

map fst . someAlgorithm = map snd

Also, how does  cutTreeApart  arrange the list? The idea is that most of
the tree structure survives in the list and can be reconstructed.


Regards,
apfelmus

-- 
http://apfelmus.nfshost.com

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


Re: [Haskell-cafe] Haddock Markup

2009-02-10 Thread Henning Thielemann
Wolfgang Jeltsch schrieb:

 This reminds me of an idea which I had some time ago. The idea is to write 
 all 
 your documentation in Template Haskell, possibly using quasiquoting to 
 support Haddock-like syntax. Then you could write math as ordinary Haskell 
 expressions and embed these expressions into your documentation expressions. 
 This would make the documentation language very extensible since you could 
 always write your own extensions in the form of some Haskell code fragments 
 or libraries.

If Template Haskell is capable of such processing that we be great since
we wouldn't need to develop a new tool, but can concentrate on writing
the transformations to TeX, MathML and so on.

And if someone wants to include chemical formulas he may write
appropriate transformations himself, upload them to Hackage, and cabal
will be able to install them when needed. Everything becomes scalable,
extensible, flexible and everything becomes great. Even versioning
conflicts will become possible for documentation generation. :-)

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


[Haskell-cafe] Darcs 2.2.0 diff on Windows

2009-02-10 Thread Peter Verswyvelen
When using this inside the Windows command prompt (CMD.EXE) I get
darcs: diff: runInteractiveProcess: does not exist (No such file or
directory)

It works fine under MSYS.

Also when using --diff-command to launch a GUI diff tool, Darcs does not
seem to copy any changes the GUI tool did to the new-program.

Is this intended behavior?
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] Re: Haddock Markup

2009-02-10 Thread Henning Thielemann
Heinrich Apfelmus schrieb:
 Henning Thielemann wrote:
 I want for long to write math formulas in a paper in Haskell. Actually,
 lhs2TeX can do such transformations but it is quite limited in handling
 of parentheses and does not support more complicated transformations
 (transforming prefix notation in infix notation or vice versa with
 minimal parentheses).

 I would like to write
   sumFor [0..n] (\i - i^2)
 (with sumFor xs f = sum $ map f xs)
 which is rendered as
   \sum_{i=0}^{n} i^2
 or
   integrate 1000 (a,b) (\t - f t)
 to be rendered as
   \int_a^b f(t) \dif t
 
 Neat idea! Can't you do implement this as a DSL?
 
 sumFor x xs f =
\sum_{ ++ x ++ = ++ head xs ++ }^{ ++ last xs ++ } 
++ f x


My original idea was to use the formulas in papers both for typesetting
and for unit testing. Thus, when you state that a function fulfills a
law, that it can be automatically tested by QuickCheck, that this at
least true for some instances.
The same would be useful for Haddock documentation. I remember that
someone proposed to permit Haddock to expose the implementation of some
functions as examples or as unit-tests/laws. Now we could extend this
idea to allow Haddock not only to expose the implementation of
functions, but also to tell Haddock how to render its implementation.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] Additonal types for Foreign.C.Types

2009-02-10 Thread Maurí­cio

Hi,

After reading an ISO draft for standard C, I found
a few types that could be usefull when binding to
libraries (these are from stdint.h):

int8_t, uint8_t, int16_t, uint16_t, int32_t,
uint32_t, int64_t, uint64_t

What about if they were included in the next version
of GHC Foreign.C.Types module? For instance, as:

CInt8, CUInt8, CInt16 etc.

Some libraries (e.g. sqlite) define function parameters
that are supposed to always have a given size (e.g.,
sqlite defines sqlite3_int64). In order to have a
portable binding to those libraries, it would be nice
to have types in Haskell that also offer that guarantee.

There are also a few other nice types, although I'm not
sure they belong to standard modules. If they did,
however, they could make life easier for those people
writing higher level Haskell modules after standard
C functions:

complex, float complex, double complex (from complex.h)
are used in functions like ccos, csin, cexp, csqrt etc.

struct lconv (from locale.h)

struct tm (from time.h)

From wchar.h and wctype.h: mbstate_t, wint_t,
wctrans_t, wctype_t.

Do you think I could open a ticket for GHC proposing
that?

Best,
Maurício

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


Re: [Haskell-cafe] Haskell Fest

2009-02-10 Thread Gregg Reynolds
Just be careful.  The judge uses lazy evaluation, so if you get arrested you
might spend 20 years in the holding pen.  On the bright side, you can pay
for stuff whenever you feel like it.

2009/2/9 Lyle Kopnicky li...@qseep.net

 Looks like a lot of fun!

 http://www.haskellchamber.com/page6.html

 ___
 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] evaluation semantics of bind

2009-02-10 Thread Alberto G. Corona
forwarded:

Yes!  if no state is passed, the optimization makes sense and the term is
not executed, like any lazy evaluation. For example, I used the debugger
(that is, without optimizations) to verify it with the Maybe monad:
op x= x+x

print $ Just (op 1) = \y- return (Just 2)

does not evaluate  op 1

but

print $ Just (op 1) = \y- return y

does execute it.



The trace of the first:

[1 of 1] Compiling Main ( test.hs, interpreted )
Ok, modules loaded: Main.
*Main :set stop :list
*Main :step main
Stopped at test.hs:4:6-43
_result :: IO () = _
3
4  main= print $ Just (op 1) = \y- return  2
 ^^
5
[test.hs:4:6-43] *Main :step
Stopped at test.hs:4:14-43
_result :: Maybe Integer = _
3
4  main= print $ Just (op 1) = \y- return  2
^^
5
[test.hs:4:14-43] *Main :step
Stopped at test.hs:4:14-24
_result :: Maybe Integer = _
3
4  main= print $ Just (op 1) = \y- return  2
  ^^^
5
[test.hs:4:14-24] *Main :step
Stopped at test.hs:4:35-43
_result :: Maybe Integer = _
3
4  main= print $ Just (op 1) = \y- return  2
   ^
5
[test.hs:4:35-43] *Main :step
Just 2


But in the second case op is executed:


*Main :step main
Stopped at test.hs:4:6-43
_result :: IO () = _
3
4  main= print $ Just (op 1) = \y- return  y
   ^^
5
[test.hs:4:6-43] *Main :step
Stopped at test.hs:4:14-43
_result :: Maybe Integer = _
3
4  main= print $ Just (op 1) = \y- return  y
   ^^
5
[test.hs:4:14-43] *Main :step
Stopped at test.hs:4:14-24
_result :: Maybe Integer = _
3
4  main= print $ Just (op 1) = \y- return  y
  ^^^
5
[test.hs:4:14-24] *Main :step
Stopped at test.hs:4:35-43
_result :: Maybe Integer = _
y :: Integer = _
3
4  main= print $ Just (op 1) = \y- return  y
   ^
5
[test.hs:4:35-43] *Main :step
Just Stopped at test.hs:4:20-23
_result :: Integer = _
3
4  main= print $ Just (op 1) = \y- return  y
  
5
[test.hs:4:20-23] *Main :step
Stopped at test.hs:6:0-8
_result :: Integer = _
5
6  op x= x+x
^
7
[test.hs:6:0-8] *Main :step
Stopped at test.hs:6:6-8
_result :: Integer = _
x :: Integer = _
5
6  op x= x+x
  ^^^
7
[test.hs:6:6-8] *Main :step
Just 2




2009/2/5 Gregg Reynolds d...@mobileink.com- Ocultar texto citado -


 On Thu, Feb 5, 2009 at 9:27 AM, Bulat Ziganshin bulat.zigans...@gmail.com
wrote:

 Hello Gregg,

 Thursday, February 5, 2009, 6:20:06 PM, you wrote:

  An optimizer can see that the result of the first getChar is
  discarded and replace the entire expression with one getChar without
  changing the formal semantics.

 this is prohibited by using pseudo-value of type RealWorld which is
 passed through entire action stream. actually, order of execution is
 controlled by dependencies on this values

 http://haskell.org/haskellwiki/IO_inside

 Thanks.  I actually read that a few weeks ago and forgot all about it.  So
the gist is that type IO has special magic semantics.  Formal, but hidden.
Which means monad semantics are built in to the language, at least for that
type.  The Haskell Report doesn't seem to say anything about this, which
seems odd.

 But then for non-IO monads, the optimization would be allowed, no?  Of
course; only the IO monad has external world behavior.

 Thanks,

 gregg

 ___
 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] evaluation semantics of bind

2009-02-10 Thread Gregg Reynolds
On Mon, Feb 9, 2009 at 10:17 PM, Richard O'Keefe o...@cs.otago.ac.nz wrote:


 On 10 Feb 2009, at 5:07 pm, Gregg Reynolds wrote:

 Thanks.  I see the error of my ways.  So, IO expressions must be evaluated
 if they are in the chain leading to main.



 We need some standard terminology to distinguish
 between *evaluating* an expression and *performing*
 the result of an expression of type IO something.


Indeed.  Wrote a blog article about this proposing a semiotic approach:
http://syntax.wikidot.com/blog:4


 An IO expression that is passed to a function at a
 strict position must be evaluated whether the result
 is performed or not.

 An IO expression whose result will be performed must
 be evaluated before that performance can take place.


Is the result of evaluation a thunk/suspension/closer?



 (Dash it, this really is getting us into White Knight land.)


What's White Knight land?
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Painting logs to get a coloured tree

2009-02-10 Thread minh thu
2009/2/10 Joachim Breitner m...@joachim-breitner.de:
 Hi,

 Am Dienstag, den 10.02.2009, 10:05 +0100 schrieb minh thu:
 I forgot to mention you can try to tie the knot too, using the result
 of the processing in the first mapping (and then you don't need the
 second one)...

 could you elaborate who to tie that particular knot? I unfortunately, I
 don't see it.

 Thanks,
 Joachim

I can post some code later but here is the idea.

You conceptually label the tree with Int's. If you go through the tree
visiting the node in a specific order, you don't have to actually
label it since the label of a node is just its position in the
parcour.

The goal is to map the tree with some data drawn from an
association-list. Again, a straight-forward association is just a
plain list indexed by Int's.

Thus, when visiting the nodes of the tree, if you have the
above-mentionned list, you can use that information when doing the
mapping, replacing the data in the node by the data in the list (where
the index used for the list is the 'label' of the node).

The list is the result of going to the tree too, thus tying the knot.
To construct it, you simply make some kind of mapAccum, using [] as
the starting value and : (cons) to accumulate the data.

To understand this intuitiveley, just note that a three can be
flattened into a list. Thus if you want to process the
'association-list' which is represented by a plain list, just zipWith
it [0..].

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


Re: [Haskell-cafe] evaluation semantics of bind

2009-02-10 Thread Lennart Augustsson
The result of an evaluation is always in WHNF (weak head normal form).
So if it's a function, it's been evaluated to \ x - ..., but no
evaluation under lambda.
Similarely, if it's a data type it has been evaluated so the outermost
form is a constructor, but no evaluation inside the constructor.

The terms thunk/suspension/closure usually refer to implementation
rather than semantics.
But in terms of an implementation, the answer is no.  After evaluation
you will have none of those as the outmost thing.

  -- Lennart

2009/2/10 Gregg Reynolds d...@mobileink.com:
 Is the result of evaluation a thunk/suspension/closer?
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] Re: How outdated is Hugs?

2009-02-10 Thread Simon Marlow

John Goerzen wrote:


Just to close -- I will point out that ghci doesn't work on many
platforms that Hugs does (though ghc does).  Hugs is the only
interpreter on some of these platforms.


I didn't see anyone follow up to this so I'll just mention that nowadays 
GHCi works wherever GHC works, since 6.10.1.  Actually I think most 
platforms worked with 6.8.1, but 6.10.1 added libffi which meant that GHCi 
also gets working FFI support on any platform supported by libffi, which is 
most of them.


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


[Haskell-cafe] Re: [Haskell] Google Summer of Code 2009

2009-02-10 Thread Jamie
What I would like to see is H.264 video codec in Haskell.  H.264/MPEG-4 is 
getting very popular nowadays and it would be great to have encoder and 
decoder in haskell.  Can use x264 (encoder) and ffmpeg (en/de coder)

as a base to start with.

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


Re: [Haskell-cafe] Painting logs to get a coloured tree

2009-02-10 Thread minh thu
2009/2/10 minh thu not...@gmail.com:
 2009/2/10 Joachim Breitner m...@joachim-breitner.de:
 Hi,

 Am Dienstag, den 10.02.2009, 10:05 +0100 schrieb minh thu:
 I forgot to mention you can try to tie the knot too, using the result
 of the processing in the first mapping (and then you don't need the
 second one)...

 could you elaborate who to tie that particular knot? I unfortunately, I
 don't see it.

 Thanks,
 Joachim

 I can post some code later but here is the idea.

 You conceptually label the tree with Int's. If you go through the tree
 visiting the node in a specific order, you don't have to actually
 label it since the label of a node is just its position in the
 parcour.

 The goal is to map the tree with some data drawn from an
 association-list. Again, a straight-forward association is just a
 plain list indexed by Int's.

 Thus, when visiting the nodes of the tree, if you have the
 above-mentionned list, you can use that information when doing the
 mapping, replacing the data in the node by the data in the list (where
 the index used for the list is the 'label' of the node).

 The list is the result of going to the tree too, thus tying the knot.
 To construct it, you simply make some kind of mapAccum, using [] as
 the starting value and : (cons) to accumulate the data.

 To understand this intuitiveley, just note that a three can be
 flattened into a list. Thus if you want to process the
 'association-list' which is represented by a plain list, just zipWith
 it [0..].

So here some code, notice the process function which work on a list
of data (drawn from the tree). As said above, it can make use of a [0..]
list if the 'tags' or 'names' are needed for processing.

Is it applicable to your problem ?

--

module Log where

data Tree a = Bud | Branch a (Tree a) (Tree a) -- no length here
  deriving Show

mapAcc f acc Bud = (acc, Bud)
mapAcc f acc (Branch a l r) = (acc2, Branch a' l' r')
  where (acc0,a') = f acc a
(acc1,l') = mapAcc f acc0 l
(acc2,r') = mapAcc f acc1 r

tree0 = Bud
tree1 = Branch a Bud Bud
tree2 = Branch r (Branch s Bud Bud) Bud
tree3 = Branch x (Branch y tree1 tree2) Bud

process :: [String] - [String]
process l = zipWith (\a b - a ++ show b) l [0..]

tie tree = tree'
  where ((acc,q),tree') = mapAcc (\(acc,p) a - ((acc + 1,a:p),r !!
acc)) (0,[]) tree
r = process (reverse q)
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Re: [Haskell] Google Summer of Code 2009

2009-02-10 Thread David Leimbach
SNMP would be really cool.  So far the best implementation of SNMP I've had
the pleasure to work with is part of the Erlang OTP distribution, and being
able to compete with Erlang on that level would be really nice.

On Tue, Feb 10, 2009 at 7:18 AM, Jamie hask...@datakids.org wrote:

 What I would like to see is H.264 video codec in Haskell.  H.264/MPEG-4 is
 getting very popular nowadays and it would be great to have encoder and
 decoder in haskell.  Can use x264 (encoder) and ffmpeg (en/de coder)
 as a base to start with.

Jamie
 ___
 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] Re: [Haskell] Google Summer of Code 2009

2009-02-10 Thread Don Stewart
Malcolm.Wallace:
 Gentle Haskellers,
 
 The Google Summer of Code will be running again this year.  Once again,
 haskell.org has the opportunity to bid to become a mentoring
 organisation.  (Although, as always, there is no guarantee of
 acceptance.)
 
 If you have ideas for student projects that you think would benefit the
 Haskell community, now is the time to start discussing them on mailing
 lists of your choice.  We especially encourage students to communicate
 with the wider community: if you keep your ideas private, you have a
 much worse chance of acceptance than if you develop ideas in
 collaboration with those who will be your customers, end-users, or
 fellow-developers.  This is the open-source world!
 

And I'll just note that since December we've been running a proposal
submission site here, where you can vote and comment on ideas,

http://www.reddit.com/r/haskell_proposals/top/

A great place to suggest ideas!

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


Re: [Haskell-cafe] Additonal types for Foreign.C.Types

2009-02-10 Thread Ross Mellgren

I think you can use Data.Word and Data.Int types for this, that is.

Data.Word.Word16 == uint16_t, Data.Word.Word32 == uint32_t, etc.
Data.Int.Int16 = int16_t, Data.Int.Int32 = int32_t, etc.

There are Foreign.Storable.Storable instances for those.

-Ross

On Feb 10, 2009, at 6:32 AM, Maurí cio wrote:


Hi,

After reading an ISO draft for standard C, I found
a few types that could be usefull when binding to
libraries (these are from stdint.h):

int8_t, uint8_t, int16_t, uint16_t, int32_t,
uint32_t, int64_t, uint64_t

What about if they were included in the next version
of GHC Foreign.C.Types module? For instance, as:

CInt8, CUInt8, CInt16 etc.

Some libraries (e.g. sqlite) define function parameters
that are supposed to always have a given size (e.g.,
sqlite defines sqlite3_int64). In order to have a
portable binding to those libraries, it would be nice
to have types in Haskell that also offer that guarantee.

There are also a few other nice types, although I'm not
sure they belong to standard modules. If they did,
however, they could make life easier for those people
writing higher level Haskell modules after standard
C functions:

complex, float complex, double complex (from complex.h)
are used in functions like ccos, csin, cexp, csqrt etc.

struct lconv (from locale.h)

struct tm (from time.h)

From wchar.h and wctype.h: mbstate_t, wint_t,
wctrans_t, wctype_t.

Do you think I could open a ticket for GHC proposing
that?

Best,
Maurício

___
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] The Haskell re-branding exercise

2009-02-10 Thread Eelco Lempsink

On 7 feb 2009, at 22:40, Don Stewart wrote:

bulat.ziganshin:

Hello Don,

Saturday, February 7, 2009, 8:20:23 PM, you wrote:

We need a voting site set up. There was some progress prior to the  
end

of the year. Updates welcome!


i think that there are a lot of free voting/survey services  
available.

the last one i went through was LimeSurvey available for any SF
project and on separate site too

http://apps.sourceforge.net/trac/sitedocs/wiki/Hosted%20Apps
https://www.limeservice.com/



Before the new year's break, the progress we made towards deciding  
on a

voting process was,

   http://groups.google.com/group/fa.haskell/msg/5d0ad1a681b044c7

   Eelco implemented a demo condorcet voting system in HAppS.

He then asked for help with some decisions:

   * Limit voting, if so how?  Email confirmation, IP based, vote  
once,  once per day?

   * Maybe don't show the results until the contest is over?

Eelco, can we do simple email-based confirm to encourage people to  
vote
only once, and can we keep the results closed until the vote process  
is

over?


Yes, sure.  I'll try to make some time to finish the implementation,  
hopefully early next week.


In the mean time, if somebody wants to go ahead and implement it (and  
maybe your own favorite feature as well), feel free to fork from http://github.com/eelco/voting


The idea is that you only need to change the HTML to change the things  
that are voted upon.  It might be nice(r) to use JavaScript to load  
those things.  If you want to hack on it and have some questions  
please email me directly if you want a prompt response ;)


--
Regards,

Eelco Lempsink



PGP.sig
Description: This is a digitally signed message part
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] Asking the GHC garbage collector to run

2009-02-10 Thread Mads Lindstrøm
Hi all,

Is it possible to ask the GHC garbage collector to run ? Something like
a collectAllGarbage :: IO() call.


Greetings,

Mads Lindstrøm



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


Re: [Haskell-cafe] Asking the GHC garbage collector to run

2009-02-10 Thread Don Stewart
mads_lindstroem:
 Hi all,
 
 Is it possible to ask the GHC garbage collector to run ? Something like
 a collectAllGarbage :: IO() call.

System.Mem.performGC

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


Re: [Haskell-cafe] Why does sleep not work?

2009-02-10 Thread Corey O'Connor
The POSIX sleep function is defined as:
sleep() makes the current process sleep until seconds seconds have
elapsed or a signal arrives which is not ignored.

Sounds like a signal is arriving that is interrupting the sleep.

-Corey O'Connor



2009/2/9 John Ky newho...@gmail.com:
 Hi Peter,

 Source code:
 import System.IO
 import System.Posix

 main = do
   putStrLn Waiting for 5 seconds.
   sleep 5 -- doesn't sleep at all
   putStrLn Done.

 OS:
 Mac OS X 10.5

 Compile command:
 ghc --threaded testsleep.hs

 If I remove --threaded, then it does sleep.

 Thanks,

 -John

 On Tue, Feb 10, 2009 at 8:59 AM, Peter Verswyvelen bugf...@gmail.com
 wrote:

 Hi John,
 Which sleep are you using? From which module? Can you show the full source
 with import statements?
 Cheers,
 Peter
 2009/2/9 John Ky newho...@gmail.com

 Hi Haskell Cafe,

 I wrote very short program to sleep for 5 seconds compiled with the
 -threaded option in ghc on the Mac OS X 1.5.

 I am finding that using the sleep function doesn't sleep at all, whereas
 using threadDelay does:

 main = do
   putStrLn Waiting for 5 seconds.
   threadDelay 500 -- works
   putStrLn Done.

 main = do
   putStrLn Waiting for 5 seconds.
   sleep 5 -- doesn't sleep at all
   putStrLn Done.

 Anybody know what's happening?

 Thanks

 -John


 ___
 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] Re: Painting logs to get a coloured tree

2009-02-10 Thread Joachim Breitner
Hi,

Am Dienstag, den 10.02.2009, 11:59 +0100 schrieb Heinrich Apfelmus:
 However, I would be surprised if  someAlgorithm  could not be formulated
 directly on the tree or at least satisfies a few invariants like for example
 
 map fst . someAlgorithm = map snd
 
 Also, how does  cutTreeApart  arrange the list? The idea is that most of
 the tree structure survives in the list and can be reconstructed.

Probably not. My algorithm calculates the amount of light that shines
through the branches, and the amount of light cought by the branches
(seeing branches as approximations for leaves here :-)).

The algorithm works by taking the list of branches (represented by their
start and end point), projects them along the direction of light,
creates a list of start and endpoints, sorts them (to be able to sweep
the line somewhat efficiently) and adds the projections of all
intersections of branches. Then it iterates through the intervals on
this line, gets the list of branches that are hit by this interval,
sorts them by hights and adds, from top to bottom, the appropriate,
decreasing portion of the light that comes in this interval.

In this process, the branches are sorted around quite a bit, and I
assume it would be hard to preserve the structure.

If you want to see code (not sure though if you really want to see that
code :-)), it’s in 
http://git.nomeata.de/?p=L-seed.git;a=blob;f=src/Lseed/Geometry.hs
Lines 74-142.

Greetings,
Joachim

-- 
Joachim Breitner
  e-Mail: m...@joachim-breitner.de
  Homepage: http://www.joachim-breitner.de
  ICQ#: 74513189
  Jabber-ID: nome...@joachim-breitner.de


signature.asc
Description: Dies ist ein digital signierter Nachrichtenteil
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] Changing version numbering schemes for HackageDB packages?

2009-02-10 Thread Corey O'Connor
I released a new version of data-spacepart that resolved some of the
issues with the previous release. One issue I had was the previous
release used the version numbering scheme I use at work:
[date].[release] Which does not appear to work as well as the
traditional X.Y.Z release numbering scheme with Cabal. As part of the
new release I changed the version numbering scheme. An *obviously* bad
idea if I thought it through. Any [date].[release] style version
number is greater than a X.Y.Z version number until X gets rather
large.

So what to do? Continue using the [date].[release] version numbering
scheme? Or is there a way to coax HackageDB to ignore the old release?

EG:
The new release is:
http://hackage.haskell.org/cgi-bin/hackage-scripts/package/data-spacepart-0.1.1

The old release is:
http://hackage.haskell.org/cgi-bin/hackage-scripts/package/data-spacepart-20090126.0

The latest release according to HackageDB is:
http://hackage.haskell.org/cgi-bin/hackage-scripts/package/data-spacepart

Which points to the old release.

Cheers,
-Corey O'Connor
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Painting logs to get a coloured tree

2009-02-10 Thread Joachim Breitner
Hi,

Am Dienstag, den 10.02.2009, 16:36 +0100 schrieb minh thu:
 So here some code, notice the process function which work on a list
 of data (drawn from the tree). As said above, it can make use of a [0..]
 list if the 'tags' or 'names' are needed for processing.
 
 Is it applicable to your problem ?
 
 --
 
 module Log where
 
 data Tree a = Bud | Branch a (Tree a) (Tree a) -- no length here
   deriving Show
 
 mapAcc f acc Bud = (acc, Bud)
 mapAcc f acc (Branch a l r) = (acc2, Branch a' l' r')
   where (acc0,a') = f acc a
 (acc1,l') = mapAcc f acc0 l
 (acc2,r') = mapAcc f acc1 r
 
 tree0 = Bud
 tree1 = Branch a Bud Bud
 tree2 = Branch r (Branch s Bud Bud) Bud
 tree3 = Branch x (Branch y tree1 tree2) Bud
 
 process :: [String] - [String]
 process l = zipWith (\a b - a ++ show b) l [0..]
 
 tie tree = tree'
   where ((acc,q),tree') = mapAcc (\(acc,p) a - ((acc + 1,a:p),r !!
 acc)) (0,[]) tree
 r = process (reverse q)

thanks for your work. It doesn’t fit directly (if the process operation
reorders the elements of the list, it fails). But if I first number
them, and later sort them again, or use lookup instead of !!, it would
work. But the knot-tying (and thus the single traversal of the tree) is
a very neat idea.

Greetings,
Joachim



-- 
Joachim Breitner
  e-Mail: m...@joachim-breitner.de
  Homepage: http://www.joachim-breitner.de
  ICQ#: 74513189
  Jabber-ID: nome...@joachim-breitner.de


signature.asc
Description: Dies ist ein digital signierter Nachrichtenteil
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Why does sleep not work?

2009-02-10 Thread Thomas DuBuisson
Not to say the issue shouldn't be tracked down, but shouldn't a more
portable function be used anyway?

untested example:

maxBoundMicroSecInSec =(maxBound `div` 10^6)
threadDelaySec :: Int - IO ()
threadDelaySec s
| s  maxBoundMicroSecInSec = threadDelay (maxBoundMicroSecInSec *
10^6)  threadDelaySec (s - maxBoundMicroSecInSec)
| otherwise = threadDelay (s * 10^6)

On Tue, Feb 10, 2009 at 5:57 PM, Corey O'Connor coreyocon...@gmail.com wrote:
 The POSIX sleep function is defined as:
sleep() makes the current process sleep until seconds seconds have
 elapsed or a signal arrives which is not ignored.

 Sounds like a signal is arriving that is interrupting the sleep.

 -Corey O'Connor



 2009/2/9 John Ky newho...@gmail.com:
 Hi Peter,

 Source code:
 import System.IO
 import System.Posix

 main = do
   putStrLn Waiting for 5 seconds.
   sleep 5 -- doesn't sleep at all
   putStrLn Done.

 OS:
 Mac OS X 10.5

 Compile command:
 ghc --threaded testsleep.hs

 If I remove --threaded, then it does sleep.

 Thanks,

 -John

 On Tue, Feb 10, 2009 at 8:59 AM, Peter Verswyvelen bugf...@gmail.com
 wrote:

 Hi John,
 Which sleep are you using? From which module? Can you show the full source
 with import statements?
 Cheers,
 Peter
 2009/2/9 John Ky newho...@gmail.com

 Hi Haskell Cafe,

 I wrote very short program to sleep for 5 seconds compiled with the
 -threaded option in ghc on the Mac OS X 1.5.

 I am finding that using the sleep function doesn't sleep at all, whereas
 using threadDelay does:

 main = do
   putStrLn Waiting for 5 seconds.
   threadDelay 500 -- works
   putStrLn Done.

 main = do
   putStrLn Waiting for 5 seconds.
   sleep 5 -- doesn't sleep at all
   putStrLn Done.

 Anybody know what's happening?

 Thanks

 -John


 ___
 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


Re: [Haskell-cafe] Re: Additonal types for Foreign.C.Types

2009-02-10 Thread Ross Mellgren
The FFI spec says (at http://www.cse.unsw.edu.au/~chak/haskell/ffi/ffi/ffise3.html#x6-120003.2) 
:


The argument types at[i] produced by fatype must be marshallable  
foreign types; that is, each ati is either (1) a basic foreign type or  
(2) a type synonym or renamed datatype of a marshallable foreign type.  
Moreover, the result type rt produced by frtype must be a marshallable  
foreign result type; that is, it is either a marshallable foreign  
type, the type (), or a type matching Prelude.IO t, where t is a  
marshallable foreign type or ().


Earlier it defines the basic foreign types:

 The following types constitute the set of basic foreign types:

* Char, Int, Double, Float, and Bool as exported by the Haskell  
98 Prelude as well as
* Int8, Int16, Int32, Int64, Word8, Word16, Word32, Word64, Ptr  
a, FunPtr a, and StablePtr a, for any type a, as exported by Foreign  
(Section 5.1).


So, that list of types, or any type synonym.

-Ross


On Feb 10, 2009, at 3:56 PM, Maurí cio wrote:


Yes, I can. Thanks. Just forget my idea, with
this I can provide all those types in a library.

I'm confused. When is it possible to use a type
as a parameter to a foreign function call? My
first guess was that I had to provide an instance
for class Storable, but after I tried writing
a complex-like type that way GHC told me my type
was unaceptable. So I thought only types allowed
by the compiler (including forall a. Ptr a) could
be used that way.

What is the rule? I've read all of FFI report
and found nothing. Did I miss something? How can
I make a type of mine acceptable? Why are
Data.Int acceptable, and how could I know that?

Thanks,
Maurício


I think you can use Data.Word and Data.Int types for this, that is.
(...)



After reading an ISO draft for standard C, I found
a few types that could be usefull when binding to
libraries (these are from stdint.h):

int8_t, uint8_t, int16_t, uint16_t, int32_t,
uint32_t, int64_t, uint64_t

(...)


___
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] Changing version numbering schemes for HackageDB packages?

2009-02-10 Thread Roman Cheplyaka
* Corey O'Connor coreyocon...@gmail.com [2009-02-10 10:21:54-0800]
 I released a new version of data-spacepart that resolved some of the
 issues with the previous release. One issue I had was the previous
 release used the version numbering scheme I use at work:
 [date].[release] Which does not appear to work as well as the
 traditional X.Y.Z release numbering scheme with Cabal. As part of the
 new release I changed the version numbering scheme. An *obviously* bad
 idea if I thought it through. Any [date].[release] style version
 number is greater than a X.Y.Z version number until X gets rather
 large.
 
 So what to do? Continue using the [date].[release] version numbering
 scheme? Or is there a way to coax HackageDB to ignore the old release?

From haxr changelog:

Sun Feb 11 11:43:15 EET 2007  bj...@bringert.net
  * Changed haxr version number to 3000.0.0 to avoid ordering problems
with old date-based version numbers.

-- 
Roman I. Cheplyaka :: http://ro-che.info/
Don't let school get in the way of your education. - Mark Twain
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Re: [Haskell] Google Summer of Code 2009

2009-02-10 Thread Conrad Meyer
On Tuesday 10 February 2009 07:18:00 am Jamie wrote:
 What I would like to see is H.264 video codec in Haskell.  H.264/MPEG-4 is
 getting very popular nowadays and it would be great to have encoder and
 decoder in haskell.  Can use x264 (encoder) and ffmpeg (en/de coder)
 as a base to start with.

   Jamie

GSoC is run out of the US, where software patents would prevent a student from 
taking this task.

-- 
Conrad Meyer kon...@tylerc.org

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


Re: [Haskell-cafe] Re: How outdated is Hugs?

2009-02-10 Thread Conrad Meyer
On Tuesday 10 February 2009 06:41:54 am Simon Marlow wrote:
 John Goerzen wrote:
  Just to close -- I will point out that ghci doesn't work on many
  platforms that Hugs does (though ghc does).  Hugs is the only
  interpreter on some of these platforms.

 I didn't see anyone follow up to this so I'll just mention that nowadays
 GHCi works wherever GHC works, since 6.10.1.  Actually I think most
 platforms worked with 6.8.1, but 6.10.1 added libffi which meant that GHCi
 also gets working FFI support on any platform supported by libffi, which is
 most of them.

 Cheers,
   Simon

Counterexample: GHC 6.10.1 works on linux/ppc, GHCi 6.10.1 does not. (6.8.3 
worked, though.)

Regards,
-- 
Conrad Meyer kon...@tylerc.org

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


Re: [Haskell-cafe] Why does sleep not work?

2009-02-10 Thread Manlio Perillo

John Ky ha scritto:

Hi Haskell Cafe,

I wrote very short program to sleep for 5 seconds compiled with the 
-threaded option in ghc on the Mac OS X 1.5.


I am finding that using the sleep function doesn't sleep at all, whereas 
using threadDelay does:


[...]
main = do
  putStrLn Waiting for 5 seconds.
  sleep 5 -- doesn't sleep at all
  putStrLn Done.

Anybody know what's happening?



Here is a syscal trace, on Linux:
http://hpaste.org/fastcgi/hpaste.fcgi/view?id=1332#a1332


The interesting part:
write(1, Waiting for 5 seconds.\n..., 23) = 23
rt_sigprocmask(SIG_BLOCK, [CHLD], [], 8) = 0
rt_sigaction(SIGCHLD, NULL, {SIG_DFL}, 8) = 0
rt_sigprocmask(SIG_SETMASK, [], NULL, 8) = 0
nanosleep({5, 0}, 0xbf85f5cc)   = ? ERESTART_RESTARTBLOCK (To be 
restarted)

--- SIGVTALRM (Virtual timer expired) @ 0 (0) ---
sigreturn() = ? (mask now [])
write(1, 5\n..., 2)   = 2


So, it seems nanosleep get interruped by a signal.



Manlio Perillo

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


[Haskell-cafe] Re: Additonal types for Foreign.C.Types

2009-02-10 Thread Maurí­cio
The FFI spec says (at 
http://www.cse.unsw.edu.au/~chak/haskell/ffi/ffi/ffise3.html#x6-120003.2):




There I see:

---
Foreign types are produced according to the following grammar:

ftype  -- frtype
   |   fatype - ftype
frtype -- fatype
   |   ()
fatype -- qtycon atype[1] ... atype[k] (k  0)
---

I can't understand the qtycon atype[1]... line. I did
search haskell 98 report syntax reference, and saw how
qtycon and tycon are defined, but I could not understand
how they are used here.

Thanks for your help,
Maurício

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


Re: [Haskell-cafe] Why does sleep not work?

2009-02-10 Thread George Pollard
On Tue, 2009-02-10 at 09:57 -0800, Corey O'Connor wrote:
 The POSIX sleep function is defined as:
 sleep() makes the current process sleep until seconds seconds have
 elapsed or a signal arrives which is not ignored.
 
 Sounds like a signal is arriving that is interrupting the sleep.
 
 -Corey O'Connor

I tested this when testing the original code; sleep reports that the
signal received is 5 (SIGTRAP). However, the following code does not
work:


 import System.Posix
 
 main = do
   putStrLn Waiting for 5 seconds.
   print sigTRAP
   blockSignals $ addSignal sigTRAP emptySignalSet
   signal - sleep 5
   print signal
   putStrLn Done.

This, on the other (strange) hand, does:

 import System.Posix
 
 main = do
   putStrLn Waiting for 5 seconds.
   blockSignals fullSignalSet 
   signal - sleep 5
   print signal
   putStrLn Done.

- George


signature.asc
Description: This is a digitally signed message part
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Re: Additonal types for Foreign.C.Types

2009-02-10 Thread Ross Mellgren
fatype is the function argument type. atype[i] are type arguments.  
qtycon is a qualified (e.g. possibly with module prefix) type  
constructor, e.g. Just


So, for example if you have:

foreign import ccall string.h strlen cstrlen :: Ptr CChar - IO CSize

fatype - ftype :: ftype
  fatype :: fatype
qtycon Ptr
atype1 CChar
  fatype :: frtype
qtycon IO
atype1 CSize

(I struggled a bit with finding a good way to communicate the  
productions chosen, so bear with me)


Make sense?

-Ross


On Feb 10, 2009, at 6:13 PM, Maurí cio wrote:

The FFI spec says (at http://www.cse.unsw.edu.au/~chak/haskell/ffi/ffi/ffise3.html#x6-120003.2) 
:


There I see:

---
Foreign types are produced according to the following grammar:

ftype  -- frtype
  |   fatype - ftype
frtype -- fatype
  |   ()
fatype -- qtycon atype[1] ... atype[k] (k  0)
---

I can't understand the qtycon atype[1]... line. I did
search haskell 98 report syntax reference, and saw how
qtycon and tycon are defined, but I could not understand
how they are used here.

Thanks for your help,
Maurício

___
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] Why does sleep not work?

2009-02-10 Thread George Pollard
On Wed, 2009-02-11 at 00:05 +0100, Manlio Perillo wrote:
 John Ky ha scritto:
  Hi Haskell Cafe,
  
  I wrote very short program to sleep for 5 seconds compiled with the 
  -threaded option in ghc on the Mac OS X 1.5.
  
  I am finding that using the sleep function doesn't sleep at all, whereas 
  using threadDelay does:
  
  [...]
  main = do
putStrLn Waiting for 5 seconds.
sleep 5 -- doesn't sleep at all
putStrLn Done.
  
  Anybody know what's happening?
  
 
 Here is a syscal trace, on Linux:
 http://hpaste.org/fastcgi/hpaste.fcgi/view?id=1332#a1332
 
 
 The interesting part:
 write(1, Waiting for 5 seconds.\n..., 23) = 23
 rt_sigprocmask(SIG_BLOCK, [CHLD], [], 8) = 0
 rt_sigaction(SIGCHLD, NULL, {SIG_DFL}, 8) = 0
 rt_sigprocmask(SIG_SETMASK, [], NULL, 8) = 0
 nanosleep({5, 0}, 0xbf85f5cc)   = ? ERESTART_RESTARTBLOCK (To be 
 restarted)
 --- SIGVTALRM (Virtual timer expired) @ 0 (0) ---
 sigreturn() = ? (mask now [])
 write(1, 5\n..., 2)   = 2
 
 
 So, it seems nanosleep get interruped by a signal.

This works:

 import System.Posix
 
 main = do
   putStrLn Waiting for 5 seconds.
   blockSignals $ addSignal sigVTALRM emptySignalSet
   sleep 5
   putStrLn Done.
 
So (see my earlier email) `sleep` is lying about what interrupts it :)

- George


signature.asc
Description: This is a digitally signed message part
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Why does sleep not work?

2009-02-10 Thread Corey O'Connor
2009/2/10 George Pollard por...@porg.es:
 import System.Posix

 main = do
   putStrLn Waiting for 5 seconds.
   blockSignals $ addSignal sigVTALRM emptySignalSet
   sleep 5
   putStrLn Done.


Huh! Does the GHC runtime uses this signal? Perhaps for scheduling?

Cheers,
-Corey O'Connor
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] ANN: Bug fix to regex-tdfa, new version 0.97.3

2009-02-10 Thread ChrisK

To Haskell and Libraries and Haskell-Cafe,

Whilst improving regex-tdfa I have run across new bugs.  Some patterns were 
getting compiled wrong and others were affected by an execution bug.


As this package has actual users, I wanted to make sure they get these fixes 
immediately.


Three Cheers For QuickCheck!

The new version is 0.97.3 at
http://hackage.haskell.org/cgi-bin/hackage-scripts/package/regex-tdfa

And this version passes all the unit tests I have, including coverage for the 
new bugs.  This is no warranty that regex-tdfa is bug free, since I made that 
same claim last release.  For instance: I suspect 0.97.3 may be buggy if used in 
the optional left-associative mode.


The new improved version of regex-tdfa is still a long way off.

Cheers,
 Chris Kuklewicz

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


Re: [Haskell-cafe] Why does sleep not work?

2009-02-10 Thread George Pollard
Also attached is a diff for strace between non-threaded and threaded. 
execve(./sleep, [./sleep], [/* 38 vars */]) = 0 
execve(./sleep, [./sleep], [/* 38 vars */]) = 0
brk(0)  = 0x83c2000   | brk(0)  
= 0x8ff
access(/etc/ld.so.nohwcap, F_OK)  = -1 ENOENT (No such
access(/etc/ld.so.nohwcap, F_OK)  = -1 ENOENT (No such 
mmap2(NULL, 8192, PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_ANONY | mmap2(NULL, 
8192, PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_ANONY
access(/etc/ld.so.preload, R_OK)  = -1 ENOENT (No such
access(/etc/ld.so.preload, R_OK)  = -1 ENOENT (No such 
open(/etc/ld.so.cache, O_RDONLY)  = 3 
open(/etc/ld.so.cache, O_RDONLY)  = 3
fstat64(3, {st_mode=S_IFREG|0644, st_size=68273, ...}) = 0  fstat64(3, 
{st_mode=S_IFREG|0644, st_size=68273, ...}) = 0
mmap2(NULL, 68273, PROT_READ, MAP_PRIVATE, 3, 0) = 0xb801b000 | mmap2(NULL, 
68273, PROT_READ, MAP_PRIVATE, 3, 0) = 0xb7f8d000
close(3)= 0 close(3)
= 0
access(/etc/ld.so.nohwcap, F_OK)  = -1 ENOENT (No such
access(/etc/ld.so.nohwcap, F_OK)  = -1 ENOENT (No such 
open(/lib/tls/i686/cmov/libutil.so.1, O_RDONLY) = 3   
open(/lib/tls/i686/cmov/libutil.so.1, O_RDONLY) = 3
read(3, \177ELF\1\1\1\0\0\0\0\0\0\0\0\0\3\0\3\0\1\0\0\0\340\   read(3, 
\177ELF\1\1\1\0\0\0\0\0\0\0\0\0\3\0\3\0\1\0\0\0\340\
fstat64(3, {st_mode=S_IFREG|0644, st_size=9688, ...}) = 0   fstat64(3, 
{st_mode=S_IFREG|0644, st_size=9688, ...}) = 0
mmap2(NULL, 12424, PROT_READ|PROT_EXEC, MAP_PRIVATE|MAP_DENYW | mmap2(NULL, 
12424, PROT_READ|PROT_EXEC, MAP_PRIVATE|MAP_DENYW
mmap2(0xb8019000, 8192, PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP | 
mmap2(0xb7f8b000, 8192, PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP
close(3)= 0 close(3)
= 0
access(/etc/ld.so.nohwcap, F_OK)  = -1 ENOENT (No such
access(/etc/ld.so.nohwcap, F_OK)  = -1 ENOENT (No such 
open(/lib/tls/i686/cmov/libdl.so.2, O_RDONLY) = 3 
open(/lib/tls/i686/cmov/libdl.so.2, O_RDONLY) = 3
read(3, \177ELF\1\1\1\0\0\0\0\0\0\0\0\0\3\0\3\0\1\0\0\0 \n\0   read(3, 
\177ELF\1\1\1\0\0\0\0\0\0\0\0\0\3\0\3\0\1\0\0\0 \n\0
fstat64(3, {st_mode=S_IFREG|0644, st_size=9676, ...}) = 0   fstat64(3, 
{st_mode=S_IFREG|0644, st_size=9676, ...}) = 0
mmap2(NULL, 12408, PROT_READ|PROT_EXEC, MAP_PRIVATE|MAP_DENYW | mmap2(NULL, 
12408, PROT_READ|PROT_EXEC, MAP_PRIVATE|MAP_DENYW
mmap2(0xb8015000, 8192, PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP | 
mmap2(0xb7f87000, 8192, PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP
close(3)= 0 close(3)
= 0
access(/etc/ld.so.nohwcap, F_OK)  = -1 ENOENT (No such
access(/etc/ld.so.nohwcap, F_OK)  = -1 ENOENT (No such 
open(/lib/tls/i686/cmov/libm.so.6, O_RDONLY) = 3  
open(/lib/tls/i686/cmov/libm.so.6, O_RDONLY) = 3
read(3, \177elf\1\1\1\0\0\0\0\0\0\0\0\0\3\0\3\0\1\0\...@4\0\   read(3, 
\177elf\1\1\1\0\0\0\0\0\0\0\0\0\3\0\3\0\1\0\...@4\0\
fstat64(3, {st_mode=S_IFREG|0644, st_size=149332, ...}) = 0 fstat64(3, 
{st_mode=S_IFREG|0644, st_size=149332, ...}) = 0
mmap2(NULL, 4096, PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_ANONY | mmap2(NULL, 
4096, PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_ANONY
mmap2(NULL, 151680, PROT_READ|PROT_EXEC, MAP_PRIVATE|MAP_DENY | mmap2(NULL, 
151680, PROT_READ|PROT_EXEC, MAP_PRIVATE|MAP_DENY
mmap2(0xb801, 8192, PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP | 
mmap2(0xb7f82000, 8192, PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP
close(3)= 0 close(3)
= 0
access(/etc/ld.so.nohwcap, F_OK)  = -1 ENOENT (No such
access(/etc/ld.so.nohwcap, F_OK)  = -1 ENOENT (No such 
open(/usr/lib/libgmp.so.3, O_RDONLY)  = 3 
open(/usr/lib/libgmp.so.3, O_RDONLY)  = 3
read(3, \177ELF\1\1\1\0\0\0\0\0\0\0\0\0\3\0\3\0\1\0\0\0\200\   read(3, 
\177ELF\1\1\1\0\0\0\0\0\0\0\0\0\3\0\3\0\1\0\0\0\200\
fstat64(3, {st_mode=S_IFREG|0644, st_size=284176, ...}) = 0 fstat64(3, 
{st_mode=S_IFREG|0644, st_size=284176, ...}) = 0
mmap2(NULL, 287052, PROT_READ|PROT_EXEC, MAP_PRIVATE|MAP_DENY | mmap2(NULL, 
287052, PROT_READ|PROT_EXEC, MAP_PRIVATE|MAP_DENY
mmap2(0xb7fea000, 8192, PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP | 
mmap2(0xb7f5c000, 8192, PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP
close(3)= 0 close(3)
= 0
access(/etc/ld.so.nohwcap, F_OK)  = -1 ENOENT (No such
access(/etc/ld.so.nohwcap, F_OK)  = -1 ENOENT (No such 
open(/lib/tls/i686/cmov/librt.so.1, O_RDONLY) = 3 
open(/lib/tls/i686/cmov/librt.so.1, O_RDONLY) = 3
read(3, \177ELF\1\1\1\0\0\0\0\0\0\0\0\0\3\0\3\0\1\0\0\0`\31\   read(3, 

Re: [Haskell-cafe] Why does sleep not work?

2009-02-10 Thread Manlio Perillo

Corey O'Connor ha scritto:

2009/2/10 George Pollard por...@porg.es:

import System.Posix

main = do
  putStrLn Waiting for 5 seconds.
  blockSignals $ addSignal sigVTALRM emptySignalSet
  sleep 5
  putStrLn Done.



Huh! Does the GHC runtime uses this signal? Perhaps for scheduling?



Right.
It is used for scheduling, as far as I understand.
So blocking it is a bad idea (unless you block it in a thread other than 
the main thread, IMO).



Cheers,
-Corey O'Connor




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


[Haskell-cafe] Re: [Haskell] Google Summer of Code 2009

2009-02-10 Thread Michael Litchard
I would love a mentor to help me with a Haskell binding to libnova.
This is part of a larger project I have in mind, but the libnova
binding seems like the first step.
I don't expect this to be picked as an official GSoC, but this seemed
like a good time to look
for a mentor for this project.


Michael Litchard

On Tue, Feb 10, 2009 at 6:26 AM, Malcolm Wallace
malcolm.wall...@cs.york.ac.uk wrote:
 Gentle Haskellers,

 The Google Summer of Code will be running again this year.  Once again,
 haskell.org has the opportunity to bid to become a mentoring
 organisation.  (Although, as always, there is no guarantee of
 acceptance.)

 If you have ideas for student projects that you think would benefit the
 Haskell community, now is the time to start discussing them on mailing
 lists of your choice.  We especially encourage students to communicate
 with the wider community: if you keep your ideas private, you have a
 much worse chance of acceptance than if you develop ideas in
 collaboration with those who will be your customers, end-users, or
 fellow-developers.  This is the open-source world!

 The timeline is that Haskell.org will apply for GSoC membership between
 9-13 March, and if we are successful, students can submit applications
 between 23 March - 3 April.

 If you wish to help publicise GSoC amongst students, there are official
 posters/fliers available (not specific to haskell.org):

http://code.google.com/p/google-summer-of-code/wiki/GsocFlyers

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

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


Re: [Haskell-cafe] evaluation semantics of bind

2009-02-10 Thread Richard O'Keefe


On 11 Feb 2009, at 2:22 am, Gregg Reynolds wrote:

Is the result of evaluation a thunk/suspension/closer?


As T. S. Eliot wrote,
  Teach us to care and not to care
   Teach us to sit still.

There are some things it is better not to care about
and this is one of them.




(Dash it, this really is getting us into White Knight land.)

What's White Knight land?


From Alice in Wonderland.


``You are sad,'' the Knight said in an anxious tone:
``let me sing you a song to comfort you.''

``Is it very long?'' Alice asked,
for she had heard a good deal of poetry that day.

``It's long,'' said the Knight,
``but it's very, {\it very} beautiful.
Everybody that hears me sing it---either
it brings tears to their eyes, or else---''

``Or else what?'' said Alice,
for the Knight had made a sudden pause.

``Or else it doesn't, you know.
The name of the song is called {\it `Haddocks' Eyes.'\/}{}''

``Oh, that's the name of the song, is it?''
Alice said, trying to feel interested.

``No, you don't understand,'' the Knight said,
looking a little vexed.
``That's what the name is {\it called}.
The name really {\it is `The Aged Aged Man.'\/}{}''

``Then I ought to have said, `That's what the {\it song}
is called?'' Alice corrected herself.

``No, you oughtn't:  that's quite another thing!
The {\it song} is called {\it `Ways and Means'\/}:
but that's only what it's {\it called}, you know.''

``Well, what {\it is} the song, then?'' said Alice,
who was by this time completely bewildered.

``I was coming to that,'' the Knight said.
``The song really {\it is `A-sitting On a Gate'\/}:
and the tune's my own invention.''


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


Re: [Haskell-cafe] Why does sleep not work?

2009-02-10 Thread Manlio Perillo

George Pollard ha scritto:

[...]


So, it seems nanosleep get interruped by a signal.


This works:


import System.Posix

main = do
putStrLn Waiting for 5 seconds.
blockSignals $ addSignal sigVTALRM emptySignalSet
sleep 5
putStrLn Done.


So (see my earlier email) `sleep` is lying about what interrupts it :)

- George



A possibly better solution is:

sleep' :: Int - IO Int
sleep' n = do
  n' - sleep n
  if n' == 0 then return 0 else sleep' n'


From the trace, I see that nanosleep is being called 17 times here.

Another solution is to set RTS flag:
./bug_sleep +RTS -V0 -RTS


What strange is that the timer is created in non threaded RTS, too, but 
sleep is interrupted only with the threaded RTS.


This may be caused by an incorrect execution of a foreign function 
marked safe.




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


Re: [Haskell-cafe] Monad explanation

2009-02-10 Thread wren ng thornton

Richard O'Keefe wrote:

Gregg Reynolds wrote:
   Sure, you can treat a morphism as an object, but only by moving to a 
 higher (or different) level of abstraction.


False as a generalisation about mathematics.
False about functional programming languages, the very essence
of which is treating functions (morphisms) as values (objects)
exactly like any other values.

   That doesn't erase the difference between object and morphism.

There is no intrinsic difference between objects and morphisms.
It's what you DO with something that makes it an object or a
morphism (or both).

   This is way confusing.

Composer (Haskell program) writes score (computes getChar).
Performer (Haskell environment) sings score (performs Gamaliel).
Sound happens (a character is read).



+1.

The only difference between objects and morphisms is in the decision by 
some supreme entity (human reader, Haskell runtime) to treat them 
differently. There is nothing different between them other than our 
decisions to treat them differently.



As for the concrete example about 3, I define:

 let 3 = \f x - f(f(f x))

which is as valid as any other definition. Oh noes, you say, it's a 
function and therefore a morphism. And certainly it is. However, it's 
perfectly fine to treat that as a value and define a real function 
like addition:


 let m + n = \f x - m f (n f x)

When people see something like 1 + 2 + 3 they choose to think of 1, 2, 
and 3 as objects and choose to think of (+) and (+) as morphisms, 
but who cares? Any datum can be encoded as a function, the execution of 
which enacts the existence of the object the function denotes. And, in 
functional languages, functions can be passed around and clubbed over 
the head just like every other value.


And therein lies the rub: the execution of which enacts the existence 
of the object the function denotes. The only thing that distinguishes 
objects and morphisms is the decision by some supreme entity to treat 
them that way. Just as you once said that values don't concatenate, so 
neither do functions apply. The application of functions can only be 
observed by some evaluator for the structure generated by application. 
Application itself has no semantics, it just builds ASTs and 
uninterpreted terms; only our choice to evaluate ASTs and terms gives 
them meaning.


--
Live well,
~wren
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] ANN: convertible (first release)

2009-02-10 Thread Daniel Schüssler
Hello,

it is a real code snippet, but I failed to include the necessary pragma (which 
is: 
{-# OPTIONS_GHC -fglasgow-exts #-} 
or 
{-# OPTIONS_GHC -XMagicHash #-} 
at the beginning of the file).

the # suffix is for unboxed types:

http://www.haskell.org/ghc/docs/latest/html/users_guide/primitives.html
http://www.haskell.org/ghc/docs/latest/html/users_guide/syntax-extns.html#magic-hash


Greetings,
Daniel

On Wednesday 11 February 2009 00:19:56 Dylan Tisdall wrote:
 Maybe I'm just a noob falling for someone's joke here, but I can't
 make that sample, or anything else I tried with # on the end of
 names, to compile with ghci. In the example below, I get a parse error
 at the line defining d2f. Is this a real code snippet?


 Cheers,
 Dylan

 On Feb 10, 2009, at 2:46 AM, Daniel Schüssler wrote:
  Hi,
 
  On Wednesday 28 January 2009 04:30:07 John Goerzen wrote:
  On Tue, Jan 27, 2009 at 09:41:30PM -0500, wren ng thornton wrote:
  I once again point out that realToFrac is *wrong* for converting
  from
  Float or Double.
 
  realToFrac (1/0::Float) ::Double
 
 3.402823669209385e38
 
  Yes, I understand what you are saying and agree with you.  But there
  is nothing better in the standard library
 
  don't know whether you consider GHC as standard library, but if you
  do...:
 
  import GHC.Types
  import GHC.Prim
 
  -- | Double to Float
  d2f  (D# d) = F# (double2Float# d)
 
  -- | Float to Double
  f2d  (F# f) = D# (float2Double# f)
 
 
  ghci f2d (1/0)
  Infinity
  it :: Double
 
  :)
 
  --
  Daniel
  ___
  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] Re: Additonal types for Foreign.C.Types

2009-02-10 Thread Maurí­cio

Sure it does!

Thanks.


(...)So, for example if you have:

foreign import ccall string.h strlen cstrlen :: Ptr CChar - IO CSize

fatype - ftype :: ftype
  fatype :: fatype
qtycon Ptr
atype1 CChar
  fatype :: frtype
qtycon IO
atype1 CSize

(I struggled a bit with finding a good way to communicate the 
productions chosen, so bear with me)


Make sense?


The FFI spec says (at 
http://www.cse.unsw.edu.au/~chak/haskell/ffi/ffi/ffise3.html#x6-120003.2): 



There I see:

---
(...)
I can't understand the qtycon atype[1]... line. (...)


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


Re: [Haskell-cafe] Painting logs to get a coloured tree

2009-02-10 Thread wren ng thornton

minh thu wrote:

Joachim Breitner:
 I thought about Zippers, but I understand that they improve _navigating_
 in a Tree-like structure, or to refrence _one_ position in a tree.

 But if I would deconstruct my tree to the list of _all_ locations, with
   type Loc a = (Tree a, Cxt a)
 and then run my algorithm that returns [(Loc a, Info)], it's still not
 clear to me how I can combine all of these locations to get back my
 original Tree, annotated with the Info returned.

I guess I just repeat your last praragraph of your original mail but it seems
to me you can mapAccump some 'names' on the tree, process an
association list (or an IntMap) of the (name,log) then map the three
again using the result.
In spirits, it's the same thing than the STRef solution but it seems
cleaner to me.


It might also be worth looking at Okasaki's algorithm for 
(breadth-first) numbering of nodes in a tree[1]. Assuming your tree 
doesn't have interesting invariants to maintain, a similar/inverse 
algorithm could be used to unfold a list of logs back into a tree.


As minh thu says, the numbering seems like it only needs to be 
conceptual rather than actual. In which case you should be able to fuse 
the code that traverses the tree to produce logs and the code that 
traverses the logs to produce a tree (aka a hylomorphism, if you're 
familiar). The knot-tying step should only be necessary if constructing 
the tree from logs requires more information than whatever's local to 
the log itself. Of course, if global information is necessary then you 
probably _do_ need to actually label the tree.


At least it's cleaner than STRefs since you don't need mutability.


[1] http://www.eecs.usma.edu/webs/people/okasaki/pubs.html#icfp00

--
Live well,
~wren
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] evaluation semantics of bind

2009-02-10 Thread wren ng thornton

Alberto G. Corona wrote:

forwarded:

Yes!  if no state is passed, the optimization makes sense and the term is
not executed, like any lazy evaluation. For example, I used the debugger
(that is, without optimizations) to verify it with the Maybe monad:
op x= x+x

print $ Just (op 1) = \y- return (Just 2)

does not evaluate  op 1


Presumably you mean?: print $ Just (op 1) = \y- return 2



but

print $ Just (op 1) = \y- return y

does execute it.



Dashing off towards the White Knight, we should be careful what is said 
here. If we take only the expression Just (op 1) = \y- return y 
then evaluating it yields Just (op 1). That is, it only evaluates to 
WHNF and does not evaluate what's inside. It is only once this value is 
subsequently handed off to print or some other function, that it may 
become evaluated.


Similarly with the first example as originally written. It so happens 
that bind is non-strict for the field in Just, so we can discard the op 
1. However, according to the semantics we do not evaluate Just 2 
either; we only need to evaluate the return which will produce Just and 
pass the operand down. (Regardless of the fact that the value yielded by 
applying Just to 2 is Just 2. Expressions and their denotations are 
different.)


--
Live well,
~wren
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Re: [Haskell] Google Summer of Code 2009

2009-02-10 Thread Jamie

On Tue, 10 Feb 2009, Conrad Meyer wrote:


On Tuesday 10 February 2009 07:18:00 am Jamie wrote:

What I would like to see is H.264 video codec in Haskell.  H.264/MPEG-4 is
getting very popular nowadays and it would be great to have encoder and
decoder in haskell.  Can use x264 (encoder) and ffmpeg (en/de coder)
as a base to start with.

Jamie


GSoC is run out of the US, where software patents would prevent a 
student from taking this task.


via http://www.videolan.org/developers/x264.html

x264 is a free library for encoding H264/AVC video streams. The code is 
written from scratch by Laurent Aimar, Loren Merritt, Eric Petit (OS X), 
Min Chen (vfw/asm), Justin Clay (vfw), Måns Rullgård, Radek Czyz, 
Christian Heine (asm), Alex Izvorski, and Alex Wright. It is released 
under the terms of the GPL license.


Seems like it is ok to write H.264 in Haskell and released via GPL 
license?


There is theora.org but H.264 would be ideal.  Ditto for H.263.


Conrad Meyer kon...@tylerc.org 


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


Re: [Haskell-cafe] Re: [Haskell] Google Summer of Code 2009

2009-02-10 Thread Gwern Branwen

2009/2/10 Jamie hask...@datakids.org:

On Tue, 10 Feb 2009, Conrad Meyer wrote:


On Tuesday 10 February 2009 07:18:00 am Jamie wrote:


What I would like to see is H.264 video codec in Haskell.  H.264/MPEG-4
is
getting very popular nowadays and it would be great to have encoder and
decoder in haskell.  Can use x264 (encoder) and ffmpeg (en/de coder)
as a base to start with.

       Jamie


GSoC is run out of the US, where software patents would prevent a student
from taking this task.


via http://www.videolan.org/developers/x264.html

x264 is a free library for encoding H264/AVC video streams. The code is
written from scratch by Laurent Aimar, Loren Merritt, Eric Petit (OS X), Min
Chen (vfw/asm), Justin Clay (vfw), Måns Rullgård, Radek Czyz, Christian
Heine (asm), Alex Izvorski, and Alex Wright. It is released under the terms
of the GPL license.

Seems like it is ok to write H.264 in Haskell and released via GPL license?

There is theora.org but H.264 would be ideal.  Ditto for H.263.


Conrad Meyer kon...@tylerc.org 


       Jamie


Software patent issues are entirely orthogonal to the copyright issues of who 
wrote what under which license. That's why software patents suck so very hard.

See 
https://secure.wikimedia.org/wikipedia/en/wiki/Software_patent#Free_and_open_source_software
  
https://secure.wikimedia.org/wikipedia/en/wiki/Software_patents_and_free_software

--
gwern

signature.asc
Description: OpenPGP digital signature
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Re: [Haskell] Google Summer of Code 2009

2009-02-10 Thread Gwern Branwen
(The following is a quasi essay/list of past Summer of Code projects;
my hope is to guide thinking about what Summer of Code projects would
be good to pick, and more specifically what should be avoided.
If you're in a hurry, my conclusions are at the bottom.
The whole thing is written in Markdown; for best results pass it
through Pandoc or view it via your friendly local Gitit wiki.)

# Summer of Code

As part of Google's [Summer of
code](http://en.wikipedia.org/wiki/Google_Summer_of_Code)[](http://code.google.com/soc/)
program, Google sponsors 5-10 [projects for
Haskell](http://hackage.haskell.org/trac/summer-of-code/).

The Haskell Summer of Codes have often produced excellent results, but
how excellent is excellent? Are there any features or commonalities
between successful projects or unsuccessful ones?

(This questions are particularly important as SoC 2009 isn't too far
away; yet we don't have even a general sense of where we are.)

## Example retrospective: Debian

An energetic blogger  Debian developer has produced
[a](http://www.milliways.fr/2009/01/20/debian-2008-where-now-1/)
[three](http://www.milliways.fr/2009/01/28/debian-2008-where-now-2/)
[part](http://www.milliways.fr/2009/02/02/debian-2008-where-now-3/)
series on the many Debian-related Summer of Code projects.

The results are interesting: some projects were a failure and the
relevant student drifted away and had little to do with Debian again;
and some were great successes. I don't discern any particular lessons
there, except perhaps one against hubris or filling unclear needs.
Let's see whether that holds true of Haskell.

### Haskell retrospective

Haskell wasn't part of the first Summer of Code in 2005, but it was
accepted for 2006. We start there.

 2006
The 2006 [homepage](http://hackage.haskell.org/trac/summer-of-code/wiki/SoC2006)
lists the following projects:

- Fast Mutable Collection Types for Haskell

Caio Marcelo de Oliveira Filho, mentored by Audrey Tang

This ultimately resulted in the
[HsJudy](http://hackage.haskell.org/cgi-bin/hackage-scripts/package/HsJudy)
library ('fast mutable collection' here meaning 'array'; see the
[application](http://darcs.haskell.org/judy/SOC_APP.txt)). HsJudy was
apparently used in Pugs at one time, but no more. Thus, I judge this
to have been **unsuccessful**.

- Port Haddock to use GHC

   David Waern, mentored by Simon Marlow

   **Successful**. Haddock has used the GHC API ever since.[^complaints]

- A model for client-side scripts with HSP

Joel Björnson, mentored by Niklas Broberg

Was initially unsuccessful, but seems to've been picked up again.
So I give this a tentative **successful**

- GHCi based debugger for Haskell

José Iborra López, mentored by David Himmelstrup

**Successful**. The GHCi debugger was accepted into GHC HEAD, and
by now is in production use,

- HaskellNet

Jun Mukai, mentored by Shae Erisson

**Unsuccessful**. HaskellNet is dead, and nothing of it has
propagated elsewhere. (I'm not entirely sure what happened with the
HaskellNet code - I know of
[two](http://darcs.haskell.org/SoC/haskellnet/)
[repos](http://stuff.mit.edu/afs/sipb/project/suez/src/haskell/haskellnet/),
but that's about it.) Shae tells me that this poor uptake is probably
due to a lack of advertising, and not any actual defect in the
HaskellNet code.

- Language.C - a C parser written in Haskell

Marc van Woerkom, mentored by Manuel Chakravarty

**Failure**. According to [Don Stewart's
outline](http://www.haskell.org/pipermail/haskell-cafe/2007-February/022509.html)
of the 2006 SoC, this project was not completed.

- Implement a better type checker for Yhc

Leon P Smith, mentored by Malcolm Wallace

**Failure**. See Language.C

- Thin out cabal-get and integrate in GHC

Paolo Martini, mentored by Isaac Jones

**Successful**. Code is in Cabal, which we all know and love.

- Unicode ByteString, Data.Rope, Parsec for generic strings

Spencer Janssen, mentored by Don Stewart

**Successful**. (Again, per Don.)

4 successful; 2 unsuccessful; and 2 failures.

 2007

The [2007 homepage](http://hackage.haskell.org/trac/summer-of-code/wiki/SoC2007)

- Darcs conflict handling

Jason Dagit, mentored by David Roundy

**Successful**. The work was successful in almost completely
getting rid of the exponential conflict bug, and has been in the
regular releases of Darcs 2.x for some time now.

- Automated building of packages and generation of Haddock documentation

Sascha Böhme, mentored by Ross Paterson

**Successful**. The auto build and doc generation are
long-standing and very useful parts of Hackage.

- Rewrite the typechecker for YHC and nhc98

Mathieu Boespflug, mentored by Malcolm Wallace

Unknown.

- Cabal Configurations

Thomas Schilling, mentored by Michael Isaac Jones

**Successful**. Cabal configurations have been around for a while
and are very useful for enabling/disabling things

- Update 

[Haskell-cafe] Gtk2HS 0.10.0 Released

2009-02-10 Thread Peter Gavin

Hi everyone,

Oh, dear... it seems I've forgotten how to spell cafe, and sent this 
message to haskell-c...@haskell.org the first time around.  I resent it 
to all the lists again (just to make sure everyone interested receives 
it), so I apologize for any duplicated messages you might have received. 
 In any case...


I'd like to release the announcement of Gtk2HS 0.10.0.  A lot of new 
stuff has gone into this release, including:


- Support for GHC 6.10
- Bindings to GIO and GtkSourceView-2.0
- Full switch to the new model-view implementation using a Haskell model
- Support for many more model-based widgets such as IconView and an 
updated binding for ComboBox

- Full Drag-and-Drop support
- Better support for Attributes in Pango
- Replaced Event for EventM monad, thereby improving efficiency and 
convenience

- Functions for interaction between Cairo and Pixbuf drawing
- Lots of bug fixes, code cleanups, and portability improvements

With this release, the bindings to GnomeVFS and GtkSourceView-1.0 have 
been deprecated.  The TreeList modules have been deprecated from the 
Gtk+ bindings.


Source and Win32 binaries are available at:


https://sourceforge.net/project/showfiles.php?group_id=49207package_id=42440release_id=659598

Thanks to everyone who submitted bug fixes and features this time around!

Thanks,
Peter Gavin
Gtk2HS Release Manager

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


[Haskell-cafe] GMP on Mac OS X linked statically by default

2009-02-10 Thread David Leimbach
Was there a reason for this?  If so, it'd be nice if the package that was
build explained why... otherwise it feels kind of arbitrary, and would be
nice if there was documentation available to make it link dynamically in
case someone didn't want to LGPL their program.
Anyone know the steps to make it link dynamically?

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


[Haskell-cafe] Re: [Gtk2hs-users] Gtk2HS 0.10.0 Released

2009-02-10 Thread Jeff Heard
Wonderful!  Who maintains the mac-ports port of it?  I'm itching to
get hieroglyph working on the Mac.

On Tue, Feb 10, 2009 at 11:40 PM, Peter Gavin pga...@gmail.com wrote:
 Hi everyone,

 Oh, dear... it seems I've forgotten how to spell cafe, and sent this
 message to haskell-c...@haskell.org the first time around.  I resent it
 to all the lists again (just to make sure everyone interested receives
 it), so I apologize for any duplicated messages you might have received.
  In any case...

 I'd like to release the announcement of Gtk2HS 0.10.0.  A lot of new
 stuff has gone into this release, including:

 - Support for GHC 6.10
 - Bindings to GIO and GtkSourceView-2.0
 - Full switch to the new model-view implementation using a Haskell model
 - Support for many more model-based widgets such as IconView and an
 updated binding for ComboBox
 - Full Drag-and-Drop support
 - Better support for Attributes in Pango
 - Replaced Event for EventM monad, thereby improving efficiency and
 convenience
 - Functions for interaction between Cairo and Pixbuf drawing
 - Lots of bug fixes, code cleanups, and portability improvements

 With this release, the bindings to GnomeVFS and GtkSourceView-1.0 have
 been deprecated.  The TreeList modules have been deprecated from the
 Gtk+ bindings.

 Source and Win32 binaries are available at:


 https://sourceforge.net/project/showfiles.php?group_id=49207package_id=42440release_id=659598

 Thanks to everyone who submitted bug fixes and features this time around!

 Thanks,
 Peter Gavin
 Gtk2HS Release Manager


 --
 Create and Deploy Rich Internet Apps outside the browser with Adobe(R)AIR(TM)
 software. With Adobe AIR, Ajax developers can use existing skills and code to
 build responsive, highly engaging applications that combine the power of local
 resources and data with the reach of the web. Download the Adobe AIR SDK and
 Ajax docs to start building applications today-http://p.sf.net/sfu/adobe-com
 ___
 Gtk2hs-users mailing list
 gtk2hs-us...@lists.sourceforge.net
 https://lists.sourceforge.net/lists/listinfo/gtk2hs-users

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


Re: [Haskell-cafe] Re: [Haskell] Google Summer of Code 2009

2009-02-10 Thread Alexandr N. Zamaraev

On Tue, Feb 10, 2009 at 6:26 AM, Malcolm Wallace
malcolm.wall...@cs.york.ac.uk wrote:
 Gentle Haskellers,

 The Google Summer of Code will be running again this year.  Once again,
 haskell.org has the opportunity to bid to become a mentoring
 organisation.  (Although, as always, there is no guarantee of
 acceptance.)

 If you have ideas for student projects that you think would benefit the
 Haskell community, now is the time to start discussing them on mailing
 lists of your choice.
1. Binding for FireBird RDBMS.
2. Library for manipulate ODF.
3. Binding to OOo UNO.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] GMP on Mac OS X linked statically by default

2009-02-10 Thread Don Stewart
leimy2k:
 Was there a reason for this?  If so, it'd be nice if the package that was 
 build
 explained why... otherwise it feels kind of arbitrary, and would be nice if
 there was documentation available to make it link dynamically in case someone
 didn't want to LGPL their program.
 
 Anyone know the steps to make it link dynamically?
 

Here's how we do it on Windows. The Mac should be far easier,

http://haskell.forkio.com/gmpwindows

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


Re: [Haskell-cafe] Gtk2HS 0.10.0 Released

2009-02-10 Thread Don Stewart
Well done!

Our flagship GUI bindings... Go team!

-- Don

pgavin:
 Hi everyone,

 Oh, dear... it seems I've forgotten how to spell cafe, and sent this  
 message to haskell-c...@haskell.org the first time around.  I resent it  
 to all the lists again (just to make sure everyone interested receives  
 it), so I apologize for any duplicated messages you might have received.  
  In any case...

 I'd like to release the announcement of Gtk2HS 0.10.0.  A lot of new  
 stuff has gone into this release, including:

 - Support for GHC 6.10
 - Bindings to GIO and GtkSourceView-2.0
 - Full switch to the new model-view implementation using a Haskell model
 - Support for many more model-based widgets such as IconView and an  
 updated binding for ComboBox
 - Full Drag-and-Drop support
 - Better support for Attributes in Pango
 - Replaced Event for EventM monad, thereby improving efficiency and  
 convenience
 - Functions for interaction between Cairo and Pixbuf drawing
 - Lots of bug fixes, code cleanups, and portability improvements

 With this release, the bindings to GnomeVFS and GtkSourceView-1.0 have  
 been deprecated.  The TreeList modules have been deprecated from the  
 Gtk+ bindings.

 Source and Win32 binaries are available at:


 https://sourceforge.net/project/showfiles.php?group_id=49207package_id=42440release_id=659598

 Thanks to everyone who submitted bug fixes and features this time around!

 Thanks,
 Peter Gavin
 Gtk2HS Release Manager

 ___
 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