added support for negation and basic relational and arithmetic operators

german-vidal · german-vidal · commit a0b3ec9f42b7 · 2022-03-05T22:54:33.000+01:00
diff --git a/parser.pl b/parser.pl
@@ -89,27 +89,58 @@
   atom_ast(H),
   [punct(":")],
   [punct("-")],
-  atom_ast(B),
+  sep,
+  literal(B),
+  sep,
   body_ast(T),
   [punct(".")].
 
 clause(cl(1,H,[B|T])) -->
   atom_ast(H),
   [punct(":")],
   [punct("-")],
-  atom_ast(B),
+  sep,
+  literal(B),
   body_ast(T),
   [punct(".")].
 
 body_ast([]) --> [].
 body_ast([Atom|T]) -->
+  sep,
   [punct(",")],
-  atom_ast(Atom),
+  sep,
+  literal(Atom),
+  sep,
   body_ast(T).
 
+sep -->
+  {true}.
+sep -->
+  [cntrl("\n")].
+
+literal(Atom) -->
+  atom_ast(Atom).
+literal(not(Atom)) -->
+  [word("not")],
+  atom_ast(Atom).
+
 atom_ast(Atom) -->
   [word(X)],
   {atom_codes(Atom,X)}.
+atom_ast(Atom) -->
+  [word(X)],
+  [punct(A)],
+  [word(Y)],
+  {word_to_term(X,Atom1),word_to_term(Y,Atom2),atom_codes(Op,A),
+    Atom =.. [(Op)|[Atom1,Atom2]]}.
+atom_ast(Atom) -->
+  [word(X)],
+  [punct(A)],
+  [punct(B)],
+  [word(Y)],
+  {word_to_term(X,Atom1),word_to_term(Y,Atom2),
+    string_concat(A,B,C),atom_codes(Op,C),
+    Atom =.. [(Op)|[Atom1,Atom2]]}.
 atom_ast(Atom) -->
   [word(P)],
   [punct("(")],
@@ -126,6 +157,7 @@
   {word_to_term(H,Arg)},
   [punct(",")],
   args_ast(T).
+%missing: lists and functions in general...
 
 comment_ast([]) --> [].
 comment_ast([H|T]) -->
@@ -134,6 +166,9 @@
 comment_ast([H|T]) -->
   [punct(H)],
   comment_ast(T).
+comment_ast([H|T]) -->
+  [other(H)],
+  comment_ast(T).
 
 pred_ast([]) --> [].
 pred_ast([(Pred,N)|R]) -->
diff --git a/temp.txt b/temp.txt
@@ -1 +1 @@
-[[call(0,ancestor(anna,fanny),"anna is the ancestor of fanny"),call(1,parent(anna,fanny),"anna is the parent of fanny"),call(2,mother(anna,fanny),"anna is the mother of fanny")],[call(0,ancestor(daniel,fanny),"daniel is the ancestor of fanny"),call(1,parent(daniel,fanny),"daniel is the parent of fanny"),call(2,mother(daniel,fanny),"daniel is the mother of fanny")],[call(0,ancestor(tim,fanny),"tim is the ancestor of fanny"),call(1,parent(tim,anna),"tim is the parent of anna"),call(2,mother(tim,anna),"tim is the mother of anna"),call(1,ancestor(anna,fanny),"anna is the ancestor of fanny"),call(2,parent(anna,fanny),"anna is the parent of fanny"),call(3,mother(anna,fanny),"anna is the mother of fanny")],[call(0,ancestor(celine,fanny),"celine is the ancestor of fanny"),call(1,parent(celine,daniel),"celine is the parent of daniel"),call(2,father(celine,daniel),"celine is the father of daniel"),call(1,ancestor(daniel,fanny),"daniel is the ancestor of fanny"),call(2,parent(daniel,fanny),"daniel is the parent of fanny"),call(3,mother(daniel,fanny),"daniel is the mother of fanny")]]
+[[call(0,intraocularLens,"intraocular lens are recommended"),call(1,correctiveLens,"needs corrective lenses"),call(2,shortSighted,"is short sighted"),not_call(2,laserSurgery,"did not undergo laser surgery"),call(3,shortSighted,"is short sighted"),call(3,tightOnMoney,"is tight on money"),call(4,student,"is a student"),not_call(4,richParents,"has not rich parents"),not_call(1,glasses,"does not wear glasses"),call(2,correctiveLens,"needs corrective lenses"),call(3,shortSighted,"is short sighted"),not_call(3,laserSurgery,"did not undergo laser surgery"),call(4,shortSighted,"is short sighted"),call(4,tightOnMoney,"is tight on money"),call(5,student,"is a student"),not_call(5,richParents,"has not rich parents"),call(2,caresPracticality,"cares about practicality"),call(3,likesSports,"likes sports"),not_call(1,contactLens,"does not wear contact lenses"),call(2,correctiveLens,"needs corrective lenses"),call(3,shortSighted,"is short sighted"),not_call(3,laserSurgery,"did not undergo laser surgery"),call(4,shortSighted,"is short sighted"),call(4,tightOnMoney,"is tight on money"),call(5,student,"is a student"),not_call(5,richParents,"has not rich parents"),call(2,afraidToTouchEyes,"is afraid to touch eyes")]]
diff --git a/tracer.pl b/tracer.pl
@@ -5,47 +5,7 @@
 :- dynamic fresh_vars/1.
 :- dynamic verbose/0.
 
-main :- 
-    prolog_flag(argv,ArgV),
-    get_options(ArgV,Options,_RemArgV), !,
-    %(member(verbose,Options) -> (assert_verbose, print(Options),nl)
-    %  ; (member(very_verbose,Options) -> (assert_verbose,assert_very_verbose, print(Options),nl) ; true)),
-    ((member(format(F),Options), assert(cli_format(F)),fail)
-     ; true),
-    ((member(file(File),Options), assert(cli_initial_file(File)),fail)
-     ; true),
-    main_cli.
-
-:- dynamic cli_initial_file/1.
-:- dynamic cli_format/1.
-:- dynamic cli_option/1.
-
-main_cli :-
-  cli_initial_file(File),
-  %cli_format(Format),
-  !,
-  xgen(File).
-
-get_options([],Rec,Rem) :- !,Rec=[],Rem=[].
-get_options(Inputs,RecognisedOptions,RemOptions) :-
-   (recognise_option(Inputs,Flag,RemInputs)
-     -> (RecognisedOptions = [Flag|RecO2], 
-         assert(cli_option(Flag)), %%print(Flag),nl,
-         RemO2 = RemOptions)
-     ;  (Inputs = [H|RemInputs], RemOptions = [H|RemO2], RecO2 = RecognisedOptions)
-   ),
-   get_options(RemInputs,RecO2,RemO2).
-
-recognise_option(Inputs,Flag,RemInputs) :-
-   recognised_option(Heads,Flag),
-   append(Heads,RemInputs,Inputs).
-   
-recognised_option(['-file',NT],file(NT)).
-%recognised_option(['-format',F],format(F)).
-
-/*
-xgen(filename)
-*/
+%%%%%%%%%%%%%%%%%%%%% tracer.pl %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 
 :- dynamic cl/3.
 :- dynamic reading/3.
@@ -96,7 +56,7 @@
   retractall(explanations(_)),
   retractall(counter(_)),assertz(counter(0)),
   read_problog_program(File,Program),
-  %print(Program).
+  %print(Program),
   file_base_name(File,FileNameExt),
   string_concat(FileName,'.pl',FileNameExt),
   assertz(filename(FileName)),
@@ -116,6 +76,15 @@
   (reading(A,String,Vars) -> format(string(S),String,Vars)
     ; term_string(A,S)),
   process_trace(R,RT).
+process_trace([not_call(N,A)|R],[not_call(N,A,S)|RT]) :-
+  (reading(not(A),String,Vars) -> format(string(S),String,Vars)
+    ; term_string(A,AS), string_concat("not ",AS,S)),
+  process_trace(R,RT).
+process_trace([failed_call(N,A)|R],[failed_call(N,A,S2)|RT]) :-
+  (reading(A,String,Vars) -> format(string(S),String,Vars)
+    ; term_string(A,S)),
+  string_concat("(failed) ", S, S2),
+  process_trace(R,RT).
 
 run(Q) :-
   findall(Trace,eval(0,Q,Trace),Traces),
@@ -142,6 +111,14 @@
 
 print_trace([]).
 print_trace([call(N,_A,S)|R]) :-
+%  tab(N*3),format("~p~n",[A]),
+  tab(N*3),format(S),nl,
+  print_trace(R).
+print_trace([not_call(N,_A,S)|R]) :-
+%  tab(N*3),format("~p~n",[A]),
+  tab(N*3),format(S),nl,
+  print_trace(R).
+print_trace([failed_call(N,_A,S)|R]) :-
 %  tab(N*3),format("~p~n",[A]),
   tab(N*3),format(S),nl,
   print_trace(R).
@@ -150,12 +127,55 @@
 eval(N,[ret|R],Trace) :-
    M is N-1,
   eval(M,R,Trace).
+eval(N,[A|R],[call(N,A)|Trace]) :-
+  predicate_property(A,built_in),
+  \+ predicate_name(A,"not/1"), 
+  !,
+  call(A),
+  eval(N,R,Trace).
+eval(N,[not(A)|R],[not_call(N,A)|Trace]) :- 
+  ground(A),
+  \+ cl(_,A,_Body),
+  eval(N,R,Trace).
+eval(N,[not(A)|R],[not_call(N,A)|Trace]) :- 
+  ground(A),
+  cl(_,A,Body),
+  M is N+1,
+  eval_not(M,Body,Trace1),
+  !,
+  eval(N,R,Trace2),
+  append(Trace1,Trace2,Trace).
 eval(N,[A|R],[call(N,A)|Trace]) :- 
   cl(_,A,Body),
   append(Body,[ret|R],RB),
   M is N+1,
   eval(M,RB,Trace).
 
+eval_not(N,[ret|R],Trace) :-
+   M is N-1,
+  eval_not(M,R,Trace).
+eval_not(N,[not(A)|_R],[call(N,A)|Trace]) :- 
+  ground(A),
+  cl(_,A,Body),
+  M is N+1,
+  eval(M,Body,Trace).
+eval_not(N,[not(A)|R],[not_call(N,A)|Trace]) :- 
+  ground(A),
+  cl(_,A,Body),
+  M is N+1,
+  \+ eval(M,Body,_Trace),
+  eval_not(N,R,Trace).
+eval_not(N,[A|_R],[failed_call(N,A)]) :- 
+  \+ cl(_,A,_Body).
+eval_not(N,[A|R],[call(N,A)|Trace]) :- 
+  ground(A),
+  cl(_,A,Body),
+  M is N+1,
+  eval(M,Body,Trace1),!,
+  eval_not(N,R,Trace2),
+  append(Trace1,Trace2,Trace).
+
+
   %% findall(SortedExplanation,
   %%         (cl(P,Atom,Body),
   %%          add_empty_ancestors(Body,BodyAn),
@@ -254,6 +274,12 @@
   replace_vars(R,RT).
 
 rvars([],[],_,_).
+rvars([not(Atom)|R],[not(NAtom)|RR],VarList,N) :-
+  !,
+  Atom=..[Pred|Args],
+  rvars_args(Args,VarList,N,ArgsVars,NVarList,NN),
+  NAtom =.. [Pred|ArgsVars],
+  rvars(R,RR,NVarList,NN).
 rvars([Atom|R],[NAtom|RR],VarList,N) :-
   Atom=..[Pred|Args],
   rvars_args(Args,VarList,N,ArgsVars,NVarList,NN),
diff --git a/tracer_shell.pl b/tracer_shell.pl
@@ -9,7 +9,8 @@
 :- dynamic verbose/0.
 
 main :- 
-    current_prolog_flag(argv,ArgV),
+    %current_prolog_flag(argv,ArgV),
+    current_prolog_flag(os_argv,[_,_|ArgV]),
     get_options(ArgV,Options,RemArgV), !,
     (RemArgV = [FileName] 
         -> assert(cli_initial_file(FileName))
@@ -56,6 +57,8 @@
 recognised_option(['-o',F],output(F)).
 recognised_option(['-g',F],goal(F)).
 
+%%%%%%%%%%%%%%%%%%%%% tracer.pl %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
 :- dynamic cl/3.
 :- dynamic reading/3.
 :- dynamic comment/1.
@@ -105,7 +108,7 @@
   retractall(explanations(_)),
   retractall(counter(_)),assertz(counter(0)),
   read_problog_program(File,Program),
-  %print(Program).
+  %print(Program),
   file_base_name(File,FileNameExt),
   string_concat(FileName,'.pl',FileNameExt),
   assertz(filename(FileName)),
@@ -125,6 +128,15 @@
   (reading(A,String,Vars) -> format(string(S),String,Vars)
     ; term_string(A,S)),
   process_trace(R,RT).
+process_trace([not_call(N,A)|R],[not_call(N,A,S)|RT]) :-
+  (reading(not(A),String,Vars) -> format(string(S),String,Vars)
+    ; term_string(A,AS), string_concat("not ",AS,S)),
+  process_trace(R,RT).
+process_trace([failed_call(N,A)|R],[failed_call(N,A,S2)|RT]) :-
+  (reading(A,String,Vars) -> format(string(S),String,Vars)
+    ; term_string(A,S)),
+  string_concat("(failed) ", S, S2),
+  process_trace(R,RT).
 
 run(Q) :-
   findall(Trace,eval(0,Q,Trace),Traces),
@@ -151,6 +163,14 @@
 
 print_trace([]).
 print_trace([call(N,_A,S)|R]) :-
+%  tab(N*3),format("~p~n",[A]),
+  tab(N*3),format(S),nl,
+  print_trace(R).
+print_trace([not_call(N,_A,S)|R]) :-
+%  tab(N*3),format("~p~n",[A]),
+  tab(N*3),format(S),nl,
+  print_trace(R).
+print_trace([failed_call(N,_A,S)|R]) :-
 %  tab(N*3),format("~p~n",[A]),
   tab(N*3),format(S),nl,
   print_trace(R).
@@ -159,12 +179,55 @@
 eval(N,[ret|R],Trace) :-
    M is N-1,
   eval(M,R,Trace).
+eval(N,[A|R],[call(N,A)|Trace]) :-
+  predicate_property(A,built_in),
+  \+ predicate_name(A,"not/1"), 
+  !,
+  call(A),
+  eval(N,R,Trace).
+eval(N,[not(A)|R],[not_call(N,A)|Trace]) :- 
+  ground(A),
+  \+ cl(_,A,_Body),
+  eval(N,R,Trace).
+eval(N,[not(A)|R],[not_call(N,A)|Trace]) :- 
+  ground(A),
+  cl(_,A,Body),
+  M is N+1,
+  eval_not(M,Body,Trace1),
+  !,
+  eval(N,R,Trace2),
+  append(Trace1,Trace2,Trace).
 eval(N,[A|R],[call(N,A)|Trace]) :- 
   cl(_,A,Body),
   append(Body,[ret|R],RB),
   M is N+1,
   eval(M,RB,Trace).
 
+eval_not(N,[ret|R],Trace) :-
+   M is N-1,
+  eval_not(M,R,Trace).
+eval_not(N,[not(A)|_R],[call(N,A)|Trace]) :- 
+  ground(A),
+  cl(_,A,Body),
+  M is N+1,
+  eval(M,Body,Trace).
+eval_not(N,[not(A)|R],[not_call(N,A)|Trace]) :- 
+  ground(A),
+  cl(_,A,Body),
+  M is N+1,
+  \+ eval(M,Body,_Trace),
+  eval_not(N,R,Trace).
+eval_not(N,[A|_R],[failed_call(N,A)]) :- 
+  \+ cl(_,A,_Body).
+eval_not(N,[A|R],[call(N,A)|Trace]) :- 
+  ground(A),
+  cl(_,A,Body),
+  M is N+1,
+  eval(M,Body,Trace1),!,
+  eval_not(N,R,Trace2),
+  append(Trace1,Trace2,Trace).
+
+
   %% findall(SortedExplanation,
   %%         (cl(P,Atom,Body),
   %%          add_empty_ancestors(Body,BodyAn),
@@ -263,6 +326,12 @@
   replace_vars(R,RT).
 
 rvars([],[],_,_).
+rvars([not(Atom)|R],[not(NAtom)|RR],VarList,N) :-
+  !,
+  Atom=..[Pred|Args],
+  rvars_args(Args,VarList,N,ArgsVars,NVarList,NN),
+  NAtom =.. [Pred|ArgsVars],
+  rvars(R,RR,NVarList,NN).
 rvars([Atom|R],[NAtom|RR],VarList,N) :-
   Atom=..[Pred|Args],
   rvars_args(Args,VarList,N,ArgsVars,NVarList,NN),

Original file line number	Diff line number	Diff line change
`@@ -1 +1 @@`
`1`		-[[call(0,ancestor(anna,fanny),"anna is the ancestor of fanny"),call(1,parent(anna,fanny),"anna is the parent of fanny"),call(2,mother(anna,fanny),"anna is the mother of fanny")],[call(0,ancestor(daniel,fanny),"daniel is the ancestor of fanny"),call(1,parent(daniel,fanny),"daniel is the parent of fanny"),call(2,mother(daniel,fanny),"daniel is the mother of fanny")],[call(0,ancestor(tim,fanny),"tim is the ancestor of fanny"),call(1,parent(tim,anna),"tim is the parent of anna"),call(2,mother(tim,anna),"tim is the mother of anna"),call(1,ancestor(anna,fanny),"anna is the ancestor of fanny"),call(2,parent(anna,fanny),"anna is the parent of fanny"),call(3,mother(anna,fanny),"anna is the mother of fanny")],[call(0,ancestor(celine,fanny),"celine is the ancestor of fanny"),call(1,parent(celine,daniel),"celine is the parent of daniel"),call(2,father(celine,daniel),"celine is the father of daniel"),call(1,ancestor(daniel,fanny),"daniel is the ancestor of fanny"),call(2,parent(daniel,fanny),"daniel is the parent of fanny"),call(3,mother(daniel,fanny),"daniel is the mother of fanny")]]
	`1`	+[[call(0,intraocularLens,"intraocular lens are recommended"),call(1,correctiveLens,"needs corrective lenses"),call(2,shortSighted,"is short sighted"),not_call(2,laserSurgery,"did not undergo laser surgery"),call(3,shortSighted,"is short sighted"),call(3,tightOnMoney,"is tight on money"),call(4,student,"is a student"),not_call(4,richParents,"has not rich parents"),not_call(1,glasses,"does not wear glasses"),call(2,correctiveLens,"needs corrective lenses"),call(3,shortSighted,"is short sighted"),not_call(3,laserSurgery,"did not undergo laser surgery"),call(4,shortSighted,"is short sighted"),call(4,tightOnMoney,"is tight on money"),call(5,student,"is a student"),not_call(5,richParents,"has not rich parents"),call(2,caresPracticality,"cares about practicality"),call(3,likesSports,"likes sports"),not_call(1,contactLens,"does not wear contact lenses"),call(2,correctiveLens,"needs corrective lenses"),call(3,shortSighted,"is short sighted"),not_call(3,laserSurgery,"did not undergo laser surgery"),call(4,shortSighted,"is short sighted"),call(4,tightOnMoney,"is tight on money"),call(5,student,"is a student"),not_call(5,richParents,"has not rich parents"),call(2,afraidToTouchEyes,"is afraid to touch eyes")]]