/* Class functions ... really part of heap.c, but split out here to make it
 * more manageable.
 */

/*

	Copyright (C) 1991-2003 The National Gallery

	This program is free software; you can redistribute it and/or modify
	it under the terms of the GNU General Public License as published by
	the Free Software Foundation; either version 2 of the License, or
	(at your option) any later version.

	This program is distributed in the hope that it will be useful,
	but WITHOUT ANY WARRANTY; without even the implied warranty of
	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
	GNU General Public License for more details.

	You should have received a copy of the GNU General Public License along
	with this program; if not, write to the Free Software Foundation, Inc.,
	51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA

 */

/*

	These files are distributed with VIPS - http://www.vips.ecs.soton.ac.uk

 */

#include "nip4.h"

/*
#define DEBUG_MEMBER
#define DEBUG_VERBOSE
#define DEBUG
#define DEBUG_BUILD
 */

static gboolean
class_is_class(PElement *instance)
{
	if (!PEISCLASS(instance)) {
		char txt[50];
		VipsBuf buf = VIPS_BUF_STATIC(txt);

		if (!itext_value(reduce_context, &buf, instance))
			return FALSE;
		error_top(_("Bad argument"));
		error_sub(_("object %s is not a class"),
			vips_buf_all(&buf));

		return FALSE;
	}

	return TRUE;
}

Compile *
class_get_compile(PElement *instance)
{
	if (!class_is_class(instance))
		return NULL;

	return PEGETCLASSCOMPILE(instance);
}

/* Look up "super" in a class ... try to do it quickly.
 */
gboolean
class_get_super(PElement *instance, PElement *out)
{
	Compile *compile;

	if (!(compile = class_get_compile(instance)))
		return FALSE;
	g_assert(compile->super);

	return class_get_symbol(instance, compile->super, out);
}

void *
class_map(PElement *instance, class_map_fn fn, void *a, void *b)
{
	PElement member;
	HeapNode *p;

	if (!PEISCLASS(instance))
		return NULL;

	/* Loop over the instance member list.
	 */
	PEGETCLASSMEMBER(&member, instance);
	if (!PEISELIST(&member))
		for (p = PEGETVAL(&member); p; p = GETRIGHT(p)) {
			HeapNode *hn;
			PElement s, v;
			Symbol *sym;
			void *result;

			/* Get the sym/value pair, get the sym.
			 */
			hn = GETLEFT(p);
			PEPOINTLEFT(hn, &s);
			PEPOINTRIGHT(hn, &v);
			sym = PEGETSYMREF(&s);

			if ((result = fn(sym, &v, a, b)))
				return result;
		}

	return NULL;
}

/* Look up a member in a class instance by name. If lookup fails in this
 * instance, try the superclass. Don't search secrets. Point sym and value
 * at the symbol we found and its value. sym can be NULL for no result
 * required.
 */
gboolean
class_get_member(PElement *instance, const char *name,
	Symbol **sym_out, PElement *out)
{
	PElement member;
	PElement super;
	HeapNode *p;

#ifdef DEBUG_MEMBER
	printf("class_get_member: looking up \"%s\" in class ", name);
	pgraph(instance);
#endif /*DEBUG_MEMBER*/

	if (!class_is_class(instance))
		return FALSE;

	/* Search this instance member list.
	 */
	PEGETCLASSMEMBER(&member, instance);
	if (!PEISELIST(&member))
		for (p = PEGETVAL(&member); p; p = GETRIGHT(p)) {
			HeapNode *hn;
			PElement s;
			Symbol *sym;

			/* Get the sym/value pair, get the sym.
			 */
			hn = GETLEFT(p);
			PEPOINTLEFT(hn, &s);

			/* Match?
			 */
			sym = PEGETSYMREF(&s);
			if (strcmp(IOBJECT(sym)->name, name) == 0) {
				/* Found!
				 */
				PEPOINTRIGHT(hn, out);
				if (sym_out)
					*sym_out = sym;

#ifdef DEBUG_MEMBER
				printf("class_get_member: found: ");
				pgraph(out);
#endif /*DEBUG_MEMBER*/

				return TRUE;
			}
		}

	/* Nope ... try the superclass.
	 */
	if (!class_get_super(instance, &super) || !PEISELIST(&super)) {
		/*

			FIXME ... gcc 2.95.2 gets this wrong, tries to
				  eliminate the tail recursion with -O2
				  and makes bad code
				  ... guess how long that took to find
				  ... put this back at some point

		return( class_get_member( &super, name, sym_out, value ) );
		 */
		gboolean result = class_get_member(&super, name,
			sym_out, out);

		return result;
	}

	error_top(_("Member not found"));
	error_sub(_("member \"%s\" not found in class \"%s\""),
		name, IOBJECT(PEGETCLASSCOMPILE(instance)->sym)->name);

	return FALSE;
}

/* Look up a symbol in a class. Write to out, or FALSE for not found. Look up
 * by symbol pointer. Search secrets as well. Try the superclass if lookup
 * fails.
 */
gboolean
class_get_symbol(PElement *instance, Symbol *sym, PElement *out)
{
	HeapNode *p;
	PElement secret;
	PElement super;

#ifdef DEBUG_MEMBER
	printf("class_get_symbol: looking up ");
	symbol_name_print(sym);
	printf("in class ");
	pgraph(instance);
#endif /*DEBUG_MEMBER*/

	if (!class_is_class(instance))
		return FALSE;

	PEGETCLASSSECRET(&secret, instance);
	if (PEISNODE(&secret))
		for (p = PEGETVAL(&secret); p; p = GETRIGHT(p)) {
			PElement s;
			HeapNode *hn;

			/* Get the sym/value pair, get the sym.
			 */
			hn = GETLEFT(p);
			PEPOINTLEFT(hn, &s);

			/* Match?
			 */
			if (PEGETSYMREF(&s) == sym) {
				/* Found!
				 */
				PEPOINTRIGHT(hn, out);

#ifdef DEBUG_MEMBER
				printf("class_get_symbol: found: ");
				pgraph(out);
#endif /*DEBUG_MEMBER*/

				return TRUE;
			}
		}

	/* Nope ... try the superclass.
	 */
	if (!class_get_super(instance, &super) || !PEISELIST(&super)) {
		/*

			FIXME ... gcc 2.95.2 gets this wrong, tries to
				  eliminate the tail recursion with -O2
				  and makes bad code
				  ... guess how long that took to find
				  ... put this back at some point

		return( class_get_member( &super, name, out ) );
		 */
		gboolean result = class_get_symbol(&super, sym, out);

		return result;
	}

	return FALSE;
}

/* Search back up the inheritance tree for an exact instance of this
 * class.
 */
gboolean
class_get_exact(PElement *instance, const char *name, PElement *out)
{
	PElement pe;

	pe = *instance;
	while (!reduce_is_instanceof_exact(reduce_context, name, &pe)) {
		if (!class_get_super(&pe, &pe) || PEISELIST(&pe))
			return FALSE;
	}

	*out = pe;

	return TRUE;
}

/* Stuff we need for class build.
 */
typedef struct {
	Heap *heap;		  /* Heap to build on */
	Symbol *sym;	  /* Sym we are local to */
	PElement *arg;	  /* Args to constructor */
	PElement *this;	  /* Base of instance we are building */
	int i;			  /* Index in arg list */
	Compile *compile; /* Compile for our class */
} ClassBuildInfo;

/* Member sym of class pbi->sym needs secret as an argument ... add it!
 */
static gboolean
class_member_secret(ClassBuildInfo *pbi,
	Symbol *sym, GSList *secret, PElement *out)
{
	Symbol *ssym;
	Heap *heap = pbi->heap;
	HeapNode *apl;

	if (!secret)
		return TRUE;
	ssym = SYMBOL(secret->data);

	/* Make function application for this member.
	 */
	if (NEWNODE(heap, apl))
		return FALSE;
	apl->type = TAG_APPL;
	PEPUTLEFT(apl, out);

	/* Is the secret "this"? Easy.
	 */
	if (ssym == pbi->sym->expr->compile->this) {
		PEPUTRIGHT(apl, pbi->this);
	}
	else {
		/* Look up ssym in pbi->sym's secrets ... should be there
		 * somewhere. Use it's index to find the pbi->arg[] we need.
		 */
		int pos = g_slist_index(
			pbi->sym->expr->compile->secret, ssym);

		/* FIXME ... may not be if we've regenerated one of these
		 * stupid things :-( change this so we always go through
		 * 'this'.
		 */
		if (pos < 0 || pos >= pbi->sym->expr->compile->nsecret) {
			error_top(_("No such secret"));
			error_sub(_("editing local classes which reference "
						"non-local objects is a bit broken at the "
						"moment :-("));
			return FALSE;
		}

		PEPUTRIGHT(apl,
			&pbi->arg[pbi->sym->expr->compile->nsecret - pos - 1]);
	}

	PEPUTP(out, ELEMENT_NODE, apl);

#ifdef DEBUG_VERBOSE
	{
		PElement p1;
		char txt[1024];
		VipsBuf buf = VIPS_BUF_STATIC(txt);

		PEPOINTRIGHT(apl, &p1);
		graph_pelement(pbi->heap, &buf, &p1, TRUE);
		printf("class_member_secret: secret arg ");
		symbol_name_print(ssym);
		printf("to member ");
		symbol_name_print(sym);
		printf("= %s\n", vips_buf_all(&buf));
	}
#endif /*DEBUG_VERBOSE*/

	return class_member_secret(pbi, sym, secret->next, out);
}

/* Add a member to a class.
 */
static void *
add_class_member(Symbol *sym, ClassBuildInfo *pbi, PElement *out)
{
	Heap *heap = pbi->heap;
	HeapNode *base, *sv;
	PElement v;

	/* Is this something that should be part of a class.
	 */
	if (sym->type != SYM_VALUE)
		return NULL;

	/* Make new class-local-list element for this local.
	 */
	if (NEWNODE(heap, base))
		return sym;
	base->type = TAG_CONS;
	PPUTLEFT(base, ELEMENT_ELIST, NULL);
	PEPUTRIGHT(base, out);
	PEPUTP(out, ELEMENT_NODE, base);

	/* Make sym/value pair for this local.
	 */
	if (NEWNODE(heap, sv))
		return sym;
	sv->type = TAG_CONS;
	PPUT(sv, ELEMENT_SYMREF, sym, ELEMENT_SYMBOL, sym);
	PPUTLEFT(base, ELEMENT_NODE, sv);

	/* Build value ... apply args to the symbol.
	 */
	PEPOINTRIGHT(sv, &v);
	if (!class_member_secret(pbi, sym, sym->expr->compile->secret, &v))
		return sym;

#ifdef DEBUG_VERBOSE
	{
		char txt[1024];
		VipsBuf buf = VIPS_BUF_STATIC(txt);

		graph_pelement(heap, &buf, &v, TRUE);
		printf("add_class_member: member \"%s\" of class \"%s\" = %s\n",
			IOBJECT(sym)->name, IOBJECT(pbi->sym)->name,
			vips_buf_all(&buf));
	}
#endif /*DEBUG_VERBOSE*/

	return NULL;
}

/* Add a symbol/value pair to a class.
 */
static gboolean
add_class_svpair(ClassBuildInfo *pbi,
	Symbol *sym, PElement *val, PElement *out)
{
	Heap *heap = pbi->heap;
	HeapNode *base, *sv;

#ifdef DEBUG_VERBOSE
	{
		char txt[1024];
		VipsBuf buf = VIPS_BUF_STATIC(txt);

		graph_pelement(heap, &buf, val, TRUE);
		printf("add_class_svpair: adding parameter \"%s\" to class "
			   "\"%s\" = %s\n",
			IOBJECT(sym)->name, IOBJECT(pbi->sym)->name,
			vips_buf_all(&buf));
	}
#endif /*DEBUG_VERBOSE*/

	/* Make new class-local-list element for this parameter.
	 */
	if (NEWNODE(heap, base))
		return FALSE;
	base->type = TAG_CONS;
	PPUTLEFT(base, ELEMENT_ELIST, NULL);
	PEPUTRIGHT(base, out);
	PEPUTP(out, ELEMENT_NODE, base);

	/* Make sym/value pair for this parameter.
	 */
	if (NEWNODE(heap, sv))
		return FALSE;
	sv->type = TAG_CONS;
	PPUTLEFT(sv, ELEMENT_SYMREF, sym);
	PEPUTRIGHT(sv, val);
	PPUTLEFT(base, ELEMENT_NODE, sv);

	return TRUE;
}

/* Add a parameter (secret or real) to a class.
 */
static void *
add_class_parameter(Symbol *sym, ClassBuildInfo *pbi, PElement *out)
{
	/* Add this symbol/value pair.
	 */
	if (!add_class_svpair(pbi, sym, &pbi->arg[pbi->i], out))
		return sym;

	/* Move arg index on.
	 */
	pbi->i += 1;

	return NULL;
}

/* Add the name member ... build the name string carefully.
 */
static void *
class_new_single_name(Heap *heap, PElement *pe,
	ClassBuildInfo *pbi, PElement *instance)
{
	Symbol *snm = compile_lookup(pbi->compile, MEMBER_NAME);

	/* Make class name string. We want local classes to name as:
	 *
	 *   A = class {
	 *     B = class {
	 *     }
	 *   }
	 *
	 * then:
	 *
	 *   dir A == ["this", "name", "super", "A", "B"]
	 *   dir A.B == ["this", "name", "super", "B"]
	 *   A.B.name == B
	 *
	 * So A.B.name must be a member of (dir A.B) .
	 */
	PEPUTP(pe, ELEMENT_ELIST, NULL);
	if (!heap_managedstring_new(heap, IOBJECT(pbi->sym)->name, pe))
		return heap;

	/* Add as a member.
	 */
	if (!add_class_svpair(pbi, snm, pe, instance))
		return heap;

	return NULL;
}

/* Make a single level class instance ... fn below then loops over a class
 * hierarchy with this.
 */
static gboolean
class_new_single(Heap *heap,
	Compile *compile, PElement *arg, PElement *this, PElement *out)
{
	Symbol *sym = compile->sym;
	Symbol *sths = compile->this;

	HeapNode *base, *sm;
	PElement p1;
	ClassBuildInfo pbi;

#ifdef DEBUG
	{
		int i;

		printf("class_new_single: starting for ");
		symbol_name_print(sym);
		printf("%d secrets, %d params\n",
			compile->nsecret, compile->nparam);

		for (i = 0; i < compile->nsecret; i++) {
			char txt[256];
			VipsBuf buf = VIPS_BUF_STATIC(txt);

			graph_pelement(heap, &buf, &arg[i], TRUE);
			printf("\tsecret %2d = %s\n", i, vips_buf_all(&buf));
		}

		for (i = 0; i < compile->nparam; i++) {
			char txt[256];
			VipsBuf buf = VIPS_BUF_STATIC(txt);

			graph_pelement(heap, &buf, &arg[i + compile->nsecret], TRUE);
			printf("\targ %2d = %s\n", i, vips_buf_all(&buf));
		}
	}
#endif /*DEBUG*/

	/* Make class base.
	 */
	if (NEWNODE(heap, base))
		return FALSE;
	base->type = TAG_CLASS;
	PPUT(base, ELEMENT_COMPILEREF, compile, ELEMENT_ELIST, NULL);
	PEPUTP(out, ELEMENT_NODE, base);

	/* Make node for holding secrets and members.
	 */
	if (NEWNODE(heap, sm))
		return FALSE;
	sm->type = TAG_CONS;
	PPUT(sm, ELEMENT_ELIST, NULL, ELEMENT_ELIST, NULL);
	PPUTRIGHT(base, ELEMENT_NODE, sm);

	/* Build list of members.
	 */
	pbi.heap = heap;
	pbi.sym = sym;
	pbi.arg = arg;
	pbi.this = this;
	pbi.compile = compile;
	PEPOINTRIGHT(sm, &p1);
	if (icontainer_map_rev(ICONTAINER(compile),
			(icontainer_map_fn) add_class_member, &pbi, &p1))
		return FALSE;

	/* Add name member.
	 */
	if (heap_safe_pointer(heap,
			(heap_safe_pointer_fn) class_new_single_name,
			&pbi, &p1, NULL, NULL))
		return FALSE;

	/* Add this member.
	 */
	if (!add_class_svpair(&pbi, sths, this, &p1))
		return FALSE;

	/* Add class parameters to member list.
	 */
	pbi.i = 0;
	if (slist_map2_rev(compile->param,
			(SListMap2Fn) add_class_parameter, &pbi, &p1))
		return FALSE;

	/* Now ... secret list starts off pointing to head of member list.
	 */
	PEPUTLEFT(sm, &p1);

	/* Add all secret parameters to secret list.
	 */
	PEPOINTLEFT(sm, &p1);
	if (slist_map2_rev(compile->secret,
			(SListMap2Fn) add_class_parameter, &pbi, &p1))
		return FALSE;

#ifdef DEBUG
	{
		char txt[256];
		VipsBuf buf = VIPS_BUF_STATIC(txt);

		graph_pelement(heap, &buf, out, TRUE);
		printf("class_new_single: built instance of ");
		symbol_name_print(sym);
		printf(":\n%s\n", vips_buf_all(&buf));
	}
#endif /*DEBUG*/

	return TRUE;
}

/* Look at a scrap of graph and try to find a constructor it might be using.
 * This will only work for really basic functions :-( but it's enough to allow
 * us to pass extra secrets through the superclass. Used by (eg.) Colour when
 * it overrides Value and adds the colourspace arg.
 */
static Compile *
class_guess_constructor(PElement *fn)
{
	if (PEISCONSTRUCTOR(fn))
		return PEGETCOMPILE(fn);
	else if (PEISNODE(fn)) {
		HeapNode *hn = PEGETVAL(fn);

		if (hn->type == TAG_APPL) {
			PElement left;

			PEPOINTLEFT(hn, &left);

			return class_guess_constructor(&left);
		}
	}

	return NULL;
}

/* Look at arg0 and try to extract the arguments (all the RHS of the @ nodes).
 * Return the number of args we found, or -1 if we find crazy stuff.
 */
static int
class_guess_args(PElement arg[], PElement *fn)
{
	if (PEISCONSTRUCTOR(fn))
		return 0;
	else if (PEISNODE(fn)) {
		PElement left;
		int i;

		PEPOINTLEFT(PEGETVAL(fn), &left);
		if ((i = class_guess_args(arg, &left)) == -1)
			return -1;
		if (i >= MAX_SYSTEM) {
			error_top(_("Too many arguments"));
			error_sub(_("you can't have more than %d "
						"arguments to a superclass constructor"),
				MAX_SYSTEM);

			return -1;
		}

		PEPOINTRIGHT(PEGETVAL(fn), &arg[i]);

		return i + 1;
	}
	else
		return -1;
}

static void *
class_new_super_sub(Heap *heap, PElement *p1,
	Compile *compile, PElement *arg, PElement *this, PElement *super)
{
	/* Build the superclass ... we overwrite the super
	 * list with the constructed class, so make a copy of
	 * the pointer to stop it being GCed.
	 */
	PEPUTPE(p1, super);

	if (!class_new_single(heap, compile, arg, this, super))
		return heap;

	return NULL;
}

/* Clone a class instance. Copy pointers to the the args, secrets and super;
 * rebuild with the specified "this". Instance and out can be equal.
 */
static gboolean
class_clone_super(Heap *heap, Compile *compile,
	PElement *instance, PElement *this, PElement *out)
{
	PElement arg[MAX_SYSTEM];
	const int nargs = compile->nsecret + compile->nparam;
	PElement secret;
	int i;

	g_assert(nargs <= MAX_SYSTEM);

#ifdef DEBUG_VERBOSE
	{
		char txt[MAX_STRSIZE];
		VipsBuf buf = VIPS_BUF_STATIC(txt);

		graph_pelement(heap, &buf, instance, TRUE);
		printf("class_new_clone: about to clone \"%s\": %s\n",
			IOBJECT(compile->sym)->name, vips_buf_all(&buf));
	}
#endif /*DEBUG_VERBOSE*/

	/* Pull out values of secrets and class args into arg[].
	 */
	PEGETCLASSSECRET(&secret, instance);
	for (i = 0; i < nargs; i++) {
		HeapNode *hn = PEGETVAL(&secret);
		HeapNode *sv = GETLEFT(hn);
		int index = nargs - i - 1;

		PEPOINTRIGHT(sv, &arg[index]);
		PEPOINTRIGHT(hn, &secret);
	}

	/* Build class again.
	 */
	return class_new_single(heap, compile, arg, this, out);
}

static void *
class_clone_super_sub(Heap *heap, PElement *p1,
	Compile *compile, PElement *instance, PElement *this, PElement *out)
{
	/* instance and out can point to the same node, so save a pointer to
	 * instance to stop it being GCed.
	 */
	PEPUTPE(p1, instance);

	if (!class_clone_super(heap, compile, instance, this, out))
		return heap;

	return NULL;
}

/* Does this class have a "super"? Build it and recurse.
 */
gboolean
class_new_super(Heap *heap,
	Compile *compile, PElement *this, PElement *instance)
{
	PElement super;

	if (compile->has_super && class_get_super(instance, &super)) {
		Compile *super_compile;
		int len, fn_len;
		PElement arg0;

		/* It must be a list whose first element is the superclass
		 * constructor, or a partially parameterised constructor, or
		 * the superclass itself (if it has already
		 * been constructed, or has no args). Other elements in the
		 * list are the remaining args.
		 *
		 * We keep the list form, since we want to not build the
		 * superclass until now if we can help it ... otherwise we
		 * have to construct once, then construct again when we clone.
		 */
		if ((len = heap_list_length(&super)) < 1 ||
			!heap_list_index(&super, 0, &arg0) ||
			!heap_reduce_strict(&arg0))
			return FALSE;

		if ((super_compile = class_guess_constructor(&arg0))) {
			PElement fn_arg[MAX_SYSTEM];
			PElement arg[MAX_SYSTEM];
			int i;

			/* How many function args are there?
			 */
			if ((fn_len = class_guess_args(fn_arg, &arg0)) < 0)
				return FALSE;

			/* Check total arg count.
			 */
			if (super_compile->nsecret != 0) {
				char txt[1024];
				VipsBuf buf = VIPS_BUF_STATIC(txt);

				slist_map2(super_compile->secret,
					(SListMap2Fn) symbol_name_error,
					&buf, NULL);

				error_top(_("Bad superclass"));
				error_sub(_("superclass constructor \"%s\" "
							"refers to non-local symbols %s"),
					symbol_name(super_compile->sym),
					vips_buf_all(&buf));

				return FALSE;
			}
			if (len - 1 + fn_len != super_compile->nparam) {
				error_top(_("Wrong number of arguments"));
				error_sub(_("superclass constructor \"%s\" "
							"expects %d arguments, not %d"),
					symbol_name(super_compile->sym),
					super_compile->nparam,
					len - 1 + fn_len);

				return FALSE;
			}

			/* Grab the explicit args from the super list.
			 */
			for (i = 0; i < len - 1; i++) {
				if (!heap_list_index(&super, len - 1 - i,
						&arg[i]))
					return FALSE;
			}

			/* Append the function args, but reverse them as we
			 * go so we get most-nested arg last.
			 */
			for (i = 0; i < fn_len; i++)
				arg[i + len - 1] = fn_arg[fn_len - 1 - i];

			/* Build the superclass ... we overwrite the super
			 * list with the constructed class, so make a copy of
			 * the pointer to stop it being GCed.
			 */
			if (heap_safe_pointer(heap,
					(heap_safe_pointer_fn) class_new_super_sub,
					super_compile, arg, this, &super))
				return FALSE;
		}
		else if (PEISCLASS(&arg0)) {
			/* Super is a constructed class ... clone it, but with
			 * our "this" in there. Slow, but useful.
			 */
			super_compile = PEGETCLASSCOMPILE(&arg0);

			if (heap_safe_pointer(heap,
					(heap_safe_pointer_fn) class_clone_super_sub,
					super_compile, &arg0, this, &super))
				return FALSE;
		}
		else {
			char txt1[300];
			VipsBuf buf1 = VIPS_BUF_STATIC(txt1);
			char txt2[300];
			VipsBuf buf2 = VIPS_BUF_STATIC(txt2);

			error_top(_("Bad superclass"));

			itext_value(reduce_context, &buf1, &arg0);
			vips_buf_appendf(&buf2,
				_("first element in superclass of \"%s\" "
				  "must be class or constructor"),
				symbol_name(compile->sym));
			vips_buf_appendf(&buf2, "\n");
			vips_buf_appendf(&buf2, _("You passed:"));
			error_sub("%s\n  %s",
				vips_buf_all(&buf2), vips_buf_all(&buf1));

			return FALSE;
		}

		/* And recursively build any superclasses.
		 */
		if (!class_new_super(heap, super_compile, this, &super))
			return FALSE;
	}

	return TRUE;
}

/* Make a class instance.
 */
gboolean
class_new(Heap *heap, Compile *compile, HeapNode **arg, PElement *out)
{
	int i;
	PElement pe_arg[MAX_SYSTEM];

	/* Make a set of arg pointers.
	 */
	if (compile->nparam + compile->nsecret >= MAX_SYSTEM) {
		error_top(_("Too many arguments"));
		error_sub(_("too many arguments to class constructor \"%s\". "
					"No more than %d arguments are supported"),
			symbol_name(compile->sym), MAX_SYSTEM);
		return FALSE;
	}
	for (i = 0; i < compile->nparam + compile->nsecret; i++) {
		PEPOINTRIGHT(arg[i], &pe_arg[i]);
	}

	/* Build the base instance.
	 */
	if (!class_new_single(heap, compile, pe_arg, out, out))
		return FALSE;

	/* And recursively build any superclasses.
	 */
	if (!class_new_super(heap, compile, out, out))
		return FALSE;

#ifdef DEBUG_BUILD
	{
		char txt[MAX_STRSIZE];
		VipsBuf buf = VIPS_BUF_STATIC(txt);

		graph_pelement(heap, &buf, out, TRUE);
		printf("class_new: built instance of \"%s\": %s\n",
			IOBJECT(compile->sym)->name, vips_buf_all(&buf));
	}
#endif /*DEBUG_BUILD*/

	return TRUE;
}

/* Clone a class instance. Copy pointers to the the args, secrets and super;
 * regenerate all the members. instance and out can be equal.
 */
gboolean
class_clone_args(Heap *heap, PElement *instance, PElement *out)
{
	HeapNode *arg[MAX_SYSTEM];
	Compile *compile = PEGETCLASSCOMPILE(instance);
	const int nargs = compile->nsecret + compile->nparam;
	PElement secret;
	int i;

	g_assert(nargs <= MAX_SYSTEM);

#ifdef DEBUG_VERBOSE
	{
		char txt[MAX_STRSIZE];
		VipsBuf buf = VIPS_BUF_STATIC(txt);

		graph_pelement(heap, &buf, instance, TRUE);
		printf("class_clone_args: about to clone \"%s\": %s\n",
			IOBJECT(compile->sym)->name, vips_buf_all(&buf));
	}
#endif /*DEBUG_VERBOSE*/

	/* Pull out values of secrets and class args into RHS of arg[].
	 */
	PEGETCLASSSECRET(&secret, instance);
	for (i = 0; i < nargs; i++) {
		HeapNode *hn = PEGETVAL(&secret);
		HeapNode *sv = GETLEFT(hn);
		int index = nargs - i - 1;

		arg[index] = sv;
		PEPOINTRIGHT(hn, &secret);
	}

	/* Build class again.
	 */
	return class_new(heap, compile, &arg[0], out);
}

/* Build a class instance picking parameters from C args ... handy for
 * making a new toggle instance on a click, for example.
 */
gboolean
class_newv(Heap *heap, const char *name, PElement *out, ...)
{
	va_list ap;
	Symbol *sym;
	Compile *compile;
	HeapNode args[MAX_SYSTEM];
	HeapNode *pargs[MAX_SYSTEM];
	int i;

	if (!(sym = compile_lookup(symbol_root->expr->compile, name)) ||
		!is_value(sym) || !is_class(sym->expr->compile)) {
		error_top(_("Class not found"));
		error_sub(_("class \"%s\" not found"), name);
		return FALSE;
	}
	compile = sym->expr->compile;
	if (compile->nparam >= MAX_SYSTEM) {
		error_top(_("Too many arguments"));
		error_sub(_("too many arguments to class constructor \"%s\". "
					"No more than %d arguments are supported"),
			symbol_name(compile->sym), MAX_SYSTEM);
		return FALSE;
	}

	va_start(ap, out);
	for (i = 0; i < compile->nparam; i++) {
		PElement *arg = va_arg(ap, PElement *);
		PElement rhs;

		pargs[i] = &args[i];
		PEPOINTRIGHT(pargs[i], &rhs);
		PEPUTPE(&rhs, arg);
	}
	va_end(ap);

	return class_new(heap, compile, &pargs[0], out);
}

static void
class_typecheck_error(PElement *instance, const char *name, const char *type)
{
	char txt[1024];
	VipsBuf buf = VIPS_BUF_STATIC(txt);
	PElement val;

	vips_buf_appendf(&buf, _("member \"%s\" of class \"%s\" "
							 "should be of type \"%s\", instead it's:"),
		name,
		IOBJECT(PEGETCLASSCOMPILE(instance)->sym)->name,
		type);
	vips_buf_appends(&buf, "\n   ");
	if (class_get_member(instance, name, NULL, &val) &&
		!itext_value(reduce_context, &buf, &val))
		return;

	error_top(_("Bad argument"));
	error_sub("%s", vips_buf_all(&buf));
}

/* A function that gets a type from a class.
 */
typedef gboolean (*ClassGetFn)(PElement *, void *);

static gboolean
class_get_member_check(PElement *instance, const char *name, const char *type,
	ClassGetFn fn, void *a)
{
	PElement val;

	if (!class_get_member(instance, name, NULL, &val))
		return FALSE;

	if (!fn(&val, a)) {
		class_typecheck_error(instance, name, type);
		return FALSE;
	}

	return TRUE;
}

gboolean
class_get_member_bool(PElement *instance, const char *name, gboolean *out)
{
	return class_get_member_check(instance, name, "bool",
		(ClassGetFn) heap_get_bool, out);
}

gboolean
class_get_member_real(PElement *instance, const char *name, double *out)
{
	return class_get_member_check(instance, name, "real",
		(ClassGetFn) heap_get_real, out);
}

gboolean
class_get_member_int(PElement *instance, const char *name, int *out)
{
	double d;

	if (!class_get_member_check(instance, name, "real",
			(ClassGetFn) heap_get_real, &d))
		return FALSE;
	*out = rint(d);

	return TRUE;
}

gboolean
class_get_member_class(PElement *instance, const char *name,
	const char *type, PElement *out)
{
	gboolean result;

	if (!class_get_member_check(instance, name, type,
			(ClassGetFn) heap_get_class, out))
		return FALSE;

	if (!heap_is_instanceof(type, out, &result))
		return FALSE;
	if (!result) {
		class_typecheck_error(instance, name, type);
		return FALSE;
	}

	return TRUE;
}

gboolean
class_get_member_image(PElement *instance, const char *name, Imageinfo **out)
{
	return class_get_member_check(instance, name, "image",
		(ClassGetFn) heap_get_image, out);
}

gboolean
class_get_member_lstring(PElement *instance, const char *name,
	GSList **labels)
{
	return class_get_member_check(instance, name, "finite [[char]]",
		(ClassGetFn) heap_get_lstring, labels);
}

gboolean
class_get_member_string(PElement *instance, const char *name,
	char *buf, int sz)
{
	PElement val;

	if (!class_get_member(instance, name, NULL, &val))
		return FALSE;

	if (!heap_get_string(&val, buf, sz)) {
		class_typecheck_error(instance, name, "finite [char]");
		return FALSE;
	}

	return TRUE;
}

gboolean
class_get_member_instance(PElement *instance,
	const char *name, const char *klass, PElement *out)
{
	gboolean result;

	return class_get_member(instance, name, NULL, out) &&
		heap_is_instanceof(klass, out, &result) &&
		result;
}

gboolean
class_get_member_matrix_size(PElement *instance, const char *name,
	int *xsize, int *ysize)
{
	PElement val;

	if (!class_get_member(instance, name, NULL, &val))
		return FALSE;

	if (!heap_get_matrix_size(&val, xsize, ysize)) {
		class_typecheck_error(instance, name,
			"finite rectangular [[real]]");
		return FALSE;
	}

	return TRUE;
}

gboolean
class_get_member_matrix(PElement *instance, const char *name,
	double *buf, int n, int *xsize, int *ysize)
{
	PElement val;

	if (!class_get_member(instance, name, NULL, &val))
		return FALSE;

	if (!heap_get_matrix(&val, buf, n, xsize, ysize)) {
		class_typecheck_error(instance, name,
			"finite rectangular [[real]]");
		return FALSE;
	}

	return TRUE;
}

gboolean
class_get_member_realvec(PElement *instance, const char *name,
	double *buf, int n, int *length)
{
	PElement val;
	int l;

	if (!class_get_member(instance, name, NULL, &val))
		return FALSE;

	if ((l = heap_get_realvec(&val, buf, n)) < 0) {
		class_typecheck_error(instance, name, "finite [real]");
		return FALSE;
	}

	*length = l;

	return TRUE;
}
