[Haskell-cafe] matrix computations based on the GSL
Alberto Ruiz
aruiz at um.es
Tue Jul 19 09:11:27 EDT 2005
Hello Bulat, thanks a lot for your message, the RULES pragma is just what we
need!
However, in some initial experiments I have observed some strange behavior.
For instance, in the following program:
------------------------------------------
{-# OPTIONS_GHC -fglasgow-exts #-}
apply :: (Int -> Int) -> Int -> Int
apply f n = f n
sqr :: Int -> Int
sqr n = n * n
optimized_sqr :: Int -> Int
optimized_sqr n = n*n+1 -- to check that the rule works :-)
{-# RULES
"apply/sqr" apply sqr = optimized_sqr
#-}
main = do
--print $ apply sqr 3
print $ apply sqr 5
-----------------------------------------
The rule is not applied.
1 RuleFired
1 *#
if we uncomment the first line in the main function
main = do
print $ apply sqr 3
print $ apply sqr 5
then the rule is correctly applied:
6 RuleFired
2 *#
2 +#
2 apply/sqr
Solution: include at the beginning of the file
module Main
where
and then the rule works in both cases.
I have a similar problem in the LinearAlgebra library but there, curiously,
the rule only works if it is applied once:
module Main
where
import (...)
(...)
main = do
(...)
print $ Vector.map cos v
--print $ Vector.map cos v
==================== Grand total simplifier statistics ====================
Total ticks: 2584
461 PreInlineUnconditionally
230 PostInlineUnconditionally
387 UnfoldingDone
91 RuleFired
2 *#
16 *##
5 +##
8 ++
5 -##
2 SPEC $fLinearArray1
2 SPEC $fLinearArray2
1 SPEC $fNumComplex
1 SPEC $fShowComplex
1 Vector.map/cos <--------------- OK
20 int2Double#
4 map
4 mapList
2 plusDouble 0.0 x
4 plusDouble x 0.0
2 timesDouble x 0.0
2 timesDouble x 1.0
3 unpack
3 unpack-list
2 zipWith
2 zipWithList
47 LetFloatFromLet
9 EtaReduction
1136 BetaReduction
6 CaseOfCase
217 KnownBranch
14 SimplifierDone
But:
(...)
main = do
(...)
print $ Vector.map cos v
print $ Vector.map cos v
==================== Grand total simplifier statistics ====================
Total ticks: 2664
470 PreInlineUnconditionally
240 PostInlineUnconditionally
402 UnfoldingDone
90 RuleFired
2 *#
16 *##
5 +##
8 ++
5 -##
2 SPEC $fLinearArray1
2 SPEC $fLinearArray2
1 SPEC $fNumComplex
1 SPEC $fShowComplex
20 int2Double#
4 map
4 mapList
2 plusDouble 0.0 x
4 plusDouble x 0.0
2 timesDouble x 0.0
2 timesDouble x 1.0
3 unpack
3 unpack-list
2 zipWith
2 zipWithList
49 LetFloatFromLet
9 EtaReduction
1181 BetaReduction
5 CaseOfCase
218 KnownBranch
17 SimplifierDone
I have tried several ideas, without any luck.
Alberto
On Monday 18 July 2005 10:14, Bulat Ziganshin wrote:
> Hello Alberto,
>
> Wednesday, July 13, 2005, 8:13:48 PM, you wrote:
> >>If there are no efficiency concerns, I would drop element-wise operations
> >>and prefer a matrix-map and a matrix-zipWith. If these operations shall
> >>remain I would somehow point to their element-wise operation in the name.
>
> AR> There is about 5x speed gain if we map in the C side. The "optimized"
> floating AR> map functions could be moved to a separate module.
>
> GHC also have a RULES pragma which can be used to automatically
> convert, for example, "mmap (*)" to "multipleElementWise". below is
> examples of using this pragma in the standard GHC modules:
>
> {-# RULES
> "foldr/id" foldr (:) [] = \x->x
> "foldr/single" forall k z x. foldr k z [x] = k x z
> "foldr/nil" forall k z. foldr k z [] = z
> #-}
More information about the Haskell-Cafe
mailing list