e5f4633c39
which included commits to RCS files with non-trunk default branches. git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@5 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
113 lines
3.2 KiB
Prolog
113 lines
3.2 KiB
Prolog
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
|
|
% clp(q,r) version 1.3.2 %
|
|
% %
|
|
% (c) Copyright 1992,1993,1994,1995 %
|
|
% Austrian Research Institute for Artificial Intelligence (OFAI) %
|
|
% Schottengasse 3 %
|
|
% A-1010 Vienna, Austria %
|
|
% %
|
|
% File: class.pl %
|
|
% Author: Christian Holzbaur christian@ai.univie.ac.at %
|
|
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
|
|
|
|
|
|
%
|
|
% the class theory
|
|
%
|
|
|
|
:- module( classq,
|
|
[
|
|
class_allvars/2,
|
|
class_new/4,
|
|
class_drop/2,
|
|
class_basis/2,
|
|
class_basis_add/3,
|
|
class_basis_drop/2,
|
|
class_basis_pivot/3,
|
|
|
|
ordering/1,
|
|
arrangement/2
|
|
]).
|
|
|
|
:- use_module( clpq, '../clpq', [get_or_add_class/2]).
|
|
|
|
:- ensure_loaded( ordering).
|
|
|
|
:- use_module( library(lists), [append/3]).
|
|
|
|
:- use_module( library(atts)).
|
|
|
|
:- attribute class_atts/4.
|
|
|
|
|
|
verify_attributes( X, Y, []) :-
|
|
get_atts( X, class_atts(La,Lat,ABasis,PrioA)),
|
|
!,
|
|
var( Y), % required
|
|
get_atts( Y, class_atts(Lb,Lbt,BBasis,PrioB)),
|
|
Lat = Lb, % append
|
|
append( ABasis, BBasis, CBasis),
|
|
combine( PrioA, PrioB, PrioC),
|
|
put_atts( Y, class_atts(La,Lbt,CBasis,PrioC)).
|
|
verify_attributes( _, _, []).
|
|
|
|
%
|
|
% for the debugger
|
|
%
|
|
% attribute_goal( V, V:A) :- get_atts( V, A), A = [_|_].
|
|
|
|
|
|
% ----------------------------------------------------------------------------------
|
|
|
|
class_new( Class, All,AllT, Basis) :-
|
|
put_atts( Su, class_atts(All,AllT,Basis,[])),
|
|
Su = Class.
|
|
|
|
class_get_prio( Class, Priority) :-
|
|
get_atts( Class, class_atts(_,_,_,Priority)).
|
|
|
|
class_put_prio( Class, Priority) :-
|
|
get_atts( Class, class_atts(All,AllT,Basis,_)),
|
|
put_atts( Class, class_atts(All,AllT,Basis,Priority)).
|
|
|
|
class_drop( Class, X) :-
|
|
get_atts( Class, class_atts(Allvars,Tail,Basis,Priority)),
|
|
delete_first( Allvars, X, NewAllvars),
|
|
delete_first( Basis, X, NewBasis),
|
|
put_atts( Class, class_atts(NewAllvars,Tail,NewBasis,Priority)).
|
|
|
|
class_allvars( Class, All) :- get_atts( Class, class_atts(All,_,_,_)).
|
|
|
|
class_basis( Class, Basis) :- get_atts( Class, class_atts(_,_,Basis,_)).
|
|
|
|
class_basis_add( Class, X, NewBasis) :-
|
|
NewBasis = [X|Basis],
|
|
get_atts( Class, class_atts(All,AllT,Basis,Priority)),
|
|
put_atts( Class, class_atts(All,AllT,NewBasis,Priority)).
|
|
|
|
class_basis_drop( Class, X) :-
|
|
get_atts( Class, class_atts(All,AllT,Basis0,Priority)),
|
|
delete_first( Basis0, X, Basis),
|
|
Basis0 \== Basis, % anything deleted ?
|
|
!,
|
|
put_atts( Class, class_atts(All,AllT,Basis,Priority)).
|
|
class_basis_drop( _, _).
|
|
|
|
class_basis_pivot( Class, Enter, Leave) :-
|
|
get_atts( Class, class_atts(All,AllT,Basis0,Priority)),
|
|
delete_first( Basis0, Leave, Basis1),
|
|
put_atts( Class, class_atts(All,AllT,[Enter|Basis1],Priority)).
|
|
|
|
%
|
|
% remove the first occurence
|
|
%
|
|
delete_first( L, _, Res) :- var(L), !, Res = L.
|
|
delete_first( [], _, []).
|
|
delete_first( [Y|Ys], X, Res) :-
|
|
( X==Y ->
|
|
Res = Ys
|
|
;
|
|
Res = [Y|Tail],
|
|
delete_first( Ys, X, Tail)
|
|
).
|