#pragma implementation
#include <iostream.h>
extern "C" {
#include <string.h>
}
#include "gvars.h"
#include "gennum.h"
#ifdef __GNU_LIBRARY__
#include <stdlib.h>
EXTERN void exit(int);
/*EXTERN void bcopy(const void *, void *, int);*/
#else
#include <std.h>
#endif
#include "stdarg.h"
#include "genmap.h"
#include "genfiles.h"
#include "gfunc.h"
#include "gfiles.h"
#include "gcompile.h"
#include "gkinds.h"
#include "exceptions.h"
#include "evalprocs.h"
#include "undobind.h"
#include "ifthenelse.h"

#ifndef MULTI_PROCESS
UndoCommand *UndoTrail = NULL; /* chronological list */
#ifndef HAVE_PAGE_ALLOC
char *UndoBuffer = 0;
#endif
#endif

#ifndef DO_BACKTRACK
static OrContextCounter = 0;

OrContext::OrContext()
{
    context = this;
    _contextId = OrContextCounter++;
    next = CurrentOrContext;
}

#define BadContextJoin NULL

OrContext RootContext;
OrContext *CurrentOrContext = &RootContext;

// Produce the join/merge of two OrContext chains.
// Return BadContextJoin if they are incompatible.

OrContextLink* Join(OrContextLink *context1, OrContextLink *context2)
{
    register OrContextLink *link1 = context1;
    register OrContextLink *link2 = context2;
    int skipped1 = 0;
    int skipped2 = 0;
    for (;;) {
	while (link1->contextId() > link2->contextId())
	    link1 = link1->next, skipped1++;
	while (link2->contextId() > link1->contextId())
	    link2 = link2->next, skipped2++;
	if (link1->variant() != link2->variant())
	    return BadContextJoin;
	if (link1 == link2)
	    break;
	link1 = link1->next; skipped1++;
	link2 = link2->next; skipped2++;
    }
    OrContextLink *meet = link1;
    if (skipped1 == 0)
	return context2;
    if (skipped2 == 0)
	return context1;

    // Must actually construct merged context chain.
    OrContextLink *result;
    OrContextLink **resultPtr = &result;
    link1 = context1;
    link2 = context2;
    for (;;) {
	while (link1->contextId() > link2->contextId()) {
	    *resultPtr = new OrContextLink(*link1);
	    resultPtr = &(*resultPtr)->next;
	    link1 = link1->next;
	}
	while (link2->contextId() > link1->contextId()) {
	    *resultPtr = new OrContextLink(*link2);
	    resultPtr = &(*resultPtr)->next;
	}
	link2 = link2->next;
	if (link1 == link2)
	    break;
	*resultPtr = new OrContextLink(*link1);
	resultPtr = &(*resultPtr)->next;
	link1 = link1->next;
	link2 = link2->next;
    }
    *resultPtr = meet;
    return result;
}

#endif

EXTERN char *AllocPages(int, int);

Root *LVariable::value() { return NULL; }

void LVariable::dumpPtr(CFile *cf) const
{
    Root *val = ((LVariable*)this)->value();
    if (val) DumpPointerTo(val, cf);
    else fprintf(stderr, "Don't know how to LVariable::dumpPtr\n");
}

void LVariable::xapply(void* dst, Type* dstType, ArgDesc& desc)
{
  Root *val = value();
  if (val)
    val->xapply(dst, dstType, desc);
  else
    return Root::xapply(dst, dstType, desc);
}

long LVariable::magic() const
{
    Root *val = ((LVariable*)this)->value();
    if (val == NULL) return VariableKind;
    else return val->magic() | VariableKind;
}

Numeric * LVariable::numeric()
{
    Root *v = ((LVariable*)this)->value();
    if (v) return v->numeric();
    else return NULL;
}

GenMap * LVariable::mapping()
{
    Root *v = ((LVariable*)this)->value();
    if (v) return v->mapping();
    else return NULL;
}

GenFile * LVariable::file()
{
    Root *v = value();
    if (v) return v->file();
    else return NULL;
}

GenSeq * LVariable::sequence() const
{
    Root *v = ((LVariable*)this)->value();
    if (v) return v->sequence();
    else return NULL;
}

Functional * LVariable::functional()
{
    Root *v = ((LVariable*)this)->value();
    if (v) return v->functional();
    else return NULL;
}

Assignable * LVariable::assignable() const
{
    Root *v = ((LVariable*)this)->value();
    if (v) return v->assignable();
    else return NULL;
}

void LVariable::assign(Root *new_value)
{
    Root *val = value();
    if (val == NULL)
	SignalBadAssignment(this, new_value);
    return val->assign(new_value);
}

const StringC * LVariable::asString(int format=0) const
{
    Root *val = ((LVariable*)this)->value();
    if (val == NULL) return NULL;
    return val->asString(format);
}

Root *PVariable::value()
{
    if (val == NULL) return NULL;
    LVariable *v = val->lvariable();
    if (v == NULL) return val;
    Root *nval = v->value();
#if 0
    if (nval) val = nval; // simplify -- however, must watch for backtracking
#endif
    return nval;
}

void PVariable::printon(ostream& outs) const
{
    if (val == NULL) outs << '_';
    else val->printon(outs);
}

PVariable::PVariable()
{
    val = NULL;
#ifndef DO_BACKTRACK
    __env = CurrentOrContext;
#endif
}

NamedPVariable::NamedPVariable(Symbol * n) { val = NULL; name = n; }

void NamedPVariable::printon(ostream& outs) const
{
    if (val == NULL) name->printon(outs);
    else val->printon(outs);
}

void PVariable::unify(Root& other)
{
    // *** Rodo/rethink this, probably to be more WAM-like
    if (&other == (Root*)this) return;
    if (val == NULL) {
	Root *optr = &other;
	for (;;) {
	    LVariable *ovar = optr->lvariable();
	    if (ovar == NULL || !(ovar->varflags() & LVarPlain)) break;
	    if ((PVariable*)ovar == this) return;
	    if (!((PVariable*)ovar)->val) break;
	    optr = ((PVariable*)ovar)->val;
	}
	val = optr;
	struct UndoChange *undo =
	    (struct UndoChange*)GetUndoCommand(sizeof(struct UndoChange));
	undo->kind = UndoChangeFlag;
	undo->ptr = &val;
	undo->old = NULL;
	return;
    }
    val->unify(other);
}

// A CVariable has the following representation:
// If the value is known, link points to the value
// If the value is unknown, the CVariable is linked in a circular
// chain of variables that have been unified.
// In the latter case, the UnknownVarMask bit is set

CVariable::CVariable() { ilink = (long)this | (UnknownVarMask+LastVarMask); }

Root *CVariable::value()
{
    if (unknown()) return NULL;
    else return link();
}

void CVariable::printon(ostream& outs) const
{
    if (unknown()) outs << '_';
    else val()->printon(outs);
}

// The representative of a chain of CVariables is the
// variable with LastVarMask bit set
CVariable * CVariable::getRepresentative()
{
    register CVariable *var = this;
    while (!(var->ilink & LastVarMask))
	var = var->link();
    return var;
}

void CVariable::notify() { }

void CVariable::Set(Root *value)
{
    UndoCommand *undo = GetUndoCommand(sizeof(struct UndoSet));
    CVariable *v, *next;
    undo->kind = UndoLastFlag;
    undo->set.var = this;
    next = link();
    setvar(value);
    for (v = next; v!=this; v= next) {
	undo = GetUndoCommand(sizeof(struct UndoSet));
	undo->kind = UndoSetFlag;
	undo->set.var = v;
	next = v->link();
	v->setvar(value);
    }
  /* do notifications, if needed */
    for (undo = UndoTrail; ;) {
	CVariable *v = undo->set.var;
	v->notify();
	if (undo->kind == UndoLastFlag) break;
	undo = (UndoCommand*)(&undo->set  + 1);
	if (undo->kind == UndoLinkFlag)
	    undo = undo->link.prev;
    }
}

void CVariable::unify(Root& other)
{
    if (!unknown()) { val()->unify(other); return; }
#ifndef DO_BACKTRACK
    if (CurrentOrContext != lenviron()) {
	OrContext *penv = CurrentOrContext;
	for (; penv != lenviron(); penv = penv->parent()) { }
    }
#endif
    CVariable *x = getRepresentative();
    LVariable *yvar = other.lvariable();
    if (yvar == NULL) {
	x->Set(&other);
	return;
    }
    Root *yval = yvar->value();
    if (yval) {
	x->Set(yval);
	return;
    }
    if (chainLinked()) {
	CVariable *y = ((CVariable*)yvar)->getRepresentative();
	if (x == y) return;

	long v = x->ilink;
	x->ilink = y->ilink & ~LastVarMask;
	y->ilink = v;
	struct UndoEqual *undo =
	     (struct UndoEqual*)GetUndoCommand(sizeof(struct UndoEqual));
	undo->kind = UndoEqualFlag;
	undo->var = x;
    } else {
	// ???
    }
}

NamedCVariable::NamedCVariable(Symbol * n) { name = n; }

void NamedCVariable::printon(ostream& outs) const
{
    if (unknown()) name->printon(outs);
    else val()->printon(outs);
}

LDependency::LDependency(Combination *comb, Root *arg)
  : CVariable(), _combination(comb)
{
    unify(*arg);
}

void LDependency::notify()
{
    combination()->recalculate(this);
    
}

void InverseVariable::notify()
{
    Root *val = value();
    if (val == NULL) return;
    ArgDesc new_args = args;
    if (args.lCount) {
	new_args.lArgs = (Root**)alloca(args.lCount * sizeof(Root*));
	bcopy(args.lArgs, new_args.lArgs, args.lCount * sizeof(Root*));
	new_args.lArgs[0] = val;
	args.lArgs[0]->unify(*function->apply(new_args));
    } else {
	new_args.rArgs = (Root**)alloca(args.rCount * sizeof(Root*));
	bcopy(args.rArgs, new_args.rArgs, args.rCount * sizeof(Root*));
	new_args.rArgs[0] = val;
	args.rArgs[0]->unify(*function->apply(new_args));
    }
}

Choice::Choice(int nchoices ...) : Combination()
{
    va_list args;
    va_start(args, nchoices);
    ndeps = nchoices;
    dep = new LDependency[nchoices];
    for (int i = 0; i < ndeps; i++) {
	Root * arg = va_arg(args, Root*);
 	dep[i].LDependency::LDependency(this, arg);
    }
    va_end(args);
}

void Choice::xapply(void* dst, Type* dstType, ArgDesc& args)
{
  Root **result_vals = (Root**)alloca(nchoices() * sizeof(Root*));
#ifndef DO_BACKTRACK
  OrContext **result_contexts =
    (OrContext**)alloca(nchoices() * sizeof(OrContext*));
#endif
  int i;
  for (i = 0; i < nchoices(); i++) {
    result_vals[i] = dep[i].apply(args);
#ifndef DO_BACKTRACK
    result_contexts[i] = dep[i].lenviron();
#endif
  }
#ifdef DO_BACKTRACK
  dstType->coerceFromRoot(dst, new Choice(result_vals, nchoices()));
#else
  dstType->coerceFromRoot(dst, new Choice(result_vals, result_contexts, nchoices()));
#endif
}

#ifdef DO_BACKTRACK
Choice::Choice(Root **vals, int nchoices) : Combination()
{
    ndeps = nchoices;
    dep = new LDependency[nchoices];
    for (int i = 0; i < ndeps; i++) {
 	dep[i].LDependency::LDependency(this, vals[i]);
    }
}
#else
Choice::Choice(Root **vals, OrContext *envs, int nchoices) : Combination()
{
    ndeps = nchoices;
    dep = new LDependency[nchoices];
    OrContext *save_env = CurrentOrContext;
    for (int i = 0; i < ndeps; i++) {
	CurrentOrContext = &envs[i];
 	dep[i].LDependency::LDependency(this, vals[i]);
    }
    CurrentOrContext = save_env;
}
Choice::Choice(Root **vals, OrContext **envs, int nchoices) : Combination()
{
    ndeps = nchoices;
    dep = new LDependency[nchoices];
    OrContext *save_env = CurrentOrContext;
    for (int i = 0; i < ndeps; i++) {
	CurrentOrContext = envs[i];
 	dep[i].LDependency::LDependency(this, vals[i]);
    }
    CurrentOrContext = save_env;
}
#endif

void Choice::printon(ostream& outs) const
{
    int ndone = 0;
    for (int i = 0; i < nchoices(); i++) {
	//if (dep[i].link == NULL) continue;
	if (ndone) outs << '|';
	dep[i].printon(outs);
	ndone++;
    }
}

void Choice::recalculate(LDependency*)
{
    return;
}

void Choice::notify()
{
    Root *val = value();
    if (val == NULL) return;
    for (int i = 0; i < nchoices(); i++) {
	dep[i].unify(*val);
    }
}

Product::Product(const Numeric *_constant, int nfactors ...) : Combination()
{
    // if (nfactors <= 0) return constant;
    va_list args;
    va_start(args, nfactors);
    constant = _constant;
    ndeps = nfactors;
    dep = new LDependency[nfactors];
    for (int i = 0; i < ndeps; i++) {
	Root * arg = va_arg(args, Root*);
 	dep[i].LDependency::LDependency(this, arg);
    }
    va_end(args);
}

void Product::printon(ostream& outs) const
{
    int ndone = 0;
    if (constant) {
	constant->printon(outs);
	ndone++;
    }
    for (int i = 0; i < nfactors(); i++) {
	if (dep[i].link == NULL) continue;
	if (ndone) outs << '*';
	dep[i].printon(outs);
	ndone++;
    }
}

Sum::Sum(const Numeric *_constant, int naddends ...) : Combination()
{
    // if (naddends <= 0) return constant;
    va_list args;
    va_start(args, naddends);
    constant = _constant;
    ndeps = naddends;
    dep = new LDependency[naddends];
    for (int i = 0; i < ndeps; i++) {
	Root * arg = va_arg(args, Root*);
 	dep[i].LDependency::LDependency(this, arg);
    }
    va_end(args);
}

void Sum::printon(ostream& outs) const
{
    int ndone = 0;
    if (constant && constant != Zero) {
	constant->printon(outs);
	ndone++;
    }
    for (int i = 0; i < naddends(); i++) {
	if (dep[i].link == NULL) continue;
	if (ndone) outs << '+';
	dep[i].printon(outs);
	ndone++;
    }
    if (!ndone)
	outs << '0';
}

void Combination::recalculate(LDependency*) { }

void
Sum::recalculate(LDependency*)
{
    Root *sum;
    if (constant) sum = (Root*)constant;
    for (int i = 0; i < naddends(); i++) {
	Root *val = dep[i].value();
	if (val == NULL) return;
	if (sum) sum = Plus(sum, val);
	else sum = val;
	if (sum == NULL) RaiseDomainError(0);
    }
    unify(*sum);
}

void
Sum::notify()
{
#if 1
    abort();
#else
    Root *val = value();
    if (val == NULL) return;

    int unknowndep = -1;
    Root *sum;
    if (constant) sum = (Root*)constant;
    for (int i = 0; i < naddends(); i++) {
	Root *val = dep[i].value();
	if (val == NULL) {
	    if (unknowndep >= 0) return;
	    unknowndep = i;
	    continue;
	}
	if (sum) sum = Plus(sum, val);
	else sum = val;
	if (sum == NULL) RaiseDomainError(0);
    }
    if (unknowndep >= 0) {
	dep[unknowndep].unify(*DoMinus(val, sum));
    }
#endif
}

void
Product::recalculate(LDependency*)
{
    Root *prod;
    if (constant) prod = (Root*)constant;
    for (int i = 0; i < nfactors(); i++) {
	Root *val = dep[i].value();
	if (val == NULL) return;
	if (prod) prod = Times(prod, val);
	else prod = val;
	if (prod == NULL) RaiseDomainError(0);
    }
    unify(*prod);
}

void Product::notify()
{
#if 1
    abort();
#else
    Root *val = value();
    if (val == NULL) return;

    int unknowndep = -1;
    Root *prod;
    if (constant) prod = (Root*)constant;
    for (int i = 0; i < nfactors(); i++) {
	Root *val = dep[i].value();
	if (val == NULL) {
	    if (unknowndep >= 0) return;
	    unknowndep = i;
	    continue;
	}
	if (prod) prod = Times(prod, val);
	else prod = val;
	if (prod == NULL) RaiseDomainError(0);
    }
    if (unknowndep >= 0) {
	dep[unknowndep].unify(*DoDivide(val, prod));
    }
#endif
}

void UnknownTuple::printon(ostream& outs) const
{
    lmap->printon(outs);
    outs << '@';
}

void UndoBindings(UndoCommand *limit)
  {
    UndoCommand *curUndo, *next;
    CVariable *first, *prev = NULL;
    for (curUndo = UndoTrail; curUndo != limit; curUndo = next) {
	switch (curUndo->kind) {
	  case UndoLinkFlag:
	    next = curUndo->link.prev;
#ifdef HAVE_PAGE_ALLOC
	    FreePages((int)curUndo & ~ (PageSize-1), PageSize);
#else
	  {
	    char *buffer = UndoBuffer;
	    UndoBuffer = curUndo->link.buffer;
	    free(buffer);
	  }
#endif
	    break;
	  case UndoEqualFlag: {
	    CVariable *var = curUndo->equal.var;
	    CVariable *last = var->getRepresentative();
	    long v = last->ilink;
	    last->ilink = var->ilink | LastVarMask;
	    var->ilink = v;
	    next = (UndoCommand*)(&curUndo->equal + 1);
	    break;
	  }
	/* When a variable is instantiated, a UndoLastFlag command
	 * is pushed, followed by zero or more UndoSetFlag (one for
	 * each non-IsLastVar variable bound equal).
	 * When undoing, we go into opposite order, trying to re-create
	 * the list of linked variables.
	 * The first to undo is recognized by prev==NULL.
	 */
	  case UndoSetFlag: {
	    CVariable *var = curUndo->set.var;
	    if (prev == NULL) first = var;
	    var->ilink = (long)prev + UnknownVarMask;
	    prev = var;
	    next = (UndoCommand*)(&curUndo->set + 1);
	    break;
	  }
	  case UndoLastFlag: {
	    CVariable *var = curUndo->set.var;
	    if (prev == NULL) prev = var;
	    else first->ilink = (long)var + UnknownVarMask;
	    var->ilink = (long)prev + (UnknownVarMask+LastVarMask);
	    prev = NULL;
	    next = (UndoCommand*)(&curUndo->set + 1);
	    break;
	  }
	  case UndoSeekFlag: {
#if 1
abort();
#else
	    struct BFile *file = curUndo->seek.file;
	    file->handlerAtLastSeek = curUndo->seek.savedHandlerAtLastSeek;
	    file->flags &= ~FileUndoSeeks;
	    BFileSeek(file, curUndo->seek.savedIndex, 0);
	    file->flags |= FileUndoSeeks;
	    next = (UndoCommand*)(&curUndo->seek + 1);
#endif
	    break;
	  }
	  case UndoChangeFlag:
	    *(void**)curUndo->change.ptr = curUndo->change.old;
	    next = (UndoCommand*)(&curUndo->change + 1);
	    break;
	  case UndoChangesFlag:
	    memcpy(curUndo->changes.ptr, &curUndo->changes + 1,
		    curUndo->changes.length);
	    next = (UndoCommand*)((char*)&curUndo->changes
		+ sizeof(struct UndoChanges) + curUndo->changes.length);
	    break;
	  case UndoJoinFlag:
	  {
	    void *tmp;
	    tmp = *(void**)curUndo->join.ptr1;
	    *(void**)curUndo->join.ptr1 = *(void**)curUndo->join.ptr2;
	    *(void**)curUndo->join.ptr2 = tmp;
	    next = (UndoCommand*)(&curUndo->join + 1);
	    break;
	  }
	  default:
	    fprintf(stderr, "Illegal kind of UndoCommand: %d\n",
		curUndo->kind);
	    fflush(stderr);
	    abort();
	}
    };
    UndoTrail = curUndo;
  }

Concatenation::Concatenation()
{
    knownLength = 0; knownVars = 0;
}

void Concatenation::printon(ostream& outs) const
{
    outs << '[';
    for (int i = 0; i < nSegs; i++) {
	if (i) outs << ' ';
#if 1
	segments[i]->printon(outs);
#else
	Root *val = dep[i].value();
	if (val) {
	    GenSeq *seq = val->sequence();
	    if (seq) {
		seq->printBare(outs);
		continue;
	    }
	}
	dep[i].printon(outs);
#endif
	outs << '@';
    }
    outs << ']';
}

void Concatenation::recalculate(LDependency *triggerDep)
{
    Root *v = triggerDep->value();
    if (v == NULL) return;
    GenSeq *triggerSeq = v->sequence();
    if (triggerSeq == NULL) RaiseDomainError(NULL);
    SaveUndoChanges(&knownLength, 2*sizeof(int));
    knownLength += triggerSeq->length();
    knownVars++;
    if (knownVars < nVars()) return;

    // now finally do the concatenation
    Root **buf = (Root**)malloc(knownLength * sizeof(Root*));
    register Root **bptr = buf;
    for (int i = 0; i < nSegs; i++) {
	GenSeq *seq = segments[i]->sequence();
	if (seq == NULL) abort(); // cannot happen - I hope!
	ITERATOR(it, seq);
	for (;;) {
	    Root *el = it.next();
	    if (el == Missing) break;
	    *bptr++ = el;
	}
    }
    unify(* new OArray(knownLength, buf));
}

GenSeq * GetSegments(StackIterator& stream, int minLen, int maxLen)
{
#ifndef news
    Signal(new UnimplementedOp("GetSegments", NULL));
#else
    Root *pos = stream.key();
    int i = minLen;
fprintf(stderr, "GetSegments(, %d, %d)\n:", minLen, maxLen);
  repeat:
    if (i == maxLen) return stream.get(i);
    if (i > maxLen) RaiseDomainError(0);
    return
	OR_(GetSegs, Root*)
	    stream.get(i)
	ELSE_OR_(GetSegs) {
	    stream.seek(pos);
	    i++;
	    goto repeat;
	    (GenSeq*)NULL;
	}
	END_OR_;
#endif
}

void Concatenation::notify()
{
    if (knownVars == nVars()) return;
    // do patten matching
    Root *val = value();
    if (val == NULL) return;
cerr << *this << "->notify() val:" << val << '\n';
    GenSeq *seq = val->sequence();
    if (seq == NULL) RaiseDomainError(0);
    int seqLength = seq->length();
    if (seqLength < knownLength) RaiseDomainError(0);
    ITERATOR(iter, seq);
    notifyRest(iter, 0, seqLength);
    Missing->unify(*iter.next());
}

void Concatenation::notifyRest(StackIterator& iter, int i, int seqLength)
// Unify the remaining elements of file iter with the
// segments of this starting with segment number i.
{
    if (i < nSegs) {
	Root *seg = segments[i];
#if 0
cerr << "notifyRest(file:" << *iter.key();
cerr.form(", %d, %d) {seg:", i, seqLength);
cerr << *seg << "}\n";
cerr.flush();
#endif
	GenSeq *segSeq = seg->sequence();
	if (segSeq == NULL) {
	    GetSegments(iter, 0, seqLength - knownLength)->unify(*seg);
	}
	else {
	    ITERATOR(segFile, segSeq);
	    for (;;) {
		Root *segEl = segFile.next();
		if (segEl == Missing) break;
#if 0
		cerr << "- " << *segEl << "->unify(");
#endif
	    Root *v = iter.next();
#if 0
	    cerr << *v << ")\n";
#endif
		segEl->unify(*v);
	    }
	}
	notifyRest(iter, i+1, seqLength);
    }
}

int UseLVars = 0;
LVariable *AllocVariable(Symbol * name)
{
    if (UseLVars)
	if (name)
	    return new NamedPVariable(name);
	else
	    return new PVariable();
    else
	if (name)
	    return new NamedCVariable(name);
	else
	    return new CVariable();
}

union _Undo_ *
GetUndoCommand(int size)
{
    char *old_ptr = (char*)UndoTrail;
    char *new_ptr = old_ptr - size;
#ifdef HAVE_PAGE_ALLOC
    if (((int)new_ptr & (PageSize-1)) > ((int)old_ptr & (PageSize-1))) {
	/* warp-around */
	new_ptr = AllocPages(PageSize, PageSize)
	   + (PageSize - sizeof(struct UndoLink));
	((struct UndoLink*)new_ptr)->kind = UndoLinkFlag;
	((struct UndoLink*)new_ptr)->prev = (UndoCommand*)old_ptr;
        new_ptr -= size;
    }
#else
    if ((int)new_ptr < (int)UndoBuffer) { /* warp-around ! */
	char *new_buffer = (char*)malloc(UNDO_CHUNK_SIZE);
	new_ptr = new_buffer + UNDO_CHUNK_SIZE - sizeof(struct UndoLink);
	((struct UndoLink*)new_ptr)->kind = UndoLinkFlag;
	((struct UndoLink*)new_ptr)->prev = (UndoCommand*)old_ptr;
	((struct UndoLink*)new_ptr)->buffer = UndoBuffer;
	UndoBuffer = new_buffer;
        new_ptr -= size;
    }
#endif
    return UndoTrail = (UndoCommand*)new_ptr;
}

void SaveUndoChanges(void *addr, int size)
{
    struct UndoChanges *undo =
	(struct UndoChanges*)GetUndoCommand(sizeof(struct UndoChanges) + size);
    undo->kind = UndoChangesFlag;
    undo->ptr = addr;
    undo->length = size;
    bcopy(addr, undo+1, size);
}

void ClearUndoCommands()
{
    UndoCommand *link = UndoTrail;
    while (link != NULL) {
#ifdef HAVE_PAGE_ALLOC
	long page = (long)link & ~(PageSize-1);
	link =
	    ((struct UndoLink*)(page+PageSize-sizeof(struct UndoLink)))->prev;
	FreePages(page, PageSize);
#else
	char *page = UndoBuffer;
	struct UndoLink *cur_link =
	    (struct UndoLink*)(page+UNDO_CHUNK_SIZE-sizeof(struct UndoLink));
	link = cur_link->prev;
	UndoBuffer = cur_link->buffer;
	free(page);
#endif
    }
    UndoTrail = 0;	
}

void Tuple::xapply(void* dst, Type* dstType, ArgDesc& args)
{
  if (args.lCount + args.rCount == 0)
    dstType->coerceFromRoot(dst, (Root*)this);
  else
    {
      int left_size = args.lCount + size;
      Root * left_args[left_size];
      Root **left_ptr = left_args;
      int i;
      for (i = 0; i < args.lCount; i++) *left_ptr++ = args.lArgs[i];
      if (size <= MAX_TUPLE_INLINE)
	for (i = 0; i < size; i++)
	  *left_ptr++ = head[i];
      else
	{
	  GenSeq *seq = val->sequence();
	  if (seq == NULL) RaiseDomainError(NULL);
	  ITERATOR(iter, seq);
	  for (i = 0; i < size; i++)
	    *left_ptr++ = iter.next();
	}
      if (args.rCount == 0)
	dstType->coerceFromRoot(dst,
				new Tuple(NewVector(left_size, left_args)));
      else
	{
	  ArgDesc xargs(left_args, args.rArgs+1, args.nArgs, args.names,
		   left_size, args.rCount-1, args.nCount);
	  args.rArgs[0]->xapply(dst, dstType, xargs);
	}
    }
}

void Tuple::printon(ostream& outs) const
{
    if (size <= MAX_TUPLE_INLINE) {
	if (print_readable && size != 1) outs << "[";
	for (int i = 0; i < size; i++) {
	    if (i > 0) outs << ' ';
	    outs << *head[i];
	}
	if (print_readable && size != 1) outs << "]@";
	return;
    }
    val->printBare(outs);
}

Tuple::Tuple(GenSeq *v) : val(v)
{
    size = v->length();
    for (register int i = 0; i < MAX_TUPLE_INLINE; i++)
	head[i] = i < size ? v->index(i) : &NilSymbol;
}

Tuple EmptyTuple(0, (Root**)0);

Tuple::Tuple(size_t count, Root **vals)
: val(count > MAX_TUPLE_INLINE ? NewVector(count, vals) : NULL)
{
    size = count;
    for (register int i = 0; i < MAX_TUPLE_INLINE; i++)
	head[i] = i < count ? vals[i] : &NilSymbol;
}

Root *MakeTuple(Root *val)
{
#if 1
    GenSeq *seq = val->sequence();
    if (seq) return new Tuple(seq);
#else
    const GenMap *map = val->mapping();
    if (map) return new Tuple(map);
#endif
    LVariable *lvar = val->lvariable();
    if (lvar) return new UnknownTuple(lvar);
    RaiseDomainError(0);
    return NULL;
}
