This repository has been archived on 2023-08-20. You can view files and clone it, but cannot push or open issues or pull requests.
yap-6.3/CLPQR/clpq/class.yap

113 lines
3.2 KiB
Plaintext
Raw Normal View History

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% 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( '../clpqr/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)
).