1%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    2% FILE    : Interpreters/transfinal-bdi.pl
    3%
    4%       IndiGolog TRANS & FINAL Implementation for BDI constructs.
    5%
    6%  AUTHOR : Yves Lesperance (July 2010) 
    7%  EMAIL  : 
    8%  WWW    : www.cs.toronto.edu/cogrobo
    9%  TYPE   : system independent code
   10%  TESTED : SWI Prolog 5.0.10 http://www.swi-prolog.org
   11%
   12%           For more information on Golog and some of its variants, see:
   13%               http://www.cs.toronto.edu/~cogrobo/
   14%
   15%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   16%
   17%  This file provides:
   18%
   19% -- trans(P,H,P2,H2)    : configuration (P,H) can perform a single step
   20%                          to configuration (P2,H2)
   21% -- final(P,H)          : configuration (P,H) is terminating
   22%
   23%  The following special features are also provided:
   24% 
   25%
   26%
   27%  The following is required for this file:
   28%
   29% FROM SYSTEM CODE DEPENDING ON WHERE IT IS USED
   30% -- report_message(T, M) : report message M of type T
   31%
   32% FROM TEMPORAL PROJECTOR:
   33% -- isTrue(+C, +H) 
   34%           Conditio C is true at history H
   35% -- calc_arg(+A, -A2, +H) 
   36%           calculate the arguments of action A at history H
   37% -- domain(-V, +D)       
   38% -- rdomain(-V, +D)       
   39%           object V is an element of domain D (random)
   40% -- getdomain(+D, -L) 
   41%           L is the list of elements in domain D
   42% -- sensed(+A, ?V, ?H) 
   43%           action A got sensing result V w.r.t. history H
   44%
   45%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   46
   47
   48trans(achieve(Goal),H,E1,H1) :- 
   49	rule(Goal,Guard,Body), trans(if(Guard,Body,?(false)), H, E1, H1).
   50
   51final(achieve(Goal),H) :- 
   52	rule(Goal,Guard,Body), final(if(Guard,Body,?(false)), H).
   53
   54	
   55%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   56% EOF: Interpreters/transfinal-bdi.pl
   57%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%