]> Repositorios git - scryer-prolog.git/commitdiff
add structural equality and inequality predicates.
authorMark Thom <[email protected]>
Fri, 16 Feb 2018 01:31:03 +0000 (18:31 -0700)
committerMark Thom <[email protected]>
Fri, 16 Feb 2018 01:31:03 +0000 (18:31 -0700)
README.md
src/prolog/builtins.rs
src/prolog/machine/machine_state_impl.rs
src/prolog/macros.rs
src/prolog/parser
src/tests.rs

index 9934a22a2fe32a948c57639d3cfc0fd7aa712f8d..e2b959e048c1622932a5bac06de8c1b8da319b21 100644 (file)
--- 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`
index 7454addbbae4d7931cc6f9bc64d0ed6b090b920a..e6aaa5ea88cd538ded7cb2ba834beeecc2e12fd8 100644 (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)
 }
index d66735ae1075029e3e872384625c5b37262beaf6..0e797f4c8ce0f9c2302f1cb7912a11c4e1bdb90e 100644 (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 => {
index d6b144e28a7b76755f7d032508908e6174a7e2aa..2d892915a6befb555a75c03fcf6a3244b5d5b834 100644 (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))
index 2e9979b9d20abb5b130e788606e3ea8f688a5600..5cd21c56d516f934d89b40935487cfda8ad903b4 160000 (submodule)
@@ -1 +1 @@
-Subproject commit 2e9979b9d20abb5b130e788606e3ea8f688a5600
+Subproject commit 5cd21c56d516f934d89b40935487cfda8ad903b4
index 5f3a3d0890595a6d59db74b521a224b3bc029320..9c1898c41309bb22bce92402eb34b7a1959b42b6 100644 (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]