% OOPS2 - A toy production system interpreter.  It uses a forward chaining,
%        data driven, rule based approach for expert system development.
%
% Version 2, the simplest version without LEX, MEA, or conflict sets
%
% author Dennis Merritt
% Copyright (c) Dennis Merritt, 1986


% fixed for SWI Prolog by GJN 12.2005
%%%%%%%%%  To start program write main. or uncomment the last line in this file %%%%%%%%%%%%%%%%%%%%%
:- write('********To start program write main.**********').

info(X):-
   jpl_datums_to_array(X,Q),
   jpl_new('miw2.Info',[Q],_).
   
readF(File):-
				jpl_new('miw2.PlFileChooser',[],F),
				jpl_call(F,getFile,[],File).

control(X,Buttons):-
            repeat,
			jpl_datums_to_array(Buttons,B),
            jpl_new('miw2.ControlForm',[X,B],F),
			jpl_call(F,getValue,[],V),
			change(V,Z),
			doit(Z),
			Z = exit.

change(0,load).
change(1,list).			
change(2,go).
   
% operator definitions

:-op(800,xfx,==>).          % used to separate LHS and RHS of rule
:-op(500,xfy,:).            % used to separate attributes and values
:-op(810,fx,rule).          % used to define rule
:-op(700,xfy,#).            % used for unification instead of =

main :- welcome, write_help.

welcome:-
	info(['OOPS - A Toy Production System',
	'This is an interpreter for files containing rules coded in the',
	'OOPS format.']).

write_help :-
	control('Commands:\n
load -  prompts for name of rules file enclose in single quotes\n
list -  lists working memory\n
go   -  starts the inference\n
exit -  does what you\'d expect',['load','list','go']).

% the supervisor, uses a repeat fail loop to read and process commands
% from the user

supervisor :-
	repeat,
	doit(X),
	X = exit.

doit(X) :- do(X).

% actions to take based on commands

do(exit) :- !.
do(go) :- initialize,go,!.
do(load) :-load,!.
do(list) :- lst,!.       % lists all of working storage
do(list(X)) :- lst(X),!. % lists all which match the pattern
do(_) :- info(['invalid command!']),nl,write_help.

% loads the rules (Prolog terms) into the Prolog database

load :-
	readF(F),
	consult(F).            % loads a rule file into interpreter work space

% assert each of the initial conditions into working storage

initialize :-
	initial_data(X),
	assert_list(X).

% working storage is represented by database terms stored
% under the key "fact"

assert_list([]) :- !.
assert_list([H|T]) :-
	assertz( fact(H) ),
	!,assert_list(T).

% the main inference loop, find a rule and try it.  if it fired, say so
% and repeat the process.  if not go back and try the next rule.  when
% no rules succeed, stop the inference

go :-
	call(rule ID: LHS ==> RHS),
	try(LHS,RHS),
	info(['Rule fired ',ID]),
	!,go.
go.

% find the current conflict set.

% conflict_set(CS) :-
%	bagof(rule ID: LHS ==> RHS,
%		[rule ID: LHS ==> RHS, match(LHS)],CS).

% match the LHS against working storage, if it succeeds process the
% actions from the RHS

try(LHS,RHS) :-
	match(LHS),
	process(RHS,LHS),!.

% recursively go through the LHS list, matching conditions against
% working storage

match([]) :- !.
match([_:Prem|Rest]) :-
	!,
	(fact(Prem);
	 test(Prem)),          % a comparison test rather than a fact
	match(Rest).
match([Prem|Rest]) :-
	(fact(Prem);    % condition number not specified
	 test(Prem)),
	match(Rest).

% various tests allowed on the LHS

test(not(X)) :-
	fact(X),
	!,fail.
test(not(_)) :- !.
test(X#Y) :- X=Y,!.
test(X>Y) :- X>Y,!.
test(X>=Y) :- X>=Y,!.
test(X<Y) :- X<Y,!.
test(X=<Y) :- X=<Y,!.
test(X = Y) :- X is Y,!.
test(member(X,Y)) :- member(X,Y),!.

% recursively execute each of the actions in the RHS list

process([],_) :- !.
process([Action|Rest],LHS) :-
	take(Action,LHS),
	!,process(Rest,LHS).

% if its retract, use the reference numbers stored in the Lrefs list,
% otherwise just take the action

take(retract(N),LHS) :-
	(N == all; integer(N)),
	retr(N,LHS),!.
take(A,_) :-take(A),!.

take(retract(X)) :- retract(fact(X)), !.
take(assert(X)) :- asserta(fact(X)),write(adding-X),info([{X}]),nl,!.
take(X # Y) :- X=Y,!.
take(X = Y) :- X is Y,!.
take(write(X)) :- write(X),!.
take(nl) :- nl,!.
take(read(X)) :- read(X),!.
take(prompt(X,Y)) :- nl,write(X),read(Y),!.
take(member(X,Y)) :- member(X,Y), !.
take(list(X)) :- lst(X), !.

% logic for retraction

retr(all,LHS) :-retrall(LHS),!.
retr(N,[]) :-write('retract error, no '-N),nl,!.
retr(N,[N:Prem|_]) :- retract(fact(Prem)),!.
retr(N,[_|Rest]) :- !,retr(N,Rest).

retrall([]).
retrall([_:Prem|Rest]) :-
	retract(fact(Prem)),
	!, retrall(Rest).
retrall([Prem|Rest]) :-
	retract(fact(Prem)),
	!, retrall(Rest).
retrall([_|Rest]) :-		% must have been a test
	retrall(Rest).

% list all of the terms in working storage

lst :-
	fact(X),
	info([{X}]),nl,
	fail.
lst :- !.

% lists all of the terms which match the pattern

lst(X) :-
	fact(X),
	info([{X}]),nl,
	fail.
lst(_) :- !.

% utilities

member(X,[X|_]).
member(X,[_|Z]) :- member(X,Z).

:-dynamic(fact/1).

% :- main.