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

[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:
Elf M. Sternberg 2015-07-27 21:27:21 -07:00
parent 02f79c4255
commit 5d9703aa33
2 changed files with 114 additions and 79 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

99
chapter-lambda-1/interpreter.coffee
View File

@ -2,6 +2,7 @@
cadr, caadr, cadar, caddr, nilp, nil, setcdr, metacadr} = require "cons-lists/lists" cadr, caadr, cadar, caddr, nilp, nil, setcdr, metacadr} = require "cons-lists/lists"
readline = require "readline" readline = require "readline"
{inspect} = require "util" {inspect} = require "util"
{Symbol} = require '../chapter1/reader_types'
class LispInterpreterError extends Error class LispInterpreterError extends Error
name: 'LispInterpreterError' name: 'LispInterpreterError'
@ -10,9 +11,6 @@ class LispInterpreterError extends Error
env_init = nil env_init = nil
env_global = env_init 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_global = (cons (cons name, value), env_global)
name name
@ -25,6 +23,9 @@ defprimitive = (name, nativ, arity) ->
else 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
the_false_value = (cons "false", "boolean") the_false_value = (cons "false", "boolean")
definitial "#t", true definitial "#t", true
@ -35,9 +36,6 @@ definitial "bar"
definitial "fib" definitial "fib"
definitial "fact" 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 "cons", cons, 2
defprimitive "car", car, 2 defprimitive "car", car, 2
defprimitive "set-cdr!", setcdr, 2 defprimitive "set-cdr!", setcdr, 2
@ -48,6 +46,9 @@ defprimitive "/", ((a, b) -> a / b), 2
defpredicate "lt", ((a, b) -> a < b), 2 defpredicate "lt", ((a, b) -> a < b), 2
defpredicate "eq?", ((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) -> extend = (env, variables, values) ->
if (pairp variables) if (pairp variables)
if (pairp values) if (pairp values)
@ -58,8 +59,8 @@ extend = (env, variables, values) ->
else if (nilp variables) else if (nilp variables)
if (nilp values) then env else throw new LispInterpreterError "Too many values" if (nilp values) then env else throw new LispInterpreterError "Too many values"
else else
if (symbolp variables) if (variables instanceof Symbol)
(cons (cons variables, values), env) (cons (cons variables.v, values), env)
else else
nil nil
@ -115,52 +116,82 @@ update = (id, env, value, callback) ->
# interpreter core. I can't help but think that this design precludes # interpreter core. I can't help but think that this design precludes
# pluggable interpreter core. # pluggable interpreter core.
# TODO: Reengineer this with a call to normalize
astSymbolsToLispSymbols = (node) -> astSymbolsToLispSymbols = (node) ->
nvalu = (node) -> cadr node
return nil if nilp 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) -> handler = (node) ->
return nil if nilp node return nil if nilp node
cons (nvalu car node), (handler cdr node) cons (nvalu car node).v, (handler cdr node)
handler(nvalu node) handler(nvalu node)
# Takes an AST node and evaluates it and its contents. A node may be # Takes an AST node and evaluates it and its contents. A node may be
# ("list" (... contents ...)) or ("number" 42) or ("symbol" x), etc. # ("list" (... contents ...)) or ("number" 42) or ("symbol" x), etc.
cadddr = metacadr('cadddr') cadddr = metacadr('cadddr')
evaluate = (e, env, callback) -> metadata_evaluation =
[type, exp] = [(ntype e), (nvalu e)] listp: (node) -> (car node) == 'list'
if type == "symbol" symbolp: (node) -> (car node) == 'symbol'
return callback lookup exp, env numberp: (node) -> (car node) == 'number'
else if type in ["number", "string", "boolean", "vector"] stringp: (node) -> (car node) == 'string'
return callback exp nvalu: (node) -> cadr node
else if type == "list" mksymbols: astSymbolsToLispSymbols
head = car exp
if (ntype head) == 'symbol' straight_evaluation =
return switch (nvalu head) listp: (node) -> node.__type == 'list'
when "quote" symbolp: (node) -> node instanceof Symbol
callback cdr exp 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" when "if"
evaluate (cadr exp), env, (res) -> evaluate (cadr body), env, (res) ->
w = unless res == the_false_value then caddr else cadddr w = unless res == the_false_value then caddr else cadddr
evaluate (w exp), env, callback evaluate (w body), env, callback
when "begin" when "begin" then eprogn (cdr body), env, callback
eprogn (cdr exp), env, callback
when "set!" when "set!"
evaluate (caddr exp), env, (newvalue) -> evaluate (caddr body), env, (newvalue) ->
update (nvalu cadr exp), env, newvalue, callback update (ix.nvalu cadr body).v, env, newvalue, callback
when "lambda" when "lambda"
make_function (astSymbolsToLispSymbols cadr exp), (cddr exp), env, callback make_function (ix.mksymbols cadr body), (cddr body), env, callback
else else
evaluate (car exp), env, (fn) -> evaluate (car body), env, (fn) ->
evlis (cdr exp), env, (args) -> evlis (cdr body), env, (args) ->
invoke fn, args, callback invoke fn, args, callback
else else
evaluate (car exp), env, (fn) -> evaluate (car body), env, (fn) ->
evlis (cdr exp), env, (args) -> evlis (cdr body), env, (args) ->
invoke fn, args, callback invoke fn, args, callback
else 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 module.exports = (c, cb) -> evaluate c, env_global, cb

40
chapter1/interpreter.coffee
View File

@ -26,6 +26,8 @@ defprimitive = (name, nativ, arity) ->
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
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
@ -44,8 +46,6 @@ defprimitive "/", ((a, b) -> a / b), 2
defpredicate "lt", ((a, b) -> a < b), 2 defpredicate "lt", ((a, b) -> a < b), 2
defpredicate "eq?", ((a, b) -> a == b), 2 defpredicate "eq?", ((a, b) -> a == b), 2
the_false_value = (cons "false", "boolean")
extend = (env, variables, values) -> extend = (env, variables, values) ->
if (pairp variables) if (pairp variables)
if (pairp values) if (pairp values)
@ -56,8 +56,8 @@ extend = (env, variables, values) ->
else if (nilp variables) else if (nilp variables)
if (nilp values) then env else throw new LispInterpreterError "Too many values" if (nilp values) then env else throw new LispInterpreterError "Too many values"
else else
if (symbolp variables) if (variables instanceof Symbol)
(cons (cons variables, values), env) (cons (cons variables.v, values), env)
else else
nil nil
@ -107,13 +107,15 @@ update = (id, env, value) ->
else else
nil nil
# TODO: Reengineer this with a call to normalize
astSymbolsToLispSymbols = (node) -> astSymbolsToLispSymbols = (node) ->
nvalu = (node) -> cadr node nvalu = (node) -> cadr node
return nil if nilp 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) -> handler = (node) ->
return nil if nilp node return nil if nilp node
cons (nvalu car node), (handler cdr node) cons (nvalu car node).v, (handler cdr node)
handler(nvalu node) handler(nvalu node)
@ -130,6 +132,7 @@ metadata_evaluation =
numberp: (node) -> (car node) == 'number' numberp: (node) -> (car node) == 'number'
stringp: (node) -> (car node) == 'string' stringp: (node) -> (car node) == 'string'
nvalu: (node) -> cadr node nvalu: (node) -> cadr node
mksymbols: (node) -> astSymbolsToLispSymbols(node)
straight_evaluation = straight_evaluation =
listp: (node) -> node.__type == 'list' listp: (node) -> node.__type == 'list'
@ -144,33 +147,34 @@ straight_evaluation =
objectp: (node) -> (node._prototype?) and toString.call(node) == '[object Object]' objectp: (node) -> (node._prototype?) and toString.call(node) == '[object Object]'
nilp: (node) -> nilp(node) nilp: (node) -> nilp(node)
nvalu: (node) -> node nvalu: (node) -> node
mksymbols: (node) -> node
makeEvaluator = (ix = straight_evaluation, ty="straight") -> makeEvaluator = (ix = straight_evaluation, ty="straight") ->
(exp, env) -> (exp, env) ->
console.log("Type:", ty)
# Takes an AST node and evaluates it and its contents. A node may be # Takes an AST node and evaluates it and its contents. A node may be
# ("list" (... contents ...)) or ("number" 42) or ("symbol" x), etc. # ("list" (... contents ...)) or ("number" 42) or ("symbol" x), etc.
if ix.symbolp(exp) if ix.symbolp(exp)
return lookup (ix.nvalu exp).v, env return lookup (ix.nvalu exp).v, env
else if ([ix.numberp, ix.stringp].filter (i) -> i(exp)).length > 0 else if ([ix.numberp, ix.stringp].filter (i) -> i(exp)).length > 0
return exp return ix.nvalu exp
else if ix.listp(exp) else if ix.listp(exp)
head = car ix.nvalu exp body = ix.nvalu exp
head = car body
if ix.symbolp(head) if ix.symbolp(head)
switch (ix.nvalu head).v switch (ix.nvalu head).v
when "quote" then cdr exp when "quote" then cdr body
when "if" when "if"
unless (evaluate (cadr exp), env) == the_false_value unless (evaluate (cadr body), env) == the_false_value
evaluate (caddr exp), env evaluate (caddr body), env
else else
evaluate (cadddr exp), env evaluate (cadddr body), env
when "begin" then eprogn (cdr exp), env when "begin" then eprogn (cdr body), env
when "set!" then update (ix.nvalu cadr exp).v, env, (evaluate (caddr exp), env) when "set!" then update (ix.nvalu cadr body).v, env, (evaluate (caddr body), env)
when "lambda" then make_function (astSymbolsToLispSymbols cadr exp), (cddr exp), env when "lambda" then make_function (ix.mksymbols cadr body), (cddr body), env
else invoke (evaluate (car exp), env), (evlis (cdr exp), env) else invoke (evaluate (car body), env), (evlis (cdr body), env)
else else
invoke (evaluate (car exp), env), (evlis (cdr exp), env) invoke (evaluate (car body), env), (evlis (cdr body), env)
else else
throw new LispInterpreterError "Can't handle a #{type}" throw new LispInterpreterError "Can't handle a #{type}"