// -*- mode: js2; js-run: "lisp-tests.js" -*- // // Copyright (c) 2010 Ivan Shvedunov. All rights reserved. // // Redistribution and use in source and binary forms, with or without // modification, are permitted provided that the following conditions // are met: // // * Redistributions of source code must retain the above copyright // notice, this list of conditions and the following disclaimer. // // * Redistributions in binary form must reproduce the above // copyright notice, this list of conditions and the following // disclaimer in the documentation and/or other materials // provided with the distribution. // // THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED // OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED // WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE // ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY // DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL // DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE // GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS // INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, // WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING // NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS // SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. var util = require("util"); var assert = process.assert; var I = {}; function _symbol (name) { this.name = name; } _symbol.prototype.toString = function toString () { return this.name; }; function S(name) { if (I.hasOwnProperty(name)) return I[name]; return I[name] = new _symbol(name); }; function symbolp (o) { return o instanceof _symbol; }; var nil = S("nil"); function nullp (o) { return o === nil; }; function _cons (car, cdr) { this.car = car; this.cdr = cdr; } _cons.prototype.toString = function toString () { var result = []; if (this.car == S("quote") && consp(this.cdr) && nullp(this.cdr.cdr)) return "'" + repr(this.cdr.car); for (var c = this;; c = c.cdr) { if (consp(c)) result.push(repr(c.car)); else { if (!nullp(c)) result.push(". " + repr(c)); break; } } return '(' + result.join(" ") + ')'; }; function consp (o) { return o instanceof _cons; } function cons (car, cdr) { return new _cons(car, cdr); } function car (o) { return o.car; } function cdr (o) { return o.cdr; } function repr (x) { if (typeof(x) == "string") return '"' + x.replace(/\\/g, "\\\\").replace(/"/g, '\\"') + '"'; return String(x); }; function list () { var tail = nil; for (var i = arguments.length - 1; i >= 0; --i) tail = cons(arguments[i], tail); return tail; } function listp (o) { return nullp(o) || consp(o); } function reverse (l) { var r = nil; for (; !nullp(l); l = cdr(l)) r = cons(car(l), r); return r; } function append (l1, l2) { if (l1 === nil) return l2; var r = cons(car(l1), nil), tail = r; while ((l1 = cdr(l1)) !== nil) { tail.cdr = cons(car(l1)); tail = tail.cdr; } tail.cdr = l2; return r; } function StringInputStream (string) { this._string = string; this._pos = 0; this._max = this._string.length; } StringInputStream.prototype.pos = function pos () { return this._pos; }; StringInputStream.prototype.getc = function getc () { if (this._pos == this._max) return null; return this._string.charAt(this._pos++); }; StringInputStream.prototype.readchar = function readchar () { var c = this.getc(); if (c === null) throw new Error("StringInputStream.readchar(): EOF reached"); return c; }; StringInputStream.prototype.ungetc = function ungetc (c) { if (this._pos > 0 && this._string[this._pos - 1] == c) --this._pos; else { /* FIXME: { is just to make nodejs repl happy */ throw new Error("StringInputStream.ungetc(): invalid argument"); } }; function LispReader (s) { this.s = s; } LispReader.prototype.readNumberOrSymbol = function readNumberOrSymbol () { var token = this.readToken(); if (token == "") throw new Error("LispReader.readNumberOrSymbol(): EOF reached"); if (/^[-+]?[0-9]+$/.test(token)) return parseInt(token); if (/^[-+]?[0-9]*\.?[0-9]+(?:[dDeE][-+]?[0-9]+)?/.test(token)) return parseFloat(token.replace(/d/g, "e")); return S(token); }; LispReader.prototype.read = function read () { this.skipWhitespace(); var c = this.s.getc(); switch (c) { case "(": return this.readList(); case '"': return this.readString(); case "'": return this.readQuote(); case null: throw new Error("LispReader.read(): EOF reached"); default: this.s.ungetc(c); return this.readNumberOrSymbol(); } }; LispReader.prototype.readList = function readList () { var l = nil; var head = nil; while (true) { this.skipWhitespace(); var c = this.s.readchar(); switch (c) { case ")": return l; case ".": var c1 = this.s.readchar(); if (" \n\t".indexOf(c1) < 0) this.s.ungetc(c1); // process the default case else { if (nullp(l)) throw new Error("LispReader.readList(): invalid placement of the dot"); head.cdr = this.read(); return l; } default: this.s.ungetc(c); if (nullp(l)) { l = list(this.read()); head = l; } else { head.cdr = list(this.read()); head = head.cdr; } } } return null; /* never get there */ }; LispReader.prototype.readString = function readString () { var r = []; while (true) { var c = this.s.readchar(); switch (c) { case '"': return r.join(""); case "\\": c = this.s.readchar(); if (c != "\\" && c != '"') throw new Error("Invalid escape char " + c); } r.push(c); } return null; /* never get there */ }; LispReader.prototype.readQuote = function readQuote () { return list(S("quote"), this.read()); }; LispReader.prototype.readToken = function readToken () { var c, token = []; while ((c = this.s.getc()) != null) { if (this.isTerminating(c)) { this.s.ungetc(c); break; } token.push(c); } return token.join(""); }; LispReader.prototype.skipWhitespace = function skipWhitespace () { while (true) { var c = this.s.getc(); switch (c) { case " ": case "\n": case "\t": continue; case null: return; default: this.s.ungetc(c); return; } } }; LispReader.prototype.isTerminating = function isTerminating (c) { return " \n\t()\"'".indexOf(c) >= 0; }; function readFromString (str) { return new LispReader(new StringInputStream(str)).read(); } function _conversionError (value, spec) { return new TypeError( "error converting " + util.inspect(value) + " using spec " + util.inspect(spec)); }; function naturalValue (v) { if (typeof(v) == "number" || typeof(v) == "string") return v; else if (symbolp(v)) return v === nil ? null : v.name; else if (consp(v)) { var result = []; for (; v !== nil; v = cdr(v)) { if (consp(v)) result.push(naturalValue(car(v))); else { result.push(naturalValue(v)); break; } } return result; } else return v; }; function plistValue (l, useNatural, map) { assert(!map || !useNatural); var origList = l; var result = {}; for (; l !== nil; l = cdr(cdr(l))) { if (!consp(l) || !consp(cdr(l))) throw _conversionError(origList, ""); var nameSym = car(l); if (!symbolp(nameSym)) throw _conversionError(origList, ""); var value = car(cdr(l)); var targetName = nameSym.name.replace(/^.*:/, "").toLowerCase(); if (useNatural) result[targetName] = naturalValue(value); else if (map) { if (!map.hasOwnProperty(targetName)) continue; var mapSpec = map[targetName]; if (typeof(mapSpec) == "object") { assert(mapSpec.spec); result[mapSpec.hasOwnProperty("name") ? mapSpec.name : targetName] = fromLisp(value, mapSpec.spec); } else { var arg = mapSpec.split(/:/); if (arg.length > 1) result[arg[1]] = fromLisp(value, arg[0]); else result[targetName] = fromLisp(value, arg[0]); } } else result[targetName] = value; } return result; }; function plainList (l, spec) { var result = {}; var origList = l; for (var i = 0; i < spec.length; ++i, l = cdr(l)) { if (l !== nil && !consp(l)) throw _conversionError(origList, spec); var arg = spec[i].split(/:/); var type = arg[0]; var name = arg[1]; if (type == ">") { assert(i < spec.length - 1); type = spec[++i]; } if (type == ">*") { assert(i < spec.length - 1); result[name] = fromLisp(l, spec[++i]); l = nil; break; } if (type == "R" || type == "R*") { result[name] = []; for (; l !== nil; l = cdr(l)) result[name].push(type == "R*" ? car(l) : naturalValue(car(l))); break; } if (type == "RD" || type == "RD*") { result[name] = plistValue(l, type == "RD"); l = nil; break; } if (l === nil) throw _conversionError(origList, spec); result[name] = fromLisp(car(l), type); } if (l !== nil) throw _conversionError(origList, spec); return result; }; function fromLisp (o, spec) { spec = spec || "@"; if (typeof(spec) == "string") { switch (spec) { case 'B': return naturalValue(o) !== null; case 'S': if (!symbolp(o)) throw _conversionError(o, spec); return nullp(o) ? null : o.name; case 'K': if (!symbolp(o) || (!nullp(o) && !/:/.test(o.name))) throw _conversionError(o, spec); return nullp(o) ? null : o.name.replace(/^:/, ""); case 's': if (typeof(o) != "string") throw _conversionError(o, spec); return o; case 'N': if (typeof(o) != "number") throw _conversionError(o, spec); return o; case 'D': case 'D*': return plistValue(o, spec == "D"); case "@": return naturalValue(o); case '_': return o; } } else if (spec instanceof Array) return plainList(o, spec); else if (typeof(spec) == "object") return plistValue(o, false, spec); throw new Error("invalid destructuring type spec"); } function naturalValueToLisp (v) { if (v === null) return nil; if (typeof(v) == "number" || typeof(v) == "string" || symbolp(v) || consp(v)) return v; if (v instanceof Array) { var r = nil; for (var i = 0; i < v.length; ++i) r = cons(naturalValueToLisp(v[i]), r); return reverse(r); } if (typeof(v) != "object") throw _conversionError(v, ""); var keys = []; for (var k in v) { if (v.hasOwnProperty(k)) keys.push(k); } keys.sort(); var r = nil; for (var i = 0; i < keys.length; ++i) { var keyNameSym = /:/.test(keys[i]) ? S(keys[i]) : S(":" + keys[i]); r = cons(naturalValueToLisp(v[keys[i]]), cons(keyNameSym, r)); } return reverse(r); }; function plistValueToLisp (o, useNatural) { var r = nil; var keys = []; for (var k in o) { if (o.hasOwnProperty(k)) keys.push(k); } keys.sort(); for (var i = 0; i < keys.length; ++i) { var v = o[keys[i]]; if (useNatural) v = naturalValueToLisp(v); var keyNameSym = /:/.test(keys[i]) ? S(keys[i]) : S(":" + keys[i]); r = cons(v, cons(keyNameSym, r)); } return reverse(r); } function mappedPlistValueToLisp (o, map) { var items = []; for (var k in map) { if (!map.hasOwnProperty(k)) continue; var mapSpec = map[k]; if (typeof(mapSpec) == "object") { assert(mapSpec.spec); items.push({ jsName: mapSpec.hasOwnProperty("name") ? mapSpec.name : k, lispName: k, spec: mapSpec.spec }); } else { var arg = mapSpec.split(/:/); items.push({ jsName: arg.length > 1 ? arg[1] : k, lispName: k, spec: arg[0] }); } } items.sort(function (a, b) { if (a.lispName < b.lispName) return -1; else if (a.lispName > b.lispName) return 1; return 0; }); var r = nil; for (var i = 0; i < items.length; ++i) { if (!o.hasOwnProperty(items[i].jsName)) continue; var v = toLisp(o[items[i].jsName], items[i].spec); var lispName = items[i].lispName; var keyNameSym = /:/.test(lispName) ? S(lispName) : S(":" + lispName); r = cons(v, cons(keyNameSym, r)); } return reverse(r); }; function plainListToLisp (o, spec) { var r = nil; if (typeof(o) != "object") throw _conversionError(o, spec); for (var i = 0; i < spec.length; ++i) { if (symbolp(spec[i])) { r = cons(spec[i], r); continue; } var arg = spec[i].split(/:/); var type = arg[0]; var name = arg[1]; if (!o.hasOwnProperty(name)) throw _conversionError(o, spec); var v = o[name]; if (type == ">") { assert(i < spec.length - 1); type = spec[++i]; } switch (type) { case ">*": assert(i < spec.length - 1); return append(reverse(r), toLisp(v, spec[++i])); case "R": return append(reverse(r), naturalValueToLisp(v)); case "R*": return append(reverse(r), list.apply(null, v)); case "RD": case "RD*": return append(reverse(r), plistValueToLisp(v, type == "RD")); default: r = cons(toLisp(v, type), r); } } return reverse(r); }; function toLisp (o, spec) { spec = spec || "@"; if (typeof(spec) == "string") { switch (spec) { case 'B': return !o || o === nil ? nil : S("t"); case 'S': case 'K': if (symbolp(o)) return o; if (o === null) return nil; if (typeof(o) != "string") throw _conversionError(o, spec); return S(spec == "S" ? o : ":" + o); case 's': if (typeof(o) != "string") throw _conversionError(o, spec); return o; case 'N': if (typeof(o) != "number") throw _conversionError(o, spec); return o; case 'D': case 'D*': return plistValueToLisp(o, spec == "D"); case "@": return naturalValueToLisp(o); case '_': return o === null ? nil : o; } } else if (spec instanceof Array) return plainListToLisp(o, spec); else if (typeof(spec) == "object") return mappedPlistValueToLisp(o, spec); throw new Error("invalid destructuring type spec"); } exports.S = S; exports.cons = cons; exports.consp = consp; exports.car = car; exports.cdr = cdr; exports.nil = nil; exports.nullp = nullp; exports.listp = listp; exports.list = list; exports.reverse = reverse; exports.append = append; exports.repr = repr; exports.StringInputStream = StringInputStream; exports.readFromString = readFromString; exports.fromLisp = fromLisp; exports.toLisp = toLisp;