diff options
author | dos-reis <gdr@axiomatics.org> | 2013-06-24 16:39:32 +0000 |
---|---|---|
committer | dos-reis <gdr@axiomatics.org> | 2013-06-24 16:39:32 +0000 |
commit | 36db462d3a02e5df058861589b60d1f9c808e7c3 (patch) | |
tree | 477a8c3be153d9ca4ba4fc085090e3f6c0a39b03 /src/interp | |
parent | 0af724597cff0d9235a37223e46e6f9ffb804e0b (diff) | |
download | open-axiom-36db462d3a02e5df058861589b60d1f9c808e7c3.tar.gz |
Simplify database construction.
Diffstat (limited to 'src/interp')
-rw-r--r-- | src/interp/cattable.boot | 24 | ||||
-rw-r--r-- | src/interp/daase.lisp | 163 | ||||
-rw-r--r-- | src/interp/database.boot | 4 | ||||
-rw-r--r-- | src/interp/sys-driver.boot | 1 | ||||
-rw-r--r-- | src/interp/util.lisp | 1 |
5 files changed, 19 insertions, 174 deletions
diff --git a/src/interp/cattable.boot b/src/interp/cattable.boot index 34bd928e..7cb1dc0d 100644 --- a/src/interp/cattable.boot +++ b/src/interp/cattable.boot @@ -1,6 +1,6 @@ -- Copyright (C) 1991-2002, The Numerical Algorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2011, Gabriel Dos Reis. +-- Copyright (C) 2007-2013, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -429,28 +429,6 @@ compressSexpr(x,left,right) == compressSexpr(rest x,nil,x) tableValue($found,x) := x -squeezeList(l) == --- changes the list l, so that is has maximal sharing of cells - $found:local:= nil - squeeze1 l - -squeeze1(l) == --- recursive version of squeezeList - x:= first l - y:= - x isnt [.,:.] => x - z:= member(x,$found) => first z - $found:= [x,:$found] - squeeze1 x - l.first := y - x:= rest l - y:= - x isnt [.,:.] => x - z:= member(x,$found) => first z - $found:= [x,:$found] - squeeze1 x - l.rest := y - updateCategoryTable(cname,kind) == $updateCatTableIfTrue => kind is 'package => nil diff --git a/src/interp/daase.lisp b/src/interp/daase.lisp index 55e4f561..df27ff72 100644 --- a/src/interp/daase.lisp +++ b/src/interp/daase.lisp @@ -33,10 +33,9 @@ ;; In order to understand this program you need to understand some details -;; of the structure of the databases it reads. Axiom has 5 databases, -;; the interp.daase, operation.daase, category.daase, compress.daase, and -;; browse.daase. The compress.daase is special and does not follow the -;; normal database format. +;; of the structure of the databases it reads. Axiom has 4 databases, +;; the interp.daase, operation.daase, category.daase, and +;; browse.daase. ;; ;; This documentation refers to KAF files which are random access files. ;; NRLIB files are KAF files (look for NRLIB/index.KAF) @@ -64,15 +63,6 @@ ;; One existing optimization is that if the data is a simple thing like a ;; symbol then the nth-entry-byte-address is replaced by immediate data. ;; -;; Another existing one is a compression algorithm applied to the -;; data so that the very long names don't take up so much space. -;; We could probably remove the compression algorithm as 64k is no -;; longer considered 'huge'. The database-abbreviation routine -;; handles this on read and write-compress handles this on write. -;; The squeeze routine is used to compress the keys, the unsqueeze -;; routine uncompresses them. Making these two routines disappear -;; should remove all of the compression. -;; ;; Indeed, a faster optimization is to simply read the whole database ;; into the image before it is saved. The system would be easier to ;; understand and the interpreter would be faster. @@ -371,18 +361,6 @@ ; position information in the database then the database is NOT ; read in and is assumed to match the in-core version -(defvar *compressvector* nil - "a vector of things to compress in the databases") - -(defvar *compressVectorLength* 0 - "length of the compress vector") - -(defvar *compress-stream* nil - "an stream containing the compress vector") - -(defvar *compress-stream-stamp* 0 - "*compress-stream* (position . time)") - (defvar *interp-stream* nil "an open stream to the interpreter database") @@ -428,9 +406,6 @@ (setq *hascategory-hash* (make-hash-table :test #'equal)) (setq *operation-hash* (make-hash-table)) (setq *allconstructors* nil) - (setq *compressvector* nil) - (setq *compress-stream-stamp* '(0 . 0)) - (compressopen) (setq *interp-stream-stamp* '(0 . 0)) (interpopen) (setq *operation-stream-stamp* '(0 . 0)) @@ -470,7 +445,6 @@ (file-position *interp-stream* pos) (setq constructors (read *interp-stream*)) (dolist (item constructors) - (setq item (unsqueeze item)) (setq *allconstructors* (adjoin (first item) *allconstructors*)) (setq dbstruct (|makeDB| (first item) (ninth item) (seventh item))) (setf (|dbOperations| dbstruct) (second item)) @@ -525,7 +499,6 @@ (file-position *browse-stream* pos) (setq constructors (read *browse-stream*)) (dolist (item constructors) - (setq item (unsqueeze item)) (unless (setq dbstruct (|constructorDB| (car item))) (format t "browseOpen:~%") (format t "the browse database contains a constructor ~a~%" item) @@ -556,7 +529,6 @@ (setq keys (read *category-stream*)) (setq *hasCategory-hash* (make-hash-table :test #'equal)) (dolist (item keys) - (setq item (unsqueeze item)) (setf (gethash (first item) *hasCategory-hash*) (second item)))) (format t "~&"))) @@ -573,7 +545,6 @@ (file-position *operation-stream* pos) (setq operations (read *operation-stream*)) (dolist (item operations) - (setq item (unsqueeze item)) (setf (gethash (car item) *operation-hash*) (cdr item)))) (format t "~&"))) @@ -747,10 +718,6 @@ (format t "getdatabase miss: ~20a ~a~%" key constructor)) (file-position stream data) (setq data (read stream)) - ;; Don't attempt to uncompress codes -- they are not compressed. - (cond ((eq key 'superdomain) - (rplaca data (unsqueeze (car data)))) - (t (setq data (unsqueeze data)))) (case key ; cache the result of the database read (operation (setf (gethash constructor *operation-hash*) data)) @@ -952,13 +919,6 @@ (apply key args))) (|sayKeyedMsg| 'S2IU0001 (list key object)))))) -;; The infamous SQUEEZE functions couple produces its results by -;; in-place transmoglification. We use this function in places -;; where we want the arguments to remain unmolested. -;; -- gdr, 2011-09-03 -(defun |squeezeCopy| (x) - (squeeze (copy-tree x))) - ; making new databases consists of: ; 1) reset all of the system hash tables ; *) set up Union, Record and Mapping @@ -1013,7 +973,6 @@ (setq *hascategory-hash* (make-hash-table :test #'equal)) (setq *operation-hash* (make-hash-table)) (setq *allconstructors* nil) - (setq *compressvector* nil) (withSpecialConstructors) (localdatabase nil (list (list '|dir| (|getWorkingDirectory|) )) @@ -1035,7 +994,6 @@ (|mkDependentsHashTable|) (|saveDependentsHashTable|) (|buildGloss|) - (write-compress) (write-browsedb) (write-operationdb) ; note: genCategoryTable creates a new *hascategory-hash* table @@ -1058,9 +1016,6 @@ ; does gethash calls into it rather than doing a getdatabase call. (write-interpdb) #+:AKCL (write-warmdata) - (when (probe-file (final-name "compress")) - (delete-file (final-name "compress"))) - (rename-file "compress.build" (final-name "compress")) (when (probe-file (final-name "interp")) (delete-file (final-name "interp"))) (rename-file "interp.build" (final-name "interp")) @@ -1076,56 +1031,6 @@ (rename-file "category.build" (final-name "category"))))) -(defun compressOpen () - (let (lst stamp pos) - (setq *compress-stream* - (open (|pathToDatabase| "compress.daase") :direction :input)) - (setq stamp (read *compress-stream*)) - (unless (equal stamp *compress-stream-stamp*) - (when |$verbose| - (format t " Re-reading compress.daase")) - (setq *compress-stream-stamp* stamp) - (setq pos (car stamp)) - (file-position *compress-stream* pos) - (setq lst (read *compress-stream*)) - (setq *compressVectorLength* (car lst)) - (setq *compressvector* - (make-array (car lst) :initial-contents (cdr lst)))))) - -(defun write-compress () - (let (compresslist masterpos out) - (close *compress-stream*) - (setq out (open "compress.build" :direction :output)) - (princ " " out) - (finish-output out) - (setq masterpos (file-position out)) - (setq compresslist - (append (|allConstructors|) (|allOperations|) |$BuiltinAttributes|)) - (push 'signature compresslist) - (push '|ofType| compresslist) - (push '|Join| compresslist) - (push 'and compresslist) - (push 'category compresslist) - (push '|category| compresslist) - (push '|domain| compresslist) - (push '|package| compresslist) - (push 'attribute compresslist) - (push '|isDomain| compresslist) - (push '|ofCategory| compresslist) - (push '|Union| compresslist) - (push '|Record| compresslist) - (push '|Mapping| compresslist) - (push '|Enumeration| compresslist) - (setq *compressVectorLength* (length compresslist)) - (setq *compressvector* - (make-array *compressVectorLength* :initial-contents compresslist)) - (print (cons (length compresslist) compresslist) out) - (finish-output out) - (file-position out 0) - (print (cons masterpos (get-universal-time)) out) - (finish-output out) - (close out))) - (defun write-interpdb () "build interp.daase from hash tables" (declare (special *ancestors-hash*)) @@ -1140,13 +1045,13 @@ (let (struct) (setq struct (|constructorDB| constructor)) (setq opalistpos (file-position out)) - (print (|squeezeCopy| (|dbOperations| struct)) out) + (print (|dbOperations| struct) out) (finish-output out) (setq cmodemappos (file-position out)) - (print (|squeezeCopy| (|dbConstructorModemap| struct)) out) + (print (|dbConstructorModemap| struct) out) (finish-output out) (setq modemapspos (file-position out)) - (print (|squeezeCopy| (|dbModemaps| struct)) out) + (print (|dbModemaps| struct) out) (finish-output out) (let ((entry (|dbModule| struct))) (cond ((consp entry) @@ -1156,7 +1061,7 @@ (setq obj (pathname-name (first (last (pathname-directory entry)))))) (t (setq obj nil)))) - (setq concategory (|squeezeCopy| (|dbCategory| struct))) + (setq concategory (|dbCategory| struct)) (if concategory ; if category then write data else write nil (progn (setq categorypos (file-position out)) @@ -1167,7 +1072,7 @@ (setq cosig (|dbDualSignature| struct)) (setq kind (|dbConstructorKind| struct)) (setq defaultdomain (|dbDefaultDomain| struct)) - (setq ancestors (|squeezeCopy| (gethash constructor *ancestors-hash*))) ;cattable.boot + (setq ancestors (gethash constructor *ancestors-hash*)) ;cattable.boot (if ancestors (progn (setq ancestorspos (file-position out)) @@ -1175,12 +1080,10 @@ (finish-output out)) (setq ancestorspos nil)) (setq superpos - ;; We do NOT want to compress codes, as we may not be - ;; able to uncompress them to their original form. (let ((super (|dbSuperDomain| struct))) (when super (prog1 (file-position out) - (print (list (|squeezeCopy| (car super)) (second super)) out) + (print (list (car super) (second super)) out) (finish-output out))))) (push (list constructor opalistpos cmodemappos modemapspos @@ -1188,7 +1091,7 @@ ancestorspos superpos) master))) (finish-output out) (setq masterpos (file-position out)) - (print (|squeezeAll| master) out) + (print master out) (finish-output out) (file-position out 0) (print (cons masterpos (get-universal-time)) out) @@ -1208,21 +1111,21 @@ ; sourcefile is small. store the string directly (setq src (|dbSourceFile| struct)) (setq formpos (file-position out)) - (print (|squeezeCopy| (|dbConstructorForm| struct)) out) + (print (|dbConstructorForm| struct) out) (finish-output out) (setq docpos (file-position out)) (print (database-documentation struct) out) (finish-output out) (setq attpos (file-position out)) - (print (|squeezeCopy| (|dbAttributes| struct)) out) + (print (|dbAttributes| struct) out) (finish-output out) (setq predpos (file-position out)) - (print (|squeezeCopy| (|dbPredicates| struct)) out) + (print (|dbPredicates| struct) out) (finish-output out) (push (list constructor src formpos docpos attpos predpos) master))) (finish-output out) (setq masterpos (file-position out)) - (print (|squeezeAll| master) out) + (print master out) (finish-output out) (file-position out 0) (print (cons masterpos (get-universal-time)) out) @@ -1242,48 +1145,18 @@ (setq pos value) (progn (setq pos (file-position out)) - (print (|squeezeCopy| value) out) + (print value out) (finish-output out))) (push (list key pos) master)) *hasCategory-hash*) (setq pos (file-position out)) - (print (|squeezeAll| master) out) + (print master out) (finish-output out) (file-position out 0) (print (cons pos (get-universal-time)) out) (finish-output out) (close out))) -(defun unsqueeze (expr) - (cond ((atom expr) - (cond ((and (numberp expr) (<= expr 0)) - (svref *compressVector* (- expr))) - (t expr))) - (t (rplaca expr (unsqueeze (car expr))) - (rplacd expr (unsqueeze (cdr expr))) - 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*)) - (|substitute!| (- pos) leaf expr))) - expr))) - (defun write-operationdb () (let (pos master out) (declare (special leaves)) @@ -1292,13 +1165,13 @@ (finish-output out) (maphash #'(lambda (key value) (setq pos (file-position out)) - (print (|squeezeCopy| value) out) + (print value out) (finish-output out) (push (cons key pos) master)) *operation-hash*) (finish-output out) (setq pos (file-position out)) - (print (|squeezeAll| master) out) + (print master out) (file-position out 0) (print (cons pos (get-universal-time)) out) (finish-output out) diff --git a/src/interp/database.boot b/src/interp/database.boot index f9e41788..9343bb32 100644 --- a/src/interp/database.boot +++ b/src/interp/database.boot @@ -799,10 +799,6 @@ displayHiddenConstructors() == centerAndHighlight c --% -squeezeAll: %List %Code -> %List %Code -squeezeAll x == - [SQUEEZE t for t in x] - makeInitialDB [form,kind,abbrev,srcfile] == db := makeDB(form.op,kind,abbrev) dbConstructorForm(db) := form diff --git a/src/interp/sys-driver.boot b/src/interp/sys-driver.boot index f6a8e7de..9b5ae5c9 100644 --- a/src/interp/sys-driver.boot +++ b/src/interp/sys-driver.boot @@ -137,7 +137,6 @@ initMemoryConfig() == --% openDatabases() == - COMPRESSOPEN() INTERPOPEN() OPERATIONOPEN() CATEGORYOPEN() diff --git a/src/interp/util.lisp b/src/interp/util.lisp index c8dfa8b6..0f2b7f02 100644 --- a/src/interp/util.lisp +++ b/src/interp/util.lisp @@ -253,7 +253,6 @@ (|buildHtMacroTable|) (|initHist|) (|initNewWorld|) - (compressopen) (interpopen) (|start| :fin) (setq *load-verbose* nil) |