1:- module(aop_dsl, [  
    2  
    3  new_aspect/1,
    4  in_aspect/1,
    5  end_aspect/0,
    6
    7  new_object/1,
    8  new_object/2,
    9  in_object/1,
   10  end_object/0,
   11
   12  term_expansion/2,
   13  goal_expansion/2,
   14
   15  op(650, fx, ::),
   16  (::)/1,
   17
   18  op(1100, fx, method),
   19  (method)/1
   20
   21  ]).   22
   23:- use_module(library(apply)).   24
   25:- use_module('./context').   26:- use_module('./helpers').   27:- use_module('./runtime').   28
   29:- dynamic new_aspect/1.   30:- dynamic in_aspect/1.   31:- dynamic new_object/1.   32:- dynamic new_object/2.   33
   34% Used for declaring methods that take a reference
   35% to the receiver as the first or "this" parameter
   36:- dynamic (::)/1.   37
   38% For declaring unimplemented methods in an object
   39:- dynamic (method)/1.   40
   41end_aspect :-
   42  aop_pop_active_aspect.
   43
   44in_object(Object) :-
   45  aop_push_active_object(Object).
   46
   47end_object :-
   48  aop_pop_active_object.
   49
   50% - - - - - - - - - - - - - - - - - - -
   51% 
   52% Term expansion
   53% 
   54% - - - - - - - - - - - - - - - - - - -
   55
   56term_expansion(:- new_aspect(Aspect),[
   57  aop:aspect(Aspect),
   58  aop:aspect_enabled(Aspect,true),
   59  aop:aspect_event_queue(Aspect, Queue, Thread) | InAspectExpansions
   60  ]) :-
   61  format(atom(Queue), '~w_aspect_events',[Aspect]),
   62  format(atom(Thread),'~w_aspect_event_dispatcher',[Aspect]),
   63  term_expansion(:- in_aspect(Aspect), InAspectExpansions).
   64
   65term_expansion(:- in_aspect(Aspect), [
   66  aop:aspect_module(Aspect, Module)
   67  ]) :-
   68  prolog_load_context(module, Module),
   69  aop_push_active_aspect(Aspect).
   70
   71term_expansion(:- new_object(Object), Expansion) :- 
   72  term_expansion(:- new_object(Object,[]), Expansion).
   73
   74term_expansion(:- new_object(Object, Accessors), Expansion) :-
   75  aop_load_context(aspect, Aspect),
   76  prolog_load_context(module, Module),
   77  ObjectExpansion = aop:object(Aspect, Object, Module),
   78  expand_accessors(Aspect, Object, Accessors, AccessorExpansions),
   79  term_expansion(:- in_object(Object), InObjectExpansion),
   80  append([ObjectExpansion | AccessorExpansions], InObjectExpansion, Expansion).
   81
   82term_expansion(:- in_object(Object), Expansion) :-
   83  aop_load_context(aspect, Aspect),
   84  prolog_load_context(module, Module),
   85  Expansion = [
   86    aop:augmented(Aspect, Object, Module)
   87  ],
   88  aop_push_active_object(Object).
   89
   90term_expansion(:- nested_object(Object), [ObjectExpansion]) :-
   91  aop_load_context(object, Current),
   92  aop_load_context(aspect, Aspect),
   93  prolog_load_context(module, Module),
   94  Object =.. [Kind | Args],
   95  NestedObject =.. [Kind, Current | Args],
   96  ObjectExpansion = aop:object(Aspect, NestedObject, Module),
   97  aop_push_active_object(NestedObject).
   98
   99term_expansion(:- extension(Name/MethodArity), Expansion ) :-
  100    aop_load_context(object, Object),
  101    aop_load_context(aspect, Aspect),
  102    ( aop:extension(Aspect, Object, Name/MethodArity)  
  103      -> Expansion = []
  104      ; Expansion = [aop:extension(Aspect, Object, Name/MethodArity)]
  105      ).
  106
  107term_expansion(:- method(Name/MethodArity), Expansion) :-
  108    aop_load_context(object, Object),
  109    aop_load_context(aspect, Aspect),
  110    prolog_load_context(module, Module),
  111    method_expansion(Aspect, Object, Module:Name/MethodArity, Expansion).
  112
  113% Events -- ::on(This, EventType, Object, Message) :- baz.
  114% expand_object_declaration(Aspect, This, (::on(This,EventType,Object,Message) :- Body), [
  115term_expansion(::on(This,EventType,Object,Message) :- Body, [
  116    (aop:on(Aspect, This, EventType, Object, Message) :- Body)
  117    ]) :-
  118  aop_load_context(object, This),
  119  aop_load_context(aspect, Aspect),
  120  start_aspect_event_dispatcher(Aspect).
  121
  122% Events -- ::at(This, EventType, Object, Message) :- baz.
  123% expand_object_declaration(Aspect, This, (::at(This,EventType,Object,Message) :- Body), [
  124term_expansion(::at(This,EventType,Object,Message) :- Body, [
  125    (aop:at(Aspect, This, EventType, Object, Message) :- Body)
  126    ]) :-
  127  aop_load_context(object, This),
  128  aop_load_context(aspect, Aspect).
  129
  130% Rule -- ::foo(This, bar) :- baz.
  131% expand_object_declaration(Aspect, Object, (::Message :- Body), [
  132term_expansion(::Message :- Body, [
  133    aop:do(Aspect, Object, ContractedMessage) :- ExtendedBody |
  134    MethodExpansion
  135    ]) :-
  136  aop_load_context(object, Object),
  137  aop_load_context(aspect, Aspect),
  138  contract(Message, ContractedMessage),
  139  functor(Message, Name, Arity),
  140  MethodArity is Arity - 1,
  141  % We need to check "this" against the object, to ensure
  142  % there is a match for the method
  143  arg(1,Message,This),
  144  prolog_load_context(module, Module),
  145  ExtendedBody = (This = Object, current_enabled_aspect(Aspect), Body),
  146  method_expansion(Aspect, Object, Module:Name/MethodArity, MethodExpansion).
  147
  148% Fact -- ::foo(This, bar)
  149term_expansion(::Message, [
  150    aop:do(Aspect, Object, ContractedMessage) :- ExtendedBody |
  151    MethodExpansion
  152    ]) :-
  153  aop_load_context(object, Object),
  154  aop_load_context(aspect, Aspect),
  155  contract(Message, ContractedMessage),
  156  functor(Message, Name, Arity),
  157  MethodArity is Arity - 1,
  158  % We need to check "this" against the object, to ensure
  159  % there is a match for the method
  160  arg(1,Message,This),
  161  prolog_load_context(module, Module),
  162  ExtendedBody = (This = Object),
  163  method_expansion(Aspect, Object, Module:Name/MethodArity, MethodExpansion).
  164
  165% Rule -- foo(bar) :- baz.
  166% expand_object_declaration(Aspect, Object, (Message :- Body), [
  167term_expansion((Message :- Body), [
  168    aop:do(Aspect, Object, Message) :- Body |
  169    MethodExpansion
  170    ]) :-
  171  aop_load_context(object, Object),
  172  aop_load_context(aspect, Aspect),
  173  functor(Message,Name, MethodArity),
  174  prolog_load_context(module, Module),
  175  method_expansion(Aspect, Object, Module:Name/MethodArity, MethodExpansion).
  176
  177% Fact -- foo(bar)
  178% expand_object_declaration(Aspect, Object, Message, [
  179term_expansion(Message, [
  180    aop:do(Aspect, Object, Message) |
  181    MethodExpansion
  182    ]) :-
  183  aop_load_context(object, Object),
  184  ( Message = begin_of_file -> fail ; true ),
  185  ( Message = end_of_file -> fail ; true),
  186  ( (functor(Message,Op,1),  current_op(_,_,Op) ) -> fail ; true),
  187  aop_load_context(aspect, Aspect),
  188  functor(Message,Name,MethodArity),
  189  prolog_load_context(module, Module),
  190  method_expansion(Aspect, Object, Module:Name/MethodArity,  MethodExpansion).
  191
  192expand_accessors(_Aspect, _Object, [],[]).
  193
  194expand_accessors(Aspect, Object, [Accessor | Accessors], [
  195   aop:do(Aspect, Object, Accessor),
  196   MethodExpansion | AccessorExpansions
  197   ]) :-
  198  functor(Accessor,Name,MethodArity),
  199  method_expansion(Aspect, Object, Module:Name/MethodArity, MethodExpansion),
  200  prolog_load_context(module, Module),
  201  expand_accessors(Aspect, Object, Accessors, AccessorExpansions).
  202
  203method_expansion(Aspect, Object, Module:Name/MethodArity, MethodExpansion) :-
  204  aop:method(Aspect, Object, Module:Name/MethodArity)
  205    -> MethodExpansion = []
  206    ; (
  207      method_signature(Name, Signature, VariableNames),
  208      MethodExpansion = [
  209        aop:method(Aspect, Object, Module:Name/MethodArity),
  210        aop:method_signature(Aspect, Object, Module:Name/MethodArity, Signature, VariableNames)
  211        ]
  212        ).
  213
  214method_signature(Method, Signature, Names) :-
  215  prolog_load_context(variable_names, Variables),
  216  findall(Name, member(Name=_Var, Variables), Names),
  217  MethodCall =.. [Method| Names],
  218  with_output_to(
  219    string(SignatureString),
  220    write_term(MethodCall,[])
  221    ),
  222  atom_string(Signature, SignatureString).
  223
  224% 
  225% Goal expansion
  226% 
  227
  228% The idiom `::here(Here)` where `Here` can be any variable name
  229% will bind the current aspect to that variable
  230goal_expansion(::here(Here), Aspect = Here) :-
  231  % This has to be done at compile time because the
  232  % context isn't availale at run time
  233  aop_load_context(aspect, Aspect).
  234
  235% Support messages to `This` object without
  236% explicitly needing a `This` variable
  237goal_expansion(::Message, Object::ExpandedMessage) :-
  238  aop_load_context(object, Object),
  239  expand_goal(Message, ExpandedMessage).
  240
  241% Ensure that even nested terms are properly
  242% expanded as well
  243goal_expansion(Goal, ExpandedGoal) :-
  244  aop_load_context(object, _Object),
  245  Goal =.. [Name | Args],
  246  maplist(expand_goal, Args, ExpandedArgs),
  247  ExpandedGoal =.. [Name | ExpandedArgs]