197 lines
		
	
	
		
			5.1 KiB
		
	
	
	
		
			Prolog
		
	
	
	
	
	
			
		
		
	
	
			197 lines
		
	
	
		
			5.1 KiB
		
	
	
	
		
			Prolog
		
	
	
	
	
	
| /*************************************************************************
 | |
| *									 *
 | |
| *	 YAP Prolog 							 *
 | |
| *									 *
 | |
| *	Yap Prolog was developed at NCCUP - Universidade do Porto	 *
 | |
| *									 *
 | |
| * Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997	 *
 | |
| *									 *
 | |
| **************************************************************************
 | |
| *									 *
 | |
| * File:		atts.yap						 *
 | |
| * Last rev:	8/2/88							 *
 | |
| * mods:									 *
 | |
| * comments:	attribute support for Prolog				 *
 | |
| *									 *
 | |
| *************************************************************************/
 | |
| 
 | |
| % :- yap_flag(unknown,error).
 | |
| % :- style_check(all).
 | |
| 
 | |
| %
 | |
| % Code originally written by Arvin Bansal and Vitor Santos Costa
 | |
| % Includes nice extensions from Jan Wielemaker (from the SWI version).
 | |
| %
 | |
| 
 | |
| :- module(coinduction,
 | |
|           [ (coinductive)/1,
 | |
|             op(1150, fx, (coinductive))
 | |
|           ]).
 | |
| 
 | |
| :- use_module(library(error)).
 | |
| 
 | |
| /** <module> Co-Logic Programming
 | |
| 
 | |
| This simple module implements the   directive coinductive/1 as described
 | |
| in "Co-Logic Programming: Extending Logic  Programming with Coinduction"
 | |
| by Luke Somin et al. The idea behind coinduction is that a goal succeeds
 | |
| if it unifies to a parent goal.  This enables some interesting programs,
 | |
| notably on infinite trees (cyclic terms).
 | |
| 
 | |
|     ==
 | |
|     :- use_module(library(coinduction)).
 | |
| 
 | |
|     :- coinductive stream/1. 
 | |
|     stream([H|T]) :- i(H), stream(T).
 | |
| 
 | |
|     % inductive
 | |
|     i(0).
 | |
|     i(s(N)) :- i(N).
 | |
| 
 | |
|     ?- X=[s(s(A))|X], stream(X).
 | |
|      X= [s(s(A))|X], stream(X).
 | |
|      A = 0,
 | |
|      X = [s(s(0)),**]
 | |
|     ==
 | |
| 
 | |
| This predicate is  true  for  any   cyclic  list  containing  only  1-s,
 | |
| regardless of the cycle-length.
 | |
| 
 | |
| @bug    Programs mixing normal predicates and coinductive predicates must
 | |
|         be _stratified_.  The theory does not apply to normal Prolog calling
 | |
|         coinductive predicates, calling normal Prolog predicates, etc.
 | |
| 
 | |
|         Stratification is not checked or enforced in any other way and thus
 | |
|         left as a responsibility to the user.
 | |
| @see    "Co-Logic Programming: Extending Logic  Programming with Coinduction"
 | |
|         by Luke Somin et al.
 | |
| */
 | |
| 
 | |
| :- meta_predicate coinductive(:).
 | |
| 
 | |
| :- dynamic coinductive/3.
 | |
| 
 | |
| 
 | |
| %-----------------------------------------------------
 | |
| 
 | |
| coinductive(Spec) :-
 | |
| 	var(Spec),
 | |
| 	!,
 | |
| 	throw(error(instantiation_error,coinductive(Spec))).
 | |
| coinductive(Module:Spec) :-
 | |
|         coinductive_declaration(Spec, Module, coinductive(Module:Spec)).
 | |
| coinductive(Spec) :-
 | |
|         prolog_load_context(module, Module),
 | |
|         coinductive_declaration(Spec, Module, coinductive(Spec)).
 | |
| 	
 | |
| coinductive_declaration(Spec, _M, G) :-
 | |
| 	var(Spec),
 | |
| 	!,
 | |
| 	throw(error(instantiation_error,G)).
 | |
| coinductive_declaration((A,B), M, G) :- !,
 | |
| 	coinductive_declaration(A, M, G),
 | |
| 	coinductive_declaration(B, M, G).
 | |
| coinductive_declaration(M:Spec, _, G) :- !,
 | |
| 	coinductive_declaration(Spec, M, G).
 | |
| coinductive_declaration(Spec, M, _G) :-
 | |
| 	valid_pi(Spec, F, N),
 | |
| 	functor(S,F,N), 
 | |
| 	atomic_concat(['__coinductive__',F,'/',N],NF),
 | |
| 	functor(NS,NF,N), 
 | |
| 	match_args(N,S,NS),
 | |
| 	atomic_concat(['__stack_',M,':',F,'/',N],SF), 
 | |
| 	nb_setval(SF, _),
 | |
| 	assert((M:S :-
 | |
| 	       b_getval(SF,L),
 | |
| 		coinduction:in_stack(S, L, End),
 | |
| 		(
 | |
| 		 nonvar(End)
 | |
| 		->
 | |
| 		 true
 | |
| 		;
 | |
| 		 End = [S|_],
 | |
| 		 M:NS)
 | |
| 	       )
 | |
| 	      ),
 | |
| 	assert(coinduction:coinductive(S,M,NS)).
 | |
|   
 | |
| valid_pi(Name/Arity, Name, Arity) :-
 | |
|         must_be(atom, Name),
 | |
|         must_be(integer, Arity).
 | |
| 
 | |
| match_args(0,_,_) :- !.
 | |
| match_args(I,S1,S2) :-
 | |
| 	arg(I,S1,A),
 | |
| 	arg(I,S2,A),
 | |
| 	I1 is I-1,
 | |
| 	match_args(I1,S1,S2).
 | |
| 
 | |
| %-----------------------------------------------------
 | |
| 
 | |
| co_term_expansion((M:H :- B), _, (M:NH :- B)) :- !,
 | |
| 	co_term_expansion((H :- B), M, (NH :- B)).
 | |
| co_term_expansion((H :- B), M, (NH :- B)) :- !,
 | |
| 	coinductive(H, M, NH), !.
 | |
| co_term_expansion(H, M, NH) :-
 | |
| 	coinductive(H, M, NH), !.
 | |
| 
 | |
| user:term_expansion(M:Cl,M:NCl ) :- !,
 | |
| 	co_term_expansion(Cl, M, NCl).
 | |
| 
 | |
| user:term_expansion(G, NG) :-
 | |
|         prolog_load_context(module, Module),
 | |
| 	co_term_expansion(G, Module, NG).
 | |
| 
 | |
| 
 | |
| %-----------------------------------------------------
 | |
| 
 | |
| in_stack(_, V, V) :- var(V), !.
 | |
| in_stack(G, [G|_], [G|_]) :- !.
 | |
| in_stack(G, [_|T], End) :- in_stack(G, T, End).
 | |
| 
 | |
| writeG_val(G_var) :- 
 | |
|   b_getval(G_var, G_val),
 | |
|   write(G_var), write(' ==> '), write(G_val), nl.
 | |
| 
 | |
| %-----------------------------------------------------
 | |
| 
 | |
| /**************************************
 | |
| 
 | |
|   Some examples from Coinductive Logic Programming and its Applications by Gopal Gupta et al, ICLP 97
 | |
| 
 | |
| :- coinductive stream/1. 
 | |
| stream([H|T]) :- i(H), stream(T).
 | |
| 
 | |
| % inductive
 | |
| i(0).
 | |
| i(s(N)) :- i(N).
 | |
| 
 | |
| 	% Are there infinitely many "occurrences" of arg1 in arg2?
 | |
| 	:- coinductive comember/2.
 | |
| 
 | |
| 	comember(X, L) :-
 | |
| 		drop(X, L, L1),
 | |
| 		comember(X, L1).
 | |
| 
 | |
| 	% Drop some prefix of arg2 upto an "occurrence" of arg1 from arg2,
 | |
| 	% yielding arg3.
 | |
| 	% ("Occurrence" of X = something unifiable with X.)
 | |
| 	%:- table(drop/3).	% not working; needs tabling supporting cyclic terms!
 | |
| 	drop(H, [H| T], T).
 | |
| 	drop(H, [_| T], T1) :-
 | |
| 		drop(H, T, T1).
 | |
| 
 | |
| 
 | |
| % X = [1, 2, 3| X], comember(E, X).
 | |
| 
 | |
|         user:p(E) :- 
 | |
|                 X = [1, 2, 3| X],
 | |
|                 comember(E, X),
 | |
|                 format('~w~n',[E]), 
 | |
|                 get_code(_),
 | |
|                 fail.
 | |
| 
 | |
| 
 | |
| **************************************/
 | |
| 
 |