# Write Yourself a Scheme in 48 Hours/Defining Scheme Functions

Now that we can define variables, we might as well extend it to
functions. After this section, you\'ll be able to define your own
functions within Scheme and use them from other functions. Our
implementation is nearly finished.

Let\'s start by defining new `LispVal` constructors:

``` haskell
| PrimitiveFunc ([LispVal] -> ThrowsError LispVal)
| Func { params :: [String], vararg :: (Maybe String),
         body :: [LispVal], closure :: Env }
```

We\'ve added a separate constructor for primitives, because we\'d like
to be able to store `+`, `eqv?`, etc. in variables and pass them to
functions. The `PrimitiveFunc` constructor stores a function that takes
a list of arguments to a `ThrowsError LispVal`, the same type that is
stored in our primitive list.

We also want a constructor to store user-defined functions. We store
four pieces of information:

1.  the names of the parameters, as they\'re bound in the function body;
2.  whether the function accepts a variable-length list of arguments,
    and if so, the variable name it\'s bound to;
3.  the function body, as a list of expressions;
4.  the environment that the function was created in.

This is an example of a
record type. Records are
somewhat clumsy in Haskell, so we\'re only using them for demonstration
purposes. However, they can be invaluable in large-scale programming.

Next, we\'ll want to edit our `show` function to include the new types:

``` haskell
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) ++ ") ...)"
```

Instead of showing the full function, we just print out the word
`<primitive>` for primitives and the header info for user-defined
functions. This is an example of pattern-matching for records: as with
normal algebraic types, a pattern looks exactly like a constructor call.
Field names come first and the variables they\'ll be bound to come
afterwards.

Next, we need to change `apply`. Instead of being passed the name of a
function, it\'ll be passed a `LispVal` representing the actual function.
For primitives, that makes the code simpler: we need only read the
function out of the value and apply it.

``` haskell
apply :: LispVal -> [LispVal] -> IOThrowsError LispVal
apply (PrimitiveFunc func) args = liftThrows $ func args
```

The interesting code happens when we\'re faced with a user defined
function. Records let you pattern match on both the field name (as shown
above) or the field position, so we\'ll use the latter form:

``` haskell
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
```

The very first thing this function does is check the length of the
parameter list against the expected number of arguments. It throws an
error if they don\'t match. We define a local function `num` to enhance
readability and make the program a bit shorter.

Assuming the call is valid, we do the bulk of the call in monadic
pipeline that binds the arguments to a new environment and executes the
statements in the body. The first thing we do is zip the list of
parameter names and the list of (already evaluated) argument values
together into a list of pairs. Then, we take that and the function\'s
closure (*not* the current environment -- this is what gives us lexical
scoping) and use them to create a new environment to evaluate the
function in. The result is of type `IO`, while the function as a whole
is `IOThrowsError`, so we need to `liftIO` it into the combined monad.

Now it\'s time to bind the remaining arguments to the varargs variable,
using the local function `bindVarArgs`. If the function doesn\'t take
`varargs` (the `Nothing` clause), then we just return the existing
environment. Otherwise, we create a singleton list that has the variable
name as the key and the remaining args as the value, and pass that to
bindVars. We define the local variable `remainingArgs` for readability,
using the built-in function
`drop`
to ignore all the arguments that have already been bound to variables.

The final stage is to evaluate the body in this new environment. We use
the local function `evalBody` for this, which maps the monadic function
`eval env` over every statement in the body, and then returns the value
of the last statement.

Since we\'re now storing primitives as regular values in variables, we
have to bind them when the program starts up:

``` haskell
primitiveBindings :: IO Env
primitiveBindings = nullEnv >>= (flip bindVars $ map makePrimitiveFunc primitives)
     where makePrimitiveFunc (var, func) = (var, PrimitiveFunc func)
```

This takes the initial null environment, makes a bunch of name/value
pairs consisting of PrimitiveFunc wrappers, and then binds the new pairs
into the new environment. We also want to change `runOne` and `runRepl`
to `primitiveBindings` instead:

``` haskell
runOne :: String -> IO ()
runOne expr = primitiveBindings >>= flip evalAndPrint expr

runRepl :: IO ()
runRepl = primitiveBindings >>= until_ (== "quit") (readPrompt "Lisp>>> ") . evalAndPrint
```

Finally, we need to change the evaluator to support
`lambda`
and function
`define`.
We\'ll start by creating a few helper functions to make it a little
easier to create function objects in the `IOThrowsError` monad:

``` haskell
makeFunc varargs env params body = return $ Func (map showVal params) varargs body env
makeNormalFunc = makeFunc Nothing
makeVarArgs = makeFunc . Just . showVal
```

Here, `makeNormalFunc` and `makeVarArgs` should just be considered
specializations of `makeFunc` with the first argument set appropriately
for normal functions vs. variable args. This is a good example of how to
use first-class functions to simplify code.

Now, we can use them to add our extra eval clauses. They should be
inserted after the define-variable clause and before the
function-application one:

``` haskell
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
```

The following needs to replace the prior function-application eval
clause.

``` haskell
eval env (List (function : args)) = do
     func <- eval env function
     argVals <- mapM (eval env) args
     apply func argVals
```

As you can see, they just use pattern matching to destructure the form
and then call the appropriate function helper. In define\'s case, we
also feed the output into `defineVar` to bind a variable in the local
environment. We also need to change the function application clause to
remove the `liftThrows` function, since apply now works in the
`IOThrowsError` monad.

We can now compile and run our program, and use it to write real
programs!

`$ 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`

