// file:      polya.H
// version:   2.0
// author:    Robert Keller
// purpose:   header file for "polya" library (dynamic polymorphism)
// 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.H,v 1.140 1997/08/02 00:54:49 keller Exp keller $
//

#ifndef __POLYA_H__      // "once" pragma

#include <iostream.h>
#include <string.h>

// This is an escape character prefixed to read in special characters such
// ( ) [ ] + - etc.  Anything which follows it is read as a literal character

const char ioEscape = '\\';

// models for numeric types integer and floating as used by polya
// define FLOAT to be 0 for float, 1 for double
// define INT   to be 0 for long,  1 for Integer

#define FLOAT 0
#define INT   0

#if FLOAT
typedef double floating;
#else
typedef float floating;
#endif

#if INT
#include <Integer.h>
typedef Integer integer;
#else
typedef long    integer;
#endif


// forward references
// user classes
class Poly;
class Polylist;
class Polyarray;
class Fclosure;
class Sclosure;
class Oclosure;
class Seed;

// implementation classes
class arraycell;
class fclosurecell;
class sclosurecell;
class oclosurecell;
class listcell;         
class seedcell;
class Polycell;
class error;

typedef Poly(*Function1)(Poly);         // function storable as Poly
typedef Poly(*gen)(Poly);               // generator function used with seed
typedef Poly(*Function2)(Poly, Poly);   // function of 2 args (e.g. closure fn)


// This class is meant to be extended, for the purpose of creating Oclosures

class Applicable
{
public:
virtual Poly operator()(Poly arg) const = 0;
}; 


// These types are used only in Sclosures (symbolic closures to define 
// application of same.

typedef Poly (*Eval)(Poly exp, Poly env);
typedef Polylist (*NewEnv)(Poly Vars, Poly Args, Polylist env);


//
// enumeration of possible variants of Poly
//

typedef short Polytype;

// Note: numeric type, rather than enum is used since the numeric
// values are used in < comparisons among different contained types.
// The exact numeric value is not important, but the ordering is.

const Polytype

      INTEGER   =  0,        // integer
      FLOATING  =  1,        // floating point
      CHAR      =  2,        // character
      STRING    =  3,        // character string
      LIST      =  4,        // list of Polys
      ARRAY     =  5,        // array of Polys
      SEED      =  6,        // Seed
      FCLOSURE  =  7,        // Function Closure
      SCLOSURE  =  8,        // Symbolic Closure
      OCLOSURE  =  9,        // Object Closure
      FUNCTION1 = 10,        // function from Poly into Poly
      FUNCTION2 = 11,        // function from Poly x Poly into Poly
      ISTREAM   = 12,        // input stream, e.g. used to get stream of chars
      ERROR     = 13;        // error


class Poly  
{           
public:

private:

mutable Polytype Type;

mutable union
  {
  integer       integerValue;    // for integer
  floating      floatingValue;   // for floating
  char*         stringValue;     // for string
  char          charValue;	 // for character
  listcell*     lptr;            // for Polylist
  arraycell*    aptr;            // for Polyarray
  seedcell*     sptr;            // for Seed
  fclosurecell* cptr;            // for Function Closure
  sclosurecell* kptr;            // for Symbolic Closure
  oclosurecell* optr;            // for Object Closure
  Function1     fptr;            // for function
  Function2     gptr;            // for Function
  istream*      iptr;            // for istream
  char*         eptr;            // for error values
  } u;

///////
public:
///////

// constructors, create Poly that contains a given value

Poly(const Poly &x);            // copy constructor

Poly();                         // default constructor
Poly(integer x);                // construct from integer
Poly(floating x);               // construct from floating
Poly(char* x);                  // construct from string
Poly(char x);                   // construct from char
Poly(const Polylist &x);        // construct from list
Poly(const Polyarray &x);       // construct from array
Poly(const Seed &s);            // construct from Seed
Poly(const Fclosure &c);        // construct from Function Closure
Poly(const Sclosure &cs);       // construct from Symbolic Closure
Poly(const Oclosure &oc);       // construct from Object Closure
Poly(Function1 fun);            // construct from Function
Poly(Function2 fun);            // construct from Function2
Poly(istream &in);              // construct from istream
Poly(const error &e);           // construct from error value
~Poly();                        // destructor

Poly operator()(Poly arg) const;
const Poly & grow() const;      // grow, if a seed
int ready() const;              // tell if ready

#if INT
Poly(long x);
#endif

Poly(int x);

#if !FLOAT
Poly(double x);
#endif

Poly & operator=(const Poly &source);   // assignment operator

int operator==(const Poly & q) const;   // equality operator
int operator!=(const Poly & q) const;   // inequality operators
int operator< (const Poly & q) const;
int operator<=(const Poly & q) const;
int operator>=(const Poly & q) const;
int operator> (const Poly & q) const;

Polytype type() const;     // type inquiry function, returns contained type 
Polytype trueType() const; // like type except returns SEED for seed

char* typenam() const;                  // returns name of the type


// Define conversion FROM Polys to these types:

operator bool()	     const;
operator int()       const;
operator integer()   const;
operator floating()  const;
operator char*()     const;
operator char()      const;
operator Polylist()  const;
operator Polyarray() const;
operator Seed()      const;
operator Fclosure()  const;
operator Sclosure()  const;
operator Oclosure()  const;
operator Function1() const;
operator Function2() const;
operator istream&()  const;
operator error()     const;

Poly operator+(const Poly & arg2) const;
Poly operator*(const Poly & arg2) const;
Poly operator/(const Poly & arg2) const;
Poly operator-(const Poly & arg2) const;

Poly operator+=(const Poly & arg2);
Poly operator*=(const Poly & arg2);
Poly operator/=(const Poly & arg2);
Poly operator-=(const Poly & arg2);

// testing functions

int atomic()  ;          // same as !isAggregate
int isAggregate();       // return 1 if arg is a list or array
int isArray();           // return 1 if arg is an array, 0 otherwise
int isChar();            // return 1 if arg is a char, 0 otherwise
int isList();            // return 1 if arg is a list, 0 otherwise
int isFloating();        // return 1 if arg is floating, else 0
int isInteger();         // return 1 if arg is integer, else 0
int isNumeric();         // tell whether argument is numeric
int isString();          // return 1 if arg is a string, 0 o.w.
int nonList();           // return 1 if arg is not a list, 0 o.w.


// Default values in the case of improper conversion

integer     integerDefault()   const;
int         intDefault()       const;
floating    floatingDefault()  const;
char        charDefault()      const;
Polylist &  listDefault()      const;
Polyarray   arrayDefault()     const;
Seed        SeedDefault()      const;
Fclosure    FclosureDefault()  const;
Sclosure    SclosureDefault()  const;
Oclosure    OclosureDefault()  const;
Function1   Function1Default() const;
Function2   Function2Default() const;
istream &   istreamDefault()   const;
error       errorDefault()     const;

void conversionError(char* type) const;

Polylist explode() const;               // explode into list of characters

Poly deepCopy() const;                  // deep copy of Poly
Poly deepType() const;                  // deep type structure
Poly force()    const;                  // force full evaluation

static int Poly::insideEscape(char c);	// inside of string
static int Poly::startEscape(char c);	// at start of string

ostream & print(ostream & out);		// print without escape characters

static void report();                   // report on storage

private:
inline void inc() const;                // handle reference counting
inline void dec() const;

};  // class Poly


//
// Polylist class, a list of Polys
//

class Polylist           
{
friend Poly;                             // needed because Poly uses lptr

////////
private:
////////

listcell *lptr;                          // pointer to first listcell in list
Polylist(listcell* cell);                // construction from cell

///////
public:
///////

Polylist();                                     // default constructor
Polylist(const Polylist & original);            // copy constructor
static Polylist cons(const Poly & First, const Poly & Rest); // cons function
Poly & first() const;                           // extract first of list
Polylist rest() const;                          // extract rest of list
Poly & rawRest() const;
int isEmpty() const;                            // test for empty list
int nonEmpty() const;                           // test for empty list
long length() const;                            // length of list (computed)
~Polylist();                                    // destructor
Poly & operator[](long n) const;   // REFERENCE to n-th element (n = 0, ...)
Poly & operator()(long n) const;   // same
Poly append(Poly M) const;
Polylist lappend(Seed S) const;
Polylist operator^(const Polylist &M) const;
Polylist reverse() const;

Polylist & operator=(const Polylist & source);  // assignment
int operator==(Polylist M) const;               // equality comparison
int operator!=(Polylist M) const;               // inequality comparison
int operator<(Polylist M) const;

char* implode();                                // implode list to char*

operator char*() const;                         // printable
operator Polyarray() const;                     // array from list

Polylist deepCopy() const;
Polylist deepType() const;                      // type structure of object

static Polylist from(Poly m);                   // generate sequences
static Polylist from(Poly m, Poly inc);
static Polylist range(Poly M, Poly N);
static Polylist range(Poly M, Poly N, Poly I);
static Polylist random(long base, long modulus);// generate random numbers
static Polylist make(Poly, long);               // make list from a function
Polylist map(Poly) const;                       // map a function
Polylist mappend(Poly) const;                   // map a function, appending
Polylist keep(Poly pred) const;                 // keep based on predicate
Polylist drop(Poly pred) const;                 // drop based on predicate

Polylist assoc(Poly key) const;                 // find item matching key
int member(Poly item) const;                    // find if item occurs in list
Polylist find(Poly pred) const;                 // find item satisfying pred
Polylist prefix(integer i) const;               // give prefix of length i
Polylist scanl(Function2 fun, Poly unit) const; // scan-left of a list
Polylist scanr(Function2 fun, Poly unit) const; // scan-right of a list
Poly foldl(Function2 fun, Poly acc) const;      // fold-left
Poly foldr(Function2 fun, Poly acc) const;      // fold-right
Polylist force() const;                         // force generation of all 
Polylist sort() const;                          // sort (non-destructive)
static Polylist inchars(istream & in);          // chars from istream

private:

// generators for infinite sequences
static Poly appendGen(Poly S);
static Poly dropGen(Poly p);
static Poly foldlGen(Poly p);
static Poly fromGen(Poly x);
static Poly fromGen2(Poly x);
static Poly incharsGen(Poly x);
static Poly keepGen(Poly p);
static Poly keepGen2(Poly p);
static Polylist lappendGen(Poly p);
static Poly mapGen(Poly p);
static Poly mappendGen(Poly p);
static Poly randomGen(Poly p);
static Poly scanlGen(Poly p);
Polylist scanlaux(Function2 fun, Poly acc) const;
}; // class Polylist


// read S expression from istream

istream& operator>>(istream& in, Poly& P);
istream& operator>>(istream& in, Polylist& L);
istream& operator>>(istream& in, Polyarray& A);

ostream & operator<<(ostream & out, const Poly &p);
ostream & operator<<(ostream & out, Polylist L);
ostream & operator<<(ostream & out, Polyarray A);
ostream & operator<<(ostream & out, Seed S);
ostream & operator<<(ostream & out, Fclosure C);
ostream & operator<<(ostream & out, Sclosure S);
ostream & operator<<(ostream & out, Oclosure S);
ostream & operator<<(ostream & out, error E);


//
// Polyarray class, a dynamic array of Polys
//

class Polyarray
{
friend class Poly;                      // needed because Poly uses aptr

////////
private:
////////

arraycell *aptr;                        // pointer to array info
Polyarray(arraycell *aptr);             // construct from pointer

///////
public:
///////

Polyarray();                                    // default constructor
Polyarray(long N);
Polyarray(const Polyarray &orig);               // copy constructor
Poly & operator[](long index) const;            // element access
Poly & operator()(long index) const;            // element access
long length() const;                            // return length
void resize(long size);                         // resize array
void accomodate(long index);                    // accomodate index
~Polyarray();                                   // destructor

Polyarray & operator=(const Polyarray &source); // assignment
int operator==(Polyarray B) const;              // equality and inequality
int operator!=(Polyarray B) const;
int operator<(Polyarray M) const;
Polyarray append(const Polyarray &A) const;     // append two arrays
Polyarray operator^(const Polyarray &M) const;
operator Polylist() const;                      // list from array
operator char*() const;                         // return string representation

static Polyarray make(Poly, long);              // make array from a function
Polyarray map(Poly) const;                      // map a function
Polyarray deepCopy() const;                     // make deep copy
Polyarray deepType() const;                     // type structure of object
Polyarray force() const;                        // force generation of all 

void sort();
void reverse();
void swap(long i, long j);

private: 
void adjust(long Top, long Last);               // used in sort
}; // class Polyarray



// hashtable stuff

struct entry
{
char* symbol;
entry* next;

entry(char* Symbol, entry* Next)
: symbol(Symbol), next(Next)
{}

};


//
// Seed class
//

class Seed
{
friend Poly;                            // needed because Poly uses sptr

////////
private:
////////

seedcell *sptr;
Seed(seedcell* cell);                   // construction from a cell

///////
public:
///////

Seed(gen fun, Poly arg);                // constructor from fun and arg
Seed();                                 // default constructor
Seed(const Seed & original);            // copy constructor
Poly & grow() const;                    // causes the Seed to grow
int ready();                            // tells if ready; use sparingly
int operator==(const Seed & q) const;   // compare to another Seed for identity
int operator<(const Seed & q) const;
~Seed();                                // destructor
Seed & operator=(const Seed & source);  // assignment
}; // class Seed


//
// Fclosure class
//

class Fclosure
{
friend Poly;                    // needed because Poly uses sptr

////////
private:
////////

fclosurecell *cptr;
Fclosure(fclosurecell* cell);                   // construction from a cell

///////
public:
///////

Fclosure(Function2 fun, Poly env);              // constructor from fun and env
Fclosure();                                     // default constructor
Fclosure(const Fclosure & original);            // copy constructor
Poly operator()(Poly arg) const;                // apply operator
int operator==(const Fclosure & q) const;       // compare to another
int operator<(const Fclosure & q) const;
operator char*() const;                         // show as string
~Fclosure();                                    // destructor
Fclosure & operator=(const Fclosure & source);  // assignment
}; // class Fclosure


//
// Symbolic Closure class
//

class Sclosure
{
friend Poly;                    // needed because Poly uses sptr

////////
private:
////////

sclosurecell *kptr;
Sclosure(sclosurecell* Kptr);                  // construction from a cell

///////
public:
///////

Sclosure(Poly Vars, Poly Body, Poly env, Eval eval, NewEnv newEnv);
Sclosure();                                    // default constructor
Sclosure(const Sclosure & original);           // copy constructor
Poly operator()(Poly arg) const;               // apply operator
int operator==(const Sclosure & q) const;      // compare to another
int operator<(const Sclosure & q) const;
operator char*() const;                        // show as string
~Sclosure();                                   // destructor
Sclosure & operator=(const Sclosure & source); // assignment
}; // class Sclosure


//
// Object Closure class
//

class Oclosure
{
friend Poly;                    // needed because Poly uses sptr

////////
private:
////////

oclosurecell *optr;

///////
public:
///////

Oclosure();		                       // default constructor
Oclosure(oclosurecell *optr);	               // construct from oclosurecell
Oclosure(const Oclosure & original);           // copy constructor
Oclosure(Applicable* aptr);                    // construction from applicable
virtual Poly operator()(Poly arg) const;       // apply operator
int operator==(const Oclosure & q) const;      // compare to another
int operator<(const Oclosure & q) const;
operator char*() const;                        // show as string
virtual ~Oclosure();                           // destructor
Oclosure & operator=(const Oclosure & source); // assignment
}; // class Oclosure


//
// Polycell is the base class for several cell types.
// It contains the reference-counting information.
//

class Polycell
{
protected:
int rc;                                 // reference count

static long allocated;                  // total cells allocated
static long count;                      // total cells outstanding
static long hi, low;                    // high and low watermarks

public:
Polycell();
long outstanding();                     // return number of cells in use
static void inc(Polycell* ptr);         // increment ref count
static void dec(Polycell* ptr);         // decrement ref count & reclaim if 0

static void report();
virtual ~Polycell();
};


//
// error value
//

class error
{
friend class Poly;

private:
char* msg;

public:
error(char* msg);
operator char*();
error(error &orig);
error & operator=(error &source);
static char* errorPrefix;
};


// hashtable for string Polys

class hashtab
{
public:
static long defaultSize;                 // default size

hashtab();                               // constructor
hashtab(long Size);                      // constructor, number of buckets
entry* search(char* symbol, entry* ptr);
int ensure(char* symbol, char* &value);  // ensure there is a value
void dump(ostream &out);                 // for debugging purposes

static unsigned long hash(char *str);    // hashing function

private:
entry* *bucket;                          // the hash table
long size;                               // number of buckets
void init(long Size);                    // initializing procedure
};  // class hashtab


//
// isTrue returns 1 if Poly is interpreted as true in rex
//

int isTrue(Poly arg);


//
// isFalse returns 1 if Poly is interpreted as false in rex
//

int isFalse(Poly V);


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

Poly deepType(Poly p);


// convenience functions; these are the same as static functions of the
// same name in classes such as Polylist or Poly,
// but are defined globally so that the class qualification does not
// have to be used.  They can be removed if desired.

Poly deepCopy(Poly p);
Polylist from(Poly m);
Polylist from(Poly m, Poly inc);
Polylist range(Poly M, Poly N);
Polylist range(Poly M, Poly N, Poly I);

// Polylist functions

int isEmpty(const Polylist & L);     // return 1 if null list
int nonEmpty(const Polylist & L);    // return 1 if not null list
Poly & first(const Polylist & L);    // return (reference to) first of list
Polylist rest(const Polylist & L);   // return rest of list

// list utility functions

char* implode(Polylist L);           // string from elements of list

Polylist explode(Poly P);            // list of characters from Poly

Polylist prefix(long i, Polylist L);


// Functions which don't correspond to methods

Polylist cons(const Poly & First, const Poly & Rest); // cons function
Poly max(Poly arg1, Poly arg2);
Poly min(Poly arg1, Poly arg2);


// build list with number of arguments
Polylist list();
Polylist list(const Poly &a);
Polylist list(const Poly &a, const Poly &b);
Polylist list(const Poly &a, const Poly &b, const Poly &c);
Polylist list(const Poly &a, const Poly &b, const Poly &c, const Poly &d);

Polylist list(const Poly &a, const Poly &b, const Poly &c, const Poly &d, 
              const Poly &e);

Polylist list(const Poly &a, const Poly &b, const Poly &c, const Poly &d, 
              const Poly &e, const Poly &f);

Polylist list(const Poly &a, const Poly &b, const Poly &c, const Poly &d, 
              const Poly &e, const Poly &f, const Poly &g);

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);

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);

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);

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); 

// extract from list second, third, ....
Poly & second(const Polylist & L);

Poly & third(const Polylist & L);

Poly & fourth(const Polylist & L);

Poly & fifth(const Polylist & L);

Poly & sixth(const Polylist & L);

Poly & seventh(const Polylist & L);

Poly & eighth(const Polylist & L);

Poly & ninth(const Polylist & L);

Poly & tenth(const Polylist & L);

// build array with number of arguments
Polyarray array(long N, Poly init[]);
Polyarray array();
Polyarray array(const Poly &a);
Polyarray array(const Poly &a, const Poly &b);
Polyarray array(const Poly &a, const Poly &b, const Poly &c);
Polyarray array(const Poly &a, const Poly &b, const Poly &c, const Poly &d);

Polyarray array(const Poly &a, const Poly &b, const Poly &c, const Poly &d, 
                const Poly &e);

Polyarray array(const Poly &a, const Poly &b, const Poly &c, const Poly &d, 
                const Poly &e, const Poly &f);

Polyarray array(const Poly &a, const Poly &b, const Poly &c, const Poly &d, 
                const Poly &e, const Poly &f, const Poly &g);

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 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 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 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 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); 


// 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.

// return type of Poly

Poly type(Poly p);

// append one Polylist to another non-destructively
Poly append(Poly L, Poly M);

// reverse Polylist non-destructively
Polylist reverse(const Polylist & L);

// length of a list
long length(const Polylist & L);

Polylist find(Poly pred, Polylist L);   // see if member satisfies pred
Polylist drop(Poly pred, Polylist L);   // drop members satisfying pred
Polylist keep(Poly pred, Polylist L);   // keep members satisfying pred
Polylist map(Poly fun, Polylist L);     // map a function
Poly foldr(Function2 fun, Poly unit, Polylist L);
Poly foldl(Function2 fun, Poly unit, Polylist L);
int member(Poly item, Polylist L);      // see if member occurs
Polytype type(const Poly & p);  // returns contained type of Poly

// Functions

int atomic(Poly p)  ;          // same as !isAggregate
int isAggregate(Poly p);       // return 1 if arg is a list or array
int isArray(Poly p);           // return 1 if arg is an array, 0 otherwise
int isChar(Poly p);            // return 1 if arg is a char, 0 otherwise
int isList(Poly p);            // return 1 if arg is a list, 0 otherwise
int isFloating(Poly p);        // return 1 if arg is floating, else 0
int isInteger(Poly p);         // return 1 if arg is integer, else 0
int isNumeric(Poly p);         // tell whether argument is numeric
int isString(Poly p);          // return 1 if arg is a string, 0 o.w.
int nonList(Poly p);           // return 1 if arg is not a list, 0 o.w.
Poly makeFloating(Poly x);
Poly makeInteger(Poly x);
Poly makeString(Poly x);

// arithmetic on Polys

Poly add(Poly arg1, Poly arg2);
Poly cat(Poly arg1, Poly arg2);
Poly multiply(Poly arg1, Poly arg2);
Poly subtract(Poly arg1, Poly arg2);
Poly divide(Poly arg1, Poly arg2);

// various constants, etc.

extern Polylist nil;
extern Polylist NIL;
extern Seed nullSeed;
extern Fclosure nullFclosure;
extern Sclosure nullSclosure;
extern Oclosure nullOclosure;
extern hashtab table;

#define __POLYA_H__
#endif

