rishi/scryer-prolog
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

add structural equality and inequality predicates.

Browse Source
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
Download Patch File Download Diff File Expand all files Collapse all files

9
src/prolog/builtins.rs
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_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<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));
// 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<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, 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)
}

67
src/prolog/machine/machine_state_impl.rs
View File

@@ -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<Number, Vec<HeapCellValue>> {
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 => {

6
src/prolog/macros.rs
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 {
($qt:expr) => (
Line::Control(ControlInstruction::CompareTermExecute($qt))

2
src/prolog/parser

Submodule src/prolog/parser updated: 2e9979b9d2...5cd21c56d5

9
src/tests.rs
View File

@@ -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]