Make Haskell Imperative

Question

Note: this is an exercise, and I'm trying to understand how things work.

I am trying to make it possible to do something like this in Haskell:

f :: Integer -> Integer
f n = def $ do
  i      <- var n
  while i (>0) $ do
    i      -= lit 1
  return i
-- for now, my program returns n 

Below is my program. At this point, I cannot understand why it doesn't work, but for some reason, the variables are not changing.

import Control.Monad.State


data Lit a = Lit a
type Variable a = State Integer a


def :: Variable (Lit a) -> a
def (State f) = fromLit . fst . f $ 0 

fromLit :: Lit a -> a
fromLit (Lit a) = a

lit :: a -> Lit a
lit l = Lit l

var :: a -> Variable (Lit a)
var v = State $ \x -> (lit v, x)

while :: Lit a -> (a -> Bool) -> Variable () -> Variable ()
while (Lit r) cond act = do
                 if cond r then do
                          _ <- act
                          while (Lit r) cond act
                    -- or act >> while (Lit r) cond act
                 else return ()


op :: (Integer -> Integer -> Integer) -> Lit Integer -> Lit Integer -> Variable ()
op f (Lit a) (Lit b) = State $ \n -> ((), if n == a then f a b else n)
-- that is, if the state is (a) change it to (f a b), else don't change it

(+=) = op (+)
(-=) = op (-)
(*=) = op (*)

Please, help me to understand what is wrong here and how to improve the code. Thank you.

Answer 1

It goes without saying that this is a silly thing to do in Haskell; but I'm all for trying silly things if it helps you learn something.

I think you should probably back off to a simpler problem and experiment with the State monad a bit more before trying something complex like this; from the code snippets you posted I suspect your intuition is a bit off.

You CAN do this sort of thing of course, but it's tricky to handle variables of "arbitrary" type in a State monad (which must have a fixed type for the state). You can do it in a relatively type-safe way using Dynamic and Proxy; but I think that might still be a bit out of reach.

We'll start by storing variables of just type Int. I'm not sure which State monad you're using, but I'll use the one from mtl instead.

import Control.Monad.State
import qualified Data.Map as M
import Data.Maybe

data Var = Var Int
  deriving (Show, Eq, Ord)

data Env = Env {freshVar :: Int, vars :: M.Map Var Int}
  deriving Show

type Imperative a = State Env a

I've defined the Env type which keeps track of all the variables we've "created", as well as a "fresh name" generator, which is just an Int that keeps counting upwards as we define variables.

lit :: Int -> Imperative Var
lit n = do
    varID <- gets freshVar
    let newVar = Var varID
    modify (\s -> s{freshVar=n+1, vars=(M.insert newVar n (vars s))})
    return newVar

This code creates a new "variable" from a literal number, it does so by getting a fresh variable name from the environment, wrapping it in a constructor, then storing it in the environment with the provided value. Note that we bump the freshVar number so we'll get a different variable id for the next literal.

getVar :: Var -> Imperative Int
getVar v = gets (fromJust . M.lookup v . vars)

setVar :: Var -> Int -> Imperative ()
setVar v n = modify (\s -> s{vars=M.insert v n (vars s)})

These are some helpers which look up variable or set variables in our Map of variables. getVar uses fromJust which is unsafe in general; but if you only define new variables with "lit" then it works fine.

op :: (Int -> Int -> Int) -> Var -> Var -> Imperative ()
op f aVar bVar = do
    a <- getVar aVar
    b <- getVar bVar
    setVar aVar (f a b)

(+=) = op (+)
(-=) = op (-)
(*=) = op (*)

To perform your version of a mutation operation we take two variables, look up their current values, perform the operation, then store the result into the variable on the left.

Now we can define while

while :: Imperative Bool -> Imperative () -> Imperative ()
while cond act = do
    continue <- cond
    if continue then act >> while cond act
                else return ()

We can accept any imperative statement which returns a boolean as the condition; the user can look up the state of variables within the statement if they need to. We simply run the statement, if we want to continue we act and then recurse, otherwise we return.

f :: Int -> Int
f n = run $ do
  i <- lit n
  while ((>0) <$> getVar i) $ do
    one <- lit 1
    i -= one
  getVar i

It's a bit wordy (we could simplify it down, but it would make the combinators more complex). We define our i as a new variable with the value n, then check whether it's greater than 0 in the condition. In the loop body we define a variable with the value 1, then subtract it from the variable i.

After the loop terminates we check the value of i

run :: Imperative a -> a
run m = evalState m (Env 0 M.empty)

Here's the run function we used above, which simply runs state with no variables defined.

If you try it out you'll see it successfully hits zero; and you can add a trace statement to see which values it hits:

import Debug.Trace
f :: Int -> Int
f n = run $ do
  i <- lit n
  while ((>0) <$> getVar i) $ do
    getVar i >>= traceShowM
    one <- lit 1
    i -= one
  getVar i

>>> f 10
10
9
8
7
6
5
4
3
2
1
0