/* --- Copyright University of Sussex 1989. All rights reserved. ----------
 > File:            C.all/pml/src/operators.p
 > Purpose:         PML: Operator declarations
 > Author:          Rob Duncan & Simon Nichols, Feb 13 1989
 */


;;; prec, fix:
;;;		precedence and fixity tables for operators. Precedence is from
;;;		0 - 9; fixity is "infix", "infixr" or "nonfix".

constant procedure (
	prec	= newproperty([], 32, -1, true),
	fix		= newproperty([], 32, "nonfix", true),
);

;;; local_ops:
;;;		a list of operators declared locally with their previous -prec-
;;;		and -fix-. Organised as a list of lists, one per declaration
;;;		level, where each leaf entry is a 3-vector of {^fix ^prec ^id}

vars
	local_ops = [],
;

;;; set_ops:
;;;		locally declare -ids- as operators with fixity -f- and precedence
;;;		-n-.

define lconstant set_ops(ids, f, n);
	lvars id, ids, f, n;
	For id in ids do
		;;; save current values in the -local_ops- list
		conspair({% fix(id), prec(id), id %}, Front(local_ops))
			-> Front(local_ops);
		;;; enter the new precedence in the global tables
		f -> fix(id); n -> prec(id);
	endfor;
enddefine;

;;; reset_ops:
;;;		restore the precedences of the given list of local operators

define lconstant reset_ops(ops);
	lvars id, op, ops;
	For op in ops do
		explode(op) -> id -> prec(id) -> fix(id);
	endfor;
enddefine;

;;; swap_ops:
;;;		swap local and global values of the given operators (for nested
;;;		compilation streams, processes etc.)

define lconstant swap_ops(ops);
	lvars id, op, n, f, ops;
	For op in ops do
		explode(op) -> id -> n -> f;
		;;; save the current values
		prec(id) -> Subscrv(2, op);
		fix(id) -> Subscrv(1, op);
		;;; then reset to the new values
		n -> prec(id);
		f -> fix(id);
	endfor;
enddefine;

;;; guard_local_ops:
;;;		called by -guard_env- (in "env.p") to maintain consistency of the
;;;		-local_ops- list: called as accessor on entry to the parser and as
;;;		updater on exit. Allows the parser to be re-entrant.

define guard_local_ops();
	app(local_ops, swap_ops);
	local_ops, conspair([], []) -> local_ops;
enddefine;

define updaterof guard_local_ops() with_nargs 1;
	app(local_ops, reset_ops);
	-> local_ops;
	app(local_ops, swap_ops);
enddefine;

;;;	declare_local_ops:
;;;		declares a set of local operators

constant procedure declare_local_ops = set_ops;

;;;	undeclare_local_ops:
;;;		undoes any local operator declarations in the current level

define undeclare_local_ops();
	reset_ops(Destpair(local_ops) -> local_ops);
enddefine;

;;; isinfix:
;;;		returns a pair of [fix|prec] for infix operators, or <false> if
;;;		-id- is nonfix

define isinfix(id);
	lvars id, f = fix(id);
	if f == "nonfix" then
		false;
	else
		conspair(f, prec(id));
	endif;
enddefine;
