Coffeescript attempt.
This commit is contained in:
parent
0551a6fd4c
commit
86efa8c09a
129
LICENSE
129
LICENSE
|
|
@ -1,117 +1,22 @@
|
|||
CC0 1.0 Universal
|
||||
The MIT License (MIT)
|
||||
|
||||
Statement of Purpose
|
||||
Copyright (c) 2015 Ken "Elf" Mathieu Sternberg
|
||||
|
||||
The laws of most jurisdictions throughout the world automatically confer
|
||||
exclusive Copyright and Related Rights (defined below) upon the creator and
|
||||
subsequent owner(s) (each and all, an "owner") of an original work of
|
||||
authorship and/or a database (each, a "Work").
|
||||
Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
of this software and associated documentation files (the "Software"), to deal
|
||||
in the Software without restriction, including without limitation the rights
|
||||
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
|
||||
copies of the Software, and to permit persons to whom the Software is
|
||||
furnished to do so, subject to the following conditions:
|
||||
|
||||
Certain owners wish to permanently relinquish those rights to a Work for the
|
||||
purpose of contributing to a commons of creative, cultural and scientific
|
||||
works ("Commons") that the public can reliably and without fear of later
|
||||
claims of infringement build upon, modify, incorporate in other works, reuse
|
||||
and redistribute as freely as possible in any form whatsoever and for any
|
||||
purposes, including without limitation commercial purposes. These owners may
|
||||
contribute to the Commons to promote the ideal of a free culture and the
|
||||
further production of creative, cultural and scientific works, or to gain
|
||||
reputation or greater distribution for their Work in part through the use and
|
||||
efforts of others.
|
||||
The above copyright notice and this permission notice shall be included in all
|
||||
copies or substantial portions of the Software.
|
||||
|
||||
For these and/or other purposes and motivations, and without any expectation
|
||||
of additional consideration or compensation, the person associating CC0 with a
|
||||
Work (the "Affirmer"), to the extent that he or she is an owner of Copyright
|
||||
and Related Rights in the Work, voluntarily elects to apply CC0 to the Work
|
||||
and publicly distribute the Work under its terms, with knowledge of his or her
|
||||
Copyright and Related Rights in the Work and the meaning and intended legal
|
||||
effect of CC0 on those rights.
|
||||
|
||||
1. Copyright and Related Rights. A Work made available under CC0 may be
|
||||
protected by copyright and related or neighboring rights ("Copyright and
|
||||
Related Rights"). Copyright and Related Rights include, but are not limited
|
||||
to, the following:
|
||||
|
||||
i. the right to reproduce, adapt, distribute, perform, display, communicate,
|
||||
and translate a Work;
|
||||
|
||||
ii. moral rights retained by the original author(s) and/or performer(s);
|
||||
|
||||
iii. publicity and privacy rights pertaining to a person's image or likeness
|
||||
depicted in a Work;
|
||||
|
||||
iv. rights protecting against unfair competition in regards to a Work,
|
||||
subject to the limitations in paragraph 4(a), below;
|
||||
|
||||
v. rights protecting the extraction, dissemination, use and reuse of data in
|
||||
a Work;
|
||||
|
||||
vi. database rights (such as those arising under Directive 96/9/EC of the
|
||||
European Parliament and of the Council of 11 March 1996 on the legal
|
||||
protection of databases, and under any national implementation thereof,
|
||||
including any amended or successor version of such directive); and
|
||||
|
||||
vii. other similar, equivalent or corresponding rights throughout the world
|
||||
based on applicable law or treaty, and any national implementations thereof.
|
||||
|
||||
2. Waiver. To the greatest extent permitted by, but not in contravention of,
|
||||
applicable law, Affirmer hereby overtly, fully, permanently, irrevocably and
|
||||
unconditionally waives, abandons, and surrenders all of Affirmer's Copyright
|
||||
and Related Rights and associated claims and causes of action, whether now
|
||||
known or unknown (including existing as well as future claims and causes of
|
||||
action), in the Work (i) in all territories worldwide, (ii) for the maximum
|
||||
duration provided by applicable law or treaty (including future time
|
||||
extensions), (iii) in any current or future medium and for any number of
|
||||
copies, and (iv) for any purpose whatsoever, including without limitation
|
||||
commercial, advertising or promotional purposes (the "Waiver"). Affirmer makes
|
||||
the Waiver for the benefit of each member of the public at large and to the
|
||||
detriment of Affirmer's heirs and successors, fully intending that such Waiver
|
||||
shall not be subject to revocation, rescission, cancellation, termination, or
|
||||
any other legal or equitable action to disrupt the quiet enjoyment of the Work
|
||||
by the public as contemplated by Affirmer's express Statement of Purpose.
|
||||
|
||||
3. Public License Fallback. Should any part of the Waiver for any reason be
|
||||
judged legally invalid or ineffective under applicable law, then the Waiver
|
||||
shall be preserved to the maximum extent permitted taking into account
|
||||
Affirmer's express Statement of Purpose. In addition, to the extent the Waiver
|
||||
is so judged Affirmer hereby grants to each affected person a royalty-free,
|
||||
non transferable, non sublicensable, non exclusive, irrevocable and
|
||||
unconditional license to exercise Affirmer's Copyright and Related Rights in
|
||||
the Work (i) in all territories worldwide, (ii) for the maximum duration
|
||||
provided by applicable law or treaty (including future time extensions), (iii)
|
||||
in any current or future medium and for any number of copies, and (iv) for any
|
||||
purpose whatsoever, including without limitation commercial, advertising or
|
||||
promotional purposes (the "License"). The License shall be deemed effective as
|
||||
of the date CC0 was applied by Affirmer to the Work. Should any part of the
|
||||
License for any reason be judged legally invalid or ineffective under
|
||||
applicable law, such partial invalidity or ineffectiveness shall not
|
||||
invalidate the remainder of the License, and in such case Affirmer hereby
|
||||
affirms that he or she will not (i) exercise any of his or her remaining
|
||||
Copyright and Related Rights in the Work or (ii) assert any associated claims
|
||||
and causes of action with respect to the Work, in either case contrary to
|
||||
Affirmer's express Statement of Purpose.
|
||||
|
||||
4. Limitations and Disclaimers.
|
||||
|
||||
a. No trademark or patent rights held by Affirmer are waived, abandoned,
|
||||
surrendered, licensed or otherwise affected by this document.
|
||||
|
||||
b. Affirmer offers the Work as-is and makes no representations or warranties
|
||||
of any kind concerning the Work, express, implied, statutory or otherwise,
|
||||
including without limitation warranties of title, merchantability, fitness
|
||||
for a particular purpose, non infringement, or the absence of latent or
|
||||
other defects, accuracy, or the present or absence of errors, whether or not
|
||||
discoverable, all to the greatest extent permissible under applicable law.
|
||||
|
||||
c. Affirmer disclaims responsibility for clearing rights of other persons
|
||||
that may apply to the Work or any use thereof, including without limitation
|
||||
any person's Copyright and Related Rights in the Work. Further, Affirmer
|
||||
disclaims responsibility for obtaining any necessary consents, permissions
|
||||
or other rights required for any use of the Work.
|
||||
|
||||
d. Affirmer understands and acknowledges that Creative Commons is not a
|
||||
party to this document and has no duty or obligation with respect to this
|
||||
CC0 or use of the Work.
|
||||
|
||||
For more information, please see
|
||||
<http://creativecommons.org/publicdomain/zero/1.0/>
|
||||
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
||||
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
|
||||
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
|
||||
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
|
||||
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
|
||||
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
|
||||
SOFTWARE.
|
||||
|
||||
|
|
|
|||
|
|
@ -0,0 +1,8 @@
|
|||
#!/bin/bash
|
||||
|
||||
# /bin comes before /node_modules/.bin because sometimes I want to
|
||||
# override the behaviors provided.
|
||||
|
||||
PROJECT_ROOT=`pwd`
|
||||
PATH="$PROJECT_ROOT/bin:$PROJECT_ROOT/node_modules/.bin:$PATH"
|
||||
export PATH
|
||||
|
|
@ -0,0 +1,5 @@
|
|||
lisp = require '../lib/lisp'
|
||||
fs = require 'fs'
|
||||
{inspect} = require 'util'
|
||||
|
||||
console.log lisp.run process.argv[2]
|
||||
|
|
@ -0,0 +1,26 @@
|
|||
{
|
||||
"name": "CoffeeLisp",
|
||||
"version": "0.0.1",
|
||||
"description": "A Coffeescript rendition of Lisp In Small Pieces",
|
||||
"main": "bin/lisp",
|
||||
"dependencies": {
|
||||
"coffee-script": "^1.9.1",
|
||||
"git+https://github.com/elfsternberg/cons-lists.git"
|
||||
},
|
||||
"devDependencies": {
|
||||
"chai": "^2.0.0",
|
||||
"mocha": "^2.1.0"
|
||||
},
|
||||
"scripts": {
|
||||
"test": "echo \"Error: no test specified\" && exit 1"
|
||||
},
|
||||
"keywords": [
|
||||
"scheme",
|
||||
"practice",
|
||||
"interpreter",
|
||||
"javascript",
|
||||
"coffeescript"
|
||||
],
|
||||
"author": "Elf M. Sternberg",
|
||||
"license": "MIT"
|
||||
}
|
||||
|
|
@ -0,0 +1,17 @@
|
|||
lookup = require './lookup'
|
||||
{car, cdr, cadr, caadr, cdadr} = require './lists'
|
||||
|
||||
lispeval = (element, scope) ->
|
||||
|
||||
switch (car element)
|
||||
when 'number' then parseInt (cadr element), 10
|
||||
when 'string' then (cadr element)
|
||||
when 'symbol' then lookup scope, (cadr element)
|
||||
when 'list'
|
||||
proc = lispeval (caadr element), scope
|
||||
args = cdadr element
|
||||
proc args, scope
|
||||
else throw new Error ("Unrecognized type in parse: #{(car element)}")
|
||||
|
||||
module.exports = lispeval
|
||||
|
||||
|
|
@ -0,0 +1,43 @@
|
|||
lispeval = require './eval'
|
||||
{cons, nil, nilp, car, cdr, listToVector} = require './lists'
|
||||
|
||||
module.exports =
|
||||
create_vm_expression_evaluator: (defining_scope, params, body) ->
|
||||
(cells, scope) ->
|
||||
args = (amap = (cells, accum) ->
|
||||
return accum if nilp cells
|
||||
amap((cdr cells), accum.concat(lispeval (car cells), scope)))(cells, [])
|
||||
body.apply null, args
|
||||
|
||||
create_lisp_expression_evaluator: (defining_scope, params, body) ->
|
||||
(cells, scope) ->
|
||||
|
||||
# Takes the current scope, which has been passed in during the
|
||||
# execution phase, and evaluate the contents of the parameters
|
||||
# in the context in which this call is made (i.e. when the
|
||||
# function is *called*, rather than defined.
|
||||
|
||||
new_scope = (cmap = (cells, params, nscope) ->
|
||||
return nscope if (nilp cells) or (nilp params)
|
||||
nscope[(car params)] = lispeval (car cells), scope
|
||||
cmap((cdr cells), (cdr params), nscope))(cells, params, {})
|
||||
|
||||
# Execute and evaluate the body, creating an inner scope that
|
||||
# consists of: (1) the bound variables (the parameters)
|
||||
# evaluated in the context of the function call, because that's
|
||||
# where they were encountered (2) the free variables evaluated
|
||||
# in the context of the defining scope, because that's where
|
||||
# *they* were encountered.
|
||||
#
|
||||
# While this inspiration comes from Coglan, the clearest
|
||||
# explanation is from Lisperator's 'make_lambda' paragraph at
|
||||
# http://lisperator.net/pltut/eval1/
|
||||
|
||||
inner_scope = cons(new_scope, defining_scope)
|
||||
(nval = (body, memo) ->
|
||||
return memo if nilp body
|
||||
nval((cdr body), lispeval((car body), inner_scope)))(body)
|
||||
|
||||
create_special_form_evaluator: (defining_scope, params, body) ->
|
||||
(cells, scope) -> body(cells, scope)
|
||||
|
||||
|
|
@ -0,0 +1,16 @@
|
|||
fs = require 'fs'
|
||||
{readForms} = require './reader'
|
||||
lispeval = require './eval'
|
||||
scope = require './scope'
|
||||
{car, cdr, nilp, cadr} = require './lists'
|
||||
|
||||
module.exports =
|
||||
run: (pathname) ->
|
||||
text = fs.readFileSync(pathname, 'utf8')
|
||||
ast = readForms(text)
|
||||
(nval = (body, memo) ->
|
||||
return memo if nilp body
|
||||
nval((cdr body), lispeval((car body), scope)))(cadr ast)
|
||||
|
||||
|
||||
|
||||
|
|
@ -0,0 +1,145 @@
|
|||
{listToString, listToVector, pairp, cons, car, cdr, caar, cddr, cdar, cadr, caadr, cadar, caddr, nilp, nil, setcdr, metacadr} = require "./lists"
|
||||
readline = require "readline"
|
||||
{inspect} = require "util"
|
||||
|
||||
env_init = nil
|
||||
env_global = env_init
|
||||
|
||||
ntype = (node) -> car node
|
||||
nvalu = (node) -> cadr node
|
||||
|
||||
definitial = (name, value = nil) ->
|
||||
env_global = (cons (cons name, value), env_global)
|
||||
name
|
||||
|
||||
defprimitive = (name, value, arity) ->
|
||||
definitial name, ((values) ->
|
||||
vvalues = listToVector(values)
|
||||
if (vvalues.length == arity)
|
||||
return value(vvalues)
|
||||
else
|
||||
throw "Incorrect arity")
|
||||
|
||||
the_false_value = (cons "false", "boolean")
|
||||
|
||||
definitial "#t", true
|
||||
definitial "#f", the_false_value
|
||||
definitial "nil", nil
|
||||
definitial "foo"
|
||||
definitial "bar"
|
||||
definitial "fib"
|
||||
definitial "fact"
|
||||
|
||||
defpredicate = (name, nativ, arity) ->
|
||||
defprimitive name, ((args) -> if (nativ.apply null, args) then true else the_false_value), arity
|
||||
|
||||
defprimitive "cons", cons, 2
|
||||
defprimitive "car", car, 2
|
||||
defprimitive "set-cdr!", setcdr, 2
|
||||
defprimitive "+", ((a, b) -> a + b), 2
|
||||
defprimitive "*", ((a, b) -> a * b), 2
|
||||
defprimitive "-", ((a, b) -> a - b), 2
|
||||
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 "Too few values"
|
||||
else if (nilp variables)
|
||||
if (nilp values) then env else throw "Too many values"
|
||||
else
|
||||
if (symbolp variables)
|
||||
(cons (cons variables, values), env)
|
||||
|
||||
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
|
||||
return eprogn (cdr exps), env
|
||||
return evaluate (car exps), env
|
||||
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 (car env), value
|
||||
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.
|
||||
|
||||
cadddr = metacadr("cadddr")
|
||||
|
||||
astSymbolsToLispSymbols = (node) ->
|
||||
return nil if nilp node
|
||||
throw "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.
|
||||
|
||||
evaluate = (e, env) ->
|
||||
[type, exp] = [(ntype e), (nvalu e)]
|
||||
if type == "symbol"
|
||||
return lookup exp, env
|
||||
if type in ["number", "string", "boolean", "vector"]
|
||||
return exp
|
||||
if type == "list"
|
||||
head = car exp
|
||||
if (ntype head) == 'symbol'
|
||||
return 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)
|
||||
return invoke (evaluate (car exp), env), (evlis (cdr exp), env)
|
||||
throw new Error("Can't handle a #{type}")
|
||||
|
||||
module.exports = (c) -> evaluate c, env_global
|
||||
|
|
@ -0,0 +1,8 @@
|
|||
{nilp, car, cdr} = require './lists'
|
||||
|
||||
module.exports = lookup = (scopes, name) ->
|
||||
throw new Error "Unknown variable '#{name}'" if nilp scopes
|
||||
scope = car scopes
|
||||
return scope[name] if scope[name]?
|
||||
lookup((cdr scopes), name)
|
||||
|
||||
|
|
@ -0,0 +1,197 @@
|
|||
{car, cdr, cons, nil, nilp, pairp, vectorToList} = require './lists'
|
||||
|
||||
NEWLINES = ["\n", "\r", "\x0B", "\x0C"]
|
||||
WHITESPACE = [" ", "\t"].concat(NEWLINES)
|
||||
|
||||
EOF = new (class)
|
||||
EOO = new (class)
|
||||
|
||||
class Source
|
||||
constructor: (@inStream) ->
|
||||
@index = 0
|
||||
@max = @inStream.length - 1
|
||||
@line = 0
|
||||
@column = 0
|
||||
|
||||
peek: -> @inStream[@index]
|
||||
|
||||
position: -> [@line, @column]
|
||||
|
||||
next: ->
|
||||
c = @peek()
|
||||
return EOF if @done()
|
||||
@index++
|
||||
[@line, @column] = if @peek() in NEWLINES then [@line + 1, 0] else [@line, @column + 1]
|
||||
c
|
||||
|
||||
done: -> @index > @max
|
||||
|
||||
# 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) ->
|
||||
cons(type, cons(value, cons(line, cons(column, nil))))
|
||||
|
||||
# msg -> (IO -> Node => Error)
|
||||
handleError = (message) ->
|
||||
(line, column) -> makeObj('error', message, line, column)
|
||||
|
||||
# IO -> Node => Comment
|
||||
readComment = (inStream) ->
|
||||
[line, column] = inStream.position()
|
||||
r = (while inStream.peek() != "\n" and not inStream.done()
|
||||
inStream.next()).join("")
|
||||
if not inStream.done()
|
||||
inStream.next()
|
||||
makeObj 'comment', r, line, column
|
||||
|
||||
# IO -> (Node => Literal => String) | 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()
|
||||
makeObj 'string', (string.join ''), line, column
|
||||
|
||||
# (String) -> (Node => Literal => Number) | Nothing
|
||||
readMaybeNumber = (symbol) ->
|
||||
if symbol[0] == '+'
|
||||
return readMaybeNumber symbol.substr(1)
|
||||
if symbol[0] == '-'
|
||||
ret = readMaybeNumber symbol.substr(1)
|
||||
return if ret? then -1 * ret else undefined
|
||||
if symbol.search(/^0x[0-9a-fA-F]+$/) > -1
|
||||
return parseInt(symbol, 16)
|
||||
if symbol.search(/^0[0-9a-fA-F]+$/) > -1
|
||||
return parseInt(symbol, 8)
|
||||
if symbol.search(/^[0-9]+$/) > -1
|
||||
return parseInt(symbol, 10)
|
||||
if symbol.search(/^nil$/) > -1
|
||||
return nil
|
||||
undefined
|
||||
|
||||
# (IO, macros) -> (IO, Node => Number | Symbol) | Error
|
||||
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 makeObj 'number', number, line, column
|
||||
makeObj 'symbol', symbol, line, column
|
||||
|
||||
|
||||
# (Delim, TypeName) -> IO -> (IO, node) | Error
|
||||
makeReadPair = (delim, type) ->
|
||||
# IO -> (IO, Node) | Error
|
||||
(inStream) ->
|
||||
inStream.next()
|
||||
skipWS inStream
|
||||
[line, column] = inStream.position()
|
||||
if inStream.peek() == delim
|
||||
inStream.next()
|
||||
return makeObj(type, nil, line, column)
|
||||
|
||||
# IO -> (IO, Node) | Error
|
||||
readEachPair = (inStream) ->
|
||||
[line, column] = inStream.position()
|
||||
obj = read inStream, true, null, true
|
||||
if inStream.peek() == delim then return cons obj, nil
|
||||
if inStream.done() then return handleError("Unexpected end of input")(line, column)
|
||||
return obj if (car obj) == 'error'
|
||||
cons obj, readEachPair(inStream)
|
||||
|
||||
ret = makeObj type, readEachPair(inStream), line, column
|
||||
inStream.next()
|
||||
ret
|
||||
|
||||
# Type -> (IO -> (IO, Node))
|
||||
prefixReader = (type) ->
|
||||
# IO -> (IO, Node)
|
||||
(inStream) ->
|
||||
[line, column] = inStream.position()
|
||||
inStream.next()
|
||||
[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
|
||||
|
||||
# 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
|
||||
# future revision I can vertically de-integrate these.
|
||||
|
||||
readMacros =
|
||||
'"': readString
|
||||
'(': makeReadPair ')', 'list'
|
||||
')': handleError "Closing paren encountered"
|
||||
'[': makeReadPair ']', 'vector'
|
||||
']': handleError "Closing bracket encountered"
|
||||
'{': makeReadPair('}', 'record', (res) ->
|
||||
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
|
||||
# object has been found and returns the object
|
||||
|
||||
# IO -> Form
|
||||
read = (inStream, eofErrorP = false, eofError = EOF, recursiveP = false, inReadMacros = null, keepComments = false) ->
|
||||
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()
|
||||
return nil
|
||||
if c == ';'
|
||||
return readComment(inStream)
|
||||
ret = if c in inReadMacroKeys then inReadMacros[c](inStream) else readSymbol(inStream, inReadMacroKeys)
|
||||
skipWS inStream
|
||||
ret
|
||||
|
||||
while true
|
||||
form = matcher inStream, c
|
||||
skip = (not nilp form) and (car form == '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
|
||||
# forms. As such, it always returns a list of zero or more forms.
|
||||
|
||||
# IO -> (Form* | Error)
|
||||
readForms = (inStream) ->
|
||||
inStream = if inStream instanceof Source then inStream else new Source inStream
|
||||
return nil if inStream.done()
|
||||
|
||||
# IO -> (FORM*, IO) | Error
|
||||
[line, column] = inStream.position()
|
||||
readEach = (inStream) ->
|
||||
obj = read inStream, true, null, false
|
||||
return nil if (nilp obj)
|
||||
return obj if (car obj) == 'error'
|
||||
cons obj, readEach inStream
|
||||
|
||||
obj = readEach inStream
|
||||
if (car obj) == 'error' then obj else makeObj "list", obj, line, column
|
||||
|
||||
exports.read = read
|
||||
exports.readForms = readForms
|
||||
|
|
@ -0,0 +1,50 @@
|
|||
{car, cdr, cons, pairp, nilp, nil, list, listToString} = require './lists'
|
||||
|
||||
reduce = (lst, iteratee, memo, context) ->
|
||||
count = 0
|
||||
ptr = lst
|
||||
while not nilp ptr
|
||||
[item, ptr] = [(car ptr), (cdr ptr)]
|
||||
memo = iteratee.call(context, memo, item, count, lst)
|
||||
count++
|
||||
iteratee.call(context, memo, nil, count, lst)
|
||||
|
||||
map = (lst, iteratee, context) ->
|
||||
return nil if nilp lst
|
||||
root = cons("")
|
||||
|
||||
reducer = (memo, item, count) ->
|
||||
next = cons(iteratee.call(context, item, count, lst))
|
||||
memo[1] = next
|
||||
next
|
||||
|
||||
reduce(lst, reducer, root, context)
|
||||
(cdr root)
|
||||
|
||||
rmap = (lst, iteratee, context) ->
|
||||
reducer = (memo, item, count) ->
|
||||
cons(iteratee.call(context, item, count, lst), memo)
|
||||
reduce(lst, reducer, nil, context)
|
||||
|
||||
|
||||
filter = (lst, iteratee, context) ->
|
||||
return nil if nilp lst
|
||||
root = cons("")
|
||||
|
||||
reducer = (memo, item, count) ->
|
||||
if iteratee.call(context, item, count, lst)
|
||||
next = cons(item)
|
||||
memo[1] = next
|
||||
next
|
||||
else
|
||||
memo
|
||||
|
||||
reduce(lst, reducer, root, context)
|
||||
(cdr root)
|
||||
|
||||
module.exports =
|
||||
reduce: reduce
|
||||
map: map
|
||||
rmap: rmap
|
||||
filter: filter
|
||||
|
||||
|
|
@ -0,0 +1,31 @@
|
|||
lispeval = require './eval'
|
||||
{cons, car, cdr, nilp, nil, cadar, cadr, caddr} = require './lists'
|
||||
{create_lisp_expression_evaluator, create_vm_expression_evaluator, create_special_form_evaluator} = require './fn'
|
||||
|
||||
scope = cons
|
||||
'+': create_vm_expression_evaluator scope, [], (a, b) -> a + b
|
||||
'-': create_vm_expression_evaluator scope, [], (a, b) -> a - b
|
||||
'*': create_vm_expression_evaluator scope, [], (a, b) -> a * b
|
||||
'/': create_vm_expression_evaluator scope, [], (a, b) -> a / b
|
||||
'==': create_vm_expression_evaluator scope, [], (a, b) -> a == b
|
||||
'#t': true
|
||||
'#f': false
|
||||
|
||||
'define': create_special_form_evaluator scope, [], (nodes, scope) ->
|
||||
current = (car scope)
|
||||
current[(cadar nodes)] = lispeval((cadr nodes), scope)
|
||||
|
||||
'lambda': create_special_form_evaluator scope, [], (nodes, scope) ->
|
||||
param_nodes = cadar nodes
|
||||
reducer = (l) ->
|
||||
if (nilp l) then nil else cons (cadar l), reducer(cdr l)
|
||||
param_names = reducer(param_nodes)
|
||||
create_lisp_expression_evaluator scope, param_names, (cdr nodes)
|
||||
|
||||
'if': create_special_form_evaluator scope, [], (nodes, scope) ->
|
||||
if lispeval (car nodes), scope
|
||||
lispeval (cadr nodes), scope
|
||||
else
|
||||
lispeval (caddr nodes), scope
|
||||
|
||||
module.exports = scope
|
||||
|
|
@ -0,0 +1,5 @@
|
|||
lisp = require './lisp_ch1'
|
||||
{read, readForms} = require './reader'
|
||||
{inspect} = require 'util'
|
||||
ast = read("(begin (set! fact (lambda (x) (if (eq? x 0) 1 (* x (fact (- x 1)))))) (fact 5))")
|
||||
console.log "Result:", (lisp ast)
|
||||
Loading…
Reference in New Issue