/* Various sequence classes.  This is -*- C++ -*- code.
   Copyright (C) 1992 Per Bothner.

This file is part of Q.

Q 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, or (at your option)
any later version.

Q is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESSS 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 GNU CC; see the file COPYING.  If not, write to
the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */

#pragma implementation
#include <strstream.h>
#include "genmap.h"
#include "genfiles.h"
#include "gvars.h"
#include "gennum.h"
#include "gfunc.h"
#include "gkinds.h"
#include "gassign.h"
#include <stddef.h>
#include "symbol.h" /* For Record */
#include "mapping.h"
#include "expression.h"
#include "gcompile.h"
#include "builtin-syms.h"
#include <std.h>
#include "exceptions.h"
#include "gfiles.h"
#include "ifthenelse.h"
extern "C" {
#include "listprocs.h"
#include <gmp.h>
#include <gmp-impl.h>
}
#include "evalprocs.h"

#if 0
QS = subseq(Q,S,E);
ES = S >= 0 ? S : length Q + 1 + S; /* Effective start */
EE = E >= 0 ? min(E, length Q) : max(0, length Q + 1 + E); /* Effective end */
length(QS) = EE - ES;
QS[I] = I >= 0 ? (I >= length(QS) ? EOF : Q[ES+I]) : QS[length QS + 1 + I]
#endif

typedef void *Pix;
long print_length = 200;
long print_list_separator = '\n';

long  GenMap::magic() const { return MappingKind; }

Root * GenMap::prefix(Root *) { return Missing; }

// Return if we should contiue printing a long sequence.

int check_more(ostream& s)
{
    // Should also check for interactive?  FIXME
    if (s.rdbuf() == cout.rdbuf()) {
	char buf[20];
	s << " More? ";
	s.flush();
	cin.getline(buf, 20);
	if (buf[0] == 'y' || buf[0] == 'Y' || buf[0] == '\n' || buf[0] == 0)
	    return 1;
	return 0;
    }
    return 1;
}

void GenMap::printBare(ostream& outs) const
{
    ITERATOR(iter, (GenMap*)this);
    const long BadIndex = 0x7FFFFFFF;
    long prevIndex = -1;
    Root *prevKey = NULL;
    int prevWasChar = 0;
    int prevWasMap = 0;
    int i = 0;
    int count_at_more = 0;
    for ( ; ; i++) {
	Root *k = iter.key();
	if (k == Missing) break;
	Root *v = iter.next();
	if (v == Missing) break;
  	if (i - count_at_more >= print_length && print_length >= 0) {
	    if (check_more(outs) == 0)
		break;
	    count_at_more = i;
	}
	if (k == prevKey) {
	    outs << '|';
	} else {
	    long curIndex;
	    int skipKey = 0;
	    const Numeric *kn = k->numeric();
	    if (kn && kn->getlong(&curIndex)) {
		if (curIndex == prevIndex+1 && prevIndex != BadIndex)
		    skipKey = 1;
		prevIndex = curIndex;
	    } else
		prevIndex = BadIndex;
	    int v_magic = v->magic();
	    int curIsChar = IsCharacter(v);
	    int curIsMap = v->mapping() != NULL;
	    if (i)
		if (curIsMap && prevWasMap) outs << (char)print_list_separator;
		else if (print_readable || !prevWasChar)
		    outs << ' ';
	    prevWasChar = curIsChar;
	    prevWasMap = curIsMap;
	    if (!skipKey) {
		outs << *k << "->";
	    }
	    prevKey = k;
	}
	outs << *v;
    }
}

void GenMap::printon(ostream& outs) const
{
    if (print_readable)
	outs << '[';
    printBare(outs);
    if (print_readable)
	outs << ']';
}

Functional * GenMap::inverse()
{
#if 1

    // Doesn't compile under gcc-1.95.
    ITERATOR(iter, this);
    SplayMap *map = GC_NEW SplayMap();
    PtrPtrMap& mmap = map->map;
    for (;;) {
	Root *key = iter.key();
	if (key == Missing) break;
	Root *val = iter.next();
	if (val == Missing) break;
	RootPtr& ref = mmap[val];
	if (ref != NULL) {
	    if (ref->magic() == MultipleKind)
		fprintf(stderr, "Duplicate definition for inverse!\n");
#if 1
	    Choice *mul = GC_NEW Choice(2, ref, key);
#else
	    Multiple *mul = GC_NEW Multiple2(ref, key);
#endif
	    key = mul;
	}
	ref = key;
	map->len++;
    }
    return map;
#else
    return Functional::inverse();
#endif
}

GenSeq* GenMap::keys()
{
    Signal(GC_NEW UnimplementedOp("GenMap::key", isA()));
}

Root* DoKeys(Root* arg)
{
    GenMap *m = arg->mapping();
    if (m == NULL)
	Signal(new ParameterFail(arg, GenMap::desc(), &ARG1_str));
    return m->keys();
}

void GenSeq::printBare(ostream& outs) const
{
    ITERATOR(iter, (GenSeq*)this);
    const long BadIndex = 0x7FFFFFFF;
    long prevIndex = -1;
    int prevWasChar = 0;
    int prevWasMap = 0;
    int i = 0;
    int count_at_more = 0;
    for ( ; ; i++) {
	Root *v = iter.next();
	if (v == Missing) break;
  	if (i - count_at_more >= print_length && print_length >= 0) {
	    if (check_more(outs) == 0)
		break;
	    count_at_more = i;
	}

	int v_magic = v->magic();
	int curIsChar = IsCharacter(v);
	int curIsMap = v->mapping() != NULL;
	if (i)
	    if (curIsMap && prevWasMap) outs << (char)print_list_separator;
	    else if (print_readable || !prevWasChar)
		outs << ' ';
	prevWasChar = curIsChar;
	prevWasMap = curIsMap;

	outs << *v;
    }
}

GenSeq* GenSeq::keys()
{
    length_t l = length();
    GenRange* r = new GenRange(Zero, 1);
    if (l != InfiniteLength)
	r->len = l;
    return r;
}

Vector NullSequence(0);
GenRange IndexSequence(Zero, 1);

int GenMap::sizeof_file() const { return sizeof(Iterator); }

void GenMap::open(GenFile* result, OpenFlags flags = 0)
{
    Iterator *xfile = (Iterator*)result;
    xfile->Iterator::Iterator();
    xfile->cltn = this;
    xfile->index = 0;
    xfile->state = NULL;
}

#if 0
virtual GenFile* GenMap::open(Iterator* it, OpenFlags flags)
{
    if (it == NULL) {
	it = new Iterator();
	it->cltn = this;
    }
    it->index=0;
    it->state=NULL;
    return it;
}
#endif

GenFile* GenMap::open(OpenFlags flags = 0)
{
    GenFile *f = (GenFile*)new char[sizeof_file()];
    open(f, flags);
    return f;
}

int GenSeq::sizeof_file() const { return sizeof(SeqIterator); }

void GenSeq::open(GenFile* result, OpenFlags flags)
{
    SeqIterator *xfile = (SeqIterator*)result;
    CONSTRUCT(xfile, SeqIterator, ());
    xfile->cltn = this;
    xfile->index=0;
    xfile->state=NULL;
}

#if 0
GenFile* GenSeq::open(Iterator* it, OpenFlags flags)
{
    if (it == NULL) {
	it = new SeqIterator();
	it->cltn = this;
    }
    it->index=0;
    it->state=NULL;
    return it;
}
#endif

#if 0
GenSeq * CharSeq::subseq(index_t start, index_t end)
{
    return new CharSubSeq(this, start, end);
}
#endif

struct WhileIterator : public SeqIterator {
    GenFile* el_iter;
    GenFile* cond_iter;
    Root *current;
    int is_until;
    WhileIterator(WhileSeq *wh, OpenFlags flags = 0) {
	el_iter = wh->elements->GenMap::open(flags);
	cond_iter = wh->conds->GenMap::open(flags);
	cltn = wh;
	index = 0;
	is_until = 0;
    }
    ~WhileIterator() { delete el_iter; delete cond_iter; }
    virtual Root *next();
};

int WhileSeq::sizeof_file() const
{
    return sizeof(WhileIterator);
}
void WhileSeq::open(GenFile* result, OpenFlags flags)
{
    WhileIterator *xfile = (WhileIterator*)result;
    CONSTRUCT(xfile, WhileIterator, (this, flags));
}

void UntilSeq::open(GenFile* result, OpenFlags flags)
{
    WhileIterator *xfile = (WhileIterator*)result;
    CONSTRUCT(xfile, WhileIterator, (this, flags));
    xfile->is_until = 1;
}

Root *WhileIterator::next()
{
    WhileSeq *wh = (WhileSeq*)cltn;
    if (wh->limit == wh->tested && index >= wh->limit)
	return Missing;
    Root *cond, *el;
    int succeeded;
    if (is_until)
	el = el_iter->next();
    IFV(WhileSeqIfHandler) {
	if (!is_until || el != Missing) {
		cond = cond_iter->next();
		if (cond != Missing) {
		    // FIXME: if following fails, should not be treated as EOF!
		if (!is_until)
		    el = el_iter->next();
		const Functional *func = cond->functional();
		if (func && el != Missing) {
		    cond = func->apply(&el, NULL, NULL, NULL, 1, 0, 0);
		}
	    }
	}
    }
    THENV {
	succeeded = cond == Missing || el == Missing ? -1 : 1;
    }
    ELSEV(WhileSeqIfHandler,Fail)
	succeeded = 0;
    ENDV;
    index++;
    if (index > wh->tested)
	wh->tested = index;
    if (succeeded <= 0) {
	wh->limit = wh->tested;
	return Missing;
    }
    return el;
}

int GenSeq::null() { return length() == 0; }

void GenSeq::xapply(void* dst, Type* dstType, ArgDesc& args)
{
    if (args.rCount == 0) {
	dstType->coerceFromRoot(dst, DoCurry(this, args));
	return;
    }
    Root *val;
    int rnk = rank();
    int range_start[rnk];
    int range_size[rnk];
    int range_step[rnk];
    int r;
    int result_rank = rnk;
    for (r = 0; r < rnk; r++)
      {
	if (r >= args.rCount)
	  {
	    range_start[r] = 0;
	    range_step[r] = 1;
	    range_size[r] = dimension(r);
	    continue;
	  }
	const Numeric *num = args.rArgs[r]->numeric();
	if (num != NULL)
	  {
	    long li;
	    if (num->getlong(&li))
	      {
		range_start[r] = li;
		range_size[r] = -1;
		range_step[r] = 1;
		result_rank--;
	      }
	    else
	      Signal(&MissingElement); // ERROR?  Non-integer.
	  }
	else
	  {
	    GenSeq *seq = args.rArgs[r]->sequence();
	    if (seq == NULL)
	      {
		if (r == 0) { // KLUDGE FIXME
		  Root::xapply(dst, dstType, args);
		  return;
		}
		Signal(&MissingElement); // ERROR?  Not integer or sequence?
	      }
	    if (seq->isKindOf(*Range::desc()))
	      {
		Range *range = (Range*)seq;
		range_step[r] = range->istep();
		range_start[r] = range->ilower();
		size_t lenr = range->length();
		if (lenr == InfiniteLength)
		  {
		    lenr = dimension(r) - range_start[r];
		  }
		range_size[r] =  lenr;
	      }
	    else
	      break; /* Sequence, but not a range. */
	  }
      }
    if (r == rnk && args.rCount == 1 && range_step[0] == 1)
      { Root* val;
	if (range_size[0] == -1) // Single element
	  val = index(range_start[0]);
	else
	  val = subseq(range_start[0], range_start[0] + range_size[0] - 1);
	dstType->coerceFromRoot(dst, val);
	return;
      }

#if 0
    if (r == rnk && r >= args.rCount && is an Marray)
      {
	MArray *marr = (MArray*)this;
	....;
	return MArray::New(result_rank, base, offset, ls, st);
      }
#endif

    Root* nextArg = args.rArgs[0];
    const Numeric *num = nextArg->numeric();
    if (num == NULL) {
	GenSeq *seq = (GenSeq*)nextArg->sequence();
	if (seq != NULL) {
	    ArgDesc new_args(args.lArgs, args.rArgs+1, args.nArgs, args.names,
			     args.lCount, args.rCount-1, args.nCount);
	    if (seq->isKindOf(*Range::desc()) && ((Range*)seq)->istep() == 1) {
		Range *bseq = (Range*)seq;
#if 1
		if (new_args.empty()) {
		    dstType->coerceFromRoot(dst,
					    subseq(bseq->ilower(),
					    bseq->iupper()));
		    return;
		}
#else
		GenSeq *sub = subseq(bseq->ilower(), bseq->iupper());
		if (new_args.empty())
		    return sub;
		else
		    return sub->apply(new_args);
#endif
		}
#if 0
	    if (isKindOf(*CharSeq::desc()))
		return new IndexedCharSeq(this, seq, new_args);
	    else
#endif
		dstType->coerceFromRoot(dst,
					new IndexedSeq(this, seq, new_args));
	    return;
	}
	val = NULL;
    } else {
	long i;
	if (num->getlong(&i))
#if 1
	    val = new SeqElementLocative(this, i);
#else
	    val = index(i);
#endif
	else val = NULL;
    }

    if (val == NULL) {
	Root *thisPtr;
	Root **lArgs;
	if (args.lCount) {
	    lArgs = (Root**)alloca((args.lCount+1) * sizeof(Root*));
	    memcpy(lArgs, args.lArgs, args.lCount * sizeof(Root*));
	}
	else
	    lArgs = &thisPtr;
	lArgs[args.lCount] = this;
	ArgDesc xargs(lArgs, args.rArgs + 1, args.nArgs, args.names,
		      args.lCount+1, args.rCount-1, args.nCount);
	nextArg->xapply(dst, dstType, xargs);
    }
    else 
	ApplyRest(dst, dstType, val, args, 0, 1);
}

Root * GenSeq::prefix(Root *arg)
{
    const Numeric *num = arg->numeric();
    if (num == NULL) {
	if (arg == Missing) return Missing;
    }
    else {
	long i;
	if (num->getlong(&i)) {
	    Root *val = ((GenSeq*)this)->index(i);
	    if (val == Missing)
		Signal(&MissingElement);
	    return val;
	}
    }
    Signal(new CoercionFail(arg, &RefInteger));
}

Root * GenSeq::index(index_t) { return Missing; }

void GenArray::set_at(index_t, Root *new_value)
{
    SignalBadAssignment(this, new_value);
}

#ifdef DEBUG
int DbgSeqUnify = 0;
#endif
void GenSeq::unify(Root& other)
{
#ifdef DEBUG
    if (DbgSeqUnify) cerr << *this << "->GenSeq::unify(" << other;
#endif
    GenSeq *seq = other.sequence();
    if (seq == NULL) {
#ifdef DEBUG
	if (DbgSeqUnify) cerr << ")\n", cerr.flush();
#endif
	LVariable *var = other.lvariable();
	if (var == NULL) RaiseDomainError(NULL);
	var->unify(*this);
	return;
    }
    size_t len = length();
    size_t seq_len = seq->length();
    if (seq_len != len && seq_len != UnknownLength && len != UnknownLength) {
#ifdef DEBUG
	if (DbgSeqUnify) cerr << ") FAILED(length)\n", cerr.flush();
#endif

	RaiseDomainError(NULL);
    }

    // TODO: If both are either UnknownLength or InfiniteLength,
    // should link, and don't do eager unification.

#ifdef DEBUG
    if (DbgSeqUnify) cerr << ")\n", cerr.flush();
#endif
    ITERATOR(this_iter, this);
    ITERATOR(other_iter, seq);
    for (;;) {
	Root *this_val = this_iter.next();
	Root *other_val = other_iter.next();
	// FIXME: Doesn't close this_file & other_file on Failure.
	this_val->unify(*other_val);
	if (this_val == Missing || other_val == Missing)
	    break;
    }
}

int GenSeq::compare(Root& other)
{
    GenSeq *seq = other.sequence();
    if (seq == NULL) {
	RaiseDomainError(NULL);
    }
    size_t len1 = length();
    size_t len2 = seq->length();
    size_t len = len1 <= len2 ? len1 : len2;
    
    register int i;
    for (i = 0; i < len; i++) {
	int d = index(i)->compare(*seq->index(i));
	if (d) return d;
    }
    if (len1 == len2) return 0;
    else if (len1 < len2) return -1;
    else return 1;
}

length_t GenSeq::_cycle_length(int cycle_part)
{
  if (cycle_part)
    return 0;
  else
    return length();
}

GenSeq * GenSeq::subseq(index_t start, index_t end)
{
    return new SubSeq(this, start, end);
}
SubSeq::SubSeq(GenSeq *q, index_t st, index_t e) : seq(q)
{
    start = st;
    end = e;
}
GenSeq * SubSeq::subseq(index_t st, index_t e)
{
    index_t new_start, new_end;
    if (st >= 0)
	new_start = start + st;
    else
	new_start = end  + st + 1;
    if (e >= 0)
	new_end = start + e;
    else
	new_end = end + e + 1;
    return new SubSeq(seq, new_start, new_end);
}

size_t SubSeq::length()
{
    size_t seq_len = seq->length();
    index_t s = start;
    if (s < 0) {
	s += seq_len + 1;
	if (s < 0) s = 0;
    }
    index_t e = end;
    if (e < 0) {
	e += seq_len + 1;
	if (e < 0) e = 0;
    }
    if (e > seq_len) e = seq_len;
    if (s > e)
	return 0;
    else
	return e - s;
}

Root * SubSeq::index(index_t i)
{
    size_t seq_len = seq->length();
    index_t s = start;
    if (s < 0) {
	s += seq_len + 1;
	if (s < 0) s = 0;
    }
    index_t e = end;
    if (e < 0) {
	e += seq_len + 1;
	if (e < 0) e = 0;
    }
    if (s > seq_len) s = seq_len;
    if (e > seq_len) e = seq_len;
    if (i >= 0)
	i += s;
    else {
	i += e;
	if (i < 0) i = 0;
    }
    if (i >= e)
	return Missing;
    return seq->index(i);
}

int SubSeq::sizeof_file() const
{
    return seq->sizeof_file() + sizeof(SubSeqIterator);
}

void SubSeq::open(GenFile* file, OpenFlags flags=0)
{
    SubSeqIterator *subfile = (SubSeqIterator*)file;
    seq->open(subfile->base(), flags);
    CONSTRUCT(subfile, SubSeqIterator, (this));
}

CharSubSeq::CharSubSeq(CharSeq *q, index_t st, index_t e) : seq(q)
{
    start = st;
    end = e;
}
GenSeq * CharSubSeq::subseq(index_t st, index_t e)
{
    index_t new_start, new_end;
    if (st >= 0)
	new_start = start + st;
    else
	new_start = end  + st + 1;
    if (e >= 0)
	new_end = start + e;
    else
	new_end = end + e + 1;
    return new CharSubSeq(seq, new_start, new_end);
}

size_t CharSubSeq::length()
{
    size_t seq_len = seq->length();
    index_t s = start;
    if (s < 0) {
	s += seq_len + 1;
	if (s < 0) s = 0;
    }
    index_t e = end;
    if (e < 0) {
	e += seq_len + 1;
	if (e < 0) e = 0;
    }
    if (e > seq_len) e = seq_len;
    if (s > e)
	return 0;
    else
	return e - s;
}

Root * CharSubSeq::index(index_t i)
{
    size_t seq_len = seq->length();
    index_t s = start;
    if (s < 0) {
	s += seq_len + 1;
	if (s < 0) s = 0;
    }
    index_t e = end;
    if (e < 0) {
	e += seq_len + 1;
	if (e < 0) e = 0;
    }
    if (s > seq_len) s = seq_len;
    if (e > seq_len) e = seq_len;
    if (i >= 0)
	i += s;
    else {
	i += e;
	if (i < 0) i = 0;
    }
    if (i >= e)
	return Missing;
    return seq->index(i);
}

#if 0
virtual GenFile* SubSeq::open(Iterator* it, OpenFlags flags)
{
    if (start > 0)
	return GenMap::open(it, flags);
    if (end == -1)
	return seq->open(it, flags);
    if (end < 0)
	return GenMap::open(it, flags);
}
#endif

size_t AList::length()
{
    GenSeq *rest_seq = cdr->sequence();
    if (rest_seq == NULL) return UnknownLength;
    return 1 + rest_seq->length();
}

Root * AList::index(index_t i)
{
    if (i == 0) return car;
    if (i < 0)
	i += length() + 1;
    GenSeq *rest_seq = cdr->sequence();
    if (rest_seq) return rest_seq->index(i-1);
    return Missing;
}

#if 0
Root * ConsPair::index(index_t i)
{
    if (i == 0) return new ObFieldLocative(this, offsetof(ConsPair, car));
    if (i > 0) {
	const GenSeq *rest_seq = cdr->sequence();
	if (rest_seq) return rest_seq->index(i-1);
    }
    return Missing;
}
#endif

void AList::printon(ostream& outs) const
{
    if (print_lisp) {
	const AList *current = this;
	outs << '(';
      repeat:
	current->car->printon(outs);
	if (current->cdr->isKindOf(*AList::desc())) {
	    outs << ' ';
	    current = (const AList*)current->cdr;
	    goto repeat;
	}
	else if (current->cdr != &NullSequence && current->cdr != &NilSymbol) {
	    outs << " . ";
	    current->cdr->printon(outs);
	}
	outs << ')';
    }
    else {
      GenSeq::printon(outs);
    }
}

void AList::printBare(ostream &outs) const
{
    int car_magic = car->magic();
    int carIsSymbol = (car_magic & BasicKindMask) == SymbolKind;
    outs << *car;
    GenSeq* cdr_seq = cdr->sequence();
    if (cdr_seq == NULL) {
	outs << ',' << *cdr;
	return;
    }
    if (cdr_seq->null()) return;
    if (print_readable || !carIsSymbol)
	outs << ' ';
    cdr_seq->printBare(outs);
}

IndexedSeq::IndexedSeq(GenSeq *b, GenSeq *i, ArgDesc& a)
{
    base = b;
    indexes = i;
    a.copy_to(args);
}

size_t IndexedSeq::length()
{
    return indexes->length();
}

Root *IndexedSeq::index(index_t i)
{
    Root *val = base->prefix(indexes->index(i));
    if (args.empty())
	return val;
    return val->apply(args);
}

fix_int Coerce2Fix(Root *val)
{
    long i;
    const Numeric *num = val->numeric();
    if (num == NULL || !num->getlong(&i))
	RaiseDomainError(0);
    return i;
}

void IndexedSeq::assign(Root *new_value)
{
    GenSeq *new_seq = new_value->sequence();
    if (new_seq == NULL)
	SignalBadAssignment(this, new_value);
    ITERATOR(new_iter, new_seq);
    ITERATOR(index_iter, indexes);
    for (;;) {
	Root *index_val = index_iter.next();
	Root *new_val = new_iter.next();
	if (new_val == Missing || index_val == Missing)
	    break; // ERROR?
	base->set_at(Coerce2Fix(index_val), new_val);
    }
}

Vector * NewVector(size_t size)
{
    Vector *v = (Vector*)GC_malloc(sizeof(Vector) + size * sizeof(Root*));
    v->Vector::Vector(size);
    return v;
}

Vector * NewVector(size_t size, Root **vals)
{
#ifdef DO_GC
    Vector *v
      = (Vector*)GC_malloc_stubborn(sizeof(Vector) + size * sizeof(Root*));
    v->Vector::Vector(size);
    memcpy(v->start_addr(), vals, size*sizeof(Root*));
    GC_end_stubborn_change(v);
#else
    Vector *v = (Vector*)malloc(sizeof(Vector) + size * sizeof(Root*));
    v->Vector::Vector(size);
    memcpy(v->start_addr(), vals, size*sizeof(Root*));
#endif
    return v;
}

VectorV * NewVectorV(size_t size)
{
    VectorV *v = (VectorV*)GC_malloc(sizeof(VectorV) + size * sizeof(Root*));
    v->VectorV::VectorV(size);
    return v;
}

Root *Copy2Vector(GenSeq* inits, long length, Root* fill)
{
  VectorV *vec = NewVectorV(length);
  register Root **ptr = vec->start_addr();
  if (inits)
    {
      ITERATOR(iter, inits);
      for ( ; length > 0; length --)
	{
	  Root *val = iter.next();
	  if (val == Missing)
	    break;
	  *ptr++ = val;
	}
    }
  if (length > 0 && fill == NULL)
    Signal(new GenericCondition("Too few elements to initialize vector."));
  while (--length >= 0) *ptr++ = fill;
  return vec;
}

Root *MakeVector(Root* inits, Root* length)
{
  GenSeq *seq = inits->sequence();
  if (seq == NULL)
    Signal(new GenericCondition("Argument is not a sequence."));
  long size;
  if (length == NULL)
    size = seq->length();
  else
    {
      const Numeric *n_count = length->numeric();
      if (n_count == NULL || !n_count->getlong(&size))
	Signal(new GenericCondition("length parameter is not an integer"));
    }
  return Copy2Vector(seq, size, NULL);
}

void Vector::printon(ostream& outs) const 
{
    register Root **ptr;
    size_t i;
    if (print_lisp) {
	int count = len;
	outs << "#(";
	for (i = 0, ptr = start_addr(); i < len; i++) {
	    if (i > 0) outs << ' ';
	    if (i > print_length && print_length >= 0) {
		outs << "...";
		break;
	    }
	    (*ptr++)->printon(outs);
	}
	outs << ')';
    }
    else {
#if 1
	GenSeq::printon(outs);
#else
	int count = len;
	outs << '[';
	register Root **ptr = start_addr();
	for (i = 0; i < count; i++) {
	    if (i > 0) outs << ' ';
	    (*ptr++)->printon(outs);
	}
	outs << ']';
#endif
    }
}

Root* Vector::index(index_t i)
{
    if ((fix_unsigned)i >= (fix_unsigned)len)
	if (i >= 0 || (fix_unsigned)(i += len+1) >= (fix_unsigned)len)
	    return Missing;
    return start_addr()[i];
}

void Vector::dumpPtr(CFile *cf) const
{
    if (this == &NullSequence)
	cf->asm_stream() << "&NullSequence";
    else
	Root::dumpPtr(cf);
}

#if 0
Root * VectorV::index(index_t i)
{
    if ((fix_unsigned)i >= (fix_unsigned)len)
	if (i >= 0 || (fix_unsigned)(i += len+1) >= (fix_unsigned)len)
	    return Missing;
    Root **ptr = &start_addr()[i];
    return new ObFieldLocative((Root*)this, (char*)ptr - (char*)this);
}
#endif

void VectorV::set_at(index_t i, Root *new_val)
{
    if ((fix_unsigned)i >= (fix_unsigned)len)
	if (i >= 0 || (fix_unsigned)(i += len+1) >= (fix_unsigned)len)
	    RaiseDomainError(0);
//	    return;
    start_addr()[i] = new_val;
}

void Vector::assign(Root *new_value)
{
    GenSeq *new_seq = new_value->sequence();
    if (new_seq == NULL)
	SignalBadAssignment(this, new_value);
    ITERATOR(iter, new_seq);
    int count = leng();
    Root **ptr = start_addr();
    for (; --count >= 0; ptr++) {
	Root *val = iter.next();
	if (val == Missing)
	    break; // ERROR?
	(*ptr)->assign(val);
    }
}

void VectorV::assign(Root *new_value)
{
    GenSeq *new_seq = new_value->sequence();
    if (new_seq == NULL)
	SignalBadAssignment(this, new_value);
    ITERATOR(iter, new_seq);
    int count = leng();
    Root **ptr = start_addr();
    while (--count >= 0) {
	Root *val = iter.next();
	if (val == Missing)
	    break; // ERROR?
	*ptr++ = val;
    }
}

Root* BitVector::index(index_t i)
{
    if ((fix_unsigned)i >= (fix_unsigned)len)
	if (i >= 0 || (fix_unsigned)(i += len+1) >= (fix_unsigned)len)
	    return Missing;
    int val = (start_addr()[(fix_unsigned)i / BITS_PER_MP_LIMB] >> (i & (BITS_PER_MP_LIMB-1))) & 1;
    if (val)
	return (Root*)One;
    else
	return (Root*)Zero;
}

void BitVector::printon(ostream& outs) const
{
    outs << "#*";
    register fix_unsigned mask = 1;
    register fix_unsigned *ptr = start_addr();
    register int count = (int)len;
    while (--count >= 0) {
	outs << (*ptr & mask ? '1' : '0');
	mask <<= 1;
	if (mask == 0) {
	    ptr++;
	    mask = 1;
	}
    }
}

BitVector* BitVector::New(size_t len)
{
    int words = (len + (BITS_PER_MP_LIMB-1)) / BITS_PER_MP_LIMB;
    BitVector *bv = (BitVector*)GC_malloc(sizeof(BitVector)
				       + words * sizeof(fix_unsigned));
    bv->BitVector::BitVector(len);
    return bv;
}

size_t BitVector::nwords()
{
    return (unsigned)(len + (BITS_PER_MP_LIMB-1)) / BITS_PER_MP_LIMB;
}


OArray::OArray(size_t l, Root **f) { len = l; first = f; }

Root * OArray::index(index_t i)
{
    if ((fix_unsigned)i >= (fix_unsigned)len)
	if (i >= 0 || (fix_unsigned)(i += len+1) >= (fix_unsigned)len)
	    return Missing;
    return first[i];
}

GenSeq * OArray::subseq(index_t start, index_t end)
{
    if (start < 0) start += leng() + 1;
    if (end < 0) end += leng() + 1;
    if (start > leng())
	start = leng();
    if (end < start) end = start;
    return new OArray(end-start, first + start);
}

// Calculates total size of array whose whose is in dims.
// As a size effect, set the stride fields of dims.

size_t CalculateSize(int rank, DimInfo *dims)
{
    size_t size = 1;
    for (register int i = rank; --i >= 0; ) {
	dims[i].stride = size;
	size *= dims[i].length;
    }
    return size;
}

#if 0
index_t *CalculateStrides(int rank, size_t *shape, size_t *total_size)
{
    index_t *strides = rank ? (int*)GC_malloc(rank * sizeof(int)) : NULL;
    long size = 1;
    for (register int i = rank; --i >= 0; ) {
	strides[i] = size;
	size *= shape[i];
    }
    if (total_size) *total_size = size;
    return strides;
}
#endif

MArray*MArray::New(int d, GenArray *b, long offset, size_t *ls, index_t *st)
{
    MArray *a = (MArray*)GC_malloc(sizeof(MArray) + d * sizeof(DimInfo));
    a->MArray::MArray(d, b, offset, ls, st);
    return a;
}

MArray*MArray::New(int d, GenArray *b, long offset, DimInfo *di)
{
    MArray *a = (MArray*)GC_malloc(sizeof(MArray) + d * sizeof(DimInfo));
    a->MArray::MArray(d, b, offset, di);
    return a;
}

MArray::MArray(int d, GenArray *b, long offset, size_t *ls, index_t *st)
: _rank(d)
{
    _base=b;
    _offset=offset;
    misc_flags = 0;
    if (ls) {
	register int i;
	for (i = d; --i >= 0; ) dim[i].length = ls[i];
	if (st)
	    for (i = d; --i >= 0; ) dim[i].stride = st[i];
	else {
	    size_t size = 1;
	    for (i = d; --i >= 0; ) {
		dim[i].stride = size;
		size *= ls[i];
	    }
	}
    }
}

MArray::MArray(int d, GenArray *b, long offset, DimInfo *di)
: _rank(d)
{
    misc_flags = 0;
    _base=b;
    _offset=offset;
    register int i;
    for (i = d; --i >= 0; )
	dim[i] = di[i];
}

Root * MArray::index(index_t i)
{
    if (_rank <= 0) return Missing;
    if ((fix_unsigned)i >= (fix_unsigned)dim[0].length)
	if (i >= 0
	    || (fix_unsigned)(i += dim[0].length+1) >= dim[0].length)
	    return Missing;
    fix_int offset = i * dim[0].stride + _offset;
    if (_rank == 1)
	return _base->row_major_index(offset);
    else {
	return MArray::New(_rank-1, _base, offset, dim+1);
    }
}

void MArray::set_at(index_t i, Root *new_value)
{
    if (_rank <= 0
	|| (((fix_unsigned)i >= (fix_unsigned)dim[0].length)
	    && (i >= 0
		|| (fix_unsigned)(i += dim[0].length+1) >= dim[0].length)))
	SignalBadAssignment(this, new_value);
    fix_int offset = i * dim[0].stride + _offset;
    if (_rank > 1)
	return (MArray::New(_rank-1, _base, offset, dim+1))->assign(new_value);
    else
	return _base->set_at(offset, new_value);
}

void AssignArray(MArray *m, int level,
		 index_t offset,
		 Root *new_value,
		 int diff_len_ok)
{
    if (level == m->_rank)
	m->_base->set_at(offset, new_value);
    else {
	GenSeq *new_seq = new_value->sequence();
	if (new_seq == NULL)
	    SignalBadAssignment(m, new_value);
	ITERATOR(iter, new_seq);
	for (int i = 0; i < m->dim[level].length; i++) {
	    Root *new_el = iter.next();
	    if (new_el == Missing)
		if (diff_len_ok)
		    return;
		else
		    SignalBadAssignment(m, new_value);
	    AssignArray(m, level+1, offset, new_el, diff_len_ok);
	    offset += m->dim[level].stride;
	}
	if (!diff_len_ok && iter.next() != Missing)
	    SignalBadAssignment(m, new_value);
    }
}

void MArray::assign(Root *new_value)
{
    AssignArray(this, 0, _offset, new_value, 0);
}

Root * MArray::row_major_index(fix_int ind)
{ // WRONG, if non-standard strides!
    return _base->row_major_index(ind+_offset);
}

void MArray::printon(ostream& outs) const
{
    if (_rank == 0) {
	_base->row_major_index(_offset)->printon(outs);;
    } else {
	if (print_readable)
	    outs << '[';
	printBare(outs);
	if (print_readable)
	    outs << ']';
    }
}

static void PrintCell(const MArray *m, int level, index_t offset,
		      ostream& outs)
{
    int sub_rank = m->_rank - level - 1;
    if (sub_rank < 0) {
	m->_base->row_major_index(offset)->printon(outs);
	return;
    }
    int prevWasChar = 0;
    for (int i = 0; i < m->dim[level].length; i++) {
	if (sub_rank == 0) {
	    Root *v = m->_base->row_major_index(offset);
	    if (i > 0 && (print_readable || !prevWasChar))
		outs << ' ';
	    int curIsChar = IsCharacter(v);
	    v->printon(outs);
	    prevWasChar = curIsChar;
	}
	else {
	    if (i > 0) {
		int irank = sub_rank;
		if (irank > 4) irank = 4;
		while (--irank >= 0) outs << (char)print_list_separator;
	    }
	    PrintCell(m, level+1, offset, outs);
	}
	offset += m->dim[level].stride;
    }
}

void MArray::printBare(ostream& outs) const
{
    if (_rank == 0) {
	_base->row_major_index(_offset)->printon(outs);
	return;
    }
    PrintCell(this, 0, _offset, outs);
}

Root*
MakeArray(Root *_base, Root* _dims, Root* _strides, int offset)
{
  GenSeq *dims = _dims->sequence();
  int rank = dims != NULL ? dims->length() : 1;
  DimInfo diminfo[rank];
  int i;
  long li;

  if (dims != NULL)
    {
      for (i = 0; i < rank; i++)
	{
	  Root *v = dims->index(i);
	  const Numeric *n = v->numeric();
	  if (n == NULL || !n->getlong((long*)&li))
	    RaiseDomainError(0);
	  diminfo[i].length = li;
	}
    }
  else
    {
      const Numeric *n = dims->numeric();
      if (n == NULL || !n->getlong((long*)&i))
	RaiseDomainError(0);
      diminfo[0].length = i;
    }
  if (_strides)
    {
      GenSeq *strides = _strides->sequence();
      if (strides == NULL)
	RaiseDomainError(0);
      ITERATOR(iter, strides);
      for (i = 0; i < rank; i++)
	{
	  Root *str = iter.next();
	  if (str == Missing)
	    RaiseDomainError(0);
	  const Numeric *n = str->numeric();
	  long li;
	  if (n == NULL || !n->getlong(&li))
	    RaiseDomainError(0);
	  diminfo[i].stride = li;
	}
    }
  else
    CalculateSize(rank, diminfo);
  GenSeq *base = _base->sequence();
  if (base == NULL)
    Signal(new GenericCondition("Argument to array is not a sequence."));
  return MArray::New(rank, base, offset, diminfo);
}

StringC * NewString(length_t size)
{
#if 1
#ifdef DO_GC
    char *chars = (char*)GC_malloc_atomic(size+1);
    chars[size] = '\0';
    return GC_NEW StringC(chars, size);
#else
    char *chars = (char*)malloc(size+1);
    chars[size] = '\0';
    return GC_NEW StringC(chars, size);
#endif
#else
    StringC *s = (StringC*)GC_malloc(sizeof(StringC) + (size+1) * sizeof(char));
    s->StringC::StringC(size);
    s->chars()[size] = '\0';
    return s;
#endif
}

StringC * NewString(length_t size, const char *vals)
{
#if 1
#ifdef DO_GC
    char *chars = (char*)GC_malloc_atomic(size+1);
    memcpy(chars, vals, size);
    chars[size] = '\0';
    StringC *result = (StringC*)GC_malloc_stubborn(sizeof(StringC));
    result->StringC::StringC(chars, size);
    GC_end_stubborn_change(result);
    return result;
#else
    char *chars = (char*)malloc(size+1);
    memcpy(chars, vals, size);
    chars[size] = '\0';
    return new StringC(chars, size);
#endif
#else
    StringC *str = NewString(size);
    char *buf = str->chars();
    bcopy(vals, buf, size);
    return str;
#endif
}

Root * StringC::index(index_t i)
{
    if ((fix_unsigned)i >= (fix_unsigned)len)
	if (i >= 0 || (fix_unsigned)(i += len+1) >= (fix_unsigned)len)
	    return Missing;
    return CCharToChar(chars()[i]);
}

const StringC *StringV::asString(int format=0) const
{
    return NewString(leng(), chars());
}

int StringC::equal(const StringC& other) const
{
    if (leng() != other.leng())
	return 0;
    return memcmp(chars(), other.chars(), leng()) == 0;
}

void PrintQuotedInterior(register const char *str, int len, ostream& outs)
{
    register int i;
    for (i = len; --i >= 0; ) {
	unsigned char ch = (unsigned char)*str++;
	if (ch == '\"' || ch == '$' || ch == '\\') outs << '\\';
	else if (ch < ' ' || ch >= 127) {
	    char buf[8];
	    switch (ch) {
	      case '\n': outs << "\\n"; continue;
              case '\r': outs << "\\r"; continue;
	      case '\t': outs << "\\t"; continue;
              case '\b': outs << "\\b"; continue;
	      case '\f': outs << "\\f"; continue;
#ifdef __STDC__
	      case '\a': outs << "\\a"; continue;
	      case '\v': outs << "\\v"; continue;
#endif
	      default: sprintf(buf, "\\%03o", ch); outs << buf;  continue;
	    }
	}
        outs << ch;
    }
}
void PrintQuotedString(register const char *str, int len, ostream& outs)
{
    outs << '\"';
    PrintQuotedInterior(str, len, outs);
    outs << '\"';
}

void PrintString(register const char *str, int len, ostream& outs)
{
    if (print_readable)
	PrintQuotedString(str, len, outs);
    else
	outs.write(str, len);
}

#if 0
void String::printon(ostream& outs) const
{
    PrintString(chars(), leng(), outs);
}
void String::printBare(ostream& outs) const
{
    register char *ptr;
    register int i;
    for (ptr = chars(), i = leng(); --i >= 0; ) {
	char ch = *ptr++;
        outs << ch;
    }
}
#endif

void StringC::printon(ostream &outs) const
{
    PrintString(chars(), leng(), outs);
}

void StringC::printBare(ostream& outs) const
{
    register char *ptr;
    register int i;
    for (ptr = chars(), i = leng(); --i >= 0; ) {
	char ch = *ptr++;
        outs << ch;
    }
}

#if 0
Root * String::index(index_t i)
{
    if ((size_t)i >= leng()) return Missing;
    return &CharTable[(unsigned char)chars()[i]];
}

const StringC * String::asString(int format = 0) const
{
    return NewString(leng(), chars());
}
#endif

GenSeq * StringC::subseq(index_t start, index_t end)
{
    if (start < 0) start += leng() + 1;
    if (end < 0) end += leng() + 1;
    if (start > leng())
	start = leng();
    if (end < start) end = start;
    return NewString(end-start, chars() + start);
}

#if 0
int String::sizeof_file() const { return sizeof(CharFile); }
void String::open(GenFile* result, OpenFlags flags=0)
{
    strstreambuf *sbuf = new strstreambuf(chars(), leng());
    CharFile* cresult = (CharFile*)result;
    cresult->CharFile::CharFile(*this, sbuf);
    cresult->index = -1;
    cresult->state=0;
    cresult->stream = sbuf;
}
#endif

int StringC::sizeof_file() const { return sizeof(CharFile); }
void StringC::open(GenFile* result, OpenFlags flags)
{
    strstreambuf *sbuf = new strstreambuf((const char*)chars(), (int)leng());
    CharFile* cresult = (CharFile*)result;
    CONSTRUCT(cresult, CharFile, (*this, sbuf));
    cresult->index = -1;
    cresult->state=0;
    cresult->stream = sbuf;
}

#if 0
GenFile * GenRecur::open(long flags) const
{
    RangeFile* file =
	(RangeFile*)GC_malloc(sizeof(RangeFile)+el_type()->inst_size);
    file->RangeFile::RangeFile(this);
    return file;
}
#endif

Root *GenRecur::index(index_t i)
{
    if (i >= len && len != InfiniteLength)
	return Missing;
    char buf[el_type()->inst_size];
    stepper(first, buf, i);
    return  el_type()->coerceToRoot(buf);
}

Root *Range::index(index_t i)
{
    if (i < 0)
	i += length() + 1;
    if ((size_t)i >= len) return Missing;
    return (Root*)MakeFixInt(VoidToInt(first) + step * i);
}

void Range::stepper(void *_old, void *_new, int count = 1) const
{
#if 1
  abort();
#else
    _new = IntToVoid(VoidToInt(_old) + step * count);
#endif
}

void Range::printon(ostream& outs) const
{
    if (!print_readable) {
	GenSeq::printon(outs);
	return;
    }
    GenSeq::printon(outs);
    outs << "(";
    outs << ilower();
    if (step != 1 || len == InfiniteLength)
	outs << " by " << step;
    if (len != InfiniteLength)
	outs << " for " << len;
    outs << ")";
}

Recurrence::Recurrence(Root* i0, Functional* st)
     : initial(i0), step_func(st)
{
    elType = &RefRoot;
    first = (void*)&initial;
    len = InfiniteLength;
}

GenSeq * Recurrence::subseq(index_t start, index_t end)
{
    int drop = start; size_t length = end-start;

    Root *new_start;
    size_t new_len = len;
    if (KnownLength(new_len)) new_len -= drop;
    if (new_len >= length) new_len = length;
    if (new_len == 0)
	return &NullSequence;
    stepper((void*)&initial, (void*)&new_start, drop);
    Recurrence* subrange = new Recurrence(new_start, step_func);
    subrange->len = new_len;
    return subrange;
}

void Recurrence::printon(ostream& outs) const
{
    if (print_readable)
	outs << '(';
    initial->printon(outs);
    outs << " by ";
    step_func->printon(outs);
    if (len != InfiniteLength)
	outs << "for " << len;
    if (print_readable)
	outs << ')';
}

void Recurrence::stepper(void* _old, void *_new, int count = 1) const
{
    Root* current = *(Root**)_old;
    while (--count >= 0) {
	current = step_func->postfix(current);
    }
    *(Root**)_new = current;
}

GenRange::GenRange(const Root* i0, fix_int st) : initial(i0)
{
    step = st;
    elType = &RefRoot;
    first = (void*)&initial;
    len = InfiniteLength;
}

GenSeq * GenRange::subseq(index_t start, index_t end)
{
    if (len == InfiniteLength) {
	// ???
    }
    else {
	if (start < 0) start += len + 1;
	if (end < 0) end += len + 1;
	if (start > len)
	    return &NullSequence;
    }
    int drop = start; size_t length = end-start;
    const Root *new_start;
    size_t new_len = len;
    if (KnownLength(new_len)) new_len -= drop;
    if (new_len >= length) new_len = length;
    if (new_len == 0)
	return &NullSequence;
    stepper((void*)&initial, (void*)&new_start, drop);
    GenRange* subrange = new GenRange(new_start, step);
    subrange->len = end == -1 ? len : end-start;
    return subrange;
}

void GenRange::printon(ostream& outs) const
{
    if (!print_readable) {
	GenSeq::printon(outs);
	return;
    }
    outs << "(";
    initial->printon(outs);
    if (step != 1 || len == InfiniteLength)
	outs << " by " << step;
    if (len != InfiniteLength)
	outs << " for " << len;
    outs << ")";
}

void GenRange::stepper(void* _old, void *_new, int count = 1) const
{
    *(Root**)_new = Plus(*(const Root**)_old, (Root*)MakeFixInt(count * step));
}

#if 0
GenSeq * GenRecur::subseq(int drop, size_t length)
{
    if (drop < 0) drop = 0;
    size_t l = len;
    if (drop >= l) drop = l;
    if (l != InfiniteLength) l -= drop;
    if (l > length) l = length;
    return new <thistype>(first + step * drop, step, l);
}
#endif

GenSeq * Range::subseq(index_t start, index_t end)
{
    int drop = start; size_t length = end-start;
    if (drop < 0) drop = 0;
    size_t l = len;
    if (drop >= l) drop = l;
    if (KnownLength(l)) l -= drop;
    if (l > length) l = length;
    return new Range(VoidToInt(first) + step * drop, step, l);
}

MapSeq::MapSeq(Clause* cl, Function* fun, Root* en, ArgDesc& args)
{
    clause = cl;
    function = fun;
    env = en;
    int i;

    // Copy args. Check which are sequences.
    lCount = args.lCount;
    rCount = args.rCount;
    nCount = args.nCount;
    i = args.lCount+args.rCount+args.nCount;
    arg_list = i ? new RootPtr[i] : NULL;
    arg_is_sequence = i ? new signed char[i] : NULL;
    names = args.nCount ? new Symbol* [args.nCount] : NULL;
    int out_index = 0;
    for (i = 0; i < lCount; i++, out_index++) {
	Root* arg = args.lArgs[i];
	arg_is_sequence[out_index] = -1;
	GenSeq *seq_arg = arg->sequence();
	if (seq_arg) arg = seq_arg, arg_is_sequence[out_index] = 1;
	else arg_is_sequence[out_index] = -1;
	arg_list[out_index] = arg;
    }
    for (i = 0; i < rCount; i++, out_index++) {
	Root* arg = args.rArgs[i];
	arg_is_sequence[out_index] = -1;
	GenSeq *seq_arg = arg->sequence();
	if (seq_arg) arg = seq_arg, arg_is_sequence[out_index] = 1;
	else arg_is_sequence[out_index] = -1;
	arg_list[out_index] = arg;
    }
    for (i = 0; i < nCount; i++, out_index++) {
	Root* arg = args.rArgs[i];
	arg_is_sequence[out_index] = -1;
	GenSeq *seq_arg = arg->sequence();
	if (seq_arg) arg = seq_arg, arg_is_sequence[out_index] = 1;
	else arg_is_sequence[out_index] = -1;
	arg_list[out_index] = arg;
	names[i] = args.names[i];
    }
}

Root *MapSeq::index(index_t i)
{
    Root *dst;
    ArgDesc args;
    args.lCount = lCount;
    args.rCount = rCount;
    args.nCount = nCount;
    args.names = names;
    int allCount = lCount+rCount+nCount;
    Root** new_args = (Root**)alloca(sizeof(Root**) * allCount);
    for (int argi = 0; argi < allCount; argi++) {
	Root* arg = arg_list[argi];
	if (arg_is_sequence[argi] > 0) {
	    arg = ((GenSeq*)arg)->index(i);
	    if (arg == Missing)
		return Missing;
	}
	new_args[argi] = arg;
    }
    args.lArgs = new_args;
    args.rArgs = new_args+lCount;
    args.nArgs = new_args+lCount+rCount;
    ApplyClause(&dst, &RefRoot, clause, function, env, args);
    return dst;
}

size_t MapSeq::length()
{
    size_t len = InfiniteLength;
    int allCount = lCount+rCount+nCount;
    for (int argi = 0; argi < allCount; argi++) {
	if (arg_is_sequence[argi] <= 0)
	    continue;
	GenSeq* arg = (GenSeq*)arg_list[argi];
	size_t tmp = arg->length();
	if (tmp < len || len == InfiniteLength) len = tmp;
    }
    return len;
}

size_t BinOpSeq::length()
{
    size_t len = InfiniteLength;
    size_t tmp;
    if (leftIsSeq) {
	tmp = left->sequence()->length();
	if (tmp < len) len = tmp;
    }
    if (rightIsSeq) {
	tmp = right->sequence()->length();
	if (tmp < len) len = tmp;
    }
    return len;
}

Root *BinOpSeq::index(index_t i)
{
    Root *leftArg = leftIsSeq ? left->sequence()->index(i) : left;
    Root *rightArg = rightIsSeq ? right->sequence()->index(i) : right;
    if (leftArg == Missing || rightArg == Missing) return Missing;
    return op->infix(leftArg, rightArg);
}


extern "C" unsigned short *ClassSearch(const struct ClassDesc *, const Name);

Root *WhileSeq::index(index_t i)
{
    if (i < 0)
	i = i + length() + 1;
    if (limit != InfiniteLength && limit != UnknownLength
	&& (size_t)i >= limit)
	return Missing;
    if (i < tested)
	return elements->index(i);
    Root *el;
    Root *cond;
    for ( ; tested <= i; tested++) {
	int succeeded;
	IFV(WhileIndexIfHandler) {
	    cond = conds->index(tested);
	    if (cond != Missing) {
		// FIXME: if following fails, should not be treated as EOF!
		el = elements->index(tested);
		const Functional *func = cond->functional();
		if (func && el != Missing) {
		    cond = func->apply(&el, NULL, NULL, NULL, 1, 0, 0);
		}
	    }
	}
	THENV {
	    succeeded = cond == Missing || el == Missing ? -1 : 1;
	}
	ELSEV(WhileIndexIfHandler,Fail)
	    succeeded = 0;
	ENDV;
	if (succeeded <= 0) {
	    limit = tested;
	    return Missing;
	}
    }
    return el;
}

Root *UntilSeq::index(index_t i)
{
    if (i < 0)
	i = i + length() + 1;
    if ((size_t)i >= limit)
	return Missing;
    if (i < tested)
	return elements->index(i);
    Root *el;
    for ( ; tested <= i; tested++) {
	el = elements->index(tested);
	if (el == Missing) {
	    limit = tested;
	    return Missing;
	}
	int succeeded;
	IFV(UntilIndexIfHandler) {
	    Root *cond = conds->index(tested);
	    const Functional *func = cond->functional();
	    if (func) {
		cond = func->apply(&el, NULL, NULL, NULL, 1, 0, 0);
	    }
	}
	THENV
	    succeeded = 1;
	ELSEV(UntilIndexIfHandler,Fail)
	    succeeded = 0;
	ENDV
	if (succeeded) {
	    limit = tested++;
	    return el;
	}
    }
    return el;
}

size_t WhileSeq::length()
{
    if (tested == limit)
	return tested;
    for (;;) {
	Root *el = index(tested);
	if (el == Missing) {
	    limit = tested;
	    return limit;
	}
    }
}

WhereSeq::WhereSeq(GenSeq *e, GenSeq *c)
{
    elements = e;
    conds = c;
    indexes = NULL;
    allocated = 0;
    next_to_try = 0;
    upper_index = 0;
    eof_seen = 0;
}

Root *WhereSeq::index(index_t i)
{
    if (i < 0)
	i = i + length() + 1;
    if (i < upper_index)
	return elements->index(lookup(i));
    if (eof_seen)
	return Missing;
    for (;; ) {
	int succeeded;
	Root *cond;
	Root *el;
	IFV(WhereIndexIfHandler) {
	    el = elements->index(next_to_try);
	    if (el == Missing)
		cond = Missing;
	    else {
		cond = conds->index(next_to_try);
		const Functional *func = cond->functional();
		if (func && el != Missing)
		    cond = func->apply(&el, NULL, NULL, NULL, 1, 0, 0);
	    }
	}
	THENV
	    succeeded = cond == Missing || el == Missing ? -1 : 1;
	ELSEV(WhereIndexIfHandler,Fail)
	    succeeded = 0;
	ENDV;
	if (succeeded == -1) {
	    eof_seen = 1;
	    return Missing;
	}
	next_to_try++;
	if (succeeded) {
	    if (upper_index >= allocated) // Test for overflow of indexes.
		if (allocated == 0) {
		    allocated = 64;
		    indexes = (index_t*)GC_malloc(allocated * sizeof(index_t));
		}
		else {
		    allocated *= 2;
		    indexes = (index_t*)GC_realloc(indexes,
						allocated * sizeof(index_t));
		}
	    lookup(upper_index) = next_to_try-1;
	    if (upper_index++ == i)
		return el;
	}
    }
}

size_t WhereSeq::length()
{
    while (!eof_seen) {
	index(upper_index);
    }
    return upper_index;
}

Root *CreateWhile(Root *arg1, Root *arg2)
{
    GenSeq *seq1 = arg1->sequence();
    GenSeq *seq2 = arg2->sequence();
    if (seq1 == NULL)
	seq1 = new ConstSeq(arg1);
    if (seq2 == NULL)
	return new WhileSeqPred(seq1, arg2);
    return new WhileSeq(seq1, seq2);
}

Root *CreateUntil(Root *arg1, Root *arg2)
{
    GenSeq *seq1 = arg1->sequence();
    GenSeq *seq2 = arg2->sequence();
    if (seq1 == NULL)
	seq1 = new ConstSeq(arg1);
    if (seq2 == NULL)
	seq2 = new ConstSeq(arg2);
    return new UntilSeq(seq1, seq2);
}

Root *CreateWhere(Root *arg1, Root *arg2)
{
    GenSeq *seq1 = arg1->sequence();
    GenSeq *seq2 = arg2->sequence();
    if (seq1 == NULL)
	seq1 = new ConstSeq(arg1);
    if (seq2 == NULL)
	seq2 = new ConstSeq(arg2);
    return new WhereSeq(seq1, seq2);
}

Root * LessEqualUnary::postfix(Root *arg1)
{
    if (arg1->compare(*arg2) > 0)
	RAISE(Compare_failed, 0);
    return &NullSequence;
}

void LessEqualUnary::xapply(void* dst, Type* dstType, ArgDesc& args)
{
  Root* result;
  if (args.lCount == 0)
    result = DoCurry(this, args);
  else
    {
      if (args.lArgs[args.lCount-1]->compare(*arg2) > 0)
	RAISE(Compare_failed, 0);
      if (args.rCount + args.lCount + args.nCount == 1)
	result = &NullSequence;
      else
	{
	  ArgDesc xargs(args, 1, 0);
	  NullSequence.xapply(dst, dstType, xargs);
	  return;
	}
    }
  dstType->coerceFromRoot(dst, result);
}

Root * GreaterEqualUnary::postfix(Root *arg1)
{
    if (arg1->compare(*arg2) < 0)
	RAISE(Compare_failed, 0);
    return &NullSequence;
}

void GreaterEqualUnary::xapply(void* dst, Type* dstType, ArgDesc& args)
{
  Root* result;
  if (args.lCount == 0)
    result = DoCurry(this, args);
  else
    {
      if (args.lArgs[args.lCount-1]->compare(*arg2) < 0)
	RAISE(Compare_failed, 0);
      if (args.rCount + args.lCount + args.nCount == 1)
	result = &NullSequence;
      else
	{
	  ArgDesc xargs(args, 1, 0);
	  NullSequence.xapply(dst, dstType, xargs);
	  return;
	}
    }
  dstType->coerceFromRoot(dst, result);
}

Root *CreateUpto(Root *arg1, Root *arg2)
{
    GenSeq *seq1 = arg1->sequence();
    if (seq1 == NULL)
	seq1 = new GenRange(arg1, 1);
    return new UptoSeq(seq1, arg2);
}

Root *CreateDownto(Root *arg1, Root *arg2)
{
    GenSeq *seq1 = arg1->sequence();
    if (seq1 == NULL)
	seq1 = new GenRange(arg1, -1);
    return new DowntoSeq(seq1, arg2);
}

Root *CreateTo(int lo, int hi)
{
    return new Range(lo, 1, hi-lo+1);
}

Root * Record::prefix(Root *arg)
{
    const RecordType *type = rtype();
    if (FunctionLike(arg)) return NULL;
    if (arg->magic() != SymbolKind) RaiseDomainError(NULL);
    Field *fld;
    Name name((Symbol*)arg);
    FOR_EACH_FIELD(fld, type->desc) {
	if (strcmp(fld->name->string(), name->string()) == 0)
	    return (Root*)fld->extractObject(this);
    }
    RaiseDomainError(NULL);
    return NULL;
}

Root * Record::lookup_at(const char *name, int nlen = -1)
{
    const RecordType *type = rtype();
    Field *fld;
    FOR_EACH_FIELD(fld, type->desc) {
	if (strcmp(fld->name->string(), name) == 0)
	    return (Root*)fld->extractObject(this);
    }
    return NULL;
}

size_t Record::length() { return 0; }

void Record::printon(ostream& outs) const
{
    const struct RecordType *typ = rtype();
    const ClassDesc *dsc = typ->desc;
    struct Field *fld;
    int i = 0;
    if (typ->class_name)
	outs << '(' << typ->class_name->string() << " ";
    else
	outs << '[';
    FOR_EACH_FIELD(fld, dsc) {
	if (fld->isPrivate()) continue;
	if (i++) outs << ' ';
	if (fld->kind == Include_Field) outs << "*: ";
	else if (fld->name == NULL) outs << "?: ";
	else outs << fld->name->string() << ": ";;
#if 1
	fld->extract((char*)this).printon(outs);
#else
      case Pointer_Field:
      case Struct_Field:
	fld->class()->print((char*)this + fld->offset, outs);
#endif
    }
    outs << (typ->class_name ? ')' : ']');
}

Record * RecordType::alloc(size_t size = (size_t)(-1))
{
    if (size == (size_t)(-1)) size = inst_size;
    Record *rec = (Record*)GC_malloc(size);
    *(void**)rec = instanceVTable;
    return rec;
}

#if 0
Record *AllocRecord(const Type *cl, size_t size)
{
    Record *rec = (Record*)GC_malloc(sizeof(Record)+size);
    rec->Record::Record(cl);
    return rec;
}
#endif

#if 0
struct Any ListToMultiple(struct Any map)
{
    const GenMap *m = ((Root*)(map.addr))->mapping();
    if (m == NULL) RaiseDomainError(0);
    return MAKE_ANY(m->chooseAll(), NULL);
}
#endif

Root * GenMap::chooseAll() const
{
#ifndef news
    Signal(new UnimplementedOp("genMap::chooseAll", NULL));
    return NULL;
#else
    extern struct ExceptionClass *LastRaiseException;
    ITERATOR(iter, this);
  retry:
     Root *v = iter.next();
     if (v == Missing) RAISE(End_of_file, NULL);
     return
     OR_(List2Mult, Root *)
	v
     ELSE_OR_(List2Mult) {
	if (LastRaiseException != (struct ExceptionClass*)End_of_file) {
	    goto retry;
	}
	RAISE(Fail, NULL);
	(Root*)0;
    }
    END_OR_;
#endif
}

#if 0
struct Any MakeMapPair(struct Any arg, struct Any val)
{
    return MAKE_ANY(MakeTuple(new SplayMap(arg.addr, val.addr)), NULL);
}
#endif

#if 0
OArray *MakeArray(Root **ptr, int len, int copy)
{
    Root **arr;
    if (copy) {
	int bytes = len * sizeof(Root*);
	arr = (Root**)GC_malloc(bytes);
	bcopy(ptr, arr, bytes);
	ptr = arr;
    }
    return new OArray(len, ptr);
}
#endif

Root * DoShape(Root *object)
{
  GenMap *map = object->mapping();
  if (map == NULL || !map->isKindOf(*GenArray::desc()))
	return &NullSequence;
  GenArray *arr = GenArray::castdown(map);
  int rank = arr->rank();
  Vector *vec = NewVector(rank);
  for (int i = 0; i < rank; ++i)
    vec->start_addr()[i] = (Root*)MakeFixInt(arr->dimension(i));
  return vec;
}

unsigned char AlphabethBuf[256] = {
  000, 001, 002, 003, 004, 005, 006, 007,
  010, 011, 012, 013, 014, 015, 016, 017,
  020, 021, 022, 023, 024, 025, 026, 027,
  030, 031, 032, 033, 034, 035, 036, 037,
  040, 041, 042, 043, 044, 045, 046, 047,
  050, 051, 052, 053, 054, 055, 056, 057,
  060, 061, 062, 063, 064, 065, 066, 067,
  070, 071, 072, 073, 074, 075, 076, 077,
 0100,0101,0102,0103,0104,0105,0106,0107,
 0110,0111,0112,0113,0114,0115,0116,0117,
 0120,0121,0122,0123,0124,0125,0126,0127,
 0130,0131,0132,0133,0134,0135,0136,0137,
 0140,0141,0142,0143,0144,0145,0146,0147,
 0150,0151,0152,0153,0154,0155,0156,0157,
 0160,0161,0162,0163,0164,0165,0166,0167,
 0170,0171,0172,0173,0174,0175,0176,0177,
 0200,0201,0202,0203,0204,0205,0206,0207,
 0210,0211,0212,0213,0214,0215,0216,0217,
 0220,0221,0222,0223,0224,0225,0226,0227,
 0230,0231,0232,0233,0234,0235,0236,0237,
 0240,0241,0242,0243,0244,0245,0246,0247,
 0250,0251,0252,0253,0254,0255,0256,0257,
 0260,0261,0262,0263,0264,0265,0266,0267,
 0270,0271,0272,0273,0274,0275,0276,0277,
 0300,0301,0302,0303,0304,0305,0306,0307,
 0310,0311,0312,0313,0314,0315,0316,0317,
 0320,0321,0322,0323,0324,0325,0326,0327,
 0330,0331,0332,0333,0334,0335,0336,0337,
 0340,0341,0342,0343,0344,0345,0346,0347,
 0350,0351,0352,0353,0354,0355,0356,0357,
 0360,0361,0362,0363,0364,0365,0366,0367,
 0370,0371,0372,0373,0374,0375,0376,0377,
};

static String AlphabethString((char*)AlphabethBuf, 256);
static Predefined pre_t(ADotSymbol, AlphabethString);

void DoMap(ostream* dest, Root*arg)
{
    GenSeq *seq = arg->sequence();
    if (seq == NULL)
	RaiseDomainError(NULL);
    ITERATOR(iter, seq);
    for (;;) {
	Root* val;
	CATCH_MISSING(DoMapHandler) {
	    val = iter.next();
	} HANDLE_MISSING(DoMapHandler) {
	    break;
	} END_MISSING;
	if (val == Missing) break;
	*dest << *val;
    }
}

static int CompObs(void *a, void *b)
{
    return (((Root*)a)->value())->compare(*((Root*)b)->value());
}

Root* CompareObs(Root *a, Root *b)
{
    return (Root*)MakeFixInt(CompObs(a, b));
}

typedef int (*compare_func)(void *, void*);
extern "C" void psort (void **, size_t, compare_func);

#if 0 /* __GNUC__*/
/* Doesn't work for g++ ??? */
#define NESTED_C_FUNCTIONS
#endif

#ifndef NESTED_C_FUNCTIONS
/* FIXME!  non-reentrant! */
static Root *__compare_func = NULL;

int FCompOb(void *a, void *b)
{
  Root *larg = ((Root*)a)->value();
  Root *rarg = ((Root*)b)->value();
  Numeric *result =
    __compare_func->apply(&larg, &rarg, NULL, NULL, 1, 1, 0)->numeric();
  if (result == NULL)
    Signal(new GenericCondition("compare routine call by sort return non-number"));
  return result->sign();
}
#endif /* !NESTED_C_FUNCTIONS */

Root *Sort(Root *arg, Root *comp)
{
  GenSeq *seq = Coerce2Sequence(arg);
  size_t n = seq->length();
  Vector *vec = NewVector(n);
  Root **ptr = vec->start_addr();
#ifdef NESTED_C_FUNCTIONS
  Root *__compare_func = NULL;
  int FCompOb(void *a, void *b)
    {
      Root *larg = ((Root*)a)->value();
      Root *rarg = ((Root*)b)->value();
      Numeric *result =
	__compare_func->apply(&larg, &rarg, NULL, NULL, 1, 1, 0)->numeric();
      if (result == NULL)
	Signal(new GenericCondition("compare routine call by sort return non-number"));
      return result->sign();
    }
#endif  /* NESTED_C_FUNCTIONS */
  ITERATOR(iter, seq);
  size_t i;
  for (i = 0; i < n; i++)
    {
      Root* v = iter.next();
      *ptr++ = v;
    }
  if (comp == NULL)
    psort ((void**)vec->start_addr(), n, CompObs);
  else
    {
      if (__compare_func)
	  Signal(new UnimplementedOp("Recursive calls to 'sort'"));
      __compare_func = comp;
      psort ((void**)vec->start_addr(), n, FCompOb);
      __compare_func = NULL;  
    }
  return vec;
}

size_t Cyclic::length()
{
  return InfiniteLength;
}

size_t Cyclic::_cycle_length(int cycle_part)
{
  if (cycle_part)
    return cycle_length();
  else
    return finite_length();
}

Root* Cyclic::index(index_t i)
{
  if (i < 0)
    return Missing;
  length_t f_len = finite_length();
  if (f_len == InfiniteLength || i < f_len)
    return finite_part()->index(i);
  i -= f_len;
  i %= cycle_length();
  return cycle_part()->index(i);
}

GenSeq* Cyclic::subseq(index_t start, index_t end)
{
  if (end < 0)
    return this;
  if (start < 0)
    return this;
  if (end <= start)
    return &NullSequence;
  size_t f_len = finite_length();
  if (end <= f_len)
    return finite_part()->subseq(start, end);
  size_t c_len = cycle_length();
  if (start >= f_len && end <= f_len + c_len)
    return cycle_part()->subseq(start - f_len, end - f_len);
  return GenSeq::subseq(start, end);
}

Root* MakeCyclic(Root *X, Root* Y)
{
  GenSeq *x = X->sequence();
  GenSeq *y = Y->sequence();
  if (x == NULL)
    Signal(new CoercionFail(X, GenSeq::desc()));
  if (y == NULL)
    Signal(new CoercionFail(Y, GenSeq::desc()));
  return new Cyclic(x, y);
}

