[refactor] A new representation for symbols to handle quoted code
This is a big refactoring; the parser is now modal, to handle either complex Node objects that carry around a lot of state with them, or simpler objects that represent the McCarthy-style IST. I'm still feeling my way through the subject material. The node construction is such pure artifice I feel silly keeping it, and may end up revising it (again). The nice thing is, everything goes through evaluate. Almost no other code needs to know anything at all about the shape of the Nodes themselves; it all makes assumptions based on the return value (or continuation passed) by evaluate.
This commit is contained in:
parent
02f79c4255
commit
5d9703aa33
|
|
@ -2,6 +2,7 @@
|
|||
cadr, caadr, cadar, caddr, nilp, nil, setcdr, metacadr} = require "cons-lists/lists"
|
||||
readline = require "readline"
|
||||
{inspect} = require "util"
|
||||
{Symbol} = require '../chapter1/reader_types'
|
||||
|
||||
class LispInterpreterError extends Error
|
||||
name: 'LispInterpreterError'
|
||||
|
|
@ -10,9 +11,6 @@ class LispInterpreterError extends Error
|
|||
env_init = nil
|
||||
env_global = env_init
|
||||
|
||||
ntype = (node) -> car node
|
||||
nvalu = (node) -> cadr node
|
||||
|
||||
definitial = (name, value = nil) ->
|
||||
env_global = (cons (cons name, value), env_global)
|
||||
name
|
||||
|
|
@ -25,6 +23,9 @@ defprimitive = (name, nativ, arity) ->
|
|||
else
|
||||
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
|
||||
|
||||
the_false_value = (cons "false", "boolean")
|
||||
|
||||
definitial "#t", true
|
||||
|
|
@ -35,9 +36,6 @@ definitial "bar"
|
|||
definitial "fib"
|
||||
definitial "fact"
|
||||
|
||||
defpredicate = (name, nativ, arity) ->
|
||||
defprimitive name, ((a, b) -> if nativ.call(null, a, b) then true else the_false_value), arity
|
||||
|
||||
defprimitive "cons", cons, 2
|
||||
defprimitive "car", car, 2
|
||||
defprimitive "set-cdr!", setcdr, 2
|
||||
|
|
@ -48,6 +46,9 @@ defprimitive "/", ((a, b) -> a / b), 2
|
|||
defpredicate "lt", ((a, b) -> a < b), 2
|
||||
defpredicate "eq?", ((a, b) -> a == b), 2
|
||||
|
||||
# MISTAKE: Variables are always of type Symbol. This is probably a
|
||||
# mistake.
|
||||
|
||||
extend = (env, variables, values) ->
|
||||
if (pairp variables)
|
||||
if (pairp values)
|
||||
|
|
@ -58,8 +59,8 @@ extend = (env, variables, values) ->
|
|||
else if (nilp variables)
|
||||
if (nilp values) then env else throw new LispInterpreterError "Too many values"
|
||||
else
|
||||
if (symbolp variables)
|
||||
(cons (cons variables, values), env)
|
||||
if (variables instanceof Symbol)
|
||||
(cons (cons variables.v, values), env)
|
||||
else
|
||||
nil
|
||||
|
||||
|
|
@ -115,52 +116,82 @@ update = (id, env, value, callback) ->
|
|||
# interpreter core. I can't help but think that this design precludes
|
||||
# pluggable interpreter core.
|
||||
|
||||
# TODO: Reengineer this with a call to normalize
|
||||
|
||||
astSymbolsToLispSymbols = (node) ->
|
||||
nvalu = (node) -> cadr node
|
||||
return nil if nilp node
|
||||
throw (new LispInterpreterError "Not a list of variable names") if not (ntype(node) is 'list')
|
||||
throw (new LispInterpreterError "Not a list of variable names") if not ((car node) is 'list')
|
||||
handler = (node) ->
|
||||
return nil if nilp node
|
||||
cons (nvalu car node), (handler cdr node)
|
||||
cons (nvalu car node).v, (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')
|
||||
|
||||
evaluate = (e, env, callback) ->
|
||||
[type, exp] = [(ntype e), (nvalu e)]
|
||||
if type == "symbol"
|
||||
return callback lookup exp, env
|
||||
else if type in ["number", "string", "boolean", "vector"]
|
||||
return callback exp
|
||||
else if type == "list"
|
||||
head = car exp
|
||||
if (ntype head) == 'symbol'
|
||||
return switch (nvalu head)
|
||||
when "quote"
|
||||
callback cdr exp
|
||||
when "if"
|
||||
evaluate (cadr exp), env, (res) ->
|
||||
w = unless res == the_false_value then caddr else cadddr
|
||||
evaluate (w exp), env, callback
|
||||
when "begin"
|
||||
eprogn (cdr exp), env, callback
|
||||
when "set!"
|
||||
evaluate (caddr exp), env, (newvalue) ->
|
||||
update (nvalu cadr exp), env, newvalue, callback
|
||||
when "lambda"
|
||||
make_function (astSymbolsToLispSymbols cadr exp), (cddr exp), env, callback
|
||||
else
|
||||
evaluate (car exp), env, (fn) ->
|
||||
evlis (cdr exp), env, (args) ->
|
||||
invoke fn, args, callback
|
||||
metadata_evaluation =
|
||||
listp: (node) -> (car node) == 'list'
|
||||
symbolp: (node) -> (car node) == 'symbol'
|
||||
numberp: (node) -> (car node) == 'number'
|
||||
stringp: (node) -> (car node) == 'string'
|
||||
nvalu: (node) -> cadr node
|
||||
mksymbols: astSymbolsToLispSymbols
|
||||
|
||||
straight_evaluation =
|
||||
listp: (node) -> node.__type == 'list'
|
||||
symbolp: (node) -> node instanceof Symbol
|
||||
commentp: (node) -> node instanceof Comment
|
||||
numberp: (node) -> typeof node == 'number'
|
||||
stringp: (node) -> typeof node == 'string'
|
||||
boolp: (node) -> typeof node == 'boolean'
|
||||
nullp: (node) -> node == null
|
||||
vectorp: (node) -> (not straight_evaluation.listp node) and toString.call(node) == '[object Array]'
|
||||
recordp: (node) -> (not node._prototype?) and toSTring.call(node) == '[object Object]'
|
||||
objectp: (node) -> (node._prototype?) and toString.call(node) == '[object Object]'
|
||||
nilp: (node) -> nilp(node)
|
||||
nvalu: (node) -> node
|
||||
mksymbols: (node) -> node
|
||||
|
||||
makeEvaluator = (ix = straight_evaluation, ty="straight") ->
|
||||
(exp, env, callback) ->
|
||||
if ix.symbolp exp
|
||||
return callback lookup (ix.nvalu exp).v, env
|
||||
else if ([ix.numberp, ix.stringp].filter (i) -> i(exp)).length > 0
|
||||
return callback ix.nvalu exp
|
||||
else if ix.listp exp
|
||||
body = ix.nvalu exp
|
||||
head = car body
|
||||
if ix.symbolp head
|
||||
return switch (ix.nvalu head).v
|
||||
when "quote" then callback cdr body
|
||||
when "if"
|
||||
evaluate (cadr body), env, (res) ->
|
||||
w = unless res == the_false_value then caddr else cadddr
|
||||
evaluate (w body), env, callback
|
||||
when "begin" then eprogn (cdr body), env, callback
|
||||
when "set!"
|
||||
evaluate (caddr body), env, (newvalue) ->
|
||||
update (ix.nvalu cadr body).v, env, newvalue, callback
|
||||
when "lambda"
|
||||
make_function (ix.mksymbols cadr body), (cddr body), env, callback
|
||||
else
|
||||
evaluate (car body), env, (fn) ->
|
||||
evlis (cdr body), env, (args) ->
|
||||
invoke fn, args, callback
|
||||
else
|
||||
evaluate (car body), env, (fn) ->
|
||||
evlis (cdr body), env, (args) ->
|
||||
invoke fn, args, callback
|
||||
else
|
||||
evaluate (car exp), env, (fn) ->
|
||||
evlis (cdr exp), env, (args) ->
|
||||
invoke fn, args, callback
|
||||
else
|
||||
throw new LispInterpreterError ("Can't handle a #{type}")
|
||||
throw new LispInterpreterError ("Can't handle a #{type}")
|
||||
|
||||
nodeEval = makeEvaluator(metadata_evaluation, "node")
|
||||
lispEval = makeEvaluator(straight_evaluation, "lisp")
|
||||
|
||||
evaluate = (exp, env, cb) ->
|
||||
(if exp? and exp.__node then nodeEval else lispEval)(exp, env, cb)
|
||||
|
||||
module.exports = (c, cb) -> evaluate c, env_global, cb
|
||||
|
|
|
|||
|
|
@ -26,6 +26,8 @@ defprimitive = (name, nativ, arity) ->
|
|||
defpredicate = (name, nativ, arity) ->
|
||||
defprimitive name, ((a, b) -> if nativ.call(null, a, b) then true else the_false_value), arity
|
||||
|
||||
the_false_value = (cons "false", "boolean")
|
||||
|
||||
definitial "#t", true
|
||||
definitial "#f", the_false_value
|
||||
definitial "nil", nil
|
||||
|
|
@ -44,8 +46,6 @@ defprimitive "/", ((a, b) -> a / b), 2
|
|||
defpredicate "lt", ((a, b) -> a < b), 2
|
||||
defpredicate "eq?", ((a, b) -> a == b), 2
|
||||
|
||||
the_false_value = (cons "false", "boolean")
|
||||
|
||||
extend = (env, variables, values) ->
|
||||
if (pairp variables)
|
||||
if (pairp values)
|
||||
|
|
@ -56,8 +56,8 @@ extend = (env, variables, values) ->
|
|||
else if (nilp variables)
|
||||
if (nilp values) then env else throw new LispInterpreterError "Too many values"
|
||||
else
|
||||
if (symbolp variables)
|
||||
(cons (cons variables, values), env)
|
||||
if (variables instanceof Symbol)
|
||||
(cons (cons variables.v, values), env)
|
||||
else
|
||||
nil
|
||||
|
||||
|
|
@ -107,13 +107,15 @@ update = (id, env, value) ->
|
|||
else
|
||||
nil
|
||||
|
||||
# TODO: Reengineer this with a call to normalize
|
||||
|
||||
astSymbolsToLispSymbols = (node) ->
|
||||
nvalu = (node) -> cadr node
|
||||
return nil if nilp node
|
||||
throw (new LispInterpreterError "Not a list of variable names") if not (ntype(node) is 'list')
|
||||
throw (new LispInterpreterError "Not a list of variable names") if not ((car node) is 'list')
|
||||
handler = (node) ->
|
||||
return nil if nilp node
|
||||
cons (nvalu car node), (handler cdr node)
|
||||
cons (nvalu car node).v, (handler cdr node)
|
||||
handler(nvalu node)
|
||||
|
||||
|
||||
|
|
@ -125,52 +127,54 @@ cadddr = metacadr('cadddr')
|
|||
# favor of normalizeForm (s?) and Symbol extraction
|
||||
|
||||
metadata_evaluation =
|
||||
listp: (node) -> (car node) == 'list'
|
||||
symbolp: (node) -> (car node) == 'symbol'
|
||||
numberp: (node) -> (car node) == 'number'
|
||||
stringp: (node) -> (car node) == 'string'
|
||||
nvalu: (node) -> cadr node
|
||||
listp: (node) -> (car node) == 'list'
|
||||
symbolp: (node) -> (car node) == 'symbol'
|
||||
numberp: (node) -> (car node) == 'number'
|
||||
stringp: (node) -> (car node) == 'string'
|
||||
nvalu: (node) -> cadr node
|
||||
mksymbols: (node) -> astSymbolsToLispSymbols(node)
|
||||
|
||||
straight_evaluation =
|
||||
listp: (node) -> node.__type == 'list'
|
||||
symbolp: (node) -> node instanceof Symbol
|
||||
commentp: (node) -> node instanceof Comment
|
||||
numberp: (node) -> typeof node == 'number'
|
||||
stringp: (node) -> typeof node == 'string'
|
||||
boolp: (node) -> typeof node == 'boolean'
|
||||
nullp: (node) -> node == null
|
||||
vectorp: (node) -> (not straight_evaluation.listp node) and toString.call(node) == '[object Array]'
|
||||
recordp: (node) -> (not node._prototype?) and toSTring.call(node) == '[object Object]'
|
||||
objectp: (node) -> (node._prototype?) and toString.call(node) == '[object Object]'
|
||||
nilp: (node) -> nilp(node)
|
||||
nvalu: (node) -> node
|
||||
listp: (node) -> node.__type == 'list'
|
||||
symbolp: (node) -> node instanceof Symbol
|
||||
commentp: (node) -> node instanceof Comment
|
||||
numberp: (node) -> typeof node == 'number'
|
||||
stringp: (node) -> typeof node == 'string'
|
||||
boolp: (node) -> typeof node == 'boolean'
|
||||
nullp: (node) -> node == null
|
||||
vectorp: (node) -> (not straight_evaluation.listp node) and toString.call(node) == '[object Array]'
|
||||
recordp: (node) -> (not node._prototype?) and toSTring.call(node) == '[object Object]'
|
||||
objectp: (node) -> (node._prototype?) and toString.call(node) == '[object Object]'
|
||||
nilp: (node) -> nilp(node)
|
||||
nvalu: (node) -> node
|
||||
mksymbols: (node) -> node
|
||||
|
||||
makeEvaluator = (ix = straight_evaluation, ty="straight") ->
|
||||
(exp, env) ->
|
||||
console.log("Type:", ty)
|
||||
# Takes an AST node and evaluates it and its contents. A node may be
|
||||
# ("list" (... contents ...)) or ("number" 42) or ("symbol" x), etc.
|
||||
|
||||
if ix.symbolp(exp)
|
||||
return lookup (ix.nvalu exp).v, env
|
||||
else if ([ix.numberp, ix.stringp].filter (i) -> i(exp)).length > 0
|
||||
return exp
|
||||
return ix.nvalu exp
|
||||
else if ix.listp(exp)
|
||||
head = car ix.nvalu exp
|
||||
body = ix.nvalu exp
|
||||
head = car body
|
||||
if ix.symbolp(head)
|
||||
switch (ix.nvalu head).v
|
||||
when "quote" then cdr exp
|
||||
when "quote" then cdr body
|
||||
when "if"
|
||||
unless (evaluate (cadr exp), env) == the_false_value
|
||||
evaluate (caddr exp), env
|
||||
unless (evaluate (cadr body), env) == the_false_value
|
||||
evaluate (caddr body), env
|
||||
else
|
||||
evaluate (cadddr exp), env
|
||||
when "begin" then eprogn (cdr exp), env
|
||||
when "set!" then update (ix.nvalu cadr exp).v, env, (evaluate (caddr exp), env)
|
||||
when "lambda" then make_function (astSymbolsToLispSymbols cadr exp), (cddr exp), env
|
||||
else invoke (evaluate (car exp), env), (evlis (cdr exp), env)
|
||||
evaluate (cadddr body), env
|
||||
when "begin" then eprogn (cdr body), env
|
||||
when "set!" then update (ix.nvalu cadr body).v, env, (evaluate (caddr body), env)
|
||||
when "lambda" then make_function (ix.mksymbols cadr body), (cddr body), env
|
||||
else invoke (evaluate (car body), env), (evlis (cdr body), env)
|
||||
else
|
||||
invoke (evaluate (car exp), env), (evlis (cdr exp), env)
|
||||
invoke (evaluate (car body), env), (evlis (cdr body), env)
|
||||
else
|
||||
throw new LispInterpreterError "Can't handle a #{type}"
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue