原文。
https://en.wikibooks.org/wiki/Write_Yourself_a_Scheme_in_48_Hours/Defining_Scheme_Functions
现在既然可以定义变量了，我们就来把它扩展到函数上来。在这章之后，你就能够在你的Scheme里定义并使用你自己的函数了。我们的整个实现也就基本完成了。
让我们从给LispVal定义新的构造器开始：
| PrimitiveFunc ([LispVal] -> ThrowsError LispVal)
| Func { params :: [String], vararg :: (Maybe String),
body :: [LispVal], closure :: Env }
我们为原生函数添加了一个额外的构造器，因为我们会希望能够将+,eqv?这样的原生函数作为变量传递给其他函数。我们的PrimitiveFunc构造器包含了一个读入参数列表然后返回一个ThrowsError LispVal的函数，就和我们在primitive列表里存储的类型一样。
我们还为用户定义的函数添加了一个构造器。我们会在其中存储以下四种信息：
- 与函数体绑定的参数名称；
- 函数是否接受可变长度的参数，如果接受的话，参数绑定的变量是什么；
- 一个表达式列表，也就是函数体；
- 函数定义所在的环境。
这是一个record类型的例子。Record在Haskell中看起来有点笨重，因此我们也只是在这里示范以下。然而在大规模的编程开发中，他有着无可替代的价值。
接下来，我们在show函数中添加新的类型：
showVal (PrimitiveFunc _) = "<primitive>"
showVal (Func {params = args, vararg = varargs, body = body, closure = env}) =
"(lambda (" ++ unwords (map show args) ++
(case varargs of
Nothing -> ""
Just arg -> " . " ++ arg) ++ ") ...)"
我们这里对原生函数仅仅打印了<primitive>，对用户自定义的函数则是打印出来头部信息，而不是将整个函数体全部打印出来。这是一个对Record进行模式匹配的例子：与普通的代数类型一样，模式看起来和构造器是一样的。前面是字段名然后紧跟着的是会与值绑定的变量名称。
接下来，我们需要修改apply函数。和之前传递函数名不同的是，现在我们直接将代表函数的LispVal值传递给它。对于原生函数来说代码变得更简单了：我们将函数值从参数中读出然后应用就可以了。
apply :: LispVal -> [LispVal] -> IOThrowsError LispVal
apply (PrimitiveFunc func) args = liftThrows $ func args
当我们处理用户自定义函数的时候，有趣的事情发生了。Record类型不仅允许你对字段名进行匹配，你也可以通过位置来识别它们，我们来试试看：
apply (Func params varargs body closure) args =
if num params /= num args && varargs == Nothing
then throwError $ NumArgs (num params) args
else (liftIO $ bindVars closure $ zip params args) >>= bindVarArgs varargs >>= evalBody
where remainingArgs = drop (length params) args
num = toInteger . length
evalBody env = liftM last $ mapM (eval env) body
bindVarArgs arg env = case arg of
Just argName -> liftIO $ bindVars env [(argName, List $ remainingArgs)]
Nothing -> return env
这里第一步是确认参数列表的长度，判断和期望的参数是否一致。如果不一致的话则会抛出一个错误。我们还定义了一个局部的num函数来增加代码的可读性并让程序更短。
如果调用是合法的，那我们就会在Monad管理进行一系列操作，将参数绑定给新的环境，然后执行函数体中的语句。我们做的第一件事就是将参数名称的列表和已经经过计算的参数值列表通过zip函数拉成一个键值对的列表。然后我们用这个列表和函数的闭包（其实这并不是当前的环境，而只是函数的静态作用域）组成一个新的环境并且将函数在其中进行求值。返回的结果是IO类型的，而整个函数的返回值是IOThrowsError类型，因此我们需要使用liftIO来将它进行转换。
接下来，我们将剩余的参数通过局部函数bindVarArgs绑定给varArgs变量。如果函数不需要可变参数（Nothing子句），那我们就将现在的环境返回。不然的话，我们创建一个将变量名作为键，输入参数为值的列表然后把它传给bindVars。方便起见我们定义它为局部变量remainingArgs，并用内置的drop函数来忽略之前已经绑定过得参数。
最后一步是在新的环境中对函数体进行求值。我们为了这个定义了一个局部函数evalBody。它将eval env这个Monad函数映射到了每一个函数体中的语句，然后讲最后一个语句的值返回。
我们现在将原生函数存储在普通的变量值里，让我们来在程序开始的时候预先绑定它们：
primitiveBindings :: IO Env
primitiveBindings = nullEnv >>= (flip bindVars $ map makePrimitiveFunc primitives)
where makePrimitiveFunc (var, func) = (var, PrimitiveFunc func)
这里我们首先将最初的空环境读入，将封装好的原生函数扎成一捆键值对，然后再将它们一起绑定成新的环境。让我们在runOne和runRepl里也替换成primitiveBindings函数：
runOne :: String -> IO ()
runOne expr = primitiveBindings >>= flip evalAndPrint expr
runRepl :: IO ()
runRepl = primitiveBindings >>= until_ (== "quit") (readPrompt "Lisp>>> ") . evalAndPrint
最后让我们来修改求值器让它来支持lambda函数以及define功能。我们从几个能在IOThrowsError中帮助我们创建函数对象的辅助函数开始：
makeFunc varargs env params body = return $ Func (map showVal params) varargs body env
makeNormalFunc = makeFunc Nothing
makeVarArgs = makeFunc . Just . showVal
这里makeNormalFunc和makeVarArgs函数只是MakeFunc函数的在普通情况和可变参数情况下的特殊形式而已。这是一个如何将函数看做一等公民然后简化代码的很好的例子。
现在我们用它们来添加新的求值子句。我们在定义变量以及函数应用的子句之间添加以下内容：
eval env (List (Atom "define" : List (Atom var : params) : body)) =
makeNormalFunc env params body >>= defineVar env var
eval env (List (Atom "define" : DottedList (Atom var : params) varargs : body)) =
makeVarArgs varargs env params body >>= defineVar env var
eval env (List (Atom "lambda" : List params : body)) =
makeNormalFunc env params body
eval env (List (Atom "lambda" : DottedList params varargs : body)) =
makeVarArgs varargs env params body
eval env (List (Atom "lambda" : varargs@(Atom _) : body)) =
makeVarArgs varargs env [] body
之前的求值函数中的函数应用部分的子句也需要替换掉：
eval env (List (function : args)) = do
func <- eval env function
argVals <- mapM (eval env) args
apply func argVals
正如你所见，这里我们用模式匹配来对输入参数进行解构，然后调用适当的辅助函数。在定义define的时候，我们还需要将结果传入到defineVar函数来将变量绑定到本地环境当中。我们还需要将函数应用部分的子句进行修改，因为现在apply函数能够在IOThrowsError Monad中工作了，所以我们也不需要liftThrows函数了。
编译并且运行程序，现在我们可以用它来写我们自己的程序了！
$ ghc -package parsec -fglasgow-exts -o lisp [../code/listing9.hs listing9.hs]
$ ./lisp
Lisp>>> (define (f x y) (+ x y))
(lambda ("x" "y") ...)
Lisp>>> (f 1 2)
3
Lisp>>> (f 1 2 3)
Expected 2 args; found values 1 2 3
Lisp>>> (f 1)
Expected 2 args; found values 1
Lisp>>> (define (factorial x) (if (= x 1) 1 (* x (factorial (- x 1)))))
(lambda ("x") ...)
Lisp>>> (factorial 10)
3628800
Lisp>>> (define (counter inc) (lambda (x) (set! inc (+ x inc)) inc))
(lambda ("inc") ...)
Lisp>>> (define my-count (counter 5))
(lambda ("x") ...)
Lisp>>> (my-count 3)
8
Lisp>>> (my-count 6)
14
Lisp>>> (my-count 5)
19