Ejemplo n.º 1
0
/* assign -- bind a list of values to a list of variables */
static List *assign(Tree *varform, Tree *valueform0, Binding *binding0) {
	Ref(List *, result, NULL);

	Ref(Tree *, valueform, valueform0);
	Ref(Binding *, binding, binding0);
	Ref(List *, vars, glom(varform, binding, FALSE));

	if (vars == NULL)
		fail("es:assign", "null variable name");

	Ref(List *, values, glom(valueform, binding, TRUE));
	result = values;

	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;
		}
		vardef(name, binding, value);
		RefEnd(name);
	}

	RefEnd4(values, vars, binding, valueform);
	RefReturn(result);
}
Ejemplo n.º 2
0
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);
}
Ejemplo n.º 3
0
/* 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);
}
Ejemplo n.º 4
0
extern Term *mkterm(char *str, Closure *closure) {
	gcdisable();
	Ref(Term *, term, gcnew(Term));
	term->str = str;
	term->closure = closure;
	gcenable();
	RefReturn(term);
}
Ejemplo n.º 5
0
/* listify -- turn an argc/argv vector into a list */
extern List *listify(int argc, char **argv) {
    Ref(List *, list, NULL);
    while (argc > 0) {
        Term *term = mkterm(argv[--argc], NULL);
        list = mklist(term, list);
    }
    RefReturn(list);
}
Ejemplo n.º 6
0
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);
}
Ejemplo n.º 7
0
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);
}
Ejemplo n.º 8
0
static Var *mkvar(List *defn) {
	Ref(Var *, var, NULL);
	Ref(List *, lp, defn);
	var = gcnew(Var);
	var->env = NULL;
	var->defn = lp;
	var->flags = hasbindings(lp) ? var_hasbindings : 0;
	RefEnd(lp);
	RefReturn(var);
}
Ejemplo n.º 9
0
/* local -- build, recursively, one layer of local assignment */
static List *local(Tree *defn, Tree *body0,
		   Binding *bindings0, int evalflags) {
	Ref(List *, result, NULL);
	Ref(Tree *, body, body0);
	Ref(Binding *, bindings, bindings0);
	Ref(Binding *, dynamic,
	    reversebindings(letbindings(defn, NULL, bindings, evalflags)));

	result = localbind(dynamic, bindings, body, evalflags);

	RefEnd3(dynamic, bindings, body);
	RefReturn(result);
}
Ejemplo n.º 10
0
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);
}
Ejemplo n.º 11
0
/* extractpattern -- Like matchpattern, but returns matches */
static List *extractpattern(Tree *subjectform0, Tree *patternform0,
			    Binding *binding) {
	List *pattern;
	StrList *quote = NULL;
	Ref(List *, result, NULL);
	Ref(Binding *, bp, binding);
	Ref(Tree *, patternform, patternform0);
	Ref(List *, subject, glom(subjectform0, bp, TRUE));
	pattern = glom2(patternform, bp, &quote);
	result = (List *) extractmatches(subject, pattern, quote);
	RefEnd3(subject, patternform, bp);
	RefReturn(result);
}
Ejemplo n.º 12
0
static List *callsettor(char *name, List *defn) {
	Push p;
	List *settor;

	if (specialvar(name) || (settor = varlookup2("set-", name, NULL)) == NULL)
		return defn;

	Ref(List *, lp, defn);
	Ref(List *, fn, settor);
	varpush(&p, "0", mklist(mkstr(name), NULL));

	lp = listcopy(eval(append(fn, lp), NULL, 0));

	varpop(&p);
	RefEnd(fn);
	RefReturn(lp);
}
Ejemplo n.º 13
0
/* 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);
}
Ejemplo n.º 14
0
/* localbind -- recursively convert a Bindings list into dynamic binding */
static List *localbind(Binding *dynamic0, Binding *lexical0,
		       Tree *body0, int evalflags) {
	if (dynamic0 == NULL)
		return walk(body0, lexical0, evalflags);
	else {
		Push p;
		Ref(List *, result, NULL);
		Ref(Tree *, body, body0);
		Ref(Binding *, dynamic, dynamic0);
		Ref(Binding *, lexical, lexical0);

		varpush(&p, dynamic->name, dynamic->defn);
		result = localbind(dynamic->next, lexical, body, evalflags);
		varpop(&p);

		RefEnd3(lexical, dynamic, body);
		RefReturn(result);
	}
}
Ejemplo n.º 15
0
/* 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);
}
Ejemplo n.º 16
0
/* 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);
}
Ejemplo n.º 17
0
/* listvars -- return a list of all the (dynamic) variables */
extern List *listvars(Boolean internal) {
	Ref(List *, varlist, NULL);
	dictforall(vars, internal ? listinternal : listexternal, &varlist);
	varlist = sortlist(varlist);
	RefReturn(varlist);
}
Ejemplo n.º 18
0
/* 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], &quote->str[slash], pathlen - slash);
				q[len] = '\0';
			}
			quote->str = q;
		}
		RefEnd(home);
	}
	RefEnd2(list, quote);
	RefReturn(string);
}
Ejemplo n.º 19
0
/* 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);
}
Ejemplo n.º 20
0
/* 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);
}