Merge pull request #2934 from linas/or-pattern-compile

OrLink w/evaluatables fix

opencog/atoms/pattern/PatternLink.cc

@@ -1061,7 +1061,7 @@ void PatternLink::make_term_tree_recursive(const PatternTermPtr& root,
                                            PatternTermPtr& ptm)
 {
 	// `h` is usually the same as `term`, unless there's quotation.
-	Handle h(ptm->getHandle());
+	const Handle& h(ptm->getHandle());
 	_pat.connected_terms_map[{h, root}].emplace_back(ptm);
 
 	// If the current node is a bound variable, store this as a
@@ -1154,6 +1154,12 @@ void PatternLink::make_term_tree_recursive(const PatternTermPtr& root,
 		}
 	}
 
+	if (PRESENT_LINK == t)
+	{
+		ptm->markPresent();
+		return;
+	}
+
 	// If a term is literal then the corresponding pattern term
 	// should be also.
 	if (CHOICE_LINK == t)
@@ -1167,12 +1173,24 @@ void PatternLink::make_term_tree_recursive(const PatternTermPtr& root,
 		return;
 	}
 
-	if (PRESENT_LINK == t)
+	// Much like the ChoiceLink above, except that the term itself
+	// cannot be marked as a choice.
+	if (OR_LINK == t)
 	{
-		ptm->markPresent();
+		for (PatternTermPtr& optm: ptm->getOutgoingSet())
+		{
+			if (PRESENT_LINK == optm->getHandle()->get_type())
+				optm->markPresent();
+		}
 		return;
 	}
 
+	// Skip the second pass below, when exploring the insides of an
+	// OrLink.  The problem is that add_unaries below will add terms
+	// inside the OrLink as mandatory, when of course, they are not.
+	const Handle& hpnt(parent->getHandle());
+	if (hpnt and OR_LINK == hpnt->get_type()) return;
+
 	// Second pass for evaluatables - this time to mark the left-overs
 	// as literals. We need to do this AFTER recursion, not before.
 	if ((parent->getHandle() == nullptr or parent->hasEvaluatable())

tests/query/CMakeLists.txt

@@ -113,6 +113,7 @@ IF (HAVE_GUILE)
 	ADD_GUILE_TEST(OrLinkTest or-link-test.scm)
 	ADD_GUILE_TEST(OrMoreTest or-more-test.scm)
 	ADD_GUILE_TEST(OrBindTest or-bind-test.scm)
+	ADD_GUILE_TEST(OrEvalTest or-eval-test.scm)
 	ADD_GUILE_TEST(QuoteStartTest quote-start-test.scm)
 	ADD_GUILE_TEST(RecursiveTest recursive-test.scm)
 

tests/query/VirtualUTest.cxxtest

@@ -56,7 +56,6 @@ public:
 	void tearDown(void);
 
 	void test_satisfaction(void);
-	void xtest_disjunction(void);
 };
 
 void VirtualUTest::tearDown(void)
@@ -110,21 +109,3 @@ void VirtualUTest::test_satisfaction(void)
 
 	logger().debug("END TEST: %s", __FUNCTION__);
 }
-
-/*
- * Test disjunction of virtual clauses (including one that is always true)
- */
-void VirtualUTest::xtest_disjunction(void)
-{
-	logger().debug("BEGIN TEST: %s", __FUNCTION__);
-
-	eval->eval("(load-from-path \"tests/query/virtual-disjunction.scm\")");
-
-	Handle result = eval->eval_h("(cog-execute! query)");
-	Handle human = as->add_link(SET_LINK, as->add_node(CONCEPT_NODE, "human"));
-	printf("Expecting human, got %s", result->to_string().c_str());
-
-	TS_ASSERT_EQUALS(result, human);
-
-	logger().debug("END TEST: %s", __FUNCTION__);
-}

tests/query/or-eval-test.scm

@@ -0,0 +1,71 @@
+;
+; or-eval-test.scm -- Verify OrLink with GroundedPredicates in it
+; Tests for problem reported in opencog/atomspace#2931
+
+(use-modules (opencog) (opencog exec))
+(use-modules (opencog test-runner))
+
+;; Functions
+(define-public (bool->tv b) (stv (if b 1 0) 1))
+(define-public (tv->bool tv) (equal? (stv 1 1) tv))
+(define-public (true? A) (bool->tv (tv->bool (cog-tv A))))
+(define (always-true) (stv 1 1))
+
+;; KB
+(Inheritance (stv 1 1) (Concept "human") (Concept "person"))
+
+;; Query
+(define query-plain
+(Get
+  (TypedVariable (Variable "$A") (Type "ConceptNode"))
+  (And
+    (Or
+      (Evaluation
+        (GroundedPredicate "scm: true?")
+        (Evaluation
+          (Predicate "P")
+          (List
+            (Concept "dog")
+            (Variable "$A"))))
+      (Evaluation
+        (GroundedPredicate "scm: always-true")
+        (List)))
+    (Inheritance
+      (Variable "$A")
+      (Concept "person"))))
+)
+
+(define query-present
+(Get
+  (TypedVariable (Variable "$A") (Type "ConceptNode"))
+  (And
+    (Or
+      (Evaluation
+        (GroundedPredicate "scm: true?")
+        (Evaluation
+          (Predicate "P")
+          (List
+            (Concept "dog")
+            (Variable "$A"))))
+      (Evaluation
+        (GroundedPredicate "scm: always-true")
+        (List)))
+    (Present
+      (Inheritance
+        (Variable "$A")
+        (Concept "person")))))
+)
+
+(opencog-test-runner)
+(define tname "or-eval-test")
+(test-begin tname)
+
+(test-assert "human-plain"
+   (equal? (cog-execute! query-plain) (Set (Concept "human"))))
+
+(test-assert "human-present"
+   (equal? (cog-execute! query-present) (Set (Concept "human"))))
+
+(test-end tname)
+
+(opencog-test-end)