How does this function append the log to the beginning of the list?

Hello. Could you explain this example(0)? Could you show its step by step execution? gcd' :: Int -> Int -> Writer (DiffList String) Int gcd' a b | b == 0 = do tell (toDiffList ["Finished with " ++ show a]) return a | otherwise = do result <- gcd' b (a `mod` b) tell (toDiffList [show a ++ " mod " ++ show b ++ " = " ++ show (a `mod` b)]) return result Why does the above append the log to the beginning of the list? What value will result have in the following? result <- gcd' 2 (3 `mod` 2) (0) http://learnyouahaskell.com/for-a-few-monads-more#writer

What value will result have in the following? result <- gcd' 2 (3 `mod` 2)
First of all, your question suggests a mental model of assignables, which
you want to avoid because it will just end up confusing you.
Instead, you want to come to grips with true (lambda) variables. Read on!
The neat thing about FP in general is that you can keep DRY'er than in
other languages. Why? Because you can take any piece of code, circle almost
anywhere, and the fragment you've got is an honest-to-goodness expression
that you can evaluate (modulo the free variables in that fragment).
Define a name at the top-level and you're good to go replacing all
lookalikes with that name. This is especially true in Haskell because of
non-strict semantics, a.k.a. full beta-reduction.
Ditto for an annulus, not just circle.
Back to your original question about the value of result. First of all the
whole line isn't even an expression, being part of the sugaring over
monadic syntax, which is likely the source of the confusion.
The bigger problem however, is that in general, abstracting over this
particular example, result doesn't have the value you think it should have!
Take for instance:
x :: Maybe Int
x = return Nothing
That's (almost!) the desugar of
x = do
result <- return Nothing
return result
Now result has type Int, so let's ask: what's its Int-value?
See what I mean?
Ans: This "result" is actually a lambda variable, as is plain to see after
desugaring. That's its value!
-- Kim-Ee
On Mon, Dec 24, 2012 at 6:47 PM,
Hello.
Could you explain this example(0)? Could you show its step by step execution?
gcd' :: Int -> Int -> Writer (DiffList String) Int gcd' a b | b == 0 = do tell (toDiffList ["Finished with " ++ show a]) return a | otherwise = do result <- gcd' b (a `mod` b) tell (toDiffList [show a ++ " mod " ++ show b ++ " = " ++ show (a `mod` b)]) return result
Why does the above append the log to the beginning of the list?
What value will result have in the following?
result <- gcd' 2 (3 `mod` 2)
(0) http://learnyouahaskell.com/for-a-few-monads-more#writer
_______________________________________________ Beginners mailing list Beginners@haskell.org http://www.haskell.org/mailman/listinfo/beginners

Correction, should be:
x = do
result <- Nothing
return result
-- Kim-Ee
On Mon, Dec 24, 2012 at 8:12 PM, Kim-Ee Yeoh
What value will result have in the following? result <- gcd' 2 (3 `mod` 2)
First of all, your question suggests a mental model of assignables, which you want to avoid because it will just end up confusing you.
Instead, you want to come to grips with true (lambda) variables. Read on!
The neat thing about FP in general is that you can keep DRY'er than in other languages. Why? Because you can take any piece of code, circle almost anywhere, and the fragment you've got is an honest-to-goodness expression that you can evaluate (modulo the free variables in that fragment).
Define a name at the top-level and you're good to go replacing all lookalikes with that name. This is especially true in Haskell because of non-strict semantics, a.k.a. full beta-reduction.
Ditto for an annulus, not just circle.
Back to your original question about the value of result. First of all the whole line isn't even an expression, being part of the sugaring over monadic syntax, which is likely the source of the confusion.
The bigger problem however, is that in general, abstracting over this particular example, result doesn't have the value you think it should have!
Take for instance:
x :: Maybe Int x = return Nothing
That's (almost!) the desugar of
x = do result <- return Nothing return result
Now result has type Int, so let's ask: what's its Int-value?
See what I mean?
Ans: This "result" is actually a lambda variable, as is plain to see after desugaring. That's its value!
-- Kim-Ee
On Mon, Dec 24, 2012 at 6:47 PM,
wrote: Hello.
Could you explain this example(0)? Could you show its step by step execution?
gcd' :: Int -> Int -> Writer (DiffList String) Int gcd' a b | b == 0 = do tell (toDiffList ["Finished with " ++ show a]) return a | otherwise = do result <- gcd' b (a `mod` b) tell (toDiffList [show a ++ " mod " ++ show b ++ " = " ++ show (a `mod` b)]) return result
Why does the above append the log to the beginning of the list?
What value will result have in the following?
result <- gcd' 2 (3 `mod` 2)
(0) http://learnyouahaskell.com/for-a-few-monads-more#writer
_______________________________________________ Beginners mailing list Beginners@haskell.org http://www.haskell.org/mailman/listinfo/beginners

On Montag, 24. Dezember 2012, 06:47:34, jugree@lavabit.com wrote:
Hello.
Could you explain this example(0)? Could you show its step by step execution?
gcd' :: Int -> Int -> Writer (DiffList String) Int gcd' a b | b == 0 = do tell (toDiffList ["Finished with " ++ show a]) return a | otherwise = do result <- gcd' b (a `mod` b) tell (toDiffList [show a ++ " mod " ++ show b ++ " = " ++ show (a `mod` b)]) return result
Why does the above append the log to the beginning of the list?
It doesn't. Note that it first computes the gcd of b and (a `mod` b), logging the steps, and only afterwards "tell"s the original arguments. So the very first thing that is logged is the "Finished with" message. gcd' 3 2 -- nothing logged yet gcd' 2 1 -- nothing logged yet gcd' 1 0 -- start logging tell (["Finished with 1"]++) return 1 -- log is (["F. w. 1"]++) tell (["2 mod 1 = 0"]++) return 1 -- log is ((["F. w. 1"]++) . (["2 mod 1 = 0"]++)) tell (["3 mod 2 = 1"]++) return 1 -- log is (((["F. w. 1"]++) . (["2 mod 1 = 0"]++)) . (["3 mod 2 = 1"]++))
What value will result have in the following?
result <- gcd' 2 (3 `mod` 2)
result will be bound to 1 (the value of gcd 2 1). Basically, a `Writer monoid a` is a pair `(a, monoid)` and the monadic bind `(>>=)` that the do-notation desugars to is (x,log) >>= f = let (y, newLog) = f x in (y, log `mappend` newLog) so do result <- gcd' 2 (3 `mod` 2) tell (["3 mod 2 = 1"]++) return result becomes gcd' 2 1 >>= \result -> (tell (...) >> return result) and substituting gcd' 2 1 with its result: (1,log) >>= \result -> (tell (...) >> return result) ~> let (y, newLog) = (\result -> (tell (...) >> return result)) 1 in (y, log <> newLog) ~> let (y, newLog) = tell (...) >> return 1 in (y, log <> newLog) ~> let (y, newLog) = let (_, told) = tell (...) in (1, mempty <> told) in (y, log <> newLog)
(0) http://learnyouahaskell.com/for-a-few-monads-more#writer
participants (3)
-
Daniel Fischer
-
jugree@lavabit.com
-
Kim-Ee Yeoh