// file:      polya.C
// version:   2.0
// author:    Robert M. Keller
// purpose:   header file for "Polya" library (dynamic polymorphism)
// compile:   g++ -c polya.C 
//            or to check reference counting:  g++ -c -g -DTRACEREF=1 polya.C 
// copyright: 1997 by Robert M. Keller
// Permission is hereby granted to use this code not-for-profit only.
// See http://www.cs.hmc.edu/~keller/Polya/ for documentation.
// $Id: polya.C,v 1.170 1997/08/02 00:54:49 keller Exp keller $

// REFSTAT is set to 1 if you want to see statistics on dynamic allocations
// TRACEREF is set to 1 if you want to see each allocation and deallocation
// when it occurs.  TRACEREF only has effect if REFSTAT is 1

// #define REFSTAT 1
// #define TRACEREF 1

#include "polya.H"
#include <stdlib.h>
#include <strstream.h>
#include <ctype.h>

hashtab table(1000);    // hashtable for interned atoms


long Polycell::outstanding()
  {
  return count;
  }

void Polycell::inc(Polycell* ptr)
  {
  if( ptr != 0 )
    ptr->rc++;
  }

void Polycell::dec(Polycell* ptr)
  {
  if( ptr != 0 )
    {
    if( --(ptr->rc) <= 0 )
      delete ptr;
    }
  }

Polycell::Polycell()
  {
  rc = 0;
  #if REFSTAT
    allocated++;
    count++;
    if( count > hi ) hi = count;
    #if TRACEREF
    cout << "allocating cell at " << this 
         << " (" << count << " outstanding)" << endl;
    #endif
  #endif
  }

Polycell::~Polycell()
  {
  #if REFSTAT
    count--;
    if( count < low ) low = count;
    #if TRACEREF
    cout << "deleting cell at " << this 
         << " (" << count << " outstanding)" << endl;
    #endif
  #endif
  }

void Polycell::report()
  {
  #if REFSTAT
    cout << "Polycell report: " << allocated << " allocated, "
         << count << " outstanding, "
         << low << " low, " << hi << " high" << endl;
  #endif
  }


//
// A listcell represents one cell of a Polylist.
// It contains a Poly First representing the first element of the list,
// and a Poly Rest.
// Rest normally contains a Polylist, representing the rest of the list,
// but it may instead contain a seed which needs to be "grown" to get the
// rest of an incremental list.  
// Any other type for Rest is considered an "improper" list.
//
// A listcell also contains a reference count rc 
// which is assumed to never overflow.
// 

class listcell : public Polycell
{
friend class Poly;
friend class Polylist;

Poly First;                             // first element in list
Poly Rest;                              // rest of list

listcell(const Poly &first, const Poly &rest);  // constructor
};  // class listcell


//
// An arraycell represents the contents of a Polyarray.
// It keeps track of the pointer to the first cell of the array,
// the size of the array, and the reference count.
//

class arraycell : public Polycell
{
friend class Poly;
friend class Polyarray;
Poly *array;                      // The actual array
long size;                        // length of the array

arraycell(long size);             // constructor
void resize(long size);           // resize method
~arraycell();                     // destructor
};


// Note: DEMANDED is reserved for the case of parallel processing

class seedcell : public Polycell
{
friend class Poly;
friend class Seed;

enum seedStatus {UNDEMANDED, DEMANDED, READY};  // possible status of a seed

public:
seedcell(gen fun, seedStatus status, Poly arg);
Poly & grow() const;

private:

mutable seedStatus status;      // status of this seed
mutable Poly result;            // value, if status == READY
gen fun;                        // function to create value
Poly arg;                       // argument of function
}; // seedcell


seedcell::seedcell(gen fun, seedStatus status, Poly arg)
  {
  this->status = status;
  this->fun = fun;
  this->arg = arg;
  }

Poly & seedcell::grow() const
  {
  switch( status )
    {
    case READY:
      break;

    case UNDEMANDED:
      result = fun(arg);
      status = READY;
      break;

    case DEMANDED:      // no op in sequential case
      break;
    }
  return result;
  }


Seed::Seed(gen fun, Poly arg)
  {
  sptr = new seedcell(fun, seedcell::UNDEMANDED, arg);
  Polycell::inc(sptr);
  }

Seed::Seed(const Seed & original)         // copy constructor
  : sptr(original.sptr)
  {
  Polycell::inc(sptr);
  }

Seed::Seed(seedcell* Sptr)              // construct from pointer
  : sptr(Sptr)
  {
  Polycell::inc(sptr);
  }

Seed::Seed()                            // default constructor
  : sptr(0)
  { }

Poly & Seed::grow() const
  {
  return sptr->grow();
  }

int Seed::ready()
  {
  return sptr->status == seedcell::READY;
  }

int Seed::operator==(const Seed & q) const
  {
  return sptr == q.sptr;
  }

int Seed::operator<(const Seed & q) const
  {
  return sptr < q.sptr;
  }

Seed::~Seed()                   // destroy seed
  {
  Polycell::dec(sptr);  // actual deletion only if no more references to cell
  }

Seed & Seed::operator=(const Seed & source)             // assignment
  {
  if( this == &source )
    return *this;
  Polycell::inc(source.sptr);           // new pointer to source cell
  Polycell::dec(sptr);                  // over-writing old sptr
  sptr = source.sptr;
  return *this;
  }


class fclosurecell : public Polycell
{
friend class Poly;
friend class Fclosure;

public:
fclosurecell(Function2 fun, Poly env);
Poly operator()(Poly arg) const;
operator char*() const;

private:

Function2 fun;                  // Function to be applied
Poly env;                       // environment for function
}; // fclosurecell


fclosurecell::fclosurecell(Function2 fun, Poly env)
  {
  this->fun = fun;
  this->env = env;
  }

Poly fclosurecell::operator()(Poly arg) const    // apply operator
  {
  return fun(env, arg);
  }

fclosurecell::operator char*() const
  {
  strstream buff;
  buff << "Fclosure, code " << (int)fun << ends;
  return buff.str();
  }

Fclosure::Fclosure(Function2 fun, Poly env)       // construct from fun and env
  {
  cptr = new fclosurecell(fun, env);
  Polycell::inc(cptr);
  }

Fclosure::Fclosure(const Fclosure & original)      // copy constructor
  : cptr(original.cptr)
  {
  Polycell::inc(cptr);
  }

Fclosure::Fclosure(fclosurecell *Cptr)             // construct from pointer
  : cptr(Cptr)
  {
  Polycell::inc(Cptr);
  }

Fclosure::Fclosure()                      // default constructor
  : cptr(0)
  { }

Poly Fclosure::operator()(Poly arg) const
  {
  return cptr->operator()(arg);
  }

int Fclosure::operator==(const Fclosure & q) const
  {
  return cptr == q.cptr;
  }

int Fclosure::operator<(const Fclosure & q) const
  {
  return cptr < q.cptr;
  }

Fclosure::operator char*() const
  {
  return (char*)(*cptr);
  }

Fclosure::~Fclosure()                     // destroy Fclosure
  {
  Polycell::dec(cptr); // actual deletion only if no more references to cell
  }

Fclosure & Fclosure::operator=(const Fclosure & source)            // assignment
  {
  if( this == &source )
    return *this;
  Polycell::inc(source.cptr);           // new pointer to source Polycell
  Polycell::dec(cptr);                  // over-writing old cptr
  cptr = source.cptr;
  return *this;
  }


class sclosurecell : public Polycell
{
friend class Poly;
friend class Sclosure;

public:
sclosurecell(Poly Vars, Poly Body, Poly env, Eval eval, NewEnv newEnv);
Poly operator()(Poly arg) const;
operator char*() const;
~sclosurecell();

private:

Poly Vars;		        // Formal argument or arguments
Poly Body;                      // Body expression
Poly env;                       // Environment for function
Eval eval;			// Evaluator function
NewEnv newEnv;			// New-environment function
}; // sclosurecell


sclosurecell::
  sclosurecell(Poly Vars, Poly Body, Poly env, Eval eval, NewEnv newEnv)
  {
  this->Vars = Vars;
  this->Body = Body;
  this->env  = env;
  this->eval = eval;
  this->newEnv = newEnv;
  }

Poly sclosurecell::operator()(Poly args) const    // apply operator
  {
  return eval(Body, newEnv(Vars, args, env));	
  }

sclosurecell::operator char*() const
  {
  strstream buff;
  buff << "Sclosure: " << Vars << " => " << Body << ends;
  return buff.str();
  }

sclosurecell::~sclosurecell()
  {
  }


Sclosure::Sclosure(Poly Vars, Poly Body, Poly env, Eval eval, NewEnv newEnv)
  {
  kptr = new sclosurecell(Vars, Body, env, eval, newEnv);
  Polycell::inc(kptr);
  }

Sclosure::Sclosure(const Sclosure & original)      // copy constructor
  : kptr(original.kptr)
  {
  Polycell::inc(kptr);
  }

Sclosure::Sclosure(sclosurecell *Kptr)             // construct from pointer
  : kptr(Kptr)
  {
  Polycell::inc(kptr);
  }

Sclosure::Sclosure()                      // default constructor
  : kptr(0)
  { }

Poly Sclosure::operator()(Poly arg) const
  {
  return kptr->operator()(arg);
  }

int Sclosure::operator==(const Sclosure & q) const
  {
  return kptr == q.kptr;
  }

int Sclosure::operator<(const Sclosure & q) const
  {
  return kptr < q.kptr;
  }

Sclosure::operator char*() const
  {
  return (char*)(*kptr);
  }

Sclosure::~Sclosure()                     // destroy Sclosure
  {
  Polycell::dec(kptr); // actual deletion only if no more references to cell
  }

Sclosure & Sclosure::operator=(const Sclosure & source)  // assignment
  {
  if( this == &source )
    return *this;
  Polycell::inc(source.kptr);           // new pointer to source Polycell
  Polycell::dec(kptr);                  // over-writing old cptr
  kptr = source.kptr;
  return *this;
  }



class oclosurecell : public Polycell
{
friend class Poly;
friend class Oclosure;
private:
Applicable *aptr;			// pointer to applicable object

public:
oclosurecell();
oclosurecell(Applicable *aptr);
Poly operator()(Poly arg) const;
operator char*() const;
~oclosurecell();
}; // oclosurecell


oclosurecell::oclosurecell(Applicable *aptr)
  {
  this->aptr = aptr;
  }

oclosurecell::operator char*() const
  {
  strstream buff;
  buff << "Oclosure " << ends;
  return buff.str();
  }

Poly oclosurecell::operator()(Poly arg) const
  {
  return (*aptr)(arg);
  }

oclosurecell::~oclosurecell()
  {
  delete aptr;
  }

// Oclosure methods and constructor

Oclosure::Oclosure(const Oclosure & original)     // copy constructor
  : optr(original.optr)
  {
  Polycell::inc(optr);
  }

Oclosure::Oclosure(Applicable *aptr)              // construct from applicable
  {
  optr = new oclosurecell(aptr);
  Polycell::inc(optr);
  }

Oclosure::Oclosure(oclosurecell *op)
  : optr(op)
  { 
  Polycell::inc(optr);
  }

Oclosure::Oclosure()                      	  // default constructor
  : optr(0)
  { }

Poly Oclosure::operator()(Poly arg) const
  {
  return optr->operator()(arg);
  }

int Oclosure::operator==(const Oclosure & q) const
  {
  return optr == q.optr;
  }

int Oclosure::operator<(const Oclosure & q) const
  {
  return optr < q.optr;
  }

Oclosure::operator char*() const
  {
  return (char*)(*optr);
  }

Oclosure::~Oclosure()                     // destroy Oclosure
  {
  Polycell::dec(optr); // actual deletion only if no more references to cell
  }

Oclosure & Oclosure::operator=(const Oclosure & source)  // assignment
  {
  if( this == &source )
    return *this;
  Polycell::inc(source.optr);           // new pointer to source Polycell
  Polycell::dec(optr);                  // over-writing old cptr
  optr = source.optr;
  return *this;
  }


// Poly methods and constructors

//
// type() returns the type of a Poly as an element of the enum 'Polytype'
// If the Poly is a Seed, it is grown first.

Polytype Poly::type() const
  {
  grow();
  return Type;
  }


//
// trueType() returns the type of a Poly 
// without growing it in the case of a seed
//

Polytype Poly::trueType() const
  {
  return Type;
  }


//
// typenam() returns the name of the type of a Poly as a string
//

char* Poly::typenam() const
  {
  switch( Type )
    {
    case INTEGER:       return "integer";
    case FLOATING:      return "floating";
    case CHAR:          return "char";
    case LIST:          return "list";
    case ARRAY:         return "array";
    case STRING:        return "string";
    case FUNCTION1:     return "Function1";
    case FUNCTION2:     return "Function2";
    case SEED:          return "Seed";
    case FCLOSURE:      return "Fclosure";
    case OCLOSURE:      return "Oclosure";
    case ISTREAM:       return "istream";
    case ERROR:         return "error";
    }
  return "unknown";
  }


//
// The destructor destroys a Poly.  If the Poly references the first cell of
// a list or an array, then the latter is not destroyed unless its reference
// count goes to 0.
//

Poly::~Poly()                   // destructor
  {
  dec();
  }


//
// copy constructor for a Poly.
// The argument Poly is only shallow copied.  If the Poly references a list
// or array, then only the pointer is copied, not the entire list or array.
// If deep copying is desired, use the method deepCopy() instead.
//

Poly::Poly(const Poly & x)      // copy constructor
  {
  Type = x.Type;
  u = x.u;
  inc();                        // possible new pointer
  }

//
// default constructor for a Poly.
// The default value is the null list.
//

Poly::Poly()
  {
  Type = LIST;
  u.lptr = 0;
  }

// other Poly constructors

Poly::Poly(integer x)           // construct from integer
  {
  Type = INTEGER;
  u.integerValue = x;
  }

Poly::Poly(floating x)          // construct from floating
  {  
  Type = FLOATING;
  u.floatingValue = x;
  }

Poly::Poly(char* x)             // construct from string
  {
  Type = STRING;
  table.ensure(x, u.stringValue);       // ensure string is in hashtable
  }

Poly::Poly(char x)              // construct from char
  {
  Type = CHAR;
  u.charValue = x;
  }

Poly::Poly(const Polylist &x)   // construct from list
  {
  Type = LIST;
  u.lptr = x.lptr;
  Polycell::inc(x.lptr);        // new Poly pointing to cell
  }

Poly::Poly(const Polyarray &x)  // construct from array
  {
  Type = ARRAY;
  u.aptr = x.aptr;
  Polycell::inc(x.aptr);        // new Poly pointing to array
  }

Poly::Poly(const Seed & s)      // construct from seed
  {
  Type = SEED;
  u.sptr = s.sptr;
  Polycell::inc(s.sptr);
  }

Poly::Poly(const Fclosure & c)   // construct from Fclosure
  {
  Type = FCLOSURE;
  u.cptr = c.cptr;
  Polycell::inc(c.cptr);
  }

Poly::Poly(const Sclosure & c)   // construct from symbolic closure
  {
  Type = SCLOSURE;
  u.kptr = c.kptr;
  Polycell::inc(c.kptr);
  }

Poly::Poly(const Oclosure & c)   // construct from symbolic closure
  {
  Type = OCLOSURE;
  u.optr = c.optr;
  Polycell::inc(c.optr);
  }

Poly::Poly(Function1 f)          // construct from function
  {
  Type = FUNCTION1;
  u.fptr = f;
  }

Poly::Poly(Function2 f)         // construct from function of 2 args
  {
  Type = FUNCTION2;
  u.gptr = f;
  }

Poly::Poly(istream & i)         // construct from input stream
  {
  Type = ISTREAM;
  u.iptr = &i;
  }

Poly::Poly(const error & e)     // construct from input stream
  {
  Type = ERROR;
  u.eptr = e.msg;
  }

const Poly & Poly::grow() const // grow if a seed
  {
  while( Type == SEED )
    {
    seedcell *hold = u.sptr;    // hold on to pointer to seedcell
    Poly & r = hold->grow();    // grow the seedcell
    Type = r.Type;              // copy the resulting type
    u = r.u;                    // copy the value
    inc();                      // inc. ref count if necessary
    Polycell::dec(hold);        // losing pointer to seedcell
    }
  return *this;
  }

int Poly::ready() const         // tell if ready
  {
  if( Type == SEED )
    return u.sptr->status == seedcell::READY;
  return 1;
  }

Poly Poly::force() const
  {
  switch( type() )
    {
    case LIST:  Polylist(*this).force();
    case ARRAY: (this->operator Polyarray()).force();
    }
  return *this;
  }

//
// operator() applies Poly as if function
//

Poly Poly::operator()(Poly arg) const
  {
  switch( type() )
    {
    case INTEGER:       return error("can't apply integer");
    case FLOATING:      return error("can't apply floating");
    case CHAR:          return error("can't apply char");
    case LIST:          return Polylist(*this)(integer(arg));
    case ARRAY:         return (this->operator Polyarray())(integer(arg));
    case STRING:        return ((char*)(*this))[int(integer(arg))];
    case FUNCTION1:     return Function1(*this)(arg);
    case FUNCTION2:     return error("can't apply Function2 to one argument");
    case SEED:          return Poly(0);// grow()(arg);     // should not occur
    case FCLOSURE:      return Fclosure(*this)(arg);
    case SCLOSURE:      return Sclosure(*this)(arg);
    case OCLOSURE:      return Oclosure(*this)(arg);
    case ISTREAM:       return error("can't apply istream");
    case ERROR:         return error("can't apply error");
    }
  return nil;  
  }

#if !FLOAT
Poly::Poly(double x)
  {  
  Type = FLOATING;
  u.floatingValue = floating(x);
  }
#endif

#if INT
Poly::Poly(long x)
  {  
  Type = INTEGER;
  u.integerValue = integer(x);
  }
#endif

Poly::Poly(int x)
  {  
  Type = INTEGER;
  u.integerValue = integer(x);
  }


// handle reference counts of things pointed to by embedded pointers

inline void Poly::inc() const
  {
  switch( Type )
    {
    case LIST:    
        Polycell::inc(u.lptr);
        break;

    case ARRAY:
        Polycell::inc(u.aptr);
        break;

    case SEED:
        Polycell::inc(u.sptr);
        break;

    case FCLOSURE:
        Polycell::inc(u.cptr);
        break;

    case SCLOSURE:
        Polycell::inc(u.kptr);
        break;

    case OCLOSURE:
        Polycell::inc(u.optr);
        break;
    }
  }

inline void Poly::dec() const
  {
  switch( Type )
    {
    case LIST:    
        Polycell::dec(u.lptr);
        break;

    case ARRAY:
        Polycell::dec(u.aptr);
        break;

    case SEED:
        Polycell::dec(u.sptr);
        break;

    case FCLOSURE:
        Polycell::dec(u.cptr);
        break;

    case SCLOSURE:
        Polycell::dec(u.kptr);
        break;

    case OCLOSURE:
        Polycell::dec(u.optr);
        break;
    }
  }


//
// assignment operator for Poly
// must handle reference counting properly; a new pointer can be introduced
// and an old one can be destroyed.

Poly & Poly::operator=(const Poly & source)
  {
  source.inc();         // possible new reference to source
  dec();                // possible removal of reference to target
  Type = source.Type;
  u = source.u;
  return *this;
  }


// equality and inequality test for Polys

int Poly::operator==(const Poly & q) const
  {
  Polytype T = type();
  if( T != q.type() )
    return 0;

  switch( T )
    {
    case INTEGER:   return integer(*this)   == integer(q);
    case FLOATING:  return floating(*this)  == floating(q);
    case CHAR:      return char(*this)      == char(q);
    case LIST:      return Polylist(*this)  == Polylist(q);
    case ARRAY:     return (this->operator Polyarray()) 
                           == (q.operator Polyarray());
                   // NOTE: assumes interned strings
    case STRING:    return (char*)(*this)   == (char*)q;
    case FUNCTION1: return Function1(*this) == Function1(q);
    case FUNCTION2: return Function2(*this) == Function2(q);
    case SEED:      return Seed(*this)      == Seed(q);
    case FCLOSURE:  return Fclosure(*this)   == Fclosure(q);
    case SCLOSURE:  return Sclosure(*this)  == Sclosure(q);
    case OCLOSURE:  return Oclosure(*this)  == Oclosure(q);
    case ISTREAM:   return this == &q;
    case ERROR:     return 0;  // NOTE: no two errors are considered equal
    }
  return 0;
  }

int Poly::operator!=(const Poly & q) const
  {
  int result = !(operator==(q));
  return result;
  }


/*
  switch( type() )
    {
    case INTEGER:
    case FLOATING:
    case CHAR:
    case LIST:
    case ARRAY:
    case STRING:
    case FUNCTION1:
    case FUNCTION2:
    case SEED:
    case FCLOSURE:
    case SCLOSURE:
    case OCLOSURE:
    case ISTREAM:
    case ERROR:
    }
*/


int Poly::operator<(const Poly & q) const
  {
  switch( type() )
    {
    case INTEGER:       
      switch( q.type() )
        {
        case INTEGER:   return integer(*this) < integer(q);
        case FLOATING:  return integer(*this) < floating(q);
        case CHAR:      return integer(*this) < int(char(q));
        default:        return 1;
        }
    case FLOATING:
      switch( q.type() )
        {
        case INTEGER:   return floating(*this) < integer(q);
        case FLOATING:  return floating(*this) < floating(q);
        case CHAR:      return floating(*this) < int(char(q));
        default:        return 1;
        }
    case CHAR:
      switch( q.type() )
        {
        case INTEGER:   return int(char(*this)) < integer(q);
        case FLOATING:  return int(char(*this)) < floating(q);
        case CHAR:      return char(*this) < char(q);
        default:        return 1;
        }
      }
    
  if( type() == q.type() )
    // types are same
    switch( type() )
      {
      case LIST:        return Polylist(*this) < Polylist(q);
      case ARRAY:       return (this->operator Polyarray()) 
                               < (q.operator Polyarray());
      case STRING:      return strcmp((char*)(*this), (char*)q) < 0;
      case FUNCTION1:   return Function1(*this) < Function1(q);
      case FUNCTION2:   return Function2(*this) < Function2(q);
      case SEED:        return (this->operator Seed()) 
                               < (q.operator Seed()); // should not occur
      case FCLOSURE:    return (this->operator Fclosure())
                               < (q.operator Fclosure());
      case SCLOSURE:    return (this->operator Sclosure())
                               < (q.operator Sclosure());
      case OCLOSURE:    return (this->operator Oclosure()) 
                               < (q.operator Oclosure());
      case ISTREAM:     return this < &q;
      case ERROR:       return this < &q;
      }
  // unequal types are compared by numeric order to give a total order
  return type() < q.type();
  }


int Poly::operator>(const Poly & q) const
  {
  return q.operator<(*this);
  }

int Poly::operator<=(const Poly & q) const
  {
  return !operator>(q);
  }

int Poly::operator>=(const Poly & q) const
  {
  return !operator<(q);
  }

Poly::operator integer() const          // convert Poly to integer
  {
  switch( type() )
    {
    case INTEGER:  return u.integerValue;
    case FLOATING: return (integer)u.floatingValue;
    } 
  conversionError("integer");
  return integerDefault();
  }

Poly::operator int() const           // convert Poly to int
  {
  switch( type() )
    {
    case INTEGER:  return u.integerValue;
    case FLOATING: return (int)u.floatingValue;
    } 
  conversionError("int");
  return int();
  }

Poly::operator bool() const          // convert Poly to boolean
  {
  switch( type() )
    {
    case INTEGER: return integer() != 0;
    default:      return true;
    }
  }

#if INT == 1
inline floating make_floating(Integer i)
  {
  return i.as_double();
  }
#endif

inline floating make_floating(integer i)
  {
  return floating(i);
  }

Poly::operator floating() const         // convert Poly to floating
  {
  switch( type() )
    {
    case FLOATING:      return u.floatingValue;
    case INTEGER:       return floating(u.integerValue);
    }
  conversionError("floating");
  return floatingDefault();
  }


Poly::operator Polylist() const         // convert Poly to Polylist
  {
  switch( type() )
    {
    case LIST:  return Polylist(u.lptr);
    case ARRAY: return Polylist(this->operator Polyarray());
    }
  conversionError("list");
  return listDefault();
  }


Poly::operator Polyarray() const                // convert Poly to Polylist
  {
  switch( type() )
    {
    case LIST:  return Polyarray(Polylist(*this));
    case ARRAY: return Polyarray(u.aptr);
    }
  conversionError("array");
  return arrayDefault();
  }


// default values are returned in case of an impossible conversion

integer Poly::integerDefault() const
  {
  return 0;
  }

int Poly::intDefault() const
  {
  return 0;
  }

floating Poly::floatingDefault() const
  {
  return 0.0;
  }

char Poly::charDefault() const
  {
  return ' ';
  }

Polylist& Poly::listDefault() const
  {
  return nil;
  }

Polyarray Poly::arrayDefault() const
  {
  return array();
  }

Seed Poly::SeedDefault() const
  {
  return nullSeed;
  }

Fclosure Poly::FclosureDefault() const
  {
  return nullFclosure;
  }

Sclosure Poly::SclosureDefault() const
  {
  return nullSclosure;
  }

Oclosure Poly::OclosureDefault() const
  {
  return nullOclosure;
  }

Poly defaultFUNCTION1(Poly x)
  {
  return nil;
  }

Poly defaultFUNCTION2(Poly x, Poly y)
  {
  return nil;
  }

Function1 Poly::Function1Default() const
  {
  return defaultFUNCTION1;
  }

Function2 Poly::Function2Default() const
  {
  return defaultFUNCTION2;
  }

istream & Poly::istreamDefault() const
  {
  return cin;
  }

error Poly::errorDefault() const
  {
  return error("default error");
  }

void Poly::conversionError(char* type) const
  {
  cerr << "error converting from " << typenam() << " to " << type << endl;
  exit(1);
  }


//
// explode makes a list of characters from a Poly, such as a string
//

Polylist Poly::explode() const
  {
  char* temp = *this;
  long len = strlen(temp);
  Polylist result = nil;
  for( long i = len-1; i >= 0; i-- )
    result = cons(Poly(temp[i]), result);
  return result;
  }


// report on storage usage

void Poly::report()
  {
  Polycell::report();
  }


//
// implode makes a string from a Polylist, such as a list of characters
//

char* Polylist::implode()
  {
  strstream buff;
  Polylist source = *this;
  while( !source.isEmpty() )
    {
    Poly First = source.first();
    switch( First.type() )
      {
      case ARRAY:
      case LIST:  buff << Polylist(First).implode(); break;
      default:          buff << (char*)source.first();
      }
    source = source.rest();
    }
  buff << ends;
  return buff.str();
  }

char* error::errorPrefix = "*** error: ";

long Polycell::allocated = 0;
long Polycell::count = 0;
long Polycell::hi = 0;
long Polycell::low = 0;


// listcell methods

listcell::listcell(const Poly &first, const Poly &rest) // constructor
  {
  First = first;
  Rest = rest;
  }

Polylist::Polylist()    // default constructor (creates null list)
  {
  lptr = 0;
  }

Polylist::Polylist(const Polylist & original)     // copy constructor
  : lptr(original.lptr)
  {
  Polycell::inc(lptr);
  }

Polylist::Polylist(listcell* Lptr)      // construct list from first cell
  : lptr(Lptr)
  {
  Polycell::inc(lptr);
  }

Polylist::~Polylist()                   // destroy list
  {
  Polycell::dec(lptr);  // actual deletion only if no more references to cell
  }

Polylist & Polylist::operator=(const Polylist & source)         // assignment
  {
  if( this == &source )
    return *this;
  Polycell::inc(source.lptr);           // new pointer to source cell
  Polycell::dec(lptr);                  // over-writing old lptr
  lptr = source.lptr;
  return *this;
  }

// list construction and decomposition functions

Polylist Polylist::cons(const Poly & First, const Poly & Rest)
  {
  return Polylist(new listcell(First, Rest));
  } 

Poly & Polylist::first() const
  {
  return lptr->First;
  }

Polylist Polylist::rest() const
  {
  return rawRest().grow();
  }

Poly & Polylist::rawRest() const
  {
  return lptr->Rest;
  }

// test Polylist for being empty

int Polylist::isEmpty() const
  {
  return lptr == 0;
  }

int Polylist::nonEmpty() const
  {
  return lptr != 0;
  }


// get length of Polylist

long Polylist::length() const
  {
  listcell *lptr = this->lptr;
  long result = 0;
  while( lptr != 0 )
    {
    lptr = Polylist(lptr->Rest).lptr;
    result++;
    }
  return result;
  }


// convert Poly to string (e.g. for output)

Poly::operator char*() const
  {
  if( type() == STRING )
    {
    return u.stringValue;
    }
  else
    {
    ostrstream buff;
    switch( type() )
      {
      case INTEGER:   buff << integer(*this);                      break;
      case FLOATING:  buff << floating(*this);                     break;
      case CHAR:      buff << char(*this);                         break;
      case LIST:      buff << Polylist(*this);                     break;
      case ARRAY:     buff << (this->operator Polyarray());                    break;
      case STRING:    buff << (char*)(*this);                      break;
      case FUNCTION1: buff << "Function1 at " << int(u.fptr);	   break;
      case FUNCTION2: buff << "Function2 at " << u.gptr;	   break;
      case SEED:      buff << Seed(*this);                         break;
      case FCLOSURE:  buff << Fclosure(*this);                     break;
      case SCLOSURE:  buff << Sclosure(*this);                     break;
      case OCLOSURE:  buff << Oclosure(*this);                     break;
      case ISTREAM:   buff << "istream at " << this;               break;
      case ERROR:     buff << error(*this);                        break;
      default:        buff << "unknown";                           break;    
      }
    buff << ends;
    return buff.str();  // This string must be deleted by user to reclaim.
    }
  }


Polylist Polylist::sort() const
  {
  Polyarray A = *this;
  A.sort();
  return A;
  }


// convert Poly to char

Poly::operator char() const
  {
  if( type() != CHAR )
    {
    conversionError("char");
    return charDefault();
    }
  return u.charValue;
  }


Poly::operator Seed() const
  {
  if( Type != SEED )
    {
    conversionError("Seed");
    return SeedDefault();
    }
  return Seed(u.sptr);
  }

Poly::operator Fclosure() const
  {
  if( type() != FCLOSURE )
    {
    conversionError("Fclosure");
    return FclosureDefault();
    }
  return Fclosure(u.cptr);
  }

Poly::operator Sclosure() const
  {
  if( type() != SCLOSURE )
    {
    conversionError("Sclosure");
    return SclosureDefault();
    }
  return Sclosure(u.kptr);
  }

Poly::operator Oclosure() const
  {
  if( type() != OCLOSURE )
    {
    conversionError("Oclosure");
    return OclosureDefault();
    }
  return Oclosure(u.optr);
  }

Poly::operator Function1() const
  {
  if( type() != FUNCTION1 )
    {
    conversionError("Function1");
    return Function1Default();
    }
  return Function1(u.fptr);
  }

Poly::operator Function2() const
  {
  if( type() != FUNCTION2 )
    {
    conversionError("Function2");
    return Function2Default();
    }
  return Function2(u.gptr);
  }

Poly::operator istream&() const
  {
  if( type() != ISTREAM )
    {
    conversionError("istream");
    return istreamDefault();
    }
  return *(u.iptr);
  }

Poly::operator error() const
  {
  if( type() != ERROR )
    {
    conversionError("error");
    return errorDefault();
    }
  return error(u.eptr);
  }


int Poly::isList()          { return type() == LIST; }
int Poly::nonList()         { return type() != LIST; }
int Poly::isArray()         { return type() == ARRAY; }
int Poly::isString()        { return type() == STRING; }
int Poly::isChar()          { return type() == CHAR; }
int Poly::isFloating()      { return type() == FLOATING; }
int Poly::isInteger()       { return type() == INTEGER; }

int Poly::isNumeric()
  {
  switch( type() )
    {
    case INTEGER:  return 1;
    case FLOATING: return 1;
    default:       return 0;
    }
  }

int Poly::isAggregate()          
  {
  switch( type() )
    {
    case LIST:    return 1;
    case ARRAY:   return 1;
    default:      return 0;
    }
  }

int Poly::atomic()          
  {
  switch( type() )
    {
    case LIST:    return 0;
    case ARRAY:   return 0;
    default:      return 1;
    }
  }

// convert list to string (e.g. for output)
// The string must be reclaimed by the user.

Polylist::operator char*() const
  {
  ostrstream buff;
  Polylist L = *this;
  buff << "(";
  if( L.nonEmpty() )
    {
    buff << (char*)(L.first());
    L = L.rest();
    }

  while( L.nonEmpty() )
    {
    buff << " " << (char*)(L.first());
    L = L.rest();
    }
  buff << ")" << ends;
  return buff.str();
  }

// make an arraycell of a specified size

arraycell::arraycell(long size)
  {
  array = new Poly[size];
  this->size = size;
  }


// resize the array in an arraycell

void arraycell::resize(long size)
  {
  Poly *old_array = array;
  array = new Poly[size];
  long copy_size = this->size < size ? this->size : size;
  for( long i = 0; i < copy_size; i++ )
      array[i] = old_array[i];
  this->size = size;
  delete [] old_array;
  }


// make an arraycell of a specified size

arraycell::~arraycell()
  {
  delete [] array;
  }


// Output of Polys, etc.

// startEscape tells which characters to escape if they appear at the
// start of a string.  

int Poly::startEscape(char c)
  {
  switch( c )
    {
    case '(':
    case ')':
    case '[':
    case ']':
    case '{':
    case '}':
    case '+':
    case '-':
    case ' ':
    case '0': case '1': case '2': case '3': case '4':
    case '5': case '6': case '7': case '8': case '9':
      return true;

    default:
      return false;
    }
  }

// insideEscape tells which characters to escape if they appear inside a string

int Poly::insideEscape(char c)
  {
  switch( c )
    {
    case '(':
    case ')':
    case '[':
    case ']':
    case '{':
    case '}':
    case ' ':
      return true;

    default:
      return false;
    }
  }

// print string with escape characters embedded

ostream & printString(ostream & out, char* s)
  {
  ostrstream buff;
  if( *s )
    {
    if( Poly::startEscape(*s) )
      buff << ioEscape;
    buff << *s;
    s++;
    }
  while( *s )
    {
    if( Poly::insideEscape(*s) )
      buff << ioEscape;
    buff << *s;
    s++;
    }
  buff << ends;
  char* str = buff.str();
  out << str;
  delete [] str;    
  return out;
  }


// print Poly with no escape characters embedded

ostream & Poly::print(ostream & out)
  {
  char* s = *this;
  ostrstream buff;
  if( *s )
    {
    buff << *s;
    s++;
    }
  while( *s )
    {
    buff << *s;
    s++;
    }
  buff << ends;
  char* str = buff.str();
  out << str;
  delete [] str;    
  return out;
  }


ostream & operator<<(ostream & out, const Poly &p)
  {
  switch( p.trueType() )
    {
    case INTEGER:   return out << (integer)p;
    case FLOATING:  return out << (floating)p;
    case CHAR:      return out << (char)p;
    case LIST:      return out << (Polylist)p;
    case ARRAY:     return out << (p.operator Polyarray());
    case STRING:    return printString(out, (char*)p); // for escapes
    case FUNCTION1: return out << (Function1)p;
    case FUNCTION2: return out << (Function2)p;
    case SEED:      return out << (Seed)p;
    case FCLOSURE:  return out << (Fclosure)p;
    case SCLOSURE:  return out << (Sclosure)p;
    case OCLOSURE:  return out << (Oclosure)p;
    case ISTREAM:   return out << "istream at " << &p;
    case ERROR:     return out << (error)p;
    default:              return out << "unknown";
    }
  }


ostream & operator<<(ostream & out, Polylist L)
  {
  out << "(";
  if( L.nonEmpty() )
    {
    out << L.first();
    L = L.rest();
    }

  while( L.nonEmpty() )
    {
    out << " " << L.first();
    Poly r = L.rawRest();
    if( !r.ready())     // check for infinite list
      {
      out << " ... ";
      break;
      }
    L = L.rest();
    }

  return out << ")";  
  }

ostream & operator<<(ostream & out, Polyarray A)
  {
  out << "[";
  if( A.length() > 0 )
    {
    out << A[0];
    }
  for( long i = 1; i < A.length(); i++ )
    {
    out << " " << A[i];
    }
  return out << "]";  
  }


ostream & operator<<(ostream & out, Seed S)
  {
  return out << " ... ";
  }

ostream & operator<<(ostream & out, Fclosure C)
  {
  return out << (char*)C;
  }

ostream & operator<<(ostream & out, Sclosure S)
  {
  return out << (char*)S;
  }

ostream & operator<<(ostream & out, Oclosure S)
  {
  return out << (char*)S;
  }

ostream & operator<<(ostream & out, error E)
  {
  return out << error::errorPrefix << (char*)E;
  }


// input of Polys

// getNumeral is used when numeral is detected; c and d are first 2 chars

istream & getNumeral(istream & in, char c, Poly &P)
  {
  strstream s;

  s << c;

  while( in.get(c) && isdigit(c) )
    {
    s << c;
    }

  // see if it's not floating
  if( in && c != '.' && c != 'e' )
    {
    in.putback(c);
    s << ends;
    integer i;
    s >> i;
    P = i;
    return in;
    }

  if( in && c == '.' )
    {
    s << c;
    in.get(c);
    while( in && isdigit(c) )
      {
      s << c;
      in.get(c);
      }
    }

  if( in && c == 'e' || c == 'E' )
    {
    s << c;
    in.get(c);
    if( c == '+' )
      in.get(c);
    else if( c == '-' )
      {
      s << c;
      in.get(c);
      }
    while( in && isdigit(c) )
      {
      s << c;
      in.get(c);
      }
    }
  if( in ) in.putback(c);
  s << ends;
  floating f;
  s >> f;
  P = f;
  return in;
  }


int isdelim(char c)
  {
  switch( c )
    {
    case '(':
    case ')':
    case '[':
    case ']':
      return 1;

    default:
      return 0;
    }
  }

istream& operator>>(istream& in, Poly& P)
  {
  strstream s;
  in >> ws;
  char c, d;
  if( !in.get(c) )                      // first char of S expression
    return in;

  switch( c )
    {
    case '(':
      {
      in.putback(c);
      Polylist L;
      in >> L;                            // input a list
      P = L;
      return in;
      }

    case '[':
      {
      in.putback(c);
      Polyarray A;
      in >> A;                            // input an array
      P = A;
      return in;
      }

    case '0': case '1': case '2': case '3': case '4':	  // input numerals
    case '5': case '6': case '7': case '8': case '9':
      return getNumeral(in, c, P);

    case '+':
    case '-':
      if( in.get(d) && isdigit(d) )
        {
        in.putback(d);
        return getNumeral(in, c, P);	// + or - followed by digit
        }

      if( in ) in.putback(d);		// falling through

    default:    
      {
      while( in && !(isspace(c) || isdelim(c) ) )           // input string
	{
	s << c;
	in.get(c);
	}
      if( in ) in.putback(c);
      s << ends;

      char * strTemp = s.str();
      P = strTemp;
      delete strTemp;

      return in;
      }
    }
  }


// read sequence of items, up to delim, as a list

Polylist input_sequence(istream& in, char delim)
  {
  in >> ws;

  if(!in)
    {
    return nil;
    }

  char c;
  in.get(c);
  if( !in || c == delim )
    return nil;
  in.putback(c);
  Poly p;
  in >> p;
  return cons(p, input_sequence(in, delim));
  }


istream& operator>>(istream& in, Polylist& L)
  {
  in >> ws;
  char c;
  in.get(c);
  if( c != '(' )
    L = nil;
  else
    {
    Polylist temp = input_sequence(in, ')');
    L = temp;
    }
  return in;
  }


istream& operator>>(istream& in, Polyarray& A)
  {
  Polylist L;
  in >> ws;
  char c;
  in.get(c);
  if( c != '[' )
    L = nil;
  else
    {
    L = input_sequence(in, ']');
    }
  A = L;
  return in;
  }


// functional forms of various list and Poly methods

Polytype type(const Poly &p) { return p.type(); }

int isList(Poly p)          { return p.isList();      }
int nonList(Poly p)         { return p.nonList();     }
int isArray(Poly p)         { return p.isArray();     }
int isString(Poly p)        { return p.isString();    }
int isChar(Poly p)          { return p.isChar();      }
int isFloating(Poly p)      { return p.isFloating();  }
int isInteger(Poly p)       { return p.isInteger();   }
int isNumeric(Poly p)       { return p.isNumeric();   }
int isAggregate(Poly p)     { return p.isAggregate(); }
int atomic(Poly p)          { return p.atomic();      }


// return REFERENCE to n-th element (n = 0, 1, 2, ...)

Poly & Polylist::operator[](long index) const
  {
  listcell *lptr = this->lptr;
  while( index-- > 0 )
    {
    lptr = Polylist(lptr->Rest).lptr;
    }
  return lptr->First;
  }


Poly & Polylist::operator()(long n) const
  {
  return (*this)[n];
  }

Poly Polylist::appendGen(Poly S)
  {
  Polyarray a = S;
  Polylist L = a[0];
  if( L.isEmpty() )
    return a[1];
  Poly f = L.first();
  Poly r = L.rawRest();
  if( r.ready() )
    return cons(f, Polylist(r).append(a[1]));
  else
    {
    a[0] = r;
    return cons(f, Seed(appendGen, a));
    }
  }

Poly Polylist::append(Poly M) const
  {
  if( isEmpty() )
    return M;
  Poly f = first();
  Poly r = rawRest();
  if( r.ready() )
    return cons(f, Polylist(r).append(M));
  else
    return cons(f, Seed(appendGen, array(r, M)));
  }

Polylist Polylist::operator^(const Polylist &M) const
  {
  return append(M);
  }

Polylist Polylist::reverse() const
  {
  Polylist L = *this;
  Polylist R = nil;     // R will become reverse
  while( L.nonEmpty() )
    {
    R = cons(L.first(), R);
    L = L.rest();
    }
  return R;
  }


// list of numbers from M to N by 1

Polylist Polylist::range(Poly M, Poly N)
  {
  if( M > N )
    return nil;
  return cons(M, range(add(M, 1), N));
  }


// list of numbers from M to N by 1

Polylist Polylist::range(Poly M, Poly N, Poly I)
  {
  if( (I.operator integer()) > 0 )
    {
    if( M > N )
      return nil;
    else
      return cons(M, range(add(M, I), N, I));
    }
  else  /* I <= 0 */
    {
    if( M < N )
      return nil;
    else
      return cons(M, range(add(M, I), N, I));
    }
  }


// create Polyarray from Polylist 

Polylist::operator Polyarray() const
  {
  Polylist L = *this;
  long N = length();
  Polyarray result(N);
  for( long i = 0; i < N; i++ )
    {
    result[i] = L.first();
    L = L.rest();
    }
  return result;
  }


// equality and inequality test for lists

int Polylist::operator==(Polylist M) const
  {
  Polylist L = *this;
  while( L.nonEmpty() && M.nonEmpty() )
    {
    if( L.first() != M.first() )
      {
      return 0;
      }
    L = L.rest();
    M = M.rest();
    }
  return L.isEmpty() && M.isEmpty();
  }

int Polylist::operator!=(Polylist M) const
  {
  return !operator==(M);
  }


// equality and inequality test for lists

int Polylist::operator<(Polylist M) const
  {
  Polylist L = *this;
  int strict = 0;
  while( L.nonEmpty() && M.nonEmpty() )
    {
    if( L.first() > M.first() )
      return 0;
    else if( L.first() < M.first() )
      strict = 1;
    L = L.rest();
    M = M.rest();
    }
  return strict || (L.isEmpty() && !M.isEmpty());
  }

// null constants

Polylist nil;
Polylist NIL;
Seed nullSeed;
Fclosure nullFclosure;
Sclosure nullSclosure(nil, nil, nil, 0, 0);
Oclosure nullOclosure;

Poly nullEval(Poly exp, Poly env)
  {
  return nil;
  }


// utility functions

Poly append(Poly L, Poly M)
  {
  return Polylist(L).append(M);
  }

Polylist reverse(const Polylist &L)
  {
  return L.reverse();
  }

long length(const Polylist &L)
  {
  return L.length();
  }


// Polyarray methods

Polyarray::Polyarray()                                  // default constructor
  {                                                     // length-0 array
  aptr = new arraycell(0);
  Polycell::inc(aptr);
  }

Polyarray::Polyarray(long N)                            // construct array
  {                                                     // of specified length
  aptr = new arraycell(N);
  Polycell::inc(aptr);
  }

Polyarray::Polyarray(const Polyarray & original)        // copy constructor
  : aptr(original.aptr)
  {
  Polycell::inc(aptr);
  }

Polyarray::Polyarray(arraycell *aptr)                   // construct from cell
  {
  this->aptr = aptr;
  Polycell::inc(aptr);
  }

Poly & Polyarray::operator[](long index) const
  {
  return aptr->array[index];
  }

Poly & Polyarray::operator()(long index) const
  {
  return (*this)[index];
  }

long Polyarray::length() const
  {
  return aptr->size;
  }

void Polyarray::resize(long size)
  {
  aptr->resize(size);
  }

void Polyarray::accomodate(long index)
  {
  if( index+1 > length() )
    aptr->resize(index+1);
  }

Polyarray::~Polyarray()
  {
  Polycell::dec(aptr);
  }

void Polyarray::reverse()
  {
  for( int i = 0, j = length()-1; i < j; i++, j-- )
    swap(i, j);
  }

Polyarray Polyarray::append(const Polyarray &A) const
  {
  Polyarray result(length()+A.length());
  long i, j;
  for( i = 0; i < length(); i++ )
    result[i] = (*this)[i];
  
  for( j = 0; j < A.length(); i++, j++ )
    result[i] = A[j];

  return result;
  }

Polyarray Polyarray::operator^(const Polyarray &A) const
  {
  return append(A);
  }

Polyarray::operator Polylist() const
  {
  Polylist result = nil;
  for( int i = length()-1; i >= 0; i-- )
    result = cons(operator[](i), result);
  return result;
  }


// convert array to string (e.g. for output)
// The string must be reclaimed by the user.

Polyarray::operator char*() const
  {
  ostrstream buff;
  buff << "[";
  if( length() > 0 )
    {
    buff << (char*)(operator[](0));
    }

  for( long i = 1; i < length(); i++ )
    {
    buff << " " << (char*)(operator[](i));
    }
  buff << "]" << ends;
  return buff.str();
  }

Polyarray& Polyarray::operator=(const Polyarray &source)        // assignment
  {
  if( this == &source )
    return *this;
  Polycell::inc(source.aptr);           // new pointer to source cell
  Polycell::dec(aptr);                  // over-writing old ptr
  aptr = source.aptr;
  return *this;
  }


int Polyarray::operator==(Polyarray B) const    // equality test
  {
  return !operator==(B);
  }

int Polyarray::operator!=(Polyarray B) const    // inequality test
  {
  if( length() != B.length() )
    return 0;
  for( long i = 0; i < length(); i++ )
    {
    if( (*this)[i] != B[i] )
      return 0;
    }
  return 1;
  }

int Polyarray::operator<(Polyarray B) const     // inequality test
  {
  if( length() > B.length() )
    return 0;
  int strict = 0;
  for( long i = 0; i < length(); i++ )
    {
    if( (*this)[i] > B[i] )
      return 0;
    else if( (*this)[i] < B[i] )
      strict = 1;
    }
  return strict;
  }

void Polyarray::sort()
  {
  Poly* array = aptr -> array;
  long Last = length()-1;

  // A heap is a tree in which each node is smaller than either of its
  // children (and thus than any of its descendants).  All sub-trees of a
  // heap are also heaps.  In this program, a heap is stored as an array,
  // with the root at element 0.  In general, if a node is at element I,
  // its children are at elements 2*I+1 and 2*I+2.


  // phase 1: form heap
  // Construct heap bottom-up, starting with small trees just above leaves
  // and coalescing into larger trees near the root.

  for( long Top = Last/2; Top >= 0; Top-- )
    {
    adjust(Top, Last);
    }


  // phase 2: use heap to sort
  // Move top element (largest) out of heap, swapping with last element 
  // and changing the heap boundary, until only one element remains.

  while( Last > 0 )
    {
    swap(0, Last);
    adjust(0, --Last);
    }
  }


/**
  *  adjust(Top, Last) adjusts the tree between Top and Last
 **/

void Polyarray::adjust(long Top, long Last)
  {
  Poly* array = aptr -> array;
  Poly TopVal = array[Top];                   // Set aside top of heap
  long Parent, Child;

  for( Parent = Top; ; Parent = Child )       // Iterate down through tree
    {
    Child = 2*Parent+1;                       // Child means left child

    if( Child > Last ) 
      break;                                  // Left child non-existent

    if( Child+1 <= Last                       // Right child exists
         && array[Child] < array[Child+1] )   // and right child is larger
      Child++;                                // Child is the larger child

    if( TopVal >= array[Child] ) 
      break;                                  // Location for TopVal found

    array[Parent] = array[Child];             // Move larger child up in tree
    }

  array[Parent] = TopVal;                     // Install TopVal in place
  }


/**
  *  swap(i, j) interchanges the values in array[i] and array[j]
 **/

void Polyarray::swap(long i, long j)
  {
  Poly* array = aptr -> array;
  Poly temp = array[i];
  array[i] = array[j];
  array[j] = temp;
  }


// Copy string onto the heap

char* newString(char* string)
  {
  char* result = new char[strlen(string)+1];
  strcpy(result, string);
  return result;
  }


// error methods and constructors

error::error(char* msg)
  {
  this->msg = newString(msg);
  }

error::operator char*()
  {
  return msg;
  }

error::error(error &orig)
  {
  msg = orig.msg;
  }

error & error::operator=(error & source)
  {
  msg = source.msg;
  return *this;
  }


/* hashtable stuff:

A hashtab is an implementation of a partial function from "symbols" (type
char*) to some arbitrary range.  The type of range itself is supplied to 
hashtab as a type parameter.  A symbol may have a "value" in the range 
associated with it through the hashtab.

Associated with each symbol is also an index, defining its position in an
internal array.  These indices can be used to identify the symbol and its value
by indexing rather than searching.  The indexes don't change over time.  They
are natural numbers: 0, 1, 2, ...

constructors:

    hashtab(long size);

        Provides a hashtab with the indicated size
        In the first constructor, a default size of 1000 is used.

    hashtab();

        Use the default size

methods:

    char* ensure(char* symbol, char* &value)

        Sets value to the value to which symbol hashes.  Here value will
        be the same string in an internal table.  If no string is present,
        one is created.

*/

// The hashing function

unsigned long hashtab::hash(char *str)
{
const int multiplier = 131;
unsigned long h;
for( h = 0; *str ; h = h*multiplier + (*str++) )
  {}
return h;
}


//
// hashtab constructor
//

hashtab::hashtab(long Size)
{
init(Size);
for( long i = 0; i < size; i++ )
  bucket[i] = 0;
}


//
// int ensure(char* symbol, char* & value) method of class hashtab
//
// if symbol is already in table, sets argument value and returns 1.
// if not in table, inserts it and sets value, returning 0.
//

int hashtab::ensure(char* symbol, char* &value)
{
long index = hash(symbol)%size;
entry *ptr = bucket[index];
ptr = search(symbol, ptr);              // see if symbol exists
if( !ptr )
  {
  value = newString(symbol);
  bucket[index] = new entry(value, bucket[index]);
  return 0;                             // indicate no value before
  }
value = ptr -> symbol;                  // set value
return 1;                               // indicate there was a value
}


//
// search(char* symbol, entry* ptr)
//
// Returns pointer to cell of symbol if seen, otherwise 0
//

entry* hashtab::search(char* symbol, entry* ptr)
{
while( ptr )
  if( !strcmp(symbol, ptr -> symbol) )
    return ptr;
  else
    ptr = ptr -> next;
return 0;
}


//
// void init(long Size) of class hashtab
// 
// initializes internal array to size of specified Size 
// and retains this Size for further extension as needed
//

void hashtab::init(long Size)
{
bucket = new entry*[Size];
if( !bucket )
  {
  cerr << "*** not enough space for hashtab" << endl;
  exit(1);
  }
size = Size;
}


void hashtab::dump(ostream &out)                // for debugging purposes
{
out << "dump of hashtab" << endl;
for( long i = 0; i < size; i++ )
  {
  entry* ptr = bucket[i];
  if( !ptr )
    continue;
  out << "bucket " << i << ": ";
  while( ptr )
    {
    out << ptr -> symbol << " ";
    ptr = ptr -> next;
    }
  out << endl;
  }
}

// make deep copy of stuff

Poly Poly::deepCopy() const
  {
  switch( type() )
    {
    case LIST:  return Polylist(*this).deepCopy();
    case ARRAY: return (this->operator Polyarray()).deepCopy();
    default:          return *this;
    }
  }

Polylist Polylist::deepCopy() const 
  {
  Polylist L = *this;
  if( L.isEmpty() )
    return nil;
  return cons(L.first().deepCopy(), L.rest().deepCopy());
  }

Polyarray Polyarray::deepCopy() const
  {
  Polyarray copy(length());
  for( long i = 0; i < length(); i++ )
    {
    copy[i] = (*this)[i].deepCopy();
    }
  return copy;
  }

Polyarray Polyarray::force() const
  {
  for( long i = 0; i < length(); i++ )
    {
    (*this)[i].force();
    }
  return *this;
  }

//
// Make an array of a specifed size from a function f as
// [f(0), f(1), ...., f(size-1)]
//

Polyarray Polyarray::make(Poly fun, long size)
  {
  Polyarray a(size);
  for( long i = 0; i < size; i++ )
    {
    a[i] = fun.operator()(i);
    }
  return a;
  }


Polyarray Polyarray::map(Poly fun) const
  {
  Polyarray copy(length());
  for( long i = 0; i < length(); i++ )
    {
    copy[i] = fun.operator()((*this)[i]);
    }
  return copy;
  }


Poly Poly::deepType() const
  {
  switch( type() )
    {
    case LIST:  return Polylist(*this).deepType();
    case ARRAY: return (this->operator Polyarray()).deepType();
    default:          return typenam();
    }
  }

Polylist Polylist::deepType() const
  {
  return map(::deepType);
  }

Polyarray Polyarray::deepType() const
  {
  return map(::deepType);
  }


// Interpretation of Poly as Boolean

int isTrue(Poly arg)
  {
  return arg.type() != INTEGER || integer(arg) != 0;
  }


int isFalse(Poly arg)
  {
  return arg.type() == INTEGER && integer(arg) == 0;
  }


// generator of integers

Poly Polylist::fromGen(Poly m)                  // declaration as a generator
  {
  return cons(m, Seed(fromGen, integer(m)+1));
  }

Polylist Polylist::from(Poly m)
  {
  return fromGen(m);
  }


Poly Polylist::fromGen2(Poly x)                 // declaration as a generator
  {
  Polyarray a = x;
  a[0] = add(a[0], a[1]);
  return cons(a[0], Seed(fromGen2, a));
  }

Polylist Polylist::from(Poly m, Poly inc)
  {
  return fromGen2(array(m, inc));
  }


//
// Make a list of a specifed size from a function f as
// [f(0), f(1), ...., f(size-1)]
//

Polylist Polylist::make(Poly fun, long size)
  {
  Polylist result = nil;
  for( long i = size-1; i >= 0; i-- )
    {
    result = cons(fun.operator()(i), result);
    }
  return result;
  }


// this map works on infinite lists as well as finite

Poly Polylist::mapGen(Poly p)
  {
  Polyarray a = p;
  Poly fun = a[0];
  Polylist arg = a[1];
  if( arg.isEmpty() )
    return nil;
  a[1] = arg.rest();    // reuse array
  return cons(fun.operator()(arg.first()), Seed(mapGen, a));
  }


//
// map maps as much of the list as is ready.  It then turns things over
// to mapGen which maps the rest lazily.
//

Polylist Polylist::map(Poly fun) const
  {
  if( isEmpty() )
    return nil;

  Poly r = rawRest();
  if( r.ready() )
    return cons(fun.operator()(first()), Polylist(r).map(fun));
  else
    return cons(fun.operator()(first()), mapGen(array(fun, r)));
  }


// this mappend works on infinite lists as well as finite

Poly Polylist::mappendGen(Poly p)
  {
  Polyarray a = p;
  Poly fun = a[0];
  Polylist arg = a[1];
  if( arg.isEmpty() )
    return nil;
  a[1] = arg.rawRest();    // reuse array
  return Polylist(fun.operator()(arg.first())).append(Seed(mappendGen, a));
  }


//
// mappend maps as much of the list as is ready.  It then turns things over
// to mappendGen which maps the rest lazily.
//

Polylist Polylist::mappend(Poly fun) const
  {
  if( isEmpty() )
    return nil;

  Poly r = rawRest();
  if( r.ready() )
    return Polylist(fun.operator()(first())).append(Polylist(r).mappend(fun));
  else
    return Polylist(fun.operator()(first())).append(mappendGen(array(fun, r)));
  }


// this scanl works on infinite lists as well as finite

Poly Polylist::scanlGen(Poly p)
  {
  Polyarray a = p;
  Function2 fun = a[0];
  Poly acc = a[1];
  Polylist r = a[2];
  if( r.isEmpty() )
    return list(acc);
  a[1] = fun(acc, r.first());           // reuse array
  a[2] = r.rest();
  return cons(a[1], Seed(scanlGen, a));
  }


Polylist Polylist::scanlaux(Function2 fun, Poly acc) const
  {
  if( isEmpty() )
    return nil;

  Poly f = fun(acc, first());
  Poly r = rawRest();
  if( r.ready() )
    {
    return cons(f, Polylist(r).scanlaux(fun, f));
    }
  else
    return cons(f, scanlGen(array(fun, f, r)));
  }


Polylist Polylist::scanl(Function2 fun, Poly unit) const
  {
  return scanlaux(fun, unit);
  }


Polylist Polylist::scanr(Function2 fun, Poly unit) const
  {
  if( isEmpty() )
    return nil;

  Polylist r = rest().scanr(fun, unit);
  if( r.isEmpty() )
    return list(fun(first(), unit));
  return cons(fun(first(), r.first()), r);
  }


Poly Polylist::foldlGen(Poly p)
  {
  Polyarray a = p;
  Function2 fun = a[0];
  Poly acc = a[1];
  Polylist arg = a[2];
  if( arg.isEmpty() )
    return acc;
  Poly f = arg.first();
  Poly r = arg.rawRest();
  if( r.ready() )
    return Polylist(r).foldl(fun, fun(acc, f));
  else
    {
    a[1] = fun(acc, f);
    a[2] = r;    // reuse array
    return Seed(foldlGen, a);
    }
  }


Poly Polylist::foldl(Function2 fun, Poly acc) const     // fold-left
  {
  if( isEmpty() )
    return acc;
  else
    {
    Poly f = first();
    Poly r = rawRest();
    if( r.ready() )
      return Polylist(r).foldl(fun, fun(acc, f));
    else
      return Seed(foldlGen, array(fun, fun(acc, f), r));
    }
  }

Poly Polylist::foldr(Function2 fun, Poly acc) const     // fold-right
  {
  if( isEmpty() )
    return acc;
  else
    return fun(first(), rest().foldr(fun, acc));
  }


// keepgen is used in keep

Poly Polylist::keepGen(Poly p)
  {
  Polyarray a = p;
  Poly pred = a[0];
  Polylist arg = a[1];
  if( arg.isEmpty() )
    return nil;
  a[1] = arg.rest();    // reuse array
  Poly f = arg.first();
  if( isTrue(pred.operator()(f)) )
    return cons(f, Seed(keepGen, a));
  else
    return Seed(keepGen, a);
  }

// keep keeps elements of list satisfying predicate, discarding others

Polylist Polylist::keep(Poly pred) const
  {
  if( isEmpty() )
    return nil;

  Poly r = rawRest();
  Poly f = first();
  if( r.ready() )
    {
    if( isTrue(pred.operator()(f)) )
      return cons(f, Polylist(r).keep(pred));
    else
      return Polylist(r).keep(pred);
    }
  else
    {
    return keepGen(array(pred, *this));
    }
  }


// dropgen is used in drop

Poly Polylist::dropGen(Poly p)
  {
  Polyarray a = p;
  Poly pred = a[0];
  Polylist arg = a[1];
  if( arg.isEmpty() )
    return nil;
  a[1] = arg.rest();
  Poly f = arg.first();
  if( isTrue(pred.operator()(f)) )
    return Seed(dropGen, a);
  else
    return cons(f, Seed(dropGen, a));
  }

// drop drops elements of list satisfying predicate, discarding others

Polylist Polylist::drop(Poly pred) const
  {
  if( isEmpty() )
    return nil;

  Poly r = rawRest();
  Poly f = first();
  if( r.ready() )
    {
    if( isTrue(pred.operator()(f)) )
      return rest().drop(pred);
    else
      return cons(f, rest().drop(pred));
    }
  else
    {
    return dropGen(array(pred, *this));
    }
  }


// find whether member occurs in list

int Polylist::member(Poly item) const
  {
  Polylist L = *this;
  while( L.nonEmpty() )
    {
    if( item == L.first() )
      return 1;
    L = L.rest();
    }
  return 0;
  }


//
// Find item satisfying predicate, return list beginning with this item
// Empty list is returned if not found.
//

Polylist Polylist::find(Poly pred) const
  {
  Polylist L = *this;
  while( L.nonEmpty() )
    {
    if( isTrue(pred.operator()(L.first())) )
      return L;
    L = L.rest();
    }
  return nil;
  }


//
// Find item with first element equal to argument.
// Empty list is returned if not found.
//

Polylist Polylist::assoc(Poly key) const
  {
  Polylist L = *this;
  while( L.nonEmpty() )
    {
    Polylist f = L.first();
    if( f.nonEmpty() && key == f.first() )
      return f;
    L = L.rest();
    }
  return nil;
  }


Polylist Polylist::prefix(long i) const
  {
  if( i <= 0 || isEmpty() )
    {
    return nil;
    }
  return cons(first(), rest().prefix(i-1));
  }


Polylist Polylist::force() const
  {
  if( isEmpty() )
    {
    return nil;
    }
  first().force();
  rest().force();
  return *this;
  }


// generate infinite sequence of random numbers

Poly Polylist::randomGen(Poly p)
  {
  Polyarray a = p;
  long base = a[0];
  long modulus = a[1];
  long num = base + rand()%modulus;
  return cons(num, Seed(randomGen, p));
  }

Polylist Polylist::random(long base, long modulus)
  {
  return randomGen(array(base, modulus));
  }

// inchars reads chars as a list from istream

Poly Polylist::incharsGen(Poly x)
  {
  istream & in = (istream &)x;
  char c;
  if( in.get(c) )
    return cons(c, Seed(incharsGen, x));
  return nil;
  }

Polylist Polylist::inchars(istream & in)
  {
  return incharsGen(in);
  }


// non-member function versions

Polylist map(Poly fun, Polylist L)
  {
  return L.map(fun);
  }

Polylist keep(Poly pred, Polylist L)
  {
  return L.keep(pred);
  }

Polylist drop(Poly pred, Polylist L)
  {
  return L.drop(pred);
  }

int member(Poly item, Polylist L)
  {
  return L.member(item);
  }

Polylist find(Poly pred, Polylist L)
  {
  return L.find(pred);
  }

Polylist prefix(long i, Polylist L)
  {
  return L.prefix(i);
  }

Polylist force(Polylist L)
  {
  return L.force();
  }

char* implode(Polylist L)
  {
  return L.implode();
  }

Polylist explode(Poly P)
  {
  return P.explode();
  }


Poly foldr(Function2 fun, Poly unit, Polylist L)
  {
  return L.foldr(fun, unit);
  }


Poly foldl(Function2 fun, Poly unit, Polylist L)
  {
  return L.foldl(fun, unit);
  }


Poly add(Poly arg1, Poly arg2)
  {
  switch( arg1.type() )
    {
    case FLOATING:      
      switch( arg2.type() )
        {
        case INTEGER:
        case FLOATING:
          return floating(arg1)+floating(arg2);

        case STRING:
          return cat(arg1, arg2);
        }
      
      return floating(arg1)+floating(arg2);

    case INTEGER:       
      switch( arg2.type() )
        {
        case FLOATING:
          return floating(arg1)+floating(arg2);

        case INTEGER:
          return integer(arg1)+integer(arg2);

        case STRING:
          return cat(arg1, arg2);
        }

    case STRING:
      {
      return cat(arg1, arg2);
      }    

    }
  return error("Poly add");
  }


Poly cat(Poly arg1, Poly arg2)
  {
  char* a = arg1;
  char* b = arg2;
  char* c = new char[strlen(a)+strlen(b)+1];
  strcpy(c, a);
  strcat(c, b);
  Poly result = c;
  delete [] c;
  return result;
  }


Poly multiply(Poly arg1, Poly arg2)
  {
  switch( arg1.type() )
    {
    case FLOATING:      
      return floating(arg1)*floating(arg2);
    case INTEGER:       
      switch( arg2.type() )
        {
        case FLOATING:
          return floating(arg1)*floating(arg2);

        case INTEGER:
          return integer(arg1)*integer(arg2);
        }
    }
  return error("Poly multiply");
  }


Poly subtract(Poly arg1, Poly arg2)
  {
  switch( arg1.type() )
    {
    case FLOATING:      
      return floating(arg1)-floating(arg2);
    case INTEGER:       
      switch( arg2.type() )
        {
        case FLOATING:
          return floating(arg1)-floating(arg2);

        case INTEGER:
          return integer(arg1)-integer(arg2);
        }
    }
  return error("Poly subtract");
  }


Poly divide(Poly arg1, Poly arg2)
  {
  switch( arg1.type() )
    {
    case FLOATING:      
      return floating(arg1)/floating(arg2);
    case INTEGER:       
      switch( arg2.type() )
        {
        case FLOATING:
          return floating(arg1)/floating(arg2);

        case INTEGER:
          return integer(arg1)/integer(arg2);
        }
    }
  return error("Poly divide");
  }


Poly Poly::operator+(const Poly & arg2) const
  {
  return add(*this, arg2);
  }


Poly Poly::operator*(const Poly & arg2) const
  {
  return multiply(*this, arg2);
  }


Poly Poly::operator/(const Poly & arg2) const
  {
  return divide(*this, arg2);
  }


Poly Poly::operator-(const Poly & arg2) const
  {
  return subtract(*this, arg2);
  }


Poly Poly::operator+=(const Poly & arg2)
  {
  return *this = add(*this, arg2);
  }


Poly Poly::operator*=(const Poly & arg2)
  {
  return *this = multiply(*this, arg2);
  }


Poly Poly::operator/=(const Poly & arg2)
  {
  return *this = divide(*this, arg2);
  }


Poly Poly::operator-=(const Poly & arg2)
  {
  return *this = subtract(*this, arg2);
  }


// Functional Forms

// some global functions which are essential with respect to the way
// in which this library is coded

Poly deepType(Poly p) { return p.deepType(); }


// convenience functions; some of these are closely related to methods of the
// same name in classes such as Polylist or Poly,
// but are defined so that they can be used in functional rather than 
// object-oriented form, including as arguments to functions which
// take function arguments, where methods cannot be used.

Poly type(Poly p) { return p.type(); }

Poly deepCopy(Poly p) { return p.deepCopy(); }

Polylist from(Poly m)
  {
  return Polylist::from(m);
  }

Polylist from(Poly m, Poly inc)
  {
  return Polylist::from(m, inc);
  }

Polylist range(Poly M, Poly N)
  {
  return Polylist::range(M, N);
  }

Polylist range(Poly M, Poly N, Poly I)
  {
  return Polylist::range(M, N, I);
  }

int isEmpty(const Polylist &L)     { return L.isEmpty(); }

int nonEmpty(const Polylist &L)    { return L.nonEmpty(); }

Poly & first(const Polylist &L)    { return L.first(); }

Polylist rest(const Polylist &L)   { return L.rest(); }


// Functions which don't correspond to methods

Polylist cons(const Poly & First, const Poly & Rest)
  {
  return Polylist::cons(First, Rest);
  } 

Poly max(Poly arg1, Poly arg2)
  {
  return arg1 < arg2 ? arg2 : arg1;
  }

Poly min(Poly arg1, Poly arg2)
  {
  return arg1 < arg2 ? arg1 : arg2;
  }

Poly & second(const Polylist &L)   { return L.rest().first(); }

Poly & third(const Polylist &L)    { return L.rest().rest().first(); }

Poly & fourth(const Polylist &L)   { return L.rest().rest().rest().first(); }

Poly & fifth(const Polylist &L)   
 { return L.rest().rest().rest().rest().first(); }

Poly & sixth(const Polylist &L)    
  { return L.rest().rest().rest().rest().rest().first(); }

Poly & seventh(const Polylist &L)  
  { return L.rest().rest().rest().rest().rest().rest().first(); }

Poly & eighth(const Polylist &L)   
  { return L.rest().rest().rest().rest().rest().rest().rest().first(); }

Poly & ninth(const Polylist &L)   
  { return L.rest().rest().rest().rest().rest().rest().rest().rest().first(); }

Poly & tenth(const Polylist &L)   
  { return L.rest().rest().rest().rest().rest().rest().rest().rest().rest()
            .first(); }

Polylist list()
  { return nil; }

Polylist list(const Poly &a)       
  { return cons(a, nil); }

Polylist list(const Poly &a, const Poly &b) 
  { return cons(a, cons(b, nil)); }

Polylist list(const Poly &a, const Poly &b, const Poly &c) 
  { return cons(a, cons(b, cons(c, nil))); }

Polylist list(const Poly &a, const Poly &b, const Poly &c, const Poly &d) 
  { return cons(a, cons(b, cons(c, cons(d, nil)))); }

Polylist list(const Poly &a, const Poly &b, const Poly &c, const Poly &d, 
              const Poly &e)
  { return cons(a, cons(b, cons(c, cons(d, cons(e, nil))))); }

Polylist list(const Poly &a, const Poly &b, const Poly &c, const Poly &d, 
              const Poly &e, const Poly &f)
  { return cons(a, cons(b, cons(c, cons(d, cons(e, cons(f, nil)))))); }

Polylist list(const Poly &a, const Poly &b, const Poly &c, const Poly &d, 
              const Poly &e, const Poly &f, const Poly &g)
  { 
  return cons(a, cons(b, cons(c, cons(d, cons(e, cons(f, cons(g, nil))))))); 
  }

Polylist list(const Poly &a, const Poly &b, const Poly &c, const Poly &d, 
              const Poly &e, const Poly &f, const Poly &g, const Poly &h)
  { 
  return cons(a, cons(b, cons(c, cons(d, cons(e, cons(f, cons(g, 
                 cons(h, nil)))))))); 
  }

Polylist list(const Poly &a, const Poly &b, const Poly &c, const Poly &d, 
              const Poly &e, const Poly &f, const Poly &g, const Poly &h, 
              const Poly &i)
  { 
  return cons(a, cons(b, cons(c, cons(d, cons(e, cons(f, cons(g, cons(h, 
                 cons(i, nil)))))))));
  }

Polylist list(const Poly &a, const Poly &b, const Poly &c, const Poly &d, 
              const Poly &e, const Poly &f, const Poly &g, const Poly &h, 
              const Poly &i, const Poly &j)
  { 
  return cons(a, cons(b, cons(c, cons(d, cons(e, cons(f, cons(g, cons(h, 
                 cons(i, cons(j, nil)))))))))); 
  }

Polylist list(const Poly &a, const Poly &b, const Poly &c, const Poly &d, 
              const Poly &e, const Poly &f, const Poly &g, const Poly &h, 
              const Poly &i, const Poly &j, const Poly &k)
  { 
  return cons(a, cons(b, cons(c, cons(d, cons(e, cons(f, cons(g, cons(h, 
                 cons(i, cons(j, cons(k, nil))))))))))); 
  }
 

Polylist list(const Poly &a, const Poly &b, const Poly &c, const Poly &d, 
              const Poly &e, const Poly &f, const Poly &g, const Poly &h, 
              const Poly &i, const Poly &j, const Poly &k, const Poly &l)
  { 
  return cons(a, cons(b, cons(c, cons(d, cons(e, cons(f, cons(g, cons(h, 
                 cons(i, cons(j, cons(k, cons(l, nil)))))))))))); 
  }
 
Polyarray array(long N, Poly init[])
  { 
  Polyarray x(N);
  for( long i = 0; i < N; i++ )
    x[i] = init[i];
  return x;
  }

Polyarray array()
  { 
  Polyarray x;
  return x;
  }

Polyarray array(const Poly &a)
  { 
  Polyarray x(1);
  x[0] = a;
  return x;
  }

Polyarray array(const Poly &a, const Poly &b)
  { 
  Polyarray x(2);
  x[0] = a;
  x[1] = b;
  return x;
  }

Polyarray array(const Poly &a, const Poly &b, const Poly &c)
  { 
  Polyarray x(3);
  x[0] = a;
  x[1] = b;
  x[2] = c;
  return x;
  }

Polyarray array(const Poly &a, const Poly &b, const Poly &c, const Poly &d)
  { 
  Polyarray x(4);
  x[0] = a;
  x[1] = b;
  x[2] = c;
  x[3] = d;
  return x;
  }

Polyarray array(const Poly &a, const Poly &b, const Poly &c, const Poly &d, 
                const Poly &e)
  { 
  Polyarray x(5);
  x[0] = a;
  x[1] = b;
  x[2] = c;
  x[3] = d;
  x[4] = e;
  return x;
  }

Polyarray array(const Poly &a, const Poly &b, const Poly &c, const Poly &d, 
                const Poly &e, const Poly &f)
  { 
  Polyarray x(6);
  x[0] = a;
  x[1] = b;
  x[2] = c;
  x[3] = d;
  x[4] = e;
  x[5] = f;
  return x;
  }

Polyarray array(const Poly &a, const Poly &b, const Poly &c, const Poly &d, 
                const Poly &e, const Poly &f, const Poly &g)
  { 
  Polyarray x(7);
  x[0] = a;
  x[1] = b;
  x[2] = c;
  x[3] = d;
  x[4] = e;
  x[5] = f;
  x[6] = g;
  return x;
  }

Polyarray array(const Poly &a, const Poly &b, const Poly &c, const Poly &d, 
                const Poly &e, const Poly &f, const Poly &g, const Poly &h)
  { 
  Polyarray x(8);
  x[0] = a;
  x[1] = b;
  x[2] = c;
  x[3] = d;
  x[4] = e;
  x[5] = f;
  x[6] = g;
  x[7] = h;
  return x;
  }

Polyarray array(const Poly &a, const Poly &b, const Poly &c, const Poly &d, 
                const Poly &e, const Poly &f, const Poly &g, const Poly &h, 
                const Poly &i)
  { 
  Polyarray x(9);
  x[0] = a;
  x[1] = b;
  x[2] = c;
  x[3] = d;
  x[4] = e;
  x[5] = f;
  x[6] = g;
  x[7] = h;
  x[8] = i;
  return x;
  }

Polyarray array(const Poly &a, const Poly &b, const Poly &c, const Poly &d, 
                const Poly &e, const Poly &f, const Poly &g, const Poly &h, 
                const Poly &i, const Poly &j)
  { 
  Polyarray x(10);
  x[0] = a;
  x[1] = b;
  x[2] = c;
  x[3] = d;
  x[4] = e;
  x[5] = f;
  x[6] = g;
  x[7] = h;
  x[8] = i;
  x[9] = j;
  return x;
  }


Polyarray array(const Poly &a, const Poly &b, const Poly &c, const Poly &d, 
                const Poly &e, const Poly &f, const Poly &g, const Poly &h, 
                const Poly &i, const Poly &j, const Poly &k) 
  { 
  Polyarray x(11);
  x[0] = a;
  x[1] = b;
  x[2] = c;
  x[3] = d;
  x[4] = e;
  x[5] = f;
  x[6] = g;
  x[7] = h;
  x[8] = i;
  x[9] = j;
  x[10] = k;
  return x;
  }


Polyarray array(const Poly &a, const Poly &b, const Poly &c, const Poly &d, 
                const Poly &e, const Poly &f, const Poly &g, const Poly &h, 
                const Poly &i, const Poly &j, const Poly &k, const Poly &l) 
  { 
  Polyarray x(12);
  x[0] = a;
  x[1] = b;
  x[2] = c;
  x[3] = d;
  x[4] = e;
  x[5] = f;
  x[6] = g;
  x[7] = h;
  x[8] = i;
  x[9] = j;
  x[10] = k;
  x[11] = l;
  return x;
  }

Poly makeFloating(Poly x)
  {
  return floating(x);
  }


Poly makeInteger(Poly x)
  {
  return integer(x);
  }

Poly makeString(Poly x)
  {
  return (char*)(x);
  }