/* --- Copyright University of Sussex 1994. All rights reserved. ----------
 > File:            C.all/lisp/src/clos-utils.p
 > Purpose:         Utility procedures for CLOS. Maybe merge with 'util.p'.
 > Author:          John Williams, Apr 26 1994
 > Documentation:
 > Related Files:   C.all/lisp/src/clos.p, C.all/lisp/src/methods.p
 */

lisp_compile_mode;

section $-lisp;

define vmember(item, vector);
	lvars i, item, vector;
	fast_for i from 1 to fast_vector_length(vector) do
		if fast_subscrv(i, vector) == item then
			return(i)
		endif
	endfast_for;
	false
enddefine;


define pushnew(item, list) -> list;
	lvars item, list;
	unless lmember(item, list) do
		conspair(item, list) -> list
	endunless
enddefine;


define ncdelete_if(list, p) -> list;
	lvars list, p, l;
	returnif(list == []);
	while apply(front(list), p) do
		back(list) -> list;
		returnif(list == [])
	endwhile;
	list -> l;
	until back(l) == [] do
		if apply(front(back(l)), p) then
			back(back(l)) -> back(l)
		else
			back(l) -> l
		endif
	enduntil
enddefine;


define on_stack(thing);
	lvars thing, n = 1, item;
	repeat
		subscr_stack(n) -> item;
		if item == popstackmark then
			return(false)
		elseif item == thing then
			return(true)
		else
			n fi_+ 1 -> n
		endif
	endrepeat
enddefine;


/* Insertion procedure used when creating ordered list of applicable methods */

define insert(item, list, before_p) -> list;
	lvars item, list, procedure before_p, l, prev;
	if list == [] then
		conspair(item, list) -> list
	else
		list -> l;
		false -> prev;
		repeat
			if l == [] or before_p(item, front(l)) then
				conspair(item, l);
				if prev then
					-> back(prev)
				else
					-> list
				endif;
				return
			else
				l -> prev;
				back(l) -> l
			endif
		endrepeat
	endif
enddefine;


define define_fast_accessors(key);
	lvars key, pvec, p, n, slow, w;
	unless iskey(key) and is_record_key(key) do
		mishap(0, 'RECORD CLASS KEY NEEDED')
	endunless;
	cons_access(initl(datalength(key)), class_field_spec(key), false, 0)
		-> pvec;
	for p with_index n in_vector pvec do
		class_access(n, key) -> slow;
		pdprops(slow) -> w;
		"fast_" <> w -> w;
		pop11_define_declare(w, false, false, false);
		sysPASSIGN(p, w)
	endfor
enddefine;


define syntax fastprocs;
	lvars item;
	dlocal pop_vm_flags = (pop_vm_flags _biset VM_NOPROT_LVARS);
	until (readitem() ->> item) == ";" do
		nextif(item == ",");
		sysLCONSTANT(item, "macro");
		sysPASSIGN("fast_" <> item, item)
	enduntil;
	";" :: proglist -> proglist
enddefine;


define macro SLOW;
	lvars item;
	readitem() -> item;
	word_identifier(item, current_section, true)
enddefine;


endsection;
