Managing state - chapter 3 of SICP

Question

I've been working through in Structure and Interpretation of Computer Programs and completing the exercises in Haskell. The first two chapters were fine (code at github) but Chapter 3 is making me think harder.

It starts by talking about managing state, with the example of a bank account. They define a function make-withdraw by

(define (make-withdraw balance)
    (lambda (amount)
        (if (>= balance amount)
            (begin (set! balance (- balance amount))
                balance)
            "Insufficient funds")))

so that you can execute the following code:

(define w1 (make-withdraw 100))
(define w2 (make-withdraw 100))

(w1 50)
50

(w2 70)
30

(w2 40)
"Insufficient funds"

(w1 40)
10

I'm not sure how I can emulate this in Haskell. I first thought to a some simple function using the State monad:

import Control.Monad.State

type Cash    = Float
type Account = State Cash

withdraw :: Cash -> Account (Either String Cash)
withdraw amount = state makewithdrawal where
    makewithdrawal balance = if balance >= amount
        then (Right amount, balance - amount)
        else (Left "Insufficient funds", balance)

which allows me to run the code

ghci> runState (do { withdraw 50; withdraw 40 }) 100
(Left "Insufficient funds",30.0)

but that does something different to the scheme code. Ideally I'd be able to run something like

do
  w1 <- makeWithdraw 100
  w2 <- makeWithdraw 100
  x1 <- w1 50
  y1 <- w2 70
  y2 <- w2 40
  x2 <- w1 40
  return [x1,y1,y2,x2]

[Right 50,Right 70,Left "Insufficient funds",Right 40]

but I'm not sure how to write the function makeWithdraw. Any advice?

Answer 1

The Scheme code is sneakily using two bits of state: one is the (implicit) association between variables w1 and w2 and a ref-cell; the other is the (explicit) state stored in a ref-cell. There's a couple different ways to model this in Haskell. For example, we might pull a similar ref-cell trick with ST:

makeWithdraw :: Float -> ST s (Float -> ST s (Either String Float))
makeWithdraw initialBalance = do
    refBalance <- newSTRef initialBalance
    return $ \amount -> do
        balance <- readSTRef refBalance
        let balance' = balance - amount
        if balance' < 0
            then return (Left "insufficient funds")
            else writeSTRef refBalance balance' >> return (Right balance')

Which lets us do this:

*Main> :{
*Main| runST $ do
*Main|   w1 <- makeWithdraw 100
*Main|   w2 <- makeWithdraw 100
*Main|   x1 <- w1 50
*Main|   y1 <- w2 70
*Main|   y2 <- w2 40
*Main|   x2 <- w1 40
*Main|   return [x1,y1,y2,x2]
*Main| :}
[Right 50.0,Right 30.0,Left "insufficient funds",Right 10.0]

Another option is to make both pieces of the state explicit, for example by associating each account with a unique Int id.

type AccountNumber = Int
type Balance = Float
data BankState = BankState
    { nextAccountNumber :: AccountNumber
    , accountBalance :: Map AccountNumber Balance
    }

Of course, we would then basically be re-implementing the ref-cell operations:

newAccount :: Balance -> State BankState AccountNumber
newAccount balance = do
    next <- gets nextAccountNumber
    modify $ \bs -> bs
        { nextAccountNumber = next + 1
        , accountBalance = insert next balance (accountBalance bs)
        }
    return next

withdraw :: Account -> Balance -> State BankState (Either String Balance)
withdraw account amount = do
    balance <- gets (fromMaybe 0 . lookup account . accountBalance)
    let balance' = balance - amount
    if balance' < 0
        then return (Left "insufficient funds")
        else modify (\bs -> bs { accountBalance = insert account balance' (accountBalance bs) }) >> return (Right balance')

Which would then let us write makeWithdraw:

makeWithDraw :: Balance -> State BankState (Balance -> State BankState (Either String Balance))
makeWithdraw balance = withdraw <$> newAccount balance