1% This is like example1, except that sensing is used to find out which 
    2%    elevator call lights are on.
    3% run: ?- indigolog(control).
    4%
    5%  Respond to "look(i):" (where i is a floor) with either "on." or "off."
    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(N)) :- fl(N).  % check call button on floor n 
   19
   20% Fluents 
   21prim_fluent(floor).             % the floor the elevator is on (1 to 6)
   22prim_fluent(light(N)) :- fl(N). % call button of floor n is (on or off)
   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), light(N), off, true).   % Note: nothing puts light on
   28
   29% Preconditions  of prim actions 
   30poss(down,    neg(floor=1)).
   31poss(up,      neg(floor=6)).
   32poss(off(N),  and(floor=N,light(N)=on)).
   33poss(look(_), true).
   34
   35% Sensing axioms for primitive fluents. 
   36senses(look(N), light(N)).      % look(n) asks for the value of light(n) 
   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), light(N)=on).
   45
   46% Definitions of complex actions    
   47proc(go_floor(N), while(neg(floor=N), if(below_floor(N),up,down))).
   48proc(serve_a_floor, pi(n, [?(next_floor_to_serve(n)), go_floor(n), off(n)])).
   49proc(check_buttons, [look(1), look(2), look(3), look(4), look(5), look(6)]).
   50
   51proc(control, 
   52  [ check_buttons, 
   53    while(or(some(n,light(n)=on), above_floor(1)), 
   54      if(some(n,light(n)=on), serve_a_floor, [down, check_buttons])) ])