From 05d2bcbfd95b7afa8f180d528a40d6fbf80875c6 Mon Sep 17 00:00:00 2001 From: Justine Tunney Date: Sat, 30 Oct 2021 00:42:55 -0700 Subject: [PATCH] Improve LISP/C/ASM Rosetta Stone consistency --- bestline.c | 429 +++++++++++++++++++++++++++++++-------------------- bestline.h | 10 +- lisp.c | 255 ++++++++++++------------------ lisp.lisp | 68 ++++---- sectorlisp.S | 22 +-- 5 files changed, 413 insertions(+), 371 deletions(-) diff --git a/bestline.c b/bestline.c index 9979093..23ffd64 100644 --- a/bestline.c +++ b/bestline.c @@ -58,6 +58,7 @@ │ CTRL-L CLEAR │ │ CTRL-H BACKSPACE │ │ CTRL-D DELETE │ +│ CTRL-Y YANK │ │ CTRL-D EOF (IF EMPTY) │ │ CTRL-N NEXT HISTORY │ │ CTRL-P PREVIOUS HISTORY │ @@ -69,13 +70,17 @@ │ ALT-B BACKWARD WORD │ │ CTRL-ALT-F FORWARD 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-U KILL LINE BACKWARDS │ │ ALT-H KILL WORD BACKWARDS │ │ CTRL-W KILL WORD BACKWARDS │ │ CTRL-ALT-H KILL WORD BACKWARDS │ │ ALT-D KILL WORD FORWARDS │ -│ CTRL-Y YANK │ │ ALT-Y ROTATE KILL RING AND YANK AGAIN │ │ ALT-\ SQUEEZE ADJACENT WHITESPACE │ │ CTRL-T TRANSPOSE │ @@ -83,7 +88,6 @@ │ ALT-U UPPERCASE WORD │ │ ALT-L LOWERCASE WORD │ │ ALT-C CAPITALIZE WORD │ -│ CTRL-C INTERRUPT PROCESS │ │ CTRL-Z SUSPEND PROCESS │ │ CTRL-\ QUIT PROCESS │ │ CTRL-S PAUSE OUTPUT │ @@ -243,7 +247,7 @@ static struct sigaction orig_cont; static struct sigaction orig_winch; static struct termios orig_termios; static char *history[BESTLINE_MAX_HISTORY]; -static unsigned (*xlatCallback)(unsigned); +static bestlineXlatCallback *xlatCallback; static bestlineHintsCallback *hintsCallback; static bestlineFreeHintsCallback *freeHintsCallback; 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 * other things like blocks and emoji (So). */ -static char IsSeparator(unsigned c) { +char bestlineIsSeparator(unsigned c) { int m, l, r, n; if (c < 0200) { 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) { @@ -1091,7 +1095,7 @@ static unsigned GetMirror(const unsigned short A[][2], size_t n, unsigned c) { return 0; } -static unsigned GetMirrorLeft(unsigned c) { +unsigned bestlineMirrorLeft(unsigned c) { static const unsigned short kMirrorRight[][2] = { {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); } -static unsigned GetMirrorRight(unsigned c) { +unsigned bestlineMirrorRight(unsigned c) { static const unsigned short kMirrorLeft[][2] = { {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); } -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) { @@ -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; size_t i; ssize_t rc; @@ -1444,7 +1450,16 @@ static ssize_t ReadCharacter(int fd, char *p, size_t n) { break; case kEsc: 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 */ t = kDone; } 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) */ t = kStr; break; - case '\\': - goto Whoopsie; default: t = kDone; break; @@ -1562,7 +1575,7 @@ static char *GetLineChar(int fin, int fout) { rc = -1; break; } - if ((rc = ReadCharacter(fin, seq, sizeof(seq))) == -1) { + if ((rc = bestlineReadCharacter(fin, seq, sizeof(seq))) == -1) { if (errno == EAGAIN || errno == EWOULDBLOCK) { if (WaitUntilReady(fin, POLLIN) > 0) { continue; @@ -1584,7 +1597,7 @@ static char *GetLineChar(int fin, int fout) { } if (seq[0] == '\r') { 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') { break; } @@ -1681,12 +1694,19 @@ static int ParseUnsigned(const char *s, void *e) { 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) { int c, d; size_t i, w; struct rune r; 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) { c = p[i] & 255; switch (t) { @@ -1710,85 +1730,27 @@ static size_t GetMonospaceWidth(const char *p, size_t n, char *out_haswides) { r.c <<= 6; r.c |= c & 077; 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 { goto Whoopsie; } break; 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 { t = kAscii; } 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: if (0x20 <= c && c <= 0x2f) { t = kCsi2; - } else if (c == '[' && i == 3) { - /* linux function keys */ } else if (0x40 <= c && c <= 0x7e) { t = kAscii; } 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; } 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: assert(0); } @@ -1962,7 +1899,7 @@ static ssize_t bestlineRead(int fd, char *buf, size_t size, refreshme = 1; } if (refreshme) bestlineRefreshLine(l); - rc = ReadCharacter(fd, buf, size); + rc = bestlineReadCharacter(fd, buf, size); } while (rc == -1 && errno == EINTR); if (rc != -1) { got = rc; @@ -2271,11 +2208,11 @@ static size_t Backward(struct bestlineState *l, size_t 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; if ((pos = Backward(l, l->pos))) { right = GetUtf8(l->buf + pos, l->len - pos).c; - if ((left = GetMirrorLeft(right))) { + if ((left = bestlineMirrorLeft(right))) { depth = 0; index = pos; do { @@ -2298,13 +2235,13 @@ static int bestlineMirrorLeft(struct bestlineState *l, int res[2]) { return -1; } -static int bestlineMirrorRight(struct bestlineState *l, int res[2]) { +static int bestlineEditMirrorRight(struct bestlineState *l, int res[2]) { struct rune rune; unsigned pos, left, right, depth, index; pos = l->pos; rune = GetUtf8(l->buf + pos, l->len - pos); left = rune.c; - if ((right = GetMirrorRight(left))) { + if ((right = bestlineMirrorRight(left))) { depth = 0; index = pos; do { @@ -2326,10 +2263,10 @@ static int bestlineMirrorRight(struct bestlineState *l, int res[2]) { return -1; } -static int bestlineMirror(struct bestlineState *l, int res[2]) { +static int bestlineEditMirror(struct bestlineState *l, int res[2]) { 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; } @@ -2365,7 +2302,7 @@ static void bestlineRefreshLineImpl(struct bestlineState *l, int force) { gotwinch = 0; l->ws = GetTerminalSize(l->ws, l->ifd, l->ofd); } - hasflip = !l->final && !bestlineMirror(l, flip); + hasflip = !l->final && !bestlineEditMirror(l, flip); StartOver: 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) { - pos = Forwards(l, pos, IsSeparator); - pos = Forwards(l, pos, NotSeparator); + pos = Forwards(l, pos, bestlineIsSeparator); + pos = Forwards(l, pos, bestlineNotSeparator); return 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; } @@ -2616,13 +2553,13 @@ static size_t EscapeWord(struct bestlineState *l) { for (i = l->pos; i && i < l->len; i += r.n) { if (i < l->len) { r = GetUtf8(l->buf + i, l->len - i); - if (IsSeparator(r.c)) break; + if (bestlineIsSeparator(r.c)) break; } if ((j = i)) { do --j; while (j && (l->buf[j] & 0300) == 0200); r = GetUtf8(l->buf + j, l->len - j); - if (IsSeparator(r.c)) break; + if (bestlineIsSeparator(r.c)) break; } } return i; @@ -2652,22 +2589,22 @@ static void bestlineEditRightWord(struct bestlineState *l) { static void bestlineEditLeftExpr(struct bestlineState *l) { 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]; } else { - l->pos = Backwards(l, l->pos, NotSeparator); + l->pos = Backwards(l, l->pos, bestlineNotSeparator); } bestlineRefreshLine(l); } static void bestlineEditRightExpr(struct bestlineState *l) { 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]); } else { - l->pos = Forwards(l, l->pos, NotSeparator); + l->pos = Forwards(l, l->pos, bestlineNotSeparator); } bestlineRefreshLine(l); } @@ -2718,10 +2655,10 @@ static void bestlineEditXlatWord(struct bestlineState *l, unsigned xlat(unsigned struct rune r; struct abuf ab; abInit(&ab); - i = Forwards(l, l->pos, IsSeparator); + i = Forwards(l, l->pos, bestlineIsSeparator); for (j = i; j < l->len; j += r.n) { 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) { abAppendw(&ab, EncodeUtf8(c)); } else { /* avoid canonicalization */ @@ -2821,10 +2758,10 @@ static void bestlineEditTransposeWords(struct bestlineState *l) { char *q, *p; size_t pi, xi, xj, yi, yj; 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; p = q = (char *)malloc(yj - xi); p = Copy(p, l->buf + yi, yj - yi); @@ -2839,8 +2776,8 @@ static void bestlineEditTransposeWords(struct bestlineState *l) { static void bestlineEditSqueeze(struct bestlineState *l) { 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; memmove(l->buf + i, l->buf + j, l->len - j + 1); l->len -= j - i; @@ -2864,26 +2801,26 @@ static size_t bestlineEscape(char *d, const char *s, size_t n) { unsigned c, w, l; for (p = d, l = i = 0; i < n; ++i) { 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[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. * @@ -2948,8 +3028,8 @@ static ssize_t bestlineEdit(int stdin_fd, int stdout_fd, const char *prompt, char **obuf) { ssize_t rc; size_t nread; - char *p, seq[16]; struct rune rune; + char *p, seq[16]; unsigned long long w; struct bestlineState 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('Z'), bestlineEditSuspend()); Case(Ctrl('U'), bestlineEditKillLeft(&l)); - Case(Ctrl('C'), bestlineEditInterrupt()); Case(Ctrl('T'), bestlineEditTranspose(&l)); Case(Ctrl('K'), bestlineEditKillRight(&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'): if (l.seq[1][0] == Ctrl('X')) { bestlineEditGoto(&l); @@ -3035,6 +3125,9 @@ static ssize_t bestlineEdit(int stdin_fd, int stdout_fd, const char *prompt, switch (seq[1]) { Case('<', bestlineEditBof(&l)); Case('>', bestlineEditEof(&l)); + Case('B', bestlineEditBarf(&l)); + Case('S', bestlineEditSlurp(&l)); + Case('R', bestlineEditRaise(&l)); Case('y', bestlineEditRotate(&l)); Case('\\', bestlineEditSqueeze(&l)); Case('b', bestlineEditLeftWord(&l)); @@ -3093,19 +3186,19 @@ static ssize_t bestlineEdit(int stdin_fd, int stdout_fd, const char *prompt, case '[': if (nread < 4) break; 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; case 'O': if (nread < 4) break; 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; default: @@ -3420,7 +3513,7 @@ void bestlineSetFreeHintsCallback(bestlineFreeHintsCallback *fn) { /** * Sets character translation callback. */ -void bestlineSetXlatCallback(unsigned fn(unsigned)) { +void bestlineSetXlatCallback(bestlineXlatCallback *fn) { xlatCallback = fn; } diff --git a/bestline.h b/bestline.h index 6e03b28..d8d01a1 100644 --- a/bestline.h +++ b/bestline.h @@ -9,11 +9,13 @@ typedef void(bestlineCompletionCallback)(const char *, bestlineCompletions *); typedef char *(bestlineHintsCallback)(const char *, const char **, const char **); typedef void(bestlineFreeHintsCallback)(void *); +typedef unsigned(bestlineXlatCallback)(unsigned); void bestlineSetCompletionCallback(bestlineCompletionCallback *); void bestlineSetHintsCallback(bestlineHintsCallback *); void bestlineSetFreeHintsCallback(bestlineFreeHintsCallback *); void bestlineAddCompletion(bestlineCompletions *, const char *); +void bestlineSetXlatCallback(bestlineXlatCallback *); char *bestline(const char *); char *bestlineRaw(const char *, int, int); @@ -28,6 +30,10 @@ void bestlineMaskModeEnable(void); void bestlineMaskModeDisable(void); void bestlineDisableRawMode(void); void bestlineFree(void *); -unsigned bestlineLowercase(unsigned); + +char bestlineIsSeparator(unsigned); +char bestlineNotSeparator(unsigned); +char bestlineIsXeparator(unsigned); unsigned bestlineUppercase(unsigned); -void bestlineSetXlatCallback(unsigned(*)(unsigned)); +unsigned bestlineLowercase(unsigned); +long bestlineReadCharacter(int, char *, unsigned long); diff --git a/lisp.c b/lisp.c index adc5f4e..36d8ad7 100644 --- a/lisp.c +++ b/lisp.c @@ -33,10 +33,10 @@ │ 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 OBJECT(t,v) ((v)<<1|(t)) @@ -52,17 +52,7 @@ #define ATOM_LAMBDA OBJECT(ATOM,38) #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" "T\0" "QUOTE\0" @@ -78,53 +68,40 @@ static const char kSymbols[] = #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; - 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); return cell; } -static char *StpCpy(char *d, char *s) { +char *StpCpy(char *d, char *s) { char c; do { c = *s++; @@ -133,10 +110,10 @@ static char *StpCpy(char *d, char *s) { return d; } -static int Intern(char *s) { +int Intern(char *s) { int j, cx; char c, *z, *t; - z = q->str; + z = g_str; c = *z++; while (c) { for (j = 0;; ++j) { @@ -144,7 +121,7 @@ static int Intern(char *s) { break; } if (!c) { - return OBJECT(ATOM, z - q->str - j - 1); + return OBJECT(ATOM, z - g_str - j - 1); } c = *z++; } @@ -153,14 +130,14 @@ static int Intern(char *s) { } --z; 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); } -static void PrintString(char *s) { +void PrintString(char *s) { char c; for (;;) { 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; if (l || (l = p = bestlineWithHistory("* ", "sectorlisp"))) { if (*p) { - b = *p++; + b = *p++ & 255; } else { free(l); l = p = 0; @@ -182,108 +159,83 @@ static int GetChar(void) { } return b; } else { - PrintChar('\n'); + PrintString("\n"); 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(); 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)); } -static int Quote(int x) { +int Quote(int x) { return List(ATOM_QUOTE, x); } -static int GetQuote(void) { +int GetQuote(void) { return Quote(ConsumeObject()); } -static int AddList(int x) { +int AddList(int x) { return Cons(x, GetList()); } -static int GetList(void) { +int GetList(void) { GetToken(); - switch (*q->token & 0xFF) { - default: - return AddList(GetObject()); - case ')': - return NIL; - case '.': - return ConsumeObject(); #if QUOTES - case '\'': - return AddList(GetQuote()); + if (*g_token == '.') return ConsumeObject(); + if (*g_token == '\'') return AddList(GetQuote()); #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 - case '\'': - return GetQuote(); + if (*g_token == '\'') return GetQuote(); #endif - } + if (*g_token == '(') return GetList(); + return Intern(g_token); } -static int ReadObject(void) { - q->look = GetChar(); +int ReadObject(void) { + g_look = GetChar(); GetToken(); return GetObject(); } -static int Read(void) { +int Read(void) { 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 (Car(x) == ATOM_QUOTE) { PrintChar('\''); - PrintObject(Cadr(x)); + PrintObject(Car(Cdr(x))); return; } #endif @@ -294,7 +246,7 @@ static void PrintList(int x) { PrintChar(' '); PrintObject(Car(x)); } else { - PrintString(" . "); + PrintString("∙"); PrintObject(x); break; } @@ -302,7 +254,7 @@ static void PrintList(int x) { PrintChar(')'); } -static void PrintObject(int x) { +void PrintObject(int x) { if (ISATOM(x)) { PrintAtom(x); } else { @@ -310,60 +262,46 @@ static void PrintObject(int x) { } } -static void Print(int i) { +void Print(int i) { PrintObject(i); - PrintString("\r\n"); + PrintString("\n"); } /*───────────────────────────────────────────────────────────────────────────│─╗ │ 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 */ +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 Cdar(int x) { - return Cdr(Car(x)); /* ((A B C D) (E F G) H I) → (B C D) */ +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 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 */ -} - -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; -} - -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)); si = Pairlis(Cdr(x), Cdr(y), a); return Cons(di, si); /* Tail-Modulo-Cons */ } -static int Evlis(int m, int a) { +int Evlis(int m, int a) { int di, si; - if (!m) return NIL; + if (m == NIL) return NIL; di = Eval(Car(m), a); si = Evlis(Cdr(m), a); 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; if (ISATOM(fn)) { switch (fn) { @@ -372,15 +310,15 @@ static int Apply(int fn, int x, int a) { return UNDEFINED; #endif case ATOM_CAR: - return Caar(x); + return Car(Car(x)); case ATOM_CDR: - return Cdar(x); + return Cdr(Car(x)); case ATOM_ATOM: return ISATOM(Car(x)) ? ATOM_T : NIL; case ATOM_CONS: - return Cons(Car(x), Cadr(x)); + return Cons(Car(x), Car(Cdr(x))); case ATOM_EQ: - return Car(x) == Cadr(x) ? ATOM_T : NIL; + return Car(x) == Car(Cdr(x)) ? ATOM_T : NIL; default: 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) { t1 = Cdr(fn); si = Pairlis(Car(t1), x, a); - ax = Cadr(t1); + ax = Car(Cdr(t1)); return Eval(ax, si); } return UNDEFINED; } -static int Evaluate(int e, int a) { +int Evaluate(int e, int a) { int ax; if (ISATOM(e)) return Assoc(e, a); ax = Car(e); if (ISATOM(ax)) { if (ax == ATOM_QUOTE) - return Cadr(e); + return Car(Cdr(e)); if (ax == ATOM_COND) return Evcon(Cdr(e), a); } return Apply(ax, Evlis(Cdr(e), a), a); } -static int Eval(int e, int a) { +int Eval(int e, int a) { int ax; #if TRACE PrintString("> "); @@ -432,12 +370,11 @@ static int Eval(int e, int a) { void Repl(void) { for (;;) { - Print(Eval(Read(), q->globals)); + Print(Eval(Read(), NIL)); } } int main(int argc, char *argv[]) { - SetupSyntax(); SetupBuiltins(); bestlineSetXlatCallback(bestlineUppercase); PrintString("THE LISP CHALLENGE V1\r\n" diff --git a/lisp.lisp b/lisp.lisp index d8f7f50..aeb3e29 100644 --- a/lisp.lisp +++ b/lisp.lisp @@ -73,44 +73,50 @@ NIL ;; CORRECT RESULT OF EXPRESSION IS STILL `A` ;; REQUIRES CONS CAR CDR QUOTE ATOM EQ LAMBDA COND ;; 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 -((LAMBDA (ASSOC EVCON BIND APPEND EVAL) +((LAMBDA (ASSOC EVCON PAIRLIS EVLIS APPLY EVAL) (EVAL (QUOTE ((LAMBDA (FF X) (FF X)) (QUOTE (LAMBDA (X) (COND ((ATOM X) X) ((QUOTE T) (FF (CAR X)))))) (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) (COND ((ATOM E) (ASSOC E A)) ((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)))))) diff --git a/sectorlisp.S b/sectorlisp.S index b7342c3..17f08d5 100644 --- a/sectorlisp.S +++ b/sectorlisp.S @@ -30,8 +30,8 @@ .set ATOM_CONS, 61 .set ATOM_EQ, 71 -.set q.token, 0x4000 -.set q.str, 0x4080 +.set g_token, 0x4000 +.set g_str, 0x4080 .set boot, 0x7c00 //////////////////////////////////////////////////////////////////////////////// @@ -56,10 +56,10 @@ _begin: push %cs # memory model cs=ds=es = 0x600 mov %cx,%sp cld xor %ax,%ax - mov %ax,%fs # fs = &q.mem + mov %ax,%fs # fs = &g_mem xor %di,%di rep stosb # clears our bss memory -main: mov $q.str,%di +main: mov $g_str,%di mov $kSymbols,%si mov $37,%cx rep movsb @@ -73,15 +73,15 @@ main: mov $q.str,%di call PutChar 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 cmp $' ',%al jbe 2f stosb xchg %ax,%cx 2: call GetChar # bh = 0 after PutChar - xchg %ax,%dx # dl = q.look + xchg %ax,%dx # dl = g_look cmp $' ',%al jbe 1b cmp $')',%al @@ -95,10 +95,10 @@ GetToken: # GetToken():al, dl is q.look GetObject: # called just after GetToken cmpb $'(',%al je GetList - mov $q.token,%si + mov $g_token,%si .Intern: mov %si,%bx # save s - mov $q.str,%di + mov $g_str,%di xor %al,%al 0: mov $-1,%cl push %di # save 1 @@ -118,7 +118,7 @@ GetObject: # called just after GetToken test %al,%al jnz 3b 4: pop %ax # restore 1 - add $-q.str,%ax # stc + add $-g_str,%ax # stc adc %ax,%ax # ax = 2 * ax + carry .ret: ret @@ -128,7 +128,7 @@ PrintObject: # PrintObject(x:ax) jz .PrintList .PrintAtom: shr %di - lea q.str(%di),%si + lea g_str(%di),%si .PrintString: # nul-terminated in si lodsb test %al,%al