use sort.ss in kw.ss too

svn: r9129

collects/scheme/private/kw.ss

@@ -8,7 +8,8 @@
                          "stxcase-scheme.ss"
                          "name.ss"
                          "norm-define.ss"
-                         "qqstx.ss"))
+                         "qqstx.ss"
+                         "sort.ss"))
 
   (#%provide new-lambda new-λ
              new-define
@@ -172,31 +173,6 @@
                              "procedure"
                              p)]))
 
-  ;; ----------------------------------------
-  ;; Sorting keywords.
-  
-  ;; The sort in "list.ss" should be moved into it's own library, 
-  ;; so we can use it here without requiring lots of other stuff.)
-  
-  (define-for-syntax (sort l <?)
-    (cond
-      [(null? l) null]
-      [(null? (cdr l)) l]
-      [else (let loop ([l l]
-                       [a null]
-                       [b null])
-              (cond
-                [(null? l) (let loop ([a (sort a <?)]
-                                      [b (sort b <?)])
-                             (cond
-                               [(null? a) b]
-                               [(null? b) a]
-                               [(<? (car a) (car b))
-                                (cons (car a) (loop (cdr a) b))]
-                               [else
-                                (cons (car b) (loop a (cdr b)))]))]
-                [else (loop (cdr l) (cons (car l) b) a)]))]))
-
   ;; ----------------------------------------
   ;; `lambda' with optional and keyword arguments
   

collects/scheme/private/sort.ss

@@ -1,9 +1,8 @@
-(module sort "pre-base.ss"
+(module sort '#%kernel
 
-(provide sort)
+(#%require "small-scheme.ss" "define.ss" (for-syntax "stxcase-scheme.ss"))
 
-(#%require (for-syntax "stxcase-scheme.ss")
+(#%provide sort)
-           (for-syntax "pre-base.ss"))
 
 ;; This is a destructive stable merge-sort, adapted from slib and improved by
 ;; Eli Barzilay.
@@ -25,6 +24,11 @@
 
 (define sort (let ()
 
+(define-syntax define-syntax-rule
+  (syntax-rules ()
+    [(dr (foo . pattern) template)
+     (define-syntax foo (syntax-rules () [(_ . pattern) template]))]))
+
 (define-syntax-rule (sort-internal-body lst *less? n has-getkey? getkey)
   (begin
     (define-syntax-rule (less? x y)
@@ -95,13 +99,11 @@
 
 (define sort-internals (make-hash-table))
 (define _
-  (let-syntax ([precomp
+  (let ()
-                (syntax-rules ()
+    (define-syntax-rule (precomp less? more ...)
-                  [(_ less? more ...)
+      (let ([proc (lambda (lst n) (sort-internal-body lst less? n #f #f))])
-                   (let ([proc (lambda (lst n)
-                                 (sort-internal-body lst less? n #f #f))])
         (hash-table-put! sort-internals less? proc)
-                     (hash-table-put! sort-internals more proc) ...)])])
+        (hash-table-put! sort-internals more proc) ...))
     (precomp < <=)
     (precomp > >=)
     (precomp string<? string<=?)