extern List *extractmatches(List *subjects, List *patterns, StrList *quotes) {
List **prevp;
List *subject;
Ref(List *, result, NULL);
prevp = &result;
gcdisable();
for (subject = subjects; subject != NULL; subject = subject->next) {
List *pattern;
StrList *quote;
for (pattern = patterns, quote = quotes;
pattern != NULL;
pattern = pattern->next, quote = quote->next) {
List *match;
char *pat = getstr(pattern->term);
match = extractsinglematch(getstr(subject->term),
pat, quote->str, NULL);
if (match != NULL) {
/* match is returned backwards, so reverse it */
match = reverse(match);
for (*prevp = match; match != NULL; match = *prevp)
prevp = &match->next;
break;
}
}
}
gcenable();
RefReturn(result);
}
/* bindargs -- bind an argument list to the parameters of a lambda */
extern Binding *bindargs(Tree *params, List *args, Binding *binding) {
if (params == NULL)
return mkbinding("*", args, binding);
gcdisable();
for (; params != NULL; params = params->u[1].p) {
Tree *param;
List *value;
assert(params->kind == nList);
param = params->u[0].p;
assert(param->kind == nWord || param->kind == nQword);
if (args == NULL)
value = NULL;
else if (params->u[1].p == NULL || args->next == NULL) {
value = args;
args = NULL;
} else {
value = mklist(args->term, NULL);
args = args->next;
}
binding = mkbinding(param->u[0].s, value, binding);
}
Ref(Binding *, result, binding);
gcenable();
RefReturn(result);
}
extern Term *mkterm(char *str, Closure *closure) {
gcdisable();
Ref(Term *, term, gcnew(Term));
term->str = str;
term->closure = closure;
gcenable();
RefReturn(term);
}
extern List *mklist(Term *term, List *next) {
gcdisable(0);
assert(term != NULL);
Ref(List *, list, gcnew(List));
list->term = term;
list->next = next;
gcenable();
RefReturn(list);
}
extern StrList *mkstrlist(char *str, StrList *next) {
gcdisable(0);
assert(str != NULL);
Ref(StrList *, list, gcnew(StrList));
list->str = str;
list->next = next;
gcenable();
RefReturn(list);
}
/* sortlist */
extern List *sortlist(List *list) {
if (length(list) > 1) {
Vector *v = vectorize(list);
sortvector(v);
gcdisable(0);
Ref(List *, lp, listify(v->count, v->vector));
gcenable();
list = lp;
RefEnd(lp);
}
/* setnoexport -- mark a list of variable names not for export */
extern void setnoexport(List *list) {
isdirty = TRUE;
if (list == NULL) {
noexport = NULL;
return;
}
gcdisable();
for (noexport = mkdict(); list != NULL; list = list->next)
noexport = dictput(noexport, getstr(list->term), (void *) setnoexport);
gcenable();
}
/* importvar -- import a single environment variable */
static void importvar(char *name0, char *value) {
char sep[2] = { ENV_SEPARATOR, '\0' };
Ref(char *, name, name0);
Ref(List *, defn, NULL);
defn = fsplit(sep, mklist(mkstr(value + 1), NULL), FALSE);
if (strchr(value, ENV_ESCAPE) != NULL) {
List *list;
gcdisable();
for (list = defn; list != NULL; list = list->next) {
int offset = 0;
const char *word = list->term->str;
const char *escape;
while ((escape = strchr(word + offset, ENV_ESCAPE))
!= NULL) {
offset = escape - word + 1;
switch (escape[1]) {
case '\0':
if (list->next != NULL) {
const char *str2
= list->next->term->str;
char *str
= gcalloc(offset
+ strlen(str2) + 1,
&StringTag);
memcpy(str, word, offset - 1);
str[offset - 1]
= ENV_SEPARATOR;
strcpy(str + offset, str2);
list->term->str = str;
list->next = list->next->next;
}
break;
case ENV_ESCAPE: {
char *str
= gcalloc(strlen(word), &StringTag);
memcpy(str, word, offset);
strcpy(str + offset, escape + 2);
list->term->str = str;
offset += 1;
break;
}
}
}
}
gcenable();
}
vardef(name, NULL, defn);
RefEnd2(defn, name);
}
extern Vector *mkenv(void) {
if (isdirty || rebound) {
env->count = envmin;
gcdisable(); /* TODO: make this a good guess */
dictforall(vars, mkenv0, NULL);
gcenable();
env->vector[env->count] = NULL;
isdirty = FALSE;
rebound = FALSE;
if (sortenv == NULL || env->count > sortenv->alloclen)
sortenv = mkvector(env->count * 2);
sortenv->count = env->count;
memcpy(sortenv->vector, env->vector, sizeof (char *) * (env->count + 1));
sortvector(sortenv);
}
return sortenv;
}
/* safereverse -- reverse a list, non-destructively */
extern List *safereverse(List *list) {
List *lp;
if (list == NULL)
return NULL;
if (list->next == NULL)
return list;
gcdisable(0);
for (lp = NULL; list != NULL; list = list->next)
lp = mklist(list->term, lp);
Ref(List *, result, lp);
gcenable();
RefReturn(result);
}
static noreturn failexec(char *file, List *args) {
List *fn;
assert(gcisblocked());
fn = varlookup("fn-%exec-failure", NULL);
if (fn != NULL) {
int olderror = errno;
Ref(List *, list, append(fn, mklist(mkstr(file), args)));
RefAdd(file);
gcenable();
RefRemove(file);
eval(list, NULL, 0);
RefEnd(list);
errno = olderror;
}
eprint("%s: %s\n", file, esstrerror(errno));
exit(1);
}
/* strv -- print a formatted string into gc space */
extern char *strv(const char *fmt, va_list args) {
Buffer *buf;
Format format;
gcdisable(0);
buf = openbuffer(0);
format.u.p = buf;
format.args = args;
format.buf = buf->str;
format.bufbegin = buf->str;
format.bufend = buf->str + buf->len;
format.grow = str_grow;
format.flushed = 0;
printfmt(&format, fmt);
fmtputc(&format, '\0');
gcenable();
return sealbuffer(format.u.p);
}
/* forkexec -- fork (if necessary) and exec */
extern List *forkexec(char *file, List *list, Boolean inchild) {
int pid, status;
Vector *env;
gcdisable();
env = mkenv();
pid = efork(!inchild, FALSE);
if (pid == 0) {
execve(file, vectorize(list)->vector, env->vector);
failexec(file, list);
}
gcenable();
status = ewaitfor(pid);
if ((status & 0xff) == 0) {
sigint_newline = FALSE;
SIGCHK();
sigint_newline = TRUE;
} else
SIGCHK();
printstatus(0, status);
return mklist(mkterm(mkstatus(status), NULL), NULL);
}
/* append -- merge two lists, non-destructively */
extern List *append(List *head, List *tail) {
List *lp, **prevp;
#if 0 /* if you want this optimization, rewrite listcopy */
if (tail0 == NULL)
return head0;
#endif
Ref(List *, hp, head);
Ref(List *, tp, tail);
gcdisable(40 * sizeof (List));
head = hp;
tail = tp;
RefEnd2(tp, hp);
for (prevp = &lp; head != NULL; head = head->next) {
List *np = mklist(head->term, NULL);
*prevp = np;
prevp = &np->next;
}
*prevp = tail;
Ref(List *, result, lp);
gcenable();
RefReturn(result);
}