[refactor] Knuckled under and made nodes a Javascript type
This commit is contained in:
parent
746f92fcdb
commit
501ac5fe72
|
@ -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
|
||||||
|
|
|
@ -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'
|
|
||||||
|
|
|
@ -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) ->
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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) ->
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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"}]
|
||||||
]
|
]
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue