[Axiom-developer] database fixes

[Waldek Hebisch]

Below is a patch that fixes few problems with databases:

1) If old database contained constructors or operations which
   were removed from new database, Axiom kept using old data.
   The patch cleans old data

2) Patch adds ability to dump uncompressed databases (easier to
   read): to get uncompressed format just set *do-not-compress-databases*
   to t

3) Patch improves formatting in showdatabase

4) Patch omits separate loading of topic.o in make-databases (topic.o
   is loaded anyway as part of the browser

5) correction to comment describing database structure

diff -u pp/build-improvements/src/interp/daase.lisp.pamphlet 
build-improvements-1012.nn2/src/interp/daase.lisp.pamphlet
--- pp/build-improvements/src/interp/daase.lisp.pamphlet        2006-09-08 
02:59:43.000000000 +0200
+++ build-improvements-1012.nn2/src/interp/daase.lisp.pamphlet  2006-10-16 
22:24:41.590936240 +0200
@@ -206,6 +206,8 @@
 
 (defvar *miss* nil "print out cache misses on getdatabase calls")
 
+(defvar *do-not-compress-databases* nil)
+
    ; note that constructorcategory information need only be kept for
    ; items of type category. this will be fixed in the next iteration
    ; when the need for the various caches are reviewed
@@ -377,7 +379,7 @@
 ;        constructormodemap for domains and packages so it is stored
 ;        as NIL for them. it is valid for categories.
 ;    niladic            -- t or nil directly
-;    unused
+;    abbreviation        -- kept directly
 ;    cosig              -- kept directly
 ;    constructorkind    -- kept directly
 ;    defaultdomain      -- a short list, for %i
@@ -391,6 +393,13 @@
   (setq stamp (read *interp-stream*))
   (unless (equal stamp *interp-stream-stamp*)
    (format t "   Re-reading interp.daase")
+
+   ; Clean old data
+   (do-symbols (symbol)
+      (when (get symbol 'database)
+         (setf (get symbol 'database) nil)))
+   (setq *allconstructors* nil)
+
    (setq *interp-stream-stamp* stamp)
    (setq pos (car stamp))
    (file-position *interp-stream* pos)
@@ -499,6 +508,11 @@
    (setq pos (car stamp))
    (file-position *operation-stream* pos)
    (setq operations (read *operation-stream*))
+
+   ; Clean old data
+   (setq *operation-hash* (make-hash-table))
+   (setq *allOperations* nil)
+
    (dolist (item operations)
     (setq item (unsqueeze item))
     (setf (gethash (car item) *operation-hash*) (cdr item))))
@@ -526,15 +540,15 @@
   (getdatabase constructor 'cosig))
  (format t "~a: ~a~%" 'operation
   (getdatabase constructor 'operation))
- (format t "~a: ~%" 'constructormodemap)
+ (format t "~a: " 'constructormodemap)
   (pprint (getdatabase constructor 'constructormodemap))
- (format t "~&~a: ~%" 'constructorcategory)
+ (format t "~&~a: " 'constructorcategory)
   (pprint (getdatabase constructor 'constructorcategory))
- (format t "~&~a: ~%" 'operationalist)
+ (format t "~&~a: " 'operationalist)
   (pprint (getdatabase constructor 'operationalist))
- (format t "~&~a: ~%" 'modemaps)
+ (format t "~&~a: " 'modemaps)
   (pprint (getdatabase constructor 'modemaps))
- (format t "~a: ~a~%" 'hascategory
+ (format t "~&~a: ~a~%" 'hascategory
   (getdatabase constructor 'hascategory))
  (format t "~a: ~a~%" 'object
   (getdatabase constructor 'object))
@@ -558,9 +572,9 @@
   (getdatabase constructor 'constructorargs))
  (format t "~a: ~a~%" 'attributes
   (getdatabase constructor 'attributes))
- (format t "~a: ~%" 'predicates)
+ (format t "~a: " 'predicates)
   (pprint (getdatabase constructor 'predicates))
- (format t "~a: ~a~%" 'documentation
+ (format t "~&~a: ~a~%" 'documentation
   (getdatabase constructor 'documentation))
  (format t "~a: ~a~%" 'parents
   (getdatabase constructor 'parents)))
@@ -1104,6 +1118,7 @@
   (setq *operation-hash* (make-hash-table))
   (setq *allconstructors* nil)
   (setq *compressvector* nil)
+  (setq *allOperations* nil)
   (withSpecialConstructors)
   (localdatabase nil
      (list (list '|dir| (namestring (truename "./")) ))
@@ -1116,7 +1131,6 @@
                                                          dir)))))
                         'make-database))
 ;browse.daase
-#+:AKCL  (load (concatenate 'string (|getEnv| "AXIOM") "/autoload/topics"))  
;; hack
   (|oldCompilerAutoloadOnceTrigger|)
   (|browserAutoloadOnceTrigger|)
 #+:AKCL    (|mkTopicHashTable|)
@@ -1389,25 +1403,27 @@
           expr)))
 
 (defun squeeze (expr)
- (let (leaves pos (bound (length *compressvector*)))
-  (labels (
-   (flat (expr)
-    (when (and (numberp expr) (< expr 0) (>= expr bound))
-     (print expr)
-     (break "squeeze found a negative number"))
-    (if (atom expr)
-     (unless (or (null expr)
-                 (and (symbolp expr) (char= (schar (symbol-name expr) 0) #\*)))
-      (setq leaves (adjoin expr leaves)))
-     (progn
-      (flat (car expr))
-      (flat (cdr expr))))))
-  (setq leaves nil)
-  (flat expr)
-  (dolist (leaf leaves)
-   (when (setq pos (position leaf *compressvector*))
-     (nsubst (- pos) leaf expr)))
-  expr)))
+  (if *do-not-compress-databases*
+    expr
+    (let (leaves pos (bound (length *compressvector*)))
+     (labels (
+      (flat (expr)
+       (when (and (numberp expr) (< expr 0) (>= expr bound))
+        (print expr)
+        (break "squeeze found a negative number"))
+       (if (atom expr)
+        (unless (or (null expr)
+                    (and (symbolp expr) (char= (schar (symbol-name expr) 0) 
#\*)))
+         (setq leaves (adjoin expr leaves)))
+        (progn
+         (flat (car expr))
+         (flat (cdr expr))))))
+     (setq leaves nil)
+     (flat expr)
+     (dolist (leaf leaves)
+      (when (setq pos (position leaf *compressvector*))
+        (nsubst (- pos) leaf expr)))
+     expr))))
 
 (defun write-operationdb ()
  (let (pos master out)

-- 
                              Waldek Hebisch
address@hidden