add term comparison operators.

src/prolog/ast.rs

@@ -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,6 +492,7 @@ 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",
@@ -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 {
@@ -851,6 +904,8 @@ pub enum ControlInstruction {
     CatchExecute,
     CheckCpExecute,
     CompareNumber(CompareNumberQT, ArithmeticTerm, ArithmeticTerm),
+    CompareTermCall(CompareTermQT),
+    CompareTermExecute(CompareTermQT),
     DisplayCall,
     DisplayExecute,
     Deallocate,
@@ -897,6 +952,8 @@ impl ControlInstruction {
             &ControlInstruction::CatchCall => true,
             &ControlInstruction::CatchExecute => true,
             &ControlInstruction::CompareNumber(..) => true,
+            &ControlInstruction::CompareTermCall(..) => true,
+            &ControlInstruction::CompareTermExecute(..) => true,
             &ControlInstruction::DisplayCall => true,
             &ControlInstruction::DisplayExecute => true,
             &ControlInstruction::DuplicateTermCall => true,

src/prolog/builtins.rs

@@ -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,6 +597,10 @@ 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)
@@ -639,6 +647,10 @@ 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, 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)
 }

src/prolog/codegen.rs

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

src/prolog/io.rs

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

src/prolog/iterators.rs

@@ -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);

src/prolog/machine/machine_state_impl.rs

@@ -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());
 
@@ -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 a1 = self[temp_v!(1)].clone();
-        let a2 = self.store(self.deref(self[temp_v!(2)].clone()));
+        let a2 = self[temp_v!(2)].clone();
 
         let iter = self.zipped_acyclic_pre_order_iter(a1, a2);
 
@@ -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;
 

src/prolog/macros.rs

@@ -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
+    )
+}

src/tests.rs

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