add structural equality and inequality predicates.

This commit is contained in:
Mark Thom
2018-02-15 18:31:03 -07:00
parent f1ac75f21d
commit cf67b938c0
6 changed files with 82 additions and 13 deletions

View File

@@ -81,6 +81,8 @@ The following predicates are built-in to rusty-wam.
* `(@>=)/2` * `(@>=)/2`
* `(@=<)/2` * `(@=<)/2`
* `(@<)/2` * `(@<)/2`
* `(=@=)/2`
* `(\=@=)/2`
* `(\+)/1` * `(\+)/1`
* `(==)/2` * `(==)/2`
* `(\==)/2` * `(\==)/2`

View File

@@ -546,6 +546,8 @@ fn get_builtins(atom_tbl: TabledData<Atom>) -> Code {
compare_term_execute!(term_cmp_lte!()), // (@=<)/2, 388. compare_term_execute!(term_cmp_lte!()), // (@=<)/2, 388.
compare_term_execute!(term_cmp_gt!()), // (@>)/2, 389. compare_term_execute!(term_cmp_gt!()), // (@>)/2, 389.
compare_term_execute!(term_cmp_lt!()), // (@<)/2, 390. 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<Atom>) -> (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)); 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 // 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) // (an extra register is needed for the predicate name)
@@ -651,6 +655,9 @@ pub fn build_code_dir(atom_tbl: TabledData<Atom>) -> (Code, CodeDir, OpDir)
code_dir.insert((tabled_rc!("@=<", atom_tbl), 2), (PredicateKeyType::BuiltIn, 388)); 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, 389));
code_dir.insert((tabled_rc!("@<", atom_tbl), 2), (PredicateKeyType::BuiltIn, 390)); 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) (builtin_code, code_dir, op_dir)
} }

View File

@@ -12,6 +12,7 @@ use prolog::or_stack::*;
use prolog::tabled_rc::*; use prolog::tabled_rc::*;
use std::cmp::{max, Ordering}; use std::cmp::{max, Ordering};
use std::collections::HashMap;
use std::rc::Rc; use std::rc::Rc;
macro_rules! try_or_fail { macro_rules! try_or_fail {
@@ -259,7 +260,6 @@ impl MachineState {
} }
fn get_number(&self, at: &ArithmeticTerm) -> Result<Number, Vec<HeapCellValue>> { fn get_number(&self, at: &ArithmeticTerm) -> Result<Number, Vec<HeapCellValue>> {
match at { match at {
&ArithmeticTerm::Reg(r) => { &ArithmeticTerm::Reg(r) => {
let addr = self[r].clone(); let addr = self[r].clone();
@@ -1134,7 +1134,7 @@ impl MachineState {
} }
}; };
} }
fn compare_term_test(&self, a1: Addr, a2: Addr) -> Ordering { fn compare_term_test(&self, a1: Addr, a2: Addr) -> Ordering {
let iter = self.zipped_acyclic_pre_order_iter(a1, a2); let iter = self.zipped_acyclic_pre_order_iter(a1, a2);
@@ -1228,7 +1228,7 @@ impl MachineState {
return n1.cmp(&n2); return n1.cmp(&n2);
} else { } else {
continue; continue;
}, },
(HeapCellValue::Addr(Addr::Lis(_)), HeapCellValue::Addr(Addr::Lis(_))) => (HeapCellValue::Addr(Addr::Lis(_)), HeapCellValue::Addr(Addr::Lis(_))) =>
continue, continue,
(HeapCellValue::Addr(Addr::Lis(_)), HeapCellValue::NamedStr(ar, n, _)) (HeapCellValue::Addr(Addr::Lis(_)), HeapCellValue::NamedStr(ar, n, _))
@@ -1546,6 +1546,49 @@ SetupCallCleanupCutPolicy.")
false 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. // returns true on failure.
fn ground_test(&self) -> bool fn ground_test(&self) -> bool
{ {
@@ -1640,11 +1683,25 @@ SetupCallCleanupCutPolicy.")
}; };
}, },
&ControlInstruction::CompareTermCall(qt) => { &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; self.p += 1;
}, },
&ControlInstruction::CompareTermExecute(qt) => { &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; self.p = self.cp;
}, },
&ControlInstruction::Deallocate => { &ControlInstruction::Deallocate => {

View File

@@ -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 { macro_rules! compare_term_execute {
($qt:expr) => ( ($qt:expr) => (
Line::Control(ControlInstruction::CompareTermExecute($qt)) Line::Control(ControlInstruction::CompareTermExecute($qt))

View File

@@ -1374,6 +1374,15 @@ fn test_queries_on_builtins()
assert_prolog_failure!(&mut wam, "?- 1.1 @< 1."); assert_prolog_failure!(&mut wam, "?- 1.1 @< 1.");
assert_prolog_success!(&mut wam, "?- 1.0 @=< 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, "?- 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] #[test]