Browse Source

Add constraint checking for extension constraints

Samuel W. Flint 4 years ago
parent
commit
bf16d9e0b2
1 changed files with 13 additions and 0 deletions
  1. 13 0
      checking.lisp

+ 13 - 0
checking.lisp

@@ -27,4 +27,17 @@
                       :test #'equal))
             variables)))
 
+(defmethod check-constraint ((constraint <constraint-extension>) vvps &key &allow-other-keys)
+  (unless (= (length vvps) (constraint-adicity constraint))
+    (error "Incorrect number of VVPs (~a vs. ~a)."
+           (length vvps)
+           (constraint-adicity constraint)))
+  (let* ((cvvps (fix-vvps vvps constraint))
+         (the-values (mapcar #'cdr cvvps))
+         (is-member-p (member the-values (constraints-list constraint)
+                              :test #'equalp)))
+    (if (nogoodsp constraint)
+        (not is-member-p)
+        is-member-p)))
+
 ;;; End lcsp