/* Copyright Per Bothner 1987. Read the file Q-INFO */
#include <stdio.h>
#include <stdlib.h>
#include <types.h>
//#include <hash.h>
#include "genmap.h"
#include "expression.h"
#include "loopcons.h"
#include "exceptions.h"
#include <parsefile.h>
#include <debug.h>
#include <tempbuf.h>
#include "reader.h"
#include <parsestream.h>
#include <fstream.h>
#include "vtablename.h"
#include "builtin-syms.h"
#include "mapping.h"
#include <ctype.h>
#include "shell.h" /* For RemoveQuotes */
extern "C" {
#include <string.h>
#ifdef DLD
#include "../dld/dld.h"
#include "a.out.h"
#endif
}
#include "modules.h"

#if 0
static struct Macro * GetToken(struct ParseFile *ff)
/* return a macro if found; otherwise NULL */
{
   return NULL;
}
#endif

extern Root *decode_label_to_object(char *label);
extern int ParseBackslash(register InStream *ff);
extern Expr* SchemeReadExpr(InStream * stream);
extern Expr* LispReadExpr(InStream * stream);
extern Expr *ParseReject2(struct ParseFile *ff);
extern HashTable *MacroTab, *GlobalSymbols;
int CompilePrimitiveData = 0;
extern struct ParamExpr *
  AddParam(struct ParseFile *ff, struct ProcExpr *fnc, int side, Expr *arg);

Expr * GetLeftExpr(struct ParseFile *ff, int left_also = 0)
{   Expr *cur;
    if ((cur = ff->cur) == NULL)
	if (left_also && ff->left != NULL) {
	    cur = ff->left;
	    ff->left = NULL;
	}
	else
	    cur = NullExpr;
    ff->cur = NULL;
    return cur;
}

int CountIndentation(char *start, char *pos, int i = 0)
{   register char *ptr = start;
    while (ptr < pos) {
	register ch = *ptr++;
	if (ch >= ' ') i++; // Assumes ASCII!
	else if (ch == '\t') i = (i & ~7) + 8;
	else if (ch == '\b') i--;
	else if (ch == '\n' || ch == '\r' || ch == ('L' & 31)) i = 0;
	else i++;
    }
    return i;
}

int CountCurrentIndentation(struct ParseFile *ff)
{
#if 0
    if (ff->current != ff->readLimit)
	ParseError(ff, "W bad call on CountCurrentIndentation");
#endif
//    return CountIndentation(ff->bufStart(), ff->curPtr());
    return ff->pbuf()->tell_in_line();
}

// Add 'decl' to the end of chain 'end'.

void ChainDeclaration(struct Declaration **&end, struct Declaration *decl)
{
    decl->dummyNextField.set_fchain(*end);
    *end = decl;
    end = &decl->next();
}

struct Statement *
LinkStatement(struct Statement **ptr, Expr *val)
{
    Statement *st = GC_NEW Statement;
    st->sourcePos.set_unknown();
    st->src.E = val;
    st->next = *ptr;
    st->idList = NULL;
    st->flags = 0;
    st->kind = ExprStatement;
    *ptr = st;
    return st;
}

struct Statement * AppendStatement(struct Block *block, Expr *val)
{
    struct Statement *st = LinkStatement(block->last, val);
    block->last = &st->next;
    return st;
}

// Add 'decl' to 'block'.
// Also add a statement initializing 'decl' to the value of 'val'.

UnifyExpr* AppendDeclaration(Block* block, Declaration* decl, Expr* val)
  {
    struct Identifier *id = Decl2Ident(decl);
    struct Statement *st;
    struct UnifyExpr *eq = GC_NEW UnifyExpr((Expr*)id, val);
//if (id->flags & IdentNesting)
//fprintf(stderr, "IdentNesting for %X in AppendDeclaration\n", id);
    id->flags |= IdentExplicit;
    decl->defining.E = val;
    decl->blockLevel = block->level;
    AddDeclaration(block, decl);
    st = AppendStatement(block, (Expr*)eq);
    st->kind = ClosureStatement;
    eq->set = 1;
    return eq;
  }

struct ExprCall * AllocExprCall(int i, Expr_Ptr *args)
  { struct ExprCall *callEx = (struct ExprCall*)
	malloc(sizeof(struct ExprCall) + (i-1)*sizeof(Object));
    callEx->clear_std_fields(ExprCall_code);
    callEx->args = i;
    callEx->offset = 0;
    if (args != NULL)
	for (i = callEx->args; --i>=0; ) callEx->arg[i] = args[i];
    return callEx;
  }

#if 0
struct ExprCall *
ParseNew(struct ParseFile *ff)
  { struct ExprCall *callEx;
    Expr_Ptr type;
    type.E = ParseLook(ff, DefaultPrio<<4);
    if (IsNullExpr(type.E))
	type.P = NullExpr;
    callEx = AllocExprCall(1, &type);
    callEx->kind = 0;
    callEx->proc.name = EnterSymbol("NewResettableVar");
    return callEx;
  }

static Expr * ParseExclam(struct ParseFile *ff)
  { struct ExprCall *callEx;
    Expr_Ptr ex;
    ex.E = ParseLook(ff, ONEprio);
    if (IsNullExpr(ex.E))
      {
	ParseError(ff, "%s must be followed by primary expression", ff->macro);
	return (struct ExprCall*)FailedParse;
      }
    callEx = AllocExprCall(1, &ex);
    callEx->kind = 0;
    callEx->proc.name = EnterSymbol("NewConstSeq");
    return callEx;
  }
#endif

static Expr * CheckLeftExpr(struct ParseFile *ff, Expr *ex, Expr **ptr)
/* ptr is a subfield of ex and is meant to contain a prefix expression.
 * if *ptr==FailedParse, return a postfix function x$=>ex, with *ptr==x.
 */
  {
    if (*ptr == FailedParse)
      { struct Declaration *param_decl = Symbol2Declaration(NULL);
	*ptr = Decl2Ident(param_decl);
#if 1
	abort();
#else
	return MakePostfixLambda(param_decl, ex, ff);
#endif
      }
    return ex;
  }

Expr *
ParseInverse(struct ParseFile *ff)
  { struct InverseExpr *expr = GC_NEW InverseExpr();
    char saveTerminators = ff->terminators;
    SetStdExprFields(expr, ff); expr->set_code(InverseExpr_code);
    expr->arg.E = GetLeftExpr(ff);
    ff->terminators |= ParseLParenSinceSpace;
    ff->nesting++;
    expr->func.E = ParseLook(ff, ONEprio);
    ff->nesting--;
    ff->terminators = saveTerminators;
    return CheckLeftExpr(ff, expr, &expr->arg.E);
  }

Expr *ParseParens(register struct ParseFile *ff)
{
    unsigned char saveTerminators = ff->terminators;
    struct Location saveLoc = SourceLocation(ff);
    ff->terminators = ParsePeekOK|ParseLParenSinceSpace;
    ff->nesting++;
    const StringC * save_nesting_kind = ff->nesting_kind;
    ff->nesting_kind = &PARENS_str;
    ExprList* ex = ParseList(ff);
    ff->nesting_kind = save_nesting_kind;
    ff->nesting--;
    ff->terminators = saveTerminators;
    int ch = ff->get();
    if (ch  != ')') {
        ParseError(ff,
	     "Left parenthesis at line %d has no closing right parenthesis",
	     saveLoc.lineNo);
	return FailedParse;
    }
    ex->flags |= ExprHasParens;
    return ex;
}

void AddIdentifier(Identifier *id, ParseFile *ff, enum Privacy privacy)
{
    id->set_location(SourceLocation(ff));
    struct Declaration *decl = Symbol2Declaration(id->symbol());
    decl->setPrivacy(privacy);
    ff->unclaimed_decls.add(decl);
//    id->v.decl = decl; Leave this for Identifier::traverse
}

struct Identifier *
AddIdentifier(Symbol *name, ParseFile *ff, enum Privacy privacy)
{
    struct Identifier *id = NewIdentifier(name, ff);
    AddIdentifier(id, ff, privacy);
    return id;
}

Expr *GetUnquotedPart(struct ParseFile *ff)
/* Parse word(s) following a '$' */
{
    Expr *exp;
    int c = ff->get();
    if (c=='(')
	exp = ParseParens(ff);
#if 0
    else if (c == ' ' || c == '\t')
	exp = NewIdentifier(CCharToChar(c), NULL);
#endif
//    else if (c == '\n') ; /* skip it */
    else if (c==':') {
	struct Identifier *id = ParseIdentifier(ff);
	if (id == NULL) {
	    ParseError(ff,
		       "The token `$:' must be followed by an identifier.\n");
	    return NullExpr;
	}
	id->set_location(SourceLocation(ff));
	AddIdentifier(id, ff, IsPrivate);
	id->flags |= IdentExplicit;
	exp = id;
    }
    else if (Letter(c)) {
	ff->putback(c);
	struct Identifier *id = ParseIdentifier(ff);
	id->set_location(SourceLocation(ff));
	exp = id;
    }
    else {
	ff->putback(c);
	ParseError(ff, "Bad character following `$'");
	return NullExpr;
    }
    return exp;
}

#if 0
int ExprLinkCount(register struct ExprLink *link)
{
    register int count = 0;
    for ( ; link; link = link->next) count++;
    return count;
}
#endif

struct Identifier * ParseIdentifier(ParseFile* ff)
{
    int is_quoted = 0;
    int c = ff->get();
    if (!Alphameric(c) && c != '\\')
	return NULL;
    TempBuf cbuf;
    TempBuf qbuf;
//    cbuf.set_size(0);
    do {
	if (c == '\\') {
	    c = ff->get();
	    if (c == EOF) { // ERROR!
		break;
	    }
	    if (c == '\n')
		goto next_char;
	    if (!is_quoted) { // Mark previous characters as not quoted.
		for (is_quoted = cbuf.size(); --is_quoted >= 0; )
		    qbuf.put(0);
		is_quoted = 1;
	    }
	    qbuf.put(1);
	}
	else if (is_quoted)
	    qbuf.put(0);
	cbuf.put(c);
      next_char:
	c = ff->get();
	if (c == EOF) break;
    } while (Alphameric(c) || c == '\\');
    if (c != EOF) ff->putback(c);
    if (cbuf.size() == 0)
	return NULL;
    Identifier *id =
	NewIdentifier(EnterSymbol(cbuf.string(), cbuf.size()), NULL);
    id->set_location(SourceLocation(ff));
    if (is_quoted) {
	id->quoted_chars = qbuf.copy();
    }
    return id;
}

#if 0
Expr *MakeQuotedWord(Expr_Ptr *list)
{
    int count = 0;
    for (register Expr_Ptr *ptr = list; ptr->E; ptr++) count++;
    struct MakeSymbolExpr *lexpr = GC_NEW MakeSymbolExpr();
    lexpr->arg = list;
    lexpr->length = count;
#if 1
//    if (0) // (lexpr->length == 1)
//    return lexpr->arg[0].E;
#else
    if (lexpr->length == 1 && lexpr->list->flags == 0)
	return (Expr*)DoQuote(lexpr->list->symbol());
#endif
    return (Expr*)lexpr;
}
#endif

Expr *ParseQuotedString(struct ParseFile *ff)
{
    TempPtrBuf sub_exprs;
    TempBuf char_buf;
    struct Location saveLoc;
    const StringC * save_nesting_kind = ff->nesting_kind;
    ff->nesting_kind = &QUOTES_str;
    int len;
    int done = 0;
//    struct ExprLink *chain = NULL, **ptr = &chain; 
    struct MakeStringExpr *lexpr;
    Expr *exp;
    saveLoc = SourceLocation(ff);
    for (;;) {
	int c = ff->get();
	if (c == EOF) goto bad_eof;
	if (c == '"') {
	    c = ff->get();
	    if (c == EOF) done = 1;
	    else if (c  == '"') {
		char_buf.put(c);
		continue;
	    } else {
	        ff->putback(c);
		done = 1;
	    }
	}
	if (c == UnquoteChar && !done) {
	    int c2 = ff->get();
	    if (c2 == EOF) goto bad_eof;
	    if (c2 == ' ' || c2 == '\t' || c2 == UnquoteChar) {
		char_buf.put(c2);
		continue;
	    }
	    else
	        ff->putback(c2);
	}
	if (c == UnquoteChar || done) {
	    len = char_buf.size();
	    if (len != 0 /* || done && sub_exprs.count() == 0*/) {
		exp = DoQuote(NewString(len, char_buf.string()));
		char_buf.set_size(0);
		sub_exprs.putp(exp);
	    }
	    if (done) break;
	    /* now, c == UnquoteChar */
	    sub_exprs.putp(GetUnquotedPart(ff));
	}
	else {
	    if (c == '\\') {
		c = ff->get();
//		if (c == ' ' || c == '\t') {
//		} else
		    if (c != EOF) {
		    ff->putback(c);
		    c = ParseBackslash(ff);
		}
		if (c == EOF) goto bad_eof;
	    }
	    char_buf.put(c);
	}
    }
    lexpr = GC_NEW MakeStringExpr();
//    *ptr = NULL;
//    lexpr->list = chain;
    lexpr->length = sub_exprs.count();
    sub_exprs.putp(NULL);
    lexpr->arg = (Expr_Ptr*)sub_exprs.copy(0);
    ff->nesting_kind = save_nesting_kind;
    return (Expr*)lexpr;
  bad_eof:
    ff->nesting_kind = save_nesting_kind;
    ParseError(ff,
        "non-terminated string, started at line %d", saveLoc.lineNo);
    return NullExpr;  
}
Expr *ParseWord(struct ParseFile *ff)
{
    TempPtrBuf sub_exprs;
    TempBuf char_buf;
    struct Location saveLoc;
    int len;
    int done = 0;
//    struct ExprLink *chain = NULL, **ptr = &chain; 
    struct MakeStringExpr *lexpr;
    Expr *exp;
    saveLoc = SourceLocation(ff);
    for (;;) {
	int c = ff->get();
	if (c == EOF) break;
	if (c == UnquoteChar && !done) {
	    int c2 = ff->get();
	    if (c2 == EOF) goto bad_eof;
	    if (c2 == ' ' || c2 == '\t' || c2 == UnquoteChar) {
		char_buf.put(c2);
		continue;
	    }
	    else
	        ff->putback(c2);
	}
	else if (c != '\\' && !Alphameric(c)) {
	    ff->putback(c);
	    done=1;
	}
	if (c == UnquoteChar || done) {
	    len = char_buf.size();
	    if (len != 0 /* || done && sub_exprs.count() == 0*/) {
		exp = DoQuote(NewString(len, char_buf.string()));
		char_buf.set_size(0);
		sub_exprs.putp(exp);
	    }
	    if (done) break;
	    /* now, c == UnquoteC */
	    sub_exprs.putp(GetUnquotedPart(ff));
	}
	else {
	    if (c == '\\') {
		c = ff->get();
		if (c == EOF) goto bad_eof;
	    }
	    char_buf.put(c);
	}
    }
    lexpr = GC_NEW MakeStringExpr();
//    *ptr = NULL;
//    lexpr->list = chain;
    lexpr->length = sub_exprs.count();
    sub_exprs.putp(NULL);
    lexpr->arg = (Expr_Ptr*)sub_exprs.copy(0);
    return (Expr*)lexpr;
  bad_eof:
    ParseError(ff,
        "non-terminated word, started at line %d", saveLoc.lineNo);
    return NullExpr;  
}

Expr* ParseQuote(struct ParseFile *ff)
{
    return GC_NEW MakeSymbolExpr(ParseWord(ff));
}

extern void * init_address;

#ifdef DLD
extern void my_dld_init();
#else
EXTERN void linkload(FILE *fp);
#endif

Root * LoadValue = NULL;

Expr *ParseLoad(struct ParseFile *ff)
{
    int ch = ScanBlanks(ff);
    if (ch != EOF) ff->putback(ch);
    Expr *name_expr = ParseLook(ff, ONEprio);
    name_expr = name_expr->quote_words();
    char *mod_name = NULL;
    Module *module;
    if (name_expr->code() == ExprQuote_code) {
	StringList *s = (StringList*)((ExprQuote*)name_expr)->value();
	if (StringsCount(s) == 1) {
	    mod_name = RemoveQuotes(StringsPtr(s)[0])->chars();
	    module = CheckModule(mod_name);
	}
    }
    return GC_NEW LoadExpr(name_expr, module);
#if 0
#if 1
    if (mod_name == NULL) {
#else
    if (name_expr->code() == Identifier_code) {
	mod_name = ((Identifier*)name_expr)->symbol()->string();
    } else if (name_expr->code() == MakeString_code &&
	       ((MakeStringExpr*)name_expr)->length == 1 &&
	       ((MakeStringExpr*)name_expr)->arg[0].code() == ExprQuote_code) {
	mod_name = ((StringC*)name_expr->eval(NULL))->start_addr();
    }
    else {
#endif
	ParseError(ff, "Bad argument to LOAD");
	return NullExpr;
    }
    fprintf(stderr, "[Load %s]\n", mod_name);
//    Module *module = CheckModule(mod_name);
#ifdef DLD
    my_dld_init();
    if (dld_link(mod_name)) {
	dld_perror ("dld: Load failed");
	ParseError(ff, "Cannot LOAD %s", mod_name);
	return NullExpr;
    }
    LoadValue = &NullSequence;
    if (dld_undefined_sym_count) {
	char ** missing_syms = dld_list_undefined_sym();
#define SymPrefix "_KEY$"
#define SymPrefixLength 5
	for (int i = dld_undefined_sym_count; --i >= 0; ) {
	    char *missing_sym = missing_syms[i];
	    Root *val = decode_label_to_object(missing_sym);
	    if (val)
		dld_define_sym_as(missing_sym, val, N_DATA | N_EXT);
	    else
		fprintf(stderr, "[Undefined symbol: %s]\n", missing_sym);
	}
	free(missing_syms);
    }
    if (!dld_undefined_sym_count) {
	Func func;
	func = (Func)dld_get_func(/*UNDERSCORE*/ "__CTOR_LIST__");
	if (func) {
	    fprintf(stderr, "[__CTOR_LIST__]\n");
	    (*func)();
	}
	func = (Func)dld_get_func(/*UNDERSCORE*/ "_GLOBAL_$I$F__Fi");
	if (func) {
	    fprintf(stderr, "[_GLOBAL_$I$F__Fi]\n");
	    (*func)();
	}
    }
#else
    FILE *fp = fopen(mod_name, "r");
    if (fp == NULL) {
	ParseError(ff, "Cannot LOAD %s", mod_name);
	return NullExpr;
    }
    linkload(fp);
    fclose(fp);
    if (init_address) {
	(*(Func)init_address)();
    }
#endif
    return DoQuote(LoadValue);
#endif
}

Expr * ParseMakeTuple(struct ParseFile *ff)
{
    int ch = ff->get();
    if (ch == '|') { // SetPriority(11, DefaultPrio);
	struct ExprStdOp *expr = AllocStdOp(ListChoose_code, 1);
	expr->set_location(SourceLocation(ff));
	expr->arg[0].E = GetLeftExpr(ff);
	return expr;
    }
    else if (ch == '?') { // SetPriority(11, DefaultPrio);
	struct ExprStdOp *expr = AllocStdOp(Length_code, 1);
	expr->set_location(SourceLocation(ff));
	expr->arg[0].E = GetLeftExpr(ff);
	return expr;
    }
    else if (ch != EOF)
	ff->putback(ch);
    Expr *right = ParseLook(ff, ONEprio);
    if (IsNullExpr(right)) 
	right = NULL;
    MakeTupleExpr *texpr = GC_NEW MakeTupleExpr(GetLeftExpr(ff), right);
    texpr->set_location(SourceLocation(ff));
    return texpr;
#if 0
    ExprList *elist = GC_NEW ExprList(2);
    elist->flags |= ExprOneWord;
    elist->arg[0].E = DoQuote(&ReduceFunc);
    elist->arg[1].E = right;
    return elist;
#endif
}

Expr * ParseBrackets(struct ParseFile *ff)
{
#if 1
    int ch;
    // Look ahead for: [:name:] - used for regexes.
    ch = ff->get();
    if (ch == ':') {
	int old_pos = ff->pbuf()->tell_in_line() - 1;
	for (;;) {
	    ch = ff->get();
//	    if (ch == EOF) break;
	    if (isalnum(ch)) continue;
	    if (ch != ':')
		break;
	    ch = ff->get();
	    if (ch != ']') break;
	    int len = ff->pbuf()->tell_in_line() - (old_pos - 1);
	    ff->pbuf()->seek_in_line(old_pos-1);
	    StringC* name = NewString(len);
	    ff->pbuf()->sgetn(name->chars(), len);
	    return GC_NEW QuoteOnlyExpr(name);
	    
	}
	ff->pbuf()->seek_in_line(old_pos);
    }
    else if (ch != EOF)
	ff->putback(ch);
    TempPtrBuf sub_exprs;
//    struct ExprLink *link;
//    struct ExprLink **ptr;
    struct ListConsExpr *lexpr;
    int count = 0;
    lexpr = GC_NEW ListConsExpr();
    SetStdExprFields(lexpr, ff); lexpr->set_code(ListCons_code);

//    ptr = &lexpr->list;
    for (;;) {
	unsigned char saveTerminators = ff->terminators;
	ff->terminators &= ~ParseAcceptRParen;
	Expr *ex = ParseLook(ff, WRDprio);
	ff->terminators = saveTerminators;
	if (IsNullExpr(ex)) {
	    ch = ff->get();
	    if (ch == '\n')
		continue;
	    if (ch == ']')
		break;
	    else {
		ParseError(ff, "Missing right bracket ']'");
		return FailedParse;
	    }
	}
//	link = (struct ExprLink*)malloc(sizeof(struct ExprLink));
//	link->expr.E = ex;
	if (ex->code() == MakeTuple_code)
	    lexpr->flags |= ConsTupled;
	if (ex->code() == MapPair_code)
	    lexpr->flags |= ConsMapping;
//	*ptr = link;
//	ptr = &link->next;
	sub_exprs.putp(ex);
	count++;
    }
//    *ptr = NULL;
    lexpr->length = count;
    sub_exprs.putp(NULL);
    lexpr->arg = (Expr_Ptr*)sub_exprs.copy(0);
    return (Expr*)lexpr;
#else
    struct ExprCall *cons;
    Expr *ex;
    Expr_Ptr car_cdr[2];
  retry:
    car_cdr[0].E = ex = ParseLook(ff, WRDprio);
    if (IsNullExpr(ex))
      { Object in = getob(ff); extern struct Type Macro;
	if ((Object)ob == CCharToChar('\n')) goto retry;
	else if (!HasHType(ob, Macro) || ob->name != EnterSymbol("]"))
	    ParseErr0(ff, "Missing right bracket ']'");
	else
	    return (Expr*)DoQuote(EmpArray);
      }
    car_cdr[1].E = ParseBrackets(ff);
    cons = AllocExprCall(2, car_cdr);
    cons->kind = 0;
    cons->proc.name = "Cons";
    return (Expr*)cons;
#endif
  }

Expr * ParseIndex(struct ParseFile *ff)
{
    struct ExprStdOp *expr = GC_NEW IndexExpr();
    expr->set_location(SourceLocation(ff));
    expr->arg[0] = GetLeftExpr(ff);
    expr->arg[1] = NewIdentifier(&_INDEX__sym, NULL);
    return (Expr*)expr;
}

Expr *
ParsePostfix(struct ParseFile *ff)
  {
    Expr *left = GetLeftExpr(ff);
    Expr *right = ParseLook(ff, WRDprio);
    struct ExprNode *ex = NewExprNode(left, right);
    ex->postfix = 1;
    return CheckLeftExpr(ff, ex, &ex->arg.E);
  }

Expr *
ParseLastfix(struct ParseFile *ff)
  {
    Expr *left = GetLeftExpr(ff);
    struct ExprNode *ex = NewExprNode(left, NULL);
    ex->postfix = 2;
    return CheckLeftExpr(ff, ex, &ex->arg.E);
  }

Expr *
ParseNoLastfix(struct ParseFile *ff)
  {
    Expr *expr = GetLeftExpr(ff);
    if (expr == NULL
    || (expr->code() != Identifier_code
	&& expr->code() != ExprNode_code))
	ParseError(ff, "Bad use of NOLASTFIX");
    else expr->flags |= LastfixProtect;
    return expr;
  }

#if 0
Expr*
ParseDirect(struct ParseFile *ff)
  { struct ExprCall *callEx;
    Expr_Ptr type;
    type.E = ParseLook(ff, ONEprio);
    if (IsNullExpr(type.E))
	ParseError(ff, "DIRECT must be followed by type or integer expression");
    callEx = AllocExprCall(1, &type);
    callEx->kind = 0;
    callEx->proc.name = EnterSymbol("MakeDirectField");
    return callEx;
  }

char *MakeBytesName = "MakeBytesType";
struct ExprCall *
ParseBytes(struct ParseFile *ff)
  { struct ExprCall *callEx;
    Expr *n = ParseLook(ff, ONEprio);
    if (n == NULL || !HasHType(n, FixInt))
	ParseError(ff, "BYTES must be followed by integer constant");
    callEx = AllocExprCall(1, &n);
    callEx->kind = 0;
    callEx->proc.name = MakeBytesName;
    return callEx;
  }
#endif

#if 0
Expr *
ParseDeref(struct ParseFile *ff)
  {
    Expr_Ptr var;
    struct ExprCall *callEx;
#if 0
    if (ff->terminators & DebugParse) return (Expr*)ParseDebugAt(ff);
#endif
    var.E = GetLeftExpr(ff);
    callEx = AllocExprCall(1, &var);
    callEx->kind = 0;
    callEx->proc.name = EnterSymbol("DerefVar");
    return (Expr*)callEx;
  }
#endif

Expr *ParseCollect(struct ParseFile *ff)
{
    struct ExprStdOp *expr = AllocStdOp(Collect_code, 1);
    expr->set_location(SourceLocation(ff));
    expr->arg[0].E = ParseLook(ff, 15);
    return (Expr*)expr;
}

Expr *ParseSetSort(struct ParseFile *ff)
{
    struct ExprStdOp *expr = AllocStdOp(SetSort_code, 1);
    expr->set_location(SourceLocation(ff));
    expr->arg[0].E = ParseLook(ff, 11);
    return (Expr*)expr;
}

Expr *ParseBinOp(struct ParseFile *ff, enum ExprCode code, int rPrio)
{
    struct MapPairExpr *expr = GC_NEW MapPairExpr();
    expr->set_location(SourceLocation(ff));
    expr->arg[0].E = GetLeftExpr(ff);
    expr->arg[1].E = ParseLook(ff, rPrio<<4);
    return (Expr*)expr;
/*    return CheckLeftExpr(ff, expr, &expr->arg.E); */
}

Expr *ParseDefException(struct ParseFile *ff)
{
    struct ExprStdOp *expr = AllocStdOp(DefException_code, 2);
    expr->set_location(SourceLocation(ff));
    expr->arg[0].E = GetLeftExpr(ff);
    expr->arg[1].E = ParseLook(ff, WRDprio);
    return (Expr*)expr;
}
Expr *ParseWhen(struct ParseFile *ff) { return ParseBinOp(ff, WhenOp_code, 6);}
Expr *ParseConcat(struct ParseFile *ff) {return ParseBinOp(ff,Concat_code,9);}
Expr *ParseSetDiff(struct ParseFile *ff){return ParseBinOp(ff,SetDiff_code,9);}

#if 0
Expr *ParseRange(struct ParseFile *ff) { return (Expr*)DoQuote(&Iota); }
#endif

#if 0
Expr *ParseTake(struct ParseFile *ff) {return ParseBinOp(ff, TakeOp_code, 7);}
Expr *ParseDrop(struct ParseFile *ff) {return ParseBinOp(ff, DropOp_code, 7);}
extern Expr *ParseBitField(struct ParseFile *, int);
Expr *ParseSigned(struct ParseFile *ff) { return ParseBitField(ff, 0); }
Expr *ParseUnsigned(struct ParseFile *ff) { return ParseBitField(ff, 1); }
Expr *ParseBits(struct ParseFile *ff) { return ParseBitField(ff, 2); }
Expr *ParseBytes(struct ParseFile *ff) { return ParseBitField(ff, 3); }

struct Identifier *
MakeLookup(Symbol * name, Symbol * label)
  { struct Declaration *decl = Symbol2Declaration(name);
  /* decl->blockLevel = 0; -- redundant */
    MakeLabelToken(&decl->u.token, SymbolString(label), 0, 0);
    decl->flags |= SetDeclaration|LookupDeclaration;
    return Decl2Ident(decl);
  }

Expr *
ParseLookup(register struct ParseFile *ff)
  { Symbol * label = ParseIdent(ff);
    Expr_Ptr id;
    if (label == NULL)
      {
	ParseError(ff, "LOOKUP most be followed by label (an identifier)");
	return FailedParse;
      }
    int ch = ff->get();
    if (ch == ':') {
	RootPtr var = (RootPtr)AllocVariable(label);
	struct UnifyExpr *ex =
	    GC_NEW UnifyExpr((Expr*)DoQuote(var), ParseLook(ff, 8<<4));
	register struct Declaration *decl = Symbol2Declaration(label);
	decl->flags |= LookupDeclaration;
/*	AddGlobalLabel(label->string(), var); */
	decl->set_value(var);
/* 	MakeLabelToken(&decl->u.token, NULL, var, 0); */
	decl->next = ff->module->lookupDecls;
	ff->module->lookupDecls = decl;
	return (Expr*)ex;
    }
    id = MakeLookup(label, label);
    id.ident()->name = NULL;
    ff->putback(ch);
    return id.E;
  }
#endif

extern struct LabelExpr *AllocLabel();

#if 0
Expr *
ParseLoop(struct ParseFile *ff)
  { struct Block *block; Expr *body;
    struct LabelExpr *top;
    struct BlockSave save[1];
    TestPushBlock(save, ff);
    ff->block = block = GC_NEW Block(ff->saveBlock);;
    block->flags |= BlockIsReturnable;
    top = AllocLabel(NULL, NULL, block);
    AppendStatement(block, top);

/*    SetStdExprFields(expr, ff); */
    body = ParseOne(ff, EOLprio);
    CheckEndLabel(ff, ff->macro);
    if (body == FailedParse)
      {
	ParseError(ff, "Bad expression after %s", ff->macro);
	return FailedParse;
      }
    AppendStatement(block, AllocGotoExpr(top, NoValue));
    if (&body->block != block)
	ParseError(ff, "ParseLoop confusion: ex=#%X != block=#%X",
	    body, block);
    TestPopBlock(save);
    return (Expr*)block;
  }
#endif

#if 0
Expr * ParseCall(struct ParseFile *ff)
  { struct ExprCall *callEx; int i, kind;
    Expr_Ptr buf[20], *tPtr = buf;
    FILE *f = ff->file;
    int c;
    struct Location loc;
    Symbol * ss;
    Symbol * cmd = ff->macro;
    loc = SourceLocation(ff);
    ss = ParseIdent(ff);
#ifdef COMPILER
    kind = 0;
#else
    kind = (cmd == sCallC ? 7 : cmd == sCallR ? 5 : cmd == sCall ? 3 : 0);
#endif
    if (ss == NULL)
      {
	kind++;
	ss = (Symbol *)ParseLook(ff, ONEprio);
	if (IsNullExpr((Expr*)ss))
	  {
	    ParseError(ff, "No procedure following %s", ff->macro);
	    return FailedParse;
	  }
      }
    for (i = 0; ; i++)
      {
	Expr_Ptr ex;
	ex.E = ParseLook(ff, WRDprio);
	if (IsNullExpr(ex.E)) break;
	if (i > 20)
	  {
	    ParseError(ff, "Too many parameters for %s", cmd);
	    return FailedParse;
	  }
	*tPtr++ = ex;
      }
    callEx = AllocExprCall(i, buf);
    callEx->kind = kind;
    callEx->proc.name = ss;
    callEx->set_location(loc);
    return (Expr*)callEx;
  }
#endif

#if 0
Expr *
ParseGiveNameToType(struct ParseFile *ff)
{
    struct ExprStdOp *expr = AllocStdOp(GiveNameToType_code, 2);
    expr->arg[0].E = ParseLook(ff, WRDprio);
    expr->arg[1].E = ParseLook(ff, WRDprio);
    return (Expr*)expr;
}
#endif

Root *ParseExternName(struct ParseFile *ff)
{
    Root *label;
    int ch = ScanBlanks(ff);
    if (ch == '\"') {
	Expr *sexp = ParseQuotedString(ff);
	sexp->eval(&label, &RefRoot, NULL);
    }
    else if (ch != EOF && Letter(ch)) {
	ff->putback(ch);
	label = GetName(ff);
    }
    else {
	ParseError(ff, "'external' must be followed by identifier or string");
	label = NULL;
    }
    return label;
}

Expr * ParseExtern(struct ParseFile *ff)
{
#if 1
    ProcExpr *proc = ff->cur_proc;
    proc->code_label = ParseExternName(ff);
    proc->flags |= ProcIsExternal;
    return NullExpr;
#else
    struct ExprCall *callEx; int i, kind;
    Expr_Ptr buf[20], *tPtr = buf;
    FILE *f = ff->file;
    int c;
    struct Location loc;
    Expr *ss;
    Symbol * cmd = ff->macro;
    loc = SourceLocation(ff);
    ss = (Expr*)ParseIdent(ff);
    kind = 0;
    if (ss == NULL)
      {
	kind++;
	ss = ParseLook(ff, ONEprio);
	if (IsNullExpr(ss))
	  {
	    ParseError(ff, "No identifier following %s", ff->macro);
	    return FailedParse;
	  }
      }
    for (i = 0; ; i++)
      {
	Expr_Ptr ex;
	ex.E = ParseLook(ff, WRDprio);
	if (IsNullExpr(ex.E)) break;
	if (i > 20)
	  {
	    ParseError(ff, "Too many parameters for %s", cmd);
	    return FailedParse;
	  }
	*tPtr++ = ex;
      }
    callEx = AllocExprCall(i, buf);
    callEx->kind = kind;
    callEx->proc.E = ss;
    callEx->set_location(loc);
    callEx->set_code(External_code);
    ff->cur_proc->flags |= ProcIsExternal;
    return (Expr*)callEx;
#endif
}

static char * SearchGraphic(char *str, char *lim)
{
    register char *ptr = str;
    while (ptr < lim) {
	register ch = *ptr++;
	if (ch != ' ' && ch != '\t') { ptr--; break; }
    }
    return ptr;
}

#if 0
static int ParseIsMacroSymbol(struct Macro *macro, Symbol * name)
{
    if (macro == NULL) return 0;
    if (MACRO_NAME(macro) == name) return 1;
    return 0;
}
#endif

char * ConcatStrs(char *str0, ...)
{
    int length = strlen(str0);
    char *new_str, *ptr;
    va_list ap;
 /* count total length */
    va_start(ap, str0);
    for (;;) {
	char *stri = va_arg(ap, char *);
	if (stri == NULL) break;
	length += strlen(stri);
    }
    va_end(ap);
    new_str = (char*)malloc(length + 1);
    strcpy(new_str, str0);
    ptr = new_str + strlen(str0);
    va_start(ap, str0);
    for (;;) {
	char *stri = va_arg(ap, char *);
	if (stri == NULL) break;
	strcpy(ptr, stri);
	ptr += strlen(stri);
    }
    va_end(ap);
    *ptr = '\0';
    return new_str;
}

Expr * ParseLoopCons(struct ParseFile *ff)
{
/*
 * ParseLoopCons returns an expression representing a loop like:
 * {...?...}.
 * Simplistically, this is the same as:
 * (memo :(lambda :_INDEX_)=..._INDEX_...)
 */
    struct BlockSave save[1];
    char buf[60]; static LoopCount = 0;

//    Name startToken = ff->macro;
//    Name endToken;
//    if (startToken == EnterSymbol("[|")) endToken = EnterSymbol("|]");
//    else if (startToken == EnterSymbol("{")) endToken = EnterSymbol("}");
//    else endToken = NULL;

    sprintf(buf, "%s_LOOP_%d", ff->module->name, ++LoopCount);
    Symbol *fname = EnterSymbol(buf);

    int saveTerminators = ff->terminators;
    ff->terminators = ParsePeekOK;

    Expr *leftArg = NULL; /* left argument expression, or NULL if none */
    DeclListMark savedDecls = ff->unclaimed_decls.mark();
    struct Declaration *firstArg = NULL;
    struct ProcExpr *save_cur_proc = ff->cur_proc;
    struct Location loc;
    int side = 0; /* start out with left parameters */

    TestPushBlock(save, ff);
    struct LoopConsClosure *closure = GC_NEW LoopConsClosure(ff->saveBlock);
    if (MemoSeq::desc()->instanceVTable == NULL)
      {
#ifdef __GNUG__
#if VTABLE_LABEL_HAS_LENGTH
	extern char MemoSeqVTable[] asm(VTABLE_LABEL_PREFIX "7MemoSeq");
#else
	extern char MemoSeqVTable[] asm(VTABLE_LABEL_PREFIX "MemoSeq");
#endif
	*(char**)&MemoSeq::desc()->instanceVTable = MemoSeqVTable;
#else
	/* Semi-portable kludge to extract MemoSeq's vtable. */
	MemoMap dummy(0);
	*(void**)&MemoSeq::desc()->instanceVTable = *(void**)&dummy;
#endif
      }
    BindRecordType(closure, MemoSeq::desc());
    struct Block *block = GC_NEW Block(closure);
    block->size = BlockIsLoopMagic;
    ff->block = block; 
    block->flags |= BlockIsReturnable;

    loc = SourceLocation(ff);
    register LoopConsProc *fnc = GC_NEW LoopConsProc (block);
    fnc->closure = closure;
    ff->cur_proc = fnc;
    fnc->fname = fname;
    fnc->flags |= ProcPrefix;

    block->globalName = ConcatStrs(block->enclosing->globalName,
				   "_", SymbolString(fname), NULL);

    struct Identifier *id = AddIdentifier(&_INDEX__sym, ff, IsPrivate);
    id->flags |= IdentExplicit+IdentHasMark;
    struct ParamExpr *param = AddParam(ff, fnc, 1, id);
    param->arg_type = ExTypePtr; /* was ExTypeAny */
//    fnc->argList->idList = id;

    fnc->resultType.E = NULL;
#if 0
    ch = ScanBlanks(ff);
    if (ch != '~') ff->putback(ch);
    else fnc->resultType.E = ParseOne(ff, 8<<4);
#endif

    DeclList dlist;
    dlist.grab_from(ff->unclaimed_decls, savedDecls);
    fnc->paramDecls = dlist.first;
    Expr *ex = ParseOne(ff, PARprio);
    int ch = ff->get();
    if (ch != '}') {
	ParseError(ff, "Mapping constructor '{' has no closing '}'");
	return FailedParse;
    }
    if ((Block*)ex != block)
	ParseError(ff, "ParseLoopCons confusion: ex=#%X != block=#%X", ex, block);

    if ((fnc->flags & ProcIsExternal) && ff->saveBlock->enclosing != NULL)
	AllocContext(fnc);

    struct Statement* st = AppendStatement(closure, fnc);
    st->idList = NewIdentifier(EnterSymbol("LOOP.BODY"), NULL);
    st->kind = MethodStatement;
    TestPopBlock(save);
/*    AppendStatement(block, ex); */
/*    fnc->procDesc = NULL; */
    fnc->set_location(loc);
    if (block->decls.first != NULL)
	ParseError(ff, "ParseRule confusion: bad decls");
    BindClause(fnc);
    ff->cur_proc = save_cur_proc;
    ff->terminators = saveTerminators;
    return GC_NEW LoopConsExpr(fnc, closure);
}

// Assuming we have parsed 'if TEST =>' parse and build an ElseExpr.

ElseExpr* ParseIfTail(ParseFile *ff, Expr *test, int indentation)
{
  struct BlockSave save[1];
  ElseExpr *cond = MakeElseNode(test, NULL);
  if (test->code() == Block_code)
    test->flags &= ~BlockReturnSelf;
  cond->kind = 0;
  TestPushBlock(save, ff);
  Expr* then = ParseOne(ff, EOLprio); // ?
  TestPopBlock(save);
  cond->then.E = then;
  int separator = ff->get();

  int has_else = 0;

  if (separator == '\n' && (ff->terminators & ParsePeekOK))
    {
      ff->peek(); /* Get next line. */
      char* line_start = ff->pbuf()->current_line();
      char* line_end = line_start + ff->pbuf()->line_length();
      char *start = SearchGraphic(line_start, line_end);
      if (indentation == CurIndentation(ff) && line_end > start+1
	  && start[0] == '|' && start[1] == '|')
	{
	  ff->pbuf()->seek_in_line(start - line_start);
	  separator = ff->get();
	}
    }
  if (separator == '|')
    {
      separator = ff->get();
      if (separator != '|')
	ParseError(ff,
		   "Internal confusion: 'IF ... |' not followed by '|'\n");
      has_else = 1;
    }

  if (!has_else)
    {
      if (separator != EOF) ff->putback(separator);
      cond->e2 = NullExpr;
    }
  else
    {
      TestPushBlock(save, ff);
      cond->e2.E = ParseOne(ff, EOLprio);
      TestPopBlock(save);
      separator = ff->get();
      if (separator != '=')
	{ if (separator != EOF) ff->putback(separator); }
      else
	{
	  separator = ff->get();
	  if (separator == '>')
	    cond->e2.E = ParseIfTail(ff, cond->e2.E,indentation);
	  else
	    {
	      if (separator != EOF) ff->putback(separator);
	      ff->putback('=');
	    }
	}
    }
  return cond;
}

Expr * ParseIf(struct ParseFile *ff)
{
  Expr *test;
  int indentation = CountCurrentIndentation(ff) - 2; /* 2 == sizeof["if"] */
  char saveTerminators = ff->terminators;
  int separator;
  ElseExpr *cond;
  ff->terminators |= TerminatorIF;
  test = ParseList(ff);
  separator = ff->get();
  if (separator == '\n' && (ff->terminators & ParsePeekOK))
    {
      ff->peek(); /* Get next line. */
      char* line_start = ff->pbuf()->current_line();
      char* line_end = line_start + ff->pbuf()->line_length();
      char *start = SearchGraphic(line_start, line_end);
      if (indentation == CurIndentation(ff) && line_end > start+1
	  && ((start[0] == '|' && start[1] == '|')
	      || (start[0] == '=' && start[1] == '>')))
	{
	  ff->pbuf()->seek_in_line(start - line_start);
	  separator = ff->get();
	}
    }
  
  if (separator != '=')
    goto no_arrow;
  separator = ff->get();
  if (separator != '>')
    goto no_arrow;
  cond = ParseIfTail(ff, test, indentation);
  ff->terminators = saveTerminators;
  return cond;
 no_arrow:
  ParseError(ff,
	     "Internal confusion: 'IF ... =' not followed by '>'\n");
  ff->terminators = saveTerminators;
  return FailedParse;
}

extern ExprQuoteOp QUnion;
Expr * ParseVBar2(struct ParseFile *ff)
{
    if (ff->terminators & TerminatorIF) {
	return ParseReject2(ff); // Backup the ||
    }
#if 1
    return &QUnion;
#else
    Expr *left = GetLeftExpr(ff, 1);
    if (left == NullExpr) {
	ParseError(ff, "Missing left operand of `||'");
	return NullExpr;
    }
    if (left->code() == Union_code && ((UnionExpr*)left)->right == NULL) {
    }
    UnionExpr *uex = GC_NEW UnionExpr();
    SetStdExprFields(uex, ff);
    uex->set_code(Union_code);
    uex->left = left;
    uex->right = ,,,;
    return uex;
#endif
}

Expr * ParseElse(struct ParseFile *ff)
/* Assumes that: 'e1 ELSE' or 'e1 THEN' or 'e1 |' have alrady been scanned.
 * Matches '[ON [pattern] handler-list:] e2', where 'handler-list'
 * is a list of names of exception-classes, separated by spaces or commas.
 * 'patten' is currently not supported, so must be left out.
 */
    
{
    int ch = ff->get();
    if (ch == '|')
	return ParseVBar2(ff);
    else if (ch != EOF)
	ff->putback(ch);

    struct ElseExpr *ee; Expr *e1; Expr_Ptr then;
#define MaxExList 20
    struct ExceptionClass *(exList[MaxExList]);
    int exListCount = 0;
    if ((e1 = GetLeftExpr(ff)) == FailedParse)
	ParseError(ff, "`|' must be preceded by an expression");
#if 0
    if (ff->macro == &THEN_sym)
      {
	then.E = ParseLook(ff, 14 << 4);
	ss = GetName(ff);
	if (ss != &VBAR_sym && ss != &else_sym && ss != &ELSE_sym)
	  {
	    ParseError(ff, "THEN must be followed by '|', 'ELSE' or 'else'");
	    return (struct ElseExpr*)FailedParse;
	  }
      }
    else 
#endif
	then = (Expr*)NULL;
#if 0
    ss = ParseIdent(ff);
    if (ss == sON || ss == sOn)
      {
	for (;;)
	  {
	    ss = ParseIdent(ff);
	    if (ss == FailedParse)
	      {
		ParseErr0(0, "Exception class name expected after ELSE ON");
		return FailedParse;
	      }
	    if (exListCount>=MaxExList)
	      {
		ParseErr0(0, "Too long an exception handler list in ELSE");
		return FailedParse;
	      }
	    exList[exListCount] =
		ss == sAny
		    ? Any_exception 
			: LookupGlobalLabel(SymbolString(ss), NULL);
/* NOTE: should test if the search failed */
	    exListCount++;
	    ch = ScanBlanks(ff);
	    if (ch == ':')
		break;
	    else if (ch != ',' && ch != EOF)
		ff->putback(ch);
	  }
      }
    else
      {
	if (HasHType(ss, Symbol))
	    ParseUngetString(ff, SymbolString(ss), SymbolLength(ss));
	else if (ss != FailedParse)
	    ParseUnget(ss, ff);
	exList[exListCount++] = (struct ExceptionClass*)Fail;
      }
    ee = Alloc(ElseExprT,
	sizeof(struct ElseExpr) + (exListCount-1)*sizeof(Object));
    ee->e1.E = e1;
#else
    exList[exListCount++] = (struct ExceptionClass*)Fail;
    ee = MakeOrNode(e1, NULL);
#endif
    SetStdExprFields(ee, ff); ee->set_code(ElseExpr_code);
    ee->handlerCount = exListCount;
#if 0
    ee->kind = ff->macro == &VBAR_sym;
    while (--exListCount >= 0)
	ee->exception[exListCount] = exList[exListCount];
#endif
    ee->then = then;
    ch = ff->peek();
    if (ch == ' ' || ch == '\t')
	ee->e2.E = ParseLook(ff, DEFprio);
    else
	ee->e2.E = ParseLook(ff, WRDprio);
    return ee;
  }

#if 0
Expr * ParseSelect(struct ParseFile *ff)
{
    Name initKeyWord = ff->macro;
    Name ss;
/*    ex->kind = ff->macro != sTEST;*/
    Expr_Ptr condition;
    Expr_Ptr result;
    Expr_Ptr *last = &result;
    struct Statement *selectors;
    int n_selectors = 0;
    condition.P = NoValue;
    result.E = FailedParse;

    if (initKeyWord == sIf || initKeyWord == sIF)
	return ParseIf(ff);
      {
	selectors = GetStatements(ff, PARprio);
	ss = (Name)getob(ff);
/* NOTE: This is broken -- it only gets single character these days! */
      }
/*   else selectors = NULL; */

    if (selectors != NULL)
      { struct Statement *st;
	result.block = GC_NEW Block(NULL);	/* ??? */
	result.block->first = selectors;
	for (st = selectors; st != NULL; st = st->next)
	  {
	    n_selectors++;
	    if (st->decl == NULL)
	      { char buf[30];
		sprintf(buf, "TEST_TMP_%d", n_selectors);
		st->decl = Symbol2Declaration(EnterSymbol(buf));
/*		st->decl->blockLevel ??? */
		st->decl->useCount = 2;
	      }
	    result.block->last = &st->next;
	  }
	st = AllocStd(Statement);
	st->sourcePos.set_unknown(st);
	st->decl = NULL;
	st->src.E = NULL;
	last = &st->src;
	*result.block->last = st;
	result.block->last = &st->next;
	st->next = NULL;
      }
    while (ss == sIF || ss == sIf)
      { Expr_Ptr test;
	int saveTerminators = ff->terminators;
	if (selectors == NULL)
	    test.E = ParseList(ff);
	else
	  { struct Statement *test_list = GetStatements(ff, PARprio);
	    struct Statement *t_st, *s_st;
	    if (test_list == NULL)
		test = (Expr*)NULL;
	    else
	      {
		test.block = GC_NEW Block(NULL); /* ??? */
		test.block->decls.first = test_list;
		test.block->last = NULL;
	      }
	    t_st = test_list;
	    s_st = selectors;
	    while (t_st != NULL && s_st != NULL)
	      {
		t_st->src.unify = GC_NEW UnifyExpr(t_st->src, s_st->decl);
		s_st = s_st->next;
		t_st = t_st->next;
	      }
	  }
	ff->terminators = saveTerminators;
	if (condition.E == (Expr*)NULL) condition = test;
	else
	    condition.test = MakeElseNode(condition, test);
	ss = (Name)getob(ff);
	if (ss == sIF || ss == sIf)
	  {
	    continue;
	  }
 	else if (ss != (Name)CCharToChar(':'))
	    ParseErr0(0, "IF must be terminated by ':' or a new IF");

	else if (condition.E != NULL)
	  { struct ElseExpr *cond = MakeElseNode(condition.E, NULL);
	    cond->then.E = ParseLook(ff, PARprio);
	    condition.E = NULL;
	    last->test = cond;
	    last = &cond->e2;
	    ss = (Name)getob(ff);
	  }
	else
	  {
	    last->E = ParseLook(ff, PARprio);
	    ss = (Name)getob(ff);
	    if (ss == sIF || ss == sIf)
	      {
		ParseErr1(0, "Default branch ('IF :') followed by %s", ss);
	      }
	    else last = NULL;
	  }
      }
    if (last != NULL)
      { /* raise if no match */
	last->node =
	    NewExprNode(NoValue, NewIdentifier(EnterSymbol("No_match"), NULL));
      }
#if 1
    ParseUnget(ss, ff);
    CheckEndLabel(ff, initKeyWord);
#else
    if (ss == sEND)
      {
	ss = (Object)ParseIdent(ff);
	if (ss != FailedParse && ss != initKeyWord)
	    ParseError(ff, "END %s does not match preceding %s",
		ss, initKeyWord);
      }
    else ParseUnget(ss, ff);
#endif
    return result.E;
}
#endif

#if 0
struct ExprCall *
ParseFuture(struct ParseFile *ff)
{   Expr *(args[1]); struct ExprCall *callEx;
    struct ExprCall *AllocExprCall();
    ParseUngetString(ff, "_=>", -1);
    args[0] = (Expr*)ParseLambda(ff, NULL, NULL, NULL);
    callEx = AllocExprCall(1, args);
    callEx->kind = 0;
    callEx->proc.name = (Name)"CreateProcVar";
    return callEx;
}
#endif

#if 0
Expr *
ParseKnownCall(struct ParseFile *ff, Name proc, int nArgs)
  { int i; Expr *ex;
    struct ExprCall *callEx;
    if (nArgs > 100) nArgs = *(long*)nArgs;
    callEx = AllocExprCall(nArgs, NULL);
    callEx->kind = 0;
    callEx->proc.name = proc;
    for (i = 0; i < nArgs; i++)
      {
	ex = ParseLook(ff, WRDprio);
	if (IsNullExpr(ex))
	  {
	    for ( ; i < nArgs; i++) callEx->arg[i].E = NullExpr;
	    break;
	  }
	callEx->arg[i].E = ex;
      }
    return (Expr*)callEx;
  }
#endif

Expr *ParseComment(struct ParseFile *ff)
/* have just read '#'; skip until end of comment */
{
    register int c = ff->get();
    if (c == EOF)
	ParseError(ff, "Warning: Comment start symbol followed by EOF");
    else
    switch (c)
      {
	case '\n': case '\r': ff->putback(c); return NullExpr;
	case '%': /* read a pragma */
	  {
	    Symbol* ss = ParseIdent(ff);
	    if (ss == NULL)
		ParseError(ff, "pragma (#%%) must be followed by identifier");
	    else if (strcmp(SymbolString(ss), "primitive") == 0)
		CompilePrimitiveData = 1;
#if 0
	    else if (strcmp(SymbolString(ss), "log") == 0)
		LogSetFlags(GetWord(ff, 0));
#endif
	    else
		ParseError(ff, "Unknown pragma: %s", SymbolString(ss));
	    return NullExpr;
	  }
	case '(':
	  { int nesting = 0, startLine = ff->sourcePos.lineNo;
	    for (;;) {
		c = ff->get();
		if (c == EOF) {
		    ParseError(ff, 
"End of file ocurred in the middle of comment starting at line %d",
			startLine);
		    break;
		}
		if (c == '\n') {
		    if (ff->promptFile) fprintf(ff->promptFile, "#:");
		}
		if (c == CommentChar) {
		    c = ff->get();
		    if (c == '(') nesting++;
		    else if (c == ')' && --nesting < 0) break;
		  }
	      }
	    break;
	  }
	case '<':
	  {
	    TempBuf name_buf;
	    for (;;) {
		c = ff->get();
		if (c == EOF
		 || c == '\n' || c == '\r') {
		    ParseError(ff, "Bad include command");
		    return NullExpr;
		}
		if (c == '>') break;
		name_buf.put(c);
	    }
	    name_buf.put('\0');
	    
	    char *newname = name_buf.string();
	    filebuf* newfile = new filebuf;
	    newfile->open(newname, ios::in);
	    if (newfile->is_open())
		PushParseFile(ff, new general_parsebuf(newfile, 1), newname);
	    else {
		delete newfile;
	        ParseError(ff, "Could not open included file <%s>", newname);
	    }
	  }
	  break;
	default:
	    if (!Letter(c) && c != ':')
		ParseError(ff, "Bad char '%c' following '#'", c);
	case CommentChar: case ' ': case '\t':
	    for (;;)
	      {
		c = ff->get();
		if (c == EOF) return NullExpr;
		if (c == '\n' || c == '\r')
		  { ff->putback(c); return NullExpr; }
	      }
      }
    return NullExpr;
  }

#if 0
static int
ParseCountIndentation(struct ParseFile *ff)
  { register char *ptr = ff->bufStart(), *lim = ff->readFence();
    register int i = 0;
    while (ptr < lim)
      { register ch = *ptr++;
	if (ch == '\t') i = (i & ~7) + 8;
	else if (ch == ' ') i++;
	else if (ch == '\n' || ch == '\r' || ch == ('L' & 31)) return -1;
	else return i;
      }
    return -1;
  }

int ParseFile::underflow()
{
    if (readFence()[-1] == '\n')
	(void)sourcePos.lineNo++; // g++ -Wall complains without (void)
    /* Next 3 lines are rather clumsy, but there seems to be a compiler bug */
//    typedef int (*Getl)(struct ParseFile *);
//    Getl getl = getLine;
    if (!(*getLine)(this))
	return -1;
    if (curIndentation >= 0) prevIndentation = curIndentation;
    curIndentation = ParseCountIndentation(this);
    return readCurrent();
}

Symbol * GetParseChar(register struct ParseFile *ff)
{
#if 1
    int ch = ff->get();
    return ch == EOF ? EOF_mark : CCharToChar(ch);
#else
    if (ff->curPtr() < ff->readFence())
	return CCharToChar(ff->readCurrent());
    if (ff->readFence()[-1] == '\n')
	(void)ff->sourcePos.lineNo++; // g++ -Wall complains without (void)
    if (!(*ff->getLine)(ff))
	return EOF_mark;
    if (ff->curIndentation >= 0) ff->prevIndentation = ff->curIndentation;
    ff->curIndentation = ParseCountIndentation(ff);
    return CCharToChar(ff->readCurrent());
#endif
}
#endif

Expr * DoReject(struct ParseFile *ff)
{ return (Expr*)&REJECT_sym; }

ExprQuote NULL_expr((Root*)NULL);

Expr * ParseNULL(ParseFile *ff)
{
    return &NULL_expr;
}

Expr * ParseWith(ParseFile *ff)
{
    TempPtrBuf var_exprs;
    TempPtrBuf init_exprs;

    // parse:  with binding1 ... bindingn => body
    // where: binding is either a variable or variable:=expression
    for (;;) {
	Expr *bind = ParseLook(ff, WRDprio);
	Expr *init = NULL;
	if (IsNullExpr(bind))
	    break;
	if (bind->code() == UnifyExpr_code) {
	    struct UnifyExpr *unify = (struct UnifyExpr*)bind;
	    if (unify->set == 2) { // :=
		init = unify->right.E;
		bind = unify->left.E;
	    }
	}
	var_exprs.putp(bind);
	init_exprs.putp(init);
    }

    DynamicBindExpr *dyn_expr = GC_NEW DynamicBindExpr();
    dyn_expr->count = var_exprs.count();
    dyn_expr->var_exprs = (Expr**)var_exprs.copy();
    dyn_expr->init_exprs = (Expr**)init_exprs.copy();

    int ch = ScanBlanks(ff);
    if (ch != '=' || ff->get() != '>') {
	ParseError(ff, "No '=>' found after 'save'.");
	return FailedParse;
    }
    struct BlockSave save[1];
    TestPushBlock(save, ff);
    Expr *body = ParseOne(ff, EOLprio);
    TestPopBlock(save);

    dyn_expr->body = body;

    return dyn_expr;
}

ExprQuote NullExprQ(&NullSequence);

HashTable IdMacroTable(32);

QReadIdMacro::QReadIdMacro(Symbol& n, QMacroFunction f)
: QReadEntry(ReadWord /* Doesn't matter*/, f), name(n)
{
    StringInsert(&IdMacroTable, name.Str(), this);
}

static QReadIdMacro IF_dummy(IF_sym, ParseIf);
static QReadIdMacro if_dummy(if_sym, ParseIf);
static QReadIdMacro else_dummy(else_sym, DoReject);
static QReadIdMacro ELSE_dummy(ELSE_sym, DoReject);
static QReadIdMacro LOAD_dummy(load_sym, ParseLoad);
static QReadIdMacro Scheme_dummy(Scheme_sym, (QMacroFunction)SchemeReadExpr);
static QReadIdMacro Lisp_dummy(Lisp_sym, (QMacroFunction)LispReadExpr);
static QReadIdMacro COLLECT_dummy(COLLECT_sym, ParseCollect);
static QReadIdMacro collect_dummy(collect_sym, ParseCollect);
static QReadIdMacro setsort_dummy(setsort_sym, ParseSetSort);
static QReadIdMacro SIGNAL_dummy(SIGNAL_sym, ParseDefException);
static QReadIdMacro setdiff_dummy(setdiff_sym, ParseSetDiff);
//static QReadIdMacro GNTT_dummy(GIVE_NAME_TO_TYPE_sym, ParseGiveNameToType);
static QReadIdMacro POSTFIX_dummy(POSTFIX_sym, ParsePostfix);
static QReadIdMacro LASTFIX_dummy(LASTFIX_sym, ParseLastfix);
static QReadIdMacro NOLASTFIX_dummy(NOLASTFIX_sym, ParseNoLastfix);
static QReadIdMacro WHEN_dummy(WHEN_sym, ParseWhen);
static QReadIdMacro when_dummy(when_sym, ParseWhen);
static QReadIdMacro external_dummy(external_sym, ParseExtern);
static QReadIdMacro NULL_POINTER_dummy(NULL_POINTER_sym, ParseNULL);
static QReadIdMacro with_dummy(with_sym, ParseWith);
