[doc] Add many comments to the final interpreter.

This adds many comments to the final interpreter, which hopefully helps
me (and anyone else reading this) understand what's going on inside the
3G interpreter.

[refactor] This last interpreter takes all the evaluate function's
"syntax" objects and moves them into a lookup table.  THis prefigures the
idea of making even the syntax malleable and extensible by future code.
I have to wonder if there's a place for making some core commands (the
"holy 7" of McCarthy, for example) un-reassignable.

Probably not.  I can vaguely see an interest in wrapping even some core
functions (car, cdr, cons) in contractual decorators.

This concludes the base homework for chapter 3.  I might get to the
exercises someday.
This commit is contained in:
Elf M. Sternberg 2015-08-07 17:09:51 -07:00
parent bf7068d0ad
commit 73be7dee59
2 changed files with 104 additions and 34 deletions

View File

@ -10,31 +10,47 @@ class LispInterpreterError extends Error
the_false_value = (cons "false", "boolean") the_false_value = (cons "false", "boolean")
# Base class that represents a value. Base class representing a LiSP # An equality function that compares two values. This is necessary
# value, a primitive, or a function # because object comparison in Javascipt is by reference, not by value.
# I want them to be by value, and this accomplishes that in this one
# special case.
eq = (id1, id2) -> eq = (id1, id2) ->
if id1 instanceof Symbol and id2 instanceof Symbol if id1 instanceof Symbol and id2 instanceof Symbol
return id1.name == id2.name return id1.name == id2.name
id1 == id2 id1 == id2
# Base class that represents a value. Base class representing a LiSP
# value, a primitive, or a function
class Value class Value
# Represents the base class of a continuation. Calls to invoke resume # Represents the base class of a continuation.
# the contained continuation, which is typecast to one of the specific
# continuation needs of conditional, sequence, etc...
class Continuation class Continuation
# Takes an existing continuation, which represents what to do when
# this continuation is invoked.
constructor: (@kont) -> constructor: (@kont) ->
# Near as I can tell, this exists strictly to support call/cc
invoke: (value, env, kont) -> invoke: (value, env, kont) ->
if nilp cdr value if nilp cdr value
@kont.resume (car value) @kont.resume (car value)
else else
throw new LispInterpreterError "Continuations expect one argument" throw new LispInterpreterError "Continuations expect one argument"
# As we're unwinding the stack, when we receive a new ktarget we've
# "breached" where this protection was created and need to resume the
# continuation passed there.
unwind: (value, ktarget) -> unwind: (value, ktarget) ->
if (@ == ktarget) then (@kont.resume value) else (@kont.unwind value, ktarget) if (@ == ktarget) then (@kont.resume value) else (@kont.unwind value, ktarget)
# When a throw happens, we need to proceed down the stack looking
# for a CatchContinuation. This supports that for all continuations.
catchLookup: (tag, kk) -> catchLookup: (tag, kk) ->
@kont.catchLookup tag, kk @kont.catchLookup tag, kk
# Resume is literally the "What to do next."
resume: (value) -> resume: (value) ->
throw new LispInterpreterError "Wrong continuation for #{@_type}" throw new LispInterpreterError "Wrong continuation for #{@_type}"
@ -102,7 +118,6 @@ evaluateQuote = (v, env, kont) ->
evaluateIf = (exps, env, kont) -> evaluateIf = (exps, env, kont) ->
evaluate (car exps), env, new IfCont(kont, (cadr exps), (caddr exps), env) evaluate (car exps), env, new IfCont(kont, (cadr exps), (caddr exps), env)
class IfCont extends Continuation class IfCont extends Continuation
constructor: (@kont, @ift, @iff, @env) -> constructor: (@kont, @ift, @iff, @env) ->
@_type = "IfCont" @_type = "IfCont"
@ -111,7 +126,10 @@ class IfCont extends Continuation
# Sequences: evaluates the current expression with a continuation that # Sequences: evaluates the current expression with a continuation that
# represents "the next expression" in the sequence. Upon resumption, # represents "the next expression" in the sequence. Upon resumption,
# calls this function with that next expression. # calls this function with that next expression. You can begin to
# note how the "what to do next" gets wrapped in deeper and deeper
# layers of context until the current needs are resolved and we
# finally reach that final expression.
evaluateBegin = (exps, env, kont) -> evaluateBegin = (exps, env, kont) ->
if (pairp exps) if (pairp exps)
@ -178,22 +196,30 @@ extend = (env, names, values) ->
# Now we start the invocation: this is applying the function. Let's # Now we start the invocation: this is applying the function. Let's
# take it stepwise. # take it stepwise.
# Create a function environment. Calls the evaluateArguments(), which # Evaluate the application of a function call. The first step is to
# in turns goes down the list of arguments and creates a new # evaluate the first element of the function call, assuming it is or
# environment, and then the continuation is to actually appy the nev # will resolve to a function (something of type * -> *). The
# environment to the existing function. # continuation we create is to evaluate-function-cont.
evaluateApplication = (exp, exps, env, kont) -> evaluateApplication = (exp, exps, env, kont) ->
evaluate exp, env, (new EvFunCont kont, exps, env) evaluate exp, env, (new EvFunCont kont, exps, env)
# After the function reference is finally generated, the resume()
# function here takes that reference and creates an
# apply-continuation, then calls evaluateArguments. See that.
class EvFunCont extends Continuation class EvFunCont extends Continuation
constructor: (@kont, @exp, @env) -> constructor: (@kont, @exp, @env) ->
@_type = "EvFunCont" @_type = "EvFunCont"
resume: (f) -> resume: (f) ->
evaluateArguments @exp, @env, (new ApplyCont(@kont, f, @env)) evaluateArguments @exp, @env, (new ApplyCont(@kont, f, @env))
# Evaluate the first list, creating a new list of the arguments. Upon # Evaluate the argument list, creating a new list of the arguments.
# completion, resume the continuation with the gather phase # For each argument pair, in calls the gather-cont, which creates the
# actual pair and resumes by processing the next pair, building the
# new environment. When the list is exhausted, the EvFunCont's built
# ApplyCont() is called with the generated new environment and its
# associated thunk.
evaluateArguments = (exp, env, kont) -> evaluateArguments = (exp, env, kont) ->
if (pairp exp) if (pairp exp)
@ -216,7 +242,9 @@ class GatherCont extends Continuation
resume: (value) -> resume: (value) ->
@kont.resume (cons @value, value) @kont.resume (cons @value, value)
# Upon resumption, invoke the function. # Called with the new environment, and the orginal continuation that
# says what to do with the value generated by this function, now that
# it's actually been invoke.
class ApplyCont extends Continuation class ApplyCont extends Continuation
constructor: (@kont, @fn, @env) -> constructor: (@kont, @fn, @env) ->
@ -237,6 +265,11 @@ class BottomCont extends Continuation
catchLookup: (tag, kk) -> catchLookup: (tag, kk) ->
throw new LispInterpreterError "No associated catch" throw new LispInterpreterError "No associated catch"
# A block is an implicit begin. So we evaluate it's contents with a
# new block-environment, which will automatically unwind any contents
# found within by traversing up the environment stack looking for
# labels that match the one with which this block was created.
evaluateBlock = (label, body, env, kont) -> evaluateBlock = (label, body, env, kont) ->
k = new BlockCont(kont, label) k = new BlockCont(kont, label)
evaluateBegin body, (new BlockEnv env, label, k), k evaluateBegin body, (new BlockEnv env, label, k), k
@ -258,6 +291,13 @@ class BlockEnv extends FullEnv
evaluateReturnFrom = (label, form, env, kont) -> evaluateReturnFrom = (label, form, env, kont) ->
evaluate form, env, (new ReturnFromCont kont, env, label) evaluate form, env, (new ReturnFromCont kont, env, label)
# Note that when return-from-cont's body has been evaluated, we then
# unwind up the environment stack until we find the first block that
# has the same label and call the continuation saved there. Note that
# this is the *first* time that continuation and executable is stored
# on the environment, and isn't implicitly part of the continuation
# stack.
class ReturnFromCont extends Continuation class ReturnFromCont extends Continuation
constructor: (@kont, @env, @label) -> constructor: (@kont, @env, @label) ->
@_type = "ReturnFromCont" @_type = "ReturnFromCont"
@ -267,12 +307,24 @@ class ReturnFromCont extends Continuation
evaluateCatch = (tag, body, env, kont) -> evaluateCatch = (tag, body, env, kont) ->
evaluate tag, env, (new CatchCont kont, body, env) evaluate tag, env, (new CatchCont kont, body, env)
# catch-continuation receives (from evaluate) the processed value of a
# tag, the current environment, and what should happen after the
# context containing the catch is complete (the passed in 'kont' to
# evaluateCatch). That processed value becomes the label of the new
# labeled-continuation.
class CatchCont extends Continuation class CatchCont extends Continuation
constructor: (@kont, @body, @env) -> constructor: (@kont, @body, @env) ->
@_type = "CatchFromCont" @_type = "CatchFromCont"
resume: (value) -> resume: (value) ->
evaluateBegin @body, @env, (new LabeledCont @kont, value) evaluateBegin @body, @env, (new LabeledCont @kont, value)
# Resume here does just that; it just resumes with the continuation
# passed in above. But should catch be *triggered* by a throw (and
# the throw-continuation), we get the contents of throw as a thing to
# be evaluated with its current environment, then continue with *this*
# as the continuation passed to throwing-continuation.
class LabeledCont extends Continuation class LabeledCont extends Continuation
constructor: (@kont, @tag) -> constructor: (@kont, @tag) ->
@_type = "LabeledFromCont" @_type = "LabeledFromCont"
@ -298,6 +350,12 @@ class UnwindCont extends Continuation
resume: (value) -> resume: (value) ->
@kont.unwind @value, @target @kont.unwind @value, @target
# Works its way through the stack environment stack, looking for
# ("breaching") protected blocks to unwind, and processing them as
# necessary. One of those will by definition be the continuation
# passed to the catch continuation, as the throwing-continuation is
# constructed with it as the address of the resumecont.
class ThrowingCont extends Continuation class ThrowingCont extends Continuation
constructor: (@kont, @tag, @resumecont) -> constructor: (@kont, @tag, @resumecont) ->
@_type = "ThrowingCont" @_type = "ThrowingCont"
@ -321,6 +379,8 @@ class ProtectReturnCont extends Continuation
resume: (value) -> resume: (value) ->
@kont.resume @value @kont.resume @value
# The bottom of the function pile, where native code is invoked.
class Primitive extends Value class Primitive extends Value
constructor: (@name, @nativ) -> constructor: (@name, @nativ) ->
@_type = "Primitive" @_type = "Primitive"
@ -337,6 +397,8 @@ defprimitive = (name, nativ, arity) ->
definitial name, new Primitive name, (args, env, kont) -> definitial name, new Primitive name, (args, env, kont) ->
vmargs = listToVector(args) vmargs = listToVector(args)
if (vmargs.length == arity) if (vmargs.length == arity)
# Note that native.apply(ctx, vmargs) is expected to return a
# singleton, like all evaluate() passes.
kont.resume (nativ.apply null, vmargs) kont.resume (nativ.apply null, vmargs)
else else
throw new LispInterpreterError "Incorrect arity" throw new LispInterpreterError "Incorrect arity"
@ -415,6 +477,8 @@ metadata_evaluation =
nvalu: (node) -> node.value nvalu: (node) -> node.value
mksymbols: (list) -> astSymbolsToLispSymbols(list) mksymbols: (list) -> astSymbolsToLispSymbols(list)
# The hairness of this makes me doubt the wisdom of using Javascript.
straight_evaluation = straight_evaluation =
listp: (cell) -> cell.__type == 'list' listp: (cell) -> cell.__type == 'list'
symbolp: (cell) -> typeof cell == 'string' and cell.length > 0 and cell[0] not in ["\"", ";"] symbolp: (cell) -> typeof cell == 'string' and cell.length > 0 and cell[0] not in ["\"", ";"]
@ -430,6 +494,19 @@ straight_evaluation =
nvalu: (cell) -> cell nvalu: (cell) -> cell
mksymbols: (cell) -> cell mksymbols: (cell) -> cell
prox =
"quote": (body, env, kont, ix) -> evaluateQuote (cadr body), env, kont
"if": (body, env, kont, ix) -> evaluateIf (cdr body), env, kont
"begin": (body, env, kont, ix) -> evaluateBegin (cdr body), env, kont
"set!": (body, env, kont, ix) -> evaluateSet (ix.nvalu cadr body), (caddr body), env, kont
"lambda": (body, env, kont, ix) -> evaluateLambda (ix.mksymbols cadr body), (cddr body), env, kont
"block": (body, env, kont, ix) -> evaluateBlock (ix.nvalu cadr body), (cddr body), env, kont
"return": (body, env, kont, ix) -> evaluateReturnFrom (ix.nvalu cadr body), (caddr body), env, kont
"catch": (body, env, kont, ix) -> evaluateCatch (cadr body), (cddr body), env, kont
"throw": (body, env, kont, ix) -> evaluateThrow (cadr body), (caddr body), env, kont
"protect": (body, env, kont, ix) -> evaluateUnwindProtect (cadr body), (cddr body), env, kont
makeEvaluator = (ix = straight_evaluation, ty="straight") -> makeEvaluator = (ix = straight_evaluation, ty="straight") ->
(exp, env, kont) -> (exp, env, kont) ->
if ix.symbolp exp if ix.symbolp exp
@ -440,17 +517,10 @@ makeEvaluator = (ix = straight_evaluation, ty="straight") ->
body = ix.nvalu exp body = ix.nvalu exp
head = car body head = car body
if ix.symbolp head if ix.symbolp head
switch (ix.nvalu head) # Every call is boiled down to body/env/kont (with ix.nvalu tossed in for fun)
when "quote" then evaluateQuote (cadr body), env, kont # It should be possible to move natives into an address space
when "if" then evaluateIf (cdr body), env, kont if prox[(ix.nvalu head)]?
when "begin" then evaluateBegin (cdr body), env, kont prox[(ix.nvalu head)](body, env, kont, ix)
when "set!" then evaluateSet (ix.nvalu cadr body), (caddr body), env, kont
when "lambda" then evaluateLambda (ix.mksymbols cadr body), (cddr body), env, kont
when "block" then evaluateBlock (ix.nvalu cadr body), (cddr body), env, kont
when "return-from" then evaluateReturnFrom (ix.nvalu cadr body), (caddr body), env, kont
when "catch" then evaluateCatch (cadr body), (cddr body), env, kont
when "throw" then evaluateThrow (cadr body), (caddr body), env, kont
when "unwind-protect" then evaluateUnwindProtect (cadr body), (cddr body), env, kont
else evaluateApplication (car body), (cdr body), env, kont else evaluateApplication (car body), (cdr body), env, kont
else else
evaluateApplication (car body), (cdr body), env, kont evaluateApplication (car body), (cdr body), env, kont

View File

@ -13,19 +13,19 @@ lisp = (ast) ->
olisp ast, (i) -> ret = i olisp ast, (i) -> ret = i
return ret return ret
describe "Core interpreter #3: Unwind-Protect", -> describe "Core interpreter #3: Protect", ->
it "unwinds but returns the value of the form", -> it "unwinds but returns the value of the form", ->
expect(lisp read "(unwind-protect 1 2").to.equal(1) expect(lisp read "(protect 1 2").to.equal(1)
it "unwinds within an iffe to correctly evaluate the side-effect", -> it "unwinds within an iffe to correctly evaluate the side-effect", ->
expect(lisp read "((lambda (c) (unwind-protect 1 (set! c 2)) c ) 0 ").to.equal(2) expect(lisp read "((lambda (c) (protect 1 (set! c 2)) c ) 0 ").to.equal(2)
it "Unwinds inside an unevaluated definition", -> it "Unwinds inside an unevaluated definition", ->
expect(lisp read "((lambda (c) (catch 111 (* 2 (unwind-protect (* 3 (throw 111 5)) (set! c 1) ))) ) 0)").to.equal(5) expect(lisp read "((lambda (c) (catch 111 (* 2 (protect (* 3 (throw 111 5)) (set! c 1) ))) ) 0)").to.equal(5)
it "Unwinds inside the evaluated definition, triggering the side effect", -> it "Unwinds inside the evaluated definition, triggering the side effect", ->
expect(lisp read "((lambda (c) (catch 111 (* 2 (unwind-protect (* 3 (throw 111 5)) (set! c 1) ))) c ) 0)").to.equal(1) expect(lisp read "((lambda (c) (catch 111 (* 2 (protect (* 3 (throw 111 5)) (set! c 1) ))) c ) 0)").to.equal(1)
it "Same story, using block/return", -> it "Same story, using block/return", ->
expect(lisp read "((lambda (c) (block A (* 2 (unwind-protect (* 3 (return-from A 5)) (set! c 1) ))) ) 0)").to.equal(5) expect(lisp read "((lambda (c) (block A (* 2 (protect (* 3 (return A 5)) (set! c 1) ))) ) 0)").to.equal(5)
it "Same story, using block/return with a triggered side-effect", -> it "Same story, using block/return with a triggered side-effect", ->
expect(lisp read "((lambda (c) (block A (* 2 (unwind-protect (* 3 (return-from A 5)) (set! c 1) ))) c ) 0)").to.equal(1) expect(lisp read "((lambda (c) (block A (* 2 (protect (* 3 (return A 5)) (set! c 1) ))) c ) 0)").to.equal(1)
#describe "Core interpreter #3: Try/Catch with Throw as a function", -> #describe "Core interpreter #3: Try/Catch with Throw as a function", ->