git » jacl.git » commit 8d02ba0

diff --git a/jacl.js b/jacl.js
index c37b7f6..ce2426a 100644
--- a/jacl.js
+++ b/jacl.js
@@ -232,7 +232,7 @@ class Package {
 
 Package.makePackage('JACL');
 Package.makePackage('COMMON-LISP', 'CL');
-Package.makePackage('COMMON-LISP-USER');
+Package.makePackage('COMMON-LISP-USER', 'CL-USER');
 Package.makePackage('KEYWORD');
 
 const PACKAGE = Package.intern('CL', '*PACKAGE*');
@@ -285,6 +285,8 @@ 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);
@@ -295,7 +297,32 @@ class ReadTable {
     return this.terminatingMacros.has(ch);
   }
   getMacro(ch) {
-    return this.macros.has(ch) ? this.macros.get(ch) : null;
+    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`);
@@ -374,34 +401,6 @@ const readList = async stream => {
   return new Values(new Cons(car, (await readList(stream))[0]));
 }
 
-// TODO: http://clhs.lisp.se/Body/f_set__1.htm
-const readSharpsign = async stream => {
-  const ch = await stream.read();
-  switch(ch) {
-    case ':':
-      const rdr = new Reader(stream),
-            sym = await rdr.read(false);
-      if (sym instanceof LispSymbol && sym.packageName === null) {
-        return new Values(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`);
-      }
-    case '\\':
-      return new Values(await stream.read());
-    case '<':
-      throw new Error(`Illegal # char: <`);
-    case "'":
-      return new Values(Cons.listOf(
-        Package.intern('CL', 'FUNCTION'),
-        await (new Reader(stream)).read()
-      ));
-    default:
-      throw new Error(`Unknown # char: ${ch}`);
-  }
-};
-
 READTABLE.value = new ReadTable()
   .setMacro(';', true, async stream => {
     for await(const ch of stream) {
@@ -427,7 +426,30 @@ READTABLE.value = new ReadTable()
       await (new Reader(stream)).read()
     ));
   })
-  .setMacro('#', false, readSharpsign);
+  .makeDispatchMacroChar('#', true)
+  .setDispatchMacroChar('#', ':', async stream => {
+    const rdr = new Reader(stream),
+          sym = await rdr.read(false);
+    if (sym instanceof LispSymbol && sym.packageName === null) {
+      return new Values(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 Values(await stream.read());
+  })
+  .setDispatchMacroChar('#', '<', async stream => {
+    throw new Error(`Illegal # char: <`);
+  })
+  .setDispatchMacroChar('#', "'", async stream => {
+    return new Values(Cons.listOf(
+      Package.intern('CL', 'FUNCTION'),
+      await (new Reader(stream)).read()
+    ));
+  });
 
 const isWhitespace = ch => ' \t\n\r\b'.indexOf(ch) > -1;