// Copyright (c) 2020-2021 Alan Dipert <alan@dipert.org>
// Part of the JACL project: https://tailrecursion.com/JACL/
//
// 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:
//
// The above copyright notice and this permission notice shall be included in all
// copies or substantial portions of the Software.
//
// 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.
// Sentinel used in a few places to indicate absence of a user-provided value
const UNDEFINED = new Object();
// Sentinel used to indicate EOF, should generally be a parameter
const EOF = new Object();
class TagEx extends Error {
constructor(name, tagbodyId, tagId) {
super(`Unknown GO tag: ${name}`);
this.tagbodyId = tagbodyId;
this.tagId = tagId;
}
}
class List {
static length(x) {
if (x === null) return 0;
if (x instanceof Cons) {
return x.cdr === null ? 1 : 1 + List.length(x.cdr);
} else if (x instanceof Slice) {
return x.length - x.start;
} else {
throw new Error(`Unsupported type`);
}
}
static nth(x, n) {
if (x === null) return null;
if (x instanceof Cons) {
return n === 0 ? x.car : List.nth(x.cdr, n-1);
} else if (x instanceof Slice) {
if (n > (x.end - x.start)) throw new Error(`Out of range`);
return x.arr[x.start + n];
} else {
throw new Error(`Unsupported type`);
}
}
static nthcdr(x, n) {
if (x === null) return null;
if (x instanceof Cons) {
return n === 0 ? x : List.nthcdr(x.cdr, n-1);
} else {
throw new Error(`Unsupported type`);
}
}
static isProperList(x) {
if (x === null) return true;
if (x instanceof Cons) return List.isProperList(x.cdr);
if (x instanceof Slice) return true;
return false;
}
static first(x) {
if (x === null) return null;
if (x instanceof Cons) return x.car;
if (x instanceof Slice) {
return (x.end - x.start) ? x.arr[x.start] : null;
}
throw new Error(`Unsupported type`);
}
static rest(x) {
if (x === null) return null;
if (x instanceof Cons) return x.cdr;
if (x instanceof Slice) {
if ((x.end - x.start) <= 1) return null;
return new Slice(x.arr.slice(x.start + 1, x.end));
}
throw new Error(`Unsupported type`);
}
static toArray(x) {
if (x === null) return [];
if (x instanceof Cons) return Array.from(x);
if (x instanceof Slice) return x.arr.slice(x.start, x.end);
throw new Error(`Unsupported type`);
}
}
class Slice {
constructor(...xs) {
this.arr = xs;
this.start = 0;
this.end = xs.length;
}
static withArray(xs) {
const s = new Slice();
s.arr = xs;
s.start = 0;
s.end = xs.length;
return s;
}
[Symbol.iterator]() {
let i = this.start;
return {
next: () => {
if (i < this.end) {
return { value: this.arr[i++], done: false };
} else {
return { done: true };
}
}
};
}
}
class Cons {
constructor(car, cdr = null) {
this.car = car;
this.cdr = cdr;
}
static fromArray(xs) {
let list = null;
for(let i = xs.length-1; i >= 0; i--) list = new Cons(xs[i], list);
return list;
}
static listOf(...xs) {
return Cons.fromArray(xs);
}
static append(...xs) {
if (xs.length === 0) {
return null;
} else if (xs.length === 1) {
return xs[0];
} else if (xs.length === 2) {
if (xs[0] === null) return xs[1];
let arr = [...List.toArray(xs[0])],
ret = Cons.fromArray(arr),
lastcons = List.nthcdr(ret, arr.length-1);
lastcons.cdr = xs[1];
return ret;
} else {
let ret = Cons.fromArray(xs.slice(0, xs.length-1).flatMap(x => List.toArray(x)));
return Cons.append(ret, xs[xs.length-1]);
}
}
static toArray(cons) {
return cons ? Array.from(cons) : [];
}
static listStar(...xs) {
if (xs.length === 0) {
throw new Error(`LIST* requires at least one argument`);
} else if (xs.length == 1) {
return xs[0];
} else {
let list = xs[xs.length-1];
for (let i = xs.length-2; i >= 0; i--) list = new Cons(xs[i], list);
return list;
}
}
[Symbol.iterator]() {
let ptr = this,
proper = true,
done = false;
return {
next: () => {
if (done || ptr === null) {
return { done: true };
} else if (!proper) {
done = true;
return { value: ptr.cdr, done: false };
} else if (ptr !== null && !(ptr.cdr instanceof Cons || ptr.cdr === null)) {
proper = false;
return { value: ptr.car, done: false };
} else {
let ret = { value: ptr.car, done: false }
ptr = ptr.cdr;
return ret;
}
}
};
}
}
class LispSymbol {
constructor(name, packageName) {
this.name = name;
this.packageName = packageName;
this.value = UNDEFINED;
this.fvalue = UNDEFINED;
this.stack = [];
this.isMacro = false;
this.isConstant = false;
this.isSpecial = false;
}
val() {
if (this.value === UNDEFINED)
throw new Error(`Variable '${this.name}' unbound`);
return this.value;
}
func() {
if (this.fvalue === UNDEFINED)
throw new Error(`Function '${this.name}' unbound`);
return this.fvalue;
}
setMacro() {
this.isMacro = true;
return this;
}
setConstant() {
this.isConstant = true;
return this;
}
pushBinding(v) {
this.stack.push(this.value);
this.value = v;
}
popBinding() {
this.value = this.stack.pop();
}
getPackage() {
return Package.get(this.packageName);
}
static bindSpecial(syms, vals, thunk) {
try {
for (let i = 0; i < syms.length; i++) {
const sym = syms[i];
if (sym.isConstant) {
throw new Error(`Can't bind constant`);
}
sym.stack.push(sym.value);
sym.value = vals[i];
}
return thunk();
} finally {
for (let i = 0; i < syms.length; i++) {
syms[i].value = syms[i].stack.pop();
}
}
}
static intern(packageName, name) {
if (readInteger(packageName).first())
throw new Error(`Symbol package must not be number: '${packageName}'`);
if (readInteger(name).first())
throw new Error(`Symbol name must not be number: '${name}'`);
return Package.get(packageName, true).intern(name);
}
// Returns a triple of name, package, and whether or not the symbol is
// external. For example, the token 'foo:bar' would cause this to be returned:
// ['bar', 'foo', true]. If the symbol is unqualified, external is null. For
// example: 'foo' => ['foo', null, null]
static parseSymbol(token) {
let accum = '';
for (let i = 0; i < token.str.length; i++) {
if (token.str[i] === ':'
&& token.str.length > i+2
&& token.str[i+1] === ':'
&& (token.firstPipe === null || token.firstPipe >= i+1)) {
return [token.str.substring(i+2), accum, false];
} else if (token.str[i] === ':'
&& token.str.length > i+1
&& token.str[i+1] !== ':'
&& (token.firstPipe === null || token.firstPipe >= i)) {
return [
token.str.substring(i+1),
accum.length ? accum : 'KEYWORD',
true
];
} else {
accum += token.str[i];
}
}
return [accum, null, null];
}
static kw(kwName, upcase = true) {
kwName = upcase ? kwName.toUpperCase() : kwName;
return LispSymbol.intern('KEYWORD', kwName);
}
// intern: whether or not the symbol should be interned
static createFromString(token, intern) {
let [name, pkgName, singleColon] = LispSymbol.parseSymbol(token);
if (pkgName === 'KEYWORD') return LispSymbol.intern('KEYWORD', name);
if (intern) {
if (pkgName) {
// The symbol is package-qualified
const pkg = Package.get(pkgName, true);
if (singleColon) {
// The symbol should exist and should be external
if (pkg.hasSymbol(name)) {
if (pkg.isExported(name)) {
return pkg.symbols.get(name);
} else {
throw new Error(`Symbol '${name}' not external in package '${pkgName}'`);
}
} else {
throw new Error(`Symbol '${name}' not found in package '${pkgName}'`);
}
} else {
// The symbol needn't exist nor be external; it will be created if
// necessary in its package and returned.
return pkg.intern(name);
}
} else {
// The symbol isn't qualified, so first attempt to resolve it using
// information stored in the current package.
const sym = PACKAGE.val().findSymbol(name, false).first();
// If the symbol wasn't found, intern in the current package.
return sym ? sym : PACKAGE.val().intern(name);
}
} else {
return new LispSymbol(name, null);
}
}
}
// TODO consider using a hash table instead of Map in the runtime, and
// then using LispStrings everywhere we currently use JS Strings
class LispString extends Array {
static fromString(str) {
return LispString.from(str.split(''));
}
toString() {
return this.join('');
}
}
class Values extends Array { }
const PACKAGES = new Map();
class Package {
constructor(name) {
this.name = name;
// Map of name JS strings to LispSymbol objects contained in this package
// Note that names may refer to symbols from different packages if they are
// imported
this.symbols = new Map();
// Set of JS String names (keys of this.symbols) that are exported
this.exports = new Set();
// The 'use list'; list of packages, the symbols of which to also search
this.use = [];
}
intern(name, exported = false) {
let sym = this.symbols.get(name)
if (!sym) {
sym = new LispSymbol(name, this.name);
this.symbols.set(name, sym);
if (this.name === 'KEYWORD') sym.setConstant();
}
if (exported || this.name === 'KEYWORD') {
this.exports.add(name);
}
return sym;
}
usePackage(otherPackage) {
this.use.push(otherPackage);
}
exportSymbol(name) {
this.exports.add(name);
}
hasSymbol(name) {
return this.symbols.has(name);
}
isExported(name) {
return this.exports.has(name);
}
findSymbol(name) {
if (this.symbols.has(name)) {
return new ReadValues(
this.symbols.get(name),
LispSymbol.kw(this.exports.has(name) ? 'external' : 'internal')
);
}
for (const usedPkg of this.use) {
if (usedPkg.isExported(name)) {
return new ReadValues(
usedPkg.symbols.get(name),
LispSymbol.kw('inherited')
);
}
}
return new ReadValues(null, null);
}
static intern(packageName, name) {
const pkg = Package.get(packageName, true);
return pkg.intern(name);
}
static get(packageName, throwNotFound = false) {
const pkg = PACKAGES.get(packageName);
if (!pkg && throwNotFound) {
throw new Error(`Package '${packageName}' does not exist`);
}
return pkg;
}
static makePackage(name, ...aliases) {
const newPackage = new Package(name);
for(const n of [name, ...aliases]) PACKAGES.set(n, newPackage);
return newPackage;
}
}
const JACLPKG = Package.makePackage('JACL');
const JSPKG = Package.makePackage('JS');
const CLPKG = Package.makePackage('COMMON-LISP', 'CL');
Package.makePackage('COMMON-LISP-USER', 'CL-USER');
Package.makePackage('KEYWORD');
// Temporary definitions for testing
JACLPKG.intern('!LOG').fvalue = console.log;
JACLPKG.intern('!ARRAY').fvalue = (...xs) => [...xs];
JACLPKG.intern('!<').fvalue = (x, y) => x < y ? true : null;
JACLPKG.intern('!>').fvalue = (x, y) => x > y ? true : null;
JACLPKG.intern('!+').fvalue = (x, y) => x+y;
JACLPKG.intern('!-').fvalue = (x, y) => x-y;
JACLPKG.intern('!EQL').fvalue = (x, y) => x === y ? true : null;
JACLPKG.intern('!*').fvalue = (x, y) => x*y;
// CL package constants
// TODO update this, look into constants
const CLCONSTS = new Map([
['T', true],
['NIL', null]
]);
for (const [k,v] of CLCONSTS) {
CLPKG.intern(k).setConstant().value = v;
CLPKG.exportSymbol(k);
}
// CL package functions set early as used by QUASIQUOTE
const CLFUNCS = new Map([
['LIST', Cons.listOf],
['APPEND', Cons.append],
['LIST*', Cons.listStar],
]);
for (const [k,v] of CLFUNCS) {
CLPKG.intern(k).fvalue = v;
CLPKG.exportSymbol(k);
}
// Lambda list keywords
for (const kw of [
// Ordinary lambda list keywords
'&ALLOW-OTHER-KEYS',
'&AUX',
'&KEY',
'&OPTIONAL',
'&REST',
// Macro lambda list keywords
'&BODY',
'&ENVIRONMENT',
'&WHOLE'
]) {
CLPKG.intern(kw);
CLPKG.exportSymbol(kw);
}
// Declaration-related symbols
CLPKG.intern('DECLARE');
CLPKG.exportSymbol('DECLARE');
JACLPKG.intern('ASYNC');
JACLPKG.exportSymbol('ASYNC');
JACLPKG.intern('REST-ARRAY');
JACLPKG.exportSymbol('REST-ARRAY');
// JS package constants
const JSCONSTS = new Map([
['+FALSE+', false],
['+NAN+', NaN],
['+NULL+', null],
['+TRUE+', true],
['+UNDEFINED+', undefined]
]);
for (const [k,v] of JSCONSTS) {
JSPKG.intern(k).setConstant().value = v;
JSPKG.exportSymbol(k);
}
const PACKAGE = CLPKG.intern('*PACKAGE*', true);
PACKAGE.isSpecial = true;
PACKAGE.value = Package.get('JACL');
JACLPKG.usePackage(CLPKG);
// Multiple values
// faux read macros, async friendly
class ReadValues {
constructor(...vals) {
this.vals = vals;
}
[Symbol.iterator]() {
return this.vals[Symbol.iterator]();
}
first() {
if (this.vals.length < 1) throw new Error("No first value");
return this.vals[0];
}
second() {
if (this.vals.length < 2) throw new Error("No second value");
return this.vals[1];
}
}
// real
const MV_EXPECTED = JACLPKG.intern("*MV-EXPECTED*")
MV_EXPECTED.isSpecial = true;
MV_EXPECTED.value = 1;
let MV = [];
const mValues = (...vals) => {
MV = vals.slice(0, Math.min(vals.length, MV_EXPECTED.value));
MV_EXPECTED.value = vals.length;
return MV.length ? MV[0] : null;
};
const mvArray = (thunk, n = Infinity) => {
try {
MV_EXPECTED.pushBinding(n);
const val = thunk();
return MV_EXPECTED.value === 1 ? [val] : MV.slice(0, MV_EXPECTED.value);
} finally {
MV_EXPECTED.popBinding();
}
};
mvArrayCall = (n, f, ...args) => {
return mvArray(() => f(...args), n);
};
class StringStream {
constructor(str) {
this.ptr = 0;
this.str = str;
}
unread(ch) {
this.ptr--;
}
read() {
if (this.ptr < this.str.length) {
return this.str[this.ptr++];
} else {
return EOF;
}
}
*[Symbol.iterator]() {
while (true) yield this.read();
}
}
class BufferedStream {
constructor() {
this.buf = [];
this.resolveQueue = [];
}
write(obj) {
if (this.resolveQueue.length) {
this.resolveQueue.shift()(obj);
} else {
this.buf.push(obj);
}
}
writeEach(xs) {
for (const x of xs) this.write(x);
}
unread(obj) {
if (this.resolveQueue.length) {
this.resolveQueue.shift()(obj)
} else {
this.buf.unshift(obj);
}
}
async read() {
if (this.buf.length) {
return Promise.resolve(this.buf.shift());
} else {
return new Promise(resolve => this.resolveQueue.push(resolve));
}
}
[Symbol.asyncIterator]() {
return {
next: () => this.read().then(obj => {
return { value: obj, done: false };
})
}
}
}
class ReadTable {
constructor() {
this.macros = new Map();
this.terminatingMacros = new Set();
// Map<dispatch-char, Map<sub-char, async function(stream)>>
this.dispatchMacros = new Map();
}
setMacro(ch, isTerminating, fun) {
this.macros.set(ch, fun);
if (isTerminating) this.terminatingMacros.add(ch);
return this;
}
isTerminating(ch) {
return this.terminatingMacros.has(ch);
}
getMacro(ch) {
if (this.dispatchMacros.has(ch)) {
return async stream => {
const subCh = await stream.read(),
mFn = this.dispatchMacros.get(ch).get(subCh);
if (mFn === undefined)
throw new Error(`No macro for dispatch char '${ch}' and sub-char '${subCh}'`);
return await mFn(stream);
};
}
if (this.macros.has(ch)) {
return this.macros.get(ch);
}
return null;
}
makeDispatchMacroChar(ch, nonTerminating = false) {
if (!nonTerminating) this.terminatingMacros.add(ch);
this.dispatchMacros.set(ch, new Map());
return this;
}
setDispatchMacroChar(dispCh, ch, asyncFunc) {
if (!this.dispatchMacros.has(dispCh))
throw new Error(`No dispatch char: ${dispCh}`);
this.dispatchMacros.get(dispCh).set(ch, asyncFunc);
return this;
}
clone() {
throw new Error(`Not implemented`);
}
}
const READTABLE = Package.intern('CL', '*READTABLE*');
const interpretToken = (token, intern) => {
const [isInt, intVal] = readInteger(token.str);
if (isInt) return intVal;
const sym = LispSymbol.createFromString(token, intern);
if (eqClSym(sym, 'NIL')) {
return null;
} else if (eqClSym(sym, 'T')) {
return true;
}
return sym;
};
const listSentinels = new Map([
['.', new Object()],
[')', new Object()]
]);
const readList = async stream => {
const rdr = new Reader(stream);
let x, car;
x = await rdr.read(true, listSentinels);
if (x === listSentinels.get('.'))
throw new Error(`Nothing before . in list`);
if (x === listSentinels.get(')'))
return new ReadValues(null);
car = x;
x = await rdr.read(true, listSentinels);
if (x === listSentinels.get('.')) {
x = await rdr.read(true, listSentinels);
if (x === listSentinels.get(')'))
throw new Error(`Nothing after . in list`);
const cdr = x;
x = await rdr.read(true, listSentinels);
if (x === listSentinels.get(')'))
return new ReadValues(new Cons(car, cdr));
throw new Error(`More than one object after . in list`);
}
if (x === listSentinels.get(')'))
return new ReadValues(new Cons(car));
return new ReadValues(new Cons(car, new Cons(x, (await readList(stream)).first())));
}
const readString = async stream => {
let str = new LispString();
for await(const x of stream) {
if (x === '"') {
return new ReadValues(str);
} else if(x === '\\') {
str.push(await stream.read());
} else {
str.push(x);
}
}
};
// TODO make this a real JS string reader
const readJsString = async stream => {
const [clStr] = await readString(stream);
return new ReadValues(clStr.toString());
};
const readGlobalReference = async stream => {
const sym = await readMultiEscaped(stream, new Token().sawPipe(), false),
parts = sym.name.split('.'),
[topic, ...fields] = parts;
return new ReadValues(Cons.listOf(
JACLPKG.intern('.'),
Cons.listOf(JACLPKG.intern('%JS'), topic),
...fields.map(x => new LispSymbol(x, null))
));
};
const readAwait = async stream => {
return new ReadValues(Cons.listOf(
JACLPKG.intern('AWAIT'),
await (new Reader(stream)).read()
));
}
READTABLE.value = new ReadTable()
.setMacro(';', true, async stream => {
for await(const ch of stream) {
if (ch === '\n') return new ReadValues();
}
})
.setMacro('"', true, readString)
.setMacro('(', true, readList)
.setMacro("'", true, async stream => {
return new ReadValues(Cons.listOf(
Package.intern('CL', 'QUOTE'),
await (new Reader(stream)).read()
));
})
.setMacro("`", true, async stream => {
return new ReadValues(Cons.listOf(
JACLPKG.intern('QUASIQUOTE'),
await new Reader(stream).read()
));
})
.setMacro(',', true, async stream => {
const ch = await stream.read();
if (ch === '@') {
return new ReadValues(Cons.listOf(
JACLPKG.intern('UNQUOTE-SPLICING'),
await new Reader(stream).read()
));
} else {
stream.unread(ch);
return new ReadValues(Cons.listOf(
JACLPKG.intern('UNQUOTE'),
await new Reader(stream).read()
));
}
})
.makeDispatchMacroChar('#', true)
.setDispatchMacroChar('#', ':', async stream => {
const rdr = new Reader(stream),
sym = await rdr.read(false);
if (sym instanceof LispSymbol && sym.packageName === null) {
return new ReadValues(sym);
} else if (sym instanceof LispString && sym.packageName !== null) {
throw new Error(`Object after #: contains a package marker`);
} else {
throw new Error(`Object after #: not a symbol`);
}
})
.setDispatchMacroChar('#', '\\', async stream => {
return new ReadValues(await stream.read());
})
.setDispatchMacroChar('#', '<', async stream => {
throw new Error(`Illegal # char: <`);
})
.setDispatchMacroChar('#', "'", async stream => {
return new ReadValues(Cons.listOf(
Package.intern('CL', 'FUNCTION'),
await (new Reader(stream)).read()
));
});
const isWhitespace = ch => ' \t\n\r\b'.indexOf(ch) > -1;
const isConstituent = ch => {
return /[A-Za-z]/.test(ch)
|| '!$%&*+-./:<=>?@[]^_{}~'.indexOf(ch) > -1
|| /[0-9]/.test(ch);
}
const symCharNames = new Map([
['!', '_BANG_'],
['$', '_DOLLAR_'],
['%', '_PERCENT_'],
['&', '_AMP_'],
['*', '_STAR_'],
['+', '_PLUS_'],
['-', '_DASH_'],
['.', '_DOT_'],
['/', '_SLASH_'],
[':', '_COLON_'],
['<', '_LT_'],
['=', '_EQUAL_'],
['>', '_GT_'],
['?', '_QMARK_'],
['@', '_AT_'],
['[', '_LBRACE_'],
[']', '_RBRACE_'],
['^', '_CARET_'],
['_', '_UNDERSCORE_'],
['{', '_LBRACK_'],
['}', '_RBRACK_'],
['~', '_TILDE_'],
[' ', '_SPACE_'],
['#', '_SHARP_']
]);
const munge = s => {
let munged = '';
for (const ch of s) {
if (symCharNames.has(ch)) {
munged += symCharNames.get(ch);
} else {
munged += ch;
}
}
return munged;
};
const mungeSym = (sym, prefix = '') => {
prefix = prefix !== '' ? (prefix + '_') : '';
if (sym.packageName === undefined || PACKAGE.val().name === sym.packageName) {
return prefix + munge(sym.name);
} else {
return prefix + munge(sym.packageName) + '$' + munge(sym.name);
}
};
class Token {
constructor(initial = '') {
this.str = initial;
this.firstPipe = null;
}
add(ch) {
this.str += ch;
}
sawPipe() {
if (this.firstPipe === null) this.firstPipe = this.str.length;
return this;
}
}
const readMultiEscaped = async function(stream, token, intern = true) {
for await(const y of stream) {
if (isConstituent(y) || READTABLE.val().isTerminating(y) || isWhitespace(y)) {
token.add(y);
continue;
} else if (y === '\\') {
token.add(await stream.read());
continue;
} else if (y === '|') {
return readSingleEscaped(stream, token.sawPipe());
} else {
throw new Error(`Illegal character: '${y}'`);
}
}
};
const readInteger = token => {
if (/^[+-]?[0-9]+\.?$/.test(token)) {
return new ReadValues(true, window.parseInt(token));
} else {
return new ReadValues(false, null);
}
};
const readSingleEscaped = async function(stream, token, intern = true) {
for await(const y of stream) {
// # is a "non-terminating macro char" and so may appear in the
// # middle of a token.
if (isConstituent(y) || y === '#') {
token.add(y.toUpperCase());
continue;
} else if (y === '\\') {
token.add(await stream.read());
continue;
} else if (y === '|') {
return readMultiEscaped(stream, token.sawPipe());
} else if (READTABLE.val().isTerminating(y) || isWhitespace(y) || y === ')') {
stream.unread(y);
return interpretToken(token, intern);
} else {
throw new Error(`Illegal character: '${y}'`);
}
}
};
class Reader {
constructor(stream) {
this.stream = stream;
}
static of(stream) {
return new Reader(stream);
}
async read(internSymbols = true, charSentinels = new Map()) {
let macroFun;
for await(const x of this.stream) {
if (x === EOF) {
return EOF;
} else if (isWhitespace(x)) {
continue;
} else if (charSentinels.has(x)) {
return charSentinels.get(x);
} else if (macroFun = READTABLE.val().getMacro(x)) {
const vals = [...await macroFun(this.stream)];
if (vals.length) {
return vals[0];
} else {
continue;
}
} else if (x === '\\') {
let y = new Token(await this.stream.read());
return readSingleEscaped(this.stream, y, internSymbols);
} else if (x === '|') {
return readMultiEscaped(this.stream, new Token().sawPipe(), internSymbols);
} else if (isConstituent(x)) {
return readSingleEscaped(this.stream, new Token(x.toUpperCase()), internSymbols);
} else {
throw new Error(`Illegal character: '${x}'`);
}
}
}
[Symbol.asyncIterator]() {
return {
next: () => this.read().then(obj => {
return { value: obj, done: false };
})
}
}
}
// Special forms
const SPECIAL_FORMS = [
'%CALL',
'%DOT',
'%LAMBDA',
'%LET',
'%NEW',
'%PROGN',
'%SETQ',
'%TAGBODY',
'%GO',
'%JS',
'%IF',
'%THROW'
];
for (const s of SPECIAL_FORMS) {
JACLPKG.intern(s);
JACLPKG.exportSymbol(s);
}
CLPKG.intern('QUOTE').setMacro().fvalue = function(env, form, x) {
return Cons.listOf(JACLPKG.intern('%QUOTE'), x);
};
JACLPKG.intern('UNQUOTE').setMacro().fvalue =
JACLPKG.intern('UNQUOTE-SPLICING').setMacro().fvalue = function(env, form) {
throw new Error(`Comma not inside backquote`);
};
JACLPKG.intern('QUASIQUOTE').setMacro().fvalue = function(env, form) {
const callCL = (funcName, ...args) => Cons.listOf(CLPKG.intern(funcName), ...args); ;
const transform = (form, wrapInList = true) => {
const maybeWrap = x => wrapInList ? callCL('LIST', x) : x;
if (form instanceof Cons && JACLPKG.intern('UNQUOTE') === form.car) {
return maybeWrap(form.cdr.car);
} else if (form instanceof Cons && JACLPKG.intern('UNQUOTE-SPLICING') === form.car) {
return form.cdr.car;
} else {
return maybeWrap(transformQuasiquoteArgument(form));
}
};
const transformCompound = compound => {
const rec = object => {
if (object instanceof Cons &&
(!(object.cdr instanceof Cons) ||
(object.cdr instanceof Cons && JACLPKG.intern('UNQUOTE') === object.cdr.car))) {
return Cons.listOf(transform(object.car), transform(object.cdr, false));
} else if (object instanceof Cons &&
(object.cdr instanceof Cons && JACLPKG.intern('UNQUOTE-SPLICING') === object.cdr.car)) {
throw new Error(`UNQUOTE-SPLICING in dotted list`);
} else {
return new Cons(transform(object.car), rec(object.cdr));
}
};
return rec(compound);
};
const transformQuasiquoteArgument = argument => {
if (argument instanceof Cons && JACLPKG.intern('UNQUOTE') === argument.car) {
return argument.cdr.car;
} else if (argument instanceof Cons && JACLPKG.intern('UNQUOTE-SPLICING') === argument.car) {
throw new Error(`UNQUOTE-SPLICING at top`);
} else if (argument instanceof Cons) {
return callCL('APPEND', ...transformCompound(argument));
} else {
return callCL('QUOTE', argument);
}
};
const expand = form => {
if (form instanceof Cons) {
const expanded = new Cons(expand(form.car), expand(form.cdr));
if (JACLPKG.intern('QUASIQUOTE') === expanded.car) {
return transformQuasiquoteArgument(expanded.cdr.car);
} else {
return expanded;
}
} else {
return form;
}
};
return expand(form);
};
const isMacroForm = form => {
return form instanceof Cons
&& form.car
&& form.car instanceof LispSymbol
&& form.car.isMacro;
};
const isLambdaForm = form => {
return form instanceof Cons
&& form.car
&& form.car instanceof LispSymbol
&& (
(form.car.packageName === 'COMMON-LISP' && form.car.name === 'LAMBDA')
|| (form.car.packageName === 'JACL' && form.car.name === '%LAMBDA')
);
}
const merge = (...objs) => Object.assign(Object.create(null), ...objs);
const makeNode = (op, ...objs) => merge({ op: op }, ...objs);
const analyzeBlock = (env, parent, forms) => {
let stmts = forms.slice(0, forms.length-1)
.map(x => analyze(env.withContext('stmt'), parent, x)),
ret;
if (forms.length <= 1) {
ret = analyze(env.withContext(env.context === 'stmt' ? 'stmt' : 'return'), parent, forms.length ? forms[0] : null);
} else {
ret = analyze(
env.withContext(env.context === 'stmt' ? 'stmt' : 'return'),
parent,
forms.slice(forms.length-1)[0]
)
}
let children = [...stmts];
if (ret) children.push(ret);
for (const child of children) {
child.parent = parent;
}
return { statements: stmts, ret: ret, children: children };
};
const eqClSym = (x, name) => (x instanceof LispSymbol) &&
x.packageName === 'COMMON-LISP' &&
x.name === name;
const parseLambdaList = (list, isMacro) => {
const checkValidLocal = x => {
if (!(x instanceof LispSymbol) || x.packageName == 'KEYWORD')
throw new Error(`${x} not a valid local variable`);
return x;
};
let arr = List.toArray(list),
sections = {
// Array of symbols
required: [],
// Array of [symbol, expr, symbol] for [name, init, svar]
optional: [],
// Array of &optional svar names (symbols)
optionalSvars: [],
// null or symbol
rest: null,
// Array of [symbol, expr, symbol] for [key, name, init, svar]
key: [],
// Array of &key svar names (symbols)
keySvars: [],
// Bool, whether other keys allowed (can still be set at runtime by passing
// :allow-other-keys t etc
keyAllowOthers: false,
// Array of [symbol, expr] for [name, init]
aux: [],
// Macro lambda list only
// null or symbol
body: null,
// null or symbol
environment: null,
// null or symbol
whole: null
},
state = 'required';
while (arr.length) {
const x = arr.shift();
switch (state) {
case 'required':
if (eqClSym(x, '&OPTIONAL')
|| eqClSym(x, '&KEY')
|| eqClSym(x, '&REST')
|| eqClSym(x, '&AUX')) {
state = x.name.substring(1).toLowerCase();
} else if (eqClSym(x, '&BODY')
|| eqClSym(x, '&ENVIRONMENT')
|| eqClSym(x, '&WHOLE')) {
if (isMacro) {
state = x.name.substring(1).toLowerCase();
} else {
throw new Error(`&${x.name.substring(1).toUpperCase()} may only appear in a macro lambda list`)
}
} else if (eqClSym(x, '&ALLOW-OTHER-KEYS')) {
throw new Error(`Misplaced ${x.name}`);
} else if (x instanceof LispSymbol) {
sections.required.push(checkValidLocal(x));
} else {
throw new Error(`Required argument is not a symbol`);
}
break;
case 'optional':
if (eqClSym(x, '&OPTIONAL')) {
throw new Error(`Repeated &OPTIONAL`);
} else if (eqClSym(x, '&KEY')
|| eqClSym(x, '&REST')
|| eqClSym(x, '&AUX')) {
state = x.name.substring(1).toLowerCase();
} else if (eqClSym(x, '&ALLOW-OTHER-KEYS')) {
throw new Error(`Misplaced ${x.name} after &OPTIONAL`);
} else if (x instanceof LispSymbol) {
sections.optional.push({
name: checkValidLocal(x),
initform: UNDEFINED,
svar: UNDEFINED
});
} else if (List.isProperList(x)) {
const len = List.length(x);
if (len === 0 || len > 3)
throw new Error(`&OPTIONAL parameter list wrong size`);
let svar = UNDEFINED;
if (len === 3) {
svar = checkValidLocal(List.nth(x, 2));
sections.optionalSvars.push(svar);
}
sections.optional.push({
name: checkValidLocal(x.car),
initform: len > 1 ? List.nth(x, 1) : UNDEFINED,
svar: svar
});
} else {
throw new Error(`&OPTIONAL parameter not symbol or valid list`);
}
break;
case 'body':
case 'rest':
if (sections.body || sections.rest)
throw new Error(`Too many &REST/&BODY`);
if (eqClSym(x, '&ALLOW-OTHER-KEYS'))
throw new Error(`Expected variable after &${state.toUpperCase()}, got ${x.name}`);
if (!(x instanceof LispSymbol))
throw new Error(`&${state.toUpperCase()} parameter not a symbol`);
sections[state] = x;
state = `after-${state}`;
break;
case 'after-body':
case 'after-rest':
if (eqClSym(x, '&REST') || eqClSym(x, '&BODY')) {
throw new Error(`Too many &REST/&BODY`)
} else if (eqClSym(x, '&OPTIONAL')
|| eqClSym(x, '&KEY')
|| eqClSym(x, '&AUX')) {
state = x.name.substring(1).toLowerCase();
if (sections[state].length)
throw new Error(`Duplicate ${x.name}`);
} else if (eqClSym(x, '&ALLOW-OTHER-KEYS')) {
throw new Error(`Misplaced ${x.name} after &${state.split("-")[1].toUpperCase()}`);
} else {
throw new Error(`Expected keyword after &${state.split("-")[1].toUpperCase()} param`);
}
break;
case 'key':
// TODO (keyword var) e.g. ((:foo foo))
if (eqClSym(x, '&KEY')) {
throw new Error(`Repeated &KEY`);
} else if (eqClSym(x, '&ALLOW-OTHER-KEYS')) {
if (sections.keyAllowOther)
throw new Error(`Duplicate &ALLOW-OTHER-KEYS`);
sections.keyAllowOthers = true;
} else if (eqClSym(x, '&OPTIONAL') || eqClSym(x, '&REST') || eqClSym(x, '&BODY')) {
throw new Error(`Misplaced ${x.name}`);
} else if (eqClSym(x, '&AUX')) {
state = 'aux';
} else if (x instanceof LispSymbol) {
const key = LispSymbol.intern('KEYWORD', x.name);
sections.key.push({
key: key,
name: checkValidLocal(x),
initform: UNDEFINED,
svar: UNDEFINED
});
} else if (List.isProperList(x)) {
const len = List.length(x);
if (len === 0 || len > 3)
throw new Error(`&KEY parameter list wrong size`);
const key = LispSymbol.intern('KEYWORD', x.car.name);
let svar = UNDEFINED;
if (len === 3) {
svar = checkValidLocal(List.nth(x, 2));
sections.keySvars.push(svar);
}
sections.key.push({
key: key,
name: checkValidLocal(x.car),
initform: len > 1 ? List.nth(x, 1) : UNDEFINED,
svar: svar
});
} else {
throw new Error(`&KEY parameter not symbol or valid list`);
}
break;
case 'whole':
if (eqClSym(x, '&WHOLE')) {
throw new Error(`Repeated &WHOLE`);
} else if (eqClSym(x, '&OPTIONAL')
|| eqClSym(x, '&KEY')
|| eqClSym(x, '&REST')
|| eqClSym(x, '&BODY')
|| eqClSym(x, '&ENVIRONMENT')) {
throw new Error(`Misplaced ${x.name}`);
} else if (sections.whole) {
throw new Error(`Duplicate &WHOLE`);
} else if (x instanceof LispSymbol) {
sections.whole = x
state = 'required';
} else {
throw new Error(`&WHOLE parameter not a symbol`);
}
break;
case 'environment':
if (eqClSym(x, '&ENVIRONMENT')) {
throw new Error(`Repeated &ENVIRONMENT`);
} else if (eqClSym(x, '&OPTIONAL')
|| eqClSym(x, '&KEY')
|| eqClSym(x, '&REST')
|| eqClSym(x, '&WHOLE')
|| eqClSym(x, '&BODY')) {
throw new Error(`Misplaced ${x.name}`);
} else if (sections.environment) {
throw new Error(`Duplicate &ENVIRONMENT`);
} else if (x instanceof LispSymbol) {
sections.environment = x
state = 'required';
} else {
throw new Error(`&ENVIRONMENT parameter not a symbol`);
}
break;
case 'aux':
if (eqClSym(x, '&AUX')) {
throw new Error(`Repeated &AUX`);
} else if (eqClSym(x, '&OPTIONAL')
|| eqClSym(x, '&KEY')
|| eqClSym(x, '&REST')
|| eqClSym(x, '&BODY')) {
throw new Error(`Misplaced ${x.name}`);
} else if (x instanceof LispSymbol) {
sections.aux.push({ name: checkValidLocal(x), initform: UNDEFINED });
} else if (List.isProperList(x)) {
if (List.length(x) !== 2)
throw new Error(`&AUX parameter list wrong size`);
sections.aux.push({
name: checkValidLocal(x.car),
initform: x.cdr.car
});
} else {
throw new Error(`&AUX parameter not symbol or valid list`);
}
break;
}
}
return sections;
};
const analyzeLambdaList = (env, parent, list, isMacro) => {
const sections = parseLambdaList(list, isMacro),
locals = [...sections.required],
envId = env.counter();
const initforms = [];
for (const spec of sections.optional) {
if (spec.initform !== UNDEFINED) {
spec.initform = analyze(env.withLocals(locals, envId), parent, spec.initform);
initforms.push(spec.initform)
}
locals.push(spec.name);
if (spec.svar !== UNDEFINED) {
locals.push(spec.svar);
}
}
if (sections.rest)
locals.push(sections.rest);
if (sections.body)
locals.push(sections.body);
if (sections.environment)
locals.push(sections.environment);
if (sections.whole)
locals.push(sections.whole);
for (const spec of sections.key) {
if (spec.initform !== UNDEFINED) {
spec.initform = analyze(env.withLocals(locals, envId), parent, spec.initform);
initforms.push(spec.initform)
}
locals.push(spec.name);
if (spec.svar !== UNDEFINED) {
locals.push(spec.svar);
}
}
for (const spec of sections.aux) {
if (spec.initform !== UNDEFINED) {
spec.initform = analyze(env.withLocals(locals, envId), parent, spec.initform);
initforms.push(spec.initform)
}
locals.push(spec.name);
}
return {
lambdaList: sections,
initforms: initforms,
bodyEnv: env.withLocals(locals, envId),
envId: envId
};
};
const stringy = x => x instanceof String || typeof x === 'string' || x instanceof LispString;
const isTag = x => x instanceof LispSymbol
|| typeof x === 'number'
|| x instanceof Number;
const asTagName = x => x instanceof LispSymbol ? x.name : x.valueOf();
const analyzeSpecials = new Map([
[JACLPKG.intern('%QUOTE'), (env, parent, form) => {
const [, obj] = form;
return makeNode('constant', {
env: env,
parent: parent,
children: [],
form: obj
});
}],
[JACLPKG.intern('%DOT'), (env, parent, form) => {
const [, target, field] = form;
if (!(field instanceof LispSymbol || stringy(field)))
throw new Error(`%DOT field must be a symbol, JS string, or Lisp string`)
const node = makeNode('js-field', {
env: env,
parent: parent,
form: form,
field: field instanceof LispSymbol ? field.name : field.toString()
});
node.target = analyze(env.withContext('expr'), node, target);
node.children = [node.target];
return node;
}],
[JACLPKG.intern('%CALL'), (env, parent, form) => {
const [, func, ...args] = form;
const node = makeNode('call', { env: env, parent: parent, form: form });
node.f = analyze(env.withContext('expr'), node, func);
node.args = args.map(analyze.bind(null, env.withContext('expr'), node))
node.children = [node.f, ...node.args];
return node;
}],
[JACLPKG.intern('%LAMBDA'), (env, parent, form) => {
let [, name, isMacro, list, ...body] = form;
let declarations = [];
if (body.length > 0
&& List.isProperList(body[0])
&& (List.first(body[0]) === CLPKG.intern('DECLARE'))) {
declarations = List.toArray(List.rest(body[0]));
body = body.slice(1);
}
env = name ? env.withLocalFunctions([name]) : env;
name = name ? mungeSym(name, `flocal_${env.functionEnvId(name)}`) : "";
node = makeNode('lambda', {
env: env,
parent: parent,
form: form,
name: name,
declarations: declarations,
isMacro: isMacro
});
const { lambdaList, initforms, bodyEnv, envId } = analyzeLambdaList(
env.withContext('expr'), node, list, isMacro
);
node.lambdaList = lambdaList;
node = merge(node, analyzeBlock(bodyEnv, node, body));
node.envId = envId;
node.children = [...node.children, ...initforms];
return node;
}],
[JACLPKG.intern('%JS'), (env, parent, form) => {
const [, template, ...args] = form,
templateStr = template.toString(),
numPlaceholders = (templateStr.match(/~{}/g) || []).length;
if (numPlaceholders !== args.length)
throw new Error(`%JS wrong number of arguments`);
const node = makeNode('js', { env: env, parent: parent, form: form });
node.args = args.map(x => analyze(env.withContext('expr'), node, x));
node.children = node.args;
node.template = templateStr;
return node;
}],
[JACLPKG.intern('%NEW'), (env, parent, form) => {
const [, ctor, ...args] = form;
const node = makeNode('new', { env: env, parent: parent, form: form });
node.ctor = analyze(env.withContext('expr'), node, ctor);
node.args = args.map(x => analyze(env.withContext('expr'), node, x));
node.children = [node.ctor, ...node.args];
return node;
}],
[JACLPKG.intern('%THROW'), (env, parent, form) => {
const [, obj] = form;
const node = makeNode('throw', { env: env, parent: parent, form: form });
node.obj = analyze(env.withContext('expr'), node, obj);
node.children = [node.obj];
return node;
}],
[JACLPKG.intern('%LET'), (env, parent, form) => {
const [, bindings, ...body] = form;
const node = makeNode('let', {
env: env,
parent: parent,
form: form
});
node.locals = [];
node.envId = env.counter();
node.specials = [];
for (const binding of List.toArray(bindings)) {
if (!List.isProperList(binding) || !List.length || (List.length(binding) > 2))
throw new Error(`Improper %LET binding`);
let name = binding.car, expr;
if (List.length(binding) === 1) {
expr = null;
} else {
expr = binding.cdr.car;
}
const val = analyze(env.withContext('expr'), node, expr);
if (name.isSpecial) {
node.specials.push([name, val]);
} else {
node.locals.push([name, val]);
}
}
return merge(
node,
analyzeBlock(
env.withLocals(node.locals.map(([name]) => name), node.envId),
node,
body
)
);
}],
[JACLPKG.intern('%PROGN'), (env, parent, form) => {
const [, ...body] = form;
const node = makeNode('progn', {
env: env,
parent: parent,
form: form
});
return merge(node, analyzeBlock(env, node, body));
}],
[JACLPKG.intern('%SETQ'), (env, parent, form) => {
const [, target, val] = form;
if (!(target instanceof LispSymbol))
throw new Error(`Can't assign to non-symbol`);
const valExpr = analyze(env.withContext('expr'), null, val);
let op, envId;
if (env.hasLocal(target)) {
// Local
op = 'set-local';
} else {
// Global
if (target.isConstant) throw new Error(`Can't set constant`);
op = 'set-global';
}
const node = makeNode(op, { env: env, parent: parent, form: form });
if (op === 'set-local') {
node.envId = env.localEnvId(target);
}
node.targetSym = target;
node.val = valExpr;
node.val.parent = node;
node.children = [node.val];
return node;
}],
[JACLPKG.intern('%TAGBODY'), (env, parent, form) => {
const [, ...tagsStmts] = form;
// Map from tag names (string or int) to arrays of statements
// Any statements that appear before a tag are stored with the null tag
// Tags/statements are processed in multiple passes because any parent tag
// can be jumped to from any child even if the child appears syntactically
// after the tag
// First pass: gather tags and statements, don't analyze
const tags = new Map();
let currentTag = null, currentStmts = [];
for (const x of tagsStmts) {
if (isTag(x)) {
tags.set(currentTag, currentStmts);
currentTag = asTagName(x);
currentStmts = [];
} else {
currentStmts.push(x);
}
}
tags.set(currentTag, currentStmts);
const node = makeNode('tagbody', {
env: env,
parent: parent,
form: form,
id: env.newId()
});
node.prelude = tags.get(null);
tags.delete(null);
const childEnv = env
.withContext('stmt')
.withTags(node.id, Array.from(tags.keys()));
const ana = analyze.bind(null, childEnv, node);
node.children = [];
let tagId = 0;
for (const [tag, stmts] of tags) {
tags.set(tag, [tagId++, stmts.map(ana)]);
node.children = [...node.children, ...tags.get(tag)[1]];
}
node.tags = tags;
node.prelude = node.prelude.map(ana);
node.children = [...node.prelude, ...node.children];
return node;
}],
[JACLPKG.intern('%GO'), (env, parent, form) => {
const [, tag] = form;
if (!isTag(tag)) throw new Error(`Invalid GO tag`);
const tagName = asTagName(tag);
if (!env.hasTag(tagName))
throw new Error(`Non-existent GO tag: ${tagName}`);
const [tagbodyId, tagId] = env.tags.get(tagName);
return makeNode('go', {
env: env,
parent: parent,
form: form,
tagName: tagName,
tagbodyId: tagbodyId,
tagId: tagId,
children: []
});
}],
[JACLPKG.intern('%IF'), (env, parent, form) => {
if ([...form].length < 3) throw new Error(`IF requires at least 2 args`);
let [, pred, expr0, expr1] = form;
if (expr1 === undefined)
expr1 = null;
const childEnv = env.context === 'return' ? env.withContext('expr') : env;
const node = makeNode('if', {
env: env,
parent: parent,
form: form
});
const testNode = analyze(env.withContext('expr'), node, pred),
thenNode = analyze(childEnv, node, expr0),
elseNode = analyze(childEnv, node, expr1);
node.testNode = testNode;
node.thenNode = thenNode;
node.elseNode = elseNode;
node.children = [testNode, thenNode, elseNode];
return node;
}]
]);
const parseCall = (env, parent, form) => {
const [func, ...args] = form;
let node = makeNode('call', { env: env, parent: parent, form: form });
node.args = args.map(analyze.bind(null, env.withContext('expr'), node));
if (isLambdaForm(func)) {
node.f = analyze(env.withContext('expr'), parent, func);
} else if (env.hasLocalFunction(func)) {
node.f = makeNode('flocal', {
env: env.withContext('expr'),
envId: env.functionEnvId(func),
parent: node,
form: func,
children: []
});
} else if (func instanceof LispSymbol) {
node.f = makeNode('global', {
env: env.withContext('expr'),
parent: node,
form: func,
slot: 'function',
children: []
});
}
node.children = [node.f, ...node.args];
return node;
};
const analyzeList = (env, parent, form) => {
if (isMacroForm(form)) {
while (isMacroForm(form)) {
const [sym, ...args] = form;
form = sym.func()(env, form, ...args);
}
return analyze(env, parent, form);
} else if (analyzeSpecials.has(form.car)) {
return analyzeSpecials.get(form.car)(env, parent, form);
} else if (isLambdaForm(form.car) || form.car instanceof LispSymbol) {
return parseCall(env, parent, form);
} else {
throw new Error(`Invalid call`)
}
};
const analyzeSymbol = (env, parent, form) => {
const node = makeNode(null, { env: env, parent: parent, form: form });
if (form.packageName === 'KEYWORD') {
node.op = 'constant';
} else if (form.packageName === 'JS' && !form.getPackage().isExported(form.name)) {
// TODO Explode if the name isn't a valid JS identifier
node.op = 'js-var';
node.name = form.name;
} else if (env.hasLocal(form)) {
node.op = 'local';
node.envId = env.localEnvId(form);
} else {
node.op = 'global';
node.slot = 'value';
}
node.children = [];
return node;
};
const makeCounter = () => {
let i = 0;
return () => i++;
};
class Env {
constructor(init = true) {
if (init) Env.init(this);
return this;
}
static init(env) {
// sym => envId
env.locals = new Map();
env.localFunctions = new Map();
// sym => tagbodyName
env.tags = new Map();
env.context = 'expr';
env.counter = makeCounter();
return env;
}
clone() {
const newEnv = new Env(false);
newEnv.locals = new Map(this.locals);
newEnv.localFunctions = new Map(this.localFunctions);
newEnv.tags = new Map(this.tags);
newEnv.context = this.context;
newEnv.counter = this.counter;
return newEnv;
}
withLocals(syms, envId = this.counter()) {
const newEnv = this.clone();
newEnv.locals = new Map([
...this.locals,
...syms.map(sym => [sym, envId])
]);
return newEnv;
}
withLocalFunctions(syms, envId = this.counter()) {
const newEnv = this.clone();
newEnv.localFunctions = new Map([
...this.localFunctions,
...syms.map(sym => [sym, envId])
]);
return newEnv;
}
newId() {
return this.counter();
}
withTags(tagbodyId, tags) {
const newEnv = this.clone();
newEnv.tags = new Map([
...this.tags,
...tags.map((tag, tagId) => [tag, [tagbodyId, tagId]])
]);
return newEnv;
}
localEnvId(sym) {
return this.locals.get(sym);
}
hasLocal(sym) {
return this.locals.has(sym);
}
functionEnvId(sym) {
return this.localFunctions.get(sym);
}
hasLocalFunction(sym) {
return this.localFunctions.has(sym);
}
hasTag(tag) {
return this.tags.has(tag);
}
withContext(context) {
const newEnv = this.clone();
newEnv.context = context;
return newEnv;
}
}
const emptyEnv = () => new Env(true);
const analyze = (env, parent, form) => {
if (form instanceof LispSymbol) {
return analyzeSymbol(env, parent, form);
} else if (form instanceof Cons) {
return analyzeList(env, parent, form);
} else {
return makeNode('constant', { env: env, parent: parent, children: [], form: form });
}
};
// TODO Consider turning this into an iterator function.
const findNodes = (root, pred) => {
let found = [];
if (pred(root))
found.push(root);
for (const x of root.children) {
found = [...found, ...findNodes(x, pred)];
}
return found;
};
const tagbodyPreludeGos = tagbody => {
return findNodes({ children: tagbody.prelude }, x => x.op === 'go');
};
const optimizeGo = node => {
const gos = findNodes(node, x => {
return x.op === 'go' && x.context !== 'expr';
});
next: for (const go of gos) {
let parent = go.parent;
while (parent) {
if (parent.op === 'tagbody'
&& go.tagbodyId === parent.id
&& !tagbodyPreludeGos(parent).includes(go)) {
go.op = 'go-continue';
continue next;
}
if (parent.op === 'lambda')
continue next;
parent = parent.parent;
}
}
};
const optimizeTagbody = node => {
const tbs = findNodes(node, x => x.op === 'tagbody');
next: for (const tb of tbs) {
const gos = findNodes(tb, x => x.op === 'go' && x.tagbodyId === tb.id);
// If gos is empty, tb has no GOs that will throw exceptions.
if (!gos.length)
tb.op = 'tagbody-static';
}
};
const optimize = node => {
optimizeGo(node);
// TODO: optimizeTagbody(node);
return node;
};
const escapeSingle = name => name.replace(/'/g, "\\'");
const constantCode = val => {
if (val instanceof LispSymbol && !val.packageName) {
return `new LispSymbol('${escapeSingle(val.name)}', null)`;
} else if (val instanceof LispSymbol) {
return `Package.get('${escapeSingle(val.packageName)}', true).intern('${escapeSingle(val.name)}')`;
} else if (val instanceof Number || typeof val === 'number') {
return val.valueOf().toString();
} else if (val instanceof String || typeof val === 'string') {
return `'${escapeSingle(val)}'`;
} else if (val instanceof LispString) {
return `LispString.fromString('${escapeSingle(val.toString())}')`;
} else if (val === null) {
return 'null';
} else if (val === true) {
return 'true';
} else if (val === false) {
return 'false';
} else if (val instanceof Cons) {
const { car, cdr } = val;
return `new Cons(${constantCode(car)}, ${constantCode(cdr)})`;
} else {
throw new Error(`Don't know how to emit constant value ${val}`);
}
};
const truth = x => x != null && x !== false;
const emitBlock = (print, statements, ret) => {
if (statements.length) {
for (const stmt of statements) {
print('\t');
emitNode(print, stmt);
}
print('\t');
emitNode(print, ret);
} else {
emitNode(print, ret);
}
};
// Assumes JS variables keyVals and knownKeys have been emitted
const emitKeyCheck = (print, lambdaList) => {
if (!lambdaList.keyAllowOthers) {
// If :allow-other-keys passed and non-nil, skip check. Passed keywords
// are stored by .name.
print(`if(!(keyVals.hasOwnProperty('ALLOW-OTHER-KEYS')&&keyVals['ALLOW-OTHER-KEYS']!==null)){\n`);
print('for(var prop in keyVals){\n');
print(`if(keyVals.hasOwnProperty(prop)){\n`);
print(`if(!knownKeys.includes(prop))throw new Error('Unknown keyword argument: '+prop);\n`);
print('}');
print('}');
print('}\n');
}
};
const formatTag = x => typeof x === 'number'
? x.toString()
: `'${escapeSingle(x)}'`;
// Used by 'let' and 'lambda' nodes
// TODO expr and stmt variations?
const emitSpecialBlock = (print, blockNode) => {
print('try{');
for (const [name, val] of blockNode.specials) {
print(`Package.get('${escapeSingle(name.packageName)}', true).intern('${escapeSingle(name.name)}').pushBinding(`);
emitNode(print, val);
print(');');
}
emitBlock(print, blockNode.statements, blockNode.ret);
print('}finally{');
for (const [name, val] of blockNode.specials) {
print(`Package.get('${escapeSingle(name.packageName)}', true).intern('${escapeSingle(name.name)}').popBinding();`);
}
print('}');
}
const emitNode = (print, node) => {
const { op, env: { context }, parent, form } = node;
switch (op) {
case 'js-var':
if (context === 'return') print('return ');
print(node.name);
if (context !== 'expr') print(';\n');
break;
case 'js-field':
if (context === 'return') print('return ');
emitNode(print, node.target);
print(`.${node.field}`);
if (context !== 'expr') print(';\n');
break;
case 'constant':
if (context === 'return') print('return ');
print(constantCode(form));
if (context !== 'expr') print(';\n');
break;
case 'local':
if (context === 'return') print('return ');
print(mungeSym(form, `local_${node.envId}`));
if (context !== 'expr') print(';\n');
break;
case 'flocal':
if (context === 'return') print('return ');
print(mungeSym(form, `flocal_${node.envId}`));
if (context !== 'expr') print(';\n');
break;
case 'global':
if (context === 'return') print('return ');
if (form.packageName === 'COMMON-LISP' && form.name === 'NIL') {
print('null');
} else {
print(`Package.get('${escapeSingle(form.packageName)}', true).intern('${escapeSingle(form.name)}')`);
if (node.slot === 'value') {
print('.val()');
} else if (node.slot === 'function') {
print('.func()');
} else {
throw new Error(`Unknown global slot: ${node.slot}`);
}
}
if (context !== 'expr') print(';\n');
break;
case 'set-global':
if (context === 'return') print('return ');
print(`Package.get('${escapeSingle(node.targetSym.packageName)}').intern('${escapeSingle(node.targetSym.name)}').value=`);
emitNode(print, node.val);
if (context !== 'expr') print(';\n');
break;
break;
case 'set-local':
if (context === 'return') print('return ');
print(mungeSym(node.targetSym, `local_${node.envId}`))
print('=');
emitNode(print, node.val);
if (context !== 'expr') print(';\n');
break;
case 'js':
if (context === 'return') print('return ');
if (node.args.length) {
let template = node.template,
args = [...node.args],
end = -1;
while (true) {
end = template.indexOf('~{}');
if (end < 0) break;
print(template.substring(0, end));
emitNode(print, args.shift());
template = template.substring(end+3);
}
print(template);
} else {
print(node.template);
}
if (context !== 'expr') print(';\n');
break;
case 'new':
if (context === 'return') print('return ');
print('(new ');
emitNode(print, node.ctor);
print('(');
for (let i = 0; i < node.args.length; i++) {
emitNode(print, node.args[i]);
if (i < node.args.length-1) print(',');
}
print(')');
print(')');
if (context !== 'expr') print(';\n');
break;
case 'throw': {
if (context === 'expr') print('(function(){');
print('throw ');
emitNode(print, node.obj);
print(';');
if (context === 'expr') print('})()');
break;
}
case 'let':
{
if (context === 'expr') print('(function()');
print('{');
if (node.locals.length) print('var ');
for (let i = 0; i < node.locals.length; i++) {
const [ name, val ] = node.locals[i];
print(mungeSym(name, `local_${node.envId}`));
print('=');
emitNode(print, val);
if (i < node.locals.length-1) print(',');
}
if (node.locals.length) print(';');
if (node.specials.length) {
emitSpecialBlock(print, node);
} else {
emitBlock(print, node.statements, node.ret);
}
print('}');
if (context === 'expr') print(')()');
break;
}
case 'lambda': {
if (context === 'return') print('return ');
if (context === 'expr' || context == 'return') {
print(`(`);
}
if (node.declarations.find(x => List.first(x) === JACLPKG.intern('ASYNC'))) {
print(`async function ${node.name}(`);
} else {
print(`function ${node.name}(`);
}
// Emit required argument names
// TODO Move lambda list production to a function for use by macro ll,
// destructuring-bind, etc. Similar to emitBlock.
const required = node.isMacro ? [
JACLPKG.intern('&ENVIRONMENT'),
JACLPKG.intern('&WHOLE')
].concat(node.lambdaList.required) : node.lambdaList.required;
for (let i = 0; i < required.length; i++) {
print(mungeSym(required[i], `local_${node.envId}`))
if (i < required.length-1) print(',');
}
// Emit optional argument names
if (required.length && node.lambdaList.optional.length)
print(',');
for (let i = 0; i < node.lambdaList.optional.length; i++) {
print(mungeSym(node.lambdaList.optional[i].name, `local_${node.envId}`))
if (i < node.lambdaList.optional.length-1) print(',');
}
print('){\n');
// Emit argument length checks
const min = required.length,
hasRest = node.lambdaList.rest || node.lambdaList.body || node.lambdaList.key.length,
max = hasRest ? false : min + node.lambdaList.optional.length;
if (min >= 0 && min === max) {
print(`if (arguments.length !== ${min}) throw new Error('Called with invalid number of arguments: ' + arguments.length);\n`);
} else {
if (min > 0) {
print(`if (arguments.length < ${min}) throw new Error('Called with too few arguments: ' + arguments.length);\n`);
}
if (max) {
print(`if (arguments.length > ${max}) throw new Error('Called with too many arguments: ' + arguments.length);\n`);
}
}
// Macro-specific and conditional assignment of &ENVIRONMENT and &WHOLE
if (node.isMacro) {
if (node.lambdaList.environment) {
print(`var ${mungeSym(node.lambdaList.environment, 'local_${node.envId}')} = ${mungeSym(required[0], 'local_${node.envId}')};\n`);
}
if (node.lambdaList.whole) {
print(`var ${mungeSym(node.lambdaList.whole, 'local_${node.envId}')} = ${mungeSym(required[1], 'local_${node.envId}')};\n`);
}
}
// &optional
if (node.lambdaList.optional.length) {
if (node.lambdaList.optionalSvars.length) {
print('var ');
for (let i = 0; i < node.lambdaList.optionalSvars.length; i++) {
const svar = node.lambdaList.optionalSvars[i];
print(mungeSym(svar, `local_${node.envId}`));
print('=true');
if (i < node.lambdaList.optionalSvars.length-1) print(',');
}
print(';\n');
}
print('switch(arguments.length){\n');
for (let i = 0; i < node.lambdaList.optional.length; i++) {
const ospec = node.lambdaList.optional[i];
print(`case ${min+i}:\n`);
print(mungeSym(ospec.name, `local_${node.envId}`));
print('=');
if (ospec.initform === UNDEFINED) {
print('null');
} else {
emitNode(print, ospec.initform);
}
print(';\n');
if (ospec.svar !== UNDEFINED) {
print(mungeSym(ospec.svar, `local_${node.envId}`));
print('=null;\n');
}
}
print('default:\n');
print('break;\n');
print('}\n');
}
// &rest
const restStart = required.length
+ node.lambdaList.optional.length;
if (node.lambdaList.rest) {
print(mungeSym(node.lambdaList.rest, `local_${node.envId}`));
} else if (node.lambdaList.body) {
print(mungeSym(node.lambdaList.body, `local_${node.envId}`));
}
if (node.lambdaList.rest || node.lambdaList.body) {
print('=');
if (node.declarations.find(x => List.first(x) === JACLPKG.intern('REST-ARRAY'))) {
print(`Array.prototype.slice.call(arguments, ${restStart});\n`);
} else {
print(`Cons.fromArray(Array.prototype.slice.call(arguments, ${restStart}));\n`);
}
}
// &key
if (node.lambdaList.key.length) {
if (node.lambdaList.keySvars.length) {
print('var ');
for (let i = 0; i < node.lambdaList.keySvars.length; i++) {
print(mungeSym(node.lambdaList.keySvars[i], `local_${node.envId}`));
print('=true');
if (i < node.lambdaList.keySvars.length-1) print(',');
}
print(';\n');
}
print('var ');
for (let i = 0; i < node.lambdaList.key.length; i++) {
print(mungeSym(node.lambdaList.key[i].name, `local_${node.envId}`));
print('=null')
if (i < node.lambdaList.key.length-1) print(',');
}
print(';\n');
print(`if((arguments.length-${restStart})%2)throw new Error('Odd number of &key arguments');\n`);
print('var keyVals={};\n');
print('var knownKeys=[');
print(node.lambdaList.key.map(({key}) => `'${escapeSingle(key.name)}'`).join(','));
print('];\n');
print(`for(var i=${restStart}; i<arguments.length; i+=2){\n`);
print(`if (!(arguments[i] instanceof LispSymbol) || arguments[i].packageName!=='KEYWORD')throw new Error('Not a keyword: '+arguments[i]);\n`);
// Duplicate keys are ignored
print(`if(!keyVals.hasOwnProperty(arguments[i].name)){\n`);
print('keyVals[arguments[i].name]=arguments[i+1];\n');
print('}}\n');
// Conditionally reject unknown keys
emitKeyCheck(print, node.lambdaList);
for (const kspec of node.lambdaList.key) {
print(`if(keyVals.hasOwnProperty('${escapeSingle(kspec.key.name)}')){\n`);
print(mungeSym(kspec.name, `local_${node.envId}`));
print(`=keyVals['${escapeSingle(kspec.key.name)}'];\n`);
if (kspec.initform !== UNDEFINED) {
print('}else{\n');
print(mungeSym(kspec.name, `local_${node.envId}`));
print('=');
emitNode(print, kspec.initform);
print(';\n');
if (kspec.svar !== UNDEFINED) {
print(mungeSym(kspec.svar, `local_${node.envId}`));
print('=false;\n');
}
}
print('}\n');
}
}
if (node.lambdaList.aux.length) {
print('var ');
for (let i = 0; i < node.lambdaList.aux.length; i++) {
aspec = node.lambdaList.aux[i];
print(mungeSym(aspec.name, `local_${node.envId}`));
print('=');
if (aspec.initform === UNDEFINED) {
print('null');
} else {
emitNode(print, aspec.initform);
}
if (i < node.lambdaList.aux.length-1) print(',');
}
print(';\n');
}
emitBlock(print, node.statements, node.ret);
if (context === 'expr' || context == 'return') {
print('})');
} else {
print(`}\n`);
}
break;
} case 'call':
if (context === 'return') print('return ');
emitNode(print, node.f);
print('(');
node.args.forEach((arg, i) => {
emitNode(print, arg);
if (i < node.args.length-1) print(',');
});
print(')');
if (context !== 'expr') print(';\n');
break;
case 'if': {
if (context === 'return') {
print('return ');
}
if (context === 'expr' || context === 'return') {
print('((');
emitNode(print, node.testNode);
print('!==null)?')
emitNode(print, node.thenNode);
print(':');
emitNode(print, node.elseNode);
print(')');
} else {
print('if(');
emitNode(print, node.testNode);
print('!==null){\n\t');
emitNode(print, node.thenNode);
print('}else{\n\t');
emitNode(print, node.elseNode);
print('}\n');
}
break;
} case 'tagbody': {
if (context === 'return') print('return ');
if (context === 'return' || context === 'expr') {
print('(function()\n');
}
print('{\n');
if (node.tags.size) {
print(`var tagbody_${node.id}_to;\n`);
print(`var tagbody_${node.id}_id = [];\n`);
}
if (node.prelude.length && node.tags.size) {
print(`try{\n`);
for (const stmt of node.prelude) {
emitNode(print, stmt);
}
print(`}catch(e){\n`);
print(`if((e instanceof TagEx) && tagbody_${node.id}_id === e.tagbodyId){\n`);
print(`tagbody_${node.id}_to=e.tagId;\n`);
print(`}else{\n`);
print(`throw e;\n`);
print(`}\n`);
print(`}\n`);
} else if (node.prelude.length) {
for (const stmt of node.prelude) {
emitNode(print, stmt);
}
}
if (node.tags.size) {
const firstTag = node.tags.values().next().value[0];
print(`if (tagbody_${node.id}_to===undefined){\n`);
print(`tagbody_${node.id}_to=${firstTag};\n`);
print(`}\n`);
print(`tagbody_${node.id}:while(true){\n`);
print(`try{\n`);
print(`switch(tagbody_${node.id}_to){\n`);
for (const [tagId, stmts] of node.tags.values()) {
print(`case ${tagId}:\n`);
for (const stmt of stmts) emitNode(print, stmt);
}
print(`default:\nbreak tagbody_${node.id};\n`);
print('}\n');
print(`}catch(e){\n`);
print(`if((e instanceof TagEx) && tagbody_${node.id}_id === e.tagbodyId){\n`);
print(`tagbody_${node.id}_to=e.tagId;\n`);
print(`continue tagbody_${node.id};\n`);
print(`}else{\n`);
print(`throw e;\n`);
print(`}\n`);
print(`}\n`);
print('}\n');
}
if (context === 'return' || context === 'expr') {
print('return null;\n})()');
} else {
print('}\n');
}
break;
} case 'go': {
if (context === 'return') print('return ');
if (context === 'return' || context == 'expr') {
print(`(function(){throw new TagEx(${formatTag(node.tagName)}, tagbody_${node.tagbodyId}_id, ${node.tagId});})()`);
} else {
print(`throw new TagEx(${formatTag(node.tagName)}, tagbody_${node.tagbodyId}_id, ${node.tagId})`);
}
if (context !== 'expr') print(';\n');
break;
} case 'go-continue': {
if (context === 'return' || context === 'stmt') {
print(`tagbody_${node.tagbodyId}_to=${node.tagId};\n`);
print(`continue tagbody_${node.tagbodyId};\n`);
} else {
throw new Exception(`Unimplemented`);
}
break;
} case 'progn': {
if (context === 'expr' && !node.statements.length) {
// If there's only a return expression, just emit that.
emitNode(print, merge(node.ret, { env: node.ret.env.withContext('expr') }));
} else {
if (context === 'expr') print('(function()');
print('{');
emitBlock(print, node.statements, node.ret);
print('}');
if (context === 'expr') print(')()');
}
break;
} default:
throw new Error(`Unknown op: ${op}`);
}
};
class StringBuffer {
constructor(str = '') {
this.str = str;
}
append(str) {
this.str += str;
}
toString() {
return this.str;
}
}
const emitter = (() => {
let sb = '';
return node => {
emitNode(x => { sb += x; return null; }, node);
return sb;
};
});
JACLPKG.intern('.')
.setMacro()
.fvalue = (env, form, topic, ...ops) => {
return ops.reduce((form, op) => {
if (op instanceof LispSymbol) {
return Cons.listOf(
JACLPKG.intern("%JS"),
`((~{}).${op.name})`,
form
);
} else if (op instanceof LispString
|| op instanceof String
|| (typeof op) === 'string') {
return Cons.listOf(
JACLPKG.intern("%JS"),
`((~{})['${escapeSingle(op.toString())}'])`,
form
);
} else if (List.isProperList(op)) {
const [meth, ...args] = op
if (meth.name === '=') {
if (args.length !== 1) {
throw new Error(`Assignment syntax accepts only one value`);
}
return Cons.listOf(
JACLPKG.intern("%JS"),
env.context === 'stmt' ? `~{}=~{};\n` : `(~{}=~{})`,
form,
args[0]
);
} else {
return Cons.listOf(
JACLPKG.intern("%CALL"),
Cons.listOf(
JACLPKG.intern("%JS"),
`((~{}).${meth.name})`,
form
),
...args
);
}
} else {
throw new Error(`Unknown op: ${op}`);
}
}, topic)
};
JACLPKG.exportSymbol('.');
JACLPKG.intern('AWAIT')
.setMacro()
.fvalue = (env, form, expr) => {
return Cons.listOf(
JACLPKG.intern("%JS"),
env.context === 'stmt' ? `await ~{}` : `(await ~{})`,
expr
);
};
JACLPKG.exportSymbol('AWAIT');
JACLPKG.intern('ENABLE-JS-SYNTAX').fvalue = () => {
READTABLE
.val()
.makeDispatchMacroChar('@', true)
.setDispatchMacroChar('@', '"', readJsString)
.setDispatchMacroChar('@', '@', readAwait)
.setDispatchMacroChar('@', '|', readGlobalReference);
return null;
};
JACLPKG.exportSymbol('ENABLE-JS-SYNTAX');
JACLPKG.intern('TRUTH').fvalue = x => (x != null && x !== false) || null;
JACLPKG.exportSymbol('TRUTH');
let replInputStream = new BufferedStream(),
replReader = new Reader(replInputStream);
const startRepl = async () => {
try {
for await(const obj of replReader) {
console.log("read", obj);
console.log(obj)
const node = optimize(analyze(emptyEnv(), null, obj));
const sb = new StringBuffer();
emitNode(sb.append.bind(sb), node);
const code = sb.toString();
// console.log('code="',code,'"');
const result = (new Function(`return ${code}`))();
console.log(prstr(result));
console.log(result);
}
} catch (e) {
console.error(e);
replInputStream = new BufferedStream(),
replReader = new Reader(replInputStream);
setTimeout(startRepl, 0);
}
};
const fetchLoad = async (src) => {
const code = await (await fetch(src, {cache: "reload"})).text(),
ss = new StringStream(code),
rdr = new Reader(ss);
for await(const obj of rdr) {
if (obj === EOF) break;
const node = optimize(analyze(emptyEnv().withContext('return'), null, obj)),
sb = new StringBuffer();
emitNode(sb.append.bind(sb), node);
// console.log(js_beautify(sb.toString()));
await (new Function(sb.toString())());
}
};
const loadLispScripts = async () => {
let urlParams = new URLSearchParams(window.location.search);
for (let i = 0; i < document.head.childNodes.length; i++) {
const child = document.head.childNodes[i];
if (child.nodeName === 'SCRIPT' && child.src.endsWith('.lisp')) {
const start = new Date();
await fetchLoad(child.src);
console.log(`;Loaded ${child.src} in ${(new Date())-start} ms`);
}
}
// if (deliverAs !== null) {
// let selfsrc = document.querySelector('script[data-name="jacl"]').src,
// prelude = await (await fetch(selfsrc, {cache: "reload"})).text(),
// file = new File([prelude + '\n' + compiledCode], deliverAs || "app.js", {type: "application/javascript;charset=utf-8"});
// saveAs(file);
// }
};
window.addEventListener('DOMContentLoaded', async () => {
await loadLispScripts();
//QUnit.start();
await startRepl();
});
const prstr = obj => {
if (obj instanceof LispSymbol) {
return obj.name;
} else if (obj === null) {
return "nil";
} else if (List.isProperList(obj)) {
return "("
+ List.toArray(obj).map(prstr).join(' ')
+ ")";
} else {
return obj.toString();
}
}
const unspread = (arr) => {
if (arr.length && arr[arr.length-1] instanceof Cons) {
const more = arr.pop();
Array.prototype.push.apply(arr, Array.from(more));
}
return arr;
}