[refactor] Is this the functor/applicative/monadic life?

This is a big change.  For chapter 5, I ripped out all line/column
tracking and most error handling from the parser; it's now a plain
ol' Lisp parser, and if it's not close to CL 22.1.1, it's a hell of
a lot closer than it used to be.

In doing so, I reduced the size of the parser by about 40 lines.

TrackingReader takes every function in a Reader and puts that
debugging information *back*.  It turns out that all that information
was prelude and postlude to the act of parsing; by wrapping each
function in a decorator I was able to restore all that information,
and I only had to get it right exactly *once*.

In functional programming terms, this lifts:

	IO -> (atom | list)

to:

	IO with tracking -> Node (atom | list) with tracking

It's a totally free win without having to do much extra work.

Now, this check-in isn't perfect.  The tracking reader is still
tossing on some things, and because I don't have a robust type
system (it is Coffeescript, after all), I'm having to do the
decorating and wrapping by hand.  But I'm definitely on my way
to understanding the issues, and having a grasp on functors and
monoids.
This commit is contained in:
Elf M. Sternberg 2015-08-20 08:50:52 -07:00
parent 981baec645
commit db2e93b2f3
7 changed files with 220 additions and 118 deletions

View File

@ -1,6 +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"
{Node, Comment, Symbol} = require "../chapter5/reader_types" {Comment, Symbol} = require "../chapter5/reader_types"
NEWLINES = ["\n", "\r", "\x0B", "\x0C"] NEWLINES = ["\n", "\r", "\x0B", "\x0C"]
WHITESPACE = [" ", "\t"].concat(NEWLINES) WHITESPACE = [" ", "\t"].concat(NEWLINES)
@ -8,6 +8,10 @@ WHITESPACE = [" ", "\t"].concat(NEWLINES)
EOF = new (class Eof)() EOF = new (class Eof)()
EOO = new (class Eoo)() EOO = new (class Eoo)()
class ReadError extends Error
name: 'LispInterpreterError'
constructor: (@message) ->
class Source class Source
constructor: (@inStream) -> constructor: (@inStream) ->
@index = 0 @index = 0
@ -32,33 +36,6 @@ class Source
skipWS = (inStream) -> skipWS = (inStream) ->
while inStream.peek() in WHITESPACE then inStream.next() while inStream.peek() in WHITESPACE then inStream.next()
# msg -> (IO -> IO, Node)
handleError = (message) ->
(line, column) -> new Node('error', message, line, column)
# IO -> (IO, Node)
readComment = (inStream) ->
[line, column] = inStream.position()
r = (while inStream.peek() != "\n" and not inStream.done()
inStream.next()).join("")
if not inStream.done()
inStream.next()
new Node 'comment', (new Comment r), line, column
# IO -> (IO, Node) | Error
readString = (inStream) ->
[line, column] = inStream.position()
inStream.next()
string = until inStream.peek() == '"' or inStream.done()
if inStream.peek() == '\\'
inStream.next()
inStream.next()
if inStream.done()
return handleError("end of file seen before end of string.")(line, column)
inStream.next()
new Node 'string', (string.join ''), line, column
# (String) -> (Symbol | Number) | Nothing
readMaybeNumber = (symbol) -> readMaybeNumber = (symbol) ->
if symbol[0] == '+' if symbol[0] == '+'
return readMaybeNumber symbol.substr(1) return readMaybeNumber symbol.substr(1)
@ -75,129 +52,116 @@ readMaybeNumber = (symbol) ->
return nil return nil
undefined undefined
# (IO, macros) -> (IO, Node => Number | Symbol) | Error # (Delim, TypeName) -> IO -> (IO, Node) | Errorfor
readSymbol = (inStream, tableKeys) ->
[line, column] = inStream.position()
symbol = (until (inStream.done() or inStream.peek() in tableKeys or inStream.peek() in WHITESPACE)
inStream.next()).join ''
number = readMaybeNumber symbol
if number?
return new Node 'number', number, line, column
new Node (new Symbol symbol), line, column
# (Delim, TypeName) -> IO -> (IO, Node) | Error
makeReadPair = (delim, type) -> makeReadPair = (delim, type) ->
# IO -> (IO, Node) | Error # IO -> (IO, Node) | Error
(inStream) -> (inStream) ->
inStream.next() inStream.next()
skipWS inStream skipWS inStream
[line, column] = inStream.position()
if inStream.peek() == delim if inStream.peek() == delim
inStream.next() inStream.next() unless inStream.done()
return new Node type, nil, line, column return if type then cons((new Symbol type), nil) else nil
# IO -> (IO, Node) | Error # IO -> (IO, Node) | Error
dotted = false dotted = false
readEachPair = (inStream) -> readEachPair = (inStream) =>
[line, column] = inStream.position() obj = @read inStream, true, null, true
obj = read inStream, true, null, true
if inStream.peek() == delim if inStream.peek() == delim
if dotted then return obj if dotted then return obj
return cons obj, nil return cons obj, nil
if inStream.done() then return handleError("Unexpected end of input")(line, column) return obj if obj instanceof ReadError
if dotted then return handleError("More than one symbol after dot") if inStream.done() then return new ReadError "Unexpected end of input"
return obj if obj.type == 'error' if dotted then return new ReadError "More than one symbol after dot in list"
if obj.type == 'symbol' and obj.value == '.' if obj instanceof Symbol and obj.name == '.'
dotted = true dotted = true
return readEachPair inStream return readEachPair inStream
cons obj, readEachPair inStream cons obj, readEachPair inStream
ret = new Node type, readEachPair(inStream), line, column obj = readEachPair(inStream)
inStream.next() inStream.next()
ret if type then cons((new Symbol type), obj) else obj
# Type -> IO -> IO, Node # Type -> IO -> IO, Node
prefixReader = (type) -> prefixReader = (type) ->
# IO -> IO, Node # IO -> IO, Node
(inStream) -> (inStream) ->
[line, column] = inStream.position()
inStream.next() inStream.next()
[line1, column1] = inStream.position()
obj = read inStream, true, null, true obj = read inStream, true, null, true
return obj if obj.type == 'error' return obj if obj instanceof ReadError
new Node "list", cons((new Node("symbol", (new Symbol type), line1, column1)), cons(obj)), line, column cons((new Symbol type), obj)
# I really wanted to make anything more complex than a list (like an class Reader
# object or a vector) something handled by a read macro. Maybe in a "symbol": (inStream) ->
# future revision I can vertically de-integrate these. symbol = (until (inStream.done() or @[inStream.peek()]? or inStream.peek() in WHITESPACE)
inStream.next()).join ''
number = readMaybeNumber symbol
if number?
return number
new Symbol symbol
"read": (inStream, eofErrorP = false, eofError = EOF, recursiveP = false, keepComments = false) ->
inStream = if inStream instanceof Source then inStream else new Source inStream
c = inStream.peek()
# (IO, Char) -> (IO, Node) | Error
matcher = (inStream, c) =>
if inStream.done()
return if recursiveP then (new ReadError 'EOF while processing nested object') else nil
if c in WHITESPACE
inStream.next()
return nil
if c == ';'
return readComment(inStream)
ret = if @[c]? then @[c](inStream) else @symbol(inStream)
skipWS inStream
ret
while true
form = matcher inStream, c
skip = (not nilp form) and (form instanceof Comment) and not keepComments
break if (not skip and not nilp form) or inStream.done()
c = inStream.peek()
null
form
'(': makeReadPair ')', null
readMacros =
'"': readString
'(': makeReadPair ')', 'list'
')': handleError "Closing paren encountered"
'[': makeReadPair ']', 'vector' '[': makeReadPair ']', 'vector'
']': handleError "Closing bracket encountered"
'{': makeReadPair('}', 'record', (res) -> '{': makeReadPair('}', 'record', (res) ->
res.length % 2 == 0 and true or mkerr "record key without value") res.length % 2 == 0 and true or mkerr "record key without value")
'}': handleError "Closing curly without corresponding opening."
"`": prefixReader 'back-quote'
"'": prefixReader 'quote'
",": prefixReader 'unquote'
";": readComment
# Given a stream, reads from the stream until a single complete lisp '"': (inStream) ->
# object has been found and returns the object inStream.next()
s = until inStream.peek() == '"' or inStream.done()
# IO -> IO, Node if inStream.peek() == '\\'
read = (inStream, eofErrorP = false, eofError = EOF, recursiveP = false, inReadMacros = null, keepComments = false) -> inStream.next()
inStream = if inStream instanceof Source then inStream else new Source inStream
inReadMacros = if InReadMacros? then inReadMacros else readMacros
inReadMacroKeys = (i for i of inReadMacros)
c = inStream.peek()
# (IO, Char) -> (IO, Node) | Error
matcher = (inStream, c) ->
if inStream.done()
return if recursiveP then handleError('EOF while processing nested object')(inStream) else nil
if c in WHITESPACE
inStream.next() inStream.next()
return nil return (new ReadError "end of file seen before end of string") if inStream.done()
if c == ';' inStream.next()
return readComment(inStream) s.join ''
ret = if c in inReadMacroKeys then inReadMacros[c](inStream) else readSymbol(inStream, inReadMacroKeys)
skipWS inStream
ret
while true ')': (inStream) -> new ReadError "Closing paren encountered"
form = matcher inStream, c
skip = (not nilp form) and (form.type == 'comment') and not keepComments
break if (not skip and not nilp form) or inStream.done()
c = inStream.peek()
null
form
# readForms assumes that the string provided contains zero or more ']': (inStream) -> new ReadError "Closing bracket encountered"
# forms. As such, it always returns a list of zero or more forms.
# IO -> (IO, Nodes* | Error) '}': (inStream) -> new ReadError "Closing curly without corresponding opening."
readForms = (inStream) ->
inStream = if inStream instanceof Source then inStream else new Source inStream
return nil if inStream.done()
# IO -> (IO, Nodes* | Error "`": prefixReader 'back-quote'
[line, column] = inStream.position()
readEach = (inStream) ->
obj = read inStream, true, null, false
return nil if (nilp obj)
return obj if obj.type == 'error'
cons obj, readEach inStream
obj = readEach inStream "'": prefixReader 'quote'
if obj.type == 'error' then obj else new Node "list", obj, line, column
exports.read = read ",": prefixReader 'unquote'
exports.readForms = readForms
exports.Node = Node ";": (inStream) ->
exports.Symbol = Symbol r = (while inStream.peek() != "\n" and not inStream.done()
inStream.next()).join("")
inStream.next() if not inStream.done()
new Comment r
exports.Source = Source
exports.ReadError = ReadError
exports.Reader = Reader
reader = new Reader()
exports.read = -> reader.read.apply(reader, arguments)

View File

@ -0,0 +1,27 @@
{car, cdr, cons, listp, nilp, nil,
list, pairp, listToString} = require 'cons-lists/lists'
{Symbol, Comment} = require './reader_types'
exports.normalize = normalize = (form) ->
return nil if nilp form
methods =
'vector': (form) ->
until (nilp form) then p = normalize(car form); form = cdr form; p
'record': (form) ->
o = Object.create(null)
until (nilp form)
o[(normalize car form)] = (normalize car cdr form)
form = cdr cdr form
null
o
if (listp form) and (car form) instanceof Symbol
if (car form).name in ['vector', 'record']
methods[(car form).name](cdr form)
else
cons (normalize car form), (normalize cdr form)
else
form

View File

@ -0,0 +1,37 @@
{car, cdr, cons, listp, nilp, nil,
list, pairp, listToString} = require 'cons-lists/lists'
{Symbol, Comment} = require './reader_types'
exports.normalize = normalize = (form) ->
_normalize = (form) ->
return nil if nilp form.v
methods =
'vector': (form) ->
until (nilp form.v) then p = normalize(car form.v); form = cdr form.v; p
'record': (form) ->
o = Object.create(null)
until (nilp form.v)
o[(normalize car form.v)] = (normalize car cdr form.v)
form = cdr cdr form.v
null
o
'list': (form) ->
handle = (form) ->
return nil if (nilp form)
return _normalize(form) if not (listp form)
cons (_normalize car form), (handle cdr form)
handle(form.v)
if (listp form.v)
if (car form.v) instanceof Symbol and (car form.v).name in ['vector', 'record']
methods[(car form.v).name](cdr form.v)
else
methods.list(form)
else
form.v
_normalize(form)

View File

@ -0,0 +1,22 @@
{Reader, ReadError, Source} = require './reader'
{Node} = require './reader_types'
liftToTrack = (f) ->
(ioStream) ->
ioStream = if ioStream instanceof Source then ioStream else new Source ioStream
[line, column] = ioStream.position()
obj = f.apply(this, arguments)
if obj instanceof ReadError
obj['line'] = line
obj['column'] = column
return obj
if obj instanceof Node then obj else new Node obj, line, column
TrackingReader = class
for own key, func of Reader::
TrackingReader::[key] = liftToTrack(func)
exports.ReadError = ReadError
exports.Reader = TrackingReader
exports.reader = reader = new TrackingReader()
exports.read = -> reader.read.apply(reader, arguments)

View File

@ -0,0 +1,22 @@
{cons, nil} = require "cons-lists/lists"
exports.samples = [
['nil', nil]
['0', 0]
['1', 1]
['500', 500]
['0xdeadbeef', 3735928559]
['"Foo"', 'Foo']
['(1)', cons(1)]
['(1 2)', cons(1, (cons 2))]
['(1 2 )', cons(1, (cons 2))]
['( 1 2 )', cons(1, (cons 2))]
['( 1 2 )', cons(1, (cons 2))]
['("a" "b")', cons("a", (cons "b"))]
['("a" . "b")', cons("a", "b")]
['[]', []]
['{}', {}]
['[1 2 3]', [1, 2, 3]]
# ['(1 2 3', 'error']
['{"foo" "bar"}', {foo: "bar"}]
]

15
test/test_reader5a.coffee Normal file
View File

@ -0,0 +1,15 @@
chai = require 'chai'
chai.should()
expect = chai.expect
{cons, nil, nilp} = require "cons-lists/lists"
{read} = require '../chapter5/reader'
{normalize} = require '../chapter5/reader_rawtoform'
{samples} = require './reader5_samples'
describe "Lisp reader functions", ->
for [t, v] in samples
do (t, v) ->
it "should interpret #{t} as #{v}", ->
res = normalize read t
expect(res).to.deep.equal(v)

15
test/test_reader5b.coffee Normal file
View File

@ -0,0 +1,15 @@
chai = require 'chai'
chai.should()
expect = chai.expect
{cons, nil, nilp} = require "cons-lists/lists"
{read} = require '../chapter5/tracking_reader'
{normalize} = require '../chapter5/reader_tracktoform'
{samples} = require './reader5_samples'
describe "Tracker reader functions", ->
for [t, v] in samples
do (t, v) ->
it "should interpret #{t} as #{v}", ->
res = normalize read t
expect(res).to.deep.equal(v)