fix group_by_variants/4 and keysort in setof/3 (#1440, #1856)

diff --git a/build/instructions_template.rs b/build/instructions_template.rs
index 5eaa542b6d93a7e241e12707a152ec259182dd3c..25fa6b1bac9d997cc749e1f45547966fa7cbc09f 100644 (file)
--- a/build/instructions_template.rs
+++ b/build/instructions_template.rs
@@ -584,6 +584,8 @@ enum SystemClauseType {
     UnattributedVar,
     #[strum_discriminants(strum(props(Arity = "4", Name = "$get_db_refs")))]
     GetDBRefs,
+    #[strum_discriminants(strum(props(Arity = "2", Name = "$keysort_with_constant_var_ordering")))]
+    KeySortWithConstantVarOrdering,
     REPL(REPLCodePtr),
 }
 
@@ -1653,6 +1655,7 @@ fn generate_instruction_preface() -> TokenStream {
                     &Instruction::CallDeleteAllAttributesFromVar |
                     &Instruction::CallUnattributedVar |
                     &Instruction::CallGetDBRefs |
+                    &Instruction::CallKeySortWithConstantVarOrdering |
                     &Instruction::CallFetchGlobalVar |
                     &Instruction::CallFirstStream |
                     &Instruction::CallFlushOutput |
@@ -1877,6 +1880,7 @@ fn generate_instruction_preface() -> TokenStream {
                     &Instruction::ExecuteDeleteAllAttributesFromVar |
                     &Instruction::ExecuteUnattributedVar |
                     &Instruction::ExecuteGetDBRefs |
+                    &Instruction::ExecuteKeySortWithConstantVarOrdering |
                     &Instruction::ExecuteFetchGlobalVar |
                     &Instruction::ExecuteFirstStream |
                     &Instruction::ExecuteFlushOutput |

diff --git a/src/forms.rs b/src/forms.rs
index 627fb4b212628fb281ed8f973866a48cd0b0eb38..ca5c7ffefb22a687f05a47142b2df66a3f50a7d5 100644 (file)
--- a/src/forms.rs
+++ b/src/forms.rs
@@ -55,6 +55,12 @@ impl AppendOrPrepend {
     }
 }
 
+#[derive(Debug)]
+pub enum VarComparison {
+    Indistinct,
+    Distinct
+}
+
 #[derive(Debug, Clone, Copy, PartialEq, Eq, Hash)]
 pub enum Level {
     Deep,

diff --git a/src/lib/builtins.pl b/src/lib/builtins.pl
index db5282f7f698992abe0cb0f24720dc2301dced43..7769592613765d6caad7c66856e5d8ad694b1438 100644 (file)
--- a/src/lib/builtins.pl
+++ b/src/lib/builtins.pl
@@ -883,12 +883,45 @@ set_difference([X|Xs], [Y|Ys], Zs) :-
 set_difference([], _, []) :- !.
 set_difference(Xs, [], Xs).
 
+
+% variant/2 checks whether X is a variant of Y per the definition in
+% 7.1.6.1 of the ISO standard.
+
+:- non_counted_backtracking variant/4.
+
+variant(X,Y,VPs,VPs0) :-
+    (  var(X) ->
+       var(Y),
+       VPs = [X-Y|VPs0]
+    ;  var(Y) ->
+       false
+    ;  X =.. [FX | XArgs],
+       Y =.. [FX | YArgs],
+       lists:foldl('$call'(builtins:variant), XArgs, YArgs, VPs, VPs0)
+    ).
+
+:- non_counted_backtracking variant/2.
+
+singleton([_]).
+
+variant(X, Y) :-
+    variant(X,Y, VPs, []),
+    keysort(VPs, SVPs),
+    pairs:group_pairs_by_key(SVPs, SVPKs),
+    pairs:pairs_values(SVPKs, Vals),
+    lists:maplist('$call'(builtins:term_variables), Vals, Vs),
+    lists:maplist('$call'(builtins:singleton), Vs),
+    term_variables(Vs, YVars),
+    lists:length(SVPKs, N),
+    lists:length(YVars, N).
+
+
 :- non_counted_backtracking group_by_variant/4.
 
 group_by_variant([V2-S2 | Pairs], V1-S1, [S2 | Solutions], Pairs0) :-
-    V1 = V2, % \+ \+ (V1 = V2), % (2) % iso_ext:variant(V1, V2), % (1)
+    variant(V1, V2),
     !,
-    % V1 = V2, % (3)
+    V1 = V2,
     group_by_variant(Pairs, V2-S2, Solutions, Pairs0).
 group_by_variant(Pairs, _, [], Pairs).
 
@@ -1008,7 +1041,7 @@ setof(Template, Goal, Solution) :-
     term_variables(TemplateVars+GoalVars, TGVs),
     lists:append(TemplateVars, Witnesses0, TGVs),
     findall_with_existential(Template, Goal, PairedSolutions0, Witnesses0, Witnesses),
-    keysort(PairedSolutions0, PairedSolutions),
+    '$keysort_with_constant_var_ordering'(PairedSolutions0, PairedSolutions), % see 7.2.1
     group_by_variants(PairedSolutions, GroupedSolutions),
     iterate_variants_and_sort(GroupedSolutions, Witnesses, Solution).
 

diff --git a/src/machine/dispatch.rs b/src/machine/dispatch.rs
index afe67fb9e0785ea10291dfc69919d8aa9b84dc44..a36bf29b978d8bc202ce5e450284266090c5d891 100644 (file)
--- a/src/machine/dispatch.rs
+++ b/src/machine/dispatch.rs
@@ -141,7 +141,7 @@ impl MachineState {
         Ok(())
     }
 
-    fn keysort(&mut self) -> CallResult {
+    fn keysort(&mut self, var_comparison: VarComparison) -> CallResult {
         self.check_keysort_errors()?;
 
         let stub_gen = || functor_stub(atom!("keysort"), 2);
@@ -155,7 +155,7 @@ impl MachineState {
         }
 
         key_pairs.sort_by(|a1, a2| {
-            compare_term_test!(self, a1.0, a2.0).unwrap_or(Ordering::Less)
+            compare_term_test!(self, a1.0, a2.0, var_comparison).unwrap_or(Ordering::Less)
         });
 
         let key_pairs = key_pairs.into_iter().map(|kp| kp.1);
@@ -1437,11 +1437,11 @@ impl Machine {
                     step_or_fail!(self, self.machine_st.p = self.machine_st.cp);
                 }
                 &Instruction::DefaultCallKeySort => {
-                    try_or_throw!(self.machine_st, self.machine_st.keysort());
+                    try_or_throw!(self.machine_st, self.machine_st.keysort(VarComparison::Distinct));
                     step_or_fail!(self, self.machine_st.p += 1);
                 }
                 &Instruction::DefaultExecuteKeySort => {
-                    try_or_throw!(self.machine_st, self.machine_st.keysort());
+                    try_or_throw!(self.machine_st, self.machine_st.keysort(VarComparison::Distinct));
 
                     if self.machine_st.fail {
                         self.machine_st.backtrack();
@@ -1870,7 +1870,7 @@ impl Machine {
                     }
                 }
                 &Instruction::CallKeySort => {
-                    try_or_throw!(self.machine_st, self.machine_st.keysort());
+                    try_or_throw!(self.machine_st, self.machine_st.keysort(VarComparison::Distinct));
 
                     if self.machine_st.fail {
                         self.machine_st.backtrack();
@@ -1884,7 +1884,35 @@ impl Machine {
                     }
                 }
                 &Instruction::ExecuteKeySort => {
-                    try_or_throw!(self.machine_st, self.machine_st.keysort());
+                    try_or_throw!(self.machine_st, self.machine_st.keysort(VarComparison::Distinct));
+
+                    if self.machine_st.fail {
+                        self.machine_st.backtrack();
+                    } else {
+                        try_or_throw!(
+                            self.machine_st,
+                            (self.machine_st.increment_call_count_fn)(&mut self.machine_st)
+                        );
+
+                        self.machine_st.p = self.machine_st.cp;
+                    }
+                }
+                &Instruction::CallKeySortWithConstantVarOrdering => {
+                    try_or_throw!(self.machine_st, self.machine_st.keysort(VarComparison::Indistinct));
+
+                    if self.machine_st.fail {
+                        self.machine_st.backtrack();
+                    } else {
+                        try_or_throw!(
+                            self.machine_st,
+                            (self.machine_st.increment_call_count_fn)(&mut self.machine_st)
+                        );
+
+                        self.machine_st.p += 1;
+                    }
+                }
+                &Instruction::ExecuteKeySortWithConstantVarOrdering => {
+                    try_or_throw!(self.machine_st, self.machine_st.keysort(VarComparison::Indistinct));
 
                     if self.machine_st.fail {
                         self.machine_st.backtrack();

diff --git a/src/machine/machine_state_impl.rs b/src/machine/machine_state_impl.rs
index 6b08b93ecd7e2876eda740bc4846acd5bea11eee..a161481c655ac9a401e9dfd06637386db3de17c9 100644 (file)
--- a/src/machine/machine_state_impl.rs
+++ b/src/machine/machine_state_impl.rs
@@ -435,7 +435,7 @@ impl MachineState {
         }
     }
 
-    pub fn compare_term_test(&mut self) -> Option<Ordering> {
+    pub fn compare_term_test(&mut self, var_comparison: VarComparison) -> Option<Ordering> {
         let mut tabu_list = IndexSet::new();
 
         while !self.pdl.is_empty() {
@@ -462,12 +462,14 @@ impl MachineState {
 
             match order_cat_v1 {
                 Some(TermOrderCategory::Variable) => {
-                    let v1 = v1.as_var().unwrap();
-                    let v2 = v2.as_var().unwrap();
+                    if let VarComparison::Distinct = var_comparison {
+                        let v1 = v1.as_var().unwrap();
+                        let v2 = v2.as_var().unwrap();
 
-                    if v1 != v2 {
-                        self.pdl.clear();
-                        return Some(v1.cmp(&v2));
+                        if v1 != v2 {
+                            self.pdl.clear();
+                            return Some(v1.cmp(&v2));
+                        }
                     }
                 }
                 Some(TermOrderCategory::FloatingPoint) => {

diff --git a/src/macros.rs b/src/macros.rs
index 8a3ede55909d00f1dffc498a897b5d6d9e15c4dc..9bd89ab7180572ad53c03a4c4001fc7f38e5be11 100644 (file)
--- a/src/macros.rs
+++ b/src/macros.rs
@@ -625,6 +625,12 @@ macro_rules! compare_term_test {
         $machine_st.pdl.push($e2);
         $machine_st.pdl.push($e1);
 
-        $machine_st.compare_term_test()
+        $machine_st.compare_term_test(VarComparison::Distinct)
+    }};
+    ($machine_st:expr, $e1:expr, $e2:expr, $var_comparison:expr) => {{
+        $machine_st.pdl.push($e2);
+        $machine_st.pdl.push($e1);
+
+        $machine_st.compare_term_test($var_comparison)
     }};
 }