AIwiki

oops.pl

% 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.