Re: [Haskell-cafe] Haskellers.com skills list moderation?

2010-10-19 Thread David Virebayre
2010/10/18 Andrew Coppin andrewcop...@btinternet.com:

 ...I thought *I* was the only person who's ever heard of Rexx?

... and thanks to you, I now know some people here have heard of Amiga :)

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


[Haskell-cafe] Eta-expansion and existentials (or: types destroy my laziness)

2010-10-19 Thread oleg

Max Bolingbroke wrote:
 Let's start with a simple example of an existential data type:
  data Stream a = forall s. Stream s (s - Maybe (a, s))
  ones :: Stream Int
  ones = cons 1 ones

 Unfortunately, 'ones' is just _|_! The reason is that cons is strict
 in its second argument. The problem I have is that there is no way to
 define cons which is
 simultaneously:

   1. Lazy in the tail of the list
   2. Type safe
   3. Non-recursive

Really? Here are two 'cons' that seem to satisfy all the criteria

 {-# LANGUAGE ExistentialQuantification #-}

 data Stream a = forall s. Stream s (s - Maybe (a, s))

 nil :: Stream a
 nil = Stream () (const Nothing)

 -- One version
 -- cons :: a - Stream a - Stream a
 -- cons a str = Stream Nothing (maybe (Just (a, Just str)) run)
 --  where run (Stream s step) = 
 -- step s = (\ (a,s) - return (a, Just (Stream s step)))

 -- the second version
 cons :: a - Stream a - Stream a
 cons a str = Stream (Just (a,str)) step
  where step Nothing = Nothing
step (Just (a, (Stream s step'))) = Just (a,
case step' s of
  Nothing  - Nothing
  Just (a',s') - Just (a',(Stream s' step')))


 instance Show a = Show (Stream a) where
   showsPrec _ (Stream s step) k = '[' : go s
 where go s = maybe (']' : k) 
   (\(a, s) - shows a . showString ,  $ go s) (step s)

 taken :: Int - Stream a - Stream a
 taken n (Stream s step) = 
   Stream (n, s) (\(n, s) - 
   if n = 0 then Nothing else maybe Nothing
  (\(a, s) - Just (a, (n - 1, s))) (step s))

 ones :: Stream Int
 ones = cons 1 ones

 test2 = taken 5 $ ones
 -- [1, 1, 1, 1, 1, ]

Finally, if one doesn't like existentials, one can try
universals:
http://okmij.org/ftp/Algorithms.html#zip-folds
http://okmij.org/ftp/Haskell/zip-folds.lhs

The code implements the whole list library, including zip and
zipWith. None of the list operations use value recursion. We still can
use value recursion to define infinite streams, which are processed
lazily. In fact, the sample stream2 of the example is the infinite
stream.


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


Re: [Haskell-cafe] Why isn't there a cheaper split-in-two operation for Data.Set?

2010-10-19 Thread Ryan Newton
That sounds good to me.  In any case the parallel map/fold operations by
themselves shouldn't compromise the abstraction.

Perhaps an eventual solution would be to start including parallel maps/folds
right inside the standard libraries.  I haven't began testing this yet but
it would seem that all the balanced tree implementations are good candidates
for a little `par` treatment.  Has this been tried somewhere already?
   Alas, having par/nonpar versions of library functions compounds the
already present monadic/non-monadic schism...

Anyway, right this second I'm primarily interested in speeding up difference
and intersection -- that would be really useful for a simple utility I've
been using that compares files as Maps of word-tuples and runs rather slowly
(http://hackage.haskell.org/package/wordsetdiff).

Cheers,
-Ryan


On Mon, Oct 4, 2010 at 11:00 AM, Bertram Felgenhauer 
bertram.felgenha...@googlemail.com wrote:

 Ryan Newton wrote:
  Would there be anything wrong with a Data.Set simply chopping off half
 its
  (balanced) tree and returning two approximately balanced partitions
 ...
  cleave :: Set a - (Set a, Set a)
  cleave Tip = (Tip, Tip)
  cleave (Bin _ x l r)
| size l  size r = (l, insertMin x r)
| otherwise   = (insertMax x l, r)

 This function would expose some of the internal structure of Set - i.e.
 there could be equal sets  s1 == s2  with  cleave s1 /= cleave s2.

 Maybe a better idea than to expose such a function would be to split
 Data.Set into Data.Set.Internal and Data.Set, where Data.Set.Internal
 would export the actual Tip and Bin constructors. Then people who want
 to break the abstraction, for example to experiment with parallel folds,
 could do that easily.

 regards,

 Bertram

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


[Haskell-cafe] Re: Eta-expansion and existentials (or: types destroy my laziness)

2010-10-19 Thread Max Bolingbroke
Hi Oleg,

Thanks for your reply!

 Really? Here are two 'cons' that seem to satisfy all the criteria

Thanks - your definitions are similar to Roman's suggestion.
Unfortunately my criteria 3) is not quite what I actually wanted - I
really wanted something GHC-optimisable - (so non-recursive
definitions are a necessary but not sufficient condition).

The problem is that I'd like to do the static argument transformation
on the Stream argument to cons so that GHC can optimise it
properly. This is why I've made my cons pattern match on str
directly, so the local run/step loop can refer to the lexically
bound step/state fields of the stream being consed on to.

As Roman suggests, the best way to get GHC to optimise these
compositions would be to do something like extend GHC so it can do the
SAT by itself :-). Alternatively, a type-safe eta for data types
involving existentials would let me do what I want without GHC changes
- but I don't think there is a way to define this.

        Finally, if one doesn't like existentials, one can try
 universals:
        http://okmij.org/ftp/Algorithms.html#zip-folds
        http://okmij.org/ftp/Haskell/zip-folds.lhs

I hadn't seen this - thanks! It is certainly a neat trick. I can't
quite see how to use it to eliminate the existential I'm actually
interested eta-expanding without causing work duplication, but I'll
keep thinking about it.

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


[Haskell-cafe] A State Monad Tutorial

2010-10-19 Thread Artyom Kazak
Some time ago I have read A State Monad Tutorial
(http://strabismicgobbledygook.wordpress.com/2010/03/06/a-state-monad-tutorial/).
While reading, I was fixing some minor mistakes (okay, a lot of
mistakes). After all, I had an idea to create PDF with fixed version.
So, here it is: http://dl.dropbox.com/u/8662438/A%20State%20Monad%20Tutorial.pdf
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Haskellers.com skills list moderation?

2010-10-19 Thread Michael Snoyman
Alright, adding skills is now only possible by an admin. In the place
where we previously had add a skill, we now have request a new
skill. That's the easy part. Now we need to determine which skills
stay, and which ones go. I think the vast majority of them are fine,
so I'll leave them at the end of this email. If anyone thinks I'm
being to generous by allowing a specific still to say, just say so.

There's only two skills which I think absolutely must go:

Other languages I know: C# .NET, XSLT, Microsoft SQL Server, XML, SQL,
CSS, C, C++, Java, HTML, Visual Basic Script, Pascal, Rexx, Basic and
assembler
tool building

There are 11 skills I'm leaning towards dropping, all because they
fall in the too vague/too general category. Your input is requested on
these. They are:

Attribute Grammar
Cabal, packaging, build and distribution tools
Categorical Programming
Denotational design
Digital Forensics
Fault Tolerant Server Software
Mathematics
Programming using Arrows
Proving observational equivalence between Haskell programs
Transactional business applications development
UNIX Scripting and Tool Authoring

Of the remaining 32 skills, some of them fall in the too specific
range just a bit (software transactional memory, property based
testing), but I'm inclined to let it slide. These 32 are:

Advanced type-level programming (GADTs, TypeFamilies, proofs, etc.)
Algorithmic Problem Solving
Bioinformatics
Concurrent Haskell
DSL Design
Darcs internals
Foreign Function Interface (FFI)
Formal Verification
Functional graphics programming (2D, 3D, GPU)
GHC internals
Generic Programming
Graphical User Interfaces
Happstack Web Framework
Hardware Acceleration DSLs
Haskell on embedded devices
High Assurance Software Development
High-performance Haskell
Metaprogamming via Template Haskell
Natural Language Processing (tagging, parsing, translation,...)
Physics  Simulation
Programming language translation
Property based testing (QuickCheck)
Purely functional data structures — design and implementation
Reverse Engineering
Robotics and Automation
Signal Processing
Software Transactional Memory
Teaching Haskell
Web development (HTML, CSS and Javascript)
Yesod Web Framework

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


Re: [Haskell-cafe] Haskellers.com skills list moderation?

2010-10-19 Thread Michael Snoyman
Hey JP,

It's a tough question you're asking. I think areas directly applicable
with Haskell, such as bioinformatics, games, physics simulations, are
a pretty easy yes. Some more complicated things would be related
skills, such as knowing other programming languages, system
administration, etc. I would like to hear the cafe's opinion on that;
my gut feeling is a yes is moderation. Having a web programming
skill seems OK, but I wouldn't want to put in HTML5, Javascript, CSS 3
and so on as separate skills.

Michael

On Tue, Oct 19, 2010 at 3:45 PM, JP Moresmau jpmores...@gmail.com wrote:
 Are skills only Haskell related? I mean, are they only subcategories of
 haskell programming. Because bioinformatics is there, and in that case
 it shouldn't be. If skills include any application domain where people might
 use Haskell, the list will be much bigger, and surely the Hackage categories
 can be of use (for example, for me, I would request Games, Artificial
 Intelligence...).
 And, thanks for doing haskellers, great work! One day I want to really do a
 web application in Haskell and I'll sure give a go to yesod.
 JP

 On Tue, Oct 19, 2010 at 3:32 PM, Michael Snoyman mich...@snoyman.com
 wrote:

 Alright, adding skills is now only possible by an admin. In the place
 where we previously had add a skill, we now have request a new
 skill. That's the easy part. Now we need to determine which skills
 stay, and which ones go. I think the vast majority of them are fine,
 so I'll leave them at the end of this email. If anyone thinks I'm
 being to generous by allowing a specific still to say, just say so.

 There's only two skills which I think absolutely must go:

 Other languages I know: C# .NET, XSLT, Microsoft SQL Server, XML, SQL,
 CSS, C, C++, Java, HTML, Visual Basic Script, Pascal, Rexx, Basic and
 assembler
 tool building

 There are 11 skills I'm leaning towards dropping, all because they
 fall in the too vague/too general category. Your input is requested on
 these. They are:

 Attribute Grammar
 Cabal, packaging, build and distribution tools
 Categorical Programming
 Denotational design
 Digital Forensics
 Fault Tolerant Server Software
 Mathematics
 Programming using Arrows
 Proving observational equivalence between Haskell programs
 Transactional business applications development
 UNIX Scripting and Tool Authoring

 Of the remaining 32 skills, some of them fall in the too specific
 range just a bit (software transactional memory, property based
 testing), but I'm inclined to let it slide. These 32 are:

 Advanced type-level programming (GADTs, TypeFamilies, proofs, etc.)
 Algorithmic Problem Solving
 Bioinformatics
 Concurrent Haskell
 DSL Design
 Darcs internals
 Foreign Function Interface (FFI)
 Formal Verification
 Functional graphics programming (2D, 3D, GPU)
 GHC internals
 Generic Programming
 Graphical User Interfaces
 Happstack Web Framework
 Hardware Acceleration DSLs
 Haskell on embedded devices
 High Assurance Software Development
 High-performance Haskell
 Metaprogamming via Template Haskell
 Natural Language Processing (tagging, parsing, translation,...)
 Physics  Simulation
 Programming language translation
 Property based testing (QuickCheck)
 Purely functional data structures — design and implementation
 Reverse Engineering
 Robotics and Automation
 Signal Processing
 Software Transactional Memory
 Teaching Haskell
 Web development (HTML, CSS and Javascript)
 Yesod Web Framework

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



 --
 JP Moresmau
 http://jpmoresmau.blogspot.com/

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


Re: [Haskell-cafe] Compiling a DSL on the shoulders of GHC

2010-10-19 Thread Tom Hawkins
On Tue, Oct 19, 2010 at 7:54 AM, Patai Gergely
patai_gerg...@fastmail.fm wrote:
 I have nearly the same plan: I want to compile a restrictive form of
 Haskell to constant time and space C code for hard realtime embedded
 targets.  Except I need a top level monad with different semantics
 than IO.
 Which language is that? ImProve?

No.  It would be something STMish, similar to Atom.

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


[Haskell-cafe] Re: A rant against the blurb on the Haskell front page

2010-10-19 Thread Heinrich Apfelmus

Henning Thielemann wrote:

Vo Minh Thu schrieb:


Every once in a while, a discussion about the top-level text on
Haskell.org pops in this list. Without paying much attention to this
thread, and without digging the older threads, it occurs to me that
different people have very different opinion on this subject. I think
this is not a problem at all, because of the following thought:

When someone is interested enough in a programming language to land on
its homepage (i.e. haskell.org here), that someone has enough
resources at her disposal to make a somewhat informed choice, and
those resources can't be only a top-level text on the homepage.


When thinking about What would I like to see when judging a programming
language?, I found that I most like a gallery of small example programs.


I started such a gallery in the style of a restaurant menu some years 
ago, but never got around to finishing it:


  http://www.haskell.org/haskellwiki/Haskell_a_la_carte


Regards,
Heinrich Apfelmus

--
http://apfelmus.nfshost.com

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


[Haskell-cafe] profiling cabal libraries

2010-10-19 Thread Tom Hawkins
How do I profile cabal libraries?

I cabal install -p a local package I am testing, and I compile a
test of the library using -prof -auto-all.  But the profiling report
only lists a CAF entry for the library, but does not detail any of the
library's top level functions.

What am I doing wrong?

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


Re: [Haskell-cafe] profiling cabal libraries

2010-10-19 Thread Vo Minh Thu
2010/10/19 Tom Hawkins tomahawk...@gmail.com:
 How do I profile cabal libraries?

 I cabal install -p a local package I am testing, and I compile a
 test of the library using -prof -auto-all.  But the profiling report
 only lists a CAF entry for the library, but does not detail any of the
 library's top level functions.

 What am I doing wrong?

Maybe use -auto-all for compiling the library itself too?

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


Re: [Haskell-cafe] profiling cabal libraries

2010-10-19 Thread Bryan O'Sullivan
On Tue, Oct 19, 2010 at 8:42 AM, Tom Hawkins tomahawk...@gmail.com wrote:


 I cabal install -p a local package I am testing, and I compile a
 test of the library using -prof -auto-all.  But the profiling report
 only lists a CAF entry for the library, but does not detail any of the
 library's top level functions.


That's expected and normal. You either have to manually add SCC annotations
to code, or if you want the usual automated ones, add the following to your
.cabal file:

ghc-prof-options: -auto-all
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] HaskellDB/ODBC/MySQL issue

2010-10-19 Thread Neil Davies
Hi

I can't seem to get the combination of HaskellDB/ODBC/MySQL to even get off the 
ground, example:

import OmlqDBConnectData (connect'options)
import Database.HaskellDB
import Database.HaskellDB.HDBC.ODBC (odbcConnect)
import Database.HaskellDB.Sql.MySQL (generator)

main = odbcConnect generator connect'options 
  $ \db - tables db = print

gives me 

Prelude.(!!): index too large

Suggestions?

Cheers

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


Re: [Haskell-cafe] An interesting paper from Google

2010-10-19 Thread Brandon S Allbery KF8NH
-BEGIN PGP SIGNED MESSAGE-
Hash: SHA1

On 10/18/10 21:37 , Evan Laforge wrote:
 For instance, currently I have the top consumer of both time and alloc
 as 'get', which is 'lift . Monad.State.Strict.get'.  Of course it
 occurs in a million places in the complete profile, along with
 mysteries like a line with 0 entries 0.7%/0.1 time/alloc.  Doesn't 0
 entries mean it was never called?  Meanwhile, a line with 37000
 entries has 0.2/0.2.  Is the difference how the 'get'ed value was
 used?  And then there's the wider question of how 'get' is taking so
 much time and space.  Doesn't it just return a pointer to the State
 value?  Biographical profiling shows large amounts of void, lag, and
 drag, but no clear way to trace that to the code that is responsible.

Any time you see something inexplicable like lots of time being attributed
to something simple like get, it means that something isn't strict enough
and get is having to force a bunch of lazy evaluations to do its job.
Since you're using State.Strict but lift-ing to get there, I'd first look at
the strictness of the monad you're lift-ing from.  (I'm assuming
State.Strict does what the label says, but it's possible that it's not
strict in the way you need; strictness is kinda tricky.)

Moral of the story:  time is accounted to the function that forces
evaluation of lazy thunks, not to the thunks themselves or the function that
created the lazy thunks.  (I think the latter is impossible without passing
around a lot of expensive baggage, and in any case doesn't tell you anything
useful; unexpected functions taking a lot of time, on the other hand, tells
you right away that there's excessive laziness in the invocation somewhere
and gives you a starting point to track it down.)

- -- 
brandon s. allbery [linux,solaris,freebsd,perl]  allb...@kf8nh.com
system administrator  [openafs,heimdal,too many hats]  allb...@ece.cmu.edu
electrical and computer engineering, carnegie mellon university  KF8NH
-BEGIN PGP SIGNATURE-
Version: GnuPG v2.0.10 (Darwin)
Comment: Using GnuPG with Mozilla - http://enigmail.mozdev.org/

iEYEARECAAYFAky9zQ8ACgkQIn7hlCsL25UvhACeIGaziKg+nx6cTWRLnwjf0T5c
Gg8An1ZvNSDj/NXh032wsTGWZjLxZ7xD
=VPo+
-END PGP SIGNATURE-
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Template Haskell: onward and upward

2010-10-19 Thread Brandon Moore
From: Simon Peyton-Jones simo...@microsoft.com
Sent: Mon, October 18, 2010 5:02:57 PM
  
Folks
 
Following lots of feedback from users, especially at ICFP, I’ve evolved some 
proposals for Template Haskell, that should make it both more expressive, and 
more secure.
 
http://hackage.haskell.org/trac/ghc/blog/Template%20Haskell%20Proposal
 
Do let me know what you think.  Discussion by email is fine (cc me if it’s on 
Haskell-cafe), or comments direct on the Trac.  

A and B are both excellent ideas.

Less typechecking makes it easier to provide sugar for operations that
cannot be expressed nicely in the current type system, and also to
experiment with syntax. One example is

$(tmap 'Con [| [a, b, c, d] |]) = [Con a, Con b, Con c, Con d]

Another would be experimenting with monadic-case syntax
by making a macro that rewrites top-level case statements in
a quoted do block.

Case B starts to provide the sorts of static guarantees that
begin to justify (by using the result) the restrictions imposed
by typechecking splices ahead of time.

In D, adding a parseHaskell quasiquoter is an excellent idea.

This should be the proper fixpoint including all the current quasiquoters.
That might be easier to implement if the Haskell parser is passed as an argument
to the quasiquoters, rather than exposed as a binding in a module.

Brandon




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


Re: [Haskell-cafe] Haskellers.com skills list moderation?

2010-10-19 Thread Andrew Coppin

 On 18/10/2010 09:59 PM, Magnus Therning wrote:

On 18/10/10 21:56, Andrew Coppin wrote:

...I thought *I* was the only person who's ever heard of Rexx?

Every amiga user is very likely to have heard of rexx, as a close
relative to it was included in AmigaOS at some point.


...and I had of course assumed that I was the only person to have ever 
heard of the Amiga too.


(Not that I suppose it matters 10 years later...)

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


[Haskell-cafe] Happstack, RqData: (How) can I extract multiple data from form?

2010-10-19 Thread Никитин Лев


 Пересылаемое сообщение 
20.10.10, 00:22, Никитин Лев leon.v.niki...@pravmail.ru:

Are formlets integrated with HSP?

 hsp support is in a separate package:
 http://hackage.haskell.org/package/formlets-hsp
 There is a demo of using HSP+Formlets+Happstack here:
 http://src.seereason.com/formlets-hsp/examples/happs-hsp/
 hope this helps!
 - jeremy
 

Thanks! (Sorry for my stuped question)
 Завершение пересылаемого сообщения 
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] HaskellDB/ODBC/MySQL issue

2010-10-19 Thread Christopher Done
On 19 October 2010 18:51, Neil Davies semanticphilosop...@gmail.com wrote:
 Hi

 I can't seem to get the combination of HaskellDB/ODBC/MySQL to even get off 
 the ground, example:

 import OmlqDBConnectData (connect'options)
 import Database.HaskellDB
 import Database.HaskellDB.HDBC.ODBC (odbcConnect)
 import Database.HaskellDB.Sql.MySQL (generator)

 main = odbcConnect generator connect'options
      $ \db - tables db = print

 gives me

 Prelude.(!!): index too large

I ran a search for '!!' in HaskellDB and came up with nothing related.
Maybe you could search the ODBC or MySQL libraries for this. There
shouldn't be many instances of it (in fact in my opinion people
shouldn't use this non-total function at all). I've found the
HaskellDB libraries to be pretty easy to grok. Even if the bugs are
not. I'm using it with PostgreSQL.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Re: Eta-expansion and existentials (or: types destroy my laziness)

2010-10-19 Thread Dan Doel
On Tuesday 19 October 2010 6:16:16 am Max Bolingbroke wrote:

 Thanks - your definitions are similar to Roman's suggestion.
 Unfortunately my criteria 3) is not quite what I actually wanted - I
 really wanted something GHC-optimisable - (so non-recursive
 definitions are a necessary but not sufficient condition).

 ...

 I hadn't seen this - thanks! It is certainly a neat trick. I can't
 quite see how to use it to eliminate the existential I'm actually
 interested eta-expanding without causing work duplication, but I'll
 keep thinking about it.

I doubt it's possible, aside from your unsafeCoerce version.

The nub of the problem seems to me to be the lack of irrefutable match on the 
existential---irrefutable match should be equivalent to eta expanding values, 
so it's been intentionally disallowed. One could argue that this corresponds 
to their weak elimination:

  elim :: (forall a. P a - r) - (exists a. P a) - r

However, this argument is a bit circular, since that eliminator could be 
defined to behave similarly to an irrefutable match. One might expect it to be 
strict, but it isn't necessary (although it might be difficult to specify how 
such a lazy reduction would work formally, without resorting to other, 
stronger elimination principles).

Presumably, GHC requires strictness because of constraints that can be bundled 
in an existential. For one, with local equality constraints, it'd be unsound 
in the same way that irrefutable matches on a type equality GADT are. However, 
I also seem to recall that GHC expects all dictionaries to be strictly 
evaluated (for optimization purposes), while irrefutable matching on a 
constrained existential would introduce lazy dictionaries. Or, put another 
way, eta expansion of a dictionary-holding existential would result in a value 
holding a bottom dictionary, whereas that's otherwise impossible, I think.

However, your stream type has no constraints, so there's nothing that would 
make an irrefutable match unreasonable (unless I'm missing something). I don't 
expect GHC to start to support this, because, you can only use irrefutable 
matches on existentials without constraints, is a complicated rule. But I 
believe that is the core of your troubles, and it doesn't have any necessary 
connection to type safety in this case.

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


[Haskell-cafe] Re: libefence useful for debugging ghc+ffi programs?

2010-10-19 Thread Johannes Waldmann
some more info on this:

Program received signal SIGSEGV, Segmentation fault.
[Switching to Thread 0x42773950 (LWP 29449)]
0x7f717c70e370 in free () from /usr/lib/libefence.so.0
(gdb) where
#0  0x7f717c70e370 in free () from /usr/lib/libefence.so.0
#1  0x7f717b931ee9 in conn_free () from /usr/local/lib/libcurl.so.4
#2  0x7f717b9326fd in Curl_disconnect () from /usr/local/lib/libcurl.so.4
#3  0x7f717b932865 in ConnectionKillOne () from /usr/local/lib/libcurl.so.4
#4  0x7f717b9348a8 in Curl_close () from /usr/local/lib/libcurl.so.4
#5  0x0401 in ?? ()

is curl OK with the threaded runtime? 
I realize might have one curl connection active via hxt,
and another one because I call it directly.

J.W.


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


[Haskell-cafe] Are newtypes optimised and how much?

2010-10-19 Thread Christopher Done
So I have the following nice things:

{-# LANGUAGE GeneralizedNewtypeDeriving, OverloadedStrings #-}

import Data.String

newtype Foo = Foo { unFoo :: String } deriving (IsString)

x :: Foo
x = Hello, World!

newtype Bar = Bar { unBar :: Integer } deriving
(Eq,Show,Num,Integral,Real,Enum,Ord)

y :: Bar
y = 2

I can write literals and they will be converted to the type I wanted
with no extra verbiage needed.

Questions (I'm talking about GHC when I refer to compilation):

(1) Are fromString and fromIntegral ran at compile time? I don't think
that this is the case. I think they are just translated to fromString
Hello, World! and fromIntegral 2 verbatim.
(2) Regardless of this, the implementation of fromString and
fromIntegral is essentially a no-op, it's just fromString = Foo,
fromIntegral = Bar, which is in turn essentially fromString = id,
fromIntegral = id, as far as I understand it. It's purely compile
time. But supposing I write:

fromIntegral (fromIntegral (2::Integer) :: Bar) :: Integer

Is this at the end of the day equal to just (2::Integer)? Thinking
simple-mindedly, I would say, yes. The compiler knows that
fromIntegral :: Integer - Bar == id, and that fromIntegral :: Bar -
Integer == id (right?). But is that the case? Perhaps the type class
methods have some dictionary and thus cannot be inlined, or maybe that
doesn't matter?

At the end of the day what motivated me to ask these questions it that
I like very much defining newtypes for most of the types I use, I have
completely forgotten about `type' aliasing. I'm completely happy to
write Foo and unFoo all over the place to aid my type correctness, but
I want a nice generic way to convert to/from newtypes but keeping it a
compile-time concept. Sometimes I have unThisThat, unTheOther,
unThoseWhoShantBeNamed, etc. and it I could just use fromIntegral and
fromString then that would be super.

Also, is 'map unFoo' optimised away at compile-time, too? I think that
it would be compiled to map id. So it would still wrap a thunk around
each cons. How far does it go?

So, if I go around using fromIntegral/fromString (etc. for other
newtype types), is it still kept compile time? After having newtypes
catch dozens of type mismatches that otherwise wouldn't unified
happily but were completely wrong (e.g. wrong argument order), I've
found newtype to be an indispensable part of Haskell and of writing a
large piece of software.

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


Re: [Haskell-cafe] Haskellers.com skills list moderation?

2010-10-19 Thread Brandon S Allbery KF8NH
-BEGIN PGP SIGNED MESSAGE-
Hash: SHA1

On 10/19/10 13:09 , Andrew Coppin wrote:
  On 18/10/2010 09:59 PM, Magnus Therning wrote:
 On 18/10/10 21:56, Andrew Coppin wrote:
 ...I thought *I* was the only person who's ever heard of Rexx?
 Every amiga user is very likely to have heard of rexx, as a close
 relative to it was included in AmigaOS at some point.
 
 ...and I had of course assumed that I was the only person to have ever heard
 of the Amiga too.

Not to mention us old geekosaurs, some of whom have used (a) OS/2 (b) IBM
VM/SP, for which REXX was the standard scripting language.  (Fun stuff:
extending XEDIT with REXX code.)

- -- 
brandon s. allbery [linux,solaris,freebsd,perl]  allb...@kf8nh.com
system administrator  [openafs,heimdal,too many hats]  allb...@ece.cmu.edu
electrical and computer engineering, carnegie mellon university  KF8NH
-BEGIN PGP SIGNATURE-
Version: GnuPG v2.0.10 (Darwin)
Comment: Using GnuPG with Mozilla - http://enigmail.mozdev.org/

iEYEARECAAYFAky+U+EACgkQIn7hlCsL25VJAQCgzKsfXsTJ26r0Dlkhfb+eiMPq
XKMAn3D0ygw74Y4YbqKiNtVVkEa1W/cm
=/WfD
-END PGP SIGNATURE-
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] ANN: fountain-0.0.0

2010-10-19 Thread Tom Hawkins
This library [1] implements a fountain code [2].  Fountain codes are
forward error correction codes for erasure channels [3].  A fountain
code encodes a message into an infinite stream of packets --
transmitters generate message packets at random, on-the-fly.  To
reconstruct the message, receivers simply need to capture enough
packets for the decoding process.  As a rateless code, fountain codes
automatically adapt to varying channel conditions.

Some of the more interesting applications of fountain codes include
unsynchronized data broadcast and distributed download.  For example,
a multiple number of devices can transmitting content to multiple
receivers without any coordination.  Because packets are generated at
random, receivers increase their bandwidth simply by listening to more
transmitters.  Note that receivers can also start generating packets
and forwarding the message on even before they have decoded the
complete message.

This library provides a packet generator and a decoder for one of the
first known fountain codes: LT codes [4].  It also includes a test
function to experiment with message lengths, and encoding degrees --
it runs a simulation to determine the number of packets needed to
decode a message.

-Tom


[1] http://hackage.haskell.org/package/fountain
[2] http://en.wikipedia.org/wiki/Fountain_code
[3] http://en.wikipedia.org/wiki/Binary_erasure_channel
[4] http://en.wikipedia.org/wiki/LT_codes
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Why isn't there a cheaper split-in-two operation for Data.Set?

2010-10-19 Thread wren ng thornton

On 10/19/10 5:47 AM, Ryan Newton wrote:

That sounds good to me.  In any case the parallel map/fold operations by
themselves shouldn't compromise the abstraction.

Perhaps an eventual solution would be to start including parallel maps/folds
right inside the standard libraries.  I haven't began testing this yet but
it would seem that all the balanced tree implementations are good candidates
for a little `par` treatment.  Has this been tried somewhere already?
Alas, having par/nonpar versions of library functions compounds the
already present monadic/non-monadic schism...


Another problem is that the desirable level of parallelization isn't 
fixed. For example, let's consider a function f being mapped over a 
collection C.


With non-parallel map this has cost O(0*k) + O(C)*O(f) where k is the 
cost of spawning/reaping threads, O(C) is the size of the collection, 
and O(f) is the cost of running f once.


Now, consider mapPar2 which uses two threads. The cost of this is O(1*k) 
+ 2 `par` O(C)/2*O(f), where `par` is a kind of multiplication based on 
the level of parallelism actually achieved. With perfect paralellism 
x`par`y = y; with no parallelism x`par`y = x*y.


We can generalize this to O((n-1)*k) + n `par` O(C)/n*O(f) for n 
threads. But the problem is, depending on how big O(f) is relative to 
O(k), there's going to be a different n which gives the optimal 
tradeoff. If O(f) is small enough, then the overhead of sparking threads 
is wasted; if O(f) is middling, then we'd want a few threads but not 
too many; if O(f) is huge, then we want n = O(C) since the overhead 
disappears in the asymptotics. Thus, what we'd need to offer in the API 
is a set of evaluators in order to alter the level of parallelization.


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


Re: [Haskell-cafe] Haskellers.com skills list moderation?

2010-10-19 Thread wren ng thornton

On 10/19/10 9:32 AM, Michael Snoyman wrote:

There are 11 skills I'm leaning towards dropping, all because they
fall in the too vague/too general category. Your input is requested on
these. They are:

Attribute Grammar
Categorical Programming
Denotational design
Proving observational equivalence between Haskell programs


Taking all these together, they seem like they're trying to make more 
specific what someone means when they say they know mathematics. 
Bisimulation, denotational semantics, category theory, and AG are all 
popular mathematical techniques for writing robust functional programs. 
Perhaps they should be renamed to be a bit clearer to the uninitiated, 
but I see no reason to remove them. Perhaps something about domain 
theory should be added to the list.



Mathematics


Definitely too general IMO. Do we mean analytical mathematics (calculus, 
analytic geometry,...), discrete mathematics (sets, automata,...), 
algebraic mathematics (group theory, rings,...), or what? It might be 
worth having my more specific examples for folks who want to advertise 
having mathematics degrees, but just Mathematics is too vague.


 Cabal, packaging, build and distribution tools

This seems like a good one to keep. There's a difference between knowing 
a language itself, and knowing the ecosystem well enough to be an 
effective developer in a team setting. This is the kind of skill that 
employers really like to see, since it distinguishes hobbyists from 
folks who have used the language in a professional setting.


For example, I've known Java well enough to write programs in it for a 
long time. But I've only recently learned how to use Ant, PMD, FindBugs, 
TestNG, etc. Knowing those latter skills is what makes me a Java 
developer; not knowing the language. Similarly, one could consider 
knowing C++ vs knowing Boost etc.



UNIX Scripting and Tool Authoring


I think this one absolutely needs to stay. *nix scripting is a whole 
field of work, even though it's not generally recognized as such. This 
is what *nix sysadmins do all day (when they're not fighting fires). And 
it's one of the reasons why current NLP/SMT research is so painful (the 
lack of people writing the appropriate tools). Half of web development, 
in practice, often ends up being about this kind of thing too.


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


Re: [Haskell-cafe] Are newtypes optimised and how much?

2010-10-19 Thread wren ng thornton

On 10/19/10 2:12 PM, Christopher Done wrote:

Questions (I'm talking about GHC when I refer to compilation):

(1) Are fromString and fromIntegral ran at compile time? I don't think
that this is the case. I think they are just translated to fromString
Hello, World! and fromIntegral 2 verbatim.
(2) Regardless of this, the implementation of fromString and
fromIntegral is essentially a no-op, it's just fromString = Foo,
fromIntegral = Bar, which is in turn essentially fromString = id,
fromIntegral = id, as far as I understand it.


Foo and unFoo are /essentially/ id, but they're not actually id. In 
particular, they stick around as System Fc coersions in the core 
language, whereas id can be compiled away entirely. Unfortunately this 
means that rewrite rules involving id won't fire, which is why I often 
add things like:


{-# RULES
map Foomap   Foo = unsafeCoerce
fmap Foo   fmap  Foo = unsafeCoerce
liftA Foo  liftA Foo = unsafeCoerce
liftM Foo  liftM Foo = unsafeCoerce

map unFoo  map   unFoo = unsafeCoerce
fmap unFoo fmap  unFoo = unsafeCoerce
liftA unFooliftA unFoo = unsafeCoerce
liftM unFooliftM unFoo = unsafeCoerce
#-}

if I want to ensure them. Unfortunately, last I heard the use of 
unsafeCoerce can interfere with other rewrite rules, too, since it's 
also /essentially/ but not exactly id.


I'd love to get an up-to-date story on how exactly newtypes and things 
like fromString, fromInteger, fromEnum, and fromRational are handled re 
how they get optimized in GHC 7.


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


[Haskell-cafe] Return value of a (windows) process

2010-10-19 Thread Arnaud Bailly
Hello,
I have the following code (fragment) I use to wrap execution of
various processes in Haskell, in the spirit of Don Stewart's slides
about Scripting in Haskell.

instance MonadExec IO where
  exec proc args = do (exit, out, err) -  liftIO $
readProcessWithExitCode proc args 
  case exit of
ExitFailure e - throwError $ userError (Fail
execution of  ++ program proc args ++ :  ++ (show e) ++,  ++err)
ExitSuccess   - return out

Here is the abridged declaration of MonadExec:
class (Monad m) = MonadExec m  where
  exec  :: String - [String] - m String

The issue I am facing is that readProcessWithExitCode does not seem to
return the expected failures.
When I run some failing process within windows command shell, I have:

D:\projets\psug-dojo\lagsd:/Program
Files/scala-2.8.0/bin/scalac.bat -d target\test-classes -classpath
target\classes;D:\projets\
psug-dojo\lags\test-lib\specs_2.8.0-1.6.5.jar;D:\projets\psug-dojo\lags\test-lib\scalacheck_2.8.0-1.7.jar;D:\projets\psug-dojo\lags\
test-lib\junit-4.7.jar -d target\test-classes
src\test\scala\oqube\lags\LagsTest.scala
src\test\scala\oqube\lags\LagsTest.scala:86: error: not found: value beS_==
  bid.sublists(List(Request(1,2,3))) must
beS_==(List(Nil,List(Request(1,2,3
  ^
one error found

D:\projets\psug-dojo\lagsecho %ERRORLEVEL%
1

D:\projets\psug-dojo\lags

but wrapping this same process in my shell, I always got an ExitSuccess.

What am I doing wrong ?

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


[Haskell-cafe] Idea for a tool

2010-10-19 Thread Michael Snoyman
Hi all,

I saw a quote from Eric Kow via Neil Mitchell[1] that we don't spend
enough time writing tools. Well, I've decided that the most annoying
part of package maintainership right now is staying on top of new
versions of dependencies. We essentially have two options right now:

* Follow the PVP and put an upper bound on all dependencies, and
people will be upset when your package only works with the old version
of the dependency.
* Skip the upper bound, and risk having your code break when there's a
new version.

I have an idea for a tool: you give it a list of packages you
maintain, or even better yet, you give it your email address and it
gets that list automatically. Then is looks through all your
dependencies and sees if you have any upper bounds preventing newer
versions from being used. Bonus points for making it a web service
that just gives you an RSS feed.

If anyone's interested in writing a tool like that, let me know.
Otherwise, next time I'm twiddling my thumbs I'll try to throw it
together. I've never dealt directly with the Cabal library, but
there's a first time for everything. If someone else wants to write
that tool and wants help sticking a web service on it, let me know.

Michael

[1] http://neilmitchell.blogspot.com/2010/10/enhanced-cabal-sdist.html
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe