Fix a bug in nested search.
Toshimi Sawada
5 years ago
| 139 | 139 | (bind nil) ; .... |
| 140 | 140 | (if nil) ; |
| 141 | 141 | (pr-out? nil) ; |
| 142 | (term-hash nil :type simple-vector) ; | |
| 142 | 143 | ) |
| 143 | 144 | |
| 144 | 145 | (defun print-sch-context (ctxt &optional (stream *standard-output*) &rest ignore) |
| 749 | 750 | (term-hash-equal (term-builtin-value term)))) |
| 750 | 751 | ((term-is-variable? term) (term-hash-eq term)))) |
| 751 | 752 | |
| 752 | (defun dump-cexec-term-hash (term-hash &optional (size term-hash-size)) | |
| 753 | (dotimes (x size) | |
| 754 | (let ((ent (svref term-hash x))) | |
| 755 | (when ent | |
| 756 | (format t "~%[~3d]: ~d entrie(s)" x (length ent)) | |
| 757 | (dotimes (y (length ent)) | |
| 758 | (let ((e (nth y ent))) | |
| 759 | (format t "~%(~d)" y) | |
| 760 | (let ((*print-indent* (+ 2 *print-indent*))) | |
| 761 | (term-print (car e)) | |
| 762 | (print-next) | |
| 763 | (princ "==>") | |
| 764 | (print-next) | |
| 765 | (term-print (cdr e))))))))) | |
| 753 | (defun dump-cexec-term-hash (&optional (size term-hash-size)) | |
| 754 | (let ((mod (get-context-module))) | |
| 755 | (unless mod (return-from dump-cexec-term-hash nil)) | |
| 756 | (with-in-module (mod) | |
| 757 | (dotimes (x size) | |
| 758 | (let ((ent (svref .cexec-term-hash. x))) | |
| 759 | (when ent | |
| 760 | (format t "~%[~3d]: ~d entrie(s)" x (length ent)) | |
| 761 | (dotimes (y (length ent)) | |
| 762 | (let ((e (nth y ent))) | |
| 763 | (format t "~%(~d)" y) | |
| 764 | (let ((*print-indent* (+ 2 *print-indent*))) | |
| 765 | (term-print (car e)) | |
| 766 | (print-next) | |
| 767 | (princ "==>") | |
| 768 | (print-next) | |
| 769 | (term-print (cdr e))))))))))) | |
| 766 | 770 | |
| 767 | 771 | (defvar .cexec-term-hash. nil) |
| 768 | ||
| 769 | (declaim (inline init-rwl-term-hash)) | |
| 770 | (defun init-rwl-term-hash (depth) | |
| 771 | (declare (type fixnum depth) | |
| 772 | (optimize (speed 3) (safety 0))) | |
| 773 | (unless .cexec-term-hash. | |
| 774 | (setq .cexec-term-hash. (alloc-svec term-hash-size))) | |
| 775 | (when (zerop depth) | |
| 776 | (dotimes (x term-hash-size) | |
| 777 | (setf (svref .cexec-term-hash. x) nil)))) | |
| 778 | 772 | |
| 779 | 773 | (declaim (inline get-sch-hashed-term)) |
| 780 | 774 | (defun get-sch-hashed-term (term term-hash) |
| 1136 | 1130 | (push (dag-node-datum node) |
| 1137 | 1131 | (rwl-sch-context-answers sch-context)) |
| 1138 | 1132 | ;; |
| 1139 | (when (and (= (rwl-state-depth state) 0) | |
| 1133 | (when (and ;; (= (rwl-state-depth state) 0) | |
| 1140 | 1134 | (not *rwl-search-no-state-report*)) |
| 1141 | 1135 | (format t "~%** Found [state ~D-~D] " (rwl-state-depth state) (rwl-state-state state)) |
| 1142 | 1136 | (term-print-with-sort (rwl-state-term state)) |
| 1275 | 1269 | :max-depth max-depth |
| 1276 | 1270 | :state-predicate nil |
| 1277 | 1271 | :bind bind |
| 1278 | :if if)) | |
| 1272 | :if if | |
| 1273 | :term-hash (alloc-svec term-hash-size))) | |
| 1279 | 1274 | (root nil) |
| 1280 | 1275 | (res nil) |
| 1281 | 1276 | (no-more nil) |
| 1314 | 1309 | (setf (rwl-sch-context-state-predicate sch-context) (make-state-pred-pat)) |
| 1315 | 1310 | (let ((.rwl-sch-context. sch-context) |
| 1316 | 1311 | (.rwl-search-depth. (1+ .rwl-search-depth.)) |
| 1312 | (.cexec-term-hash. (rwl-sch-context-term-hash sch-context)) | |
| 1317 | 1313 | (.ignore-term-id-limit. t)) |
| 1318 | 1314 | (declare (special .rwl-sch-context. .cexec.term-hash. .ignore-term-id-limit.)) |
| 1319 | 1315 | (push sch-context .rwl-context-stack.) |
| 1320 | (init-rwl-term-hash .rwl-search-depth.) | |
| 1321 | 1316 | ;; the first state is 0 |
| 1322 | 1317 | (set-sch-hashed-term t1 .cexec-term-hash. 0) |
| 1323 | 1318 | ;; |
| 1441 | 1436 | ;; the followings are experimental |
| 1442 | 1437 | (if nil)) |
| 1443 | 1438 | (declare (type term term pattern) |
| 1444 | (type fixnum max-result max-depth) | |
| 1445 | 1439 | (type (or null t) zero? final?)) |
| 1446 | 1440 | (let ((module (get-context-module)) |
| 1447 | 1441 | max-r |