Merge fix.
This commit is contained in:
commit
8572d84817
|
@ -0,0 +1,10 @@
|
||||||
|
{car, cdr} = require 'cons-lists/lists'
|
||||||
|
|
||||||
|
symbol = (form) -> (car form)
|
||||||
|
|
||||||
|
module.exports =
|
||||||
|
aSymbol: symbol
|
||||||
|
aValue: (form) -> (car cdr form)
|
||||||
|
isAList: (form) -> (symbol form) == 'list'
|
||||||
|
isARecord: (form) -> (symbol form) == 'record'
|
||||||
|
isAVector: (form) -> (symbol form) == 'vector'
|
|
@ -0,0 +1,51 @@
|
||||||
|
{car, cdr, cons, listp, nilp, nil, list, listToString} = require 'cons-lists/lists'
|
||||||
|
{aSymbol, aValue} = require './astAccessors'
|
||||||
|
|
||||||
|
# RICH_AST -> LISP_AST
|
||||||
|
normalizeForm = (form) ->
|
||||||
|
|
||||||
|
listToRecord1 = (l) ->
|
||||||
|
o = Object.create(null)
|
||||||
|
while(l != nil)
|
||||||
|
o[normalizeForm(car l)] = normalizeForm(car cdr l)
|
||||||
|
l = cdr cdr l
|
||||||
|
null
|
||||||
|
o
|
||||||
|
|
||||||
|
listToVector1 = (l) ->
|
||||||
|
while(l != nil) then p = normalizeForm(car l); l = cdr l; p
|
||||||
|
|
||||||
|
id = (a) -> a
|
||||||
|
|
||||||
|
methods =
|
||||||
|
'list': normalizeForms
|
||||||
|
'vector': (atom) -> listToVector1(atom)
|
||||||
|
'record': (atom) -> listToRecord1(atom)
|
||||||
|
|
||||||
|
# Basic native types. Meh.
|
||||||
|
'symbol': id
|
||||||
|
'number': id
|
||||||
|
'string': (atom) -> atom
|
||||||
|
'nil': (atom) -> nil
|
||||||
|
|
||||||
|
# Values inherited from the VM.
|
||||||
|
'true': (atom) -> true
|
||||||
|
'false': (atom) -> false
|
||||||
|
'null': (atom) -> null
|
||||||
|
'undefined': (atom) -> undefined
|
||||||
|
|
||||||
|
methods[(car form)](car cdr form)
|
||||||
|
|
||||||
|
|
||||||
|
normalizeForms = (forms) ->
|
||||||
|
# Yes, this reifies the expectation than an empty list and 'nil' are
|
||||||
|
# the same.
|
||||||
|
return nil if nilp forms
|
||||||
|
cons(normalizeForm(car forms), normalizeForms(cdr forms))
|
||||||
|
|
||||||
|
module.exports =
|
||||||
|
normalizeForm: normalizeForm
|
||||||
|
normalizeForms: normalizeForms
|
||||||
|
|
||||||
|
|
||||||
|
|
|
@ -1,4 +1,4 @@
|
||||||
{listToString, listToVector, pairp, cons, car, cdr, caar, cddr, cdar, cadr, caadr, cadar, caddr, nilp, nil, setcdr, metacadr} = require "cons-lists/lists"
|
{listToString, listToVector, pairp, cons, car, cdr, caar, cddr, cdar, cadr, caadr, cadar, caddr, nilp, nil, setcdr, metacadr, setcar} = require "cons-lists/lists"
|
||||||
readline = require "readline"
|
readline = require "readline"
|
||||||
{inspect} = require "util"
|
{inspect} = require "util"
|
||||||
print = require "./print"
|
print = require "./print"
|
||||||
|
@ -8,6 +8,10 @@ nvalu = (node) -> cadr node
|
||||||
|
|
||||||
class Value
|
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...
|
||||||
|
|
||||||
class Continuation
|
class Continuation
|
||||||
constructor: (@k) ->
|
constructor: (@k) ->
|
||||||
invoke: (v, env, kont) ->
|
invoke: (v, env, kont) ->
|
||||||
|
@ -43,28 +47,33 @@ class FullEnv extends Environment
|
||||||
|
|
||||||
# This is the classic environment pair; either it's *this*
|
# This is the classic environment pair; either it's *this*
|
||||||
# environment, or it's a parent environment, until you hit the
|
# environment, or it's a parent environment, until you hit the
|
||||||
# NullEnv.
|
# NullEnv. Once the name has been found, the continuation is called
|
||||||
|
# with the found value.
|
||||||
|
|
||||||
class VariableEnv extends FullEnv
|
class VariableEnv extends FullEnv
|
||||||
constructor: (@others, @name, @value) ->
|
constructor: (@others, @name, @value) ->
|
||||||
lookup: (name, kont) ->
|
lookup: (name, kont) ->
|
||||||
if name == @name
|
if name == @name
|
||||||
resume kont, @value
|
kont.resume @value
|
||||||
else
|
else
|
||||||
@others.lookup name, kont
|
@others.lookup name, kont
|
||||||
update: (nam, kont, value) ->
|
update: (nam, kont, value) ->
|
||||||
if name == @name
|
if name == @name
|
||||||
@value = value
|
@value = value
|
||||||
resume kont, value
|
kont.resume value
|
||||||
else
|
else
|
||||||
@others.update name, kont, value
|
@others.update name, kont, value
|
||||||
|
|
||||||
# QUOTE
|
# "Renders the quote term to the current continuation"; in a more
|
||||||
|
# familiar parlance, calls resume in the current context with the
|
||||||
|
# quoted term uninterpreted.
|
||||||
|
|
||||||
evaluateQuote = (v, env, kont) ->
|
evaluateQuote = (v, env, kont) ->
|
||||||
resume kont, v
|
kont.resume v
|
||||||
|
|
||||||
# IF
|
# Evaluates the conditional expression, creating a continuation with
|
||||||
|
# the current environment that, when resumed, evaluates either the
|
||||||
|
# true or false branch, again in the current enviornment.
|
||||||
|
|
||||||
evaluateIf = (exps, env, kont) ->
|
evaluateIf = (exps, env, kont) ->
|
||||||
evaluate (car e), env, new IfCont(kont, (cadr e), (caddr e), env)
|
evaluate (car e), env, new IfCont(kont, (cadr e), (caddr e), env)
|
||||||
|
@ -73,7 +82,9 @@ class IfCont extends Continuation
|
||||||
constructor: (@k, @ift, @iff, @env) ->
|
constructor: (@k, @ift, @iff, @env) ->
|
||||||
resume: (v) -> evaluate (if v then @ift else @iff), @env, @k
|
resume: (v) -> evaluate (if v then @ift else @iff), @env, @k
|
||||||
|
|
||||||
# BEGIN
|
# 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.
|
||||||
|
|
||||||
evaluateBegin = (exps, env, kont) ->
|
evaluateBegin = (exps, env, kont) ->
|
||||||
if (pairp exps)
|
if (pairp exps)
|
||||||
|
@ -82,18 +93,21 @@ evaluateBegin = (exps, env, kont) ->
|
||||||
else
|
else
|
||||||
evaluate (car exps), env, kont
|
evaluate (car exps), env, kont
|
||||||
else
|
else
|
||||||
resume kont, "Begin empty value"
|
kont.resume("Begin empty value")
|
||||||
|
|
||||||
class BeginCont extends Continuation
|
class BeginCont extends Continuation
|
||||||
constructor: (@k, @exps, @env) ->
|
constructor: (@k, @exps, @env) ->
|
||||||
resume: (v) -> evaluateBegin (cdr @exps), @env, @k
|
resume: (v) -> evaluateBegin (cdr @exps), @env, @k
|
||||||
|
|
||||||
# VARIABLE
|
# In this continuation, we simply pass the continuation and the name
|
||||||
|
# to the environment to look up. The environment knows to call the
|
||||||
|
# continuation with the value.
|
||||||
|
|
||||||
evaluateVariable = (name, env, kont) ->
|
evaluateVariable = (name, env, kont) ->
|
||||||
env.lookup(name, kont)
|
env.lookup(name, kont)
|
||||||
|
|
||||||
# SET
|
# This is the same dance as lookup, only with the continuation being
|
||||||
|
# called after an update has been performed.
|
||||||
|
|
||||||
evaluateSet = (name, exp, env, kont) ->
|
evaluateSet = (name, exp, env, kont) ->
|
||||||
evaluate exp, env, (new setCont(kont, name, env))
|
evaluate exp, env, (new setCont(kont, name, env))
|
||||||
|
@ -103,16 +117,26 @@ class SetCont extend Continuation
|
||||||
resume: (value) ->
|
resume: (value) ->
|
||||||
update @env, @name, @k, value
|
update @env, @name, @k, value
|
||||||
|
|
||||||
# LAMBDA
|
# Calls the current contunation, passing it a new function wrapper.
|
||||||
|
|
||||||
evaluateLambda = (names, exp, env, kont) ->
|
evaluateLambda = (names, exp, env, kont) ->
|
||||||
resume kont, new Function names, exp, env
|
kont.resume new Function names, exp, env
|
||||||
|
|
||||||
|
# Upon invocation, evaluates the body with a new environment that
|
||||||
|
# consists of the original names, their current values as called, and
|
||||||
|
# the continuation an the moment of invocation, which will continue
|
||||||
|
# (resume) execution once the function is finished.
|
||||||
|
#
|
||||||
|
# By the way: this is pretty much the whole the point.
|
||||||
|
|
||||||
class Function extends Value
|
class Function extends Value
|
||||||
constructor: (@variables, @body, @env) ->
|
constructor: (@variables, @body, @env) ->
|
||||||
invoke: (values, env, kont) ->
|
invoke: (values, env, kont) ->
|
||||||
evaluateBegin @body, (extend @env, @variables, values), kont
|
evaluateBegin @body, (extend @env, @variables, values), kont
|
||||||
|
|
||||||
|
# Helper function to build name/value pairs for the current execution
|
||||||
|
# context.
|
||||||
|
|
||||||
extend = (env, names, values) ->
|
extend = (env, names, values) ->
|
||||||
if (pairp names) and (pairp values)
|
if (pairp names) and (pairp values)
|
||||||
new VariableEnv (extend env (cdr names) (cdr values)), (car names), (car values)
|
new VariableEnv (extend env (cdr names) (cdr values)), (car names), (car values)
|
||||||
|
@ -121,7 +145,13 @@ extend = (env, names, values) ->
|
||||||
else
|
else
|
||||||
new VariableEnv env, names, values
|
new VariableEnv env, names, values
|
||||||
|
|
||||||
# APPLICATION
|
# 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.
|
||||||
|
|
||||||
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)
|
||||||
|
@ -131,27 +161,38 @@ class EvFunCont extends Continuation
|
||||||
resume: (f) ->
|
resume: (f) ->
|
||||||
evaluateArguments (@exp, @k, new ApplyCont @k, f, @env)
|
evaluateArguments (@exp, @k, new ApplyCont @k, f, @env)
|
||||||
|
|
||||||
|
# Evaluate the first list, creating a new list of the arguments. Upon
|
||||||
|
# completion, resume the continuation with the gather phase
|
||||||
|
|
||||||
evaluateArguments = (exp, env, kont) ->
|
evaluateArguments = (exp, env, kont) ->
|
||||||
if (pairp exp)
|
if (pairp exp)
|
||||||
evaluate (car exp), env, (new ArgumentCont kont, exp, env)
|
evaluate (car exp), env, (new ArgumentCont kont, exp, env)
|
||||||
else
|
else
|
||||||
resume kont, "No more arguments"
|
kont.resume("No more arguments")
|
||||||
|
|
||||||
class ApplyCont extends Continuation
|
|
||||||
constructor: (@k, @fn, @env) ->
|
|
||||||
resume: (v) ->
|
|
||||||
invoke @fn, v, @env, @k
|
|
||||||
|
|
||||||
class ArgumentCont extends Continuation
|
class ArgumentCont extends Continuation
|
||||||
constructor: (@k, @exp, @env) ->
|
constructor: (@k, @exp, @env) ->
|
||||||
resume: (v) ->
|
resume: (v) ->
|
||||||
evaluateArguments (cdr @env, @env, new GatherCont @k, v)
|
evaluateArguments (cdr @env, @env, new GatherCont @k, v)
|
||||||
|
|
||||||
|
# Gather the arguments as each ArgumentCont is resumed into a list to
|
||||||
|
# be passed to our next step.
|
||||||
|
|
||||||
class GatherCont extends Continuation
|
class GatherCont extends Continuation
|
||||||
constructor: (@k, @v) ->
|
constructor: (@k, @v) ->
|
||||||
resume: (v) ->
|
resume: (v) ->
|
||||||
@k.resume (cons @v, v)
|
@k.resume (cons @v, v)
|
||||||
|
|
||||||
|
# Upon resumption, invoke the function.
|
||||||
|
|
||||||
|
class ApplyCont extends Continuation
|
||||||
|
constructor: (@k, @fn, @env) ->
|
||||||
|
resume: (v) ->
|
||||||
|
invoke @fn, v, @env, @k
|
||||||
|
|
||||||
|
# A special continuation that represents what we want the interpreter
|
||||||
|
# to do when it's done processing.
|
||||||
|
|
||||||
class BottomCont extends Continuation
|
class BottomCont extends Continuation
|
||||||
constructor: (@k, @f) ->
|
constructor: (@k, @f) ->
|
||||||
resume: (v) ->
|
resume: (v) ->
|
||||||
|
@ -162,11 +203,6 @@ class Primitive extends Value
|
||||||
invoke: (args, env, kont) ->
|
invoke: (args, env, kont) ->
|
||||||
@nativ.apply null, (listToVector 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"
|
||||||
|
@ -196,7 +232,7 @@ 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)
|
||||||
resume kont (nativ.apply null, vmargs
|
kont.resume (nativ.apply null, vmargs)
|
||||||
else
|
else
|
||||||
throw "Incorrect arity")
|
throw "Incorrect arity")
|
||||||
|
|
||||||
|
@ -213,124 +249,44 @@ for i in [
|
||||||
"fib", "fact", "visit", "primes", "length"]
|
"fib", "fact", "visit", "primes", "length"]
|
||||||
definitial i
|
definitial i
|
||||||
|
|
||||||
|
|
||||||
defprimitive "cons", cons, 2
|
defprimitive "cons", cons, 2
|
||||||
defprimitive "car", car, 2
|
defprimitive "car", car, 2
|
||||||
|
defprimitive "cdr", cdr, 2
|
||||||
defprimitive "set-cdr!", setcdr, 2
|
defprimitive "set-cdr!", setcdr, 2
|
||||||
|
defprimitive "set-car!", setcar, 2
|
||||||
defprimitive "+", ((a, b) -> a + b), 2
|
defprimitive "+", ((a, b) -> a + b), 2
|
||||||
defprimitive "*", ((a, b) -> a * b), 2
|
defprimitive "*", ((a, b) -> a * b), 2
|
||||||
defprimitive "-", ((a, b) -> a - b), 2
|
defprimitive "-", ((a, b) -> a - b), 2
|
||||||
defprimitive "/", ((a, b) -> a / b), 2
|
defprimitive "/", ((a, b) -> a / b), 2
|
||||||
defpredicate "lt", ((a, b) -> a < b), 2
|
defpredicate "lt", ((a, b) -> a < b), 2
|
||||||
|
defpredicate "gt", ((a, b) -> a > b), 2
|
||||||
|
defpredicate "lte", ((a, b) -> a <= b), 2
|
||||||
|
defpredicate "gte", ((a, b) -> a >= b), 2
|
||||||
defpredicate "eq?", ((a, b) -> a == b), 2
|
defpredicate "eq?", ((a, b) -> a == b), 2
|
||||||
|
defpredicate "pair?" ((a) -> pairp a), 1
|
||||||
|
defpredicate "nil?" ((a) -> nilp a), 1
|
||||||
|
defpredicate "symbol?" ((a) -> /\-?[0-9]+$/.test(a) == false), 1
|
||||||
|
|
||||||
|
definitial "call/cc", new Primitive "call/cc", (values, env, kont) ->
|
||||||
|
if nilp cdr values
|
||||||
|
(car values).invoke (cons kont), env, kont
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
extend = (env, variables, values) ->
|
|
||||||
if (pairp variables)
|
|
||||||
if (pairp values)
|
|
||||||
(cons (cons (car variables), (car values)),
|
|
||||||
(extend env, (cdr variables), (cdr values)))
|
|
||||||
else
|
else
|
||||||
throw "Too few values"
|
throw "Incorrect arity for call/cc", [r, k]
|
||||||
else if (nilp variables)
|
|
||||||
if (nilp values) then env else throw "Too many values"
|
|
||||||
else
|
|
||||||
if (symbolp variables)
|
|
||||||
(cons (cons variables, values), env)
|
|
||||||
else
|
|
||||||
nil
|
|
||||||
|
|
||||||
make_function = (variables, body, env) ->
|
definitial "apply", new Primitive "apply", (values, env, kont) ->
|
||||||
(values) -> eprogn body, (extend env, variables, values)
|
if pairp cdr values
|
||||||
|
f = car values
|
||||||
|
args = (() ->
|
||||||
|
(flat = (args) ->
|
||||||
|
if nilp cdr args then (car args) else (cons (car args), (flat cdr args)))(cdr values))()
|
||||||
|
f.invoke args, env, kont
|
||||||
|
|
||||||
invoke = (fn, args) ->
|
definitial "list", new Primitive "list", (values, env, kont) ->
|
||||||
(fn args)
|
(values, env, kont) -> kont.resume(values)
|
||||||
|
|
||||||
# Takes a list of nodes and calls evaluate on each one, returning the
|
env_init = new NullEnv()
|
||||||
# last one as the value of the total expression. In this example, we
|
|
||||||
# are hard-coding what ought to be a macro, namely the threading
|
|
||||||
# macros, "->"
|
|
||||||
|
|
||||||
eprogn = (exps, env) ->
|
interpreter = (ast, kont) ->
|
||||||
if (pairp exps)
|
evaluate ast, env_init, new BottomCont null, kont
|
||||||
if pairp (cdr exps)
|
|
||||||
evaluate (car exps), env
|
|
||||||
eprogn (cdr exps), env
|
|
||||||
else
|
|
||||||
evaluate (car exps), env
|
|
||||||
else
|
|
||||||
nil
|
|
||||||
|
|
||||||
evlis = (exps, env) ->
|
module.exports = intepreter
|
||||||
if (pairp exps)
|
|
||||||
(cons (evaluate (car exps), env), (evlis (cdr exps), env))
|
|
||||||
else
|
|
||||||
nil
|
|
||||||
|
|
||||||
lookup = (id, env) ->
|
|
||||||
if (pairp env)
|
|
||||||
if (caar env) == id
|
|
||||||
cdar env
|
|
||||||
else
|
|
||||||
lookup id, (cdr env)
|
|
||||||
else
|
|
||||||
nil
|
|
||||||
|
|
||||||
update = (id, env, value) ->
|
|
||||||
if (pairp env)
|
|
||||||
if (caar env) == id
|
|
||||||
setcdr value, (car env)
|
|
||||||
value
|
|
||||||
else
|
|
||||||
update id, (cdr env), value
|
|
||||||
else
|
|
||||||
nil
|
|
||||||
|
|
||||||
# This really ought to be the only place where the AST meets the
|
|
||||||
# interpreter core. I can't help but think that this design precludes
|
|
||||||
# pluggable interpreter core.
|
|
||||||
|
|
||||||
astSymbolsToLispSymbols = (node) ->
|
|
||||||
return nil if nilp node
|
|
||||||
throw "Not a list of variable names" if not (ntype(node) is 'list')
|
|
||||||
handler = (node) ->
|
|
||||||
return nil if nilp node
|
|
||||||
cons (nvalu car node), (handler cdr node)
|
|
||||||
handler(nvalu node)
|
|
||||||
|
|
||||||
|
|
||||||
# Takes an AST node and evaluates it and its contents. A node may be
|
|
||||||
# ("list" (... contents ...)) or ("number" 42) or ("symbol" x), etc.
|
|
||||||
|
|
||||||
cadddr = metacadr('cadddr')
|
|
||||||
|
|
||||||
class Component
|
|
||||||
invoke: -> throw "Not a function"
|
|
||||||
|
|
||||||
class Environment
|
|
||||||
lookup: -> throw "Not an environment"
|
|
||||||
|
|
||||||
class NullEnv extends Environment
|
|
||||||
lookup: -> throw "Unknown Variable"
|
|
||||||
|
|
||||||
class FullEnv extends Environment
|
|
||||||
constructor: (@others, @name) ->
|
|
||||||
lookup: (id) -> lookup id, @others
|
|
||||||
|
|
||||||
class VariableEnv extends FullEnv
|
|
||||||
constructor:(@others, @name, @value) ->
|
|
||||||
lookup: (id) ->
|
|
||||||
|
|
||||||
class Primitive extends Invokable
|
|
||||||
invoke: (args, kont) -> @fn args, kont
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
module.exports = (c) -> evaluate c, env_global
|
|
||||||
|
|
|
@ -0,0 +1,34 @@
|
||||||
|
chai = require 'chai'
|
||||||
|
chai.should()
|
||||||
|
expect = chai.expect
|
||||||
|
|
||||||
|
{cons, nil, nilp} = require "cons-lists/lists"
|
||||||
|
{read, readForms} = require '../chapter1/reader'
|
||||||
|
{normalizeForm} = require '../chapter1/astToList'
|
||||||
|
|
||||||
|
describe "Core reader functions", ->
|
||||||
|
samples = [
|
||||||
|
['nil', nil]
|
||||||
|
['0', 0]
|
||||||
|
['1', 1]
|
||||||
|
['500', 500]
|
||||||
|
['0xdeadbeef', 3735928559]
|
||||||
|
['"Foo"', 'Foo']
|
||||||
|
['(1)', cons(1)]
|
||||||
|
['(1 2)', cons(1, (cons 2))]
|
||||||
|
['(1 2 )', cons(1, (cons 2))]
|
||||||
|
['( 1 2 )', cons(1, (cons 2))]
|
||||||
|
['( 1 2 )', cons(1, (cons 2))]
|
||||||
|
['("a" "b")', cons("a", (cons "b"))]
|
||||||
|
['("a" . "b")', cons("a", "b")]
|
||||||
|
['[]', []]
|
||||||
|
['{}', {}]
|
||||||
|
['[1 2 3]', [1, 2, 3]]
|
||||||
|
['{foo "bar"}', {foo: "bar"}]
|
||||||
|
]
|
||||||
|
|
||||||
|
for [t, v] in samples
|
||||||
|
do (t, v) ->
|
||||||
|
it "should interpret #{t} as #{v}", ->
|
||||||
|
res = normalizeForm read t
|
||||||
|
expect(res).to.deep.equal(v)
|
Loading…
Reference in New Issue