<commit_before>#include <value.h>
#include <basic.h>
#include <die.h>
#include <memory.h>
#include <num.h>
#include <output.h>
#include <source.h>
#include <str.h>
#include <type_num.h>
#include <type_str.h>
#include <type_sym.h>

static void sym_free(symbol sym)
	{
	drop(sym->name);
	free_memory(sym,sizeof(struct symbol));
	}

value type_sym(value f)
	{
	if (!f->L) return 0;
	replace_void(f);
	return 0;
	}

value Qsym(string name, unsigned long line)
	{
	symbol sym = new_memory(sizeof(struct symbol));
	sym->name = Qstr(name);
	sym->line = line;
	return D(type_sym,sym,(type)sym_free);
	}

/* Apply f to g, where either can be a symbolic form. */
value app(value f, value g)
	{
	type t = (f->T == type_sym || g->T == type_sym) ? type_sym : type_A;
	return V(t,f,g);
	}

static int sym_eq(symbol x, symbol y)
	{
	return str_eq(data(x->name),data(y->name));
	}

static value combine_patterns(value p, value q)
	{
	if (p->T == type_C && q->T == type_C)
		{
		drop(p);
		drop(q);
		return hold(C);
		}
	else
		return A(p,q);
	}

value Qsubst(value p, value f)
	{
	return app(V(type_subst,Q(type_subst),p),f);
	}

/* Abstract the symbol from the body, returning a form which is a function of
that symbol, and no longer contains that symbol. */
static value abstract(value sym, value body)
	{
	if (body->T != type_sym)
		return Qsubst(hold(C),hold(body));
	else if (body->L == 0)
		{
		if (sym_eq(data(sym),data(body)))
			return Qsubst(hold(I),hold(I));
		else
			return Qsubst(hold(C),hold(body));
		}
	else
		{
		value f = abstract(sym,body->L);
		value g = abstract(sym,body->R);
		value h = Qsubst(combine_patterns(hold(f->L->R),hold(g->L->R)),
			app(hold(f->R),hold(g->R)));
		drop(f);
		drop(g);
		return h;
		}
	}

value lam(value sym, value body)
	{
	value f = abstract(sym,body);
	drop(sym);
	drop(body);
	return f;
	}

/* Return the last symbol in the value, if any, in right to left order. */
static value last_sym(value f)
	{
	value sym;
	if (f->T != type_sym) return 0;
	if (f->L == 0) return f;
	sym = last_sym(f->R);
	if (sym) return sym;
	return last_sym(f->L);
	}

static value x;
static value substitute(value p, value f)
	{
	if (p->T == type_C)
		return hold(f);
	else if (p->T == type_I)
		return hold(x);
	else if (p->L->T == type_C)
		return A(hold(f->L),substitute(p->R,f->R));
	else
		return A(substitute(p->L,f->L),substitute(p->R,f->R));
	}

/* (subst pattern form arg) */
value type_subst(value f)
	{
	if (!f->L || !f->L->L || !f->L->L->L) return 0;
	x = f->R;
	replace(f,substitute(f->L->L->R,f->L->R));
	return f;
	}

static void undefined_symbol(const char *name, unsigned long line)<commit_msg>Tune up the substitution mechanism a bit.<commit_after>#include <value.h>
#include <basic.h>
#include <die.h>
#include <memory.h>
#include <num.h>
#include <output.h>
#include <source.h>
#include <str.h>
#include <type_num.h>
#include <type_str.h>
#include <type_sym.h>

static void sym_free(symbol sym)
	{
	drop(sym->name);
	free_memory(sym,sizeof(struct symbol));
	}

value type_sym(value f)
	{
	if (!f->L) return 0;
	replace_void(f);
	return 0;
	}

value Qsym(string name, unsigned long line)
	{
	symbol sym = new_memory(sizeof(struct symbol));
	sym->name = Qstr(name);
	sym->line = line;
	return D(type_sym,sym,(type)sym_free);
	}

/* Apply f to g, where either can be a symbolic form. */
value app(value f, value g)
	{
	type t = (f->T == type_sym || g->T == type_sym) ? type_sym : type_A;
	return V(t,f,g);
	}

static int sym_eq(symbol x, symbol y)
	{
	return str_eq(data(x->name),data(y->name));
	}

static value combine_patterns(value p, value q)
	{
	if (p == C && q == C)
		{
		drop(p);
		drop(q);
		return hold(C);
		}
	else
		return A(p,q);
	}

value Qsubst(value p, value f)
	{
	return app(V(type_subst,Q(type_subst),p),f);
	}

/* Abstract the symbol from the body, returning a form which is a function of
that symbol, and no longer contains that symbol. */
static value abstract(value sym, value body)
	{
	if (body->T != type_sym)
		return Qsubst(hold(C),hold(body));
	else if (body->L == 0)
		{
		if (sym_eq(data(sym),data(body)))
			return Qsubst(hold(I),hold(I));
		else
			return Qsubst(hold(C),hold(body));
		}
	else
		{
		value f = abstract(sym,body->L);
		value g = abstract(sym,body->R);
		value h = Qsubst(combine_patterns(hold(f->L->R),hold(g->L->R)),
			app(hold(f->R),hold(g->R)));
		drop(f);
		drop(g);
		return h;
		}
	}

value lam(value sym, value body)
	{
	value f = abstract(sym,body);
	drop(sym);
	drop(body);
	return f;
	}

/* Return the last symbol in the value, if any, in right to left order. */
static value last_sym(value f)
	{
	value sym;
	if (f->T != type_sym) return 0;
	if (f->L == 0) return f;
	sym = last_sym(f->R);
	if (sym) return sym;
	return last_sym(f->L);
	}

/* Make a copy of f, but substitute x wherever I appears in pattern p.  There
are a couple of cases where I look ahead at p->L for optimization purposes.  At
this time it makes the code 1112 bytes smaller, and a certain test runs about
3.5% faster.  At some point we might want to replace substitution patterns with
trees of function pointers to avoid the conditional branching, which might be
faster in itself, but might also give us more opportunities for "long reach"
patterns that do certain common substitutions "all at once".
*/
static value x;
static value substitute(value p, value f)
	{
	if (p == C)
		return hold(f);
	else if (p == I)
		return hold(x);
	else if (p->L == I)
		return A(hold(x),substitute(p->R,f->R));
	else if (p->L == C)
		return A(hold(f->L),substitute(p->R,f->R));
	else
		return A(substitute(p->L,f->L),substitute(p->R,f->R));
	}

/* (subst pattern form arg) */
value type_subst(value f)
	{
	if (!f->L || !f->L->L || !f->L->L->L) return 0;
	x = f->R;
	replace(f,substitute(f->L->L->R,f->L->R));
	return f;
	}

static void undefined_symbol(const char *name, unsigned long line)
{'fraction_non_alphanumeric': 0.17394281801061462, 'fraction_numerical': 0.0030816640986132513, 'mean_word_length': 3.872393661384487, 'pattern_counts': {'":': 0, '<': 25, '<?xml version=': 0, '>': 118, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '5674228', 'n_tokens_mistral': 2446, 'n_tokens_neox': 2348, 'n_words': 659}