From 9cc9d7afd1aa92577c588a73badf733f4e7f1f5b Mon Sep 17 00:00:00 2001
From: Peter Bex <address@hidden>
Date: Sun, 13 Aug 2017 14:42:46 +0200
Subject: [PATCH] Move sorting procedures from chicken.data-structures to
 chicken.sort

This also wraps the chicken-bug and chicken-profile programs in a
"main" module.  This helped find a bug in chicken-profile: we forgot
to import chicken.file in chicken-profile when we moved "glob" into
that module.

We also forgot to export merge!, the side-effect version of merge from
data-structures.  The new chicken.sort module does export this
procedure.
---
 README                          |  1 +
 c-backend.scm                   |  1 +
 chicken-bug.scm                 |  9 ++++++-
 chicken-install.scm             |  3 ++-
 chicken-profile.scm             | 11 +++++++--
 chicken-status.scm              |  5 ++--
 csi.scm                         |  1 +
 data-structures.scm             | 12 ++++++++--
 defaults.make                   |  2 +-
 distribution/manifest           |  2 ++
 optimizer.scm                   |  5 ++--
 rules.make                      | 18 ++++++++++----
 support.scm                     |  1 +
 tests/data-structures-tests.scm |  3 ++-
 tests/test-find-files.scm       |  5 +++-
 types.db                        | 52 ++++++++++++++++++++++-------------------
 16 files changed, 90 insertions(+), 41 deletions(-)

diff --git a/README b/README
index 75f51e0a..288f6e64 100644
--- a/README
+++ b/README
@@ -319,6 +319,7 @@ _/        _/    _/    _/    _/        _/  _/    _/        _/    _/_/
 	|   |       |-- chicken.process-context.import.so
 	|   |       |-- chicken.random.import.so
 	|   |       |-- chicken.repl.import.so
+	|   |       |-- chicken.sort.import.so
 	|   |       |-- chicken.read-syntax.import.so
 	|   |       |-- chicken.syntax.import.so
 	|   |       |-- chicken.tcp.import.so
diff --git a/c-backend.scm b/c-backend.scm
index 6be88abe..1fe60dd3 100644
--- a/c-backend.scm
+++ b/c-backend.scm
@@ -41,6 +41,7 @@
 	chicken.foreign
 	chicken.format
 	chicken.internal
+	chicken.sort
 	chicken.time
 	chicken.compiler.core
 	chicken.compiler.c-platform
diff --git a/chicken-bug.scm b/chicken-bug.scm
index e0977546..7b5b04ff 100644
--- a/chicken-bug.scm
+++ b/chicken-bug.scm
@@ -25,7 +25,11 @@
 
 (declare (block))
 
-(import chicken.data-structures
+(module main ()
+
+(import chicken scheme)
+
+(import (only chicken.data-structures chop string-intersperse)
 	chicken.foreign
 	chicken.format
 	chicken.io
@@ -34,6 +38,7 @@
 	chicken.port
 	chicken.posix
 	chicken.platform
+	chicken.sort
 	chicken.time)
 
 (define-constant +bug-report-file+ "chicken-bug-report.~a-~a-~a")
@@ -164,3 +169,5 @@ EOF
   (print "\nA bug report has been written to `" fname "'."))
 
 (main (command-line-arguments))
+
+)
diff --git a/chicken-install.scm b/chicken-install.scm
index ad8bbfa6..5ca3947e 100644
--- a/chicken-install.scm
+++ b/chicken-install.scm
@@ -29,8 +29,8 @@
 (import (scheme))
 (import (chicken))
 (import (chicken condition))
-(import (chicken foreign))
 (import (chicken data-structures))
+(import (chicken foreign))
 (import (chicken keyword))
 (import (chicken file))
 (import (chicken format))
@@ -39,6 +39,7 @@
 (import (chicken posix))
 (import (chicken port))
 (import (chicken io))
+(import (chicken sort))
 (import (chicken time))
 (import (chicken pathname))
 (import (chicken process))
diff --git a/chicken-profile.scm b/chicken-profile.scm
index 78582a84..b676f474 100644
--- a/chicken-profile.scm
+++ b/chicken-profile.scm
@@ -26,9 +26,14 @@
 
 (declare (block))
 
-(import chicken.data-structures
+(module main ()
+
+(import chicken scheme)
+(import (only chicken.data-structures string-intersperse)
+	chicken.file
 	chicken.internal
-	chicken.posix)
+	chicken.posix
+	chicken.sort)
 
 (include "mini-srfi-1.scm")
 
@@ -251,3 +256,5 @@ EOF
       (for-each print-row data))))
   
 (run (command-line-arguments))
+
+)
diff --git a/chicken-status.scm b/chicken-status.scm
index a51e18d5..5f4bbb2d 100644
--- a/chicken-status.scm
+++ b/chicken-status.scm
@@ -27,7 +27,7 @@
 
   (import (scheme))
   (import (chicken))
-  (import (chicken data-structures)
+  (import (only (chicken data-structures) ->string)
 	  (chicken file)
 	  (chicken foreign)
 	  (chicken format)
@@ -35,7 +35,8 @@
 	  (chicken port)
 	  (chicken posix)
           (chicken pathname)
-	  (chicken pretty-print))
+	  (chicken pretty-print)
+	  (chicken sort))
 
   (include "mini-srfi-1.scm")
   (include "egg-environment.scm")
diff --git a/csi.scm b/csi.scm
index 55f8ec3f..cab891ae 100644
--- a/csi.scm
+++ b/csi.scm
@@ -58,6 +58,7 @@ EOF
 	chicken.port
 	chicken.pretty-print
 	chicken.repl
+	chicken.sort
 	chicken.syntax)
 
 (include "banner.scm")
diff --git a/data-structures.scm b/data-structures.scm
index bf9821b1..a0415010 100644
--- a/data-structures.scm
+++ b/data-structures.scm
@@ -31,7 +31,6 @@
 (module chicken.data-structures
   (alist-ref alist-update alist-update! atom? butlast
    chop compress flatten intersperse join rassoc tail?
-   merge sort sort! sorted? topological-sort
    conc ->string string-chop string-chomp
    string-compare3 string-compare3-ci
    reverse-string-append
@@ -587,6 +586,15 @@
 	(##sys#substring str 0 diff)
 	str) ) )
 
+) ; chicken.data-structures
+
+
+(module chicken.sort
+    (merge merge! sort sort! sorted? topological-sort)
+
+(import chicken scheme)
+(import (only (chicken data-structures)
+	      alist-ref alist-update!))
 
 
 ;;; Defines: sorted?, merge, merge!, sort, sort!
@@ -783,5 +791,5 @@
                      (cdar dag)
                      '()
                      state)))))
+) ; chicken.sort
 
-)
diff --git a/defaults.make b/defaults.make
index 8b072088..9bebd8b6 100644
--- a/defaults.make
+++ b/defaults.make
@@ -268,7 +268,7 @@ DYNAMIC_IMPORT_LIBRARIES = srfi-4
 DYNAMIC_CHICKEN_IMPORT_LIBRARIES = bitwise blob errno file.posix	\
 	fixnum flonum format gc io keyword load locative memory		\
 	platform plist posix pretty-print process process.signal	\
-	process-context random syntax time time.posix
+	process-context random syntax sort time time.posix
 DYNAMIC_CHICKEN_COMPILER_IMPORT_LIBRARIES = user-pass
 DYNAMIC_CHICKEN_UNIT_IMPORT_LIBRARIES = continuation data-structures \
 	eval file internal irregex lolevel pathname port \
diff --git a/distribution/manifest b/distribution/manifest
index 56ceddb4..1e6a4468 100644
--- a/distribution/manifest
+++ b/distribution/manifest
@@ -336,6 +336,8 @@ chicken.read-syntax.import.scm
 chicken.read-syntax.import.c
 chicken.repl.import.scm
 chicken.repl.import.c
+chicken.sort.import.scm
+chicken.sort.import.c
 chicken.syntax.import.scm
 chicken.syntax.import.c
 chicken.tcp.import.scm
diff --git a/optimizer.scm b/optimizer.scm
index 99703051..8d48b3d1 100644
--- a/optimizer.scm
+++ b/optimizer.scm
@@ -36,9 +36,10 @@
      default-optimization-passes rewrite)
 
 (import chicken scheme
-	chicken.data-structures
 	chicken.compiler.support
-	chicken.internal)
+	chicken.data-structures
+	chicken.internal
+	chicken.sort)
 
 (include "tweaks")
 (include "mini-srfi-1.scm")
diff --git a/rules.make b/rules.make
index a4faa94b..945f31ab 100644
--- a/rules.make
+++ b/rules.make
@@ -522,6 +522,7 @@ $(eval $(call declare-emitted-import-lib-dependency,chicken.random,extras))
 $(eval $(call declare-emitted-import-lib-dependency,chicken.locative,lolevel))
 $(eval $(call declare-emitted-import-lib-dependency,chicken.memory,lolevel))
 $(eval $(call declare-emitted-import-lib-dependency,chicken.syntax,expand))
+$(eval $(call declare-emitted-import-lib-dependency,chicken.sort,data-structures))
 
 chicken.c: chicken.scm mini-srfi-1.scm \
 		chicken.compiler.batch-driver.import.scm \
@@ -563,6 +564,7 @@ c-backend.c: c-backend.scm mini-srfi-1.scm \
 		chicken.foreign.import.scm \
 		chicken.format.import.scm \
 		chicken.internal.import.scm \
+		chicken.sort.import.scm \
 		chicken.time.import.scm
 core.c: core.scm mini-srfi-1.scm \
 		chicken.compiler.scrutinizer.import.scm \
@@ -578,7 +580,8 @@ core.c: core.scm mini-srfi-1.scm \
 optimizer.c: optimizer.scm mini-srfi-1.scm \
 		chicken.compiler.support.import.scm \
 		chicken.data-structures.import.scm \
-		chicken.internal.import.scm
+		chicken.internal.import.scm \
+		chicken.sort.import.scm
 scheduler.c: scheduler.scm \
 		chicken.format.import.scm
 scrutinizer.c: scrutinizer.scm mini-srfi-1.scm \
@@ -620,6 +623,7 @@ support.c: support.scm mini-srfi-1.scm \
 		chicken.port.import.scm \
 		chicken.pretty-print.import.scm \
 		chicken.random.import.scm \
+		chicken.sort.import.scm \
 		chicken.syntax.import.scm \
 		chicken.time.import.scm
 modules.c: modules.scm \
@@ -647,6 +651,7 @@ csi.c: csi.scm \
 		chicken.port.import.scm \
 		chicken.pretty-print.import.scm \
 		chicken.repl.import.scm \
+		chicken.sort.import.scm \
 		chicken.syntax.import.scm
 chicken-bug.c: chicken-bug.scm \
 		chicken.foreign.import.scm \
@@ -661,7 +666,8 @@ chicken-bug.c: chicken-bug.scm \
 chicken-profile.c: chicken-profile.scm \
 		chicken.data-structures.import.scm \
 		chicken.internal.import.scm \
-		chicken.posix.import.scm
+		chicken.posix.import.scm \
+		chicken.sort.import.scm
 chicken-status.c: chicken-status.scm \
 		chicken.data-structures.import.scm \
 		chicken.file.import.scm \
@@ -671,7 +677,8 @@ chicken-status.c: chicken-status.scm \
 		chicken.pathname.import.scm \
 		chicken.port.import.scm \
 		chicken.posix.import.scm \
-		chicken.pretty-print.import.scm
+		chicken.pretty-print.import.scm \
+		chicken.sort.import.scm
 chicken-install.c: chicken-install.scm \
 		chicken.condition.import.scm \
 		chicken.data-structures.import.scm \
@@ -684,6 +691,7 @@ chicken-install.c: chicken-install.scm \
 		chicken.port.import.scm \
 		chicken.posix.import.scm \
 		chicken.pretty-print.import.scm \
+		chicken.sort.import.scm \
 		chicken.tcp.import.scm
 chicken-uninstall.c: chicken-uninstall.scm \
 		chicken.data-structures.import.scm \
@@ -833,7 +841,9 @@ chicken-ffi-syntax.c: $(SRCDIR)chicken-ffi-syntax.scm $(SRCDIR)common-declaratio
 continuation.c: $(SRCDIR)continuation.scm $(SRCDIR)common-declarations.scm
 	$(bootstrap-lib) -emit-import-library chicken.continuation
 data-structures.c: $(SRCDIR)data-structures.scm $(SRCDIR)common-declarations.scm
-	$(bootstrap-lib) -emit-import-library chicken.data-structures
+	$(bootstrap-lib) \
+	-emit-import-library chicken.data-structures \
+	-emit-import-library chicken.sort
 pathname.c: $(SRCDIR)pathname.scm $(SRCDIR)common-declarations.scm
 	$(bootstrap-lib) -emit-import-library chicken.pathname
 port.c: $(SRCDIR)port.scm $(SRCDIR)common-declarations.scm
diff --git a/support.scm b/support.scm
index 158cae2f..78ce2940 100644
--- a/support.scm
+++ b/support.scm
@@ -92,6 +92,7 @@
 	chicken.port
 	chicken.pretty-print
 	chicken.random
+	chicken.sort
 	chicken.syntax
 	chicken.time)
 
diff --git a/tests/data-structures-tests.scm b/tests/data-structures-tests.scm
index 9db1cddf..3f8db863 100644
--- a/tests/data-structures-tests.scm
+++ b/tests/data-structures-tests.scm
@@ -1,6 +1,7 @@
 ;;;; data-structures-tests.scm
 
-(use data-structures)
+(import (chicken data-structures)
+	(chicken sort))
 
 (define-syntax assert-error
   (syntax-rules ()
diff --git a/tests/test-find-files.scm b/tests/test-find-files.scm
index 30405fde..723e4720 100644
--- a/tests/test-find-files.scm
+++ b/tests/test-find-files.scm
@@ -1,4 +1,7 @@
-(use (chicken file) (chicken process-context) data-structures)
+(use (chicken file)
+     (chicken process-context)
+     (chicken sort))
+
 (include "test.scm")
 
 (handle-exceptions exn
diff --git a/types.db b/types.db
index e62c82db..b88505b6 100644
--- a/types.db
+++ b/types.db
@@ -1487,14 +1487,6 @@
 (chicken.data-structures#join (#(procedure #:clean #:enforce) chicken.data-structures#join ((list-of list) #!optional list) list))
 (chicken.data-structures#list-of? (#(procedure #:clean #:enforce) chicken.data-structures#list-of? ((procedure (*) *)) (procedure (list) boolean)))
 
-(chicken.data-structures#merge
- (forall (e)
-	 (#(procedure #:enforce) chicken.data-structures#merge ((list-of e) (list-of e) (procedure (e e) *)) (list-of e))))
-
-(chicken.data-structures#merge!
- (forall (e)
-	 (#(procedure #:enforce) chicken.data-structures#merge! ((list-of e) (list-of e) (procedure (e e) *)) (list-of e))))
-
 (chicken.data-structures#o (#(procedure #:clean #:enforce) chicken.data-structures#o (#!rest (procedure (*) *)) (procedure (*) *)))
 
 (chicken.data-structures#rassoc
@@ -1503,22 +1495,6 @@
                   (or false (pair b c)))))
 (chicken.data-structures#reverse-string-append (#(procedure #:clean #:enforce) chicken.data-structures#reverse-string-append ((list-of string)) string))
 
-(chicken.data-structures#sort
- (forall (e (s (or (vector-of e) (list-of e))))
-	 (#(procedure #:enforce)
-	  chicken.data-structures#sort
-	  (s (procedure (e e) *))
-	  s)))
-
-(chicken.data-structures#sort!
- (forall (e (s (or (vector-of e) (list-of e))))
-	 (#(procedure #:enforce)
-	  chicken.data-structures#sort!
-	  (s (procedure (e e) *))
-	  s)))
-
-(chicken.data-structures#sorted? (#(procedure #:enforce) chicken.data-structures#sorted? ((or list vector) (procedure (* *) *)) boolean))
-(chicken.data-structures#topological-sort (#(procedure #:enforce) chicken.data-structures#topological-sort ((list-of list) (procedure (* *) *)) list))
 (chicken.data-structures#string-chomp (#(procedure #:clean #:enforce) chicken.data-structures#string-chomp (string #!optional string) string))
 (chicken.data-structures#string-chop (#(procedure #:clean #:enforce) chicken.data-structures#string-chop (string fixnum) (list-of string)))
 (chicken.data-structures#string-compare3 (#(procedure #:clean #:enforce) chicken.data-structures#string-compare3 (string string) fixnum))
@@ -2106,6 +2082,34 @@
 (chicken.process#system* (#(procedure #:clean #:enforce) chicken.process#system* (string #!rest) undefined))
 (chicken.process#qs (#(procedure #:clean #:enforce) chicken.process#qs (string) string))
 
+;; sort
+
+(chicken.sort#merge
+ (forall (e)
+	 (#(procedure #:enforce) chicken.sort#merge ((list-of e) (list-of e) (procedure (e e) *)) (list-of e))))
+
+(chicken.sort#merge!
+ (forall (e)
+	 (#(procedure #:enforce) chicken.sort#merge! ((list-of e) (list-of e) (procedure (e e) *)) (list-of e))))
+
+(chicken.sort#sort
+ (forall (e (s (or (vector-of e) (list-of e))))
+	 (#(procedure #:enforce)
+	  chicken.sort#sort
+	  (s (procedure (e e) *))
+	  s)))
+
+(chicken.sort#sort!
+ (forall (e (s (or (vector-of e) (list-of e))))
+	 (#(procedure #:enforce)
+	  chicken.sort#sort!
+	  (s (procedure (e e) *))
+	  s)))
+
+(chicken.sort#sorted? (#(procedure #:enforce) chicken.sort#sorted? ((or list vector) (procedure (* *) *)) boolean))
+(chicken.sort#topological-sort (#(procedure #:enforce) chicken.sort#topological-sort ((list-of list) (procedure (* *) *)) list))
+
+
 ;; srfi-4
 
 (srfi-4#blob->f32vector (#(procedure #:clean #:enforce) srfi-4#blob->f32vector (blob) (struct f32vector)))
-- 
2.11.0