Added some comments.

This commit is contained in:
Elf M. Sternberg 2015-07-02 17:21:50 -07:00
parent 51ae30e31f
commit c2ff0a3d88
1 changed files with 50 additions and 38 deletions

View File

@ -3,17 +3,37 @@ readline = require "readline"
{inspect} = require "util" {inspect} = require "util"
print = require "./print" print = require "./print"
class Value ntype = (node) -> car node
nvalu = (node) -> cadr node
class Environment class Value
class Continuation class Continuation
constructor: (@k) -> constructor: (@k) ->
invoke: (v, env, kont) ->
if nilp cdr v
resume @k, (car v)
else
throw "Continuations expect one argument", [v, env, kont]
# Abstract class representing the environment
class Environment
lookup: -> throw "Nonspecific invocation"
update: -> throw "Nonspecific invocation"
# Base of the environment stack. If you hit this, your variable was
# never found for lookup/update. Note that at this time in the
# class, you have not
class NullEnv extends Environment class NullEnv extends Environment
lookup: -> throw "Unknown variable" lookup: -> throw "Unknown variable"
update: -> throw "Unknown variable" update: -> throw "Unknown variable"
# This appears to be an easy and vaguely abstract handle to the
# environment. The book is not clear on the distinction between the
# FullEnv and the VariableEnv.
class FullEnv extends Environment class FullEnv extends Environment
constructor: (@others, @name) -> constructor: (@others, @name) ->
lookup: (name, kont) -> lookup: (name, kont) ->
@ -21,6 +41,10 @@ class FullEnv extends Environment
update: (name, kont, value) -> update: (name, kont, value) ->
@others.update name, kont, value @others.update name, kont, value
# This is the classic environment pair; either it's *this*
# environment, or it's a parent environment, until you hit the
# NullEnv.
class VariableEnv extends FullEnv class VariableEnv extends FullEnv
constructor: (@others, @name, @value) -> constructor: (@others, @name, @value) ->
lookup: (name, kont) -> lookup: (name, kont) ->
@ -81,7 +105,7 @@ class SetCont extend Continuation
# LAMBDA # LAMBDA
evaluateLambda = (name, exp, env, kont) -> evaluateLambda = (names, exp, env, kont) ->
resume kont, new Function names, exp, env resume kont, new Function names, exp, env
class Function extends Value class Function extends Value
@ -134,58 +158,45 @@ class BottomCont extends Continuation
@f(v) @f(v)
class Primitive extends Value class Primitive extends Value
constructor: (@name, @address) -> constructor: (@name, @nativ) ->
invoke: (args, env, kont) ->
@nativ.apply null, (listToVector args), env, kont
env_init = new NullEnv()
interpreter = (ast, kont) ->
evaluate ast, env_init, new BottomCont null, kont
evaluate = (e, env, kont) -> evaluate = (e, env, kont) ->
[type, exp] = [(ntype e), (nvalu e)] [type, exp] = [(ntype e), (nvalu e)]
if type == "symbol" if type == "symbol"
return variables.evaluate exp, env, kont return evaluateVariable exp, env, kont
if type in ["number", "string", "boolean", "vector"] if type in ["number", "string", "boolean", "vector"]
return exp return exp
if type == "list" if type == "list"
head = car exp head = car exp
if (ntype head) == 'symbol' if (ntype head) == 'symbol'
switch (nvalu head) switch (nvalu head)
when "quote" then resume (cdr exp), kont when "quote" then evaluateQuote (cdr exp), env, kont
when "if" then evaluateIf (cdr exp), env, kont when "if" then evaluateIf (cdr exp), env, kont
when "begin" then evaluateBegin (cdr exp), env, kont
evaluate (cadr e), env, new Ifs((-> (caddr e)), (->(cadddr e)), env, kont) when "set!" then evaluateSet (nvalu cadr exp), (nvalu caddr exp), env, kont
when "begin" then eprogn (cdr exp), env when "lambda" then evaluateLambda (astSymbolsToLispSymbols cadr exp), (cddr exp), env, kont
when "set!" then update (nvalu cadr exp), env, (evaluate (caddr exp), env) evaluateApplication (car exp), (cdr exp), env, cont
when "lambda" then make_function (astSymbolsToLispSymbols cadr exp), (cddr exp), env
else invoke (evaluate (car exp), env), (evlis (cdr exp), env)
else else
invoke (evaluate (car exp), env), (evlis (cdr exp), env) evaluateApplication (car exp), (cdr exp), env, cont
else else
throw new Error("Can't handle a #{type}") throw new Error("Can't handle a #{type}")
class Ifs:
evaluate: (cond, pass, alt, env, kont) ->
if cond then
resume: (
env_init = nil
env_global = env_init
ntype = (node) -> car node
nvalu = (node) -> cadr node
definitial = (name, value = nil) -> definitial = (name, value = nil) ->
env_global = (cons (cons name, value), env_global) env_init = new VariableEnv env_init, name, value
name name
defprimitive = (name, nativ, arity) -> defprimitive = (name, nativ, arity) ->
definitial name, ((args) -> definitial name, new Primitive name, (args, env, kont) ->
vmargs = listToVector(args) vmargs = listToVector(args)
if (vmargs.length == arity) if (vmargs.length == arity)
nativ.apply null, vmargs resume kont (nativ.apply null, vmargs
else else
throw "Incorrect arity") throw "Incorrect arity")
@ -194,10 +205,11 @@ the_false_value = (cons "false", "boolean")
definitial "#t", true definitial "#t", true
definitial "#f", the_false_value definitial "#f", the_false_value
definitial "nil", nil definitial "nil", nil
definitial "foo" for i in [
definitial "bar" "x", "y", "z", "a", "b", "c", "foo", "bar", "hux",
definitial "fib" "fib", "fact", "visit", "primes", "length"]
definitial "fact" definitial i
defpredicate = (name, nativ, arity) -> defpredicate = (name, nativ, arity) ->
defprimitive name, ((a, b) -> if nativ.call(null, a, b) then true else the_false_value), arity defprimitive name, ((a, b) -> if nativ.call(null, a, b) then true else the_false_value), arity