Newsgroups: comp.lang.prolog
Path: cantaloupe.srv.cs.cmu.edu!rochester!udel!delmarva.com!internetMCI!newsfeed.internetmci.com!EU.net!sun4nl!freya.let.rug.nl!vannoord
From: vannoord@let.rug.nl (Gertjan van Noord)
Subject: Local operator definitions
Sender: news@let.rug.nl (News system at let.rug.nl)
Message-ID: <1995Oct20.102515.9161@let.rug.nl>
Date: Fri, 20 Oct 1995 10:25:15 GMT
Nntp-Posting-Host: saga.let.rug.nl
Organization: Faculteit der Letteren, Rijksuniversiteit Groningen, NL
Lines: 129

Sometimes I want to have operator declarations whose scope
is limited. For example if you want to read in a file in user
language you might want to use the `:' operator with a
non standard Type of Precedence. However, in the rest of your
program you don't want to be bothered with that (: is used in
module prefixes).

My question is whether something better exists than the following
that I wrote as a library for SICStus. It provides the predicate
call_with_ops(Ops,Call). This calls the goal Call with the standard 
operators + the operators in Ops in effect. After Call (which is
supposed to succeed exactly once) the operator declarations are
restored to the situation before the call to call_with_ops.

Note that this uses a notion `standard operator', since otherwise
you would always need to give a very long list as an argument...

:- module( operators, [ read_with_ops/2,
			read_with_ops/3,
			compile_with_ops/2,
			reconsult_with_ops/2,
			call_with_ops/2
		      ]).

% read_with_ops(+ListOfOperatorDefinitions,?TermRead)
read_with_ops(Ops,Term) :-
	call_with_ops(Ops,read(Term)).
read_with_ops(Stream,Ops,Term) :-
	call_with_ops(Ops,read(Stream,Term)).


compile_with_ops(Ops,File) :-
	call_with_ops(Ops,compile(File)).

reconsult_with_ops(Ops,File) :-
	call_with_ops(Ops,reconsult(File)).

:- meta_predicate call_with_ops(?,:).
% note: old operators are restored in case of success, and in case
% of an exception. Maybe also add in case of failure..
call_with_ops(Ops,Call):-
	set_ops(Ops,Old),
	on_exception(Pat,
		     call(Call),
		     (  set_ops(Old),
			raise_exception(Pat)
		     )),
	set_ops(Old).

% THE IDEA is that you define for NEW only those operators that are distinct
% from SICSTUS built-in operators (defined below). 
% set_ops(New,Old).
% set_ops(New)
set_ops(New) :-
	set_ops(New,_Old).
set_ops(New,Old) :-
	remove_non_standard(Old),
	define_ops(New).


define_ops([]).
define_ops([op(A,B,C)|T]) :-
	op(A,B,C),
	define_ops(T).

remove_non_standard(Ops) :-
	findall(Op,standardize(Op),Ops).

standardize(op(Prec,Type,Operator)) :-
	current_op(Prec,Type,Operator),
	(  standard(Operator,Prec,Type)
	-> fail                    % don't remember it, if it's standard anyway
	;  (  standard(Operator,Prec0,Type0) % non-standard use of standard op.
	   -> op(Prec0,Type0,Operator)
	   ;  op(0,fx,Operator)    % undefines an unknown operator...
	   )
	).

% this list is constructed with
% current_op(A,B,C), format("standard((~w),~w,~w).~n",[C,A,B]), fail.
% but I've added extra quotes around the comma 
standard((~),300,fy).
standard((:-),1200,xfx).
standard((-->),1200,xfx).
standard((:-),1200,fx).
standard((?-),1200,fx).
standard((mode),1150,fx).
standard((public),1150,fx).
standard((dynamic),1150,fx).
standard((multifile),1150,fx).
standard((block),1150,fx).
standard((meta_predicate),1150,fx).
standard((;),1100,xfy).
standard((->),1050,xfy).
standard((','),1000,xfy).
standard((\+),900,fy).
standard((spy),900,fy).
standard((nospy),900,fy).
standard((=),700,xfx).
standard((is),700,xfx).
standard((=..),700,xfx).
standard((==),700,xfx).
standard((\==),700,xfx).
standard((@<),700,xfx).
standard((@>),700,xfx).
standard((@=<),700,xfx).
standard((@>=),700,xfx).
standard((=:=),700,xfx).
standard((=\=),700,xfx).
standard((<),700,xfx).
standard((=<),700,xfx).
standard((>),700,xfx).
standard((>=),700,xfx).
standard((:),550,xfy).
standard((+),500,yfx).
standard((-),500,yfx).
standard((/\),500,yfx).
standard((\/),500,yfx).
standard((#),500,yfx).
standard((+),500,fx).
standard((-),500,fx).
standard((*),400,yfx).
standard((/),400,yfx).
standard((//),400,yfx).
standard((<<),400,yfx).
standard((>>),400,yfx).
standard((mod),300,xfx).
standard((^),200,xfy).  

