[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, {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' {aSymbol, aValue, astObject} = require './astAccessors'
{Symbol} = require './reader_types'
# RICH_AST -> LISP_AST # RICH_AST -> LISP_AST
@ -25,7 +26,7 @@ normalizeForm = (form) ->
'record': (atom) -> listToRecord1(atom) 'record': (atom) -> listToRecord1(atom)
# Basic native types. Meh. # Basic native types. Meh.
'symbol': id 'symbol': (a) -> a.v
'number': id 'number': id
'string': (atom) -> atom 'string': (atom) -> atom
'nil': (atom) -> nil 'nil': (atom) -> nil

View File

@ -7,11 +7,13 @@ class LispInterpreterError extends Error
name: 'LispInterpreterError' name: 'LispInterpreterError'
constructor: (@message) -> constructor: (@message) ->
env_init = nil env_init = nil
env_global = env_init env_global = env_init
ntype = (node) -> car node defpredicate = (name, nativ, arity) ->
nvalu = (node) -> cadr node defprimitive name, ((a, b) -> if nativ.call(null, a, b) then true else the_false_value), arity
definitial = (name, value = nil) -> definitial = (name, value = nil) ->
env_global = (cons (cons name, value), env_global) env_global = (cons (cons name, value), env_global)
@ -25,8 +27,6 @@ defprimitive = (name, nativ, arity) ->
else else
throw (new LispInterpreterError "Incorrect arity")) throw (new LispInterpreterError "Incorrect arity"))
the_false_value = (cons "false", "boolean")
definitial "#t", true definitial "#t", true
definitial "#f", the_false_value definitial "#f", the_false_value
definitial "nil", nil definitial "nil", nil
@ -35,9 +35,6 @@ definitial "bar"
definitial "fib" definitial "fib"
definitial "fact" 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 "cons", cons, 2
defprimitive "car", car, 2 defprimitive "car", car, 2
defprimitive "set-cdr!", setcdr, 2 defprimitive "set-cdr!", setcdr, 2
@ -48,6 +45,33 @@ defprimitive "/", ((a, b) -> a / b), 2
defpredicate "lt", ((a, b) -> a < b), 2 defpredicate "lt", ((a, b) -> a < b), 2
defpredicate "eq?", ((a, b) -> a == b), 2 defpredicate "eq?", ((a, b) -> a == b), 2
the_false_value = (cons "false", "boolean")
cadddr = metacadr('cadddr')
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) -> extend = (env, variables, values) ->
if (pairp variables) if (pairp variables)
if (pairp values) if (pairp values)
@ -121,13 +145,9 @@ astSymbolsToLispSymbols = (node) ->
cons (nvalu car node), (handler cdr node) cons (nvalu car node), (handler cdr node)
handler(nvalu node) handler(nvalu node)
# 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.
cadddr = metacadr('cadddr')
evaluate = (e, env) ->
[type, exp] = [(ntype e), (nvalu e)] [type, exp] = [(ntype e), (nvalu e)]
if type == "symbol" if type == "symbol"
return lookup exp, env return lookup exp, env

View File

@ -1,5 +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"
NEWLINES = ["\n", "\r", "\x0B", "\x0C"] NEWLINES = ["\n", "\r", "\x0B", "\x0C"]
@ -28,17 +29,19 @@ 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)} # (type, value, line, column) -> (node {type, value, line, column)}
makeObj = (type, value, line, column) -> mkObj = (type, value, line, column) ->
list(type, value, line, column) mkNode list type, value, line, column
# msg -> (IO -> Node => Error) # msg -> (IO -> Node => Error)
handleError = (message) -> handleError = (message) ->
(line, column) -> makeObj('error', message, line, column) (line, column) -> mkObj('error', message, line, column)
# IO -> Node => Comment # IO -> Node => Comment
readComment = (inStream) -> readComment = (inStream) ->
@ -47,7 +50,7 @@ readComment = (inStream) ->
inStream.next()).join("") inStream.next()).join("")
if not inStream.done() if not inStream.done()
inStream.next() inStream.next()
makeObj 'comment', r, line, column mkObj 'comment', (new Comment r), line, column
# IO -> (Node => Literal => String) | Error # IO -> (Node => Literal => String) | Error
readString = (inStream) -> readString = (inStream) ->
@ -60,7 +63,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()
makeObj 'string', (string.join ''), line, column mkObj 'string', (string.join ''), line, column
# (String) -> (Node => Literal => Number) | Nothing # (String) -> (Node => Literal => Number) | Nothing
readMaybeNumber = (symbol) -> readMaybeNumber = (symbol) ->
@ -86,8 +89,8 @@ readSymbol = (inStream, tableKeys) ->
inStream.next()).join '' inStream.next()).join ''
number = readMaybeNumber symbol number = readMaybeNumber symbol
if number? if number?
return makeObj 'number', number, line, column return mkObj 'number', number, line, column
makeObj 'symbol', symbol, line, column mkObj 'symbol', (new Symbol symbol), line, column
# (Delim, TypeName) -> IO -> (IO, node) | Error # (Delim, TypeName) -> IO -> (IO, node) | Error
@ -99,7 +102,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 makeObj(type, nil, line, column) return mkObj(type, nil, line, column)
# IO -> (IO, Node) | Error # IO -> (IO, Node) | Error
dotted = false dotted = false
@ -112,12 +115,12 @@ makeReadPair = (delim, type) ->
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 (car obj) == 'error'
if (car obj) == 'symbol' and (car cdr obj) == '.' if (car obj) == 'symbol' and (car cdr obj).v == '.'
dotted = true dotted = true
return readEachPair inStream return readEachPair inStream
cons obj, readEachPair inStream cons obj, readEachPair inStream
ret = makeObj type, readEachPair(inStream), line, column ret = mkObj type, readEachPair(inStream), line, column
inStream.next() inStream.next()
ret ret
@ -130,7 +133,7 @@ prefixReader = (type) ->
[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 (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 # 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
@ -200,7 +203,7 @@ readForms = (inStream) ->
cons obj, readEach inStream cons obj, readEach inStream
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.read = read
exports.readForms = readForms 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 class CatchCont extends Continuation
constructor: (@kont, @body, @env) -> constructor: (@kont, @body, @env) ->
resume: (value) -> resume: (value) ->
console.log(value)
evaluateBegin @body, @env, (new LabeledCont @kont, normalizeForm car value) evaluateBegin @body, @env, (new LabeledCont @kont, normalizeForm car value)
class LabeledCont extends Continuation class LabeledCont extends Continuation