/* 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 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); }
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); }
/* 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); }