elf
/
LispInSmallPieces
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

[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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
chapter1/astToList.coffee
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

76
chapter1/interpreter.coffee
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,7 +45,34 @@ 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
extend = (env, variables, values) -> 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) ->
if (pairp variables) if (pairp variables)
if (pairp values) if (pairp values)
(cons (cons (car variables), (car values)), (cons (cons (car variables), (car values)),
@ -63,18 +87,18 @@ extend = (env, variables, values) ->
else else
nil nil
make_function = (variables, body, env) -> make_function = (variables, body, env) ->
(values) -> eprogn body, (extend env, variables, values) (values) -> eprogn body, (extend env, variables, values)
invoke = (fn, args) -> invoke = (fn, args) ->
(fn args) (fn args)
# Takes a list of nodes and calls evaluate on each one, returning the # 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 # 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 # are hard-coding what ought to be a macro, namely the threading
# macros, "->" # macros, "->"
eprogn = (exps, env) -> eprogn = (exps, env) ->
if (pairp exps) if (pairp exps)
if pairp (cdr exps) if pairp (cdr exps)
evaluate (car exps), env evaluate (car exps), env
@ -84,13 +108,13 @@ eprogn = (exps, env) ->
else else
nil nil
evlis = (exps, env) -> evlis = (exps, env) ->
if (pairp exps) if (pairp exps)
(cons (evaluate (car exps), env), (evlis (cdr exps), env)) (cons (evaluate (car exps), env), (evlis (cdr exps), env))
else else
nil nil
lookup = (id, env) -> lookup = (id, env) ->
if (pairp env) if (pairp env)
if (caar env) == id if (caar env) == id
cdar env cdar env
@ -99,7 +123,7 @@ lookup = (id, env) ->
else else
nil nil
update = (id, env, value) -> update = (id, env, value) ->
if (pairp env) if (pairp env)
if (caar env) == id if (caar env) == id
setcdr value, (car env) setcdr value, (car env)
@ -109,11 +133,11 @@ update = (id, env, value) ->
else else
nil nil
# This really ought to be the only place where the AST meets the # 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 # interpreter core. I can't help but think that this design precludes
# pluggable interpreter core. # pluggable interpreter core.
astSymbolsToLispSymbols = (node) -> astSymbolsToLispSymbols = (node) ->
return nil if nilp node return nil if nilp node
throw (new LispInterpreterError "Not a list of variable names") if not (ntype(node) is 'list') throw (new LispInterpreterError "Not a list of variable names") if not (ntype(node) is 'list')
handler = (node) -> handler = (node) ->
@ -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
# ("list" (... contents ...)) or ("number" 42) or ("symbol" x), etc.
# Takes an AST node and evaluates it and its contents. A node may be
# ("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

27
chapter1/reader.coffee
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

6
chapter1/reader_types.coffee Normal file
View File

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

1
chapter3/interpreter.coffee
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