/* Copyright Per Bothner 1987. Read the file Q-INFO */
#include "types.h"
#include <iostream.h>
#include <stdlib.h>
#include <stdarg.h>
#include "traverse.h"
//#include <hash.h>
#include "debug.h"
#include "debug.h"
#include "genmap.h"
#include "modules.h"
#include "symbol.h"

EXTERN int TypeIsInt(ExType type);
EXTERN ExType FindExprType(Expr *expr);
EXTERN RootPtr LookupLabelToken(register struct DataToken *token);
EXTERN void * LookupGlobalLabel(char *name, int *found);

struct VarStateList * NewVarState(struct TraverseData *data)
  { register struct VarStateList *state;
    if (data->pass > BindPass) return NULL;
    state = (struct VarStateList*)malloc(sizeof(struct VarStateList));
    state->first = NULL;
    state->next = data->varStates;
    state->prev = &data->varStates;
    data->varStates = state;
    if (state->next != NULL)
	state->next->prev = &state->next;
    state->level = data->curBlock ? data->curBlock->level : 0;
    return state;
  }

void SwapVarState(struct VarStateList *state, struct TraverseData *data)
  { register struct VarStateLink *link;
    if (data->pass > BindPass) return;
    if (data->curBlock->level != state->level)
	RunError(0, "SwapVarState confusion");
    for (link = state->first; link != NULL; link = link->next)
      { int tmp_flags = link->saveFlags;
	register struct Declaration *decl = link->decl;
	link->saveFlags = decl->flags & ImplicitDeclMask;
	decl->flags &= ~ImplicitDeclMask;
	decl->flags |= tmp_flags;
      }
  }

void MergeVarState(struct VarStateList *state, struct TraverseData *data)
   /* data->state := MERGE(data->state, state); Free(state) */
  { register struct VarStateLink *link;
    struct VarStateLink *next;
    if (data->pass > BindPass) return;
    if ((data->curBlock ? data->curBlock->level : 0) != state->level)
	RunError(0, "MergeVarState confusion");
    for (link = state->first; link != NULL; link = next)
      { int save_flags = link->saveFlags;
	register struct Declaration *decl = link->decl;
	int decl_flags = decl->flags & ImplicitDeclMask;
	if (*decl->linkAddr() != link) abort();
	*decl->linkAddr() = link->down;
	next = link->next;
	if (decl_flags != GeneralDeclaration && decl_flags != save_flags)
	  {
	    decl->flags &= ~ImplicitDeclMask;
	    if (save_flags == GeneralDeclaration)
		decl->flags |= GeneralDeclaration;
	    else decl->flags |= TentativeDeclaration;
	  }
	free(link);
      }
    if (state->next != NULL)
	state->next->prev = state->prev;
    *state->prev = state->next;
    free(state);
  }

Type* ExprToType(Expr *expr, struct TraverseData *data)
{
    if (ExprCodeOf(expr) != ExprQuote_code)
	return NULL;
    Root* val = (Root*)((ExprQuote*)expr)->quotee.addr;
    if (!val->isKindOf(*Type::desc()))
	return NULL;
    return (Type*)val;
}

#if 0
Object
LookupLabelOffset(label, offset)
    Name label; int offset;
{   Object ob;
    if (label == NULL)
	return (Object)offset;
    int found;
    ob = LookupGlobalLabel(SymbolString(label), &found);
    if (!found)
	return (Object)((char*)ob + offset);
    return NULL;
}

RootPtr LookupLabelToken(register struct DataToken *token)
{   Object ob;
    if (token->kind != ConstToken) return NULL;
    ob = (Object)token->u.constant.offset;
    if (token->u.constant.label != NULL)
      { Object obl = LookupGlobalLabel(token->u.constant.label, NULL);
	if (obl == NULL) return NULL;
	ob = (Object)((long)obl + (long)ob);
      }
    if (!(token->options & LiteralToken)) ob = *(Object*)ob;
    return ob;
}
#endif

#if 0
Object
TestConstant(Expr *expr)
  /* if expr is non-expression, or refers to a constant, return that constant */
  /* else return NULL */
  { struct Type *type = MemGetType(expr);
#if 0
    if (type == &ExprNode && expr->node.postfix == 2)
      { extern Object Default_lastfix();
	Object arg = TestConstant(expr->node.arg);
	if (arg && MemGetType(arg)->lastfix == Default_lastfix)
	    return arg;
	else return NULL;
      }
#endif
#if 0
    if (type == ExprQuoteT)
	return (Object)expr->quote.quotee.addr;
    if (type == IdentifierT)
      { struct Declaration *decl = Ident2Decl(&expr->ident);
	if (decl != NULL)
	    return LookupLabelToken(&decl->u.token);
      }
#endif
    return NULL;
  }
#endif

#if 0
ExType FindExprType(Expr *expr)
  { Object ob;
    ob = TestConstant(expr);
    if (ob != NULL)
	return MakeExType(ExPointerType, MemGetType(ob));
#if 0
    if (HasHType(expr, Identifier))
      { struct Declaration *decl = Ident2Decl(&expr->ident);
	if (decl != NULL && (decl->flags & ImplicitDeclMask) == SetDeclaration)
	  { struct ExprNode *node = decl->defining.node;
	    if (node != NULL && HasHType(node, ExprNode) && node->postfix == 1)
	      {
	        ob = TestConstant(node->func.E);
		if (ob != NULL && HasHType(ob, Type))
		    return (struct Type*)ob;
	      }
	  }
      }
#endif
    return expr->type;
  }
extern Object Default_prefix(), Default_lastfix();
#endif

Expr *
CheckDirectFunctionCall(struct ExprCall *call, struct TraverseData *data)
{
    struct Function *func = ((FunctionCall*)call->proc.E)->func;
    struct ExprCall *dcall;
    struct Clause *clause; struct Formal *formal;
    int i, iActual, skipDefaults;
    if (func->nClauses > 1) return (Expr*)call;
    clause = func->clauses;
    if (!(clause->flags & ClauseDirectCallOk)) return (Expr*)call;
    dcall = AllocExprCall(clause->nParams, NULL);
    if(clause->nParams < call->args || clause->minParams > call->args) abort();
    skipDefaults = call->args - clause->minParams;
    iActual = 0;
    for (i = 0, formal = clause->formals; i < clause->nParams; i++, formal++){
	if (formal->flags & FormalMustUnify) abort();
	if (formal->default_expr != NULL && skipDefaults-- <= 0)
	    dcall->arg[i].E = formal->default_expr;
	else {
#if 0
	    dcall->arg[i] = call->arg[iActual++];
#else
	    struct ExprStdOp *coerce = AllocStdOp(Coerce_code, 2);
	    struct Field *fld = formal->u.id;
	    coerce->arg[0] = call->arg[iActual++];
	    coerce->arg[1].E = NULL;
	    switch (fld->kind) {
#if 0
	      case Pointer_Field:
		coerce->type = MakeExType(ExPointerType, fld->u.type); break;
	      case Struct_Field:
		coerce->type = MakeExType(ExDirectType, fld->u.type); break;
	      case Bit_Field:
		if (fld->u.b.is_signed)
		    coerce->type = MakeSignedType(fld->u.b.size);
		else
		    coerce->type = MakeUnsignedType(fld->u.b.size);
		break;
#endif
	      default: coerce->type = MakeExType(ExBogusType, 0);
	    }
	    dcall->arg[i] = coerce;
#endif
	}
    }
    dcall->proc = call->proc;
    dcall->offset = 0;
    dcall->kind = 10;
#if 1
    dcall->type = clause->expr->expr->type;
#else
    if (clause->expr->resultType.E == NULL)
	dcall->type = ExTypePtr;
    else
	dcall->type = ExprToType(clause->expr->resultType.E, data);
#endif
/*  free(call); */
    return (Expr*)dcall;
}

Expression * ExprQuote::traverse(register struct TraverseData *data)
{
    return this;
}

Functional* ExprQuoteOp::func_value()
{
    Root* val = value();
    if (val)
	return (Functional*)val;
    Symbol* sym = BuiltinPackage.find_interned(name, strlen(name), NULL);
    if (sym) {
	Root *f = sym->sym_function();
	if (f && f->isKindOf(*Functional::desc()))
	    return (Functional*)f;
    }
    return NULL;
}

Expression * ExprQuoteOp::traverse(register struct TraverseData *data)
{
    if (value() == NULL) {
	Functional* f = func_value();
	if (!f)
	    TrError(data, "Internal error: can't lookup function %s", name);
	else
	    quotee = MAKE_ANY(f, &Root_classDesc);
    }
    return this;
}

Expression * ExprCall::traverse(struct TraverseData *data)
{
    int i; Expr_Ptr *argPtr;
    unsigned short flags = ExprAtMostOneResult;
    if (kind == 1 || kind == 4 || kind == 6
	|| kind == 8)
	proc = proc.traverse(data);
    for (i = 0, argPtr = &arg[0]; i < args; i++, argPtr++ )
	{
	    *argPtr = argPtr->traverse(data);
	    flags &= argPtr->E->flags;
	}
    if (flags && kind <= 1) flags |= ExprAtMostOneResult;
    if (kind == 7 || kind == 8) type = ExTypePtr;
    if (kind == 9 && data->pass > BindPass)
	return CheckDirectFunctionCall(this, data);
    return this;
}

ExprList * ConvertNode(ExprNode *expr)
{
    Expr_Ptr ex(expr);
/* NOTE: should also handle BindExpr */
    int len = 1;
    int postfix = 0;
    struct ExprList *list;
    Expr_Ptr *ptr;
    
    if (expr->postfix == 2) ex = expr->arg;
    for (;;) {
	if (ex.code() == ExprNode_code)
	    switch (ex.node()->postfix) {
/*prefix*/    case 0: ex = ex.node()->arg; len += 1; continue;
/*postfix*/   case 1: len += 1; postfix++; break;
/*lastfix*/   case 2: break;
/*namefix*/   case 3: ex = ex.node()->arg; len += 2; continue;
	    }
	break;
    }
    list = postfix ? new ExprPostfix(len) : new ExprList(len);
    ptr = list->arg + len;
    ex = expr;
    list->type = expr->type;
    list->flags = expr->flags;
    list->set_location(expr->sourcePos);
    ptr->E = NULL;
    if (expr->postfix == 2)
	ex = ex.node()->arg;
    for (;;) {
	if (ex.code() == ExprNode_code && ex.node()->postfix != 2) {
	    struct ExprNode *cur = ex.node(); ex = cur->arg;
	    switch (cur->postfix) {
/*prefix*/    case 0: *--ptr = cur->func; continue;
/*postfix*/   case 1: *--ptr = cur->func; break;
/*lastfix     case 2: break; */
#if 0
/*namefix*/   case 3:
		*--ptr = cExprCodeOfur->func; (--ptr)->E = (Expr*)MarkPointer(cur->name);
		 continue;
#endif
	    }
	}
	break;
    }
    *--ptr = ex;
    if (ptr != list->arg) abort();
    return list;
}

Expr * TraverseExprNode(struct ExprNode *node, struct TraverseData *data)
{
#if 1
    return ConvertNode(node)->traverse(data);
#else
    Expr *arg; struct Type *arg_type, *func_type; struct GotoExpr *jump;
    node->arg = node->arg.traverse(data);
    arg = node->arg.E;
#if 1
    arg_type = NULL;
#else
    arg_type = FindExprType(arg);
#endif
    if (node->postfix == 2)
      {
	if (HasHType(arg, ExtractExpr) && arg->extract.stepSize == -1) {
	    arg->extract.stepSize = -2;
	    return arg;
	}
	if (arg_type != NULL && arg_type->lastfix == Default_lastfix)
	    return arg;
	if (HasHType(arg, Identifier) || HasHType(arg, ExprNode))
	    if (arg->any.flags & LastfixProtect)
		/* NOTE: crock needed because of ConvertNonLocalReference */
		return arg;
	if (HasHType(arg, Identifier) && arg->ident.decl != NULL
	  && !arg->ident.decl->is_proc())
	    return arg;
	return (Expr*)node;
      }
    if (arg_type != NULL)
      {
#if 0
	fprintf(LogFile, "[Node #%X(#%X, #%X) has type ",
	    node, node->arg, node->func);
	PutType(LogFile, arg_type); fputs("]\n", LogFile);
#endif

#if 0
needs work because of new ClassDesc [yet]
	if (node->postfix == 0 && arg_type->prefix == Default_prefix)
	  /* NOTE: This should imply arg_type->lastfix == Default_lastfix */
	    /* node->arg has no sPrefix field */
	    node->postfix = 1;
#endif
      }
    node->func = node->func.traverse(data);
    if ((jump = node->func.jump),
	(HasHType(jump, GotoExpr) && jump->result.E == NULL))
      {
	jump->result = node->arg;
	return (Expr*)jump;
      }
    else if ((jump = node->arg.jump),
	(HasHType(jump, GotoExpr) && jump->result.E == NULL))
      {
	jump->result = node->func;
	return (Expr*)jump;
      }
#if 0
    func_type = FindExprType(node->func.E);
    if (node->postfix && func_type == &UnaryPostfix)
      { struct ExprCall *call = AllocExprCall(1, &node->arg.E);
	call->kind = 6;
	call->proc = node->func;
	return (Expr*)call;
      }
    if (node->postfix && func_type == &Type)
	if ((func_type = (struct Type*)TestConstant(node->func.E)) != NULL
	  && HasHType(func_type, Type))
	    node->type = MakeExType(ExPointerType, func_type);
#endif
   /* Strictly speaking, the next optimization should only be done
    * if node->postfix, but convenience wins ... */
#if 0
-- will need fixing with new symbol table format
    if (node->func.code() == ExprQuote_code) {
	Name name = (Name)node->func.quote->quotee;
	struct Declaration *decl;
	if (HasHType(name, Symbol) && arg_type != NULL) {
	    decl = (struct Declaration*)Search(arg_type->hash, name);
	    if (decl == NULL)
		TrError(data, "W Undefined field name: %s", name);
	    else {
		if (decl->flags & PrivateDeclaration)
		    TrError(data, "W Using private field name: %s", name);
		if (decl->kind == Pointer_Field
		 || decl->is_const())
		    return (Expr*)AllocExtract(node->arg, decl, -1);
	    }
	}
    }
#endif
    return (Expr*)node;
#endif
}

void TraverseData::clear(struct Module *module)
{
    curProc = NULL;
    curBlock = NULL;
    curModule = module;
    curLoopCons = NULL;
    if (module) module->tr_data = this;
    flags = 0;
    nesting = -99;
    displayMax = 0;
    errors = 0;
    varStates = NULL;
    sourcePos.set_unknown();
    notFoundId = NULL;
    pendingProcs = NULL;
    pass = BindPass;
}

TraverseData::TraverseData(struct Module *module)
{
    clear(module);
    visibleLoopConsList = NULL;
    symTab = (HashTable*)HashTable::New(512);
    compile_to = NULL;
}

TraverseData::~TraverseData()
{
    if (curModule && curModule->tr_data == this)
	curModule->tr_data = NULL;
    // free hashtable symTab;
}

extern Expr *TraverseMoveExpr(),
    *TypeDefTraverse(), *TraverseLabelExpr(),
    *TraverseGoto(), *TraverseReturn();

Expr * ListConsExpr::traverse(struct TraverseData *data)
{
    int nonconst = 0;
    Expr_Ptr *ptr;
    for (ptr = arg; *ptr; ptr++) {
	*ptr = ptr->traverse(data);
	if (ptr->code() != ExprQuote_code) nonconst++;
    }
    if (code() == Word_code )
	return this;
    if (nonconst == 0)
	return new ExprQuote(Expression::eval((DisplayEnv*)0));
    return this;
}

#if 0
Expr * WordExpr::traverse(struct TraverseData *data)
{
    Expr_Ptr *ptr;
    for (ptr = arg; *ptr; ptr++) {
	*ptr = ptr->traverse(data);
    }
    return this;
}
#endif

Expr * MakeStringExpr::traverse(struct TraverseData *data)
{
    int save_flags = data->flags;
    data->flags &= ~TraverseInQuote;
    Expr_Ptr *ptr;
    int all_quoted = 1;
    for (ptr = arg; *ptr; ptr++) {
	*ptr = ptr->traverse(data);
	if (ptr->code() != ExprQuote_code)
	    all_quoted = 0;
    }
    data->flags = save_flags;
    if (all_quoted && ! (save_flags & TraverseInQuote)) {
	return new ExprQuote(Expression::eval((DisplayEnv*)0));
    }
    return this;
}

Expr * UnquoteExpr::traverse(struct TraverseData *data)
{
    int save_flags = data->flags;
    data->flags &= ~TraverseInQuote;
    arg = arg.traverse(data);
    data->flags = save_flags;
    return this;
}

Expr * MakeSymbolExpr::traverse(struct TraverseData *data)
{
#if 1
    name = name->traverse(data);
    if (name->code() == ExprQuote_code)
	return DoQuote(Expression::eval((DisplayEnv*)0));
#else
    short save_flags = data->flags;
    data->flags |= TraverseInQuote;
    Expr_Ptr *ptr;
    for (ptr = arg; *ptr; ptr++) {
	*ptr = ptr->traverse(data);
    }
    data->flags = save_flags;
    if (length == 1 && arg[0].code() == Identifier_code) {
	Symbol *sym = arg[0].ident()->symbol();
	return new ExprQuote(KeywordPackage.intern(sym->string(),
						   sym->length()));
    }
#endif
    return this;
}

Expr * UnionExpr::traverse(struct TraverseData *data)
{
    left = left->traverse(data);
    right = right->traverse(data);
    return this;
}

Expr * MakeTupleExpr::traverse(struct TraverseData *data)
{
    seq = seq.traverse(data);
    if (right)
	right = right->traverse(data);
    return this;
}

Expr * ElseExpr::traverse(struct TraverseData *data)
{   ExType type1, type2;
    struct VarStateList *save = NewVarState(data);
    if (e1.code() == Block_code) {
	/* This is essentially BlockTraverse(e1.block, data),
	 * except that the traverse of expr->then is pulled "inside" it.
	 */
	struct LoopConsExpr *saveLoops = data->visibleLoopConsList;
	BlockScan(e1.block(), data);
	BlockAssignFields(e1.block(), data);
	if (then)
	    then = then.traverse(data);
	BlockPopDecls(data, e1.block());
	data->visibleLoopConsList = saveLoops;
    } else {
	e1 = e1.traverse(data);
	if (then)
	    then = then.traverse(data);
    }
    SwapVarState(save, data);
    e2 = e2.traverse(data);
    MergeVarState(save, data);
    if (then.E == NULL)
	type1 = e2.E->type;
    else
	type1 = then.E->type;
    type2 = e2.E->type;
#if 0
    if (type1.kind != type2.kind || type1.ptr != type2.ptr)
	TrError(data, "W Inconsistent types for if"),
	type1 = ExTypePtr;
#endif
    type = type1;
    if (kind == 0
     && (e1.E->flags & ExprAtMostOneResult)
     && (e2.E->flags & ExprAtMostOneResult)
     && (then.E == (Expr*)NULL
      || then.E->flags & ExprAtMostOneResult))
	flags |= ExprAtMostOneResult;
    return this;
}

Expression *InverseExpr::traverse(struct TraverseData *data)
{
    arg = arg.traverse(data);
    func = func.traverse(data);
    return this;
}

Expression * C_Code::traverse(struct TraverseData *data)
{
    for (int i = 0; i < inserts; i++)
	insert[i].expr = insert[i].expr.traverse(data);
    return this;
}

Expression * CoerceSeqExpr::traverse(struct TraverseData *data)
{
    coercee = coercee.traverse(data);
    return this;
}

Expression * CoerceStringListExpr::traverse(struct TraverseData *data)
{
    coercee = coercee.traverse(data);
    return this;
}

Expr *
TraverseStdOp(struct ExprStdOp *ex, struct TraverseData *data)
{
    ExType type[2]; long i;
    int kind[2]; /* 0: any; 1: constant int; 2: signed or unsigned */
    for (i = 0; i < 2; i++) {
	Expr *arg = ex->arg[i].E->traverse(data);
	ex->arg[i].E = arg;
	type[i] = arg->type;
	if (ExType_Kind(type[i]) >= ExSignedType) kind[i] = 2;
#if 0
	else if (ExprCodeOf(arg)==ExprQuote_code)
	    if (HasAType(arg->quote.quotee,FixNumT)) kind[i] = 1;
	    else kind[i] = 0;
#endif
	else kind[i] = 0;
    }
#if 0
    if (kind[0] == 1 && kind[1] == 1) {
	extern struct Any ApplyPlus();
	switch (ExprCodeOf((Expr*)ex)) {
	  case PlusOp_code:
	    return new ExprQuote(
		ApplyPlus(ex->arg[0].quote->quotee, ex->arg[1].quote->quotee));
	  default:
	    ex->type = ExTypePtr;
	    return (Expr*)ex;
	}
    }
#endif
    if (kind[0] > 0 && kind[1] > 0) {
	int len0 = kind[0]==2 ? ExType_BitSize(type[0]) : 32;
	int len1 = kind[1]==2 ? ExType_BitSize(type[1]) : 32;
	if (len1 > len0) len0 = len1;
	if (kind[0]==1 || kind[1]==1) ex->type = MakeSignedType(len0);
	else if (ExType_Kind(type[0]) == ExUnsignedType
	 && ExType_Kind(type[1]) == ExUnsignedType)
	    ex->type = MakeUnsignedType(len0);
	else
	    ex->type = MakeSignedType(len0);
	if (kind[0]==1) ex->arg[0].set_val_type(ex->type);
	if (kind[1]==1) ex->arg[1].set_val_type(ex->type);
	switch (ExprCodeOf((Expr*)ex)) {
	  case PlusOp_code:
	    if (ExprCannotFail & ex->arg[0]->flags & ex->arg[1]->flags)
		ex->flags |= ExprCannotFail;
	    if (ExprAtMostOneResult
	      & ex->arg[0]->flags & ex->arg[1]->flags)
		ex->flags |= ExprAtMostOneResult;
	    break;
	  default:
	    break;
	}
    }
    else ex->type = ExTypePtr;
    return (Expr*)ex;
}

Expr *
TraverseCoerce(struct ExprStdOp *ex, struct TraverseData *data)
{
    if (ex->arg[1].E != NULL) {
	ex->arg[1] = ex->arg[1].traverse(data);
	ex->type = MakeExType(ExPointerType, ExprToType(ex->arg[1].E, data));
	if (ExprCodeOf(ex->arg[0].E) == ElseExpr_code) {
	    struct ElseExpr *els = ex->arg[0].or();
	    struct ExprStdOp *op;
	    if (els->kind || els->then.E != (Expr*)NoValue) {
		op = AllocStdOp(Coerce_code, 2);
		op->arg[1] = ex->arg[1];
		op->type = ex->type;
		if (els->kind) op->arg[0] = els->e1, els->e1 = op;
		else op->arg[0] = els->then, els->then = op;
		ex->arg[0] = els->e2;
		els->e2 = ex;
		return els->traverse(data);
	    }
	}
    }
    ex->arg[0] = ex->arg[0].traverse(data);
    return ex;
}

int TypeIsInt(ExType type)
{
#if 0
    if (ExType_Kind(type) >= ExSignedType) return 1;
    if (ExType_Kind(type) == ExPointerType)
	if (ExType_Type(type) == FixNumT) return 2;
	else if (ExType_Type(type) == IntT) return 2;
#endif
    return 0;
}

Expr *
CopyExpr(Expr *p, struct TraverseData *data)
{
    if (p == NULL) return NULL;
    switch (ExprCodeOf(p)) {
      case Identifier_code:
      {
	struct Identifier *oldId = (struct Identifier*)p;
	struct Identifier *newId = NewIdentifier(oldId->name, NULL);
	*newId = *oldId;
	*data->identPtr = newId;
	data->identPtr = &newId->next;
	return newId;
      }
      default:
	TrError(data,
	"W internal - copying expression other than identifier");
	return p;
    }
}

struct Statement *
CopyStatement(struct Statement *st, struct TraverseData *data)
{
    struct Statement *new_st = new Statement;
    struct Identifier **saveIdentPtr = data->identPtr;
    data->identPtr = &new_st->idList;
    *new_st = *st;
    new_st->src.E = CopyExpr(st->src.E, data);
    *data->identPtr = NULL;
    data->identPtr = saveIdentPtr;
    return new_st;
}

Expression * Expression::traverse(register struct TraverseData *data)
  { /* int n = 0; * # of substitutions performed */
    register Expr * p = this;

    switch (code()) {
      case ExprNode_code: return TraverseExprNode((struct ExprNode*)p, data);
#if 0
      case ExprQuote_code:
	if (p->quote.quotee.type == FixNumT)
	    p->any.type = MakeExType(ExPointerType, FixNumT);
	return p;
      case SelectExpr_code: return SelectTraverse(p, data);
      case ExtractExpr_code: return TraverseExtract(p, data);
      case RegExpr_code: return p;
      case MoveExpr_code: return TraverseMoveExpr(p, data);
      case TypeDefExpr_code: return TypeDefTraverse(p, data);
      case LabelExpr_code: return TraverseLabelExpr(p, data);
      case GotoExpr_code: return TraverseGoto(p, data);
      case ReturnExpr_code: return TraverseReturn(p, data);
#endif
      case External_code:
	return p;
#if 0
      case Length_code:
	p->bin.arg[0] = p->bin.arg[0].traverse(data);
	p->any.type = MakeSignedType(32);
	return p;
      case Reduce_code:
      case MakeTuple_code:
      case ListChoose_code:
      case Collect_code:
      case SetSort_code:
	p->bin.arg[0] = p->bin.arg[0].traverse(data);
	p->any.type = ExTypePtr;
	return p;
#endif
      case Coerce_code: return TraverseCoerce((ExprStdOp*)p, data);
      default:
	if (IsStdOpCode(p->code()))
	    return TraverseStdOp((struct ExprStdOp *)p, data);
	TrError(data, "W Unknown type code (%d) during traversal",
		p->code());
	return p;
    }
  }

void TrError(struct TraverseData *data, char *format, ...)
{
    va_list ap;
    int level = CheckErrorLevel(format);
    struct Location *sourcePos;
    if (level >= 0) format += 2;
    else level = ErrMessage;
    if (data == NULL)
	sourcePos = NULL;
    else
      {
	sourcePos = &data->sourcePos;
	if (level > data->errors) data->errors = level;
      }
    va_start(ap, format);
    ErrorPrint(TraverseTimeErr, level, sourcePos, stderr, format, ap);
    va_end(ap);
    fflush(stderr);
}

struct Block *
TraverseForEval(struct Block *block, struct TraverseData *data)
{   extern int Optimizing;
    if (LogExpr & 2)
	cout << "Parsed:{ " << *block << " }\n";
    /* traverse the whole expression tree */
    data->pass = BindPass;
#if 1
//    block = &ExprTraverse(block, data)->block;
    block->bl_traverse(data);
#else
    BlockScan(block, data);
 /* leave out:  BlockPopDecls(data, block); from BlockTraverse */
    BlockAssignFields(block, data);
#endif

    PopPendingProcs(data);

    if (Optimizing) {
	if (LogExpr & 2) {
	    cerr << "Traversed:{ " << *block << " }\n";
	}
	data->pass = OptPass;
	BlockScan(block, data);
	/* leave out:  BlockPopDecls(data, block); from BlockTraverse */
	BlockAssignFields(block, data);
    }
    if (LogExpr & 1) {
	cerr << (Optimizing ? "Optimized:{ " : "Traversed:{ ");
	cerr << *block << " }\n";
    }
    return block;
}
