Write Yourself a Scheme in 48 Hours in F# – Part IV


It is the eval­u­a­tor turn. It is a big file, let’s see if I can fit it in a sin­gle post.

Aptly enough, the most im­por­tant func­tion is called eval.

eval env = function
| String _ as v -> v
| Number _ as v -> v
| Bool _ as v -> v
| Atom var -> getVar var env
| List [Atom "quote"; v] -> v
| List [Atom "if"; pred; conseq; alt] -> evalIf env pred conseq alt
| List [Atom "load"; fileName] -> load [fileName] |> List.map (eval env) |> last
| List [Atom "set!" ; Atom var ; form] -> env |> setVar var (eval env form)
| List [Atom "define"; Atom var; form] -> define env var (eval env form)
| List (Atom "define" :: (List (Atom var :: parms) :: body)) ->
    makeNormalFunc env parms body |> define env var
| List (Atom "define" :: (DottedList ((Atom var :: parms), varargs) :: body)) ->
    makeVarargs varargs env parms body |> define env var
| List (Atom "lambda" :: (List parms :: body)) -> makeNormalFunc env parms body
| List (Atom "lambda" :: (DottedList(parms, varargs) :: body)) -> makeVarargs varargs env parms body
| List (Atom "lambda" :: ((Atom _) as varargs :: body)) -> makeVarargs varargs env [] body
| List (func :: args) ->
    let f = eval env func
    let argVals = List.map (eval env) args
    apply f argVals
| badForm -> throw (BadSpecialForm("Unrecognized special form", badForm))

This is the core of the eval­u­a­tor. It takes as an in­put the LispVal gen­er­ated by the parser and an en­vi­ron­ment and re­turns a LispVal that is the re­sult of the re­duc­tion. As a side ef­fect, it oc­ca­sion­ally mod­ify the en­vi­ron­ment. I care­fully crafted the pre­vi­ous phrase to max­i­mize the dis­com­fort  of the func­tional pro­gram­mers tuned in. Such fun 🙂

More se­ri­ously (?), here is what it does:

We have a bunch of see be­low’ to take care of. We’ll look at them in or­der.

First the if’ state­ment. If the eval­u­ated pred­i­cate is Bool(True) eval­u­ate the con­se­quent, oth­er­wise eval­u­ate the al­ter­na­tive. For some rea­son, I wrote it the other way around.

    // 1a. If the evaluation of the pred is false evaluate alt, else evaluate cons
    evalIf env pred conseq alt =
        match eval env pred with
        | Bool(false) -> eval env alt
        | _ -> eval env conseq

Then there is the load func­tion. It reads all the test and gets out the list of LispVal con­tained in it.

let load = fileIOFunction (fun fileName -> File.ReadAllText(fileName)
                                           |> readExprList)

ReadExprList is part of the parser. We’ll look at it then. Sufficient here to say that it takes a string and re­turns a list of LispVal.

FileIOFunction just en­cap­su­lates a com­mon pat­tern in all the file ac­cess func­tions. I don’t like such me­chan­i­cal fac­tor­iza­tion of meth­ods, with­out any real reusabil­ity out­side the im­me­di­ate sur­round­ings of the code. But I like rep­e­ti­tion even less.

let fileIOFunction func = function
    | [String fileName] -> func (fileName)
    | [] -> throw (IOError("No file name"))
    | args -> throw (NumArgs(1, args))

A fam­ily of func­tions cre­ate FuncRecord given ap­pro­pri­ate pa­ra­me­ters. I seem to have lost mem­ory of the con­tor­tions re­lated to the last one. If I end up hav­ing to work again on this code, I’ll need to fig­ure it out again. Note to my­self, please com­ment this kind of code next time.

let makeFunc varargs env parms body =
            Func ({parms = (List.map showVal parms); varargs = varargs; body = body; closure = env})
let makeNormalFunc = makeFunc None
let makeVarargs = showVal >> Some >> makeFunc

ap­ply is the other work­horse func­tion in the eval­u­a­tor.  The best way to un­der­stand it is to start from the bot­tom (where bind­Vars starts the line). We are bind­ing the ar­gu­ments and the vari­able ar­gu­ments in the clo­sure that has been passed in. We then eval­u­ate the body. But the body is just a list of LispVal, so we just need to eval­u­ate them in se­quence and re­turn the re­sult of the last one.

and apply func args =
    match func with
    | PrimitiveFunc(f) -> f args
    | Func ({parms = parms; varargs = varargs; body = body; closure = closure}) ->
        let invalidNonVarargs = args.Length <> parms.Length && varargs.IsNone
        let invalidVarargs = args.Length < parms.Length && varargs.IsSome
        if invalidVarargs || invalidNonVarargs
            throw (NumArgs(parms.Length, args))
            let remainingArgs = args |> Seq.skip parms.Length |> Seq.toList
            let evalBody env = body |> List.map (eval env) |> last
            let rec zip xs1 xs2 acc =
                match xs1, xs2 with
                | x1::xs1, x2::xs2 -> zip xs1 xs2 ((x1, x2)::acc)
                | _ -> acc
            let bindVarArgs arg env =
                match arg with
                | Some(argName) -> bindVars [argName, (List remainingArgs)] env
                | None -> env
            bindVars (zip parms args []) closure
                |> bindVarArgs varargs
                |> evalBody
    | funcName -> throw (NotFunction("Expecting a function, getting ", showVal funcName))

This is enough for one post. Next time we’ll fin­ish the eval­u­a­tor.