/* -*- mode:prolog; -*-
 ******************************************************************
 * $Id: dyalogrc 473 2005-03-02 10:34:14Z clerger $
 * Copyright (C) 1998, 2002, 2003, 2004, 2005 by INRIA 
 * Author: Eric de la Clergerie <Eric.De_La_Clergerie@inria.fr>
 * ----------------------------------------------------------------
 *
 *  dyalogrc -- Ressource file for DyALog Compiler
 *
 * ----------------------------------------------------------------
 * Description
 * 
 * ----------------------------------------------------------------
 */

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%  Op declarations

:-op( 1200, xfx, [(:-),(-->)] ).
:-op( 1200,  fy, [xcompiler,toplevel_clause] ).
:-op( 1200,  fy, [(:-),(?-)] ).
:-op( 1100, xfy, [(;)] ).
:-op( 1050, xfy, [->] ).
:-op( 1040, xfy, ['##'] ).
:-op( 1000, xfy, [','] ).
:-op(  900,  fy, [\+,spy,nospy] ).
:-op(  800, xfx, [:=]).
:-op(  700, xfx, [=,is,=..,==,@<,@>,@=,@=<,@>=,\==,=:=,=\=,<,>,=<,>=,(..)] ).
:-op(  600, xfy, [:,::] ).
:-op(  590, xfy, [=>] ).
:-op(  500, yfx, [+,-,\\/,/\\] ).
:-op(  500,  fx, [-,+] ).
:-op(  400, yfx, [*,/,//,<<,>>,div] ).
:-op(  300, xfx, [mod] ).
:-op(  200, xfy, [^,^^] ).
:-op(  900, xfy, [&] ).
:-op(  700, xf , [?] ).
:-op(  700, xf , [@?,@*,@+] ).
:-op(  700, xfx, [isagg] ).

%% For bidirectionnal parsing of DCGs

:-op( 520, yfx, <+ ).
:-op( 550, xfy, +> ).

:-prolog(['$call'/1,call!call/1,'$bmgcall'/5,call!bmgcall/5]).

:-rec_prolog(['$pcall'/1,call!pcall/1,'$bmgpcall'/5,call!bmgpcall/5]).

:-op(1100, fx, [ extensional,
		 hilog,
		 lco,
		 prolog,
		 rec_prolog,
		 std_prolog,
		 light_tabular,
		 include,
		 require,
		 resource,
		 lc
              ]).

:-op(1050, fx, [ dcg ] ).

:-op( 550, xfy, :> ).

:-extensional 'C'/3.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Compiler extension   \+

%% Negation on a guard

\+ Guard :- ( Guard -> fail ; true ).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Compiler extension   lock

%% lock(Lock,Generator,Code) 
%% Don't know yet how to do it !

%% Code must be evaluated for each value generated by Generator
%% but with Code running for only one value at a time
lock( Lock, Generator , Code ) :- Generator, Code.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Compiler extension   bestof

% to be correct, Test should be a guard (at least until lock not implemented).
% (otherwise there may be some probleme of concurrence)

bestof( X, Generator, Y^Test ) :-
    gensym(Id),
    wait( lock(Id,Generator,
		( recorded( toto(Id,Y) ) ->
		  ( Test,
		    erase( toto(Id,Y) ),
		    record( toto(Id,X) ) )
		  ; record( toto(Id,X) ))
	      )
	),
    recorded( toto(Id,X) ).

				
/* Example

 ?- bestof(X,                         % Test are run on X
	   member(X,[4,-2,3]),        % values for X are generated by member
	   Old^(X<Old)                % min test : X kept if less than previous recorded value
	  )
  -> X=-2

*/
		 
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Compiler extension   group_by
		 
group_by( Generator, Group, X^Y^(Acc^Updater,Init) ) :-
    gensym(Id),
    wait( (Generator,
	   ( recorded( toto(Id,Group,Acc) ) ->
	     (	 erase( toto(Id,Group,Acc) ),
		 Updater,
		 record( toto(Id,Group,X) ) )
	     ;
	     ( Init,
		 record( toto(Id,Group,X) ) )
	   ))),
    recorded( toto(Id,Group,X) )
    .

/* Example

   group_by( member(X,[1,2,3]),           % generator is member
	     [],                          % every generated element belong to the same group
	     New^X^(
		 Old^(New is X+Old),      % sum old recorded value with generated value for X
		 New=X                    % Initialization
	     )               
	   ).
    -> New = 6

    employee(john,1,100).
    employee( paul,1,200).
    employee( stefe,2,100).

   group_by( employee( Name, Dept, Salary ),
	     [Dept],
	     Total^Salary^(
		 Old^(Total is Salary+Old),
		 Total=Salary
	     )
	   ).
    -> Dept = 1, Total=300
    -> Dept = 2, Total=100
		 
*/

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Compiler extension   iterate

iterate( X^(Init,Y^Acc^Updater), Generator ) :-
    gensym(Id),
    ( Init,
      record( toto(Id,X) ),
      fail
      ; 
      wait( ( Generator,
	      recorded( toto(Id,Acc) ),
	      erase( toto(Id,Acc) ),
	      Updater,
	      record( toto(Id,X) ) )
	  ),
      recorded( toto(Id,X) )
    ).

iterate( [X^(Init,Y^Acc^Update)|R], Generator ) :-
    iterate( X^(Init,Y^Acc^Update), R , Generator ).

iterate( X^(Init,Y^Acc^Update), [], Generator ) :-
    iterate( X^(Init,Y^Acc^Update), Generator ).

iterate( X^(Init,Y^Acc^Update), [X2^(Init2,Y2^Acc2^Update2)|R], Generator ) :-
    iterate( (X,X2)^( (Init,Init2), (Y,Y2)^(Acc,Acc2)^(Update,Update2) ), R, Generator ).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% DCG compiler extension `?'

(A ?) --> [] | A.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%  Builtins

'*DATABASE*'( T ) :- recorded( T ).

dif(A,B) :- \+ A = B.
A \== B  :- \+ A == B.

read_term( T, V ) :- read_term([],T,V).
read( S, T ) :- read_term(S,T,_).
read( T ) :- read_term( T,_).

write( T ) :- write([],T).
writeq( T ) :- writeq([],T).
write_canonical( T ) :- write_canonical([],T).
display(T) :- display([],T).

(T1 @< T2 ) :- compare(<,T1,T2).
(T1 @> T2 ) :- compare(>,T1,T2).
(T1 @=< T2 ) :- \+ T1 @> T2.
(T1 @>= T2 ) :- \+ T1 @< T2.

writeln( Stream, A ) :- write(Stream,A), nl(Stream).
writeln( A ) :- write(A),nl.

ls :- system('ls -F', Res), Res =:= 0.

numbervars(T) :- numbervars(T,0,_).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% XSB compatibilty

:-op( 1025, fx, export ).

not( G ) :- wait( (G,record( G )) ), \+ recorded( G ).

% The following def would be better but we have to extend the notion of
% guard to include '$answers' !
% not( G ) :- wait( G ), \+ '$answers'( G ).

%repeat :- '$interface'( 'DyALog_Repeat'(), [choice_size(1)] ).

%% Error when Action is not a guard
repeat(Action) :- ('$interface'('$$repeat',[choice_size(1)]), Action -> true ; fail ).

/*
repeat( Action ) :-
	gensym(Id),
	record( '___repeat'(Id) ),
	'___repeat'(Id),
	Action,
	erase( '___repeat'(Id) ).
*/

%% strate_repeat needs a fact '___repeat'(_,_). to work properly

strate_repeat( I^Action ) :-
	gensym(Id),
	( ('___repeat'(Id,0) , fail) ;
	  '$answers'( '___repeat'(Id,I) ),
          J is I + 1,
	  wait( (Action, '___repeat'(Id,J) ))
	).

%% Every will work if G is pure Prolog or Guard
every( G ) :- ( G, fail ; true ).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Feature Path Notation

:-op(600,xfx, .=).
:-op(400,yfx, .>).

:-extensional('$farg'/3).

X .= Y :- '$fpath'(X,U),'$fpath'(Y,U).

'$fpath'(X,Y) :- X=Y.
'$fpath'(X .> F,Y) :- '$fpath'(X,Z),'$farg'(F,Z,Y).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Modified Builtins

record(A) :- record(A,_).
recorded(A) :- recorded(A,_).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Control

% G should be a tabular atom
recorded_answer(G) :- item_term(I,G), recorded(I).

% Exclusive or: A should be a guard
:-op( 1100, xfy, [xor] ).
A xor B :- (A -> true ; B).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Mutables

mutable(M,V,Backtrack) :- '$interface'( 'DyALog_Mutable_Write'( M:ptr, V:term, Backtrack:bool ),
					[return(M:ptr)] ).
mutable(M,V) :- mutable(M,V,false).
mutable_read(M,V) :- '$interface'( 'DyALog_Mutable_Read'(M:ptr, V:term), [] ).
mutable_inc(M,I) :- '$interface'( 'DyALog_Mutable_Inc'(M:ptr, I: -int), [] ).

V := T :- '$interface'( 'DyALog_Variable_Rebind'(V:term,T:term), [] ).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

my_domain(V,L) :- '$interface'( 'DyALog_Domain'(),
				[ choice_size(4),
				  load([L:term,V:term])
				]).


gensym(I) :- '$interface'( 'DyALog_Gensym'(), [return(I:int)] ).
%atom_concat(A,B,C) :- '$interface'( 'DyALog_Atom_Concat'(A:string, B:string), [return(C:string)] ).
put_char(S,C) :- '$interface'( 'DyALog_Put_Char'(S:output,C:char), [return(none)]).
put_char(C) :- '$interface'( 'DyALog_Put_Char'([]:output,C:char), [return(none)]).


string_stream(S,Stream) :- '$interface'( 'DyALog_Open_String_Stream'(S:string),
					 [ return(Stream:int) ]).

flush_string_stream(Stream,S) :- '$interface'( 'DyALog_Flush_String_Stream'(Stream:output),
					       [ return(S:string) ] ).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

assign_display_info(X) :- '$interface'( 'DyALog_Assign_Display_Info'(X:term), [return(none)]).

assign_varname(X,Name) :- '$interface'( 'DyALog_Assign_Varname'(X:term,Name:string), []).

newline_start(Start) :- '$interface'( 'Newline_Start_1'(Start:term),[]).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

delete_address(X) :- '$interface'( 'object_delete'(X:ptr),[return(bool)]).

%erase_recorded(T) :- recorded(T,T_Address),delete_address(T_Address).
erase_recorded(T) :- recorded(T,_),erase(T).


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

inlined_feature_arg(T,F,I,A) :-
	'$interface'( 'DyALog_Feature_Arg'(T:term, F: -string, I: -int, A: term),
		    [ choice_size(3) ] ).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Modules

:-features(import,[module,file,preds]).
