1% This is the original Golog elevator with no exogenous events, no sensing 
    2% Serve each floor whose call button is on initially, then park the elevator.
    3% run: ?- indigolog(control). 
    4%
    5% No user input is required.
    6
    7% Interface to the outside world via read and write 
    8execute(A,Sr) :- ask_execute(A,Sr).
    9exog_occurs(_) :- fail.
   10
   11fl(N) :- N=1; N=2; N=3; N=4; N=5; N=6.    % the 6 elevator floors
   12
   13% Actions 
   14prim_action(down).              % elevator down one floor
   15prim_action(up).                % elevator up one floor
   16prim_action(off(N)) :- fl(N).   % turn off call button on floor n
   17prim_action(open).              % open elevator door
   18prim_action(close).             % close elevator door
   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 (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 turns a 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(open, true).
   34poss(close, true).
   35
   36% Initial state: elevator is at floor 3, and lights 2 and 5 are on
   37initially(floor,3).
   38initially(light(1), off).
   39initially(light(2), on).
   40initially(light(3), off).
   41initially(light(4), off).
   42initially(light(5), on).
   43initially(light(6), off).
   44
   45% Definitions of complex conditions
   46proc(below_floor(N), floor<N).
   47proc(above_floor(N), floor>N).
   48proc(next_floor_to_serve(N), light(N)=on).
   49
   50% Definitions of complex actions
   51proc(go_floor(N), while(neg(floor=N), if(below_floor(N),up,down))).
   52proc(serve_a_floor, pi(n, 
   53   [ ?(next_floor_to_serve(n)), go_floor(n), open, close, off(n) ])).
   54proc(control, 
   55   [ while( some(n,light(n)=on), serve_a_floor ),
   56     go_floor(1),
   57     open ] )