1:- module(aop_assertions,[
    2  ]).    3
    4:- use_module('./internal').    5
    6% 
    7% Default methods: Assertions -- extensions of baseline
    8% 
    9
   10% 
   11% asserta
   12% 
   13
   14:- new_aspect(assertions).   15
   16  % This definition means that all objects obtain these methods
   17  :- in_object(_This).   18
   19    ::assert(This,Assertion) :- This::assert(Assertion, _Ref).
   20    ::assert(This,Assertion, Ref) :- This::assertz(Assertion, Ref).
   21    % Any assertion, add it in front of prior assertions
   22    ::asserta(This,Assertion) :- This::asserta(Assertion, _Ref).
   23    % Rules -- asserta(Head :- Body, Ref)
   24    ::asserta(This, (Head :- Body), Ref) :- 
   25      !,
   26      asserta( (aop:do(asserted, This, Head) :- Body), Ref ).
   27
   28    % Facts -- asserta(Fact, Ref)
   29    ::asserta(This, Fact, Ref) :-
   30      !,
   31      asserta( aop:do(asserted, This, Fact), Ref ).
   32
   33    ::assertz(This,Assertion) :- This::assertz(Assertion, _Ref).
   34
   35    % Rules -- assertz(Head :- Body)
   36    ::assertz(This, (Head :- Body), Ref) :- 
   37      !,
   38      assertz( (aop:do(asserted, This, Head) :- Body), Ref ).
   39
   40    % Facts -- assertz(Fact, Ref)
   41    ::assertz(This, Fact, Ref) :-
   42      !,
   43      assertz( aop:do(asserted, This, Fact), Ref ).
   44
   45    ::retract(This, Head :- Body) :-
   46      !,
   47      retract(aop:do(asserted, This, Head) :- Body).
   48
   49    ::retract(This, Body) :-
   50      !,
   51      retract(aop:do(asserted, This, Body)).
   52
   53    ::retractall(This, Head :- Body) :-
   54      !,
   55      retractall(aop:do(asserted, This, Head) :- Body).
   56
   57    ::retractall(This, Body) :-
   58      !,
   59      retractall(aop:do(asserted, This, Body)).
   60
   61    :- end_object.   62
   63:- end_aspect.