From 5d9703aa33d43ea697b02c71119a52f684d47d65 Mon Sep 17 00:00:00 2001 From: "Elf M. Sternberg" Date: Mon, 27 Jul 2015 21:27:21 -0700 Subject: [PATCH] [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. --- chapter-lambda-1/interpreter.coffee | 119 ++++++++++++++++++---------- chapter1/interpreter.coffee | 74 +++++++++-------- 2 files changed, 114 insertions(+), 79 deletions(-) diff --git a/chapter-lambda-1/interpreter.coffee b/chapter-lambda-1/interpreter.coffee index a463cb2..cffd91f 100644 --- a/chapter-lambda-1/interpreter.coffee +++ b/chapter-lambda-1/interpreter.coffee @@ -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 - else - evaluate (car exp), env, (fn) -> - evlis (cdr exp), env, (args) -> - invoke fn, args, callback - else - throw new LispInterpreterError ("Can't handle a #{type}") +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 + 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 diff --git a/chapter1/interpreter.coffee b/chapter1/interpreter.coffee index 480aa17..c36d225 100644 --- a/chapter1/interpreter.coffee +++ b/chapter1/interpreter.coffee @@ -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}"