Re: [Haskell-cafe] Increasing memory use in stream computation

2013-10-10 Thread Bertram Felgenhauer
Arie Peterson wrote: (Sorry for the long email.) Summary: why does the attached program have non-constant memory use? Unfortunately, I don't know. I'll intersperse some remarks and propose an alternative to stream fusion at the end, which allows your test program to run in constant space.

Re: [Haskell-cafe] Is withAsync absolutely safe?

2013-07-28 Thread Bertram Felgenhauer
Roman Cheplyaka wrote: Can withAsync guarantee that its child will be terminated if the thread executing withAsync gets an exception? To remind, here's an implementation of withAsync: withAsyncUsing :: (IO () - IO ThreadId) - IO a - (Async a - IO b) - IO b -- The

Re: [Haskell-cafe] I killed performance of my code with Eval and Strategies

2012-11-17 Thread Bertram Felgenhauer
Dear Janek, I am reading Simon Marlow's tutorial on parallelism and I have problems with correctly using Eval monad and Strategies. I *thought* I understand them but after writing some code it turns out that obviously I don't because parallelized code is about 20 times slower. Here's a short

Re: [Haskell-cafe] What does unpacking an MVar really mean?

2012-07-31 Thread Bertram Felgenhauer
Leon Smith wrote: I am familiar with the source of Control.Concurrent.MVar, and I do see {-# UNPACK #-}'ed MVars around, for example in GHC's IO manager. What I should have asked is, what does an MVar# look like? This cannot be inferred from Haskell source; though I suppose I could

Re: [Haskell-cafe] not enough fusion?

2012-07-02 Thread Bertram Felgenhauer
Hi, Johannes Waldmann wrote: s2 :: Int - Int s2 n = sum $ do x - [ 0 .. n-1 ] y - [ 0 .. n-1 ] return $ gcd x y This code shows some interesting behaviour: its runtime depends heavily on the allocation area size. For comparison, with main = print $ s1 1 I

Re: [Haskell-cafe] mueval leaving behind tmp files

2012-04-04 Thread Bertram Felgenhauer
regards, Bertram 1 patch for repository http://darcsden.com/jcpetruzza/hint: Wed Apr 4 14:59:33 CEST 2012 Bertram Felgenhauer in...@gmx.de * clean temporary files in runInterpreterT(withArgs) New patches: [clean temporary files in runInterpreterT(withArgs) Bertram Felgenhauer in...@gmx.de

[Haskell-cafe] Cabal-1.10.1.0 and bytestring-0.9.2.0 hackage problem.

2011-08-25 Thread Bertram Felgenhauer
Dear list, Cabal-1.10.1.0 contains a bug that causes it to fail to parse the test-suite target of bytestring-0.9.2.0. Since cabal-install parses all package descriptions to before resolving dependencies, users with that version of Cabal are stuck. Now it seems somebody realised this problem and

Re: [Haskell-cafe] pointer equality

2011-07-20 Thread Bertram Felgenhauer
Carl Howells wrote: On Tue, Jul 19, 2011 at 11:14 PM, yi huang yi.codepla...@gmail.com wrote: 2011/7/20 Eugene Kirpichov ekirpic...@gmail.com reallyUnsafePointerEq#, and it really is as unsafe as it sounds :) Why is it so unsafe? i can't find any documentation on it. I think always

Re: [Haskell-cafe] pointer equality

2011-07-20 Thread Bertram Felgenhauer
David Barbour wrote: On Wed, Jul 20, 2011 at 10:40 AM, Chris Smith cdsm...@gmail.com wrote: The point, I think, is that if pointer equality testing really does what it says, then there shouldn't *be* any correct implementation in which false positives are possible. It seems the claim is

Re: [Haskell-cafe] Splitting Hackage Packages and re-exporting entire modules (with same module name)

2011-07-13 Thread Bertram Felgenhauer
Antoine Latter wrote: If you give the module a new name in the new package then the old module can re-export all of the symbols in the new module. In GHC I don't think there is a way for two packages to export the same module and have them be recognized as the same thing, as far as I know.

Re: [Haskell-cafe] Generating random graph

2011-04-13 Thread Bertram Felgenhauer
Hi Mitar, I have made this function to generate a random graph for Data.Graph.Inductive library: generateGraph :: Int - IO (Gr String Double) generateGraph graphSize = do when (graphSize 1) $ throwIO $ AssertionFailed $ Graph size out of bounds ++ show graphSize let ns = map (\n -

Re: [Haskell-cafe] Faster timeout but is it correct?

2011-02-21 Thread Bertram Felgenhauer
Hi Bas, The solution is probably to reverse the order of: unsafeUnmask $ forkIO to forkIO $ unsafeUnmask. Or just use forkIOUnmasked. The reason I didn't used that in the first place was that it was much slower for some reason. The reason is probably that in order for the forkIOUnmaske-d

Re: [Haskell-cafe] Misleading MVar documentation

2011-01-05 Thread Bertram Felgenhauer
Mitar wrote: Hi! On Sat, Dec 25, 2010 at 11:58 AM, Edward Z. Yang ezy...@mit.edu wrote: I think you're right. A further comment is that you don't really need stringent timing conditions (which is the only thing I think of when I hear race) to see another thread grab the mvar underneath

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

2010-11-05 Thread Bertram Felgenhauer
| Then we can define | | safeCoerce :: (a ~~ b) = a - b | safeCoerce = unsafeCoerce Yes, that's right. When I said we have the technology I meant that we (will) have something similar to ~~. See our paper Generative Type Abstraction and Type-level Computation

Re: [Haskell-cafe] Scrap your rolls/unrolls

2010-11-02 Thread Bertram Felgenhauer
Max Bolingbroke wrote: On 23 October 2010 15:32, Sjoerd Visscher sjo...@w3future.com wrote: A little prettier (the cata detour wasn't needed after all):   data IdThunk a   type instance Force (IdThunk a) = a Yes, this IdThunk is key - in my own implementation I called this Forced,

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

2010-11-02 Thread Bertram Felgenhauer
Simon Peyton-Jones wrote: What you really want is to say is something like this. Suppose my_tree :: Tree String. Then you'd like to say my_tree ::: Tree Foo meaning please find a way to convert m_tree to type (Tree Foo), using newtype coercions. The exact syntax is a problem

Re: [Haskell-cafe] Re: Eta-expansion destroys memoization?

2010-10-12 Thread Bertram Felgenhauer
Simon Marlow wrote: Interesting. You're absolutely right, GHC doesn't respect the report, on something as basic as sections! The translation we use is (e op) == (op) e once upon a time, when the translation in the report was originally written (before seq was added) this would have

Re: [Haskell-cafe] hClose: invalid argument (Invalid or incomplete multibyte or wide character)

2010-10-06 Thread Bertram Felgenhauer
Hi, Daniel Fischer wrote: On Tuesday 05 October 2010 23:34:56, Johannes Waldmann wrote: main = writeFile check.out ü that's u-umlaut, and the source file is utf-8-encoded and ghc-6.12.3 compiles it without problems but when running, I get hClose: invalid argument (Invalid or

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

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

Re: [Haskell-cafe] Re: base-3 -gt; base-4

2010-09-05 Thread Bertram Felgenhauer
Johannes Waldmann wrote: Ivan Lazar Miljenovic ivan.miljenovic at gmail.com writes: ... the only thing that changed of significance was the exception handling: Control.Exception now uses extensible exceptions base-4 also introduced the Control.Category.Category class and restructured

Re: [Haskell-cafe] Fast Integer Input

2010-08-23 Thread Bertram Felgenhauer
Serguey Zefirov wrote: 2010/8/23 200901...@daiict.ac.in: This function takes 1.8 seconds to convert 2000 integers of length 10^13000. I need it to be smaller that 0.5 sec. Is it possible? 2000 integers of magnitude 10^13000 equals to about 26 MBytes of data (2000 numbers each 13000

Re: [Haskell-cafe] Space leak with unsafePerformIO

2010-06-27 Thread Bertram Felgenhauer
Henning Thielemann wrote: Attached is a program with a space leak that I do not understand. I have coded a simple 'map' function, once using unsafePerformIO and once without. UnsafePerformIO has a space leak in some circumstances. In the main program I demonstrate cases with and without space

Re: [Haskell-cafe] Re: Huffman Codes in Haskell

2010-06-27 Thread Bertram Felgenhauer
Andrew Bromage wrote: But honestly, it's just not that hard to do in linear time, assuming the symbols are sorted by frequency: Or maybe not so easy. But not much harder. data Tree a = Branch (Tree a) (Tree a) | Leaf a deriving Show huffmanTree :: (Ord a, Num a) = [(a,

Re: [Haskell-cafe] C variable access via FFI

2010-04-20 Thread Bertram Felgenhauer
Tom Hawkins wrote: I have a bunch of global variables in C I would like to directly read and write from Haskell. Is this possible with FFI, Yes it is, as explained in section 4.1.1. in the FFI specification [1]. An import for a global variable int bar would look like this: foreign

Re: [Haskell-cafe] GHC, odd concurrency space leak

2010-04-18 Thread Bertram Felgenhauer
Bulat Ziganshin wrote: This expands as always a = a always a = a a always a = a a a always a ... where each application is represented by a newly allocated object (or several, I have not looked at it in detail) on the heap. why

Re: [Haskell-cafe] GHC, odd concurrency space leak

2010-04-17 Thread Bertram Felgenhauer
Daniel Fischer wrote: Am Samstag 17 April 2010 14:41:28 schrieb Simon Peyton-Jones: I have not been following the details of this, I'm afraid, but I notice this: forever' m = do _ - m forever' m When I define that version of forever, the space leak goes away.

Re: [Haskell-cafe] GHC, odd concurrency space leak

2010-04-17 Thread Bertram Felgenhauer
Bulat Ziganshin wrote: Hello Bertram, Sunday, April 18, 2010, 12:11:05 AM, you wrote: always a = -- let act = a act in act do _ - a always a hinting at the real problem: 'always' actually creates a long chain of actions instead of tying the

Re: [Haskell-cafe] GHC, odd concurrency space leak

2010-04-17 Thread Bertram Felgenhauer
Daniel Fischer wrote: Except that with optimisations turned on, GHC ties the knot for you (at least if always isn't exported). Without -fno-state-hack, the knot is tied so tightly that always (return ()) is never descheduled (and there's no leak). Yes, I was concentrating on -O2, without

Re: Fwd: [Haskell-cafe] Re: Simple game: a monad for each player

2010-04-14 Thread Bertram Felgenhauer
Limestraël wrote: Okay, I just understood that 'Prompt' was just a sort of view for 'Program'. Right. runMyStackT :: MyStackT (Player m) a - Player m a According to what Bertram said, each strategy can pile its own custom monad stack ON the (Player m) monad. Yes, and I meant what

Re: [Haskell-cafe] Simple game: a monad for each player

2010-04-13 Thread Bertram Felgenhauer
Yves Parès wrote: I answered my own question by reading this monad-prompt example: http://paste.lisp.org/display/53766 But one issue remains: those examples show how to make play EITHER a human or an AI. I don't see how to make a human player and an AI play SEQUENTIALLY (to a TicTacToe,

Re: [Haskell-cafe] Re: Asynchronous exception wormholes kill modularity

2010-04-09 Thread Bertram Felgenhauer
Simon Marlow wrote: but they are needlessly complicated, in my opinion. This offers the same functionality: mask :: ((IO a - IO a) - IO b) - IO b mask io = do b - blocked if b then io id else block $ io unblock How does forkIO fit into the picture? That's one point where

Re: [Haskell-cafe] Re: Asynchronous exception wormholes kill modularity

2010-04-09 Thread Bertram Felgenhauer
Simon Marlow wrote: On 09/04/2010 09:40, Bertram Felgenhauer wrote: Simon Marlow wrote: mask :: ((IO a - IO a) - IO b) - IO b How does forkIO fit into the picture? That's one point where reasonable code may want to unblock all exceptions unconditionally - for example to allow the thread

Re: [Haskell-cafe] Re: breadth first search one-liner?

2010-03-22 Thread Bertram Felgenhauer
Ross Paterson wrote: On Mon, Mar 22, 2010 at 10:30:32AM +, Johannes Waldmann wrote: Nice! - Where's the 'nub'? A bit longer: bfs :: Eq a = (a - [a]) - a - [a] bfs f s = concat $ takeWhile (not . null) $ map snd $ iterate step ([], [s]) where step (seen, xs) = let seen' = xs++seen

Re: [Haskell-cafe] Re: breadth first search one-liner?

2010-03-22 Thread Bertram Felgenhauer
Bertram Felgenhauer wrote: or bfs next start = lefts . takeWhile (not . null) I copied the wrong version. This should be bfs next start = rights . concat . takeWhile (not . null) -- rest unchanged . unfoldr (Just . span (either (const False) (const True)) . tail

Re: [Haskell-cafe] parallel matrix multiply (dph, par/pseq)

2010-01-18 Thread Bertram Felgenhauer
Johannes Waldmann wrote: Hello. How can I multiply matrices (of Doubles) with dph (-0.4.0)? (ghc-6.12.1) - I was trying type Vector = [:Double:] type Matrix = [:Vector:] times :: Matrix - Matrix - Matrix times a b = mapP ( \ row - mapP ( \ col - sumP ( zipWithP (*)

Re: [Haskell-cafe] Are there standard idioms for lazy, pure error handling?

2009-12-13 Thread Bertram Felgenhauer
Duncan Coutts wrote: Another approach that some people have advocated as a general purpose solution is to use: data Exceptional e a = Exceptional { exception :: Maybe e result:: a } However it's pretty clear from the structure of this type that it cannot cope with lazy error

Re: [Haskell-cafe] Fair diagonals

2009-11-06 Thread Bertram Felgenhauer
Martijn van Steenbergen wrote: Bonus points for the following: * An infinite number of singleton axes produces [origin] (and finishes computing), e.g. forall (infinite) xs. diagN (map (:[]) xs) == map (:[]) xs This can't be done - you can not produce any output before you have checked that

Re: [Haskell-cafe] \Statically checked binomail heaps?

2009-10-30 Thread Bertram Felgenhauer
Maciej Kotowicz wrote: I'm trying to implement a binomial heaps from okaski's book [1] but as most it's possible to be statically checked for correctness of definition. How about this encoding in Haskell 98? data Tree a t = Tree { root :: a, children :: t } data Nest a t = Nest { head

Re: [Haskell-cafe] Re: Haskell Platform - changing the global install dir

2009-10-06 Thread Bertram Felgenhauer
Paul Moore wrote: grep global -A7 D:\Documents and Settings\uk03306\Application Data\cabal\config install-dirs global -- prefix: D:\\Apps\\Haskell\\Cabal ^^^ You should remove the '-- '. Lines beginning with '--' are comments. So this line has no effect. HTH, Bertram

Re: [Haskell-cafe] Quadratic complexity though use of STArrays

2009-09-27 Thread Bertram Felgenhauer
Dan Rosén wrote: What complexity does these functions have? I argue that the shuffleArr function should be O(n), since it only contains one loop of n, where each loop does actions that are O(1): generating a random number and swapping two elements in an array. However, they both have the

Re: [Haskell-cafe] How to calculate de number of digits of an integer? (was: Is logBase right?)

2009-08-29 Thread Bertram Felgenhauer
Uwe Hollerbach wrote: Here's my version... maybe not as elegant as some, but it seems to work. For base 2 (or 2^k), it's probably possible to make this even more efficient by just walking along the integer as stored in memory, but that difference probably won't show up until at least tens of

Re: [Haskell-cafe] Improving MPTC usability when fundeps aren't appropriate?

2009-08-13 Thread Bertram Felgenhauer
Daniel Peebles wrote: I've been playing with multiparameter typeclasses recently and have written a few uncallable methods in the process. For example, in class Moo a b where moo :: a - a Another solution would be to artificially force moo to take a dummy b so that the compiler can

Re: [Haskell-cafe] Re: [Haskell] ANNOUNCE: OpenGL 2.3.0.0

2009-08-01 Thread Bertram Felgenhauer
Rafael Gustavo da Cunha Pereira Pinto wrote: Sorry for all this annoyance, but I was starting to study those libraries (OpenGL, GLUT and GLFW) using Haskell and the update broke some of my code. Here is a patch that makes it compile, but then it breaks all code developed for GLFW-0.3, as all

Re: [Haskell-cafe] excercise - a completely lazy sorting algorithm

2009-07-12 Thread Bertram Felgenhauer
Petr Pudlak wrote: Would it be possible to create a lazy selection/sorting algorithm so that getting any element of the sorted list/array by its index would require just O(n) time, and getting all the elements would still be in O(n * log n)? The (merge) sorting algorithm provided by Data.List

Re: [Haskell-cafe] Type families and polymorphism

2009-07-12 Thread Bertram Felgenhauer
Jeremy Yallop wrote: Why does compiling the following program give an error? {-# LANGUAGE TypeFamilies, RankNTypes #-} type family TF a identity :: (forall a. TF a) - (forall a. TF a) identity x = x GHC 6.10.3 gives me: Couldn't match expected type `TF a1' against inferred type `TF

Re: [Haskell-cafe] STM/Data Invariant related Segfault with GHC 6.10.3

2009-06-22 Thread Bertram Felgenhauer
Jan Schaumlöffel wrote: I just discovered that programs compiled with GHC 6.10.3 segfault when accessing a TVar created under certain conditions. This is a known bug, but it hasn't gotten much attention: http://hackage.haskell.org/trac/ghc/ticket/3049 Bertram

Re: [Haskell-cafe] Slightly off-topic: Lambda calculus

2009-06-21 Thread Bertram Felgenhauer
Miguel Mitrofanov wrote: Correction: I think that one can find an expression that causes name clashes anyway, I'm just not certain that there is one that would clash independent of whichever order you choose. Yes there is. Consider (\f g - f (f (f (f (f (f g)) (\l a b - l (b a)) (\x -

Re: [Haskell-cafe] Performance of functional priority queues

2009-06-15 Thread Bertram Felgenhauer
Sebastian Sylvan wrote: On Mon, Jun 15, 2009 at 4:18 AM, Richard O'Keefe o...@cs.otago.ac.nz wrote: There's a current thread in the Erlang mailing list about priority queues. I'm aware of, for example, the Brodal/Okasaki paper and the David King paper. I'm also aware of James Cook's

Re: [Haskell-cafe] nubBy seems broken in recent GHCs

2009-06-06 Thread Bertram Felgenhauer
Cale Gibbard wrote: According to the Report: nubBy:: (a - a - Bool) - [a] - [a] nubBy eq [] = [] nubBy eq (x:xs) = x : nubBy eq (filter (\y - not (eq x y)) xs) Hence, we should have that nubBy () (1:2:[]) = 1 : nubBy () (filter (\y - not (1 y)) (2:[])) = 1

Re: [Haskell-cafe] Still having problems building a very simple Executable ....

2009-06-06 Thread Bertram Felgenhauer
Hi Vasili, Vasili I. Galchin wrote: I picked an exceedingly case to build an Executable: Executable QNameTest Hs-source-dirs: Swish/ Main-Is:HaskellUtils/QNameTest.hs Other-Modules: HaskellUtils.QName I'm not sure what you did; the original Swish code doesn't

Re: [Haskell-cafe] type checking that I can't figure out ....

2009-06-03 Thread Bertram Felgenhauer
Michael Snoyman wrote: On Wed, Jun 3, 2009 at 8:42 AM, Daniel Fischer daniel.is.fisc...@web.dewrote: Am Mittwoch 03 Juni 2009 06:12:46 schrieb Michael Snoyman: 2. lookup does not return any generalized Monad, just Maybe (I think that should be changed). Data.Map.lookup used to

Re: [Haskell-cafe] Cabal/primes

2009-06-02 Thread Bertram Felgenhauer
michael rice wrote: Finally got adventurous enough to get Cabal working, downloaded the primes package, and got the following error message when trying isPrime. Am I missing something here? The Data.Numbers.Primes module of the primes package does not implement 'isPrime'. The Numbers package

Re: [Haskell-cafe] Stack overflow

2009-05-28 Thread Bertram Felgenhauer
Krzysztof Skrzętnicki wrote: 2009/5/27 Bertram Felgenhauer bertram.felgenha...@googlemail.com: I wrote: Krzysztof Skrzętnicki wrote: The code for modifying the counter: (\ msg - atomicModifyIORef ioref (\ cnt - (cntMsg cnt msg,( atomicModifyIORef does not force the new value

Re: [Haskell-cafe] Stack overflow

2009-05-27 Thread Bertram Felgenhauer
Krzysztof Skrzętnicki wrote: The code for modifying the counter: (\ msg - atomicModifyIORef ioref (\ cnt - (cntMsg cnt msg,( atomicModifyIORef does not force the new value of the IORef. If the previous contents of the IORef is x, the new contents will be a thunk, (\ cnt - (cntMsg cnt

Re: [Haskell-cafe] Stack overflow

2009-05-27 Thread Bertram Felgenhauer
I wrote: Krzysztof Skrzętnicki wrote: The code for modifying the counter: (\ msg - atomicModifyIORef ioref (\ cnt - (cntMsg cnt msg,( atomicModifyIORef does not force the new value of the IORef. If the previous contents of the IORef is x, the new contents will be a thunk,   (\ cnt -

Re: [Haskell-cafe] Issues with IO and FFIs

2009-04-22 Thread Bertram Felgenhauer
Jon Harrop wrote: Does anyone have any comments on the following criticism of some difficulties with FFI, including IO, in Haskell: http://groups.google.com/group/comp.lang.functional/msg/6d650c086b2c8a49?hl=en That post conflates two separate questions. 1) binding to foreign libraries

Re: [Haskell-cafe] Link errors in Gtk2Hs are more general than I thought.

2009-04-04 Thread Bertram Felgenhauer
Jeff Heard wrote: I tried to get yi to run on my Mac earlier and I get the following errors: dyld: lazy symbol binding failed: Symbol not found: _cairo_quartz_font_face_create_for_atsu_font_id Referenced from: /opt/local/lib/libpangocairo-1.0.0.dylib Expected in:

Re: [Haskell-cafe] trying to download leksah ....

2009-04-04 Thread Bertram Felgenhauer
Vasili I. Galchin wrote: vigalc...@ubuntu:~/FTP$ darcs get http://code.haskell.org/leksah Invalid repository: http://code.haskell.org/leksah darcs failed: Failed to download URL http://code.haskell.org/leksah/_darcs/inventory : HTTP error (404?) I did a google on HTTP 404 = not found

Re: [Haskell-cafe] TMVar's are great but fail under ghc 6.10.1 windows

2009-03-31 Thread Bertram Felgenhauer
Alberto G. Corona wrote: however, It happens that fails in my windows box with ghc 6.10.1 , single core here is the code and the results: ---begin code: module Main where import Control.Concurrent.STM import Control.Concurrent import System.IO.Unsafe import GHC.Conc

Re: [Haskell-cafe] Re: Definition of tail recursive wrt Folds

2009-03-28 Thread Bertram Felgenhauer
Ben Franksen wrote: Mark Spezzano wrote: Just looking at the definitions for foldr and foldl I see that foldl is (apparently) tail recursive while foldr is not. Why? Is it because foldl defers calling itself until last whereas foldr evaluates itself as it runs? What, strictly

Re: [Haskell-cafe] Performance question

2009-02-26 Thread Bertram Felgenhauer
hask...@kudling.de wrote: Do you think it would be feasable to replace the GHC implementation of System.Random with something like System.Random.Mersenne? There's a problem with using the Mersenne Twister: System.Random's interface has a split method: class RandomGen g where split:: g -

Re: [Haskell-cafe] Data.Binary, strict reading

2009-02-25 Thread Bertram Felgenhauer
Neil Mitchell wrote: Hi, I want to read a file using Data.Binary, and I want to read the file strictly - i.e. when I leave the read file I want to guarantee the handle is closed. The reason is that (possibly immediately after) I need to write to the file. The following is the magic I need

Re: [Haskell-cafe] Data.Binary, strict reading

2009-02-25 Thread Bertram Felgenhauer
I wrote: With binary 0.5, Or binary 0.4.3 and later. Bertram ___ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe

Re: Pickling a finite map (Binary + zlib) [was: [Haskell-cafe] Data.Binary poor read performance]

2009-02-24 Thread Bertram Felgenhauer
Don Stewart wrote: dons: [...] Just serialising straight lists of pairs, [...] And reading them back in, main = do [f] - getArgs m - decode `fmap` L.readFile f print (length (m :: [(B.ByteString,Int)])) print done Well, you don't actually read the

Re: Pickling a finite map (Binary + zlib) [was: [Haskell-cafe] Data.Binary poor read performance]

2009-02-24 Thread Bertram Felgenhauer
Felipe Lessa wrote: On Tue, Feb 24, 2009 at 4:59 AM, Don Stewart d...@galois.com wrote: Looks like the Map reading/showing via association lists could do with further work. Anyone want to dig around in the Map instance? (There's also some patches for an alternative lazy Map

Re: [Haskell-cafe] ONeillPrimes.hs - priority queue broken?

2009-02-24 Thread Bertram Felgenhauer
Eugene Kirpichov wrote: Hi, I've recently tried to use the priority queue from the ONeillPrimes.hs, which is famous for being a very fast prime generator: actually, I translated the code to Scheme and dropped the values, to end up with a key-only heap implementation. However, the code didn't

Re: [Haskell-cafe] ONeillPrimes.hs - priority queue broken?

2009-02-24 Thread Bertram Felgenhauer
Eugene Kirpichov wrote: module PQ where import Test.QuickCheck data PriorityQ k v = Lf | Br {-# UNPACK #-} !k v !(PriorityQ k v) !(PriorityQ k v) deriving (Eq, Ord, Read, Show) For the record, we can exploit the invariant that the sizes of the left and

Re: [Haskell-cafe] Re: speed: ghc vs gcc

2009-02-20 Thread Bertram Felgenhauer
Don Stewart wrote: If we take what I usually see as the best loops GHC can do for this kind of thing: import Data.Array.Vector main = print (sumU (enumFromToU 1 (10^9 :: Int))) And compile it: $ ghc-core A.hs -O2 -fvia-C -optc-O3 We get ideal core, all data structures

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

2009-01-28 Thread Bertram Felgenhauer
wren ng thornton wrote: John Goerzen wrote: Hi folks, I have uploaded a new package to Haskell: convertible. At its heart, it's a very simple typeclass that's designed to enable a reasonable default conversion between two different types without having to remember a bunch of functions. I

Re: [Haskell-cafe] Comments from OCaml Hacker Brian Hurt

2009-01-15 Thread Bertram Felgenhauer
Andrew Wagner wrote: I think perhaps the correct question here is not how many instances of Monoid are there?, but how many functions are written that can use an arbitrary Monoid. E.g., the fact that there are a lot of instances of Monad doesn't make it useful. There are a lot of instances of

Re: [Haskell-cafe] IORef vs TVar performance: 6 seconds versus 4 minutes

2008-12-29 Thread Bertram Felgenhauer
Evan Laforge wrote: On Mon, Dec 29, 2008 at 1:15 PM, Ryan Ingram ryani.s...@gmail.com wrote: Both readTVar and writeTVar are worse than O(1); they have to look up the TVar in the transaction log to see if you have made local changes to it. Right now it looks like that operation is O(n)

Re: [Haskell-cafe] How to think about this? (profiling)

2008-12-16 Thread Bertram Felgenhauer
Magnus Therning wrote: This behaviour by Haskell seems to go against my intuition, I'm sure I just need an update of my intuition ;-) I wanted to improve on the following little example code: foo :: Int - Int foo 0 = 0 foo 1 = 1 foo 2 = 2 foo n = foo (n - 1) + foo (n - 2) +

Re: [Haskell-cafe] Memoization-question

2008-12-12 Thread Bertram Felgenhauer
Mattias Bengtsson wrote: The program below computes (f 27) almost instantly but if i replace the definition of (f n) below with (f n = f (n - 1) * f (n -1)) then it takes around 12s to terminate. I realize this is because the original version caches results and only has to calculate, for

Re: [Haskell-cafe] The Knight's Tour: solutions please

2008-12-02 Thread Bertram Felgenhauer
Dan Doel wrote: On Monday 01 December 2008 1:39:13 pm Bertram Felgenhauer wrote: As one of the posters there points out, for n=100 the program doesn't actually backtrack if the 'loneliest neighbour' heuristic is used. Do any of our programs finish quickly for n=99? The Python one doesn't

Re: [Haskell-cafe] Re: The Knight's Tour: solutions please

2008-12-02 Thread Bertram Felgenhauer
ChrisK wrote: Hmmm... it seems that n=63 is a special case. [EMAIL PROTECTED] wrote: Yes, there is a solution for n=99 and for n=100 for that matter -- which can be found under one second. I only had to make a trivial modification to the previously posted code tour n k s b | k n*n =

Re: [Haskell-cafe] The Knight's Tour: solutions please

2008-12-01 Thread Bertram Felgenhauer
Don Stewart wrote: Lee Pike forwarded the following: Solving the Knight's Tour Puzzle In 60 Lines of Python http://developers.slashdot.org/article.pl?sid=08/11/30/1722203 Seems that perhaps (someone expert in) Haskell could do even better? Maybe even parallelize the

Re: [Haskell-cafe] '#' in literate haskell

2008-11-30 Thread Bertram Felgenhauer
John MacFarlane wrote: Can anyone explain why ghc does not treat the following as a valid literate haskell program? - test.lhs # This is a test foo = reverse . words I believe this is an artifact of ghc trying to parse cpp style line number

Re: [Haskell-cafe] Permutations

2008-11-30 Thread Bertram Felgenhauer
Daniel Fischer wrote: Needs an Ord constraint: inserts :: [a] - [a] - [[a]] inserts [] ys = [ys] inserts xs [] = [xs] inserts xs@(x:xt) ys@(y:yt) = [x:zs | zs - inserts xt ys] ++ [y:zs | zs - inserts xs yt] Heh, I came up with basically the same thing. I'd

Re: [Haskell-cafe] Histogram creation

2008-11-10 Thread Bertram Felgenhauer
Alexey Khudyakov wrote: Hello! I'm tryig to write efficient code for creating histograms. I have following requirements for it: 1. O(1) element insertion 2. No reallocations. Thus in place updates are needed. accumArray won't go because I need to fill a lot of histograms (hundrends)

Re: [Haskell-cafe] Histogram creation

2008-11-10 Thread Bertram Felgenhauer
Alexey Khudyakov wrote: Hello! I'm tryig to write efficient code for creating histograms. I have following requirements for it: 1. O(1) element insertion 2. No reallocations. Thus in place updates are needed. accumArray won't go because I need to fill a lot of histograms (hundrends)

Re: [Haskell-cafe] Writing an IRC bot, problems with plugins

2008-11-06 Thread Bertram Felgenhauer
Alexander Foremny wrote: I am writing an single server, multi channel IRC bot with the support of plugins and limited plugin communication. With the plugin system I am facing problems I cannot really solve myself. Here's an approach built completely around Data.Typeable. The fundamental idea

Re: [Haskell-cafe] Anyone know why this always returns invalid texture objects?

2008-11-06 Thread Bertram Felgenhauer
[CCing gtk2hs-users] Jefferson Heard wrote: import Graphics.UI.Gtk import Graphics.UI.Gtk.Glade import Graphics.UI.Gtk.OpenGL import qualified Graphics.Rendering.OpenGL as GL import Graphics.Rendering.OpenGL (($=)) main = do initGUI initGL initGL may be slightly misleading - it

Re: [Haskell-cafe] Array bug?

2008-11-02 Thread Bertram Felgenhauer
Andrew Coppin wrote: Bertram Felgenhauer wrote: Yes, it's a known bug - a conscious choice really. See http://hackage.haskell.org/trac/ghc/ticket/2120 It's somewhat ironic that this behaviour was introduced by a patch that made arrays safer to use in other respects. ...so it's

Re: [Haskell-cafe] Array bug?

2008-11-01 Thread Bertram Felgenhauer
Andrew Coppin wrote: Consider the following GHCi session: GHCi, version 6.8.2: http://www.haskell.org/ghc/ :? for help Prelude Data.Array.IO t - newArray ((0,0),(5,4)) 0 :: IO (IOUArray (Int,Int) Int) Prelude Data.Array.IO getBounds t ((0,0),(5,4)) Prelude Data.Array.IO Is this a known

Re: [Haskell-cafe] Re: Why 'round' does not just round numbers ?

2008-10-30 Thread Bertram Felgenhauer
George Pollard wrote: There's also the ieee-utils package, which provides an IEEE monad with `setRound`: http://hackage.haskell.org/packages/archive/ieee-utils/0.4.0/doc/html/Numeric-IEEE-RoundMode.html Hmm, this does not work well with the threaded RTS: import Numeric.IEEE.Monad import

Re: [Haskell-cafe] Re: is there a way to pretty print a module?

2008-10-30 Thread Bertram Felgenhauer
Jason Dagit wrote: Could you use haskell-src from TH and then unsafePerformIO to get the reading to work during compile time? I've done something like this in the past with Language.Haskell and TH. I described it here: http://blog.codersbase.com/2006/09/01/simple-unit-testing-in-haskell/

Re: [Haskell-cafe] Re: ghc error: requested module name differs from name found in interface file

2008-10-21 Thread Bertram Felgenhauer
Larry Evans wrote: On 10/20/08 12:33, Larry Evans wrote: With a file containing: module Main where import Array import Control.Functor.Fix I get: make ghc -i/root/.cabal/lib/category-extras-0.53.5/ghc-6.8.2 -c catamorphism.example.hs Yes, using -i to give paths to installed

Re: [Haskell-cafe] is 256M RAM insufficient for a 20 million element Int/Int map?

2008-10-19 Thread Bertram Felgenhauer
Bulat Ziganshin wrote: Hello Bertram, Sunday, October 19, 2008, 6:19:31 AM, you wrote: That's 5 words per elements ... that, like everything else, should be multiplied by 2-3 to account GC effect True. You can control this factor though. Two RTS options help: -c (Enable compaction

Re: [Haskell-cafe] package question/problem

2008-10-18 Thread Bertram Felgenhauer
Galchin, Vasili wrote: I am trying to cabal install HSQL. I am using ghc 6.8.2. I get the following error about a non-visible/hidden package (old-time-1.0.0.0): [EMAIL PROTECTED]:~$ cabal install hsql [snip] Database/HSQL.hsc:66:7: Could not find module `System.Time': it is a

Re: [Haskell-cafe] is 256M RAM insufficient for a 20 million element Int/Int map?

2008-10-18 Thread Bertram Felgenhauer
Don Stewart wrote: tphyahoo: I'm trying to run a HAppS web site with a large amount of data: stress testing happstutorial.com. Well, 20 million records doesn't sound that large by today's standards, but anyway that's my goal for now. I have a standard Data.Map.Map as the base structure

Re: [Haskell-cafe] 'par' - why has it the type a - b - b ?

2008-09-29 Thread Bertram Felgenhauer
Henning Thielemann wrote: What is the reason for implementing parallelism with 'par :: a - b - b'? Analogy to 'seq'? I'd think it's actually easier to implement than par2 below; evaluating par x y sparks a thread evaluating x, and then returns y. The analogy to 'seq' is there, of course. I

Re: [Haskell-cafe] random colors, stack space overflow, mersenne and mersenne.pure64

2008-09-12 Thread Bertram Felgenhauer
Cetin Sert wrote: [snip] colorR :: RandomGen g ⇒ (RGB,RGB) → g → (RGB,g) colorR ((a,b,c),(x,y,z)) s0 = ((r,g,b),s3) where (r,s1) = q (a,x) s0 (g,s2) = q (b,y) s1 (b,s3) = q (c,z) s2 q = randomR Look closely at how you use the variable 'b'. HTH, Bertram

Re: [Haskell-cafe] two problems with Data.Binary and Data.ByteString

2008-08-14 Thread Bertram Felgenhauer
Tim Newsham wrote: [snip] I would have expected this to fix my problems: binEof :: Get () binEof = do more - not $ isEmpty when more $ error expected EOF decodeFully :: Binary b = B.ByteString - b decodeFully = runGet (get binEof) where a b = a = (\x - b return

Re: [Haskell-cafe] -fvia-C error

2008-06-12 Thread Bertram Felgenhauer
Duncan Coutts wrote: Don, this does not work: includes: SFMT.h SFMT_wrap.h install-includes: SFMT.h Sorry, that was my fault. (It does work with ghc 6.9, but that's not much of an excuse) Bertram ___ Haskell-Cafe mailing list

Re: [Haskell-cafe] Mersenne Build Problem

2008-06-07 Thread Bertram Felgenhauer
Dominic Steinitz wrote: I'm getting errors (see below) trying to build the tests in http://hackage.haskell.org/cgi-bin/hackage-scripts/package/mersenne-random-0.1.1 [snip] Linking Unit ... Unit.o: In function `s4Da_info': (.text+0x1b21): undefined reference to `genrand_real2' Unit.o:

Re: [Haskell-cafe] Re: Fwd: installing happy 1.17

2008-06-07 Thread Bertram Felgenhauer
Duncan Coutts wrote: The immediate workarounds are: * unregister Cabal-1.5.2 Better, hide it (that's reversible) - or does that not work with cabal-install? Bertram ___ Haskell-Cafe mailing list Haskell-Cafe@haskell.org

[Haskell-cafe] [ANN] hs-pgms 0.1 -- Programmer's Minesweeper in Haskell

2008-06-04 Thread Bertram Felgenhauer
Hi, I've just uploaded hs-pgms to hackage. It is a Haskell implementation of Programmer's Minesweeper [1], which allows programmers to implement minesweeper strategies and run them. (Note: ghc = 6.8 is required.) hs-pgms uses MonadPrompt to achieve a clean separation between strategies, game

Re: [Haskell-cafe] [ANNOUNCE] git-darcs-import 0.1

2008-06-03 Thread Bertram Felgenhauer
Darrin Thompson wrote: On Sun, Jun 1, 2008 at 2:44 PM, Bertram Felgenhauer [EMAIL PROTECTED] wrote: I'm pleased to announce yet another tool for importing darcs repositories to git. [...] What's the appeal of this? I personally love git, but I thought all the cool kids at this school used

Re: [Haskell-cafe] [ANNOUNCE] git-darcs-import 0.1

2008-06-02 Thread Bertram Felgenhauer
Thomas Schilling wrote: On 1 jun 2008, at 20.44, Bertram Felgenhauer wrote: [git-darcs-import] Nice! Do you happen to also have a darcs (or Git) repository somewhere? I've uploaded my (git) repo to repo.or.cz, see http://repo.or.cz/w/git-darcs-import.git Patches are welcome. enjoy

[Haskell-cafe] [ANNOUNCE] git-darcs-import 0.1

2008-06-01 Thread Bertram Felgenhauer
Hi, I'm pleased to announce yet another tool for importing darcs repositories to git. Unlike darcs2git [1] and darcs-to-git [2], it's written in Haskell, on top of the darcs2 source code. The result is a much faster program - it can convert the complete ghc 6.9 branch (without libraries) in less

  1   2   >