[refactor] Custom reader types have unique Javascript equivalents now.

This commit is contained in:
Elf M. Sternberg 2015-07-24 07:44:04 -07:00
parent bb0c06b073
commit 5bba101ee2
5 changed files with 150 additions and 121 deletions

View File

@ -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

View File

@ -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)
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
invoke (evaluate (car exp), env), (evlis (cdr exp), env)
else
throw new LispInterpreterError "Can't handle a #{type}"
throw new LispInterpreterError "Can't handle a #{type}"
module.exports = (c) -> evaluate c, env_global

View File

@ -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

View File

@ -0,0 +1,6 @@
exports.Symbol = class
constructor: (@v) ->
exports.Comment = class
constructor: (@text) ->

View File

@ -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