From: Matt Birkholz <matt@birkholz.chandler.az.us>
Date: Sat, 7 Jan 2012 17:00:19 +0000 (-0700)
Subject: cref: Eliminate needless sorting of bindings and references.
X-Git-Tag: release-9.2.0~334^2~26^2^2~1
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=430ea31d23833983dfd3e4b68d793e9fde744f59;p=mit-scheme.git

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 cffe6490e..efa71c3bc 100644
--- 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 1ad91e206..2bce76456 100644
--- 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)))
 
@@ -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 6b240fcae..1d10d6090 100644
--- 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 de93c377c..d8afa7c5c 100644
--- 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)