[Haskell-cafe] Performance question

Ozgur Akgun ozgurakgun at gmail.com
Fri Apr 9 05:08:17 EDT 2010


A lte reply, but if you still need to have circular module depency: 4.6.9.
How to compile mutually recursive modules in
http://www.haskell.org/ghc/docs/latest/html/users_guide/separate-compilation.html

On 21 March 2010 01:31, Arnoldo Muller <arnoldomuller at gmail.com> wrote:

> Hello Daniel,
>
> Regarding your solution, can I apply {-# SPECIALISE ... #-} statements to
> datatypes I define?
> And if so, I am not able to import the datatypes to the module where
> binarySearch is.
> The problem is that if I import them a circular dependency is detected and
> the compiler gives an error.
> Is there a way of importing a datatype from another module do avoid this
> circular dependency?
>
> Thank you,
>
> Arnoldo
>
>
> On Thu, Mar 18, 2010 at 10:48 PM, Daniel Fischer <daniel.is.fischer at web.de
> > wrote:
>
>> Am Donnerstag 18 März 2010 21:57:34 schrieb Daniel Fischer:
>> >
>> > Contrary to my expectations, however, using unboxed arrays is slower
>> > than straight arrays (in my tests).
>> >
>>
>> However, a few {-# SPECIALISE #-} pragmas set the record straight.
>> Specialising speeds up both, boxed and unboxed arrays, significantly, but
>> now, for the specialised types, unboxed arrays are faster (note, however,
>> that when the code for the binary search is in the same module as it is
>> used, with optimisations, GHC will probably specialise it itself. If
>> binarySearch is not exported, AFAIK, you can delete "probably".).
>>
>> {-# LANGUAGE BangPatterns #-}
>> module SATBinSearch (binarySearch) where
>>
>> import Data.Array.IArray
>> import Data.Array.Base (unsafeAt)
>> import Data.Bits
>>
>> {-# SPECIALISE binarySearch :: Double -> Array Int Double -> Int #-}
>> {-# SPECIALISE binarySearch :: Int -> Array Int Int -> Int #-}
>> {-# SPECIALISE binarySearch :: Bool -> Array Int Bool -> Int #-}
>> {-# SPECIALISE binarySearch :: Char -> Array Int Char -> Int #-}
>> {-# SPECIALISE binarySearch :: Float -> Array Int Float -> Int #-}
>> binarySearch :: Ord a => a -> Array Int a -> Int
>> binarySearch q a = go l h
>>      where
>>        (l,h) = bounds a
>>        go !lo !hi
>>            | hi < lo   = -(lo+1)
>>            | otherwise = case compare mv q of
>>                            LT -> go (m+1) hi
>>                            EQ -> m
>>                            GT -> go lo (m-1)
>>              where
>>                 -- m = lo + (hi-lo) `quot` 2
>>                 m = (lo .&. hi) + (lo `xor` hi) `shiftR` 1
>>                mv = a `unsafeAt` m
>>
>> Use Data.Array.Unboxed and UArray if possible.
>> Now the bit-fiddling instead of arithmetics makes a serious difference,
>> about 20% for unboxed arrays, 17% for boxed arrays (Double), so I'd
>> recommend that.
>>
>
>
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-Cafe at haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe
>
>


-- 
Ozgur Akgun
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://www.haskell.org/pipermail/haskell-cafe/attachments/20100409/eb1a4ccd/attachment.html


More information about the Haskell-Cafe mailing list