From 101d0548db9d22b9ba09f05a0bdc59f5543d9be2 Mon Sep 17 00:00:00 2001 From: Mark Date: Fri, 14 Jul 2023 17:01:46 -0600 Subject: [PATCH] fix group_by_variants/4 and keysort in setof/3 (#1440, #1856) --- build/instructions_template.rs | 4 ++++ src/forms.rs | 6 +++++ src/lib/builtins.pl | 39 +++++++++++++++++++++++++++--- src/machine/dispatch.rs | 40 ++++++++++++++++++++++++++----- src/machine/machine_state_impl.rs | 14 ++++++----- src/macros.rs | 8 ++++++- 6 files changed, 95 insertions(+), 16 deletions(-) diff --git a/build/instructions_template.rs b/build/instructions_template.rs index 5eaa542b..25fa6b1b 100644 --- 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 627fb4b2..ca5c7ffe 100644 --- 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 db5282f7..77695926 100644 --- 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 afe67fb9..a36bf29b 100644 --- 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 6b08b93e..a161481c 100644 --- 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 { + pub fn compare_term_test(&mut self, var_comparison: VarComparison) -> Option { 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 8a3ede55..9bd89ab7 100644 --- 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) }}; } -- 2.54.0