/* Implement methods for expressions.  This is -*- C++ -*-.
   Copyright (C) 1992 Per Bothner.

This file is part of Q.

Q is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.

Q is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with GNU CC; see the file COPYING.  If not, write to
the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */

#pragma implementation
#include <strstream.h>
#include "genob.h"
#include "symbol.h"
#include "expression.h"
#include "exceptions.h"
#include "genmap.h"
#include "mapping.h"
#include "loopcons.h"
#include "std.h"
#include "gkinds.h"
#include "gassign.h"
#include "genfiles.h"
#include "traverse.h"
#include "gvars.h"
#include "gfiles.h"
#include "gennum.h"
#include <parsefile.h>
//#include "format.h"
#include "tempbuf.h"
#include "ifthenelse.h"
#include "shell.h"
#include "evalprocs.h"
#include "builtin-syms.h"
#include "modules.h"
#include <stddef.h>
#include <sys/types.h>
#include <sys/stat.h>
#include "vtablename.h"

extern Expr *QuotedDivideOp; 
extern "C" char *tilde_expand (char*);
EXTERN RootPtr Becomes(RootPtr, RootPtr);
EXTERN void PrintQuotedWord(char *str, int len, FILE *, int quoteAll);
/* Evaluation routines */

#if 0
char * Expression::string(struct DisplayEnv *env = NULL, int flags = 0)
{
    char buf[30];
    sprintf(buf, "<Bad expr type:%d>", code());
    return strdup(buf);
}
#endif

// Convert a single string to a list of strings.
// Use '\n' to split.
// At least one string in result, even if input is "".

StringList *String2Strings(char* arg, int free_arg = 1)
{
    if (arg == NULL)
	return NULL;
    TempPtrBuf strs_buf;
    char *line_start = arg;
    register char *ptr = arg;
    for (;; ptr++) {
	if (*ptr == 0) {
	    strs_buf.putp(NewString(ptr-line_start, line_start));
	    break;
	}
	else if (*ptr == '\\') ptr++;
	else if (*ptr == '\n') {
	    *ptr = 0;
	    strs_buf.putp(NewString(ptr-line_start, line_start));
	    line_start = ptr+1;
	    if (*line_start == 0)
		break;
	}
    }
    if (free_arg)
	free(arg);
    return (StringList*)NewVector(strs_buf.count(), (Root**)strs_buf.base());
}

char * Strings2String(StringList *args)
{
    int count = StringsLen(args);
    int tot_len = 0;
    int i;
    StringC **ptr;
    for (i = count, ptr = StringsPtr(args); --i >= 0; ++ptr) {
	tot_len += (*ptr)->leng();
    }
    char *str = (char*)malloc(count + tot_len);
    char *cur_dest = str;
    for (i = count, ptr = StringsPtr(args); --i >= 0; ++ptr) {
	int cur_len = (*ptr)->leng();
	memcpy(cur_dest, (*ptr)->chars(), cur_len);
#ifndef DO_GC
	delete (*ptr);
#endif
	cur_dest += cur_len;
	*cur_dest++ = ' ';
    }
    cur_dest[-1] = '\0';
#ifndef DO_GC
    delete args;
#endif
    return str;
}

void CoerceStringListExpr::eval(void* dst, Type* dstType, DisplayEnv *env)
{
    // Inefficient if arg is already a StringList or dstType==&Text !
    ostrstream dest;
    Root *result;
    long save_print_lisp = print_lisp;
    long save_print_readable = print_readable;
    print_lisp = 0;
    print_readable = 0;
    result = coercee.eval(env);
    if (result != Missing) {
	dest << *result;
	print_lisp = save_print_lisp;
	print_readable = save_print_readable;
	dest << '\0';
	StringList *strs = String2Strings(dest.str(), 0);
	dest.freeze(0);
	result = strs;
    }
    dstType->coerceFromRoot(dst, result);
}

Expression * Expression::quote_words(TraverseData * /* = NULL*/)
{
    char buf[30];
    sprintf(buf, "<Bad expr type:%d>", code());
    StringC *str = NewString(strlen(buf), buf);
    return DoQuote(NewVector(1, (Root**)&str));
}

Expression * UnquoteExpr::quote_words(TraverseData *data /* = NULL*/)
{
    return GC_NEW CoerceStringListExpr(data ? arg.E->traverse(data) : arg.E);
}

void Expression::eval(void* dst, Type* dstType, struct DisplayEnv *env)
{
#if 1
    cerr << "Bogus or obsolete expression type: " << code() << "\n";
    cerr.flush();
    abort();
#else
    dstType->coerceFromRoot(dst, eval(env));
#endif
}

void PrintResult(Root* val, ostream& outs)
{
#ifdef __HAVE_COLUMN
    outs << *val;
#else
    GenSeq* seq = val->sequence();
    if (seq == NULL)
	outs << *val << '\n';
    else {
	// Similar to GenMap::printon
	ITERATOR(iter, seq);
	int i = 0;
	int prevWasChar = 0;
	int prevWasMap = 0;
	for (;; i++) {
	    Root* v = iter.next();
	    if (v == Missing) break;
	    int curIsChar = IsCharacter(v);
	    int curIsMap = v->mapping() != NULL;
	    if (i)
		if (curIsMap && prevWasMap) outs << (char)print_list_separator;
		else if (!prevWasChar)
		    outs << ' ';
	    prevWasChar = curIsChar;
	    prevWasMap = curIsMap;
	    outs << *v;
	}
	if (i > 0 && !prevWasChar)
	    outs << '\n';
    }
#endif
}

#if 0
char *ExprQuote::string(struct DisplayEnv *env = NULL, int flags = 0)
{
    if (text) return strdup(text);
    const StringC * str = ((Root*)quotee.addr)->asString();
    if (str == NULL) return NULL;
    return strdup(str->chars());
}
#endif

Expression * ExprQuote::quote_words(TraverseData * /*= NULL*/)
{
    char *cstr;
    if (text)
	cstr = text;
    else {
	const StringC * str = ((Root*)quotee.addr)->asString();
	if (str == NULL) return NULL;
	cstr = str->chars();
    }
    return DoQuote(String2Strings(cstr, 0));
}

Expression * ExprQuoteOp::quote_words(TraverseData * /*= NULL*/)
{
    return DoQuote(String2Strings(text, 0));
}

static void
EvalWordsToStrings(struct StringPair *spBuf,
		   ExprList *lexpr, struct DisplayEnv * env)
{
    struct StringPair *sp;
    Expr_Ptr *eptr = lexpr->arg;
    long save_print_list_separator = print_list_separator;
    print_list_separator = ' ';
    for (sp = spBuf; *eptr != NULL; eptr++, sp++) {
	RootPtr val = eptr->eval(env);
	VString(val, &sp->data, &sp->length);
    }
    sp->set_done();
    print_list_separator = save_print_list_separator;
}

static int StringsLength(struct StringPair *spBuf)
{
    int length = 0;
    register struct StringPair *sp = spBuf;
    for ( ; !sp->done(); sp++) length += sp->length;
    return length;
}

static char *StringsConcat(char *result, struct StringPair *spBuf)
{
    register struct StringPair *sp = spBuf;
    register char *ptr = result;
    for ( ; !sp->done(); sp++) {
	memcpy(ptr, sp->data, sp->length);
	ptr += sp->length;
    }
    return result;
}

#if 0
char* WordExpr::string(DisplayEnv *env = NULL, int flags = 0)
{
#if 1
    return Strings2String(strings(env, flags));
#else
    struct StringPair *spBuf =
	alloca((length+1) * sizeof(struct StringPair));
    struct StringPair *sp;
    Expr_Ptr *eptr = arg;
    for (sp = spBuf; *eptr != NULL; eptr++, sp++) {
	sp->data = eptr->E->string(env, flags);
	sp->length = strlen(sp->data);
    }
    sp->set_done();
    char *sym = (char*)malloc(StringsLength(spBuf) + 1);
    char *sptr = sym;
    for (sp = spBuf ; !sp->done(); sp++) {
	bcopy(sp->data, sptr, sp->length);
	free(sp->data);
	sptr += sp->length;
	*sptr++ = ' ';
    }
    sptr[0] = '\0';
    return sym;
#endif
}
#endif

static Vector *space_str_vec = NULL;
static Vector *lbrack_str_vec = NULL;
static Vector *rbrack_str_vec = NULL;

Expression * ListConsExpr::quote_words(struct TraverseData *data)
{
#if 1
    if (space_str_vec == NULL) {
	Root *tmp;
	tmp = &space_str; space_str_vec = NewVector(1, &tmp);
	tmp = &lbrack_str; lbrack_str_vec = NewVector(1, &tmp);
	tmp = &rbrack_str; rbrack_str_vec = NewVector(1, &tmp);
    }
    QuotedWordListExpr *words = GC_NEW QuotedWordListExpr(2*length+1);
    Expr_Ptr *ptr = words->arg;
    *ptr++ = DoQuote(lbrack_str_vec);
    for (int i = 0; i < length; i++) {
	if (i > 0)
	    *ptr++ = DoQuote(space_str_vec);
	*ptr++ = arg[i].E->quote_words(data);
    }
    *ptr++ = DoQuote(rbrack_str_vec);
    words->flags = ExprOneWord;
    return words;
#else
    struct StringPair *spBuf =
	alloca((length+1) * sizeof(struct StringPair));
    struct StringPair *sp;
    int count = 0;
    Expr_Ptr *eptr = arg;
    for (sp = spBuf; *eptr != NULL; eptr++, sp++, count++) {
	sp->data = eptr->E->string(env, flags);
	sp->length = strlen(sp->data);
    }
    sp->set_done();
    count += StringsLength(spBuf) + 2; // Needed buffer size.
    char *sym = (char*)malloc(count);
    char *sptr = sym;
    *sptr++ = '[';
    for (sp = spBuf ; !sp->done(); sp++) {
	bcopy(sp->data, sptr, sp->length);
	free(sp->data);
	sptr += sp->length;
	*sptr++ = ' ';
    }
    sptr[-1] = ']';
    sptr[0] = '\0';
    return sym;
#endif
}

Expression * MakeStringExpr::quote_words(struct TraverseData *data)
{
    Expr_Ptr *ptr;
    if (data)
	for (ptr = arg; *ptr; ptr++)
	    *ptr = ptr->traverse(data);
    add_quotes = 1;
    for (ptr = arg; *ptr; ptr++) {
	if (ptr->code() != ExprQuote_code)
	    return this;
    }
    return DoQuote(eval_quote((DisplayEnv*)0));
}

StringList *MakeStringExpr::eval_quote(struct DisplayEnv *env)
{
#ifdef __GNUC__
    StringPair spBuf[length+1];
#else
    StringPair *spBuf
      = *StringPair*)alloca((length+1) * sizeof(struct StringPair));
#endif
    EvalWordsToStrings(spBuf, this, env);
    struct StringPair *sp;
    ostrstream dest;
    dest << '\"';
    for (sp = spBuf; !sp->done(); sp++) {
	PrintQuotedInterior(sp->data, sp->length, dest);
	free(sp->data);
    }
    dest << '\"';
    StringC *str = NewString(dest.pcount(), dest.str());
    dest.freeze(0);
    return NewVector(1, (Root**)&str);
}

void MakeStringExpr::eval(void* dst, Type* dstType, struct DisplayEnv *env)
{
    if (add_quotes) {
	dstType->coerceFromRoot(dst, eval_quote(env));
	return;
    }
#ifdef __GNUC__
    StringPair spBuf[length+1];
#else
    StringPair *spBuf = (StringPair*)alloca((length+1) * sizeof(StringPair));
#endif
    EvalWordsToStrings(spBuf, this, env);
    int length = StringsLength(spBuf);
    StringC * str = NewString(length);
    StringsConcat((char*)str->chars(), spBuf);
    for (StringPair* sp = spBuf; !sp->done(); sp++) free(sp->data);
    dstType->coerceFromRoot(dst, str);
}

#if 0
char *MakeStringExpr::string(struct DisplayEnv *env = NULL, int flags = 0)
{
    struct StringPair *spBuf = alloca((length+1) * sizeof(struct StringPair));
    EvalWordsToStrings(spBuf, this, env);
    struct StringPair *sp;
    if (flags & EString_Quote) {
	for (sp = spBuf; !sp->done(); sp++) {
    	    register char *ptr;
	    char *new_str = (char*)malloc(2 * sp->length + 1);
	    register char *dptr = new_str;
	    for (ptr = sp->data; *ptr; ptr++) {
		*dptr++ = '\\';
		*dptr++ = *ptr;
	    }
	    *ptr = 0;
	    free(sp->data);
	    sp->data = new_str;
	    sp->length *= 2;
	}
    }
    int length = StringsLength(spBuf);
    char *sym = malloc(length+1);
    StringsConcat(sym,spBuf);
    sym[length] = '\0';
    for (sp = spBuf; !sp->done(); sp++) free(sp->data);
    return sym;
}
#endif

Expression * Identifier::quote_words(struct TraverseData * /* = NULL*/)
{
    if (ExprCodeOf(this) != Identifier_code) abort();
    int len = symbol()->length();
    register char *ptr;
    int n_quoted = 0;
    register int i;
    if (quoted_chars) {
	for (i = len, ptr = quoted_chars; --i >= 0; )
	    if (*ptr++) n_quoted++;
    }
    StringC *str = NewString(len+n_quoted);
    ptr = str->chars();
    for (i = 0; i < len; i++) {
	if (quoted_chars && quoted_chars[i])
	    *ptr++ = '\\';
	*ptr++ = symbol()->string()[i];
    }
    StringList *strs = NewVector(1);
    StringsPtr(strs)[0] = str;
    return DoQuote(strs);
}

#if 0
char * Identifier::string(struct DisplayEnv *env = NULL, int flags = 0)
{
    if (ExprCodeOf(this) != Identifier_code) return NULL;
    int len = symbol()->length();
    register char *ptr;
    int n_quoted = 0;
    register int i;
    if (quoted_chars) {
	for (i = len, ptr = quoted_chars; --i >= 0; )
	    if (*ptr++) n_quoted++;
    }
    char *copy = malloc(len+n_quoted+1);
    ptr = copy;
    for (i = 0; i < len; i++) {
	if (quoted_chars && quoted_chars[i])
	    *ptr++ = '\\';
	*ptr++ = symbol()->string()[i];
    }
    *ptr = 0;
    return copy;
}
#endif

// Do a reduction over strs_list (whose length is argc)
// using the outer product of string concatenation.

StringList* ConcatProduct(StringList**strs_list, int argc, int add_parens)
{
    int i;
    int str_count = 1;
    int *strs_count = (int*)alloca(argc * sizeof(int));
    for (i = 0; i < argc; i++) {
	int count = strs_list[i]->leng();
	strs_count[i] = count;
	str_count *= count;
    }
    StringList* strs = NewVector(str_count);
    StringC **strs_ptr = StringsPtr(strs);
    
    // String concatenate all string combination, using an "outer join":
    // First result is concat(strs_list[0][0], ..., strs_list[argc-1][0])
    // then concat(strs_list[0][0], ..., strs_list[argc-1][1])
    // and so on upto:
    // concat(strs_list[0][0], ..., strs_list[argc-1][strs_count[argc-1]])
    // ... continuing thus, ending with:
    // concat(strs_list[0][strs_count[0]], ...,
    //        strs_list[argc-1][strs_count[argc-1]])
    
    int *indexes = (int*)alloca(argc * sizeof(int));
    for (i = argc; --i >= 0; ) indexes[i] = 0;
    for (;;) {
	
	for (i = argc-1; ; ) { // i is index number.
	    if (i < 0) // "Carry" overflow from most-significant index
		goto done; // ... implies we're done with the "join."
	    // Check if index is in range.
	    if (indexes[i] < strs_count[i])
		break;
	    // If index is out of range, do a "carry" to next index "digit"
	    indexes[i] = 0;
	    i--;
	    indexes[i]++; // Bump next index "digit"
	}
	
	// Calculate total length for concatenated string.
	int length = 0;
	for (i = argc; --i >= 0; )
	    length += StringsPtr(strs_list[i])[indexes[i]]->leng();
	if (add_parens) 
	    length += 2;
	StringC* new_str = NewString(length);
	*strs_ptr++ = new_str;
	char *ptr = new_str->chars();
	if (add_parens) 
	    *ptr++ = '(';
	// Now do actual concatenations:
	for (i = 0; i < argc; i++) {
	    StringC *str_i = StringsPtr(strs_list[i])[indexes[i]];
	    strcpy(ptr, str_i->chars());
	    ptr += str_i->leng();
	}
	if (add_parens) 
	    *ptr++ = ')';
	indexes[argc-1]++; // Bump least-significant index.
    }
  done:
    for (i = argc; --i >= 0; ) {
	StringList *strs = strs_list[i];
	StringC **ptr = StringsPtr(strs);
//	for (int j = strs->leng(); --j >= 0; ptr++) delete (*ptr);
//	delete strs;
    }
    return strs;
}

StringList* AppendStringLists(StringList**strs_list, int argc, int add_parens)
{
    int i;
    int str_count = 0;
    int *strs_count = (int*)alloca(argc * sizeof(int));
    for (i = 0; i < argc; i++) {
	int count = strs_list[i]->leng();
	strs_count[i] = count;
	str_count += count;
    }
    StringList* strs = NewVector(str_count);
    StringC **strs_ptr = StringsPtr(strs);
    for (i = 0; i < argc; i++) {
	StringList *strs = strs_list[i];
	int j = StringsLen(strs);
	for (StringC **ptr = StringsPtr(strs);
	     --j >= 0; ptr++) {
	    if (add_parens) {
		int len = (*ptr)->leng();
		StringC *new_str = NewString(len+2);
		sprintf(new_str->chars(), "(%s)",
			(*ptr)->chars());
//		delete *ptr;
		*ptr = new_str;
	    }
	    *strs_ptr++ = *ptr;
	}
//	delete strs;
    }
    return strs;
}

Expression* QuotedWordListExpr::traverse(struct TraverseData *data)
{
    int is_const = 1;
    for (int i = 0; i < length; i++) {
	arg[i] = arg[i].traverse(data);
	if (arg[i].code() != ExprQuote_code)
	    is_const = 0;
    }
    if (!is_const)
	return this;
    return DoQuote(Expression::eval(NULL));
}

void QuotedWordListExpr::eval(void* dst, Type* dstType, DisplayEnv *env)
{
    Root* val;
#if 0
    typedef StringList* StringListPtr;
    StringListPtr& strs_list =
	*(StringList**)alloca(length*sizeof(StringList*));
#else /* Doesn't work with gcc-1.95 */
    StringList * strs_list[length];
#endif
    for (int i = 0; i < length; i++) {
	// The coercion is safe, if we assume that the quote_words
	// transformation always yields Exprs that yield StringLists.
	strs_list[i] = (StringList*)arg[i].eval(env);
    }
    if (one_word())
	val = ConcatProduct(strs_list, length, has_parens());
    else
	val = AppendStringLists(strs_list, length, has_parens());
    dstType->coerceFromRoot(dst, val);
}

Expression* IndexExpr::quote_words(struct TraverseData *data)
{
    StringList * parts[2];
    StringC *str = &quest_str;
    parts[1] = NewVector(1, (Root**)&str);
    
    if (arg[0].E == NullExpr)
	return DoQuote(parts[1]);
    else {
	Expression *quoted_arg = arg[0].E->quote_words(data);
	if (quoted_arg->code() == ExprQuote_code) {
	    parts[0] = (StringList*)((ExprQuote*)quoted_arg)->value();
	    return DoQuote(ConcatProduct(parts, 2, 0));
	}
	else {
	    QuotedWordListExpr *words = GC_NEW QuotedWordListExpr(2);
	    words->arg[0].E = quoted_arg;
	    words->arg[1].E = DoQuote(parts[1]);
	    words->flags = ExprOneWord;
	    return words;
	}
    }
}

Expression * QuoteExprList(Expr_Ptr *arg, int length, int flags,
			   TraverseData *data)
{
    TempPtrBuf words_buf;
    int i;
    int out_length = 0;
    // The most recent quoted_count elements of words_buf
    // are all ExprQuotes. Prefix_count is the number of elements upto
    // the last non-ExprQuote element.
    // The total length of words_buf is prefix_count+quoted_count.
    int prefix_count = 0;
    int quoted_count = 0;
    int has_parens = flags & ExprHasParens;
    int one_word = flags & ExprOneWord;
    Expr_Ptr *ptr;
    for (i = 0; i < length; ) {
	Expr_Ptr new_word;
	new_word.E = arg[i].E->quote_words(data);
	if (new_word.code() == ExprQuote_code) {
	    words_buf.putp(new_word.E);
	    quoted_count++;
	}
	i++;
	if ((i == length || new_word.code() != ExprQuote_code)
	    && quoted_count > 1) {
	    ptr = (Expr_Ptr*)&words_buf.base()[prefix_count];
	    for (int j = 0; j < quoted_count; j++, ptr++) {
		*(StringList**)ptr = (StringList*)(ptr->quote())->value();
	    }
	    ptr = (Expr_Ptr*)&words_buf.base()[prefix_count];
	    ptr->E = DoQuote(one_word ?
			     ConcatProduct((StringList**)ptr,
					   quoted_count, has_parens) :
			     AppendStringLists((StringList**)ptr,
					       quoted_count, has_parens));
	    quoted_count = 1;
	    words_buf.set_size((prefix_count+1)*sizeof(void*));
	}
	if (new_word.code() != ExprQuote_code) {
	    words_buf.putp(new_word.E);
	    prefix_count += quoted_count; // 0 or 1
	    quoted_count = 0;
	    prefix_count++;
	}
    }
    ptr = (Expr_Ptr*)words_buf.base();
    if (prefix_count == 0 && quoted_count == 1)
	return ptr->E;
    prefix_count += quoted_count;
    if (prefix_count == 0)
	return NullExpr;
    QuotedWordListExpr *words = GC_NEW QuotedWordListExpr(prefix_count);
    for (i = 0; i < prefix_count; i++) {
	words->arg[i].E = *ptr++;
    }
    words->flags = flags;
    return words;
}

Root* QuoteMacro(Vector *args)
{
    return QuoteExprList((Expr_Ptr*)args->start_addr(), args->leng(), 0, NULL);
}

Expression * ExprList::quote_words(TraverseData * data /* = NULL*/)
{
    return QuoteExprList(arg, length, flags, data);
}

Expression * ExprNode::quote_words(TraverseData * data /* = NULL*/)
{
    Expr_Ptr pair[2];
    pair[0] = arg;
    pair[1] = func;
    return QuoteExprList(pair, 2, ExprOneWord, data);
}

static Identifier *TildeId = NULL;

Expression * InverseExpr::quote_words(TraverseData * data /* = NULL*/)
{
    Expr_Ptr args[3];
    args[0] = arg;
    if (TildeId == NULL)
	TildeId = NewIdentifier(&Tilde_sym, NULL);
    args[1] = TildeId;
    args[2] = func;
    return QuoteExprList(args, 3, ExprOneWord, data);
}

static Identifier *AtSignId = NULL;

Expression * MakeTupleExpr::quote_words(TraverseData * data /* = NULL*/)
{
    Expr_Ptr args[3];
    args[0] = seq;
    if (AtSignId == NULL)
	AtSignId = NewIdentifier(&AtSign_sym, NULL);
    args[1] = AtSignId;
    args[2].E = right;
    return QuoteExprList(args, right == NULL ? 2 : 3, ExprOneWord, data);
}

#if 0
char * ExprList::string(struct DisplayEnv *env = NULL, int flags = 0)
{
    return Strings2String(strings(env, flags));
}
#endif

extern struct Declaration LookupSpecialDecl[1];
void ExprQuote::eval(void* dst, Type* dstType, struct DisplayEnv *env)
{
    if (quotee.type == NULL || quotee.type == &RefRoot)
	dstType->coerceFromRoot(dst, (Root*)quotee.addr);
    else if (quotee.type == dstType) // && dstType is fixed size! FIXME!
	dstType->copy_object(dst, quotee.addr);
    else
	dstType->coerceFromRoot(dst, quotee.coerceToRoot());
}

void Identifier::eval(void* dst, Type* dstType, struct DisplayEnv *env)
{
#if 1
    Root* val;
    if (decl() == LookupSpecialDecl) {
	if (flags & IdentFuncOnly) {
	    val = symbol()->sym_function();
	    if (!val) {
		fprintf(stderr, "[Unbound function name: %s]\n",
			symbol()->string());
		RaiseDomainError(NULL);
	    }
	}
	else
	    val = LookupSpecial(symbol());
    }
    else if (decl() == NULL) abort();
    else if (decl()->is_const())
	val = (Root*)decl()->get_const();
    else {
	void *frame = decl()->blockLevel == 0 ? NULL
	    : env->env[decl()->blockLevel - env->minLevel];
	val = (Root*)decl()->extractObject(frame);
    }
    dstType->coerceFromRoot(dst, val);
#else
    if (decl == NULL) RaiseDomainError(ident->name);
    if (decl->is_proc() || decl->is_const())
	return Object_TO_Any(decl->type);
    if (decl->token.kind == ConstToken) {
	extern Object LookupLabelToken(struct DataToken*);
	Object ob = LookupLabelToken(&decl->token);
	if (ob != NULL)	return Object_TO_Any(ob);
    }
    RaiseDomainError(ident->name);
#endif
}

DummyExpr::DummyExpr()
{
    name = &UnderScore_sym;
    clear_std_fields(Dummy_code);
}

void DummyExpr::eval(void* dst, Type* dstType, struct DisplayEnv *env)
{
    dstType->coerceFromRoot(dst, AllocVariable(NULL));
}

void DummyExpr::printon(ostream& outs) const { outs << "_"; }

void ProcExpr::eval(void* dst, Type* dstType, struct DisplayEnv *env)
{
    dstType->coerceFromRoot(dst, GC_NEW GFunction((struct Function*)type, NULL));
}

void ExprList::eval(void* dst, Type* dstType, DisplayEnv *env)
{
    if (dstType == &Pipe && arg[1].E == NULL) {
	// FIXME:  Kludge!
	// How about:  If only one arg, and that
	// is is not an identifier or function???
	// I.e., length(arg[*]) == 1.
	arg[0].E->eval(dst, dstType, env);
	return;
    }
    register Expr_Ptr *ptr = arg;
    Root *val = (*ptr++).E->eval(env);
    EvalApply(dst, dstType, val, NULL, ptr, env);
}

void ExprPostfix::eval(void* dst, Type* dstType, DisplayEnv *env)
{
    register Expr_Ptr *ptr = arg;
    Root *first = (*ptr++).E->eval(env);
    Root *next = (*ptr++).E->eval(env);
    EvalApply(dst, dstType, next, first, ptr, env);
}

void InverseExpr::eval(void* dst, Type* dstType, struct DisplayEnv *env)
{
    Root *arg_val = arg.E == NullExpr ? NULL : arg.eval(env);
    Root *func_val = func.eval(env);
    const Functional *f = func_val->functional();
    if (f == NULL)
	f = GC_NEW InverseOp(func_val);
    else
	f = f->inverse();
    if (arg.E == NullExpr)
	dstType->coerceFromRoot(dst, (Root*)f);
    else {
	ArgDesc args(&arg_val, NULL, NULL, NULL, 1, 0, 0);
	((Root*)f)->xapply(dst, dstType, args);
    }
}

void ElseExpr::eval(void* dst, Type* dstType, DisplayEnv * env)
{
    IFV(EvalIfHandler)
	e1.eval(dst, dstType, env);
    THENV
	if (then.E != NULL) then.eval(dst, dstType, env);
	else dstType->coerceFromRoot(dst, &NullSequence);
    ELSEV(EvalIfHandler,Fail)
	e2.eval(dst, dstType, env);
    ENDV
}

void OrExpr::eval(void* dst, Type* dstType, DisplayEnv * env)
{
#if defined(USE_EXCEPTIONS) || defined(USE_LONGJMP)
    Signal(GC_NEW UnimplementedOp("OrExpr::eval", NULL));
#else
#ifdef DO_BACKTRACK
    dstType->coerceFromRoot(dst,
	OR_(EvalOrHandler, struct Any)
	    e1.eval(env)
	ELSE_OR_(EvalOrHandler)
	    e2.eval(env)
	END_OR_);
#else
    Root *(v[2]);
    OrContext *sub_envs = GC_NEW OrContext[2];
    OrContext *save_env = CurrentOrContext;
    IFV(EvalIfHandler1)
	CurrentOrContext = &sub_envs[0];
        v[0] = e1.eval(env);
    THENV ;
    ELSEV(EvalIfHandler1,Fail)
	CurrentOrContext = save_env;
        return e2.eval(env);
    ENDV
    IFV(EvalIfHandler2)
	CurrentOrContext = &sub_envs[1];
        v[1] = e2.eval(env);
    THENV ;
    ELSEV(EvalIfHandler2,Fail)
	CurrentOrContext = save_env;
        return v[0];
    ENDV ;
    CurrentOrContext = save_env;
    dstType->coerceFromRoot(dst, GC_NEW Choice(v, sub_envs, 2));
#endif
#endif
}

void UnifyExpr::eval(void* dst, Type* dstType, struct DisplayEnv *env)
{
    Root *val = &NullSequence;
    if (set == 1) {
	Root * right_val = right.eval(env)->apply_empty();
	void *frame;
	struct Field *fld;
	if (left.code() == ExtractField_code) {
	    ExtractFieldExpr *eleft = (ExtractFieldExpr*)left.E;
	    Root *left_val = eleft->value->eval(env);
	    fld = eleft->field;
	    frame = left_val;
	}
	else if (IdentifierLike(left.E)) {
	    Declaration *decl = left.ident()->decl();
	    frame = env->env[decl->blockLevel-env->minLevel];
	    fld = decl;
	}
	else  RaiseDomainError(NULL);
	if (fld->is_const()) {
	    // old_var is usually a Variable
	    Root *old_var = (Root*)fld->get_const();
	    old_var->unify(*right_val);
	    // Smash old constant with new value
	    fld->set_value(right_val);
	}
	else if (fld->is_proc()) ;
	else
	    SetField(right_val, frame, fld);
    }
    else {
	Root *left_val = left.eval(env);
	Root *right_val = right.eval(env);
	switch (set) {
	  case 0:
//	    left_val->apply_empty()->unify(*right_val->apply_empty());//
	    left_val->unify(*right_val);
	    break;
	  case 2: Assign(left_val, right_val);
	    val = left_val;
	    break;
	  case 3:
	    if (left_val!=right_val) RAISE(Compare_failed, &EQ2_sym);
	  default:
	    ;
	}
    }
    dstType->coerceFromRoot(dst, val);
}

void RedirectOut::eval(void* dst, Type* dstType, struct DisplayEnv *env)
{
    StringList *out_strings = (StringList*)filename->eval(env);
    if (StringsLen(out_strings) != 1)
	RaiseDomainError(0);
    StringC *str = *StringsPtr(out_strings);
    int mode = append ? ios::app : ios::out;
    int old_stderr;
    ofstream out_stream(str->chars(), mode);
    if (!out_stream.rdbuf()->is_open())
	Signal(GC_NEW BadSyscall("Failed to open file % for writing",
			      str->chars(), errno));
    if (stderr_too) {
	cerr.flush();
	fflush(stderr);
	old_stderr = dup(2);
	dup2(1, 2);
    }
    action->eval(&out_stream, &Text, env);
    if (stderr_too) {
	cerr.flush();
	fflush(stderr);
	dup2(old_stderr, 2);
	close(old_stderr);
    }
    out_stream.close();
    dstType->coerceFromRoot(dst, &NullSequence);
}

extern "C" int glob_pattern_p (char *pattern);
void FileName::eval(void* dst, Type* dstType, struct DisplayEnv *env)
{
    char *fname = Strings2String((StringList*)filename->eval(env));
    StringC *str = NULL;
    if (glob_pattern_p(fname)) {
	str = RemoveQuotes(fname);
	fname = str->chars();
    }
    // Emacs-style handling of embedded '/':
    // A filename of the form 'prefix//rest' is simplified to '/rest'.
    for (register char *ptr = fname; *ptr; ptr++) {
	if (ptr[0] == '/' && ptr[1] == '/')
	    fname = ptr+1;
    }
    FileNode *node = GC_NEW FileNode(fname);
#ifndef DO_GC
    delete str;
#endif
    dstType->coerceFromRoot(dst, node);
}

Expression * FileName::quote_words(struct TraverseData *data)
{
    return filename->quote_words(data);
}

void LoadExpr::eval(void* dst, Type* dstType, struct DisplayEnv *env)
{
    Module *mod = module;
    if (module == NULL) {
	StringList *s = (StringList*)filename->eval(env);
	if (StringsCount(s) != 1) {
	    fprintf(stderr, "A 'load' requires only one parameter!\n");
	    RaiseDomainError(0);
	}
	mod = CheckModule(RemoveQuotes(StringsPtr(s)[0])->chars());
    }
    else {
	// mark as evaluated?
    }
    dstType->coerceFromRoot(dst, EvalModule(mod));
}

static Root * EvalListTupled(ListConsExpr *lexpr, struct DisplayEnv *env)
{
    Root **buf = (Root**)alloca((lexpr->length + 1)* sizeof(Root*));
    long *lengths = (long*)alloca(lexpr->length * sizeof(long));
    register Root **bptr = buf; 
    register long *lptr = lengths;
    int totLength = 0;
    int unknowns = 0;
    int currentIsUnknown = -1;
    int segments = 0;
    for (Expr_Ptr *eptr = lexpr->arg; *eptr; eptr++) {
	if (eptr->code() == MakeTuple_code) {
	    Root* val;
	    eptr->bin()->arg[0].eval(&val, &RefRoot, env);
	    GenMap *map = val->mapping();
	    if (map == NULL) {
		if (val->lvariable()) {
		    unknowns++;
		    if (currentIsUnknown <= 0)
			segments++, currentIsUnknown = 1;
		    *bptr++ = val;
		    *lptr++ = -1;
		    continue;
		}
		RaiseDomainError(NULL);
	    }
	    int length = map->length();
	    if (length == 0) continue;
	    *bptr++ = (Root*)map;
	    *lptr++ = length;
	    totLength += length;
	    if (currentIsUnknown != 0) segments++, currentIsUnknown = 0;
	} else {
	    Root *val = eptr->eval(env);
	    *bptr++ = val;
	    *lptr++ = 0;
	    totLength += 1;
	    if (currentIsUnknown != 0) segments++, currentIsUnknown = 0;
	}
    }
    *bptr = 0; // mark end
    if (unknowns) {
	register Root **aptr =
	    totLength ? (Root**)malloc(sizeof(Root*) * totLength) : NULL;
	int size = sizeof(Concatenation) + unknowns * sizeof(LDependency)
	    + segments * sizeof(Root*);
	Concatenation *concat = (Concatenation*)malloc(size);
	concat->Concatenation::Concatenation();
	concat->nSegs = segments;
	concat->ndeps = unknowns;
	concat->knownVars = 0;
	concat->knownLength = totLength;
	concat->segments = (Root**)&concat->dep[unknowns];
	concat->dep = (LDependency*)(concat + 1);
	Root **startSeg = aptr;
	Root **pSeg = concat->segments;
	LDependency *pDep = &concat->dep[0];
	for (lptr = lengths, bptr = buf; ; lptr++, bptr++) {
	    if (!*bptr || *lptr < 0) { // either end of list, or LVariable
		if (startSeg != aptr) {
		    *pSeg++ = GC_NEW OArray(aptr - startSeg, startSeg);
		    startSeg = aptr;
		}
		if (!*bptr) break;
		*pSeg++ = *bptr;
	 	pDep->LDependency::LDependency(concat, *bptr);
		pDep++;
	    }
	    else if (*lptr > 0) { // tupled sequence
		ITERATOR(f, (GenMap*)*bptr);
		for (int i = *lptr; --i >= 0; )
		    *aptr++ = f.next();
	    } else { // single element
		*aptr++ = *bptr;
	    }
	}
	return concat;
    } else {
	Vector *arr = NewVector(totLength);
	register Root **aptr = arr->start_addr();
	for (lptr = lengths, bptr = buf; *bptr; lptr++, bptr++) {
	    if (*lptr) {
		ITERATOR(f, (GenMap*)*bptr);
		for (int i = *lptr; --i >= 0; )
		    *aptr++ = f.next();
	    } else
		*aptr++ = *bptr;
	}
	return arr;
    }
}

void UnquoteExpr::eval(void* dst, Type* dstType, DisplayEnv *env)
{
    struct TraverseData data(DefaultModule);
    Expr *exp;
    Root *val;
    arg.eval(&val, &RefRoot, env);
    char* string;
    size_t string_length;
    VString(val, &string, &string_length);
    exp = ParseString(string, string_length, DefaultModule);
    dstType->coerceFromRoot(dst, 
			    EvalInteractive(exp, &data, DefaultModule));
}

void UnquoteExpr::printon(ostream& outs) const
{
    outs << '$' << arg;
}

#if 0
char * UnquoteExpr::string(struct DisplayEnv *env = NULL, int flags = 0)
{
    Root *val = arg.eval(env);
    char *str;
    size_t len;
    VString(val, &str, &len);
    return str;
}
#endif

void MakeSymbolExpr::eval(void* dst, Type* dstType, DisplayEnv *env)
{
    StringC *str = (StringC*)name->eval(env);
    dstType->coerceFromRoot(dst, EnterSymbol(str->chars(), str->leng()));
}

void ListConsExpr::eval(void* dst, Type* dstType, DisplayEnv *env)
{
    Root *val;
    /* case ListCons_code: */
    if (flags & ConsMapping) {
        extern Object NewSplayMap();
        int index = 0;
	Root **abuf = (Root**)alloca(length * sizeof(Root*));
	Root **vbuf = (Root**)alloca(length * sizeof(Root*));
	register Root **aptr = abuf;
	register Root **vptr = vbuf;
	for (Expr_Ptr *ptr = arg; *ptr; ptr++) {
	    if (ptr->code() == MapPair_code) {
	        *aptr++ = ptr->bin()->arg[0].eval(env);
	        *vptr++ = ptr->bin()->arg[1].eval(env);
	    } else {
	        *aptr++ = (Root*)MakeFixInt(index++);
		*vptr++ = ptr->eval(env);
	    }
	}
	val = GC_NEW SplayMap(length, abuf, vbuf);
    } else if (flags & ConsTupled) {
	val = EvalListTupled(this, env);
    } else {
	if (length == 0)
	    val = &NullSequence;
	else {
	    Vector *a = NewVector(length);
	    register Root **ptr = a->start_addr();
	    for (Expr_Ptr *eptr = arg; *eptr; eptr++)
		*ptr++ = eptr->eval(env);
	    val = a;
	}
    }
    dstType->coerceFromRoot(dst, val);
}


void UnionExpr::eval(void* dst, Type* dstType, DisplayEnv *env)
{
    abort();
}

Root * AllocGenVar(struct Declaration *decl)
{
    if (decl->_loop_nesting) {
	return GC_NEW MemoSeq(&AllocLogicalCmd, 0);
    } else
	return AllocVariable(decl->name);
}

void AllocVars(struct Declaration *decl_list, void *data)
{
    register struct Declaration *decl;
    for (decl = decl_list ; decl != NULL; decl = decl->next())
	if (decl->must_allocate() & decl->indirection != IsConst)
	    if (decl->kind != Pointer_Field) abort();
	    else
		*(Root**)((char*)data + decl->get_offset())
		    = AllocGenVar(decl);
}

void Block::eval(void* dst, Type* dstType, struct DisplayEnv *env)
{
    register struct Statement *st;
    void *record = NULL;
    struct DisplayEnv *display = env;
    if (decls.first == NULL) { }
    else if (flags & BlockIsGlobal) { }
    else if ((flags & BlockReturnSelf) == 0) {
	record = alloca(size);
	display->env[level - display->minLevel] = record;
    }
    else if (flags & BlockGivenResult) {
	record = display->env[level - display->minLevel];
    }
    else {
	const struct Type *t = val_type();
	if (t == dstType)
	    record = dst;
	else if (t->kind == RecordTypeKind)
	    record = (char*)((RecordType*)t)->alloc()/* + 4*/;
	else
	    abort();
	display->env[level - display->minLevel] = record;
    }
    AllocVars(decls.first, record);

    // result stream is only used if we actually need to concatenate strings.
    // In that case save is NULL. Otherwise, result is NULL.
    Root *save = &NullSequence;
    ostrstream *result = NULL;
    int print_as_we_go = !combiner && dstType == &Text && record==NULL;

    for (st = first; st != NULL; st = st->next) {
	if (st->kind == ForgetStatement) continue;
	if (st->kind == MethodStatement) continue;
	Root *val;
	if (print_as_we_go) {
	    st->src.E->eval(dst, &Text, display);
	    continue;
	}
	else {
	    val = st->src.E->eval(display);
	}
	val = val->apply_empty();
	if (combiner) // E.g. Lisp progn
	    save = val;
	else if (val == &NullSequence) { } // Do Nothing.
	else if (val == Missing) {
	    // FIXME:  Should append MISSING, and then return?
	    // For consistency with when dstType==&Text ?
	    dstType->coerceFromRoot(dst, val);
	    return;
	}
	else if (save == &NullSequence)
	    save = val;
	else {
	    // Concatenate to previous results.
	    int save_print_readable = print_readable;
	    print_readable = 0;
	    if (!result)
		result = new ostrstream;
	    if (save != &NullSequence && save != NULL)
		PrintResult(save, *result);
	    save = NULL;
	    PrintResult(val, *result);
	    print_readable = save_print_readable;
	}
    }
    if (result) {
	save = NewString(result->pcount(), result->str());
	result->freeze(0);
	delete result;
    }
    if ((flags & BlockReturnSelf+BlockIsGlobal) == BlockReturnSelf) {
	save = (Root*)record;
    }
    if (!print_as_we_go)
	dstType->coerceFromRoot(dst, save);
}

void BindRecordType(Block *closure, const RecordType *super)
{
    if (super == NULL)
      {
	super = (RecordType*)Record::desc();
	if (super->instanceVTable == NULL)
	  {
#ifdef __GNUG__
#if VTABLE_LABEL_HAS_LENGTH
	    extern char RecordVTable[] asm(VTABLE_LABEL_PREFIX "6Record");
#else
	    extern char RecordVTable[] asm(VTABLE_LABEL_PREFIX "Record");
#endif
	    *(char**)&super->instanceVTable = RecordVTable;
#else
	    /* Semi-portable kludge to extract Record's vtable. */
	    Record dummy;
	    *(void**)&super->instanceVTable = *(void**)&dummy;
#endif
	  }
      }
    RecordType* rType = super->new_subclass(NULL);

    // Add a dummy field for 'super' (the inherited super-object).
    Declaration* decl0 = Symbol2Declaration(&SUPER_sym);
    rType->desc->fields = decl0;
    decl0->setPrivacy(IsPrivate);
    decl0->type = (RecordType*)super;
    decl0->indirection = IsField;
    decl0->kind = Include_Field;
    decl0->size = super->inst_size;
    decl0->flags &= ~ImplicitDeclMask; decl0->flags |= SetDeclaration;
    closure->decls.add_front(decl0);
    closure->flags |= BlockReturnSelf;
    closure->rtype = rType;
}

struct Declaration * Symbol2Declaration(Symbol *symbol)
{
    register struct Declaration *decl = GC_NEW Declaration();
    decl->name = symbol;
    decl->size = Unknown_SizeCode; decl->kind = 0;
    decl->useCount = 1;
    decl->dummyNextField.set_fchain(NULL);
/*  decl->sameName = NULL; */
    decl->defining = NULL;
    decl->flags = 0;
    decl->ftype() = NULL;
    decl->loop_nesting() = 0;
    decl->tr_link = 0;
/*     decl->blockLevel = 0; calculated during traverse */
    return decl;
}

struct Identifier * NewIdentifier(Symbol *name, struct ParseFile *ff)
{
    if (name == &UnderScore_sym) {
	return GC_NEW DummyExpr();
    }
    struct Identifier *id = GC_NEW Identifier;
    id->quoted_chars = NULL;
    id->name = name;
    id->decl() = 0;
    if (ff == NULL) {
	id->next = NULL;
    }
    else {
#if 0
	if (ff->terminators & ParseLParenSinceSpace) id->v.nesting = 0;
	else id->v.nesting = ff->nesting;
	id->flags |= IdentNesting;
#endif
	id->next = ff->identifiers; ff->identifiers = id;
    }
    return id;
}

struct Identifier * Decl2Ident(struct Declaration *decl)
{
    struct Identifier *id = NewIdentifier(decl->name, NULL);
    id->v.decl = decl;
    id->flags |= LastfixProtect;
    return id;
}

struct ExprNode *NewExprNode(Expr *arg, Expr *func)
{
    register struct ExprNode *expr = GC_NEW ExprNode;
    expr->clear_std_fields(ExprNode_code);
    expr->type = ExTypePtr;
    expr->flags = 0;
    expr->arg.E = arg;
    expr->func.E = func;
    expr->postfix = 0;
    if (func && ExprCodeOf(func) == ExprQuote_code)
	if (((ExprQuote*)func)->force_postfix)
	    expr->postfix = 1;
    return expr;
}

#if 1
Expr * NewBindExpr(Expr *name, Expr *val)
{
#if 1
    struct MapPairExpr *expr = GC_NEW MapPairExpr();
    expr->arg[0].E = name;
    expr->arg[1].E = val;
#else
    register struct BindExpr *expr =
	(struct BindExpr*)AllocGen(ExprNode, sizeof(struct BindExpr));
    expr->clear_std_fields(BindExpr_code);
    expr->type = ExTypePtr;
    expr->flags = 0;
    expr->name.E = name;
    expr->val.E = val;
#endif
    return (Expr*)expr;
}
#else
struct ExprNode *
NewNamedNode(Expr *func, Name name, Expr *arg)
{
    register struct ExprNode *expr = GC_NEW ExprNode;
    expr->clear_std_fields(ExprNode_code);
    expr->type = ExTypeAny;
    expr->flags = 0;
    expr->arg.E = func;
    expr->func.E = arg;
    expr->name = name;
    expr->postfix = 3;
    return expr;
}
#endif

Block::Block(struct Block *outer) : Expression(Block_code), decls()
{
    first = NULL;
    last = &first;
    size = 0;
    enclosing = outer;
    rtype = NULL;
    type = NULL;
    level = 0;
    combiner = 0;
    coercion = NULL;
    if (outer == NULL) {
	flags |= BlockIsGlobal;
	globalName = NULL;
    }
    else
	globalName = outer->globalName;
}

ExprQuote::ExprQuote(struct Any object)
{
    clear_std_fields(ExprQuote_code);
    flags |= ExprAtMostOneResult+ExprCannotFail;
    quotee = object;
    type = ExTypePtr;
    text = NULL;
    force_postfix = 0;
}

ExprQuote::ExprQuote(Root *value)
{
    clear_std_fields(ExprQuote_code);
    flags |= ExprAtMostOneResult+ExprCannotFail;
    quotee = MAKE_ANY(value, &Root_classDesc);
    type = ExTypePtr;
    text = NULL;
    force_postfix = 0;
}

struct ExprQuote *DoQuote(void * object)
{
    return GC_NEW ExprQuote((Root*)object);
}

struct OrExpr *MakeOrNode(Expr *e1, Expr *e2)
  { struct OrExpr *ee = GC_NEW OrExpr;
    ee->clear_std_fields(ElseExpr_code);
    ee->handlerCount = 1;
    ee->kind = 1;
/*    ee->exception[0] = (struct ExceptionClass*)Fail; */
    ee->e1 = e1;
    ee->then = (Expr*)NULL;
    ee->e2 = e2;
    return ee;
  }

struct ElseExpr *MakeElseNode(Expr *e1, Expr *e2)
  { struct ElseExpr *ee = GC_NEW ElseExpr;
    ee->clear_std_fields(ElseExpr_code);
    ee->handlerCount = 0;
    ee->kind = 1;
/*    ee->exception[0] = (struct ExceptionClass*)Fail; */
    ee->e1 = e1;
    ee->then = (Expr*)NULL;
    ee->e2 = e2;
    return ee;
  }

ExprList::ExprList(int len /*= -1*/, Expr_Ptr* exprs /*= NULL*/)
{
    clear_std_fields(ExprList_code);
    length = len;
    if (exprs == NULL && len != -1) {
      exprs = (Expr_Ptr*)GC_malloc(sizeof(Expr_Ptr) * (len+1));
	exprs[len].E = NULL;
    }
    arg = exprs;
}

QuotedWordListExpr::QuotedWordListExpr(int len /*= -1*/, Expr_Ptr* exprs /*= NULL*/)
{
    clear_std_fields(QuotedWordList_code);
    length = len;
    if (exprs == NULL && len != -1) {
      exprs = (Expr_Ptr*)GC_malloc(sizeof(Expr_Ptr)*(len+1));
	exprs[len].E = NULL;
    }
    arg = exprs;
}

ExprPostfix::ExprPostfix(int len /*= -1*/, Expr_Ptr* exprs /*= NULL*/)
{
    clear_std_fields(ExprPostfix_code);
    length = len;
    if (exprs == NULL && len != -1) {
        exprs = (Expr_Ptr*)GC_malloc(sizeof(Expr_Ptr)*(len+1));
	exprs[len].E = NULL;
    }
    arg = exprs;
}

RedirectOut::RedirectOut(Expr *fname, Expr *actn)
{
    clear_std_fields(RedirectOut_code);
    filename = fname;
    action = actn;
    append = 0;
    stderr_too = 0;
    fd = 1;
}

FileName::FileName(Expr *fname)
{
    clear_std_fields(FileName_code);
    filename = fname;
}

UnifyExpr::UnifyExpr(Expr *e1, Expr *e2, int kind = 0)
{
    clear_std_fields(UnifyExpr_code);
    set = kind;
    left.E = e1;
    right.E = e2;
}

struct ExprStdOp * AllocStdOp(enum ExprCode code, int n)
{
    if (n > 2) abort();
    struct ExprStdOp *expr = GC_NEW ExprStdOp();
    expr->clear_std_fields(code);
    return expr;
}

ProcExpr::ProcExpr(Block *body)
{
  clear_std_fields(ProcExpr_code);
  expr = body;
  flags = ExprAtMostOneResult|ExprCannotFail|ProcHasNotBeenTraversed;
#if 0
  flags |= ProcCompatibleWithC;
  leftArg = NULL;
  rightArg = NULL;
  auxArg = NULL;
#endif
  chain = NULL;
  clause = NULL;
  paramDecls = NULL;
  context = NULL;
  argList = NULL;
  nParams = 0;
  for (int i = 3; --i >= 0; )
    {
      pn[i].required = 0;
      pn[i].optional = 0;
      pn[i].tuple = 0;
    }
  procKind = ' ';
  lisp_body = NULL;
  code_label = NULL;
}

#if 0
extern "C" struct Any PrefixApplyAll(struct Any val, struct ExList exprs)
{
 /* essentially OBSOLETE */
    extern void *VPrefix(void *, struct ExList);
    return MAKE_ANY(((Root*)val.addr)->apply(&NullSequence, exprs), NULL);
}
#endif

/* Traversal routines */

Expr * ExprTraverse(register Expr * p, register struct TraverseData *data)
{
    return p->traverse(data);
}

#if 0
static Expr *
ConvertFunctionCall(
    struct ExprList *expr,
    struct TraverseData *data,
    struct Function *func)
{
    Expr_Ptr *ptr, *rest = NULL;
    int n = func->nParams, i, nCall;
    register struct ExprCall *call;
    for (ptr = expr->arg + 1;;) {
	Expr_Ptr cur = *ptr++;
	if (!PointerIsMarked(cur.E)) {
	    n--;
	    if (n < 0) { rest = ptr; break; }
	}
	else if (cur.E == EndExL || cur.E == ExitExL)
	    break;
	else
	    continue; /* name */
    }
    nCall = n < 0 ? func->nParams : func->nParams - n;
    call = AllocExprCall(nCall, NULL);
    for (i = 0, ptr = expr->arg + 1; i < nCall;) {
	Expr_Ptr cur = *ptr++;
	if (!PointerIsMarked(cur.E))
	    call->arg[i++] = cur;
	else if (cur.E == EndExL || cur.E == ExitExL)
	    break;
	else
	    continue; /* name */
    }
    call->kind = 9;
    call->proc.fcall =
	(struct FunctionCall*)malloc(sizeof(struct FunctionCall));
    call->proc.fcall->func = func;
    call->proc.fcall->unnamedParams = nCall;
    if (func->nClauses != 1) call->type = ExTypeAny;
    else {
	struct Clause *clause = &func->clauses[0];
	if (clause->result)
	    call->type = MakeExType(ExDirectType, clause->resultType);
	else
	    call->type = MakeExType(ExPointerType, clause->resultType);
    }

if (rest != NULL) fprintf(stderr, "[Too many args]\n");
else return call;
    return expr;
}
#endif

ExprQuoteOp BottomOp("BOTTOM", NULL, 999, 1000);

FileName* CheckFilePath(ExprList* exp, TraverseData *data)
{
    // Look for /.. or IDENT/... (or FUTURE:  ~IDENT/...)
    if (!(exp->flags&ExprOneWord))
	return NULL;
    if (exp->length < 2)
	return NULL;
    if (exp->arg[0].E == QuotedDivideOp)
	return GC_NEW FileName(exp->quote_words());
    if (exp->arg[1].E != QuotedDivideOp)
	return NULL;
    if (exp->arg[0].code() != Identifier_code)
	return NULL;
    exp->arg[0].E = exp->arg[0].ident()->traverse1(data);
    if (exp->arg[0].code() != Identifier_code)
	return NULL;
    else if (exp->arg[0].ident()->decl() != NULL)
	    return NULL;
    struct stat stat_buf;
    if (stat (exp->arg[0].ident()->symbol()->chars(), &stat_buf) != 0
	|| !S_ISDIR(stat_buf.st_mode))
	return NULL;
    
    // We've now established that IDENT is undeclared, and names a directory.

    return GC_NEW FileName(exp->quote_words());
}

char* check_executable_filename(FileName *fname, TraverseData *data)
{
    char *cname;
    Expr* quoted = fname->filename;
    if (quoted->code() != ExprQuote_code)
	return NULL;
    StringList *slname = (StringList*)quoted->eval(NULL);
    if (StringsLen(slname) != 1)
	return NULL;
    char *tname = StringsPtr(slname)[0]->chars();
    if (glob_pattern_p(tname))
	tname = RemoveQuotes(tname)->chars();
    if (tname[0] == '~')
	tname = tilde_expand(tname);
    if (!check_executable_file(tname))
	return NULL;
    return tname;
}

// Do operator-precedence parsing on the exprs pointed to by 'args'.

Expr* CheckOperatorPrecedence(ExprList* elist, int length, TraverseData *data)
{
#if 1
    if (elist->length > 19)
	abort();
    Expr_Ptr expr_stack[20];
    short op_stack[20];
#else
    Expr_Ptr expr_stack[elist->length+1];
    short op_stack[elist->length+1]; // Offset of ExprQuoteOps on expr_stack;
#endif
#if 1
    if (elist->flags&ExprOneWord) {
	FileName *filname = CheckFilePath(elist, data);
	if (filname) {
	    char *fname = check_executable_filename(filname, data);
	    if (fname) {
		RunCommandExpr* run_expr = GC_NEW RunCommandExpr(0);
		run_expr->left.E = NULL;
		Expr_Ptr eplist[1];
		eplist->E = elist;
		Expr* qargs = QuoteExprList(eplist, 1, 0, NULL);
		run_expr->right_args = qargs;
		return run_expr;
	    }
	    else
		return filname;
	}
    }
#endif
    Expr_Ptr* cur_arg = elist->arg;
    register i;
    int cur_right = 0;
    expr_stack[0].E = &BottomOp;
    int cur_expr = 1;
    int cur_op = 1;
    op_stack[0] = 0;
#define top_op_index op_stack[cur_op-1]
#define prev_op_index op_stack[cur_op-2]
#define top_op ((ExprQuoteOp*)(expr_stack[top_op_index].E))
    for (;; cur_arg++) {
	ExprQuoteOp* new_op;
	if (cur_arg->E == NULL) { // No more.
	    new_op = &BottomOp;
	}
	else if (cur_arg->code() == ExprQuoteOp_code)
	    new_op = (ExprQuoteOp*)cur_arg->E;
	else {
	    Expr_Ptr cur = *cur_arg;

	    // Check for a macro.
	    if (cur.E->code() == ExprQuote_code
		&& ((ExprQuote*)cur.E)->value()->isKindOf(*MFunction::desc())){
		// Recognized a macro: call it.

		int first_left_ops = top_op_index+1;
		int count_left_ops = cur_expr - first_left_ops;
		int first_right_ops = cur_arg + 1 - elist->arg;
		int count_right_ops = length - first_right_ops;
		int iClause;
		Root* result;
		ArgDesc args;
		MFunction* macro = (MFunction*)((ExprQuote*)cur.E)->value();
//		fprintf(stderr, "[Seen macro (%d,%d)]\n",
//			count_left_ops, count_right_ops);
		Clause* clause = macro->func->clauses;
		Clause* ok_clause = NULL;
		Clause* good_clause = NULL;
		for (iClause = 0; iClause < macro->func->nClauses;
		     iClause++, clause++) {
		    int left_excess = clause->pn[0].excess(count_left_ops);
		    int right_excess = clause->pn[1].excess(count_right_ops);
		    // If right_excess>0 curry?
		    // If left_excess, combine?
		    if (left_excess == 0 && right_excess == 0)
			good_clause = clause;
		    else if (left_excess >= 0 && right_excess >= 0)
			ok_clause = clause;
		    // FIXME: check for duplicates!
		}
		if (ok_clause == NULL && good_clause == NULL) {
		    TrError(data, "Macro parameters don't match.");
		    return NullExpr;
		}
		clause = good_clause ? good_clause : ok_clause;
		int left_excess = clause->pn[0].excess(count_left_ops);
		int right_excess = clause->pn[1].excess(count_right_ops);
		args.lArgs = (Root**)&expr_stack[first_left_ops];
		if (left_excess) {
		    if (left_excess == count_left_ops - 1) {
			// Collect multiple left operands into one list.
			ExprList* left_list = GC_NEW ExprList(count_left_ops);
			for (i = count_left_ops; --i >= 0; )
			    left_list->arg[i] = expr_stack[first_left_ops+i];
			left_list->flags = elist->flags + ExprDontOpParse;
			count_left_ops = 1;
			expr_stack[first_left_ops].E = left_list;
			cur_expr -= left_excess;
		    }
		    else {
			count_left_ops += left_excess;
			args.lArgs += left_excess;
		    }
		}
		args.lCount = count_left_ops;
		cur_expr -= count_left_ops; // Pop used left args;
		count_right_ops -= right_excess;
		args.rCount = count_right_ops;
		args.rArgs = (Root**)(cur_arg+1);
		cur_arg += count_right_ops;
		args.names = NULL; args.nArgs = NULL; args.nCount = 0;
		args.rCount = count_right_ops;
		ApplyClause(&result, &RefRoot, clause, macro->func, 0, args);
		if (result->isKindOf(*Expression::desc()))
		    cur.E = (Expr*)result;
		else {
		    TrError(data,"W Macro call does not yield an expression.");
		    cur.E = DoQuote(result);
		}
		expr_stack[cur_expr++] = cur;
		continue;
	    }

	    // Check to see if cur_arg is a program to run.

	    char *executable_file = NULL;  // File name of executable file.

	    if (!(elist->flags&ExprOneWord)) {
		if (cur.code() == Identifier_code) {
		    cur.E = ((Identifier*)cur.E)->traverse1(data);
		
		    if (cur.code() == Identifier_code
			&& cur.ident()->decl() == NULL)
			executable_file =
			    check_executable_file(cur.ident()->name->string());
		}
		else if (cur.code() == ExprList_code) {
		    FileName *filname = CheckFilePath((ExprList*)cur.E, data);
		    if (filname) {
			cur.E = filname;
			executable_file =
			    check_executable_filename(filname, data);
		    }
		}
	    }

	    if (executable_file) {
		
		// Pretend we saw a "run" & generate a RunCommandExpr.
		int first_left_ops = top_op_index+1;
		int count_left_ops = cur_expr - first_left_ops;
		int count_right_ops = length - (cur_arg-elist->arg);
		Expr* qargs = QuoteExprList(cur_arg,
					    count_right_ops, 0, NULL);
		RunCommandExpr* run_expr = GC_NEW RunCommandExpr(0);
		run_expr->left.E = NULL;
		if (count_left_ops == 1
		    && expr_stack[first_left_ops].code()
		    != Identifier_code) {
		    run_expr->left = expr_stack[first_left_ops];
		    cur_expr -= 1;
		}
		else if (count_left_ops) {
		    // Collect multiple left operands into one list.
		    ExprList* left_list = GC_NEW ExprList(count_left_ops);
		    for (i = count_left_ops; --i >= 0; )
			left_list->arg[i]=expr_stack[first_left_ops+i];
		    left_list->flags = elist->flags + ExprDontOpParse;
		    cur_expr -= count_left_ops;
		    run_expr->left.E = left_list;
		}
		run_expr->right_args = qargs;
		expr_stack[cur_expr++].E = run_expr;
		cur_arg = &elist->arg[length-1]; // Skip to end
		continue;
	    }

	    // Check for a macro.
	    if (cur.E->code() == ExprQuote_code
		&& ((ExprQuote*)cur.E)->value()->isKindOf(*MFunction::desc())){
		// Recognized a macro: call it.

		int first_left_ops = top_op_index+1;
		int count_left_ops = cur_expr - first_left_ops;
		int first_right_ops = cur_arg + 1 - elist->arg;
		int count_right_ops = length - first_right_ops;
		int iClause;
		Root* result;
		ArgDesc args;
		MFunction* macro = (MFunction*)((ExprQuote*)cur.E)->value();
//		fprintf(stderr, "[Seen macro (%d,%d)]\n",
//			count_left_ops, count_right_ops);
		Clause* clause = macro->func->clauses;
		Clause* ok_clause = NULL;
		Clause* good_clause = NULL;
		for (iClause = 0; iClause < macro->func->nClauses;
		     iClause++, clause++) {
		    int left_excess = clause->pn[0].excess(count_left_ops);
		    int right_excess = clause->pn[1].excess(count_right_ops);
		    // If right_excess>0 curry?
		    // If left_excess, combine?
		    if (left_excess == 0 && right_excess == 0)
			good_clause = clause;
		    else if (left_excess >= 0 && right_excess >= 0)
			ok_clause = clause;
		    // FIXME: check for duplicates!
		}
		if (ok_clause == NULL && good_clause == NULL) {
		    TrError(data, "Macro parameters don't match.");
		    return NullExpr;
		}
		clause = good_clause ? good_clause : ok_clause;
		int left_excess = clause->pn[0].excess(count_left_ops);
		int right_excess = clause->pn[1].excess(count_right_ops);
		args.lArgs = (Root**)&expr_stack[first_left_ops];
		if (left_excess) {
		    if (left_excess == count_left_ops - 1) {
			// Collect multiple left operands into one list.
			ExprList* left_list = GC_NEW ExprList(count_left_ops);
			for (i = count_left_ops; --i >= 0; )
			    left_list->arg[i] = expr_stack[first_left_ops+i];
			left_list->flags = elist->flags + ExprDontOpParse;
			count_left_ops = 1;
			expr_stack[first_left_ops].E = left_list;
			cur_expr -= left_excess;
		    }
		    else {
			count_left_ops += left_excess;
			args.lArgs += left_excess;
		    }
		}
		args.lCount = count_left_ops;
		cur_expr -= count_left_ops; // Pop used left args;
		count_right_ops -= right_excess;
		args.rCount = count_right_ops;
		args.rArgs = (Root**)(cur_arg+1);
		cur_arg += count_right_ops;
		args.names = NULL; args.nArgs = NULL; args.nCount = 0;
		args.rCount = count_right_ops;
		ApplyClause(&result, &RefRoot, clause, macro->func, 0, args);
		if (result->isKindOf(*Expression::desc()))
		    cur.E = (Expr*)result;
		else {
		    TrError(data,"W Macro call does not yield an expression.");
		    cur.E = DoQuote(result);
		}
	    }
	    
	    expr_stack[cur_expr++] = cur;
	    continue;
	}
	while (top_op->right_priority <= new_op->left_priority) { // Reduce
	    Expr_Ptr args[3];
	    int first_right_ops = top_op_index+1;
	    int count_right_ops = cur_expr - first_right_ops;
	    int first_left_ops = prev_op_index+1;
	    int count_left_ops = top_op_index - first_left_ops;
	    // Simplify left list of args to 0 or 1 arg, and add to 'args'.
	    if (count_left_ops > 1) {
		ExprList* left_list = GC_NEW ExprList(count_left_ops);
		for (i = count_left_ops; --i >= 0; )
		    left_list->arg[i] = expr_stack[first_left_ops+i];
		left_list->flags = elist->flags + ExprDontOpParse;
		count_left_ops = 1;
		args[0].E = left_list;
	    }
	    else if (count_left_ops)
		args[0] = expr_stack[first_left_ops].E;
	    // Add operand to 'args'.
	    args[count_left_ops].E = top_op;
	    // Simplify right list of args to 0 or 1 arg, and add to 'args'.
	    if (count_right_ops > 1) {
		ExprList* right_list = GC_NEW ExprList(count_right_ops);
		for (i = count_right_ops; --i >= 0; )
		    right_list->arg[i] = expr_stack[first_right_ops+i];
		right_list->flags = elist->flags + ExprDontOpParse;
		count_right_ops = 1;
		args[count_left_ops+1].E = right_list;
	    }
	    else if (count_right_ops)
		args[count_left_ops+1].E = expr_stack[first_right_ops].E;
	    i = count_left_ops+count_right_ops+1;
	    ExprList* new_arg =
		count_left_ops ? GC_NEW ExprPostfix(i) : GC_NEW ExprList(i);
	    while (--i >= 0) new_arg->arg[i] = args[i];
	    new_arg->flags = elist->flags + ExprDontOpParse;
	    expr_stack[first_left_ops].E = new_arg;
	    cur_op--;
	    cur_expr = first_left_ops + 1;
	}

	if (cur_arg->E == NULL)
	    break;

	// Shift.
	op_stack[cur_op++] = cur_expr;
	expr_stack[cur_expr++] = *cur_arg;
    }
    ExprList* new_list = GC_NEW ExprList(cur_expr-1);
    for (i = cur_expr-1; --i >= 0; )
	new_list->arg[i] = expr_stack[i+1];
    new_list->flags = elist->flags + ExprDontOpParse;
    return new_list;
    return expr_stack[1].E;
    
}

MFunction* CheckMacro(Expression* expr, TraverseData* data)
{
    if (expr->code() == ExprQuote_code
	&& ((ExprQuote*)expr)->value()->isKindOf(*MFunction::desc()))
	    return (MFunction*)((ExprQuote*)expr)->value();
    return NULL;
}

Expr* ExprList::traverse(struct TraverseData *data)
{
    int postfix = code() == ExprPostfix_code;

    if (postfix && length == 3 && arg[1].E == &QEquals)
	return (GC_NEW UnifyExpr(arg[0].E, arg[2].E))->traverse(data);

    if (!(flags & ExprDontOpParse)) {
	Expr* checked = CheckOperatorPrecedence(this, length, data);
	if (checked)
	    return checked->traverse(data);
    }
    register Expr_Ptr *ptr = arg;
    int save_flags = data->flags;
    for (int i = 0; ptr->E; ptr++, i++) {
	struct VarStateList *save1 = NewVarState(data);
	ptr->E = ptr->E->traverse(data);
	MergeVarState(save1, data);
    }
    data->flags = save_flags;

    ptr = arg;
#if 0
    if (ptr->code() == Identifier_code) {
	struct Declaration *decl = ptr->ident()->decl();
	if (decl != NULL && decl->type->isFunction())
	    return ConvertFunctionCall(this, data, ExType_Ptr(decl->type));
    }
#endif
    // If singleton list, just return the one element.
    // However, if the element is an Identifier, it might be a function
    // (which we *do* want to call),  so let it be an ExprList.
    // Ditto, for a quoted function.
    if (length == 1) {
	enum ExprCode arg_code = arg->code();
	// Could/should be more clever here.
	if (arg_code != Identifier_code
	    && arg_code != ExprQuote_code && arg_code != ExprQuoteOp_code )
	    return arg->E;
    }
    return this;
}

static int CheckId(Expr_Ptr ident)
{
    if (ident.code() == ExprNode_code && ident.node()->postfix == 2)
	ident = ident.node()->arg;
    if (ident.code() == Identifier_code) return 1;
    if (ident.ident()->flags & IdentExplicit)
	if (ident.code() == LoopCons_code) return 1;
    return 0;
  }

Symbol* MapPairExpr::label() const
{
    Expr *key_expr = arg[0].E;
    if (key_expr->code() == MakeSymbol_code) {
	if (key_expr->code() != ExprQuote_code)
	    return 0;
	MakeSymbolExpr *sexpr = (MakeSymbolExpr*)key_expr;
	StringList *slist;
	sexpr->eval(&slist, &RefRoot, NULL);
	if (StringsCount(slist) != 1)
	    return 0;
	StringC *slabel = StringsPtr(slist)[0];
	return KeywordPackage.intern(slabel->chars(), slabel->leng());
    }
    if (key_expr->code() == ExprQuote_code) {
	Root *sym = ((ExprQuote*)key_expr)->quotee.coerceToRoot();
	if (sym->isA() != Symbol::desc()) return 0;
	return (Symbol*)sym;
    }
    return 0;
}

void MapPairExpr::printon(ostream& outs) const
{
    Symbol *lab = label();
    if (lab)
	outs << lab << ':';
    else
	outs << arg[0] << "->";
    outs << arg[1];

}
void MapPairExpr::eval(void* dst, Type* dstType, struct DisplayEnv *env)
{
    Root* sym = arg[0].eval(env);
    Root* val = arg[1].eval(env);
    dstType->coerceFromRoot(dst, MakeTuple(GC_NEW SplayMap(sym, val)));
}
void MakeTupleExpr::printon(ostream& outs) const
{
    outs << seq << '@';
    if (right)
	outs << right;
}

void MakeTupleExpr::eval(void* dst, Type* dstType, struct DisplayEnv *env)
{
    if (seq.E == NullExpr && right != NULL) {
	Functional *func = Dereference(right->eval(env))->functional();
	if (func) {
	    dstType->coerceFromRoot(dst, GC_NEW Reduction(func, 0));
	    return;
	}
    }
    if (right != NULL)
	Signal(GC_NEW UnimplementedOp("...@..."));
    Root *seq_val = Dereference(seq.eval(env));
    GenSeq *seq_seq = seq_val->sequence();
    if (seq_seq) {
	dstType->coerceFromRoot(dst, GC_NEW Tuple(seq_seq));
	return;
    }
    Functional *func = seq_val->functional();
    if (func) {
	dstType->coerceFromRoot(dst, GC_NEW Reduction(func, 1));
	return;
    }
    dstType->coerceFromRoot(dst, MakeTuple(seq_val));
}

void CoerceSeqExpr::eval(void* dst, Type* dstType, struct DisplayEnv *env)
{
    const GenSeq* val = coercee.eval(env)->sequence();
    if (val == NULL) RaiseDomainError(NULL);
    dstType->coerceFromRoot(dst, (Root*)val);    
}

Expr * RedirectOut::traverse(struct TraverseData *data)
{
    filename = filename->traverse(data);
    action = action->traverse(data);
    return this;
}
Expr * FileName::traverse(struct TraverseData *data)
{
    filename = filename->traverse(data);
    return this;
}

void FileName::printon(ostream& outs) const
{
    outs << "./" << *filename;
}

Expr * LoadExpr::traverse(struct TraverseData *data)
{
    filename = filename->traverse(data);
    return this;
}

static int IdTraverseAndTest(
    register Expr_Ptr *ptr,
    struct TraverseData *data,
    Expr_Ptr defining)
 /* Traverse *ptr. Check if *ptr is the initial reference of an Identifier */
  {
    Expr_Ptr *iptr = ptr;
    data->flags |= TraverseInUnify;
    if (ptr->code() == ExprNode_code && ptr->node()->postfix == 2)
	iptr = &ptr->node()->arg;
    *iptr = iptr->traverse(data);
    if (data->flags & TraverseInUnify)
      { struct Declaration *decl = Ident2Decl(iptr->ident());
	ExType type = defining->type;
	data->flags &= ~TraverseInUnify;
#if 0
	decl->defining = defining;
	if (type.kind >= ExSignedType) {
	    int size = ((int)type.ptr << 3) /* !!! - type->excess_bits */;
	    decl->type = type;
	    decl->size = -(size << 3);
	}
	else
#endif
	if (decl->is_proc() || DeclIsInclude(decl)) { }
/* bogus: should take care of different types from different branches
 * of ExprElse */
	else if (defining.code() == ExprQuote_code) {
	    ExprQuote *exq = defining.quote();
	    if (exq->quotee.type == NULL && decl->type == NULL)
		decl->set_value(exq->quotee);
	}
#if 0
	else if ((val  = TestConstant(defining)) != NULL)
/* bad if: id=2|id=3 --- defines id to be 3 !!! */
	    decl->set_value(val);
	    MakeLabelToken(&decl->token, NULL, val, 0);
	}
	else
	    decl->type = defining->type;
#endif
	if (iptr != ptr) ptr->E = iptr->E;
	return 1;
      }
    return 0;
  }

Expr * UnifyExpr::traverse(struct TraverseData *data)
{
    int left_id = 0, right_id = 0;
    unsigned short flags = ExprAtMostOneResult|ExprCannotFail;
    if (set > 0)
      {
	if (set > 1)
	  { /* Becomes or Identity */
	    left = left.traverse(data);
	    flags &= left->flags;
	  }
	/* just do right side, since left side is "set" */
	right = right.traverse(data);
	flags &= left->flags;
	flags |= flags;
	return this;
      }
 /* [[x~f=y]] => [[x=y@f]] */
    if (right.code() == InverseExpr_code)
      { Expr_Ptr tmp = right; right = left; left = tmp; }
    if (left.code() == InverseExpr_code)
      { struct ExprNode *node =
	    NewExprNode(right.E, left.inverse()->func.E);
	right = node;
	left = left.inverse()->arg;
	node->postfix = 1;
      }

    if (left.code() == Dummy_code) /* [[_=y]] => [[y]] */
	return right.traverse(data);
    if (right.code() == Dummy_code) /* [[x=_]] => [[x]] */
	return left.traverse(data);
    if (data->pass > BindPass) {
	left = left.traverse(data);
	right = right.traverse(data);
	return this;
    }
/*
 * The complication here is that we want to recognize both "id = expr"
 * "expr = id". However, in case "id" occurs in "expr", we must
 * Traverse "expr" first.
 */

    left_id = CheckId(left);
    right_id = (flags & UnifyDontSwap) ? 0 : CheckId(right);
    if (left_id & right_id)
      { /* choose one direction by zeroing one of left_ or right_id */
/* NOTE: Do better than this! */
	right_id = 0;
      }
    if (!left_id) left = left.traverse(data);
    if (!right_id) right = right.traverse(data);
    if (left_id)
      {
	if (IdTraverseAndTest(&left, data, right))
	    set = 1;
      }
    else if (right_id)
      {
	if (IdTraverseAndTest(&right, data, left))
	  { Expr_Ptr tmp = left;
	    left = right; right = tmp;
	    set = 1;
	  }
      }
    flags &= left->flags;
    flags &= right->flags;
    flags |= flags;
#if 0
    if (!expr->set) {
	int isInt[2];
	struct ExprStdOp *op;
	extern struct ExprStdOp *AllocStdOp();
	flags &= ~ExprCannotFail;
	isInt[0] = TypeIsInt(expr->left.val_type);
	if (isInt[0] == 0) return (Expr*)expr;
	isInt[1] = TypeIsInt(expr->right.val_type());
	if (isInt[0] == 0) return (Expr*)expr;
	op = AllocStdOp(CmpEqu_code, 2);
	((Expr*)op)->any = ((Expr*)expr)->any;
	op->set_code(CmpEqu_code);
	op->arg[0].E = expr->left.E;
	op->arg[1].E = expr->right.E;
	op->flags |= ExprAtMostOneResult;
	if (isInt[0]+isInt[1] == 4)
	    op->type = MakeExType(ExPointerType, FixNumT);
	else
	    op->type = MakeExType(ExPointerType, IntT);
	return (Expr*)op;
    }
#endif
    return this;
  }

#if 0
Expression * Expression::traverseEvaluated(register struct TraverseData *data)
{
    return traverse(data);
}

extern RootPtr SearchSpecial(Name name);
extern struct Declaration LookupSpecialDecl[1];
Expression * Identifier::traverseEvaluated(register struct TraverseData *data)
{
    Expr *p = traverse(data);
    if (p != (Expr*)this) return p;
    if (decl() == LookupSpecialDecl) {
	RootPtr ob = SearchSpecial(name);
	if (ob != NULL) return GC_NEW ExprQuote(ob);
    }
    return p;
}
#endif

void Identifier::printon(ostream& outs) const
{
    char buf[20];
    if (symbol() == NULL)
	sprintf(buf, "#%x", decl()), outs << buf;
    else
	outs.write(symbol()->string(), symbol()->length());
#if 0
    if (IsFormattedFile(f) && ((struct FormattedFile*)f)->detail > 0) {
	sprintf(buf, "{%d}->#%x", flags, decl()), outs << buf;
	if (decl() && (flags & IdentNesting == 0))
	    sprintf(buf, "{%d}", decl()->flags), outs << buf;
      }
    else
#endif
	if (symbol() == NULL)
	    sprintf(buf, "->#%x", decl()), outs << buf;
}

void ElseExpr::printon(ostream& outs) const
{
    register const struct ElseExpr *expr = this;
    outs << "if ";
    for (;; expr = expr->e2.or())
      {
	expr->e1.printon(outs);
	if (expr->then.E != NULL)
	  {
	    outs << " => ";
	    expr->then.printon(outs);
	  }
	outs << (expr->kind ? " |" : " ||");
	if (expr->e2.code() != ElseExpr_code)
	    break;
	outs << '\n';
      }
    outs << ' ';
    expr->e2.printon(outs);
}

#if 0
char * ElseExpr::string(struct DisplayEnv *env = NULL, int flags = 0)
{
    char *str1 = e1.E->string(env, flags);
    char *str2 = e2.E->string(env, flags);
    char *str = (char*)malloc(strlen(str1) + strlen(str2) + 2);
    sprintf(str, "%s|%s", str1, str2);
    free(str1);
    free(str2);
    return str;
}
#endif

void InverseExpr::printon(ostream& outs) const
{
    outs << arg << '~' << func;
}

void ExprQuote::printon(ostream& outs) const
{
    if (this == (struct ExprQuote*)NullExpr) return;
    if (this == &NULL_expr)
	outs << "NULL_POINTER";
    else
	outs << '\'' << quotee;
}

void ExprQuoteOp::printon(ostream& outs) const
{
    outs << '\'' << text;
}

void CoerceSeqExpr::printon(ostream& outs) const
{ outs << "SEQUENCE " << coercee; }

void CoerceStringListExpr::printon(ostream& outs) const
{ outs << coercee; }

void ExprNode::printon(ostream& outs) const
{
    outs << "("<< arg;
    switch (postfix)
      {
      case 0: outs << " PREFIX "; break;
      case 1: outs << " POSTFIX "; break;
      case 2: outs << " LASTFIX"; break;
/*    case 3: outs << " " << x->name << "/N: "; break; */
      default: abort();
      }
    if (postfix != 2) outs << func;
    outs << ")";
}

void Block::printon(ostream& outs) const
{
    register struct Statement *st;
#if 0
    if (!IsFormattedFile(file)
     || ((struct FormattedFile*)file)->detail <= 0)
#endif
	outs.form("( %% Block=#%X ", this);
    outs.form("[fl=#%X, outer: #%X, lev: %d]",
	flags, enclosing, level);

    // List declarations of block.
    outs << '<';
    Declaration **dptr;
    for (dptr = &decls.first; *dptr != NULL; dptr = &(*dptr)->next()) {
	outs << ' ' << *(*dptr)->fname();
    }
    if (dptr != decls.last)
	outs << "{DeclList botch!}";    
    outs << '>';

    for (st = first ; st != NULL; st = st->next) {
	outs << "\n";
#if 0
	if (st->decl != NULL) {
	    DeclPrint(st->decl, outs);
	    oust << ": ";
	}
#endif
	if (st->kind == ForgetStatement)
	    outs << "forget";
	else
	    st->src.printon(outs);
	outs.form(" k:%d", st->kind);
    }
#if 0
    if (!IsFormattedFile(file)
	|| ((struct FormattedFile*)file)->detail <= 0)
#endif
     outs << " )";
/*    outs << "\n"; */
}

void UnifyExpr::printon(ostream& outs) const
{
    outs << left
         << (set == 0  ? "=" : set == 3 ? "==" : ":=")
         << right;
}

void UnionExpr::printon(ostream& outs) const
{
    outs << left << " || " << right;
}

void ExprCall::printon(ostream& outs) const
{
    int i; int expr = 0;
    outs << '(';
    switch (kind)
      {
      case 1:
	expr = 1;
      case 0:
	outs << "CallC ";
	break;
      case 4:
	expr = 1;
      case 3:
	outs << "CallQ ";
	break;
      case 6:
	expr = 1;
      case 5:
	outs << "CallR ";
	break;
      case 9: case 10:
	break;
      default:
	outs << "Call? ";
	break;
      }
    if (kind == 10)
	 outs.form("CLAUSE[%s,%d] ", 
	    ((FunctionCall*)proc.E)->func->str_name(), offset);
    else if (kind == 9)
	outs.form("FCALL[%s] ", 
	    ((FunctionCall*)proc.E)->func->str_name());
    else if (expr == 0)
	outs << ((Symbol*)proc.E)->string();
    else
	outs << '(' << proc.E << ')';
    for (i = 0; i < args; i++)
	outs << ' ' << arg[i].E;
    outs << ')';
}

void ExprList::printon(int postfix, ostream& outs) const
{
    register Expr_Ptr *ptr = arg;
    if (PointerIsMarked(ptr->E)) abort();
    outs << "(";
    outs << *ptr++;
    if (postfix & !PointerIsMarked(ptr->E))
	outs << " POSTFIX";
    for (;;) {
	Expr_Ptr cur = *ptr++;
	if (cur.E == NULL)
	    break;
	if (!(flags & ExprOneWord)) outs << ' ';
	outs << cur;
    }
    outs << ")";
}

void ExprList::printon(ostream& outs) const { printon(0, outs); }
void ExprPostfix::printon(ostream& outs) const { ExprList::printon(1, outs); }

void RunCommandExpr::printon(ostream& outs) const
{
    outs << '(';
    if (left.E)
	outs << left << ' ';
    outs << replaces_self() ? "exec " : "run ";
    right_args.printon(outs);
    outs << ')';
}

Expr* RunCommandExpr::traverse(struct TraverseData *data)
{
    if (left.E) left = left.traverse(data);
    right_args = right_args.traverse(data);
    return this;
}

void ListConsExpr::printon(ostream& outs) const
{
    outs << "[";
    Expr_Ptr *ptr = arg;
    if (*ptr != NULL)
	for (;;) {
	    outs << *ptr->E;
	    ptr++;
	    if (*ptr == NULL) break;
	    outs << ' ';
	}
    outs << "]";
}

void MakeStringExpr::printon(ostream& outs) const
{
    outs << "\"";
    Expr_Ptr *ptr = arg;
    if (*ptr != NULL)
	for (;;) {
	    outs << *ptr;
	    ptr++;
	    if (*ptr == NULL) break;
	}
    outs << "\"";
}

void MakeSymbolExpr::printon(ostream& outs) const
{
    outs << "'" << *name;
}

static void PrintParam(struct ParamExpr *param, ostream& outs)
{
#if 1
    outs << ':';
    if (param->name)
	outs.form("%s:[N]", param->name->string());
    outs << param->arg_expr;
    if (param->flags & FormalMultiple)
	outs << "@[M]"; 
#else
    if (param->param_kind > 0)
	outs.form("%s", ((Symbol*)param->arg_expr)->string());
    else outs << param->arg_expr;
    switch (param->param_kind) {
      case 1: outs << "%:"; break;
      case 2: outs << ":"; break;
    }
#endif
    if (param->default_expr)
	outs << '=' << *param->default_expr;
}

Expression * QuoteOnlyExpr::quote_words(TraverseData * /*= NULL*/)
{
    return DoQuote(NewVector(1, (Root**)&name));
}

void QuoteOnlyExpr::printon(ostream& outs) const
{
    outs << *name;
}

Expression* QuoteOnlyExpr::traverse(struct TraverseData *data)
{
    TrError(data, "Form '%s' cannot be evaluated, only quoted.",
	    name->chars());
    return this;
}

void ProcExpr::printon(ostream& outs) const
{
    struct ParamExpr *param = argList;
    outs << ":(";
    if (param && !(flags & ProcPrefix)) {
	PrintParam(param, outs);
	param = param->next;
	outs << ' ';
    }
    outs << *fname;
    for (; param; param = param->next) {
	outs << ' ';
	PrintParam(param, outs);
    }
    outs << ")= " << *expr;
}

void DynamicBindExpr::printon(ostream& outs) const
{
    outs << "save ";
    for (int i = 0; i < count; i++) {
	outs << *var_exprs[i];
	if (init_exprs[i])
	    outs << ":=" << *init_exprs[i];
	outs << " ";
    }
    outs << "=> " << *body;
}

Expression* DynamicBindExpr::traverse(struct TraverseData *data)
{
    for (int i = 0; i < count; i++) {
	var_exprs[i] = var_exprs[i]->traverse(data);
	if (init_exprs && init_exprs[i])
	    init_exprs[i] = init_exprs[i]->traverse(data);
    }
    body = body->traverse(data);
    return this;
}

void DynamicBindExpr::eval(void* dst, Type* dstType, DisplayEnv *env)
{
#if 0 /* Optimization */
    if (count == 1) {
	Root *var = var_exprs[0]->eval(env);
	DynamicBind(var);
	if (init_expres && init_exprs[0])
	    var->assign(eval(init_exprs[0], env));
	body->eval(dst, dstType, env);
    }
#endif
    RootPtr new_vals[count];
    RootPtr vars[count];
    int i;
    for (i = 0; i < count; i++) {
	var_exprs[i]->eval(&vars[i], &RefRoot, env);
	if (init_exprs && init_exprs[i])
	    init_exprs[i]->eval(&new_vals[i], &RefRoot, env);
	else
	    new_vals[i] = NULL;
    }
    RootPtr old_buffer[count];
    DynamicBindMany bindings(count, vars, old_buffer);
#if 0
    IFV(DynBindEval) {
#endif
	for (i = 0; i < count; i++) {
	    if (new_vals[i] != NULL)
		vars[i]->assign(new_vals[i]);
	}
	body->eval(dst, dstType, env);
#if 0
    } THENV { }
    ELSEV(DynBindEval,Fail) {
    } ENDV;
#endif
}

void ExtractFieldExpr::printon(ostream& outs) const
{
    value->printon(outs);
    outs << "'" << field->fname()->chars();
}

Expression* ExtractFieldExpr::traverse(struct TraverseData *data)
{
    value = value->traverse(data);
    return this;
}

void ExtractFieldExpr::eval(void* dst, Type* dstType, DisplayEnv *env)
{
    Root *val = value->eval(env);
    field->extract(val).coerceTo(dst, dstType);
}

void Expression::printon(ostream& outs) const
{
#if 1
    outs.form("[Expr:%X,code:%d]", this, (int)code());
#else
    int i;
    Expr *ex = this;
    switch (ex->code()) {
      case SetSort_code:
	fprintf(file, "SetSort ");
	PrintExpr(ex->bin.arg[0].E, file);
	break;
      case Length_code:
	PrintExpr(ex->bin.arg[0].E, file);
	fputs("@?", file);
	break;
      case WhenOp_code:
	PrintExpr(ex->bin.arg[0].E, file);
	fprintf(file, " WHEN ");
	PrintExpr(ex->bin.arg[1].E, file);
	break;
      case ListIndex_code:
	PrintExpr(ex->bin.arg[0].E, file);
	fprintf(file, "[");
	PrintExpr(ex->bin.arg[1].E, file);
	fprintf(file, "]");
	break;
      case GotoExpr_code: PrintGoto(ex, file); break;
      case ReturnExpr_code: ReturnPrint(ex, file); break;
      case LabelExpr_code: PrintLabelExpr(ex, file); break;
#if 0
      case External_code: ExternalExprPrint(ex, file); break;
      case RegExpr_code: PrintRegExpr(ex, file); break;
      case MoveExpr_code: PrintMoveExpr(ex, file); break;
      case ExtractExpr_code:
	PrintIt(ex->extract.source.P, file);
	if (ex->extract.stepSize < 0) {
	    fprintf(file, " EXTRACT '%s", ex->extract.offset.decl->name);
	    return;
	}
	fprintf(file, " EXTRACT#%d ", ex->extract.stepSize);
	PrintIt(ex->extract.offset.P, file);
	break;
      case TypeDefExpr_code: TypeExprPrint(ex, file); break;
#endif
      case SelectExpr_code: SelectPrint(ex, file); break;
      case MakeString_code:
	fputc('"', file);
	WordExprPrint(&ex->listcons, file);
	fputc('"', file);
	break;
      case MakeSymbol_code:
	fputc('$', file);
	/* ... fall through to ... */
      case Word_code:
	WordExprPrint(&ex->listcons, file);
	break;
      case RedirectOut_code:
	fputc('>', file);
	PrintExpr(ex->redirect.filename, file);
	fputc(' ', file);
	PrintExpr(ex->redirect.action, file);
	break;
      case ReadFileFrom_code:
	fputc('<', file);
	/* ... fall through to ... */
      case FileName_code:
	PrintExpr(ex->redirect.filename, file);
	break;
      case C_Code_code:
	fprintf(file, "C_CODE [%s]", ex->c_code.code0);
	for (i = 0; i < ex->c_code.inserts; i++)
	    PrintExpr(ex->c_code.insert[i].expr.E, file),
	    fprintf(file, "[%s]", ex->c_code.insert[i].code);
	break;
      case ListChoose_code:
	ex->bin.arg[0].printon(file);
	fprintf(file, "@|");
	break;
      case Collect_code:
	fprintf(file, "collect ");
	ex->bin.arg[0].printon(file);
	break;
      case DefException_code: PrintBinOp(&ex->bin, "SIGNAL,", file); break;
      case Concat_code: PrintBinOp(&ex->bin, "@,", file); break;
      case SetDiff_code: PrintBinOp(&ex->bin, "setdiff", file); break;
      case PlusOp_code: PrintBinOp(&ex->bin, "+", file); break;
      case MinusOp_code: PrintBinOp(&ex->bin, "-", file); break;
      case FromOp_code: PrintBinOp(&ex->bin, "--", file); break;
      case TimesOp_code: PrintBinOp(&ex->bin, "*", file); break;
      case DivOp_code: PrintBinOp(&ex->bin, "/", file); break;
      case IDivOp_code: PrintBinOp(&ex->bin, "//", file); break;
      case CmpGrt_code: PrintBinOp(&ex->bin, ">", file); break;
      case CmpLss_code: PrintBinOp(&ex->bin, "<", file); break;
      case CmpLeq_code: PrintBinOp(&ex->bin, "<=", file); break;
      case CmpGeq_code: PrintBinOp(&ex->bin, ">=", file); break;
      case CmpNeq_code: PrintBinOp(&ex->bin, "<>", file); break;
      case CmpEqu_code: PrintBinOp(&ex->bin, "=", file); break;
      case TakeOp_code: PrintBinOp(&ex->bin, "^^", file); break;
      case DropOp_code: PrintBinOp(&ex->bin, "^/", file); break;
      case ConsOp_code: PrintBinOp(&ex->bin, ",", file); break;
      case Coerce_code:
	fprintf(file, "COERCE(");
	PrintExpr(ex->bin.arg[0].E, file);
	fprintf(file, ",/*TO*/");
	PrintExpr(ex->bin.arg[1].E, file);
	fprintf(file, ")");
	break;
      case Reduce_code:
	fprintf(file, "REDUCE[");
	PrintExpr(ex->bin.arg[0].E, file);
	fprintf(file, "]");
	break;
      case GiveNameToType_code:
	fprintf(file, "GIVE_NAME_TO_TYPE ");
	PrintExpr(ex->bin.arg[0].E, file);
	fprintf(file, " ");
	PrintExpr(ex->bin.arg[1].E, file);
	break;
      default:
	abort();
    }
#endif
}

extern const Class * (RootTypeList[2]);
extern void DefaultCoerceTo(void *dst, const void *src,
	const Type * dstClass, const Type *srcClass);
#define COERCE_FUNCTION DefaultCoerceTo
DEFINE_CLASS(Expression,RootTypeList)
