author | Alan Dipert
<alan@dipert.org> 2019-10-18 01:13:12 UTC |
committer | Alan Dipert
<alan@dipert.org> 2019-10-18 01:13:12 UTC |
parent | e408cbd526e857981fa9326bb68d65b59f125573 |
jacl.js | +61 | -61 |
diff --git a/jacl.js b/jacl.js index b00299f..f7e1dd4 100644 --- a/jacl.js +++ b/jacl.js @@ -27,6 +27,17 @@ class Cons { return xs.reduce((a, b) => Cons.append(a,b)); } } + 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, @@ -256,6 +267,7 @@ Package.makePackage('COMMON-LISP-USER', 'CL-USER'); Package.makePackage('KEYWORD'); // CL package constants +// TODO update this, look into constants const CLCONSTS = new Map([ ['T', 'true'], ['NIL', 'null'] @@ -266,6 +278,18 @@ for (const [k,v] of CLCONSTS) { 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); +} + // JS package constants const JSCONSTS = new Map([ ['+FALSE+', 'false'], @@ -707,74 +731,50 @@ JACLPKG.intern('UNQUOTE').setMacro().fvalue = function(env, form) { throw new Error(`Comma not inside backquote`); }; +JACLPKG.intern('QUASIQUOTE').setMacro().fvalue = function(env, form) { -const transform = (form, wrapInList = true) => { - const maybeWrap = x => { - if (wrapInList) { - return Cons.listOf( - JACLPKG.intern('%CALL'), - Cons.listOf( - JACLPKG.intern('%DOT'), - JSPKG.intern('Cons'), - new LispSymbol('listOf', null) - ), - x - ); - } else { - return 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 && JACLPKG.intern('UNQUOTE') === object.car) { - return Cons.listOf(transform(object.car), transform(object.cdr, false)); - } else if (object instanceof Cons && JACLPKG.intern('UNQUOTE-SPLICING') === object.car) { - throw new Error(`UNQUOTE-SPLICING in dotted list`); - } else if (object === null) { - return null; + const callCL = (funcName, ...args) => { + return 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 new Cons(transform(object.car), rec(object.cdr)); + return maybeWrap(transformQuasiquoteArgument(form)); } }; - return rec(compound); -}; -const ppr = x => { - if (x instanceof Cons) { - return Array.from(x).map(ppr); - } else if (x instanceof LispSymbol) { - return x.name; - } else { - return x.toString(); - } -}; + const transformCompound = compound => { + const rec = object => { + if (object instanceof Cons && JACLPKG.intern('UNQUOTE') === object.car) { + return Cons.listOf(transform(object.car), transform(object.cdr, false)); + } else if (object instanceof Cons && JACLPKG.intern('UNQUOTE-SPLICING') === object.car) { + throw new Error(`UNQUOTE-SPLICING in dotted list`); + } else if (object === null) { + return null; + } 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) { - const foo = Cons.listOf( - JACLPKG.intern('%CALL'), - Cons.listOf(JACLPKG.intern('%DOT'), JSPKG.intern('Cons'), new LispSymbol('append', null)), - ...transformCompound(argument) - ); - return foo; - } else { - return Cons.listOf(CLPKG.intern('QUOTE'), argument); - } -}; + 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); + } + }; -JACLPKG.intern('QUASIQUOTE').setMacro().fvalue = function(env, form) { const expand = form => { if (form instanceof Cons) { const expanded = new Cons(expand(form.car), expand(form.cdr));