add term comparison operators.

This commit is contained in:
Mark Thom
2018-02-13 23:34:44 -07:00
parent a1fb4f529b
commit ae323a0cdf
9 changed files with 341 additions and 21 deletions

View File

@@ -389,6 +389,29 @@ impl CompareNumberQT {
}
}
#[derive(Clone, Copy)]
pub enum CompareTermQT {
GreaterThan,
LessThan,
GreaterThanOrEqual,
LessThanOrEqual,
NotEqual,
Equal
}
impl CompareTermQT {
fn name<'a>(self) -> &'a str {
match self {
CompareTermQT::GreaterThan => "@>",
CompareTermQT::LessThan => "@<",
CompareTermQT::GreaterThanOrEqual => "@>=",
CompareTermQT::LessThanOrEqual => "@=<",
CompareTermQT::NotEqual => "\\=@=",
CompareTermQT::Equal => "=@="
}
}
}
// vars of predicate, toplevel offset. Vec<Term> is always a vector
// of vars (we get their adjoining cells this way).
pub type JumpStub = Vec<Term>;
@@ -397,6 +420,7 @@ pub enum QueryTerm {
Arg(Vec<Box<Term>>),
CallN(Vec<Box<Term>>),
Catch(Vec<Box<Term>>),
CompareTerm(CompareTermQT, Vec<Box<Term>>),
Cut,
Display(Vec<Box<Term>>),
DuplicateTerm(Vec<Box<Term>>),
@@ -417,6 +441,7 @@ impl QueryTerm {
match self {
&QueryTerm::Arg(_) => 3,
&QueryTerm::Catch(_) => 3,
&QueryTerm::CompareTerm(..) => 2,
&QueryTerm::Display(_) => 1,
&QueryTerm::Throw(_) => 1,
&QueryTerm::DuplicateTerm(_) => 2,
@@ -446,6 +471,7 @@ pub enum ClauseType<'a> {
CallN,
Catch,
CompareNumber(CompareNumberQT),
CompareTerm(CompareTermQT),
Deep(Level, &'a Cell<RegType>, &'a TabledRc<Atom>, Option<Fixity>),
Display,
DuplicateTerm,
@@ -466,12 +492,13 @@ impl<'a> ClauseType<'a> {
&ClauseType::CallN => "call",
&ClauseType::Catch => "catch",
&ClauseType::CompareNumber(qt) => qt.name(),
&ClauseType::CompareTerm(qt) => qt.name(),
&ClauseType::Display => "display",
&ClauseType::Deep(_, _, name, _) => name.as_str(),
&ClauseType::DuplicateTerm => "duplicate_term",
&ClauseType::Eq => "==",
&ClauseType::Functor => "functor",
&ClauseType::Ground => "ground",
&ClauseType::Ground => "ground",
&ClauseType::Is => "is",
&ClauseType::NotEq => "\\==",
&ClauseType::Root(name) => name.as_str(),
@@ -551,6 +578,32 @@ pub enum Number {
Rational(Rc<Ratio<BigInt>>)
}
impl PartialOrd for Number {
fn partial_cmp(&self, other: &Number) -> Option<Ordering> {
match NumberPair::from(self.clone(), other.clone()) {
NumberPair::Integer(n1, n2) =>
Some(n1.cmp(&n2)),
NumberPair::Float(n1, n2) =>
Some(n1.cmp(&n2)),
NumberPair::Rational(n1, n2) =>
Some(n1.cmp(&n2))
}
}
}
impl Ord for Number {
fn cmp(&self, other: &Number) -> Ordering {
match NumberPair::from(self.clone(), other.clone()) {
NumberPair::Integer(n1, n2) =>
n1.cmp(&n2),
NumberPair::Float(n1, n2) =>
n1.cmp(&n2),
NumberPair::Rational(n1, n2) =>
n1.cmp(&n2)
}
}
}
impl fmt::Display for Number {
fn fmt(&self, f: &mut fmt::Formatter) -> fmt::Result {
match self {
@@ -820,17 +873,17 @@ pub enum ArithmeticInstruction {
}
pub enum BuiltInInstruction {
CleanUpBlock,
CleanUpBlock,
EraseBall,
Fail,
GetArgCall,
GetArgExecute,
GetBall,
GetCurrentBlock,
GetCutPoint(RegType),
GetCutPoint(RegType),
InstallCleaner,
InstallNewBlock,
InternalCallN,
InternalCallN,
ResetBlock,
RestoreCutPolicy,
SetBall,
@@ -851,6 +904,8 @@ pub enum ControlInstruction {
CatchExecute,
CheckCpExecute,
CompareNumber(CompareNumberQT, ArithmeticTerm, ArithmeticTerm),
CompareTermCall(CompareTermQT),
CompareTermExecute(CompareTermQT),
DisplayCall,
DisplayExecute,
Deallocate,
@@ -868,7 +923,7 @@ pub enum ControlInstruction {
GotoCall(usize, usize), // p, arity.
GotoExecute(usize, usize), // p, arity.
GroundCall,
GroundExecute,
GroundExecute,
JmpByCall(usize, usize), // arity, global_offset.
JmpByExecute(usize, usize),
IsCall(RegType, ArithmeticTerm),
@@ -896,7 +951,9 @@ impl ControlInstruction {
&ControlInstruction::Call(_, _, _) => true,
&ControlInstruction::CatchCall => true,
&ControlInstruction::CatchExecute => true,
&ControlInstruction::CompareNumber(..) => true,
&ControlInstruction::CompareNumber(..) => true,
&ControlInstruction::CompareTermCall(..) => true,
&ControlInstruction::CompareTermExecute(..) => true,
&ControlInstruction::DisplayCall => true,
&ControlInstruction::DisplayExecute => true,
&ControlInstruction::DuplicateTermCall => true,
@@ -906,7 +963,7 @@ impl ControlInstruction {
&ControlInstruction::EqCall => true,
&ControlInstruction::EqExecute => true,
&ControlInstruction::Execute(_, _) => true,
&ControlInstruction::CallN(_) => true,
&ControlInstruction::CallN(_) => true,
&ControlInstruction::ExecuteN(_) => true,
&ControlInstruction::FunctorCall => true,
&ControlInstruction::FunctorExecute => true,
@@ -930,7 +987,7 @@ impl ControlInstruction {
&ControlInstruction::IsCall(..) => true,
&ControlInstruction::IsExecute(..) => true,
&ControlInstruction::JmpByCall(..) => true,
&ControlInstruction::JmpByExecute(..) => true,
&ControlInstruction::JmpByExecute(..) => true,
_ => false
}
}

View File

@@ -481,7 +481,7 @@ fn get_builtins(atom_tbl: TabledData<Atom>) -> Code {
retry_me_else!(12),
allocate!(2),
query![put_value!(temp_v!(3), 1)],
reset_block!(),
reset_block!(),
query![put_var!(perm_v!(1), 1)],
get_ball!(),
get_level!(perm_v!(2)),
@@ -489,7 +489,7 @@ fn get_builtins(atom_tbl: TabledData<Atom>) -> Code {
goto_call!(342, 0), // goto run_cleaners_with_handling/0, 342.
query![put_unsafe_value!(1, 1)],
deallocate!(),
goto_execute!(59, 1), // goto throw/1, 59.
goto_execute!(59, 1), // goto throw/1, 59.
trust_me!(),
allocate!(0),
goto_call!(354, 0), // goto run_cleaners_without_handling/0, 354.
@@ -542,6 +542,10 @@ fn get_builtins(atom_tbl: TabledData<Atom>) -> Code {
ground_execute!(), // ground/1, 384.
eq_execute!(), // (==)/2, 385.
not_eq_execute!(), // (\==)/2, 386.
compare_term_execute!(term_cmp_gte!()), // (@>=)/2, 387.
compare_term_execute!(term_cmp_lte!()), // (@=<)/2, 388.
compare_term_execute!(term_cmp_gt!()), // (@>)/2, 389.
compare_term_execute!(term_cmp_lt!()), // (@<)/2, 390.
]
}
@@ -593,7 +597,11 @@ 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));
// 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)
for arity in 0 .. 63 {
@@ -638,7 +646,11 @@ pub fn build_code_dir(atom_tbl: TabledData<Atom>) -> (Code, CodeDir, OpDir)
code_dir.insert((tabled_rc!("ground", atom_tbl), 1), (PredicateKeyType::BuiltIn, 384));
code_dir.insert((tabled_rc!("==", atom_tbl), 2), (PredicateKeyType::BuiltIn, 385));
code_dir.insert((tabled_rc!("\\==", atom_tbl), 2), (PredicateKeyType::BuiltIn, 386));
code_dir.insert((tabled_rc!("\\==", atom_tbl), 2), (PredicateKeyType::BuiltIn, 386));
code_dir.insert((tabled_rc!("@>=", atom_tbl), 2), (PredicateKeyType::BuiltIn, 387));
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));
(builtin_code, code_dir, op_dir)
}

View File

@@ -257,6 +257,8 @@ impl<'a, TermMarker: Allocator<'a>> CodeGenerator<'a, TermMarker>
},
&QueryTerm::Catch(_) =>
code.push(Line::Control(ControlInstruction::CatchCall)),
&QueryTerm::CompareTerm(qt, _) =>
code.push(Line::Control(ControlInstruction::CompareTermCall(qt))),
&QueryTerm::Display(_) =>
code.push(Line::Control(ControlInstruction::DisplayCall)),
&QueryTerm::DuplicateTerm(_) =>
@@ -303,6 +305,8 @@ impl<'a, TermMarker: Allocator<'a>> CodeGenerator<'a, TermMarker>
*ctrl = ControlInstruction::Execute(name, arity),
ControlInstruction::CallN(arity) =>
*ctrl = ControlInstruction::ExecuteN(arity),
ControlInstruction::CompareTermCall(qt) =>
*ctrl = ControlInstruction::CompareTermExecute(qt),
ControlInstruction::DisplayCall =>
*ctrl = ControlInstruction::DisplayExecute,
ControlInstruction::DuplicateTermCall =>

View File

@@ -96,6 +96,20 @@ impl fmt::Display for CompareNumberQT {
}
}
impl fmt::Display for CompareTermQT {
fn fmt(&self, f: &mut fmt::Formatter) -> fmt::Result {
match self {
&CompareTermQT::GreaterThan => write!(f, "@>"),
&CompareTermQT::GreaterThanOrEqual => write!(f, "@>="),
&CompareTermQT::LessThan => write!(f, "@<"),
&CompareTermQT::LessThanOrEqual => write!(f, "@<="),
&CompareTermQT::NotEqual => write!(f, "\\=@="),
&CompareTermQT::Equal => write!(f, "=@="),
}
}
}
impl fmt::Display for ControlInstruction {
fn fmt(&self, f: &mut fmt::Formatter) -> fmt::Result {
match self {
@@ -115,6 +129,10 @@ impl fmt::Display for ControlInstruction {
write!(f, "catch_execute"),
&ControlInstruction::CheckCpExecute =>
write!(f, "check_cp_execute"),
&ControlInstruction::CompareTermCall(qt) =>
write!(f, "compare_term_call {}", qt),
&ControlInstruction::CompareTermExecute(qt) =>
write!(f, "compare_term_execute {}", qt),
&ControlInstruction::DisplayCall =>
write!(f, "display_call"),
&ControlInstruction::DisplayExecute =>

View File

@@ -72,6 +72,10 @@ impl<'a> QueryIterator<'a> {
let state = TermIterState::Clause(0, ClauseType::CompareNumber(qt), terms);
QueryIterator { state_stack: vec![state] }
},
&QueryTerm::CompareTerm(qt, ref terms) => {
let state = TermIterState::Clause(0, ClauseType::CompareTerm(qt), terms);
QueryIterator { state_stack: vec![state] }
},
&QueryTerm::Is(ref terms) => {
let state = TermIterState::Clause(0, ClauseType::Is, terms);
QueryIterator { state_stack: vec![state] }
@@ -302,6 +306,11 @@ impl<'a> ChunkedIterator<'a>
arity = vars.len();
break;
},
&QueryTerm::CompareTerm(..) => {
result.push(term);
arity = 2;
break;
},
&QueryTerm::Term(ref inner_term) =>
if let GenContext::Head = self.term_loc {
result.push(term);

View File

@@ -11,7 +11,7 @@ use prolog::num::rational::Ratio;
use prolog::or_stack::*;
use prolog::tabled_rc::*;
use std::cmp::max;
use std::cmp::{max, Ordering};
use std::rc::Rc;
macro_rules! try_or_fail {
@@ -1112,6 +1112,147 @@ impl MachineState {
self.p += 1;
}
fn compare_term(&mut self, qt: CompareTermQT) {
let a1 = self[temp_v!(1)].clone();
let a2 = self[temp_v!(2)].clone();
match self.compare_term_test(a1, a2) {
Ordering::Greater =>
match qt {
CompareTermQT::GreaterThan | CompareTermQT::GreaterThanOrEqual => return,
_ => self.fail = true
},
Ordering::Equal =>
match qt {
CompareTermQT::GreaterThanOrEqual | CompareTermQT::LessThanOrEqual => return,
_ => self.fail = true
},
Ordering::Less =>
match qt {
CompareTermQT::LessThan | CompareTermQT::LessThanOrEqual => return,
_ => self.fail = true
}
};
}
fn compare_term_test(&self, a1: Addr, a2: Addr) -> Ordering {
let iter = self.zipped_acyclic_pre_order_iter(a1, a2);
for (v1, v2) in iter {
match (v1, v2) {
(HeapCellValue::Addr(Addr::HeapCell(hc1)),
HeapCellValue::Addr(Addr::HeapCell(hc2))) =>
if hc1 != hc2 {
return hc1.cmp(&hc2);
} else {
continue;
},
(HeapCellValue::Addr(Addr::HeapCell(_)), _) =>
return Ordering::Less,
(HeapCellValue::Addr(Addr::StackCell(fr1, sc1)),
HeapCellValue::Addr(Addr::StackCell(fr2, sc2))) =>
if fr1 > fr2 {
return Ordering::Greater;
} else if fr1 < fr2 || sc1 < sc2 {
return Ordering::Less;
} else if sc1 > sc2 {
return Ordering::Greater;
} else {
continue;
},
(HeapCellValue::Addr(Addr::StackCell(..)),
HeapCellValue::Addr(Addr::HeapCell(_))) =>
return Ordering::Greater,
(HeapCellValue::Addr(Addr::StackCell(..)), _) =>
return Ordering::Less,
(HeapCellValue::Addr(Addr::Con(Constant::Number(..))),
HeapCellValue::Addr(Addr::HeapCell(_))) =>
return Ordering::Greater,
(HeapCellValue::Addr(Addr::Con(Constant::Number(..))),
HeapCellValue::Addr(Addr::StackCell(..))) =>
return Ordering::Greater,
(HeapCellValue::Addr(Addr::Con(Constant::Number(n1))),
HeapCellValue::Addr(Addr::Con(Constant::Number(n2)))) =>
if n1 != n2 {
return n1.cmp(&n2);
} else {
continue;
},
(HeapCellValue::Addr(Addr::Con(Constant::Number(_))), _) =>
return Ordering::Less,
(HeapCellValue::Addr(Addr::Con(Constant::String(..))),
HeapCellValue::Addr(Addr::HeapCell(_))) =>
return Ordering::Greater,
(HeapCellValue::Addr(Addr::Con(Constant::String(..))),
HeapCellValue::Addr(Addr::StackCell(..))) =>
return Ordering::Greater,
(HeapCellValue::Addr(Addr::Con(Constant::String(_))),
HeapCellValue::Addr(Addr::Con(Constant::Number(_)))) =>
return Ordering::Greater,
(HeapCellValue::Addr(Addr::Con(Constant::String(s1))),
HeapCellValue::Addr(Addr::Con(Constant::String(s2)))) =>
if s1 != s2 {
return s1.cmp(&s2);
} else {
continue;
},
(HeapCellValue::Addr(Addr::Con(Constant::String(_))), _) =>
return Ordering::Less,
(HeapCellValue::Addr(Addr::Con(Constant::Atom(..))),
HeapCellValue::Addr(Addr::HeapCell(_))) =>
return Ordering::Greater,
(HeapCellValue::Addr(Addr::Con(Constant::Atom(..))),
HeapCellValue::Addr(Addr::StackCell(..))) =>
return Ordering::Greater,
(HeapCellValue::Addr(Addr::Con(Constant::Atom(_))),
HeapCellValue::Addr(Addr::Con(Constant::Number(_)))) =>
return Ordering::Greater,
(HeapCellValue::Addr(Addr::Con(Constant::Atom(_))),
HeapCellValue::Addr(Addr::Con(Constant::String(_)))) =>
return Ordering::Greater,
(HeapCellValue::Addr(Addr::Con(Constant::Atom(s1))),
HeapCellValue::Addr(Addr::Con(Constant::Atom(s2)))) =>
if s1 != s2 {
return s1.cmp(&s2);
} else {
continue;
},
(HeapCellValue::Addr(Addr::Con(Constant::Atom(_))), _) =>
return Ordering::Less,
(HeapCellValue::NamedStr(ar1, n1, _), HeapCellValue::NamedStr(ar2, n2, _)) =>
if ar1 < ar2 {
return Ordering::Less;
} else if ar1 > ar2 {
return Ordering::Greater;
} else if *n1 != *n2 {
return n1.cmp(&n2);
} else {
continue;
},
(HeapCellValue::Addr(Addr::Lis(_)), HeapCellValue::Addr(Addr::Lis(_))) =>
continue,
(HeapCellValue::Addr(Addr::Lis(_)), HeapCellValue::NamedStr(ar, n, _))
| (HeapCellValue::NamedStr(ar, n, _), HeapCellValue::Addr(Addr::Lis(_))) =>
if ar == 2 && *n == "." {
continue;
} else if ar < 2 {
return Ordering::Greater;
} else if ar > 2 {
return Ordering::Less;
} else {
return n.cmp(&String::from("."));
},
(HeapCellValue::NamedStr(..), _) =>
return Ordering::Greater,
(HeapCellValue::Addr(Addr::Lis(_)), _) =>
return Ordering::Greater,
_ => {}
}
};
Ordering::Equal
}
fn reset_block(&mut self, addr: Addr) {
// let addr = self.deref(self[temp_v!(1)].clone());
@@ -1128,7 +1269,7 @@ impl MachineState {
cut_policy: &mut Box<CutPolicy>,
instr: &BuiltInInstruction)
{
match instr {
match instr {
&BuiltInInstruction::GetArgCall =>
try_or_fail!(self, {
let val = self.try_get_arg();
@@ -1273,7 +1414,7 @@ SetupCallCleanupCutPolicy.")
self.or_stack.truncate(self.b);
self.fail = true;
},
},
&BuiltInInstruction::InternalCallN =>
self.handle_internal_call_n(code_dir),
&BuiltInInstruction::Fail => {
@@ -1381,8 +1522,8 @@ SetupCallCleanupCutPolicy.")
// returns true on failure.
fn eq_test(&self) -> bool
{
let a1 = self.store(self.deref(self[temp_v!(1)].clone()));
let a2 = self.store(self.deref(self[temp_v!(2)].clone()));
let a1 = self[temp_v!(1)].clone();
let a2 = self[temp_v!(2)].clone();
let iter = self.zipped_acyclic_pre_order_iter(a1, a2);
@@ -1397,7 +1538,7 @@ SetupCallCleanupCutPolicy.")
(HeapCellValue::Addr(a1), HeapCellValue::Addr(a2)) =>
if a1 != a2 {
return true;
},
},
_ => return true
}
}
@@ -1498,6 +1639,14 @@ SetupCallCleanupCutPolicy.")
}
};
},
&ControlInstruction::CompareTermCall(qt) => {
self.compare_term(qt);
self.p += 1;
},
&ControlInstruction::CompareTermExecute(qt) => {
self.compare_term(qt);
self.p = self.cp;
},
&ControlInstruction::Deallocate => {
let e = self.e;
@@ -1717,7 +1866,7 @@ SetupCallCleanupCutPolicy.")
&ControlInstruction::NotEqExecute => {
self.fail = !self.eq_test();
self.p = self.cp;
},
},
&ControlInstruction::Proceed =>
self.p = self.cp,
&ControlInstruction::ThrowCall => {

View File

@@ -580,3 +580,51 @@ macro_rules! not_eq_execute {
Line::Control(ControlInstruction::NotEqExecute)
)
}
macro_rules! compare_term_call {
($qt:expr) => (
Line::Control(ControlInstruction::CompareTermCall($qt))
)
}
macro_rules! compare_term_execute {
($qt:expr) => (
Line::Control(ControlInstruction::CompareTermExecute($qt))
)
}
macro_rules! term_cmp_gt {
() => (
CompareTermQT::GreaterThan
)
}
macro_rules! term_cmp_lt {
() => (
CompareTermQT::LessThan
)
}
macro_rules! term_cmp_gte {
() => (
CompareTermQT::GreaterThanOrEqual
)
}
macro_rules! term_cmp_lte {
() => (
CompareTermQT::LessThanOrEqual
)
}
macro_rules! term_cmp_ne {
() => (
CompareTermQT::NotEqual
)
}
macro_rules! term_cmp_eq {
() => (
CompareTermQT::Equal
)
}

View File

@@ -1351,6 +1351,29 @@ fn test_queries_on_builtins()
assert_prolog_success!(&mut wam, "?- A \\== B.");
assert_prolog_success!(&mut wam, "?- A \\== 12.1.");
assert_prolog_failure!(&mut wam, "?- X = x, f(X, x) \\== f(x, X).");
assert_prolog_success!(&mut wam, "?- X @=< Y.");
assert_prolog_failure!(&mut wam, "?- X @>= Y.");
assert_prolog_failure!(&mut wam, "?- X @> Y.");
assert_prolog_success!(&mut wam, "?- X @>= X.");
assert_prolog_failure!(&mut wam, "?- atom @=< \"string\".");
assert_prolog_success!(&mut wam, "?- atom @=< atom.");
assert_prolog_failure!(&mut wam, "?- atom @=< aaa.");
assert_prolog_success!(&mut wam, "?- atom @>= \"string\".");
assert_prolog_success!(&mut wam, "?- X is 3 + 3, X @>= Y.");
assert_prolog_success!(&mut wam, "?- f(X) @>= f(X).");
assert_prolog_success!(&mut wam, "?- f(X) @>= a.");
assert_prolog_failure!(&mut wam, "?- f(X) @=< a.");
assert_prolog_success!(&mut wam, "?- [1,2] @=< [1,2].");
assert_prolog_failure!(&mut wam, "?- [1,2,3] @=< [1,2].");
assert_prolog_success!(&mut wam, "?- [] @=< [1,2].");
assert_prolog_failure!(&mut wam, "?- [] @< 1.");
assert_prolog_failure!(&mut wam, "?- [] @< \"string\".");
assert_prolog_failure!(&mut wam, "?- [] @< atom.");
assert_prolog_success!(&mut wam, "?- atom @< [].");
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.
}
#[test]