[Haskell-cafe] Trouble with numbers

2008-02-29 Thread Lloyd Smith
I have a question about how numeric classes and type checking works. I have two
functions that I think should behave the same but don't.

-- I want to split n things up using a given list of fractions
-- for example allocate' 100 [1/3,1/3,1/3]
-- [33,33,33]
allocate' n fs = vs
where vs = map (floor . (*n)) fs

-- I want to find anything left over eventually I will want to
-- return what is unallocated as well but for now allocated
-- and unallocated are not used!
allocate n fs = vs
where vs = map (floor . (*n)) fs
  allocated = sum vs
  unallocated = n - allocated

When I load these function in the top level everything looks good

[1 of 1] Compiling Main ( allocate.hs, interpreted )
Ok, modules loaded: Main.main
*Main allocate' 100 [1/3,1/3,1/3]
[33,33,33]
*Main allocate 100 [1/3,1/3,1/3]

interactive:1:0:
Ambiguous type variable `t' in the constraints:
  `Integral t'
arising from a use of `allocate' at interactive:1:0-25
  `RealFrac t'
arising from a use of `allocate' at interactive:1:0-25
Probable fix: add a type signature that fixes these type variable(s)
*Main

I mixed up my types when finding the allocated and unallocated,
but I am not sure why it produces an error when unallocated and
allocated are never used? Shouldn't the two functions be compiled
down to the same thing?

Suggestions on how to do this more elegantly as well as pointers for
understanding numeric
type classes would be appreciated.

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


Re: [Haskell-cafe] Trouble with numbers

2008-02-29 Thread Ryan Ingram
The important thing is the type of floor:
  floor :: (Integral b, RealFrac a) = a - b
That is, if you have a real, fractional type, and you apply floor to
it, you'll get some integral type.

If you look at allocate', you'll see
allocate' :: (RealFrac in, Integral out) = in - [in] - [out]

When you apply this function without any other information, you're
applying Haskell's defaulting rules; I believe you'll get Double for
in and Integer for out.

But in allocate, you have two additional declarations:
   allocated = sum vs
   therefore, allocated :: out
   unallocated = n - sum vs
   unallocated :: ?

(-) has type (Num a) = a - a - a.  Since both RealFrac and Integral
have Num as a superclass, that constraint goes away.  But you still
end up unifying in with out.  Now you need a type that is both a
real-fractional type and an integer type.  Unsurprisingly, no such
type exists.

To fix:
unallocated = n - fromIntegral (sum vs)

  -- ryan



On Fri, Feb 29, 2008 at 12:09 AM, Lloyd Smith [EMAIL PROTECTED] wrote:
 I have a question about how numeric classes and type checking works. I have 
 two
  functions that I think should behave the same but don't.

  -- I want to split n things up using a given list of fractions
  -- for example allocate' 100 [1/3,1/3,1/3]
  -- [33,33,33]
  allocate' n fs = vs
 where vs = map (floor . (*n)) fs

  -- I want to find anything left over eventually I will want to
  -- return what is unallocated as well but for now allocated
  -- and unallocated are not used!
  allocate n fs = vs
 where vs = map (floor . (*n)) fs
   allocated = sum vs
   unallocated = n - allocated

  When I load these function in the top level everything looks good

  [1 of 1] Compiling Main ( allocate.hs, interpreted )
  Ok, modules loaded: Main.main
  *Main allocate' 100 [1/3,1/3,1/3]
  [33,33,33]
  *Main allocate 100 [1/3,1/3,1/3]

  interactive:1:0:
 Ambiguous type variable `t' in the constraints:
   `Integral t'
 arising from a use of `allocate' at interactive:1:0-25
   `RealFrac t'
 arising from a use of `allocate' at interactive:1:0-25
 Probable fix: add a type signature that fixes these type variable(s)
  *Main

  I mixed up my types when finding the allocated and unallocated,
  but I am not sure why it produces an error when unallocated and
  allocated are never used? Shouldn't the two functions be compiled
  down to the same thing?

  Suggestions on how to do this more elegantly as well as pointers for
  understanding numeric
  type classes would be appreciated.

  TIA
  Lloyd
  ___
  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] Trouble with numbers

2008-02-29 Thread Stuart Cook
On Fri, Feb 29, 2008 at 7:09 PM, Lloyd Smith [EMAIL PROTECTED] wrote:
  I mixed up my types when finding the allocated and unallocated,
  but I am not sure why it produces an error when unallocated and
  allocated are never used? Shouldn't the two functions be compiled
  down to the same thing?

  Suggestions on how to do this more elegantly as well as pointers for
  understanding numeric
  type classes would be appreciated.

Let's have a look at the types involved:

  Prelude :t allocate'
  allocate' :: (RealFrac a, Integral b) = a - [a] - [b]
  Prelude :t allocate
  allocate :: (Integral b, RealFrac b) = b - [b] - [b]

We can see that (allocate') takes RealFrac arguments and returns an
Integral result. So far so good.

However, the signature for (allocate) is slightly different: it
requires that the argument and result types be the same.
Unfortunately, this is impossible, because no type can have a sensible
instance for both RealFrac and Integral.

Why do the two functions have different signatures? The obvious
culprit is the unused code in the definition of (allocate'). Notice
that (allocated) will use the same underlying type as (vs), which is
the return type of the function. However, unallocated tries to
subtract (allocated) from (n), and (n) has the argument type of the
function. The type-checker sees the two types must be the same in
order for the subtraction to work, and so the overall function ends up
with a nonsense type.

The moral of the story is that even though that extra code might not
execute at run-time, it can still influence type-inference and
type-checking, which is your actual problem here.

The solution for your woes is probably to insert a (fromIntegral)
somewhere. I suspect that

  allocated = fromIntegral $ sum vs

will do the trick.


Hope this helps,

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


Re: [Haskell-cafe] Re: ANN: Hoogle 3.1

2008-02-29 Thread Henning Thielemann


On Fri, 29 Feb 2008, Neil Mitchell wrote:


Hi Steve,


 Would you consider adding auto-complete feature on Hoogle in the forth
 coming release?

 http://wiki.script.aculo.us/scriptaculous/show/Ajax.Autocompleter


I am slightly hoping that I'll be able to remove the Search button
entirely, and just have results as you type.


For the WWW version of Hoogle this means that data must be transmitted 
constantly and I think that rises a privacy problem. I don't want that my 
typing behaviour can be observed and analysed somewhere. Such technique 
would also require JavaScript which is disabled in browsers of security 
oriented people.

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


Re: [Haskell-cafe] Re: ANN: Hoogle 3.1

2008-02-29 Thread Neil Mitchell
Hi Henning,

  For the WWW version of Hoogle this means that data must be transmitted
  constantly and I think that rises a privacy problem. I don't want that my
  typing behaviour can be observed and analysed somewhere. Such technique
  would also require JavaScript which is disabled in browsers of security
  oriented people.

The current version of Hoogle already uses Javascript to do a few
things (setting focus, adding quick search) - but if javascript is
disabled it still works perfectly well. I will stick to this design
principle. I haven't thought too much about the front end, as the
front end is comparatively easy compared to the back end stuff. Once I
have thought about it, I'll release something for feedback, and will
be happy to incorporate anyones suggestions. AJAX'y and auto-complete
would save me time when using Hoogle, so I would like to add it, but
of course will take privacy very seriously.

Thanks

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


Re: [Haskell-cafe] cabal errors

2008-02-29 Thread Duncan Coutts

On Thu, 2008-02-28 at 07:10 -0500, Kristofer Buffington wrote:
 Hi
 
 I installed ghc 6.8 from source and I've been installing packages from
 hackage. I'm not sure when the problem started, but I've been getting
 this error trying to install any cabal package.. accept apparently,
 Cabal itself.

(Which is because Cabal does not use the installed Cabal lib to build
itself, it bootstraps from its own source code.)

 Setup.hs:2:0:
 Warning: Deprecated use of `defaultUserHooks'
  (imported from Distribution.Simple):
  Use simpleUserHooks or autoconfUserHooks
 Setup: /usr/local/lib/Cabal-1.3.6/ghc-6.8.2.20080225/HSCabal-1.3.6.o:
 unknown symbol `directoryzm1zi0zi0zi0_SystemziDirectory_a9_closure'
 Setup: exception :: GhcException
 
 Any ideas?

My first suggestion would be to clean and rebuild your development
version of Cabal. Once it's re-registered, see if ghci -package Cabal
works.

Duncan

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


Re: [Haskell-cafe] ANN: Hoogle 3.1

2008-02-29 Thread Steve Lihn
Interesting to know people are looking for \where\. As a fairly new
Haskeller, I bumped into frequent indentation issues (if-then-else,
case, where, let, do, etc) and sometimes not sure where to place
\where\ properly. Maybe beginners are having problem with syntax
more than other things and they are asking Hoogle to get some
suggestions...

Or they are using Hoogle as Ask.com. Where is this? Where can I find that?

On 2/29/08, Neil Mitchell [EMAIL PROTECTED] wrote:

 The Hoogle logs suggest this wouldn\'t be that useful. The most
 commonly invoked searches are the three listed on the front page.
 After that, the most common search is actually for \where\, at under
 1%. However, there are other ways I think I can get the necessary
 speed, and autocomplete would be very useful.

 Thanks

 Neil

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


Re: [Haskell-cafe] ANN: Hoogle 3.1

2008-02-29 Thread Neil Mitchell
Hi

 Interesting to know people are looking for \where\. As a fairly new
  Haskeller, I bumped into frequent indentation issues (if-then-else,
  case, where, let, do, etc) and sometimes not sure where to place
  \where\ properly. Maybe beginners are having problem with syntax
  more than other things and they are asking Hoogle to get some
  suggestions...

  Or they are using Hoogle as Ask.com. Where is this? Where can I find that?

No, they are just searching for where on its own. I'm not entirely
sure why - if a new user who actually did it would let me know, I'd be
very interested. Originally, Hoogle did not search for keywords - as a
result of real users actually searching for them it got modified to
include them. Because they are a new addition, they got tacked on
lightly, which is why keywords actually have a module in Hoogle :-)

Thanks

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


Re: [Haskell-cafe] cabal errors

2008-02-29 Thread Ross Paterson
On Thu, Feb 28, 2008 at 07:10:03AM -0500, Kristofer Buffington wrote:
 I installed ghc 6.8 from source and I've been installing packages from
 hackage.  I'm not sure when the problem started, but I've been getting
 this error trying to install any cabal package.. accept apparently,
 Cabal itself.
 
 Setup.hs:2:0:
 Warning: Deprecated use of `defaultUserHooks'
  (imported from Distribution.Simple):
  Use simpleUserHooks or autoconfUserHooks
 Setup: /usr/local/lib/Cabal-1.3.6/ghc-6.8.2.20080225/HSCabal-1.3.6.o: unknown
 symbol `directoryzm1zi0zi0zi0_SystemziDirectory_a9_closure'
 Setup: exception :: GhcException

I've seen this too.  Have you somehow rebuilt directory-1.0.0.0 using
Cabal?  If so, the Cabal-built library exports different internal symbols
from the version built with ghc-6.8.2, even though it's the same source
compiled with the same version of GHC.  Any library built against the
earlier version will no longer work.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] Re: ANN: Hoogle 3.1

2008-02-29 Thread Aaron Denney
On 2008-02-29, Neil Mitchell [EMAIL PROTECTED] wrote:
 Hi

 Interesting to know people are looking for \where\. As a fairly new
  Haskeller, I bumped into frequent indentation issues (if-then-else,
  case, where, let, do, etc) and sometimes not sure where to place
  \where\ properly. Maybe beginners are having problem with syntax
  more than other things and they are asking Hoogle to get some
  suggestions...

  Or they are using Hoogle as Ask.com. Where is this? Where can I find that?

 No, they are just searching for where on its own. I'm not entirely
 sure why - if a new user who actually did it would let me know, I'd be
 very interested. Originally, Hoogle did not search for keywords - as a
 result of real users actually searching for them it got modified to
 include them. Because they are a new addition, they got tacked on
 lightly, which is why keywords actually have a module in Hoogle :-)

How's about modifying hoogle to put up a message asking them before the
normal response?

-- 
Aaron Denney
--

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


Re: [Haskell-cafe] to stimulate discussion concerning where Haskell is going .. ...

2008-02-29 Thread Galchin Vasili
1)
http://research.sun.com/spotlight/2007/2007-08-13_transactional_memory.html

2)
http://www.jamesward.org/wordpress/2007/11/29/can-sun-monetize-java-with-transactional-memory/

3)http://research.sun.com/scalable/pubs/index.html
http://research.sun.com/scalable/




On 2/29/08, Benjamin L. Russell [EMAIL PROTECTED] wrote:


 --- Galchin Vasili [EMAIL PROTECTED] wrote:

  [snip]
 
   I have fished around and collected some Sun
  papers and slides. If any
  anybody wants I can post the URLs or send to the
  interested

 Yes, I am interested.  Please post the URLs, and I
 will flag the message and refer to the associated
 pages as soon as I have time.

 Benjamin L. Russell

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


[Haskell-cafe] Re: static constants -- ideas?

2008-02-29 Thread Don Stewart
jay:
 Don Stewart [EMAIL PROTECTED]:
 jay:
  Don Stewart [EMAIL PROTECTED]:
  jay:
   I also have constants that are too large to compile. I am resigned to
   loading them from data files--other solutions seem even worse.
  ...
   Data.Binary eases the irritation somewhat.
  
  Did you try bytestring literals (and maybe parsing them in-memory with
  Data.Binary)?
 
 I finally squeezed enough time to try it, and it didn't work for me.

 
 --
 ghc Overflow.hs
 [1 of 1] Compiling Overflow ( Overflow.hs, Overflow.o )

Enable optimisations!  Compile with ghc -O2. You need this to avoid
having a very slow pack call at runtime.

 Overflow.hs:8:10:stack overflow: use +RTS -Ksize to increase it
 --
 
 where Overflow.hs is in the vicinity of 40M and looks like
 
 --
 {-# LANGUAGE OverloadedStrings #-}
 
 module Overflow where
 
 import qualified Data.ByteString.Lazy as S
 
 bigData :: S.ByteString
 bigData = \0\0\0\0\0\5\67\195\0\0\0\0...
 --
 
 I didn't compress it, because Codec.Compression.GZip didn't compile for
 me. It looked like a library change since 6.6 broke it.

Probably you don't have the zlib.h header?
Or make sure you have the latest version of zlib from hackage -- it does
work.
  
 Is there a handy string escaping function in the libraries somewhere? It
 only took a minute to write one, and I spent longer than that looking,
 so maybe it's the wrong question Surely it's in there somewhere, and
 I'm just 2 dum 2 c.

The show function?

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


[Haskell-cafe] Connection helpers: for people interested in network code

2008-02-29 Thread Adam Langley
I generally find that I'm wrapping sockets in the same functions a lot
and now I'm looking writings code which works with both Sockets and
SSL connections. So I wrote a module, presumptuously called
Network.Connection, although I'm not actually going to try and take
that name (even in Hackage) unless I get a general agreement that this
is a good thing.

So, any comments on the interface, similar things that I should look at etc?

http://www.imperialviolet.org/binary/network-connection/Network-Connection.html

I made the BaseConnection an ADT, rather than a class because I wanted
to avoid hitting the monomorphism restriction in code. That might have
been a mistake, I'm not sure yet.

If it doesn't excite anyone enough to reply, I'll change the name and
put it in Hackage, mostly as is. Then I'll tie HsOpenSSL into it so
that SSL connections work transparently.

Cheers,


AGL

-- 
Adam Langley [EMAIL PROTECTED] http://www.imperialviolet.org
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] Re: static constants -- ideas?

2008-02-29 Thread Don Stewart
jay:
 Don Stewart [EMAIL PROTECTED]:
 
 jay:
  Don Stewart [EMAIL PROTECTED]:
  jay:
   Don Stewart [EMAIL PROTECTED]:
   jay:
I also have constants that are too large to compile. I am resigned to
loading them from data files--other solutions seem even worse.
   ...
Data.Binary eases the irritation somewhat.
   
   Did you try bytestring literals (and maybe parsing them in-memory with
   Data.Binary)?
  
  I finally squeezed enough time to try it, and it didn't work for me.
 
  
  --
  ghc Overflow.hs
  [1 of 1] Compiling Overflow ( Overflow.hs, Overflow.o )
 
 Enable optimisations!  Compile with ghc -O2. You need this to avoid
 having a very slow pack call at runtime.
 
 Yes, I tried basic variations like that. The result is the same with -O1
 or with -O2, and with Data.ByteString or Data.ByteString.Lazy .

Ok, hmm, that really shouldn't be the case. Do you have the example 
available somewhere? It's just a 40M inline bytestring?

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


[Haskell-cafe] Announce: category-extras 0.1

2008-02-29 Thread Dan Doel
Hello everyone,

While fooling about with generalized tries a night or two ago, I found myself 
once again interacting with fixed points of shape functors and the like, and 
so decided it was time to finish cabalizing David Menendez' excellent 
category theory inspired modules.[1]

So, it is my pleasure to announce version 0.1 of category-extras. This is an 
initial import of the code, with only what work it took to get things 
compiling properly. As such, some of the documentation is a bit scanty, and 
there is some overlap with other packages (notably, TypeCompose, off the top 
of my head), but I hope to rectify that later.

Notable bits include:

 * Control.Comonad
   * Control.Comonad.Context -- the state-in-context monad
 * Control.Functor.Adjunction
   -- a class for adjoint functors, and their associated (co)monads
 * Control.Recursion
   -- Various generalized recursion operators (cata/zygo/histo/apomorphisms)
   -- A class for associating fixpoint data types to their shape functors

Also included are some Data.* modules with some comonadic data types (infinite 
trees and streams, for instance), but they are in the 
as-yet-poorly-documented section of the package.

Haddock 2.0 is required to build what documentation there is for 
Control.Functor.Transform, as it uses type operators. However, the rest 
should be compatible with earlier versions of haddock. Some modules are 
portable Haskell98, but many use various extensions (rank-2 types and 
functional dependencies being the most common).

Links:
 * hackage: 
http://hackage.haskell.org/cgi-bin/hackage-scripts/package/category-extras-0.1
 * darcs: http://code.haskell.org/~dolio/category-extras/

If you identify any issues with the package, or simply have some wild category 
theoretic abstractions that you think should be made available to Haskell 
programmers at large, feel free let me know.

-- Dan Doel

[1] The original home of these modules is here: 
http://www.eyrie.org/~zednenem/2004/hsce/
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] Generating a random list

2008-02-29 Thread Milos Hasan

Hi,

so let's say I want to generate a list of N random floats. The elegant 
way of doing it would be to create an infinite lazy list of floats and 
take the first N, but for N = 1,000,000 or more, this overflows the 
stack. The reason is apparently that the take function is not 
tail-recursive, and so it uses O(N) stack space..


What is the right way to do this? Sure, I could write my own 
tail-recursive generator function. But this seems to be an instance of a 
more general problem - how to avoid algorithms linear in stack space 
when dealing with large lists.


Thanks a lot!
Milos

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


Re: [Haskell-cafe] Generating a random list

2008-02-29 Thread Luke Palmer
On Sat, Mar 1, 2008 at 6:50 AM, Milos Hasan [EMAIL PROTECTED] wrote:
 Hi,

  so let's say I want to generate a list of N random floats. The elegant
  way of doing it would be to create an infinite lazy list of floats and
  take the first N, but for N = 1,000,000 or more, this overflows the
  stack. The reason is apparently that the take function is not
  tail-recursive, and so it uses O(N) stack space..

Not too likely.  take should not be tail recursive, because that is
not lazy (you have to compute all n elements to get the first one) and
thus uses O(n) space, whereas the take in the Prelude is lazy, so uses
O(1) space.  The prelude take is the one you want.

It's likely that the stack overflow is occurring elsewhere in your
program.  For example, if you are adding together all the random
numbers using foldl or foldr, that will eat up your stack (the right
solution in that case is to use the strict foldl').  Perhaps you could
post your code, or a minimal example of what you're experiencing.

Luke

  What is the right way to do this? Sure, I could write my own
  tail-recursive generator function. But this seems to be an instance of a
  more general problem - how to avoid algorithms linear in stack space
  when dealing with large lists.

  Thanks a lot!
  Milos

  ___
  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] Generating a random list

2008-02-29 Thread Bryan O'Sullivan
Milos Hasan wrote:

 so let's say I want to generate a list of N random floats. The elegant
 way of doing it would be to create an infinite lazy list of floats and
 take the first N, but for N = 1,000,000 or more, this overflows the
 stack. The reason is apparently that the take function is not
 tail-recursive, and so it uses O(N) stack space..

You might want to post your code.  The reason take isn't tail recursive
is that it will be evaluated lazily, so it will not consume O(n) stack
space.

However, using take is the wrong approach anyway, as the user of the
random numbers needs to return the unconsumed portion of the list so
that the next user can consume them.  This is why code that uses random
numbers is usually written in the context of a state monad, such as
MonadRandom: http://www.haskell.org/haskellwiki/New_monads/MonadRandom

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