[refactor] Knuckled under and made nodes a Javascript type

This commit is contained in:
Elf M. Sternberg 2015-07-28 16:51:01 -07:00
parent 746f92fcdb
commit 501ac5fe72
8 changed files with 135 additions and 143 deletions

View File

@ -1,8 +1,6 @@
{listToString, listToVector, pairp, cons, car, cdr, caar, cddr, cdar, {listToString, listToVector, pairp, cons, car, cdr, caar, cddr, cdar,
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" {Node} = require "../chapter1/reader_types"
{inspect} = require "util"
{Symbol} = require '../chapter1/reader_types'
class LispInterpreterError extends Error class LispInterpreterError extends Error
name: 'LispInterpreterError' name: 'LispInterpreterError'
@ -59,8 +57,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 (variables instanceof Symbol) if (variables.type == 'symbol')
(cons (cons variables.v, values), env) (cons (cons variables, values), env)
else else
nil nil
@ -119,13 +117,12 @@ update = (id, env, value, callback) ->
# TODO: Reengineer this with a call to normalize # 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 ((car node) is 'list') throw (new LispInterpreterError "Not a list of variable names") if not node.type == 'list'
handler = (node) -> handler = (cell) ->
return nil if nilp node return nil if nilp cell
cons (nvalu car node).v, (handler cdr node) cons (car cell).value, (handler cdr cell)
handler(nvalu node) handler node.value
# 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.
@ -133,39 +130,40 @@ astSymbolsToLispSymbols = (node) ->
cadddr = metacadr('cadddr') cadddr = metacadr('cadddr')
metadata_evaluation = metadata_evaluation =
listp: (node) -> (car node) == 'list' listp: (node) -> node.type == 'list'
symbolp: (node) -> (car node) == 'symbol' symbolp: (node) -> node.type == 'symbol'
numberp: (node) -> (car node) == 'number' numberp: (node) -> node.type == 'number'
stringp: (node) -> (car node) == 'string' stringp: (node) -> node.type == 'string'
nvalu: (node) -> cadr node commentp: (node) -> node.type == 'comment'
mksymbols: astSymbolsToLispSymbols nvalu: (node) -> node.value
mksymbols: (list) -> astSymbolsToLispSymbols(list)
straight_evaluation = straight_evaluation =
listp: (node) -> node.__type == 'list' listp: (cell) -> cell.__type == 'list'
symbolp: (node) -> node instanceof Symbol symbolp: (cell) -> typeof cell == 'string' and cell.length > 0 and cell[0] not in ["\"", ";"]
commentp: (node) -> node instanceof Comment commentp: (cell) -> typeof cell == 'string' and cell.length > 0 and cell[0] == ";"
numberp: (node) -> typeof node == 'number' numberp: (cell) -> typeof cell == 'number'
stringp: (node) -> typeof node == 'string' stringp: (cell) -> typeof cell == 'string' and cell.length > 0 and cell[0] == "\""
boolp: (node) -> typeof node == 'boolean' boolp: (cell) -> typeof cell == 'boolean'
nullp: (node) -> node == null nullp: (cell) -> cell == null
vectorp: (node) -> (not straight_evaluation.listp node) and toString.call(node) == '[object Array]' vectorp: (cell) -> (not straight_evaluation.listp cell) and toString.call(cell) == '[object Array]'
recordp: (node) -> (not node._prototype?) and toSTring.call(node) == '[object Object]' recordp: (cell) -> (not cell._prototype?) and toSTring.call(cell) == '[object Object]'
objectp: (node) -> (node._prototype?) and toString.call(node) == '[object Object]' objectp: (cell) -> (cell._prototype?) and toString.call(cell) == '[object Object]'
nilp: (node) -> nilp(node) nilp: (cell) -> nilp(cell)
nvalu: (node) -> node nvalu: (cell) -> cell
mksymbols: (node) -> node mksymbols: (cell) -> cell
makeEvaluator = (ix = straight_evaluation, ty="straight") -> makeEvaluator = (ix = straight_evaluation, ty="straight") ->
(exp, env, callback) -> (exp, env, callback) ->
if ix.symbolp exp if ix.symbolp exp
return callback lookup (ix.nvalu exp).v, env return callback lookup (ix.nvalu exp), 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 callback ix.nvalu exp return callback ix.nvalu exp
else if ix.listp exp else if ix.listp exp
body = ix.nvalu exp body = ix.nvalu exp
head = car body head = car body
if ix.symbolp head if ix.symbolp head
return switch (ix.nvalu head).v return switch (ix.nvalu head)
when "quote" then callback cdr body when "quote" then callback cdr body
when "if" when "if"
evaluate (cadr body), env, (res) -> evaluate (cadr body), env, (res) ->
@ -174,7 +172,7 @@ makeEvaluator = (ix = straight_evaluation, ty="straight") ->
when "begin" then eprogn (cdr body), env, callback when "begin" then eprogn (cdr body), env, callback
when "set!" when "set!"
evaluate (caddr body), env, (newvalue) -> evaluate (caddr body), env, (newvalue) ->
update (ix.nvalu cadr body).v, env, newvalue, callback update (ix.nvalu cadr body), env, newvalue, callback
when "lambda" when "lambda"
make_function (ix.mksymbols cadr body), (cddr body), env, callback make_function (ix.mksymbols cadr body), (cddr body), env, callback
else else
@ -192,6 +190,6 @@ nodeEval = makeEvaluator(metadata_evaluation, "node")
lispEval = makeEvaluator(straight_evaluation, "lisp") lispEval = makeEvaluator(straight_evaluation, "lisp")
evaluate = (exp, env, cb) -> evaluate = (exp, env, cb) ->
(if exp? and exp.__node then nodeEval else lispEval)(exp, env, cb) (if exp? and (exp instanceof 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

View File

@ -1,11 +1,10 @@
{car, cdr, listp} = require 'cons-lists/lists' {car, cdr, listp} = require 'cons-lists/lists'
{Node, Symbol} = require "./reader_types"
symbol = (form) -> (car form) module.exports = ops =
astObject: (form) -> form instanceof Node
module.exports = aValue: (form) -> form.value
astObject: (form) -> typeof (car form) == "string" aSymbol: (form) -> form.value
aSymbol: symbol isAList: (form) -> ops.astObject(form) and form.type == 'list'
aValue: (form) -> (car cdr form) isARecord: (form) -> ops.astObject(form) and form.type == 'record'
isAList: (form) -> (symbol form) == 'list' isAVector: (form) -> ops.astObject(form) and form.type == 'vector'
isARecord: (form) -> (symbol form) == 'record'
isAVector: (form) -> (symbol form) == 'vector'

View File

@ -1,7 +1,6 @@
{car, cdr, cons, listp, nilp, nil, {car, cdr, cons, listp, nilp, nil,
list, pairp, listToString} = require 'cons-lists/lists' list, pairp, listToString} = require 'cons-lists/lists'
{aSymbol, aValue, astObject} = require './astAccessors' {astObject} = require './astAccessors'
{Symbol} = require './reader_types'
# RICH_AST -> LISP_AST # RICH_AST -> LISP_AST
@ -26,7 +25,7 @@ normalizeForm = (form) ->
'record': (atom) -> listToRecord1(atom) 'record': (atom) -> listToRecord1(atom)
# Basic native types. Meh. # Basic native types. Meh.
'symbol': (a) -> a.v 'symbol': id
'number': id 'number': id
'string': (atom) -> atom 'string': (atom) -> atom
'nil': (atom) -> nil 'nil': (atom) -> nil
@ -37,7 +36,7 @@ normalizeForm = (form) ->
'null': (atom) -> null 'null': (atom) -> null
'undefined': (atom) -> undefined 'undefined': (atom) -> undefined
methods[(car form)](car cdr form) methods[form.type](form.value)
normalizeForms = (forms) -> normalizeForms = (forms) ->

View File

@ -1,8 +1,7 @@
{listToString, listToVector, pairp, cons, car, cdr, caar, cddr, {listToString, listToVector, pairp, cons, car, cdr, caar, cddr,
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" {Node} = require "./reader_types"
{Symbol} = require "./reader_types"
class LispInterpreterError extends Error class LispInterpreterError extends Error
name: 'LispInterpreterError' name: 'LispInterpreterError'
@ -56,8 +55,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 (variables instanceof Symbol) if (variables.type == 'symbol')
(cons (cons variables.v, values), env) (cons (cons variables, values), env)
else else
nil nil
@ -109,15 +108,15 @@ update = (id, env, value) ->
# TODO: Reengineer this with a call to normalize # TODO: Reengineer this with a call to normalize
astSymbolsToLispSymbols = (node) -> tap = (i) -> console.log(i) ; i
nvalu = (node) -> cadr node
return nil if nilp node
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).v, (handler cdr node)
handler(nvalu node)
astSymbolsToLispSymbols = (node) ->
return nil if nilp node
throw (new LispInterpreterError "Not a list of variable names") if not node.type == 'list'
handler = (cell) ->
return nil if nilp cell
cons (car cell).value, (handler cdr cell)
handler node.value
cadddr = metacadr('cadddr') cadddr = metacadr('cadddr')
@ -127,42 +126,42 @@ cadddr = metacadr('cadddr')
# favor of normalizeForm (s?) and Symbol extraction # favor of normalizeForm (s?) and Symbol extraction
metadata_evaluation = metadata_evaluation =
listp: (node) -> (car node) == 'list' listp: (node) -> node.type == 'list'
symbolp: (node) -> (car node) == 'symbol' symbolp: (node) -> node.type == 'symbol'
numberp: (node) -> (car node) == 'number' numberp: (node) -> node.type == 'number'
stringp: (node) -> (car node) == 'string' stringp: (node) -> node.type == 'string'
nvalu: (node) -> cadr node commentp: (node) -> node.type == 'comment'
mksymbols: (node) -> astSymbolsToLispSymbols(node) nvalu: (node) -> node.value
mksymbols: (list) -> astSymbolsToLispSymbols(list)
straight_evaluation = straight_evaluation =
listp: (node) -> node.__type == 'list' listp: (cell) -> cell.__type == 'list'
symbolp: (node) -> node instanceof Symbol symbolp: (cell) -> typeof cell == 'string' and cell.length > 0 and cell[0] not in ["\"", ";"]
commentp: (node) -> node instanceof Comment commentp: (cell) -> typeof cell == 'string' and cell.length > 0 and cell[0] == ";"
numberp: (node) -> typeof node == 'number' numberp: (cell) -> typeof cell == 'number'
stringp: (node) -> typeof node == 'string' stringp: (cell) -> typeof cell == 'string' and cell.length > 0 and cell[0] == "\""
boolp: (node) -> typeof node == 'boolean' boolp: (cell) -> typeof cell == 'boolean'
nullp: (node) -> node == null nullp: (cell) -> cell == null
vectorp: (node) -> (not straight_evaluation.listp node) and toString.call(node) == '[object Array]' vectorp: (cell) -> (not straight_evaluation.listp cell) and toString.call(cell) == '[object Array]'
recordp: (node) -> (not node._prototype?) and toSTring.call(node) == '[object Object]' recordp: (cell) -> (not cell._prototype?) and toSTring.call(cell) == '[object Object]'
objectp: (node) -> (node._prototype?) and toString.call(node) == '[object Object]' objectp: (cell) -> (cell._prototype?) and toString.call(cell) == '[object Object]'
nilp: (node) -> nilp(node) nilp: (cell) -> nilp(cell)
nvalu: (node) -> node nvalu: (cell) -> cell
mksymbols: (node) -> node mksymbols: (cell) -> cell
makeEvaluator = (ix = straight_evaluation, ty="straight") -> makeEvaluator = (ix = straight_evaluation, ty="straight") ->
(exp, env) -> (exp, env) ->
# 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), 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 ix.nvalu exp return ix.nvalu exp
else if ix.listp(exp) else if ix.listp(exp)
body = ix.nvalu exp body = ix.nvalu exp
head = car body head = car body
if ix.symbolp(head) if ix.symbolp(head)
switch (ix.nvalu head).v switch (ix.nvalu head)
when "quote" then cdr body when "quote" then cdr body
when "if" when "if"
unless (evaluate (cadr body), env) == the_false_value unless (evaluate (cadr body), env) == the_false_value
@ -170,18 +169,18 @@ makeEvaluator = (ix = straight_evaluation, ty="straight") ->
else else
evaluate (cadddr body), env evaluate (cadddr body), env
when "begin" then eprogn (cdr body), env when "begin" then eprogn (cdr body), env
when "set!" then update (ix.nvalu cadr body).v, env, (evaluate (caddr body), env) when "set!" then update (ix.nvalu cadr body), env, (evaluate (caddr body), env)
when "lambda" then make_function (ix.mksymbols cadr body), (cddr 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 body), env), (evlis (cdr body), env)
else else
invoke (evaluate (car body), env), (evlis (cdr body), 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 #{exp.type}"
nodeEval = makeEvaluator(metadata_evaluation, "node") nodeEval = makeEvaluator(metadata_evaluation, "node")
lispEval = makeEvaluator(straight_evaluation, "lisp") lispEval = makeEvaluator(straight_evaluation, "lisp")
evaluate = (exp, env) -> evaluate = (exp, env) ->
(if exp? and exp.__node then nodeEval else lispEval)(exp, env) (if exp? and (exp instanceof Node) then nodeEval else lispEval)(exp, env)
module.exports = (c) -> evaluate c, env_global module.exports = (c) -> evaluate c, env_global

View File

@ -1,7 +1,6 @@
{car, cdr, cons, nil, nilp, pairp, vectorToList, list} = require 'cons-lists/lists' {car, cdr, cons, nil, nilp, pairp, vectorToList, list} = require 'cons-lists/lists'
{inspect} = require "util" {inspect} = require "util"
{Symbol, Comment} = require "./reader_types" {Node, Comment} = require "./reader_types"
NEWLINES = ["\n", "\r", "\x0B", "\x0C"] NEWLINES = ["\n", "\r", "\x0B", "\x0C"]
WHITESPACE = [" ", "\t"].concat(NEWLINES) WHITESPACE = [" ", "\t"].concat(NEWLINES)
@ -29,19 +28,13 @@ class Source
done: -> @index > @max done: -> @index > @max
mkNode = (obj) -> Object.defineProperty obj, '__node', {value: true}
# IO -> IO # IO -> IO
skipWS = (inStream) -> skipWS = (inStream) ->
while inStream.peek() in WHITESPACE then inStream.next() while inStream.peek() in WHITESPACE then inStream.next()
# (type, value, line, column) -> (node {type, value, line, column)}
mkObj = (type, value, line, column) ->
mkNode list type, value, line, column
# msg -> (IO -> Node => Error) # msg -> (IO -> Node => Error)
handleError = (message) -> handleError = (message) ->
(line, column) -> mkObj('error', message, line, column) (line, column) -> new Node('error', message, line, column)
# IO -> Node => Comment # IO -> Node => Comment
readComment = (inStream) -> readComment = (inStream) ->
@ -50,7 +43,7 @@ readComment = (inStream) ->
inStream.next()).join("") inStream.next()).join("")
if not inStream.done() if not inStream.done()
inStream.next() inStream.next()
mkObj 'comment', (new Comment r), line, column new Node 'comment', (new Comment r), line, column
# IO -> (Node => Literal => String) | Error # IO -> (Node => Literal => String) | Error
readString = (inStream) -> readString = (inStream) ->
@ -63,7 +56,7 @@ readString = (inStream) ->
if inStream.done() if inStream.done()
return handleError("end of file seen before end of string.")(line, column) return handleError("end of file seen before end of string.")(line, column)
inStream.next() inStream.next()
mkObj 'string', (string.join ''), line, column new Node 'string', (string.join ''), line, column
# (String) -> (Node => Literal => Number) | Nothing # (String) -> (Node => Literal => Number) | Nothing
readMaybeNumber = (symbol) -> readMaybeNumber = (symbol) ->
@ -89,8 +82,8 @@ readSymbol = (inStream, tableKeys) ->
inStream.next()).join '' inStream.next()).join ''
number = readMaybeNumber symbol number = readMaybeNumber symbol
if number? if number?
return mkObj 'number', number, line, column return new Node 'number', number, line, column
mkObj 'symbol', (new Symbol symbol), line, column new Node 'symbol', symbol, line, column
# (Delim, TypeName) -> IO -> (IO, node) | Error # (Delim, TypeName) -> IO -> (IO, node) | Error
@ -102,7 +95,7 @@ makeReadPair = (delim, type) ->
[line, column] = inStream.position() [line, column] = inStream.position()
if inStream.peek() == delim if inStream.peek() == delim
inStream.next() inStream.next()
return mkObj(type, nil, line, column) return new Node type, nil, line, column
# IO -> (IO, Node) | Error # IO -> (IO, Node) | Error
dotted = false dotted = false
@ -114,13 +107,13 @@ makeReadPair = (delim, type) ->
return cons obj, nil return cons obj, nil
if inStream.done() then return handleError("Unexpected end of input")(line, column) if inStream.done() then return handleError("Unexpected end of input")(line, column)
if dotted then return handleError("More than one symbol after dot") if dotted then return handleError("More than one symbol after dot")
return obj if (car obj) == 'error' return obj if obj.type == 'error'
if (car obj) == 'symbol' and (car cdr obj).v == '.' if obj.type == 'symbol' and obj.value == '.'
dotted = true dotted = true
return readEachPair inStream return readEachPair inStream
cons obj, readEachPair inStream cons obj, readEachPair inStream
ret = mkObj type, readEachPair(inStream), line, column ret = new Node type, readEachPair(inStream), line, column
inStream.next() inStream.next()
ret ret
@ -132,8 +125,8 @@ prefixReader = (type) ->
inStream.next() inStream.next()
[line1, column1] = inStream.position() [line1, column1] = inStream.position()
obj = read inStream, true, null, true obj = read inStream, true, null, true
return obj if (car obj) == 'error' return obj if obj.type == 'error'
mkObj "list", cons((mkObj("symbol", type, line1, column1)), cons(obj)), line, column new Node "list", cons((new Node("symbol", type, line1, column1)), cons(obj)), line, column
# I really wanted to make anything more complex than a list (like an # 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 # object or a vector) something handled by a read macro. Maybe in a
@ -180,7 +173,7 @@ read = (inStream, eofErrorP = false, eofError = EOF, recursiveP = false, inReadM
while true while true
form = matcher inStream, c form = matcher inStream, c
skip = (not nilp form) and (car form == 'comment') and not keepComments skip = (not nilp form) and (form.type == 'comment') and not keepComments
break if (not skip and not nilp form) or inStream.done() break if (not skip and not nilp form) or inStream.done()
c = inStream.peek() c = inStream.peek()
null null
@ -199,11 +192,13 @@ readForms = (inStream) ->
readEach = (inStream) -> readEach = (inStream) ->
obj = read inStream, true, null, false obj = read inStream, true, null, false
return nil if (nilp obj) return nil if (nilp obj)
return obj if (car obj) == 'error' return obj if obj.type == 'error'
cons obj, readEach inStream cons obj, readEach inStream
obj = readEach inStream obj = readEach inStream
if (car obj) == 'error' then obj else mkObj "list", obj, line, column if obj.type == 'error' then obj else new Node "list", obj, line, column
exports.read = read exports.read = read
exports.readForms = readForms exports.readForms = readForms
exports.Node = Node
exports.Symbol = Symbol

View File

@ -1,6 +1,8 @@
exports.Symbol = class exports.Node = class
constructor: (@v) -> constructor: (@type, @value, @line, @column) ->
exports.Comment = class exports.Comment = class
constructor: (@text) -> constructor: (@text) ->

View File

@ -2,10 +2,7 @@
cadr, caadr, cadar, caddr, nilp, nil, setcdr, cadr, caadr, cadar, caddr, nilp, nil, setcdr,
metacadr, setcar} = require "cons-lists/lists" metacadr, setcar} = require "cons-lists/lists"
{normalizeForm} = require "../chapter1/astToList" {normalizeForm} = require "../chapter1/astToList"
readline = require "readline" {Node} = require '../chapter1/reader_types'
{Symbol} = require '../chapter1/reader_types'
{inspect} = require "util"
minspect = (obj) -> inspect obj, false, null, true
class LispInterpreterError extends Error class LispInterpreterError extends Error
name: 'LispInterpreterError' name: 'LispInterpreterError'
@ -13,6 +10,9 @@ class LispInterpreterError extends Error
the_false_value = (cons "false", "boolean") the_false_value = (cons "false", "boolean")
# Base class that represents a value. Base class representing a LiSP
# value, a primitive, or a function
class Value class Value
# Represents the base class of a continuation. Calls to invoke resume # Represents the base class of a continuation. Calls to invoke resume
@ -302,7 +302,6 @@ class Primitive extends Value
invoke: (args, env, kont) -> invoke: (args, env, kont) ->
@nativ.apply null, [args, env, kont] @nativ.apply null, [args, env, kont]
env_init = new NullEnv() env_init = new NullEnv()
definitial = (name, value = nil) -> definitial = (name, value = nil) ->
@ -372,52 +371,52 @@ definitial "list", new Primitive "list", (values, env, kont) ->
# Only called in rich node mode... # Only called in rich node mode...
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 ((car node) is 'list') throw (new LispInterpreterError "Not a list of variable names") if not node.type == 'list'
handler = (node) -> handler = (cell) ->
return nil if nilp node return nil if nilp cell
cons (nvalu car node).v, (handler cdr node) cons (car cell).value, (handler cdr cell)
handler(nvalu node) handler node.value
metadata_evaluation = metadata_evaluation =
listp: (node) -> (car node) == 'list' listp: (node) -> node.type == 'list'
symbolp: (node) -> (car node) == 'symbol' symbolp: (node) -> node.type == 'symbol'
numberp: (node) -> (car node) == 'number' numberp: (node) -> node.type == 'number'
stringp: (node) -> (car node) == 'string' stringp: (node) -> node.type == 'string'
nvalu: (node) -> cadr node commentp: (node) -> node.type == 'comment'
mksymbols: astSymbolsToLispSymbols nvalu: (node) -> node.value
mksymbols: (list) -> astSymbolsToLispSymbols(list)
straight_evaluation = straight_evaluation =
listp: (node) -> node.__type == 'list' listp: (cell) -> cell.__type == 'list'
symbolp: (node) -> node instanceof Symbol symbolp: (cell) -> typeof cell == 'string' and cell.length > 0 and cell[0] not in ["\"", ";"]
commentp: (node) -> node instanceof Comment commentp: (cell) -> typeof cell == 'string' and cell.length > 0 and cell[0] == ";"
numberp: (node) -> typeof node == 'number' numberp: (cell) -> typeof cell == 'number'
stringp: (node) -> typeof node == 'string' stringp: (cell) -> typeof cell == 'string' and cell.length > 0 and cell[0] == "\""
boolp: (node) -> typeof node == 'boolean' boolp: (cell) -> typeof cell == 'boolean'
nullp: (node) -> node == null nullp: (cell) -> cell == null
vectorp: (node) -> (not straight_evaluation.listp node) and toString.call(node) == '[object Array]' vectorp: (cell) -> (not straight_evaluation.listp cell) and toString.call(cell) == '[object Array]'
recordp: (node) -> (not node._prototype?) and toSTring.call(node) == '[object Object]' recordp: (cell) -> (not cell._prototype?) and toSTring.call(cell) == '[object Object]'
objectp: (node) -> (node._prototype?) and toString.call(node) == '[object Object]' objectp: (cell) -> (cell._prototype?) and toString.call(cell) == '[object Object]'
nilp: (node) -> nilp(node) nilp: (cell) -> nilp(cell)
nvalu: (node) -> node nvalu: (cell) -> cell
mksymbols: (node) -> node mksymbols: (cell) -> cell
makeEvaluator = (ix = straight_evaluation, ty="straight") -> makeEvaluator = (ix = straight_evaluation, ty="straight") ->
(exp, env, kont) -> (exp, env, kont) ->
if ix.symbolp exp if ix.symbolp exp
return evaluateVariable (ix.nvalu exp).v, env, kont return evaluateVariable (ix.nvalu exp), env, kont
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 kont.resume ix.nvalu exp return kont.resume ix.nvalu exp
else if ix.listp exp else if ix.listp exp
body = ix.nvalu exp body = ix.nvalu exp
head = car body head = car body
if ix.symbolp head if ix.symbolp head
switch (ix.nvalu head).v switch (ix.nvalu head)
when "quote" then evaluateQuote (cdr body), env, kont when "quote" then evaluateQuote (cdr body), env, kont
when "if" then evaluateIf (cdr body), env, kont when "if" then evaluateIf (cdr body), env, kont
when "begin" then evaluateBegin (cdr body), env, kont when "begin" then evaluateBegin (cdr body), env, kont
when "set!" then evaluateSet (ix.nvalu cadr body).v, (caddr body), env, kont when "set!" then evaluateSet (ix.nvalu cadr body), (caddr body), env, kont
when "lambda" then evaluateLambda (ix.mksymbols cadr body), (cddr body), env, kont when "lambda" then evaluateLambda (ix.mksymbols cadr body), (cddr body), env, kont
when "block" then evaluateBlock (ix.nvalu cadr body), (cddr body), env, kont when "block" then evaluateBlock (ix.nvalu cadr body), (cddr body), env, kont
when "return-from" then evaluateReturnFrom (ix.nvalu cadr body), (caddr body), env, kont when "return-from" then evaluateReturnFrom (ix.nvalu cadr body), (caddr body), env, kont
@ -434,7 +433,7 @@ nodeEval = makeEvaluator(metadata_evaluation, "node")
lispEval = makeEvaluator(straight_evaluation, "lisp") lispEval = makeEvaluator(straight_evaluation, "lisp")
evaluate = (exp, env, kont) -> evaluate = (exp, env, kont) ->
(if exp? and exp.__node then nodeEval else lispEval)(exp, env, kont) (if exp? and (exp instanceof Node) then nodeEval else lispEval)(exp, env, kont)
interpreter = (ast, kont) -> interpreter = (ast, kont) ->
evaluate ast, env_init, new BottomCont null, kont evaluate ast, env_init, new BottomCont null, kont

View File

@ -24,6 +24,7 @@ describe "Core reader functions", ->
['[]', []] ['[]', []]
['{}', {}] ['{}', {}]
['[1 2 3]', [1, 2, 3]] ['[1 2 3]', [1, 2, 3]]
# ['(1 2 3', 'error']
['{foo "bar"}', {foo: "bar"}] ['{foo "bar"}', {foo: "bar"}]
] ]