1:- module(aop_runtime,[
    2  op(900, xfx, ::),
    3  (::)/2,
    4  (::)/3,
    5  (::)/4,
    6
    7  op(950, yfx, to),
    8  (to)/2,
    9  (to)/3,
   10
   11  start_aspect_event_dispatcher/1
   12  ]).   13
   14:- use_module('./helpers').   15:- use_module('./inspection').   16:- use_module(library(prolog_stack)).   17
   18% 
   19% Runtime support
   20% 
   21
   22% do(Object, Message)
   23:- dynamic aop:do/3.   24:- multifile aop:do/3.   25
   26% Events -- on(Listener, EventType, Object, Message),
   27% where EventType is before or after
   28:- dynamic aop:on/5.   29:- multifile aop:on/5.   30
   31% For name of queue for aspect events
   32% aop:aspect_event_queue(Aspect, Queue, DispatcherThread)
   33:- dynamic aop:aspect_event_queue/3.   34:- multifile aop:aspect_event_queue/3.   35
   36% If true, then event dispatcher started
   37% aop:aspect_events_started(Aspect).
   38:- dynamic aop:aspect_events_started/1.   39:- multifile aop:aspect_events_started/1.   40
   41% Actions -- at(Listener, ActionType, Object, Message),
   42% where ActionType is before or after
   43:- dynamic aop:at/5.   44:- multifile aop:at/5.   45
   46% 
   47% Central mechanics of method dispatching
   48% 
   49
   50:- module_transparent to/2, to/3.   51
   52% When the right-hand side of a `to` expression is a list,
   53% then expand to execute Left to Element, where Element
   54% is each element in the list.
   55to(Left, [Right]) :-
   56  !,
   57  Left to Right.
   58
   59to(Left, [Right|More]) :-
   60  More \= [],
   61  !,
   62  Left to Right,
   63  Left to More.
   64
   65% Expand Left to have an additional parameter for obtaining
   66% a result, then use that as a target of :: to send the Right
   67% message
   68to(Left, Right) :-
   69  Left =.. [Functor | Args],
   70  append(Args, [Result], ExtendedArgs),
   71  ExtendedLeft =.. [Functor | ExtendedArgs],
   72  ExtendedLeft,
   73  Result::Right.
   74
   75% Useful for chained instances of to (3 or more).
   76% When called this way, the 3rd argument is the result
   77% for the right side, in preparation for chaining.
   78to(Left, Right, Result) :-
   79  Right =.. [Functor | Args],
   80  append(Args, [Result], ExtendedArgs),
   81  ExtendedRight =.. [Functor | ExtendedArgs],
   82  Left to ExtendedRight.
   83
   84% 
   85% Central mechanics of method dispatching
   86% 
   87
   88::(_Object, []).
   89
   90::(Object, [Message | Messages]) :- 
   91  Object :: Message,
   92  Object :: Messages.
   93
   94::(Object, Message) :- send_message(Object, Message).
   95
   96::(Object, Message, Extra) :- send_message(Object, Message, Extra).
   97
   98::(Object, Message, Extra1, Extra2) :- send_message(Object, Message, Extra1, Extra2).
   99
  100send_message(Object, Message) :-
  101  ( extended(_Aspect, Object, Message)
  102    -> (
  103      before(Object, Message),
  104      % run it
  105      aop:do(_, Object, Message),
  106      after(Object, Message)
  107      )  % run it
  108    ; aop:do(_, Object, Message)
  109    ).
  110
  111send_message(Object, Message, ExtraArg) :-
  112  Message =.. MessageList,
  113  append(MessageList,[ExtraArg], ExtendedMessageList),
  114  ExtendedMessage =.. ExtendedMessageList,
  115  send_message(Object, ExtendedMessage).
  116
  117send_message(Object, Message, ExtraArg1, ExtraArg2) :-
  118  Message =.. MessageList,
  119  append(MessageList,[ExtraArg1, ExtraArg2], ExtendedMessageList),
  120  ExtendedMessage =.. ExtendedMessageList,
  121  send_message(Object, ExtendedMessage).
  122
  123extended(Aspect, Object, Message) :-
  124  functor(Message,Name,Arity),
  125  aop:extension(Aspect, Object, Name/Arity),
  126  !.
  127
  128before(Object, Message) :-
  129  trigger_method_events(Object, before, Message),
  130  invoke_method_actions(Object, before, Message).
  131
  132find_method(Aspect, Object, Message, Module, ExtendedMessage) :-
  133  extend([Aspect, Object], Message, ExtendedMessage),
  134  functor(ExtendedMessage, Name, Arity),
  135  find_predicate(Aspect, Module, Name, Arity).
  136
  137:- table find_predicate/4.  138find_predicate(Aspect, Module, Name, Arity) :-
  139  current_enabled_aspect(Aspect, Module),
  140  % check its a viable predicate -- if not, will
  141  % likely backtrack into assuming a built-in predicate
  142  current_predicate(Module:Name/Arity).
  143
  144
  145after(Object, Message) :-
  146  trigger_method_events(Object, after, Message),
  147  invoke_method_actions(Object, after, Message).
  148
  149trigger_method_events(Object, EventType, Message) :-
  150  % TODO put this on a background worker pool, so that its all async
  151  % from each other and from actions
  152  findall( 
  153    [Aspect, Listener, Object, Message], 
  154    ( 
  155      current_enabled_aspect(Aspect),
  156      % aop:on(Aspect, Listener, EventType, Object, Message) 
  157      Event = aop:on(Aspect, Listener, EventType, Object, Message) ,
  158      clause(Event, _),
  159      post_aspect_event(Aspect, Event)
  160    ), 
  161    _
  162    ),
  163    !.
  164
  165invoke_method_actions(Object, EventType, Message) :- 
  166  findall( 
  167    [Aspect, Listener, Object, Message], 
  168    (
  169      current_enabled_aspect(Aspect),
  170      aop:at(Aspect, Listener, EventType, Object, Message)
  171    ), 
  172    _
  173    ),
  174    !.
  175
  176start_aspect_event_dispatcher(Aspect) :-
  177  aop:aspect_event_queue(Aspect, Queue, Thread),
  178  (aop:aspect_events_started(Aspect)
  179    -> true
  180    ; (
  181      message_queue_create(_Queue, [alias(Queue)]),
  182      thread_create(
  183        dispatch_aspect_events(Aspect, Queue), 
  184        _Id, 
  185        [alias(Thread), detatched(true)]
  186        ),
  187      assertz(aop:aspect_events_started(Aspect))        
  188      )
  189    ).  
  190
  191post_aspect_event(Aspect, Event) :-
  192  aop:aspect_event_queue(Aspect, Queue, _Thread),
  193  thread_send_message(Queue, Event),
  194  !.
  195
  196dispatch_aspect_events(Aspect, Queue) :-
  197  thread_get_message(Queue, Event),
  198  % only process events of this type
  199  ( Event = aop:on(Aspect, _Listener, _EventType, _Object, _Message)
  200    -> (
  201      % Only process events if aspect enabled
  202      current_enabled_aspect(Aspect)
  203        -> catch_with_backtrace(
  204          Event,
  205          Error,
  206          print_message(error, Error)
  207          )
  208        ; true
  209        )
  210    ; true
  211    ),
  212  dispatch_aspect_events(Aspect, Queue)