Re: [Haskell-cafe] Re: Overloading functions based on arguments?

2009-02-13 Thread Ketil Malde
"John A. De Goes"  writes:

> I'm referring to a rather conservative proposal wherein if there is
> one and exactly one definition that allows an expression to type, then
> name overloading in the same scope is permitted.

Perhaps this was discussed in the context of records and field
accessors? 

-k
-- 
If I haven't seen further, it is by standing in the footprints of giants
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Re: Overloading functions based on arguments?

2009-02-13 Thread Robert Greayer
-- John A. De Goes wrote:

>> Adding information cannot remove a contradiction from the information
>> set available to the compiler.

> But it can and often does, for example, for [] or 4. What's the type of 
> either expression without more information?

[] :: [a]

4 :: Num a => a

Do I win something?


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


Re: [Haskell-cafe] Re: Overloading functions based on arguments?

2009-02-13 Thread Krzysztof Skrzętnicki
On Fri, Feb 13, 2009 at 22:37, John A. De Goes  wrote:
> On Feb 13, 2009, at 2:11 PM, Jonathan Cast wrote:
>>
>> The compiler should fail when you tell it two mutually contradictory
>> things, and only when you tell it two mutually contradictory things.
>
> By definition, it's not a contradiction when the symbol is unambiguously
> typeable. Do you think math textbooks are filled with contradictions when
> they give '+' a different meaning for vectors than matrices or real
> numbers???

I can easily imagine a book which uses some operator in ambiguous way
yet relies on readers' intelligence in solving that issue. It is OK to
do that as
long as it is easy. However: it can get arbitrarily worse. I would
consider any book which is hard
to read because of that badly written. Things are quite similar with the code.

> Type is implicitly or explicitly a part of the definition of every function.
> It's not the name that need be unique, but the name over a given domain.
> When two functions have different domains, the same name can be
> unambiguously used to describe both of them.

I think the whole point is not about what is and what isn't possible
to implement.
For example GHC often can do just fine with undecidable instances
despite the problems they may cause.
Programming language should be easy to reason about for both computers
and humans. Compiler should therefore disallow programming style that is
inaccessible for potential readers. Want to overload something? Well,
use typeclasses to
be explicit about it.

All best

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


Re: [Haskell-cafe] Delimited continuations: please comment

2009-02-13 Thread Brandon S. Allbery KF8NH

On 2009 Feb 12, at 11:55, Cristiano Paris wrote:

import Control.Monad.Trans  -- why do I have to import this?



liftIO is defined there, I believe.  Many of the monad modules re- 
export it with their MonadTrans definitions, but apparently  
Control.Monad.CC doesn't so you need to go to the source.


--
brandon s. allbery [solaris,freebsd,perl,pugs,haskell] allb...@kf8nh.com
system administrator [openafs,heimdal,too many hats] allb...@ece.cmu.edu
electrical and computer engineering, carnegie mellon universityKF8NH




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] Re: Complex C99 type in Foreign

2009-02-13 Thread Maurí­cio

Are there plans to include C99 'complex' type
in Foreign, maybe as CFloatComplex, CDoubleComplex

A separate library for new types to add to Foreign would be the easiest
way forward. Just put the foreign-c99 package on Hackage?

(...) I could actually have some
arbitrary sized parameter as argument to a function
or as a return value (and not its pointer), what
did I saw wrong? I understand only Foreign.C.C*
types or forall a. => Foreign.Ptr.Ptr a can be used
like that.

Oh, you mean you need to teach the compiler about unboxed complex types?


I'm sorry, maybe I didn't understand you well. Are
you saying that I could get this 'CComplex' type using
unboxed types and other things already available?


Yes, because the C standard guarantees that a complex  is
stored as [2].

I have been using the following, for binding to FFTW:


The way you wrote CComplex a, is it possible to write

foreign import ccall "somename" somename
  :: CComplex CDouble -> IO CComplex CDouble

?

Thanks,
Maurício

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


Re: [Haskell-cafe] Infinite types should be optionally allowed

2009-02-13 Thread Luke Palmer
On Fri, Feb 13, 2009 at 4:04 PM, Luke Palmer  wrote:

> On Fri, Feb 13, 2009 at 3:13 PM, Job Vranish  wrote:
>
>> There are good reasons against allowing infinite types by default
>> (mostly, that a lot of things type check that are normally not what we
>> want). An old haskell cafe conversation on the topic is here:
>>
>> http://www.nabble.com/There%27s-nothing-wrong-with-infinite-types!-td7713737.html
>>
>> However, I think infinite types should be allowed, but only with an
>> explicit type signature. In other words, don't allow infinite types to
>> be inferred, but if they are specified, let them pass. I think it
>> would be very hard to shoot yourself in the foot this way.
>
>
Oops!  I'm sorry, I completely misread the proposal.  Or read it correctly,
saw an undecidability hiding in there, and got carried away.

What you are proposing is called equi-recursive types, in contrast to the
more popular iso-recursive types (which Haskell uses).  There are plentiful
undecidable problems with equi-recursive types, but there are ways to pull
it off.  The question is whether these ways play nicely with Haskell's type
system.

But because of the fundamental computational problems associated, there
needs to be a great deal of certainty that this is even possible before
considering its language design implications.


>
> That inference engine seems to be a pretty little proof-of-concept, doesn't
> it?  But it is sweeping some very important stuff under the carpet.
>
> The proposal is to infer the type of a term,  then check it against an
> annotation.  Thus every program is well-typed, but it's the compiler's job
> to check that it has the type the user intended.  I like the idea.
>
> But the inference engine is only half of the story.  It does no type
> checking.  Although checking is often viewed as the easier of the two
> problems, in this case it is not.  A term has no normal form if and only if
> its type is equal to (forall a. a).  You can see the problem here.
>
> Luke
>
>
>>
>> Newtype is the standard solution to situations where you really need
>> an infinite type, but in some cases this can be a big annoyance. Using
>> newtype sacrifices data type abstraction and very useful type classes
>> like Functor. You can use multiparameter type classes and functional
>> dependencies to recover some of the lost abstraction, but then type
>> checking becomes harder to reason about and the code gets way more
>> ugly (If you doubt, let me know, I have some examples). Allowing
>> infinite types would fix this.
>>
>> I'm imagining a syntax something like this:
>> someFunctionThatCreatesInfiniteType :: a -> b | b = [(a, b)]
>>
>> Thoughts? Opinions? Am I missing anything obvious?
>>
>> - Job
>> ___
>> 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] Infinite types should be optionally allowed

2009-02-13 Thread Luke Palmer
On Fri, Feb 13, 2009 at 3:13 PM, Job Vranish  wrote:

> There are good reasons against allowing infinite types by default
> (mostly, that a lot of things type check that are normally not what we
> want). An old haskell cafe conversation on the topic is here:
>
> http://www.nabble.com/There%27s-nothing-wrong-with-infinite-types!-td7713737.html
>
> However, I think infinite types should be allowed, but only with an
> explicit type signature. In other words, don't allow infinite types to
> be inferred, but if they are specified, let them pass. I think it
> would be very hard to shoot yourself in the foot this way.


That inference engine seems to be a pretty little proof-of-concept, doesn't
it?  But it is sweeping some very important stuff under the carpet.

The proposal is to infer the type of a term,  then check it against an
annotation.  Thus every program is well-typed, but it's the compiler's job
to check that it has the type the user intended.  I like the idea.

But the inference engine is only half of the story.  It does no type
checking.  Although checking is often viewed as the easier of the two
problems, in this case it is not.  A term has no normal form if and only if
its type is equal to (forall a. a).  You can see the problem here.

Luke


>
> Newtype is the standard solution to situations where you really need
> an infinite type, but in some cases this can be a big annoyance. Using
> newtype sacrifices data type abstraction and very useful type classes
> like Functor. You can use multiparameter type classes and functional
> dependencies to recover some of the lost abstraction, but then type
> checking becomes harder to reason about and the code gets way more
> ugly (If you doubt, let me know, I have some examples). Allowing
> infinite types would fix this.
>
> I'm imagining a syntax something like this:
> someFunctionThatCreatesInfiniteType :: a -> b | b = [(a, b)]
>
> Thoughts? Opinions? Am I missing anything obvious?
>
> - Job
> ___
> 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] Semantic web

2009-02-13 Thread Doug Burke


> - Original Message 
> From: Don Stewart 
> To: gregg reynolds 
> Cc: haskell-cafe@haskell.org
> Sent: Saturday, February 7, 2009 2:40:41 PM
> Subject: Re: [Haskell-cafe] Semantic web
>
> dev:
>> Anybody implementing rdf or owl  stuff in haskell?  Seems like a natural fit.
>
> http://www.ninebynine.org/RDFNotes/Swish/Intro.html
> 
> Needs moving to Hackage.

There is also 

http://protempore.net/rdf4h/ 

which I haven't used and doesn't look to be particularly active at the moment.

Doug



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


[Haskell-cafe] Infinite types should be optionally allowed

2009-02-13 Thread Job Vranish
There are good reasons against allowing infinite types by default
(mostly, that a lot of things type check that are normally not what we
want). An old haskell cafe conversation on the topic is here:
http://www.nabble.com/There%27s-nothing-wrong-with-infinite-types!-td7713737.html

However, I think infinite types should be allowed, but only with an
explicit type signature. In other words, don't allow infinite types to
be inferred, but if they are specified, let them pass. I think it
would be very hard to shoot yourself in the foot this way.

Newtype is the standard solution to situations where you really need
an infinite type, but in some cases this can be a big annoyance. Using
newtype sacrifices data type abstraction and very useful type classes
like Functor. You can use multiparameter type classes and functional
dependencies to recover some of the lost abstraction, but then type
checking becomes harder to reason about and the code gets way more
ugly (If you doubt, let me know, I have some examples). Allowing
infinite types would fix this.

I'm imagining a syntax something like this:
someFunctionThatCreatesInfiniteType :: a -> b | b = [(a, b)]

Thoughts? Opinions? Am I missing anything obvious?

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


Re: [Haskell-cafe] IO semantics and evaluation - summary

2009-02-13 Thread roconnor
I also recommend reading 
 (mostly because I wrote 
it).  Feel free to improve upon it.


--
Russell O'Connor  
``All talk about `theft,''' the general counsel of the American Graphophone
Company wrote, ``is the merest claptrap, for there exists no property in
ideas musical, literary or artistic, except as defined by statute.''
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Help needed with apache config for hackage

2009-02-13 Thread George Pollard
On Fri, 2009-02-13 at 12:19 +, Duncan Coutts wrote:
> Can we do that just for one user agent? I don't think we want to use
> non-standard stuff in general. Apparently Content-Disposition is not in
> the official HTTP spec, but IE is known to follow it.

It's not in the HTTP spec, but it's about as official as something that
isn't can be :) [1] I believe all web browsers in common use support it.
(And it shouldn't cause any problems for those that don't, who will just
ignore it.)

- George

[1]: http://www.ietf.org/rfc/rfc2183.txt


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] IO semantics and evaluation - summary

2009-02-13 Thread Gregg Reynolds
Hi Daryoush,

2009/2/13 Daryoush Mehrtash 

> I have been trying to figure out the distinction between value, function
> and computation. You raised a few points that I am not sure about.
>
>
> In " "Computation" considered harmful. "Value" not so hot either." you
> said:
>
> I still don't like it; a lambda expression is not a computation, it's a
> formal *representation* of a mathematical object (a *value*).
>
>
> Isn't the lambda expression a representation of  something (potentially
> with recursion) that yields "a value" and not the value itself?   Even
> integer which we think of as values are represented in the same way:
> http://safalra.com/science/lambda-calculus/integer-arithmetic/
>

Excellent question, and it illustrates the problem of "abstraction
management" very nicely.  The way Church presented the lambda operator in
"Introduction to Mathematical Logic" is very instructive.  The basic idea
was how to avoid having to name functions.  This is a very pragmatic
concern; if we didn't have the lambda operator, we would have to invent a
name for every function we want to discuss, which would quickly lead to
unmanageable clutter for both writer and reader.  Church put it in terms
like this:  "x + 2" is a formula, but it doesn't denote anything, since x is
free.  It's not completely devoid of meaning - we get the "+ 2" part - but
it's an "open sentence": not a function, not a value (or: not the name of a
function or value).  But there is a function /associated/ with the formula;
we can denote that function, but only by introducing a name: f x = x + 2.
Now f denotes the function associated with the formula.  Which means we have
two things: syntax, and semantics.  Actually three things, since the name f
is a thing.  The lambda operator just allows us to do the same thing without
names:  the expression "lambda x.x+2" denotes the function associated with
the form x + 2.

So a lambda abstraction expression denotes a function without naming it.
IOW, the function is not the formula; it is an abstract mathematical thing.
A lambda application expression - e.g. (\x -> x + 2)3 denotes application of
the function to an argument.  Here '3' names a "value"; but the value and
the name are distinct.  Lambda calculus thinks of function application in
terms of rewriting forms - it's a calculus, it just manipulates the symbolic
forms.  In other words, the fact that \x -> x + 2 and 3 denote values isn't
important; we say the application denotes 5 because of syntactic rules.  5
is just a symbol that replaces the application expression.

The contrast with ZF set theory helps.  In a set theoretic account,
functions are just sets of ordered pairs.  Application just projects the
second element of the function pair whose first element is equal to the
argument.  The notion of algorithm or computation is totally absent; that's
why ZF is so attractive for semantics.  We only want to know what an
expression means, not how its meaning was discovererd.

So even though lambda calculus may used to describe the symbolic
manipulations needed to find the value of an application, it is not accurate
to say that a lambda expression represents a computation or something that
yields a value, as you put it.  Or at any rate that it /only/ represents a
computation.  It is entirely legitimate to say that "(\x -> x+2)3" denotes 5
(or more accurately, the value represented by the symbol '5'); that
represents the set theoretic perspective.  But lambda calculus licenses us
the think of the same expression as a representation of the reduction chain
leading to the symbol '5'.  So it really depends on your perspective.


>
> In " Fixing Haskell IO" you say:
>
> This "works" well enough; GHC manages to perform IO. But it doesn't fly
>> mathematically. Mathematical objects *never* act, sing, dance, or 
>> *do*anything. They just are. A value that acts is an oxymoron.
>>
>
>
> I guess I am not sure what a "mathematical object" is.   Do you consider
> Newton method a mathematical object?   What would be the "value" :
> http://en.wikipedia.org/wiki/Newton's_method#Square_root_of_a_number
>

Again, it all depends on perspective.  A formal method can be considered a
mathematical object: a sequence.  Just like a lambda expression, viewed as a
representation of a sequence of reductions.  But here again, the
representation and the thing represented are not the same.  Newton's method
is an algorithm, which exists independently of any particular
representation, just like the integer "three" is independent of the symbolic
conventions we use to denote it.   So Newton's method can be considered a
value, just as an algorithm is a kind of value, in the abstract.  And the
function "sqrt" can be considered a value, independent of any algorithm.
Application of Newton's method - note I said "application", not "syntactic
representation of application" can be thought of as a value, or an
algorithmic 

Re: [Haskell-cafe] Re: Overloading functions based on arguments?

2009-02-13 Thread John A. De Goes

On Feb 13, 2009, at 2:11 PM, Jonathan Cast wrote:

The compiler should fail when you tell it two mutually contradictory
things, and only when you tell it two mutually contradictory things.


By definition, it's not a contradiction when the symbol is  
unambiguously typeable. Do you think math textbooks are filled with  
contradictions when they give '+' a different meaning for vectors than  
matrices or real numbers???


Type is implicitly or explicitly a part of the definition of every  
function. It's not the name that need be unique, but the name over a  
given domain. When two functions have different domains, the same name  
can be unambiguously used to describe both of them.



Adding information cannot remove a contradiction from the information
set available to the compiler.


But it can and often does, for example, for [] or 4. What's the type  
of either expression without more information?


Regards,

John A. De Goes
N-BRAIN, Inc.
The Evolution of Collaboration

http://www.n-brain.net|877-376-2724 x 101


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


[Haskell-cafe] Re: Complex C99 type in Foreign

2009-02-13 Thread Aaron Denney
On 2009-02-03, Maurí­cio  wrote:
> Are there plans to include C99 'complex' type
> in Foreign, maybe as CFloatComplex, CDoubleComplex
>
 A separate library for new types to add to Foreign would be the easiest
 way forward. Just put the foreign-c99 package on Hackage?
>
>>> (...) I could actually have some
>>> arbitrary sized parameter as argument to a function
>>> or as a return value (and not its pointer), what
>>> did I saw wrong? I understand only Foreign.C.C*
>>> types or forall a. => Foreign.Ptr.Ptr a can be used
>>> like that.
>> 
>> Oh, you mean you need to teach the compiler about unboxed complex types?
>> 
>
> I'm sorry, maybe I didn't understand you well. Are
> you saying that I could get this 'CComplex' type using
> unboxed types and other things already available?

Yes, because the C standard guarantees that a complex  is
stored as [2].

I have been using the following, for binding to FFTW:

-
-- |
-- Module  : CComplex
-- Copyright   : (c) Aaron Denney 2004
-- License : BSD, 2-clause
-- 
-- Maintainer  : wnoise-hask...@ofb.net
-- Stability   : experimental
-- Portability : FFI
--
-- Aims to provide "CComplex a" parameterized type representing C99's
-- complex types and provide Storable instances for both it and
-- Haskell's Complex a types.  Note that C99 can parameterize over
-- integral types -- I think it's a mistake for Complex to not be
-- defined over all Real types.
--
-- For efficiency of common use, we use C's representation for easy
-- conversion.  So, we can be sloppy and use Complex CDouble instead of
-- CComplex CDouble.  In fact, for now CComplex is merely a type synonym
-- for Complex.
--
-- Will hopefully become obsolete when the FFI is revised to include the
-- complex types of C99.


module CComplex (CComplex) where
import Complex (Complex(..))
import Foreign.Ptr (castPtr)
import Foreign.Storable

-- C 99 specifies that a variable v of type complex t is stored as
-- t v [2], with v[0] the real part and v[1] the imaginary part.
-- elem off and byte off are defaulted, but perhaps shouldn't be,
-- for efficiency.

instance (RealFloat a, Storable a) => Storable (Complex a) where
sizeOf x= 2 * sizeOf (f x)
alignment x = alignment  (f x)
poke  x (a :+ b) = do let y = castPtr x
  poke y a
  pokeElemOff y 1 b
peek  x  = do let y = castPtr x
  a <- peek y
  b <- peekElemOff y 1
  return (a :+ b)

type CComplex a = Complex a

f :: Complex a -> a
f _ = undefined 


HTH.

-- 
Aaron Denney
-><-

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


Re: [Haskell-cafe] Re: Overloading functions based on arguments?

2009-02-13 Thread Jonathan Cast
On Fri, 2009-02-13 at 21:57 +0100, Daniel Fischer wrote:
> Am Freitag, 13. Februar 2009 21:08 schrieb Jonathan Cast:
> > On Fri, 2009-02-13 at 12:15 -0700, John A. De Goes wrote:
> > > On Feb 13, 2009, at 12:07 PM, Jonathan Cast wrote:
> > > > Exactly!  But if it fails, why on earth should any other use of map in
> > > > the module succeed?
> > >
> > > Because more information is known about other usages of map. Such is
> > > the nature of type inference.
> >
> > No it's not.  Type inference -- in Haskell --- means --- by definition!
> > --- looking up the principle type of each sub-term, specializing it
> > based on its use, and then generalizing to find the principle type of
> > the overall term.  Adding information can cause type inference to fail,
> > but --- in Haskell as it exists --- it cannot cause type inference to
> > succeed.
> 
> I'm not sure about the finer distinctions between type inference and type 
> checking as performed by Haskell implementations when compiling a module, but 
> what about polymorphic recursion, where adding information via a type 
> signature can be necessary to make the compilation succeed?

Um, sort of.  Adding --- or relaxing --- a type signature on a function
you *call* can make typing succeed when it would have failed.  But take
the recursion out of polymorphic recursion and it does become
problematic, yes.  For much the same reason the monomorphism restriction
is problematic, actually.

> Not what this thread is about, though.
> 
> >  Which is good!
> 
> Why is it good?

The compiler should fail when you tell it two mutually contradictory
things, and only when you tell it two mutually contradictory things.
Adding information cannot remove a contradiction from the information
set available to the compiler.  Therefore it should not stop the
compiler from failing.

And that is all I will say on this subject.

jcc


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


Re: [Haskell-cafe] Re: Overloading functions based on arguments?

2009-02-13 Thread Daniel Fischer
Am Freitag, 13. Februar 2009 21:08 schrieb Jonathan Cast:
> On Fri, 2009-02-13 at 12:15 -0700, John A. De Goes wrote:
> > On Feb 13, 2009, at 12:07 PM, Jonathan Cast wrote:
> > > Exactly!  But if it fails, why on earth should any other use of map in
> > > the module succeed?
> >
> > Because more information is known about other usages of map. Such is
> > the nature of type inference.
>
> No it's not.  Type inference -- in Haskell --- means --- by definition!
> --- looking up the principle type of each sub-term, specializing it
> based on its use, and then generalizing to find the principle type of
> the overall term.  Adding information can cause type inference to fail,
> but --- in Haskell as it exists --- it cannot cause type inference to
> succeed.

I'm not sure about the finer distinctions between type inference and type 
checking as performed by Haskell implementations when compiling a module, but 
what about polymorphic recursion, where adding information via a type 
signature can be necessary to make the compilation succeed?

Not what this thread is about, though.

>  Which is good!

Why is it good?
Because using additional information to make type inference succeed would 
cause an ad hoc and hard to reason about type inference algorithm?
Or other reasons?

>
> jcc
>
Cheers,
Daniel

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


Re: [Haskell-cafe] createProcess shutting file handles

2009-02-13 Thread Duncan Coutts
On Fri, 2009-02-13 at 15:38 +, Neil Mitchell wrote:

> What have I done wrong? Did createProcess close the handle, and is
> there a way round this?

The docs for runProcess says:

Any Handles passed to runProcess are placed immediately in the
closed state.

but the equivalent seems to be missing from the documentation for
createProcess.

I'm not exactly sure what the justification is. I thought at first it
might be for the H98 many readers or single writer rule, but it's not
obvious how that applies here.

Duncan

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


Re: [Haskell-cafe] Re: Overloading functions based on arguments?

2009-02-13 Thread John A. De Goes

On Feb 13, 2009, at 1:38 PM, Daniel Fischer wrote:

? Well, still easy, we must unify with (a -> b) -> c -> [d], only one
possibility, fine. Or is it? What if we have another 'take' in scope?
Say take :: Int -> Set a -> Set a ? Oops.
So, where draw the line?


You draw the line exactly when you cannot perform unambiguous typing.


Bottom line, allowing that sort of overloading would at least be very
ad-hoccish, and probably a bad thing.


Why? All existing programs would type check and run without  
modification. So if you really like type class abuse and a billion  
pseudonyms for '+' (among others), then you would still have the  
option of developing in that style.


On the other hand, if you wanted the machine to do what a human can  
(which is, deciding in completely unambiguous cases which of several  
definitions to use), then you'd be able to use name overloading and  
make some programs a lot more readable.


Regards,

John A. De Goes
N-BRAIN, Inc.
The Evolution of Collaboration

http://www.n-brain.net|877-376-2724 x 101


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


Re: [Haskell-cafe] Re: Overloading functions based on arguments?

2009-02-13 Thread David Menendez
On Fri, Feb 13, 2009 at 1:29 PM, John A. De Goes  wrote:
> On Feb 13, 2009, at 11:23 AM, Jonathan Cast wrote:
>>
>> Usually `when no ambiguity can arise', no?  Plenty of mathematical
>> practice rests on imprecision and the expectation that the human reader
>> will understand what you mean.  Haskell has to be understandable by the
>> machine (which is less forgiving, but also more reasonable!) as well.
>
> Yes, and name overloading is decidable for machines as well, as the feature
> exists in numerous languages, and from time to time, we hear talk of the
> feature for Haskell, as well.

ML uses name overloading for + and *. Type classes were originally
invented as a more principled way of dealing with ad-hoc overloading
like that.


I suspect that you can use type classes for any example of name
overloading, if you're willing to turn on enough extensions in GHC.

If we want an expression's value to be completely determined by its
type, we can just do something like this:

class MapFunction a where
map :: a

instance MapFunction ((a -> b) -> [a] -> [b]) where ...
instance (Ord a, Ord b) => MapFunction ((a -> b) -> Set a -> Set b) where ...

-- 
Dave Menendez 

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


Re: [Haskell-cafe] Re: Overloading functions based on arguments?

2009-02-13 Thread Daniel Fischer
Am Freitag, 13. Februar 2009 20:06 schrieb Jonathan Cast:
> On Fri, 2009-02-13 at 20:06 +0100, Daniel Fischer wrote:
> > Am Freitag, 13. Februar 2009 19:49 schrieb Jonathan Cast:
> > > It breaks type inference.  I explained this at the time.  I can explain
> > > it again:
> > >
> > >   import Data.List
> > >   import Data.Set
> > >   import Data.Map
> > >
> > >   warmFuzzyThingFirstOperation = map
> > >
> > > This gives an error currently.  Quite properly.  But if *any* use of
> > > `map' type-checks, with those imports, why on earth should this
> > > one fail? 
> >
> > To do justice to the above proposal, in that situation more than one
> > choice would typecheck (were the other imports absent or qualified), so
> > that should also be rejected according to it.
>
> Yeah, my objection is precisely that this trivial example is rejected.
> If this use of map is rejected, then I claim *every* use of map should
> be rejected.
>
Okay, why?
If warmFuzzyThingFirstOperation were accepted, it would have the type

(forall a b. (a -> b) -> [a] -> [b]) 
\/ (forall k a b. Ord k => (a -> b) -> Map k a -> Map k b)
\/ (forall a b. (Ord a, Ord b) => (a -> b) -> Set a -> Set b)

Looks kind of ambiguous, doesn't it? I would rather not allow that.
But if we have

take 5 (map (const True) [0,1,1,2,3,5,8,13,21,34,55])

we can infer that the 'map' used here must have a type unifyable with
Num a => (b -> Bool) -> [a] -> [c]
and only one of the 'map's in scope has such a type, so we must pick that.
Doesn't look sooo evil at first.
However, let us remove some information, what about

take 5 . map (const True)

? Well, still easy, we must unify with (a -> b) -> c -> [d], only one 
possibility, fine. Or is it? What if we have another 'take' in scope?
Say take :: Int -> Set a -> Set a ? Oops.
So, where draw the line?

> jcc

Bottom line, allowing that sort of overloading would at least be very 
ad-hoccish, and probably a bad thing.

Thanks,
Daniel

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


Re: [Haskell-cafe] Re: Overloading functions based on arguments?

2009-02-13 Thread John A. De Goes


In your own subjective opinion, which is not shared by many other  
Haskellers, myself included.


Regards,

John A. De Goes
N-BRAIN, Inc.
The Evolution of Collaboration

http://www.n-brain.net|877-376-2724 x 101

On Feb 13, 2009, at 1:08 PM, Jonathan Cast wrote:


On Fri, 2009-02-13 at 12:15 -0700, John A. De Goes wrote:

On Feb 13, 2009, at 12:07 PM, Jonathan Cast wrote:
Exactly!  But if it fails, why on earth should any other use of  
map in

the module succeed?



Because more information is known about other usages of map. Such is
the nature of type inference.


No it's not.  Type inference -- in Haskell --- means --- by  
definition!

--- looking up the principle type of each sub-term, specializing it
based on its use, and then generalizing to find the principle type of
the overall term.  Adding information can cause type inference to  
fail,

but --- in Haskell as it exists --- it cannot cause type inference to
succeed.  Which is good!

jcc




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


Re: [Haskell-cafe] Re: Overloading functions based on arguments?

2009-02-13 Thread Jonathan Cast
On Fri, 2009-02-13 at 12:15 -0700, John A. De Goes wrote:
> On Feb 13, 2009, at 12:07 PM, Jonathan Cast wrote:
> > Exactly!  But if it fails, why on earth should any other use of map in
> > the module succeed?

> Because more information is known about other usages of map. Such is  
> the nature of type inference.

No it's not.  Type inference -- in Haskell --- means --- by definition!
--- looking up the principle type of each sub-term, specializing it
based on its use, and then generalizing to find the principle type of
the overall term.  Adding information can cause type inference to fail,
but --- in Haskell as it exists --- it cannot cause type inference to
succeed.  Which is good!

jcc


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


Re: [Haskell-cafe] IO semantics and evaluation - summary

2009-02-13 Thread Roman Cheplyaka
* Daryoush Mehrtash  [2009-02-13 11:31:06-0800]
> Isn't the lambda expression a representation of  something (potentially with
> recursion) that yields "a value" and not the value itself?   

The same terms may refer to different notions.
If you think of values as mathematical objects, they are denotation of
syntactic constructs (value 1 is denotation of "1", as well as of
"(\x -> x-2) 3").
However, in operational (rather than denotational) semantics, "1" is
value (result of evaluation; normal form) of "(\x -> x-2) 3", and is
itself a syntactic construct.

So, you really need to define (and understand) your terms before talking
about them.

> Even integer which we think of as values are represented in the same
> way:
> http://safalra.com/science/lambda-calculus/integer-arithmetic/

Church numerals are introduced in _untyped_ lambda calculus, while we
are probably talking about _typed_ lambda calculus (as implemented in
Haskell). In the later integers usually are introduced as a basic type.


-- 
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] IO semantics and evaluation - summary

2009-02-13 Thread Daryoush Mehrtash
I have been trying to figure out the distinction between value, function and
computation. You raised a few points that I am not sure about.


In " "Computation" considered harmful. "Value" not so hot either." you said:

I still don't like it; a lambda expression is not a computation, it's a
formal *representation* of a mathematical object (a *value*).


Isn't the lambda expression a representation of  something (potentially with
recursion) that yields "a value" and not the value itself?   Even integer
which we think of as values are represented in the same way:
http://safalra.com/science/lambda-calculus/integer-arithmetic/

In " Fixing Haskell IO" you say:

This "works" well enough; GHC manages to perform IO. But it doesn't fly
> mathematically. Mathematical objects *never* act, sing, dance, or 
> *do*anything. They just are. A value that acts is an oxymoron.
>


I guess I am not sure what a "mathematical object" is.   Do you consider
Newton method a mathematical object?   What would be the "value" :
http://en.wikipedia.org/wiki/Newton's_method#Square_root_of_a_number


Since I have been thinking about Haskell, Monads, etc. I am starting to
think about the  saying "Life is a journey, not a destination" to imply life
is a computation not a value.



daryoush


2009/2/13 Gregg Reynolds 

> Many thanks to everybody who tried to set me straight on the thread about
> IO monad and evaluation semantics.  I've begun summarizing the info, and I
> believe I've come up with a much better way of explaining IO; just flip the
> semantic perspective, and think in terms of interpretations instead of
> actions.  Voila!  Oxymoron (values that perform actions) eliminated.   See
> the "Computation considered harmful" and "Fixing Haskell IO" articles at
> http://syntax.wikidot.com/blog
>
> Naturally I would be grateful for any corrections/comments.
>
> 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


[Haskell-cafe] Re: Class Instances

2009-02-13 Thread Benedikt Huber
Cetin Sert schrieb:
> Thank you for your answer!
> 
> This comes close to solving the problem but in the last line of the 
> above I want to be able to say:
> 
> either
>  > print $ broadcast id [1..10]
> 
> or
>  > print $ broadcast [ (x +) | x ← [1..10] ] [1..10]
> 
> both need to be possible*.
> 
> So is there a way to make the FunList disappear completely?
Hi Cetin,
yes, if you're willing to use multi-parameter typeclasses:
> class Processor p b c | p -> b c where
>  ready :: p -> [b -> c]
> instance Processor (b -> c) b c where
>  ready = repeat
> instance Processor [b -> c] b c where
>  ready = id
> broadcast :: Processor p b c => p -> [b] -> [c]

Maybe there are other possibilities as well.
--
benedikt

> 
> Regards,
> Cetin
> 
> P.S.: * broadcast is a dummy function, I need this for tidying up the 
> interface of a little experiment: http://corsis.blogspot.com/
> 
> 2009/2/13 Benedikt Huber mailto:benj...@gmx.net>>
> 
> Cetin Sert schrieb:
>  > Hi,
>  >
>  > class Processor a where
>  >   ready :: (forall b c. a → [b → c])
>  >
>  > instance Processor (b → c) where
>  >   ready = repeat
>  > ...
>  > ---
>  > Why can I not declare the above instances and always get:
> Hi Cetin,
> in your class declaration you state that a (Processor T) provides a
> function
>  > ready :: T -> [b -> c]
> so
>  > ready (t::T)
> has type (forall b c. [b -> c]), a list of functions from arbitrary
> types b to c.
> 
> The error messages tell you that e.g.
>  > repeat (f :: t1 -> t2)
> has type
>  > (t1->t2) -> [t1->t2]
> and not the required type
>  > (t1->t2) -> [a -> b]
> 
> With your declarations,
>  > head (ready negate) "hi"
> has to typecheck, that's probably not what you want.
> 
>  > Is there a way around this?
> 
> Maybe you meant
> 
>  > class Processor a where
>  >   ready :: a b c -> [b -> c]
>  > instance Processor (->) where
>  >   ready = repeat
>  > newtype FunList b c = FunList [b->c]
>  > instance Processor FunList where
>  >   ready (FunList fl) = fl
> 
> I think the newtype FunList is neccessary here.
> benedikt
> 
>  >
>  > message.hs:229:10:
>  > Couldn't match expected type `b' against inferred type `b1'
>  >   `b' is a rigid type variable bound by
>  >   the instance declaration at message.hs:228:20
>  >   `b1' is a rigid type variable bound by
>  >the type signature for `ready' at message.hs:226:19
>  >   Expected type: b -> c
>  >   Inferred type: b1 -> c1
>  > In the expression: repeat
>  > In the definition of `ready': ready = repeat
>  >
>  > message.hs:229:10:
>  > Couldn't match expected type `c' against inferred type `c1'
>  >   `c' is a rigid type variable bound by
>  >   the instance declaration at message.hs:228:24
>  >   `c1' is a rigid type variable bound by
>  >the type signature for `ready' at message.hs:226:21
>  >   Expected type: b -> c
>  >   Inferred type: b1 -> c1
>  > In the expression: repeat
>  > In the definition of `ready': ready = repeat
>  >
>  > message.hs:232:10:
>  > Couldn't match expected type `b1' against inferred type `b'
>  >   `b1' is a rigid type variable bound by
>  >the type signature for `ready' at message.hs:226:19
>  >   `b' is a rigid type variable bound by
>  >   the instance declaration at message.hs:231:20
>  >   Expected type: [b1 -> c]
>  >   Inferred type: [b -> c1]
>  > In the expression: id
>  > In the definition of `ready': ready = id
>  >
>  > message.hs:232:10:
>  > Couldn't match expected type `c1' against inferred type `c'
>  >   `c1' is a rigid type variable bound by
>  >the type signature for `ready' at message.hs:226:21
>  >   `c' is a rigid type variable bound by
>  >   the instance declaration at message.hs:231:24
>  >   Expected type: [b -> c1]
>  >   Inferred type: [b1 -> c]
>  > In the expression: id
>  > In the definition of `ready': ready = id
>  >
>  > Is there a way around this?
>  >
>  > Regards,
>  > CS
>  >
>  >
>  >
> 
>  >
>  > ___
>  > 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/ha

Re: [Haskell-cafe] Re: Overloading functions based on arguments?

2009-02-13 Thread John A. De Goes


On Feb 13, 2009, at 12:07 PM, Jonathan Cast wrote:

Exactly!  But if it fails, why on earth should any other use of map in
the module succeed?



Because more information is known about other usages of map. Such is  
the nature of type inference.


If you wanted to go a step further, then I suppose you could see how  
warmFuzzyThingFirstOperation is used and if it can be typed in exactly  
one way.


Regards,

John A. De Goes
N-BRAIN, Inc.
The Evolution of Collaboration

http://www.n-brain.net|877-376-2724 x 101


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


Re: [Haskell-cafe] Re: Overloading functions based on arguments?

2009-02-13 Thread Conal Elliott
Hi Daniel,

A more functional approach might be:

type Substitution = String -> Maybe Value
single :: String -> Value -> Substitution
table  :: Table -> Substitution

substitute :: Substitution -> Tree -> Tree

For better performance and a lot more features, you could switch to

type Substitution = Data.Map String Value

- Conal

On Fri, Feb 13, 2009 at 2:40 AM, Daniel Kraft  wrote:

> Colin Adams wrote:
>
>> If you have two functions that do two different things, then they
>> certainly OUGHT to have different names.
>>
>
> Well, they do "the same thing" but for different arguments; it's like this:
>
> Table is a table of name-value pairs I want to substitute in a tree-like
> structure using:
>
> substitute :: Table -> Tree -> Tree
>
> For substituting a single name-value pair I want to define this utitlity
> routine so I don't have to construct a Table all the time in the user code:
>
> substitute :: String -> Value -> Tree -> Tree
>
> In the case I believe it would certainly be good to be able to name both
> functions the same, but I fear I can not do so?  There are languages where
> this is explicitelly allowed (e.g. C++ or Java), so I don't think it is such
> an unuseful or evil thing.
>
>
> 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


Re: [Haskell-cafe] Re: Overloading functions based on arguments?

2009-02-13 Thread Jonathan Cast
On Fri, 2009-02-13 at 12:06 -0700, John A. De Goes wrote:
> On Feb 13, 2009, at 11:49 AM, Jonathan Cast wrote:
> > It breaks type inference.  I explained this at the time.  I can  
> > explain
> > it again:
> >
> >  import Data.List
> >  import Data.Set
> >  import Data.Map
> >
> >  warmFuzzyThingFirstOperation = map
> >
> > This gives an error currently.  Quite properly.  But if *any* use of
> > `map' type-checks, with those imports, why on earth should this one
> > fail?  You don't want to remove a wart from the language, you want to
> > introduce one!
> 
> Umm, no, that would still give an error. See definition of "one and  
> exactly one".

Exactly!  But if it fails, why on earth should any other use of map in
the module succeed?

jcc


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


Re: [Haskell-cafe] Re: Overloading functions based on arguments?

2009-02-13 Thread Jonathan Cast
On Fri, 2009-02-13 at 20:06 +0100, Daniel Fischer wrote:
> Am Freitag, 13. Februar 2009 19:49 schrieb Jonathan Cast:
> > On Fri, 2009-02-13 at 11:45 -0700, John A. De Goes wrote:
> > > On Feb 13, 2009, at 11:32 AM, Jonathan Cast wrote:
> > > > I believe the last time it was brought up, the proposal was that type
> > > > inference should fail on certain typeable terms.  That doesn't count.
> > >
> > > I'm referring to a rather conservative proposal wherein if there is
> > > one and exactly one definition that allows an expression to type, then
> > > name overloading in the same scope is permitted.
> > >
> > > Aside from exponential performance in pathological (but unlikely)
> > > cases, what issue do you have with such a proposal?
> >
> > It breaks type inference.  I explained this at the time.  I can explain
> > it again:
> >
> >   import Data.List
> >   import Data.Set
> >   import Data.Map
> >
> >   warmFuzzyThingFirstOperation = map
> 
> To do justice to the above proposal, in that situation more than one choice 
> would typecheck (were the other imports absent or qualified), so that should 
> also be rejected according to it.

Yeah, my objection is precisely that this trivial example is rejected.
If this use of map is rejected, then I claim *every* use of map should
be rejected.

jcc


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


Re: [Haskell-cafe] Re: Overloading functions based on arguments?

2009-02-13 Thread John A. De Goes


On Feb 13, 2009, at 11:49 AM, Jonathan Cast wrote:
It breaks type inference.  I explained this at the time.  I can  
explain

it again:

 import Data.List
 import Data.Set
 import Data.Map

 warmFuzzyThingFirstOperation = map

This gives an error currently.  Quite properly.  But if *any* use of
`map' type-checks, with those imports, why on earth should this one
fail?  You don't want to remove a wart from the language, you want to
introduce one!


Umm, no, that would still give an error. See definition of "one and  
exactly one".


Regards,

John A. De Goes
N-BRAIN, Inc.
The Evolution of Collaboration

http://www.n-brain.net|877-376-2724 x 101
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Re: Overloading functions based on arguments?

2009-02-13 Thread Daniel Fischer
Am Freitag, 13. Februar 2009 19:49 schrieb Jonathan Cast:
> On Fri, 2009-02-13 at 11:45 -0700, John A. De Goes wrote:
> > On Feb 13, 2009, at 11:32 AM, Jonathan Cast wrote:
> > > I believe the last time it was brought up, the proposal was that type
> > > inference should fail on certain typeable terms.  That doesn't count.
> >
> > I'm referring to a rather conservative proposal wherein if there is
> > one and exactly one definition that allows an expression to type, then
> > name overloading in the same scope is permitted.
> >
> > Aside from exponential performance in pathological (but unlikely)
> > cases, what issue do you have with such a proposal?
>
> It breaks type inference.  I explained this at the time.  I can explain
> it again:
>
>   import Data.List
>   import Data.Set
>   import Data.Map
>
>   warmFuzzyThingFirstOperation = map

To do justice to the above proposal, in that situation more than one choice 
would typecheck (were the other imports absent or qualified), so that should 
also be rejected according to it. I believe what is desired is to be able to 
write

thingummybob :: Ord a => [a] -> (Int,Set a)
thingummybob xs = let st = fromList xs in (size st, st)

with several 'fromLists's in scope. I think it wouldn't be worth the hassle to 
implement that, but otherwise I agree it'd not (necessarily) be a bad thing.

>
> This gives an error currently.  Quite properly.  But if *any* use of
> `map' type-checks, with those imports, why on earth should this one
> fail?  You don't want to remove a wart from the language, you want to
> introduce one!
>
> jcc
>

Cheers,
Daniel

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


[Haskell-cafe] Re: Class Instances

2009-02-13 Thread Cetin Sert
module Main where

import Control.Monad
import Control.Concurrent

class Processor p where
  ready :: p b c → [b → c]

instance Processor (→) where
  ready = repeat

--instance Processor [b → c] where
  --ready = id

newtype FunList b c = FunList [b → c]

instance Processor FunList where
  ready (FunList fl) = fl

broadcast :: Processor p ⇒ p b c → [b] → [c]
broadcast p bs = bcast ps bs []
  where
ps = ready p
bcast [] _  cs = cs
bcast _  [] cs = cs
bcast ps bs cs =
  let (cp,nps) = rotate [] ps
  (cb,nbs) = rotate [] bs in
  bcast nps nbs (cp cb:cs)

rotate :: [a] → [a] → (a,[a])
rotate os (x:[]) = (x,os)
rotate os (x:xs) = (x,xs)

main :: IO ()
main = do
  let pid = id
  let ppm = FunList [ (x +) | x ← [1..10] ]
  print $ broadcast ppm [1..10]

--

Thank you for your answer!

This comes close to solving the problem but in the last line of the above I
want to be able to say:

either
> print $ broadcast id [1..10]

or
> print $ broadcast [ (x +) | x ← [1..10] ] [1..10]

both need to be possible*.

So is there a way to make the FunList disappear completely?

Regards,
Cetin

P.S.: * broadcast is a dummy function, I need this for tidying up the
interface of a little experiment: http://corsis.blogspot.com/

2009/2/13 Benedikt Huber 

> Cetin Sert schrieb:
> > Hi,
> >
> > class Processor a where
> >   ready :: (forall b c. a → [b → c])
> >
> > instance Processor (b → c) where
> >   ready = repeat
> > ...
> > ---
> > Why can I not declare the above instances and always get:
> Hi Cetin,
> in your class declaration you state that a (Processor T) provides a
> function
> > ready :: T -> [b -> c]
> so
> > ready (t::T)
> has type (forall b c. [b -> c]), a list of functions from arbitrary
> types b to c.
>
> The error messages tell you that e.g.
> > repeat (f :: t1 -> t2)
> has type
> > (t1->t2) -> [t1->t2]
> and not the required type
> > (t1->t2) -> [a -> b]
>
> With your declarations,
> > head (ready negate) "hi"
> has to typecheck, that's probably not what you want.
>
> > Is there a way around this?
>
> Maybe you meant
>
> > class Processor a where
> >   ready :: a b c -> [b -> c]
> > instance Processor (->) where
> >   ready = repeat
> > newtype FunList b c = FunList [b->c]
> > instance Processor FunList where
> >   ready (FunList fl) = fl
>
> I think the newtype FunList is neccessary here.
> benedikt
>
> >
> > message.hs:229:10:
> > Couldn't match expected type `b' against inferred type `b1'
> >   `b' is a rigid type variable bound by
> >   the instance declaration at message.hs:228:20
> >   `b1' is a rigid type variable bound by
> >the type signature for `ready' at message.hs:226:19
> >   Expected type: b -> c
> >   Inferred type: b1 -> c1
> > In the expression: repeat
> > In the definition of `ready': ready = repeat
> >
> > message.hs:229:10:
> > Couldn't match expected type `c' against inferred type `c1'
> >   `c' is a rigid type variable bound by
> >   the instance declaration at message.hs:228:24
> >   `c1' is a rigid type variable bound by
> >the type signature for `ready' at message.hs:226:21
> >   Expected type: b -> c
> >   Inferred type: b1 -> c1
> > In the expression: repeat
> > In the definition of `ready': ready = repeat
> >
> > message.hs:232:10:
> > Couldn't match expected type `b1' against inferred type `b'
> >   `b1' is a rigid type variable bound by
> >the type signature for `ready' at message.hs:226:19
> >   `b' is a rigid type variable bound by
> >   the instance declaration at message.hs:231:20
> >   Expected type: [b1 -> c]
> >   Inferred type: [b -> c1]
> > In the expression: id
> > In the definition of `ready': ready = id
> >
> > message.hs:232:10:
> > Couldn't match expected type `c1' against inferred type `c'
> >   `c1' is a rigid type variable bound by
> >the type signature for `ready' at message.hs:226:21
> >   `c' is a rigid type variable bound by
> >   the instance declaration at message.hs:231:24
> >   Expected type: [b -> c1]
> >   Inferred type: [b1 -> c]
> > In the expression: id
> > In the definition of `ready': ready = id
> >
> > Is there a way around this?
> >
> > Regards,
> > CS
> >
> >
> > 
> >
> > ___
> > 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: Overloading functions based on arguments?

2009-02-13 Thread Jonathan Cast
On Fri, 2009-02-13 at 11:45 -0700, John A. De Goes wrote:
> On Feb 13, 2009, at 11:32 AM, Jonathan Cast wrote:
> > I believe the last time it was brought up, the proposal was that type
> > inference should fail on certain typeable terms.  That doesn't count.
> 
> 
> I'm referring to a rather conservative proposal wherein if there is  
> one and exactly one definition that allows an expression to type, then  
> name overloading in the same scope is permitted.
> 
> Aside from exponential performance in pathological (but unlikely)  
> cases, what issue do you have with such a proposal?

It breaks type inference.  I explained this at the time.  I can explain
it again:

  import Data.List
  import Data.Set
  import Data.Map

  warmFuzzyThingFirstOperation = map

This gives an error currently.  Quite properly.  But if *any* use of
`map' type-checks, with those imports, why on earth should this one
fail?  You don't want to remove a wart from the language, you want to
introduce one!

jcc


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


Re: [Haskell-cafe] Re: Overloading functions based on arguments?

2009-02-13 Thread John A. De Goes

On Feb 13, 2009, at 11:32 AM, Jonathan Cast wrote:

I believe the last time it was brought up, the proposal was that type
inference should fail on certain typeable terms.  That doesn't count.



I'm referring to a rather conservative proposal wherein if there is  
one and exactly one definition that allows an expression to type, then  
name overloading in the same scope is permitted.


Aside from exponential performance in pathological (but unlikely)  
cases, what issue do you have with such a proposal?


Regards,

John A. De Goes
N-BRAIN, Inc.
The Evolution of Collaboration

http://www.n-brain.net|877-376-2724 x 101


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


Re: [Haskell-cafe] Re: Overloading functions based on arguments?

2009-02-13 Thread Jonathan Cast
On Fri, 2009-02-13 at 11:29 -0700, John A. De Goes wrote:
> On Feb 13, 2009, at 11:23 AM, Jonathan Cast wrote:
> > Usually `when no ambiguity can arise', no?  Plenty of mathematical
> > practice rests on imprecision and the expectation that the human  
> > reader
> > will understand what you mean.  Haskell has to be understandable by  
> > the
> > machine (which is less forgiving, but also more reasonable!) as well.
> 
> Yes, and name overloading is decidable for machines as well, as the  
> feature exists in numerous languages,

Do those languages have full HDM type inference?  Do they have principle
types?  Are their principle types actually usable from the programmer's
perspective?  Those are the *bare minimum* requirements.

> and from time to time, we hear  
> talk of the feature for Haskell, as well.

I here jabbering all the time.  I try to tune most of it out.

> > Unless you, say, enjoy having type inference or something.
> 
> Name overloading and type inference are not incompatible -- the issue  
> has been discussed here before,

I believe the last time it was brought up, the proposal was that type
inference should fail on certain typeable terms.  That doesn't count.

jcc


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


Re: [Haskell-cafe] Re: Overloading functions based on arguments?

2009-02-13 Thread John A. De Goes

On Feb 13, 2009, at 11:23 AM, Jonathan Cast wrote:

Usually `when no ambiguity can arise', no?  Plenty of mathematical
practice rests on imprecision and the expectation that the human  
reader
will understand what you mean.  Haskell has to be understandable by  
the

machine (which is less forgiving, but also more reasonable!) as well.


Yes, and name overloading is decidable for machines as well, as the  
feature exists in numerous languages, and from time to time, we hear  
talk of the feature for Haskell, as well.



Unless you, say, enjoy having type inference or something.


Name overloading and type inference are not incompatible -- the issue  
has been discussed here before, though I'm too lazy to dig up the  
conversation.


Regards,

John A. De Goes
N-BRAIN, Inc.
The Evolution of Collaboration

http://www.n-brain.net|877-376-2724 x 101


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


Re: [Haskell-cafe] Re: Overloading functions based on arguments?

2009-02-13 Thread Jonathan Cast
On Fri, 2009-02-13 at 11:12 -0700, John A. De Goes wrote:
> I come from a mathematical background (in which it is quite common to  
> "overload" function names and operators in particular)

Usually `when no ambiguity can arise', no?  Plenty of mathematical
practice rests on imprecision and the expectation that the human reader
will understand what you mean.  Haskell has to be understandable by the
machine (which is less forgiving, but also more reasonable!) as well.

> , so from my  
> point of view, the lack of name overloading is a wart

What?  Are you sure of your lexical choice here?

>  on Haskell. That  
> such a feature would complicate type inference is more a concern to an  
> implementor, not to an end-user of Haskell like myself.

Unless you, say, enjoy having type inference or something.

jcc


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


[Haskell-cafe] Re: Language popularity

2009-02-13 Thread Achim Schneider
Ketil Malde  wrote:

> "Henk-Jan van Tuyl"  writes:
> 
> > My own research, using Google:
> > Search   Hits
> > ---
> > Java programming 20.400.000
> > LOGO programming 14.600.000
> 
> I get about that number of hits googling for "logo programming"
> (without quotes).  However, beyond the first 30 pages, most hits
> appear to refer to logo as in a graphical symbol representing an
> entity, rather than Logo the programming language.
> 
> By this metric, the most popular language must be "links", with 37M
> hits. :-)
> 
Does this imply that there's a huge CS industry on Java?

-- 
(c) this sig last receiving data processing entity. Inspect headers
for copyright history. All rights reserved. Copying, hiring, renting,
performance and/or quoting of this signature prohibited.


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


[Haskell-cafe] Re: Class Instances

2009-02-13 Thread Benedikt Huber
Cetin Sert schrieb:
> Hi,
> 
> class Processor a where
>   ready :: (forall b c. a → [b → c])
> 
> instance Processor (b → c) where
>   ready = repeat
> ...
> ---
> Why can I not declare the above instances and always get:
Hi Cetin,
in your class declaration you state that a (Processor T) provides a function
> ready :: T -> [b -> c]
so
> ready (t::T)
has type (forall b c. [b -> c]), a list of functions from arbitrary
types b to c.

The error messages tell you that e.g.
> repeat (f :: t1 -> t2)
has type
> (t1->t2) -> [t1->t2]
and not the required type
> (t1->t2) -> [a -> b]

With your declarations,
> head (ready negate) "hi"
has to typecheck, that's probably not what you want.

> Is there a way around this?

Maybe you meant

> class Processor a where
>   ready :: a b c -> [b -> c]
> instance Processor (->) where
>   ready = repeat
> newtype FunList b c = FunList [b->c]
> instance Processor FunList where
>   ready (FunList fl) = fl

I think the newtype FunList is neccessary here.
benedikt

> 
> message.hs:229:10:
> Couldn't match expected type `b' against inferred type `b1'
>   `b' is a rigid type variable bound by
>   the instance declaration at message.hs:228:20
>   `b1' is a rigid type variable bound by
>the type signature for `ready' at message.hs:226:19
>   Expected type: b -> c
>   Inferred type: b1 -> c1
> In the expression: repeat
> In the definition of `ready': ready = repeat
> 
> message.hs:229:10:
> Couldn't match expected type `c' against inferred type `c1'
>   `c' is a rigid type variable bound by
>   the instance declaration at message.hs:228:24
>   `c1' is a rigid type variable bound by
>the type signature for `ready' at message.hs:226:21
>   Expected type: b -> c
>   Inferred type: b1 -> c1
> In the expression: repeat
> In the definition of `ready': ready = repeat
> 
> message.hs:232:10:
> Couldn't match expected type `b1' against inferred type `b'
>   `b1' is a rigid type variable bound by
>the type signature for `ready' at message.hs:226:19
>   `b' is a rigid type variable bound by
>   the instance declaration at message.hs:231:20
>   Expected type: [b1 -> c]
>   Inferred type: [b -> c1]
> In the expression: id
> In the definition of `ready': ready = id
> 
> message.hs:232:10:
> Couldn't match expected type `c1' against inferred type `c'
>   `c1' is a rigid type variable bound by
>the type signature for `ready' at message.hs:226:21
>   `c' is a rigid type variable bound by
>   the instance declaration at message.hs:231:24
>   Expected type: [b -> c1]
>   Inferred type: [b1 -> c]
> In the expression: id
> In the definition of `ready': ready = id
> 
> Is there a way around this?
> 
> Regards,
> CS
> 
> 
> 
> 
> ___
> 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] Language popularity

2009-02-13 Thread Ketil Malde
"Henk-Jan van Tuyl"  writes:

> My own research, using Google:
> Search   Hits
> ---
> Java programming 20.400.000
> LOGO programming 14.600.000

I get about that number of hits googling for "logo programming"
(without quotes).  However, beyond the first 30 pages, most hits
appear to refer to logo as in a graphical symbol representing an
entity, rather than Logo the programming language.

By this metric, the most popular language must be "links", with 37M
hits. :-)

> Haskell programming  250.000

-k
-- 
If I haven't seen further, it is by standing in the footprints of giants
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Re: Overloading functions based on arguments?

2009-02-13 Thread John A. De Goes


I come from a mathematical background (in which it is quite common to  
"overload" function names and operators in particular), so from my  
point of view, the lack of name overloading is a wart on Haskell. That  
such a feature would complicate type inference is more a concern to an  
implementor, not to an end-user of Haskell like myself.


Regards,

John A. De Goes
N-BRAIN, Inc.
The Evolution of Collaboration

http://www.n-brain.net|877-376-2724 x 101

On Feb 13, 2009, at 10:16 AM, Neil Mitchell wrote:


Hi

Chances are the program you're using to write your e-mails was  
written in

C++ (or at least C), so don't knock it. :-)


Firefox (Javascript + C++) and Gmail (Python, so I think I read, no
doubt with C underneath somewhere). However, I am sat writing C++ at
the moment - which I think gives me the right to say that C++ is a
bloated and ugly language.

In any case, no one has really addressed the original poster's  
question: No,
"name overloading" is not possible in Haskell, and surprisingly,  
there are

no blocking technical issues why this must be the case.


Name overloading is not possible currently. You could encode name
overloading as type classes internally and add the feature, but it
complicates type inference substantially. When I first started doing
Haskell I remember asking why we didn't have overloaded names. Now, I
ask the question why anyone could possibly want overloaded names.
Having drunk the functional kool-aid I've decided they are deeply
confusing :-)

Thanks

Neil




Hi

Table is a table of name-value pairs I want to substitute in a  
tree-like

structure using:

substitute :: Table -> Tree -> Tree

For substituting a single name-value pair I want to define this  
utitlity
routine so I don't have to construct a Table all the time in the  
user

code:

substitute :: String -> Value -> Tree -> Tree


Why not:

substituteValue :: String -> Value -> Tree -> Tree
substituteValue x y = substitute (table1 x y)

In the case I believe it would certainly be good to be able to  
name both
functions the same, but I fear I can not do so?  There are  
languages

where
this is explicitelly allowed (e.g. C++ or Java), so I don't think  
it is

such
an unuseful or evil thing.


Languages like C++ and Java allow mutable state, object-orientated
programming and require massively verbose code - all of which are
unuseful and evil :-)

I think this is a case of trying to apply C++/Java thoughts on to
Haskell, you can map the concepts directly, but you really  
shouldn't.

Try writing multiple methods with many names, or simple utility
functions to convert between the cases, and it will go much nicer.

Thanks

Neil
___
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] createProcess shutting file handles

2009-02-13 Thread Jeremy Shaw
Hello,

As far as I can tell, createProcess is closing the handle:

createProcess
  :: CreateProcess
  -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess cp = do
  r <- runGenProcess_ "runGenProcess" cp Nothing Nothing
  maybeCloseStd (std_in  cp)
  maybeCloseStd (std_out cp)
  maybeCloseStd (std_err cp)
  return r
 where
  maybeCloseStd :: StdStream -> IO ()
  maybeCloseStd (UseHandle hdl)
| hdl /= stdin && hdl /= stdout && hdl /= stderr = hClose hdl
  maybeCloseStd _ = return ()

I don't see a way around it. 

- jeremy


At Fri, 13 Feb 2009 15:38:32 +,
Neil Mitchell wrote:
> 
> Hi,
> 
> I want to run multiple programs and dump the stdout/stderr to a file,
> I've tried doing:
> 
> h <- openFile file WriteMode
> let c = CreateProcess (RawCommand file [])
>   Nothing Nothing
>   Inherit (UseHandle h) (UseHandle h) False
> (_,_,_,pid) <- createProcess c
> waitForProcess pid
> hPutStrLn h "Test"
> 
> But by the time I get to the hPutStrLn line it says:
> 
> Main: test.log: hPutStr: illegal operation (handle is closed)
> 
> What have I done wrong? Did createProcess close the handle, and is
> there a way round this? This is using GHC 6.10 on Windows with the new
> process-1.0.1.1
> 
> Thanks
> 
> Neil
> ___
> 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] Possible bug?

2009-02-13 Thread Peter Verswyvelen
No the error I got was
Could not deduce (Controller m v c)
from the context (Controller m v c2)
  arising from a use of `MVC' at NM8\GUI\PanZoom.hs:126:32-65
Possible fix:
  add (Controller m v c) to the context of the constructor `MVC'
In the expression: MVC m v (PZC s z (unsafeCoerce c))
In the definition of `panZoomedMVC'':
panZoomedMVC' s z (MVC m v c) = MVC m v (PZC s z (unsafeCoerce c))

I got this after adding the type signature of

panZoomedMVC' :: (Controller m v c, PanZoomable z) =>
 State -> z -> MVC m v -> MVC m v

But I don't have the problematic code anymore.

Anyway, I've hacking away here, as you can see from the unsafeCoerce call,
which is now not needed anymore ;)

On Fri, Feb 13, 2009 at 6:26 PM, Tillmann Rendel  wrote:

> Peter Verswyvelen wrote:
>
>> Could it be considered a bug when a function compiles fine without type
>> signature, but when you add the type signature that GHCi reports with :type,
>> it fails to compile?
>>
>
> There are such cases where it is not a bug. For example, given
>
>  import Data.Map (fromList)
>
>  x a = fromList a
>
> ghci will happily report that x has type
>
>  Ord k => [(k, a)] -> Data.Map.Map k a
>
> but the name Data.Map.Map is not in scope in the module.
>
>  Tillmann
>
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] IO semantics and evaluation - summary

2009-02-13 Thread Gregg Reynolds
Many thanks to everybody who tried to set me straight on the thread about IO
monad and evaluation semantics.  I've begun summarizing the info, and I
believe I've come up with a much better way of explaining IO; just flip the
semantic perspective, and think in terms of interpretations instead of
actions.  Voila!  Oxymoron (values that perform actions) eliminated.   See
the "Computation considered harmful" and "Fixing Haskell IO" articles at
http://syntax.wikidot.com/blog

Naturally I would be grateful for any corrections/comments.

Thanks,

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


Re: [Haskell-cafe] Re: Overloading functions based on arguments?

2009-02-13 Thread minh thu
Why do you say "every name and operator" ? Why do you say "fully qualified" ?
When there is some clash, hiding the offending name or importing
"qualified as" is
quite satisfying imho.

Thu

2009/2/13 John A. De Goes :
>
> The signal-to-noise ratio with fully qualified names/operators goes way down
> -- that's the need.
>
> Go take one of your programs and fully qualify every name and every
> operator. Doesn't look so pretty then, does it? And it wouldn't be easy to
> read, either.
>
> Regards,
>
> John A. De Goes
> N-BRAIN, Inc.
> The Evolution of Collaboration
>
> http://www.n-brain.net|877-376-2724 x 101
>
> On Feb 13, 2009, at 9:37 AM, Henning Thielemann wrote:
>
>>
>> On Fri, 13 Feb 2009, John A. De Goes wrote:
>>
>>> In any case, no one has really addressed the original poster's question:
>>> No, "name overloading" is not possible in Haskell, and surprisingly, there
>>> are no blocking technical issues why this must be the case.
>>
>> Prefixing names with module names is good style:
>>  http://www.haskell.org/haskellwiki/Qualified_names
>> Where is the need for more overloading?
>>
>
> ___
> 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] Possible bug?

2009-02-13 Thread Peter Verswyvelen
Ouch, how silly of me, I did not make a backup and have been fiddling with
the code and now it works. Next time I make sure I'll make backup, sorry
about that.
On Fri, Feb 13, 2009 at 5:45 PM, Martijn van Steenbergen <
mart...@van.steenbergen.nl> wrote:

> Peter Verswyvelen wrote:
>
>> Could it be considered a bug when a function compiles fine without type
>> signature, but when you add the type signature that GHCi reports with :type,
>> it fails to compile?
>>
>
> Can you share with us your function and the compiler error, or a small test
> case and the compiler error?
>
> Groetjes,
>
> Martijn.
>
>
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Possible bug?

2009-02-13 Thread Tillmann Rendel

Peter Verswyvelen wrote:
Could it be considered a bug when a function compiles fine without type 
signature, but when you add the type signature that GHCi reports with 
:type, it fails to compile?


There are such cases where it is not a bug. For example, given

  import Data.Map (fromList)

  x a = fromList a

ghci will happily report that x has type

  Ord k => [(k, a)] -> Data.Map.Map k a

but the name Data.Map.Map is not in scope in the module.

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


Re: [Haskell-cafe] Re: Overloading functions based on arguments?

2009-02-13 Thread Neil Mitchell
Hi

> Chances are the program you're using to write your e-mails was written in
> C++ (or at least C), so don't knock it. :-)

Firefox (Javascript + C++) and Gmail (Python, so I think I read, no
doubt with C underneath somewhere). However, I am sat writing C++ at
the moment - which I think gives me the right to say that C++ is a
bloated and ugly language.

> In any case, no one has really addressed the original poster's question: No,
> "name overloading" is not possible in Haskell, and surprisingly, there are
> no blocking technical issues why this must be the case.

Name overloading is not possible currently. You could encode name
overloading as type classes internally and add the feature, but it
complicates type inference substantially. When I first started doing
Haskell I remember asking why we didn't have overloaded names. Now, I
ask the question why anyone could possibly want overloaded names.
Having drunk the functional kool-aid I've decided they are deeply
confusing :-)

Thanks

Neil

>
>> Hi
>>
>>> Table is a table of name-value pairs I want to substitute in a tree-like
>>> structure using:
>>>
>>> substitute :: Table -> Tree -> Tree
>>>
>>> For substituting a single name-value pair I want to define this utitlity
>>> routine so I don't have to construct a Table all the time in the user
>>> code:
>>>
>>> substitute :: String -> Value -> Tree -> Tree
>>
>> Why not:
>>
>> substituteValue :: String -> Value -> Tree -> Tree
>> substituteValue x y = substitute (table1 x y)
>>
>>> In the case I believe it would certainly be good to be able to name both
>>> functions the same, but I fear I can not do so?  There are languages
>>> where
>>> this is explicitelly allowed (e.g. C++ or Java), so I don't think it is
>>> such
>>> an unuseful or evil thing.
>>
>> Languages like C++ and Java allow mutable state, object-orientated
>> programming and require massively verbose code - all of which are
>> unuseful and evil :-)
>>
>> I think this is a case of trying to apply C++/Java thoughts on to
>> Haskell, you can map the concepts directly, but you really shouldn't.
>> Try writing multiple methods with many names, or simple utility
>> functions to convert between the cases, and it will go much nicer.
>>
>> Thanks
>>
>> Neil
>> ___
>> 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] Possible bug?

2009-02-13 Thread Martijn van Steenbergen

Peter Verswyvelen wrote:
Could it be considered a bug when a function compiles fine without type 
signature, but when you add the type signature that GHCi reports with 
:type, it fails to compile?


Can you share with us your function and the compiler error, or a small 
test case and the compiler error?


Groetjes,

Martijn.

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


Re: [Haskell-cafe] Re: Overloading functions based on arguments?

2009-02-13 Thread John A. De Goes


The signal-to-noise ratio with fully qualified names/operators goes  
way down -- that's the need.


Go take one of your programs and fully qualify every name and every  
operator. Doesn't look so pretty then, does it? And it wouldn't be  
easy to read, either.


Regards,

John A. De Goes
N-BRAIN, Inc.
The Evolution of Collaboration

http://www.n-brain.net|877-376-2724 x 101

On Feb 13, 2009, at 9:37 AM, Henning Thielemann wrote:



On Fri, 13 Feb 2009, John A. De Goes wrote:

In any case, no one has really addressed the original poster's  
question: No, "name overloading" is not possible in Haskell, and  
surprisingly, there are no blocking technical issues why this must  
be the case.


Prefixing names with module names is good style:
 http://www.haskell.org/haskellwiki/Qualified_names
Where is the need for more overloading?



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


[Haskell-cafe] Class Instances

2009-02-13 Thread Cetin Sert
Hi,

class Processor a where
  ready :: (forall b c. a → [b → c])

{-
instance Processor (b → c) where
  ready = repeat

instance Processor [b → c] where
  ready = id-}

doSth :: (Show p, Processor p) ⇒ p → IO ()
doSth p = print p

---
Why can I not declare the above instances and always get:

message.hs:229:10:
Couldn't match expected type `b' against inferred type `b1'
  `b' is a rigid type variable bound by
  the instance declaration at message.hs:228:20
  `b1' is a rigid type variable bound by
   the type signature for `ready' at message.hs:226:19
  Expected type: b -> c
  Inferred type: b1 -> c1
In the expression: repeat
In the definition of `ready': ready = repeat

message.hs:229:10:
Couldn't match expected type `c' against inferred type `c1'
  `c' is a rigid type variable bound by
  the instance declaration at message.hs:228:24
  `c1' is a rigid type variable bound by
   the type signature for `ready' at message.hs:226:21
  Expected type: b -> c
  Inferred type: b1 -> c1
In the expression: repeat
In the definition of `ready': ready = repeat

message.hs:232:10:
Couldn't match expected type `b1' against inferred type `b'
  `b1' is a rigid type variable bound by
   the type signature for `ready' at message.hs:226:19
  `b' is a rigid type variable bound by
  the instance declaration at message.hs:231:20
  Expected type: [b1 -> c]
  Inferred type: [b -> c1]
In the expression: id
In the definition of `ready': ready = id

message.hs:232:10:
Couldn't match expected type `c1' against inferred type `c'
  `c1' is a rigid type variable bound by
   the type signature for `ready' at message.hs:226:21
  `c' is a rigid type variable bound by
  the instance declaration at message.hs:231:24
  Expected type: [b -> c1]
  Inferred type: [b1 -> c]
In the expression: id
In the definition of `ready': ready = id

Is there a way around this?

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


Re: [Haskell-cafe] Re: Overloading functions based on arguments?

2009-02-13 Thread Henning Thielemann


On Fri, 13 Feb 2009, John A. De Goes wrote:

In any case, no one has really addressed the original poster's question: No, 
"name overloading" is not possible in Haskell, and surprisingly, there are no 
blocking technical issues why this must be the case.


Prefixing names with module names is good style:
  http://www.haskell.org/haskellwiki/Qualified_names
 Where is the need for more overloading?

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


Re: [Haskell-cafe] Re: Haddock Markup

2009-02-13 Thread Henning Thielemann


On Fri, 13 Feb 2009, Achim Schneider wrote:


What about making a SoC out of the problem? A mathematical markup
language that is easily written as well as valid Haskell, executable
within reason, compilable into mathML (think backticks) and would
revolutionise the typeset quality of literate programming?


That's what I just proposed in the SoC thread. Thanks for seconding! :-)
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Another point-free question (>>=, join, ap)

2009-02-13 Thread Thomas Davie



Hey,

Thanks for all the suggestions. I was hoping that there was some  
uniform

pattern that would extend to n arguments (rather than having to use
liftM2, litM3, etc. or have different 'application' operators in  
between

the different arguments); perhaps not. Oh well :)


Sure you can!  What you want is Control.Applicative, not Control.Monad.

(<*>) is the generic application you're looking for:

> pure (+) <*> [1,2,3] <*> [4,5,6]
[5,6,7,6,7,8,7,8,9]

Note that pure f <*> y can be shortened to fmap though, which  
Control.Applicative defines a handy infix version of:

> (+) <$> [1,2,3] <*> [4,5,6]
[5,6,7,6,7,8,7,8,9]

Hope that provides what you want

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


Re: [Haskell-cafe] Re: Overloading functions based on arguments?

2009-02-13 Thread John A. De Goes


Chances are the program you're using to write your e-mails was written  
in C++ (or at least C), so don't knock it. :-)


In any case, no one has really addressed the original poster's  
question: No, "name overloading" is not possible in Haskell, and  
surprisingly, there are no blocking technical issues why this must be  
the case.


As a result of this limitation, we end up with abuse of type classes  
and endless synonyms, suffixes, and postfixes, and funky operators  
whose meanings must be inferred from documentation rather than  
convention.


Name overloading can certainly be abused, but in my opinion, the lack  
of it results in more problems than it eliminates.


Regards,

John A. De Goes
N-BRAIN, Inc.
The Evolution of Collaboration

http://www.n-brain.net|877-376-2724 x 101

On Feb 13, 2009, at 3:43 AM, Neil Mitchell wrote:


Hi

Table is a table of name-value pairs I want to substitute in a tree- 
like

structure using:

substitute :: Table -> Tree -> Tree

For substituting a single name-value pair I want to define this  
utitlity
routine so I don't have to construct a Table all the time in the  
user code:


substitute :: String -> Value -> Tree -> Tree


Why not:

substituteValue :: String -> Value -> Tree -> Tree
substituteValue x y = substitute (table1 x y)

In the case I believe it would certainly be good to be able to name  
both
functions the same, but I fear I can not do so?  There are  
languages where
this is explicitelly allowed (e.g. C++ or Java), so I don't think  
it is such

an unuseful or evil thing.


Languages like C++ and Java allow mutable state, object-orientated
programming and require massively verbose code - all of which are
unuseful and evil :-)

I think this is a case of trying to apply C++/Java thoughts on to
Haskell, you can map the concepts directly, but you really shouldn't.
Try writing multiple methods with many names, or simple utility
functions to convert between the cases, and it will go much nicer.

Thanks

Neil
___
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: Haddock Markup

2009-02-13 Thread Achim Schneider
What about making a SoC out of the problem? A mathematical markup
language that is easily written as well as valid Haskell, executable
within reason, compilable into mathML (think backticks) and would
revolutionise the typeset quality of literate programming?

-- 
(c) this sig last receiving data processing entity. Inspect headers
for copyright history. All rights reserved. Copying, hiring, renting,
performance and/or quoting of this signature prohibited.


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


[Haskell-cafe] Possible bug?

2009-02-13 Thread Peter Verswyvelen
Could it be considered a bug when a function compiles fine without type
signature, but when you add the type signature that GHCi reports with :type,
it fails to compile?
I am using functional dependencies, and I know these are not the best way to
do it.

Can all functional dependencies be completely replaced with associated types
when using GHC 6.10.1? I tried once but I failed.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Re: Haskell.org GSoC

2009-02-13 Thread Henning Thielemann


On Fri, 13 Feb 2009, Daniel Kraft wrote:


Henning Thielemann wrote:



DoCon?


hm, I've only read a little on their webpage; what I was thinking of was to 
implement a very basic package just to do some symbolic integration or 
equation solving to be embedded in some other calculation, and DoCon sounds 
like a more abstract, mathematical system.


So maybe there could still be some interest in a basic symbolic expression 
package that could be backed by a CAS library like GiNaC or some other one 
(better yet, pluggable) instead of imlementing a full CAS itself.


So it seems to be useful to make the distinction:
 * Computer algebra is doing advanced arithmetic on advanced mathematical 
objects like polynomials, Galois groups, function compositions (for 
integration). This is what DoCon is about (integration excluded).
 * Symbolic manipulation is what you are after, where symbolic 
manipulation often involves computer algebra behind the scenes (i.e. 
translating symbolic expressions to polynomials, function compositions)

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


[Haskell-cafe] Re: Haskell.org GSoC

2009-02-13 Thread Daniel Kraft

Hi,

Henning Thielemann wrote:

Daniel Kraft wrote:
I noticed last year Haskell.org was a mentoring organization for 
Google's Summer of Code, and I barely noticed some discussion about it 
applying again this year :)


I participated for GCC in 2008 and would like to try again this year; 
while I'm still active for GCC and will surely stay so, I'd like to 
see something new at least for GSoC.  And Haskell.org would surely be 
a very, very nice organization.


Since I discovered there's more than just a lot of imperative 
languages that are nearly all the same, I love to do some programming 
in Prolog, Scheme and of course Haskell.  However, so far this was 
only some toy programs and nothing "really useful"; I'd like to change 
this (as well as learning more about Haskell during the projects).

>>
- A basic symbolic maths package; I've no idea how far one could do 
this as a single GSoC project, but it would surely be a very 
interesting task.  Alternatively or in combination, one could try to 
use an existing free CAS package as engine.


DoCon?


hm, I've only read a little on their webpage; what I was thinking of was 
to implement a very basic package just to do some symbolic integration 
or equation solving to be embedded in some other calculation, and DoCon 
sounds like a more abstract, mathematical system.


So maybe there could still be some interest in a basic symbolic 
expression package that could be backed by a CAS library like GiNaC or 
some other one (better yet, pluggable) instead of imlementing a full CAS 
itself.


Daniel

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


Re: [Haskell-cafe] Language popularity

2009-02-13 Thread Henning Thielemann

Robin Green wrote:



I think we can fairly safely discount the commercial relevance of any
language ranking which places LOGO so highly.

It may be that a lot of people *know* LOGO (or claim to know it), but
that does not mean that is used a lot for commercial programming.



If we discuss here about a new Haskell LOGO - does this also count as a 
hit for LOGO programming language?

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


[Haskell-cafe] createProcess shutting file handles

2009-02-13 Thread Neil Mitchell
Hi,

I want to run multiple programs and dump the stdout/stderr to a file,
I've tried doing:

h <- openFile file WriteMode
let c = CreateProcess (RawCommand file [])
  Nothing Nothing
  Inherit (UseHandle h) (UseHandle h) False
(_,_,_,pid) <- createProcess c
waitForProcess pid
hPutStrLn h "Test"

But by the time I get to the hPutStrLn line it says:

Main: test.log: hPutStr: illegal operation (handle is closed)

What have I done wrong? Did createProcess close the handle, and is
there a way round this? This is using GHC 6.10 on Windows with the new
process-1.0.1.1

Thanks

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


Re: [Haskell-cafe] Re: Haddock Markup

2009-02-13 Thread Jonathan Cast
On Fri, 2009-02-13 at 11:08 +0100, Heinrich Apfelmus wrote:
> Jonathan Cast wrote:
> > 
> > NB: This example is *precisely* why I will never adopt MathML as an
> > authoring format.  Bowing and scraping at the alter of W3C is not worth
> > using such a terrible syntax, not ever.
> > 
> > (Indented, that's
> > 
> >   
> > 
> >   
> > x
> > 2
> >   
> >   +
> > 
> > 4
> > ⁢
> > x
> >   
> >   +  
> >   4
> > 
> >   
> > 
> > Which is still unforgivably horrible.  I *think* it's trying to say $x^2
> > + 4x + 4$, but I'm not confident even of that.
> 
> Yeah, MathML looks like a machine-only format to me, begging the
> question why they don't use a more compact format.
> 
> > I'm also unconvinced
> > it's actually easier to parse than $x^2 + 4x + 4$.)
> 
> While parsing is a solved problem in theory, a lot of people use some
> regular expression kludges or similar atrocities in practice.

Yeah, we even seem to have adopted one of their syntaxen [markdown].  

> Writing a
> proper parser is too complicated if your language doesn't have parser
> combinators. :)

Haddock, I believe, is written in a language that does.  If MathML
output is desired at some point (e.g., if browsers start doing better at
rendering it than at rendering images with TeX source-code alt-texts :)
the I think Haddock will still be capable of handling a reasonable input
language.

jcc


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


Re: [Haskell-cafe] Overloading functions based on arguments?

2009-02-13 Thread Henning Thielemann

Daniel Kraft wrote:

Hi,

I just came across a problem like this:  Suppose I've got two related 
functions that do similar things, and I want to call them the same... 
Like in:


foobar :: String -> Int -> Int
foobar :: Int -> String -> Int

(Bad example, but I hope you got the point.)


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


[Haskell-cafe] Haskell.org GSoC -> Haskell for Math type setting

2009-02-13 Thread Henning Thielemann


I think the recent discussion about advanced markup for Haddock 
documentation could yield a Summer of code project. I still like my 
suggestion to use Haskell code as description for math formulas and I like 
Wolfgang's idea to use an existing tool like Template Haskell for 
conversion from Haskell code to an output format (TeX, MathML, or 
whatever):

   http://haskell.org/pipermail/haskell-cafe/2009-February/055358.html
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Another point-free question (>>=, join, ap)

2009-02-13 Thread Conor McBride

Hi Edsko

On 13 Feb 2009, at 09:14, Edsko de Vries wrote:


Hey,

Thanks for all the suggestions. I was hoping that there was some  
uniform

pattern that would extend to n arguments (rather than having to use
liftM2, litM3, etc. or have different 'application' operators in  
between

the different arguments); perhaps not. Oh well :)


Will this do?

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

You get to write

  iI f a1 a2 a3 Ji

for

  do x1 <- a1
 x2 <- a2
 x3 <- a3
 f a1 a2 a3

amongst other things...

Cheers

Conor


This message has been checked for viruses but the contents of an attachment
may still contain software viruses, which could damage your computer system:
you are advised to perform your own checks. Email communications with the
University of Nottingham may be monitored as permitted by UK legislation.

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


Re: [Haskell-cafe] Haskell.org GSoC

2009-02-13 Thread Henning Thielemann

Daniel Kraft wrote:

Hi,

I noticed last year Haskell.org was a mentoring organization for 
Google's Summer of Code, and I barely noticed some discussion about it 
applying again this year :)


I participated for GCC in 2008 and would like to try again this year; 
while I'm still active for GCC and will surely stay so, I'd like to see 
something new at least for GSoC.  And Haskell.org would surely be a 
very, very nice organization.


Since I discovered there's more than just a lot of imperative languages 
that are nearly all the same, I love to do some programming in Prolog, 
Scheme and of course Haskell.  However, so far this was only some toy 
programs and nothing "really useful"; I'd like to change this (as well 
as learning more about Haskell during the projects).


Here are some ideas for developing Haskell packages (that would 
hopefully be of general use to the community) as possible projects:


- Numerics, like basic linear algebra routines, numeric integration and 
other basic algorithms of numeric mathematics.


I have some unsorted routines for that:
   http://darcs.haskell.org/htam/src/Numerics/

- A basic symbolic maths package; I've no idea how far one could do this 
as a single GSoC project, but it would surely be a very interesting 
task.  Alternatively or in combination, one could try to use an existing 
free CAS package as engine.


DoCon?


- Graphs.


There was some discussion here about improved API of fgl:
   http://haskell.org/pipermail/libraries/2008-February/009241.html

- A logic programming framework.  I know there's something like that for 
Scheme; in my experience, there are some problems best expressed 
logically with Prolog-style backtracking/predicates and unification. 
This could help use such formulations from inside a Haskell program. 
This is surely also a very interesting project.


LogicT ?
___
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-13 Thread Henning Thielemann

Corey O'Connor wrote:

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?


Use a (slightly) different package name?
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Language popularity

2009-02-13 Thread Robin Green
On Fri, 13 Feb 2009 15:52:48 +0100
"Henk-Jan van Tuyl"  wrote:

> 
> Yesterday I saw Haskell mentioned for the first time in a magazine,
> Bits & Chips. It is a magazine for professionals, about hardware and
> software; the article was about the domain specific language Cryptol
> from Galois.
> 
> In the same issue of the magazine, there was an article saying that
> the company Tiobe has proclamed C the language of the year 2008,
> because of it's growth in popularity of almost two percent. The
> current statistics can befoud at [1]. The most popular functional
> language at the moment is LOGO [2], at the 15th place in the top 50
> (from 22nd place a year ago).

I think we can fairly safely discount the commercial relevance of any
language ranking which places LOGO so highly.

It may be that a lot of people *know* LOGO (or claim to know it), but
that does not mean that is used a lot for commercial programming.

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


[Haskell-cafe] Language popularity

2009-02-13 Thread Henk-Jan van Tuyl


Yesterday I saw Haskell mentioned for the first time in a magazine, Bits &  
Chips. It is a magazine for professionals, about hardware and software;  
the article was about the domain specific language Cryptol from Galois.


In the same issue of the magazine, there was an article saying that the  
company Tiobe has proclamed C the language of the year 2008, because of  
it's growth in popularity of almost two percent. The current statistics  
can befoud at [1]. The most popular functional language at the moment is  
LOGO [2], at the 15th place in the top 50 (from 22nd place a year ago).  
Haskell is at the 35th place (no indication of the score last year). A  
quick search in the Web Archive [3] reveals that Haskell was at the 41st  
place in the index in June 2007.


My own research, using Google:
Search   Hits
---
Java programming 20.400.000
LOGO programming 14.600.000
Haskell programming  250.000


[1] http://www.tiobe.com/index.php/content/paperinfo/tpci/index.html
[2] http://en.wikipedia.org/wiki/Logo_(programming_language)
[3] http://web.archive.org/web/20070606231519/www.tiobe.com/?tiobe_index

--
Regards,
Henk-Jan van Tuyl


--
http://functor.bamikanarie.com
http://Van.Tuyl.eu/
--


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


Re: [Haskell-cafe] Help needed with apache config for hackage

2009-02-13 Thread Duncan Coutts
On Fri, 2009-02-13 at 22:39 +1100, George Pollard wrote:
> On Fri, 2009-02-13 at 10:58 +, Duncan Coutts wrote:
> > Hi folks,
> > 
> > Does anyone have any experience with apache configuration, particularly
> > mime types and handling browser quirks and would like to help us with an
> > issue we have on hackage?
> > 
> > http://hackage.haskell.org/trac/hackage/ticket/498
> > 
> > The problem is described in the ticket but basically IE6 gets confused
> > by the Content-Type and Content-Encoding and ends up saving ".tar.gz"
> > files with the wrong name ".tar.tar".
> > 
> > We need help working out how to configure apache to use a workaround and
> > with testing that the solution actually works.
> > 
> > Thanks!
> > 
> > Duncan
> 
> Currently the browser receives:
> 
> > HTTP/1.1 200 OK
> > Date: Fri, 13 Feb 2009 11:15:22 GMT
> > Server: Apache/2.2.3 (Debian)
> > Last-Modified: Mon, 09 Feb 2009 07:55:57 GMT
> > ETag: "38c010-46d-b361bd40"
> > Accept-Ranges: bytes
> > Content-Length: 1133
> > Content-Type: application/x-tar
> > Content-Encoding: x-gzip
> 
> You could try adding a Content-Disposition header to specify a file name:
> 
>   Content-Disposition: attachment; filename=APackage.tar.gz
> 
> In Apache you can (apparently [1],[2]) do it like this:
> 
>   RewriteRule "^packages/archive/[^/]+/[^/]+/(.+)$" - [env=pkgname:$1]
>   Header set Content-Disposition "attachment; filename=\"%{pkgname}e\"" 
> env=pkgname 
> 
> [1]: http://httpd.apache.org/docs/2.0/mod/core.html#files
> [2]: 
> http://www.experts-exchange.com/Software/Server_Software/Web_Servers/Apache/Q_23054616.html

Can we do that just for one user agent? I don't think we want to use
non-standard stuff in general. Apparently Content-Disposition is not in
the official HTTP spec, but IE is known to follow it.

Duncan

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


Re: [Haskell-cafe] Help needed with apache config for hackage

2009-02-13 Thread George Pollard
On Fri, 2009-02-13 at 10:58 +, Duncan Coutts wrote:
> Hi folks,
> 
> Does anyone have any experience with apache configuration, particularly
> mime types and handling browser quirks and would like to help us with an
> issue we have on hackage?
> 
> http://hackage.haskell.org/trac/hackage/ticket/498
> 
> The problem is described in the ticket but basically IE6 gets confused
> by the Content-Type and Content-Encoding and ends up saving ".tar.gz"
> files with the wrong name ".tar.tar".
> 
> We need help working out how to configure apache to use a workaround and
> with testing that the solution actually works.
> 
> Thanks!
> 
> Duncan

Currently the browser receives:

> HTTP/1.1 200 OK
> Date: Fri, 13 Feb 2009 11:15:22 GMT
> Server: Apache/2.2.3 (Debian)
> Last-Modified: Mon, 09 Feb 2009 07:55:57 GMT
> ETag: "38c010-46d-b361bd40"
> Accept-Ranges: bytes
> Content-Length: 1133
> Content-Type: application/x-tar
> Content-Encoding: x-gzip

You could try adding a Content-Disposition header to specify a file name:

  Content-Disposition: attachment; filename=APackage.tar.gz

In Apache you can (apparently [1],[2]) do it like this:

  RewriteRule "^packages/archive/[^/]+/[^/]+/(.+)$" - [env=pkgname:$1]
  Header set Content-Disposition "attachment; filename=\"%{pkgname}e\"" 
env=pkgname 

[1]: http://httpd.apache.org/docs/2.0/mod/core.html#files
[2]: 
http://www.experts-exchange.com/Software/Server_Software/Web_Servers/Apache/Q_23054616.html

- 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


[Haskell-cafe] Help needed with apache config for hackage

2009-02-13 Thread Duncan Coutts
Hi folks,

Does anyone have any experience with apache configuration, particularly
mime types and handling browser quirks and would like to help us with an
issue we have on hackage?

http://hackage.haskell.org/trac/hackage/ticket/498

The problem is described in the ticket but basically IE6 gets confused
by the Content-Type and Content-Encoding and ends up saving ".tar.gz"
files with the wrong name ".tar.tar".

We need help working out how to configure apache to use a workaround and
with testing that the solution actually works.

Thanks!

Duncan

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


[Haskell-cafe] Re: Overloading functions based on arguments?

2009-02-13 Thread Daniel Kraft

Daniel Kraft wrote:
Is this kind of overloading (instead of the polymorphism based 
overloading) possible in Haskell?  Namely to have two functions with the 
same name but different signatures so they could be distinguished by a 
call's parameters?  I fear not...  So I guess I have to name the 
functions differently, right?


Thanks for all the quick replies, I think I'm really going for different 
names :)  But there were some nice ideas I will remember for the future, 
maybe they can be of some use for something else!


Daniel

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


Re: [Haskell-cafe] Re: Overloading functions based on arguments?

2009-02-13 Thread George Pollard
On Fri, 2009-02-13 at 11:40 +0100, Daniel Kraft wrote:
> Colin Adams wrote:
> > If you have two functions that do two different things, then they
> > certainly OUGHT to have different names.
> 
> Well, they do "the same thing" but for different arguments; it's like this:
> 
> Table is a table of name-value pairs I want to substitute in a tree-like 
> structure using:
> 
> substitute :: Table -> Tree -> Tree
> 
> For substituting a single name-value pair I want to define this utitlity 
> routine so I don't have to construct a Table all the time in the user code:
> 
> substitute :: String -> Value -> Tree -> Tree

You can write it like this:

  class Substitutable a where
substitute :: a -> Tree -> Tree

  instance Substitutable Table where ...
  instance Substitutable (String, Value) where ...


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] Race condition possible?

2009-02-13 Thread Peter Verswyvelen
Ah yes, then you're doing a double handshaking in a sense, of course. Not
ideal if you just want to put something in the MVar and resume as quick as
possible. However, in that case one could fork a dummy thread that only does
readMVar I guess.

But does it also work when you want multiple threads that are waiting for
the same MVar, and a single thread that writes to the MVar? It think is
does, when you use readMVar one thread will get the value and the others
will get it sequentially since readMVar puts the value back...

Again you guys gave a solution, an amazing brain thank this cafe is...
Usually one gets drunk in a cafe, destroying braincells. Here it's the
opposite :)

On Fri, Feb 13, 2009 at 11:01 AM, Duncan Coutts  wrote:

> On Thu, 2009-02-12 at 22:58 -0500, David Menendez wrote:
> > On Thu, Feb 12, 2009 at 6:26 PM, Don Stewart  wrote:
> > > bugfact:
> > >> Consider the following code
> > >>
> > >> stamp v x = do
> > >>   t <- getCurrentTime
> > >>   putMVar v (x,t)
> > >>
> > >> Is it possible - with GHC - that a thread switch happens after the t
> <-
> > >> getCurrentTime and the putMVar v (x,t)?
> > >
> > > Yes. if 't' is heap allocated, there could be a context switch.
> > >
> > >> If so, how would it be possible to make sure that the operation of
> reading the
> > >> current time and writing the pair to the MVar is an "atomic"
> operation, in the
> > >> sense that no thread switch can happen between the two? Would this
> require STM?
> > >>
> > >
> > > Using 'atomically' and TVars in STM, perhaps? Else, use withMVar?   Or
> a
> > > modifyMVar in IO?
> >
> > As I understand it, withMVar or modifyMVar will protect you from
> > extraneous exceptions, but they won't prevent another thread from
> > writing to the MVar between the take and the put.
>
> You have to cooperate with the other users of the MVar.
>
> If each thread is using readMVar, withMVar or modifyMVar then it's fine.
> The read/with/modify actions do a takeMVar followed by a putMVar. If one
> thread is using withMVar and another is doing putMVar directly then the
> exclusion scheme does not work.
>
> Duncan
>
>
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Re: Overloading functions based on arguments?

2009-02-13 Thread Neil Mitchell
Hi

> Table is a table of name-value pairs I want to substitute in a tree-like
> structure using:
>
> substitute :: Table -> Tree -> Tree
>
> For substituting a single name-value pair I want to define this utitlity
> routine so I don't have to construct a Table all the time in the user code:
>
> substitute :: String -> Value -> Tree -> Tree

Why not:

substituteValue :: String -> Value -> Tree -> Tree
substituteValue x y = substitute (table1 x y)

> In the case I believe it would certainly be good to be able to name both
> functions the same, but I fear I can not do so?  There are languages where
> this is explicitelly allowed (e.g. C++ or Java), so I don't think it is such
> an unuseful or evil thing.

Languages like C++ and Java allow mutable state, object-orientated
programming and require massively verbose code - all of which are
unuseful and evil :-)

I think this is a case of trying to apply C++/Java thoughts on to
Haskell, you can map the concepts directly, but you really shouldn't.
Try writing multiple methods with many names, or simple utility
functions to convert between the cases, and it will go much nicer.

Thanks

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


Re: [Haskell-cafe] Re: Overloading functions based on arguments?

2009-02-13 Thread minh thu
2009/2/13 Daniel Kraft :
> Colin Adams wrote:
>>
>> If you have two functions that do two different things, then they
>> certainly OUGHT to have different names.
>
> Well, they do "the same thing" but for different arguments; it's like this:
>
> Table is a table of name-value pairs I want to substitute in a tree-like
> structure using:
>
> substitute :: Table -> Tree -> Tree
>
> For substituting a single name-value pair I want to define this utitlity
> routine so I don't have to construct a Table all the time in the user code:
>
> substitute :: String -> Value -> Tree -> Tree
>
> In the case I believe it would certainly be good to be able to name both
> functions the same, but I fear I can not do so?  There are languages where
> this is explicitelly allowed (e.g. C++ or Java), so I don't think it is such
> an unuseful or evil thing.

That's probably not Evil, but it's much clearer to know what something
is by looking at its name (or the name of the function used on).

So, substituteOne and substituteMany are much clearer...

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


Re: [Haskell-cafe] Overloading functions based on arguments?

2009-02-13 Thread Duncan Coutts
On Fri, 2009-02-13 at 13:25 +0300, Eugene Kirpichov wrote:
> class Foobar a b where
>   foobar :: a -> b -> Int
> 
> instance Foobar String Int where ...
> instance Foobar Int String where ...

But we typically do not to this. It's ugly. Classes work nicely when
there is some kind of parametrisation going on, where a function can
work with any instance of some interface. Ad-hoc overloading in the
style of Java/C++ just isn't done, even though it can be encoded by the
above trick.

In the simple case just us a different name. If you would have lots of
variations then consider other approaches like passing a data type
containing some of the arguments (since that can encode alternatives).

Duncan

> 2009/2/13 Daniel Kraft :
> > Hi,
> >
> > I just came across a problem like this:  Suppose I've got two related
> > functions that do similar things, and I want to call them the same... Like
> > in:
> >
> > foobar :: String -> Int -> Int
> > foobar :: Int -> String -> Int
> >
> > (Bad example, but I hope you got the point.)
> >
> > Is this kind of overloading (instead of the polymorphism based overloading)
> > possible in Haskell?  Namely to have two functions with the same name but
> > different signatures so they could be distinguished by a call's parameters?
> >  I fear not...  So I guess I have to name the functions differently, right?
> >
> > Thanks,
> > Daniel


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


[Haskell-cafe] Re: Overloading functions based on arguments?

2009-02-13 Thread Daniel Kraft

Colin Adams wrote:

If you have two functions that do two different things, then they
certainly OUGHT to have different names.


Well, they do "the same thing" but for different arguments; it's like this:

Table is a table of name-value pairs I want to substitute in a tree-like 
structure using:


substitute :: Table -> Tree -> Tree

For substituting a single name-value pair I want to define this utitlity 
routine so I don't have to construct a Table all the time in the user code:


substitute :: String -> Value -> Tree -> Tree

In the case I believe it would certainly be good to be able to name both 
functions the same, but I fear I can not do so?  There are languages 
where this is explicitelly allowed (e.g. C++ or Java), so I don't think 
it is such an unuseful or evil thing.


Daniel

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


Re: [Haskell-cafe] Overloading functions based on arguments?

2009-02-13 Thread Colin Adams
If you have two functions that do two different things, then they
certainly OUGHT to have different names.

You can of course put the two functions in different modules. Then
they do have different (qualified) names.

2009/2/13 Daniel Kraft :
> Hi,
>
> I just came across a problem like this:  Suppose I've got two related
> functions that do similar things, and I want to call them the same... Like
> in:
>
> foobar :: String -> Int -> Int
> foobar :: Int -> String -> Int
>
> (Bad example, but I hope you got the point.)
>
> Is this kind of overloading (instead of the polymorphism based overloading)
> possible in Haskell?  Namely to have two functions with the same name but
> different signatures so they could be distinguished by a call's parameters?
>  I fear not...  So I guess I have to name the functions differently, right?
>
> Thanks,
> 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


Re: [Haskell-cafe] Overloading functions based on arguments?

2009-02-13 Thread Eugene Kirpichov
class Foobar a b where
  foobar :: a -> b -> Int

instance Foobar String Int where ...
instance Foobar Int String where ...

2009/2/13 Daniel Kraft :
> Hi,
>
> I just came across a problem like this:  Suppose I've got two related
> functions that do similar things, and I want to call them the same... Like
> in:
>
> foobar :: String -> Int -> Int
> foobar :: Int -> String -> Int
>
> (Bad example, but I hope you got the point.)
>
> Is this kind of overloading (instead of the polymorphism based overloading)
> possible in Haskell?  Namely to have two functions with the same name but
> different signatures so they could be distinguished by a call's parameters?
>  I fear not...  So I guess I have to name the functions differently, right?
>
> Thanks,
> 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] Overloading functions based on arguments?

2009-02-13 Thread Daniel Kraft

Hi,

I just came across a problem like this:  Suppose I've got two related 
functions that do similar things, and I want to call them the same... 
Like in:


foobar :: String -> Int -> Int
foobar :: Int -> String -> Int

(Bad example, but I hope you got the point.)

Is this kind of overloading (instead of the polymorphism based 
overloading) possible in Haskell?  Namely to have two functions with the 
same name but different signatures so they could be distinguished by a 
call's parameters?  I fear not...  So I guess I have to name the 
functions differently, right?


Thanks,
Daniel

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


[Haskell-cafe] parallelism or concurrency ? if they are different

2009-02-13 Thread Paolino
When I came to haskell, I arrived with a small and only evolutionary
background in programming. First monad I met was MonadState StdGen m.
Everything was in someway acceptable, I had no problem in
explicitating the need for the generator.
The lesson was referential transparency. To me referential tranparency
is still obscure as a feature.
Not using the monad , my functions pass around a generator, then they
are repeatable, same generator , same computation.
Years pass by, now evolutionary algorithms need to scale multicores.
But multicore can be used with threads or par, the difference is that
par is pure, because it respects referential transparency. But threads
not.
They are always unrespectful ? Or it's an implementation issue of
preemptive choice?
Can I have a baton to pass around like I had for random generator, so
that the computation ends without IO (unsafe performed) , without
breaking tranparency,
something like (runIOThreads :: ThreadsIO a -> ThreadsBaton -> a) ?
>From Real World Haskell my algorithm have to be parallelized as they
don't do some kind of IO, they don't deal with the world, but where is
it stated that it is possible  to write them with par (I couldn't) ?
More , I'm not caring  that my computation is unrepeatable, for me
it's fine that  the runtime system  gives me the cached results for
same arguments computation. The fact that it doesn't ,and recompute
the function giving out something fuzzily different from before, is
enough to coerce me to spit out IO  values ?
Finally, why and where the optimizer will substitute a value with its
definition, so that it possibly get computed twice ?

Thanks

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


[Haskell-cafe] Re: Haddock Markup

2009-02-13 Thread Heinrich Apfelmus
Jonathan Cast wrote:
> 
> NB: This example is *precisely* why I will never adopt MathML as an
> authoring format.  Bowing and scraping at the alter of W3C is not worth
> using such a terrible syntax, not ever.
> 
> (Indented, that's
> 
>   
> 
>   
> x
> 2
>   
>   +
> 
> 4
> ⁢
> x
>   
>   +  
>   4
> 
>   
> 
> Which is still unforgivably horrible.  I *think* it's trying to say $x^2
> + 4x + 4$, but I'm not confident even of that.

Yeah, MathML looks like a machine-only format to me, begging the
question why they don't use a more compact format.

> I'm also unconvinced
> it's actually easier to parse than $x^2 + 4x + 4$.)

While parsing is a solved problem in theory, a lot of people use some
regular expression kludges or similar atrocities in practice. Writing a
proper parser is too complicated if your language doesn't have parser
combinators. :)


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] Race condition possible?

2009-02-13 Thread Duncan Coutts
On Thu, 2009-02-12 at 22:58 -0500, David Menendez wrote:
> On Thu, Feb 12, 2009 at 6:26 PM, Don Stewart  wrote:
> > bugfact:
> >> Consider the following code
> >>
> >> stamp v x = do
> >>   t <- getCurrentTime
> >>   putMVar v (x,t)
> >>
> >> Is it possible - with GHC - that a thread switch happens after the t <-
> >> getCurrentTime and the putMVar v (x,t)?
> >
> > Yes. if 't' is heap allocated, there could be a context switch.
> >
> >> If so, how would it be possible to make sure that the operation of reading 
> >> the
> >> current time and writing the pair to the MVar is an "atomic" operation, in 
> >> the
> >> sense that no thread switch can happen between the two? Would this require 
> >> STM?
> >>
> >
> > Using 'atomically' and TVars in STM, perhaps? Else, use withMVar?   Or a
> > modifyMVar in IO?
> 
> As I understand it, withMVar or modifyMVar will protect you from
> extraneous exceptions, but they won't prevent another thread from
> writing to the MVar between the take and the put.

You have to cooperate with the other users of the MVar.

If each thread is using readMVar, withMVar or modifyMVar then it's fine.
The read/with/modify actions do a takeMVar followed by a putMVar. If one
thread is using withMVar and another is doing putMVar directly then the
exclusion scheme does not work.

Duncan

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


Re: [Haskell-cafe] How to deal with utf-8?

2009-02-13 Thread Duncan Coutts
On Fri, 2009-02-13 at 08:33 +0100, Krzysztof Skrzętnicki wrote:
> On Fri, Feb 13, 2009 at 08:06, Magicloud  
> wrote:
> > Hi,
> >   I am using Text.CSV to read and using gtk2hs to display csv files using
> > utf-8 encode. Well, it displays broken strings, seems like it cannot deal
> > with utf-8.
> >   What should I do?
> 
> You should try using functions from utf8-string package (find it on
> Hackage) to read UTF-8 encoded data.
> That's about reading data in. I'm not so sure however about the gtk2hs
> part. Experts should tell you if it is possible or not. (I think it
> is.)

Gtk2Hs displays Haskell Strings correctly. Haskell Strings are Unicode.
So all you need to do is decode utf8 into a proper Haskell String.

Duncan

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


Re: [Haskell-cafe] Another point-free question (>>=, join, ap)

2009-02-13 Thread Edsko de Vries
Hey,

Thanks for all the suggestions. I was hoping that there was some uniform
pattern that would extend to n arguments (rather than having to use
liftM2, litM3, etc. or have different 'application' operators in between
the different arguments); perhaps not. Oh well :)

Thanks again!

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


Re: [Haskell-cafe] Re: Delimited continuations: please comment

2009-02-13 Thread Cristiano Paris
On Fri, Feb 13, 2009 at 2:05 AM, Chung-chieh Shan
 wrote:
> ...
> It's not unheard of for the scheduler to react in different ways to the
> same system call -- I'm thinking of reading from a file, for example.

Sure, I went implementing something slitghtly different to double
check my understanding of delconts.

> You clearly understand the whole idea, and your code demonstrates it in
> a nice way.  Oleg and I have found this programming style particularly
> convenient when we need to
>  - fork processes (i.e., backtrack in the monad),
>  - run the same processes under different schedulers (e.g., a debugger),
>  - nest the applications of schedulers (i.e., provide virtualization).

Thanks for your feedback.

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


Re: [Haskell-cafe] Race condition possible?

2009-02-13 Thread Bulat Ziganshin
Hello Peter,

Friday, February 13, 2009, 2:17:52 AM, you wrote:

> If so, how would it be possible to make sure that the operation of
> reading the current time and writing the pair to the MVar is an
> "atomic" operation, in the sense that no thread switch can happen
> between the two? Would this require STM?

it may be better to change architecture so that you no more need
atomic operations - these are "unnatural" for mvar/chan approach


-- 
Best regards,
 Bulatmailto:bulat.zigans...@gmail.com

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