% FOOPS - an integration of frames, forward chaining with LEX and MEA, % and Prolog. % Copyright (c) Dennis Merritt, 1986 - Permission granted for % non-commercial use % The first section of the code contains the basic OOPS code, the % second section contains the FRAMES code. % 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 = :-op(700,xfy,\=). % not equal :-op(600,xfy,with). % used for frame instances in rules main :- welcome, supervisor. welcome :- write($FOOPS - A Toy Production System$),nl,nl, write($This is an interpreter for files containing rules coded in the$),nl, write($FOOPS format.$),nl,nl, write($The => prompt accepts four commands:$),nl,nl, write($ load. - prompts for name of rules file$),nl, write($ enclose in single quotes$),nl, write($ go. - starts the inference$),nl, write($ list. - list working memory$),nl, write($ exit. - does what you'd expect$),nl,nl. % the supervisor, uses a repeat fail loop to read and process commands % from the user supervisor :- repeat, write('=>'), read(X), doit(X), X = exit. doit(X) :- do(X). % actions to take based on commands do(exit) :- !. do(go) :- initialize, timer(T1), go, timer(T2), T is 10 * (T2 - T1), write(time-T),nl,!. do(load) :- load, !. do(list) :- lst, !. % lists all of working storage do(list(X)) :- lst(X), !. % lists all which match the pattern do(_) :- write('invalid command'),nl. % loads the rules (Prolog terms) into the Prolog database load :- write('Enter the file name in single quotes (ex. ''room.fkb''.): '), read(F), reconsult(F). % loads a rule file into interpreter work space % assert each of the initial conditions into working storage initialize :- setchron(1), abolish(instantiation,1), delf(all), assert(mea(no)), assert(gid(100)), initial_data(X), assert_list(X), !. initialize :- error(301,[initialization,error]). % working storage is represented by database terms stored % under the key "fact" assert_list([]) :- !. assert_list([H|T]) :- getchron(Time), assert_ws( fact(H,Time) ), !,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 :- conflict_set(CS), write_cs(CS), select_rule(CS,r(Inst,ID,LHS,RHS)), write($Rule Selected $),write(ID),nl, (process(RHS,LHS); true), asserta( instantiation(Inst) ), write($Rule fired $),write(ID),nl, !,go. go. write_cs([]). write_cs([r(I,ID,L,R)|X]) :- write(ID),nl, writeinst(I), write_cs(X). writeinst([]). writeinst([H|T]) :- tab(5), write(H),nl, writeinst(T). conflict_set(CS) :- bagof(r(Inst,ID,LHS,RHS), (rule ID: LHS ==> RHS, match(LHS,Inst)), CS). select_rule(CS,R) :- refract(CS,CS1), mea_filter(0,CS1,[],CSR), lex_sort(CSR,R). list_cs([]). list_cs([K-r(_,ID,_,_)|T]) :- write(ID-K),nl, list_cs(T). % eliminate those rules which have already been tried refract([],[]). refract([r(Inst,_,_,_)|T],TR) :- instantiation(Inst), !, refract(T,TR). refract([H|T],[H|TR]) :- refract(T,TR). % sort the rest of the conflict set according to the lex strategy lex_sort(L,R) :- build_keys(L,LK), % keysort(LK,X), sort(LK,X), reverse(X,[K-R|_]). % build lists of time stamps for lex sort keys build_keys([],[]). build_keys([r(Inst,A,B,C)|T],[Key-r(Inst,A,B,C)|TR]) :- build_chlist(Inst,ChL), sort(ChL,X), reverse(X,Key), build_keys(T,TR). % build a list of just the times of the various matched attributes % for use in rule selection build_chlist([],[]). build_chlist([_/Chron|T],[Chron|TC]) :- build_chlist(T,TC). % add the test for mea if appropriate that emphasizes the first attribute % selected. mea_filter(_,X,_,X) :- not mea(yes), !. mea_filter(_,[],X,X). mea_filter(Max,[r([A/T|Z],B,C,D)|X],Temp,ML) :- T < Max, !, mea_filter(Max,X,Temp,ML). mea_filter(Max,[r([A/T|Z],B,C,D)|X],Temp,ML) :- T = Max, !, mea_filter(Max,X,[r([A/T|Z],B,C,D)|Temp],ML). mea_filter(Max,[r([A/T|Z],B,C,D)|X],Temp,ML) :- T > Max, !, mea_filter(T,X,[r([A/T|Z],B,C,D)],ML). % recursively go through the LHS list, matching conditions against % working storage match([],[]). match([Prem|Rest],[Prem/Time|InstRest]) :- mat(Prem,Time), match(Rest,InstRest). mat(N:Prem,Time) :- !,fact(Prem,Time). mat(Prem,Time) :- fact(Prem,Time). mat(Test,0) :- test(Test). fact(Prem,Time) :- conv(Prem,Class,Name,ReqList), getf(Class,Name,ReqList,Time). assert_ws( fact(Prem,Time) ) :- conv(Prem,Class,Name,UList), addf(Class,Name,UList). update_ws( fact(Prem,Time) ) :- conv(Prem,Class,Name,UList), uptf(Class,Name,UList). retract_ws( fact(Prem,Time) ) :- conv(Prem,Class,Name,UList), delf(Class,Name,UList). conv(Class-Name with List, Class, Name, List). conv(Class-Name, Class, Name, []). % various tests allowed on the LHS test(not(X)) :- fact(X,_), !,fail. test(not(X)) :- !. test(X#Y) :- X=Y,!. test(X>Y) :- X>Y,!. test(X>=Y) :- X>=Y,!. test(X NE, !, fail. error(NE,E) :- nl, write('*** '),write(error-NE),tab(1), write_line(E), !, fail. write_line([]) :- nl. write_line([H|T]) :- write(H),tab(1), write_line(T). time_test :- write('TT> '), read(X), timer(T1), X, timer(T2), nl,nl, T is T2 - T1, write(time-T).