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 >

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 sh

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 1000

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

2012-04-04 Thread Bertram Felgenhauer
, and not write to disk at all. I suppose that ghc's interface does not support this, but I have not checked. Best regards, Bertram 1 patch for repository http://darcsden.com/jcpetruzza/hint: Wed Apr 4 14:59:33 CEST 2012 Bertram Felgenhauer * clean temporary files in runInt

[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 r

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 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 that the garb

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 wrote: > > 2011/7/20 Eugene Kirpichov > >> > >> 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 compare pointer first is a goo

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 > k

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 =

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 forkIOUnm

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 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] 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 pro

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

2010-11-02 Thread Bertram Felgenhauer
Max Bolingbroke wrote: > On 23 October 2010 15:32, Sjoerd Visscher 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", > so: > >

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 wo

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 (In

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 -> base-4

2010-09-05 Thread Bertram Felgenhauer
Johannes Waldmann wrote: > Ivan Lazar Miljenovic 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 Control.Arrow to

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 eac

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) =>

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 spa

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 impo

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 de

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: [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 i

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

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 wh

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 TicTac

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 unblo

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

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))

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'

Re: [Haskell-cafe] unexpected behavior / bug in try . System.FilePath.Find.findWithHandler

2010-01-18 Thread Bertram Felgenhauer
A late reply - but as far as I can see, this has gone unanswered so far. Thomas Hartman wrote: > Currently try . System.FilePath.Find.findWithHandler (from the FileManip package, I guess) > will return an exception wrapped in Right, which seems Wrong. For sure > it will just get ignored if wrapp

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 (

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

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 { he

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 hav

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 o

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 comp

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

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

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.L

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)) (

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 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 > > priority queue

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 does

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 <

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 > wrote: > > 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 return a value i

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 packag

Re: [Haskell-cafe] Stack overflow

2009-05-28 Thread Bertram Felgenhauer
Krzysztof Skrzętnicki wrote: > 2009/5/27 Bertram Felgenhauer : > > I wrote: > >> Krzysztof Skrzętnicki wrote: > >>> The code for modifying the counter: > >>> (\ msg -> atomicModifyIORef ioref (\ cnt -> (cntMsg cnt msg,( > >> > &g

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, > >

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 cn

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 librari

Re: [Haskell-cafe] Control.Concurrent export/import weirdness

2009-04-13 Thread Bertram Felgenhauer
Jason Dusek wrote: > Why is this function exported then imported? It causes the RTS to create a bound thread to run code in: (reordering the code slightly) > foreign import ccall "forkOS_entry" forkOS_entry_reimported > :: StablePtr (IO ()) -> IO () This is a safe call, so it suspe

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

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: /opt/local/lib/lib

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 G

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? > >

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
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: [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 n

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

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 d

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 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 serialisatio

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

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

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 funct

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 instan

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 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) where n is

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 (

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 ex

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 >

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 fin

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 parallel

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 th

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 num

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 (hu

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 (hundr

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 misleadin

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] 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 >>

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

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: 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 > imp

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

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 co

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

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': >

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

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 =

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 Haskell-C

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 http://www.haskell.org/

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'

[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 log

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, b

  1   2   >