在Haskell里写“命令式”风格代码

前不久在Codewars上看见一道很有意思的题目，大致意思就是要你用Haskell这样纯粹的函数式编程语言来写如下看起来很“命令式”的代码：

factorial :: Integer -> Integer
factorial n = def $ do
  result <- var 1
  i      <- var n
  while i (>0) $ do
    result *= i
    i      -= lit 1
  return result

乍一看，def、while等函数应该是可以实现的，唯独*=、-=等运算符与Haskell不可变变量的特性相去甚远，在Haskell中应该怎么模拟呢？

这个时候我想起了我多年前（误，其实就是一年前）写的一个辣鸡Lisp解释器，这个解释器的求值过程可以抽象为一个函数: (value, env') = eval(expr, env)

• 其中env是当前词法作用域所有变量的绑定，是(变量名, 值)这样的键值对
• expr是需要求值的表达式
• value是求值的结果
• env'是求值过程结束后新的变量绑定

*=会改变env，具体来说就是改变左边变量名所绑定的值

在Haskell里，这种状态变化特别适合用State Monad来表达，表达式求值的过程，实际上就是Env这个State的变化过程

type ImperativeExpr a = State Env a

由于无法通过变量名来标记变量，我们通过变量声明的顺序来标记变量：

type Index = Int
newtype Variable = Variable Index

type Env = Map Index Integer

var :: Integer -> ImpreativeExpr Variable
var v = do
  env <- get
  let index = length env
  put $ insert index v env
  return $ Variable index

除了变量，这个题目中还有字面量这一概念，字面量很简单，它是不可变的，只需简单包住一下即可

newtype Lit = Lit Integer

lit :: Integer -> Lit
lit = Lit

到目前为止，我们见到了两种表示“值”的类型，分别是可变的Variable和不可变的Lit：

• Variable可以出现在*=这种符号的左右两边，也可以当做while的条件变量
• Lit可以出现在*=这种符号的右边，也可当做while的条件变量，但是它不能出现在*=这种符号的左边，因为它是不可变的

综上，Variable和Lit是两种不同的类型，但是它们有一些共同点，就是它们都可以被当做“值”来使用，我们用一个type class来表现出这种共同点：

class Value v where
  evalValue :: v -> Env -> Integer

instance Value Variable where
  evalValue (Variable index) env = env ! index

instance Value Lit where
  evalValue (Lit value) _ = value

试着实现一下*=：

(*=) :: Value v => Variable -> v -> ImpreativeExpr ()
(Variable index) *= b = do
  env <- get
  let
    val1 = env ! index
    val2 = evalValue b env
    env' = insert index (op val1 val2) env
    in put env'

while的实现也就比较简单了，简单来说就是当不满足终止条件时就不断改变Env：

while :: Value v => v -> (Integer -> Bool) -> ImpreativeExpr () -> ImpreativeExpr () 
while r f act = do
  env <- get
  let value = evalValue r env
  when (f value) $ do
    let (_, env') = runState act env
    put env'
    while r f act

def实际上就是对ImperativeExpr进行求值：

def :: Value v => ImpreativeExpr v -> Integer
def m = let (v, env) = runState m empty in evalValue v env

完整代码见这里