From 5bba101ee225681fdeedf4f18ebde60a6a3ae257 Mon Sep 17 00:00:00 2001 From: "Elf M. Sternberg" Date: Fri, 24 Jul 2015 07:44:04 -0700 Subject: [PATCH] [refactor] Custom reader types have unique Javascript equivalents now. --- chapter1/astToList.coffee | 3 +- chapter1/interpreter.coffee | 234 +++++++++++++++++++---------------- chapter1/reader.coffee | 27 ++-- chapter1/reader_types.coffee | 6 + chapter3/interpreter.coffee | 1 - 5 files changed, 150 insertions(+), 121 deletions(-) create mode 100644 chapter1/reader_types.coffee diff --git a/chapter1/astToList.coffee b/chapter1/astToList.coffee index 9348bbb..bfdd540 100644 --- a/chapter1/astToList.coffee +++ b/chapter1/astToList.coffee @@ -1,6 +1,7 @@ {car, cdr, cons, listp, nilp, nil, list, pairp, listToString} = require 'cons-lists/lists' {aSymbol, aValue, astObject} = require './astAccessors' +{Symbol} = require './reader_types' # RICH_AST -> LISP_AST @@ -25,7 +26,7 @@ normalizeForm = (form) -> 'record': (atom) -> listToRecord1(atom) # Basic native types. Meh. - 'symbol': id + 'symbol': (a) -> a.v 'number': id 'string': (atom) -> atom 'nil': (atom) -> nil diff --git a/chapter1/interpreter.coffee b/chapter1/interpreter.coffee index 6b5de89..9600174 100644 --- a/chapter1/interpreter.coffee +++ b/chapter1/interpreter.coffee @@ -7,11 +7,13 @@ class LispInterpreterError extends Error name: 'LispInterpreterError' constructor: (@message) -> + env_init = nil env_global = env_init -ntype = (node) -> car node -nvalu = (node) -> cadr node +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) -> env_global = (cons (cons name, value), env_global) @@ -25,8 +27,6 @@ defprimitive = (name, nativ, arity) -> else throw (new LispInterpreterError "Incorrect arity")) -the_false_value = (cons "false", "boolean") - definitial "#t", true definitial "#f", the_false_value definitial "nil", nil @@ -35,9 +35,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,108 +45,131 @@ defprimitive "/", ((a, b) -> a / b), 2 defpredicate "lt", ((a, b) -> a < b), 2 defpredicate "eq?", ((a, b) -> a == b), 2 -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 - -# 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 -# ("list" (... contents ...)) or ("number" 42) or ("symbol" x), etc. +the_false_value = (cons "false", "boolean") cadddr = metacadr('cadddr') -evaluate = (e, env) -> - [type, exp] = [(ntype e), (nvalu e)] - if type == "symbol" - return lookup exp, env - else if type in ["number", "string", "boolean", "vector"] - return exp - else if type == "list" - head = car exp - if (ntype head) == 'symbol' - switch (nvalu head) - when "quote" then cdr exp - when "if" - unless (evaluate (cadr exp), env) == the_false_value - evaluate (caddr exp), env - else - evaluate (cadddr exp), env - when "begin" then eprogn (cdr exp), env - when "set!" then update (nvalu cadr exp), 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) - else - invoke (evaluate (car exp), env), (evlis (cdr exp), env) - 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 +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 listp node) and toString.call(node) == '[object Array]' + recordp: (node) -> (not x._prototype?) and toSTring.call(node) == '[object Object]') + objectp: (node) -> (x._prototype?) and toString.call(node) == '[object Object]') + nilp: (node) -> node == nilp + nvalu: (node) -> node + +makeEvaluator = (ix = straight_evaluation) -> + (exp, env) -> + 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 + + # 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 + # ("list" (... contents ...)) or ("number" 42) or ("symbol" x), etc. + + [type, exp] = [(ntype e), (nvalu e)] + if type == "symbol" + return lookup exp, env + else if type in ["number", "string", "boolean", "vector"] + return exp + else if type == "list" + head = car exp + if (ntype head) == 'symbol' + switch (nvalu head) + when "quote" then cdr exp + when "if" + unless (evaluate (cadr exp), env) == the_false_value + evaluate (caddr exp), env + else + evaluate (cadddr exp), env + when "begin" then eprogn (cdr exp), env + when "set!" then update (nvalu cadr exp), 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) + else + invoke (evaluate (car exp), env), (evlis (cdr exp), env) + else + throw new LispInterpreterError "Can't handle a #{type}" + module.exports = (c) -> evaluate c, env_global diff --git a/chapter1/reader.coffee b/chapter1/reader.coffee index b4be16e..8b2bf24 100644 --- a/chapter1/reader.coffee +++ b/chapter1/reader.coffee @@ -1,5 +1,6 @@ {car, cdr, cons, nil, nilp, pairp, vectorToList, list} = require 'cons-lists/lists' {inspect} = require "util" +{Symbol, Comment} = require "./reader_types" NEWLINES = ["\n", "\r", "\x0B", "\x0C"] @@ -28,17 +29,19 @@ class Source done: -> @index > @max +mkNode = (obj) -> Object.defineProperty obj, '__node', {value: true} + # IO -> IO skipWS = (inStream) -> while inStream.peek() in WHITESPACE then inStream.next() # (type, value, line, column) -> (node {type, value, line, column)} -makeObj = (type, value, line, column) -> - list(type, value, line, column) +mkObj = (type, value, line, column) -> + mkNode list type, value, line, column # msg -> (IO -> Node => Error) handleError = (message) -> - (line, column) -> makeObj('error', message, line, column) + (line, column) -> mkObj('error', message, line, column) # IO -> Node => Comment readComment = (inStream) -> @@ -47,7 +50,7 @@ readComment = (inStream) -> inStream.next()).join("") if not inStream.done() inStream.next() - makeObj 'comment', r, line, column + mkObj 'comment', (new Comment r), line, column # IO -> (Node => Literal => String) | Error readString = (inStream) -> @@ -60,7 +63,7 @@ readString = (inStream) -> if inStream.done() return handleError("end of file seen before end of string.")(line, column) inStream.next() - makeObj 'string', (string.join ''), line, column + mkObj 'string', (string.join ''), line, column # (String) -> (Node => Literal => Number) | Nothing readMaybeNumber = (symbol) -> @@ -86,8 +89,8 @@ readSymbol = (inStream, tableKeys) -> inStream.next()).join '' number = readMaybeNumber symbol if number? - return makeObj 'number', number, line, column - makeObj 'symbol', symbol, line, column + return mkObj 'number', number, line, column + mkObj 'symbol', (new Symbol symbol), line, column # (Delim, TypeName) -> IO -> (IO, node) | Error @@ -99,7 +102,7 @@ makeReadPair = (delim, type) -> [line, column] = inStream.position() if inStream.peek() == delim inStream.next() - return makeObj(type, nil, line, column) + return mkObj(type, nil, line, column) # IO -> (IO, Node) | Error dotted = false @@ -112,12 +115,12 @@ makeReadPair = (delim, type) -> if inStream.done() then return handleError("Unexpected end of input")(line, column) if dotted then return handleError("More than one symbol after dot") return obj if (car obj) == 'error' - if (car obj) == 'symbol' and (car cdr obj) == '.' + if (car obj) == 'symbol' and (car cdr obj).v == '.' dotted = true return readEachPair inStream cons obj, readEachPair inStream - ret = makeObj type, readEachPair(inStream), line, column + ret = mkObj type, readEachPair(inStream), line, column inStream.next() ret @@ -130,7 +133,7 @@ prefixReader = (type) -> [line1, column1] = inStream.position() obj = read inStream, true, null, true return obj if (car obj) == 'error' - makeObj "list", cons((makeObj("symbol", type, line1, column1)), cons(obj)), line, column + mkObj "list", cons((mkObj("symbol", type, line1, column1)), cons(obj)), line, column # I really wanted to make anything more complex than a list (like an # object or a vector) something handled by a read macro. Maybe in a @@ -200,7 +203,7 @@ readForms = (inStream) -> cons obj, readEach inStream obj = readEach inStream - if (car obj) == 'error' then obj else makeObj "list", obj, line, column + if (car obj) == 'error' then obj else mkObj "list", obj, line, column exports.read = read exports.readForms = readForms diff --git a/chapter1/reader_types.coffee b/chapter1/reader_types.coffee new file mode 100644 index 0000000..16f6696 --- /dev/null +++ b/chapter1/reader_types.coffee @@ -0,0 +1,6 @@ +exports.Symbol = class + constructor: (@v) -> + +exports.Comment = class + constructor: (@text) -> + diff --git a/chapter3/interpreter.coffee b/chapter3/interpreter.coffee index d5d3469..d88ad58 100644 --- a/chapter3/interpreter.coffee +++ b/chapter3/interpreter.coffee @@ -264,7 +264,6 @@ evaluateCatch = (tag, body, env, kont) -> class CatchCont extends Continuation constructor: (@kont, @body, @env) -> resume: (value) -> - console.log(value) evaluateBegin @body, @env, (new LabeledCont @kont, normalizeForm car value) class LabeledCont extends Continuation