2
0
Эх сурвалжийг харах

Improve LISP/C/ASM Rosetta Stone consistency

Justine Tunney 3 жил өмнө
parent
commit
05d2bcbfd9
5 өөрчлөгдсөн 413 нэмэгдсэн , 371 устгасан
  1. 261 168
      bestline.c
  2. 8 2
      bestline.h
  3. 96 159
      lisp.c
  4. 37 31
      lisp.lisp
  5. 11 11
      sectorlisp.S

+ 261 - 168
bestline.c

@@ -58,6 +58,7 @@
 │   CTRL-L         CLEAR                                                       │
 │   CTRL-L         CLEAR                                                       │
 │   CTRL-H         BACKSPACE                                                   │
 │   CTRL-H         BACKSPACE                                                   │
 │   CTRL-D         DELETE                                                      │
 │   CTRL-D         DELETE                                                      │
+│   CTRL-Y         YANK                                                        │
 │   CTRL-D         EOF (IF EMPTY)                                              │
 │   CTRL-D         EOF (IF EMPTY)                                              │
 │   CTRL-N         NEXT HISTORY                                                │
 │   CTRL-N         NEXT HISTORY                                                │
 │   CTRL-P         PREVIOUS HISTORY                                            │
 │   CTRL-P         PREVIOUS HISTORY                                            │
@@ -69,13 +70,17 @@
 │   ALT-B          BACKWARD WORD                                               │
 │   ALT-B          BACKWARD WORD                                               │
 │   CTRL-ALT-F     FORWARD EXPR                                                │
 │   CTRL-ALT-F     FORWARD EXPR                                                │
 │   CTRL-ALT-B     BACKWARD EXPR                                               │
 │   CTRL-ALT-B     BACKWARD EXPR                                               │
+│   ALT-RIGHT      FORWARD EXPR                                                │
+│   ALT-LEFT       BACKWARD EXPR                                               │
+│   ALT-SHIFT-B    BARF EXPR                                                   │
+│   ALT-SHIFT-S    SLURP EXPR                                                  │
+│   ALT-SHIFT-R    RAISE EXPR                                                  │
 │   CTRL-K         KILL LINE FORWARDS                                          │
 │   CTRL-K         KILL LINE FORWARDS                                          │
 │   CTRL-U         KILL LINE BACKWARDS                                         │
 │   CTRL-U         KILL LINE BACKWARDS                                         │
 │   ALT-H          KILL WORD BACKWARDS                                         │
 │   ALT-H          KILL WORD BACKWARDS                                         │
 │   CTRL-W         KILL WORD BACKWARDS                                         │
 │   CTRL-W         KILL WORD BACKWARDS                                         │
 │   CTRL-ALT-H     KILL WORD BACKWARDS                                         │
 │   CTRL-ALT-H     KILL WORD BACKWARDS                                         │
 │   ALT-D          KILL WORD FORWARDS                                          │
 │   ALT-D          KILL WORD FORWARDS                                          │
-│   CTRL-Y         YANK                                                        │
 │   ALT-Y          ROTATE KILL RING AND YANK AGAIN                             │
 │   ALT-Y          ROTATE KILL RING AND YANK AGAIN                             │
 │   ALT-\          SQUEEZE ADJACENT WHITESPACE                                 │
 │   ALT-\          SQUEEZE ADJACENT WHITESPACE                                 │
 │   CTRL-T         TRANSPOSE                                                   │
 │   CTRL-T         TRANSPOSE                                                   │
@@ -83,7 +88,6 @@
 │   ALT-U          UPPERCASE WORD                                              │
 │   ALT-U          UPPERCASE WORD                                              │
 │   ALT-L          LOWERCASE WORD                                              │
 │   ALT-L          LOWERCASE WORD                                              │
 │   ALT-C          CAPITALIZE WORD                                             │
 │   ALT-C          CAPITALIZE WORD                                             │
-│   CTRL-C         INTERRUPT PROCESS                                           │
 │   CTRL-Z         SUSPEND PROCESS                                             │
 │   CTRL-Z         SUSPEND PROCESS                                             │
 │   CTRL-\         QUIT PROCESS                                                │
 │   CTRL-\         QUIT PROCESS                                                │
 │   CTRL-S         PAUSE OUTPUT                                                │
 │   CTRL-S         PAUSE OUTPUT                                                │
@@ -243,7 +247,7 @@ static struct sigaction orig_cont;
 static struct sigaction orig_winch;
 static struct sigaction orig_winch;
 static struct termios orig_termios;
 static struct termios orig_termios;
 static char *history[BESTLINE_MAX_HISTORY];
 static char *history[BESTLINE_MAX_HISTORY];
-static unsigned (*xlatCallback)(unsigned);
+static bestlineXlatCallback *xlatCallback;
 static bestlineHintsCallback *hintsCallback;
 static bestlineHintsCallback *hintsCallback;
 static bestlineFreeHintsCallback *freeHintsCallback;
 static bestlineFreeHintsCallback *freeHintsCallback;
 static bestlineCompletionCallback *completionCallback;
 static bestlineCompletionCallback *completionCallback;
@@ -290,7 +294,7 @@ static int GetMonospaceCharacterWidth(unsigned c) {
  * and aren't in the number categorie (Nd, Nl, No). We also add a few
  * and aren't in the number categorie (Nd, Nl, No). We also add a few
  * other things like blocks and emoji (So).
  * other things like blocks and emoji (So).
  */
  */
-static char IsSeparator(unsigned c) {
+char bestlineIsSeparator(unsigned c) {
     int m, l, r, n;
     int m, l, r, n;
     if (c < 0200) {
     if (c < 0200) {
         return !(('0' <= c && c <= '9') ||
         return !(('0' <= c && c <= '9') ||
@@ -1070,8 +1074,8 @@ unsigned bestlineUppercase(unsigned c) {
     }
     }
 }
 }
 
 
-static char NotSeparator(unsigned c) {
-    return !IsSeparator(c);
+char bestlineNotSeparator(unsigned c) {
+    return !bestlineIsSeparator(c);
 }
 }
 
 
 static unsigned GetMirror(const unsigned short A[][2], size_t n, unsigned c) {
 static unsigned GetMirror(const unsigned short A[][2], size_t n, unsigned c) {
@@ -1091,7 +1095,7 @@ static unsigned GetMirror(const unsigned short A[][2], size_t n, unsigned c) {
     return 0;
     return 0;
 }
 }
 
 
-static unsigned GetMirrorLeft(unsigned c) {
+unsigned bestlineMirrorLeft(unsigned c) {
     static const unsigned short kMirrorRight[][2] = {
     static const unsigned short kMirrorRight[][2] = {
         {L')', L'('},   {L']', L'['},   {L'}', L'{'},   {L'⁆', L'⁅'},
         {L')', L'('},   {L']', L'['},   {L'}', L'{'},   {L'⁆', L'⁅'},
         {L'⁾', L'⁽'},   {L'₎', L'₍'},   {L'⌉', L'⌈'},   {L'⌋', L'⌊'},
         {L'⁾', L'⁽'},   {L'₎', L'₍'},   {L'⌉', L'⌈'},   {L'⌋', L'⌊'},
@@ -1110,7 +1114,7 @@ static unsigned GetMirrorLeft(unsigned c) {
                      c);
                      c);
 }
 }
 
 
-static unsigned GetMirrorRight(unsigned c) {
+unsigned bestlineMirrorRight(unsigned c) {
     static const unsigned short kMirrorLeft[][2] = {
     static const unsigned short kMirrorLeft[][2] = {
         {L'(', L')'},   {L'[', L']'},   {L'{', L'}'},   {L'⁅', L'⁆'},
         {L'(', L')'},   {L'[', L']'},   {L'{', L'}'},   {L'⁅', L'⁆'},
         {L'⁽', L'⁾'},   {L'₍', L'₎'},   {L'⌈', L'⌉'},   {L'⌊', L'⌋'},
         {L'⁽', L'⁾'},   {L'₍', L'₎'},   {L'⌈', L'⌉'},   {L'⌊', L'⌋'},
@@ -1129,8 +1133,10 @@ static unsigned GetMirrorRight(unsigned c) {
                      c);
                      c);
 }
 }
 
 
-static char IsXeparator(unsigned c) {
-    return IsSeparator(c) && !GetMirrorLeft(c) && !GetMirrorRight(c);
+char bestlineIsXeparator(unsigned c) {
+    return (bestlineIsSeparator(c) &&
+            !bestlineMirrorLeft(c) &&
+            !bestlineMirrorRight(c));
 }
 }
 
 
 static unsigned Capitalize(unsigned c) {
 static unsigned Capitalize(unsigned c) {
@@ -1331,7 +1337,7 @@ static char *GetLineBlock(FILE *f) {
     }
     }
 }
 }
 
 
-static ssize_t ReadCharacter(int fd, char *p, size_t n) {
+long bestlineReadCharacter(int fd, char *p, unsigned long n) {
     int e;
     int e;
     size_t i;
     size_t i;
     ssize_t rc;
     ssize_t rc;
@@ -1444,7 +1450,16 @@ static ssize_t ReadCharacter(int fd, char *p, size_t n) {
             break;
             break;
         case kEsc:
         case kEsc:
             if (0x20 <= c && c <= 0x2f) { /* Nf */
             if (0x20 <= c && c <= 0x2f) { /* Nf */
-                t = kNf;
+                /*
+                 * Almost no one uses ANSI Nf sequences
+                 * They overlaps with alt+graphic keystrokes
+                 * We care more about being able to type alt-/
+                 */
+                if (c == ' ' || c == '#') {
+                    t = kNf;
+                } else {
+                    t = kDone;
+                }
             } else if (0x30 <= c && c <= 0x3f) { /* Fp */
             } else if (0x30 <= c && c <= 0x3f) { /* Fp */
                 t = kDone;
                 t = kDone;
             } else if (0x20 <= c && c <= 0x5F) { /* Fe */
             } else if (0x20 <= c && c <= 0x5F) { /* Fe */
@@ -1463,8 +1478,6 @@ static ssize_t ReadCharacter(int fd, char *p, size_t n) {
                 case '_': /* APC (Application Program Command) */
                 case '_': /* APC (Application Program Command) */
                     t = kStr;
                     t = kStr;
                     break;
                     break;
-                case '\\':
-                    goto Whoopsie;
                 default:
                 default:
                     t = kDone;
                     t = kDone;
                     break;
                     break;
@@ -1562,7 +1575,7 @@ static char *GetLineChar(int fin, int fout) {
             rc = -1;
             rc = -1;
             break;
             break;
         }
         }
-        if ((rc = ReadCharacter(fin, seq, sizeof(seq))) == -1) {
+        if ((rc = bestlineReadCharacter(fin, seq, sizeof(seq))) == -1) {
             if (errno == EAGAIN || errno == EWOULDBLOCK) {
             if (errno == EAGAIN || errno == EWOULDBLOCK) {
                 if (WaitUntilReady(fin, POLLIN) > 0) {
                 if (WaitUntilReady(fin, POLLIN) > 0) {
                     continue;
                     continue;
@@ -1584,7 +1597,7 @@ static char *GetLineChar(int fin, int fout) {
         }
         }
         if (seq[0] == '\r') {
         if (seq[0] == '\r') {
             if (HasPendingInput(fin)) {
             if (HasPendingInput(fin)) {
-                if ((rc = ReadCharacter(fin, seq + 1, sizeof(seq) - 1)) > 0) {
+                if ((rc = bestlineReadCharacter(fin, seq + 1, sizeof(seq) - 1)) > 0) {
                     if (seq[0] == '\n') {
                     if (seq[0] == '\n') {
                         break;
                         break;
                     }
                     }
@@ -1681,12 +1694,19 @@ static int ParseUnsigned(const char *s, void *e) {
     return x;
     return x;
 }
 }
 
 
+/**
+ * Returns UNICODE CJK Monospace Width of string.
+ *
+ * Control codes and ANSI sequences have a width of zero. We only parse
+ * a limited subset of ANSI here since we don't store ANSI codes in the
+ * linenoiseState::buf, but we do encourage CSI color codes in prompts.
+ */
 static size_t GetMonospaceWidth(const char *p, size_t n, char *out_haswides) {
 static size_t GetMonospaceWidth(const char *p, size_t n, char *out_haswides) {
     int c, d;
     int c, d;
     size_t i, w;
     size_t i, w;
     struct rune r;
     struct rune r;
     char haswides;
     char haswides;
-    enum { kAscii, kUtf8, kEsc, kCsi1, kCsi2, kSs, kNf, kStr, kStr2 } t;
+    enum { kAscii, kUtf8, kEsc, kCsi1, kCsi2 } t;
     for (haswides = r.c = r.n = w = i = 0, t = kAscii; i < n; ++i) {
     for (haswides = r.c = r.n = w = i = 0, t = kAscii; i < n; ++i) {
         c = p[i] & 255;
         c = p[i] & 255;
         switch (t) {
         switch (t) {
@@ -1710,85 +1730,27 @@ static size_t GetMonospaceWidth(const char *p, size_t n, char *out_haswides) {
                 r.c <<= 6;
                 r.c <<= 6;
                 r.c |= c & 077;
                 r.c |= c & 077;
                 if (!--r.n) {
                 if (!--r.n) {
-                    switch (r.c) {
-                    case 033:
-                        t = kEsc;
-                        break;
-                    case 0x9b:
-                        t = kCsi1;
-                        break;
-                    case 0x8e:
-                    case 0x8f:
-                        t = kSs;
-                        break;
-                    case 0x90:
-                    case 0x98:
-                    case 0x9d:
-                    case 0x9e:
-                    case 0x9f:
-                        t = kStr;
-                        break;
-                    default:
-                        d = GetMonospaceCharacterWidth(r.c);
-                        d = Max(0, d);
-                        w += d;
-                        haswides |= d > 1;
-                        t = kAscii;
-                        break;
-                    }
+                    d = GetMonospaceCharacterWidth(r.c);
+                    d = Max(0, d);
+                    w += d;
+                    haswides |= d > 1;
+                    t = kAscii;
+                    break;
                 }
                 }
             } else {
             } else {
                 goto Whoopsie;
                 goto Whoopsie;
             }
             }
             break;
             break;
         case kEsc:
         case kEsc:
-            if (0x20 <= c && c <= 0x2f) {
-                t = kNf;
-            } else if (0x30 <= c && c <= 0x3f) {
-                t = kAscii;
-            } else if (0x20 <= c && c <= 0x5F) {
-                switch (c) {
-                case '[':
-                    t = kCsi1;
-                    break;
-                case 'N':
-                case 'O':
-                    t = kSs;
-                    break;
-                case 'P':
-                case 'X':
-                case ']':
-                case '^':
-                case '_':
-                    t = kStr;
-                    break;
-                default:
-                    t = kAscii;
-                    break;
-                }
-            } else if (0x60 <= c && c <= 0x7e) {
-                t = kAscii;
-            } else if (c == 033) {
-                if (i == 3) t = kAscii;
+            if (c == '[') {
+                t = kCsi1;
             } else {
             } else {
                 t = kAscii;
                 t = kAscii;
             }
             }
             break;
             break;
-        case kSs:
-            t = kAscii;
-            break;
-         case kNf:
-             if (0x30 <= c && c <= 0x7e) {
-                 t = kAscii;
-             } else if (!(0x20 <= c && c <= 0x2f)) {
-                 goto Whoopsie;
-             }
-            break;
         case kCsi1:
         case kCsi1:
             if (0x20 <= c && c <= 0x2f) {
             if (0x20 <= c && c <= 0x2f) {
                 t = kCsi2;
                 t = kCsi2;
-            } else if (c == '[' && i == 3) {
-                /* linux function keys */
             } else if (0x40 <= c && c <= 0x7e) {
             } else if (0x40 <= c && c <= 0x7e) {
                 t = kAscii;
                 t = kAscii;
             } else if (!(0x30 <= c && c <= 0x3f)) {
             } else if (!(0x30 <= c && c <= 0x3f)) {
@@ -1802,31 +1764,6 @@ static size_t GetMonospaceWidth(const char *p, size_t n, char *out_haswides) {
                 goto Whoopsie;
                 goto Whoopsie;
             }
             }
             break;
             break;
-        case kStr:
-            switch (c) {
-            case '\a':
-                t = kAscii;
-                break;
-            case 0033:
-            case 0302:
-                t = kStr2;
-                break;
-            default:
-                break;
-            }
-            break;
-        case kStr2:
-            switch (c) {
-            case '\a':
-            case '\\':
-            case 0234:
-                t = kAscii;
-                break;
-            default:
-                t = kStr;
-                break;
-            }
-            break;
         default:
         default:
             assert(0);
             assert(0);
         }
         }
@@ -1962,7 +1899,7 @@ static ssize_t bestlineRead(int fd, char *buf, size_t size,
             refreshme = 1;
             refreshme = 1;
         }
         }
         if (refreshme) bestlineRefreshLine(l);
         if (refreshme) bestlineRefreshLine(l);
-        rc = ReadCharacter(fd, buf, size);
+        rc = bestlineReadCharacter(fd, buf, size);
     } while (rc == -1 && errno == EINTR);
     } while (rc == -1 && errno == EINTR);
     if (rc != -1) {
     if (rc != -1) {
         got = rc;
         got = rc;
@@ -2271,11 +2208,11 @@ static size_t Backward(struct bestlineState *l, size_t pos) {
     return pos;
     return pos;
 }
 }
 
 
-static int bestlineMirrorLeft(struct bestlineState *l, int res[2]) {
+static int bestlineEditMirrorLeft(struct bestlineState *l, int res[2]) {
     unsigned c, pos, left, right, depth, index;
     unsigned c, pos, left, right, depth, index;
     if ((pos = Backward(l, l->pos))) {
     if ((pos = Backward(l, l->pos))) {
         right = GetUtf8(l->buf + pos, l->len - pos).c;
         right = GetUtf8(l->buf + pos, l->len - pos).c;
-        if ((left = GetMirrorLeft(right))) {
+        if ((left = bestlineMirrorLeft(right))) {
             depth = 0;
             depth = 0;
             index = pos;
             index = pos;
             do {
             do {
@@ -2298,13 +2235,13 @@ static int bestlineMirrorLeft(struct bestlineState *l, int res[2]) {
     return -1;
     return -1;
 }
 }
 
 
-static int bestlineMirrorRight(struct bestlineState *l, int res[2]) {
+static int bestlineEditMirrorRight(struct bestlineState *l, int res[2]) {
     struct rune rune;
     struct rune rune;
     unsigned pos, left, right, depth, index;
     unsigned pos, left, right, depth, index;
     pos = l->pos;
     pos = l->pos;
     rune = GetUtf8(l->buf + pos, l->len - pos);
     rune = GetUtf8(l->buf + pos, l->len - pos);
     left = rune.c;
     left = rune.c;
-    if ((right = GetMirrorRight(left))) {
+    if ((right = bestlineMirrorRight(left))) {
         depth = 0;
         depth = 0;
         index = pos;
         index = pos;
         do {
         do {
@@ -2326,10 +2263,10 @@ static int bestlineMirrorRight(struct bestlineState *l, int res[2]) {
     return -1;
     return -1;
 }
 }
 
 
-static int bestlineMirror(struct bestlineState *l, int res[2]) {
+static int bestlineEditMirror(struct bestlineState *l, int res[2]) {
     int rc;
     int rc;
-    rc = bestlineMirrorLeft(l, res);
-    if (rc == -1) rc = bestlineMirrorRight(l, res);
+    rc = bestlineEditMirrorLeft(l, res);
+    if (rc == -1) rc = bestlineEditMirrorRight(l, res);
     return rc;
     return rc;
 }
 }
 
 
@@ -2365,7 +2302,7 @@ static void bestlineRefreshLineImpl(struct bestlineState *l, int force) {
         gotwinch = 0;
         gotwinch = 0;
         l->ws = GetTerminalSize(l->ws, l->ifd, l->ofd);
         l->ws = GetTerminalSize(l->ws, l->ifd, l->ofd);
     }
     }
-    hasflip = !l->final && !bestlineMirror(l, flip);
+    hasflip = !l->final && !bestlineEditMirror(l, flip);
 
 
 StartOver:
 StartOver:
     fd = l->ofd;
     fd = l->ofd;
@@ -2599,14 +2536,14 @@ static size_t Forwards(struct bestlineState *l, size_t pos, char pred(unsigned))
 }
 }
 
 
 static size_t ForwardWord(struct bestlineState *l, size_t pos) {
 static size_t ForwardWord(struct bestlineState *l, size_t pos) {
-    pos = Forwards(l, pos, IsSeparator);
-    pos = Forwards(l, pos, NotSeparator);
+    pos = Forwards(l, pos, bestlineIsSeparator);
+    pos = Forwards(l, pos, bestlineNotSeparator);
     return pos;
     return pos;
 }
 }
 
 
 static size_t BackwardWord(struct bestlineState *l, size_t pos) {
 static size_t BackwardWord(struct bestlineState *l, size_t pos) {
-    pos = Backwards(l, pos, IsSeparator);
-    pos = Backwards(l, pos, NotSeparator);
+    pos = Backwards(l, pos, bestlineIsSeparator);
+    pos = Backwards(l, pos, bestlineNotSeparator);
     return pos;
     return pos;
 }
 }
 
 
@@ -2616,13 +2553,13 @@ static size_t EscapeWord(struct bestlineState *l) {
     for (i = l->pos; i && i < l->len; i += r.n) {
     for (i = l->pos; i && i < l->len; i += r.n) {
         if (i < l->len) {
         if (i < l->len) {
             r = GetUtf8(l->buf + i, l->len - i);
             r = GetUtf8(l->buf + i, l->len - i);
-            if (IsSeparator(r.c)) break;
+            if (bestlineIsSeparator(r.c)) break;
         }
         }
         if ((j = i)) {
         if ((j = i)) {
             do --j;
             do --j;
             while (j && (l->buf[j] & 0300) == 0200);
             while (j && (l->buf[j] & 0300) == 0200);
             r = GetUtf8(l->buf + j, l->len - j);
             r = GetUtf8(l->buf + j, l->len - j);
-            if (IsSeparator(r.c)) break;
+            if (bestlineIsSeparator(r.c)) break;
         }
         }
     }
     }
     return i;
     return i;
@@ -2652,22 +2589,22 @@ static void bestlineEditRightWord(struct bestlineState *l) {
 
 
 static void bestlineEditLeftExpr(struct bestlineState *l) {
 static void bestlineEditLeftExpr(struct bestlineState *l) {
     int mark[2];
     int mark[2];
-    l->pos = Backwards(l, l->pos, IsXeparator);
-    if (!bestlineMirrorLeft(l, mark)) {
+    l->pos = Backwards(l, l->pos, bestlineIsXeparator);
+    if (!bestlineEditMirrorLeft(l, mark)) {
         l->pos = mark[0];
         l->pos = mark[0];
     } else {
     } else {
-        l->pos = Backwards(l, l->pos, NotSeparator);
+        l->pos = Backwards(l, l->pos, bestlineNotSeparator);
     }
     }
     bestlineRefreshLine(l);
     bestlineRefreshLine(l);
 }
 }
 
 
 static void bestlineEditRightExpr(struct bestlineState *l) {
 static void bestlineEditRightExpr(struct bestlineState *l) {
     int mark[2];
     int mark[2];
-    l->pos = Forwards(l, l->pos, IsXeparator);
-    if (!bestlineMirrorRight(l, mark)) {
+    l->pos = Forwards(l, l->pos, bestlineIsXeparator);
+    if (!bestlineEditMirrorRight(l, mark)) {
         l->pos = Forward(l, mark[1]);
         l->pos = Forward(l, mark[1]);
     } else {
     } else {
-        l->pos = Forwards(l, l->pos, NotSeparator);
+        l->pos = Forwards(l, l->pos, bestlineNotSeparator);
     }
     }
     bestlineRefreshLine(l);
     bestlineRefreshLine(l);
 }
 }
@@ -2718,10 +2655,10 @@ static void bestlineEditXlatWord(struct bestlineState *l, unsigned xlat(unsigned
     struct rune r;
     struct rune r;
     struct abuf ab;
     struct abuf ab;
     abInit(&ab);
     abInit(&ab);
-    i = Forwards(l, l->pos, IsSeparator);
+    i = Forwards(l, l->pos, bestlineIsSeparator);
     for (j = i; j < l->len; j += r.n) {
     for (j = i; j < l->len; j += r.n) {
         r = GetUtf8(l->buf + j, l->len - j);
         r = GetUtf8(l->buf + j, l->len - j);
-        if (IsSeparator(r.c)) break;
+        if (bestlineIsSeparator(r.c)) break;
         if ((c = xlat(r.c)) != r.c) {
         if ((c = xlat(r.c)) != r.c) {
             abAppendw(&ab, EncodeUtf8(c));
             abAppendw(&ab, EncodeUtf8(c));
         } else { /* avoid canonicalization */
         } else { /* avoid canonicalization */
@@ -2821,10 +2758,10 @@ static void bestlineEditTransposeWords(struct bestlineState *l) {
     char *q, *p;
     char *q, *p;
     size_t pi, xi, xj, yi, yj;
     size_t pi, xi, xj, yi, yj;
     pi = EscapeWord(l);
     pi = EscapeWord(l);
-    xj = Backwards(l, pi, IsSeparator);
-    xi = Backwards(l, xj, NotSeparator);
-    yi = Forwards(l, pi, IsSeparator);
-    yj = Forwards(l, yi, NotSeparator);
+    xj = Backwards(l, pi, bestlineIsSeparator);
+    xi = Backwards(l, xj, bestlineNotSeparator);
+    yi = Forwards(l, pi, bestlineIsSeparator);
+    yj = Forwards(l, yi, bestlineNotSeparator);
     if (!(xi < xj && xj < yi && yi < yj)) return;
     if (!(xi < xj && xj < yi && yi < yj)) return;
     p = q = (char *)malloc(yj - xi);
     p = q = (char *)malloc(yj - xi);
     p = Copy(p, l->buf + yi, yj - yi);
     p = Copy(p, l->buf + yi, yj - yi);
@@ -2839,8 +2776,8 @@ static void bestlineEditTransposeWords(struct bestlineState *l) {
 
 
 static void bestlineEditSqueeze(struct bestlineState *l) {
 static void bestlineEditSqueeze(struct bestlineState *l) {
     size_t i, j;
     size_t i, j;
-    i = Backwards(l, l->pos, IsSeparator);
-    j = Forwards(l, l->pos, IsSeparator);
+    i = Backwards(l, l->pos, bestlineIsSeparator);
+    j = Forwards(l, l->pos, bestlineIsSeparator);
     if (!(i < j)) return;
     if (!(i < j)) return;
     memmove(l->buf + i, l->buf + j, l->len - j + 1);
     memmove(l->buf + i, l->buf + j, l->len - j + 1);
     l->len -= j - i;
     l->len -= j - i;
@@ -2864,26 +2801,26 @@ static size_t bestlineEscape(char *d, const char *s, size_t n) {
     unsigned c, w, l;
     unsigned c, w, l;
     for (p = d, l = i = 0; i < n; ++i) {
     for (p = d, l = i = 0; i < n; ++i) {
         switch ((c = s[i] & 255)) {
         switch ((c = s[i] & 255)) {
-            Case('\a', w = Read16le("\\a"));
-            Case('\b', w = Read16le("\\b"));
-            Case('\t', w = Read16le("\\t"));
-            Case('\n', w = Read16le("\\n"));
-            Case('\v', w = Read16le("\\v"));
-            Case('\f', w = Read16le("\\f"));
-            Case('\r', w = Read16le("\\r"));
-            Case('"',  w = Read16le("\\\""));
-            Case('\'', w = Read16le("\\\'"));
-            Case('\\', w = Read16le("\\\\"));
-            default:
-                if (c <= 0x1F || c == 0x7F ||
-                    (c == '?' && l == '?')) {
-                    w = Read16le("\\x");
-                    w |= "0123456789abcdef"[(c & 0xF0) >> 4] << 020;
-                    w |= "0123456789abcdef"[(c & 0x0F) >> 0] << 030;
-                } else {
-                    w = c;
-                }
-                break;
+        Case('\a', w = Read16le("\\a"));
+        Case('\b', w = Read16le("\\b"));
+        Case('\t', w = Read16le("\\t"));
+        Case('\n', w = Read16le("\\n"));
+        Case('\v', w = Read16le("\\v"));
+        Case('\f', w = Read16le("\\f"));
+        Case('\r', w = Read16le("\\r"));
+        Case('"',  w = Read16le("\\\""));
+        Case('\'', w = Read16le("\\\'"));
+        Case('\\', w = Read16le("\\\\"));
+        default:
+            if (c <= 0x1F || c == 0x7F ||
+                (c == '?' && l == '?')) {
+                w = Read16le("\\x");
+                w |= "0123456789abcdef"[(c & 0xF0) >> 4] << 020;
+                w |= "0123456789abcdef"[(c & 0x0F) >> 0] << 030;
+            } else {
+                w = c;
+            }
+            break;
         }
         }
         p[0] = (w & 0x000000ff) >> 000;
         p[0] = (w & 0x000000ff) >> 000;
         p[1] = (w & 0x0000ff00) >> 010;
         p[1] = (w & 0x0000ff00) >> 010;
@@ -2932,6 +2869,149 @@ static void bestlineEditCtrlq(struct bestlineState *l) {
     }
     }
 }
 }
 
 
+/**
+ * Moves last item inside current s-expression to outside, e.g.
+ *
+ *     (a| b c)
+ *     (a| b) c
+ *
+ * The cursor position changes only if a paren is moved before it:
+ *
+ *     (a b    c   |)
+ *     (a b)    c   |
+ *
+ * To accommodate non-LISP languages we connect unspaced outer symbols:
+ *
+ *     f(a,| b, g())
+ *     f(a,| b), g()
+ *
+ * Our standard keybinding is ALT-SHIFT-B.
+ */
+static void bestlineEditBarf(struct bestlineState *l) {
+    struct rune r;
+    unsigned long w;
+    size_t i, j, pos, depth = 0;
+    unsigned lhs, rhs, end, *stack = 0;
+    /* go as far right within current s-expr as possible */
+    for (pos = l->pos;; pos += r.n) {
+        if (pos == l->len) goto Finish;
+        r = GetUtf8(l->buf + pos, l->len - pos);
+        if (depth) {
+            if (r.c == stack[depth - 1]) {
+                --depth;
+            }
+        } else {
+            if ((rhs = bestlineMirrorRight(r.c))) {
+                stack = realloc(stack, ++depth * sizeof(*stack));
+                stack[depth - 1] = rhs;
+            } else if (bestlineMirrorLeft(r.c)) {
+                end = pos;
+                break;
+            }
+        }
+    }
+    /* go back one item */
+    pos = Backwards(l, pos, bestlineIsXeparator);
+    for (;; pos = i) {
+        if (!pos) goto Finish;
+        i = Backward(l, pos);
+        r = GetUtf8(l->buf + i, l->len - i);
+        if (depth) {
+            if (r.c == stack[depth - 1]) {
+                --depth;
+            }
+        } else {
+            if ((lhs = bestlineMirrorLeft(r.c))) {
+                stack = realloc(stack, ++depth * sizeof(*stack));
+                stack[depth - 1] = lhs;
+            } else if (bestlineIsSeparator(r.c)) {
+                break;
+            }
+        }
+    }
+    pos = Backwards(l, pos, bestlineIsXeparator);
+    /* now move the text */
+    r = GetUtf8(l->buf + end, l->len - end);
+    memmove(l->buf + pos + r.n, l->buf + pos, end - pos);
+    w = EncodeUtf8(r.c);
+    for (i = 0; i < r.n; ++i) {
+        l->buf[pos + i] = w;
+        w >>= 8;
+    }
+    if (l->pos > pos) {
+        l->pos += r.n;
+    }
+    bestlineRefreshLine(l);
+Finish:
+    free(stack);
+}
+
+/**
+ * Moves first item outside current s-expression to inside, e.g.
+ *
+ *     (a| b) c d
+ *     (a| b c) d
+ *
+ * To accommodate non-LISP languages we connect unspaced outer symbols:
+ *
+ *     f(a,| b), g()
+ *     f(a,| b, g())
+ *
+ * Our standard keybinding is ALT-SHIFT-S.
+ */
+static void bestlineEditSlurp(struct bestlineState *l) {
+    char rp[6];
+    struct rune r;
+    unsigned long w;
+    size_t i, pos, depth = 0;
+    unsigned rhs, point = 0, start = 0, *stack = 0;
+    /* go to outside edge of current s-expr */
+    for (pos = l->pos; pos < l->len; pos += r.n) {
+        r = GetUtf8(l->buf + pos, l->len - pos);
+        if (depth) {
+            if (r.c == stack[depth - 1]) {
+                --depth;
+            }
+        } else {
+            if ((rhs = bestlineMirrorRight(r.c))) {
+                stack = realloc(stack, ++depth * sizeof(*stack));
+                stack[depth - 1] = rhs;
+            } else if (bestlineMirrorLeft(r.c)) {
+                point = pos;
+                pos += r.n;
+                start = pos;
+                break;
+            }
+        }
+    }
+    /* go forward one item */
+    pos = Forwards(l, pos, bestlineIsXeparator);
+    for (; pos < l->len ; pos += r.n) {
+        r = GetUtf8(l->buf + pos, l->len - pos);
+        if (depth) {
+            if (r.c == stack[depth - 1]) {
+                --depth;
+            }
+        } else {
+            if ((rhs = bestlineMirrorRight(r.c))) {
+                stack = realloc(stack, ++depth * sizeof(*stack));
+                stack[depth - 1] = rhs;
+            } else if (bestlineIsSeparator(r.c)) {
+                break;
+            }
+        }
+    }
+    /* now move the text */
+    memcpy(rp, l->buf + point, start - point);
+    memmove(l->buf + point, l->buf + start, pos - start);
+    memcpy(l->buf + pos - (start - point), rp, start - point);
+    bestlineRefreshLine(l);
+    free(stack);
+}
+
+static void bestlineEditRaise(struct bestlineState *l) {
+}
+
 /**
 /**
  * Runs bestline engine.
  * Runs bestline engine.
  *
  *
@@ -2948,8 +3028,8 @@ static ssize_t bestlineEdit(int stdin_fd, int stdout_fd, const char *prompt,
                             char **obuf) {
                             char **obuf) {
     ssize_t rc;
     ssize_t rc;
     size_t nread;
     size_t nread;
-    char *p, seq[16];
     struct rune rune;
     struct rune rune;
+    char *p, seq[16];
     unsigned long long w;
     unsigned long long w;
     struct bestlineState l;
     struct bestlineState l;
     memset(&l,0,sizeof(l));
     memset(&l,0,sizeof(l));
@@ -3002,10 +3082,20 @@ static ssize_t bestlineEdit(int stdin_fd, int stdout_fd, const char *prompt,
         Case(Ctrl('L'), bestlineEditRefresh(&l));
         Case(Ctrl('L'), bestlineEditRefresh(&l));
         Case(Ctrl('Z'), bestlineEditSuspend());
         Case(Ctrl('Z'), bestlineEditSuspend());
         Case(Ctrl('U'), bestlineEditKillLeft(&l));
         Case(Ctrl('U'), bestlineEditKillLeft(&l));
-        Case(Ctrl('C'), bestlineEditInterrupt());
         Case(Ctrl('T'), bestlineEditTranspose(&l));
         Case(Ctrl('T'), bestlineEditTranspose(&l));
         Case(Ctrl('K'), bestlineEditKillRight(&l));
         Case(Ctrl('K'), bestlineEditKillRight(&l));
         Case(Ctrl('W'), bestlineEditRuboutWord(&l));
         Case(Ctrl('W'), bestlineEditRuboutWord(&l));
+        case Ctrl('C'):
+            if (bestlineRead(l.ifd,seq,sizeof(seq),&l) != 1) break;
+            switch (seq[0]) {
+            Case(Ctrl('C'), bestlineEditInterrupt());
+            Case(Ctrl('B'), bestlineEditBarf(&l));
+            Case(Ctrl('S'), bestlineEditSlurp(&l));
+            Case(Ctrl('R'), bestlineEditRaise(&l));
+            default:
+                break;
+            }
+            break;
         case Ctrl('X'):
         case Ctrl('X'):
             if (l.seq[1][0] == Ctrl('X')) {
             if (l.seq[1][0] == Ctrl('X')) {
                 bestlineEditGoto(&l);
                 bestlineEditGoto(&l);
@@ -3035,6 +3125,9 @@ static ssize_t bestlineEdit(int stdin_fd, int stdout_fd, const char *prompt,
             switch (seq[1]) {
             switch (seq[1]) {
             Case('<', bestlineEditBof(&l));
             Case('<', bestlineEditBof(&l));
             Case('>', bestlineEditEof(&l));
             Case('>', bestlineEditEof(&l));
+            Case('B', bestlineEditBarf(&l));
+            Case('S', bestlineEditSlurp(&l));
+            Case('R', bestlineEditRaise(&l));
             Case('y', bestlineEditRotate(&l));
             Case('y', bestlineEditRotate(&l));
             Case('\\', bestlineEditSqueeze(&l));
             Case('\\', bestlineEditSqueeze(&l));
             Case('b', bestlineEditLeftWord(&l));
             Case('b', bestlineEditLeftWord(&l));
@@ -3093,19 +3186,19 @@ static ssize_t bestlineEdit(int stdin_fd, int stdout_fd, const char *prompt,
                 case '[':
                 case '[':
                     if (nread < 4) break;
                     if (nread < 4) break;
                     switch (seq[3]) {
                     switch (seq[3]) {
-                        Case('C', bestlineEditRightExpr(&l)); /* \e\e[C alt-right */
-                        Case('D', bestlineEditLeftExpr(&l));  /* \e\e[D alt-left */
-                        default:
-                            break;
+                    Case('C', bestlineEditRightExpr(&l)); /* \e\e[C alt-right */
+                    Case('D', bestlineEditLeftExpr(&l));  /* \e\e[D alt-left */
+                    default:
+                        break;
                     }
                     }
                     break;
                     break;
                 case 'O':
                 case 'O':
                     if (nread < 4) break;
                     if (nread < 4) break;
                     switch (seq[3]) {
                     switch (seq[3]) {
-                        Case('C', bestlineEditRightExpr(&l)); /* \e\eOC alt-right */
-                        Case('D', bestlineEditLeftExpr(&l));  /* \e\eOD alt-left */
-                        default:
-                            break;
+                    Case('C', bestlineEditRightExpr(&l)); /* \e\eOC alt-right */
+                    Case('D', bestlineEditLeftExpr(&l));  /* \e\eOD alt-left */
+                    default:
+                        break;
                     }
                     }
                     break;
                     break;
                 default:
                 default:
@@ -3420,7 +3513,7 @@ void bestlineSetFreeHintsCallback(bestlineFreeHintsCallback *fn) {
 /**
 /**
  * Sets character translation callback.
  * Sets character translation callback.
  */
  */
-void bestlineSetXlatCallback(unsigned fn(unsigned)) {
+void bestlineSetXlatCallback(bestlineXlatCallback *fn) {
     xlatCallback = fn;
     xlatCallback = fn;
 }
 }
 
 

+ 8 - 2
bestline.h

@@ -9,11 +9,13 @@ typedef void(bestlineCompletionCallback)(const char *, bestlineCompletions *);
 typedef char *(bestlineHintsCallback)(const char *, const char **,
 typedef char *(bestlineHintsCallback)(const char *, const char **,
                                        const char **);
                                        const char **);
 typedef void(bestlineFreeHintsCallback)(void *);
 typedef void(bestlineFreeHintsCallback)(void *);
+typedef unsigned(bestlineXlatCallback)(unsigned);
 
 
 void bestlineSetCompletionCallback(bestlineCompletionCallback *);
 void bestlineSetCompletionCallback(bestlineCompletionCallback *);
 void bestlineSetHintsCallback(bestlineHintsCallback *);
 void bestlineSetHintsCallback(bestlineHintsCallback *);
 void bestlineSetFreeHintsCallback(bestlineFreeHintsCallback *);
 void bestlineSetFreeHintsCallback(bestlineFreeHintsCallback *);
 void bestlineAddCompletion(bestlineCompletions *, const char *);
 void bestlineAddCompletion(bestlineCompletions *, const char *);
+void bestlineSetXlatCallback(bestlineXlatCallback *);
 
 
 char *bestline(const char *);
 char *bestline(const char *);
 char *bestlineRaw(const char *, int, int);
 char *bestlineRaw(const char *, int, int);
@@ -28,6 +30,10 @@ void bestlineMaskModeEnable(void);
 void bestlineMaskModeDisable(void);
 void bestlineMaskModeDisable(void);
 void bestlineDisableRawMode(void);
 void bestlineDisableRawMode(void);
 void bestlineFree(void *);
 void bestlineFree(void *);
-unsigned bestlineLowercase(unsigned);
+
+char bestlineIsSeparator(unsigned);
+char bestlineNotSeparator(unsigned);
+char bestlineIsXeparator(unsigned);
 unsigned bestlineUppercase(unsigned);
 unsigned bestlineUppercase(unsigned);
-void bestlineSetXlatCallback(unsigned(*)(unsigned));
+unsigned bestlineLowercase(unsigned);
+long bestlineReadCharacter(int, char *, unsigned long);

+ 96 - 159
lisp.c

@@ -33,10 +33,10 @@
 │ The LISP Challenge § LISP Machine                                        ─╬─│┼
 │ The LISP Challenge § LISP Machine                                        ─╬─│┼
 ╚────────────────────────────────────────────────────────────────────────────│*/
 ╚────────────────────────────────────────────────────────────────────────────│*/
 
 
-#define ATOM 0
-#define CONS 1
+#define ATOM 1
+#define CONS 0
 
 
-#define ISATOM(x)   (~(x)&1)
+#define ISATOM(x)   ((x)&1)
 #define VALUE(x)    ((x)>>1)
 #define VALUE(x)    ((x)>>1)
 #define OBJECT(t,v) ((v)<<1|(t))
 #define OBJECT(t,v) ((v)<<1|(t))
 
 
@@ -52,17 +52,7 @@
 #define ATOM_LAMBDA OBJECT(ATOM,38)
 #define ATOM_LAMBDA OBJECT(ATOM,38)
 #define UNDEFINED   OBJECT(ATOM,45)
 #define UNDEFINED   OBJECT(ATOM,45)
 
 
-struct Lisp {
-  int mem[8192];
-  unsigned char syntax[256];
-  int look;
-  int globals;
-  int index;
-  char token[128];
-  char str[8192];
-};
-
-static const char kSymbols[] =
+const char kSymbols[] =
     "NIL\0"
     "NIL\0"
     "T\0"
     "T\0"
     "QUOTE\0"
     "QUOTE\0"
@@ -78,53 +68,40 @@ static const char kSymbols[] =
 #endif
 #endif
 ;
 ;
 
 
-static struct Lisp q[1];
+int g_look;
+int g_index;
+char g_token[128];
+int g_mem[8192];
+char g_str[8192];
 
 
-static void Print(int);
-static int GetList(void);
-static int GetObject(void);
-static void PrintObject(int);
-static int Eval(int, int);
+int GetList(void);
+int GetObject(void);
+void PrintObject(int);
+int Eval(int, int);
 
 
-static void SetupSyntax(void) {
-  q->syntax[' '] = ' ';
-  q->syntax['\r'] = ' ';
-  q->syntax['\n'] = ' ';
-  q->syntax['('] = '(';
-  q->syntax[')'] = ')';
-  q->syntax['.'] = '.';
-  q->syntax['\''] = '\'';
+void SetupBuiltins(void) {
+  memmove(g_str, kSymbols, sizeof(kSymbols));
 }
 }
 
 
-static void SetupBuiltins(void) {
-  memmove(q->str, kSymbols, sizeof(kSymbols));
+int Car(int x) {
+  return g_mem[VALUE(x) + 0];
 }
 }
 
 
-static inline int Car(int x) {
-  return q->mem[VALUE(x) + 0];
+int Cdr(int x) {
+  return g_mem[VALUE(x) + 1];
 }
 }
 
 
-static inline int Cdr(int x) {
-  return q->mem[VALUE(x) + 1];
-}
-
-static int Set(int i, int k, int v) {
-  q->mem[VALUE(i) + 0] = k;
-  q->mem[VALUE(i) + 1] = v;
-  return i;
-}
-
-static int Cons(int car, int cdr) {
+int Cons(int car, int cdr) {
   int i, cell;
   int i, cell;
-  i = q->index;
-  q->mem[i + 0] = car;
-  q->mem[i + 1] = cdr;
-  q->index = i + 2;
+  i = g_index;
+  g_mem[i + 0] = car;
+  g_mem[i + 1] = cdr;
+  g_index = i + 2;
   cell = OBJECT(CONS, i);
   cell = OBJECT(CONS, i);
   return cell;
   return cell;
 }
 }
 
 
-static char *StpCpy(char *d, char *s) {
+char *StpCpy(char *d, char *s) {
   char c;
   char c;
   do {
   do {
     c = *s++;
     c = *s++;
@@ -133,10 +110,10 @@ static char *StpCpy(char *d, char *s) {
   return d;
   return d;
 }
 }
 
 
-static int Intern(char *s) {
+int Intern(char *s) {
   int j, cx;
   int j, cx;
   char c, *z, *t;
   char c, *z, *t;
-  z = q->str;
+  z = g_str;
   c = *z++;
   c = *z++;
   while (c) {
   while (c) {
     for (j = 0;; ++j) {
     for (j = 0;; ++j) {
@@ -144,7 +121,7 @@ static int Intern(char *s) {
         break;
         break;
       }
       }
       if (!c) {
       if (!c) {
-        return OBJECT(ATOM, z - q->str - j - 1);
+        return OBJECT(ATOM, z - g_str - j - 1);
       }
       }
       c = *z++;
       c = *z++;
     }
     }
@@ -153,14 +130,14 @@ static int Intern(char *s) {
   }
   }
   --z;
   --z;
   StpCpy(z, s);
   StpCpy(z, s);
-  return OBJECT(ATOM, z - q->str);
+  return OBJECT(ATOM, z - g_str);
 }
 }
 
 
-static void PrintChar(unsigned char b) {
+void PrintChar(unsigned char b) {
   if (write(1, &b, 1) == -1) exit(1);
   if (write(1, &b, 1) == -1) exit(1);
 }
 }
 
 
-static void PrintString(char *s) {
+void PrintString(char *s) {
   char c;
   char c;
   for (;;) {
   for (;;) {
     if (!(c = s[0])) break;
     if (!(c = s[0])) break;
@@ -169,12 +146,12 @@ static void PrintString(char *s) {
   }
   }
 }
 }
 
 
-static int GetChar(void) {
-  unsigned char b;
+int GetChar(void) {
+  int b;
   static char *l, *p;
   static char *l, *p;
   if (l || (l = p = bestlineWithHistory("* ", "sectorlisp"))) {
   if (l || (l = p = bestlineWithHistory("* ", "sectorlisp"))) {
     if (*p) {
     if (*p) {
-      b = *p++;
+      b = *p++ & 255;
     } else {
     } else {
       free(l);
       free(l);
       l = p = 0;
       l = p = 0;
@@ -182,108 +159,83 @@ static int GetChar(void) {
     }
     }
     return b;
     return b;
   } else {
   } else {
-    PrintChar('\n');
+    PrintString("\n");
     exit(0);
     exit(0);
   }
   }
 }
 }
 
 
-static void GetToken(void) {
-  char *t;
-  int b, x;
-  b = q->look;
-  t = q->token;
-  for (;;) {
-    x = q->syntax[b];
-    if (x != ' ') break;
-    b = GetChar();
-  }
-  if (x) {
-    *t++ = b;
-    b = GetChar();
-  } else {
-    while (b && !x) {
-      *t++ = b;
-      b = GetChar();
-      x = q->syntax[b];
+void GetToken(void) {
+  int al;
+  char *di;
+  di = g_token;
+  do {
+    if (g_look > ' ') {
+      *di++ = g_look;
     }
     }
-  }
-  *t++ = 0;
-  q->look = b;
+    al = g_look;
+    g_look = GetChar();
+  } while (al <= ' ' || (al > ')' && g_look > ')'));
+  *di++ = 0;
 }
 }
 
 
-static int ConsumeObject(void) {
+int ConsumeObject(void) {
   GetToken();
   GetToken();
   return GetObject();
   return GetObject();
 }
 }
 
 
-static int Cadr(int x) {
-  return Car(Cdr(x));  /* ((A B C D) (E F G) H I) → (E F G) */
-}
-
-static int List(int x, int y) {
+int List(int x, int y) {
   return Cons(x, Cons(y, NIL));
   return Cons(x, Cons(y, NIL));
 }
 }
 
 
-static int Quote(int x) {
+int Quote(int x) {
   return List(ATOM_QUOTE, x);
   return List(ATOM_QUOTE, x);
 }
 }
 
 
-static int GetQuote(void) {
+int GetQuote(void) {
   return Quote(ConsumeObject());
   return Quote(ConsumeObject());
 }
 }
 
 
-static int AddList(int x) {
+int AddList(int x) {
   return Cons(x, GetList());
   return Cons(x, GetList());
 }
 }
 
 
-static int GetList(void) {
+int GetList(void) {
   GetToken();
   GetToken();
-  switch (*q->token & 0xFF) {
-    default:
-      return AddList(GetObject());
-    case ')':
-      return NIL;
-    case '.':
-      return ConsumeObject();
 #if QUOTES
 #if QUOTES
-    case '\'':
-      return AddList(GetQuote());
+  if (*g_token == '.') return ConsumeObject();
+  if (*g_token == '\'') return AddList(GetQuote());
 #endif
 #endif
-  }
+  if (*g_token == ')') return NIL;
+  return AddList(GetObject());
 }
 }
 
 
-static int GetObject(void) {
-  switch (*q->token & 0xFF) {
-    default:
-      return Intern(q->token);
-    case '(':
-      return GetList();
+int GetObject(void) {
 #if QUOTES
 #if QUOTES
-    case '\'':
-      return GetQuote();
+  if (*g_token == '\'') return GetQuote();
 #endif
 #endif
-  }
+  if (*g_token == '(') return GetList();
+  return Intern(g_token);
 }
 }
 
 
-static int ReadObject(void) {
-  q->look = GetChar();
+int ReadObject(void) {
+  g_look = GetChar();
   GetToken();
   GetToken();
   return GetObject();
   return GetObject();
 }
 }
 
 
-static int Read(void) {
+int Read(void) {
   return ReadObject();
   return ReadObject();
 }
 }
 
 
-static void PrintAtom(int x) {
-  PrintString(q->str + VALUE(x));
+void PrintAtom(int x) {
+  PrintString(g_str + VALUE(x));
 }
 }
 
 
-static void PrintList(int x) {
+void PrintList(int x) {
 #if QUOTES
 #if QUOTES
   if (Car(x) == ATOM_QUOTE) {
   if (Car(x) == ATOM_QUOTE) {
     PrintChar('\'');
     PrintChar('\'');
-    PrintObject(Cadr(x));
+    PrintObject(Car(Cdr(x)));
     return;
     return;
   }
   }
 #endif
 #endif
@@ -294,7 +246,7 @@ static void PrintList(int x) {
       PrintChar(' ');
       PrintChar(' ');
       PrintObject(Car(x));
       PrintObject(Car(x));
     } else {
     } else {
-      PrintString(" . ");
+      PrintString("");
       PrintObject(x);
       PrintObject(x);
       break;
       break;
     }
     }
@@ -302,7 +254,7 @@ static void PrintList(int x) {
   PrintChar(')');
   PrintChar(')');
 }
 }
 
 
-static void PrintObject(int x) {
+void PrintObject(int x) {
   if (ISATOM(x)) {
   if (ISATOM(x)) {
     PrintAtom(x);
     PrintAtom(x);
   } else {
   } else {
@@ -310,60 +262,46 @@ static void PrintObject(int x) {
   }
   }
 }
 }
 
 
-static void Print(int i) {
+void Print(int i) {
   PrintObject(i);
   PrintObject(i);
-  PrintString("\r\n");
+  PrintString("\n");
 }
 }
 
 
 /*───────────────────────────────────────────────────────────────────────────│─╗
 /*───────────────────────────────────────────────────────────────────────────│─╗
 │ The LISP Challenge § Bootstrap John McCarthy's Metacircular Evaluator    ─╬─│┼
 │ The LISP Challenge § Bootstrap John McCarthy's Metacircular Evaluator    ─╬─│┼
 ╚────────────────────────────────────────────────────────────────────────────│*/
 ╚────────────────────────────────────────────────────────────────────────────│*/
 
 
-static int Caar(int x) {
-  return Car(Car(x));  /* ((A B C D) (E F G) H I) → A */
-}
-
-static int Cdar(int x) {
-  return Cdr(Car(x));  /* ((A B C D) (E F G) H I) → (B C D) */
-}
-
-static int Cadar(int x) {
-  return Cadr(Car(x));  /* ((A B C D) (E F G) H I) → B */
-}
-
-static int Caddr(int x) {
-  return Cadr(Cdr(x));  /* ((A B C D) (E F G) H I) → H */
+int Assoc(int x, int y) {
+  if (y == NIL) return NIL;
+  if (x == Car(Car(y))) return Cdr(Car(y));
+  return Assoc(x, Cdr(y));
 }
 }
 
 
-static int Caddar(int x) {
-  return Caddr(Car(x));  /* ((A B C D) (E F G) H I) → C */
-}
-
-static int Evcon(int c, int a) {
-  return Eval(Caar(c), a) != NIL ? Eval(Cadar(c), a) : Evcon(Cdr(c), a);
-}
-
-static int Assoc(int x, int a) {
-  return a ? Caar(a) == x ? Cdar(a) : Assoc(x, Cdr(a)) : NIL;
+int Evcon(int c, int a) {
+  if (Eval(Car(Car(c)), a) != NIL) {
+    return Eval(Car(Cdr(Car(c))), a);
+  } else {
+    return Evcon(Cdr(c), a);
+  }
 }
 }
 
 
-static int Pairlis(int x, int y, int a) {  /* it's zip() basically */
-  int di, si;
-  if (!x) return a;
+int Pairlis(int x, int y, int a) {
+  int di, si; /* it's zip() basically */
+  if (x == NIL) return a;
   di = Cons(Car(x), Car(y));
   di = Cons(Car(x), Car(y));
   si = Pairlis(Cdr(x), Cdr(y), a);
   si = Pairlis(Cdr(x), Cdr(y), a);
   return Cons(di, si); /* Tail-Modulo-Cons */
   return Cons(di, si); /* Tail-Modulo-Cons */
 }
 }
 
 
-static int Evlis(int m, int a) {
+int Evlis(int m, int a) {
   int di, si;
   int di, si;
-  if (!m) return NIL;
+  if (m == NIL) return NIL;
   di = Eval(Car(m), a);
   di = Eval(Car(m), a);
   si = Evlis(Cdr(m), a);
   si = Evlis(Cdr(m), a);
   return Cons(di, si);
   return Cons(di, si);
 }
 }
 
 
-static int Apply(int fn, int x, int a) {
+int Apply(int fn, int x, int a) {
   int t1, si, ax;
   int t1, si, ax;
   if (ISATOM(fn)) {
   if (ISATOM(fn)) {
     switch (fn) {
     switch (fn) {
@@ -372,15 +310,15 @@ static int Apply(int fn, int x, int a) {
       return UNDEFINED;
       return UNDEFINED;
 #endif
 #endif
     case ATOM_CAR:
     case ATOM_CAR:
-      return Caar(x);
+      return Car(Car(x));
     case ATOM_CDR:
     case ATOM_CDR:
-      return Cdar(x);
+      return Cdr(Car(x));
     case ATOM_ATOM:
     case ATOM_ATOM:
       return ISATOM(Car(x)) ? ATOM_T : NIL;
       return ISATOM(Car(x)) ? ATOM_T : NIL;
     case ATOM_CONS:
     case ATOM_CONS:
-      return Cons(Car(x), Cadr(x));
+      return Cons(Car(x), Car(Cdr(x)));
     case ATOM_EQ:
     case ATOM_EQ:
-      return Car(x) == Cadr(x) ? ATOM_T : NIL;
+      return Car(x) == Car(Cdr(x)) ? ATOM_T : NIL;
     default:
     default:
       return Apply(Eval(fn, a), x, a);
       return Apply(Eval(fn, a), x, a);
     }
     }
@@ -388,27 +326,27 @@ static int Apply(int fn, int x, int a) {
   if (Car(fn) == ATOM_LAMBDA) {
   if (Car(fn) == ATOM_LAMBDA) {
     t1 = Cdr(fn);
     t1 = Cdr(fn);
     si = Pairlis(Car(t1), x, a);
     si = Pairlis(Car(t1), x, a);
-    ax = Cadr(t1);
+    ax = Car(Cdr(t1));
     return Eval(ax, si);
     return Eval(ax, si);
   }
   }
   return UNDEFINED;
   return UNDEFINED;
 }
 }
 
 
-static int Evaluate(int e, int a) {
+int Evaluate(int e, int a) {
   int ax;
   int ax;
   if (ISATOM(e))
   if (ISATOM(e))
     return Assoc(e, a);
     return Assoc(e, a);
   ax = Car(e);
   ax = Car(e);
   if (ISATOM(ax)) {
   if (ISATOM(ax)) {
     if (ax == ATOM_QUOTE)
     if (ax == ATOM_QUOTE)
-      return Cadr(e);
+      return Car(Cdr(e));
     if (ax == ATOM_COND)
     if (ax == ATOM_COND)
       return Evcon(Cdr(e), a);
       return Evcon(Cdr(e), a);
   }
   }
   return Apply(ax, Evlis(Cdr(e), a), a);
   return Apply(ax, Evlis(Cdr(e), a), a);
 }
 }
 
 
-static int Eval(int e, int a) {
+int Eval(int e, int a) {
   int ax;
   int ax;
 #if TRACE
 #if TRACE
   PrintString("> ");
   PrintString("> ");
@@ -432,12 +370,11 @@ static int Eval(int e, int a) {
 
 
 void Repl(void) {
 void Repl(void) {
   for (;;) {
   for (;;) {
-    Print(Eval(Read(), q->globals));
+    Print(Eval(Read(), NIL));
   }
   }
 }
 }
 
 
 int main(int argc, char *argv[]) {
 int main(int argc, char *argv[]) {
-  SetupSyntax();
   SetupBuiltins();
   SetupBuiltins();
   bestlineSetXlatCallback(bestlineUppercase);
   bestlineSetXlatCallback(bestlineUppercase);
   PrintString("THE LISP CHALLENGE V1\r\n"
   PrintString("THE LISP CHALLENGE V1\r\n"

+ 37 - 31
lisp.lisp

@@ -73,44 +73,50 @@ NIL
 ;; CORRECT RESULT OF EXPRESSION IS STILL `A`
 ;; CORRECT RESULT OF EXPRESSION IS STILL `A`
 ;; REQUIRES CONS CAR CDR QUOTE ATOM EQ LAMBDA COND
 ;; REQUIRES CONS CAR CDR QUOTE ATOM EQ LAMBDA COND
 ;; SIMPLIFIED BUG FIXED VERSION OF JOHN MCCARTHY PAPER
 ;; SIMPLIFIED BUG FIXED VERSION OF JOHN MCCARTHY PAPER
-;; NOTE: ((EQ (CAR E) NIL) (QUOTE *UNDEFINED)) CAN HELP
+;; NOTE: ((EQ (CAR E) ()) (QUOTE *UNDEFINED)) CAN HELP
 ;; NOTE: ((EQ (CAR E) (QUOTE LAMBDA)) E) IS NICE
 ;; NOTE: ((EQ (CAR E) (QUOTE LAMBDA)) E) IS NICE
-((LAMBDA (ASSOC EVCON BIND APPEND EVAL)
+((LAMBDA (ASSOC EVCON PAIRLIS EVLIS APPLY EVAL)
    (EVAL (QUOTE ((LAMBDA (FF X) (FF X))
    (EVAL (QUOTE ((LAMBDA (FF X) (FF X))
                  (QUOTE (LAMBDA (X)
                  (QUOTE (LAMBDA (X)
                           (COND ((ATOM X) X)
                           (COND ((ATOM X) X)
                                 ((QUOTE T) (FF (CAR X))))))
                                 ((QUOTE T) (FF (CAR X))))))
                  (QUOTE ((A) B C))))
                  (QUOTE ((A) B C))))
-         NIL))
- (QUOTE (LAMBDA (X E)
-          (COND ((EQ E NIL) NIL)
-                ((EQ X (CAR (CAR E))) (CDR (CAR E)))
-                ((QUOTE T) (ASSOC X (CDR E))))))
- (QUOTE (LAMBDA (C E)
-          (COND ((EVAL (CAR (CAR C)) E) (EVAL (CAR (CDR (CAR C))) E))
-                ((QUOTE T) (EVCON (CDR C) E)))))
- (QUOTE (LAMBDA (V A E)
-          (COND ((EQ V NIL) E)
-                ((QUOTE T) (CONS (CONS (CAR V) (EVAL (CAR A) E))
-                                 (BIND (CDR V) (CDR A) E))))))
- (QUOTE (LAMBDA (A B)
-          (COND ((EQ A NIL) B)
-                ((QUOTE T) (CONS (CAR A) (APPEND (CDR A) B))))))
+         ()))
+ (QUOTE (LAMBDA (X Y)
+          (COND ((EQ Y ()) ())
+                ((EQ X (CAR (CAR Y)))
+                       (CDR (CAR Y)))
+                ((QUOTE T)
+                 (ASSOC X (CDR Y))))))
+ (QUOTE (LAMBDA (C A)
+          (COND ((EVAL (CAR (CAR C)) A)
+                 (EVAL (CAR (CDR (CAR C))) A))
+                ((QUOTE T) (EVCON (CDR C) A)))))
+ (QUOTE (LAMBDA (X Y A)
+          (COND ((EQ X ()) A)
+                ((QUOTE T) (CONS (CONS (CAR X) (CAR Y))
+                                 (PAIRLIS (CDR X) (CDR Y) A))))))
+ (QUOTE (LAMBDA (M A)
+          (COND ((EQ M ()) ())
+                ((QUOTE T) (CONS (EVAL (CAR M) A)
+                                 (EVLIS (CDR M) A A))))))
+ (QUOTE (LAMBDA (FN X A)
+          (COND
+            ((ATOM FN)
+             (COND ((EQ FN (QUOTE CAR))  (CAR  (CAR X)))
+                   ((EQ FN (QUOTE CDR))  (CDR  (CAR X)))
+                   ((EQ FN (QUOTE ATOM)) (ATOM (CAR X)))
+                   ((EQ FN (QUOTE CONS)) (CONS (CAR X) (CAR (CDR X))))
+                   ((EQ FN (QUOTE EQ))   (EQ   (CAR X) (CAR (CDR X))))
+                   ((QUOTE T)            (APPLY (EVAL FN A) X A))))
+            ((EQ (CAR FN) (QUOTE LAMBDA))
+             (EVAL (CAR (CDR (CDR FN)))
+                   (PAIRLIS (CAR (CDR FN)) X A))))))
  (QUOTE (LAMBDA (E A)
  (QUOTE (LAMBDA (E A)
           (COND
           (COND
             ((ATOM E) (ASSOC E A))
             ((ATOM E) (ASSOC E A))
             ((ATOM (CAR E))
             ((ATOM (CAR E))
-             (COND
-               ((EQ (CAR E) (QUOTE QUOTE)) (CAR (CDR E)))
-               ((EQ (CAR E) (QUOTE ATOM)) (ATOM (EVAL (CAR (CDR E)) A)))
-               ((EQ (CAR E) (QUOTE EQ)) (EQ (EVAL (CAR (CDR E)) A)
-                                            (EVAL (CAR (CDR (CDR E))) A)))
-               ((EQ (CAR E) (QUOTE CAR)) (CAR (EVAL (CAR (CDR E)) A)))
-               ((EQ (CAR E) (QUOTE CDR)) (CDR (EVAL (CAR (CDR E)) A)))
-               ((EQ (CAR E) (QUOTE CONS)) (CONS (EVAL (CAR (CDR E)) A)
-                                                (EVAL (CAR (CDR (CDR E))) A)))
-               ((EQ (CAR E) (QUOTE COND)) (EVCON (CDR E) A))
-               ((QUOTE T) (EVAL (CONS (EVAL (CAR E) A) (CDR E)) A))))
-            ((EQ (CAR (CAR E)) (QUOTE LAMBDA))
-             (EVAL (CAR (CDR (CDR (CAR E))))
-                   (BIND (CAR (CDR (CAR E))) (CDR E) A)))))))
+             (COND ((EQ (CAR E) (QUOTE QUOTE)) (CAR (CDR E)))
+                   ((EQ (CAR E) (QUOTE COND)) (EVCON (CDR E) A))
+                   ((QUOTE T) (APPLY (CAR E) (EVLIS (CDR E) A) A))))
+            ((QUOTE T) (APPLY (CAR E) (EVLIS (CDR E) A) A))))))

+ 11 - 11
sectorlisp.S

@@ -30,8 +30,8 @@
 .set ATOM_CONS,		61
 .set ATOM_CONS,		61
 .set ATOM_EQ,		71
 .set ATOM_EQ,		71
 
 
-.set q.token,	0x4000
-.set q.str,	0x4080
+.set g_token,	0x4000
+.set g_str,	0x4080
 .set boot,	0x7c00
 .set boot,	0x7c00
 
 
 ////////////////////////////////////////////////////////////////////////////////
 ////////////////////////////////////////////////////////////////////////////////
@@ -56,10 +56,10 @@ _begin:	push	%cs				# memory model cs=ds=es = 0x600
 	mov	%cx,%sp
 	mov	%cx,%sp
 	cld
 	cld
 	xor	%ax,%ax
 	xor	%ax,%ax
-	mov	%ax,%fs				# fs = &q.mem
+	mov	%ax,%fs				# fs = &g_mem
 	xor	%di,%di
 	xor	%di,%di
 	rep stosb				# clears our bss memory
 	rep stosb				# clears our bss memory
-main:	mov	$q.str,%di
+main:	mov	$g_str,%di
 	mov	$kSymbols,%si
 	mov	$kSymbols,%si
 	mov	$37,%cx
 	mov	$37,%cx
 	rep movsb
 	rep movsb
@@ -73,15 +73,15 @@ main:	mov	$q.str,%di
 	call	PutChar
 	call	PutChar
 	jmp	0b
 	jmp	0b
 
 
-GetToken:					# GetToken():al, dl is q.look
-	mov	$q.token,%di
+GetToken:					# GetToken():al, dl is g_look
+	mov	$g_token,%di
 1:	mov	%dl,%al
 1:	mov	%dl,%al
 	cmp	$' ',%al
 	cmp	$' ',%al
 	jbe	2f
 	jbe	2f
 	stosb
 	stosb
 	xchg	%ax,%cx
 	xchg	%ax,%cx
 2:	call	GetChar				# bh = 0 after PutChar
 2:	call	GetChar				# bh = 0 after PutChar
-	xchg	%ax,%dx				# dl = q.look
+	xchg	%ax,%dx				# dl = g_look
 	cmp	$' ',%al
 	cmp	$' ',%al
 	jbe	1b
 	jbe	1b
 	cmp	$')',%al
 	cmp	$')',%al
@@ -95,10 +95,10 @@ GetToken:					# GetToken():al, dl is q.look
 GetObject:					# called just after GetToken
 GetObject:					# called just after GetToken
 	cmpb	$'(',%al
 	cmpb	$'(',%al
 	je	GetList
 	je	GetList
-	mov	$q.token,%si
+	mov	$g_token,%si
 .Intern:
 .Intern:
 	mov	%si,%bx				# save s
 	mov	%si,%bx				# save s
-	mov	$q.str,%di
+	mov	$g_str,%di
 	xor	%al,%al
 	xor	%al,%al
 0:	mov	$-1,%cl
 0:	mov	$-1,%cl
 	push	%di				# save 1
 	push	%di				# save 1
@@ -118,7 +118,7 @@ GetObject:					# called just after GetToken
 	test	%al,%al
 	test	%al,%al
 	jnz	3b
 	jnz	3b
 4:	pop	%ax				# restore 1
 4:	pop	%ax				# restore 1
-	add	$-q.str,%ax			# stc
+	add	$-g_str,%ax			# stc
 	adc	%ax,%ax				# ax = 2 * ax + carry
 	adc	%ax,%ax				# ax = 2 * ax + carry
 .ret:	ret
 .ret:	ret
 
 
@@ -128,7 +128,7 @@ PrintObject:					# PrintObject(x:ax)
 	jz	.PrintList
 	jz	.PrintList
 .PrintAtom:
 .PrintAtom:
 	shr	%di
 	shr	%di
-	lea	q.str(%di),%si
+	lea	g_str(%di),%si
 .PrintString:					# nul-terminated in si
 .PrintString:					# nul-terminated in si
 	lodsb
 	lodsb
 	test	%al,%al
 	test	%al,%al