aboutsummaryrefslogtreecommitdiff
path: root/src/interp/daase.lisp
diff options
context:
space:
mode:
Diffstat (limited to 'src/interp/daase.lisp')
-rw-r--r--src/interp/daase.lisp12
1 files changed, 9 insertions, 3 deletions
diff --git a/src/interp/daase.lisp b/src/interp/daase.lisp
index 678c390f..f4fad844 100644
--- a/src/interp/daase.lisp
+++ b/src/interp/daase.lisp
@@ -1242,11 +1242,17 @@
(when (setq dbstruct (|constructorDB| con))
(setf (|dbDualSignature| dbstruct)
(cons nil (mapcar #'|categoryForm?|
- (cddar (|dbConstructorModemap| dbstruct)))))
- (when (and (|categoryForm?| con)
+ ;; The DBs have been munged by SQUEEZE
+ ;; in WRITE-BROWSEDB, WRITE-OPERATIONDB
+ ;; WRITE-CATEGORYDB. Unsqueeze a copy
+ ;; of them before checking for category
+ ;; form-ness. This is sick! FIXME.
+ (unsqueeze (copy-tree
+ (cddar (|dbConstructorModemap| dbstruct)))))))
+ (when (and (eq (|dbConstructorKind| dbstruct) '|category|)
(= (length (setq d (|domainsOf| (list con) NIL NIL))) 1))
(setq d (caar d))
- (when (= (length d) (length (|getConstructorForm| con)))
+ (when (= (length d) (length (|dbConstructorForm| dbstruct)))
(format t " ~a has a default domain of ~a~%" con (car d))
(setf (|dbDefaultDomain| dbstruct) (car d)))))))
; note: genCategoryTable creates *ancestors-hash*. write-interpdb