:- op(1200,xfx,<-).
:- op(1000,xfy,and).
:- op(1000,xfy,or).

:- import append/3, copy_term/2, memberchk/2 from basics.
:- import get_returns/3, delete_return/2 from tables.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Meta Interpreter and Tests
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

meta(true):-!.
meta(','(Term1,Term2)):-!,
	meta(Term1),
	meta(Term2).
meta(Call:[Type,Var]):-!,
	bagjoin(Type,Call,Var).
meta(Term):- call(Term).

bagjoin(Type,Call,Res):- 
	bottom(Type,Bot),
	bagjoin1(Call,Type,Res1,Bot),
	eval(Type,Res1,Res).

eval(_Type,Val1,_Val2):- var(Val1),!.
eval(_Type,Val1,Val2):- var(Val2),Val1 = Val2,!.
eval(Type,Val1,Val2):- gt1(Type,Val1,Val2).

shortest_path(X,Y) : [min,D1] <- 
              shortest_path(X,Z): [min,D2], edge(Z,Y,D), D1 is D2 + D.
shortest_path(X,Y) : [min,C] <- edge(X,Y,C).

          edge(1,2,1).          edge(2,2,1).
          edge(2,3,1).          edge(2,4,1).
          edge(3,5,2).          edge(4,5,1).

join(min,A,B,Min):-	min(A,B,Min).
bottom(min,infinity).
gt1(min,A,B):- min(A,B,A).

min(One,infinity,One):-!.
min(infinity,Two,Two):-!.
min(One,Two,Min):- One > Two -> Min = Two ; Min = One.

:- table join/4.
join(belnap,bottom,X,X):-!.
join(belnap,X,Y,Z):- join(belnap,Y,X,Z).
join(belnap,X,Y,top):- X \== bottom,Y \== bottom.

bottom(belnap,bottom).

gt1(belnap,_,bottom):-!.
gt1(belnap,top,_).

p:[belnap,true] <-  r:[belnap,true].
p:[belnap,false] <-  r:[belnap,false].
r:[belnap,top] <- true.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% bagjoin1/4
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

/* TLS: you do not need to know code from here down */

/* Note: this predicate follows the paradigm of predicates in
aggregs.P, but does not use HiLog. */

breg_retskel(_BregOffset,_Arity,_RetTerm,_SubgoalPtr) :- '_$builtin'(154).

bagjoin1(Call,Type,Res,Bot):-
	bagjoin2(Call,Type,Res,Bot),fail.
bagjoin1(Call,Type,Res,Bot):-
	bagjoin2(Call,Type,Res,Bot).


:- table bagjoin2/4.  
bagjoin2(_,_,Bot,Bot).  		/* A:bottom is true of all atoms */
bagjoin2(Call,Type,Res,Bot):-
	'_$savecp'(Breg),
	breg_retskel(Breg,4,Skel,Cs),
				/* the previous two literals form a
				   low-level hack to instantiate Cs to
				   a pointer to the root of the answer
				   trie for the current call (via Breg) */
	copy_term(p(Call,Res,Skel),p(Call,Ovar,Oskel)),
	meta_expand(Call:[Type,Nvar]),
	(get_returns(Cs,Oskel,Leaf),
 	 join(Type,Ovar,Nvar,Res),
	 Res \== Ovar,
	 delete_return(Cs,Leaf)
				/* delete returns that have been
				   lubbed over.  There "should" be at
				   most one */
	 ;
  	 \+ get_returns(Cs,Oskel,Leaf),
 	 join(Type,Bot,Nvar,Res)
	).

meta_expand(Term):-
	'<-'(Term,Body),
	meta(Body).

end_of_file.