Re: [Haskell-cafe] Question on proper use of Data.IORef

2012-06-22 Thread Adam Smith
theValueRef isn't a pointer to theValue that you can use to somehow change
theValue (which is immutable).
theValueRef is a reference to a box that contains a totally separate,
mutable value.

When you use newIORef to create theValueRef, it's *copying* theValue into
the box. When you mutate theValueRef, you're mutating the value inside the
box - theValue remains unchanged.

Cheers,
Adam

On 22 June 2012 11:30, Captain Freako capn.fre...@gmail.com wrote:

 Hi experts,


 I fear I don't understand how to properly use *Data.IORef*.
 I wrote the following code:


   1 -- Testing Data.IORef
   2 module Main where
   3
   4 import Data.IORef
   5
   6 bump :: IORef Int - IO()
   7 bump theRef = do
   8 tmp - readIORef theRef
   9 let tmp2 = tmp + 1
  10 writeIORef theRef tmp2
  11
  12 main = do
  13 let theValue = 1
  14 print theValue
  15 theValueRef - newIORef theValue
  16 bump theValueRef
  17 return theValue


 and got this, in ghci:


 *Main :load test2.hs
 [1 of 1] Compiling Main ( test2.hs, interpreted )
 Ok, modules loaded: Main.
 *Main main
 1
 *1*


 I was expecting this:


 *Main :load test2.hs
 [1 of 1] Compiling Main ( test2.hs, interpreted )
 Ok, modules loaded: Main.
 *Main main
 1
 *2*


 Can anyone help me understand what I'm doing wrong?


 Thanks!
 -db

 ___
 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


Re: [Haskell-cafe] Specify compile error

2012-05-03 Thread Adam Smith
Nope - because at compile time, there's no way to know whether
createB's argument is a Safe or an Unsafe. That information only
exists at run time. Consider the following functions.

f :: Int - A
f x = if x  0 then Unsafe x else Safe x

g :: IO B
g = do x - getLine
   return $ createB $ f (read x)

Here, read x will convert the input (entered at runtime) to an Int
(assuming it can - failure leads to a runtime exception), and then f
will convert the resulting Int to an A, which is then passed to
createB. But there's no way of the compiler knowing whether that A
will be a Safe or an Unsafe A, since that depends on the value entered
at runtime.

If you want the compiler to typecheck two things differently, they
need to be of different types. If you give a bit more context about
what you're trying to do, someone might be able to suggest a safer way
of doing what it.

Cheers,
Adam

On 3 May 2012 11:36, Ismael Figueroa Palet ifiguer...@gmail.com wrote:

 Hi, I'm writing a program like this:

 data B = B Int
 data A = Safe Int | Unsafe Int

 createB :: A - B
 createB (Safe i) = B i
 createB (Unsafe i) = error This is not allowed

 Unfortunately, the situation when createB is called with an Unsafe value is 
 only checked at runtime.
 If I omit the second case, it is not an error to not be exhaustive :-(

 Is there a way to make it a compile time error??

 Thanks!
 --
 Ismael


 ___
 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