/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1985. */

/*
  $Header: b1tlt.c,v 1.4 85/08/22 16:53:20 timo Exp $
*/

/* generic routines for B texts, lists and tables */

#include "b.h"
#include "b0fea.h"
#include "b1obj.h"
#ifndef INTEGRATION
#include "b0con.h"
#include "b1btr.h"
#include "b1val.h"
#endif
#include "b1tlt.h"
#include "b3err.h"

#ifndef INTEGRATION

/* From b1lta.c */
int l2size();
value l2min(), l2max();

Visible value mk_elt() { /* {}, internal only */
	value e = grab_tlt(ELT, Lt);
	Root(e) = Bnil;
	return e;
}

Visible bool empty(v) value v; { /* #v=0, internal only */
	switch (Type(v)) {
	case ELT:
	case Lis:
	case Tex:
	case Tab:
		return Root(v) EQ Bnil;
	default:
		return No;
		/* Some routines must test empty(t) end return an error
		   message if it fails, before testing Type(t).
		   In this way, they won't give the wrong error message. */
	}
}

/* return size of (number of items in) dependent tree */

Hidden value treesize(pnode) btreeptr pnode; {
    int psize;
    value vsize, childsize, u;
    intlet l;
    psize = Size(pnode);
    if (psize EQ Bigsize) {
	switch (Flag(pnode)) {        
	case Inner:
	    vsize = mk_integer((int) Lim(pnode));
	    for (l = 0; l <= Lim(pnode); l++) {
		childsize = treesize(Ptr(pnode, l));
		u = vsize;
		vsize = sum(vsize, childsize);
		release(u);
		release(childsize);
	    }
	    break;
	case Irange: 
	    u = diff(Upbval(pnode), Lwbval(pnode));
	    vsize = sum(u, one);
	    release(u);
	    break;
	case Bottom: 
	case Crange: 
	    syserr(MESS(1700, "Bigsize in Bottom or Crange"));
	}
	return(vsize);
    }
    return mk_integer(psize);
}

Visible value size(t) value t; { /* #t */
	int tsize;
	switch (Type(t)) {
	case ELT:
	case Lis:
	case Tex:
	case Tab:
		tsize = Tltsize(t);
		if (tsize EQ Bigsize) return treesize(Root(t));
		return mk_integer(tsize);
	default:
		reqerr(MESS(1701, "in #t, t is not a text, list or table"));
		return zero;
	}
}

Visible value th_of(num, v) value num, v; { /* num th'of v */
	value m= Vnil;
	if (!Is_tlt(v))
		error(MESS(1702, "in n th'of t, t is not a text, list or table"));
	else if (!Is_number(num))
		error(MESS(1703, "in n th'of t, n is not a number"));
	else if (empty(v))
		error(MESS(1704, "in n th'of t, t is empty"));
	else if (numcomp(num, one) < 0)
		error(MESS(1705, "in n th'of t, n is < 1"));
	else {
		/*RANGES?*/
		m= thof(intval(num), v);
		if (m == Vnil && still_ok)
			error(MESS(1706, "in n th'of t, n exceeds #t"));
	}
	return m;
}

/*
 * 'Walktree' handles functions on texts and associates of tables.
 * The actual function performed is determined by the 'visit' function.
 * The tree is walked (possibly recursively) and all items are visited.
 * The return value of walktree() and visit() is used to determine whether
 * the walk should continue (Yes == continue, No == stop now).
 * Global variables are used to communicate the result, and the parameters
 * of the function. The naming convention is according to "e func t".
 */

Hidden intlet tt;		/* type of walked value t */
Hidden intlet wt;		/* width of items in walked value t */
Hidden value ve; 		/* value of e, if func is dyadic */
Hidden char ce; 		/* C char in e, if t is a text */

Hidden int count; 		/* result of size2 */
Hidden bool found; 		/* result for in */
Hidden intlet m_char; 		/* result for min/max on texts */
Hidden value m_val;		/* result for min/max on tables */

#define Lowchar (-Maxintlet)	/* -infinity for characters */
#define Highchar (Maxintlet)	/* +infinity */

Hidden bool walktree(p, visit) btreeptr p; bool (*visit)(); {
	intlet l;
	
	if (p EQ Bnil) return Yes; /* i.e., not found (used by in() !) */
	for (l=0; l < Lim(p); l++) {
		switch (Flag(p)) {
		case Inner:
			if (!walktree(Ptr(p, l), visit) || !still_ok)
				return No;
			if (!(*visit)(Piitm(p, l, wt)) || !still_ok)
				return No;
			break;
		case Bottom:
			if (!(*visit)(Pbitm(p, l, wt)) || !still_ok)
				return No;
		}
	}
	return Flag(p) EQ Bottom || walktree(Ptr(p, l), visit);
}

/* Common code for min/max-1/2, size2, in. */

Hidden Procedure tlt_func(e, t, where, li_func, te_visit, ta_visit)
	value e, t; 			/* [e] func t */
	string where; 			/* "in [e] func_name t" */
	value (*li_func)(); 		/* func for lists */
	bool (*te_visit)(), (*ta_visit)(); /* 'visit' for walktree */
{
	m_val = Vnil;
	if (empty(t)) {
		error3(MESSMAKE(where), Vnil, MESS(1707, ", t is empty"));
		return;
	}
	wt = Itemwidth(Itemtype(t));
	tt = Type(t);
	switch (tt) {
	case Lis:
		m_val = (*li_func)(e, t);
		break;
	case Tex:
		if (e NE Vnil) {
			if (!Character(e)) {
				error3(MESSMAKE(where), Vnil,
			MESS(1708, ", t is a text, but e is not a character"));
				return;
			}
			ce = Bchar(Root(e), 0);
		}
		found = !walktree(Root(t), te_visit);
		if (m_char NE Lowchar && m_char NE Highchar)
			m_val = mkchar(m_char);
		break;
	case Tab:
		ve = e;
		found = !walktree(Root(t), ta_visit);
		break;
	default:
		error3(MESSMAKE(where), Vnil,
			MESS(1709, ", t is not a text list or table"));
	}
}

Hidden value li2size(e, t) value e, t; {
	count = l2size(e, t);
	return Vnil;
}

Hidden bool te2size(pitm) itemptr pitm; {
	if (ce EQ Charval(pitm))
		count++;
	return Yes;
}

Hidden bool ta2size(pitm) itemptr pitm; {
	if (compare(ve, Ascval(pitm)) EQ 0)
		count++;
	return Yes;
}

Visible value size2(e, t) value e, t; { /* e#t */
	if (empty(t)) /* Must check here because tlt_func would complain */
		return copy(zero);
	m_char = Lowchar;
	count = 0;
	tlt_func(e, t, "in e#t", li2size, te2size, ta2size);
	return mk_integer(count);
}

Hidden value li_in(e, t) value e, t; {
	found = in_keys(e, t);
	return Vnil;
}
	
Hidden bool te_in(pitm) itemptr pitm; {
	return Charval(pitm) NE ce;
}

Hidden bool ta_in(pitm) itemptr pitm; {
	return compare(ve, Ascval(pitm)) NE 0;
}

Visible bool in(e, t) value e, t; {
	if (empty(t)) /* Must check here because tlt_func would complain */
		return No;
	m_char = Lowchar;
	found = No;
	tlt_func(e, t, "in the test e in t", li_in, te_in, ta_in);
	return found;
}

Hidden value li_min(e, t) value e, t; {
	return th_of(one, t);
}

Hidden bool te_min(pitm) itemptr pitm; {
	if (m_char > Charval(pitm))
		m_char = Charval(pitm);
	return Yes;
}

Hidden bool ta_min(pitm) itemptr pitm; {
	if (m_val EQ Vnil || compare(m_val, Ascval(pitm)) > 0) {
		release(m_val);
		m_val = copy(Ascval(pitm));
	}
	return Yes;
}

Visible value min1(t) value t; {
	m_char = Highchar;
	tlt_func(Vnil, t, "in min t", li_min, te_min, ta_min);
	return m_val;
}

Hidden value li_max(e, t) value e, t; {
	value v= size(t);
	m_val = th_of(v, t);
	release(v);
	return m_val;
}

Hidden bool te_max(pitm) itemptr pitm; {
	if (m_char < Charval(pitm))
		m_char = Charval(pitm);
	return Yes;
}

Hidden bool ta_max(pitm) itemptr pitm; {
	if (m_val EQ Vnil || compare(Ascval(pitm), m_val) > 0) {
		release(m_val);
		m_val = copy(Ascval(pitm));
	}
	return Yes;
}

Visible value max1(t) value t; {
	m_char = Lowchar;
	tlt_func(Vnil, t, "in max t", li_max, te_max, ta_max);
	return m_val;
}

Hidden bool te2min(pitm) itemptr pitm; {
	if (m_char > Charval(pitm) && Charval(pitm) > ce) {
		m_char = Charval(pitm);
	}
	return Yes;
}

Hidden bool ta2min(pitm) itemptr pitm; {
	if (compare(Ascval(pitm), ve) > 0
	    &&
	    (m_val EQ Vnil || compare(m_val, Ascval(pitm)) > 0)) {
		release(m_val);
		m_val = copy(Ascval(pitm));
	}
	return Yes;
}

Visible value min2(e, t) value e, t; {
	m_char = Highchar;
	tlt_func(e, t, "in e min t", l2min, te2min, ta2min);
	if (m_val EQ Vnil && still_ok)
		reqerr(MESS(1710, "in e min t, no element of t exceeds e"));
	return m_val;
}

/*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/

Hidden bool te2max(pitm) itemptr pitm; {
	if (ce > Charval(pitm) && Charval(pitm) > m_char) {
		m_char = Charval(pitm);
	}
	return Yes;
}

Hidden bool ta2max(pitm) itemptr pitm; {
	if (compare(ve, Ascval(pitm)) > 0
	    &&
	    (m_val EQ Vnil || compare(Ascval(pitm), m_val) > 0)) {
		release(m_val);
		m_val = copy(Ascval(pitm));
	}
	return Yes;
}

Visible value max2(e, t) value e, t; {
	m_char = Lowchar;
	tlt_func(e, t, "in e max t", l2max, te2max, ta2max);
	if (m_val EQ Vnil && still_ok)
		reqerr(MESS(1711, "in e max t, no element of t is less than e"));
	return m_val;
}

#else INTEGRATION

Visible value mk_elt() { return grab_elt(); }

Visible value size(x) value x; { /* monadic # operator */
	if (!Is_tlt(x))
		error(MESS(1712, "in #t, t is not a text, list or table"));
	return mk_integer((int) Length(x));
}

#define Lisent(tp,k) (*(tp+(k)))

Visible value size2(v, t) value v, t; { /* Dyadic # operator */
	intlet len= Length(t), n= 0, k; value *tp= Ats(t);
	if (!Is_tlt(t)) {
		error(MESS(1713, "in e#t, t is not a text, list or table"));
		return mk_integer((int) n);
	}
	switch (Type(t)) {
	case Tex:
		{string cp= (string)tp; char c;
			if (Type(v) != Tex)
				error(MESS(1714, "in e#t, t is a text but e is not"));
			if (Length(v) != 1)
				error(MESS(1715, "in e#t, e is a text but not a character"));
			c= *Str(v);
			Overall if (*cp++ == c) n++;
		} break;
	case ELT:
		break;
	case Lis:
		{intlet lo= -1, mi, xx, mm, hi= len; relation c;
		bins:	if (hi-lo < 2) break;
			mi= (lo+hi)/2;
			if ((c= compare(v, Lisent(tp,mi))) == 0) goto some;
			if (c < 0) hi= mi; else lo= mi;
			goto bins;
		some:	xx= mi;
			while (xx-lo > 1) {
				mm= (lo+xx)/2;
				if (compare(v, Lisent(tp,mm)) == 0) xx= mm;
				else lo= mm;
			}
			xx= mi;
			while (hi-xx > 1) {
				mm= (xx+hi)/2;
				if (compare(v, Lisent(tp,mm)) == 0) xx= mm;
				else hi= mm;
			}
			n= hi-lo-1;
		} break;
	case Tab:
		Overall if (compare(v, Dts(*tp++)) == 0) n++;
		break;
	default:
		syserr(MESS(1716, "e#t with non text, list or table"));
		break;
	}
	return mk_integer((int) n);
}

Hidden bool less(r) relation r;    { return r<0; }
Hidden bool greater(r) relation r; { return r>0; }

Hidden value mm1(t, rel) value t; bool (*rel)(); {
	intlet len= Length(t), k; value m, *tp= Ats(t);
	switch (Type(t)) {
	case Tex:
		{string cp= (string) tp; char mc= '\0', mm[2];
			Overall {
				if (mc == '\0' || ((*rel)(*cp < mc ? -1 : (*cp > mc ? 1 : 0))))
					mc= *cp;
				cp++;
			}
			mm[0]= mc; mm[1]= '\0';
			m= mk_text(mm);
		} break;
	case Lis:
		if ((*rel)(-1)) /*min*/ m= copy(*Ats(t));
		else m= copy(*(Ats(t)+len-1));
		break;
	case Tab:
		{value dm= Vnil;
			Overall {
				if (dm == Vnil || (*rel)(compare(Dts(*tp), dm)))
					dm= Dts(*tp);
				tp++;
			}
			m= copy(dm);
		} break;
	default:
		syserr(MESS(1717, "min or max t, with non text, list or table"));
	}
	return m;
}

#ifdef NO_ABS

Hidden int abs(i) int i; {
	return i >= 0 ? i : -i;
}

#endif

Hidden value mm2(v, t, rel) value v, t; bool (*rel)(); {
	intlet len= Length(t), k; value m= Vnil, *tp= Ats(t);
	switch (Type(t)) {
	case Tex:
		{string cp= (string) tp; char c, mc= '\0', mm[2];
			c= *Str(v);
			Overall {
				if ((*rel)(c < *cp ? -1 : c > *cp ? 1 : 0)) {
					if (mc == '\0' || (*rel)(*cp < mc ? -1 : *cp>mc ? 1 : 0))
						mc= *cp;
				}
				cp++;
			}
			if (mc != '\0') {
				mm[0]= mc; mm[1]= '\0';
				m= mk_text(mm);
			}
		} break;
	case Lis:
		{intlet lim1, mid, lim2;
			if ((*rel)(-1)) { /*min*/
				lim1= 1; lim2= len-1;
			} else {
				lim2= 1; lim1= len-1;
			}
			if (!(*rel)(compare(v, Lisent(tp,lim2)))) break;
			if (len == 1 || (*rel)(compare(v, Lisent(tp,lim1)))) {
				m= copy(Lisent(tp,lim1));
				break;
			}
			/* v rel tp[lim2] && !(v rel tp[lim1]) */
			while (abs(lim2-lim1) > 1) {
				mid= (lim1+lim2)/2;
				if ((*rel)(compare(v, Lisent(tp,mid)))) lim2= mid;
				else lim1= mid;
			}
			m= copy(Lisent(tp,lim2));
		} break;
	case Tab:
		{value dm= Vnil;
			Overall {
				if ((*rel)(compare(v, Dts(*tp)))) {
					if (dm == Vnil ||
						(*rel)(compare(Dts(*tp), dm)))
						dm= Dts(*tp);
				}
				tp++;
			}
			if (dm != Vnil) m= copy(dm);
		} break;
	default:
		syserr(MESS(1718, "min2 or max2 with non text, list or table"));
		break;
	}
	return m;
}

Visible value min1(t) value t; { /* Monadic min */
	value m= Vnil;
	if (!Is_tlt(t))
		error(MESS(1719, "in min t, t is not a text, list or table"));
	else if (Length(t) == 0)
		error(MESS(1720, "in min t, t is empty"));
	else m= mm1(t, less);
	return m;
}

Visible value min2(v, t) value v, t; {
	value m= Vnil;
	if (!Is_tlt(t))
		error(MESS(1721, "in e min t, t is not a text, list or table"));
	else if (Length(t) == 0)
		error(MESS(1722, "in e min t, t is empty"));
	else if (Is_text(t)) {
		if (!Is_text(v))
			error(MESS(1723, "in e min t, t is a text but e is not"));
		else if (Length(v) != 1)
			error(MESS(1724, "in e min t, e is a text but not a character"));
	}
	if (still_ok) {
		m= mm2(v, t, less);
		if (m == Vnil)
			error(MESS(1725, "in e min t, no element of t exceeds e"));
	}
	return m;
}

Visible value max1(t) value t; {
	value m= Vnil;
	if (!Is_tlt(t))
		error(MESS(1726, "in max t, t is not a text, list or table"));
	else if (Length(t) == 0)
		error(MESS(1727, "in max t, t is empty"));
	else m= mm1(t, greater);
	return m;
}

Visible value max2(v, t) value v, t; {
	value m= Vnil;
	if (!Is_tlt(t))
		error(MESS(1728, "in e max t, t is not a text, list or table"));
	else if (Length(t) == 0)
		error(MESS(1729, "in e max t, t is empty"));
	else if (Is_text(t)) {
		if (!Is_text(v))
			error(MESS(1730, "in e max t, t is a text but e is not"));
		else if (Length(v) != 1)
			error(MESS(1731, "in e max t, e is a text but not a character"));
	}
	if (still_ok) {
		m= mm2(v, t, greater);
		if (m == Vnil)
			error(MESS(1732, "in e max t, no element of t is less than e"));
	}
	return m;
}

Visible value th_of(n, t) value n, t; {
	return thof(intval(n), t);
}

Visible value thof(n, t) int n; value t; {
	intlet len= Length(t); value w= Vnil;
	if (!Is_tlt(t))
		error(MESS(1733, "in n th'of t, t is not a text, list or table"));
	else if (n <= 0 || n > len)
		error(MESS(1734, "in n th'of t, n is out of bounds"));
	else {
		switch (Type(t)) {
		case Tex:
			{char ww[2];
				ww[0]= *(Str(t)+n-1); ww[1]= '\0';
				w= mk_text(ww);
			} break;
		case Lis:
			w= copy(*(Ats(t)+n-1));
			break;
		case Tab:
			w= copy(Dts(*(Ats(t)+n-1)));
			break;
		default:
			syserr(MESS(1735, "th'of with non text, list or table"));
		}
	}
	return w;
}

Visible bool found(elem, v, probe, where)
	value (*elem)(), v, probe; intlet *where;
	/* think of elem(v,lo-1) as -Infinity and elem(v,hi+1) as +Infinity.
	   found and where at the end satisfy:
	   SELECT:
	       SOME k IN {lo..hi} HAS probe = elem(v,k):
		   found = Yes AND where = k
	       ELSE: found = No AND elem(v,where-1) < probe < elem(v,where).
	*/
{relation c; intlet lo=0, hi= Length(v)-1;
	if (lo > hi) { *where= lo; return No; }
	if ((c= compare(probe, (*elem)(v, lo))) == 0) {*where= lo; return Yes; }
	if (c < 0) { *where=lo; return No; }
	if (lo == hi) { *where=hi+1; return No; }
	if ((c= compare(probe, (*elem)(v, hi))) == 0) { *where=hi; return Yes; }
	if (c > 0) { *where=hi+1; return No; }
	/* elem(lo) < probe < elem(hi) */
	while (hi-lo > 1) {
		if ((c= compare(probe, (*elem)(v, (lo+hi)/2))) == 0) {
			*where= (lo+hi)/2; return Yes;
		}
		if (c < 0) hi= (lo+hi)/2; else lo= (lo+hi)/2;
	}
	*where= hi; return No;
}

Visible bool in(v, t) value v, t; {
	intlet where, k, len= Length(t); value *tp= Ats(t);
	if (!Is_tlt(t)) {
		error(MESS(1736, "in the test e in t, t is not a text, list or table"));
		return No;
	}
	switch (Type(t)) {
	case Tex:
		if (Type(v) != Tex)
			error(MESS(1737, "in the test e in t, t is a text but e is not"));
		else if (Length(v) != 1)
			error(MESS(1738, "in the test e in t, e is a text but not a character"));
		else return index((string) tp, *Str(v)) != 0;
		return No;
	case ELT:
		return No;
	case Lis:
		return found(list_elem, t, v, &where);
	case Tab:
		Overall if (compare(v, Dts(*tp++)) == 0) return Yes;
		return No;
	default:
		syserr(MESS(1739, "e in t with non text, list or table"));
		return No;
	}
}

Visible bool empty(v) value v; {
	switch (Type(v)) {
	case Tex:
	case Lis:
	case Tab:
	case ELT:
		return (Length(v) == 0);
	default:
		syserr(MESS(1740, "empty() on non tlt value"));
		return (No);
	}
}

#endif INTEGRATION