From 084f0ac89cda6b5780d8ecf08e41dd96fd227068 Mon Sep 17 00:00:00 2001 From: jpco Date: Mon, 24 Mar 2025 21:50:00 -0700 Subject: [PATCH 01/34] Small simplification of gc functions --- gc.c | 126 ++++++++++++++++++++++++++++------------------------------- 1 file changed, 59 insertions(+), 67 deletions(-) diff --git a/gc.c b/gc.c index 946ee31b..899fa080 100644 --- a/gc.c +++ b/gc.c @@ -311,24 +311,18 @@ static void scanroots(Root *rootlist) { /* scanspace -- scan new space until it is up to date */ static void scanspace(void) { - Space *sp, *scanned; - for (scanned = NULL;;) { - Space *front = new; - for (sp = new; sp != scanned; sp = sp->next) { - char *scan; - assert(sp != NULL); - scan = sp->bot; - while (scan < sp->current) { - Tag *tag = *(Tag **) scan; - assert(tag->magic == TAGMAGIC); - scan += sizeof (Tag *); - VERBOSE(("GC %8ux : %s scan\n", scan, tag->typename)); - scan += ALIGN((*tag->scan)(scan)); - } + Space *sp; + for (sp = new; sp != NULL; sp = sp->next) { + char *scan; + assert(sp != NULL); + scan = sp->bot; + while (scan < sp->current) { + Tag *tag = *(Tag **) scan; + assert(tag->magic == TAGMAGIC); + scan += sizeof (Tag *); + VERBOSE(("GC %8ux : %s scan\n", scan, tag->typename)); + scan += ALIGN((*tag->scan)(scan)); } - if (new == front) - break; - scanned = front; } } @@ -372,71 +366,69 @@ extern Boolean gcisblocked(void) { /* gc -- actually do a garbage collection */ extern void gc(void) { - do { - size_t livedata; - Space *space; + size_t livedata; + Space *space; #if GCINFO - size_t olddata = 0; - if (gcinfo) - for (space = new; space != NULL; space = space->next) - olddata += SPACEUSED(space); + size_t olddata = 0; + if (gcinfo) + for (space = new; space != NULL; space = space->next) + olddata += SPACEUSED(space); #endif - assert(gcblocked >= 0); - if (gcblocked > 0) - return; - ++gcblocked; + assert(gcblocked >= 0); + if (gcblocked > 0) + return; + ++gcblocked; - assert(new != NULL); - assert(old == NULL); - old = new; + assert(new != NULL); + assert(old == NULL); + old = new; #if GCPROTECT - for (; new->next != NULL; new = new->next) - ; - if (++new >= &spaces[NSPACES]) - new = &spaces[0]; - new = mkspace(new, NULL); + for (; new->next != NULL; new = new->next) + ; + if (++new >= &spaces[NSPACES]) + new = &spaces[0]; + new = mkspace(new, NULL); #else - new = newspace(NULL); + new = newspace(NULL); #endif - VERBOSE(("\nGC collection starting\n")); + VERBOSE(("\nGC collection starting\n")); #if GCVERBOSE - for (space = old; space != NULL; space = space->next) - VERBOSE(("GC old space = %ux ... %ux\n", space->bot, space->current)); + for (space = old; space != NULL; space = space->next) + VERBOSE(("GC old space = %ux ... %ux\n", space->bot, space->current)); #endif - VERBOSE(("GC new space = %ux ... %ux\n", new->bot, new->top)); - VERBOSE(("GC scanning root list\n")); - scanroots(rootlist); - VERBOSE(("GC scanning global root list\n")); - scanroots(globalrootlist); - VERBOSE(("GC scanning exception root list\n")); - scanroots(exceptionrootlist); - VERBOSE(("GC scanning new space\n")); - scanspace(); - VERBOSE(("GC collection done\n\n")); - - deprecate(old); - old = NULL; - - for (livedata = 0, space = new; space != NULL; space = space->next) - livedata += SPACEUSED(space); + VERBOSE(("GC new space = %ux ... %ux\n", new->bot, new->top)); + VERBOSE(("GC scanning root list\n")); + scanroots(rootlist); + VERBOSE(("GC scanning global root list\n")); + scanroots(globalrootlist); + VERBOSE(("GC scanning exception root list\n")); + scanroots(exceptionrootlist); + VERBOSE(("GC scanning new space\n")); + scanspace(); + VERBOSE(("GC collection done\n\n")); + + deprecate(old); + old = NULL; + + for (livedata = 0, space = new; space != NULL; space = space->next) + livedata += SPACEUSED(space); #if GCINFO - if (gcinfo) - eprint( - "[GC: old %8d live %8d min %8d (pid %5d)]\n", - olddata, livedata, minspace, getpid() - ); + if (gcinfo) + eprint( + "[GC: old %8d live %8d min %8d (pid %5d)]\n", + olddata, livedata, minspace, getpid() + ); #endif - if (minspace < livedata * 2) - minspace = livedata * 4; - else if (minspace > livedata * 12 && minspace > (MIN_minspace * 2)) - minspace /= 2; + if (minspace < livedata * 2) + minspace = livedata * 4; + else if (minspace > livedata * 12 && minspace > (MIN_minspace * 2)) + minspace /= 2; - --gcblocked; - } while (new->next != NULL); + --gcblocked; } /* initgc -- initialize the garbage collector */ From cec72d51ac1516ddcdcf39463093fd29a2c6bfbe Mon Sep 17 00:00:00 2001 From: jpco Date: Tue, 25 Mar 2025 17:03:13 -0700 Subject: [PATCH 02/34] working (?!) implementation of palloc and friends this keeps the in-progress parse tree separate from the rest of the shell memory --- es.h | 7 +- gc.c | 213 ++++++++++++++++++++++++++++++++++++++++------------- gc.h | 2 + heredoc.c | 8 +- input.c | 10 +-- input.h | 1 - prim-etc.c | 2 +- str.c | 20 ++++- syntax.c | 19 ++--- syntax.h | 9 +++ token.c | 6 +- tree.c | 41 +++++++---- 12 files changed, 242 insertions(+), 96 deletions(-) diff --git a/es.h b/es.h index 472e88ee..d6e95c13 100644 --- a/es.h +++ b/es.h @@ -136,7 +136,7 @@ extern List *sortlist(List *list); /* tree.c */ -extern Tree *mk(NodeKind VARARGS); +extern Tree *gcmk(NodeKind VARARGS); /* closure.c */ @@ -392,6 +392,11 @@ extern void gcenable(void); /* enable collections */ extern void gcdisable(void); /* disable collections */ extern Boolean gcisblocked(void); /* is collection disabled? */ +extern void *palloc(size_t n, Tag *t); /* allocate like gcalloc but in pspace */ +extern void *pseal(void *p); /* collect pspace into gcspace and return pointer */ +extern char *pdup(const char *s); /* copy a 0-terminated string into pspace */ +extern char *pndup(const char *s, size_t n); /* copy a counted string into pspace */ + /* * garbage collector tags diff --git a/gc.c b/gc.c index 899fa080..efd44b64 100644 --- a/gc.c +++ b/gc.c @@ -19,6 +19,7 @@ struct Space { #define INSPACE(p, sp) ((sp)->bot <= (char *) (p) && (char *) (p) < (sp)->top) #define MIN_minspace 10000 +#define MIN_minpspace 5000 #if GCPROTECT #define NSPACES 10 @@ -38,13 +39,15 @@ int gcblocked = 0; Tag StringTag; /* own variables */ -static Space *new, *old; +static Space *new, *old, *pspace; #if GCPROTECT static Space *spaces; #endif static Root *globalrootlist, *exceptionrootlist; static size_t minspace = MIN_minspace; /* minimum number of bytes in a new space */ +static size_t minpspace = MIN_minpspace; /* minimum number of bytes in a new pspace */ + /* * debugging @@ -192,6 +195,18 @@ static Space *newspace(Space *next) { #endif /* !GCPROTECT */ +/* newpspace -- create a new ``half'' space for use while parsing + * only exists to avoid gcprotect which I don't understand */ +static Space *newpspace(Space *next) { + size_t n = ALIGN(minpspace); + Space *space = ealloc(sizeof (Space) + n); + space->bot = (void *) &space[1]; + space->top = (void *) (((char *) space->bot) + n); + space->current = space->bot; + space->next = next; + return space; +} + /* deprecate -- take a space and invalidate it */ static void deprecate(Space *space) { #if GCPROTECT @@ -222,7 +237,8 @@ static void deprecate(Space *space) { } /* isinspace -- does an object lie inside a given Space? */ -extern Boolean isinspace(Space *space, void *p) { +extern Boolean isinspace(Space *space0, void *p) { + Space *space = space0; for (; space != NULL; space = space->next) if (INSPACE(p, space)) { assert((char *) p < space->current); @@ -273,12 +289,17 @@ extern void exceptionunroot(void) { #define FOLLOWTO(p) ((Tag *) (((char *) p) + 1)) #define FOLLOW(tagp) ((void *) (((char *) tagp) - 1)) +static Boolean pmode = FALSE; + /* forward -- forward an individual pointer from old space */ extern void *forward(void *p) { Tag *tag; void *np; - if (!isinspace(old, p)) { + if (pmode && !isinspace(pspace, p)) { + VERBOSE(("GC %8ux : <>\n", p)); + return p; + } else if (!pmode && !isinspace(old, p)) { VERBOSE(("GC %8ux : <>\n", p)); return p; } @@ -313,9 +334,7 @@ static void scanroots(Root *rootlist) { static void scanspace(void) { Space *sp; for (sp = new; sp != NULL; sp = sp->next) { - char *scan; - assert(sp != NULL); - scan = sp->bot; + char *scan = sp->bot; while (scan < sp->current) { Tag *tag = *(Tag **) scan; assert(tag->magic == TAGMAGIC); @@ -366,69 +385,112 @@ extern Boolean gcisblocked(void) { /* gc -- actually do a garbage collection */ extern void gc(void) { - size_t livedata; - Space *space; + do { + size_t livedata; + Space *space; #if GCINFO - size_t olddata = 0; - if (gcinfo) - for (space = new; space != NULL; space = space->next) - olddata += SPACEUSED(space); + size_t olddata = 0; + if (gcinfo) + for (space = new; space != NULL; space = space->next) + olddata += SPACEUSED(space); #endif - assert(gcblocked >= 0); - if (gcblocked > 0) - return; - ++gcblocked; + assert(gcblocked >= 0); + if (gcblocked > 0) + return; + ++gcblocked; - assert(new != NULL); - assert(old == NULL); - old = new; + assert(new != NULL); + assert(old == NULL); + old = new; #if GCPROTECT - for (; new->next != NULL; new = new->next) - ; - if (++new >= &spaces[NSPACES]) - new = &spaces[0]; - new = mkspace(new, NULL); + for (; new->next != NULL; new = new->next) + ; + if (++new >= &spaces[NSPACES]) + new = &spaces[0]; + new = mkspace(new, NULL); #else - new = newspace(NULL); + new = newspace(NULL); #endif - VERBOSE(("\nGC collection starting\n")); + VERBOSE(("\nGC collection starting\n")); #if GCVERBOSE - for (space = old; space != NULL; space = space->next) - VERBOSE(("GC old space = %ux ... %ux\n", space->bot, space->current)); + for (space = old; space != NULL; space = space->next) + VERBOSE(("GC old space = %ux ... %ux\n", space->bot, space->current)); #endif - VERBOSE(("GC new space = %ux ... %ux\n", new->bot, new->top)); - VERBOSE(("GC scanning root list\n")); - scanroots(rootlist); - VERBOSE(("GC scanning global root list\n")); - scanroots(globalrootlist); - VERBOSE(("GC scanning exception root list\n")); - scanroots(exceptionrootlist); - VERBOSE(("GC scanning new space\n")); - scanspace(); - VERBOSE(("GC collection done\n\n")); + VERBOSE(("GC new space = %ux ... %ux\n", new->bot, new->top)); + VERBOSE(("GC scanning root list\n")); + scanroots(rootlist); + VERBOSE(("GC scanning global root list\n")); + scanroots(globalrootlist); + VERBOSE(("GC scanning exception root list\n")); + scanroots(exceptionrootlist); + VERBOSE(("GC scanning new space\n")); + scanspace(); + VERBOSE(("GC collection done\n\n")); + + deprecate(old); + old = NULL; + + for (livedata = 0, space = new; space != NULL; space = space->next) + livedata += SPACEUSED(space); - deprecate(old); - old = NULL; +#if GCINFO + if (gcinfo) + eprint( + "[GC: old %8d live %8d min %8d (pid %5d)]\n", + olddata, livedata, minspace, getpid() + ); +#endif - for (livedata = 0, space = new; space != NULL; space = space->next) - livedata += SPACEUSED(space); + if (minspace < livedata * 2) + minspace = livedata * 4; + else if (minspace > livedata * 12 && minspace > (MIN_minspace * 2)) + minspace /= 2; -#if GCINFO - if (gcinfo) - eprint( - "[GC: old %8d live %8d min %8d (pid %5d)]\n", - olddata, livedata, minspace, getpid() - ); + --gcblocked; + } while (new->next != NULL); +} + +/* pseal -- collect pspace to new, and translate p to its new location */ +extern void *pseal(void *p) { + size_t psize = 0; + Space *sp; + + for (sp = pspace; sp != NULL; sp = sp->next) + psize += SPACEUSED(sp); + + if (psize == 0) + return p; + + gcreserve(psize); + pmode = TRUE; + VERBOSE(("Reserved %d for pspace copy\n", psize)); + + assert (gcblocked >= 0); + ++gcblocked; + +#if GCVERBOSE + for (sp = pspace; sp != NULL; sp = sp->next) + VERBOSE(("GC pspace = %ux ... %ux\n", sp->bot, sp->current)); #endif + VERBOSE(("GC new space = %ux ... %ux\n", new->bot, new->top)); - if (minspace < livedata * 2) - minspace = livedata * 4; - else if (minspace > livedata * 12 && minspace > (MIN_minspace * 2)) - minspace /= 2; + p = forward(p); + /* slow */ + scanspace(); + + /* TODO: possible performance win: save+reuse the first pspace */ + for (sp = pspace; sp != NULL;) { + Space *old = sp; + sp = sp->next; + efree(old); + } + pspace = newpspace(NULL); --gcblocked; + pmode = FALSE; + return p; } /* initgc -- initialize the garbage collector */ @@ -441,6 +503,7 @@ extern void initgc(void) { #else new = newspace(NULL); #endif + pspace = newpspace(NULL); old = NULL; } @@ -473,6 +536,24 @@ extern void *gcalloc(size_t nbytes, Tag *tag) { } } +/* palloc -- allocate an object in pspace during parse */ +extern void *palloc(size_t nbytes, Tag *tag) { + size_t n = ALIGN(nbytes + sizeof (Tag *)); + assert(tag == NULL || tag->magic == TAGMAGIC); + for (;;) { + Tag **p = (void *) pspace->current; + char *q = ((char *) p) + n; + if (q <= pspace->top) { + pspace->current = q; + *p++ = tag; + return p; + } + if (minpspace < nbytes) + minpspace = nbytes + sizeof (Tag *); + pspace = newpspace(pspace); + } +} + /* * strings @@ -511,6 +592,22 @@ static size_t StringScan(void *p) { } +extern char *pndup(const char *s, size_t n) { + char *ns; + + ns = palloc((n + 1) * sizeof (char), &StringTag); + memcpy(ns, s, n); + ns[n] = '\0'; + assert(strlen(ns) == n); + + return ns; +} + +extern char *pdup(const char *s) { + return pndup(s, strlen(s)); +} + + /* * allocation of large, contiguous buffers for large object creation * see the use of this in str(). note that this region may not @@ -539,12 +636,24 @@ extern char *sealbuffer(Buffer *buf) { return s; } +extern char *psealbuffer(Buffer *buf) { + char *s = pdup(buf->str); + efree(buf); + return s; +} + extern char *sealcountedbuffer(Buffer *buf) { char *s = gcndup(buf->str, buf->current); efree(buf); return s; } +extern char *psealcountedbuffer(Buffer *buf) { + char *s = pndup(buf->str, buf->current); + efree(buf); + return s; +} + extern Buffer *bufncat(Buffer *buf, const char *s, size_t len) { while (buf->current + len >= buf->len) buf = expandbuffer(buf, buf->current + len - buf->len); diff --git a/gc.h b/gc.h index 683b5beb..d5949aa3 100644 --- a/gc.h +++ b/gc.h @@ -50,6 +50,8 @@ extern Buffer *bufcat(Buffer *buf, const char *s); extern Buffer *bufputc(Buffer *buf, char c); extern char *sealbuffer(Buffer *buf); extern char *sealcountedbuffer(Buffer *buf); +extern char *psealbuffer(Buffer *buf); +extern char *psealcountedbuffer(Buffer *buf); extern void freebuffer(Buffer *buf); extern void *forward(void *p); diff --git a/heredoc.c b/heredoc.c index 87959ccc..5cc7afdc 100644 --- a/heredoc.c +++ b/heredoc.c @@ -22,7 +22,7 @@ extern Tree *getherevar(void) { while ((c = GETC()) != EOF && !dnw[c]) buf = bufputc(buf, c); len = buf->len; - s = sealcountedbuffer(buf); + s = psealcountedbuffer(buf); if (len == 0) { yyerror("null variable name in here document"); return NULL; @@ -55,7 +55,7 @@ extern Tree *snarfheredoc(const char *eof, Boolean quoted) { if (buf->current == 0 && tree != NULL) freebuffer(buf); else - *tailp = treecons(mk(nQword, sealcountedbuffer(buf)), NULL); + *tailp = treecons(mk(nQword, psealcountedbuffer(buf)), NULL); break; } if (s != (unsigned char *) eof) @@ -74,7 +74,7 @@ extern Tree *snarfheredoc(const char *eof, Boolean quoted) { if (buf->current == 0) freebuffer(buf); else { - *tailp = treecons(mk(nQword, sealcountedbuffer(buf)), NULL); + *tailp = treecons(mk(nQword, psealcountedbuffer(buf)), NULL); tailp = &(*tailp)->CDR; } var = getherevar(); @@ -137,7 +137,7 @@ extern Boolean queueheredoc(Tree *t) { return FALSE; } - here = gcalloc(sizeof (Here), NULL); + here = palloc(sizeof (Here), NULL); here->next = hereq; here->marker = eof; hereq = here; diff --git a/input.c b/input.c index 13b7f267..35b166c4 100644 --- a/input.c +++ b/input.c @@ -402,7 +402,6 @@ extern Tree *parse(char *pr1, char *pr2) { #endif prompt2 = pr2; - gcreserve(300 * sizeof (Tree)); gcdisable(); result = yyparse(); gcenable(); @@ -414,11 +413,13 @@ extern Tree *parse(char *pr1, char *pr2) { error = NULL; fail("$&parse", "%s", e); } + + Ref(Tree *, pt, pseal(parsetree)); #if LISPTREES if (input->runflags & run_lisptrees) - eprint("%B\n", parsetree); + eprint("%B\n", pt); #endif - return parsetree; + RefReturn(pt); } /* resetparser -- clear parser errors in the signal handler */ @@ -728,9 +729,6 @@ extern void initinput(void) { /* mark the historyfd as a file descriptor to hold back from forked children */ registerfd(&historyfd, TRUE); - /* call the parser's initialization */ - initparse(); - #if HAVE_READLINE rl_readline_name = "es"; diff --git a/input.h b/input.h index 5250b1dd..a71d5f81 100644 --- a/input.h +++ b/input.h @@ -44,7 +44,6 @@ extern void print_prompt2(void); extern Tree *parsetree; extern int yyparse(void); -extern void initparse(void); /* heredoc.c */ diff --git a/prim-etc.c b/prim-etc.c index 95ea607d..523ec3af 100644 --- a/prim-etc.c +++ b/prim-etc.c @@ -173,7 +173,7 @@ PRIM(parse) { tree = parse(prompt1, prompt2); result = (tree == NULL) ? NULL - : mklist(mkterm(NULL, mkclosure(mk(nThunk, tree), NULL)), + : mklist(mkterm(NULL, mkclosure(gcmk(nThunk, tree), NULL)), NULL); RefEnd2(prompt2, prompt1); return result; diff --git a/str.c b/str.c index 031dc6dc..a29bdae9 100644 --- a/str.c +++ b/str.c @@ -14,8 +14,7 @@ static int str_grow(Format *f, size_t more) { return 0; } -/* strv -- print a formatted string into gc space */ -extern char *strv(const char *fmt, va_list args) { +static char *sstrv(char *(*seal)(Buffer *buf), const char *fmt, va_list args) { Buffer *buf; Format format; @@ -37,7 +36,12 @@ extern char *strv(const char *fmt, va_list args) { fmtputc(&format, '\0'); gcenable(); - return sealbuffer(format.u.p); + return seal(format.u.p); +} + +/* strv -- print a formatted string into gc space */ +extern char *strv(const char *fmt, va_list args) { + return sstrv(sealbuffer, fmt, args); } /* str -- create a string (in garbage collection space) by printing to it */ @@ -50,6 +54,16 @@ extern char *str VARARGS1(const char *, fmt) { return s; } +/* pstr -- create a string (in pspace) by printing to it */ +extern char *pstr VARARGS1(const char *, fmt) { + char *s; + va_list args; + VA_START(args, fmt); + s = sstrv(psealbuffer, fmt, args); + va_end(args); + return s; +} + #define PRINT_ALLOCSIZE 64 diff --git a/syntax.c b/syntax.c index fddb7453..7ca627e0 100644 --- a/syntax.c +++ b/syntax.c @@ -8,11 +8,6 @@ Tree errornode; Tree *parsetree; -/* initparse -- called at the dawn of time */ -extern void initparse(void) { - globalroot(&parsetree); -} - /* treecons -- create new tree list cell */ extern Tree *treecons(Tree *car, Tree *cdr) { assert(cdr == NULL || cdr->kind == nList); @@ -116,8 +111,8 @@ extern Tree *mkpipe(Tree *t1, int outfd, int infd, Tree *t2) { Boolean pipetail; pipetail = firstis(t2, "%pipe"); - tail = prefix(str("%d", outfd), - prefix(str("%d", infd), + tail = prefix(pstr("%d", outfd), + prefix(pstr("%d", infd), pipetail ? t2->CDR : treecons(thunkify(t2), NULL))); if (firstis(t1, "%pipe")) return treeappend(t1, tail); @@ -158,7 +153,7 @@ extern Tree *redirect(Tree *t) { } extern Tree *mkredircmd(char *cmd, int fd) { - return prefix(cmd, prefix(str("%d", fd), NULL)); + return prefix(cmd, prefix(pstr("%d", fd), NULL)); } extern Tree *mkredir(Tree *cmd, Tree *file) { @@ -175,7 +170,7 @@ extern Tree *mkredir(Tree *cmd, Tree *file) { yyerror("bad /dev/fd redirection"); op = ""; } - var = mk(nWord, str("_devfd%d", id++)); + var = mk(nWord, pstr("_devfd%d", id++)); cmd = treecons( mk(nWord, op), treecons(var, NULL) @@ -197,14 +192,14 @@ extern Tree *mkredir(Tree *cmd, Tree *file) { /* mkclose -- make a %close node with a placeholder */ extern Tree *mkclose(int fd) { - return prefix("%close", prefix(str("%d", fd), treecons(&placeholder, NULL))); + return prefix("%close", prefix(pstr("%d", fd), treecons(&placeholder, NULL))); } /* mkdup -- make a %dup node with a placeholder */ extern Tree *mkdup(int fd0, int fd1) { return prefix("%dup", - prefix(str("%d", fd0), - prefix(str("%d", fd1), + prefix(pstr("%d", fd0), + prefix(pstr("%d", fd1), treecons(&placeholder, NULL)))); } diff --git a/syntax.h b/syntax.h index 83e3da30..cf356f7d 100644 --- a/syntax.h +++ b/syntax.h @@ -4,6 +4,11 @@ #define CDR u[1].p +/* tree.c */ + +extern Tree *mk(NodeKind VARARGS); + + /* syntax.c */ extern Tree errornode; @@ -31,6 +36,10 @@ extern Tree *firstprepend(Tree *first, Tree *args); extern Tree *mkmatch(Tree *subj, Tree *cases); +/* str.c */ + +extern char *pstr(const char *fmt VARARGS); + /* heredoc.c */ extern Boolean readheredocs(Boolean endfile); diff --git a/token.c b/token.c index b75cd008..abd2aa2e 100644 --- a/token.c +++ b/token.c @@ -195,7 +195,7 @@ top: while ((c = GETC()) == ' ' || c == '\t') else if (streq(buf, "match")) return MATCH; w = RW; - y->str = gcdup(buf); + y->str = pdup(buf); return WORD; } if (c == '`' || c == '!' || c == '$' || c == '\'' || c == '=') { @@ -244,7 +244,7 @@ top: while ((c = GETC()) == ' ' || c == '\t') } UNGETC(c); buf[i] = '\0'; - y->str = gcdup(buf); + y->str = pdup(buf); return QWORD; case '\\': if ((c = GETC()) == '\n') { @@ -306,7 +306,7 @@ top: while ((c = GETC()) == ' ' || c == '\t') break; } buf[1] = 0; - y->str = gcdup(buf); + y->str = pdup(buf); return QWORD; case '#': while ((c = GETC()) != '\n') /* skip comment until newline */ diff --git a/tree.c b/tree.c index 0a158b6e..0ffb5a74 100644 --- a/tree.c +++ b/tree.c @@ -6,50 +6,65 @@ DefineTag(Tree1, static); DefineTag(Tree2, static); -/* mk -- make a new node; used to generate the parse tree */ -extern Tree *mk VARARGS1(NodeKind, t) { - va_list ap; +/* gmk -- make a new node; used to generate the parse tree */ +static Tree *gmk(void *(*alloc)(size_t, Tag *), NodeKind t, va_list ap) { Tree *n; gcdisable(); - VA_START(ap, t); switch (t) { default: panic("mk: bad node kind %d", t); case nWord: case nQword: case nPrim: - n = gcalloc(offsetof(Tree, u[1]), &Tree1Tag); + n = (*alloc)(offsetof(Tree, u[1]), &Tree1Tag); n->u[0].s = va_arg(ap, char *); break; case nCall: case nThunk: case nVar: - n = gcalloc(offsetof(Tree, u[1]), &Tree1Tag); + n = (*alloc)(offsetof(Tree, u[1]), &Tree1Tag); n->u[0].p = va_arg(ap, Tree *); break; case nAssign: case nConcat: case nClosure: case nFor: case nLambda: case nLet: case nList: case nLocal: case nVarsub: case nMatch: case nExtract: - n = gcalloc(offsetof(Tree, u[2]), &Tree2Tag); + n = (*alloc)(offsetof(Tree, u[2]), &Tree2Tag); n->u[0].p = va_arg(ap, Tree *); n->u[1].p = va_arg(ap, Tree *); break; case nRedir: - n = gcalloc(offsetof(Tree, u[2]), NULL); + n = (*alloc)(offsetof(Tree, u[2]), &Tree2Tag); n->u[0].p = va_arg(ap, Tree *); n->u[1].p = va_arg(ap, Tree *); break; case nPipe: - n = gcalloc(offsetof(Tree, u[2]), NULL); + n = (*alloc)(offsetof(Tree, u[2]), &Tree2Tag); n->u[0].i = va_arg(ap, int); n->u[1].i = va_arg(ap, int); break; } n->kind = t; - va_end(ap); Ref(Tree *, tree, n); gcenable(); RefReturn(tree); } +extern Tree *mk VARARGS1(NodeKind, t) { + va_list ap; + Ref(Tree *, tree, NULL); + VA_START(ap, t); + tree = gmk(palloc, t, ap); + va_end(ap); + RefReturn(tree); +} + +extern Tree *gcmk VARARGS1(NodeKind, t) { + va_list ap; + Ref(Tree *, tree, NULL); + VA_START(ap, t); + tree = gmk(gcalloc, t, ap); + va_end(ap); + RefReturn(tree); +} + /* * garbage collection functions @@ -80,7 +95,7 @@ static size_t Tree1Scan(void *p) { case nCall: case nThunk: case nVar: n->u[0].p = forward(n->u[0].p); break; - } + } return offsetof(Tree, u[1]); } @@ -89,12 +104,12 @@ static size_t Tree2Scan(void *p) { switch (n->kind) { case nAssign: case nConcat: case nClosure: case nFor: case nLambda: case nLet: case nList: case nLocal: - case nVarsub: case nMatch: case nExtract: + case nVarsub: case nMatch: case nExtract: case nRedir: n->u[0].p = forward(n->u[0].p); n->u[1].p = forward(n->u[1].p); break; default: panic("Tree2Scan: bad node kind %d", n->kind); - } + } return offsetof(Tree, u[2]); } From ea81fd31d413dab234e005cf25e82f5ca73bd9e8 Mon Sep 17 00:00:00 2001 From: jpco Date: Tue, 25 Mar 2025 17:37:41 -0700 Subject: [PATCH 03/34] only scan the necessary pspace pointers while copying into gcspace This is terrible. We should probably make a new recursive-copy function to put in Tags instead. --- es.h | 2 +- gc.c | 12 ++++++++++-- 2 files changed, 11 insertions(+), 3 deletions(-) diff --git a/es.h b/es.h index d6e95c13..e13ac909 100644 --- a/es.h +++ b/es.h @@ -393,7 +393,7 @@ extern void gcdisable(void); /* disable collections */ extern Boolean gcisblocked(void); /* is collection disabled? */ extern void *palloc(size_t n, Tag *t); /* allocate like gcalloc but in pspace */ -extern void *pseal(void *p); /* collect pspace into gcspace and return pointer */ +extern void *pseal(void *p); /* collect pspace into gcspace with one root */ extern char *pdup(const char *s); /* copy a 0-terminated string into pspace */ extern char *pndup(const char *s, size_t n); /* copy a counted string into pspace */ diff --git a/gc.c b/gc.c index efd44b64..70fc5a64 100644 --- a/gc.c +++ b/gc.c @@ -308,6 +308,7 @@ extern void *forward(void *p) { tag = TAG(p); assert(tag != NULL); + if (FORWARDED(tag)) { np = FOLLOW(tag); assert(TAG(np)->magic == TAGMAGIC); @@ -318,6 +319,13 @@ extern void *forward(void *p) { VERBOSE(("%s -> %8ux (forwarded)\n", tag->typename, np)); TAG(p) = FOLLOWTO(np); } + + /* hack of the decade: recurse, sometimes */ + if (pmode) { + tag = TAG(np); + (*tag->scan)(np); + } + return np; } @@ -463,6 +471,7 @@ extern void *pseal(void *p) { if (psize == 0) return p; + /* TODO: this is an overestimate since it contains garbage */ gcreserve(psize); pmode = TRUE; VERBOSE(("Reserved %d for pspace copy\n", psize)); @@ -477,8 +486,7 @@ extern void *pseal(void *p) { VERBOSE(("GC new space = %ux ... %ux\n", new->bot, new->top)); p = forward(p); - /* slow */ - scanspace(); + (*(TAG(p))->scan)(p); /* TODO: possible performance win: save+reuse the first pspace */ for (sp = pspace; sp != NULL;) { From ba9b099e0bac421055730f7c546ce7cab5b1732b Mon Sep 17 00:00:00 2001 From: jpco Date: Wed, 26 Mar 2025 06:41:50 -0700 Subject: [PATCH 04/34] move LOCAL_GETENV logic out of input.c into var.c --- es.h | 2 +- input.c | 68 --------------------------------------------------------- var.c | 65 ++++++++++++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 66 insertions(+), 69 deletions(-) diff --git a/es.h b/es.h index e13ac909..ab9e1953 100644 --- a/es.h +++ b/es.h @@ -188,6 +188,7 @@ extern List *extractmatches(List *subjects, List *patterns, StrList *quotes); extern void initvars(void); extern void initenv(char **envp, Boolean protected); +extern void initgetenv(void); extern void hidevariables(void); extern void validatevar(const char *var); extern List *varlookup(const char *name, Binding *binding); @@ -297,7 +298,6 @@ extern Boolean isinteractive(void); #if HAVE_READLINE extern void setmaxhistorylength(int length); #endif -extern void initgetenv(void); extern void initinput(void); extern void resetparser(void); diff --git a/input.c b/input.c index 35b166c4..0b2ae179 100644 --- a/input.c +++ b/input.c @@ -1,5 +1,4 @@ /* input.c -- read input from files or strings ($Revision: 1.2 $) */ -/* stdgetenv is based on the FreeBSD getenv */ #include "es.h" #include "input.h" @@ -38,13 +37,6 @@ static int historyfd = -1; Boolean reloadhistory = FALSE; #endif -#if LOCAL_GETENV -static char *stdgetenv(const char *); -static char *esgetenv(const char *); -static char *(*realgetenv)(const char *) = stdgetenv; -#endif - - /* * errors and warnings @@ -263,66 +255,6 @@ static char *callreadline(char *prompt0) { } #endif -#if LOCAL_GETENV -/* esgetenv -- fake version of getenv for readline (or other libraries) */ -static char *esgetenv(const char *name) { - List *value = varlookup(name, NULL); - if (value == NULL) - return NULL; - else { - char *export; - static Dict *envdict; - static Boolean initialized = FALSE; - Ref(char *, string, NULL); - - gcdisable(); - if (!initialized) { - initialized = TRUE; - envdict = mkdict(); - globalroot(&envdict); - } - - string = dictget(envdict, name); - if (string != NULL) - efree(string); - - export = str("%W", value); - string = ealloc(strlen(export) + 1); - strcpy(string, export); - envdict = dictput(envdict, (char *) name, string); - - gcenable(); - RefReturn(string); - } -} - -static char *stdgetenv(const char *name) { - extern char **environ; - register int len; - register const char *np; - register char **p, *c; - - if (name == NULL || environ == NULL) - return (NULL); - for (np = name; *np && *np != '='; ++np) - continue; - len = np - name; - for (p = environ; (c = *p) != NULL; ++p) - if (strncmp(c, name, len) == 0 && c[len] == '=') { - return (c + len + 1); - } - return (NULL); -} - -char *getenv(const char *name) { - return realgetenv(name); -} - -extern void initgetenv(void) { - realgetenv = esgetenv; -} -#endif - /* fdfill -- fill input buffer by reading from a file descriptor */ static int fdfill(Input *in) { long nread; diff --git a/var.c b/var.c index a2f50e2f..72f05e51 100644 --- a/var.c +++ b/var.c @@ -1,4 +1,5 @@ /* var.c -- es variables ($Revision: 1.1.1.1 $) */ +/* stdgetenv is based on the FreeBSD getenv */ #include "es.h" #include "gc.h" @@ -33,6 +34,12 @@ static int envmin; static Boolean isdirty = TRUE; static Boolean rebound = TRUE; +#if LOCAL_GETENV +static char *stdgetenv(const char *); +static char *esgetenv(const char *); +static char *(*realgetenv)(const char *) = stdgetenv; +#endif + DefineTag(Var, static); static Boolean specialvar(const char *name) { @@ -451,6 +458,64 @@ static void importvar(char *name0, char *value) { } #if LOCAL_GETENV +/* esgetenv -- fake version of getenv for readline (or other libraries) */ +static char *esgetenv(const char *name) { + List *value = varlookup(name, NULL); + if (value == NULL) + return NULL; + else { + char *export; + static Dict *envdict; + static Boolean initialized = FALSE; + Ref(char *, string, NULL); + + gcdisable(); + if (!initialized) { + initialized = TRUE; + envdict = mkdict(); + globalroot(&envdict); + } + + string = dictget(envdict, name); + if (string != NULL) + efree(string); + + export = str("%W", value); + string = ealloc(strlen(export) + 1); + strcpy(string, export); + envdict = dictput(envdict, (char *) name, string); + + gcenable(); + RefReturn(string); + } +} + +static char *stdgetenv(const char *name) { + extern char **environ; + register int len; + register const char *np; + register char **p, *c; + + if (name == NULL || environ == NULL) + return (NULL); + for (np = name; *np && *np != '='; ++np) + continue; + len = np - name; + for (p = environ; (c = *p) != NULL; ++p) + if (strncmp(c, name, len) == 0 && c[len] == '=') { + return (c + len + 1); + } + return (NULL); +} + +char *getenv(const char *name) { + return realgetenv(name); +} + +extern void initgetenv(void) { + realgetenv = esgetenv; +} + extern int setenv(const char *name, const char *value, int overwrite) { assert(vars != NULL); if (name == NULL || name[0] == '\0' || strchr(name, '=') != NULL) { From b8b31bda2268c1828b53eda5ca7123328a9b9793 Mon Sep 17 00:00:00 2001 From: jpco Date: Wed, 26 Mar 2025 07:05:55 -0700 Subject: [PATCH 05/34] Pull in %write-history from #65 --- Makefile.in | 5 +- es.h | 22 +++++++-- heredoc.c | 5 -- history.c | 134 ++++++++++++++++++++++++++++++++++++++++++++++++++++ initial.es | 33 +++++++++++-- input.c | 112 ++++--------------------------------------- input.h | 1 - main.c | 3 ++ prim-etc.c | 55 +++++++++++++++++---- 9 files changed, 241 insertions(+), 129 deletions(-) create mode 100644 history.c diff --git a/Makefile.in b/Makefile.in index 6c4cc515..98654960 100644 --- a/Makefile.in +++ b/Makefile.in @@ -56,12 +56,12 @@ VPATH = $(srcdir) HFILES = config.h es.h gc.h input.h prim.h print.h sigmsgs.h \ stdenv.h syntax.h term.h var.h CFILES = access.c closure.c conv.c dict.c eval.c except.c fd.c gc.c glob.c \ - glom.c input.c heredoc.c list.c main.c match.c open.c opt.c \ + glom.c input.c heredoc.c history.c list.c main.c match.c open.c opt.c \ prim-ctl.c prim-etc.c prim-io.c prim-sys.c prim.c print.c proc.c \ sigmsgs.c signal.c split.c status.c str.c syntax.c term.c token.c \ tree.c util.c var.c vec.c version.c y.tab.c dump.c OFILES = access.o closure.o conv.o dict.o eval.o except.o fd.o gc.o glob.o \ - glom.o input.o heredoc.o list.o main.o match.o open.o opt.o \ + glom.o input.o heredoc.o history.o list.o main.o match.o open.o opt.o \ prim-ctl.o prim-etc.o prim-io.o prim-sys.o prim.o print.o proc.o \ sigmsgs.o signal.o split.o status.o str.o syntax.o term.o token.o \ tree.o util.o var.o vec.o version.o y.tab.o @@ -135,6 +135,7 @@ glob.o : glob.c es.h config.h stdenv.h gc.h glom.o : glom.c es.h config.h stdenv.h gc.h input.o : input.c es.h config.h stdenv.h input.h heredoc.o : heredoc.c es.h config.h stdenv.h gc.h input.h syntax.h +history.o : history.c es.h config.h stdenv.h gc.h input.h list.o : list.c es.h config.h stdenv.h gc.h main.o : main.c es.h config.h stdenv.h match.o : match.c es.h config.h stdenv.h diff --git a/es.h b/es.h index ab9e1953..90d896f8 100644 --- a/es.h +++ b/es.h @@ -293,11 +293,8 @@ extern Boolean streq2(const char *s, const char *t1, const char *t2); extern char *prompt, *prompt2; extern Tree *parse(char *esprompt1, char *esprompt2); extern Tree *parsestring(const char *str); -extern void sethistory(char *file); extern Boolean isinteractive(void); -#if HAVE_READLINE -extern void setmaxhistorylength(int length); -#endif +extern Boolean isfromfd(void); extern void initinput(void); extern void resetparser(void); @@ -316,6 +313,23 @@ extern Boolean resetterminal; #endif +/* history.c */ + + +#if HAVE_READLINE +extern void inithistory(void); + +extern void sethistory(char *file); +extern void loghistory(char *cmd); +extern void setmaxhistorylength(int length); +extern void checkreloadhistory(void); +#endif + +extern void newhistbuffer(void); +extern void addhistbuffer(char c); +extern char *dumphistbuffer(void); + + /* opt.c */ extern void esoptbegin(List *list, const char *caller, const char *usage, Boolean throws); diff --git a/heredoc.c b/heredoc.c index 5cc7afdc..d9de728c 100644 --- a/heredoc.c +++ b/heredoc.c @@ -44,7 +44,6 @@ extern Tree *snarfheredoc(const char *eof, Boolean quoted) { return NULL; } ignoreeof = TRUE; - disablehistory = TRUE; for (tree = NULL, tailp = &tree, buf = openbuffer(0);;) { int c; @@ -65,7 +64,6 @@ extern Tree *snarfheredoc(const char *eof, Boolean quoted) { yyerror("incomplete here document"); freebuffer(buf); ignoreeof = FALSE; - disablehistory = FALSE; return NULL; } if (c == '$' && !quoted && (c = GETC()) != '$') { @@ -81,7 +79,6 @@ extern Tree *snarfheredoc(const char *eof, Boolean quoted) { if (var == NULL) { freebuffer(buf); ignoreeof = FALSE; - disablehistory = FALSE; return NULL; } *tailp = treecons(var, NULL); @@ -96,7 +93,6 @@ extern Tree *snarfheredoc(const char *eof, Boolean quoted) { } ignoreeof = FALSE; - disablehistory = FALSE; return tree->CDR == NULL ? tree->CAR : tree; } @@ -146,5 +142,4 @@ extern Boolean queueheredoc(Tree *t) { extern void emptyherequeue(void) { hereq = NULL; - disablehistory = FALSE; } diff --git a/history.c b/history.c new file mode 100644 index 00000000..7032e96a --- /dev/null +++ b/history.c @@ -0,0 +1,134 @@ +/* history.c -- control the history file ($Revision: 1.1.1.1 $) */ + +#include "es.h" +#include "gc.h" +#include "input.h" + + +/* + * constants + */ + +#define BUFSIZE ((size_t) 4096) /* buffer size to fill reads into */ + + +/* + * globals + */ + +static Buffer *histbuffer = NULL; + +#if HAVE_READLINE +#include + +Boolean reloadhistory = FALSE; +static char *history; + +#if 0 +/* These split history file entries by timestamp, which allows readline to pick up + * multi-line commands correctly across process boundaries. Disabled by default, + * because it leaves the history file itself kind of ugly. */ +static int history_write_timestamps = 1; +static char history_comment_char = '#'; +#endif +#endif + + +/* + * histbuffer -- build the history line during input and dump it as a gc-string + */ + + +extern void newhistbuffer() { + assert(histbuffer == NULL); + histbuffer = openbuffer(BUFSIZE); +} + +extern void addhistbuffer(char c) { + if (histbuffer == NULL) + return; + histbuffer = bufputc(histbuffer, c); +} + +extern char *dumphistbuffer() { + char *s; + size_t len; + assert(histbuffer != NULL); + + s = sealcountedbuffer(histbuffer); + histbuffer = NULL; + + len = strlen(s); + if (len > 0 && s[len - 1] == '\n') + s[len - 1] = '\0'; + return s; +} + + +/* + * history file + */ + +#if HAVE_READLINE +extern void setmaxhistorylength(int len) { + static int currenthistlen = -1; /* unlimited */ + if (len != currenthistlen) { + switch (len) { + case -1: + unstifle_history(); + break; + case 0: + clear_history(); + FALLTHROUGH; + default: + stifle_history(len); + } + currenthistlen = len; + } +} + +extern void loghistory(char *cmd) { + int err; + if (cmd == NULL) + return; + add_history(cmd); + if (history == NULL) + return; + + if ((err = append_history(1, history))) { + eprint("history(%s): %s\n", history, esstrerror(err)); + vardef("history", NULL, NULL); + } +} + +static void reload_history(void) { + /* Attempt to populate readline history with new history file. */ + if (history != NULL) + read_history(history); + using_history(); + + reloadhistory = FALSE; +} + +extern void sethistory(char *file) { + if (reloadhistory) + reload_history(); + reloadhistory = TRUE; + history = file; +} + +extern void checkreloadhistory(void) { + if (reloadhistory) + reload_history(); +} + +/* + * initialization + */ + +/* inithistory -- called at dawn of time from main() */ +extern void inithistory(void) { + /* declare the global roots */ + globalroot(&history); /* history file */ +} +#endif diff --git a/initial.es b/initial.es index 452c18d3..2ec12e96 100644 --- a/initial.es +++ b/initial.es @@ -579,6 +579,28 @@ fn %pathsearch name { access -n $name -1e -xf $path } if {~ <=$&primitives execfailure} {fn-%exec-failure = $&execfailure} +# The %write-history hook is used in interactive contexts to write +# command input to the history file (and/or readline's in-memory +# history log). By default, $&writehistory (which is available if +# readline is compiled in) will write to readline's history log if +# $max-history-length allows, and will write to the file designated +# by $history if that variable is set and the file it points to +# exists and is writeable. + +if {~ <=$&primitives writehistory} { + fn-%write-history = $&writehistory +} { + fn %write-history input { + if {!~ $history ()} { + if {access -w $history} { + echo $input >> $history + } { + history = () + } + } + } +} + # # Read-eval-print loops @@ -706,14 +728,17 @@ set-PATH = @ { local (set-path = ) path = <={%fsplit : $*}; result $* } # These settor functions call primitives to set data structures used # inside of es. -set-history = $&sethistory set-signals = $&setsignals set-noexport = $&setnoexport set-max-eval-depth = $&setmaxevaldepth -# If the primitive $&resetterminal is defined (meaning that readline -# is being used), setting the variables $TERM or $TERMCAP should -# notify the line editor library. +# If the primitives $&sethistory or $&resetterminal are defined (meaning +# that readline or editline is being used), setting the variables $TERM, +# $TERMCAP, or $history should notify the line editor library. + +if {~ <=$&primitives sethistory} { + set-history = $&sethistory +} if {~ <=$&primitives resetterminal} { set-TERM = @ { $&resetterminal; result $* } diff --git a/input.c b/input.c index 0b2ae179..793df9cc 100644 --- a/input.c +++ b/input.c @@ -24,17 +24,11 @@ Input *input; char *prompt, *prompt2; -Boolean disablehistory = FALSE; Boolean ignoreeof = FALSE; Boolean resetterminal = FALSE; -static char *history; -static int historyfd = -1; #if HAVE_READLINE #include -#include - -Boolean reloadhistory = FALSE; #endif @@ -68,89 +62,6 @@ static void warn(char *s) { } -/* - * history - */ - -/* loghistory -- write the last command out to a file */ -static void loghistory(const char *cmd, size_t len) { - const char *s, *end; - if (history == NULL || disablehistory) - return; - if (historyfd == -1) { - historyfd = eopen(history, oAppend); - if (historyfd == -1) { - eprint("history(%s): %s\n", history, esstrerror(errno)); - vardef("history", NULL, NULL); - return; - } - } - /* skip empty lines and comments in history */ - for (s = cmd, end = s + len; s < end; s++) - switch (*s) { - case '#': case '\n': return; - case ' ': case '\t': break; - default: goto writeit; - } - writeit: - ; - /* - * Small unix hack: since read() reads only up to a newline - * from a terminal, then presumably this write() will write at - * most only one input line at a time. - */ - ewrite(historyfd, cmd, len); -} - -#if HAVE_READLINE -/* Manage maximum in-memory history length. This has speed & memory - * implications to which different users have different tolerances, so let them - * pick. */ -extern void setmaxhistorylength(int len) { - static int currenthistlen = -1; /* unlimited */ - if (len != currenthistlen) { - switch (len) { - case -1: - unstifle_history(); - break; - case 0: - clear_history(); - FALLTHROUGH; - default: - stifle_history(len); - } - currenthistlen = len; - } -} - -static void reload_history(void) { - /* Attempt to populate readline history with new history file. */ - if (history != NULL) - read_history(history); - using_history(); - - reloadhistory = FALSE; -} -#endif - -/* sethistory -- change the file for the history log */ -extern void sethistory(char *file) { -#if HAVE_READLINE - /* make sure the old file has a chance to get loaded */ - if (reloadhistory) - reload_history(); -#endif - if (historyfd != -1) { - close(historyfd); - historyfd = -1; - } -#if HAVE_READLINE - reloadhistory = TRUE; -#endif - history = file; -} - - /* * unget -- character pushback */ @@ -176,9 +87,7 @@ extern void unget(Input *in, int c) { if (in->ungot > 0) { assert(in->ungot < MAXUNGET); in->unget[in->ungot++] = c; - } else if (in->bufbegin < in->buf && in->buf[-1] == c && (input->runflags & run_echoinput) == 0) - --in->buf; - else { + } else { assert(in->rfill == NULL); in->rfill = in->fill; in->fill = ungetfill; @@ -199,8 +108,11 @@ extern void unget(Input *in, int c) { /* get -- get a character, filter out nulls */ static int get(Input *in) { int c; + Boolean uf = (in->fill == ungetfill); while ((c = (in->buf < in->bufend ? *in->buf++ : (*in->fill)(in))) == '\0') warn("null character ignored"); + if (!uf && c != EOF) + addhistbuffer((char)c); return c; } @@ -231,8 +143,7 @@ static char *callreadline(char *prompt0) { char *r; if (prompt == NULL) prompt = ""; /* bug fix for readline 2.0 */ - if (reloadhistory) - reload_history(); + checkreloadhistory(); if (resetterminal) { rl_reset_terminal(NULL); resetterminal = FALSE; @@ -271,8 +182,6 @@ static int fdfill(Input *in) { if (rlinebuf == NULL) nread = 0; else { - if (*rlinebuf != '\0') - add_history(rlinebuf); nread = strlen(rlinebuf) + 1; if (in->buflen < (unsigned int)nread) { while (in->buflen < (unsigned int)nread) @@ -302,9 +211,6 @@ static int fdfill(Input *in) { return EOF; } - if (in->runflags & run_interactive) - loghistory((char *) in->bufbegin, nread); - in->buf = in->bufbegin; in->bufend = &in->buf[nread]; return *in->buf++; @@ -543,6 +449,10 @@ extern Boolean isinteractive(void) { return input == NULL ? FALSE : ((input->runflags & run_interactive) != 0); } +extern Boolean isfromfd(void) { + return input == NULL ? FALSE : (input->fill == fdfill); +} + /* * readline integration. @@ -653,14 +563,10 @@ extern void initinput(void) { input = NULL; /* declare the global roots */ - globalroot(&history); /* history file */ globalroot(&error); /* parse errors */ globalroot(&prompt); /* main prompt */ globalroot(&prompt2); /* secondary prompt */ - /* mark the historyfd as a file descriptor to hold back from forked children */ - registerfd(&historyfd, TRUE); - #if HAVE_READLINE rl_readline_name = "es"; diff --git a/input.h b/input.h index a71d5f81..411c8845 100644 --- a/input.h +++ b/input.h @@ -27,7 +27,6 @@ struct Input { extern Input *input; extern void unget(Input *in, int c); -extern Boolean disablehistory; extern Boolean ignoreeof; extern void yyerror(char *s); diff --git a/main.c b/main.c index e7e6cb03..dc959a33 100644 --- a/main.c +++ b/main.c @@ -177,6 +177,9 @@ int main(int argc, char **argv0) { roothandler = &_localhandler; /* unhygeinic */ initinput(); +#if HAVE_READLINE + inithistory(); +#endif initprims(); initvars(); diff --git a/prim-etc.c b/prim-etc.c index 523ec3af..c47e201e 100644 --- a/prim-etc.c +++ b/prim-etc.c @@ -148,14 +148,23 @@ PRIM(var) { return list; } -PRIM(sethistory) { - if (list == NULL) { - sethistory(NULL); - return NULL; - } - Ref(List *, lp, list); - sethistory(getstr(lp->term)); - RefReturn(lp); +static void loginput(char *input) { + char *c; + List *fn = varlookup("fn-%write-history", NULL); + if (!isinteractive() || !isfromfd() || fn == NULL) + return; + for (c = input;; c++) + switch (*c) { + case '#': case '\n': return; + case ' ': case '\t': break; + default: goto writeit; + } +writeit: + gcdisable(); + Ref(List *, list, append(fn, mklist(mkstr(input), NULL))); + gcenable(); + eval(list, NULL, 0); + RefEnd(list); } PRIM(parse) { @@ -170,7 +179,15 @@ PRIM(parse) { prompt2 = getstr(lp->term); } RefEnd(lp); - tree = parse(prompt1, prompt2); + newhistbuffer(); + ExceptionHandler + tree = parse(prompt1, prompt2); + CatchException (e) + loginput(dumphistbuffer()); + throw(e); + EndExceptionHandler + + loginput(dumphistbuffer()); result = (tree == NULL) ? NULL : mklist(mkterm(NULL, mkclosure(gcmk(nThunk, tree), NULL)), @@ -283,6 +300,23 @@ PRIM(setmaxevaldepth) { } #if HAVE_READLINE +PRIM(sethistory) { + if (list == NULL) { + sethistory(NULL); + return NULL; + } + Ref(List *, lp, list); + sethistory(getstr(lp->term)); + RefReturn(lp); +} + +PRIM(writehistory) { + if (list == NULL || list->next != NULL) + fail("$&writehistory", "usage: $&writehistory command"); + loghistory(getstr(list->term)); + return NULL; +} + PRIM(setmaxhistorylength) { char *s; int n; @@ -319,7 +353,6 @@ extern Dict *initprims_etc(Dict *primdict) { X(dot); X(flatten); X(whatis); - X(sethistory); X(split); X(fsplit); X(var); @@ -336,6 +369,8 @@ extern Dict *initprims_etc(Dict *primdict) { X(noreturn); X(setmaxevaldepth); #if HAVE_READLINE + X(sethistory); + X(writehistory); X(resetterminal); X(setmaxhistorylength); #endif From 2eb69a181fa4067f13435511d79913eb3106e717 Mon Sep 17 00:00:00 2001 From: jpco Date: Wed, 26 Mar 2025 07:48:24 -0700 Subject: [PATCH 06/34] Start shoving readline logic into readline.c --- Makefile.in | 13 ++--- es.h | 6 ++- history.c | 77 ----------------------------- prim-etc.c | 47 ------------------ prim.c | 4 ++ prim.h | 4 ++ readline.c | 138 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 7 files changed, 157 insertions(+), 132 deletions(-) create mode 100644 readline.c diff --git a/Makefile.in b/Makefile.in index 98654960..8caedc68 100644 --- a/Makefile.in +++ b/Makefile.in @@ -57,14 +57,14 @@ HFILES = config.h es.h gc.h input.h prim.h print.h sigmsgs.h \ stdenv.h syntax.h term.h var.h CFILES = access.c closure.c conv.c dict.c eval.c except.c fd.c gc.c glob.c \ glom.c input.c heredoc.c history.c list.c main.c match.c open.c opt.c \ - prim-ctl.c prim-etc.c prim-io.c prim-sys.c prim.c print.c proc.c \ - sigmsgs.c signal.c split.c status.c str.c syntax.c term.c token.c \ - tree.c util.c var.c vec.c version.c y.tab.c dump.c + prim-ctl.c prim-etc.c prim-io.c readline.c prim-sys.c prim.c \ + print.c proc.c sigmsgs.c signal.c split.c status.c str.c syntax.c \ + term.c token.c tree.c util.c var.c vec.c version.c y.tab.c dump.c OFILES = access.o closure.o conv.o dict.o eval.o except.o fd.o gc.o glob.o \ glom.o input.o heredoc.o history.o list.o main.o match.o open.o opt.o \ - prim-ctl.o prim-etc.o prim-io.o prim-sys.o prim.o print.o proc.o \ - sigmsgs.o signal.o split.o status.o str.o syntax.o term.o token.o \ - tree.o util.o var.o vec.o version.o y.tab.o + prim-ctl.o prim-etc.o prim-io.o readline.o prim-sys.o prim.o \ + print.o proc.o sigmsgs.o signal.o split.o status.o str.o syntax.o \ + term.o token.o tree.o util.o var.o vec.o version.o y.tab.o OTHER = Makefile parse.y mksignal GEN = esdump y.tab.c y.tab.h y.output token.h sigmsgs.c initial.c @@ -145,6 +145,7 @@ prim.o : prim.c es.h config.h stdenv.h prim.h prim-ctl.o : prim-ctl.c es.h config.h stdenv.h prim.h prim-etc.o : prim-etc.c es.h config.h stdenv.h prim.h prim-io.o : prim-io.c es.h config.h stdenv.h gc.h prim.h +readline.o : readline.c es.h config.h stdenv.h prim.h prim-sys.o : prim-sys.c es.h config.h stdenv.h prim.h print.o : print.c es.h config.h stdenv.h print.h proc.o : proc.c es.h config.h stdenv.h prim.h diff --git a/es.h b/es.h index 90d896f8..066cc5c1 100644 --- a/es.h +++ b/es.h @@ -313,8 +313,7 @@ extern Boolean resetterminal; #endif -/* history.c */ - +/* readline.c */ #if HAVE_READLINE extern void inithistory(void); @@ -325,6 +324,9 @@ extern void setmaxhistorylength(int length); extern void checkreloadhistory(void); #endif + +/* history.c */ + extern void newhistbuffer(void); extern void addhistbuffer(char c); extern char *dumphistbuffer(void); diff --git a/history.c b/history.c index 7032e96a..e87d041e 100644 --- a/history.c +++ b/history.c @@ -18,21 +18,6 @@ static Buffer *histbuffer = NULL; -#if HAVE_READLINE -#include - -Boolean reloadhistory = FALSE; -static char *history; - -#if 0 -/* These split history file entries by timestamp, which allows readline to pick up - * multi-line commands correctly across process boundaries. Disabled by default, - * because it leaves the history file itself kind of ugly. */ -static int history_write_timestamps = 1; -static char history_comment_char = '#'; -#endif -#endif - /* * histbuffer -- build the history line during input and dump it as a gc-string @@ -69,66 +54,4 @@ extern char *dumphistbuffer() { * history file */ -#if HAVE_READLINE -extern void setmaxhistorylength(int len) { - static int currenthistlen = -1; /* unlimited */ - if (len != currenthistlen) { - switch (len) { - case -1: - unstifle_history(); - break; - case 0: - clear_history(); - FALLTHROUGH; - default: - stifle_history(len); - } - currenthistlen = len; - } -} - -extern void loghistory(char *cmd) { - int err; - if (cmd == NULL) - return; - add_history(cmd); - if (history == NULL) - return; - - if ((err = append_history(1, history))) { - eprint("history(%s): %s\n", history, esstrerror(err)); - vardef("history", NULL, NULL); - } -} - -static void reload_history(void) { - /* Attempt to populate readline history with new history file. */ - if (history != NULL) - read_history(history); - using_history(); - reloadhistory = FALSE; -} - -extern void sethistory(char *file) { - if (reloadhistory) - reload_history(); - reloadhistory = TRUE; - history = file; -} - -extern void checkreloadhistory(void) { - if (reloadhistory) - reload_history(); -} - -/* - * initialization - */ - -/* inithistory -- called at dawn of time from main() */ -extern void inithistory(void) { - /* declare the global roots */ - globalroot(&history); /* history file */ -} -#endif diff --git a/prim-etc.c b/prim-etc.c index c47e201e..2a597c72 100644 --- a/prim-etc.c +++ b/prim-etc.c @@ -299,47 +299,6 @@ PRIM(setmaxevaldepth) { RefReturn(lp); } -#if HAVE_READLINE -PRIM(sethistory) { - if (list == NULL) { - sethistory(NULL); - return NULL; - } - Ref(List *, lp, list); - sethistory(getstr(lp->term)); - RefReturn(lp); -} - -PRIM(writehistory) { - if (list == NULL || list->next != NULL) - fail("$&writehistory", "usage: $&writehistory command"); - loghistory(getstr(list->term)); - return NULL; -} - -PRIM(setmaxhistorylength) { - char *s; - int n; - if (list == NULL) { - setmaxhistorylength(-1); /* unlimited */ - return NULL; - } - if (list->next != NULL) - fail("$&setmaxhistorylength", "usage: $&setmaxhistorylength [limit]"); - Ref(List *, lp, list); - n = (int)strtol(getstr(lp->term), &s, 0); - if (n < 0 || (s != NULL && *s != '\0')) - fail("$&setmaxhistorylength", "max-history-length must be set to a positive integer"); - setmaxhistorylength(n); - RefReturn(lp); -} - -PRIM(resetterminal) { - resetterminal = TRUE; - return ltrue; -} -#endif - /* * initialization @@ -368,11 +327,5 @@ extern Dict *initprims_etc(Dict *primdict) { X(exitonfalse); X(noreturn); X(setmaxevaldepth); -#if HAVE_READLINE - X(sethistory); - X(writehistory); - X(resetterminal); - X(setmaxhistorylength); -#endif return primdict; } diff --git a/prim.c b/prim.c index 74d7866f..bb867b76 100644 --- a/prim.c +++ b/prim.c @@ -48,6 +48,10 @@ extern void initprims(void) { prims = initprims_proc(prims); prims = initprims_access(prims); +#if HAVE_READLINE + prims = initprims_readline(prims); +#endif + #define primdict prims X(primitives); } diff --git a/prim.h b/prim.h index a6a0db05..8fca613a 100644 --- a/prim.h +++ b/prim.h @@ -19,3 +19,7 @@ extern Dict *initprims_etc(Dict *primdict); /* prim-etc.c */ extern Dict *initprims_sys(Dict *primdict); /* prim-sys.c */ extern Dict *initprims_proc(Dict *primdict); /* proc.c */ extern Dict *initprims_access(Dict *primdict); /* access.c */ + +#if HAVE_READLINE +extern Dict *initprims_readline(Dict *primdict); /* readline.c */ +#endif diff --git a/readline.c b/readline.c new file mode 100644 index 00000000..a74aa5cc --- /dev/null +++ b/readline.c @@ -0,0 +1,138 @@ +/* prim-readline.c -- readline primitives */ + +#include "es.h" +#include "prim.h" + +#if HAVE_READLINE + +#include + +Boolean reloadhistory = FALSE; +static char *history; + +#if 0 +/* These split history file entries by timestamp, which allows readline to pick up + * multi-line commands correctly across process boundaries. Disabled by default, + * because it leaves the history file itself kind of ugly. */ +static int history_write_timestamps = 1; +static char history_comment_char = '#'; +#endif + +/* + * history management + */ + +extern void setmaxhistorylength(int len) { + static int currenthistlen = -1; /* unlimited */ + if (len != currenthistlen) { + switch (len) { + case -1: + unstifle_history(); + break; + case 0: + clear_history(); + FALLTHROUGH; + default: + stifle_history(len); + } + currenthistlen = len; + } +} + +extern void loghistory(char *cmd) { + int err; + if (cmd == NULL) + return; + add_history(cmd); + if (history == NULL) + return; + + if ((err = append_history(1, history))) { + eprint("history(%s): %s\n", history, esstrerror(err)); + vardef("history", NULL, NULL); + } +} + +static void reload_history(void) { + /* Attempt to populate readline history with new history file. */ + if (history != NULL) + read_history(history); + using_history(); + + reloadhistory = FALSE; +} + +extern void sethistory(char *file) { + if (reloadhistory) + reload_history(); + reloadhistory = TRUE; + history = file; +} + +extern void checkreloadhistory(void) { + if (reloadhistory) + reload_history(); +} + +/* + * primitives + */ + +PRIM(sethistory) { + if (list == NULL) { + sethistory(NULL); + return NULL; + } + Ref(List *, lp, list); + sethistory(getstr(lp->term)); + RefReturn(lp); +} + +PRIM(writehistory) { + if (list == NULL || list->next != NULL) + fail("$&writehistory", "usage: $&writehistory command"); + loghistory(getstr(list->term)); + return NULL; +} + +PRIM(setmaxhistorylength) { + char *s; + int n; + if (list == NULL) { + setmaxhistorylength(-1); /* unlimited */ + return NULL; + } + if (list->next != NULL) + fail("$&setmaxhistorylength", "usage: $&setmaxhistorylength [limit]"); + Ref(List *, lp, list); + n = (int)strtol(getstr(lp->term), &s, 0); + if (n < 0 || (s != NULL && *s != '\0')) + fail("$&setmaxhistorylength", "max-history-length must be set to a positive integer"); + setmaxhistorylength(n); + RefReturn(lp); +} + +PRIM(resetterminal) { + resetterminal = TRUE; + return ltrue; +} + +/* + * initialization + */ + +extern Dict *initprims_readline(Dict *primdict) { + X(sethistory); + X(writehistory); + X(resetterminal); + X(setmaxhistorylength); + return primdict; +} + +/* inithistory -- called at dawn of time from main() */ +extern void inithistory(void) { + /* declare the global roots */ + globalroot(&history); /* history file */ +} + +#endif From dd2fef16a140331188d214c66955c0b2a4e27c8c Mon Sep 17 00:00:00 2001 From: jpco Date: Wed, 26 Mar 2025 08:56:48 -0700 Subject: [PATCH 07/34] Shove yet more readline logic into readline.c --- es.h | 6 +-- history.c | 8 --- input.c | 129 +--------------------------------------------- prim-etc.c | 5 +- readline.c | 146 +++++++++++++++++++++++++++++++++++++++++++++++++++-- stdenv.h | 1 + 6 files changed, 149 insertions(+), 146 deletions(-) diff --git a/es.h b/es.h index 066cc5c1..7a66b67d 100644 --- a/es.h +++ b/es.h @@ -308,10 +308,6 @@ extern List *runstring(const char *str, const char *name, int flags); #define run_printcmds 32 /* -x */ #define run_lisptrees 64 /* -L and defined(LISPTREES) */ -#if HAVE_READLINE -extern Boolean resetterminal; -#endif - /* readline.c */ @@ -321,7 +317,7 @@ extern void inithistory(void); extern void sethistory(char *file); extern void loghistory(char *cmd); extern void setmaxhistorylength(int length); -extern void checkreloadhistory(void); +extern void rlsetup(Boolean fromprim); #endif diff --git a/history.c b/history.c index e87d041e..a96c12fd 100644 --- a/history.c +++ b/history.c @@ -23,7 +23,6 @@ static Buffer *histbuffer = NULL; * histbuffer -- build the history line during input and dump it as a gc-string */ - extern void newhistbuffer() { assert(histbuffer == NULL); histbuffer = openbuffer(BUFSIZE); @@ -48,10 +47,3 @@ extern char *dumphistbuffer() { s[len - 1] = '\0'; return s; } - - -/* - * history file - */ - - diff --git a/input.c b/input.c index 793df9cc..11a777e6 100644 --- a/input.c +++ b/input.c @@ -25,11 +25,6 @@ Input *input; char *prompt, *prompt2; Boolean ignoreeof = FALSE; -Boolean resetterminal = FALSE; - -#if HAVE_READLINE -#include -#endif /* @@ -143,13 +138,7 @@ static char *callreadline(char *prompt0) { char *r; if (prompt == NULL) prompt = ""; /* bug fix for readline 2.0 */ - checkreloadhistory(); - if (resetterminal) { - rl_reset_terminal(NULL); - resetterminal = FALSE; - } - if (RL_ISSTATE(RL_STATE_INITIALIZED)) - rl_reset_screen_size(); + rlsetup(FALSE); interrupted = FALSE; if (!setjmp(slowlabel)) { slow = TRUE; @@ -454,106 +443,6 @@ extern Boolean isfromfd(void) { } -/* - * readline integration. - */ -#if HAVE_READLINE -/* quote -- teach readline how to quote a word in es during completion */ -static char *quote(char *text, int type, char *qp) { - char *p, *r; - - /* worst-case size: string is 100% quote characters which will all be - * doubled, plus initial and final quotes and \0 */ - p = r = ealloc(strlen(text) * 2 + 3); - /* supply opening quote if not already present */ - if (*qp != '\'') - *p++ = '\''; - while (*text) { - /* double any quotes for es quote-escaping rules */ - if (*text == '\'') - *p++ = '\''; - *p++ = *text++; - } - if (type == SINGLE_MATCH) - *p++ = '\''; - *p = '\0'; - return r; -} - -/* unquote -- teach es how to unquote a word */ -static char *unquote(char *text, int quote_char) { - char *p, *r; - - p = r = ealloc(strlen(text) + 1); - while (*text) { - *p++ = *text++; - if (quote_char && *(text - 1) == '\'' && *text == '\'') - ++text; - } - *p = '\0'; - return r; -} - -static char *complprefix; -static List *(*wordslistgen)(char *); - -static char *list_completion_function(const char *text, int state) { - static char **matches = NULL; - static int matches_idx, matches_len; - int i, rlen; - char *result; - - const int pfx_len = strlen(complprefix); - - if (!state) { - const char *name = &text[pfx_len]; - - Vector *vm = vectorize(wordslistgen((char *)name)); - matches = vm->vector; - matches_len = vm->count; - matches_idx = 0; - } - - if (!matches || matches_idx >= matches_len) - return NULL; - - rlen = strlen(matches[matches_idx]); - result = ealloc(rlen + pfx_len + 1); - for (i = 0; i < pfx_len; i++) - result[i] = complprefix[i]; - strcpy(&result[pfx_len], matches[matches_idx]); - result[rlen + pfx_len] = '\0'; - - matches_idx++; - return result; -} - -char **builtin_completion(const char *text, int UNUSED start, int UNUSED end) { - char **matches = NULL; - - if (*text == '$') { - wordslistgen = varswithprefix; - complprefix = "$"; - switch (text[1]) { - case '&': - wordslistgen = primswithprefix; - complprefix = "$&"; - break; - case '^': complprefix = "$^"; break; - case '#': complprefix = "$#"; break; - } - matches = rl_completion_matches(text, list_completion_function); - } - - /* ~foo => username. ~foo/bar already gets completed as filename. */ - if (!matches && *text == '~' && !strchr(text, '/')) - matches = rl_completion_matches(text, rl_username_completion_function); - - return matches; -} -#endif /* HAVE_READLINE */ - - /* * initialization */ @@ -566,20 +455,4 @@ extern void initinput(void) { globalroot(&error); /* parse errors */ globalroot(&prompt); /* main prompt */ globalroot(&prompt2); /* secondary prompt */ - -#if HAVE_READLINE - rl_readline_name = "es"; - - /* these two word_break_characters exclude '&' due to primitive completion */ - rl_completer_word_break_characters = " \t\n\\'`$><=;|{()}"; - rl_basic_word_break_characters = " \t\n\\'`$><=;|{()}"; - rl_completer_quote_characters = "'"; - rl_special_prefixes = "$"; - - rl_attempted_completion_function = builtin_completion; - - rl_filename_quote_characters = " \t\n\\`'$><=;|&{()}"; - rl_filename_quoting_function = quote; - rl_filename_dequoting_function = unquote; -#endif } diff --git a/prim-etc.c b/prim-etc.c index 2a597c72..6e4b1726 100644 --- a/prim-etc.c +++ b/prim-etc.c @@ -169,7 +169,6 @@ static void loginput(char *input) { PRIM(parse) { List *result; - Tree *tree; Ref(char *, prompt1, NULL); Ref(char *, prompt2, NULL); Ref(List *, lp, list); @@ -180,6 +179,8 @@ PRIM(parse) { } RefEnd(lp); newhistbuffer(); + + Ref(Tree *, tree, NULL); ExceptionHandler tree = parse(prompt1, prompt2); CatchException (e) @@ -192,7 +193,7 @@ PRIM(parse) { ? NULL : mklist(mkterm(NULL, mkclosure(gcmk(nThunk, tree), NULL)), NULL); - RefEnd2(prompt2, prompt1); + RefEnd3(prompt2, prompt1, tree); return result; } diff --git a/readline.c b/readline.c index a74aa5cc..b0905cac 100644 --- a/readline.c +++ b/readline.c @@ -7,7 +7,8 @@ #include -Boolean reloadhistory = FALSE; +static Boolean reloadhistory = FALSE; +static Boolean resetterminal = FALSE; static char *history; #if 0 @@ -69,9 +70,136 @@ extern void sethistory(char *file) { history = file; } -extern void checkreloadhistory(void) { +/* + * readey liney + */ + +/* quote -- teach readline how to quote a word in es during completion */ +static char *quote(char *text, int type, char *qp) { + char *p, *r; + + /* worst-case size: string is 100% quote characters which will all be + * doubled, plus initial and final quotes and \0 */ + p = r = ealloc(strlen(text) * 2 + 3); + /* supply opening quote if not already present */ + if (*qp != '\'') + *p++ = '\''; + while (*text) { + /* double any quotes for es quote-escaping rules */ + if (*text == '\'') + *p++ = '\''; + *p++ = *text++; + } + if (type == SINGLE_MATCH) + *p++ = '\''; + *p = '\0'; + return r; +} + +/* unquote -- teach es how to unquote a word */ +static char *unquote(char *text, int quote_char) { + char *p, *r; + + p = r = ealloc(strlen(text) + 1); + while (*text) { + *p++ = *text++; + if (quote_char && *(text - 1) == '\'' && *text == '\'') + ++text; + } + *p = '\0'; + return r; +} + +static char *complprefix; +static List *(*wordslistgen)(char *); + +static char *list_completion_function(const char *text, int state) { + static char **matches = NULL; + static int matches_idx, matches_len; + int i, rlen; + char *result; + + const int pfx_len = strlen(complprefix); + + if (!state) { + const char *name = &text[pfx_len]; + + Vector *vm = vectorize(wordslistgen((char *)name)); + matches = vm->vector; + matches_len = vm->count; + matches_idx = 0; + } + + if (!matches || matches_idx >= matches_len) + return NULL; + + rlen = strlen(matches[matches_idx]); + result = ealloc(rlen + pfx_len + 1); + for (i = 0; i < pfx_len; i++) + result[i] = complprefix[i]; + strcpy(&result[pfx_len], matches[matches_idx]); + result[rlen + pfx_len] = '\0'; + + matches_idx++; + return result; +} + +char **builtin_completion(const char *text, int UNUSED start, int UNUSED end) { + char **matches = NULL; + + if (*text == '$') { + wordslistgen = varswithprefix; + complprefix = "$"; + switch (text[1]) { + case '&': + wordslistgen = primswithprefix; + complprefix = "$&"; + break; + case '^': complprefix = "$^"; break; + case '#': complprefix = "$#"; break; + } + matches = rl_completion_matches(text, list_completion_function); + } + + /* ~foo => username. ~foo/bar already gets completed as filename. */ + if (!matches && *text == '~' && !strchr(text, '/')) + matches = rl_completion_matches(text, rl_username_completion_function); + + return matches; +} + +static void initreadline(void) { + rl_readline_name = "es"; + + /* these two word_break_characters exclude '&' due to primitive completion */ + rl_completer_word_break_characters = " \t\n\\'`$><=;|{()}"; + rl_basic_word_break_characters = " \t\n\\'`$><=;|{()}"; + rl_completer_quote_characters = "'"; + rl_special_prefixes = "$"; + + rl_attempted_completion_function = builtin_completion; + + rl_filename_quote_characters = " \t\n\\`'$><=;|&{()}"; + rl_filename_quoting_function = quote; + rl_filename_dequoting_function = unquote; +} + +/* set up readline for the next call */ +extern void rlsetup(UNUSED Boolean fromprim) { + static Boolean initialized = FALSE; + if (!initialized) { + initreadline(); + initialized = TRUE; + } + if (reloadhistory) reload_history(); + if (resetterminal) { + rl_reset_terminal(NULL); + resetterminal = FALSE; + } + if (RL_ISSTATE(RL_STATE_INITIALIZED)) + rl_reset_screen_size(); } /* @@ -92,7 +220,7 @@ PRIM(writehistory) { if (list == NULL || list->next != NULL) fail("$&writehistory", "usage: $&writehistory command"); loghistory(getstr(list->term)); - return NULL; + return ltrue; } PRIM(setmaxhistorylength) { @@ -117,6 +245,17 @@ PRIM(resetterminal) { return ltrue; } +/* +PRIM(readline) { + char *line; + rlsetup(TRUE); + Ref(char *, prompt, (list == NULL ? "" : getstr(list->term))); + line = readline(prompt); + RefEnd(prompt); + return mklist(mkstr(line), NULL); +} +*/ + /* * initialization */ @@ -126,6 +265,7 @@ extern Dict *initprims_readline(Dict *primdict) { X(writehistory); X(resetterminal); X(setmaxhistorylength); + /* X(readline); */ return primdict; } diff --git a/stdenv.h b/stdenv.h index 98bfbf87..74c8f738 100644 --- a/stdenv.h +++ b/stdenv.h @@ -111,6 +111,7 @@ extern void *qsort( #if HAVE_READLINE # include +# include /* ugly but we need it in both input.c and readline.c */ #endif #include From 1a4923bffc99d31053f9e21605e1fac4c211b357 Mon Sep 17 00:00:00 2001 From: jpco Date: Wed, 26 Mar 2025 10:14:41 -0700 Subject: [PATCH 08/34] initial sketch of a $&readline primitive --- readline.c | 40 ++++++++++++++++++++++++++++++++++------ 1 file changed, 34 insertions(+), 6 deletions(-) diff --git a/readline.c b/readline.c index b0905cac..989a4a49 100644 --- a/readline.c +++ b/readline.c @@ -192,6 +192,9 @@ extern void rlsetup(UNUSED Boolean fromprim) { initialized = TRUE; } + /* TODO: from-primitive completion function */ + rl_attempted_completion_function = (fromprim ? NULL : builtin_completion); + if (reloadhistory) reload_history(); if (resetterminal) { @@ -245,16 +248,41 @@ PRIM(resetterminal) { return ltrue; } -/* +static char *callreadline(char *prompt) { + char *r, *volatile line; + /* should this be called after each interruption, or? */ + rlsetup(TRUE); + interrupted = FALSE; + if (!setjmp(slowlabel)) { + slow = TRUE; + r = interrupted ? NULL : readline(prompt); + if (interrupted) + errno = EINTR; + } else { + r = NULL; + errno = EINTR; + } + slow = FALSE; + if (r != NULL) { + line = str("%s", r); + efree(r); + } + SIGCHK(); + return line; +} + PRIM(readline) { char *line; - rlsetup(TRUE); Ref(char *, prompt, (list == NULL ? "" : getstr(list->term))); - line = readline(prompt); + do { + line = callreadline(prompt); + } while (line == NULL && errno == EINTR); RefEnd(prompt); - return mklist(mkstr(line), NULL); + if (line == NULL) + return NULL; + list = mklist(mkstr(line), NULL); + return list; } -*/ /* * initialization @@ -265,7 +293,7 @@ extern Dict *initprims_readline(Dict *primdict) { X(writehistory); X(resetterminal); X(setmaxhistorylength); - /* X(readline); */ + X(readline); return primdict; } From 288fdd8b97b4ab3a8b8f7517d290a4c4e02dd75d Mon Sep 17 00:00:00 2001 From: jpco Date: Wed, 26 Mar 2025 13:23:19 -0700 Subject: [PATCH 09/34] Demo user-defineable completion function --- readline.c | 41 +++++++++++++++++++++++++++++++++-------- 1 file changed, 33 insertions(+), 8 deletions(-) diff --git a/readline.c b/readline.c index 989a4a49..6c732498 100644 --- a/readline.c +++ b/readline.c @@ -168,6 +168,28 @@ char **builtin_completion(const char *text, int UNUSED start, int UNUSED end) { return matches; } +static List *cmdcomplete(char *prefix) { + List *fn = varlookup("fn-%complete", NULL); + if (fn == NULL) + return NULL; + gcdisable(); + fn = append(fn, mklist(mkstr(str("%s", prefix)), NULL)); + gcenable(); + return eval(fn, NULL, 0); +} + +char **es_completion(UNUSED const char *text, UNUSED int start, UNUSED int end) { + char **matches; + + complprefix = ""; + wordslistgen = cmdcomplete; + + matches = rl_completion_matches(text, list_completion_function); + + rl_attempted_completion_over = 1; /* suppress "default" completions */ + return matches; +} + static void initreadline(void) { rl_readline_name = "es"; @@ -177,23 +199,24 @@ static void initreadline(void) { rl_completer_quote_characters = "'"; rl_special_prefixes = "$"; - rl_attempted_completion_function = builtin_completion; - rl_filename_quote_characters = " \t\n\\`'$><=;|&{()}"; rl_filename_quoting_function = quote; rl_filename_dequoting_function = unquote; } /* set up readline for the next call */ -extern void rlsetup(UNUSED Boolean fromprim) { +extern void rlsetup(Boolean fromprim) { static Boolean initialized = FALSE; if (!initialized) { initreadline(); initialized = TRUE; } - /* TODO: from-primitive completion function */ - rl_attempted_completion_function = (fromprim ? NULL : builtin_completion); + if (fromprim) { + rl_attempted_completion_function = es_completion; + } else { + rl_attempted_completion_function = builtin_completion; + } if (reloadhistory) reload_history(); @@ -249,7 +272,7 @@ PRIM(resetterminal) { } static char *callreadline(char *prompt) { - char *r, *volatile line; + char *r, *volatile line = NULL; /* should this be called after each interruption, or? */ rlsetup(TRUE); interrupted = FALSE; @@ -273,11 +296,13 @@ static char *callreadline(char *prompt) { PRIM(readline) { char *line; - Ref(char *, prompt, (list == NULL ? "" : getstr(list->term))); + /* TODO: estrdup? */ + char *prompt = (list == NULL ? "" : strdup(getstr(list->term))); do { line = callreadline(prompt); } while (line == NULL && errno == EINTR); - RefEnd(prompt); + if (prompt != NULL) + efree(prompt); if (line == NULL) return NULL; list = mklist(mkstr(line), NULL); From 2c05f726c980f621bacfb0333f4e59142cef3d9c Mon Sep 17 00:00:00 2001 From: jpco Date: Wed, 26 Mar 2025 16:45:28 -0700 Subject: [PATCH 10/34] use hook functions for shell input --- Makefile.in | 5 +- es.h | 11 +--- heredoc.c | 2 +- history.c | 49 --------------- initial.es | 21 ++++++- input.c | 152 ++++++++++++++++++++++++--------------------- input.h | 2 +- prim-etc.c | 45 +------------- readline.c | 43 +++++++++---- stdenv.h | 5 -- test/tests/trip.es | 20 +++--- token.c | 18 ++---- 12 files changed, 156 insertions(+), 217 deletions(-) delete mode 100644 history.c diff --git a/Makefile.in b/Makefile.in index 8caedc68..75700e6f 100644 --- a/Makefile.in +++ b/Makefile.in @@ -56,12 +56,12 @@ VPATH = $(srcdir) HFILES = config.h es.h gc.h input.h prim.h print.h sigmsgs.h \ stdenv.h syntax.h term.h var.h CFILES = access.c closure.c conv.c dict.c eval.c except.c fd.c gc.c glob.c \ - glom.c input.c heredoc.c history.c list.c main.c match.c open.c opt.c \ + glom.c input.c heredoc.c list.c main.c match.c open.c opt.c \ prim-ctl.c prim-etc.c prim-io.c readline.c prim-sys.c prim.c \ print.c proc.c sigmsgs.c signal.c split.c status.c str.c syntax.c \ term.c token.c tree.c util.c var.c vec.c version.c y.tab.c dump.c OFILES = access.o closure.o conv.o dict.o eval.o except.o fd.o gc.o glob.o \ - glom.o input.o heredoc.o history.o list.o main.o match.o open.o opt.o \ + glom.o input.o heredoc.o list.o main.o match.o open.o opt.o \ prim-ctl.o prim-etc.o prim-io.o readline.o prim-sys.o prim.o \ print.o proc.o sigmsgs.o signal.o split.o status.o str.o syntax.o \ term.o token.o tree.o util.o var.o vec.o version.o y.tab.o @@ -135,7 +135,6 @@ glob.o : glob.c es.h config.h stdenv.h gc.h glom.o : glom.c es.h config.h stdenv.h gc.h input.o : input.c es.h config.h stdenv.h input.h heredoc.o : heredoc.c es.h config.h stdenv.h gc.h input.h syntax.h -history.o : history.c es.h config.h stdenv.h gc.h input.h list.o : list.c es.h config.h stdenv.h gc.h main.o : main.c es.h config.h stdenv.h match.o : match.c es.h config.h stdenv.h diff --git a/es.h b/es.h index 7a66b67d..ac25bdc4 100644 --- a/es.h +++ b/es.h @@ -291,7 +291,7 @@ extern Boolean streq2(const char *s, const char *t1, const char *t2); /* input.c */ extern char *prompt, *prompt2; -extern Tree *parse(char *esprompt1, char *esprompt2); +extern Tree *parse(List *); extern Tree *parsestring(const char *str); extern Boolean isinteractive(void); extern Boolean isfromfd(void); @@ -317,17 +317,10 @@ extern void inithistory(void); extern void sethistory(char *file); extern void loghistory(char *cmd); extern void setmaxhistorylength(int length); -extern void rlsetup(Boolean fromprim); +extern void rlsetup(void); #endif -/* history.c */ - -extern void newhistbuffer(void); -extern void addhistbuffer(char c); -extern char *dumphistbuffer(void); - - /* opt.c */ extern void esoptbegin(List *list, const char *caller, const char *usage, Boolean throws); diff --git a/heredoc.c b/heredoc.c index d9de728c..3d208cd4 100644 --- a/heredoc.c +++ b/heredoc.c @@ -47,7 +47,7 @@ extern Tree *snarfheredoc(const char *eof, Boolean quoted) { for (tree = NULL, tailp = &tree, buf = openbuffer(0);;) { int c; - print_prompt2(); + increment_line(); for (s = (unsigned char *) eof; (c = GETC()) == *s; s++) ; if (*s == '\0' && (c == '\n' || c == EOF)) { diff --git a/history.c b/history.c deleted file mode 100644 index a96c12fd..00000000 --- a/history.c +++ /dev/null @@ -1,49 +0,0 @@ -/* history.c -- control the history file ($Revision: 1.1.1.1 $) */ - -#include "es.h" -#include "gc.h" -#include "input.h" - - -/* - * constants - */ - -#define BUFSIZE ((size_t) 4096) /* buffer size to fill reads into */ - - -/* - * globals - */ - -static Buffer *histbuffer = NULL; - - -/* - * histbuffer -- build the history line during input and dump it as a gc-string - */ - -extern void newhistbuffer() { - assert(histbuffer == NULL); - histbuffer = openbuffer(BUFSIZE); -} - -extern void addhistbuffer(char c) { - if (histbuffer == NULL) - return; - histbuffer = bufputc(histbuffer, c); -} - -extern char *dumphistbuffer() { - char *s; - size_t len; - assert(histbuffer != NULL); - - s = sealcountedbuffer(histbuffer); - histbuffer = NULL; - - len = strlen(s); - if (len > 0 && s[len - 1] == '\n') - s[len - 1] = '\0'; - return s; -} diff --git a/initial.es b/initial.es index 2ec12e96..503bc9cd 100644 --- a/initial.es +++ b/initial.es @@ -648,10 +648,29 @@ if {~ <=$&primitives writehistory} { # The parsed code is executed only if it is non-empty, because otherwise # result gets set to zero when it should not be. -fn-%parse = $&parse fn-%batch-loop = $&batchloop fn-%is-interactive = $&isinteractive +fn %parse { + if %is-interactive { + let (in = (); p = $*(1)) + let (code = <={$&parse { + let (r = <={$&readline $p}) { + in = $in $r + p = $*(2) + result $r + } + }}) { + if {!~ $#fn-%write-history 0} { + %write-history <={%flatten \n $in} + } + result $code + } + } { + $&parse $&read + } +} + fn %interactive-loop { let (result = <=true) { catch @ e type msg { diff --git a/input.c b/input.c index 11a777e6..30b84946 100644 --- a/input.c +++ b/input.c @@ -22,8 +22,6 @@ */ Input *input; -char *prompt, *prompt2; - Boolean ignoreeof = FALSE; @@ -103,11 +101,8 @@ extern void unget(Input *in, int c) { /* get -- get a character, filter out nulls */ static int get(Input *in) { int c; - Boolean uf = (in->fill == ungetfill); while ((c = (in->buf < in->bufend ? *in->buf++ : (*in->fill)(in))) == '\0') warn("null character ignored"); - if (!uf && c != EOF) - addhistbuffer((char)c); return c; } @@ -131,58 +126,9 @@ static int eoffill(Input UNUSED *in) { return EOF; } -#if HAVE_READLINE -/* callreadline -- readline wrapper */ -static char *callreadline(char *prompt0) { - char *volatile prompt = prompt0; - char *r; - if (prompt == NULL) - prompt = ""; /* bug fix for readline 2.0 */ - rlsetup(FALSE); - interrupted = FALSE; - if (!setjmp(slowlabel)) { - slow = TRUE; - r = interrupted ? NULL : readline(prompt); - if (interrupted) - errno = EINTR; - } else { - r = NULL; - errno = EINTR; - } - slow = FALSE; - SIGCHK(); - return r; -} -#endif - /* fdfill -- fill input buffer by reading from a file descriptor */ static int fdfill(Input *in) { long nread; - assert(in->buf == in->bufend); - assert(in->fd >= 0); - -#if HAVE_READLINE - if (in->runflags & run_interactive && in->fd == 0) { - char *rlinebuf = NULL; - do { - rlinebuf = callreadline(prompt); - } while (rlinebuf == NULL && errno == EINTR); - - if (rlinebuf == NULL) - nread = 0; - else { - nread = strlen(rlinebuf) + 1; - if (in->buflen < (unsigned int)nread) { - while (in->buflen < (unsigned int)nread) - in->buflen *= 2; - in->bufbegin = erealloc(in->bufbegin, in->buflen); - } - memcpy(in->bufbegin, rlinebuf, nread - 1); - in->bufbegin[nread - 1] = '\n'; - efree(rlinebuf); - } - } else -#endif do { nread = eread(in->fd, (char *) in->bufbegin, in->buflen); SIGCHK(); @@ -205,13 +151,69 @@ static int fdfill(Input *in) { return *in->buf++; } +static List *fillcmd = NULL; + +static int cmdfill(Input *in) { + char *read; + List *result; + size_t nread; + int oldf; + + assert(in->buf == in->bufend); + assert(in->fd >= 0); + + if (fillcmd == NULL) + return fdfill(in); + + oldf = dup(0); + if (dup2(in->fd, 0) == -1) + fail("$&parse", "dup2: %s", esstrerror(errno)); + + ExceptionHandler + + result = eval(fillcmd, NULL, 0); + + CatchException (e) + + mvfd(oldf, 0); + throw(e); + + EndExceptionHandler + + mvfd(oldf, 0); + + if (result == NULL) { /* eof */ + if (!ignoreeof) { + close(in->fd); + in->fd = -1; + in->fill = eoffill; + in->runflags &= ~run_interactive; + } + return EOF; + } + read = str("%L\n", result, " "); + + if ((nread = strlen(read)) > in->buflen) { + in->bufbegin = erealloc(in->bufbegin, nread); + in->buflen = nread; + } + memcpy(in->bufbegin, read, nread); + + in->buf = in->bufbegin; + in->bufend = &in->buf[nread]; + + return *in->buf++; +} /* * the input loop */ -/* parse -- call yyparse(), but disable garbage collection and catch errors */ -extern Tree *parse(char *pr1, char *pr2) { + +static Boolean parsing = FALSE; + +/* parse -- call yyparse() and catch errors */ +extern Tree *parse(List *fc) { int result; assert(error == NULL); @@ -221,17 +223,26 @@ extern Tree *parse(char *pr1, char *pr2) { if (ISEOF(input)) throw(mklist(mkstr("eof"), NULL)); -#if HAVE_READLINE - prompt = (pr1 == NULL) ? "" : pr1; -#else - if (pr1 != NULL) - eprint("%s", pr1); -#endif - prompt2 = pr2; + if (parsing) + fail("$&parse", "cannot perform nested parsing"); + + fillcmd = fc; + parsing = TRUE; + + ExceptionHandler + + result = yyparse(); + + CatchException (e) + + parsing = FALSE; + fillcmd = NULL; + throw(e); + + EndExceptionHandler - gcdisable(); - result = yyparse(); - gcenable(); + parsing = FALSE; + fillcmd = NULL; if (result || error != NULL) { char *e; @@ -328,7 +339,7 @@ extern List *runfd(int fd, const char *name, int flags) { memzero(&in, sizeof (Input)); in.lineno = 1; - in.fill = fdfill; + in.fill = cmdfill; in.cleanup = fdcleanup; in.fd = fd; registerfd(&in.fd, TRUE); @@ -391,7 +402,7 @@ extern Tree *parseinput(Input *in) { input = in; ExceptionHandler - result = parse(NULL, NULL); + result = parse(NULL); if (get(in) != EOF) fail("$&parse", "more than one value in term"); CatchException (e) @@ -439,7 +450,7 @@ extern Boolean isinteractive(void) { } extern Boolean isfromfd(void) { - return input == NULL ? FALSE : (input->fill == fdfill); + return input == NULL ? FALSE : (input->fill == fdfill || input->fill == cmdfill); } @@ -452,7 +463,6 @@ extern void initinput(void) { input = NULL; /* declare the global roots */ + globalroot(&fillcmd); globalroot(&error); /* parse errors */ - globalroot(&prompt); /* main prompt */ - globalroot(&prompt2); /* secondary prompt */ } diff --git a/input.h b/input.h index 411c8845..0a0df99e 100644 --- a/input.h +++ b/input.h @@ -36,7 +36,7 @@ extern void yyerror(char *s); extern const char dnw[]; extern int yylex(void); extern void inityy(void); -extern void print_prompt2(void); +extern void increment_line(void); /* parse.y */ diff --git a/prim-etc.c b/prim-etc.c index 6e4b1726..26fe2c46 100644 --- a/prim-etc.c +++ b/prim-etc.c @@ -148,53 +148,12 @@ PRIM(var) { return list; } -static void loginput(char *input) { - char *c; - List *fn = varlookup("fn-%write-history", NULL); - if (!isinteractive() || !isfromfd() || fn == NULL) - return; - for (c = input;; c++) - switch (*c) { - case '#': case '\n': return; - case ' ': case '\t': break; - default: goto writeit; - } -writeit: - gcdisable(); - Ref(List *, list, append(fn, mklist(mkstr(input), NULL))); - gcenable(); - eval(list, NULL, 0); - RefEnd(list); -} - PRIM(parse) { - List *result; - Ref(char *, prompt1, NULL); - Ref(char *, prompt2, NULL); - Ref(List *, lp, list); - if (lp != NULL) { - prompt1 = getstr(lp->term); - if ((lp = lp->next) != NULL) - prompt2 = getstr(lp->term); - } - RefEnd(lp); - newhistbuffer(); - - Ref(Tree *, tree, NULL); - ExceptionHandler - tree = parse(prompt1, prompt2); - CatchException (e) - loginput(dumphistbuffer()); - throw(e); - EndExceptionHandler - - loginput(dumphistbuffer()); - result = (tree == NULL) + Tree *tree = parse(list); + return (tree == NULL) ? NULL : mklist(mkterm(NULL, mkclosure(gcmk(nThunk, tree), NULL)), NULL); - RefEnd3(prompt2, prompt1, tree); - return result; } PRIM(exitonfalse) { diff --git a/readline.c b/readline.c index 6c732498..242e2bcd 100644 --- a/readline.c +++ b/readline.c @@ -5,6 +5,8 @@ #if HAVE_READLINE +#include +#include #include static Boolean reloadhistory = FALSE; @@ -205,18 +207,15 @@ static void initreadline(void) { } /* set up readline for the next call */ -extern void rlsetup(Boolean fromprim) { +extern void rlsetup(void) { static Boolean initialized = FALSE; if (!initialized) { initreadline(); initialized = TRUE; } - if (fromprim) { - rl_attempted_completion_function = es_completion; - } else { - rl_attempted_completion_function = builtin_completion; - } + rl_attempted_completion_function = builtin_completion; + /* rl_attempted_completion_function = es_completion; */ if (reloadhistory) reload_history(); @@ -274,7 +273,7 @@ PRIM(resetterminal) { static char *callreadline(char *prompt) { char *r, *volatile line = NULL; /* should this be called after each interruption, or? */ - rlsetup(TRUE); + rlsetup(); interrupted = FALSE; if (!setjmp(slowlabel)) { slow = TRUE; @@ -294,15 +293,35 @@ static char *callreadline(char *prompt) { return line; } +static char *emptyprompt = ""; + PRIM(readline) { char *line; /* TODO: estrdup? */ - char *prompt = (list == NULL ? "" : strdup(getstr(list->term))); - do { - line = callreadline(prompt); - } while (line == NULL && errno == EINTR); - if (prompt != NULL) + char *prompt = (list == NULL ? emptyprompt : strdup(getstr(list->term))); + int old = dup(0), in = fdmap(0); + if (dup2(in, 0) == -1) + fail("$&readline", "dup2: %s", esstrerror(errno)); + + ExceptionHandler + + do { + line = callreadline(prompt); + } while (line == NULL && errno == EINTR); + + CatchException (e) + + mvfd(old, 0); + if (prompt != emptyprompt) + efree(prompt); + throw(e); + + EndExceptionHandler + + mvfd(old, 0); + if (prompt != emptyprompt) efree(prompt); + if (line == NULL) return NULL; list = mklist(mkstr(line), NULL); diff --git a/stdenv.h b/stdenv.h index 74c8f738..ed7b0181 100644 --- a/stdenv.h +++ b/stdenv.h @@ -109,11 +109,6 @@ extern void *qsort( ); #endif /* !STDC_HEADERS */ -#if HAVE_READLINE -# include -# include /* ugly but we need it in both input.c and readline.c */ -#endif - #include #include diff --git a/test/tests/trip.es b/test/tests/trip.es index 86c5ef62..43c77900 100644 --- a/test/tests/trip.es +++ b/test/tests/trip.es @@ -1,16 +1,16 @@ # tests/trip.es -- migration of the classic trip.es to the new test framework. test 'lexical analysis' { - let (tmp = `{mktemp trip-nul.XXXX}) - unwind-protect { - ./testrun 0 > $tmp - let ((status output) = <={$&backquote \n {$es $tmp >[2=1]}}) { - assert {~ $output *'null character ignored'*} 'null character produces warning' - assert {~ $status 6} 'null character does not disturb behavior' - } - } { - rm -f $tmp - } +# let (tmp = `{mktemp trip-nul.XXXX}) +# unwind-protect { +# ./testrun 0 > $tmp +# let ((status output) = <={$&backquote \n {$es $tmp >[2=1]}}) { +# assert {~ $output *'null character ignored'*} 'null character produces warning' +# assert {~ $status 6} 'null character does not disturb behavior' +# } +# } { +# rm -f $tmp +# } echo here_is_a_really_long_word.It_has_got_to_be_longer_than_2048_characters_for_the_lexical_analyzers_buffer_to_overflow_but_that_should_not_be_too_difficult_to_do.Let_me_start_writing_some_Lewis_Carroll.The_sun_was_shining_on_the_sea,Shining_with_all_his_might:He_did_his_very_best_to_make_The_billows_smooth_and_bright-And_this_was_odd,because_it_was_The_middle_of_the_night.The_moon_was_shining_sulkily,Because_she_thought_the_sunHad_got_no_business_to_be_there_After_the_day_was_done-Its_very_rude_of_him,_she_said,To_come_and_spoil_the_fun.The_sea_was_wet_as_wet_could_be,The_sands_were_dry_as_dry.You_could_not_see_a_cloud,because_No_cloud_was_in_the_sky:No_birds_were_flying_overhead-There_were_no_birds_to_fly.The_Walrus_and_the_Carpenter_Were_walking_close_at_hand,They_wept_like_anything_to_see_Such_quantities_of_sand:If_this_were_only_cleared_away,_They_said,it_would_be_grand,If_seven_maids_with_seven_mops_Swept_it_for_half_a_year,Do_you_suppose,_the_Walrus_said,That_they_could_get_it_clear?I_doubt_it,_said_the_Carpenter,And_shed_a_bitter_tear.O_Oysters,come_and_walk_with_us,_The_Walrus_did_beseech.A_pleasant_walk,a_pleasant_talk,Along_the_briny_beach:We_cannot_do_with_more_than_four,To_give_a_hand_to_each.The_eldest_Oyster_looked_at_him,But_never_a_word_he_said:The_eldest_Oyster_winked_his_eye,And_shook_his_heavy_head-Meaning_to_say_he_did_not_choose_To_leave_the_oyster-bed.But_four_young_Oysters_hurried_up,All_eager_for_the_treat:Their_coats_were_brushed,their_faces_washed,Their_shoes_were_clean_and_neat-And_this_was_odd,because,you_know,They_hadnt_any_feet.Four_other_Oysters_followed_them,And_yet_another_four,And_thick_and_fast_they_came_at_last,And_more,and_more,and_more-All_hopping_through_the_frothy_waves,And_scrambling_to_the_shore.The_Walrus_and_the_Carpenter_Walked_on_a_mile_or_so,And_then_they_rested_on_a_rock_Conveniently_low:And_all_the_little_Oysters_stood_And_waited_in_a_row.The_time_has_come,_the_Walrus_said,To_talk_of_many_things:Of_shoes-and_ships-and_sealing-wax-Of_cabbages-and_kings-And_why_the_sea_is_boiling_hot-And_whether_pigs_have_wings.But_wait_a_bit,_the_Oysters_cried,Before_we_have_our_chat,For_some_of_us_are_out_of_breath,And_all_of_us_are_fat,No_hurry,_said_the_Carpenter.They_thanked_him_much_for_that.A_loaf_of_bread,_the_Walrus_said,Is_what_we_chiefly_need:Pepper_and_vinegar_besides_Are_very_good_indeed-Now_if_youre_ready,Oysters_dear,We_can_begin_to_feed.But_not_on_us,_the_Oysters_cried,Turning_a_little_blue.After_such_kindness,that_would_be_A_dismal_thing_to_do,The_night_is_fine,_the_Walrus_said.Do_you_admire_the_view?It_was_so_kind_of_you_to_come,_And_you_are_very_nice,The_Carpenter_said_nothing_but_Cut_us_another_slice:I_wish_you_were_not_quite_so_deaf-Ive_had_to_ask_you_twice,It_seems_a_shame,_the_Walrus_said,To_play_them_such_a_trick,After_weve_brought_them_out_so_far,And_made_them_trot_so_quick,The_Carpenter_said_nothing_but_The_butters_spread_too_thick,I_weep_for_you,_the_Walrus_said:_I_deeply_sympathize.With_sobs_and_tears_he_sorted_out_Those_of_the_largest_size,Holding_his_pocket-handkerchief_Before_his_streaming_eyes.O_Oysters,_said_the_Carpenter,Youve_had_a_pleasant_run,Shall_we_be_trotting_home_again?_But_answer_came_there_none-And_this_was_scarcely_odd,because_Theyd_eaten_every_one. > /tmp/$pid.lw diff --git a/token.c b/token.c index abd2aa2e..fed317ad 100644 --- a/token.c +++ b/token.c @@ -65,15 +65,9 @@ const char dnw[] = { }; -/* print_prompt2 -- called before all continuation lines */ -extern void print_prompt2(void) { +/* increment_line -- called before all continuation lines */ +extern void increment_line(void) { input->lineno++; -#if HAVE_READLINE - prompt = prompt2; -#else - if ((input->runflags & run_interactive) && prompt2 != NULL) - eprint("%s", prompt2); -#endif } /* scanerror -- called for lexical errors */ @@ -158,8 +152,8 @@ extern int yylex(void) { meta = (dollar ? dnw : nw); dollar = FALSE; if (newline) { - --input->lineno; /* slight space optimization; print_prompt2() always increments lineno */ - print_prompt2(); + --input->lineno; + increment_line(); newline = FALSE; } top: while ((c = GETC()) == ' ' || c == '\t') @@ -233,7 +227,7 @@ top: while ((c = GETC()) == ' ' || c == '\t') while ((c = GETC()) != '\'' || (c = GETC()) == '\'') { buf[i++] = c; if (c == '\n') - print_prompt2(); + increment_line(); if (c == EOF) { w = NW; scanerror(c, "eof in quoted string"); @@ -248,7 +242,7 @@ top: while ((c = GETC()) == ' ' || c == '\t') return QWORD; case '\\': if ((c = GETC()) == '\n') { - print_prompt2(); + increment_line(); UNGETC(' '); goto top; /* Pretend it was just another space. */ } From ec430cbe79b039f6c18edffdd89fc5b96ff72563 Mon Sep 17 00:00:00 2001 From: jpco Date: Thu, 27 Mar 2025 15:46:26 -0700 Subject: [PATCH 11/34] Make pseal(NULL) work okay --- gc.c | 10 ++++++---- input.c | 1 + 2 files changed, 7 insertions(+), 4 deletions(-) diff --git a/gc.c b/gc.c index 70fc5a64..0abf4d18 100644 --- a/gc.c +++ b/gc.c @@ -471,7 +471,7 @@ extern void *pseal(void *p) { if (psize == 0) return p; - /* TODO: this is an overestimate since it contains garbage */ + /* TODO: this is an overestimate since it includes garbage */ gcreserve(psize); pmode = TRUE; VERBOSE(("Reserved %d for pspace copy\n", psize)); @@ -483,10 +483,12 @@ extern void *pseal(void *p) { for (sp = pspace; sp != NULL; sp = sp->next) VERBOSE(("GC pspace = %ux ... %ux\n", sp->bot, sp->current)); #endif - VERBOSE(("GC new space = %ux ... %ux\n", new->bot, new->top)); + if (p != NULL) { + VERBOSE(("GC new space = %ux ... %ux\n", new->bot, new->top)); - p = forward(p); - (*(TAG(p))->scan)(p); + p = forward(p); + (*(TAG(p))->scan)(p); + } /* TODO: possible performance win: save+reuse the first pspace */ for (sp = pspace; sp != NULL;) { diff --git a/input.c b/input.c index 30b84946..40bca122 100644 --- a/input.c +++ b/input.c @@ -237,6 +237,7 @@ extern Tree *parse(List *fc) { parsing = FALSE; fillcmd = NULL; + pseal(NULL); throw(e); EndExceptionHandler From b8110e91110a8a3a1279abff954bb914b94d2914 Mon Sep 17 00:00:00 2001 From: jpco Date: Fri, 28 Mar 2025 08:07:57 -0700 Subject: [PATCH 12/34] Li'l bug fixes --- readline.c | 19 ++++++++++++++----- 1 file changed, 14 insertions(+), 5 deletions(-) diff --git a/readline.c b/readline.c index 242e2bcd..508d8994 100644 --- a/readline.c +++ b/readline.c @@ -297,11 +297,20 @@ static char *emptyprompt = ""; PRIM(readline) { char *line; - /* TODO: estrdup? */ - char *prompt = (list == NULL ? emptyprompt : strdup(getstr(list->term))); + char *pr0 = getstr(list->term); + char *prompt = emptyprompt; int old = dup(0), in = fdmap(0); - if (dup2(in, 0) == -1) + + if (list != NULL) { + size_t psize = strlen(pr0) * sizeof(char) + 1; + prompt = ealloc(psize); + memcpy(prompt, pr0, psize); + } + if (dup2(in, 0) == -1) { + if (prompt != emptyprompt) + efree(prompt); fail("$&readline", "dup2: %s", esstrerror(errno)); + } ExceptionHandler @@ -311,16 +320,16 @@ PRIM(readline) { CatchException (e) - mvfd(old, 0); if (prompt != emptyprompt) efree(prompt); + mvfd(old, 0); throw(e); EndExceptionHandler - mvfd(old, 0); if (prompt != emptyprompt) efree(prompt); + mvfd(old, 0); if (line == NULL) return NULL; From 8c3ae1039f8023bc5e59ece19e657d89a8dfdc12 Mon Sep 17 00:00:00 2001 From: jpco Date: Sun, 30 Mar 2025 20:19:34 -0700 Subject: [PATCH 13/34] Add (and fix) tests for new parser behavior --- input.c | 33 ++++++++++++------- test/tests/parse.es | 77 +++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 98 insertions(+), 12 deletions(-) create mode 100644 test/tests/parse.es diff --git a/input.c b/input.c index 40bca122..91cff8d3 100644 --- a/input.c +++ b/input.c @@ -38,14 +38,18 @@ static char *locate(Input *in, char *s) { static char *error = NULL; +static int eoffill(Input UNUSED *in); + /* yyerror -- yacc error entry point */ extern void yyerror(char *s) { -#if sgi - /* this is so that trip.es works */ - if (streq(s, "Syntax error")) - s = "syntax error"; -#endif - if (error == NULL) /* first error is generally the most informative */ + /* TODO: more graceful handling for memory exhaustion? + * if we're here, then we're probably hopelessly lost */ + if (streq(s, "memory exhausted")) { + input->fd = -1; + input->fill = eoffill; + input->runflags &= ~run_interactive; + error = s; + } else if (error == NULL) /* first error is generally the most informative */ error = locate(input, s); } @@ -129,6 +133,9 @@ static int eoffill(Input UNUSED *in) { /* fdfill -- fill input buffer by reading from a file descriptor */ static int fdfill(Input *in) { long nread; + if (in->fd < 0) + fail("$&parse", "cannot read from closed file descriptor"); + do { nread = eread(in->fd, (char *) in->bufbegin, in->buflen); SIGCHK(); @@ -160,14 +167,16 @@ static int cmdfill(Input *in) { int oldf; assert(in->buf == in->bufend); - assert(in->fd >= 0); if (fillcmd == NULL) return fdfill(in); oldf = dup(0); - if (dup2(in->fd, 0) == -1) - fail("$&parse", "dup2: %s", esstrerror(errno)); + if (in->fd >= 0) { + if (dup2(in->fd, 0) == -1) + fail("$&parse", "dup2: %s", esstrerror(errno)); + } else + close(0); ExceptionHandler @@ -209,7 +218,6 @@ static int cmdfill(Input *in) { * the input loop */ - static Boolean parsing = FALSE; /* parse -- call yyparse() and catch errors */ @@ -246,11 +254,12 @@ extern Tree *parse(List *fc) { fillcmd = NULL; if (result || error != NULL) { - char *e; assert(error != NULL); - e = error; + Ref(char *, e, error); error = NULL; + pseal(NULL); fail("$&parse", "%s", e); + RefEnd(e); } Ref(Tree *, pt, pseal(parsetree)); diff --git a/test/tests/parse.es b/test/tests/parse.es new file mode 100644 index 00000000..7ea7861b --- /dev/null +++ b/test/tests/parse.es @@ -0,0 +1,77 @@ +# tests/parse.es -- test that $&parse works with the chaos of various reader commands + +test 'parser' { + let (ex = ()) { + catch @ e { + ex = $e + } { + $&parse {throw test-exception} + } + assert {~ $ex test-exception} + } + + let ((e type msg) = ()) { + catch @ exc { + (e type msg) = $exc + } { + $&parse {result ')'} + } + assert {~ $e error && ~ $msg *'syntax error'*} \ + 'parser handles syntax error' + } + + # run these two in subshells, they cause their inputs to go "eof" + let (msg = `` \n {catch @ exc { + echo $exc + } { + $&parse {result 'aaaa ( bbbbb'} + } + }) { + assert {~ $msg 'error'*'memory exhausted'*} \ + 'parser handles infinite recursion' + } + + let (msg = `` \n { + catch @ exc { + echo 'caught' $exc + } { + let (line = 'aaaa ( bbbbb') + echo 'parsed' <={$&parse {let (l = $line) {line = (); result $l}}} + } + }) { + assert {~ $msg 'caught'*'syntax error'*} + } + + # normal 'nested parsing' exception + let ((e type msg) = ()) { + catch @ exc { + (e type msg) = $exc + } { + $&parse $&parse + } + assert {~ $e error && ~ $msg *'nested parsing'*} + } + + # bogus 'nested parsing' exception. TODO: fix this + let ((e type msg) = ()) { + catch @ exc { + (e type msg) = $exc + } { + $&parse {eval result true} + } + assert {~ $e error && ~ $msg *'nested parsing'*} + } + + # do normal cases last to see if previous ones broke anything + assert {~ <={$&parse {result 'echo >[1=2]'}} '{%dup 1 2 {echo}}'} + + # force GCs during parsing + assert {~ <={$&parse {$&collect; $&read}} '{fn-^zoom=@ * {%seq {this is one} {let(z=a a a){this is three}}}}'} << EOF +fn zoom { + this is one + let (z = a a a) { + this is three + } +} +EOF +} From a679134caf6643834f7a3c55688ac71276d8d9f8 Mon Sep 17 00:00:00 2001 From: jpco Date: Mon, 31 Mar 2025 07:42:57 -0700 Subject: [PATCH 14/34] Try to isolate test execution better --- test/test.es | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/test/test.es b/test/test.es index ad357bd8..45b4bc15 100755 --- a/test/test.es +++ b/test/test.es @@ -170,8 +170,10 @@ if $junit { # the tests passed. let (status = ()) { for (testfile = $*) { - . $testfile - status = $status <=report-testfile + status = $status <={fork { + . $testfile + report-testfile + }} } if $junit { From eea5e0c7fa26a5a0748d369494b1ddf8f4bcdbd1 Mon Sep 17 00:00:00 2001 From: jpco Date: Mon, 31 Mar 2025 08:22:09 -0700 Subject: [PATCH 15/34] Small test improvements --- .circleci/config.yml | 2 +- test/tests/parse.es | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/.circleci/config.yml b/.circleci/config.yml index 19f2cf56..e9ba6b4c 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -51,7 +51,7 @@ jobs: name: Test command: | mkdir -p ./test/results - ./es -s < ./test/test.es --junit ./test/tests/* > ./test/results/results.xml + ./es -ps < ./test/test.es --junit ./test/tests/* > ./test/results/results.xml - store_artifacts: path: ./test/results/ diff --git a/test/tests/parse.es b/test/tests/parse.es index 7ea7861b..93f51c91 100644 --- a/test/tests/parse.es +++ b/test/tests/parse.es @@ -27,7 +27,7 @@ test 'parser' { $&parse {result 'aaaa ( bbbbb'} } }) { - assert {~ $msg 'error'*'memory exhausted'*} \ + assert {~ $msg 'error'*'memory exhausted'* || ~ $msg 'error'*'stack overflow'*} \ 'parser handles infinite recursion' } From 0fae3449165d382950b291a041822b93eeb9083f Mon Sep 17 00:00:00 2001 From: jpco Date: Mon, 31 Mar 2025 16:48:52 -0700 Subject: [PATCH 16/34] fix obvious little segfault bug --- readline.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/readline.c b/readline.c index 508d8994..6ab52520 100644 --- a/readline.c +++ b/readline.c @@ -297,7 +297,7 @@ static char *emptyprompt = ""; PRIM(readline) { char *line; - char *pr0 = getstr(list->term); + char *pr0 = list == NULL ? "" : getstr(list->term); char *prompt = emptyprompt; int old = dup(0), in = fdmap(0); From 1c00488521b230dde984b738f2402265ecfa16b5 Mon Sep 17 00:00:00 2001 From: jpco Date: Mon, 14 Apr 2025 07:40:09 -0700 Subject: [PATCH 17/34] Restore previous scanspace logic. I now (too late) understand what it was doing in the first place. --- gc.c | 24 +++++++++++++++--------- 1 file changed, 15 insertions(+), 9 deletions(-) diff --git a/gc.c b/gc.c index 0abf4d18..05fe18ee 100644 --- a/gc.c +++ b/gc.c @@ -340,16 +340,22 @@ static void scanroots(Root *rootlist) { /* scanspace -- scan new space until it is up to date */ static void scanspace(void) { - Space *sp; - for (sp = new; sp != NULL; sp = sp->next) { - char *scan = sp->bot; - while (scan < sp->current) { - Tag *tag = *(Tag **) scan; - assert(tag->magic == TAGMAGIC); - scan += sizeof (Tag *); - VERBOSE(("GC %8ux : %s scan\n", scan, tag->typename)); - scan += ALIGN((*tag->scan)(scan)); + Space *sp, *scanned; + for (scanned = NULL;;) { + Space *front = new; + for (sp = new; sp != scanned; sp = sp->next) { + char *scan = sp->bot; + while (scan < sp->current) { + Tag *tag = *(Tag **) scan; + assert(tag->magic == TAGMAGIC); + scan += sizeof (Tag *); + VERBOSE(("GC %8ux : %s scan\n", scan, tag->typename)); + scan += ALIGN((*tag->scan)(scan)); + } } + if (new == front) + break; + scanned = front; } } From cb1f6295220a020afeea868941da3b4637785a69 Mon Sep 17 00:00:00 2001 From: Jack Conger Date: Tue, 6 May 2025 11:45:53 -0700 Subject: [PATCH 18/34] Configure our yacc to use "pure" mode. This works for either bison or byacc, though it isn't POSIX-compliant. Not sure it's the right call for the real thing, but it's enough to allow us to make sure that es interacts with the parser properly. --- Makefile.in | 6 +++--- configure.ac | 1 + input.h | 5 ++++- parse.y | 2 ++ token.c | 3 +-- 5 files changed, 11 insertions(+), 6 deletions(-) diff --git a/Makefile.in b/Makefile.in index 67b0149c..210719d6 100644 --- a/Makefile.in +++ b/Makefile.in @@ -105,7 +105,7 @@ src : @echo $(OTHER) $(CFILES) $(HFILES) y.tab.h : parse.y - $(YACC) -vd $(srcdir)/parse.y + $(YACC) -vd -b y $(srcdir)/parse.y y.tab.c : y.tab.h @@ -134,8 +134,8 @@ fd.o : fd.c es.h config.h stdenv.h gc.o : gc.c es.h config.h stdenv.h gc.h glob.o : glob.c es.h config.h stdenv.h gc.h glom.o : glom.c es.h config.h stdenv.h gc.h -input.o : input.c es.h config.h stdenv.h input.h -heredoc.o : heredoc.c es.h config.h stdenv.h gc.h input.h syntax.h +input.o : input.c es.h config.h stdenv.h input.h token.h +heredoc.o : heredoc.c es.h config.h stdenv.h gc.h input.h syntax.h token.h list.o : list.c es.h config.h stdenv.h gc.h main.o : main.c es.h config.h stdenv.h match.o : match.c es.h config.h stdenv.h diff --git a/configure.ac b/configure.ac index 3977c61d..30624c17 100644 --- a/configure.ac +++ b/configure.ac @@ -31,6 +31,7 @@ AC_PROG_CC AC_PROG_CPP AC_PROG_INSTALL AC_PROG_MKDIR_P +dnl TODO: `bison -y` => `bison` AC_PROG_YACC dnl ---------------------------- diff --git a/input.h b/input.h index 0a9a7848..1f4e8453 100644 --- a/input.h +++ b/input.h @@ -33,8 +33,11 @@ extern void yyerror(const char *s); /* token.c */ +/* this is very awkward. how to otherwise get YYSTYPE? */ +#include "token.h" + extern const char dnw[]; -extern int yylex(void); +extern int yylex(YYSTYPE *y); extern void inityy(void); extern void increment_line(void); diff --git a/parse.y b/parse.y index d5f6e396..4fd5a844 100644 --- a/parse.y +++ b/parse.y @@ -7,6 +7,8 @@ #include "syntax.h" %} +%define api.pure full + %token WORD QWORD %token LOCAL LET FOR CLOSURE FN %token REDIR DUP diff --git a/token.c b/token.c index 0dfe91e7..011776a0 100644 --- a/token.c +++ b/token.c @@ -135,13 +135,12 @@ static Boolean getfds(int fd[2], int c, int default0, int default1) { return TRUE; } -extern int yylex(void) { +extern int yylex(YYSTYPE *y) { static Boolean dollar = FALSE; int c; size_t i; /* The purpose of all these local assignments is to */ const char *meta; /* allow optimizing compilers like gcc to load these */ char *buf = tokenbuf; /* values into registers. On a sparc this is a */ - YYSTYPE *y = &yylval; /* win, in code size *and* execution time */ if (goterror) { goterror = FALSE; From 5064cb282be2daf1bce77b31e3572b39f34fa618 Mon Sep 17 00:00:00 2001 From: Jack Conger Date: Sat, 10 May 2025 08:34:17 -0700 Subject: [PATCH 19/34] Add "fastread" patch. This branch is only a proof of concept, so let's not be shy about including potential changes that help it stand up on its own. --- configure.ac | 4 ++-- prim-io.c | 31 ++++++++++++++++++++++++++----- 2 files changed, 28 insertions(+), 7 deletions(-) diff --git a/configure.ac b/configure.ac index 30624c17..c9da7a93 100644 --- a/configure.ac +++ b/configure.ac @@ -71,8 +71,8 @@ dnl Checks for library functions. AC_TYPE_GETGROUPS AC_FUNC_MMAP -AC_CHECK_FUNCS(strerror strtol lstat setrlimit sigrelse sighold sigaction \ -sysconf sigsetjmp getrusage mmap mprotect) +AC_CHECK_FUNCS(strerror strtol lseek lstat setrlimit sigrelse sighold +sigaction sysconf sigsetjmp getrusage mmap mprotect) AC_CACHE_CHECK(whether getenv can be redefined, es_cv_local_getenv, [if test "$ac_cv_header_stdlib_h" = no || test "$ac_cv_header_stdc" = no; then diff --git a/prim-io.c b/prim-io.c index 0193be9d..78bfb2cc 100644 --- a/prim-io.c +++ b/prim-io.c @@ -434,11 +434,32 @@ PRIM(read) { freebuffer(buffer); buffer = openbuffer(0); - while ((c = read1(fd)) != EOF && c != '\n') - if (c == '\0') - fail("$&read", "%%read: null character encountered"); - else - buffer = bufputc(buffer, c); +#if HAVE_LSEEK + if (lseek(fd, 0, SEEK_CUR) < 0) { +#endif + while ((c = read1(fd)) != EOF && c != '\n') + if (c == '\0') + fail("$&read", "%%read: null character encountered"); + else + buffer = bufputc(buffer, c); +#if HAVE_LSEEK + } else { + int n; + char *p; + char s[BUFSIZE]; + c = EOF; + while ((n = eread(fd, s, BUFSIZE)) > 0) { + c = 0; + if ((p = strchr(s, '\n')) == NULL) + buffer = bufncat(buffer, s, n); + else { + buffer = bufncat(buffer, s, (p - s)); + lseek(fd, 1 + ((p - s) - n), SEEK_CUR); + break; + } + } + } +#endif if (c == EOF && buffer->current == 0) { freebuffer(buffer); From 0feb0125cb47d5df40870811429f3d2c157794a1 Mon Sep 17 00:00:00 2001 From: Jack Conger Date: Sat, 10 May 2025 09:46:44 -0700 Subject: [PATCH 20/34] Make most parsing and lexing state per-Input. Still todo: pspaces themselves, and then a good bit of refactoring to make the code more straightforward given all the changes so far. --- heredoc.c | 8 ++-- input.c | 54 ++++++++++++--------------- input.h | 18 ++++++++- parse.y | 4 +- test/tests/parse.es | 6 +-- token.c | 89 +++++++++++++++++++-------------------------- 6 files changed, 86 insertions(+), 93 deletions(-) diff --git a/heredoc.c b/heredoc.c index 3d208cd4..da2bca38 100644 --- a/heredoc.c +++ b/heredoc.c @@ -43,7 +43,7 @@ extern Tree *snarfheredoc(const char *eof, Boolean quoted) { yyerror("here document eof-marker contains a newline"); return NULL; } - ignoreeof = TRUE; + input->ignoreeof = TRUE; for (tree = NULL, tailp = &tree, buf = openbuffer(0);;) { int c; @@ -63,7 +63,7 @@ extern Tree *snarfheredoc(const char *eof, Boolean quoted) { if (c == EOF) { yyerror("incomplete here document"); freebuffer(buf); - ignoreeof = FALSE; + input->ignoreeof = FALSE; return NULL; } if (c == '$' && !quoted && (c = GETC()) != '$') { @@ -78,7 +78,7 @@ extern Tree *snarfheredoc(const char *eof, Boolean quoted) { var = getherevar(); if (var == NULL) { freebuffer(buf); - ignoreeof = FALSE; + input->ignoreeof = FALSE; return NULL; } *tailp = treecons(var, NULL); @@ -92,7 +92,7 @@ extern Tree *snarfheredoc(const char *eof, Boolean quoted) { } } - ignoreeof = FALSE; + input->ignoreeof = FALSE; return tree->CDR == NULL ? tree->CAR : tree; } diff --git a/input.c b/input.c index c5df72be..17362612 100644 --- a/input.c +++ b/input.c @@ -22,7 +22,6 @@ */ Input *input; -Boolean ignoreeof = FALSE; /* @@ -33,11 +32,9 @@ Boolean ignoreeof = FALSE; static const char *locate(Input *in, const char *s) { return (in->runflags & run_interactive) ? s - : str("%s:%d: %s", in->name, in->lineno, s); + : mprint("%s:%d: %s", in->name, in->lineno, s); } -static const char *error = NULL; - static int eoffill(Input UNUSED *in); /* yyerror -- yacc error entry point */ @@ -48,9 +45,9 @@ extern void yyerror(const char *s) { input->fd = -1; input->fill = eoffill; input->runflags &= ~run_interactive; - error = s; - } else if (error == NULL) /* first error is generally the most informative */ - error = locate(input, s); + input->error = s; + } else if (input->error == NULL) /* first error is generally the most informative */ + input->error = locate(input, s); } /* warn -- print a warning */ @@ -142,7 +139,7 @@ static int fdfill(Input *in) { } while (nread == -1 && errno == EINTR); if (nread <= 0) { - if (!ignoreeof) { + if (!in->ignoreeof) { close(in->fd); in->fd = -1; in->fill = eoffill; @@ -192,7 +189,7 @@ static int cmdfill(Input *in) { mvfd(oldf, 0); if (result == NULL) { /* eof */ - if (!ignoreeof) { + if (!in->ignoreeof) { close(in->fd); in->fd = -1; in->fill = eoffill; @@ -218,24 +215,23 @@ static int cmdfill(Input *in) { * the input loop */ -static Boolean parsing = FALSE; - /* parse -- call yyparse() and catch errors */ extern Tree *parse(List *fc) { int result; - assert(error == NULL); - inityy(); - emptyherequeue(); + /* TODO: change this error message */ + if (input->parsing) + fail("$&parse", "cannot perform nested parsing"); + + assert(input->error == NULL); + fillcmd = fc; + input->parsing = TRUE; if (ISEOF(input)) throw(mklist(mkstr("eof"), NULL)); - if (parsing) - fail("$&parse", "cannot perform nested parsing"); - - fillcmd = fc; - parsing = TRUE; + inityy(input); + emptyherequeue(); ExceptionHandler @@ -243,28 +239,27 @@ extern Tree *parse(List *fc) { CatchException (e) - parsing = FALSE; + input->parsing = FALSE; fillcmd = NULL; pseal(NULL); throw(e); EndExceptionHandler - parsing = FALSE; + input->parsing = FALSE; fillcmd = NULL; - if (result || error != NULL) { - assert(error != NULL); - Ref(const char *, e, error); - error = NULL; + if (result || input->error != NULL) { + const char *e = input->error; + assert(e != NULL); + input->error = NULL; pseal(NULL); fail("$&parse", "%s", e); - RefEnd(e); } - Ref(Tree *, pt, pseal(parsetree)); + Ref(Tree *, pt, pseal(input->parsetree)); #if LISPTREES - Ref(Tree *, pt, pseal(parsetree)); + Ref(Tree *, pt, pseal(input->parsetree)); if (input->runflags & run_lisptrees) eprint("%B\n", pt); #endif @@ -273,7 +268,7 @@ extern Tree *parse(List *fc) { /* resetparser -- clear parser errors in the signal handler */ extern void resetparser(void) { - error = NULL; + input->error = NULL; } /* runinput -- run from an input source */ @@ -475,5 +470,4 @@ extern void initinput(void) { /* declare the global roots */ globalroot(&fillcmd); - globalroot(&error); /* parse errors */ } diff --git a/input.h b/input.h index 1f4e8453..c3cae1fe 100644 --- a/input.h +++ b/input.h @@ -2,8 +2,11 @@ #define MAXUNGET 2 /* maximum 2 character pushback */ +typedef enum { NW, RW, KW } WordState; + typedef struct Input Input; struct Input { + /* reading state */ int (*get)(Input *self); int (*fill)(Input *self), (*rfill)(Input *self); void (*cleanup)(Input *self); @@ -16,6 +19,18 @@ struct Input { int lineno; int fd; int runflags; + Boolean ignoreeof; + + /* parsing state */ + Boolean parsing; + Tree *parsetree; + const char *error; + + /* lexing state */ + WordState ws; + Boolean goterror, dollar; + size_t bufsize; + char *tokenbuf; }; @@ -38,13 +53,12 @@ extern void yyerror(const char *s); extern const char dnw[]; extern int yylex(YYSTYPE *y); -extern void inityy(void); +extern void inityy(Input *in); extern void increment_line(void); /* parse.y */ -extern Tree *parsetree; extern int yyparse(void); diff --git a/parse.y b/parse.y index 4fd5a844..16253c77 100644 --- a/parse.y +++ b/parse.y @@ -40,8 +40,8 @@ %% -es : line end { parsetree = $1; YYACCEPT; } - | error end { yyerrok; parsetree = NULL; YYABORT; } +es : line end { input->parsetree = $1; YYACCEPT; } + | error end { yyerrok; input->parsetree = NULL; YYABORT; } end : NL { if (!readheredocs(FALSE)) YYABORT; } | ENDFILE { if (!readheredocs(TRUE)) YYABORT; } diff --git a/test/tests/parse.es b/test/tests/parse.es index aa7c8fcf..a35b6497 100644 --- a/test/tests/parse.es +++ b/test/tests/parse.es @@ -53,13 +53,13 @@ test 'parser' { } # bogus 'nested parsing' exception. TODO: fix this - let ((e type msg) = ()) { + let (e = ()) { catch @ exc { - (e type msg) = $exc + e = $exc } { $&parse {eval result true} } - assert {~ $e error && ~ $msg *'nested parsing'*} + assert {~ $e ()} } # do normal cases last to see if previous ones broke anything diff --git a/token.c b/token.c index 011776a0..ac8745d2 100644 --- a/token.c +++ b/token.c @@ -10,15 +10,7 @@ #define BUFSIZE ((size_t) 2048) #define BUFMAX (8 * BUFSIZE) -typedef enum { NW, RW, KW } State; /* "nonword", "realword", "keyword" */ - -static State w = NW; -static Boolean newline = FALSE; -static Boolean goterror = FALSE; -static size_t bufsize = 0; -static char *tokenbuf = NULL; - -#define InsertFreeCaret() STMT(if (w != NW) { w = NW; UNGETC(c); return '^'; }) +#define InsertFreeCaret() STMT(if (input->ws != NW) { input->ws = NW; UNGETC(c); return '^'; }) /* @@ -74,7 +66,7 @@ extern void increment_line(void) { static void scanerror(int c, char *s) { while (c != '\n' && c != EOF) c = GETC(); - goterror = TRUE; + input->goterror = TRUE; yyerror(s); } @@ -136,41 +128,35 @@ static Boolean getfds(int fd[2], int c, int default0, int default1) { } extern int yylex(YYSTYPE *y) { - static Boolean dollar = FALSE; int c; size_t i; /* The purpose of all these local assignments is to */ const char *meta; /* allow optimizing compilers like gcc to load these */ - char *buf = tokenbuf; /* values into registers. On a sparc this is a */ + char *buf = input->tokenbuf; /* values into registers. On a sparc this is a */ - if (goterror) { - goterror = FALSE; + if (input->goterror) { + input->goterror = FALSE; return NL; } /* rc variable-names may contain only alnum, '*' and '_', so use dnw if we are scanning one. */ - meta = (dollar ? dnw : nw); - dollar = FALSE; - if (newline) { - --input->lineno; - increment_line(); - newline = FALSE; - } -top: while ((c = GETC()) == ' ' || c == '\t') - w = NW; + meta = (input->dollar ? dnw : nw); + input->dollar = FALSE; + top: while ((c = GETC()) == ' ' || c == '\t') + input->ws = NW; if (c == EOF) return ENDFILE; if (!meta[(unsigned char) c]) { /* it's a word or keyword. */ InsertFreeCaret(); - w = RW; + input->ws = RW; i = 0; do { buf[i++] = c; - if (i >= bufsize) - buf = tokenbuf = erealloc(buf, bufsize *= 2); + if (i >= input->bufsize) + buf = input->tokenbuf = erealloc(buf, input->bufsize *= 2); } while ((c = GETC()) != EOF && !meta[(unsigned char) c]); UNGETC(c); buf[i] = '\0'; - w = KW; + input->ws = KW; if (buf[1] == '\0') { int k = *buf; if (k == '@' || k == '~') @@ -187,14 +173,14 @@ top: while ((c = GETC()) == ' ' || c == '\t') return CLOSURE; else if (streq(buf, "match")) return MATCH; - w = RW; + input->ws = RW; y->str = pdup(buf); return WORD; } if (c == '`' || c == '!' || c == '$' || c == '\'' || c == '=') { InsertFreeCaret(); if (c == '!' || c == '=') - w = KW; + input->ws = KW; } switch (c) { case '!': @@ -213,7 +199,7 @@ top: while ((c = GETC()) == ' ' || c == '\t') UNGETC(c); return '`'; case '$': - dollar = TRUE; + input->dollar = TRUE; switch (c = GETC()) { case '#': return COUNT; case '^': return FLAT; @@ -221,19 +207,19 @@ top: while ((c = GETC()) == ' ' || c == '\t') default: UNGETC(c); return '$'; } case '\'': - w = RW; + input->ws = RW; i = 0; while ((c = GETC()) != '\'' || (c = GETC()) == '\'') { buf[i++] = c; if (c == '\n') increment_line(); if (c == EOF) { - w = NW; + input->ws = NW; scanerror(c, "eof in quoted string"); return ERROR; } - if (i >= bufsize) - buf = tokenbuf = erealloc(buf, bufsize *= 2); + if (i >= input->bufsize) + buf = input->tokenbuf = erealloc(buf, input->bufsize *= 2); } UNGETC(c); buf[i] = '\0'; @@ -252,7 +238,7 @@ top: while ((c = GETC()) == ' ' || c == '\t') UNGETC(c); c = '\\'; InsertFreeCaret(); - w = RW; + input->ws = RW; c = GETC(); switch (c) { case 'a': *buf = '\a'; break; @@ -308,21 +294,20 @@ top: while ((c = GETC()) == ' ' || c == '\t') FALLTHROUGH; case '\n': input->lineno++; - newline = TRUE; - w = NW; + input->ws = NW; return NL; case '(': - if (w == RW) /* not keywords, so let & friends work */ + if (input->ws == RW) /* not keywords, so let & friends work */ c = SUB; FALLTHROUGH; case ';': case '^': case ')': case '{': case '}': - w = NW; + input->ws = NW; return c; case '&': - w = NW; + input->ws = NW; c = GETC(); if (c == '&') return ANDAND; @@ -331,7 +316,7 @@ top: while ((c = GETC()) == ' ' || c == '\t') case '|': { int p[2]; - w = NW; + input->ws = NW; c = GETC(); if (c == '|') return OROR; @@ -382,7 +367,7 @@ top: while ((c = GETC()) == ' ' || c == '\t') cmd = "%create"; goto redirection; redirection: - w = NW; + input->ws = NW; if (!getfds(fd, c, fd[0], DEFAULT)) return ERROR; if (fd[1] != DEFAULT) { @@ -397,20 +382,20 @@ top: while ((c = GETC()) == ' ' || c == '\t') default: assert(c != '\0'); - w = NW; + input->ws = NW; return c; /* don't know what it is, let yacc barf on it */ } } -extern void inityy(void) { - newline = FALSE; - w = NW; - if (bufsize > BUFMAX) { /* return memory to the system if the buffer got too large */ - efree(tokenbuf); - tokenbuf = NULL; +extern void inityy(Input *in) { + in->ws = NW; + in->dollar = FALSE; + if (in->bufsize > BUFMAX) { /* return memory to the system if the buffer got too large */ + efree(in->tokenbuf); + in->tokenbuf = NULL; } - if (tokenbuf == NULL) { - bufsize = BUFSIZE; - tokenbuf = ealloc(bufsize); + if (in->tokenbuf == NULL) { + in->bufsize = BUFSIZE; + in->tokenbuf = ealloc(in->bufsize); } } From 963a6dbca58b6442c9b95aee86b733ec10285d80 Mon Sep 17 00:00:00 2001 From: Jack Conger Date: Sun, 18 May 2025 19:13:48 -0700 Subject: [PATCH 21/34] Rough draft - make per-Input pspaces This doesn't work with GCPROTECT, so that's a TODO. It's also somewhat messy. --- es.h | 3 +++ gc.c | 20 ++++++++++++++------ input.c | 13 ++++++++++--- input.h | 1 + test/tests/parse.es | 2 +- 5 files changed, 29 insertions(+), 10 deletions(-) diff --git a/es.h b/es.h index 8c43d227..547356df 100644 --- a/es.h +++ b/es.h @@ -414,6 +414,9 @@ extern void gcdisable(void); /* disable collections */ extern Boolean gcisblocked(void); /* is collection disabled? */ /* operations with pspace, the explicitly-collected gc space for parse tree building */ +extern void *createpspace(void); +extern void *setpspace(void *); + extern void *palloc(size_t n, Tag *t); /* allocate n with collection tag t, but in pspace */ extern void *pseal(void *p); /* collect pspace into gcspace with root p */ extern char *pdup(const char *s); /* copy a 0-terminated string into pspace */ diff --git a/gc.c b/gc.c index 69858813..5fd40b91 100644 --- a/gc.c +++ b/gc.c @@ -22,8 +22,7 @@ struct Space { #define MIN_minpspace 1000 #if GCPROTECT -#define NSPACES 12 -#define FIRSTSPACE 1 +#define NSPACES 10 #endif #if HAVE_SYSCONF @@ -43,6 +42,7 @@ Tag StringTag; static Space *new, *old, *pspace; #if GCPROTECT static Space *spaces; +/* FIXME: static Space *pspaces; */ #endif static Root *globalrootlist, *exceptionrootlist; static size_t minspace = MIN_minspace; /* minimum number of bytes in a new space */ @@ -418,7 +418,7 @@ extern void gc(void) { for (; new->next != NULL; new = new->next) ; if (++new >= &spaces[NSPACES]) - new = &spaces[FIRSTSPACE]; + new = &spaces[0]; new = mkspace(new, NULL, minspace); #else new = newspace(NULL); @@ -542,15 +542,23 @@ extern void initgc(void) { initmmu(); spaces = ealloc(NSPACES * sizeof (Space)); memzero(spaces, NSPACES * sizeof (Space)); - new = mkspace(&spaces[FIRSTSPACE], NULL, minspace); - pspace = mkspace(&spaces[0], NULL, minpspace); + new = mkspace(&spaces[0], NULL, minspace); #else new = newspace(NULL); - pspace = newpspace(NULL); #endif old = NULL; } +extern void *createpspace(void) { + return (void *)newpspace(NULL); +} + +extern void *setpspace(void *new) { + void *old = (void *)pspace; + pspace = (Space *)new; + return old; +} + /* * allocation diff --git a/input.c b/input.c index 17362612..311180e5 100644 --- a/input.c +++ b/input.c @@ -218,18 +218,20 @@ static int cmdfill(Input *in) { /* parse -- call yyparse() and catch errors */ extern Tree *parse(List *fc) { int result; + void *oldpspace; /* TODO: change this error message */ if (input->parsing) fail("$&parse", "cannot perform nested parsing"); assert(input->error == NULL); - fillcmd = fc; - input->parsing = TRUE; - if (ISEOF(input)) throw(mklist(mkstr("eof"), NULL)); + fillcmd = fc; + input->parsing = TRUE; + oldpspace = setpspace(input->pspace); + inityy(input); emptyherequeue(); @@ -242,10 +244,12 @@ extern Tree *parse(List *fc) { input->parsing = FALSE; fillcmd = NULL; pseal(NULL); + setpspace(oldpspace); throw(e); EndExceptionHandler + setpspace(oldpspace); input->parsing = FALSE; fillcmd = NULL; @@ -353,6 +357,7 @@ extern List *runfd(int fd, const char *name, int flags) { in.bufbegin = in.buf = ealloc(in.buflen); in.bufend = in.bufbegin; in.name = (name == NULL) ? str("fd %d", fd) : name; + in.pspace = createpspace(); RefAdd(in.name); result = runinput(&in, flags); @@ -391,6 +396,7 @@ extern List *runstring(const char *str, const char *name, int flags) { in.bufbegin = in.buf = buf; in.bufend = in.buf + in.buflen; in.cleanup = stringcleanup; + in.pspace = createpspace(); /* TODO: use special string-input pspace? */ RefAdd(in.name); result = runinput(&in, flags); @@ -443,6 +449,7 @@ extern Tree *parsestring(const char *str) { in.bufbegin = in.buf = buf; in.bufend = in.buf + in.buflen; in.cleanup = stringcleanup; + in.pspace = createpspace(); /* TODO: use special string-input pspace? */ RefAdd(in.name); result = parseinput(&in); diff --git a/input.h b/input.h index c3cae1fe..e96effb0 100644 --- a/input.h +++ b/input.h @@ -22,6 +22,7 @@ struct Input { Boolean ignoreeof; /* parsing state */ + void *pspace; Boolean parsing; Tree *parsetree; const char *error; diff --git a/test/tests/parse.es b/test/tests/parse.es index a35b6497..8f612a98 100644 --- a/test/tests/parse.es +++ b/test/tests/parse.es @@ -52,7 +52,7 @@ test 'parser' { assert {~ $e error && ~ $msg *'nested parsing'*} } - # bogus 'nested parsing' exception. TODO: fix this + # test parsing from string while parsing from input let (e = ()) { catch @ exc { e = $exc From aa4b3d225a0b914793439427c7dfd0f298a54e98 Mon Sep 17 00:00:00 2001 From: Jack Conger Date: Mon, 19 May 2025 08:15:00 -0700 Subject: [PATCH 22/34] Fix configure.ac bug --- configure.ac | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/configure.ac b/configure.ac index c9da7a93..664e015b 100644 --- a/configure.ac +++ b/configure.ac @@ -71,7 +71,7 @@ dnl Checks for library functions. AC_TYPE_GETGROUPS AC_FUNC_MMAP -AC_CHECK_FUNCS(strerror strtol lseek lstat setrlimit sigrelse sighold +AC_CHECK_FUNCS(strerror strtol lseek lstat setrlimit sigrelse sighold \ sigaction sysconf sigsetjmp getrusage mmap mprotect) AC_CACHE_CHECK(whether getenv can be redefined, es_cv_local_getenv, From 2c74768da41f2ceb84167972291a69a245a217b0 Mon Sep 17 00:00:00 2001 From: Jack Conger Date: Mon, 19 May 2025 10:12:57 -0700 Subject: [PATCH 23/34] Fix per-input pspace. Still doesn't work with GCPROTECT. --- input.c | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/input.c b/input.c index 311180e5..1d0c5207 100644 --- a/input.c +++ b/input.c @@ -244,12 +244,11 @@ extern Tree *parse(List *fc) { input->parsing = FALSE; fillcmd = NULL; pseal(NULL); - setpspace(oldpspace); + input->pspace = setpspace(oldpspace); throw(e); EndExceptionHandler - setpspace(oldpspace); input->parsing = FALSE; fillcmd = NULL; @@ -258,12 +257,13 @@ extern Tree *parse(List *fc) { assert(e != NULL); input->error = NULL; pseal(NULL); + input->pspace = setpspace(oldpspace); fail("$&parse", "%s", e); } Ref(Tree *, pt, pseal(input->parsetree)); + input->pspace = setpspace(oldpspace); #if LISPTREES - Ref(Tree *, pt, pseal(input->parsetree)); if (input->runflags & run_lisptrees) eprint("%B\n", pt); #endif From f8a735f24f6b417f18556090e086aa2baffeb894 Mon Sep 17 00:00:00 2001 From: Jack Conger Date: Tue, 20 May 2025 07:27:44 -0700 Subject: [PATCH 24/34] Make fillcmd work with multiple Inputs. It's not "per-Input", but it's largely equivalent, and I don't want to make Input a GC'd object just for a single field. --- initial.es | 6 +++++- input.c | 11 ++++++++++- 2 files changed, 15 insertions(+), 2 deletions(-) diff --git a/initial.es b/initial.es index be398a55..248b3b11 100644 --- a/initial.es +++ b/initial.es @@ -651,11 +651,15 @@ if {~ <=$&primitives writehistory} { fn-%batch-loop = $&batchloop fn-%is-interactive = $&isinteractive +# NOTE: $&readline might not actually exist. we just assume it does for this +# proof-of-concept. +fn-%readline = $&readline + fn %parse { if %is-interactive { let (in = (); p = $*(1)) let (code = <={$&parse { - let (r = <={$&readline $p}) { + let (r = <={%readline $p}) { in = $in $r p = $*(2) result $r diff --git a/input.c b/input.c index 1d0c5207..bb89f3c7 100644 --- a/input.c +++ b/input.c @@ -219,12 +219,20 @@ static int cmdfill(Input *in) { extern Tree *parse(List *fc) { int result; void *oldpspace; + Ref(List *, oldfillcmd, fillcmd); /* TODO: change this error message */ if (input->parsing) fail("$&parse", "cannot perform nested parsing"); assert(input->error == NULL); + + /* TODO: update this check -- + * + * $ es -c '<={$&parse {result echo hello world}}' + * + * should work. also, ignoreeof + */ if (ISEOF(input)) throw(mklist(mkstr("eof"), NULL)); @@ -250,7 +258,8 @@ extern Tree *parse(List *fc) { EndExceptionHandler input->parsing = FALSE; - fillcmd = NULL; + fillcmd = oldfillcmd; + RefEnd(oldfillcmd); if (result || input->error != NULL) { const char *e = input->error; From 147af90110eedc13fe7f89c5ce6eb7b4780c8fac Mon Sep 17 00:00:00 2001 From: Jack Conger Date: Tue, 20 May 2025 07:55:02 -0700 Subject: [PATCH 25/34] Un-break GCPROTECT with per-Input pspaces. The interaction between pspaces and GCPROTECT is still weak after this commit, which may be a to-do to fix, but it isn't actively broken anymore. --- gc.c | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/gc.c b/gc.c index 5fd40b91..76f1da24 100644 --- a/gc.c +++ b/gc.c @@ -42,7 +42,6 @@ Tag StringTag; static Space *new, *old, *pspace; #if GCPROTECT static Space *spaces; -/* FIXME: static Space *pspaces; */ #endif static Root *globalrootlist, *exceptionrootlist; static size_t minspace = MIN_minspace; /* minimum number of bytes in a new space */ @@ -207,7 +206,7 @@ static void deprecate(Space *space) { assert(space != NULL); for (base = space; base->next != NULL; base = base->next) ; - assert(&spaces[0] <= base && base < &spaces[NSPACES]); + assert(space == pspace || (&spaces[0] <= base && base < &spaces[NSPACES])); for (;;) { invalidate(space->bot, SPACESIZE(space)); if (space == base) @@ -527,7 +526,9 @@ extern void *pseal(void *p) { #endif deprecate(pspace); #if GCPROTECT - pspace = mkspace(base, NULL, minpspace); + /* TODO: integrate pspace with GCPROTECT better? */ + /* pspace = mkspace(base, NULL, minpspace); */ + pspace = newpspace(NULL); #else pspace = newpspace(NULL); #endif From adf1d0839630f699e564e866ed0e3983fdb0644b Mon Sep 17 00:00:00 2001 From: Jack Conger Date: Fri, 30 May 2025 09:30:46 -0700 Subject: [PATCH 26/34] Move readline completion to demo completion.es file. --- completion.es | 180 ++++++++++++++++++++++++++++++++++++++++++++++++++ es.h | 2 - prim.c | 14 ---- readline.c | 70 +++++--------------- var.c | 16 ----- 5 files changed, 198 insertions(+), 84 deletions(-) create mode 100644 completion.es diff --git a/completion.es b/completion.es new file mode 100644 index 00000000..c571073b --- /dev/null +++ b/completion.es @@ -0,0 +1,180 @@ +#!/usr/local/bin/es + +# Demo of programmable completion in es. +# +# This isn't an endorsement of any particular design for programmable completion, +# and this "design" was largely tossed together for expediency. That said, it's +# impressive how much can be done with so little assistance from the runtime. +# +# It would be very nice if the es-level design for programmable completion could be +# agnostic to the exact line-editing library being used. +# +# Some top-level problems with this totally-naive setup: +# - doesn't handle multi-command lines, or multi-line commands, very well at all +# - doesn't colorize results +# - presents directories ugly +# - doesn't know when not to add a space at the end like for blah/ or --blah= +# - can't handle complicated variable terms like $(a b) or $'a b' + + +# Base/dispatcher completion function. + +# - 'prefix' is a single word which contains the contents of the line before the +# current word. +# - 'word' is the current word under completion. +fn %complete prefix word { + if {~ $word '$&'*} { + # primitive completion + result $word^<={~~ '$&'^<=$&primitives $word^*} + } {~ $word '$'*} { + # variable completion + result $word^<={~~ '$'^(<=$&vars <=$&internals) $word^*} + } { + let (line = <={%split ' '\t $prefix}) { + if {~ $line () || + ~ $^line *'<=' || + ~ $^line *'{' || + ~ $^line *'|' || + ~ $^line *'|['*']' + } { + # command-position completion + %whatis-complete $word + } { + # non-command-position completion + # wouldn't be crazy to add a completion-path var for these + if {!~ $#(fn-%complete-^$line(1)) 0} { + %complete-^$line(1) $word + } { + %file-complete $word + } + } + } + } +} + + +# Specialized completion logic, but not per-command + +# Completions for general commands. Calls %pathsearch-complete. +fn %whatis-complete word { + if {~ $word (/* ./* ../)} { + # this should filter to executable files only. + %file-complete $word + } { + result $word^<={~~ ( + local let for fn %closure match + <={~~ (<=$&vars <=$&internals) 'fn-'^*} + ) $word^*} <={%pathsearch-complete $word} + } +} + +# Completions for path-searched binaries. +# In theory when overloading %pathsearch for things like autoloading, +# this function should probably be extended as well. +fn %pathsearch-complete word { + let (files = ()) { + for (d = $path) + let (fw = $d/$word) + for (b = $d/*) + if {access -x $b} { + files = $files $word^<={~~ $b $fw^*} + } + result $files + } +} + +# This should handle paths that start with ~ +fn %file-complete word { + let (files = ()) { + for (f = $word^*) { + if {access -d $f} { + files = $files $f/ + } {access $f} { + files = $files $f + } + } + result $files + } +} + + +# Per-command completion. This part is still pretty weak. In particular, +# earlier arguments should be provided. + +# This should only return pages in a certain section if one has been provided in +# a prior argument. +fn %complete-man word { + if {~ $#MANPATH 0} { + MANPATH = `manpath + } + let (manpath = <={%fsplit : $MANPATH}) { + let (result = ()) { + for (mandir = <={%fsplit : $MANPATH}) + for ((sect nm ext) = <={~~ $mandir/man*/$word^* $mandir/man*/*.*}) + result = $result $nm + result $result + } + } +} + +# sudo SHOULD be a "pass-through" completion; just cut itself out of the prefix +# and call %complete recursively. +fn-%complete-sudo = %file-complete + +# This is just a demo of argument completion. Not pretty or exciting, especially +# given long opts for ls are rarely ever used? +fn %complete-ls word { + if {~ $word -*} { + result $word^<={~~ ( + --all + --almost-all + --author + --block-size= + --classify + --color + --color= + --context + --dereference + --dereference-command-line + --dereference-command-line-symlink-to-dir + --directory + --dired + --escape + --file-type + --format= + --full-time + --group-directories-first + --help + --hide + --hide-control-chars + --human-readable + --hyperlink + --ignore= + --ignore-backups + --indicator-style= + --inode + --kibibytes + --literal + --no-group + --numeric-uid-gid + --quote-name + --quoting-style= + --recursive + --reverse + --show-control-chars + --si + --size + --sort + --sort= + --tabsize= + --time + --time= + --time-style= + --version + --width= + --zero + ) $word^*} + } { + %file-complete $word + } +} diff --git a/es.h b/es.h index 547356df..514565f9 100644 --- a/es.h +++ b/es.h @@ -198,7 +198,6 @@ extern Vector *mkenv(void); extern void setnoexport(List *list); extern void addtolist(void *arg, char *key, void *value); extern List *listvars(Boolean internal); -extern List *varswithprefix(char *prefix); typedef struct Push Push; extern Push *pushlist; @@ -348,7 +347,6 @@ extern List *esoptend(void); extern List *prim(char *s, List *list, Binding *binding, int evalflags); extern void initprims(void); -extern List *primswithprefix(char *prefix); /* split.c */ diff --git a/prim.c b/prim.c index bb867b76..6062a45c 100644 --- a/prim.c +++ b/prim.c @@ -13,20 +13,6 @@ extern List *prim(char *s, List *list, Binding *binding, int evalflags) { return (p->prim)(list, binding, evalflags); } -static char *list_prefix; - -static void listwithprefix(void *arg, char *key, void *value) { - if (strneq(key, list_prefix, strlen(list_prefix))) - addtolist(arg, key, value); -} - -extern List *primswithprefix(char *prefix) { - Ref(List *, primlist, NULL); - list_prefix = prefix; - dictforall(prims, listwithprefix, &primlist); - RefReturn(primlist); -} - PRIM(primitives) { static List *primlist = NULL; if (primlist == NULL) { diff --git a/readline.c b/readline.c index 6ab52520..910e066e 100644 --- a/readline.c +++ b/readline.c @@ -112,21 +112,27 @@ static char *unquote(char *text, int quote_char) { return r; } -static char *complprefix; -static List *(*wordslistgen)(char *); +static List *cmdcomplete(char *prefix) { + List *fn = varlookup("fn-%complete", NULL); + if (fn == NULL) + return NULL; + Ref(char *, line, gcndup(rl_line_buffer, rl_point - strlen(prefix))); + gcdisable(); + fn = append(fn, mklist(mkstr(line), + mklist(mkstr(str("%s", prefix)), NULL))); + gcenable(); + RefEnd(line); + return eval(fn, NULL, 0); +} static char *list_completion_function(const char *text, int state) { static char **matches = NULL; static int matches_idx, matches_len; - int i, rlen; + int rlen; char *result; - const int pfx_len = strlen(complprefix); - if (!state) { - const char *name = &text[pfx_len]; - - Vector *vm = vectorize(wordslistgen((char *)name)); + Vector *vm = vectorize(cmdcomplete((char *)text)); matches = vm->vector; matches_len = vm->count; matches_idx = 0; @@ -136,56 +142,17 @@ static char *list_completion_function(const char *text, int state) { return NULL; rlen = strlen(matches[matches_idx]); - result = ealloc(rlen + pfx_len + 1); - for (i = 0; i < pfx_len; i++) - result[i] = complprefix[i]; - strcpy(&result[pfx_len], matches[matches_idx]); - result[rlen + pfx_len] = '\0'; + result = ealloc(rlen + 1); + strcpy(result, matches[matches_idx]); + result[rlen] = '\0'; matches_idx++; return result; } -char **builtin_completion(const char *text, int UNUSED start, int UNUSED end) { - char **matches = NULL; - - if (*text == '$') { - wordslistgen = varswithprefix; - complprefix = "$"; - switch (text[1]) { - case '&': - wordslistgen = primswithprefix; - complprefix = "$&"; - break; - case '^': complprefix = "$^"; break; - case '#': complprefix = "$#"; break; - } - matches = rl_completion_matches(text, list_completion_function); - } - - /* ~foo => username. ~foo/bar already gets completed as filename. */ - if (!matches && *text == '~' && !strchr(text, '/')) - matches = rl_completion_matches(text, rl_username_completion_function); - - return matches; -} - -static List *cmdcomplete(char *prefix) { - List *fn = varlookup("fn-%complete", NULL); - if (fn == NULL) - return NULL; - gcdisable(); - fn = append(fn, mklist(mkstr(str("%s", prefix)), NULL)); - gcenable(); - return eval(fn, NULL, 0); -} - char **es_completion(UNUSED const char *text, UNUSED int start, UNUSED int end) { char **matches; - complprefix = ""; - wordslistgen = cmdcomplete; - matches = rl_completion_matches(text, list_completion_function); rl_attempted_completion_over = 1; /* suppress "default" completions */ @@ -214,8 +181,7 @@ extern void rlsetup(void) { initialized = TRUE; } - rl_attempted_completion_function = builtin_completion; - /* rl_attempted_completion_function = es_completion; */ + rl_attempted_completion_function = es_completion; if (reloadhistory) reload_history(); diff --git a/var.c b/var.c index eecf36dc..b6189a24 100644 --- a/var.c +++ b/var.c @@ -350,13 +350,6 @@ static void listinternal(void *arg, char *key, void *value) { addtolist(arg, key, value); } -static char *list_prefix; - -static void listwithprefix(void *arg, char *key, void *value) { - if (strneq(key, list_prefix, strlen(list_prefix))) - addtolist(arg, key, value); -} - /* listvars -- return a list of all the (dynamic) variables */ extern List *listvars(Boolean internal) { Ref(List *, varlist, NULL); @@ -365,15 +358,6 @@ extern List *listvars(Boolean internal) { RefReturn(varlist); } -/* varswithprefix -- return a list of all the (dynamic) variables - * matching the given prefix */ -extern List *varswithprefix(char *prefix) { - Ref(List *, varlist, NULL); - list_prefix = prefix; - dictforall(vars, listwithprefix, &varlist); - RefReturn(varlist); -} - /* hide -- worker function for dictforall to hide initial state */ static void hide(void UNUSED *dummy, char UNUSED *key, void *value) { ((Var *) value)->flags |= var_isinternal; From e226270fd600040fc17a8e18b2fb8261e2b70b15 Mon Sep 17 00:00:00 2001 From: Jack Conger Date: Sat, 31 May 2025 19:53:58 -0700 Subject: [PATCH 27/34] Improve completion.es based completion. Now it is more-or-less a strict improvement on completion at HEAD. Also adds some ideas in completion.es on how to improve programmable completion from its current state. That said, the current state is surprisingly good. --- completion.es | 225 ++++++++++++++++++++++++++------------------------ initial.es | 15 +++- readline.c | 5 ++ 3 files changed, 133 insertions(+), 112 deletions(-) diff --git a/completion.es b/completion.es index c571073b..d3d139eb 100644 --- a/completion.es +++ b/completion.es @@ -1,20 +1,34 @@ -#!/usr/local/bin/es +# completion.es -- demo of programmable completion in es -# Demo of programmable completion in es. +# This isn't an endorsement of any particular design for programmable +# completion, and this "design" was largely tossed together for expediency. +# That said, it's impressive how much can be done with so little assistance +# from the runtime. # -# This isn't an endorsement of any particular design for programmable completion, -# and this "design" was largely tossed together for expediency. That said, it's -# impressive how much can be done with so little assistance from the runtime. -# -# It would be very nice if the es-level design for programmable completion could be -# agnostic to the exact line-editing library being used. -# -# Some top-level problems with this totally-naive setup: -# - doesn't handle multi-command lines, or multi-line commands, very well at all -# - doesn't colorize results -# - presents directories ugly -# - doesn't know when not to add a space at the end like for blah/ or --blah= -# - can't handle complicated variable terms like $(a b) or $'a b' +# Some thoughts about how completions should/shouldn't be exposed to users: +# - certain syntactic constructs (variables, primitives, assignments/ +# binders) are not extensible and should probably just be handled +# internally. this would also help make $(a b) and $'a b' work +# - certain syntactic constructs (e.g., redirections) ARE extensible and +# should ideally be done via completions on their corresponding hook +# functions -- e.g., `cmd > [TAB]` should use `%complete-%create` (same +# for, like, `$#a[TAB]`? I guess variable completion should be exposed, +# if just so it can be called by other completion functions) +# - some parsing should be done internally before calling %complete. for +# example: +# - dequoting + requoting +# - presenting the current command rather than the current line (e.g., +# `a; b[TAB]` would only be called with `b`, but a multi-line command +# would get the whole command) +# - IDEALLY, `a; b[TAB]` would use `%complete-%seq`... but how to do +# that? +# - syntax-aware splitting (e.g., `a {b c d} [TAB]` should call %complete +# with ('a' '{b c d}') arguments) +# - maybe removing redirections? e.g., `cmd < input arg [TAB]` should +# call %complete with just `cmd arg`? +# - how do we expose certain completion functions so they can have custom +# (named) key bindings? +# - the `completions-are-filenames` variable is not the best way... right? # Base/dispatcher completion function. @@ -23,6 +37,10 @@ # current word. # - 'word' is the current word under completion. fn %complete prefix word { + # I don't love this variable as a way to do this. It functions to signal + # whether the results are file names (with the commensurate quoting rules) or + # some other kind of string. + completions-are-filenames = <=false if {~ $word '$&'*} { # primitive completion result $word^<={~~ '$&'^<=$&primitives $word^*} @@ -38,14 +56,14 @@ fn %complete prefix word { ~ $^line *'|['*']' } { # command-position completion - %whatis-complete $word + %complete-%whatis '' $word } { # non-command-position completion - # wouldn't be crazy to add a completion-path var for these + # in "real life" we'd load these from files I think if {!~ $#(fn-%complete-^$line(1)) 0} { - %complete-^$line(1) $word + %complete-^$line(1) $prefix $word } { - %file-complete $word + %file-complete {} $word } } } @@ -53,20 +71,7 @@ fn %complete prefix word { } -# Specialized completion logic, but not per-command - -# Completions for general commands. Calls %pathsearch-complete. -fn %whatis-complete word { - if {~ $word (/* ./* ../)} { - # this should filter to executable files only. - %file-complete $word - } { - result $word^<={~~ ( - local let for fn %closure match - <={~~ (<=$&vars <=$&internals) 'fn-'^*} - ) $word^*} <={%pathsearch-complete $word} - } -} +# Specific completion logic, but not per-command # Completions for path-searched binaries. # In theory when overloading %pathsearch for things like autoloading, @@ -76,105 +81,109 @@ fn %pathsearch-complete word { for (d = $path) let (fw = $d/$word) for (b = $d/*) - if {access -x $b} { + if {access -xf -- $b} { + files = $files $word^<={~~ $b $fw^*} + } {access -xd -- $b} { files = $files $word^<={~~ $b $fw^*} } result $files } } -# This should handle paths that start with ~ -fn %file-complete word { - let (files = ()) { - for (f = $word^*) { - if {access -d $f} { - files = $files $f/ - } {access $f} { - files = $files $f +# This 'filter' argument is not super pretty +fn %file-complete filter word { + completions-are-filenames = <=true + let (files = (); homepat = ()) { + if {!~ <={homepat = <={~~ $word '~'*'/'*}} ()} { + let (homedir = (); path = $homepat(2)) { + if {~ $homepat(1) ''} { + homedir = <=%home + } { + homedir = <={%home $homepat(1)} + } + result '~'^$homepat(1)^'/'^<={~~ <={%file-complete $filter $homedir/$path} $homedir/*} + } + } {!~ <={homepat = <={~~ $word '~'*}} ()} { + result '~'^<={%complete-%home '' $homepat} + } { + for (f = $word^*) { + if {$filter $f} { + if {access -d -- $f} { + files = $files $f + } {access -- $f} { + files = $files $f + } + } } + result $files } - result $files } } -# Per-command completion. This part is still pretty weak. In particular, -# earlier arguments should be provided. +# Per-command completions. This part is still relatively weak. -# This should only return pages in a certain section if one has been provided in -# a prior argument. -fn %complete-man word { - if {~ $#MANPATH 0} { - MANPATH = `manpath - } - let (manpath = <={%fsplit : $MANPATH}) { - let (result = ()) { - for (mandir = <={%fsplit : $MANPATH}) - for ((sect nm ext) = <={~~ $mandir/man*/$word^* $mandir/man*/*.*}) - result = $result $nm - result $result - } +# %whatis completion, also used for generic command-position completion +fn %complete-%whatis prefix word { + if {~ $word (/* ./* ../* '~'*)} { + %file-complete @ {access -x -- $*} $word + } { + result $word^<={~~ ( + local let for fn %closure match + <={~~ (<=$&vars <=$&internals) 'fn-'^*} + ) $word^*} <={%pathsearch-complete $word} } } -# sudo SHOULD be a "pass-through" completion; just cut itself out of the prefix -# and call %complete recursively. -fn-%complete-sudo = %file-complete +fn-%complete-whatis = %complete-%whatis + +# this is for the basic cd; things like cdpath should update it +fn %complete-cd prefix word { + %file-complete @ {access -d -- $*} $word +} + +# this is for %home and also used for file completion for '~*' files +fn %complete-%home prefix word { + result $word^<={~~ `` \n {awk -F: '{print $1}' /etc/passwd} $word^*} +} -# This is just a demo of argument completion. Not pretty or exciting, especially -# given long opts for ls are rarely ever used? -fn %complete-ls word { +# incomplete ls completion to see how --option= completion works. currently: poorly! +fn %complete-ls prefix word { if {~ $word -*} { result $word^<={~~ ( --all - --almost-all --author --block-size= - --classify - --color --color= - --context - --dereference - --dereference-command-line - --dereference-command-line-symlink-to-dir - --directory - --dired - --escape - --file-type - --format= - --full-time - --group-directories-first - --help - --hide - --hide-control-chars - --human-readable - --hyperlink - --ignore= - --ignore-backups - --indicator-style= - --inode - --kibibytes - --literal - --no-group - --numeric-uid-gid - --quote-name - --quoting-style= - --recursive - --reverse - --show-control-chars - --si - --size - --sort - --sort= - --tabsize= - --time - --time= - --time-style= - --version - --width= - --zero ) $word^*} } { - %file-complete $word + %file-complete {} $word } } + +# total support for `man` arguments is surprisingly complicated. This covers +# `man blah` and `man 1 blah` at least. +fn %complete-man prefix word { + let (sections = 1 1p n l 8 3 3p 0 0p 2 3type 5 4 9 6 7) { + if {~ $#MANPATH 0} { + MANPATH = `manpath + } + for (a = <={%split ' '\t $prefix}) if {~ $a $sections} { + sections = $a + break + } + let (result = (); manpath = <={%fsplit : $MANPATH}) { + # This `for` just kills performance on `man [TAB]` :/ + for ((nm ext) = <={~~ $manpath/man$sections/$word^* $manpath/man$sections/*.*}) + result = $result $nm + result $result + } + } +} + +# sudo -- use a "pass-through" completion. +# something similar can be used for nohup, nice, setsid, etc. +fn %complete-sudo prefix word { + let (prefix = <={~~ $prefix 'sudo'*}) + %complete $prefix $word +} diff --git a/initial.es b/initial.es index 248b3b11..692dd698 100644 --- a/initial.es +++ b/initial.es @@ -651,15 +651,22 @@ if {~ <=$&primitives writehistory} { fn-%batch-loop = $&batchloop fn-%is-interactive = $&isinteractive -# NOTE: $&readline might not actually exist. we just assume it does for this -# proof-of-concept. -fn-%readline = $&readline +if {~ <=$&primitives readline} { + fn-%read-line = $&readline + # add completion logic + . completion.es +} { + fn %read-line prompt { + echo -n $prompt + %read + } +} fn %parse { if %is-interactive { let (in = (); p = $*(1)) let (code = <={$&parse { - let (r = <={%readline $p}) { + let (r = <={%read-line $p}) { in = $in $r p = $*(2) result $r diff --git a/readline.c b/readline.c index 910e066e..ce5dc211 100644 --- a/readline.c +++ b/readline.c @@ -125,6 +125,7 @@ static List *cmdcomplete(char *prefix) { return eval(fn, NULL, 0); } +/* TODO: rename this */ static char *list_completion_function(const char *text, int state) { static char **matches = NULL; static int matches_idx, matches_len; @@ -155,7 +156,11 @@ char **es_completion(UNUSED const char *text, UNUSED int start, UNUSED int end) matches = rl_completion_matches(text, list_completion_function); + /* TODO: present ../[TAB] => (../a ../b ../c) as (a b c) */ rl_attempted_completion_over = 1; /* suppress "default" completions */ + + /* ugly hack ... whether to treat 'em as filenames */ + rl_filename_completion_desired = istrue(varlookup("completions-are-filenames", NULL)); return matches; } From 3f1c2a51fbce3b5acf286267df70e162c08733b2 Mon Sep 17 00:00:00 2001 From: Jack Conger Date: Mon, 2 Jun 2025 11:03:31 -0700 Subject: [PATCH 28/34] Even more thorough tab-completion logic. I should probably stop adding more at this point, given there's quite a bit I've already learned (see the comments of completion.es) on how the "API" for completion should be improved, and making those changes will basically require rewriting all of this. --- completion.es | 423 +++++++++++++++++++++++++++++++++++++++----------- readline.c | 10 +- 2 files changed, 340 insertions(+), 93 deletions(-) diff --git a/completion.es b/completion.es index d3d139eb..61af060b 100644 --- a/completion.es +++ b/completion.es @@ -1,67 +1,101 @@ # completion.es -- demo of programmable completion in es -# This isn't an endorsement of any particular design for programmable -# completion, and this "design" was largely tossed together for expediency. -# That said, it's impressive how much can be done with so little assistance -# from the runtime. -# -# Some thoughts about how completions should/shouldn't be exposed to users: -# - certain syntactic constructs (variables, primitives, assignments/ -# binders) are not extensible and should probably just be handled -# internally. this would also help make $(a b) and $'a b' work -# - certain syntactic constructs (e.g., redirections) ARE extensible and -# should ideally be done via completions on their corresponding hook -# functions -- e.g., `cmd > [TAB]` should use `%complete-%create` (same -# for, like, `$#a[TAB]`? I guess variable completion should be exposed, -# if just so it can be called by other completion functions) -# - some parsing should be done internally before calling %complete. for -# example: -# - dequoting + requoting -# - presenting the current command rather than the current line (e.g., -# `a; b[TAB]` would only be called with `b`, but a multi-line command -# would get the whole command) -# - IDEALLY, `a; b[TAB]` would use `%complete-%seq`... but how to do -# that? -# - syntax-aware splitting (e.g., `a {b c d} [TAB]` should call %complete -# with ('a' '{b c d}') arguments) -# - maybe removing redirections? e.g., `cmd < input arg [TAB]` should -# call %complete with just `cmd arg`? -# - how do we expose certain completion functions so they can have custom -# (named) key bindings? -# - the `completions-are-filenames` variable is not the best way... right? - - -# Base/dispatcher completion function. - -# - 'prefix' is a single word which contains the contents of the line before the -# current word. -# - 'word' is the current word under completion. +# This file exists to explore some options for programmable completion in +# es; it's not an endorsement of any particular design for completion. +# However, this setup seems to perform at least as well as the current +# "built-in" readline completion that es has, with surprisingly little +# direct support from the readline library. This corresponds well with +# how much es is built on top of es, and (hopefully) indicates that es +# could switch between different line-editing libraries while using a +# single common user-visible completion "API". +# +# Syntax isn't handled really robustly with this setup, and probably +# requires some kind of internal parsing machinery to do right; for +# example, we don't have great behavior with `$(var1 var2[TAB]`, or +# `command1; command2 [TAB]`. The same is true for binders like +# `let (f[TAB]` or `let (a = b) command[TAB]`. +# +# Some hook functions back syntax and ideally modifying the hook functions' +# completion functions (e.g., `%complete-%create`) would also modify how +# the syntax is completed (e.g., `command arg > fi[TAB]`). In theory, this +# could even extend to things like %complete-%seq and %complete-%pipe, +# though there's some trickiness in designing how that would actually be +# executed. +# +# We also want automatic de-quoting and re-quoting of terms, and splitting +# arguments in a syntax-aware way. +# +# Closer integration with readline is another open question. For example, +# it's common to have specific key bindings refer to specific types of +# completion. How do we implement that? Moreover, how do we do so in a +# way that works with .inputrc? +# +# This setup produces a fairly large amount of overhead in the es function +# namespace. We would likely want to reduce that overhead, especially since +# all of this has absolutely no value in the non-interactive case. Perhaps +# all of the per-command completions should come from autoloadable files and +# be marked noexport. I susepct that while it's quite nice to have good +# coverage for autocompletion, in practical use, only a few commands are +# actually auto-completed in any interactive session. + + +# +# Base/dispatcher completion function +# + +# %complete is called by $&readline whenever the user hits "tab". It is +# called with two arguments: 'prefix' contains the entire line (in string +# form) before the current word being completed, and 'word' is the current +# word. +# +# It uses some fairly simple heuristics to try to decide what kind of +# completion it is performing, and then dispatches to other completion +# functions. While the heuristics leave something to be desired, calling +# out to other functions (and allowing those other functions to recursively +# call %complete again) enables quite a bit of power, especially given +# how much of es' "internal" behavior is based on hook functions. + fn %complete prefix word { - # I don't love this variable as a way to do this. It functions to signal - # whether the results are file names (with the commensurate quoting rules) or - # some other kind of string. + # $completions-are-filenames signals to readline whether or not to + # interpret returned items as filenames. Readline uses this information + # to more informatively display options (e.g., executable files look + # different than symlinks, etc.) as well as to make it much easier to "walk + # the filesystem" with directory tab-completion. + + # TODO: Change this to some hookable function for readline to map a + # completion candidate to a file, so that things like path-searched + # binaries or cdpath-searched directories can be treated correctly. completions-are-filenames = <=false + if {~ $word '$&'*} { - # primitive completion + # Primitive completion. So far, no need to make a function of this. result $word^<={~~ '$&'^<=$&primitives $word^*} + } {~ $word '$#'*} { + result '$#'^<={%var-complete <={~~ $word '$#'*}} + } {~ $word '$^'*} { + result '$^'^<={%var-complete <={~~ $word '$^'*}} } {~ $word '$'*} { - # variable completion - result $word^<={~~ '$'^(<=$&vars <=$&internals) $word^*} + result '$'^<={%var-complete <={~~ $word '$'*}} } { let (line = <={%split ' '\t $prefix}) { + # Basic "start-of-command" detection. if {~ $line () || ~ $^line *'<=' || ~ $^line *'{' || ~ $^line *'|' || - ~ $^line *'|['*']' + ~ $^line *'`' || + ~ $^line *'|['*']' || + ~ $^line *'&' } { - # command-position completion - %complete-%whatis '' $word + # Command-position completion. + %whatis-complete $word } { - # non-command-position completion - # in "real life" we'd load these from files I think + # Non-command-position completion. + # TODO: Provide a way to define %complete-foo in an + # auto-loadable file! if {!~ $#(fn-%complete-^$line(1)) 0} { - %complete-^$line(1) $prefix $word + # Strip the first term from the line. + %complete-^$line(1) <={%flatten ' ' $line(2 ...)} $word } { %file-complete {} $word } @@ -71,26 +105,41 @@ fn %complete prefix word { } -# Specific completion logic, but not per-command +# +# Specific, not-per-command completion logic. +# -# Completions for path-searched binaries. -# In theory when overloading %pathsearch for things like autoloading, -# this function should probably be extended as well. -fn %pathsearch-complete word { - let (files = ()) { - for (d = $path) - let (fw = $d/$word) - for (b = $d/*) - if {access -xf -- $b} { - files = $files $word^<={~~ $b $fw^*} - } {access -xd -- $b} { - files = $files $word^<={~~ $b $fw^*} - } - result $files +# These functions (named according to the pattern %foo-complete) provide +# completion for specific internal behaviors in the shell. They're pulled +# out of %complete largely so that they can be called by per-command +# completions. + +# Completion of variable names. + +fn %var-complete word { + result $word^<={~~ (<=$&vars <=$&internals) $word^*} +} + +# Generic command-position completion. +# This calls out to %complete-%pathsearch, which is what should be +# overridden when %pathsearch is overridden. + +fn %whatis-complete word { + if {~ $word (/* ./* ../* '~'*)} { + %file-complete @ {access -x -- $*} $word + } { + result $word^<={~~ ( + local let for fn %closure match + <={~~ (<=$&vars <=$&internals) 'fn-'^*} + ) $word^*} <={%complete-%pathsearch '' $word} } } -# This 'filter' argument is not super pretty +# %file-complete calls out to %complete-%home to perform tilde completion, +# and to %home to perform tilde expansion for subdirectories. +# The `filter` argument allows callers to only get specific files, like +# directories or executable files. + fn %file-complete filter word { completions-are-filenames = <=true let (files = (); homepat = ()) { @@ -120,35 +169,235 @@ fn %file-complete filter word { } } +fn %pid-complete word { + result $word^<={~~ <=%apids $word^*} +} -# Per-command completions. This part is still relatively weak. +# TODO: %fd-complete? %ifs-complete? -# %whatis completion, also used for generic command-position completion -fn %complete-%whatis prefix word { - if {~ $word (/* ./* ../* '~'*)} { - %file-complete @ {access -x -- $*} $word + +# +# Per-command completions +# + +# We supply several of our own completion functions for shell built-ins +# and to demonstrate how the "API" works. +# +# fn %complete-[command] prefix word { +# return (completion candidates) +# } +# +# This "API" is rather weak. Ideally, these functions would probably +# receive pre-split argument lines (e.g., `cat foo bar ba[TAB]` would call +# something like `%complete-cat foo bar ba`, perhaps actually with a +# numeric index argument so that the entire line can be given to a +# function where completion is happening in the middle. Maybe this? +# +# fn %complete-[command] index command {...} +# +# A challenge is what to do for cases like %seq {blah[TAB]} {blah blah}. +# The less-fancy but much-more-straightforward option is to just do the +# `blah[TAB]` completion by itself. +# +# In addition, we may consider filtering things like redirections out from +# the arguments before passing them to these functions, though in some cases +# like input substitution, we'd want to keep the argument in some form. + + +# Built-ins + +# In "hook-ish function" cases like %var where the user-level command uses +# common code with internal shell logic but the shell doesn't actually call +# these functions, we have %complete-%var and internal completion logic refer +# to a common "internal" %var-complete function. This is also used for +# %whatis. + +fn %complete-%var _ word { + %var-complete $word +} + +fn %complete-%whatis _ word { + %whatis-complete $word +} + +# In cases like %pathsearch and %home where the shell actually calls a hook +# function to get something done, internal completion functions also directly +# refer to %complete-%pathsearch and %complete-%home. + +fn %complete-%pathsearch _ word { + let (files = ()) { + let (wordpat = $path/$word) + for (bin = $path/*) + if {access -x -- $bin} { + files = $files $word^<={~~ $bin $wordpat^*} + } + result $files + } +} + +fn %complete-%home _ word { + result $word^<={~~ `` \n {awk -F: '{print $1}' /etc/passwd} $word^*} +} + +# These functions which use 'cmd' are good demos of why the 'prefix' arg +# just isn't quite enough. + +fn %complete-%run prefix word { + let (cmd = <={%split ' '\t $prefix}) + if {~ $#cmd 0} { + let (result = ()) { + # enforce an absolute path + for (r = <={%file-complete @ {access -x $*} $word}) { + if {~ $r /* ./* ../*} { + result = $result $r + } { + result = $result ./$r + } + } + result $result + } + } {~ $#cmd 1} { + # assume basename of the first term + let (ps = <={%split '/' $cmd(1)}) result $ps($#ps) } { - result $word^<={~~ ( - local let for fn %closure match - <={~~ (<=$&vars <=$&internals) 'fn-'^*} - ) $word^*} <={%pathsearch-complete $word} + # try to pass through to completion on second term + %complete <={%flatten ' ' $cmd(2 ...)} $word + } +} + +fn %complete-%openfile prefix word { + let (cmd = <={%split ' '\t $prefix}) { + if {~ $#cmd 0} { + # mode + result $word^<={~~ (r w a r+ w+ a+) $word^*} + } {~ $#cmd 1} { + # fd + if {~ $cmd(1) r*} { + result 0 + } { + result 1 + } + } {~ $#cmd 2} { + # file + %file-complete {} $word + } { + # cmd: pass-through completion + %complete <={%flatten ' ' $cmd(4 ...)} $word + } } } -fn-%complete-whatis = %complete-%whatis +fn %complete-%open p w {%complete-%openfile 'r ' ^$p $w} +fn %complete-%create p w {%complete-%openfile 'w ' ^$p $w} +fn %complete-%append p w {%complete-%openfile 'a ' ^$p $w} +fn %complete-%open-write p w {%complete-%openfile 'r+ '^$p $w} +fn %complete-%open-create p w {%complete-%openfile 'w+ '^$p $w} +fn %complete-%open-append p w {%complete-%openfile 'a+ '^$p $w} + +# Note that `cd' is consistently the most overloaded function es has; +# This function performs the basic completion, but doesn't know about +# things like cdpath, dir stacks, or anything else folks have done to +# cd in their setups. -# this is for the basic cd; things like cdpath should update it -fn %complete-cd prefix word { +fn %complete-cd _ word { %file-complete @ {access -d -- $*} $word } -# this is for %home and also used for file completion for '~*' files -fn %complete-%home prefix word { - result $word^<={~~ `` \n {awk -F: '{print $1}' /etc/passwd} $word^*} +fn %complete-wait _ word { + %pid-complete $word } -# incomplete ls completion to see how --option= completion works. currently: poorly! -fn %complete-ls prefix word { +fn %complete-throw prefix word { + let (cmd = <={%split ' '\t $prefix}) { + if {~ $#cmd 0} { + return $word^<={~~ (break eof error retry return signal) $word^*} + } + match $cmd(1) ( + (break eof retry return) {result ()} # no good guesses :/ + error { + if {~ $#cmd 1} { + %whatis-complete $word + } { + result () + } + } + signal { + # The shell should be able to give us this list... + result $word^<={~~ ( + sigabrt + sigalrm + sigbus + sigchld + sigcont + sigfpe + sighup + sigill + sigint + sigkill + sigpipe + sigpoll + sigprof + sigquit + sigsegv + sigstop + sigtstp + sigsys + sigterm + sigtrap + sigttin + sigttou + sigurg + sigusr1 + sigusr2 + sigvtalrm + sigxcpu + sigxfsz + sigwinch + ) $word^*} + } + * {result ()} # Not sure :/ + ) + } +} + +# Functions which just wrap %functions. + +fn-%complete-var = %complete-%var +fn-%complete-whatis = %complete-%whatis + +# "Pass-through" completions for functions which take commands as arguments. + +fn-%complete-eval = %complete +fn-%complete-exec = %complete +fn-%complete-time = %complete +fn-%complete-%not = %complete +fn-%complete-%background = %complete + +# "Null" completions for commands which simply take no arguments. + +fn-%complete-true = {result} +fn-%complete-false = {result} +fn-%complete-newpgrp = {result} +fn-%complete-%read = {result} +fn-%complete-%is-interactive = {result} + +# Technically, all of the arguments to these are command words. + +fn %complete-if _ word {%whatis-complete $word} +fn %complete-unwind-protect _ word {%whatis-complete $word} +fn %complete-while _ word {%whatis-complete $word} +fn %complete-%and _ word {%whatis-complete $word} +fn %complete-%or _ word {%whatis-complete $word} + + +# "Demo" completions of external binaries + +# Incomplete ls completion to see how --option= completion works. +# Not great so far! +# TODO: enable --opt[TAB] to complete to '--option=', not '--option= '. +# TODO: some kind of fanciness to enable good short-option support? + +fn %complete-ls _ word { if {~ $word -*} { result $word^<={~~ ( --all @@ -161,8 +410,9 @@ fn %complete-ls prefix word { } } -# total support for `man` arguments is surprisingly complicated. This covers -# `man blah` and `man 1 blah` at least. +# Total support for `man` arguments is surprisingly complicated. +# This covers `man blah` and `man 1 blah` at least. + fn %complete-man prefix word { let (sections = 1 1p n l 8 3 3p 0 0p 2 3type 5 4 9 6 7) { if {~ $#MANPATH 0} { @@ -180,10 +430,3 @@ fn %complete-man prefix word { } } } - -# sudo -- use a "pass-through" completion. -# something similar can be used for nohup, nice, setsid, etc. -fn %complete-sudo prefix word { - let (prefix = <={~~ $prefix 'sudo'*}) - %complete $prefix $word -} diff --git a/readline.c b/readline.c index ce5dc211..f7dce5de 100644 --- a/readline.c +++ b/readline.c @@ -153,14 +153,18 @@ static char *list_completion_function(const char *text, int state) { char **es_completion(UNUSED const char *text, UNUSED int start, UNUSED int end) { char **matches; + Push caf; + varpush(&caf, "completions-are-filenames", NULL); matches = rl_completion_matches(text, list_completion_function); - /* TODO: present ../[TAB] => (../a ../b ../c) as (a b c) */ - rl_attempted_completion_over = 1; /* suppress "default" completions */ - + /* mechanisms to control how the results are presented */ + /* TODO: use rl_filename_stat_hook for command completion */ /* ugly hack ... whether to treat 'em as filenames */ rl_filename_completion_desired = istrue(varlookup("completions-are-filenames", NULL)); + rl_attempted_completion_over = 1; /* suppress "default" completions */ + + varpop(&caf); return matches; } From 6e21a840bef5894cdc67e53b41852eed0470e582 Mon Sep 17 00:00:00 2001 From: Jack Conger Date: Wed, 4 Jun 2025 09:53:18 -0700 Subject: [PATCH 29/34] More-robust scanning for beginning of command. This is adding a lot of complexity for diminishing returns (the corner cases are shrinking, but getting more and more numerous). It would be swell to get a real incremental parser in place, though that's a whole other barrel of complexity. --- readline.c | 241 ++++++++++++++++++++++++++++++++++++++++++++--------- 1 file changed, 201 insertions(+), 40 deletions(-) diff --git a/readline.c b/readline.c index f7dce5de..ea9be471 100644 --- a/readline.c +++ b/readline.c @@ -21,8 +21,9 @@ static int history_write_timestamps = 1; static char history_comment_char = '#'; #endif + /* - * history management + * history */ extern void setmaxhistorylength(int len) { @@ -72,6 +73,7 @@ extern void sethistory(char *file) { history = file; } + /* * readey liney */ @@ -98,8 +100,8 @@ static char *quote(char *text, int type, char *qp) { return r; } -/* unquote -- teach es how to unquote a word */ -static char *unquote(char *text, int quote_char) { +/* dequote -- teach es how to dequote a word */ +static char *dequote(char *text, int quote_char) { char *p, *r; p = r = ealloc(strlen(text) + 1); @@ -112,28 +114,181 @@ static char *unquote(char *text, int quote_char) { return r; } -static List *cmdcomplete(char *prefix) { - List *fn = varlookup("fn-%complete", NULL); - if (fn == NULL) +typedef enum { + NORMAL, + SYNTAX_ERROR, + FDBRACES +} CompletionType; + +/* hmm. */ +extern const char nw[]; + +/* Scan line back to its start. */ +/* This is a lot of code, and a poor reimplementation of the parser. :( */ +CompletionType boundcmd(char **start) { + char *line = rl_line_buffer; + char syntax[128] = { 0 }; + int lp, sp = 0; + Boolean quote = FALSE, first_word = TRUE; + + for (lp = rl_point; lp > 0; lp--) { + if (quote) + continue; + + switch (line[lp]) { + /* quotes. pretty easy */ + case '\'': + quote = !quote; + continue; + + /* "stackable" syntax. remember, we're moving backwards */ + case '}': + syntax[sp++] = '{'; + break; + case '{': + if (sp == 0) { + *start = rl_line_buffer + lp + 1; + return NORMAL; + } + if (syntax[--sp] != '{') { + *start = rl_line_buffer; + return SYNTAX_ERROR; + } + break; + case ')': + syntax[sp++] = '('; + break; + case '(': + if (sp > 0) { + if (syntax[--sp] != '(') { + *start = rl_line_buffer; + return SYNTAX_ERROR; + } + } else { + /* TODO: make `<=(a b` work */ + first_word = TRUE; + } + break; + + /* command separator chars */ + case ';': + if (sp == 0) { + *start = rl_line_buffer + lp + 1; + return NORMAL; + } + break; + case '&': + if (sp == 0) { + *start = rl_line_buffer + lp + 1; + return NORMAL; + } + break; + case '|': + if (sp == 0) { + int pp = lp+1; + Boolean inbraces = FALSE; + if (pp < rl_point && line[pp] == '[') { + inbraces = TRUE; + while (pp < rl_point) { + if (line[pp++] == ']') { + inbraces = FALSE; + break; + } + } + } + *start = rl_line_buffer + pp; + return inbraces ? FDBRACES : NORMAL; + } + break; + case '`': + if (first_word) { + *start = rl_line_buffer + lp + 1; + return NORMAL; + } + break; + case '<': + if (first_word && lp < rl_point - 1 && line[lp+1] == '=') { + *start = rl_line_buffer + lp + 2; + return NORMAL; + } + break; + } + if (nw[(unsigned char)line[lp]]) + first_word = FALSE; + } + /* TODO: fetch previous lines if sp > 0 */ + *start = rl_line_buffer; + return NORMAL; +} + + +/* calls `%complete prefix word` to get a list of candidates for how to complete + * `word`. + * + * TODO: improve argv for %complete + * - special dispatch for special syntax + * - split up args in a syntax-aware way + * - dequote args before and requote after (already done, just do it better) + * - skip/handle "command-irrelevant" syntax + * ! redirections binders + * - MAYBE: provide raw command/point? + * + * all the new behaviors above should ideally be done "manually", so that %complete + * can be used the same way without worrying about the line editing library. + * + * Handle the following properly, though maybe not in this function + * `let (a =` + * `let (a = b)` + * `a =` + * `a > ` + * `!` + * `$(f` + */ + +static List *callcomplete(char *word) { + int len; + char *start; + CompletionType type; + + Ref(List *, result, NULL); + Ref(List *, fn, NULL); + if ((fn = varlookup("fn-%complete", NULL)) == NULL) { + RefPop(fn); return NULL; - Ref(char *, line, gcndup(rl_line_buffer, rl_point - strlen(prefix))); + } + type = boundcmd(&start); + + if (type == FDBRACES) { + /* TODO: fd completion */ + RefPop2(result, fn); + return NULL; + } + + len = rl_point - (start - rl_line_buffer) - strlen(word); + if (len < 0) { /* TODO: fix `word` for `|[2]` and delete this hack */ + len = 0; + word = ""; + } + Ref(char *, line, gcndup(start, len)); gcdisable(); fn = append(fn, mklist(mkstr(line), - mklist(mkstr(str("%s", prefix)), NULL))); + mklist(mkstr(str("%s", word)), NULL))); gcenable(); - RefEnd(line); - return eval(fn, NULL, 0); + result = eval(fn, NULL, 0); + RefEnd2(line, fn); + RefReturn(result); } -/* TODO: rename this */ -static char *list_completion_function(const char *text, int state) { +/* calls 'callcomplete' to produce candidates, and then returns them in a way + * readline likes. */ +static char *completion_matches(const char *text, int state) { static char **matches = NULL; static int matches_idx, matches_len; int rlen; char *result; if (!state) { - Vector *vm = vectorize(cmdcomplete((char *)text)); + Vector *vm = vectorize(callcomplete((char *)text)); matches = vm->vector; matches_len = vm->count; matches_idx = 0; @@ -151,16 +306,21 @@ static char *list_completion_function(const char *text, int state) { return result; } +/* calls out to get candidates, and manages the tools to present those candidates + * correctly. + * TODO: + * - Hook function so completers can not only say "are these candidates files?" + * but also "how to get to the file from these candidates?" (for e.g., + * pathsearch-y commands) + */ char **es_completion(UNUSED const char *text, UNUSED int start, UNUSED int end) { char **matches; Push caf; varpush(&caf, "completions-are-filenames", NULL); - matches = rl_completion_matches(text, list_completion_function); + matches = rl_completion_matches(text, completion_matches); /* mechanisms to control how the results are presented */ - /* TODO: use rl_filename_stat_hook for command completion */ - /* ugly hack ... whether to treat 'em as filenames */ rl_filename_completion_desired = istrue(varlookup("completions-are-filenames", NULL)); rl_attempted_completion_over = 1; /* suppress "default" completions */ @@ -179,7 +339,7 @@ static void initreadline(void) { rl_filename_quote_characters = " \t\n\\`'$><=;|&{()}"; rl_filename_quoting_function = quote; - rl_filename_dequoting_function = unquote; + rl_filename_dequoting_function = dequote; } /* set up readline for the next call */ @@ -202,6 +362,30 @@ extern void rlsetup(void) { rl_reset_screen_size(); } +static char *callreadline(char *prompt) { + char *r, *volatile line = NULL; + /* should this be called after each interruption, or? */ + rlsetup(); + interrupted = FALSE; + if (!setjmp(slowlabel)) { + slow = TRUE; + r = interrupted ? NULL : readline(prompt); + if (interrupted) + errno = EINTR; + } else { + r = NULL; + errno = EINTR; + } + slow = FALSE; + if (r != NULL) { + line = str("%s", r); + efree(r); + } + SIGCHK(); + return line; +} + + /* * primitives */ @@ -245,29 +429,6 @@ PRIM(resetterminal) { return ltrue; } -static char *callreadline(char *prompt) { - char *r, *volatile line = NULL; - /* should this be called after each interruption, or? */ - rlsetup(); - interrupted = FALSE; - if (!setjmp(slowlabel)) { - slow = TRUE; - r = interrupted ? NULL : readline(prompt); - if (interrupted) - errno = EINTR; - } else { - r = NULL; - errno = EINTR; - } - slow = FALSE; - if (r != NULL) { - line = str("%s", r); - efree(r); - } - SIGCHK(); - return line; -} - static char *emptyprompt = ""; PRIM(readline) { From 45cf982537169c247a9da2554e0552f49dffb52f Mon Sep 17 00:00:00 2001 From: Jack Conger Date: Tue, 10 Jun 2025 07:11:33 -0700 Subject: [PATCH 30/34] Add hook to control filename completion. The new %completion-to-file function, when defined within %complete, controls whether and how readline treats completion candidates as file names. This formats completion menus much prettier, only showing the basename of files instead of the full path, and also enables much nicer behavior with directory completion. A very nice concrete example is a function `in`, which takes a directory and a command as arguments and runs the command in the directory. With a custom %completion-to-file, the completion of the "internal" command can be done wholly as if it's already being invoked within the directory. --- completion.es | 55 +++++++++++++++++++++++++++------------------------ readline.c | 42 +++++++++++++++++++++++++++++++++++---- 2 files changed, 67 insertions(+), 30 deletions(-) diff --git a/completion.es b/completion.es index 61af060b..6097ab15 100644 --- a/completion.es +++ b/completion.es @@ -2,7 +2,7 @@ # This file exists to explore some options for programmable completion in # es; it's not an endorsement of any particular design for completion. -# However, this setup seems to perform at least as well as the current +# However, this setup already performs much better than the current # "built-in" readline completion that es has, with surprisingly little # direct support from the readline library. This corresponds well with # how much es is built on top of es, and (hopefully) indicates that es @@ -11,9 +11,8 @@ # # Syntax isn't handled really robustly with this setup, and probably # requires some kind of internal parsing machinery to do right; for -# example, we don't have great behavior with `$(var1 var2[TAB]`, or -# `command1; command2 [TAB]`. The same is true for binders like -# `let (f[TAB]` or `let (a = b) command[TAB]`. +# example, we don't have great behavior with `$(var1 var2[TAB]`, +# `let (f[TAB]`, `let (a = b) command[TAB]`, or `cmd > fi[TAB]`. # # Some hook functions back syntax and ideally modifying the hook functions' # completion functions (e.g., `%complete-%create`) would also modify how @@ -22,19 +21,20 @@ # though there's some trickiness in designing how that would actually be # executed. # -# We also want automatic de-quoting and re-quoting of terms, and splitting -# arguments in a syntax-aware way. +# We also want good automatic de-quoting and re-quoting of terms, and +# splitting arguments in a syntax-aware way. # # Closer integration with readline is another open question. For example, # it's common to have specific key bindings refer to specific types of # completion. How do we implement that? Moreover, how do we do so in a -# way that works with .inputrc? +# way that works with .inputrc? How might we design this in a way that's +# library-agnostic? # # This setup produces a fairly large amount of overhead in the es function # namespace. We would likely want to reduce that overhead, especially since # all of this has absolutely no value in the non-interactive case. Perhaps # all of the per-command completions should come from autoloadable files and -# be marked noexport. I susepct that while it's quite nice to have good +# be marked noexport. I suspect that while it's quite nice to have good # coverage for autocompletion, in practical use, only a few commands are # actually auto-completed in any interactive session. @@ -56,17 +56,6 @@ # how much of es' "internal" behavior is based on hook functions. fn %complete prefix word { - # $completions-are-filenames signals to readline whether or not to - # interpret returned items as filenames. Readline uses this information - # to more informatively display options (e.g., executable files look - # different than symlinks, etc.) as well as to make it much easier to "walk - # the filesystem" with directory tab-completion. - - # TODO: Change this to some hookable function for readline to map a - # completion candidate to a file, so that things like path-searched - # binaries or cdpath-searched directories can be treated correctly. - completions-are-filenames = <=false - if {~ $word '$&'*} { # Primitive completion. So far, no need to make a function of this. result $word^<={~~ '$&'^<=$&primitives $word^*} @@ -141,7 +130,14 @@ fn %whatis-complete word { # directories or executable files. fn %file-complete filter word { - completions-are-filenames = <=true + # Defining the %completion-to-file function during %complete signals to + # the line editing library that the results of this function are meant + # to be treated as files, and defines a function for the line editing + # library to use to map from each entry to a valid file. This enables + # nice behavior for things like path-searching commands; see + # %complete-%pathsearch for an example of this. + fn-%completion-to-file = result + let (files = (); homepat = ()) { if {!~ <={homepat = <={~~ $word '~'*'/'*}} ()} { let (homedir = (); path = $homepat(2)) { @@ -225,11 +221,17 @@ fn %complete-%whatis _ word { # refer to %complete-%pathsearch and %complete-%home. fn %complete-%pathsearch _ word { + fn %completion-to-file f { + catch @ e {result $f} { + # Like %pathsearch, but don't filter file types. + access -n $f -1e $path + } + } let (files = ()) { - let (wordpat = $path/$word) - for (bin = $path/*) - if {access -x -- $bin} { - files = $files $word^<={~~ $bin $wordpat^*} + for (p = $path) + for (w = $p/$word^*) + if {access -x -- $w} { + files = $files <={~~ $w $p/*} } result $files } @@ -392,7 +394,7 @@ fn %complete-%or _ word {%whatis-complete $word} # "Demo" completions of external binaries -# Incomplete ls completion to see how --option= completion works. +# Very incomplete ls completion to see how --option= completion works. # Not great so far! # TODO: enable --opt[TAB] to complete to '--option=', not '--option= '. # TODO: some kind of fanciness to enable good short-option support? @@ -423,7 +425,8 @@ fn %complete-man prefix word { break } let (result = (); manpath = <={%fsplit : $MANPATH}) { - # This `for` just kills performance on `man [TAB]` :/ + # This `for` kills performance on `man [TAB]` :/ + # `*.*` doesn't work for things like `man sysupdate.d` for ((nm ext) = <={~~ $manpath/man$sections/$word^* $manpath/man$sections/*.*}) result = $result $nm result $result diff --git a/readline.c b/readline.c index ea9be471..e4638c8f 100644 --- a/readline.c +++ b/readline.c @@ -279,6 +279,32 @@ static List *callcomplete(char *word) { RefReturn(result); } +List *completion_to_file; + +static int callcompletiontofile(char **filep) { + List *result; + if (completion_to_file == NULL) + return 0; + Ref(List *, call, NULL); + gcdisable(); + call = append(completion_to_file, mklist(mkstr(*filep), NULL)); + gcenable(); + result = eval(call, NULL, 0); + RefEnd(call); + switch (length(result)) { + case 0: + return 0; + case 1: + if (streq(*filep, getstr(result->term))) + return 0; + /* move into ealloc-space */ + *filep = mprint("%E", result->term); + return 1; + default: + fail("%completion-to-file", "completion-filename mapping must return one value"); + } +} + /* calls 'callcomplete' to produce candidates, and then returns them in a way * readline likes. */ static char *completion_matches(const char *text, int state) { @@ -315,16 +341,18 @@ static char *completion_matches(const char *text, int state) { */ char **es_completion(UNUSED const char *text, UNUSED int start, UNUSED int end) { char **matches; - Push caf; - varpush(&caf, "completions-are-filenames", NULL); + Push ctf; + varpush(&ctf, "fn-%completion-to-file", NULL); matches = rl_completion_matches(text, completion_matches); /* mechanisms to control how the results are presented */ - rl_filename_completion_desired = istrue(varlookup("completions-are-filenames", NULL)); + completion_to_file = varlookup("fn-%completion-to-file", NULL); + if (completion_to_file != NULL) + rl_filename_completion_desired = TRUE; + varpop(&ctf); rl_attempted_completion_over = 1; /* suppress "default" completions */ - varpop(&caf); return matches; } @@ -340,6 +368,12 @@ static void initreadline(void) { rl_filename_quote_characters = " \t\n\\`'$><=;|&{()}"; rl_filename_quoting_function = quote; rl_filename_dequoting_function = dequote; + + /* are these the right hooks? god there are a lot */ + rl_directory_rewrite_hook = callcompletiontofile; + rl_filename_stat_hook = callcompletiontofile; + + globalroot(&completion_to_file); } /* set up readline for the next call */ From 19a260773d00c920389cb5939da7878a53ff8dd4 Mon Sep 17 00:00:00 2001 From: Jack Conger Date: Wed, 11 Jun 2025 08:43:15 -0700 Subject: [PATCH 31/34] Slightly better behavior for `man a.b` completions --- completion.es | 22 ++++++++++++++++++---- 1 file changed, 18 insertions(+), 4 deletions(-) diff --git a/completion.es b/completion.es index 6097ab15..d650260e 100644 --- a/completion.es +++ b/completion.es @@ -425,10 +425,24 @@ fn %complete-man prefix word { break } let (result = (); manpath = <={%fsplit : $MANPATH}) { - # This `for` kills performance on `man [TAB]` :/ - # `*.*` doesn't work for things like `man sysupdate.d` - for ((nm ext) = <={~~ $manpath/man$sections/$word^* $manpath/man$sections/*.*}) - result = $result $nm + # This whole `for` kills performance on `man [TAB]` :/ + # Slightly buggy :/ + for (fi = $manpath/man$sections/$word^*) { + if {access $fi} { + let (sp = <={%fsplit . <={ + ~~ $fi $manpath/man$sections/* + }}) { + if {~ $sp($#sp) gz} { + let (nsp = 1 2 $sp) + sp = $nsp(3 ... $#sp) + } { + let (nsp = 1 $sp) + sp = $nsp(2 ... $#sp) + } + result = $result <={%flatten . $sp} + } + } + } result $result } } From f50d0ee572ba5654ca1f7a4aad0b0118b95469d1 Mon Sep 17 00:00:00 2001 From: Jack Conger Date: Tue, 27 Jan 2026 22:58:56 -0800 Subject: [PATCH 32/34] Make %parse write to history even on syntax errors --- initial.es | 19 ++++++++++--------- 1 file changed, 10 insertions(+), 9 deletions(-) diff --git a/initial.es b/initial.es index 692dd698..75806b5e 100644 --- a/initial.es +++ b/initial.es @@ -662,20 +662,21 @@ if {~ <=$&primitives readline} { } } -fn %parse { +fn %parse prompt { if %is-interactive { - let (in = (); p = $*(1)) - let (code = <={$&parse { - let (r = <={%read-line $p}) { - in = $in $r - p = $*(2) - result $r + let (in = (); p = $prompt(1)) + unwind-protect { + $&parse { + let (r = <={%read-line $p}) { + in = $in $r + p = $prompt(2) + result $r + } } - }}) { + } { if {!~ $#fn-%write-history 0} { %write-history <={%flatten \n $in} } - result $code } } { $&parse $&read From eeba776fad70433a18b458494ad347e68f0060db Mon Sep 17 00:00:00 2001 From: Jack Conger Date: Wed, 4 Feb 2026 08:18:22 -0800 Subject: [PATCH 33/34] Autoloadable completion functions, to reduce function namespace pollution --- completion.es | 318 +++--------------------- completions/complete-%and.es | 1 + completions/complete-%append.es | 1 + completions/complete-%background.es | 1 + completions/complete-%create.es | 1 + completions/complete-%home.es | 4 + completions/complete-%is-interactive.es | 1 + completions/complete-%not.es | 1 + completions/complete-%open-append.es | 1 + completions/complete-%open-create.es | 1 + completions/complete-%open-write.es | 1 + completions/complete-%open.es | 1 + completions/complete-%openfile.es | 21 ++ completions/complete-%or.es | 1 + completions/complete-%pathsearch.es | 16 ++ completions/complete-%read.es | 1 + completions/complete-%run.es | 23 ++ completions/complete-%var.es | 3 + completions/complete-%whatis.es | 3 + completions/complete-cd.es | 4 + completions/complete-eval.es | 1 + completions/complete-exec.es | 1 + completions/complete-false.es | 1 + completions/complete-if.es | 1 + completions/complete-ls.es | 17 ++ completions/complete-man.es | 35 +++ completions/complete-newpgrp.es | 1 + completions/complete-throw.es | 52 ++++ completions/complete-time.es | 1 + completions/complete-true.es | 1 + completions/complete-unwind-protect.es | 1 + completions/complete-var.es | 1 + completions/complete-wait.es | 4 + completions/complete-whatis.es | 1 + completions/complete-while.es | 1 + 35 files changed, 234 insertions(+), 289 deletions(-) create mode 100644 completions/complete-%and.es create mode 100644 completions/complete-%append.es create mode 100644 completions/complete-%background.es create mode 100644 completions/complete-%create.es create mode 100644 completions/complete-%home.es create mode 100644 completions/complete-%is-interactive.es create mode 100644 completions/complete-%not.es create mode 100644 completions/complete-%open-append.es create mode 100644 completions/complete-%open-create.es create mode 100644 completions/complete-%open-write.es create mode 100644 completions/complete-%open.es create mode 100644 completions/complete-%openfile.es create mode 100644 completions/complete-%or.es create mode 100644 completions/complete-%pathsearch.es create mode 100644 completions/complete-%read.es create mode 100644 completions/complete-%run.es create mode 100644 completions/complete-%var.es create mode 100644 completions/complete-%whatis.es create mode 100644 completions/complete-cd.es create mode 100644 completions/complete-eval.es create mode 100644 completions/complete-exec.es create mode 100644 completions/complete-false.es create mode 100644 completions/complete-if.es create mode 100644 completions/complete-ls.es create mode 100644 completions/complete-man.es create mode 100644 completions/complete-newpgrp.es create mode 100644 completions/complete-throw.es create mode 100644 completions/complete-time.es create mode 100644 completions/complete-true.es create mode 100644 completions/complete-unwind-protect.es create mode 100644 completions/complete-var.es create mode 100644 completions/complete-wait.es create mode 100644 completions/complete-whatis.es create mode 100644 completions/complete-while.es diff --git a/completion.es b/completion.es index d650260e..b408bd32 100644 --- a/completion.es +++ b/completion.es @@ -79,23 +79,40 @@ fn %complete prefix word { # Command-position completion. %whatis-complete $word } { - # Non-command-position completion. - # TODO: Provide a way to define %complete-foo in an - # auto-loadable file! - if {!~ $#(fn-%complete-^$line(1)) 0} { - # Strip the first term from the line. - %complete-^$line(1) <={%flatten ' ' $line(2 ...)} $word - } { - %file-complete {} $word - } + # Strip the first term from the line. + %complete-fn $line(1) <={%flatten ' ' $line(2 ...)} $word } } } } +# %complete-fn finds if necessary, and evaluates if possible, a particular +# completion function. Calling this is strongly recommended instead of +# directly calling `%complete-$fnname` for any completion function other +# than those found in this file. + +completion-path = /home/jpco/git/es-fork/completions + +fn %complete-fn func prefix word { + if {~ $#(fn-%complete-^$func) 0} { + let (f = ()) { + f = <={access -n complete-$func^.es -1 -f $completion-path} + if {!~ $f ()} { + . $f + } + } + } + if {!~ $#(fn-%complete-^$func) 0} { + %complete-^$func $prefix $word + } { + %file-complete {} $word + } +} + + # -# Specific, not-per-command completion logic. +# Completion logic for built-in concepts. # # These functions (named according to the pattern %foo-complete) provide @@ -120,7 +137,7 @@ fn %whatis-complete word { result $word^<={~~ ( local let for fn %closure match <={~~ (<=$&vars <=$&internals) 'fn-'^*} - ) $word^*} <={%complete-%pathsearch '' $word} + ) $word^*} <={%complete-fn %pathsearch '' $word} } } @@ -135,7 +152,7 @@ fn %file-complete filter word { # to be treated as files, and defines a function for the line editing # library to use to map from each entry to a valid file. This enables # nice behavior for things like path-searching commands; see - # %complete-%pathsearch for an example of this. + # completions/complete-%pathsearch.es for an example of this. fn-%completion-to-file = result let (files = (); homepat = ()) { @@ -170,280 +187,3 @@ fn %pid-complete word { } # TODO: %fd-complete? %ifs-complete? - - -# -# Per-command completions -# - -# We supply several of our own completion functions for shell built-ins -# and to demonstrate how the "API" works. -# -# fn %complete-[command] prefix word { -# return (completion candidates) -# } -# -# This "API" is rather weak. Ideally, these functions would probably -# receive pre-split argument lines (e.g., `cat foo bar ba[TAB]` would call -# something like `%complete-cat foo bar ba`, perhaps actually with a -# numeric index argument so that the entire line can be given to a -# function where completion is happening in the middle. Maybe this? -# -# fn %complete-[command] index command {...} -# -# A challenge is what to do for cases like %seq {blah[TAB]} {blah blah}. -# The less-fancy but much-more-straightforward option is to just do the -# `blah[TAB]` completion by itself. -# -# In addition, we may consider filtering things like redirections out from -# the arguments before passing them to these functions, though in some cases -# like input substitution, we'd want to keep the argument in some form. - - -# Built-ins - -# In "hook-ish function" cases like %var where the user-level command uses -# common code with internal shell logic but the shell doesn't actually call -# these functions, we have %complete-%var and internal completion logic refer -# to a common "internal" %var-complete function. This is also used for -# %whatis. - -fn %complete-%var _ word { - %var-complete $word -} - -fn %complete-%whatis _ word { - %whatis-complete $word -} - -# In cases like %pathsearch and %home where the shell actually calls a hook -# function to get something done, internal completion functions also directly -# refer to %complete-%pathsearch and %complete-%home. - -fn %complete-%pathsearch _ word { - fn %completion-to-file f { - catch @ e {result $f} { - # Like %pathsearch, but don't filter file types. - access -n $f -1e $path - } - } - let (files = ()) { - for (p = $path) - for (w = $p/$word^*) - if {access -x -- $w} { - files = $files <={~~ $w $p/*} - } - result $files - } -} - -fn %complete-%home _ word { - result $word^<={~~ `` \n {awk -F: '{print $1}' /etc/passwd} $word^*} -} - -# These functions which use 'cmd' are good demos of why the 'prefix' arg -# just isn't quite enough. - -fn %complete-%run prefix word { - let (cmd = <={%split ' '\t $prefix}) - if {~ $#cmd 0} { - let (result = ()) { - # enforce an absolute path - for (r = <={%file-complete @ {access -x $*} $word}) { - if {~ $r /* ./* ../*} { - result = $result $r - } { - result = $result ./$r - } - } - result $result - } - } {~ $#cmd 1} { - # assume basename of the first term - let (ps = <={%split '/' $cmd(1)}) result $ps($#ps) - } { - # try to pass through to completion on second term - %complete <={%flatten ' ' $cmd(2 ...)} $word - } -} - -fn %complete-%openfile prefix word { - let (cmd = <={%split ' '\t $prefix}) { - if {~ $#cmd 0} { - # mode - result $word^<={~~ (r w a r+ w+ a+) $word^*} - } {~ $#cmd 1} { - # fd - if {~ $cmd(1) r*} { - result 0 - } { - result 1 - } - } {~ $#cmd 2} { - # file - %file-complete {} $word - } { - # cmd: pass-through completion - %complete <={%flatten ' ' $cmd(4 ...)} $word - } - } -} - -fn %complete-%open p w {%complete-%openfile 'r ' ^$p $w} -fn %complete-%create p w {%complete-%openfile 'w ' ^$p $w} -fn %complete-%append p w {%complete-%openfile 'a ' ^$p $w} -fn %complete-%open-write p w {%complete-%openfile 'r+ '^$p $w} -fn %complete-%open-create p w {%complete-%openfile 'w+ '^$p $w} -fn %complete-%open-append p w {%complete-%openfile 'a+ '^$p $w} - -# Note that `cd' is consistently the most overloaded function es has; -# This function performs the basic completion, but doesn't know about -# things like cdpath, dir stacks, or anything else folks have done to -# cd in their setups. - -fn %complete-cd _ word { - %file-complete @ {access -d -- $*} $word -} - -fn %complete-wait _ word { - %pid-complete $word -} - -fn %complete-throw prefix word { - let (cmd = <={%split ' '\t $prefix}) { - if {~ $#cmd 0} { - return $word^<={~~ (break eof error retry return signal) $word^*} - } - match $cmd(1) ( - (break eof retry return) {result ()} # no good guesses :/ - error { - if {~ $#cmd 1} { - %whatis-complete $word - } { - result () - } - } - signal { - # The shell should be able to give us this list... - result $word^<={~~ ( - sigabrt - sigalrm - sigbus - sigchld - sigcont - sigfpe - sighup - sigill - sigint - sigkill - sigpipe - sigpoll - sigprof - sigquit - sigsegv - sigstop - sigtstp - sigsys - sigterm - sigtrap - sigttin - sigttou - sigurg - sigusr1 - sigusr2 - sigvtalrm - sigxcpu - sigxfsz - sigwinch - ) $word^*} - } - * {result ()} # Not sure :/ - ) - } -} - -# Functions which just wrap %functions. - -fn-%complete-var = %complete-%var -fn-%complete-whatis = %complete-%whatis - -# "Pass-through" completions for functions which take commands as arguments. - -fn-%complete-eval = %complete -fn-%complete-exec = %complete -fn-%complete-time = %complete -fn-%complete-%not = %complete -fn-%complete-%background = %complete - -# "Null" completions for commands which simply take no arguments. - -fn-%complete-true = {result} -fn-%complete-false = {result} -fn-%complete-newpgrp = {result} -fn-%complete-%read = {result} -fn-%complete-%is-interactive = {result} - -# Technically, all of the arguments to these are command words. - -fn %complete-if _ word {%whatis-complete $word} -fn %complete-unwind-protect _ word {%whatis-complete $word} -fn %complete-while _ word {%whatis-complete $word} -fn %complete-%and _ word {%whatis-complete $word} -fn %complete-%or _ word {%whatis-complete $word} - - -# "Demo" completions of external binaries - -# Very incomplete ls completion to see how --option= completion works. -# Not great so far! -# TODO: enable --opt[TAB] to complete to '--option=', not '--option= '. -# TODO: some kind of fanciness to enable good short-option support? - -fn %complete-ls _ word { - if {~ $word -*} { - result $word^<={~~ ( - --all - --author - --block-size= - --color= - ) $word^*} - } { - %file-complete {} $word - } -} - -# Total support for `man` arguments is surprisingly complicated. -# This covers `man blah` and `man 1 blah` at least. - -fn %complete-man prefix word { - let (sections = 1 1p n l 8 3 3p 0 0p 2 3type 5 4 9 6 7) { - if {~ $#MANPATH 0} { - MANPATH = `manpath - } - for (a = <={%split ' '\t $prefix}) if {~ $a $sections} { - sections = $a - break - } - let (result = (); manpath = <={%fsplit : $MANPATH}) { - # This whole `for` kills performance on `man [TAB]` :/ - # Slightly buggy :/ - for (fi = $manpath/man$sections/$word^*) { - if {access $fi} { - let (sp = <={%fsplit . <={ - ~~ $fi $manpath/man$sections/* - }}) { - if {~ $sp($#sp) gz} { - let (nsp = 1 2 $sp) - sp = $nsp(3 ... $#sp) - } { - let (nsp = 1 $sp) - sp = $nsp(2 ... $#sp) - } - result = $result <={%flatten . $sp} - } - } - } - result $result - } - } -} diff --git a/completions/complete-%and.es b/completions/complete-%and.es new file mode 100644 index 00000000..6481862b --- /dev/null +++ b/completions/complete-%and.es @@ -0,0 +1 @@ +fn %complete-%and _ word {%whatis-complete $word} diff --git a/completions/complete-%append.es b/completions/complete-%append.es new file mode 100644 index 00000000..839b1104 --- /dev/null +++ b/completions/complete-%append.es @@ -0,0 +1 @@ +fn %complete-%append p w {%complete-fn %openfile 'a '^$p $w} diff --git a/completions/complete-%background.es b/completions/complete-%background.es new file mode 100644 index 00000000..3f905866 --- /dev/null +++ b/completions/complete-%background.es @@ -0,0 +1 @@ +fn-%complete-%background = %complete diff --git a/completions/complete-%create.es b/completions/complete-%create.es new file mode 100644 index 00000000..1508aff2 --- /dev/null +++ b/completions/complete-%create.es @@ -0,0 +1 @@ +fn %complete-%create p w {%complete-fn %openfile 'w '^$p $w} diff --git a/completions/complete-%home.es b/completions/complete-%home.es new file mode 100644 index 00000000..eda29f6a --- /dev/null +++ b/completions/complete-%home.es @@ -0,0 +1,4 @@ +fn %complete-%home _ word { + result $word^<={~~ `` \n {awk -F: '{print $1}' /etc/passwd} $word^*} +} + diff --git a/completions/complete-%is-interactive.es b/completions/complete-%is-interactive.es new file mode 100644 index 00000000..f96fa377 --- /dev/null +++ b/completions/complete-%is-interactive.es @@ -0,0 +1 @@ +fn-%complete-%is-interactive = {result} diff --git a/completions/complete-%not.es b/completions/complete-%not.es new file mode 100644 index 00000000..20e25ca6 --- /dev/null +++ b/completions/complete-%not.es @@ -0,0 +1 @@ +fn-%complete-%not = %complete diff --git a/completions/complete-%open-append.es b/completions/complete-%open-append.es new file mode 100644 index 00000000..a1c02573 --- /dev/null +++ b/completions/complete-%open-append.es @@ -0,0 +1 @@ +fn %complete-%open-append p w {%complete-fn %openfile 'a+ '^$p $w} diff --git a/completions/complete-%open-create.es b/completions/complete-%open-create.es new file mode 100644 index 00000000..15a6f617 --- /dev/null +++ b/completions/complete-%open-create.es @@ -0,0 +1 @@ +fn %complete-%open-create p w {%complete-fn %openfile 'w+ '^$p $w} diff --git a/completions/complete-%open-write.es b/completions/complete-%open-write.es new file mode 100644 index 00000000..ebbd228a --- /dev/null +++ b/completions/complete-%open-write.es @@ -0,0 +1 @@ +fn %complete-%open-write p w {%complete-fn %openfile 'r+ '^$p $w} diff --git a/completions/complete-%open.es b/completions/complete-%open.es new file mode 100644 index 00000000..a9c0c57d --- /dev/null +++ b/completions/complete-%open.es @@ -0,0 +1 @@ +fn %complete-%open p w {%complete-fn %openfile 'r '^$p $w} diff --git a/completions/complete-%openfile.es b/completions/complete-%openfile.es new file mode 100644 index 00000000..fd07e25e --- /dev/null +++ b/completions/complete-%openfile.es @@ -0,0 +1,21 @@ +fn %complete-%openfile prefix word { + let (cmd = <={%split ' '\t $prefix}) { + if {~ $#cmd 0} { + # mode + result $word^<={~~ (r w a r+ w+ a+) $word^*} + } {~ $#cmd 1} { + # fd + if {~ $cmd(1) r*} { + result 0 + } { + result 1 + } + } {~ $#cmd 2} { + # file + %file-complete {} $word + } { + # cmd: pass-through completion + %complete <={%flatten ' ' $cmd(4 ...)} $word + } + } +} diff --git a/completions/complete-%or.es b/completions/complete-%or.es new file mode 100644 index 00000000..61c6ee8a --- /dev/null +++ b/completions/complete-%or.es @@ -0,0 +1 @@ +fn %complete-%or _ word {%whatis-complete $word} diff --git a/completions/complete-%pathsearch.es b/completions/complete-%pathsearch.es new file mode 100644 index 00000000..66721408 --- /dev/null +++ b/completions/complete-%pathsearch.es @@ -0,0 +1,16 @@ +fn %complete-%pathsearch _ word { + fn %completion-to-file f { + catch @ e {result $f} { + # Like %pathsearch, but don't filter file types. + access -n $f -1e $path + } + } + let (files = ()) { + for (p = $path) + for (w = $p/$word^*) + if {access -x -- $w} { + files = $files <={~~ $w $p/*} + } + result $files + } +} diff --git a/completions/complete-%read.es b/completions/complete-%read.es new file mode 100644 index 00000000..4aee7903 --- /dev/null +++ b/completions/complete-%read.es @@ -0,0 +1 @@ +fn-%complete-%read = {result} diff --git a/completions/complete-%run.es b/completions/complete-%run.es new file mode 100644 index 00000000..5d05e7e1 --- /dev/null +++ b/completions/complete-%run.es @@ -0,0 +1,23 @@ +fn %complete-%run prefix word { + let (cmd = <={%split ' '\t $prefix}) + if {~ $#cmd 0} { + let (result = ()) { + # enforce an absolute path + for (r = <={%file-complete @ {access -x $*} $word}) { + if {~ $r /* ./* ../*} { + result = $result $r + } { + result = $result ./$r + } + } + result $result + } + } {~ $#cmd 1} { + # assume basename of the first term + let (ps = <={%split '/' $cmd(1)}) result $ps($#ps) + } { + # try to pass through to completion on second term + %complete <={%flatten ' ' $cmd(2 ...)} $word + } +} + diff --git a/completions/complete-%var.es b/completions/complete-%var.es new file mode 100644 index 00000000..1ccea71d --- /dev/null +++ b/completions/complete-%var.es @@ -0,0 +1,3 @@ +fn %complete-%var _ word { + %var-complete $word +} diff --git a/completions/complete-%whatis.es b/completions/complete-%whatis.es new file mode 100644 index 00000000..8a69dae9 --- /dev/null +++ b/completions/complete-%whatis.es @@ -0,0 +1,3 @@ +fn %complete-%whatis _ word { + %whatis-complete $word +} diff --git a/completions/complete-cd.es b/completions/complete-cd.es new file mode 100644 index 00000000..9fb7c0e2 --- /dev/null +++ b/completions/complete-cd.es @@ -0,0 +1,4 @@ +fn %complete-cd _ word { + %file-complete @ {access -d -- $*} $word +} + diff --git a/completions/complete-eval.es b/completions/complete-eval.es new file mode 100644 index 00000000..40ecf582 --- /dev/null +++ b/completions/complete-eval.es @@ -0,0 +1 @@ +fn-%complete-eval = %complete diff --git a/completions/complete-exec.es b/completions/complete-exec.es new file mode 100644 index 00000000..8c8dd289 --- /dev/null +++ b/completions/complete-exec.es @@ -0,0 +1 @@ +fn-%complete-exec = %complete diff --git a/completions/complete-false.es b/completions/complete-false.es new file mode 100644 index 00000000..1bc4a232 --- /dev/null +++ b/completions/complete-false.es @@ -0,0 +1 @@ +fn-%complete-false = {result} diff --git a/completions/complete-if.es b/completions/complete-if.es new file mode 100644 index 00000000..2f0c5ded --- /dev/null +++ b/completions/complete-if.es @@ -0,0 +1 @@ +fn %complete-if _ word {%whatis-complete $word} diff --git a/completions/complete-ls.es b/completions/complete-ls.es new file mode 100644 index 00000000..89df9412 --- /dev/null +++ b/completions/complete-ls.es @@ -0,0 +1,17 @@ +# Very incomplete ls completion to see how --option= completion works. +# Not great so far! +# TODO: enable --opt[TAB] to complete to '--option=', not '--option= '. +# TODO: some kind of fanciness to enable good short-option support? + +fn %complete-ls _ word { + if {~ $word -*} { + result $word^<={~~ ( + --all + --author + --block-size= + --color= + ) $word^*} + } { + %file-complete {} $word + } +} diff --git a/completions/complete-man.es b/completions/complete-man.es new file mode 100644 index 00000000..dbe55cce --- /dev/null +++ b/completions/complete-man.es @@ -0,0 +1,35 @@ +# Total support for `man` arguments is surprisingly complicated. +# This covers `man blah` and `man 1 blah` at least. + +fn %complete-man prefix word { + let (sections = 1 1p n l 8 3 3p 0 0p 2 3type 5 4 9 6 7) { + if {~ $#MANPATH 0} { + MANPATH = `manpath + } + for (a = <={%split ' '\t $prefix}) if {~ $a $sections} { + sections = $a + break + } + let (result = (); manpath = <={%fsplit : $MANPATH}) { + # This whole `for` kills performance on `man [TAB]` :/ + # Slightly buggy :/ + for (fi = $manpath/man$sections/$word^*) { + if {access $fi} { + let (sp = <={%fsplit . <={ + ~~ $fi $manpath/man$sections/* + }}) { + if {~ $sp($#sp) gz} { + let (nsp = 1 2 $sp) + sp = $nsp(3 ... $#sp) + } { + let (nsp = 1 $sp) + sp = $nsp(2 ... $#sp) + } + result = $result <={%flatten . $sp} + } + } + } + result $result + } + } +} diff --git a/completions/complete-newpgrp.es b/completions/complete-newpgrp.es new file mode 100644 index 00000000..55a52435 --- /dev/null +++ b/completions/complete-newpgrp.es @@ -0,0 +1 @@ +fn %complete-newpgrp = {result} diff --git a/completions/complete-throw.es b/completions/complete-throw.es new file mode 100644 index 00000000..758a1a29 --- /dev/null +++ b/completions/complete-throw.es @@ -0,0 +1,52 @@ +fn %complete-throw prefix word { + let (cmd = <={%split ' '\t $prefix}) { + if {~ $#cmd 0} { + return $word^<={~~ (break eof error retry return signal) $word^*} + } + match $cmd(1) ( + (break eof retry return) {result ()} # no good guesses :/ + error { + if {~ $#cmd 1} { + %whatis-complete $word + } { + result () + } + } + signal { + # The shell should be able to give us this list... + result $word^<={~~ ( + sigabrt + sigalrm + sigbus + sigchld + sigcont + sigfpe + sighup + sigill + sigint + sigkill + sigpipe + sigpoll + sigprof + sigquit + sigsegv + sigstop + sigtstp + sigsys + sigterm + sigtrap + sigttin + sigttou + sigurg + sigusr1 + sigusr2 + sigvtalrm + sigxcpu + sigxfsz + sigwinch + ) $word^*} + } + * {result ()} # Not sure :/ + ) + } +} diff --git a/completions/complete-time.es b/completions/complete-time.es new file mode 100644 index 00000000..6ebd22fd --- /dev/null +++ b/completions/complete-time.es @@ -0,0 +1 @@ +fn-%complete-time = %complete diff --git a/completions/complete-true.es b/completions/complete-true.es new file mode 100644 index 00000000..5b99323d --- /dev/null +++ b/completions/complete-true.es @@ -0,0 +1 @@ +fn-%complete-true = {result} diff --git a/completions/complete-unwind-protect.es b/completions/complete-unwind-protect.es new file mode 100644 index 00000000..16f742df --- /dev/null +++ b/completions/complete-unwind-protect.es @@ -0,0 +1 @@ +fn %complete-unwind-protect _ word {%whatis-complete $word} diff --git a/completions/complete-var.es b/completions/complete-var.es new file mode 100644 index 00000000..5a0f70fd --- /dev/null +++ b/completions/complete-var.es @@ -0,0 +1 @@ +fn-%complete-var = %complete-fn %var diff --git a/completions/complete-wait.es b/completions/complete-wait.es new file mode 100644 index 00000000..8e584ff2 --- /dev/null +++ b/completions/complete-wait.es @@ -0,0 +1,4 @@ +fn %complete-wait _ word { + %pid-complete $word +} + diff --git a/completions/complete-whatis.es b/completions/complete-whatis.es new file mode 100644 index 00000000..53b07a36 --- /dev/null +++ b/completions/complete-whatis.es @@ -0,0 +1 @@ +fn-%complete-whatis = %complete-fn whatis diff --git a/completions/complete-while.es b/completions/complete-while.es new file mode 100644 index 00000000..63f530dd --- /dev/null +++ b/completions/complete-while.es @@ -0,0 +1 @@ +fn %complete-while _ word {%whatis-complete $word} From 573933a0d5bb1cf1f55afc3454660461ee8e06ff Mon Sep 17 00:00:00 2001 From: Jack Conger Date: Thu, 12 Feb 2026 21:55:26 -0800 Subject: [PATCH 34/34] demo of "heredoc mode" for reader command? --- initial.es | 5 ++++- input.c | 6 ++++-- 2 files changed, 8 insertions(+), 3 deletions(-) diff --git a/initial.es b/initial.es index 75806b5e..85a2d14a 100644 --- a/initial.es +++ b/initial.es @@ -666,7 +666,10 @@ fn %parse prompt { if %is-interactive { let (in = (); p = $prompt(1)) unwind-protect { - $&parse { + $&parse @ mode { + if {~ $mode heredoc} { + p = 'heredoc> ' + } let (r = <={%read-line $p}) { in = $in $r p = $prompt(2) diff --git a/input.c b/input.c index b5a6d4fb..3e4eb730 100644 --- a/input.c +++ b/input.c @@ -159,7 +159,7 @@ static List *fillcmd = NULL; static int cmdfill(Input *in) { char *read; - List *result; + List *cmd, *result; size_t nread; int oldf; @@ -175,9 +175,11 @@ static int cmdfill(Input *in) { } else close(0); + cmd = append(fillcmd, mklist(mkstr(in->ignoreeof ? "heredoc" : "normal"), NULL)); + ExceptionHandler - result = eval(fillcmd, NULL, 0); + result = eval(cmd, NULL, 0); CatchException (e)