cref: Eliminate needless sorting of bindings and references.

Replaced package/sorted-references and package/sorted-bindings with
unsorted versions package/references and package/bindings.

diff --git a/src/cref/conpkg.scm b/src/cref/conpkg.scm
index cffe6490edf98e918f44e3ec381d0d6ff7a65eb8..efa71c3bc6220117006bd17a3170ff564d789325 100644 (file)
--- a/src/cref/conpkg.scm
+++ b/src/cref/conpkg.scm
@@ -55,8 +55,7 @@ USA.
   (list-transform-positive (pmodel/extra-packages pmodel)
     (lambda (package)
       (or (there-exists? (package/links package) link/new?)
-         (there-exists? (package/sorted-bindings package)
-           new-internal-binding?)))))
+         (there-exists? (package/bindings package) new-internal-binding?)))))
 
 (define (new-internal-binding? binding)
   (and (binding/new? binding)
@@ -90,7 +89,7 @@ USA.
                      '())))
              (list->vector
               (map binding/name
-                   (list-transform-positive (package/sorted-bindings package)
+                   (list-transform-positive (package/bindings package)
                      new-internal-binding?)))
              (list->vector
               (map (lambda (link)

diff --git a/src/cref/forpkg.scm b/src/cref/forpkg.scm
index 1ad91e206ddedafb03e2f7cb59d6cd3fd60d9560..2bce764561a4ae6e2e53a3e0c4e7d51859143496 100644 (file)
--- a/src/cref/forpkg.scm
+++ b/src/cref/forpkg.scm
@@ -52,7 +52,7 @@ USA.
     (let ((free-references
           (append-map! (lambda (package)
                          (delete-matching-items
-                             (package/sorted-references package)
+                             (package/references package)
                            reference/binding))
                        packages)))
       (if (pair? free-references)
@@ -91,22 +91,21 @@ USA.
         (classify-bindings-by-package
          (lambda (binding)
            (binding/package (binding/source-binding binding)))
-         (package/sorted-bindings package))))
+         (package/bindings package))))
     (let ((class (assq package classes)))
       (if class
          (format-package/bindings port indentation width package (cdr class)))
       (for-each (lambda (class)
                  (if (not (eq? package (car class)))
                      (format-package/imports port indentation width package
-                                             (car class)
-                                             (cdr class))))
+                                             (car class) (cdr class))))
                classes)
       (if class
          (for-each
           (lambda (class)
             (if (not (eq? package (car class)))
-                (format-package/exports port indentation width (car class)
-                                        (sort (cdr class) binding<?))))
+                (format-package/exports port indentation width
+                                        (car class) (cdr class))))
           (classify-bindings-by-package
            binding/package
            (append-map (lambda (binding)
@@ -148,7 +147,7 @@ USA.
                            (set! unlinked (cons value-cell unlinked)))
                           ((not (memq value-cell linked))
                            (set! linked (cons value-cell linked))))))
-                (package/sorted-bindings package)))
+                (package/bindings package)))
      packages)
     (values unlinked linked)))
 \f
@@ -231,7 +230,7 @@ USA.
               (binding->name binding)
               (append-map reference/expressions
                           (binding/references binding))))
-           bindings))
+           (sort bindings binding<?)))
 
 (define (classify-bindings-by-package binding->package bindings)
   (let ((classes '()))
@@ -243,9 +242,6 @@ USA.
               (set-cdr! entry (cons binding (cdr entry)))
               (set! classes (cons (list package binding) classes))))))
      bindings)
-    (for-each (lambda (class)
-               (set-cdr! class (reverse! (cdr class))))
-             classes)
     (sort classes
          (lambda (x y)
            (package<? (car x) (car y))))))

diff --git a/src/cref/object.scm b/src/cref/object.scm
index 6b240fcae661a018883baf8221b61f89d4b1e52f..1d10d60906193f285e586fda88707ecaea60061f 100644 (file)
--- a/src/cref/object.scm
+++ b/src/cref/object.scm
@@ -59,8 +59,8 @@ USA.
   (files '())
   parent
   (children '())
-  (bindings (make-strong-eq-hash-table) read-only #t)
-  (references (make-strong-eq-hash-table) read-only #t)
+  (%bindings (make-strong-eq-hash-table) read-only #t)
+  (%references (make-strong-eq-hash-table) read-only #t)
   (links '()))
 
 (define-integrable (package/n-files package)
@@ -70,24 +70,22 @@ USA.
   (null? (package/name package)))
 
 (define-integrable (package/find-reference package name)
-  (hash-table/get (package/references package) name #f))
+  (hash-table/get (package/%references package) name #f))
 
 (define-integrable (package/put-reference! package name reference)
-  (hash-table/put! (package/references package) name reference))
+  (hash-table/put! (package/%references package) name reference))
 
 (define-integrable (package/find-binding package name)
-  (hash-table/get (package/bindings package) name #f))
+  (hash-table/get (package/%bindings package) name #f))
 
 (define-integrable (package/put-binding! package name binding)
-  (hash-table/put! (package/bindings package) name binding))
+  (hash-table/put! (package/%bindings package) name binding))
 
-(define-integrable (package/sorted-bindings package)
-  (sort (hash-table/datum-list (package/bindings package))
-       binding<?))
+(define-integrable (package/bindings package)
+  (hash-table/datum-list (package/%bindings package)))
 
-(define-integrable (package/sorted-references package)
-  (sort (hash-table/datum-list (package/references package))
-       reference<?))
+(define-integrable (package/references package)
+  (hash-table/datum-list (package/%references package)))
 
 (define-integrable (file-case/type file-case)
   (car file-case))

diff --git a/src/cref/redpkg.scm b/src/cref/redpkg.scm
index de93c377ca5bef28a71da073d533ff484aa46976..d8afa7c5c0e0a8a177763af233d5d6701a0e07ea 100644 (file)
--- a/src/cref/redpkg.scm
+++ b/src/cref/redpkg.scm
@@ -219,7 +219,7 @@ USA.
 (define (resolve-references! pmodel)
   (for-each (lambda (package)
              (for-each resolve-reference!
-                       (package/sorted-references package)))
+                       (package/references package)))
            (pmodel/packages pmodel)))
 
 (define (resolve-reference! reference)