elf
/
LispInSmallPieces
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

[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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

124
chapter3g/interpreter.coffee
View File

@ -10,31 +10,47 @@ class LispInterpreterError extends Error
the_false_value = (cons "false", "boolean")
# Base class that represents a value. Base class representing a LiSP
# value, a primitive, or a function
# An equality function that compares two values. This is necessary
# 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) ->
if id1 instanceof Symbol and id2 instanceof Symbol
return id1.name == id2.name
id1 == id2
# Base class that represents a value. Base class representing a LiSP
# value, a primitive, or a function
class Value
# Represents the base class of a continuation. Calls to invoke resume
# the contained continuation, which is typecast to one of the specific
# continuation needs of conditional, sequence, etc...
# Represents the base class of a continuation.
class Continuation
# Takes an existing continuation, which represents what to do when
# this continuation is invoked.
constructor: (@kont) ->
# Near as I can tell, this exists strictly to support call/cc
invoke: (value, env, kont) ->
if nilp cdr value
@kont.resume (car value)
else
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) ->
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) ->
@kont.catchLookup tag, kk
# Resume is literally the "What to do next."
resume: (value) ->
throw new LispInterpreterError "Wrong continuation for #{@_type}"
@ -102,7 +118,6 @@ evaluateQuote = (v, env, kont) ->
evaluateIf = (exps, env, kont) ->
evaluate (car exps), env, new IfCont(kont, (cadr exps), (caddr exps), env)
class IfCont extends Continuation
constructor: (@kont, @ift, @iff, @env) ->
@_type = "IfCont"
@ -111,7 +126,10 @@ class IfCont extends Continuation
# Sequences: evaluates the current expression with a continuation that
# 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) ->
if (pairp exps)
@ -178,22 +196,30 @@ extend = (env, names, values) ->
# Now we start the invocation: this is applying the function. Let's
# take it stepwise.
# Create a function environment. Calls the evaluateArguments(), which
# in turns goes down the list of arguments and creates a new
# environment, and then the continuation is to actually appy the nev
# environment to the existing function.
# Evaluate the application of a function call. The first step is to
# evaluate the first element of the function call, assuming it is or
# will resolve to a function (something of type * -> *). The
# continuation we create is to evaluate-function-cont.
evaluateApplication = (exp, exps, env, kont) ->
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
constructor: (@kont, @exp, @env) ->
@_type = "EvFunCont"
resume: (f) ->
evaluateArguments @exp, @env, (new ApplyCont(@kont, f, @env))
# Evaluate the first list, creating a new list of the arguments. Upon
# completion, resume the continuation with the gather phase
# Evaluate the argument list, creating a new list of the arguments.
# 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) ->
if (pairp exp)
@ -216,7 +242,9 @@ class GatherCont extends Continuation
resume: (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
constructor: (@kont, @fn, @env) ->
@ -237,6 +265,11 @@ class BottomCont extends Continuation
catchLookup: (tag, kk) ->
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) ->
k = new BlockCont(kont, label)
evaluateBegin body, (new BlockEnv env, label, k), k
@ -258,6 +291,13 @@ class BlockEnv extends FullEnv
evaluateReturnFrom = (label, form, env, kont) ->
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
constructor: (@kont, @env, @label) ->
@_type = "ReturnFromCont"
@ -267,12 +307,24 @@ class ReturnFromCont extends Continuation
evaluateCatch = (tag, body, env, kont) ->
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
constructor: (@kont, @body, @env) ->
@_type = "CatchFromCont"
resume: (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
constructor: (@kont, @tag) ->
@_type = "LabeledFromCont"
@ -298,6 +350,12 @@ class UnwindCont extends Continuation
resume: (value) ->
@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
constructor: (@kont, @tag, @resumecont) ->
@_type = "ThrowingCont"
@ -321,6 +379,8 @@ class ProtectReturnCont extends Continuation
resume: (value) ->
@kont.resume @value
# The bottom of the function pile, where native code is invoked.
class Primitive extends Value
constructor: (@name, @nativ) ->
@_type = "Primitive"
@ -337,9 +397,11 @@ defprimitive = (name, nativ, arity) ->
definitial name, new Primitive name, (args, env, kont) ->
vmargs = listToVector(args)
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)
else
throw new LispInterpreterError "Incorrect arity"
throw new LispInterpreterError "Incorrect arity"
defpredicate = (name, nativ, arity) ->
defprimitive name, ((a, b) -> if nativ.call(null, a, b) then true else the_false_value), arity
@ -415,6 +477,8 @@ metadata_evaluation =
nvalu: (node) -> node.value
mksymbols: (list) -> astSymbolsToLispSymbols(list)
# The hairness of this makes me doubt the wisdom of using Javascript.
straight_evaluation =
listp: (cell) -> cell.__type == 'list'
symbolp: (cell) -> typeof cell == 'string' and cell.length > 0 and cell[0] not in ["\"", ";"]
@ -430,6 +494,19 @@ straight_evaluation =
nvalu: (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") ->
(exp, env, kont) ->
if ix.symbolp exp
@ -440,18 +517,11 @@ makeEvaluator = (ix = straight_evaluation, ty="straight") ->
body = ix.nvalu exp
head = car body
if ix.symbolp head
switch (ix.nvalu head)
when "quote" then evaluateQuote (cadr body), env, kont
when "if" then evaluateIf (cdr body), env, kont
when "begin" then evaluateBegin (cdr body), env, kont
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
# Every call is boiled down to body/env/kont (with ix.nvalu tossed in for fun)
# It should be possible to move natives into an address space
if prox[(ix.nvalu head)]?
prox[(ix.nvalu head)](body, env, kont, ix)
else evaluateApplication (car body), (cdr body), env, kont
else
evaluateApplication (car body), (cdr body), env, kont
else

14
test/test_chapter3g.coffee
View File

@ -13,19 +13,19 @@ lisp = (ast) ->
olisp ast, (i) -> ret = i
return ret
describe "Core interpreter #3: Unwind-Protect", ->
describe "Core interpreter #3: Protect", ->
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", ->
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", ->
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", ->
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", ->
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", ->
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", ->