[refactor] Struggling to get self-evaluating components working.

This commit is contained in:
Elf M. Sternberg 2015-07-26 14:59:49 -07:00
parent 5bba101ee2
commit 02f79c4255
2 changed files with 105 additions and 97 deletions

View File

@ -24,7 +24,7 @@ test: clean node_modules
--reporter mocha-jenkins-reporter --compilers coffee:coffee-script/register || true --reporter mocha-jenkins-reporter --compilers coffee:coffee-script/register || true
ltest: node_modules ltest: node_modules
@node_modules/.bin/mocha --compilers coffee:coffee-script/register node_modules/.bin/mocha --compilers coffee:coffee-script/register
watch: watch:
while inotifywait $(SOURCES) ; do make test; done while inotifywait $(SOURCES) ; do make test; done

View File

@ -2,19 +2,15 @@
cdar, cadr, caadr, cadar, caddr, nilp, nil, setcdr, metacadr} = require "cons-lists/lists" cdar, 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 "./reader_types"
class LispInterpreterError extends Error class LispInterpreterError extends Error
name: 'LispInterpreterError' name: 'LispInterpreterError'
constructor: (@message) -> constructor: (@message, position = null) ->
env_init = nil env_init = nil
env_global = env_init env_global = env_init
defpredicate = (name, nativ, arity) ->
defprimitive name, ((a, b) -> if nativ.call(null, a, b) then true else the_false_value), arity
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
@ -27,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
definitial "#t", true definitial "#t", true
definitial "#f", the_false_value definitial "#f", the_false_value
definitial "nil", nil definitial "nil", nil
@ -47,8 +46,84 @@ defpredicate "eq?", ((a, b) -> a == b), 2
the_false_value = (cons "false", "boolean") the_false_value = (cons "false", "boolean")
extend = (env, variables, values) ->
if (pairp variables)
if (pairp values)
(cons (cons (car variables), (car values)),
(extend env, (cdr variables), (cdr values)))
else
throw new LispInterpreterError "Too few 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)
else
nil
make_function = (variables, body, env) ->
(values) -> eprogn body, (extend env, variables, values)
invoke = (fn, args) ->
(fn args)
# Takes a list of nodes and calls evaluate on each one, returning the
# 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) ->
if (pairp exps)
if pairp (cdr exps)
evaluate (car exps), env
eprogn (cdr exps), env
else
evaluate (car exps), env
else
nil
evlis = (exps, env) ->
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
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')
handler = (node) ->
return nil if nilp node
cons (nvalu car node), (handler cdr node)
handler(nvalu node)
cadddr = metacadr('cadddr') cadddr = metacadr('cadddr')
# This is really the only thing that changes behavior between "reader
# nodes" (nodes loaded with debugging metadata) and a standard cons
# object. TODO: astSymbolsToLispSymbols should be deprecated in
# favor of normalizeForm (s?) and Symbol extraction
metadata_evaluation = metadata_evaluation =
listp: (node) -> (car node) == 'list' listp: (node) -> (car node) == 'list'
symbolp: (node) -> (car node) == 'symbol' symbolp: (node) -> (car node) == 'symbol'
@ -58,105 +133,32 @@ metadata_evaluation =
straight_evaluation = straight_evaluation =
listp: (node) -> node.__type == 'list' listp: (node) -> node.__type == 'list'
symbolp: (node) -> node instanceOf Symbol symbolp: (node) -> node instanceof Symbol
commentp: (node) -> node instanceOf Comment commentp: (node) -> node instanceof Comment
numberp: (node) -> typeof node == 'number' numberp: (node) -> typeof node == 'number'
stringp: (node) -> typeof node == 'string' stringp: (node) -> typeof node == 'string'
boolp: (node) -> typeof node == 'boolean' boolp: (node) -> typeof node == 'boolean'
nullp: (node) -> node == null nullp: (node) -> node == null
vectorp: (node) -> (not listp node) and toString.call(node) == '[object Array]' vectorp: (node) -> (not straight_evaluation.listp node) and toString.call(node) == '[object Array]'
recordp: (node) -> (not x._prototype?) and toSTring.call(node) == '[object Object]') recordp: (node) -> (not node._prototype?) and toSTring.call(node) == '[object Object]'
objectp: (node) -> (x._prototype?) and toString.call(node) == '[object Object]') objectp: (node) -> (node._prototype?) and toString.call(node) == '[object Object]'
nilp: (node) -> node == nilp nilp: (node) -> nilp(node)
nvalu: (node) -> node nvalu: (node) -> node
makeEvaluator = (ix = straight_evaluation) -> makeEvaluator = (ix = straight_evaluation, ty="straight") ->
(exp, env) -> (exp, env) ->
extend = (env, variables, values) -> console.log("Type:", ty)
if (pairp variables)
if (pairp values)
(cons (cons (car variables), (car values)),
(extend env, (cdr variables), (cdr values)))
else
throw new LispInterpreterError "Too few 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)
else
nil
make_function = (variables, body, env) ->
(values) -> eprogn body, (extend env, variables, values)
invoke = (fn, args) ->
(fn args)
# Takes a list of nodes and calls evaluate on each one, returning the
# 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) ->
if (pairp exps)
if pairp (cdr exps)
evaluate (car exps), env
eprogn (cdr exps), env
else
evaluate (car exps), env
else
nil
evlis = (exps, env) ->
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 (new LispInterpreterError "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 # 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.
[type, exp] = [(ntype e), (nvalu e)] if ix.symbolp(exp)
if type == "symbol" return lookup (ix.nvalu exp).v, env
return lookup exp, env else if ([ix.numberp, ix.stringp].filter (i) -> i(exp)).length > 0
else if type in ["number", "string", "boolean", "vector"]
return exp return exp
else if type == "list" else if ix.listp(exp)
head = car exp head = car ix.nvalu exp
if (ntype head) == 'symbol' if ix.symbolp(head)
switch (nvalu head) switch (ix.nvalu head).v
when "quote" then cdr exp when "quote" then cdr exp
when "if" when "if"
unless (evaluate (cadr exp), env) == the_false_value unless (evaluate (cadr exp), env) == the_false_value
@ -164,7 +166,7 @@ makeEvaluator = (ix = straight_evaluation) ->
else else
evaluate (cadddr exp), env evaluate (cadddr exp), env
when "begin" then eprogn (cdr exp), env when "begin" then eprogn (cdr exp), env
when "set!" then update (nvalu cadr exp), env, (evaluate (caddr 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 when "lambda" then make_function (astSymbolsToLispSymbols cadr exp), (cddr exp), env
else invoke (evaluate (car exp), env), (evlis (cdr exp), env) else invoke (evaluate (car exp), env), (evlis (cdr exp), env)
else else
@ -172,4 +174,10 @@ makeEvaluator = (ix = straight_evaluation) ->
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) ->
(if exp? and exp.__node then nodeEval else lispEval)(exp, env)
module.exports = (c) -> evaluate c, env_global module.exports = (c) -> evaluate c, env_global