2/***************************************************************************************************
    3 This program compiles an event description into a more efficient representation.
    4 It also compiles some types of declaration into a format that allows for more efficient reasoning.
    5 Input: 
    6 (a) Event Calculus axioms.
    7 (b) Declarations.
    8
    9 Event processing should be performed on the event description 
   10 produced by this compiler, along with the declarations.
   11 ***************************************************************************************************/
   12
   13:- dynamic initially/1, initiatedAt/2, initiatedAt/4, terminatedAt/2, terminatedAt/4, initiates/3, terminates/3, happensAt/2, holdsFor/2, holdsAt/2, grounding/1.   14
   15
   16compileEventDescription(Declarations, InputDescription, OutputDescription) :- 
   17	consult(Declarations),
   18	consult(InputDescription),
   19	tell(OutputDescription),
   20	% compile initially/1 rules	
   21	compileInitially.
   22
   23% compile initiatedAt/2 rules
   24compileEventDescription(_, _, _) :- compileInitiatedAt.
   25% compile terminatedAt/2 rules
   26compileEventDescription(_, _, _) :- compileTerminatedAt.
   27% compile initiates/3 rules
   28compileEventDescription(_, _, _) :- compileInitiates.
   29% compile terminates/3 rules
   30compileEventDescription(_, _, _) :- compileTerminates.
   31% compile holdsFor/2 rules
   32compileEventDescription(_, _, _) :- compileHoldsFor.
   33% compile holdsAt/2 rules
   34compileEventDescription(_, _, _) :- compileHoldsAt.
   35% compile happensAt/2 rules
   36compileEventDescription(_, _, _) :- compileHappensAt.
   37% compile cachingOrder/1 declarations:
   38% combine cachingOrder/1, grounding/1 and indexOf/2 to produce cachingOrder2/2
   39compileEventDescription(_, _, _) :- compileCachingOrder.
   40% compile collectIntervals/1 declarations: 
   41% combine collectIntervals/1, grounding/1 and indexOf/2 to produce collectIntervals2/2
   42compileEventDescription(_, _, _) :- compileCollectIntervals.
   43% compile buildFromPoints/1 declarations:
   44% combine buildFromPoints/1, grounding/1 and indexOf/2 to produce buildFromPoints2/2
   45compileEventDescription(_, _, _) :- compileBuildFromPoints.
   46compileEventDescription(_, InputDescription, _) :- compileAnythingElse(InputDescription).
   47% close the new event description file
   48compileEventDescription(_, _, _) :-  told, !.
   49
   50
   51% compile initially/1 rules
   52compileInitially :-
   53    clause(initially(F=V), Body),	
   54	\+ var(F), 
   55	compileConditions(Body, NewBody, [], false),	
   56	writeCompiledRule('initially', [F=V], NewBody), fail.
   57	
   58% compile initiatedAt/2 rules 
   59compileInitiatedAt :-
   60    clause(initiatedAt(F=V,T), Body),
   61    \+ var(F),	
   62    (
   63    cyclic(F=V),
   64    compileConditions(Body, NewBody, [T1, T2], true)
   65    ;
   66    \+ cyclic(F=V),
   67    compileConditions(Body, NewBody, [T1, T2], false)
   68    ),    
   69    writeCompiledRule('initiatedAt', [F=V,T1,T,T2], NewBody), fail.
   70	
   71% compile initiatedAt/4 rules 
   72% In this case, we assume the author treats timespans correctly inside the rule body 
   73compileInitiatedAt :-
   74    clause(initiatedAt(F=V,T1,T,T2), Body),
   75    \+ var(F),    	
   76	(
   77    cyclic(F=V),
   78    compileConditions(Body, NewBody, [], true)
   79    ;
   80    \+ cyclic(F=V),
   81    compileConditions(Body, NewBody, [], false)
   82    ),	
   83	writeCompiledRule('initiatedAt', [F=V,T1,T,T2], NewBody), fail.
   84	
   85% compile terminatedAt/2 rules 
   86compileTerminatedAt :-
   87    clause(terminatedAt(F=V,T), Body),
   88    \+ var(F),
   89	(
   90    cyclic(F=V),
   91    compileConditions(Body, NewBody, [T1, T2], true)
   92    ;
   93    \+ cyclic(F=V),
   94    compileConditions(Body, NewBody, [T1, T2], false)
   95    ),	
   96	writeCompiledRule('terminatedAt', [F=V,T1,T,T2], NewBody), fail.
   97	
   98% compile terminatedAt/4 rules 
   99% In this case, we assume the author treats timespans correctly inside the rule body
  100compileTerminatedAt :-
  101    clause(terminatedAt(F=V,T1,T,T2), Body),
  102    \+ var(F),
  103	(
  104    cyclic(F=V),
  105    compileConditions(Body, NewBody, [], true)
  106    ;
  107    \+ cyclic(F=V),
  108    compileConditions(Body, NewBody, [], false)
  109    ),	
  110	writeCompiledRule('terminatedAt', [F=V,T1,T,T2], NewBody), fail.
  111
  112% compile initiates/3 rules
  113compileInitiates :-
  114    clause(initiates(E,U,T), (Body)),
  115	compileConditions((happensAt(E,T),Body), NewBody, [], false),	
  116	writeCompiledRule('initiates', [U,T], NewBody), fail.
  117
  118% compile terminates/3 rules
  119compileTerminates :-
  120    clause(terminates(E,U,T), (Body)),
  121	compileConditions((happensAt(E,T),Body), NewBody, [], false),	
  122	writeCompiledRule('terminates', [U,T], NewBody), fail.
  123
  124% compile holdsFor/2 rules
  125compileHoldsFor :-
  126    clause(holdsFor(F=V,I), Body),	
  127	% the condition below makes sure that we do not compile rules from RTEC.prolog 
  128	% or any other domain-independent code
  129	\+ var(F),
  130	compileConditions(Body, NewBody, [], false),	
  131	writeCompiledRule('holdsFor', [F=V,I], NewBody), fail.
  132	
  133% compile holdsAt/2 rules
  134
  135compileHoldsAt :-
  136    clause(holdsAt(F=V,T), Body),	
  137	% the condition below makes sure that we do not compile rules from RTEC.prolog 
  138	% or any other domain-independent code
  139	\+ var(F),
  140	compileHoldsAtTree(Body, NewBody, I),	
  141	writeCompiledRule('holdsFor', [F=V,I], NewBody), fail.
  142
  143
  144% compile happensAt/2 rules 
  145compileHappensAt :-
  146    clause(happensAt(E,T), Body),	
  147	% the condition below makes sure that we do not compile rules from RTEC.prolog 
  148	% or any other domain-independent code
  149	\+ var(E),
  150	compileConditions(Body, NewBody, [], false),	
  151	writeCompiledRule('happensAt', [E,T], NewBody), fail.
  152
  153
  154% compile cachingOrder/1 rules
  155compileCachingOrder :-
  156    cachingOrder(Entity),
  157	clause(grounding(Entity), Body),
  158	indexOf(Index, Entity),	 
  159	write('cachingOrder2('), write(Index), write(', '), write(Entity), write(') :-'), nl, 
  160	tab(5), write(Body), write('.'), nl, nl, fail.
  161
  162% compile collectIntervals/1 rules
  163compileCollectIntervals :-
  164    collectIntervals(F=V),
  165	clause(grounding(F=V), Body),
  166	indexOf(Index, F=V),	 
  167	write('collectIntervals2('), write(Index), write(', '), write(F=V), write(') :-'), nl, 
  168	tab(5), write(Body), write('.'), nl, nl, fail.
  169
  170% compile buildFromPoints/1 rules
  171compileBuildFromPoints :-
  172    buildFromPoints(F=V),
  173	clause(grounding(F=V), Body),
  174	indexOf(Index, F=V),	 
  175	write('buildFromPoints2('), write(Index), write(', '), write(F=V), write(') :-'), nl, 
  176	tab(5), write(Body), write('.'), nl, nl, fail.
  177	
  178%compile for anything other than the EC predicates
  179compileAnythingElse(InputDescription) :-
  180	% predicate_property, for some reason, requires absolute path.
  181	% First check if InputDescription is absolute, else construct absolute path
  182	%(
  183	%is_absolute_file_name(InputDescription),
  184	%InputFullPath = InputDescription
  185	%;
  186	%working_directory(Cwd,Cwd),
  187	%atom_concat(Cwd,InputDescription,InputFullPath)
  188	%),
  189	absolute_file_name(InputDescription,[extensions([''])],InputFullPath),
  190	%predicate_property(Head,file(InputFullPath)),
  191	source_file(UserHead,InputFullPath),
  192	(UserHead = user:Head, !
  193	;
  194	Head = UserHead),
  195	\+ member(Head,[initially(F=V),
  196					initiatedAt(Ui,Ti),
  197					initiatedAt(Ui,Ti1,Ti,Ti2),
  198					terminatedAt(Ut,Tt),
  199					terminatedAt(Ut,Tt1,Tt,Tt2),
  200					initiates(Eis,Uis,Tis),
  201					terminates(Ets,Uts,Tts),
  202					holdsFor(Fhf=Vhf,Ihf),
  203					holdsAt(Fha=Vha, Tha),
  204					happensAt(Eha,Tha),
  205					collectIntervals(Fc=Vc),
  206					buildFromPoints(fb=Vb)]),
  207	clause(Head,Body),
  208	write(Head), write(' :- '), nl,
  209	tab(5), write(Body), write('.'), nl, nl, fail.
  210
  211%%%%%%%% compile body predicates %%%%%%%%
  212
  213%%%% recursive definition of compileConditions/4 %%%%
  214
  215compileConditions((\+Head,Rest), (\+NewHead,NewRest), Timespan, Cyclic) :-	
  216	!, compileConditions1(Head, NewHead, Timespan, Cyclic), 
  217	compileConditions(Rest, NewRest, Timespan, Cyclic).
  218
  219compileConditions((Head,Rest), (NewHead,NewRest), Timespan, Cyclic) :-	
  220	!, compileConditions1(Head, NewHead, Timespan, Cyclic), 
  221	compileConditions(Rest, NewRest, Timespan, Cyclic).
  222
  223compileConditions(\+Body, \+NewBody, Timespan, Cyclic) :-	
  224	!, compileConditions1(Body, NewBody, Timespan, Cyclic).
  225
  226compileConditions(Body, NewBody, Timespan, Cyclic) :-	
  227	compileConditions1(Body, NewBody, Timespan, Cyclic).
  228	
  229
  230%%%% recursive definition of compileHoldsAtTree/3 %%%%
  231compileHoldsAtTree(Body, NewBody, Interval) :-
  232	findChildren(Body, Children, Operation),
  233	!,
  234	/*findall([ChildNewBody,ChildInterval], 
  235	        (member(Child,Children),compileHoldsAtTree(Child,ChildNewBody,ChildInterval)),
  236	        ChildrenBIs),*/
  237	% findall creates new variable bindings. Use gather instead.
  238	gatherChildrenBodyIntervals(Children,[],ChildrenBIs),
  239	completeBody(ChildrenBIs,Operation,NewBody,Interval).
  240	
  241gatherChildrenBodyIntervals([HeadChild|[]],InitChildrenBIs,ChildrenBIs) :-
  242	compileHoldsAtTree(HeadChild,ChildNewBody,ChildInterval),
  243	append(InitChildrenBIs,[[ChildNewBody,ChildInterval]],ChildrenBIs).
  244	
  245gatherChildrenBodyIntervals([HeadChild|TailChildren],InitChildrenBIs,ChildrenBIs) :-
  246	compileHoldsAtTree(HeadChild,ChildNewBody,ChildInterval),
  247	append(InitChildrenBIs,[[ChildNewBody,ChildInterval]],NewInitChildrenBIs),
  248	gatherChildrenBodyIntervals(TailChildren,NewInitChildrenBIs,ChildrenBIs).
  249	
  250% simple fluent
  251compileHoldsAtTree(holdsAt(U,T), holdsForProcessedSimpleFluent(Index,U,I), I) :-
  252	simpleFluent(U), indexOf(Index, U), !.
  253	
  254% output entity/statically determined fluent
  255compileHoldsAtTree(holdsAt(U,T), holdsForProcessedSDFluent(Index,U,I), I) :-
  256	sDFluent(U), indexOf(Index, U), !.
  257	
  258findChildren(Body,Children,Operation) :-
  259	checkForNegation(Body,Intersections,Unions),
  260	convertToInters(Intersections,ChildrenI),
  261	convertToUnions(Unions,ChildrenU),
  262	Children = [ChildrenI,ChildrenU],
  263	Operation = negation.
  264	
  265checkForNegation(Body,Intersections,Unions) :-
  266	checkForNegation1(Body,[],Intersections,[],Unions),
  267	Unions \= [].
  268	
  269checkForNegation1((\+Head,Rest),InitIntersections,Intersections,InitUnions,Unions) :-
  270	append(InitUnions,[Head],NewInitUnions),
  271	checkForNegation1(Rest,InitIntersections,Intersections,NewInitUnions,Unions).
  272	
  273checkForNegation1((Head,Rest),InitIntersections,Intersections,InitUnions,Unions) :-
  274	append(InitIntersections,[Head],NewInitIntersections),
  275	checkForNegation1(Rest,NewInitIntersections,Intersections,InitUnions,Unions).
  276
  277checkForNegation1(\+Body,InitIntersections,InitIntersections,InitUnions,Unions) :-
  278	append(InitUnions,[Body],Unions).
  279	
  280checkForNegation1(Body,InitIntersections,Intersections,InitUnions,InitUnions) :-
  281	append(InitIntersections,[Body],Intersections).
  282	
  283convertToInters([H|[]], H).
  284
  285convertToInters([H|T],(H,Rest)) :-
  286	convertToInters(T,Rest).
  287	
  288convertToUnions([H|[]], H).
  289
  290convertToUnions([H|T],(H;Rest)) :-
  291	convertToUnions(T,Rest).
  292		
  293findChildren((Head,Rest),Children,Operation) :-
  294	findChildren1((Head,Rest), [], Children, Operation).
  295	
  296findChildren((Head;Rest),Children,Operation) :-
  297	findChildren1((Head;Rest), [], Children, Operation).
  298	
  299findChildren1((Head,Rest), InitChildren, Children, intersection) :-
  300	!, append(InitChildren,[Head],NewInitChildren),
  301	findChildren1(Rest, NewInitChildren, Children, intersection).
  302	
  303findChildren1((Head;Rest), InitChildren, Children, union) :-
  304	!, append(InitChildren,[Head],NewInitChildren),
  305	findChildren1(Rest, NewInitChildren, Children, union).
  306
  307findChildren1(Body, InitChildren, Children, Operation) :-
  308	append(InitChildren, [Body], Children).
  309	
  310completeBody(ChildrenBIs,intersection,(Head,Rest),Interval) :-
  311	completeBody1(ChildrenBIs,Head,[],Intervals),
  312	Rest = intersect_all(Intervals, Interval).
  313	
  314completeBody(ChildrenBIs,union,(Head,Rest),Interval) :-
  315	completeBody1(ChildrenBIs,Head,[],Intervals),
  316	Rest = union_all(Intervals, Interval).
  317	
  318completeBody(ChildrenBIs,negation,(Head,Rest),Interval) :-
  319	completeBody1(ChildrenBIs,Head,[],Intervals),
  320	Intervals = [H|T],
  321	Rest = relative_complement_all(H, T, Interval).
  322	
  323completeBody1([H|[]],(Head),InitIntervals,Intervals) :-
  324	H = [Head|Interval],
  325	append(InitIntervals,Interval,Intervals).
  326
  327completeBody1([H|T],(Head,Rest),InitIntervals,Intervals) :-
  328	H = [Head|Interval],
  329	append(InitIntervals,Interval,NewIntervals),
  330	completeBody1(T,Rest,NewIntervals,Intervals).
  331	
  332%%%% end of recursive definition of compileHoldsAtTree/3 %%%%
  333
  334
  335%%%% auxiliary predicate dealing with a single condition %%%%
  336
  337%%% happensAt
  338
  339% special event: start of simple fluent
  340compileConditions1(happensAt(start(U),T), NewBody, Timespan, Cyclic) :-
  341	simpleFluent(U), indexOf(Index, U),
  342	(
  343	Timespan = [],
  344	NewBody = happensAtProcessedSimpleFluent(Index,start(U),T)
  345	;
  346	Timespan = [T1, T2],
  347	NewBody = (happensAtProcessedSimpleFluent(Index,start(U),T), T1=<T, T<T2) 
  348	), 
  349	!.
  350	
  351% special event: start of input entity/statically determined fluent
  352compileConditions1(happensAt(start(U),T), NewBody, Timespan, Cyclic) :-
  353	sDFluent(U), inputEntity(U), indexOf(Index, U),
  354	(
  355	Timespan = [],
  356	NewBody = happensAtProcessedIE(Index,start(U),T)
  357	;
  358	Timespan = [T1, T2],
  359	NewBody = (happensAtProcessedIE(Index,start(U),T), T1=<T, T<T2)
  360	), 
  361	!.
  362	
  363% special event: start of internal entity/statically determined fluent
  364compileConditions1(happensAt(start(U),T), NewBody, Timespan, Cyclic) :-
  365	sDFluent(U), internalEntity(U), indexOf(Index, U),
  366	(
  367	Timespan = [],
  368	NewBody = happensAtProcessedIE(Index,start(U),T)
  369	;
  370	Timespan = [T1, T2],
  371	NewBody = (happensAtProcessedIE(Index,start(U),T), T1=<T, T<T2)
  372	), 
  373	!.
  374	
  375% special event: start of output entity/statically determined fluent
  376compileConditions1(happensAt(start(U),T), NewBody, Timespan, Cyclic) :-
  377	sDFluent(U), outputEntity(U), indexOf(Index, U),
  378	(
  379	Timespan = [],
  380	NewBody = happensAtProcessedSDFluent(Index,start(U),T)
  381	;
  382	Timespan = [T1, T2],
  383	NewBody = (happensAtProcessedSDFluent(Index,start(U),T), T1=<T, T<T2)
  384	), 
  385	!.
  386
  387% special event: end of simple fluent
  388compileConditions1(happensAt(end(U),T), NewBody, Timespan, Cyclic) :-
  389	simpleFluent(U), indexOf(Index, U),
  390	(
  391	Timespan = [],
  392	NewBody = happensAtProcessedSimpleFluent(Index,end(U),T)
  393	;
  394	Timespan = [T1, T2],
  395	NewBody = (happensAtProcessedSimpleFluent(Index,end(U),T), T1=<T, T<T2)
  396	), 
  397	!.
  398	
  399% special event: end of input entity/statically determined fluent
  400compileConditions1(happensAt(end(U),T), NewBody, Timespan, Cyclic) :-
  401	sDFluent(U), inputEntity(U), indexOf(Index, U),
  402	(
  403	Timespan = [],
  404	NewBody = happensAtProcessedIE(Index,end(U),T)
  405	;
  406	Timespan = [T1, T2],
  407	NewBody = (happensAtProcessedIE(Index,end(U),T), T1=<T, T<T2)
  408	), 
  409	!.
  410	
  411% special event: end of internal entity/statically determined fluent
  412compileConditions1(happensAt(end(U),T), NewBody, Timespan, Cyclic) :-
  413	sDFluent(U), internalEntity(U), indexOf(Index, U),
  414	(
  415	Timespan = [],
  416	NewBody = happensAtProcessedIE(Index,end(U),T)
  417	;
  418	Timespan = [T1, T2],
  419	NewBody = (happensAtProcessedIE(Index,end(U),T), T1=<T, T<T2)
  420	), 
  421	!.
  422	
  423% special event: end of output entity/statically determined fluent
  424compileConditions1(happensAt(end(U),T), NewBody, Timespan, Cyclic) :-
  425	sDFluent(U), outputEntity(U), indexOf(Index, U),
  426	(
  427	Timespan = [],
  428	NewBody = happensAtProcessedSDFluent(Index,end(U),T)
  429	;
  430	Timespan = [T1, T2],
  431	NewBody = (happensAtProcessedSDFluent(Index,end(U),T), T1=<T, T<T2)
  432	),
  433	!.
  434	
  435% special event: end of statically determined fluent that is neither an input nor an output entity
  436compileConditions1(happensAt(end(U),T), NewBody, Timespan, Cyclic) :-
  437	sDFluent(U),
  438	(
  439	Timespan = [],
  440	NewBody = happensAtSDFluent(end(U),T)
  441	;
  442	Timespan = [T1, T2],
  443	NewBody = (happensAtSDFluent(end(U),T), T1=<T, T<T2)
  444	),
  445	!.
  446	
  447
  448% input entity/event
  449compileConditions1(happensAt(E,T), NewBody, Timespan, Cyclic) :-
  450	inputEntity(E),
  451	(
  452	Timespan = [],
  453	NewBody = happensAtIE(E,T)
  454	;
  455	Timespan = [T1, T2],
  456	NewBody = (happensAtIE(E,T), T1=<T, T<T2)
  457	), 
  458	!.
  459	
  460% output entity/event
  461compileConditions1(happensAt(E,T), NewBody, Timespan, Cyclic) :-
  462	outputEntity(E), indexOf(Index, E),
  463	(
  464	Timespan = [],
  465	NewBody = happensAtProcessed(Index,E,T)
  466	;
  467	Timespan = [T1, T2],
  468	NewBody = (happensAtProcessed(Index,E,T), T1=<T, T<T2)
  469	),
  470	!.
  471	
  472	
  473%%% initiatedAt/2
  474
  475compileConditions1(initiatedAt(U,T), NewBody, Timespan, Cyclic) :-
  476	(
  477	Timespan = [],
  478	NewBody = initiatedAt(U,T)
  479	;
  480	Timespan = [T1, T2],
  481	NewBody = initiatedAt(U,T1,T,T2)
  482	),
  483	!.
  484	
  485%%% terminatedAt/2
  486
  487compileConditions1(terminatedAt(U,T), NewBody, Timespan, Cyclic) :-
  488	(
  489	Timespan = [],
  490	NewBody = terminatedAt(U,T)
  491	;
  492	Timespan = [T1, T2],
  493	NewBody = terminatedAt(U,T1,T,T2)
  494	),
  495	!.
  496	
  497
  498%%% holdsAt
  499
  500% simple fluent
  501compileConditions1(holdsAt(U,T), NewBody, Timespan, Cyclic) :-
  502	simpleFluent(U), indexOf(Index, U),
  503	(
  504	Cyclic,
  505	cyclic(U),
  506	NewBody = holdsAtCyclic(Index,U,T)
  507	;
  508	NewBody = holdsAtProcessedSimpleFluent(Index,U,T)
  509	), 
  510	!.
  511	
  512compileConditions1(holdsAt(I,U,T), NewBody, Timespan, Cyclic) :-
  513	simpleFluent(U), indexOf(I, U),
  514	(
  515	Cyclic,
  516	cyclic(U),
  517	NewBody = holdsAtCyclic(I,U,T)
  518	;
  519	NewBody = holdsAtProcessedSimpleFluent(I,U,T)
  520	), 
  521	!.
  522	
  523% input entity/statically determined fluent
  524compileConditions1(holdsAt(U,T), holdsAtProcessedIE(Index,U,T), Timespan, Cyclic) :-
  525	sDFluent(U), inputEntity(U), indexOf(Index, U), !.
  526
  527% internal entity/statically determined fluent
  528compileConditions1(holdsAt(U,T), holdsAtProcessedIE(Index,U,T), Timespan, Cyclic) :-
  529	sDFluent(U), internalEntity(U), indexOf(Index, U), !.
  530
  531% output entity/statically determined fluent
  532compileConditions1(holdsAt(U,T), holdsAtProcessedSDFluent(Index,U,T), Timespan, Cyclic) :-
  533	sDFluent(U), outputEntity(U), indexOf(Index, U), !.
  534
  535% statically determined fluent that is neither input nor output entity
  536compileConditions1(holdsAt(U,T), holdsAtSDFluent(U,T), Timespan, Cyclic) :-
  537	sDFluent(U), !.
  538
  539
  540%%% holdsFor
  541
  542% simple fluent
  543compileConditions1(holdsFor(U,I), holdsForProcessedSimpleFluent(Index,U,I), Timespan, Cyclic) :-
  544	simpleFluent(U), indexOf(Index, U), !.
  545
  546% input entity/statically determined fluent
  547compileConditions1(holdsFor(U,I), holdsForProcessedIE(Index,U,I), Timespan, Cyclic) :-
  548	sDFluent(U), inputEntity(U), indexOf(Index, U), !.
  549
  550% internal entity/statically determined fluent
  551compileConditions1(holdsFor(U,I), holdsForProcessedIE(Index,U,I), Timespan, Cyclic) :-
  552	sDFluent(U), internalEntity(U), indexOf(Index, U), !.
  553
  554% output entity/statically determined fluent
  555compileConditions1(holdsFor(U,I), holdsForProcessedSDFluent(Index,U,I), Timespan, Cyclic) :-
  556	sDFluent(U), outputEntity(U), indexOf(Index, U), !.
  557
  558% statically determined fluent that is neither input nor output entity
  559compileConditions1(holdsFor(U,I), holdsForSDFluent(U,I), Timespan, Cyclic) :-
  560	sDFluent(U), !.
  561
  562
  563%%% other body literals, eg interval manipulation constructs 
  564%%% or optimisation checks
  565
  566% special case for findall
  567compileConditions1(findall(Targets,user:ECPred,List),findall(Targets,NewECPred,List), Timespan, Cyclic) :-
  568	compileConditions(ECPred, NewECPred, Timespan, Cyclic), !.
  569	
  570compileConditions1(findall(Targets,ECPred,List),findall(Targets,NewECPred,List), Timespan, Cyclic) :-
  571	compileConditions(ECPred, NewECPred, Timespan, Cyclic), !.
  572
  573compileConditions1(Something, Something, Timespan, Cyclic).
  574
  575compileConditions1(Something, T1, T2, Something).
  576
  577
  578%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  579% I/O Utils
  580%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  581
  582
  583writeCompiledRule(initially, [U], (true)) :-
  584	!, write('initially('), write(U), write(').'), nl, nl. 
  585
  586writeCompiledRule(initiatedAt, [U, T], (true)) :-
  587	!, write('initiatedAt('), write(U), write(', _, '), write(T), write(', _).'), nl, nl.
  588	
  589writeCompiledRule(initiatedAt, [U, T1, T, T2], (true)) :-
  590	!, write('initiatedAt('), write(U), write(', '), write(T1), write(', '), write(T), write(', '), write(T2), write(').'), nl, nl.
  591
  592writeCompiledRule(terminatedAt, [U, T], (true)) :-
  593	!, write('terminatedAt('), write(U), write(', _, '), write(T), write(', _).'), nl, nl.
  594	
  595writeCompiledRule(terminatedAt, [U, T1, T, T2], (true)) :-
  596	!, write('terminatedAt('), write(U), write(', '), write(T1), write(', '), write(T), write(', '), write(T2), write(').'), nl, nl.
  597
  598writeCompiledRule(holdsFor, [U, I], (true)) :-
  599	!, write('holdsForSDFluent('), write(U), write(','), write(I), write(').'), nl, nl. 
  600
  601writeCompiledRule(happensAt, [E, T], (true)) :-
  602	!, write('happensAt('), write(E), write(','), write(T), write(').'), nl, nl.
  603
  604
  605writeCompiledRule(initially, [U], Body) :-
  606	write('initially('), write(U), write(') :-'), nl,  
  607	writeBodyLiterals(Body).
  608
  609writeCompiledRule(initiatedAt, [U, T], Body) :-
  610	write('initiatedAt('), write(U), write(', _, '), write(T), write(', _) :-'), nl, 
  611	writeBodyLiterals(Body).
  612	
  613writeCompiledRule(initiatedAt, [U, T1, T, T2], Body) :-
  614	write('initiatedAt('), 
  615	write(U), 
  616	write(', '), write(T1), write(', '),  
  617	write(T), 
  618	write(', '), write(T2), 
  619	write(') :-'), 
  620	nl, 
  621	writeBodyLiterals(Body).
  622
  623writeCompiledRule(terminatedAt, [U, T], Body) :-
  624	write('terminatedAt('), write(U), write(', _, '), write(T), write(', _) :-'), nl, 
  625	writeBodyLiterals(Body).
  626	
  627writeCompiledRule(terminatedAt, [U, T1, T, T2], Body) :-
  628	write('terminatedAt('), 
  629	write(U), 
  630	write(', '), write(T1), write(', '),  
  631	write(T), 
  632	write(', '), write(T2), 
  633	write(') :-'), 
  634	nl, 
  635	writeBodyLiterals(Body).
  636
  637writeCompiledRule(initiates, [U, T], Body) :-
  638	write('initiatedAt('), write(U), write(', _, '), write(T), write(', _) :-'), nl, 
  639	writeBodyLiterals(Body).
  640
  641writeCompiledRule(terminates, [U, T], Body) :-
  642	write('terminatedAt('), write(U), write(', _, '), write(T), write(', _) :-'), nl, 
  643	writeBodyLiterals(Body).
  644
  645writeCompiledRule(holdsFor, [U, I], Body) :-
  646	write('holdsForSDFluent('), write(U), write(','), write(I), write(') :-'), nl,
  647	writeBodyLiterals(Body).
  648
  649writeCompiledRule(happensAt, [E, T], Body) :-
  650	write('happensAtEv('), write(E), write(','), write(T), write(') :-'), nl, 
  651	writeBodyLiterals(Body).
  652
  653
  654writeBodyLiterals((Head,true)):-
  655	!, tab(5), write(Head), write('.'), nl, nl.
  656
  657writeBodyLiterals((Head,Rest)):-
  658	!, tab(5), write(Head), write(','), nl,
  659	writeBodyLiterals(Rest).
  660
  661writeBodyLiterals(Last) :- 
  662	tab(5), write(Last), write('.'), nl, nl