[Haskell-cafe] closures with side effects

Jared Updike jupdike at gmail.com
Mon Jun 26 11:58:37 EDT 2006


> > I have been trying to understand closures in haskell and how they relate
> > to side effects. I have been looking around but all I find are trivial
> > examples with no side effects. Please let me know if you know of any
> > examples.

Bulat> what you mean by 'closure'?

Perhaps you are refering to something like the Accumlator generator in Lisp:

(defun mkacc (n)
   (lambda (i) (incf n i)))

or Scheme:

(define (mkacc n)
  (lambda (i)
    (set! n (+ n i))
  n))

(the term closure explained in footnote 6 in SICP here:
http://mitpress.mit.edu/sicp/full-text/book/book-Z-H-15.html#footnote_Temp_154:
"A closure is an implementation technique for representing procedures
with free variables.")
?

In Haskell you can do this, but all side effects are made explicit and
can only be used within code marked with IO (in the IO monad):

import Data.IORef

mkAcc :: (Num a) => a -> IO (a -> IO a)
mkAcc n = do
  r <- newIORef n
  return (\i -> do
    modifyIORef r (+i)
    readIORef r)

(These examples are from http://www.paulgraham.com/accgen.html, by the way.)

On 6/26/06, dkarapet <dkarapetyan at ucdavis.edu> wrote:
> I have been trying to understand closures in haskell and how they relate
> to side effects. I have been looking around but all I find are trivial
> examples with no side effects. Please let me know if you know of any
> examples.

> in Haskell, expression may have a side
> effect only if it has "IO a" return type. it is then whole point of
> pure lazy language - evaluation of pure (not "IO") expression can be
> deferred until it's value really need and language guarantee that this
> don't change anything (including lack of any side effects)
>  Bulat                            mailto:Bulat.Ziganshin at gmail.com

The reason you need IO in the type that the compiler/type system
forces you to isolate side effects from pure code so all your pure
code stays pure. There is a good explanation here, under Pure
Functions:

http://en.wikipedia.org/wiki/Functional_Programming#Pure_functions

The reason purity is **enforced** is similar to the reason "goto" is
considered harmful: the belief is that the programmer receives great
benefits this tradeoff. In exchange for giving up side effects in
arbitrary places, the programmer gains freedom in knowing that all
pure functions are free from side-effects related bugs and her code is
easier to reason about mathematically.

My understanding is that Haskell's execution model is a lot more
involved than, say, Scheme, because pure code is more flexibly
refactored by the compiler and because the runtime evaluation strategy
for lazy evaluation is less obviously implemented. In this sense, if I
undertsand correctly, Haskell doesn't really use closures as an
implementation strategy (as defined above), if that is what your
question is refering to, and I'm not surprised that you don't find
interesting examples in Haskell, especially any involving side
effects.

  Jared.
-- 
http://www.updike.org/~jared/
reverse ")-:"


More information about the Haskell-Cafe mailing list