Why is it so different between 6.12.1 and 6.10.4_1 ?

In 6.12.1 under archlinux
let f x y z = x + y + z :t f f :: (Num a) => a -> a -> a -> a
:t (>>=) . f (>>=) . f :: (Num a) => a -> ((a -> a) -> a -> b) -> a -> b ((>>=) . f) 1 (\f x -> f x) 2 5
In 6.10.4_1 under freebsd
let f x y z = x + y + z *Money> :t f f :: (Num a) => a -> a -> a -> a
:t (>>=) . f (>>=) . f :: (Monad ((->) a), Num a) => a -> ((a -> a) -> a -> b) -> a -> b ((>>=) . f) 1 (\f x -> f x) 2
<interactive>:1:1: No instance for (Monad ((->) a)) arising from a use of `>>=' at <interactive>:1:1-5 Possible fix: add an instance declaration for (Monad ((->) a)) In the first argument of `(.)', namely `(>>=)' In the expression: ((>>=) . f) 1 (\ f x -> f x) 2 In the definition of `it': it = ((>>=) . f) 1 (\ f x -> f x) 2 Sincerely! ----- fac n = let { f = foldr (*) 1 [1..n] } in f -- View this message in context: http://old.nabble.com/Why-is-it-so-different-between-6.12.1-and-6.10.4_1---t... Sent from the Haskell - Haskell-Cafe mailing list archive at Nabble.com.

On Fri, Mar 26, 2010 at 8:20 PM, zaxis
In 6.12.1 under archlinux
let f x y z = x + y + z :t f f :: (Num a) => a -> a -> a -> a
:t (>>=) . f (>>=) . f :: (Num a) => a -> ((a -> a) -> a -> b) -> a -> b ((>>=) . f) 1 (\f x -> f x) 2 5
In 6.10.4_1 under freebsd
let f x y z = x + y + z *Money> :t f f :: (Num a) => a -> a -> a -> a
:t (>>=) . f (>>=) . f :: (Monad ((->) a), Num a) => a -> ((a -> a) -> a -> b) -> a -> b ((>>=) . f) 1 (\f x -> f x) 2
<interactive>:1:1: No instance for (Monad ((->) a)) arising from a use of `>>=' at <interactive>:1:1-5 Possible fix: add an instance declaration for (Monad ((->) a)) In the first argument of `(.)', namely `(>>=)' In the expression: ((>>=) . f) 1 (\ f x -> f x) 2 In the definition of `it': it = ((>>=) . f) 1 (\ f x -> f x) 2
It looks like you have the instance Monad ((->) a) loaded in 6.12, but
not in 6.10.4. In don't know of any changes regarding that instance in
6.12, but instances stick around in ghci even after their module is
unloaded, so you might have (indirectly) loaded
Control.Monad.Instances at some point in your 6.12 session.
Try starting a fresh ghci 6.12 and see what that does.
--
Dave Menendez

Did you import the module includes the instance of Monad ((->) e)
somewhere in your code loaded in ghci?
I tried this on a fresh ghci 6.12, but I got "No instance" error.
-nwn
On Sat, Mar 27, 2010 at 9:20 AM, zaxis
In 6.12.1 under archlinux
let f x y z = x + y + z :t f f :: (Num a) => a -> a -> a -> a
:t (>>=) . f (>>=) . f :: (Num a) => a -> ((a -> a) -> a -> b) -> a -> b ((>>=) . f) 1 (\f x -> f x) 2 5
In 6.10.4_1 under freebsd
let f x y z = x + y + z *Money> :t f f :: (Num a) => a -> a -> a -> a
:t (>>=) . f (>>=) . f :: (Monad ((->) a), Num a) => a -> ((a -> a) -> a -> b) -> a -> b ((>>=) . f) 1 (\f x -> f x) 2
<interactive>:1:1: No instance for (Monad ((->) a)) arising from a use of `>>=' at <interactive>:1:1-5 Possible fix: add an instance declaration for (Monad ((->) a)) In the first argument of `(.)', namely `(>>=)' In the expression: ((>>=) . f) 1 (\ f x -> f x) 2 In the definition of `it': it = ((>>=) . f) 1 (\ f x -> f x) 2
Sincerely!
----- fac n = let { f = foldr (*) 1 [1..n] } in f -- View this message in context: http://old.nabble.com/Why-is-it-so-different-between-6.12.1-and-6.10.4_1---t... Sent from the Haskell - Haskell-Cafe mailing list archive at Nabble.com.
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe

I just start ghci from shell and do nothing else. In fact, i really donot know `Monad ((->) a) ` . Would you mind expplain it ? Yusaku Hashimoto wrote:
Did you import the module includes the instance of Monad ((->) e) somewhere in your code loaded in ghci?
I tried this on a fresh ghci 6.12, but I got "No instance" error.
-nwn
On Sat, Mar 27, 2010 at 9:20 AM, zaxis
wrote: In 6.12.1 under archlinux
let f x y z = x + y + z :t f f :: (Num a) => a -> a -> a -> a
:t (>>=) . f (>>=) . f :: (Num a) => a -> ((a -> a) -> a -> b) -> a -> b ((>>=) . f) 1 (\f x -> f x) 2 5
In 6.10.4_1 under freebsd
let f x y z = x + y + z *Money> :t f f :: (Num a) => a -> a -> a -> a
:t (>>=) . f (>>=) . f :: (Monad ((->) a), Num a) => a -> ((a -> a) -> a -> b) -> a -> b ((>>=) . f) 1 (\f x -> f x) 2
<interactive>:1:1: No instance for (Monad ((->) a)) arising from a use of `>>=' at <interactive>:1:1-5 Possible fix: add an instance declaration for (Monad ((->) a)) In the first argument of `(.)', namely `(>>=)' In the expression: ((>>=) . f) 1 (\ f x -> f x) 2 In the definition of `it': it = ((>>=) . f) 1 (\ f x -> f x) 2
Sincerely!
----- fac n = let { f = foldr (*) 1 [1..n] } in f -- View this message in context: http://old.nabble.com/Why-is-it-so-different-between-6.12.1-and-6.10.4_1---t... Sent from the Haskell - Haskell-Cafe mailing list archive at Nabble.com.
_______________________________________________ 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
----- fac n = let { f = foldr (*) 1 [1..n] } in f -- View this message in context: http://old.nabble.com/Why-is-it-so-different-between-6.12.1-and-6.10.4_1---t... Sent from the Haskell - Haskell-Cafe mailing list archive at Nabble.com.

Hmm, When a ghci was started, there should be the only loaded module
(Prelude.) And in both 6.10 and 6.12, such instance is not defined or
exported in its Prelude. So please try `ghci -ignore-dot-ghci`. It
invokes ghci without reading ~/.ghci and ./.ghci.
And `((->) a)` is known as the Reader Monad, `a` can be regarded as
the environment. My typical usage of that is like following:
import Control.Monad
data Vec = Vec { x :: Int, y :: Int }
absolute :: Vec -> Double
absolute = sqrt . fromIntegral . liftM2 (+) (square . x) (square . y)
where
square a = a * a
The definition of `absolute` above can be rewritten as
absolute p = sqrt . fromIntegral $ square (x p) + square (y p)
where
square a = a * a
How `square . x` and `square . y` share the argument? Because `Monad
((->) a)` is defined as
instance Monad ((->) a) where
return x = \a -> x
m >>= f = \a -> f (m a) a
Note `(>>=)` propagates `a` into both of its arguments. That's why the
functions read same argument.
HTH
-nwn
On Sat, Mar 27, 2010 at 3:31 PM, zaxis
I just start ghci from shell and do nothing else. In fact, i really donot know `Monad ((->) a) ` . Would you mind expplain it ?
Yusaku Hashimoto wrote:
Did you import the module includes the instance of Monad ((->) e) somewhere in your code loaded in ghci?
I tried this on a fresh ghci 6.12, but I got "No instance" error.
-nwn
On Sat, Mar 27, 2010 at 9:20 AM, zaxis
wrote: In 6.12.1 under archlinux
let f x y z = x + y + z :t f f :: (Num a) => a -> a -> a -> a
:t (>>=) . f (>>=) . f :: (Num a) => a -> ((a -> a) -> a -> b) -> a -> b ((>>=) . f) 1 (\f x -> f x) 2 5
In 6.10.4_1 under freebsd
let f x y z = x + y + z *Money> :t f f :: (Num a) => a -> a -> a -> a
:t (>>=) . f (>>=) . f :: (Monad ((->) a), Num a) => a -> ((a -> a) -> a -> b) -> a -> b ((>>=) . f) 1 (\f x -> f x) 2
<interactive>:1:1: No instance for (Monad ((->) a)) arising from a use of `>>=' at <interactive>:1:1-5 Possible fix: add an instance declaration for (Monad ((->) a)) In the first argument of `(.)', namely `(>>=)' In the expression: ((>>=) . f) 1 (\ f x -> f x) 2 In the definition of `it': it = ((>>=) . f) 1 (\ f x -> f x) 2
Sincerely!
----- fac n = let { f = foldr (*) 1 [1..n] } in f -- View this message in context: http://old.nabble.com/Why-is-it-so-different-between-6.12.1-and-6.10.4_1---t... Sent from the Haskell - Haskell-Cafe mailing list archive at Nabble.com.
_______________________________________________ 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
----- fac n = let { f = foldr (*) 1 [1..n] } in f -- View this message in context: http://old.nabble.com/Why-is-it-so-different-between-6.12.1-and-6.10.4_1---t... Sent from the Haskell - Haskell-Cafe mailing list archive at Nabble.com.
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe

Both 6.10 and 6.12 use same .ghci ! %cat ~/.ghci :cd /media/G/www/qachina/db/doc/money :l Money %cat Money.hs|grep import import System( getArgs ) import System.Random import System.IO import System.Time import Text.Printf (printf) import Text.Regex import Data.List import Data.Time.Calendar import Data.Time.Calendar.WeekDate import Control.Monad Sincerely! Yusaku Hashimoto wrote:
Hmm, When a ghci was started, there should be the only loaded module (Prelude.) And in both 6.10 and 6.12, such instance is not defined or exported in its Prelude. So please try `ghci -ignore-dot-ghci`. It invokes ghci without reading ~/.ghci and ./.ghci.
And `((->) a)` is known as the Reader Monad, `a` can be regarded as the environment. My typical usage of that is like following:
import Control.Monad
data Vec = Vec { x :: Int, y :: Int } absolute :: Vec -> Double absolute = sqrt . fromIntegral . liftM2 (+) (square . x) (square . y) where square a = a * a
The definition of `absolute` above can be rewritten as
absolute p = sqrt . fromIntegral $ square (x p) + square (y p) where square a = a * a
How `square . x` and `square . y` share the argument? Because `Monad ((->) a)` is defined as
instance Monad ((->) a) where return x = \a -> x m >>= f = \a -> f (m a) a
Note `(>>=)` propagates `a` into both of its arguments. That's why the functions read same argument.
HTH -nwn
On Sat, Mar 27, 2010 at 3:31 PM, zaxis
wrote: I just start ghci from shell and do nothing else. In fact, i really donot know `Monad ((->) a) ` . Would you mind expplain it ?
Yusaku Hashimoto wrote:
Did you import the module includes the instance of Monad ((->) e) somewhere in your code loaded in ghci?
I tried this on a fresh ghci 6.12, but I got "No instance" error.
-nwn
On Sat, Mar 27, 2010 at 9:20 AM, zaxis
wrote: In 6.12.1 under archlinux
let f x y z = x + y + z :t f f :: (Num a) => a -> a -> a -> a
:t (>>=) . f (>>=) . f :: (Num a) => a -> ((a -> a) -> a -> b) -> a -> b ((>>=) . f) 1 (\f x -> f x) 2 5
In 6.10.4_1 under freebsd
let f x y z = x + y + z *Money> :t f f :: (Num a) => a -> a -> a -> a
:t (>>=) . f (>>=) . f :: (Monad ((->) a), Num a) => a -> ((a -> a) -> a -> b) -> a -> b ((>>=) . f) 1 (\f x -> f x) 2
<interactive>:1:1: No instance for (Monad ((->) a)) arising from a use of `>>=' at <interactive>:1:1-5 Possible fix: add an instance declaration for (Monad ((->) a)) In the first argument of `(.)', namely `(>>=)' In the expression: ((>>=) . f) 1 (\ f x -> f x) 2 In the definition of `it': it = ((>>=) . f) 1 (\ f x -> f x) 2
Sincerely!
----- fac n = let { f = foldr (*) 1 [1..n] } in f -- View this message in context: http://old.nabble.com/Why-is-it-so-different-between-6.12.1-and-6.10.4_1---t... Sent from the Haskell - Haskell-Cafe mailing list archive at Nabble.com.
_______________________________________________ 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
----- fac n = let { f = foldr (*) 1 [1..n] } in f -- View this message in context: http://old.nabble.com/Why-is-it-so-different-between-6.12.1-and-6.10.4_1---t... Sent from the Haskell - Haskell-Cafe mailing list archive at Nabble.com.
_______________________________________________ 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
----- fac n = let { f = foldr (*) 1 [1..n] } in f -- View this message in context: http://old.nabble.com/Why-is-it-so-different-between-6.12.1-and-6.10.4_1---t... Sent from the Haskell - Haskell-Cafe mailing list archive at Nabble.com.

zaxis
In 6.10.4_1 under freebsd
let f x y z = x + y + z *Money> :t f f :: (Num a) => a -> a -> a -> a
:t (>>=) . f (>>=) . f :: (Monad ((->) a), Num a) => a -> ((a -> a) -> a -> b) -> a -> b ((>>=) . f) 1 (\f x -> f x) 2
<interactive>:1:1: No instance for (Monad ((->) a)) arising from a use of `>>=' at <interactive>:1:1-5 Possible fix: add an instance declaration for (Monad ((->) a)) In the first argument of `(.)', namely `(>>=)' In the expression: ((>>=) . f) 1 (\ f x -> f x) 2 In the definition of `it': it = ((>>=) . f) 1 (\ f x -> f x) 2
Some definitions and exports got changed, so in 6.12 the (-> a) Monad instance is exported whereas in 6.10 it isn't.
fac n = let { f = foldr (*) 1 [1..n] } in f
Why do you bother with the interior definition of f in there? fac = product . enumFromTo 1 -- Ivan Lazar Miljenovic Ivan.Miljenovic@gmail.com IvanMiljenovic.wordpress.com

On Fri, Mar 26, 2010 at 8:59 PM, Ivan Lazar Miljenovic
zaxis
writes: In 6.10.4_1 under freebsd
let f x y z = x + y + z *Money> :t f f :: (Num a) => a -> a -> a -> a
:t (>>=) . f (>>=) . f :: (Monad ((->) a), Num a) => a -> ((a -> a) -> a -> b) -> a -> b ((>>=) . f) 1 (\f x -> f x) 2
<interactive>:1:1: No instance for (Monad ((->) a)) arising from a use of `>>=' at <interactive>:1:1-5 Possible fix: add an instance declaration for (Monad ((->) a)) In the first argument of `(.)', namely `(>>=)' In the expression: ((>>=) . f) 1 (\ f x -> f x) 2 In the definition of `it': it = ((>>=) . f) 1 (\ f x -> f x) 2
Some definitions and exports got changed, so in 6.12 the (-> a) Monad instance is exported whereas in 6.10 it isn't.
What? From where?
I thought the whole reason the Monad ((->) a) instance was in
Control.Monad.Instances (instead of Prelude) was to retain
compatibility with the library report.
--
Dave Menendez

David Menendez
On Fri, Mar 26, 2010 at 8:59 PM, Ivan Lazar Miljenovic
wrote: Some definitions and exports got changed, so in 6.12 the (-> a) Monad instance is exported whereas in 6.10 it isn't.
What? From where?
I thought the whole reason the Monad ((->) a) instance was in Control.Monad.Instances (instead of Prelude) was to retain compatibility with the library report.
I forget the specifics, but we had a discussion on this in #haskell a month or so ago: IIRC either the instance definition's location was changed or else it was re-exported by Control.Monad now or something. -- Ivan Lazar Miljenovic Ivan.Miljenovic@gmail.com IvanMiljenovic.wordpress.com

On Fri, Mar 26, 2010 at 9:13 PM, Ivan Lazar Miljenovic
David Menendez
writes: On Fri, Mar 26, 2010 at 8:59 PM, Ivan Lazar Miljenovic
wrote: Some definitions and exports got changed, so in 6.12 the (-> a) Monad instance is exported whereas in 6.10 it isn't.
What? From where?
I thought the whole reason the Monad ((->) a) instance was in Control.Monad.Instances (instead of Prelude) was to retain compatibility with the library report.
I forget the specifics, but we had a discussion on this in #haskell a month or so ago: IIRC either the instance definition's location was changed or else it was re-exported by Control.Monad now or something.
Are you sure? This would be a fairly significant change, and there's
no mention of it in the 6.12 release notes.
--
Dave Menendez

fac n = let { f = foldr (*) 1 [1..n] } in f
Why do you bother with the interior definition of f in there?
fac = product . enumFromTo 1
let fac = do is_zero <- (==0); if is_zero then return 1 else liftM2
(*) id (fac . pred)
-nwn
On Sat, Mar 27, 2010 at 9:59 AM, Ivan Lazar Miljenovic
zaxis
writes: In 6.10.4_1 under freebsd
let f x y z = x + y + z *Money> :t f f :: (Num a) => a -> a -> a -> a
:t (>>=) . f (>>=) . f :: (Monad ((->) a), Num a) => a -> ((a -> a) -> a -> b) -> a -> b ((>>=) . f) 1 (\f x -> f x) 2
<interactive>:1:1: No instance for (Monad ((->) a)) arising from a use of `>>=' at <interactive>:1:1-5 Possible fix: add an instance declaration for (Monad ((->) a)) In the first argument of `(.)', namely `(>>=)' In the expression: ((>>=) . f) 1 (\ f x -> f x) 2 In the definition of `it': it = ((>>=) . f) 1 (\ f x -> f x) 2
Some definitions and exports got changed, so in 6.12 the (-> a) Monad instance is exported whereas in 6.10 it isn't.
fac n = let { f = foldr (*) 1 [1..n] } in f
Why do you bother with the interior definition of f in there?
fac = product . enumFromTo 1
-- Ivan Lazar Miljenovic Ivan.Miljenovic@gmail.com IvanMiljenovic.wordpress.com _______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe

Why do you bother with the interior definition of f in there? Because i want to try a C code style not layout style without `do` syntax sugar .
Yusaku Hashimoto wrote:
fac n = let { f = foldr (*) 1 [1..n] } in f
Why do you bother with the interior definition of f in there?
fac = product . enumFromTo 1
let fac = do is_zero <- (==0); if is_zero then return 1 else liftM2 (*) id (fac . pred)
-nwn
On Sat, Mar 27, 2010 at 9:59 AM, Ivan Lazar Miljenovic
wrote: zaxis
writes: In 6.10.4_1 under freebsd
let f x y z = x + y + z *Money> :t f f :: (Num a) => a -> a -> a -> a
:t (>>=) . f (>>=) . f :: (Monad ((->) a), Num a) => a -> ((a -> a) -> a -> b) -> a -> b ((>>=) . f) 1 (\f x -> f x) 2
<interactive>:1:1: No instance for (Monad ((->) a)) arising from a use of `>>=' at <interactive>:1:1-5 Possible fix: add an instance declaration for (Monad ((->) a)) In the first argument of `(.)', namely `(>>=)' In the expression: ((>>=) . f) 1 (\ f x -> f x) 2 In the definition of `it': it = ((>>=) . f) 1 (\ f x -> f x) 2
Some definitions and exports got changed, so in 6.12 the (-> a) Monad instance is exported whereas in 6.10 it isn't.
fac n = let { f = foldr (*) 1 [1..n] } in f
Why do you bother with the interior definition of f in there?
fac = product . enumFromTo 1
-- Ivan Lazar Miljenovic Ivan.Miljenovic@gmail.com IvanMiljenovic.wordpress.com _______________________________________________ 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
----- fac n = let { f = foldr (*) 1 [1..n] } in f -- View this message in context: http://old.nabble.com/Why-is-it-so-different-between-6.12.1-and-6.10.4_1---t... Sent from the Haskell - Haskell-Cafe mailing list archive at Nabble.com.

zaxis
Why do you bother with the interior definition of f in there? Because i want to try a C code style not layout style without `do` syntax sugar .
Haskell /= C, so stop trying to code as if it is. If you like C so much, then use C. -- Ivan Lazar Miljenovic Ivan.Miljenovic@gmail.com IvanMiljenovic.wordpress.com

Of course, you are wrong ! C is VERY important for almost every programmer in the world! Why cannot C programmer use haskell ? And Why does haskell support C code style ? Ivan Miljenovic wrote:
zaxis
writes: Why do you bother with the interior definition of f in there? Because i want to try a C code style not layout style without `do` syntax sugar .
Haskell /= C, so stop trying to code as if it is. If you like C so much, then use C.
-- Ivan Lazar Miljenovic Ivan.Miljenovic@gmail.com IvanMiljenovic.wordpress.com _______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
----- fac n = let { f = foldr (*) 1 [1..n] } in f -- View this message in context: http://old.nabble.com/Why-is-it-so-different-between-6.12.1-and-6.10.4_1---t... Sent from the Haskell - Haskell-Cafe mailing list archive at Nabble.com.

I think Miljenovic was asking about this (I removed explicit braces): fac n = let f = foldr (*) 1 [1..n] in f Which is strictly equivalent to: fac n = foldr (*) 1 [1..n] Translated into C, this is kind of like doing this: int add(int x, int y) { int sum = x + y; return sum; } instead of this: int add(int x, int y) { return x + y; } I find it very cumbersome (though not *difficult*) and painful to use a C style of programming with Haskell, so I am not sure what you mean when you ask why Haskell supports C style. Are you talking about mutable state, syntax, or something else? --Dietrich On 2010 March 27, at 4:28, zaxis wrote:
Of course, you are wrong ! C is VERY important for almost every programmer in the world! Why cannot C programmer use haskell ? And Why does haskell support C code style ?
Ivan Miljenovic wrote:
zaxis
writes: Why do you bother with the interior definition of f in there? Because i want to try a C code style not layout style without `do` syntax sugar .
Haskell /= C, so stop trying to code as if it is. If you like C so much, then use C.
-- Ivan Lazar Miljenovic Ivan.Miljenovic@gmail.com IvanMiljenovic.wordpress.com _______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
----- fac n = let { f = foldr (*) 1 [1..n] } in f -- View this message in context: http://old.nabble.com/Why-is-it-so-different-between-6.12.1-and-6.10.4_1---t... Sent from the Haskell - Haskell-Cafe mailing list archive at Nabble.com.
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe

I just mean syntax. For example. the following code snippet is C-style. In vim, i can use `shift+%` to jump between `{' and `}', and so on. hitSSQ hitNum = do { nums <- fmap str_ints_pick $ readFile "ssqNum.txt"; forM_ nums (\n -> do { let { hitB = if (n!!6 == hitNum!!6) then 1 else 0 ; hitR = foldl (\acc x -> if(elem x (init hitNum)) then acc+1 else acc) 0 (init n);}; printf "%s\t%d:%d\t%s\n" (show n) (hitR::Int) (hitB::Int) (hit_desc hitR hitB); }); } Dietrich Epp-2 wrote:
I think Miljenovic was asking about this (I removed explicit braces):
fac n = let f = foldr (*) 1 [1..n] in f
Which is strictly equivalent to:
fac n = foldr (*) 1 [1..n]
Translated into C, this is kind of like doing this:
int add(int x, int y) { int sum = x + y; return sum; }
instead of this:
int add(int x, int y) { return x + y; }
I find it very cumbersome (though not *difficult*) and painful to use a C style of programming with Haskell, so I am not sure what you mean when you ask why Haskell supports C style. Are you talking about mutable state, syntax, or something else?
--Dietrich
On 2010 March 27, at 4:28, zaxis wrote:
Of course, you are wrong ! C is VERY important for almost every programmer in the world! Why cannot C programmer use haskell ? And Why does haskell support C code style ?
Ivan Miljenovic wrote:
zaxis
writes: Why do you bother with the interior definition of f in there? Because i want to try a C code style not layout style without `do` syntax sugar .
Haskell /= C, so stop trying to code as if it is. If you like C so much, then use C.
-- Ivan Lazar Miljenovic Ivan.Miljenovic@gmail.com IvanMiljenovic.wordpress.com _______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
----- fac n = let { f = foldr (*) 1 [1..n] } in f -- View this message in context: http://old.nabble.com/Why-is-it-so-different-between-6.12.1-and-6.10.4_1---t... Sent from the Haskell - Haskell-Cafe mailing list archive at Nabble.com.
_______________________________________________ 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
----- fac n = let { f = foldr (*) 1 [1..n] } in f -- View this message in context: http://old.nabble.com/Why-is-it-so-different-between-6.12.1-and-6.10.4_1---t... Sent from the Haskell - Haskell-Cafe mailing list archive at Nabble.com.

On Sat, 2010-03-27 at 04:28 -0700, zaxis wrote:
Of course, you are wrong ! C is VERY important for almost every programmer in the world!
Hmm. We don't deny that C is important. However importance of hammer does not make screwdriver unimportant. While you can say that you can use screwdriver like a hammer (like you can use Haskell to do imperative programming or vice versa) it is usually terribly inefficient and/or inelegant.
Why cannot C programmer use haskell ?
(S)He can. However (s)he have to redefine him/herself from being C programmer. As real programmer can program in Fortran in any language you can program in any language in Haskell. You just shouldn't (as you shouldn't program in X in Y for nearly any X != Y).
And Why does haskell support C code style ?
And BTW. Haskell have no 'C' style. You probably refer to do syntax sugar which is: - Not really C-style. It have syntax nowhere like C - Only partially in traditional imperative style as it do distinguish still between pure and unpure computation - It can be use for much more then crude C

thanks for your answer! However, i still feel the following code snippets have different code style. 1. C-style winSSQ count noRed noBlue = do { let {yesRed=[1..33] \\ noRed; yesBlue=[1..16] \\ noBlue}; ps <- picoSec; setStdGen (mkStdGen $ fromInteger ps); result <- pick_ssq_nums count yesRed yesBlue []; forM_ result (\x -> print x); writeFile "ssqNum.txt" $ ints_str result; } 2. layout style picoSec :: IO Integer picoSec = do t <- ctPicosec `liftM` (getClockTime >>= toCalendarTime) return t The layout style makes me think of python. Maciej Piechotka wrote:
On Sat, 2010-03-27 at 04:28 -0700, zaxis wrote:
Of course, you are wrong ! C is VERY important for almost every programmer in the world!
Hmm. We don't deny that C is important. However importance of hammer does not make screwdriver unimportant.
While you can say that you can use screwdriver like a hammer (like you can use Haskell to do imperative programming or vice versa) it is usually terribly inefficient and/or inelegant.
Why cannot C programmer use haskell ?
(S)He can. However (s)he have to redefine him/herself from being C programmer. As real programmer can program in Fortran in any language you can program in any language in Haskell. You just shouldn't (as you shouldn't program in X in Y for nearly any X != Y).
And Why does haskell support C code style ?
And BTW. Haskell have no 'C' style. You probably refer to do syntax sugar which is: - Not really C-style. It have syntax nowhere like C - Only partially in traditional imperative style as it do distinguish still between pure and unpure computation - It can be use for much more then crude C
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
----- fac n = let { f = foldr (*) 1 [1..n] } in f -- View this message in context: http://old.nabble.com/Why-is-it-so-different-between-6.12.1-and-6.10.4_1---t... Sent from the Haskell - Haskell-Cafe mailing list archive at Nabble.com.
participants (6)
-
David Menendez
-
Dietrich Epp
-
Ivan Lazar Miljenovic
-
Maciej Piechotka
-
Yusaku Hashimoto
-
zaxis