/* This software is copyright (c) 1997-2001 Giuseppe De Giacomo, Yves Lesperance, Hector Levesque, Ray Reiter, University of Toronto, York University, and Communications and Information Technology Ontario. All right are reserved. Use of this software is permitted for non-commercial research purposes, and it may be copied only for that use. All copies must include this copyright message. You may not redistribute it outside your institution without permission. If you are interested in a license for commercial use, contact Yves Lesperance at lesperan@cs.yorku.ca. This software and any documentation and/or information supplied with it is distributed on an as is basis. The copyright holders make no warranties, expressed or implied, including but not limited to implied warranties of merchantability and fitness for a particular purpose, regarding the documentation, functions or performance of such software, documentation and/or information. */ /*************************************************************************** ** IndiGolog interpreter ** ** ** ** first written by Hector Levesque ** ** adapted to Quintus Prolog by Yves Lesperance, April 1999 ** ** modified by Yves Lesperance and Ho Ng ** ** modified by Alexei Lapouchnian, December 2000 ** ***************************************************************************/ :- ensure_loaded(library(not)). :- multifile tracingProg/0, tracingExec/0, tracingTest/0, tracingPath/0, tracingLeft/0, prim_action/1, prim_fluent/1, causes_val/4, poss/2, proc/2. :- dynamic tracingProg/0, tracingExec/0, tracingTest/0, tracingPath/0, tracingLeft/0. /*************************************************************************** ** Main Loop : indigolog(E) ** ** ** ** The top level call is indigolog(E), where E is a program. ** ** The history H is a list of actions (prim or exog), initially []. ** ** Sensing reports are inserted as actions of the form e(fluent,value) ** ***************************************************************************/ indigolog(E) :- indigo(E,[]). indigo(E,H) :- write('H: '),write(H),nl,fail. /*This accomodates get_event - the special exog action that is the interface with OAA*/ indigo(E,H) :- get_event_exog_occurs(A,E,H), !. /*This was modified to accomodate exog actions that need to be blocked. To be executed the conditions in poss clauses must be satisfied (as with primitive actions).*/ indigo(E,H) :- blockable_exog_occurs(A,H), !, subsim(E,A,H). indigo(E,H) :- trans(E,H,E1,H1), !, checksim(E,H,E1,H1), nl. indigo(E,H) :- final(E,H), length(H,N), write(N), write(' actions.'), nl. /***NEW***blockable_exog_occurs*/ blockable_exog_occurs(A,H) :- exog_action(A), poss(A,P), holds(P,H), exog_occurs(A). /***NEW***get_event_exog_occurs*/ get_event_exog_occurs(A,E,H) :- exog_action(A), poss(A,P), holds(P,H), exog_occurs(A,E,H). checksim(E,H,E1,[sim(_)|H]) :- !, indigo(E,H). checksim(E,H,E1,H1) :- indixeq(H,H1,H2), !, indigo(E1,H2). indixeq(H,H,H). /* for test transitions */ indixeq(H,[A|H],[e(F,Sr),A|H]) :- senses(A,F), !, execute(A,Sr). indixeq(H,[A|H],[A|H]) :- execute(A,_). /* Hector's original version indixeq(H,[Act|H],[Act|H]) :- not senses(Act,_), execute(Act,_). indixeq(H,[Act|H],[e(F,Sr),Act|H]) :- senses(Act,F), execute(Act,Sr). */ /*Updated version of subsim*/ subsim(E,A,H) :- trans(E,H,E1,H1), !,subsim2(E,A,H,E1,H1). subsim(E,A,H) :- !, indigo(E,[A|H]). subsim2(E,A,H,E1,[sim(A)|H]) :- !, indigo(E1,[A|H]). subsim2(E,A,H,E1,H1) :- !, indigo(E,[A|H]). /*************************************************************************** ** indigolog_itr(E) ** ** ** ** This top level call is similar to indigolog(E), except it calls ** ** start_interrupts at the beginning and stop_interrupts at the end ** ** automatically. Program E does not have to contain ** ** prioritized_interrupts to handle any interrupt. ** ** ** ** Assumption : no interrupt is inside any search block ** ***************************************************************************/ indigolog_itr(E) :- indigo(pconc(start_interrupts, pconc(E, stop_interrupts)),[]). /*************************************************************************** ** exog_occurs and execute are the predicates that make contact with ** ** the outside world. Here are two basic versions using read and write ** ***************************************************************************/ ask_exog_occurs(Act) :- write('Exogenous input:'), read(Act). ask_execute(Act,Sr) :- write(Act), senses(Act,_) -> (write(':'),read(Sr)); nl. /*************************************************************************** ** Trans and Final ** ***************************************************************************/ /*** ConGolog ***/ final(conc(E1,E2),H) :- final(E1,H), final(E2,H). final(pconc(E1,E2),H) :- final(E1,H), final(E2,H). final(iconc(_),_). /*Original*/ %trans(conc(E1,E2),H,conc(E,E2),H1) :- trans(E1,H,E,H1). %trans(conc(E1,E2),H,conc(E1,E),H1) :- trans(E2,H,E,H1). /*Swapping the programs*/ trans(conc(E1,E2),H,conc(E2,E),H1) :- trans(E1,H,E,H1). trans(conc(E1,E2),H,conc(E,E1),H1) :- trans(E2,H,E,H1). /* original version: trans(pconc(E1,E2),H,E,H1) :- trans(E1,H,E3,H1) -> E=pconc(E3,E2) ; (trans(E2,H,E3,H1), E=pconc(E1,E3)). */ trans(pconc(E1,E2),H,pconc(E3,E2),H1) :- trans(E1,H,E3,H1). trans(pconc(E1,E2),H,pconc(E1,E3),H1) :- \+ trans(E1,H,E3,H1), trans(E2,H,E3,H1). /* may be a more efficient way: trans(pconc(E1,E2),H,E,H1) :- (trans(E1,H,_,_), !, trans(E1,H,E3,H1), E=pconc(E3,E2)) ; (trans(E2,H,E3,H1), E=pconc(E1,E3)). */ trans(iconc(E),H,conc(E1,iconc(E)),H1) :- trans(E,H,E1,H1). /*** Golog ***/ final([],_). final([E|L],H) :- final(E,H), final(L,H). final(ndet(E1,E2),H) :- final(E1,H) ; final(E2,H). /* original version: final(if(P,E1,E2),H) :- holds(P,H) -> final(E1,H) ; final(E2,H). */ final(if(P,E1,E2),H) :- holds(P,H), final(E1,H). final(if(P,E1,E2),H) :- \+ holds(P,H), final(E2,H). final(star(_),_). final(while(P,E),H) :- not(holds(P,H)) ; final(E,H). final(pi(V,E),H) :- subv(V,_,E,E2), final(E2,H). final(E,H) :- proc(E,E2), final(E2,H). trans([E|L],H,[E1|L],H2) :- trans(E,H,E1,H2). trans([E|L],H,E1,H2) :- L \== [], final(E,H), trans(L,H,E1,H2). /* Hector had: trans([E|L],H,E1,H2) :- not L=[], final(E,H), trans(L,H,E1,H2). */ trans(?(P),H,[],H) :- (holds(P,H), traceTest(P,1,H)) ; (traceTest(P,0,H), fail). trans(ndet(E1,E2),H,E,H1) :- trans(E1,H,E,H1) ; trans(E2,H,E,H1). /* original version: trans(if(P,E1,E2),H,E,H1) :- holds(P,H) -> trans(E1,H,E,H1) ; trans(E2,H,E,H1). */ trans(if(P,E1,E2),H,E,H1) :- holds(P,H), traceTest(P,1,H), trans(E1,H,E,H1). trans(if(P,E1,E2),H,E,H1) :- \+ holds(P,H), traceTest(P,0,H), trans(E2,H,E,H1). trans(star(E),H,[E1,star(E)],H1) :- trans(E,H,E1,H1). trans(while(P,E),H,[E1,while(P,E)],H1) :- (holds(P,H), traceTest(P,1,H), trans(E,H,E1,H1)) ; (traceTest(P,0,H), fail). trans(pi([V|L],E),H,E1,H1) :- subvs([V|L],E,E2), trans(E2,H,E1,H1). trans(pi(V,E),H,E1,H1) :- subv(V,_,E,E2), trans(E2,H,E1,H1). trans(E,H,E1,H1) :- proc(E,E2), trans(E2,H,E1,H1). trans(E,H,[],[E|H]) :- prim_action(E), poss(E,P), holds(P,H). trans(no_op,H,[],H). /*************************************************************************** ** Original Search ** ** ** ** It ignores exogenous or other concurrent actions. ** ***************************************************************************/ final(osearch(E),H) :- final(E,H). trans(osearch(E),H,ofollowpath(E1,L),H1) :- trans(E,H,E1,H1), ofindpath(E1,H1,L), tracePath(L,H), traceLeft(E1). ofindpath(E,H,[E,H]) :- final(E,H). ofindpath(E,H,[E,H|L]) :- trans(E,H,E1,H1), ofindpath(E1,H1,L). final(ofollowpath(E,[E,H]),H) :- !. final(ofollowpath(E,_),H) :- final(E,H). trans(ofollowpath(E,[E,H,E1,H1|L]),H,ofollowpath(E1,[E1,H1|L]),H1) :- traceLeft(E1), !. trans(ofollowpath(E,_),H,E1,H1) :- trans(osearch(E),H,E1,H1). /*************************************************************************** ** Search (from the beginning) ** ** ** ** It ignores exogenous or other concurrent actions. ** ***************************************************************************/ /* extact(+list of snapshots, +[], +list of actions) and extractout(+list of snapshots, +[], +list of actions) It returns the list of actions AL that has been performed from the beginning of search by making extact(LS,[],AL) holds */ extact([H0],AL,AL). extact([[sim(A)|H1],H|L],AL,R) :- extactout([H1,H|L],AL,R). extact([[A|H1],H|L],AL,R) :- extactout([H1,H|L],[inside(A)|AL],R). extactout([H,H|L],AL,R) :- extact([H|L],AL,R). extactout([H,[sim(A)|H]|L],AL,R) :- extact([[sim(A)|H]|L],AL,R). extactout([[A|H1],H|L],AL,R) :- extactout([H1,H|L],[A|AL],R). /* possPath(+path, +current history) It checks to see if it is still possible to continue with the path */ possPath([E,H],CH) :- final(E,CH). possPath([E,H,E1,H|L],CH) :- trans(E,CH,E1,CH), possPath([E1,H|L],CH). possPath([E,H,E1,[A|H]|L],CH) :- trans(E,CH,E1,[A|CH]), possPath([E1,[A|H]|L],[A|CH]). /* findpath(AL,E,H,L) holds if there is a legal execution of E in H that */ /* first xeqs the actions in AL, and then finishes with L, a pathlist as */ /* above to a final state */ /*1*/findpath([],E,H,[E,H]) :- final(E,H). /*2*/findpath([],E,H,[E,H|L]) :- trans(E,H,E1,H1), findpath([],E1,H1,L). /*3*/findpath([A|AL],E,H,L) :- /* silent */ trans(E,H,E1,H), findpath([A|AL],E1,H,L). /*4*/findpath([inside(A)|AL],E,H,L) :- prim_action(A), trans(E,H,E1,[A|H]), findpath(AL,E1,[A|H],L). /*5*/findpath([A|AL],E,H,L) :- \+ A = inside(_), findpath(AL,E,[A|H],L). /*** search ***/ final(search(E),H) :- final(E,H). trans(search(E),H,path(P1,LS1,E,H),H1) :- findpath([],E,H,P0), trans(path(P0,[H],E,H),H,path(P1,LS1,E,H),H1), tracePath(P1,H). /* the structure path(L,LS,E0,H0) is used as a pseudo program where */ /* L is a list E1,H1,E2,H2...En,Hn such that */ /* trans(Ei,Hi,Ei+1,Hi+1) and final(En,Hn) both hold */ /* LS is a list of snapshots */ /* E0 and H0 is where the search started (in case we need to restart) */ final(path([E,H],LS,E0,H0),H) :- !. final(path([E,H],LS,E0,H0),CH) :- final(E,CH), !. final(path([E,H,E1,H1|L],LS,E0,H0),H) :- !, fail. final(path([E,H|L],LS,E0,H0),CH) :- extactout([CH|LS],[],AL), !, findpath(AL,E0,H0,[E1,H1]). trans(path([E,H,E1,H|L],LS,E0,H0),H,path([E1,H|L],LS,E0,H0),H) :- traceLeft(E1), !. trans(path([E,H,E1,[A|H]|L],LS,E0,H0),H,path([E1,[A|H]|L],[[A|H]|LS],E0,H0),[A|H]) :- traceLeft(E1), !. trans(path([E,H,E1,H|L],LS,E0,H0),CH,path([E1,H|L],LS,E0,H0),CH) :- possPath([E,H,E1,H|L],CH), traceLeft(E1), !/*,write('trans(path([E,H,E1,H|L],LS,E0,H0),CH,path([E1,H|L],LS,E0,H0),CH) '),nl*/. trans(path([E,H,E1,[A|H]|L],LS,E0,H0),CH,path([E1,[A|H]|L],[[A|CH]|LS],E0,H0),[A|CH]) :- possPath([E,H,E1,[A|H]|L],CH), traceLeft(E1)/*,write('trans(path([E,H,E1,[A|H]|L],LS,E0,H0),CH,path([E1,[A|H]|L],[[A|CH]|LS],E0,H0),[A|CH])'),nl*/, !. trans(path([E,H,E1,H1|L],LS,E0,H0),CH,path(P2,LS2,E0,H0),H2) :- write('replanning needed'),nl, extactout([CH|LS],[],AL), findpath(AL,E0,H0,P), trans(path(P,LS,E0,H0),CH,path(P2,LS2,E0,H0),H2), tracePath(P2,CH). /*************************************************************************** ** Simulated Actions : sim(A) ** ***************************************************************************/ prim_action(sim(A)) :- exog_action(A). poss(sim(A),P) :- poss(A,P). /*************************************************************************** ** Interrupts ** ***************************************************************************/ prim_action(start_interrupts). prim_action(stop_interrupts). prim_fluent(interrupts). causes_val(start_interrupts, interrupts, running, true). causes_val(stop_interrupts, interrupts, stopped, true). poss(start_interrupts, true). poss(stop_interrupts, true). proc(interrupt(V,Trigger,Body), /* version with variable */ while(interrupts=running, pi(V,if(Trigger,Body,?(neg(true)))))). proc(interrupt(Trigger,Body), /* version without variable */ while(interrupts=running, if(Trigger,Body,?(neg(true))))). proc(prioritized_interrupts(L),[start_interrupts,E]) :- expand_interrupts(L,E). expand_interrupts([],stop_interrupts). expand_interrupts([X|L],pconc(X,E)) :- expand_interrupts(L,E). /*************************************************************************** ** Hold (holds) ** ***************************************************************************/ holds(and(P1,P2),H) :- !, holds(P1,H), holds(P2,H). holds(or(P1,P2),H) :- !, (holds(P1,H) ; holds(P2,H)). holds(neg(P),H) :- !, not(holds(P,H)). /* Negation by failure */ holds(some([V|L],P),H) :- subvs([V|L],P,P1), holds(P1,H). holds(some(V,P),H) :- !, subv(V,_,P,P1), holds(P1,H). holds(P,H) :- proc(P,P1), !, holds(P1,H). holds(P,H) :- subf(P,P1,H), call(P1). /* Hector's original version holds(P,H) :- proc(P,P1), holds(P1,H). holds(P,H) :- not proc(P,P1), subf(P,P1,H), call(P1). */ /*************************************************************************** ** Substitution ** ***************************************************************************/ /*** subv(X1,X2,T1,T2) holds iff T2 is T1 with X1 replaced by X2 ***/ subv(_,_,T1,T2) :- (var(T1);integer(T1)), !, T2 = T1. subv(X1,X2,T1,T2) :- T1 = X1, !, T2 = X2. subv(X1,X2,T1,T2) :- T1 =..[F|L1], subvl(X1,X2,L1,L2), T2 =..[F|L2]. subvl(_,_,[],[]). subvl(X1,X2,[T1|L1],[T2|L2]) :- subv(X1,X2,T1,T2), subvl(X1,X2,L1,L2). subvs([],T1,T1) :- !. subvs([V|L],T1,T2) :- subv(V,_,T1,T3), subvs(L,T3,T2). /*** subf(P1,P2,H) holds iff P2 is P1 with all fluents replaced by their values ***/ subf(P1,P2,_) :- (var(P1);integer(P1)), !, P2 = P1. subf(P1,P2,H) :- prim_fluent(P1), has_val(P1,P2,H). subf(P1,P2,H) :- \+ prim_fluent(P1), P1=..[F|L1], subfl(L1,L2,H), P2=..[F|L2]. /* Hector's original version subf(P1,P2,H) :- prim_fluent(P1), has_val(P1,P2,H). subf(P1,P2,H) :- not prim_fluent(P1), P1=..[F|L1], subfl(L1,L2,H), P2=..[F|L2]. */ subfl([],[],_). subfl([T1|L1],[T2|L2],H) :- subf(T1,T2,H), subfl(L1,L2,H). has_val(F,V,[]) :- initially(F,V). has_val(F,V,[sim(A)|H]) :- !, has_val(F,V,[A|H]). has_val(F,V,[A|H]) :- sets_val(A,F,V1,H) -> V = V1 ; has_val(F,V,H). sets_val(A,F,V,H) :- A = e(F,V) ; (causes_val(A,F,V,P), holds(P,H)). /*************************************************************************** ** Program Tracing ** ** ** ** There are five clauses which can be asserted for tracing: ** ** tracingProg - (useless, not supported) ** ** tracingTest - show each test action and its result ** ** tracingExec - (covered by the clause execute(A,_), not supported)** ** tracingPath - show the path found by the planner ** ** tracingLeft - show the advanced program during path following ** ***************************************************************************/ /* rePrintHist(+,+) [history list, level] */ rePrintHist([],_). rePrintHist(_,0) :- !, write(', ...'). rePrintHist([A|H],L) :- write(', '), write(A), L2 is L-1, rePrintHist(H,L2). /* printHist(+,+) [history list, level (>0)] It prints the first 3 actions in the history list */ printHist([],_) :- write('[]'). printHist([A|H],L) :- write('['), write(A), L2 is L-1, rePrintHist(H,L2), write(']'). /* addtail(+,+,-) [element, original list, list with element at the end] */ addtail(E,[],[E]). addtail(E,[H|L1],[H|L2]) :- addtail(E,L1,L2). /* reverseList(+,-) [original list, reversed list] */ reverseList([],[]). reverseList([H|L1],L2) :- reverseList(L1,L3), addtail(H,L3,L2). /* minusTail(+,+,-) [tail list, list with head and tail, head list] */ minusTail(H,H,[]). minusTail(H,[E|H1],[E|H2]) :- minusTail(H,H1,H2). /* getPath(+,+,-) [path list, current history, path] */ getPath([],H,[]). getPath([E1,H1],H,P) :- !, minusTail(H,H1,H2), reverseList(H2,P). getPath([E1,H1|L],H,P) :- getPath(L,H,P). /* traceTest(+,+,+) [complex predicate, value, history] It prints the predicate, its value and also the history list */ traceTest(_,_,_) :- \+ clause(tracingTest,_), !. traceTest(P,V,H) :- format(' test : ~p <- ',[V]), format('~p in ',[P]), printHist(H,3), nl, !. /* tracePath(+,+) [path generated from search, history list] It prints the path or plan generated by search() */ tracePath(_,_) :- \+ clause(tracingPath,_), !. tracePath([],H) :- write(' path : [] in '), printHist(H,3), nl. tracePath(L,H) :- write(' path : '), getPath(L,H,P), printHist(P,15), write(' in '), printHist(H,3), nl. /* traceLeft(+) [program] It prints the advanced program when the executor is following a path */ traceLeft(_) :- \+ clause(tracingLeft,_), !. traceLeft(E) :- write(' left : '), write(E), nl.