1/*****************************************************************************
    2 * This file is part of the Prolog Development Tool (PDT)
    3 * 
    4 * WWW: http://sewiki.iai.uni-bonn.de/research/pdt/start
    5 * Mail: pdt@lists.iai.uni-bonn.de
    6 * Copyright (C): 2004-2012, CS Dept. III, University of Bonn
    7 * 
    8 * All rights reserved. This program is  made available under the terms
    9 * of the Eclipse Public License v1.0 which accompanies this distribution,
   10 * and is available at http://www.eclipse.org/legal/epl-v10.html
   11 * 
   12 ****************************************************************************/
   13
   14
   15replaceForwCall(_call, _parent, _method, _origName, _execReturn,_forwMethod,_forwParams,_recvParam):-
   16    applyT(_call,_,_,_,_,_,_),
   17      createIdentRefParam(_recvParam,_callSelect, _forwReceiver),
   18      createVarDefIdents(_call, _forwParams, _argsInForw),
   19    action(replace(applyT(_call, _execReturn, _forwMethod, _forwReceiver,_origName, _argsInForw,_method))).
   20
   21replaceForwCall(_call, _parent, _method, _origName, _execReturn,_forwMethod,_forwParams,_recvParam):-
   22    newClassT(_call,_,_,Constructor,_,TypeExpr,Def,Enclosing),
   23    createVarDefIdents(_call, _forwParams, _argsInForw),
   24    action(replace(newClassT(_call, _execReturn, _forwMethod, Constructor,_argsInForw,TypeExpr,Def,Enclosing))).			    
   25
   26
   27createForwArgs(_call,_,_,_,_,_Args,_Args,_):-
   28    forwards(_call,_,_,_),
   29    !.
   30createForwArgs(_call,_enclMethod,_enclClass,_forwCall,_origReceiver,_Args,[_This|[Receiver|_Args]],DeclaringType):-
   31    create_this_or_null_if_static(_This,_forwCall, _enclMethod, _enclClass),
   32    ( 
   33      (_origReceiver = null,
   34   %createThisOrGetReceiver(OldParent, NewParent, Encl, OldReceiver, NewReceiver, DeclaringType)     
   35      createThisOrGetReceiver(_parent, _forwCall, _enclMethod,_origReceiver,Receiver,DeclaringType)
   36      
   37%       create_this_or_null_if_static(Receiver,_forwCall, _enclMethod, _enclClass)
   38      );
   39      _origReceiver = Receiver
   40    ).
   41    %createThisOrGetReceiver(_origReceiver, _forwCall,_Receiver).
   42
   43
   44getOrigParams(_call,_Params,_Params):-
   45    forwards(_call,_,_,_),
   46    !.
   47
   48getOrigParams(_,[_|[_|_ForwParams]],_ForwParams).
   49
   50
   51getOrigArgs(_call,_args,_OrigArgs) :-
   52    forwards(_call,_,_,_),
   53    !,
   54    _args = [_|[_|_OrigArgs]].
   55
   56getOrigArgs(_call,_Args,_Args).
   57/*
   58 * updateForwardsFact(+Call,+Kind,+ForwCall,+ForwMethod)
   59 */
   60updateForwardsFact(_call,_,_forwCall,_forwMethod):-
   61    forwards(_call,_lastForwMethod,_kind,_pc),
   62    !,
   63    delete(forwards(_call,_lastForwMethod,_kind,_pc)),
   64    add(forwards(_forwCall, _forwMethod, _kind, _pc)),
   65    add(forwarding(_forwMethod, _lastForwMethod,_pc)).
   66%    add(forwarding(_forwCall)).
   67
   68updateForwardsFact(_stmt,_kind, _forwCall,_forwMethod):-
   69    add(forwards(_forwCall, _forwMethod, _kind, _stmt)),
   70    add(forwarding(_forwMethod, _stmt,_stmt)).
   71%    add(forwarding(_forwCall)).
   72
   73/*
   74 * createForwardingMethod(Stat,Class,ForwMethod,ForwBody)
   75 *
   76 * Creates a forwarding method 
   77 *
   78 */
   79createForwardingMethod(_method, _class,_,_forwBody) :-
   80    methodT(_method,_class,_,_,_,_,_),
   81    !,
   82    createForwMethodExecution(_method, _forwBody,[]).
   83
   84createForwardingMethod(Stat,Class,ForwMethod,ForwBody) :-
   85    new_id(_execReturn),
   86    enclosing(Stat,EnclMethod),
   87    createForwBody(Stat, ForwMethod, ForwBody, ForwName, _params, Type, _execReturn),
   88    createReturnOrExec(ForwBody, ForwMethod, Type, Stat, _execReturn),
   89    add_to_class(Class, ForwMethod),
   90    add(methodT(ForwMethod, Class, ForwName, _params, Type, [], ForwBody)),
   91	share_static_modifier(EnclMethod,ForwMethod),
   92    add(modifierT(ForwMethod, 'private')),
   93    add(blockT(ForwBody, ForwMethod, ForwMethod, [_execReturn])).
   94
   95
   96
   97createAroundMethod(Stat, Class,ForwStats,ForwMethod,ForwBody) :-
   98%    new_ids([ForwMethod, ForwBody]),
   99    enclosing(Stat,EnclMethod),
  100    createAroundBody(Stat, ForwMethod, ForwBody, ForwName, _params, Type),
  101%    createReturnOrExec(ForwBody, ForwMethod, Type, Stat, _execReturn),
  102    add_to_class(Class, ForwMethod),
  103    add(methodT(ForwMethod, Class, ForwName, _params, Type, [], ForwBody)),
  104	share_static_modifier(EnclMethod,ForwMethod),
  105    add(modifierT(ForwMethod, 'private')),
  106    add(blockT(ForwBody, ForwMethod, ForwMethod, ForwStats)).
  107
  108
  109share_static_modifier(EnclMethod,ForwMethod):-
  110    modifierT(EnclMethod,'static'),
  111    !,
  112    add(modifierT(ForwMethod, 'static')).
  113share_static_modifier(_EnclMethod,_ForwMethod):-
  114    true.
  115
  116debugme(_id):-
  117    format('~ndebug: ~w',[_id]),
  118    flush_output.
  119
  120forwardingMethodName(_stat, _prefix, _origName, _ForwName) :-
  121    new_id(_aNumber),
  122    int2string(_aNumber, _aString),
  123    stringAppend(_origName,'$',_aString,_forwName),
  124    appendForwPrefix(_stat,_prefix, _forwName,_ForwName).
  125
  126appendForwPrefix(_stat,_, _forwName,_forwName):-
  127    forwards(_stat,_,_,_),
  128    !.
  129
  130appendForwPrefix(_stat,_prefix, _forwName,_ForwName) :-
  131    stringAppend(_prefix, _forwName, _ForwName).
  132%    stringAppend('forward$', _prefix, _forwName, _ForwName).
  133
  134    %    add(_Receiver, _apply, _encl, 'this', _enclClass).
  135
  136/*
  137 * prependBlockStatments(+Block, +Statements)
  138 *
  139 * prepends the id list Statements to block Block.
  140 */
  141
  142prependBlockStatments(_, []).
  143
  144prependBlockStatments(_block, _stmts) :-
  145    blockT(_block, _parent, _encl, _oldStmts),
  146    append(_stmts,_oldStmts,_newStmts),
  147    delete(blockT(_block, _parent, _encl, _oldStmts)),
  148    add(blockT(_block, _parent, _encl, _newStmts)).
  149
  150prependBlockStatment(_block, _pre) :-
  151    blockT(_block, _parent, _encl, _stats),
  152    prepend(_stats, _pre, _newStats),
  153%    rec_set_encl_method(_pre, _encl),
  154%    rec_set_parent(_pre, _block),
  155    delete(blockT(_block, _parent, _encl, _stats)),
  156    add(blockT(_block, _parent, _encl, _newStats)).
  157
  158
  159appendBlockStatment(_block, _post) :-
  160    blockT(_block, _parent, _encl, _stats),
  161    append(_stats, [_post], _newStats),
  162    rec_set_encl_method(_post, _encl),
  163    rec_set_parent(_post, _block),
  164    delete(blockT(_body, _p, _e, _stats)),
  165    add(blockT(_body, _p, _e, _newStats)).
  166
  167
  168/*
  169 * matchParams(ParametersOrArgs, PatternList)
  170 * 
  171 * matches a parameter/expression list with a pattern list or
  172 * with the types of another list of parameters/expressions.
  173 *
  174 * The PatternList elements of the following terms:
  175 *
  176 * id(FQN):     
  177 *            FQN is a full qualified name of a object or basic type.
  178 * list(PList):  
  179 *            PList is a list of parameters.
  180 *            If PList is not bound it will be bound to a list of parameters, 
  181 *            otherwise the types of the parameters list are compared, see tests for examples.
  182 *
  183 * TESTED?
  184 */
  185matchParams([], []):-!.
  186
  187matchParams([], [id([Term])]) :-
  188	var(Term).	
  189
  190
  191matchParams([], [Term]) :-
  192	var(Term).
  193
  194matchParams([VdHead | VdTail], [Term | PatTail]) :-
  195    nonvar(Term),
  196    Term = type(Type),
  197    getType_fq(VdHead,Type),
  198    matchParams(VdTail,  PatTail).
  199
  200
  201
  202matchParams([VdHead | VdTail], [Term | PatTail]) :-
  203    nonvar(Term),
  204    Term = params([Head|Tail]),
  205    (
  206      var(Head) ->
  207        Head = VdHead;
  208        (getType(Head,Type),getType(VdHead,Type))
  209    ),
  210    matchParams(VdTail, [params(Tail) | PatTail]).
  211
  212matchParams(VdHead, [Term | PatTail]) :-
  213    nonvar(Term),
  214    Term = params([]),
  215    matchParams(VdHead, PatTail).
  216
  217
  218
  219
  220matchParams([VdHead | VdTail], [List | PatTail]) :-
  221    nonvar(List),
  222    List = [_pattern , VdHead],
  223    !,
  224    matchParams([VdHead | VdTail], [_pattern | PatTail]).
  225
  226matchParams([VdHead | VdTail], [TypePattern | PatTail]) :-
  227    nonvar(TypePattern),
  228    TypePattern = typePattern(_pattern, _dim),
  229    getType(VdHead, type(_kind, _id,_dim)),
  230    getTypeName(type(_kind, _id,_dim), _name),
  231    matchPatterns(_name, _pattern),
  232    matchParams(VdTail, PatTail).
  233
  234matchParams([_VdHead | VdTail], [Term | PatTail]) :-
  235	var(Term),
  236    matchParams(VdTail,PatTail).
  237    
  238/*
  239 * matchLMVPattern(ParametersOrArgs, PatternList)
  240 * 
  241 * matches a PEF-list with a pattern list or
  242 * 
  243 * The PatternList elements of the following terms:
  244 *
  245 * id(FQN):     
  246 *            FQN is a full qualified name of a object or basic type.
  247 * list(PList):  
  248 *            PList is a list of parameters.
  249 *            If PList is not bound it will be bound to a list of parameters, 
  250 *            otherwise the types of the parameters list are compared, see tests for examples.
  251 *
  252 * TESTED
  253 */
  254
  255
  256
  257matchLMVPattern([], []):-!.
  258
  259matchLMVPattern(_Head, [Term | _Tail]) :-
  260    var(Term),
  261    throw('Elements of the right list must be id/1 or list terms/1.').
  262
  263matchLMVPattern([VdHead | VdTail], [Term | PatTail]) :-
  264    Term = id(VdHead),
  265    matchLMVPattern(VdTail,  PatTail).
  266
  267matchLMVPattern([Head | VdTail], [Term | PatTail]) :-
  268    Term = list([Head|Tail]),
  269    matchLMVPattern(VdTail, [list(Tail) | PatTail]).
  270
  271matchLMVPattern(VdHead, [Term | PatTail]) :-
  272    Term = list([]),
  273    matchLMVPattern(VdHead, PatTail).
  274
  275	
  276    
  277matchParamTypeNameList([],[]).
  278matchParamTypeNameList([Head | Tail],[FNHead|FNTail]):-
  279    paramT(Head,_,Type,_),
  280    getTypeName(Type,FNHead),
  281	matchParamTypeNameList(Tail,FNTail).
  282	
  283matchPatterns(_, []).
  284matchPatterns(_name, (_pat1;_pat2)) :-
  285    !,(
  286    matchPatterns(_name, _pat1);
  287    matchPatterns(_name, _pat2)
  288    ).
  289
  290matchPatterns(_name, (_pat1,_pat2)) :-
  291    !,
  292    matchPatterns(_name, _pat1),
  293    matchPatterns(_name, _pat2).
  294
  295matchPatterns(_name, _pat) :-
  296    pattern(_pat, _, _name).
  297
  298
  299weave(before, _pc,_exec):-
  300    before(_pc, _exec).
  301
  302weave(after, _pc,_exec):-
  303    after(_pc, _exec).
  304
  305
  306
  307
  308
  309
  310callToAdviceMethod(_pc, _adviceMeth, _adviceArgs,_exec,_forwMethod,_forwBody) :-
  311    (replaceStatementWithForwarding(_pc,_forwMethod,_forwBody); true),
  312    methodT(_adviceMeth,Aspect,_adviceMethName, _,_,_,_),
  313    fieldT(_adviceInstanceVar,Aspect,_,'aspectInstance',_),
  314    classT(Aspect,_,AdviceName,_),
  315    new_ids([_exec, _apply, _selectAdviceMethod,_selectInstField, _ident]),
  316    enclMethod(_pc,_enclMethod),
  317    createIdentsReferencingAdviceParams(_pc, _enclMethod,_adviceArgs, _adviceCallArgs),
  318    add(execT(_exec, 0,0, _apply)),
  319    add(applyT(_apply, _exec,0, _selectInstField,_adviceMethName, _adviceCallArgs,_adviceMeth)),
  320    add(getFieldT(_selectInstField, _apply, 0, _ident, 'aspectInstance',_adviceInstanceVar)),
  321    add(identT(_ident, _selectInstField, 0, AdviceName, Aspect)).
  322
  323
  324createIdentsReferencingAdviceParams(_,_,[],[]).
  325
  326createIdentsReferencingAdviceParams(_call,_enclMethod,[_adviceArg|_adviceArgs],[_Ident|_Idents]):-
  327    new_id(_Ident),
  328    getForwParam(_call, _adviceArg, _param,_name),
  329    add(identT(_Ident, _call, _enclMethod, _name, _param)),
  330    createIdentsReferencingAdviceParams(_call,_enclMethod,_adviceArgs,_Idents).
  331    
  332/*
  333 * boxing_class(+BasicType, ?BoxingClass)
  334 *
  335 * Binds BoxingClass to the corresponding
  336 * boxing class of the basic type BasicType.
  337 */
  338
  339boxing_class(int, _class):-
  340    packageT(_pckg, 'java.lang'),
  341    classT(_class,_pckg,'Integer',_).
  342    
  343boxing_class(double, _class):-
  344    packageT(_pckg, 'java.lang'),
  345    classT(_class,_pckg,'Double',_).
  346boxing_class(float, _class):-
  347    packageT(_pckg, 'java.lang'),
  348    classT(_class,_pckg,'Float',_).
  349boxing_class(char, _class):-
  350    packageT(_pckg, 'java.lang'),
  351    classT(_class,_pckg,'Character',_).
  352boxing_class(byte, _class):-
  353    packageT(_pckg, 'java.lang'),
  354    classT(_class,_pckg,'Byte',_).
  355boxing_class(short, _class):-
  356    packageT(_pckg, 'java.lang'),
  357    classT(_class,_pckg,'Short',_).
  358boxing_class(long, _class):-
  359    packageT(_pckg, 'java.lang'),
  360    classT(_class,_pckg,'Long',_).
  361boxing_class(boolean, _class):-
  362    packageT(_pckg, 'java.lang'),
  363    classT(_class,_pckg,'Boolean',_).
  364boxing_class(Kind, _class):-
  365	sformat(Msg, 'ERROR: Could not find boxing class for ~w~n', [Kind]),
  366	throw(Msg).
  367
  368
  369add_proceed_call_idents(_,_,_,_,[],[],_,[]).
  370add_proceed_call_idents(_pc,_call,_enclMethod, _adviceArgs, [_param|_params], [_forwParam|_forwParams], _proceedArgs,[_proceedArg|_Args]):-
  371    getCompareElement(_pc,_param,_forwParam, _compare),
  372    findProceedArg(_pc,_compare,_adviceArgs, _proceedArgs,_proceedArg),
  373%    getForwParam(_pc, _adviceArg, _compare,_),
  374    !,
  375    add_proceed_call_idents(_pc,_call,_enclMethod, _adviceArgs, _params,_forwParams, _proceedArgs,_Args).
  376
  377add_proceed_call_idents(_pc,_call,_enclMethod, _adviceArgs, [_param|_params], [_forwParam|_forwParams], _proceedArgs,[_Arg|_Args]):-
  378    new_id(_Arg),
  379    !,
  380    getCompareElement(_pc,_param,_forwParam, _ref),
  381    getRefIdentName(_ref,_name),
  382    add(identT(_Arg, _call, _enclMethod, _name, _ref)),
  383    add_proceed_call_idents(_pc,_call,_enclMethod, _adviceArgs, _params,_forwParams, _proceedArgs,_Args).
  384
  385
  386getRefIdentName(_ref,_name):-
  387    localT(_ref, _, _, _, _name, _).
  388getRefIdentName(_ref,_name):-
  389    paramT(_ref, _, _, _name).
  390getRefIdentName(_ref,'this'):-
  391    classT(_ref, _, _, _).
  392
  393
  394getCompareElement(_method,_param, _, _class):-
  395     method(_method, _class, _, _, _, _, _),
  396     forwards(_, _forwMethod, _, _method),
  397     method(_forwMethod, _, _, _params, _, _, _),
  398    (
  399        _params = [_param|_];
  400        _params = [_|[_param|_]]
  401    ),
  402    !.
  403
  404getCompareElement(_method,_, _forwParam,_forwParam):-
  405    method(_method, _, _, _, _, _, _),
  406    !.
  407
  408getCompareElement(_pc,_param,_, _param).
  409
  410
  411findProceedArg(_pc,_compare,[_adviceArg|_adviceArgs], [_proceedArg|_proceedArgs],_proceedArg) :-
  412    getForwParam(_pc, _adviceArg, _compare,_),
  413    !.
  414
  415findProceedArg(_pc,_compare,[_|_adviceArgs], [_|_proceedArgs],_proceedArg) :-
  416    findProceedArg(_pc,_compare,_adviceArgs, _proceedArgs,_proceedArg).
  417
  418
  419createForwMethParams(_enclClass,_forwMethod,_DeclaringType,_origReceiver, _args,
  420                     [_InstanceVarDef|[_ReceiverVarDef|_Params]]):-
  421    validThisType(_enclClass,ValidEnclClass),
  422    createThisInstanceParam(ValidEnclClass, _forwMethod, _InstanceVarDef),
  423    (_origReceiver == null ->
  424	  outerOrEnclClass(_enclClass,ValidTargetClass);
  425	  getType(_origReceiver,type(class, ValidTargetClass,_))
  426	),
  427    createTargetInstanceParam(ValidTargetClass,_forwMethod, _ReceiverVarDef),
  428%    createTargetInstanceParam(_enclClass, _forwMethod, _origReceiver, _ReceiverVarDef),
  429    createForwParams(_forwMethod, _args, _Params).
  430
  431validThisType(EnclClass,Type):-
  432    classT(EnclClass, Parent,_,_),
  433    newClassT(Parent,_,_,_,_,TypeExpr,_,_),
  434    getType(TypeExpr, type(class,Type,0)),
  435%    extendsT(EnclClass,Super),
  436%    enclClass(Parent,EnclOuterClass),
  437    !.
  438validThisType(EnclClass,EnclClass).
  439
  440/*
  441 * outerOrEnclClass(+EnclClass,OuterClass)
  442 *
  443 * bind outer class if available, otherwise
  444 * the second arg is bound to the first arg
  445 */
  446 
  447outerOrEnclClass(EnclClass,OuterClass):-
  448    classT(EnclClass,NewClass,_,_),
  449    newClassT(NewClass,_,NewClassEncl,_,_,_,_,_),
  450    enclClass(NewClassEncl,OuterClass),
  451    !.
  452outerOrEnclClass(EnclClass,EnclClass).
  453
  454
  455
  456createThisInstanceParam(_enclClass,_forwMethod,_InstanceVarDef):-
  457    new_id(_InstanceVarDef),
  458    add(java_fq(paramT(_InstanceVarDef, _forwMethod, _enclClass, '_this'))).
  459
  460
  461createTargetInstanceParam(DeclaringType, _forwMethod, _ReceiverVarDef):-
  462    new_id(_ReceiverVarDef),
  463    add(java_fq(paramT(_ReceiverVarDef,  _forwMethod, DeclaringType, '_target'))),
  464    !.
  465
  466/*
  467createTargetInstanceParam(_enclClass, _forwMethod, 'null',_ReceiverVarDef):-
  468    new_id(_ReceiverVarDef),
  469    add(paramT(_ReceiverVarDef,  _forwMethod, type(class,_enclClass,0), '_target')),
  470    !.
  471createTargetInstanceParam(_enclClass, _forwMethod, _origReceiver,_ReceiverVarDef):-
  472    new_id(_ReceiverVarDef),
  473    getType(_origReceiver, _type),
  474    add(paramT(_ReceiverVarDef,  _forwMethod, _type, '_target')).
  475*/
  476
  477createForwParams(_forwMethod, _args, _Params) :-
  478    createForwParams(_forwMethod, _args, _Params,0).
  479
  480createForwParams(_, [],[],_).
  481createForwParams(_forwMethod, [_arg|_args], [_Param | _Params],_counter) :-
  482    createForwParam(_forwMethod,_arg, _Param,_counter),
  483    plus(_counter, 1, _next),
  484    createForwParams(_forwMethod, _args, _Params,_next).
  485
  486createForwParam(_forwMethod, _arg, _Param,_counter) :-
  487    getType(_arg,type(basic,null,0)),
  488    !,
  489    fullQualifiedName(JLO, 'java.lang.Object'),
  490    new_id(_Param),
  491    append_num('x', _counter, _name),
  492    add(paramT(_Param, _forwMethod,type(class,JLO,0), _name)),
  493    !.
  494
  495createForwParam(_forwMethod, _arg, _Param,_counter) :-
  496    getType(_arg,_type),
  497    new_id(_Param),
  498    append_num('x', _counter, _name),
  499    add(paramT(_Param, _forwMethod, _type, _name)),
  500    !.
  501
  502% DEBUG commented
  503
  504getForwParam(_method, _adviceArg, _IdentRef,_IdentName):-
  505    % Ausnahme fuer den execution pointcut
  506    methodT(_method, _class, _, _params, _, _, _),
  507    !,
  508    forwards(_, _forwMethod, _, _method),
  509    methodT(_forwMethod, _, _, [_|[_|_origParams]], _, _, _),
  510    findParamExecution(_adviceArg,_class,_params,_origParams,_IdentName,_IdentRef).
  511
  512
  513getForwParam(Pc, _adviceArg, _forwParam,_forwParamName):-
  514    forwards(_forwCall, _forwMethod, _, Pc),
  515    methodT(_forwMethod, _, _, [_thisParam|[_targetParam|_params]], _, _, _),
  516    applyT(_forwCall, _,_, _, _,[_|[_|_args]],_),
  517    getRealEncl(Pc,_,RealEncl),
  518    methodT(RealEncl,_,_,EnclParams,_,_,_),
  519    length(EnclParams,NumEnclParams),
  520    remove_tail(_args,NumEnclParams,ArgListWithoutEnclParams),
  521    concat_lists([ArgListWithoutEnclParams,EnclParams],SearchList),
  522    findParam(_adviceArg,_thisParam,_targetParam,_params,SearchList,_forwParam),
  523    paramT(_forwParam, _,_type, _forwParamName).
  524
  525findParamExecution('_this',_class, _,_,'this',_class):- !.
  526findParamExecution('_target',_class,_,_,'this',_class):- !.
  527findParamExecution(_param,_class,_params,_origParams, _forwParamName,_Param):-
  528    _param \= '_this',
  529    _param \= '_target',
  530    findParam(_param,_,_,_params,_origParams,_Param),
  531    paramT(_Param, _, _type, _forwParamName).
  532
  533
  534findParam('_this',_ThisParam,_,_,_,_ThisParam):-
  535    !.
  536findParam('_target',_,_TargetParam,_,_,_TargetParam):-
  537    !.
  538findParam(_arg,_,_,[_Param|_params],[_arg1|_args],_Param):-
  539    _arg \= '_this',
  540    _arg \= '_target',
  541    _arg == _arg1,
  542    !.
  543findParam(_arg,_thisParam,_targetParam,[_param|_params],[_a|_args],_ForwParam):-
  544    !,
  545    findParam(_arg,_thisParam,_targetParam,_params,_args,_ForwParam).
  546
  547/*
  548  pc_visible(?Encl,?Class, ?Package)
  549
  550  Is true when a join point (pointcut) is visible
  551  */
  552
  553pc_visible(_encl,_,_):-
  554    enclClass(_encl,_enclClass),
  555    modifierT(_enclClass,'aspect'),
  556    !,
  557    fail.
  558
  559pc_visible(_encl,_,_):-
  560    not(visibility(_encl,_,_)),
  561    !.
  562
  563pc_visible(_encl,_,_):-
  564    visibility(_encl,'hidden',_),
  565    !,
  566    fail.
  567
  568pc_visible(_encl,_,_pckg):-
  569    visibility(_encl,'package',_pckg),
  570    !.
  571    
  572pc_visible(_encl,_currentAspectClass,_):-
  573    visibility(_encl,'protected',_aspectClass),
  574    !,
  575    subtype(_currentAspectClass,_aspectClass).
  576
  577pc_visible(_encl,_aspectClass,_):-
  578    visibility(_encl,'private',_aspectClass),
  579    !.
  580
  581
  582set_visibility(_pc, _type, _ref):-
  583    forwards(_,_forwMethod,_,_pc),
  584    !,
  585    add(visibility(_forwMethod, _type, _ref)).
  586
  587set_visibility(_var, _type, _ref):-
  588    add(visibility(_var, _type, _ref)).
  589
  590
  591%    current_aspect(_aspectClass,_).
  592
  593%TODO: erzeuge Argument-Listen: TESTEN
  594
  595create_ref_idents(_pc, _apply, _encl, [], []).
  596
  597create_ref_idents(_pc, _apply, _encl, [_param_id|_rest], [_ident_id | _rest_ids]) :-
  598    paramT(_param_id,_,_, _name),
  599    !,
  600    add(identT(_ident_id, _apply, _encl, _name, _param_id)),
  601    create_ref_idents(_pc, _apply, _encl, _rest, _restids).
  602
  603% leere Parameter oder Argumentliste
  604create_ref_idents(_pc, _apply, _encl, [[]|_rest], [[] | _rest_ids]) :-
  605    !,
  606    create_ref_idents(_pc, _apply, _encl, _rest, _restids).
  607
  608create_ref_idents(_pc, _apply, _encl, [_fn |_rest], [GetField | _rest_ids]) :-
  609    not(tree(_fn,_,_)),
  610    encl_class(_encl,_encl_class),
  611    resolve_field(_fn,_encl_class,_field),
  612    add(getFieldT(GetField, _apply, _encl, 'null',_fn, _field)),
  613    create_ref_idents(_pc, _apply, _encl, _rest, _restids).
  614
  615create_ref_idents(_pc, _apply, _encl, [_arg_id|_rest], [GetField | _rest_ids]) :-
  616    add_advice_param_ref(_pc, _arg_id,GetField,_apply, _encl),
  617    create_ref_idents(_pc, _apply, _encl, _rest, _restids).
  618
  619create_ref_idents(_pc, _apply, _encl, [[_h |_t] | _rest], [ _param_ids | _rest_ids]) :-
  620    !,
  621    create_ref_idents(_pc, _apply, _encl, [_h|_t], _param_ids),
  622    create_ref_idents(_pc, _apply, _encl, _rest, _restids).
  623
  624
  625
  626% leere Parameter oder Argumentliste
  627extract_types(_encl_class, [], []).
  628extract_types(_encl_class, [[]|_rest], [[] | _Rest]) :-
  629    !,
  630    create_ref_idents(_encl, _rest, _Rest).
  631
  632extract_types(_encl, [_fn|_rest], [_Type | _Rest]) :-
  633    not(tree(_fn,_,_)),
  634    !,
  635    encl_class(_encl,_encl_class),
  636    resolve_field(_fn,_encl_class,_field),
  637    fieldT(_field,_,_Type, _,_),
  638    create_ref_idents(_encl, _rest, _Rest).
  639
  640extract_types(_encl, [_arg|_rest], [_Type | _Rest]) :-
  641    get_type(_arg,_Type),
  642    create_ref_idents(_encl, _rest, _Rest).
  643
  644extract_types(_encl, [[_h |_t] | _rest], _Rest) :-
  645
  646    !,
  647    create_ref_idents(_encl, [_h | _t], _rest_1),
  648    create_ref_idents(_encl, _rest, _rest2),
  649    append(_rest_1,_rest_2, _Rest).
  650    
  651
  652constructor(_constructor,_class,_params):-
  653    methodT(_constructor,_class,'<init>', _paramsConstructor,_,[],_),
  654    matchParams(_params, _paramsConstructor).
  655
  656
  657lookupForwParameter(Arg,_,[],[],_, _):-
  658    format('forwarding parameter lookup failed: ~w~n',[Arg]).
  659lookupForwParameter(_,FnArg,[FnArg|_],[Param|_],Param, Name):-
  660    paramT(Param,_,_,Name).
  661lookupForwParameter(ForwMethod,FnArg,[_|PcArgs],[_|ArgParams],Param, Name):-
  662    lookupForwParameter(ForwMethod,FnArg,PcArgs,ArgParams,Param, Name).
  663   
  664    
  665copy_method_body(Method,BodyToCopy,Body):-
  666    cloneTree(BodyToCopy, Method, Method, Body).
  667
  668
  669/*
  670 * bindIdIfNeeded(ID) 
  671 *
  672 * Binds ID with new_id/1 if ID is a variable.
  673 */
  674bindIdIfNeeded(ID) :-
  675    var(ID),
  676    !,
  677    new_id(ID).
  678bindIdIfNeeded(_ID).
  679
  680/*
  681 * apply_aj_cts.
  682 * 
  683 * debugging predicate
  684 * applies all cts in the laj_ct_list 
  685 * fact in the given order.
  686 */
  687apply_aj_cts :-
  688    rollback,
  689    apply_ct(change_aspect_class_member_visibility),
  690    laj_ct_list(A),
  691    apply_ctlist(A)
  692    %apply_ct(resolve_no_call_invocations)
  693    .
  694    
  695getReceiverTypeOrEnclosingIfInAnonymousClass_fq(ID,RecieverType_fq):-
  696    java_fq(methodT(ID,RecieverType_fq,_,_,_,_,_)).
  697
  698
  699%--ma statements 
  700getReceiverTypeOrEnclosingIfInAnonymousClass_fq(ID,RecieverType_fq):-
  701    statement(ID),
  702    enclClass_fq(ID,RecieverType_fq).
  703   
  704    
  705
  706getReceiverTypeOrEnclosingIfInAnonymousClass_fq(ID,RecieverType_fq):-
  707    getReceiver(ID, Rec),
  708    (
  709    Rec = 'null' ->
  710       getNonAnonymousEnclosingClass_fq(ID,RecieverType_fq);
  711       getType_fq(Rec,RecieverType_fq)
  712    )    
  713   	.
  714   	
  715% getReceiverTypeOrEnclosingIfInAnonymousClass_fq(ID,RecieverType_fq):-
  716%    applyT(ID, _parent, _encl, _Receiver, 'super', _args,_method),
  717%
  718%    (
  719%    Rec = 'null' ->
  720%       getNonAnonymousEnclosingClass_fq(ID,RecieverType_fq);
  721%       getType_fq(Rec,RecieverType_fq)
  722%    )    
  723%   	.
  724      
  725getNonAnonymousEnclosingClass_fq(Id,Class_fq):- 
  726    enclClass(Id,Encl),
  727	(
  728		anonymousClass(Encl) ->
  729		(
  730			classT(Encl,Parent,_,_),
  731			enclClass(Parent,ParentOfParent),
  732			getNonAnonymousEnclosingClass_fq(ParentOfParent,Class_fq)
  733		);
  734		fullQualifiedName(Encl,Class_fq)
  735	)
  736	.
  737	
  738
  739/*
  740 * getReturnType(+ID, -TypeString)
  741 *
  742 * Returns the return type
  743 *
  744 */     
  745    
  746getReturnType(ID,Type):-
  747    getType_fq(ID,Type).
  748
  749    %mappeltauer: why did i use this definition before?
  750	% enclClass(ID,Class),
  751	% fullQualifiedName(Class,Type).   
  752      
  753anonymousClass(ID):-
  754	classT(ID,Parent,_,_),     
  755  	newClassT(Parent,_,_,_,_,_,_,_).
  756  	
  757
  758
  759
  760/*
  761 * local_vars_of_jp_rek(+[IDs],-[LocalVars])
  762 *
  763 * collects all local variables of a joinpoint, which could
  764 * be a whole block since LAJ2, in a list
  765 * see LAJ-87
  766 */          	
  767local_vars_of_jp(Jp,Vars):-
  768 methodT(Jp,_,_,Args,_,_,_),
  769 local_defs_of_jp([Jp],Blacklist),
  770 %local_vars_of_jp([Jp],LocalVars,Blacklist),
  771 local_vars_of_jp(Args,Vars,[]).
  772 %concat_lists([LocalVars,LocalVars2],Vars).
  773
  774local_vars_of_jp(Jp,LocalVars):-
  775 local_defs_of_jp([Jp],Blacklist),
  776 local_vars_of_jp([Jp],LocalVars,Blacklist).
  777
  778
  779 
  780local_vars_of_jp([],[],Blacklist):-!.
  781local_vars_of_jp([ID|IDs],LocalVars,Blacklist) :-
  782    local_var(ID,Ref),
  783    not(memberchk(Ref,Blacklist)),
  784        
  785    tree_name(ID,Name),
  786    local_vars_of_jp(IDs,List,Blacklist),
  787    !,
  788    concat_lists([lvar(Ref,Name)|List],LocalVarsTmp),
  789    list_to_set_save(LocalVarsTmp,LocalVars)
  790    .    
  791
  792local_vars_of_jp([ID|IDs],LocalVars,Blacklist) :-
  793    local_var(ID,Ref),
  794    memberchk(Ref,Blacklist),        
  795    local_vars_of_jp(IDs,LocalVarsTmp,Blacklist),
  796    !,
  797    list_to_set_save(LocalVarsTmp,LocalVars)
  798    .    
  799    
  800    
  801    
  802local_vars_of_jp([H|T],List,Blacklist) :-
  803    not( local_var(H,_)),
  804    sub_trees(H,Subtrees),
  805    concat_lists([T|Subtrees],VarList),
  806    local_vars_of_jp(VarList,List,Blacklist)
  807    .
  808
  809local_defs_of_jp([],[]).
  810local_defs_of_jp([Id|Ids],List) :-
  811    localT(Id,_,_,_,_,_),
  812    local_defs_of_jp(Ids, NewList),    
  813    !,
  814    concat_lists([Id,NewList],List)
  815   
  816    .
  817
  818local_defs_of_jp([H|T],List) :-
  819    sub_trees(H,Subtrees),
  820    concat_lists([T,Subtrees],VarList),
  821    local_defs_of_jp(VarList,List)
  822    .
  823
  824lvar_ids([],[]).
  825lvar_ids([Lvar|Lvars],Ids) :-
  826    Lvar = lvar(Id,_),
  827    lvar_ids(Lvars,OtherIds),    
  828    concat_lists([Id,OtherIds],Ids)   
  829    .
  830
  831%----------
  832% The following predecates sould be better placed into JTransformer or st.java
  833% since they are very general queries
  834
  835    
  836local_var(ID,Ref):-
  837    identT(ID,_,_,_,Ref),
  838    localT(Ref,_,_,_,_,_).
  839  
  840
  841local_var(ID,Ref):-
  842    identT(ID,_,_,_,Ref),
  843    paramT(Ref,_,_,_).
  844 
  845
  846local_var(Ref,Ref):-    
  847    paramT(Ref,_,_,_).
  848 
  849
  850   		
  851/*
  852 * tree_names(+[IDS],-[Names])
  853 *
  854 * returns the corresponding string values of the tree elements
  855 */
  856 
  857tree_names([],[]).
  858    
  859tree_names([Arg|Args],Names):-
  860    tree_name(Arg,Name),
  861    tree_names(Args,NewNames),
  862    concat_lists([Name,NewNames],Names).   
  863
  864/*
  865 * tree_name(+ID,-Name)
  866 *
  867 * returns the corresponding string value of a tree element
  868 */
  869  
  870tree_name(Arg,Name):-
  871    paramT(Arg,_,_,Name).
  872      	
  873tree_name(ID,Name):-
  874    identT(ID,_,_,_,Ref),
  875    localT(Ref,_,_,_,Name,_).  
  876
  877tree_name(ID,Name):-
  878    localT(ID,_,_,_,Name,_).  
  879
  880tree_name(ID,Name):-
  881    identT(ID,_,_,_,Ref),
  882    paramT(Ref,_,_,Name).  	
  883  
  884tree_name(ID,_):-    
  885    treeSignature(ID,Signature),
  886    stringAppend('cannot assign a string to id: ',Signature,Message),
  887    throw(Message).
  888 
  889
  890
  891block_stmt(Id):-  blockT(Id,_,_,_). 
  892block_stmt(Id):-  forLoopT(Id,_,_,_,_,_,_).
  893block_stmt(Id):-  doLoopT(Id,_,_,_,_).
  894block_stmt(Id):-  whileLoopT(Id,_,_,_,_).
  895block_stmt(Id):-  ifT(Id,_,_,_,_,_).
  896block_stmt(Id):-  switchT(Id,_,_,_,_).
  897block_stmt(Id):-  tryT(Id,_,_,_,_,_).
  898block_stmt(Id):-  catchT(Id,_,_,_,_).
  899 
  900 
  901 
  902
  903 
  904 
  905 
  906 
  907 
  908 
  909 
  910 
  911    
  912/*
  913 * advice(ID, Name, [Arg,...])
  914 */
  915 
  916/*
  917 * created_by_advice(AdviceId, ForwId)
  918 */ 
  919
  920 /* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++not used anymore*/
  921 
  922/*
  923 * add_proceed_call(+JoinPoint,+Id,+Parent,+EnclMethod,+AdviceArgs,+ProceedArgs)
  924 *
  925 * ACTION
  926 *
  927 * inserts a proceed call with the id "Id" to the last forwarding method
  928 * created for "JoinPoint".
  929 *
  930 */
  931/*add_proceed_call(_method,_call, _parent, _enclMethod,_adviceArgs,_proceedArgs):-
  932    method(_method, _, _, _forwParams, _, _, _),
  933    !,
  934    forwards(_method,_methodToCall,_,_),
  935    method(_methodToCall, _, Name, [_this|[_target|_params]], _, _, _),
  936    add_proceed_call_idents(_method,_call,_enclMethod,_adviceArgs,  [_this|[_target|_params]],  [_this|[_target|_forwParams]],_proceedArgs,_args),
  937    add(applyT(_call, _parent,_enclMethod, _expr, Name,_args,_methodToCall)),
  938    add(forwarding(_call)).
  939
  940add_proceed_call(_pc,_call, _parent, _enclMethod,_adviceArgs,_proceedArgs):-
  941    forwarding(_enclMethod,_methodToCall,_),
  942    method(_enclMethod, _, _, _params, _, _, _),
  943    method(_methodToCall, _, _name, _, _, _, _),
  944    add_proceed_call_idents(_pc,_call,_enclMethod,_adviceArgs, _params, _params,_proceedArgs,_args),
  945    add(applyT(_call, _parent,_enclMethod, 'null',_name, _args, _methodToCall)),
  946    add(forwarding(_call)).
  947    
  948    
  949    */
  950 
  951/*around(Method,AroundStmts,_,ForwBody) :-
  952% special case: execution pointcut
  953    methodT(Method,_,_,_,_,_,_),
  954    createForwMethodExecution(Method, ForwBody, AroundStmts).
  955
  956around(_stat,_aroundStmts,_forwMethod,_forwBody) :-
  957    (
  958        (
  959            not(forwards(_,_,_,_stat)),
  960            replaceStatementWithForwarding(_stat)
  961        );
  962        true
  963    ),
  964    getRealStat(_stat,_realStat),
  965    enclClass(_realStat, _enclClass),
  966    createAroundMethod(_realStat, _enclClass, _aroundStmts,_forwMethod,_forwBody).
  967  */ 
  968  /*
  969 * around(Joinpoint,Statements,ForwardingMethod,ForwardingBody)
  970 *
  971 * If this is the first advice for Joinpoint,
  972 * the Joinpoint is moved to a forwarding method.
  973 *
  974 * The following is done in both cases:
  975 * A new forwarding method is created and the list Statements
  976 * is added to the body of the method.
  977 *
  978 * ForwardingMethod and ForwardingBody were bound 
  979 * in ct the condition part by the predicate bindForwMethod/3.
  980 */
  981
  982
  983
  984%around(JP,Statements,ForwMethod, ForwBody) :-
  985%   createAdviceMethod(JP, Statements, ForwMethod, ForwBody),
  986%  add(aopT(JP,'around', ForwMethod)).
  987    
  988   
  989/*
  990 *  before(Joinpoint, Statements, ForwardingMethod, ForwardingBody)
  991 *
  992 * ACTION
  993 *
  994 * If this is the first advice for Joinpoint,
  995 * the Joinpoint is moved to a forwarding method.
  996 *
  997 * The following is done in both cases:
  998 * A new forwarding method to the last created forwarding 
  999 * method (lets call it "forw_last") is created.
 1000 * Before the call to forw_last the 
 1001 * the list "Statements" is inserted into the method body.
 1002 *
 1003 * ForwardingMethod and ForwardingBody were bound 
 1004 * in the ct condition part by the predicate bindForwMethod/3.
 1005 */
 1006    
 1007/*before(JP, Statements,ForwMethod,ForwBody) :-
 1008    (replaceStatementWithForwarding(JP,ForwMethod,ForwBody);true),
 1009    prependBlockStatments(ForwBody, Statements).
 1010*/
 1011%before(JP, Statements,ForwMethod,ForwBody) :-    
 1012%  createAdviceMethod(JP, Statements,ForwMethod,ForwBody),
 1013%  add(aopT(JP,'before',ForwMethod)).
 1014
 1015
 1016
 1017
 1018/*
 1019 *  after(Joinpoint, Statements, ForwardingMethod, ForwardingBody)
 1020 *
 1021 * ACTION
 1022 *
 1023 * Documentation see before/4, except the statements
 1024 * are inserted after the call to forw_last.
 1025 * Precisely: A try finally block is inserted around
 1026 * the forw_last call and the "Statements" are inserted into the
 1027 * finally block.
 1028 */
 1029/*
 1030after(_stat, _insertList,_forwMethod,_finallyBlock) :-
 1031    new_id(_forwBody),
 1032    (replaceStatementWithForwarding(_stat,_forwMethod,_forwBody);true),
 1033    addTryFinallyBlockStmts(_forwMethod, _finallyBlock, _insertList).
 1034*/    
 1035    
 1036%after(JP,Statements,ForwMethod,ForwBody) :-
 1037%  createAdviceMethod(JP, Statements,ForwMethod,ForwBody),
 1038%  add(aopT(JP,'after',ForwMethod)).