extern Boolean listmatch(List *subject, List *pattern, StrList *quote) { if (subject == NULL) { if (pattern == NULL) return TRUE; Ref(List *, p, pattern); Ref(StrList *, q, quote); for (; p != NULL; p = p->next, q = q->next) { /* one or more stars match null */ char *pw = getstr(p->term), *qw = q->str; if (*pw != '\0' && qw != QUOTED) { int i; Boolean matched = TRUE; for (i = 0; pw[i] != '\0'; i++) if (pw[i] != '*' || (qw != UNQUOTED && qw[i] != 'r')) { matched = FALSE; break; } if (matched) { RefPop2(q, p); return TRUE; } } } RefEnd2(q, p); return FALSE; } Ref(List *, s, subject); Ref(List *, p, pattern); Ref(StrList *, q, quote); for (; p != NULL; p = p->next, q = q->next) { assert(q != NULL); assert(p->term != NULL); assert(q->str != NULL); Ref(char *, pw, getstr(p->term)); Ref(char *, qw, q->str); Ref(List *, t, s); for (; t != NULL; t = t->next) { char *tw = getstr(t->term); if (match(tw, pw, qw)) { RefPop3(t, qw, pw); RefPop3(q, p, s); return TRUE; } } RefEnd3(t, qw, pw); } RefEnd3(q, p, s); return FALSE; }
extern Term *termcat(Term *t1, Term *t2) { if (t1 == NULL) return t2; if (t2 == NULL) return t1; Ref(Term *, term, mkstr(NULL)); Ref(char *, str1, getstr(t1)); Ref(char *, str2, getstr(t2)); term->str = str("%s%s", str1, str2); RefEnd2(str2, str1); RefReturn(term); }
/* 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); }
/* letbindings -- create a new Binding containing let-bound variables */ static Binding *letbindings(Tree *defn0, Binding *outer0, Binding *context0, int evalflags) { Ref(Binding *, binding, outer0); Ref(Binding *, context, context0); Ref(Tree *, defn, defn0); for (; defn != NULL; defn = defn->u[1].p) { assert(defn->kind == nList); if (defn->u[0].p == NULL) continue; Ref(Tree *, assign, defn->u[0].p); assert(assign->kind == nAssign); Ref(List *, vars, glom(assign->u[0].p, context, FALSE)); Ref(List *, values, glom(assign->u[1].p, context, TRUE)); if (vars == NULL) fail("es:let", "null variable name"); for (; vars != NULL; vars = vars->next) { List *value; Ref(char *, name, getstr(vars->term)); if (values == NULL) value = NULL; else if (vars->next == NULL || values->next == NULL) { value = values; values = NULL; } else { value = mklist(values->term, NULL); values = values->next; } binding = mkbinding(name, value, binding); RefEnd(name); } RefEnd3(values, vars, assign); } RefEnd2(defn, context); RefReturn(binding); }
extern Closure *getclosure(Term *term) { if (term->closure == NULL) { char *s = term->str; assert(s != NULL); if ( ((*s == '{' || *s == '@') && s[strlen(s) - 1] == '}') || (*s == '$' && s[1] == '&') || hasprefix(s, "%closure") ) { Ref(Term *, tp, term); Ref(Tree *, np, parsestring(s)); if (np == NULL) { RefPop2(np, tp); return NULL; } tp->closure = extractbindings(np); tp->str = NULL; term = tp; RefEnd2(np, tp); } } return term->closure; }
/* 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); }
/* expandhome -- do tilde expansion by calling fn %home */ static char *expandhome(char *s, StrList *qp) { int c; size_t slash; List *fn = varlookup("fn-%home", NULL); assert(*s == '~'); assert(qp->str == UNQUOTED || *qp->str == 'r'); if (fn == NULL) return s; for (slash = 1; (c = s[slash]) != '/' && c != '\0'; slash++) ; Ref(char *, string, s); Ref(StrList *, quote, qp); Ref(List *, list, NULL); RefAdd(fn); if (slash > 1) list = mklist(mkstr(gcndup(s + 1, slash - 1)), NULL); RefRemove(fn); list = eval(append(fn, list), NULL, 0); if (list != NULL) { if (list->next != NULL) fail("es:expandhome", "%%home returned more than one value"); Ref(char *, home, getstr(list->term)); if (c == '\0') { string = home; quote->str = QUOTED; } else { char *q; size_t pathlen = strlen(string); size_t homelen = strlen(home); size_t len = pathlen - slash + homelen; s = gcalloc(len + 1, &StringTag); memcpy(s, home, homelen); memcpy(&s[homelen], &string[slash], pathlen - slash); s[len] = '\0'; string = s; q = quote->str; if (q == UNQUOTED) { q = gcalloc(len + 1, &StringTag); memset(q, 'q', homelen); memset(&q[homelen], 'r', pathlen - slash); q[len] = '\0'; } else if (strchr(q, 'r') == NULL) q = QUOTED; else { q = gcalloc(len + 1, &StringTag); memset(q, 'q', homelen); memcpy(&q[homelen], "e->str[slash], pathlen - slash); q[len] = '\0'; } quote->str = q; } RefEnd(home); } RefEnd2(list, quote); RefReturn(string); }
/* eval -- evaluate a list, producing a list */ extern List *eval(List *list0, Binding *binding0, int flags) { Closure *volatile cp; List *fn; if (++evaldepth >= maxevaldepth) fail("es:eval", "max-eval-depth exceeded"); Ref(List *, list, list0); Ref(Binding *, binding, binding0); Ref(char *, funcname, NULL); restart: if (list == NULL) { RefPop3(funcname, binding, list); --evaldepth; return true; } assert(list->term != NULL); if ((cp = getclosure(list->term)) != NULL) { switch (cp->tree->kind) { case nPrim: assert(cp->binding == NULL); list = prim(cp->tree->u[0].s, list->next, binding, flags); break; case nThunk: list = walk(cp->tree->u[0].p, cp->binding, flags); break; case nLambda: ExceptionHandler Push p; Ref(Tree *, tree, cp->tree); Ref(Binding *, context, bindargs(tree->u[0].p, list->next, cp->binding)); if (funcname != NULL) varpush(&p, "0", mklist(mkterm(funcname, NULL), NULL)); list = walk(tree->u[1].p, context, flags); if (funcname != NULL) varpop(&p); RefEnd2(context, tree); CatchException (e) if (termeq(e->term, "return")) { list = e->next; goto done; } throw(e); EndExceptionHandler break; case nList: { list = glom(cp->tree, cp->binding, TRUE); list = append(list, list->next); goto restart; } default: panic("eval: bad closure node kind %d", cp->tree->kind); } goto done; } /* the logic here is duplicated in $&whatis */ Ref(char *, name, getstr(list->term)); fn = varlookup2("fn-", name, binding); if (fn != NULL) { funcname = name; list = append(fn, list->next); RefPop(name); goto restart; } if (isabsolute(name)) { char *error = checkexecutable(name); if (error != NULL) fail("$&whatis", "%s: %s", name, error); list = forkexec(name, list, flags & eval_inchild); RefPop(name); goto done; } RefEnd(name); fn = pathsearch(list->term); if (fn != NULL && fn->next == NULL && (cp = getclosure(fn->term)) == NULL) { char *name = getstr(fn->term); list = forkexec(name, list, flags & eval_inchild); goto done; } list = append(fn, list->next); goto restart; done: --evaldepth; if ((flags & eval_exitonfalse) && !istrue(list)) exit(exitstatus(list)); RefEnd2(funcname, binding); RefReturn(list); }
/* forloop -- evaluate a for loop */ static List *forloop(Tree *defn0, Tree *body0, Binding *binding, int evalflags) { static List MULTIPLE = { NULL, NULL }; Ref(List *, result, true); Ref(Binding *, outer, binding); Ref(Binding *, looping, NULL); Ref(Tree *, body, body0); Ref(Tree *, defn, defn0); for (; defn != NULL; defn = defn->u[1].p) { assert(defn->kind == nList); if (defn->u[0].p == NULL) continue; Ref(Tree *, assign, defn->u[0].p); assert(assign->kind == nAssign); Ref(List *, vars, glom(assign->u[0].p, outer, FALSE)); Ref(List *, list, glom(assign->u[1].p, outer, TRUE)); if (vars == NULL) fail("es:for", "null variable name"); for (; vars != NULL; vars = vars->next) { char *var = getstr(vars->term); looping = mkbinding(var, list, looping); list = &MULTIPLE; } RefEnd3(list, vars, assign); SIGCHK(); } looping = reversebindings(looping); RefEnd(defn); ExceptionHandler for (;;) { Boolean allnull = TRUE; Ref(Binding *, bp, outer); Ref(Binding *, lp, looping); Ref(Binding *, sequence, NULL); for (; lp != NULL; lp = lp->next) { Ref(List *, value, NULL); if (lp->defn != &MULTIPLE) sequence = lp; assert(sequence != NULL); if (sequence->defn != NULL) { value = mklist(sequence->defn->term, NULL); sequence->defn = sequence->defn->next; allnull = FALSE; } bp = mkbinding(lp->name, value, bp); RefEnd(value); } RefEnd2(sequence, lp); if (allnull) { RefPop(bp); break; } result = walk(body, bp, evalflags & eval_exitonfalse); RefEnd(bp); SIGCHK(); } CatchException (e) if (!termeq(e->term, "break")) throw(e); result = e->next; EndExceptionHandler RefEnd3(body, looping, outer); RefReturn(result); }