1:- module(aop_reflection,[
    2  ]).    3
    4:- use_module('./internal').    5:- use_module('./docs').    6
    7:- new_aspect(reflection).    8
    9  :- new_object(aop:aspect(Aspect),[
   10    name(Aspect)
   11    ]).   12
   13    ::defined_object(This, Object) :-
   14      current_object(Object),
   15      This::name(Aspect),
   16      Object = aop:object(Aspect, _, _).
   17
   18    augmented_object(Object) :-
   19      ::name(Aspect),
   20      Object = aop:augmented(Aspect, _, _),
   21      Object.
   22
   23    ::doc_comments(This, Docs) :-
   24      This::name(Aspect),
   25      aop:aspect_comment(Aspect, _, Docs).
   26
   27  :- end_object.   28
   29  :- new_object(aop:object(Aspect, Object, Module), [
   30    aspect(Aspect),
   31    object(Object),
   32    original_module(Module)
   33    ]).   34
   35    ::doc_comments(This, Docs) :-
   36      This::aspect(Aspect),
   37      This::object(Object),
   38      aop:object_comment(Aspect, Object, _, Docs).
   39
   40  :- end_object.   41
   42  :- new_object(aop:augmented(Aspect, Object, Module), [
   43    aspect(Aspect),
   44    object(Object),
   45    augmenting_module(Module)
   46    ]).   47
   48  :- end_object.   49
   50  :- in_object(_Any).   51
   52    ::this(This, This).
   53
   54    % Return the aspect where the object is defined
   55    ::where(This, Aspect) :-
   56      aop:object(Aspect, This, _Module).
   57
   58    ::defining_object(This, aop:object(Aspect, This, Module)) :-
   59      aop:object(Aspect, This, Module).
   60
   61    ::method(This, Method) :-
   62      This::method(_Aspect, Method).
   63
   64    ::method(This, Aspect, Method) :-
   65      current_enabled_aspect(Aspect),
   66      current_method(Method),
   67      Method::object(This),
   68      Method::aspect(Aspect).
   69
   70    ::clause(This, Clause) :-
   71      This::predicate(Name/Arity),
   72      \+member(Name, [clause, method]),
   73      ExtendedArity is Arity + 2,
   74      current_predicate(Module:Name/ExtendedArity),
   75      functor(Head, Name, ExtendedArity),
   76      Module:clause(Head, Body),
   77      arg(2,Head, Object),
   78      Object =@= This,
   79      ( Body = true -> Clause = Head ; Clause = ( Head :- Body)).
   80
   81    ::perform(This, Message) :-
   82      This::Message.
   83
   84    ::apply(This, Partial, Args) :-
   85      Partial =.. PartialMessage,
   86      append(PartialMessage, Args, Parts),
   87      Message =.. Parts,
   88      This::Message.
   89
   90    % Returns a nested term if term is defined
   91    % on the resceiver
   92    ::nested(This, Term, Nested) :-
   93      This::Term,
   94      This::nest(Term, Nested).
   95
   96    ::nest(This, Term, Nested) :-
   97      extend([This],Term, Nested).
   98
   99    ::ground(This) :-
  100      ground(This).
  101
  102    listing :-
  103      ::listing(_).
  104
  105    listing(MethodName) :-
  106      atom(MethodName),
  107      !,
  108      ::this(This),
  109      findall(
  110        Clause,
  111        (
  112          clause(aop:do(Aspect, This, Method), Body),
  113          functor(Method, MethodName, _Arity),
  114          Clause = [Aspect, (This::Method :- Body)]
  115          ),
  116        Clauses
  117        ),
  118      ::portray_method_clauses(Clauses).
  119
  120    listing(MethodPattern) :-
  121      ::this(This),
  122      findall(
  123        Clause,
  124        (
  125          clause(aop:do(Aspect, This, Method), Body),
  126          MethodPattern = Method,
  127          Clause = [Aspect, (This::Method :- Body)]
  128          ),
  129        Clauses
  130        ),
  131      ::portray_method_clauses(Clauses).
  132
  133    portray_method_clauses(Clauses) :-
  134      forall(
  135        member([Aspect, Clause], Clauses),
  136        (
  137          format('~n% Aspect ~w~n',Aspect),
  138          portray_clause(Clause)
  139          )
  140        ).
  141
  142  :- end_object.  143
  144  :- new_object(aop:method(Aspect, Object, Module:Name/Arity),[
  145    aspect(Aspect),
  146    object(Object),
  147    name(Name),
  148    arity(Arity),
  149    declaring_module(Module),
  150    predicate(Name/Arity)
  151  ]).  152
  153    ::doc_comments(This, Doc) :-
  154      This::aspect(Aspect),
  155      This::object(Object),
  156      This::predicate(Predicate),
  157      aop:method_comment(Aspect, Object, Predicate, _, Doc ).
  158
  159  :- end_object.  160:- end_aspect.