/* Copyright Per Bothner 1987. Read the file Q-INFO */
#include <stdio.h>
#include <types.h>
#include <procs.h>
#include <frame.h>
#include <debug.h>
#include <std.h>
#include "builtin-syms.h"
//#include <format.h>
#include "expression.h"
#include "tempbuf.h"
#include "gfunc.h"
#include <parsefile.h>
#include "ivrun.h"
#include "genmap.h"
#include "symbol.h"
#include "shell.h"
#include "modules.h"
EXTERN RootPtr AddAtom(Symbol * name, struct Module *module);
extern struct Statement *GetLastStatement(struct Block*);
EXTERN char *readline(char*);
EXTERN void add_history(char *);
EXTERN void TryIndent(struct FormattedFile *file, int n);
EXTERN void PrintQuotedWord(char *str, int len, FILE *file, int quoteAll);
extern Expr * LispReadExpr(InStream *stream);
extern Expr * SchemeReadExpr(InStream *stream);

// A fake parsebuf that contains a (pre-parsed) expression.

#define PARSE_EXPR_MAGIC (-99)

struct expr_parsebuf : public parsebuf {
    Expr* expr;
    expr_parsebuf(Expr* ex);
    int tell_in_line() { return PARSE_EXPR_MAGIC; }
};

expr_parsebuf::expr_parsebuf(Expr* ex)
{
    expr = ex;
}

int is_expr(parsebuf* pbuf) { return pbuf->tell_in_line() == PARSE_EXPR_MAGIC; }

Expr FailedParse[1];

#include "reader.h"
ReadEntry R_Illegal = { ReadIllegal};
ReadEntry R_HSpace = { ReadHSpace};
ReadEntry R_VSpace = { ReadVSpace};
ReadEntry R_Digit = { ReadDigit};
ReadEntry R_Dot = { ReadDigit};
ReadEntry R_Letter = { ReadLetter};
ReadEntry R_Word = { ReadWord};
ReadEntry R_SEscape = { ReadSEscape};
static ReadEntry R_Colon = { ReadDeclPrefix };
static ReadEntry R_RParen = { ReadRParen };
static ReadEntry R_SemiColon = { ReadStatementSep};
extern Expr *ParseQuotedString(ParseFile*), *ParseQuote(ParseFile*);
extern Expr *ParseParens(ParseFile*);
extern Expr *ParseBinOp(struct ParseFile *ff, enum ExprCode code, int rPrio);
extern Expr * ParseBrackets(ParseFile *ff);
extern Expr * ParseIndex(ParseFile *ff);
extern Expr * ParseInverse(ParseFile *ff);
extern Expr * ParseElse(struct ParseFile *ff);
extern Expr * ParseLoopCons(struct ParseFile *ff);
extern Expr * ParseMakeTuple(struct ParseFile *ff);

ExprQuoteOp QPlus("+", "__add", 6, 6);
ExprQuoteOp QPower("**","__pow", 4, 4);
ExprQuoteOp QTimes("*", "__mul", 5, 5);
ExprQuoteOp QDivide("/", "__div", 5, 5);
ExprQuoteOp QMinus("-", "__sub", 6, 6);
ExprQuoteOp QMkComplex("+%", "__mkcomplex", 6, 6);
ExprQuoteOp QGreaterEqual(">=", "__geq", 7, 7);
ExprQuoteOp QGreaterThan(">", "__grt", 7, 7);
ExprQuoteOp QLessEqual(">=", "__leq", 7, 7);
ExprQuoteOp QLessThan("<", "__lss", 7, 7);
ExprQuoteOp QNotEquals("<>", "__neq", 7, 7);
ExprQuoteOp QEquals("=", "__equ", 7, 7);
ExprQuoteOp QCons(",", "__cons", 10, 11); // Right associative
ExprQuoteOp QMapTo("->", "__mapto", 10, 10);
ExprQuoteOp QShiftAssignTo(":=>", &ShiftAssignTo, 12, 12);
ExprQuoteOp QAssignTo(":=", &AssignTo, 12, 13); // Right associative
ExprQuoteOp QUnion("||", &Union, 10, 10);

Expr *ParseReject1(struct ParseFile *ff)  // Backup 1 character
{
    parsebuf* pbuf = ff->pbuf();
    pbuf->seek_in_line(pbuf->tell_in_line() - 1);
    return (Expr*)&REJECT_sym;
}

Expr *ParseReject2(struct ParseFile *ff)  // Backup 2 characters
{
    parsebuf* pbuf = ff->pbuf();
    pbuf->seek_in_line(pbuf->tell_in_line() - 2);
    return (Expr*)&REJECT_sym;
}

Expr *ParsePlus(struct ParseFile *ff)
{
    int ch = ff->get();
    if (ch == '%')
	return &QMkComplex; // Op: +%
    else if (ch != EOF)
	ff->putback(ch);
    return &QPlus; // Op: +
}

Expr *ParseMinus(struct ParseFile *ff)
{
    int ch = ff->get();
    if (ch == '-')
	return ParseBinOp(ff, FromOp_code, 6); // Op: --
    else if (ch == '>')
	return &QMapTo; // Op: ->
    else if (ch != EOF)
	ff->putback(ch);
    return &QMinus; // Op: -
}

Expr *ParseTimes(struct ParseFile *ff)
{
    int ch = ff->get();
    if (ch == '*')
	return &QPower; // Op: **
    else if (ch != EOF)
	ff->putback(ch);
    return &QTimes; // Op: *
}

Expr *QuotedDivideOp = &QDivide; /* Also used in ExprList::traverse */
Expr *ParseDiv(struct ParseFile *ff)
{
    int ch = ff->get();
    if (ch == '/')
	return ParseBinOp(ff, IDivOp_code, 5); // Op: //
    else if (ch != EOF)
	ff->putback(ch);
    return &QDivide; // Op: /
}
Expr *ParseCons(struct ParseFile *ff) { return &QCons; }

Expr * ParseEqu(struct ParseFile *ff)
{
    int double_eq = 0;
    if (ff->terminators & ParseInParamList)
	return ParseReject1(ff);
    int ch = ff->get();
    if (ch == '=')
	double_eq = 1; // Op: ==
    else if (ch == '>')
	return ParseReject2(ff); // Reject Op: =>
    else if (ch != EOF)
	ff->putback(ch);
#if 1
    return &QEquals; // Op: =
#else
    Expr *left, *right;
    struct UnifyExpr *ex;
    left = GetLeftExpr(ff, 1);
    ch = ff->peek();
    if (ch == ' ' || ch == '\t')
	right = ParseLook(ff, DEFprio);
    else
	right = ParseLook(ff, 8<<4);
    ex = GC_NEW UnifyExpr(left, right);
    SetStdExprFields(ex, ff); ex->set_code(UnifyExpr_code);
    if (double_eq) ex->set = 3;
    return CheckLeftExpr(ff, ex, &ex->left.E);
#endif
}

Expr *ParseLss(struct ParseFile *ff)
{
    int ch = ff->get();
    if (ch == '=')
	return &QLessEqual; // Op: <=
    else if (ch == '>')
	return &QNotEquals; // Op: <>
    else if (ch != EOF)
	ff->putback(ch);
    if (ff->cur == NULL) {
	Expr * filename = ParseLook(ff, WRDprio-1);
	if (filename != NullExpr)
	    return GC_NEW ReadFileFrom(filename->quote_words());
    }
    return &QLessThan; // Op: <
}

Expr *ParseGrt(struct ParseFile *ff)
{
    int ch = ff->get();
    if (ch == '=')
	return &QGreaterEqual; // Op: >=
    else if (ch != EOF)
	ff->putback(ch);
    if (ff->cur == NULL) {
	int append = 0;
	int stderr_too = 0;
	if (ch == '>')
	    ff->get(), append = 1;
	if (ch == '&')
	    ff->get(), stderr_too = 1;
	Expr * filename = ParseLook(ff, WRDprio-1);
	if (filename == NullExpr)
	    return &QGreaterThan;
	RedirectOut* out =
	    GC_NEW RedirectOut(filename->quote_words(), ParseList(ff, EOLprio));
	if (append)
	    out->append = 1;
	if (stderr_too)
	    out->stderr_too = 1;
	return out;
    }
    return &QGreaterThan; // Op: >
}

Expr *ParseUnquote(struct ParseFile *ff)
{
    return GC_NEW UnquoteExpr(GetUnquotedPart(ff));
}

Expr *ParsePercent(struct ParseFile *ff)
{
    return GC_NEW QuoteOnlyExpr(&percent_str);
}

static QReadEntry R_Dollar(ReadTMacro, ParseUnquote);
static QReadEntry R_Percent(ReadTMacro, ParsePercent);
static QReadEntry R_DQuote(ReadTMacro, ParseQuotedString);
static QReadEntry R_SQuote(ReadTMacro, ParseQuote);
static QReadEntry R_Sharp(ReadTMacro, ParseComment);
static QReadEntry R_LParen(ReadTMacro, ParseParens);
static QReadEntry R_Plus(ReadTMacro, ParsePlus); //SetPriority(6, DefaultPrio)
static QReadEntry R_Minus(ReadTMacro, ParseMinus); //SetPriority(6,DefaultPrio)
static QReadEntry R_Comma(ReadTMacro, ParseCons); //SetPriority(11,DefaultPrio)
static QReadEntry R_Star(ReadTMacro, ParseTimes);
static QReadEntry R_LBrack(ReadTMacro, ParseBrackets);
static QReadEntry R_Quest(ReadTMacro, ParseIndex);
static QReadEntry R_Tilde(ReadTMacro, ParseInverse);
static QReadEntry R_Slash(ReadTMacro, ParseDiv);
static QReadEntry R_LBrace(ReadTMacro, ParseLoopCons);
static QReadEntry R_AtSign(ReadTMacro, ParseMakeTuple);
static QReadEntry R_VBar(ReadTMacro, ParseElse); //SetPriority(14,DefaultPrio);
static QReadEntry R_Reject1(ReadTMacro, ParseReject1);
static QReadEntry R_Lss(ReadTMacro, ParseLss); //SetPriority(7, DefaultPrio)
static QReadEntry R_Equ(ReadTMacro, ParseEqu); //SetPriority(7, DefaultPrio)
static QReadEntry R_Grt(ReadTMacro, ParseGrt); //SetPriority(7, DefaultPrio)

ReadEntry* (QReadEntries[256]) = {
  Rep8(&R_Illegal),
  &R_Word,&R_HSpace, &R_VSpace,&R_VSpace,&R_VSpace,&R_VSpace, Rep2(&R_Illegal),
  Rep8(&R_Illegal),
  Rep8(&R_Illegal),
  &R_HSpace,&R_Word, &R_DQuote,&R_Sharp, &R_Dollar,&R_Percent, &R_Word,&R_SQuote,
  &R_LParen,&R_RParen, &R_Star,&R_Plus, &R_Comma,&R_Minus, &R_Dot,&R_Slash,
  Rep8(&R_Digit),
  Rep2(&R_Digit), &R_Colon, &R_SemiColon, &R_Lss, &R_Equ, &R_Grt, &R_Quest,
  &R_AtSign, &R_Letter, Rep2(&R_Letter), Rep4(&R_Letter),
  Rep8(&R_Letter),
  Rep8(&R_Letter),
  Rep2(&R_Letter),&R_Letter,&R_LBrack,&R_SEscape,&R_Reject1, &R_Word,&R_Letter,
  &R_Word, &R_Letter, Rep2(&R_Letter), Rep4(&R_Letter),
  Rep8(&R_Letter),
  Rep8(&R_Letter),
  &R_Letter,&R_Letter,&R_Letter,&R_LBrace,&R_VBar,&R_Reject1,&R_Tilde,&R_Word,

  Rep8(&R_Illegal), Rep8(&R_Illegal), Rep8(&R_Illegal), Rep8(&R_Illegal),
  Rep8(&R_Illegal), Rep8(&R_Illegal), Rep8(&R_Illegal), Rep8(&R_Illegal),
  Rep8(&R_Illegal), Rep8(&R_Illegal), Rep8(&R_Illegal), Rep8(&R_Illegal),
  Rep8(&R_Illegal), Rep8(&R_Illegal), Rep8(&R_Illegal), Rep8(&R_Illegal),
};

#if 0
One-character macros: "();:=%~!"
Concatenable characters: "+-/&"
#endif

HashTable *MacroTab;

#if 0
Symbol * StringToDotted(x) {return EnterSymbol(FixString(x));}
#endif

void PrintQuotedWord(char *str, int len, FILE *file, int quoteAll)
 /* if quoteAll, quote everything except Alphamerics */
{
    while (--len >= 0)
      { register ch = (unsigned char)*str++;
	switch (ch)
	  {
	  case 127: fputs("\\?", file); break;
	  case '\n': fputs("\\n", file); break;
	  case '\f': fputs("\\f", file); break;
	  case '\t': fputs("\\t", file); break;
	  case 033: fputs("\\e", file); break;
	  case '\b': fputs("\\b", file); break;
	  case '\r': fputs("\\r", file); break;
	  default:
	    if (ch > 127)
		fprintf(file, "\\x%02X", ch);
	    else if (ch < ' ')
		fprintf(file, "\\^%c", ch + '@');
	    else
	      {
		if (quoteAll && !Alphameric(ch))
		    fputc('\\', file);
		fputc(ch, file);
	      }
          }
      }
}

#if 0
FILE *
DeclPrint(struct Declaration *decl, FILE *f)
  {
    if (decl->fname() == NULL)
	fprintf(f, "#%x", decl);
    else
	PrintQuotedWord(SymbolString(decl->fname()),
			SymbolLength(decl->fname()), f, 1);
    if ((decl->flags & PrivateDeclaration) != 0)
	fputs("#", f);
    fprintf(f, "{of:%d fl:%d", decl->offset, decl->flags);
    fputc('}', f);
    return f;
  }

void PrintStatements(struct Statement *list, FILE *file)
  { register struct Statement *st = list;
    int saveIndent = -1;
    TryIndent((struct FormattedFile*)file, 2);
    for ( ; st != NULL; st = st->next)
      {
	fprintf(file, "\n");
#if 0
	if (st->decl != NULL)
	  {
	    DeclPrint(st->decl, file);
	    fprintf(file, ": ");
	  }
#endif
	PrintExpr(st->src.E, file);
      }
    TryIndent((struct FormattedFile*)file, -2);
  }
#endif

#define CallMAX 20

Symbol *
GetName(register struct ParseFile *ff) /* get either identifier or symbol */
{
    TempBuf id_buf;
    int ch = ScanBlanks(ff);
    if (Letter(ch))
	do {
	    id_buf.put(ch);
	    ch = ff->get();
	  } while (ch != EOF && Alphameric(ch));
    else if (Special(ch))
	do
	  {
	    id_buf.put(ch);
	    ch = ff->get();
	  } while (ch != EOF && Special(ch));
    else {
	ff->putback(ch);
	return NULL;
    }
    ff->putback(ch);
    Symbol * sym = EnterSymbol(id_buf.string(), id_buf.size());
    return sym;
}

Symbol * ParseIdent(register struct ParseFile *ff)
{
    TempBuf id_buf;
    int ch = ScanBlanks(ff);
    if (Letter(ch))
	do {
	    id_buf.put(ch);
	    ch = ff->get();
	  } while (ch != EOF && Alphameric(ch));
    else {
	ff->putback(ch);
	return NULL;
    }
    ff->putback(ch);
    Symbol * sym = EnterSymbol(id_buf.string(), id_buf.size());
    return sym;
}

struct Block *
CheckBlock(struct ParseFile *ff)
  { struct Block *block = ff->block;
    if (block == NULL)
      {
	ff->block = block = GC_NEW Block(ff->saveBlock);
	block->set_location(SourceLocation(ff));
      }
    return block;
  }

#if 0
int DoLastfix = 1;
Expr * MakeLastfix(Expr *expr)
{
    if (!DoLastfix) return expr;
    if (ExprCodeOf(expr) == Identifier_code
    || (ExprCodeOf(expr) == ExprNode_code && ((ExprNode*)expr)->postfix != 2))
	if ((expr->flags & LastfixProtect) == 0) {
	    ExprNode *node = NewExprNode(expr, NULL);
	    node->postfix = 2;
	    return node;
	}
    return expr;
}
#endif

struct Statement *
AddStatement(struct ParseFile *ff, Expr *val)
{
    if (val->code() == Identifier_code) {
	ExprList *list = GC_NEW ExprList(1);
	list->arg[0].E = val;
	val = list;
    }
//    if (DoLastfix >= 2) val = MakeLastfix(val);
    return AppendStatement(CheckBlock(ff), val);
}

#if 0
static char NewLine[1] = "\n";
int ParseGetFromFile(struct ParseFile *ff)
{
    register char *ptr; int i;
    if (ff->bufStart() == NULL || ff->bufStart() == NewLine)
	ff->giveBuffer(malloc(ff->bufSize()), ff->bufSize());
    for (ptr = ff->bufStart(), i = ff->bufSize(); --i >= 0;)
      { register ch;
	ch = getc(ff->file);
	if (ch < 0)
	  {
//	    if (ptr > ff->bufStart()) break;
	    if (ff->pushedFile) {
	        struct PushedParseFile *save = ff->pushedFile;
		fclose (ff->file);
		ff->file = save->file;
		ff->pushedFile = save->pushedFile;
		if (ff->bufStart()) free(ff->bufStart());
		ff->giveBuffer(save->line, save->size);
		ff->giveData(save->offset, save->fence);
		if (ff->source_file_name) free(ff->source_file_name);
		ff->source_file_name = save->source_file_name;
//		ff->getLine = save->getLine;
		ff->promptFile = save->promptFile;
		ff->sourcePos = save->sourcePos;
		free(save);
		if (ff->curPtr() < ff->readFence())
		    return 1;
		else
		    return (*ff->getLine)(ff);
	    }
	    return 0;
	  }
	*ptr++ = ch;
	if (ch == '\n') break;
      }
    ff->setOffset(0);
    ff->setFence(ptr);
    return 1;
}
#endif

void PushParseFile(struct ParseFile *ff, parsebuf* str, char *name)
{
    int level = 0;
#if 1
    parsebuf* old = ff->pbuf();
    while (old) old = old->chain, level++;
    if (level > 10) {
	ParseError(ff, "Includes too deeply nested");
	return;
    }
#else
    struct PushedParseFile *save;
    for (save = ff->pushedFile; save; save = save->pushedFile, level++)
	if (level > 10) {
	   ParseError(ff, "Includes too deeply nested");
	   return;
	}
    save = (struct PushedParseFile*)
	malloc(sizeof(struct PushedParseFile));
    save->line = ff->bufStart();
    save->fence = ff->readFence() - save->line;
    save->offset = ff->getOffset();
    save->size = ff->bufSize();
    save->pushedFile = ff->pushedFile;
//    save->getLine = ff->getLine;
//    save->file = ff->file;
    save->source_file_name = ff->source_file_name;
    save->promptFile = ff->promptFile;
    save->sourcePos = ff->sourcePos;
    ff->pushedFile = save;
    ff->giveBuffer(NewLine, DefaultParseLineSize);
    ff->giveData(1,1);
#endif
    str->chain = ff->pbuf();
    ff->stream = str;
    ff->sourcePos.lineNo = 0;
//    ff->getLine = ParseGetFromFile;
    ff->source_file_name = strdup(name);
    ff->promptFile = NULL;
}

ParseFile::ParseFile(parsebuf *str = NULL) : InStream(NULL)
{
    stream = str;
//    curIndentation = 0;
    sourcePos.set_unknown();
    sourcePos.lineNo = 0;
    blocksave = NULL;
    pushedFile = NULL;
    nesting = 0;
    errors = 0;
    cur = NULL;
    saveBlock = NULL;
    identifiers = NULL;
    defaultReturn = NULL;
    cur_proc = NULL;
    nesting_kind = NULL;
}

struct ParseFile *
OpenParseFile(register parsebuf *f, struct Module *module)
{
    register struct ParseFile *ff = GC_NEW ParseFile(f);
//    ff->file = f;
    ff->terminators = ParsePeekOK;
    ff->promptFile = NULL;
    ff->module = module;
    ff->block = /* module ? module->block : */ NULL;
//    ff->macroTable = module ? module->parseTable : NULL;
//    if (ff->macroTable == NULL) ff->macroTable = QStdMacros;
    return ff;
}

char *
parse_readline(void *arg)
{
    ParseFile *ff = (ParseFile*)arg;
#if 1
    static StringC *NilStringC;
    if (NilStringC == NULL) NilStringC = NewString(0, 0);
    const StringC* prompt_string = NilStringC;
#else
    const StringC* prompt_string = &NilString; /* Random non-NULL String. */
#endif
    char promptBuffer[80];
    char* prompt;
    char *format;
    int iline = ff->pbuf()->line_number() + 1;
    cout.flush();
    if (ff->nesting_kind != NULL) {
	sprintf(promptBuffer, "%c-%d> ",
		ff->nesting_kind->chars()[0], iline);
	prompt = promptBuffer;
    }
    else  {
	// Before we print a prompt, we might have to check mailboxes.
	// We do this only if it is time to do so. Notice that only here
	// is the mail alarm reset; nothing takes place in check_mail ()
	// except the checking of mail.  Please don't change this.
	if (time_to_check_mail ()) {
	    check_mail ();
	    reset_mail_timer ();
        }
	prompt = NULL;
	Symbol* prompter_symbol =
	    UserPackage.find_interned("prompter", 8, NULL);
	if (prompter_symbol) {
	    Root* prompter_func = prompter_symbol->sym_function();
	    if (prompter_func) {
		Root* ii = (Root*)MakeFixInt(iline);
		Root* prompt_value =
		    prompter_func->apply(NULL, &ii, NULL, NULL, 0, 1, 0);
		prompt = Force2String(prompt_value, NULL, &prompt_string);
	    }
	}
	if (!prompt) {
	    sprintf(promptBuffer, "Q%d> ", iline);
	    prompt = promptBuffer;
	}
    }
    if (HaveInterViews)
      set_rl_event_hook (1);
    char *line = readline(prompt);
    if (HaveInterViews)
      set_rl_event_hook (0);
    if (prompt_string == NULL)
	free(prompt);
    if (line == NULL) {
	fputc('\n', stderr);
	return NULL;
    }
    if (line[0] != '\0')
	add_history(line);
    return line;
}

ParseFile * OpenParseInteractive()
{
    func_parsebuf *str = new func_parsebuf(parse_readline, NULL);
    register struct ParseFile *ff = GC_NEW ParseFile(str);
    str->arg = ff;
//    ff->file = stdin;
    ff->terminators = 0;
    ff->module = DefaultModule;
    ff->block = /* module ? module->block : */ NULL;

    ff->promptFile = stderr;
    return ff;
}

Expr* ParseString(char *str, int len, Module *module)
{
    string_parsebuf *str_buf = new string_parsebuf(str, len);
    struct ParseFile *ff = OpenParseFile(str_buf, module);
    Expr *exp;
#if 0
    if (len == 0) exp = NullExpr;
    else
#endif
	{
	BlockSave save[1];
	ff->block = NULL;
	TestPushBlock(save, ff);
	ff->block = GC_NEW Block(NULL);
	exp = ParseLookEOF(ff);
	TestPopBlock(save);
	if (ff->get() != EOF)
	    ParseError(ff, "Junk at end of string");
    }
#ifndef DO_GC
    delete ff;
#endif
    return exp;
}

Expr *ParseCommand(register struct ParseFile *ff)
{
    Expr *exp = NULL;
    int ch;
  retry:
    ch = ff->get();
    if (ch == EOF) {
	parsebuf* old = ff->pbuf();
	if (old->chain != NULL) {
	    ff->stream = old->chain;
	    old->chain = NULL;
	    delete old;
	    goto retry;
	}
	return (Expr*)EOF_mark;
    }
    ff->terminators |= ParseAcceptRParen;
    if (ch == '\n') return NullExpr;
    ff->putback(ch);
/*  retry: */
    switch (DefaultLanguage) {
      case LispLanguage:
	exp = LispReadExpr(ff);
	if (exp != NULL && exp != (Expr*)EOF_mark) {
	    AddStatement(ff, exp);
	    exp = ff->block;
	    ff->block = NULL;
	}
	break;
      case SchemeLanguage:
	exp = SchemeReadExpr(ff);
	if (exp != NULL && exp != (Expr*)EOF_mark) {
	    AddStatement(ff, exp);
	    exp = ff->block;
	    ff->block = NULL;
	}
	break;
      case QLanguage:
      default:
	exp = ParseScan(exp, ff, CMDprio);
    }
    if (exp == NULL) exp = NullExpr;
    if (exp == (Expr*)EOF_mark) return exp;
    ch = ff->get();
    if (ch == EOF) return exp;
#if 0
    if (ch == ')') {
	if (exp->code() == ExprNode_code)
	    exp = ConvertNode((ExprNode*)exp);
	goto retry;
    }
#endif
    if (ch != '\n' && ch != '\r' && ch != ('L' & 31))
      {
	ParseError(ff,
	    ch >= ' ' && ch < 127
	    ? "Unexpected character: '%c'"
	    : "Unexpected character: #%x", ch);
	do
	    ch = ff->get();
	while (ch != EOF
	    && ch != '\n' && ch != '\r' && ch != ('L' & 31));
       }
    return exp;
}

#define AddToken(tok) {Expr *_tmp_ = (Expr*)(tok);\
  if (cur.E==NULL) cur.E = _tmp_; \
  else {cur.E = NewExprNode(cur.E, _tmp_); cur.E->flags |= spaceFlag;}}

void TestPushBlock(struct BlockSave *save, struct ParseFile *ff)
{
    save->prev = ff->blocksave; ff->blocksave = save;
    save->ff = ff;
    save->saveBlock = ff->block;
    if (ff->block != NULL) {
	ff->saveBlock = ff->block;
	ff->block = NULL;
    }
    save->identifiers = ff->identifiers;
    ff->identifiers = NULL;
    save->decls = ff->unclaimed_decls.last;
}

void TestPopBlock(struct BlockSave *save)
{
    struct ParseFile *ff = save->ff;
    struct Block *bl = ff->block;
    register struct Identifier **idp;
    if (save->saveBlock) {
	ff->block = save->saveBlock;
	ff->saveBlock = ff->block->enclosing;
    }
#if 0
    if (ff->decl_end != save->decls) {
	*bl->decl_end = *save->decls;
	bl->decl_end = ff->decl_end;
	*ff->decl_end = NULL;
	ff->decl_end = save->decls;
	*ff->decl_end = NULL;
    }
#endif
    ff->blocksave = save->prev;
    for (idp = &ff->identifiers; *idp != NULL; idp = &(*idp)->next) ;
    *idp = save->identifiers;
    
}

#if 0
PushBlock(ff)
    struct ParseFile *ff;
  {
    if (ff->block == NULL) ParseError(ff, "Internal error: Bad PushBlock");
    ff->saveBlock = ff->block; ff->block = NULL;
  }

PopBlock(struct ParseFile *ff)
  { struct Block *bl = ff->block;
    ff->block = ff->saveBlock;
    if (ff->saveBlock != NULL) ff->saveBlock = ff->saveBlock->enclosing;
    else ff->saveBlock = NULL;
  }
#endif

int CurIndentation(ParseFile *ff)
{
#if 1
    int ch;
    parsebuf *pbuf = ff->pbuf();
    int off = pbuf->tell_in_line();
    for (;;) {
	ch = pbuf->sbumpc();
	if (ch != ' ' && ch != '\t')
	    break;
    }
    int indent = pbuf->tell_in_line() - 1;
    pbuf->seek_in_line(off);
    return indent;
#else
    return ff->curIndentation;
#endif
}

static Block *ParseIndentedLines(register struct ParseFile *ff, int *chp)
{
    int ch = *chp;
    int oldIndentation, firstIndentation;
/*    struct BlockSave save[1];  TestPushBlock(save, ff); */
    Block *block = ff->block;
    if (block == NULL) block = GC_NEW Block(ff->saveBlock);
    ff->putback(ff->get()); /* to update ff->{cur,prev}Indentation */
//    oldIndentation = ff->prevIndentation;
    oldIndentation = ff->pbuf()->tell_in_line();
    firstIndentation = CurIndentation(ff);
    do {
	if (firstIndentation != CurIndentation(ff))
	    ParseError(ff, "W Uneven indentation");
	ff->block = block;
	int oldLineNo = ff->pbuf()->line_number();
	if ((Block*)ParseScan(NULL, ff, EOLprio) != block)
	    ParseError(ff, "Parse multiple lines confusion!");
	ch = ff->get();
	if (ch != '\n')
	    break; // Hit a ')' or similar "reject" token.
	if (!(ff->terminators & ParsePeekOK))
	    break;
//	if ((ch = ff->get() != '\n')
//	    break;
	(void)ff->peek(); /* to update ff->curIndentation */
    } while (oldIndentation <= CurIndentation(ff));
    if (ch != EOF) ff->putback(ch);
/*    TestPopBlock(save); */
    *chp = ch;
//    if (block->first == NULL)
//	ParseError(ff, "W Empty block - lines not indented");
    return block;
  }

Expr * ParseBlock(struct ParseFile *ff, int prio)
{ 
    struct BlockSave save[1];
    TestPushBlock(save, ff);
    Expr *ex = ParseScan(NULL, ff, prio);
    if (ex == NULL) ex = NullExpr;
    TestPopBlock(save);
    return ex;
}
ExprList * ParseList(struct ParseFile *ff, int prio)
{
    Expr *ex = ParseBlock(ff, prio);;
//    if (IsNullExpr(ex)) ex = NullExpr;
    if (ExprCodeOf(ex) == Block_code) ((Block*)ex)->flags &= ~BlockIsGlobal;
    ExprList *list;
    if (ex->code() == ExprNode_code)
	list = ConvertNode((struct ExprNode*)ex);
    else if (ex->code() == ExprList_code)
	list = (ExprList*)ex;
    else {
	list = GC_NEW ExprList(1);
	list->arg[0].E = ex;
    }
    return list;
}

#define ClearStatement(c) {statementDelim=c; cur.E=NULL; /*AddIdList(ff);*/}

#if 0
void AddIdList(struct ParseFile *ff)
  {
    register struct Identifier *id;
    int flags = 0;
    struct Statement *st = GetLastStatement(ff->block);
    st->idList = ff->identifiers;
    ff->identifiers = NULL;
    for (id = st->idList; id != NULL; id = id->next) {
	flags |= id->flags;
//	id->flags &= ~IdentNesting;
    }
    if ((flags & IdentExplicit) && st->kind == ExprStatement)
	st->kind = DeclStatement;
  }
#endif
    

#define SeenSomething() (cur != NULL)

Expr * ParseScan(Expr *left, register struct ParseFile *ff, int prio)
{
    extern Object StructAddLink(), StructRelease();
    Expr_Ptr cur;
    Object op; Expr *ex; Symbol * ss;
/*    struct Statement statement; */
    struct Declaration *decl;
    DeclListMark savedDecls = ff->unclaimed_decls.mark();
    struct Location startLoc;
    Expr_Ptr save_left;
    int c;
    int statementDelim = 0; /* either 0 or last statement delimiter char */
//    Object in;
    struct BlockSave save[1];
    struct Identifier *identifiers = ff->identifiers;
    int spaceFlag = ExprOneWord;
    cur.E = left;
    if (prio < DEFprio) TestPushBlock(save, ff);
    startLoc = SourceLocation(ff);

    for (;;) {
	int saveSpaceFlag;
	QReadEntry * entry;
	c = ff->get();
      retry:
	if (c == EOF) {
	    parsebuf* old = ff->pbuf();
	    if (is_expr(old)) {
		AddToken(((expr_parsebuf*)old)->expr);
	    }
	    if (old->chain != NULL) {
		ff->stream = old->chain;
		old->chain = NULL;
		delete old;
		continue;
	    }
	    ff->terminators |= ParseEOFseen;
//	    if (!SeenSomething() && ff->block == NULL) cur.E = EOF_mark;
	    break;
	}
	entry = (QReadEntry*)QReadEntries[c];
	switch (entry->code) {
	  case ReadHSpace: // Space TAB
	    saveSpaceFlag = spaceFlag;
	    ff->terminators &= ~ParseLParenSinceSpace;
	    if (prio < WRDprio) { ff->putback(c); goto loop_done; }
#if 0
	    if (prio == EOFprio && ff->pbuf()->tell_in_line() == 1) {
		ParseError(ff, "W Possible indentation error: initial space");
		c = ScanBlanks(ff);
		if (c != EOF) ff->putback(c);
		continue;
	    }
#endif
	    spaceFlag = 0;
	    if (prio == WRDprio) {
		if (!SeenSomething()) {
		    c = ScanBlanks(ff);
		    if (c != EOF) ff->putback(c);
		    continue;
		} else { ff->putback(c); goto loop_done; }
	    }
	    else {
		struct Location saveLoc = SourceLocation(ff);
#if 1
		c = ScanBlanks(ff);
		if (c == EOF || cur.E == NULL)
		    goto retry;
		ff->putback(c);
		save_left = ff->left;
		ff->left = cur;
		ex = ParseScan(NULL, ff, WRDprio);
		cur = ff->left;
		ff->left = save_left;
		if (ex != NULL) {
		    if (cur.E && saveSpaceFlag && ExprCodeOf(cur.E) == ExprNode_code)
			cur.E = ConvertNode(cur.node());
		    AddToken(ex);
		}
#else
		cur.E = ParseScan(cur.E, ff, WRDprio);
#endif
#if 0
		if (saveLoc.lineNo != SourceLocation(ff).lineNo)
		    ParseError(ff,
			"WARNING: multi-line word starting at line %d",
			saveLoc.lineNo);
#endif
		continue;
	      }

	  case ReadVSpace: // LF CR VT FF
	    ff->terminators &= ~ParseLParenSinceSpace;
	    if ((prio&PrioMask) <= DEFprio
		|| (prio&PrioMask) <= EOLprio
		/*&& !(ff->terminators & ParsePeekOK)*/ ) {
		ff->putback(c);
		/* prio = DEFprio; */
		goto loop_done;
	    }
	    int oldIndentation;
#if 0
	    if (ff->promptFile /*&& ff->current >= ff->readLimit*/) {
		char buf[10];
		static char *ContinuePrompt = "--------> ";
		sprintf(buf, "%d", ff->sourcePos.lineNo);
		ff->promptFormat = ContinuePrompt + 7 - strlen(buf);
	    }
#endif
	    ff->peek(); /* update curIndentation */
	    oldIndentation = ff->pbuf()->tell_in_line(); //ff->prevIndentation;
	    if (oldIndentation >= CurIndentation(ff)) ;
	    else if (SeenSomething()) {
		while (oldIndentation < CurIndentation(ff)) {
		    Expr *new_ex ;struct BlockSave save[1];
		    TestPushBlock(save, ff);
		    new_ex = ParseScan(NULL, ff, EOMprio);
		    TestPopBlock(save);
		    if (new_ex != NULL) { AddToken(new_ex); }
		    ff->peek(); /* update curIndentation */
		}
	    }
	    else
		cur.E = ParseIndentedLines(ff, &c);
	    if (prio <= EOMprio)
		goto loop_done;
	    if (SeenSomething()) {
		AddStatement(ff,cur.E);
		ClearStatement(c);
	    }
	    if (c != '\n') ff->putback(c);
	    continue;
	    
	  case ReadIllegal:
	    ParseError(ff, "Illegal input character: 0x%x", c & 0xFF);
	    continue;

	  case ReadDigit: // '0'..'9', as well as '.'
	    if (c == '.') {
		// '.' followed by non-digit is identifier.
		int c2 = ff->get();
		if (c2 == EOF) { goto ReadWord; }
		ff->putback(c2);
		if (c2 < '0' || c2 > '9')
		    goto ReadWord;
	    }
	    ex = ParseNumeric(ff, c);
	    if (ex != FailedParse) {AddToken(ex);}
	    else ParseError(ff, "Bad numeric!");
	    continue;

	  case ReadStatementSep:
	    if ((prio & PrioMask) < DEFprio)
		{ ff->putback(c); goto loop_done ;}
	    if (SeenSomething())
		{ AddStatement(ff, cur); ClearStatement(';');}
	    c = ScanBlanks(ff);
	    break;

	  case ReadLetter: /* Includes '.' and '_' */
	  case ReadSEscape: /* '\\' */
	  ReadWord:
	    ff->putback(c);
	    Identifier *id = ParseIdentifier(ff);
	    if (id == NULL)  // I.e. '\\' followed by '\n'.
		continue;
#if 0
	    c = ff->get();
	    if (c == ':') {
		if (ff->peek() != '=') {
		    MakeSymbolExpr *sexpr = GC_NEW MakeSymbolExpr();
		    sexpr->arg = lexpr->arg;
		    sexpr->length = lexpr->length;
		    ex = NewBindExpr(sexpr, ParseLook(ff, WRDprio));
		    AddToken(ex);
		    continue;
		}
	    }
	    if (c != EOF) ff->putback(c);
#endif
	    Symbol *sym = id->symbol();
	    extern HashTable IdMacroTable;
	    const StringC **ptr =
		StringLookup(&IdMacroTable, sym->string(), sym->length());
	    if (!HashNone(*ptr)) {
		entry = (QReadEntry*)ptr[1];
		goto do_macro;
	    }
	    AddToken(id);
	    continue;

	  case ReadDeclPrefix: /* c == ':' */
	    enum Privacy privacy;
	    struct Statement *st;
	    int isClassDef;
	    privacy = IsPrivate;
	    isClassDef = 0;
	    c = ff->get();
	    if (c == '=') {
		c = ff->get();
		if (c == '>')
		    ex = &QShiftAssignTo; // Op: :=>
		else {
		    if (c != EOF)
			ff->putback(c);
		    ex = &QAssignTo; // Op: :=
		}
		AddToken(ex);
		continue;
	    } else if (c == '%') {
		isClassDef = 1;
		c = ff->get();
	    } else if (c == '|') {
		privacy = IsPublic;
		c = ff->get();
	    }
	    if (!SeenSomething()) {
		struct Identifier *id;
		if (c == '\(') { // Use \( because of emacs.
		    /*if (prio < ?) ParseError(?); */
		    CheckBlock(ff);
		    unsigned char saveTerm = ff->terminators;
		    ff->terminators &= ~ParseAcceptRParen;
		    ex = ParseFunctionPattern(ff, &ss, isClassDef);
		    ff->terminators = saveTerm;
		    st = AppendStatement(ff->block, ex);
		    st->idList = id = NewIdentifier(ss, NULL);
		    id->flags |= IdentExplicit;
		    if (privacy==IsPublic)
			id->flags |= IdentExported;
		    st->kind = MethodStatement;
		    /* ClearStatement(':') without the AddIdList: */
		    statementDelim=':'; cur=NULL;
		    continue;
		}
		if (c == '*')
		    id = NewIdentifier(&Asterisk_sym, NULL);
		else {
		    ff->putback(c);
		    id = ParseIdentifier(ff);
		    if (id == NULL) {
			ParseError(ff,
				   "Invalid identifier character after colon");
			continue;
		    }
		}
		ss = id->symbol();
		if (isClassDef)
		    ex = (Expr*)DoQuote(AddAtom(ss, ff->module));
		else {
		    id->flags |= IdentExplicit;
		    if (privacy==IsPublic)
			id->flags |= IdentHasMark;
		    AddIdentifier(id, ff, privacy);
		    ex = id;
		}
		AddToken(ex);
	    }
	    continue;

	  case ReadRParen: /* c == ')' */
	    if (prio == CMDprio /*ff->terminators & ParseAcceptRParen*/) {
		if (!SeenSomething()) cur.E = NullExpr;
		else if (cur.code() == ExprNode_code)
		    cur.E = ConvertNode(cur.node());
		continue;
	    } else {
		ff->putback(c);
		goto loop_done;
	    }

	  case ReadTMacro:
	  do_macro:
	    Expr_Ptr save_cur = ff->cur;
	    if (SeenSomething()) ff->cur = cur;
	    else ff->cur = left;
	    op = (*entry->func)(ff);
	    if (SeenSomething()) cur = ff->cur;
	    else left = ff->cur;
	    ff->cur = save_cur;
	    if (op == &REJECT_sym)
		goto loop_done;
	    if (op != NullExpr) AddToken(op);
	    continue;

	  default:
	  case ReadWord:
	    ff->putback(c);
	    goto loop_done;
	}
 	   
	ff->putback(c);
	continue;

#if 0
	Identifier *id = NewIdentifier(ss, ff);
	id->set_location(SourceLocation(ff));
	id->flags |= hasMark;
	AddToken(id);
#endif
    } /* bottom of main loop */

  loop_done:
    if (cur.E != NULL && cur.code() == ExprNode_code)
	cur.E = ConvertNode(cur.node());
    if (ff->block != 0) {
	if (statementDelim == ';' && !SeenSomething())
	    cur.E = NullExpr;
	if (SeenSomething()) { AddStatement(ff, cur.E); ClearStatement('\n'); }
	if (ff->block->size == BlockIsLoopMagic) { /* loop-body */
	    ff->block->size = 0;
	    for (decl = *savedDecls; decl; decl = decl->next()) {
		//fprintf(stderr,"Loop-nested id: %s.\n", decl->name.string());
		decl->loop_nesting() ++;
	    }
	}
	else if (ff->unclaimed_decls.mark() != savedDecls)
	    ff->block->decls.grab_from(ff->unclaimed_decls, savedDecls);
	ff->block->flags &= ~BlockReturnSelf;
	for (decl = ff->block->decls.first; decl != NULL; decl= decl->next()) {
	    if (decl->privacy() == IsPublic) {
		ff->block->flags |= BlockReturnSelf;
		if (ff->block->rtype == NULL && ff->block->enclosing)
		    BindRecordType(ff->block, 0);
		break;
	    }
	}
	ff->block->set_location(startLoc);
	cur.E = ff->block;
	ff->block = NULL;
    }
#if 0
    else
      {
	if (left != NULL)
	    if (!SeenSomething()) cur.E = left;
	    else cur.node() = NewExprNode(left, cur.E);
	if (SeenSomething()
	 && (prio != WRDprio || save_left.E == NULL)) /*i.e. not a partial word*/
	    cur.node() = MakeLastfix(cur.E);
      }
#endif
    if (prio < DEFprio) TestPopBlock(save);
    return cur.E;
  }

int SkipBlanks(int c, register FILE *f)
  { while (c == ' ' || c == '\t') c = getc(f);
    return c;
  }
int intSkipRestLine(register FILE *f)
  { register ch;
    do ch = getc(f); while (ch != '\n' && ch != EOF && ch != '\r');
    return ch;
  }

int ScanBlanks(register struct ParseFile *ff, int skip_new_lines = 0)
 /* skip horizontal white space and comments; return final character */
{
    for (;;) {
	int ch = ff->get();
	if (ch == CommentChar) ParseComment(ff);
	else if (ch == ' ' || ch == '\t')
	    continue;
	else if (skip_new_lines && ch == '\n')
	    continue;
	return ch;
    }
}

void ParseError(struct ParseFile *ff, char *format, ...)
  {
    va_list args;
    int level = CheckErrorLevel(format);
    struct Location *sourcePos;
    if (level >= 0) format += 2;
    else level = ErrMessage;
    if (ff == NULL)
	sourcePos = NULL;
    else
      {
	sourcePos = &ff->sourcePos;
	sourcePos->lineNo = ff->pbuf()->line_number();
	if (level > ff->errors) ff->errors = level;
      }
    if (ff->cur_proc && ff->cur_proc->fname)
	fprintf(stderr, "In %s: ", ff->cur_proc->fname);
    va_start(args, format);
    ErrorPrint(ParseTimeErr, level, sourcePos, stderr, format, args);
    va_end(args);
    int offset = ff->pbuf()->tell_in_line();
    ff->pbuf()->seek_in_line(0);
    for (;;) {
	int ch = ff->get();
	if (ch == EOF || ch == '\n') break;
	fputc(ch, stderr);
    }
    fputc('\n', stderr);
    ff->pbuf()->seek_in_line(0);
    for (int i = 1; i < offset; i++) {
	int ch = ff->get();
	if (ch == EOF || ch == '\n') break;
	fputc(ch=='\t' ? ch : ' ', stderr);
    }
    fputs("^\n", stderr);
    ff->pbuf()->seek_in_line(offset);
    fflush(stderr);
  }

void
ParseFilePrint(register struct ParseFile *ff, FILE *file)
{
    fputs("[buf: ", file);
#if 0
    for (Object * ptr = ff->current; ptr < ff->readLimit; ptr++)
      {
	if (IsChar(*ptr)) {
	    int i = CharExtract(*ptr);
	    fprintf(file, i>=' ' && i<127 ? "'%c'" : "'\\%o'", i);
	} else
	    fprintf(file, "'%.*s", SymbolLength(*ptr), SymbolString(*ptr));
	fputs("; ", file);
      }
    fputc('\n', file);
    register char *cptr;
    for (cptr = ff->bufStart(); cptr < ff->curPtr(); )
	fputc(*cptr++, file);
    fputs("\033[7m^\033[m", file);
    while (cptr < ff->readFence()) fputc(*cptr++, file);
    fputs("\033[7m^\033[m", file);
    fputc(']', file);
#endif
}

extern "C" void ParseDump(struct ParseFile *ff)
 { ParseFilePrint(ff, stderr); fflush(stderr); }

Expr * ParseOne(struct ParseFile *ff, int prio)
/* like ParseLook, but if no expression is found, retry with PARprio */
{
    if (LogExpr & 4)
	fprintf(stderr, "[Col:0x%x->", ff->pbuf()->tell_in_line());
    int ch = ScanBlanks(ff, 1);
    if (ch == EOF)
	return (Expr*)EOF_mark;
    ff->putback(ch);
    if (LogExpr & 4)
	fprintf(stderr, "->0x%x]\n", ff->pbuf()->tell_in_line());
#if 1
    Expr *ex = ParseIndentedLines(ff, &ch);
//    if (ch != EOF) ff->putback(ch);
    return ex;
#else
    Expr *ex = ParseScan(NULL, ff, EOLprio);
    int ch = ff->get();
    if (ch == EOF)
	return ex;
    if (ch != '\n') {
	ParseError(ff, "Confusion in ParseOne");
	return FailedParse;
    }
    ch = ff->get();
#if 0
    int ch = ScanBlanks(ff);
    if (ch == EOF) SIGNAL_FailedParse;
    else if (ch == '\n')
	return ParseIndentedLines(ff, &ch);
    else { ff->putback(ch); return ParseLook(ff, prio); }
#else
    Expr *ex = ParseScan(NULL, ff, prio);
/*  if (ex == NULL && prio > EOMprio) ex = ParseScan(NULL, ff, EOMprio); */
    if (ex == NULL) ex = ParseScan(NULL, ff, EOMprio);
    if (ex == NULL)
      {
	ParseError(ff, "Empty statement");
	ex = NullExpr;
	/* ex = ParsePar(ff); */
      }
    return ex;
#endif
#endif
  }

Expr * ParseLook(struct ParseFile *ff, int prio)
{
    Expr *ex = ParseScan(NULL, ff, prio);
    if (ex == NULL) ex = NullExpr;
    return ex;
}

Expr *ParseLookEOF(register struct ParseFile *ff)
{
    Block *block = ff->block;
    for (;;) {
	ff->block = block;
	Expr *ex = ParseScan(NULL, ff, DEFprio);
	if (ex == EOF_mark)
	    break;
	if (ex != NULL && ex != NullExpr && ex != block)
	    AddStatement(ff, ex);
	int c = ff->get();
	if (c == EOF)
	    break;
	if (c != '\n' && c != ';')
	    ParseError(ff, "W Bad statement ending");
    }
    return block;
}

Root* DoParse(Vector* args)
{
    parsebuf *str_buf_list;
    parsebuf **str_buf_tail = &str_buf_list;
    Root** arg_ptr = args->start_addr();
    for (int i = 0; i < args->leng(); i++) {
	Root* arg = *arg_ptr++;
	parsebuf* pbuf;
	if (arg->isKindOf(*Expression::desc())) {
	    pbuf = new expr_parsebuf((Expression*)arg);
	}
	else {
	    const StringC *str = Coerce2String(arg);
	    pbuf = new string_parsebuf(str->chars(), str->leng());
	}
	*str_buf_tail = pbuf;
	str_buf_tail = &pbuf->chain;
    }
    *str_buf_tail = NULL;
    if (str_buf_list == NULL) { // No args.
	str_buf_list = new string_parsebuf("", 0);
    }
    ParseFile *ff = OpenParseFile(str_buf_list, DefaultModule);
    Expr *exp;
#if 0
    if (len == 0) exp = NullExpr;
    else
#endif
	{
	struct BlockSave save[1];
	ff->block = NULL;
	TestPushBlock(save, ff);
	ff->block = GC_NEW Block(NULL);
	exp = ParseLook(ff, EOLprio);
	TestPopBlock(save);
    }
#ifndef DO_GC
    delete ff;
#endif
    return exp;
}
