/* BEGIN LICENSE BLOCK
 * Version: CMPL 1.1
 *
 * The contents of this file are subject to the Cisco-style Mozilla Public
 * License Version 1.1 (the "License"); you may not use this file except
 * in compliance with the License.  You may obtain a copy of the License
 * at www.eclipse-clp.org/license.
 * 
 * Software distributed under the License is distributed on an "AS IS"
 * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied.  See
 * the License for the specific language governing rights and limitations
 * under the License. 
 * 
 * The Original Code is  The ECLiPSe Constraint Logic Programming System. 
 * The Initial Developer of the Original Code is  Cisco Systems, Inc. 
 * Portions created by the Initial Developer are
 * Copyright (C) 1989-2006 Cisco Systems, Inc.  All Rights Reserved.
 * 
 * Contributor(s): 
 * 
 * END LICENSE BLOCK */

/*----------------------------------------------------------------------
 * System:	ECLiPSe Constraint Logic Programming System
 * Version:	$Id: read.c,v 1.21 2017/09/01 03:05:10 jschimpf Exp $
 *
 * Content:	ECLiPSe parser
 * Author: 	Joachim Schimpf, IC-Parc
 *		Micha Meier, ECRC (some macro transformation code)
 *
 * History:
 *	This is a complete rewrite of the original Sepia parser (written
 *	by Dominique Henry de Villeneuve) and retains very little of the
 *	original code. The new code is structurally based on Richard O'Keefe's
 *	public domain Prolog parser (read.pl), however, it is completely
 *	deterministic and therefore has a few restrictions wrt the resolution
 *	of ambiguities.
 *
 * TODO:
 *	- reduce the overhead of operator lookups, and avoid multiple lookups
 *	- optionally parse {a,b} as {}(a,b) as in Mercury
 *	- parse (Term)(Args) as apply(Term, Args), similar to Mercury's
 *		(X^T)(A,B,C) as ''((X^T),A,B,C)
 *
 * Syntax extensions:
 *
 *	Parse:		as:				syntax_option:
 *
 *	X[Args]		subscript(X, [Args])		no_array_subscripts
 *	f(a)[Args]	subscript(X, [Args])		no_array_subscripts
 *	a[Args]		subscript(a, [Args])		atom_subscripts
 *	(...)[Args]	subscript(..., [Args])		general_subscripts
 *	[Xs][Args]	subscript([Xs], [Args])		general_subscripts
 *	Subscript[Args]	subscript(Subscript, [Args])	general_subscripts
 *
 *	X{Args}		X 'with attributes' [Args]	no_attributes
 *	a{Args}		a with [Args]			no_curly_arguments
 *	a{}		a with []			no_curly_arguments

 *	{Args}		{}(Args)			not curly_args_as_list
 *	{Args}		{}([Args])			curly_args_as_list
 *
 *	X(Args)		apply(X, [Args])		var_functor_is_apply
 *
 *	f(a){Args}	unused
 *	f(a)(Args)	unused
 *	123[Args]	unused
 *	123{Args}	unused
 *	123(Args)	unused
 *
 *	(the atom-bracket sequences are recognised only where the
 *	atom is not a prefix/infix).
 *
 * Call hierarchy of the parser:
 *
 *  ec_read_term
 *	_read_next_term			% top term or right arg of infix/prefix
 *	    _read_next_term	
 *	    _read_list			% reads a normal list in [] syntax
 *		_read_next_term
 *	    _read_struct		% reads structure in canonical syntax
 *		_read_next_term
 *	    _read_sequence_until	% reads bracketed comma-sequence
 *		_read_next_term
 *	    _read_after_term		% infix/postfix/subscript/delimiter
 *		_read_next_term	
 *		_read_after_term
 *		_read_list		% reads a [] subscript list
 *
 *
 *
 *
 * Annotated terms
 * ---------------
 * When invoked with the LAYOUT_PLEASE option, the parser returns an
 * annotated term instead of the plain parsed term. In an annotated
 * term, every subterm is wrapped into a annotated_term/4 structure:
 *
 *	:- export struct(annotated_term(
 *		term,			% var,atomic,compound
 *		type,			% term type (see below)
 *		from, to		% source position (integer)
 *	)).
 *
 * The type field describes the type of the parsed term and is one of
 * the following:
 *
 *	integer
 *	float
 *	rational
 *	breal
 *	atom
 *	string		term is a string or a char_code list
 *	anonymous	term is an anonymous variable
 *	var(NameAtom)	term is a variable with the given name
 *	compound	term is compound (with annotated subterms)
 *
 * In the case of atomic terms and variables, the term field simply
 * contains the plain parsed term. For compound terms, the term field
 * contains a structure whose functor is the functor of the plain term,
 * but whose arguments are annotated versions of the plain term arguments.
 * E.g. the source term
 * 	3
 *    is parsed as
 *	annotated_term(3, integer, ...)
 * 
 * The source term
 * 	foo(bar, X, _, 3)
 *    is parsed as
 *	annotated_term(foo(
 *		annotated_term(bar,
 *		    atom, ...),
 *		annotated_term(_,
 *		    anonymous, ...),
 *		annotated_term(3,
 *		    integer, ...)),
 *	    compound, ...)
 * The source term
 * 	[1,2]
 *    is parsed as
 *	annotated_term(.(
 *		annotated_term(1,
 *		    integer, ...),
 *		annotated_term(.(
 *			annotated_term(2,
 *			    integer, ...),
 *			annotated_term([],
 *			    atom, ...)),
 *		    compound, ...)),
 *	    compound, ...)
 *
 *
 * The from/to fields of an annotated term describe a "source position"
 * of the term. Every term/subterm is represented by one (sometimes two
 * consecutive) tokens in the source, defined as follows:
 *
 * - atoms, strings and unsigned numbers are represented by their
 *   corresponding IDENTIFIER, NUMBER or STRING token.
 * - signed numbers are represented by two consecutive tokens (sign+number)
 * - compound terms in canonical notation are represented by two consecutive
 *   tokens (functor and opening parenthesis)
 * - compound terms in operator syntax are represented by the operator's
 *   IDENTIFIER token
 * - lists: a proper list [a,b] has subterms
 * 	[a,b]	represented by the [ token,
 * 	[b]	represented by the , token,
 * 	[]	represented by the ] token,
 *	a	represented by itself,
 *	b	represented by itself.
 *   a general list [a,b|T] has subterms
 *   	[a,b|T]	represented by the [ token,
 *   	[b|T]	represented by the , token,
 *   	T	represented by itself,
 *   	a	represented by itself,
 *   	b	represented by itself.
 *   Note that the | and ] tokens do not represent any term.
 * - special notations:
 *   X[Args]
 *	subscript(X, [...]) represented by the [ token,
 *	X,Args	represented by itself,
 *   X{Args}
 *   	'with attributes'(X,[Args]) represented by { token,
 *		(alternatively: X{ tokens)
 *   	X,Args	represented by themselves
 *   a{Args}
 *	with(a,[Args])	represented by the { token
 *		(alternatively: a{ tokens)
 *   	a,Args	represented by themselves
 *   X(Args)
 *   	apply(X,[Args])	represented by the ( token
 *   	X,Args	represented by themselves
 *   In all these cases, the commas represent nothing.
 *
 * The source position of a term is the union of the source positions of
 * the representing tokens.
 *----------------------------------------------------------------------*/


#include	"config.h"
#include	"sepia.h"
#include	"types.h"
#include	"embed.h"
#include	"error.h"
#include	"mem.h"
#include	"dict.h"
#include	"lex.h"
#include	"emu_export.h"
#include 	"ec_io.h"
#include 	"read.h"
#include	"module.h"
#include	"property.h"
#include	"os_support.h"

#ifdef HAVE_STRING_H
#include <string.h>
#endif

#include <math.h>


/*
 *	TYPES
 */

typedef struct s_varword		/* variable stack */
{ 
    char  		*str;
    pword		*ptr;
    int			 lock;
    struct s_varword	*next;
}	vword;


typedef struct parse_desc {

    /* in: */
	stream_id	nst;		/* stream we are reading from	*/
	syntax_desc	*sd;		/* module syntax descriptor	*/
	dident		module;		/* context module (for op,macro)	*/
	type		module_tag;	/* context module tag		*/
	int		options;	/* parser options		*/
	int		max_arg_prec;	/* maximium argument precedence	*/

    /* internal: */
	token_desc	token,		/* current token		*/
			prev_token,	/* previous token		*/
			next_token;	/* next token			*/

	vword		*var_table;	/* hash table for variable names */
	int		var_table_size;	/* the table's size		*/
	word		counter;	/* its generation counter	*/

	int		macro;		/* term may contain a macro	*/
	pword		*var_list_tail;	/* tail of varlist (readvar)	*/

	temp_area	string_store;	/* temp store for strings	*/
	ec_eng_t	*engine;	/* engine for compound data creation */
} parse_desc;


/*
 * STATIC VARIABLES
 */

static dident	d_comma0_;
static dident	d_bar0_;
static dident	d_annotated_term_;
static dident	d_anonymous_;


/*
 * FUNCTIONS
 */

static parse_desc
	*_alloc_parse_env(ec_eng_t *, int options, stream_id nst, dident module, type mod_tag);

static vword *
	_var_table_entry(parse_desc *pd, char *varname, word lenght);

static int
	_transf_attribute(register pword *pw, pword *r, int def),
	_read_next_term(parse_desc *pd, int context_prec, int context_flags,
		pword *result),
	_read_after_term(parse_desc *pd, int context_prec, int context_flags,
		int term_prec, pword *result);


/*
 *	CONSTANTS OF THE PARSER
*/

/* size of the variable hash table (should be a prime) */
#define NUMBER_VAR 1009



/*
 * Values for context_flags
 * The *_TERMINATES flags mean that COMMA/BAR terminate a term
 * unconditionally, i.e. overriding the normal precedence rules
 * (this is used when a subterm is a list or structure argument).
 * The SUBSCRIPTABLE flag means the term may be followed by a subscript.
 */

#define COMMA_TERMINATES	0x01	/* list elements or structure fields */
#define BAR_TERMINATES		0x02	/* list elements only */
#define SUBSCRIPTABLE		0x04	/* term can be followed by subscript */
#define PREBINFIRST		0x08	/* first argument of prefix binary op */
#define FZINC_SUBSCRIPTABLE	0x10	/* subscripts after atoms */
#define ZINC_SUBSCRIPTABLE	0x20	/* subscripts after almost everything */
#define ATTRIBUTABLE            0x40	/* term can be followed by attributes */
#define ARGOFOP			0x80	/* argument of an operator */
#define OPCANTFOLLOW		0x100	/* (infix/postfix) operator can't follow (iso) */


/*
 * Interface with the lexer
 *
 * The current token is always cached in the parse_desc.
 * Normally, we advance to the next token by calling Next_Token().
 * When lookahead is needed, we use Lookahead_Next_Token() instead,
 * and later go back by calling Prev_Token().
 */

#define	Next_Token(pd) \
	if (pd->next_token.class == NO_TOKEN) { \
	    (void) lex_an(pd->nst, pd->sd, ec_eng, &pd->token); \
	} else { \
	    pd->token = pd->next_token; \
	    pd->next_token.class = NO_TOKEN; \
	}

#define	Lookahead_Next_Token(pd) \
	pd->prev_token = pd->token; \
	if (pd->token.string == (char*) StreamLexAux(pd->nst)) { \
	    pd->prev_token.string = TempAlloc(pd->string_store, pd->token.term.val.nint + 1); \
	    Copy_Bytes(pd->prev_token.string, pd->token.string, pd->token.term.val.nint + 1); \
	} \
	Next_Token(pd)

#define	Prev_Token(pd) \
	pd->next_token = pd->token; \
	if (pd->token.string == (char*) StreamLexAux(pd->nst)) { \
	    pd->next_token.string = TempAlloc(pd->string_store, pd->token.term.val.nint + 1); \
	    Copy_Bytes(pd->next_token.string, pd->token.string, pd->token.term.val.nint + 1); \
	} \
	pd->token = pd->prev_token;

#define IsClass(pd,cl)		((pd)->token.class == (cl))
#define IsChar(pd,char)		((pd)->token.term.val.nint == (char))
#define IsToken(pd,cl,char)	(IsClass(pd,cl) && IsChar(pd,char))

#define TokenString(pd) \
	(pd->token.string)

#define TokenStringLen(pd) \
	(pd->token.term.val.nint)

#define Save_Token_String(pd, s, l) \
	l = TokenStringLen(pd); \
	if (TokenString(pd) == (char*) StreamLexAux(pd->nst)) { \
	    s = TempAlloc(pd->string_store, l + 1); \
	    Copy_Bytes(s, TokenString(pd), l + 1); \
	} else { \
	    s = TokenString(pd); \
	}

#define Make_Ident_Token(pd, s, l) \
        pd->token.string = (s); \
        pd->token.term.val.nint = (l); \
        pd->token.class = IDENTIFIER;

/*
 * Macros (read/clause/goal-macros)
 * While parsing the term, we check whether we come across any items that
 * _may_ have a macro transformation defined (no matter which), and set a flag.
 * If any, we do a macro-expansion pass over the term after it has been parsed.
 * This is done in Prolog (by calling expand_macros_/3).
 */

#define Flag_Type_Macro(pd, type) \
	{ if (DidMacro(TransfDid(type))) pd->macro = 1; }
	
#define Flag_Did_Macro(pd, wdid) \
	{ if (DidMacro(wdid)) pd->macro = 1; }
	

/*
 * Term construction:
 * The Build_XXX macros/functions construct the ECLiPSe terms, wrapped
 * into a term descriptor, if requested.
 */

#define	TERM_TERM	1
#define	TERM_TYPE	2
#define	TERM_FILE	3
#define	TERM_LINE	4
#define	TERM_FROM	5
#define	TERM_TO		6
#define	TERM_ARITY	6


static source_pos_t no_pos_ = {D_UNKNOWN,0,0,0};

#define Merge_Source_Pos(p1,p2,paux)			\
	paux.file = p1.file;				\
	paux.line = p1.line;				\
	paux.from = p1.from;				\
	paux.to = p2.to;


/*
 * Term construction
 */

/*
 * Construct the annotated_term/4 descriptive wrapper, if requested
 *	annotated_term(Term, <dtype>, <pos.from>, <pos.to>)
 */

#define	Make_Term_Wrapper(pw, _pw, dtype, pos)		\
	if (!(pd->options & LAYOUT_PLEASE)) {		\
	    _pw = (pw);					\
	} else {					\
	    _pw = TG;					\
	    Make_Struct(pw, TG);			\
	    Push_Struct_Frame(d_annotated_term_);	\
	    Make_Atom(_pw+TERM_TYPE, dtype);		\
	    Make_Atom(_pw+TERM_FILE, (pos).file);	\
	    Make_Integer(_pw+TERM_LINE, (pos).line);	\
	    Make_Integer(_pw+TERM_FROM, (pos).from);	\
	    Make_Integer(_pw+TERM_TO, (pos).to);	\
	    _pw += TERM_TERM;				\
	}

/*
 * Construct a annotated_term/4 descriptive wrapper for a variable, if requested
 *	annotated_term(X, var('X'), <pos.from>, <pos.to>)
 */
#define	Make_Var_Wrapper(pw, pvar, pos)			\
	if (!(pd->options & LAYOUT_PLEASE)) {		\
	    pvar = (pw);				\
	} else {					\
	    pword *_pw = TG;				\
	    Make_Struct(pw, TG);			\
	    Push_Struct_Frame(d_annotated_term_);	\
	    pvar = _pw+TERM_TERM;			\
	    Make_Struct(_pw+TERM_TYPE, TG);		\
	    Make_Atom(_pw+TERM_FILE, (pos).file);	\
	    Make_Integer(_pw+TERM_LINE, (pos).line);	\
	    Make_Integer(_pw+TERM_FROM, (pos).from);	\
	    Make_Integer(_pw+TERM_TO, (pos).to);	\
	    _pw = TG;					\
	    Push_Struct_Frame(d_.var);			\
	    Make_Atom(_pw+1, enter_dict_n(TokenString(pd), TokenStringLen(pd), 0));\
	}

/*
 * This macro copies the pwords at 'from' to 'to', except that in the case of
 * self-reference it creates a new self-reference at 'to'. This assumes that
 * there are no references to the location 'from' that could become dangling!
 */
#define Move_Pword(from, to)					\
	(to)->tag.all = (from)->tag.all;			\
	if (IsRef((from)->tag) && (from)->val.ptr == (from)) {	\
	    (to)->val.ptr = (to);				\
	} else {						\
	    (to)->val.all = (from)->val.all;			\
	}

#define Build_List(pw,phead,pos) {			\
	pword *_pw;					\
	Make_Term_Wrapper(pw, _pw, d_.compound0, pos);	\
	phead = TG;					\
	Make_List(_pw, TG);				\
	Push_List_Frame();				\
    }

#define Build_Nil(pw,pos) {			\
	pword *_pw;					\
	Make_Term_Wrapper(pw, _pw, d_.atom0, pos);	\
	Make_Nil(_pw);					\
    }

#define Build_Integer(pw,n,pos) {			\
	pword *_pw;					\
	Make_Term_Wrapper(pw, _pw, d_.integer0, pos);	\
	Make_Integer(_pw, n);				\
    }

#define Build_Struct(pw, pfct, d,pos) {			\
	pword *_pw;					\
	Flag_Type_Macro(pd, TCOMP);			\
	Flag_Did_Macro(pd, d);				\
	Make_Term_Wrapper(pw, _pw, d_.compound0, pos);	\
	Make_Struct(_pw, TG);			\
	pfct = TG;					\
	Push_Struct_Frame(d);			\
    }

#define Build_Struct_Or_List(pw, pfct, d,pos) {		\
	pword *_pw;					\
	Flag_Type_Macro(pd, TCOMP);			\
	Flag_Did_Macro(pd, d);				\
	Make_Term_Wrapper(pw, _pw, d_.compound0, pos);	\
	if ((d) == d_.list) {				\
	    Make_List(_pw, TG);				\
	    pfct = TG-1;				\
	    Push_List_Frame();				\
	} else {					\
	    Make_Struct(_pw, TG);			\
	    pfct = TG;					\
	    Push_Struct_Frame(d);			\
	}						\
    }

#define	Build_Atom_Or_Nil(pw, d,pos) {			\
	pword *_pw;					\
	Flag_Type_Macro(pd, TDICT);			\
	Flag_Did_Macro(pd, d);				\
	Make_Term_Wrapper(pw, _pw, d_.atom0, pos);	\
	_pw->val.did = d;				\
	_pw->tag.kernel = ((d) == d_.nil) ? TNIL : TDICT;\
    }

#define	Build_Number_From_Token(pd, pw) {		\
	pword *_pw;					\
	Make_Term_Wrapper(pw, _pw,			\
		tag_desc[tag_desc[TagType(pd->token.term.tag)].super].type_name,\
		pd->token.pos);\
	Flag_Type_Macro(pd, TagType(pd->token.term.tag));	\
	if (IsInterval(pd->token.term.tag)) {		\
	    Unmark_Interval_Raw(pd->token.term.val.ptr);	\
	    if (!GoodInterval(pd->token.term.val.ptr))	\
	    	return BAD_NUMERIC_CONSTANT;		\
	}						\
	*_pw = pd->token.term;				\
    }

#define	Build_String_From_Token(pd, pw) {		\
	word len1 = TokenStringLen(pd) + 1;		\
	pword *_pw;					\
	Flag_Type_Macro(pd, TSTRG);			\
	Make_Term_Wrapper(pw, _pw, d_.string0, pd->token.pos);		\
	_pw->val.ptr = TG;				\
	_pw->tag.kernel = TSTRG;			\
	Push_Buffer(len1);				\
	Copy_Bytes(StringStart(_pw->val), TokenString(pd), len1);\
    }


static void
_build_list_from_token(parse_desc *pd, pword *pw)
{
    ec_eng_t *ec_eng = pd->engine;
    int i;
    Flag_Type_Macro(pd, TINT);
    Flag_Type_Macro(pd, TDICT);
    Flag_Did_Macro(pd, d_.nil);
    Flag_Type_Macro(pd, TCOMP);
    Flag_Did_Macro(pd, d_.list);
    if (pd->token.class == CODES) {
        for(i=0; i<TokenStringLen(pd); ++i)
        {
            pword *phead;
            Build_List(pw, phead, pd->token.pos);
            Build_Integer(phead, TokenString(pd)[i], pd->token.pos);
            pw = phead+1;
        }
    } else /*if (pd->token.class == CHARS)*/ {
        for(i=0; i<TokenStringLen(pd); ++i)
        {
            pword *phead;
            dident char_did = enter_dict_n(TokenString(pd)+i, 1, 0);
            Build_List(pw, phead, pd->token.pos);
            Build_Atom_Or_Nil(phead, char_did, pd->token.pos);
            pw = phead+1;
        }
    }
    Build_Nil(pw, pd->token.pos);
}


static pword *
_make_variable_from_token(parse_desc *pd, pword *pvar)
{
    ec_eng_t *ec_eng = pd->engine;
    dident did0 = D_UNKNOWN;
    /*
     * Non-anonymous variables are always allocated separately and referenced
     * from all their occurrences. The self-reference is never moved, and
     * the references can simply be copied. This is somewhat suboptimal since
     * one occurrence could have the self-reference in-place, but then that
     * occurrence could not be moved easily because it would be referred by
     * other occurrences and by the name table (see usage of Move_Pword()).
     */
    Make_Ref(pvar, TG);
    pvar = TG++;
    Check_Gc;
    if (pd->options & VARNAMES_PLEASE) {
	did0 = enter_dict_n(TokenString(pd), TokenStringLen(pd), 0);
	Make_NamedVar(pvar, did0);
    } else {
	Make_Var(pvar);
    }
    if (pd->var_list_tail)		/* need list element for readvar */
    {
	pword *pw = TG;
	Make_List(pd->var_list_tail, TG);
	pd->var_list_tail = &pw[1];
	Push_List_Frame();		/* list element */
	if (pd->options & READVAR_PAIRS) {
	    Make_List(&pw[0], TG);
	    pw = TG;
	    Push_List_Frame();		/* ['Name'|Var] pair */
	} else {
	    Make_Struct(&pw[0], TG);
	    pw = TG+1;
	    Push_Struct_Frame(d_.unify);
	}
	if (did0 == D_UNKNOWN)
	    did0 = enter_dict_n(TokenString(pd), TokenStringLen(pd), 0);
	Make_Atom(&pw[0], did0);
	Make_Ref(&pw[1], pvar);
    }
    return pvar;
}


/*
 * Lookahead function:	_delimiter_follows()
 *
 * Succeeds if a delimiter follows, i.e. something that can definitely
 * not start a term. This is used to disambiguate between infix and postfix:
 * when a delimiter follows, only the postfix interpretation is possible.
 */

static int
_delimiter_follows(parse_desc *pd)
{
    ec_eng_t *ec_eng = pd->engine;
    int res;
    Lookahead_Next_Token(pd);
    switch(pd->token.class)
    {
    case EOI:
    case EOCL:
    case COMMA:
    case BAR:
    case CLOSING_SOLO:
	res = 1;
	break;

    default:
	res = 0;
	break;
    }
    Prev_Token(pd);
    return res;
}


/*
 * Lookahead function:	_cant_follow_prefix()
 *
 * This is one of the more tricky bits of the whole parser.  The
 * function returns true if the current token cannot possibly follow a
 * prefix operator with precedence oprec/rprec (in that case, we may
 * still be able to parse the term by ignoring the prefix-property and
 * interpreting the potential prefix as a plain atom).  If the current
 * token happens to be an identifier, we look ahead a second token to
 * get better ambiguity resolution.
 */

/*
 * Conservative check for tokens that can start but not follow a term
 */
#define CantFollowTerm(class) (\
	(class)==NUMBER || (class)==SPACE_NUMBER || (class)==REFERENCE \
	|| (class)==UREFERENCE || (class)==STRING || (class)==CODES \
	|| (class)==CHARS || (class)==SPACE_SOLO)
 
#define IsDelimiter(class) (\
	(class)==EOI || (class)==EOCL || (class)==COMMA || (class)==BAR \
	|| (class)==CLOSING_SOLO)

static int
_cant_follow_prefix(parse_desc *pd, int context_flags, int rprec, int prefix_arity)
{
    ec_eng_t *ec_eng = pd->engine;
    opi pre_op, follow_op;
    dident did0;
    int status, class;

    class = pd->token.class;
    switch(class)
    {
    case EOCL:
    case EOI:
    case CLOSING_SOLO:
	return 1;

    case COMMA:
	if (context_flags & COMMA_TERMINATES)
	    return 1;
	did0 = d_comma0_;
	goto _check_precedence_;

    case BAR:
	if ((context_flags & BAR_TERMINATES) || (pd->sd->options & BAR_IS_NO_ATOM))
	    return 1;
	did0 = d_bar0_;
	goto _check_precedence_;

    case IDENTIFIER:
    case QIDENTIFIER:
	/*
	 * An atom which is not an operator CAN follow the prefix
	 */
	did0 = check_did_n(TokenString(pd), TokenStringLen(pd), 0);
	if (did0 == D_UNKNOWN || !DidIsOp(did0))
	    return 0;

_check_precedence_:			/* (did0,class) */

	if (pd->sd->options & ISO_RESTRICTIONS)
	    return 0;

	/*
	 * A functor-term CAN follow the prefix
	 */
	Lookahead_Next_Token(pd);	/* Prev_Token(pd) must follow! */
	if (IsClass(pd, SOLO) && (IsChar(pd, '(') || IsChar(pd, '{')))
	    goto _return_0_;
	    
	/*
	 * A signed number CAN follow the prefix
	 */
	if (class==IDENTIFIER && (did0 == d_.minus0 || did0 == d_.plus0) && IsClass(pd,NUMBER))
	    goto _return_0_;

	/*
	 * prefix with lower priority CAN follow first prefix
	 */
	pre_op = visible_prefix_op(did0, pd->module, pd->module_tag, &status);
	if (OpiPreced(pre_op) && (OpiPreced(pre_op) <= rprec))
	    goto _return_0_;

	if (prefix_arity == 1)
	{
	    /*
	     * An infix/postfix with higher precedence CAN'T follow the prefix,
	     * i.e. forces the prefix to be interpreted as an atom.
	     * Moreover, if we have a sequence
	     *        prefix infix NEXT
	     * and NEXT is a token that can't follow a complete term, this
	     * forces the prefix to be interpreted as an atom (otherwise it
	     * would be a syntax error anyway), eg:  local / 2
	     *
	     * Examples:
	     *	fy9  yfx10 3	->	(fy9) yfx10 3
	     *	fy9  yfx10 foo	->	(fy9) yfx10 foo
	     *	fy9  yfx9  3	->	(fy9) yfx9 3
	     *	fy9  yfx9  foo	->	error because of conservative CantFollowTerm()
	     *	fy10 yfx9  3	->	(fy10) yfx9 3
	     *	fy10 yfx9  foo	->	error because of conservative CantFollowTerm()
	     *	fy9  yf10	->	(fy9) yf10
	     *	fy9  yf9	->	fy9 (yf9)	i.e. prefer prefix
	     *	fy10 yf9	->	fy10 (yf9)
	     */
	    if ((OpiPreced(follow_op = visible_infix_op(did0, pd->module, pd->module_tag, &status))
		    && (rprec < InfixLeftPrecedence(follow_op)
			    || CantFollowTerm(pd->token.class)))
	     || (OpiPreced(follow_op = visible_postfix_op(did0, pd->module, pd->module_tag, &status))
		    && rprec < PostfixLeftPrecedence(follow_op))
	       )
	    {
		Prev_Token(pd);
		return 1;
	    }
	}
	else /* if (prefix_arity == 2) */
	{
	    /*
	     * A sequence
	     *        prefix2 infix NEXT
	     * is ambiguous (independent of NEXT, either prefix2 of infix can
	     * be the functor). We could disambiguate using the precedence,
	     * but my feeling is that in practice one always wants the infix
	     * in such a case, e.g.
	     *        some / 2
	     * In a sequence
	     *        prefix2 postfix delimiter
	     * there is no choice but to prefer the postfix, and for a general
	     *        prefix2 postfix NEXT
	     * we prefer the postfix only if it binds weaker than the prefix
	     * (analogous to prefix/infix and prefix/postfix disambiguation).
	     */
	    if ((OpiPreced(follow_op = visible_infix_op(did0, pd->module, pd->module_tag, &status))
		    /* && (rprec < InfixLeftPrecedence(follow_op)) */ )
	     || (OpiPreced(follow_op = visible_postfix_op(did0, pd->module, pd->module_tag, &status))
		    && (rprec < PostfixLeftPrecedence(follow_op)
			|| IsDelimiter(pd->token.class)))
	       )
	    {
		Prev_Token(pd);
		return 1;
	    }
	}

_return_0_:
    	Prev_Token(pd);
	return 0;


    default:
	return 0;
    }
}


/*
 * Parse a standard list, i.e. everything following  [  up until  ]
 */

static int
_read_list(parse_desc *pd, pword *result, source_pos_t *ppos)
{
    ec_eng_t *ec_eng = pd->engine;
    source_pos_t pos = *ppos;

    for(;;)
    {
	int status;
	pword *pw = TG;

	Build_List(result, pw, pos);
	status = _read_next_term(pd, pd->max_arg_prec, COMMA_TERMINATES|BAR_TERMINATES, pw);
	Return_If_Error(status);
	result = &pw[1];

	switch(pd->token.class)
	{
	case BAR:
	    Next_Token(pd);
	    status = _read_next_term(pd, pd->max_arg_prec, COMMA_TERMINATES|BAR_TERMINATES, result);
	    Return_If_Error(status);
	    if (!IsToken(pd, CLOSING_SOLO, ']'))
		return PUNCTUATION;
	    Next_Token(pd);
	    Flag_Type_Macro(pd, TCOMP);
	    Flag_Did_Macro(pd, d_.list);
	    return PSUCCEED;

	case COMMA:
	    pos = pd->token.pos;
	    Next_Token(pd);
	    break;

	case CLOSING_SOLO:
	    if (IsChar(pd, ']'))
	    {
		Build_Nil(result, pd->token.pos);
		Next_Token(pd);
		Flag_Type_Macro(pd, TDICT);
		Flag_Did_Macro(pd, d_.nil);
		Flag_Type_Macro(pd, TCOMP);
		Flag_Did_Macro(pd, d_.list);
		return PSUCCEED;
	    }
	    return UNCLOSBR;

	case EOI:
	    return ENDOFFILE;

	case EOCL:
	    return ENDOFCLAUSE;

	default:
	    return LexError(pd->token.class) ? pd->token.class : UNEXPECTED;
	}
    }
}


/*
 * Parse a comma-separated sequence up until the solo-char terminator
 * (currently either a closing round or curly bracket) and return it as a list
 */

static int
_read_sequence_until(parse_desc *pd, pword *result, int terminator)
{
    ec_eng_t *ec_eng = pd->engine;
    for(;;)
    {
	int status;
	pword *pw = TG;

	Build_List(result, pw, no_pos_);
	status = _read_next_term(pd, pd->max_arg_prec, COMMA_TERMINATES, pw);
	Return_If_Error(status);
	result = &pw[1];

	switch(pd->token.class)
	{
	case COMMA:
	    Next_Token(pd);
	    break;

	case CLOSING_SOLO:
	    if (IsChar(pd, terminator))
	    {
		Build_Nil(result, no_pos_);
		Next_Token(pd);
		return PSUCCEED;
	    }
	    return UNCLOSBR;

	case EOI:
	    return ENDOFFILE;

	case EOCL:
	    return ENDOFCLAUSE;

	default:
	    return LexError(pd->token.class) ? pd->token.class : UNEXPECTED;
	}
    }
}


/*
 * Parse a standard structure, i.e. everything after  f(  up until  )
 */

static int
_read_struct(parse_desc *pd, char *name, uword length, pword *result,
	source_pos_t *ppos)
{
    ec_eng_t *ec_eng = pd->engine;
    int status;
    dident functor;
    pword all_args;
    pword *tail = &all_args;
    pword *pw;
    uword i;

    for(i=1; ; ++i)
    {
	pw = TG;
	Make_List(tail, pw);
	Push_List_Frame();
	tail = pw+1;

	status = _read_next_term(pd, pd->max_arg_prec, COMMA_TERMINATES, pw);
	Return_If_Error(status);

	switch(pd->token.class)
	{
	case COMMA:
	    Next_Token(pd);
	    continue;

	case CLOSING_SOLO:
	    if (IsChar(pd, ')'))
	    {
		Make_Nil(tail);
		Next_Token(pd);
		break;
	    }
	    return UNCLOSBR;

	case EOI:
	    return ENDOFFILE;

	case EOCL:
	    return ENDOFCLAUSE;

	default:
	    return LexError(pd->token.class) ? pd->token.class : UNEXPECTED;
	}
	break;
    }

    /* create the structure from the argument list (the list becomes garbage) */
    pw = TG;
    functor = enter_dict_n(name, length, i);
    Build_Struct_Or_List(result, pw, functor, *ppos);
    tail = all_args.val.ptr;
    do
    {
	/* We use Move_Pword() instead of a simple copy - this will move
	 * anonymous variables instead of creating a reference to them.
	 */
	++pw;
	Move_Pword(tail, pw);
	tail = tail[1].val.ptr;
    }
    while(--i);

    return PSUCCEED;
}


/*
 * Parse a toplevel term, a subterm, or a right argument of prefix/infix
 */

static int
_read_next_term(parse_desc *pd,
	int context_prec,
	int context_flags,	/* terminators, ARGOFOP */
	pword *result)
{
    ec_eng_t	*ec_eng = pd->engine;
    int		status, class;
    pword	term;
    char	*name;
    uword	length;
    dident	did0;
    opi		pre_op;
    source_pos_t	pos;

    pos = pd->token.pos;
    class = pd->token.class;
    switch(class)
    {

    case BAR:
	if (pd->sd->options & BAR_IS_NO_ATOM)
	    return UNEXPECTED;
	/* fall through and treat like normal identifier */

    case IDENTIFIER:
    case QIDENTIFIER:
	Save_Token_String(pd, name, length);	/* don't make dident eagerly */
_treat_like_identifier_:		/* (name,length,class) */
	Next_Token(pd);
	switch(pd->token.class)
	{

	case SOLO:
	    if (IsChar(pd, '('))
	    {
_treat_as_functor_:
		/* a compound term in canonical functor notation */
		Merge_Source_Pos(pos, pd->token.pos, pos);
		Next_Token(pd);
		status = _read_struct(pd, name, length, &term, &pos);
		Return_If_Error(status);
		*result = term;
		return _read_after_term(pd, context_prec, context_flags|SUBSCRIPTABLE, 0, result);
	    }
	    else if (IsChar(pd, '{')
		&& !(pd->sd->options & NO_CURLY_ARGUMENTS)
		/* Next condition makes sure that the curly-argument syntax
		 * doesn't take precedence over legal prefix{Term} notation.
		 */
	    	&& (!(pd->sd->options & ISO_RESTRICTIONS) ||
		    !OpiPreced(visible_prefix_op(check_did_n(name, length, 0), pd->module, pd->module_tag, &status))
		))
	    {
		/* a structure with arguments in curly braces */
		pword *pw;
		dident did0 = enter_dict_n(name, length, 0);
		Build_Struct(&term, pw, d_.with2, pd->token.pos);
		Build_Atom_Or_Nil(&pw[1], did0, pos);
		Next_Token(pd);
		if (IsToken(pd, CLOSING_SOLO, '}'))
		{
		    Build_Nil(&pw[2], no_pos_);
		    Next_Token(pd);
		}
		else
		{
		    status = _read_sequence_until(pd, &pw[2], '}');
		    Return_If_Error(status);
		}
		*result = term;
		return _read_after_term(pd, context_prec, context_flags, 0, result);
	    }
	    break;

	case SPACE_NUMBER:
	    if (!(pd->sd->options & BLANK_AFTER_SIGN))
	    	break;
	    /* fall through */

	case NUMBER:
            /* Here, class is IDENTIFIER or QIDENTIFIER */
            /* ECLiPSe: unquoted plus or minus are signs */
            /* ISO: only minus is a sign, but quoted sign is allowed */
	    if (length==1 &&
	    	(class==IDENTIFIER || pd->sd->options & BLANK_AFTER_SIGN))
            {
                if (*name=='-')
                {
                    /* - followed by number: treat as a sign */
                    tag_desc[pd->token.term.tag.kernel].arith_op[ARITH_CHGSIGN]
                            (ec_eng, pd->token.term.val, &pd->token.term);
                    Merge_Source_Pos(pos, pd->token.pos, pos);
                    goto _make_number_;
                }
                else if (*name=='+' && !(pd->sd->options & PLUS_IS_NO_SIGN))
                {
                    /* + followed by number: treat as a sign */
                    Merge_Source_Pos(pos, pd->token.pos, pos);
                    goto _make_number_;
                }
            }
	    break;
	}

	/* none of the special cases above - check if prefix */
	did0 = enter_dict_n(name, length, 0);
	pre_op = visible_prefix_op(did0, pd->module, pd->module_tag, &status);
	if (OpiPreced(pre_op))
	{
	    if (!IsPrefix2(pre_op))	/* unary prefix */
	    {
		int oprec, rprec;
		Get_Prefix_Prec(pre_op, oprec, rprec);
		if (oprec <= context_prec
		    && !_cant_follow_prefix(pd, context_flags, rprec, 1))
		{
		    /* treat as prefix operator */
		    pword *pw;
		    Build_Struct(&term, pw, OpiDid(pre_op), pos);
		    status = _read_next_term(pd, rprec, context_flags|ARGOFOP, &pw[1]);
		    Return_If_Error(status);
		    *result = term;
		    return _read_after_term(pd, context_prec, context_flags, oprec, result);
		}
	    }
	    else			/* binary prefix */
	    {
		int oprec, lprec, rprec;
		Get_Prefix2_Prec(pre_op, oprec, lprec, rprec);
		if (oprec <= context_prec
		    && !_cant_follow_prefix(pd, context_flags, lprec, 2))
		{
		    /* treat as binary prefix operator */
		    pword *pw;
		    Build_Struct_Or_List(&term, pw, OpiDid(pre_op), pos);
		    status = _read_next_term(pd, lprec, context_flags|ARGOFOP|PREBINFIRST, &pw[1]);
		    Return_If_Error(status);
		    status = _read_next_term(pd, rprec, context_flags|ARGOFOP, &pw[2]);
		    Return_If_Error(status);
		    *result = term;
		    return _read_after_term(pd, context_prec, context_flags, oprec, result);
		}
	    }
	}

	if (IsToken(pd, SPACE_SOLO, '('))
	{
	    /* compatibility: allow space between functor and (  */
	    if (pd->sd->options & NO_BLANKS)
		return BLANK;
	    goto _treat_as_functor_;
	}

	/* ISO does not allow operators as arguments of operators */
	if (pd->sd->options & ISO_RESTRICTIONS
	    && DidIsOp(did0) && is_visible_op(did0, pd->module, pd->module_tag))
	{
	    if (context_flags & ARGOFOP)
		return BRACKET;
	    context_flags |= OPCANTFOLLOW;
	}
	/* treat as a simple atom */
	Build_Atom_Or_Nil(&term, did0, pos);
	*result = term;
	return _read_after_term(pd, context_prec, context_flags|FZINC_SUBSCRIPTABLE|ZINC_SUBSCRIPTABLE, 0, result);


    case NUMBER:
    case SPACE_NUMBER:
_make_number_:
	Build_Number_From_Token(pd, &term);
	Next_Token(pd);
	*result = term;
	return _read_after_term(pd, context_prec, context_flags, 0, result);


    case STRING:			/* string-quoted string */
	Build_String_From_Token(pd, &term);
	Next_Token(pd);
	*result = term;
	return _read_after_term(pd, context_prec, context_flags, 0, result);


    case CODES:				/* codes-list-quoted string */
    case CHARS:				/* chars-list-quoted string */
    	_build_list_from_token(pd, &term);
	Next_Token(pd);
	*result = term;
	return _read_after_term(pd, context_prec, context_flags|ZINC_SUBSCRIPTABLE, 0, result);


    case REFERENCE:			/* general variable */
    {
	vword *vp = _var_table_entry(pd, TokenString(pd), TokenStringLen(pd));
	pword *pvar;
	Make_Var_Wrapper(result, pvar, pd->token.pos);
	if (!vp->ptr)
	    vp->ptr = _make_variable_from_token(pd, pvar);
	else
	{
	    Make_Ref(pvar, vp->ptr);
	}
	goto _after_variable_;
    }


    case UREFERENCE:			/* anonymous variable */
    {
	pword *pvar;
	/* Anonymous variables are created "in-place" and
	 * may be moved later by the Move_Pword() macro */
	Make_Term_Wrapper(result, pvar, d_anonymous_, pd->token.pos);
	Make_Var(pvar);
    }

_after_variable_:
	Next_Token(pd);
        if (IsToken(pd,SOLO,'(') && (pd->sd->options & VAR_FUNCTOR_IS_APPLY))
        {
            /* Arguments follow */
            pword *pw;
            Build_Struct(&term, pw, d_.apply2, pd->token.pos);
            Move_Pword(result, pw+1);
            Next_Token(pd);
            status = _read_sequence_until(pd, &pw[2], ')');
            Return_If_Error(status);
            *result = term;
            return _read_after_term(pd, context_prec, context_flags|ZINC_SUBSCRIPTABLE, 0, result);
        }
	return _read_after_term(pd, context_prec, context_flags|SUBSCRIPTABLE|ATTRIBUTABLE, 0, result);


    case SOLO:				/* {[( */
    case SPACE_SOLO:			/* {( */
    	if (IsChar(pd, '['))
	{
	    Next_Token(pd);
	    if (IsToken(pd, CLOSING_SOLO, ']'))
	    {
		/* the atom or functor '[]' */
		name = "[]"; length = 2;
		Merge_Source_Pos(pos, pd->token.pos, pos);
		goto _treat_like_identifier_;	/* (name,length,class) */
	    }
	    else
	    {
		/* non-empty list in standard list notation */
		status = _read_list(pd, &term, &pos);
		Return_If_Error(status);
	    }
	    *result = term;
	    context_flags |= ZINC_SUBSCRIPTABLE;
	}
    	else if (IsChar(pd, '('))
	{
	    /* parenthesised subterm */
	    Next_Token(pd);
	    status = _read_next_term(pd, 1200, 0, &term);
	    Return_If_Error(status);
	    if (!IsClass(pd, CLOSING_SOLO))
	    	return UNEXPECTED;
	    if (!IsChar(pd, ')'))
	    	return UNCLOSBR;
	    Next_Token(pd);
	    Move_Pword(&term, result);	/* could be a self-ref! */
	    context_flags |= ZINC_SUBSCRIPTABLE;
	}
    	else if (IsChar(pd, '{'))
	{
	    Next_Token(pd);
	    if (IsToken(pd, CLOSING_SOLO, '}'))
	    {
		/* the atom or functor '{}' */
		name = "{}"; length = 2;
		Merge_Source_Pos(pos, pd->token.pos, pos);
		goto _treat_like_identifier_;	/* (name,length,class) */
	    }
	    else
	    {
		/* term in curly brackets: parse as {}/1 structure */
		pword *pw;
		Build_Struct(&term, pw, d_.nilcurbr1, pos);
		if (pd->sd->options & CURLY_ARGS_AS_LIST)
		{
		    /* {a,b,c} is read as {}([a,b,c]) */
		    status = _read_sequence_until(pd, &pw[1], '}');
		}
		else
		{
		    /* {a,b,c} is read as {}(','(a,','(b,c))) */
		    status = _read_next_term(pd, 1200, 0, &pw[1]);
		    Return_If_Error(status);
		    if (!IsClass(pd, CLOSING_SOLO))
			return UNEXPECTED;
		    if (!IsChar(pd, '}'))
			return UNCLOSBR;
		    Next_Token(pd);
		}
	    }
	    *result = term;
	}
	else
	{
	    return UNEXPECTED;
	}
	return _read_after_term(pd, context_prec, context_flags, 0, result);


    case CLOSING_SOLO:			/* }]) */
	return UNCLOSBR;

    case COMMA:
	return UNEXCOMMA;

    case EOI:
	return ENDOFFILE;

    case EOCL:	
	return ENDOFCLAUSE;

    default:
	return LexError(pd->token.class) ? pd->token.class : UNEXPECTED;
    }
}


/*
 * Parse what can follow a complete term, i.e.
 * delimiter, infix, postfix, or possibly subscript.
 */

static int
_read_after_term(parse_desc *pd, int context_prec,
	int context_flags,	/* terminators, allowed subscripts */
	int lterm_prec,
	pword *result)		/* in: lterm, out: result */
{
    ec_eng_t	*ec_eng = pd->engine;
    int		status;
    pword	term;
    dident	did0;
    opi		in_op;
    opi		post_op;

    for(;;)				/* for removing tail recursion */
    {
	switch(pd->token.class)
	{

	case IDENTIFIER:
	case QIDENTIFIER:
	    did0 = enter_dict_n(TokenString(pd), TokenStringLen(pd), 0);
_treat_like_atom_:		/* (did0) - caution: may have wrong token in pd */
	    in_op = visible_infix_op(did0, pd->module, pd->module_tag, &status);
	    post_op = visible_postfix_op(did0, pd->module, pd->module_tag, &status);
	    if (OpiPreced(in_op) && !(OpiPreced(post_op) && _delimiter_follows(pd)))
	    {
		/* treat as infix */
		pword *pw;
		int lprec, oprec, rprec;
		Get_Infix_Prec(in_op, lprec, oprec, rprec);
		if (oprec > context_prec)
		    return PSUCCEED;
		if (lterm_prec > lprec)
		    return context_flags & PREBINFIRST ? PSUCCEED : BRACKET;
		/* ISO does not allow operators as arguments of operators */
		if (context_flags & OPCANTFOLLOW)
		    return BRACKET;
		Build_Struct_Or_List(&term, pw, OpiDid(in_op), pd->token.pos);
		/* Use Move_Pword() to move possible self-refs in result
		 * (because we are going to reuse result!) */
		Move_Pword(result, pw+1);
		Next_Token(pd);
		context_flags &= ~(SUBSCRIPTABLE|FZINC_SUBSCRIPTABLE|ZINC_SUBSCRIPTABLE|OPCANTFOLLOW);
		status = _read_next_term(pd, rprec, context_flags|ARGOFOP, &pw[2]);
		Return_If_Error(status);
		/*return _read_after_term(pd, context_prec, context_flags, oprec, result);*/
		*result = term; lterm_prec = oprec;
		break;	/* tail recursion */
	    }
	    else if (OpiPreced(post_op))
	    {
		/* treat as postfix */
		pword *pw;
		int lprec, oprec;
		Get_Postfix_Prec(post_op, lprec, oprec);
		if (oprec > context_prec)
		    return PSUCCEED;
		if (lterm_prec > lprec)
		    return context_flags & PREBINFIRST ? PSUCCEED : BRACKET;
		/* ISO does not allow operators as arguments of operators */
		if (context_flags & OPCANTFOLLOW)
		    return BRACKET;
		Build_Struct(&term, pw, OpiDid(post_op), pd->token.pos);
		/* Use Move_Pword() to move possible self-refs in result
		 * (because we are going to reuse result!) */
		Move_Pword(result, pw+1);
		Next_Token(pd);
		context_flags &= ~(SUBSCRIPTABLE|FZINC_SUBSCRIPTABLE|ZINC_SUBSCRIPTABLE|OPCANTFOLLOW);
		/*return _read_after_term(pd, context_prec, context_flags, oprec, result);*/
		*result = term; lterm_prec = oprec;
		break;	/* tail recursion */
	    }
	    return context_flags & PREBINFIRST ? PSUCCEED : POSTINF;


	case COMMA:
	    if ((context_flags & COMMA_TERMINATES))
	    {
		return PSUCCEED;
	    }
	    did0 = d_comma0_;
	    goto _treat_like_atom_;	/* (did0) */


	case BAR:
	    if ((context_flags & BAR_TERMINATES))
	    {
		return PSUCCEED;
	    }
	    /* Prolog compatibility: an (unquoted) bar in infix position is
             * treated as if it were a semicolon (for Cprolog/Quintus).
             */
            did0 = pd->sd->options & BAR_IS_SEMICOLON ? d_.semi0 : d_bar0_;
	    goto _treat_like_atom_;	/* (did0) */


	case SOLO:
	    if (IsChar(pd, '[') && !(pd->sd->options & NO_ARRAY_SUBSCRIPTS)
	    	&& ((context_flags & SUBSCRIPTABLE) ||
		    ((context_flags & FZINC_SUBSCRIPTABLE) && (pd->sd->options & ATOM_SUBSCRIPTS)) ||
		    ((context_flags & ZINC_SUBSCRIPTABLE) && (pd->sd->options & GENERAL_SUBSCRIPTS))))
	    {
		/* translate Term[Args] into subscript(Term, [Args]) */
		pword *pw;
		source_pos_t pos = pd->token.pos;
		Next_Token(pd);
		if (IsToken(pd, CLOSING_SOLO, ']'))
		{
		    /* it _might_ be a postfix [] */
		    did0 = d_.nil;
		    Merge_Source_Pos(pos, pd->token.pos, pd->token.pos);
                    Make_Ident_Token(pd, "[]", 2);
		    goto _treat_like_atom_;	/* (pd,did0) */
		}
		Build_Struct(&term, pw, d_.subscript, pos);
		Move_Pword(result, pw+1);
		status = _read_list(pd, &pw[2], &pos);
		Return_If_Error(status);
		context_flags &= ~(SUBSCRIPTABLE|FZINC_SUBSCRIPTABLE|OPCANTFOLLOW);
		/*return _read_after_term(pd, context_prec, context_flags, 0, result);*/
		*result = term; lterm_prec = 0;
		break;	/* tail recursion */
	    }
	    else if (IsChar(pd, '{') && !(pd->sd->options & NO_ATTRIBUTES)
	    	&& (context_flags & ATTRIBUTABLE))
	    {
		/* Attribute follows */
		pword *pw;
		source_pos_t pos = pd->token.pos;
		Next_Token(pd);
		if (IsToken(pd, CLOSING_SOLO, '}'))
		{
		    /* it _might_ be a postfix {} */
		    did0 = d_.nilcurbr;
		    Merge_Source_Pos(pos, pd->token.pos, pd->token.pos);
                    Make_Ident_Token(pd, "{}", 2);
		    goto _treat_like_atom_;	/* (pd,did0) */
		}
		Build_Struct(&term, pw, d_.with_attributes2, pos);
		Move_Pword(result, pw+1);
		status = _read_sequence_until(pd, &pw[2], '}');
		Return_If_Error(status);
		context_flags &= ~(OPCANTFOLLOW);
		/*return _read_after_term(pd, context_prec, context_flags, 0, result);*/
		*result = term; lterm_prec = 0;
		break;	/* tail recursion */
	    }
            /* fall through */
	case SPACE_SOLO:
	    if (IsChar(pd, '[')) {
		source_pos_t pos = pd->token.pos;
		Lookahead_Next_Token(pd);
		if (IsToken(pd, CLOSING_SOLO, ']'))
		{
		    did0 = d_.nil;	/* the atom or functor '[]' */
		    Merge_Source_Pos(pos, pd->token.pos, pd->token.pos);
                    Make_Ident_Token(pd, "[]", 2);
		    goto _treat_like_atom_;	/* (pd,did0) */
		}
                Prev_Token(pd);
	    } else if (IsChar(pd, '{')) {
		source_pos_t pos = pd->token.pos;
		Lookahead_Next_Token(pd);
		if (IsToken(pd, CLOSING_SOLO, '}'))
		{
		    did0 = d_.nilcurbr;	/* the atom or functor '{}' */
		    Merge_Source_Pos(pos, pd->token.pos, pd->token.pos);
                    Make_Ident_Token(pd, "{}", 2);
		    goto _treat_like_atom_;	/* (pd,did0) */
		}
                Prev_Token(pd);
	    }
	    return context_flags & PREBINFIRST ? PSUCCEED : UNEXPECTED;

	case EOI:
	case EOCL:
	case CLOSING_SOLO:
	    return PSUCCEED;

	default:
	    return LexError(pd->token.class) ? pd->token.class : context_flags & PREBINFIRST ? PSUCCEED : UNEXPECTED;
	}
    }
}


/*
 * The toplevel parser procedure. It reads one term from the given stream
 * and makes sure it is properly terminated.
 */

int
ec_read_term(
	ec_eng_t *ec_eng,	/* engine for result creation */
    	stream_id nst,		/* the stream to read from */
	int options,		/* options (VARNAMES_PLEASE etc) */
	pword *result,		/* where to store the parsed term */
	pword *varlist,		/* where to store the var list (or NULL) */
	int *has_macro,		/* flag that the term may contain (clause or
				* goal) macros that need to be expanded */
	value vm, type tm	/* context module */
    )
{
    int status;
    parse_desc *pd;
    pword *old_tg = TG;
    pword *pw;

    if (StreamMode(nst) & REPROMPT_ONLY)
	StreamMode(nst) |= DONT_PROMPT;

    pd = _alloc_parse_env(ec_eng, options, nst, vm.did, tm);
    pd->var_list_tail = varlist;

    Next_Token(pd);
    switch(pd->token.class)
    {
    case EOI:
	if (StreamMode(pd->nst) & MEOF)
	{
	    status = IsSoftEofStream(pd->nst) ? PEOF : READ_PAST_EOF;
	    goto _return_error_;
	}
	StreamMode(pd->nst) |= MEOF;
	status = PEOF;
	goto _return_error_;

    default:
	status = _read_next_term(pd, 1200, 0, result);
	if (status != PSUCCEED)
	    goto _return_error_;
	switch(pd->token.class)
	{
	case EOI:
	    if (pd->sd->options & EOF_IS_NO_FULLSTOP)
	    {
		status = ENDOFFILE;
		goto _return_error_;
	    }
	    break;
	case EOCL:
	    break;
	default:
	    status = UNEXPECTED;
	    goto _return_error_;
	}
	break;
    }

    if (pd->var_list_tail)
    {
	Make_Nil(pd->var_list_tail);
    }

    /* expand (read) macros if there were any (and expansion is not disabled) */
    if (pd->macro && (EclGblFlags & MACROEXP) && !(StreamMode(pd->nst) & SNOMACROEXP)
    	&& !(options & LAYOUT_PLEASE))
    {
	pw = result;
	Dereference_(pw);
	if (!(IsRef(pw->tag) && pw == result))
	{
	    pw = TG;
	    Push_Struct_Frame(in_dict("expand_macros_",3));
	    pw[1] = *result;
	    Make_Var(&pw[2]);
	    pw[3].val.all = vm.all;
	    pw[3].tag.all = tm.all;
	    status = do_trafo(ec_eng, pw);
	    Return_If_Error(status);
	    *result = pw[2];
	}
    }
    if (has_macro)
    	*has_macro = pd->macro;

    return PSUCCEED;

_return_error_:
    TG = old_tg;	/* pop (possibly incomplete) constructed term */
    return status;
}



/*********************** THE PARSER RELATED BUILTINS ********************/


static int
_pread3(value v, type t, stream_id nst, value vm, type tm, ec_eng_t *ec_eng)
{
    int  	status;
    pword	*pw;
    pword	result;		/* be careful not to pass this pword to Prolog,
				 * e.g. when calling a macro transformation
				 * (cf. bug #560), or when returning (see below).
				 */
    status = ec_read_term(ec_eng, nst,
    		(EclGblFlags & VARIABLE_NAMES ? VARNAMES_PLEASE : 0),
		&result, 0, 0, vm, tm);

    if (status != PSUCCEED)
	return (status);

    pw = &result;
    Dereference_(pw);
    if (IsRef(pw->tag) && pw == &result)
    {
	Succeed_;	/* a free variable */
    }
    Return_Unify_Pw(v, t, pw->val, pw->tag)
}


/*
 *	read_(Term, Module)
 *	reads a term from the current input
*/
static int
p_read2(value v, type t, value vm, type tm, ec_eng_t *ec_eng)
{
    int res;
    Check_Module(tm, vm);
    Lock_Stream(current_input_);
    res = _pread3(v, t, current_input_, vm, tm, ec_eng);
    Unlock_Stream(current_input_);
    return res;
}

/*
 *	read_(Stream, Term, Module)
 *	reads a term from the current input and unifies it with its argument.
 *	The unification/dereferencing is done by the emulator on Request_unify
*/
static int
p_read3(value vs, type ts, value v, type t, value vm, type tm, ec_eng_t *ec_eng)
{
    stream_id	nst;
    Check_Module(tm, vm);
    Get_Locked_Stream(vs, ts, SREAD, nst);
    return _pread3(v, t, nst, vm, tm, ec_eng);
}


/*
 * read_term(+Stream,-Term,+Flags,+ErrFlag,-VarList,-HasMacros,+Module)
 *
 * Term: term or annotated term (depending on Flags)
 * Flags: bit-significant options
 * ErrFlag: how to handle syntax errors (interpreted by error handler)
 * Varlist: variable_names list (depending on Flags)
 * HasMacros: current only set 0/1 when making annotated terms (LAYOUT_PLEASE)
 */
static int
p_read_term(value vs, type ts, value v, type t, value vflags, type tflags, value vef, type tef,
	value vv, type tv, value vmac, type tmac, value vm, type tm, ec_eng_t *ec_eng)
{
    pword	*pw;
    pword	result, vars;
    int		status;
    int		has_macro = 0;
    stream_id	nst;
    Prepare_Requests

    Get_Locked_Stream(vs, ts, SREAD, nst);
    Check_Integer(tflags);
    Check_Module(tm, vm);

    status = ec_read_term(ec_eng, nst,
    		vflags.nint|(EclGblFlags & VARIABLE_NAMES ? VARNAMES_PLEASE : 0),
		&result, vflags.nint&VARLIST_PLEASE ? &vars : NULL, &has_macro, vm, tm);

    if (status != PSUCCEED)
    {
	Bip_Error(status);
    }

    if (vflags.nint & VARLIST_PLEASE) {
	Request_Unify_Pw(vv, tv, vars.val, vars.tag);
    }
    if (vflags.nint & LAYOUT_PLEASE) {
	if (!(EclGblFlags & MACROEXP) || (StreamMode(nst) & SNOMACROEXP))
	    has_macro = 0;
	Request_Unify_Integer(vmac, tmac, has_macro)
    }

    pw = &result;
    Dereference_(pw);
    if (!(IsRef(pw->tag) && pw == &result))
    {
	Request_Unify_Pw(v, t, pw->val, pw->tag);
    }
    Return_Unify;
}


void
read_init(int flags)
{

    d_comma0_ = in_dict(",", 0);
    d_bar0_ = in_dict("|", 0);
    d_annotated_term_ = in_dict("annotated_term", TERM_ARITY);
    d_anonymous_ = in_dict("anonymous", 0);
    no_pos_.file = d_.empty;

    if (!(flags & INIT_SHARED))
	return;

    exported_built_in(in_dict("read_", 2), p_read2, B_UNSAFE|U_FRESH)
	-> mode = BoundArg(1, NONVAR);
    exported_built_in(in_dict("read_", 3), p_read3, B_UNSAFE|U_FRESH)
	-> mode = BoundArg(2, NONVAR);
    exported_built_in(in_dict("read_term", 7), p_read_term, B_UNSAFE|U_FRESH)
	-> mode = BoundArg(2, NONVAR) | BoundArg(4, NONVAR);
}



/*********************** PREPARING A PARSER CALL ************************/

/*
 * Allocate and initialise a parsing environment
 *
 * contents of the parsing environment: see type declaration
 *
 * Remaining Problem: when a read is aborted via an interrupt, the parsing
 * environment is not freed.
 */

static parse_desc *
_alloc_parse_env(ec_eng_t *ec_eng, int options, stream_id nst, dident module, type mod_tag)
{
    register parse_desc	*pd = (parse_desc *) PARSENV;

    if (pd)			/* reinit the existing parser environment */
    {
	if (NUMBER_VAR != pd->var_table_size)	/* table size changed */
	{
	    hp_free_size(pd->var_table, pd->var_table_size*sizeof(vword));
	    pd->var_table_size = NUMBER_VAR;
	    pd->var_table = (vword *) hp_alloc_size((int)NUMBER_VAR * sizeof(vword));
	    pd->counter = 0;
	}
	Temp_Reset(pd->string_store);
    }
    else			/* allocate a new parsing environment */
    {
	pd = (parse_desc *) hp_alloc_size(sizeof(parse_desc));
	pd->var_table_size = NUMBER_VAR;
	pd->var_table = (vword *) hp_alloc_size((int)NUMBER_VAR * sizeof(vword));
	pd->counter = 0;
	pd->engine = ec_eng;
	Temp_Create(pd->string_store, 1024);
	PARSENV = pd;	/* store it globally */
    }

    pd->nst = nst;
    pd->sd = ModuleSyntax(module);
    pd->module = module;
    pd->module_tag = mod_tag;
    pd->token.class = pd->prev_token.class = pd->next_token.class = NO_TOKEN;
    pd->macro = 0;
    pd->options = options;
    pd->max_arg_prec = (pd->sd->options & LIMIT_ARG_PRECEDENCE) ? 999 : 1200;

    if (pd->counter++ == 0)	/* (re)init the hash table	*/
    {
	register vword	*v = pd->var_table;
	register vword	*last = v + NUMBER_VAR;
	while (v < last)
	    (v++)->lock = 0;
    }
    return pd;
}


void
destroy_parser_env(ec_eng_t *ec_eng)	/* called when exiting emulators */
{
    register parse_desc	*pd = (parse_desc *) PARSENV;

    if (pd)				/* deallocate the parsing environment */
    {
	hp_free_size(pd->var_table, pd->var_table_size*sizeof(vword));
	Temp_Destroy(pd->string_store);
	hp_free_size(pd, sizeof(parse_desc));
	PARSENV = 0;
    }
}


/************************ MACRO TRANSFORMATION SUPPORT **************************/

/*
 * Run transformation goal, catch aborts,
 * turn numeric throw-tags into negative error return code.
 * Returns PSUCCEED, PFAIL or error code
*/
int
do_trafo(ec_eng_t *ec_eng, pword *term)	/* goal to call */
{
    pword	saved_a1;
    int		res;
    value	v1;
    value 	v2;
    type	t2;

    v1.ptr = term;
    v2.did = d_.kernel_sepia;
    t2.kernel = ModuleTag(d_.kernel_sepia);
    /* hack to preserve A[1] in case it gets overwritten by throw/1 */
    /* TODO: not safe wrt dictionary GC */
    saved_a1 = A[1];
    res = sub_emulc_opt(ec_eng, v1, tcomp, v2, t2, GOAL_CUT|GOAL_CATCH);

    if (res == PTHROW)
    {
	pword ball = A[1];
	A[1] = saved_a1;
	if (IsInteger(ball.tag) && ball.val.nint > 0)
	    res = (int) -ball.val.nint;
	else
	    res = TRANS_ERROR;
    }
    return res;
}

/*
 * Create a transformation goal for the functor tr_did. Return 0 if
 * no transformation possible/necessary.
 */
pword *
trafo_term(
	ec_eng_t *ec_eng,
    	dident tr_did,		/* the functor of the term to transform	*/
	int flags,		/* conditions for the macro		*/
	dident mv,		/* current module	*/
	type mt,		/* its tag		*/
	int *tr_flags)		/* flags of the macro	*/
{
    pword	*pw;
    pword	*prop;
    macro_desc	md;
    int		propid;

    /* for input goal and clause macros we don't build the goal */
    if ((flags & TR_GOAL) && !(flags & TR_WRITE))
    {
	*tr_flags = TR_GOAL;
	return 0;
    }

    if (flags & TR_CLAUSE)
	propid = CLAUSE_TRANS_PROP;
    else if (flags & TR_GOAL)
	propid = GOAL_TRANS_PROP;
    else
	propid = TRANS_PROP;
    if (flags & TR_WRITE)
	propid++;
    mt_mutex_lock(&PropertyLock);
    if (get_property_ref(tr_did, propid, mv, mt, VISIBLE_PROP, &prop) < 0)
    {
	mt_mutex_unlock(&PropertyLock);
	*tr_flags = 0;
	return 0;
    }
    md = *(macro_desc*)prop->val.ptr;
    mt_mutex_unlock(&PropertyLock);

    *tr_flags = md.flags;
    /* check if the type is ok */
    if ((md.flags & flags) != (md.flags & TR_TYPE))
	return 0;

    /* create a goal of the form:
     *	trans_term( <trans>(In,Out{,AnnIn,AnnOut}{,CurModule}), TrModule ) or
     *  AnnIn,AnnOut are always uninstantiated here
     */
    pw = TG;
    TG += DidArity(md.trans_function) + 4;
    Check_Gc;
    pw->tag.all		= TDICT;
    pw->val.did		= d_.trans_term;
    (pw+1)->tag.kernel	= TCOMP;
    (pw+1)->val.ptr	= pw+3;
    (pw+2)->tag.kernel	= ModuleTag(tr_did);
    (pw+2)->val.did	= md.module;
    (pw+3)->tag.kernel	= TDICT;
    (pw+3)->val.did	= md.trans_function;

    (pw+5)->tag.kernel	= TREF;
    (pw+5)->val.ptr	= (pw+5);
    switch (DidArity(md.trans_function))
    {
    case 2: /* <trans>(In, Out) */
	break;
    case 3: /* <trans>(In,Out,CurModule) */
	(pw+6)->tag.all	= mt.all;
	(pw+6)->val.did	= mv;
	break;
    case 5: /* <trans>(In,Out,AnnIn,AnnOut,CurModule) */
	(pw+8)->tag.all	= mt.all;
	(pw+8)->val.did	= mv;
 	/* falls through */
    case 4: /* <trans>(In,Out,AnnIn,AnnOut) */
	(pw+6)->tag.kernel = TREF;
	(pw+6)->val.ptr	= (pw+6);
	(pw+7)->tag.kernel = TREF;
	(pw+7)->val.ptr	= (pw+7);
	break;
    default:
	/* incorrect arity for <trans> */
	TG = pw;
	return 0;
    }

    return pw;
}


/*
 * Transform the metaterm attribute into the internal form.
 */
pword *
transf_meta_in(ec_eng_t *ec_eng, pword *pw, dident mod, int *err)
{
    int			i;
    register pword	*r;

    r = TG;
    TG += 1 + MetaArity;
    Check_Gc;
    r[0].val.did = in_dict("meta", MetaArity);
    r[0].tag.kernel = TDICT;
    for (i = 1; i <= MetaArity; i++) {
	r[i].val.ptr = r + i;
	r[i].tag.kernel = TREF;
    }
    i = meta_index(mod);
    i = _transf_attribute(pw, r, i);
    if (i != PSUCCEED) {
	*err = i;
	return 0;
    } else
	return r;
}

static int
_transf_attribute(register pword *pw, pword *r, int def)
{
    int		res;
    pword	*s;

    Dereference_(pw);
    if (IsStructure(pw->tag))
    {
	s = pw->val.ptr;
	if (s->val.did == d_.comma) {
	    if ((res = _transf_attribute(s + 1, r, def)) < 0)
		return res;
	    return _transf_attribute(s + 2, r, def);
	} else if (s->val.did == d_.colon) {
	    pw = s + 1;
	    Dereference_(pw);
	    if (IsAtom(pw->tag)) {
		def = meta_index(pw->val.did);
		pw = s + 2;
	    } else if (IsRef(pw->tag))
		return INSTANTIATION_FAULT;
	    else
		return TYPE_ERROR;
	}
    }
    if (!def)
	return UNDEF_ATTR;
    if (!(IsVar(r[def].tag)  &&  r[def].val.ptr == r + def))
	return TYPE_ERROR;
    r[def].val.ptr = pw->val.ptr;
    r[def].tag.kernel = pw->tag.kernel;
    return PSUCCEED;
}


/*
 * Transform the metaterm attribute into the external format.
 * Note that the caller has to allocate sufficient memory for
 * the constructed term (ATTR_IO_TERM_SIZE pwords at top).
 * The function returns the end of the memory actually used.
 */
pword *
transf_meta_out(
	ec_eng_t *ec_eng,
    	value val,		/* attribute term to transform */
	type tag,
	pword *top,		/* where to build the the resulting term */
	dident mod,		/* context module (or D_UNKNOWN) */
	pword *presult)		/* where to store the result */
{
    /* by default, return the untransformed term */
    presult->val.all = val.all;
    presult->tag.all = tag.all;

    /* transform only if we have a proper meta/N structure */
    if (IsStructure(tag)  &&  check_did(val.ptr->val.did,0) == d_.meta0)
    {
	int i, first = 1;

	for (i = DidArity(val.ptr->val.did); i > 0; --i)
	{
	    dident wd = meta_name(i);

	    if (wd != D_UNKNOWN)
	    {
		pword attr;
		if (wd == mod) {
		    attr = val.ptr[i];		/* don't module-qualify */
		} else {
		    pword *pw = top;		/* construct name:AttrI */
		    top += 3;
		    Make_Struct(&attr, pw);
		    Make_Functor(&pw[0], d_.colon);
		    Make_Atom(&pw[1], wd);
		    pw[2] = val.ptr[i];
		}
		if (first) {
		    *presult = attr;		/* the only attribute so far*/
		    first = 0;
		} else {
		    pword *pw = top;		/* construct QAttrI,Others */
		    top += 3;
		    Make_Functor(&pw[0], d_.comma);
		    pw[1] = attr;
		    pw[2] = *presult;
		    Make_Struct(presult, pw);
		}
	    }
	}
    }
    return top;
}


/********************* VARIABLE NAME HASHING *******************************/

static uword
hashfunction(char *id)
{
	register uword	hash;
	register int		length, shift, ival;
	register char		*str;

	length = 0;
	hash = 0;
        for (str = id; *str; str++)        
        {
            ival = *str & 0x000000FF;    		/* get rid of sign extension */ 
            shift = length + 4 * (length & 3);	 /* add 0, 4, 8 or 12 */
            shift &= 0x0000000F;               	 /* keep important bits */
	    hash ^= (ival << (shift) | ival >> (16 - shift)); 
            hash &= 0x0000FFFF;
            length++;
        }

        return(hash);
}

static vword *
_alloc_vword(register parse_desc *pd)
{
    Temp_Align(pd->string_store, sizeof(int *));
    return (vword *) TempAlloc(pd->string_store, sizeof(vword));
}

static vword *
_var_table_entry(parse_desc *pd, char *varname, word length)
{
    vword *p, *q;
    p = &pd->var_table[hashfunction(varname) % NUMBER_VAR];

    if (p->lock == pd->counter)		/* there is a table entry */
    {
	while (p && strcmp(p->str, varname)) { /* search the chain */
	    q = p;
	    p = p->next;
	}
	if (p)
	{
	    return p;
	}
	q->next = p = _alloc_vword(pd);
    }

    /* it is a new variable, copy the string and make a table entry */
    p->str = TempAlloc(pd->string_store, length+1);
    Copy_Bytes(p->str, varname, length+1);
    p->lock = pd->counter;
    p->next = 0;
    p->ptr = 0;
    return p;
}
