1% This is like example4, except that there is a single sensing action
    2%  that is assumed to return the state of all the lights.
    3% run: ?- indigolog(control).
    4%
    5%  Respond to "look:" with a list of 6 elements, each of which is 0 or 1
    6%  The elevator stops when it is parked and all the lights are off.
    7
    8% Interface to the outside world via read and write 
    9execute(A,Sr) :- ask_execute(A,Sr).
   10exog_occurs(_) :- fail.
   11
   12fl(N) :- N=1; N=2; N=3; N=4; N=5; N=6.    % the elevator floors
   13
   14% Actions 
   15prim_action(down).              % elevator down one floor 
   16prim_action(up).                % elevator up one floor
   17prim_action(off(N)) :- fl(N).   % turn off call button on floor n
   18prim_action(look).              % check all call buttons 
   19
   20% Fluents 
   21prim_fluent(floor).             % the floor the elevator is on (1 to 6)
   22prim_fluent(lights).            % call buttons of all floors (a list)
   23
   24% Causal laws
   25causes_val(up,   floor, N, N is floor+1).
   26causes_val(down, floor, N, N is floor-1).
   27causes_val(off(N), lights, L, repl(lights,L,N,0)).   % No turnon action
   28
   29% Preconditions  of prim actions
   30poss(down,    neg(floor=1)).
   31poss(up,      neg(floor=6)).
   32poss(off(N),  and(floor=N,lighton(N))).
   33poss(look, true).
   34
   35% Sensing axioms for primitive fluents. 
   36senses(look, lights).           % ask for current value of all lights
   37
   38% Initial state: elevator is at floor 3, the button states are unknown 
   39initially(floor,3).
   40
   41% Definitions of complex conditions   
   42proc(below_floor(N), floor<N).
   43proc(above_floor(N), floor>N).
   44proc(next_floor_to_serve(N), lighton(N)).
   45proc(lighton(N), nth1(N,lights,1)).
   46proc(floor_waiting, member(1,lights)).
   47
   48% List utility used above
   49repl([_|L],[X|L],1,X).
   50repl([Y|L1],[Y|L2],N,X) :- repl(L1,L2,M,X), N is M+1.
   51
   52% nth([X|_],1,X).
   53% nth([_|L],N,X) :- nth(L,M,X), N is M+1.
   54
   55% member(X,[X|_]).
   56% member(X,[_|L]) :- member(X,L).
   57
   58% Definitions of complex actions
   59proc(go_floor(N), while(neg(floor=N), if(below_floor(N),up,down))).
   60proc(serve_a_floor, pi(n, [?(next_floor_to_serve(n)), go_floor(n), off(n)])).
   61proc(control, 
   62  [ look, 
   63    while(or(floor_waiting, above_floor(1)), 
   64      if(floor_waiting, serve_a_floor, [down,look])) ])