new version of class.pl

git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@487 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
2002-05-24 00:48:51 +00:00 · 2002-05-24 00:48:51 +00:00 · 03231bef34
commit 03231bef34
parent c9be907884
1 changed files with 112 additions and 0 deletions
--- a/CLPQR/clpq/class.yap
+++ b/CLPQR/clpq/class.yap
@ -0,0 +1,112 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%  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)
+  ).