From cf67b938c0cc9bf6f65e0378a1fc18cf64d99c15 Mon Sep 17 00:00:00 2001 From: Mark Thom Date: Thu, 15 Feb 2018 18:31:03 -0700 Subject: [PATCH] add structural equality and inequality predicates. --- README.md | 2 + src/prolog/builtins.rs | 9 +++- src/prolog/machine/machine_state_impl.rs | 67 ++++++++++++++++++++++-- src/prolog/macros.rs | 6 --- src/prolog/parser | 2 +- src/tests.rs | 9 ++++ 6 files changed, 82 insertions(+), 13 deletions(-) diff --git a/README.md b/README.md index 9934a22a..e2b959e0 100644 --- a/README.md +++ b/README.md @@ -81,6 +81,8 @@ The following predicates are built-in to rusty-wam. * `(@>=)/2` * `(@=<)/2` * `(@<)/2` +* `(=@=)/2` +* `(\=@=)/2` * `(\+)/1` * `(==)/2` * `(\==)/2` diff --git a/src/prolog/builtins.rs b/src/prolog/builtins.rs index 7454addb..e6aaa5ea 100644 --- a/src/prolog/builtins.rs +++ b/src/prolog/builtins.rs @@ -546,6 +546,8 @@ fn get_builtins(atom_tbl: TabledData) -> Code { compare_term_execute!(term_cmp_lte!()), // (@=<)/2, 388. compare_term_execute!(term_cmp_gt!()), // (@>)/2, 389. compare_term_execute!(term_cmp_lt!()), // (@<)/2, 390. + compare_term_execute!(term_cmp_eq!()), // (=@=)/2, 391. + compare_term_execute!(term_cmp_ne!()), // (\=@=)/2, 392. ] } @@ -601,6 +603,8 @@ pub fn build_code_dir(atom_tbl: TabledData) -> (Code, CodeDir, OpDir) op_dir.insert((tabled_rc!("@>=", atom_tbl), Fixity::In), (XFX, 700)); op_dir.insert((tabled_rc!("@<", atom_tbl), Fixity::In), (XFX, 700)); op_dir.insert((tabled_rc!("@>", atom_tbl), Fixity::In), (XFX, 700)); + op_dir.insert((tabled_rc!("=@=", atom_tbl), Fixity::In), (XFX, 700)); + op_dir.insert((tabled_rc!("\\=@=", atom_tbl), Fixity::In), (XFX, 700)); // there are 63 registers in the VM, so call/N is defined for all 0 <= N <= 62 // (an extra register is needed for the predicate name) @@ -651,6 +655,9 @@ pub fn build_code_dir(atom_tbl: TabledData) -> (Code, CodeDir, OpDir) code_dir.insert((tabled_rc!("@=<", atom_tbl), 2), (PredicateKeyType::BuiltIn, 388)); code_dir.insert((tabled_rc!("@>", atom_tbl), 2), (PredicateKeyType::BuiltIn, 389)); code_dir.insert((tabled_rc!("@<", atom_tbl), 2), (PredicateKeyType::BuiltIn, 390)); - + code_dir.insert((tabled_rc!("=@=", atom_tbl), 2), (PredicateKeyType::BuiltIn, 391)); + code_dir.insert((tabled_rc!("\\=@=", atom_tbl), 2), (PredicateKeyType::BuiltIn, 392)); + + (builtin_code, code_dir, op_dir) } diff --git a/src/prolog/machine/machine_state_impl.rs b/src/prolog/machine/machine_state_impl.rs index d66735ae..0e797f4c 100644 --- a/src/prolog/machine/machine_state_impl.rs +++ b/src/prolog/machine/machine_state_impl.rs @@ -12,6 +12,7 @@ use prolog::or_stack::*; use prolog::tabled_rc::*; use std::cmp::{max, Ordering}; +use std::collections::HashMap; use std::rc::Rc; macro_rules! try_or_fail { @@ -259,7 +260,6 @@ impl MachineState { } fn get_number(&self, at: &ArithmeticTerm) -> Result> { - match at { &ArithmeticTerm::Reg(r) => { let addr = self[r].clone(); @@ -1134,7 +1134,7 @@ impl MachineState { } }; } - + fn compare_term_test(&self, a1: Addr, a2: Addr) -> Ordering { let iter = self.zipped_acyclic_pre_order_iter(a1, a2); @@ -1228,7 +1228,7 @@ impl MachineState { return n1.cmp(&n2); } else { continue; - }, + }, (HeapCellValue::Addr(Addr::Lis(_)), HeapCellValue::Addr(Addr::Lis(_))) => continue, (HeapCellValue::Addr(Addr::Lis(_)), HeapCellValue::NamedStr(ar, n, _)) @@ -1546,6 +1546,49 @@ SetupCallCleanupCutPolicy.") false } + // returns true on failure. + fn structural_eq_test(&self) -> bool + { + let a1 = self[temp_v!(1)].clone(); + let a2 = self[temp_v!(2)].clone(); + + let mut var_pairs = HashMap::new(); + + let iter = self.zipped_acyclic_pre_order_iter(a1, a2); + + for (v1, v2) in iter { + match (v1, v2) { + (HeapCellValue::NamedStr(ar1, n1, _), HeapCellValue::NamedStr(ar2, n2, _)) => + if ar1 != ar2 || *n1 != *n2 { + return true; + }, + (HeapCellValue::Addr(Addr::Lis(_)), HeapCellValue::Addr(Addr::Lis(_))) => + continue, + (HeapCellValue::Addr(v1 @ Addr::HeapCell(_)), HeapCellValue::Addr(v2 @ Addr::HeapCell(_))) + | (HeapCellValue::Addr(v1 @ Addr::HeapCell(_)), HeapCellValue::Addr(v2 @ Addr::StackCell(..))) + | (HeapCellValue::Addr(v1 @ Addr::StackCell(..)), HeapCellValue::Addr(v2 @ Addr::StackCell(..))) + | (HeapCellValue::Addr(v1 @ Addr::StackCell(..)), HeapCellValue::Addr(v2 @ Addr::HeapCell(_))) => + match (var_pairs.get(&v1).cloned(), var_pairs.get(&v2).cloned()) { + (Some(ref v2_p), Some(ref v1_p)) if *v1_p == v1 && *v2_p == v2 => + continue, + (Some(_), _) | (_, Some(_)) => + return true, + (None, None) => { + var_pairs.insert(v1.clone(), v2.clone()); + var_pairs.insert(v2, v1); + } + }, + (HeapCellValue::Addr(a1), HeapCellValue::Addr(a2)) => + if a1 != a2 { + return true; + }, + _ => return true + } + } + + false + } + // returns true on failure. fn ground_test(&self) -> bool { @@ -1640,11 +1683,25 @@ SetupCallCleanupCutPolicy.") }; }, &ControlInstruction::CompareTermCall(qt) => { - self.compare_term(qt); + match qt { + CompareTermQT::Equal => + self.fail = self.structural_eq_test(), + CompareTermQT::NotEqual => + self.fail = !self.structural_eq_test(), + _ => self.compare_term(qt) + }; + self.p += 1; }, &ControlInstruction::CompareTermExecute(qt) => { - self.compare_term(qt); + match qt { + CompareTermQT::Equal => + self.fail = self.structural_eq_test(), + CompareTermQT::NotEqual => + self.fail = !self.structural_eq_test(), + _ => self.compare_term(qt) + }; + self.p = self.cp; }, &ControlInstruction::Deallocate => { diff --git a/src/prolog/macros.rs b/src/prolog/macros.rs index d6b144e2..2d892915 100644 --- a/src/prolog/macros.rs +++ b/src/prolog/macros.rs @@ -581,12 +581,6 @@ macro_rules! not_eq_execute { ) } -macro_rules! compare_term_call { - ($qt:expr) => ( - Line::Control(ControlInstruction::CompareTermCall($qt)) - ) -} - macro_rules! compare_term_execute { ($qt:expr) => ( Line::Control(ControlInstruction::CompareTermExecute($qt)) diff --git a/src/prolog/parser b/src/prolog/parser index 2e9979b9..5cd21c56 160000 --- a/src/prolog/parser +++ b/src/prolog/parser @@ -1 +1 @@ -Subproject commit 2e9979b9d20abb5b130e788606e3ea8f688a5600 +Subproject commit 5cd21c56d516f934d89b40935487cfda8ad903b4 diff --git a/src/tests.rs b/src/tests.rs index 5f3a3d08..9c1898c4 100644 --- a/src/tests.rs +++ b/src/tests.rs @@ -1374,6 +1374,15 @@ fn test_queries_on_builtins() assert_prolog_failure!(&mut wam, "?- 1.1 @< 1."); assert_prolog_success!(&mut wam, "?- 1.0 @=< 1."); assert_prolog_success!(&mut wam, "?- 1 @=< 1.0."); //TODO: currently this succeeds. make it fail. + + assert_prolog_success!(&mut wam, "?- X =@= Y."); + assert_prolog_failure!(&mut wam, "?- f(X) =@= f(x)."); + assert_prolog_failure!(&mut wam, "?- X \\=@= X."); + assert_prolog_success!(&mut wam, "?- f(x) =@= f(x)."); + assert_prolog_failure!(&mut wam, "?- [X,Y,Z] =@= [V,W,V]."); + assert_prolog_success!(&mut wam, "?- [X,Y,Z] =@= [V,W,Z]."); + assert_prolog_success!(&mut wam, "?- [X,Y,X] =@= [V,W,V]."); + assert_prolog_success!(&mut wam, "?- g(B) = B, g(A) = A, A =@= B."); } #[test] -- 2.54.0