WIP: remove dependency on compatibility-lib

Author: rfindler

drracket-core/drracket/private/language-configuration.rkt

@@ -22,7 +22,6 @@
          browser/external
          mrlib/panel-wob
          lang/htdp-langs-save-file-prefix
-         (only-in mzlib/struct make-->vector)
 
          ;; ensure that this module is always loaded since it is shared below for pretty big
          (prefix-in : mred/mred))
@@ -1942,7 +1941,15 @@
         (super-instantiate ())))
 
     (define-struct (simple-settings+assume drracket:language:simple-settings) (no-redef?))
-    (define simple-settings+assume->vector (make-->vector simple-settings+assume))
+    (define (simple-settings+assume->vector s)
+      (vector
+       (drracket:language:simple-settings-case-sensitive s)
+       (drracket:language:simple-settings-printing-style s)
+       (drracket:language:simple-settings-fraction-style s)
+       (drracket:language:simple-settings-show-sharing s)
+       (drracket:language:simple-settings-insert-newlines s)
+       (drracket:language:simple-settings-annotations s)
+       (simple-settings+assume-no-redef? s)))
 
     (define (macro-stepper-mixin %)
       (class %

drracket-core/drracket/private/language.rkt

@@ -14,7 +14,6 @@
 
          mzlib/pconvert
          racket/pretty
-         mzlib/struct
          racket/class
          racket/file
          racket/list
@@ -211,7 +210,13 @@
 (define make-simple-settings make-drracket:language:simple-settings)
 (define simple-settings make-simple-settings)
 
-  (define simple-settings->vector (make-->vector drracket:language:simple-settings))
+(define (simple-settings->vector s)
+  (drracket:language:simple-settings-case-sensitive s)
+  (drracket:language:simple-settings-printing-style s)
+  (drracket:language:simple-settings-fraction-style s)
+  (drracket:language:simple-settings-show-sharing s)
+  (drracket:language:simple-settings-insert-newlines s)
+  (drracket:language:simple-settings-annotations s))
 
   ;; simple-module-based-language-config-panel :
   ;;   parent [#:case-sensitive (union #f #t '?)]

drracket-core/drracket/private/multi-file-search.rkt

@@ -8,7 +8,7 @@
          racket/path
          racket/list
          racket/gui/base
-         mzlib/async-channel
+         racket/async-channel
          string-constants
          drracket/private/drsig
          mrlib/close-icon

drracket-core/drracket/private/syncheck-debug.rkt

@@ -1,9 +1,9 @@
-#lang mzscheme
+#lang racket/base
 
-  (require mzlib/pretty
-           mzlib/list
-           mzlib/class
-           mred)
+  (require racket/pretty
+           racket/list
+           racket/class
+           racket/gui/base)
 
   (provide debug-origin)  ;; : syntax [syntax] -> void
   ;; creates a frame for examining the 
@@ -23,18 +23,18 @@
 
        ;; assume that there aren't any eq? sub structures, only eq? flat stuff (symbols, etc)
        ;; this is guaranteed by syntax-object->datum/ht
-       (define range-start-ht (make-hash-table))
-       (define range-ht (make-hash-table))
+       (define range-start-ht (make-hasheq))
+       (define range-ht (make-hasheq))
        (define original-output-port (current-output-port))
        (define (range-pretty-print-pre-hook x v)
-         (hash-table-put! range-start-ht x (send output-text last-position)))
+         (hash-set! range-start-ht x (send output-text last-position)))
        (define (range-pretty-print-post-hook x v)
-         (hash-table-put! range-ht x 
-                          (cons
-                           (cons
-                            (hash-table-get range-start-ht x)
-                            (send output-text last-position))
-                           (hash-table-get range-ht x (λ () null)))))
+         (hash-set! range-ht x 
+                    (cons
+                     (cons
+                      (hash-ref range-start-ht x)
+                      (send output-text last-position))
+                     (hash-ref range-ht x (λ () null)))))
 
        (define (make-modern text)
          (send text change-style
@@ -43,7 +43,7 @@
                (send text last-position)))
 
        (define dummy
-         (begin (pretty-print (syntax-object->datum original-object) output-port)
+         (begin (pretty-print (syntax->datum original-object) output-port)
                 (newline output-port)
                 (parameterize ([current-output-port output-port]
                                [pretty-print-pre-print-hook range-pretty-print-pre-hook]
@@ -54,14 +54,14 @@
 
        (define ranges 
          (sort 
-          (apply append (hash-table-map range-ht (λ (k vs) (map (λ (v) (cons k v)) vs))))
+          (apply append (hash-map range-ht (λ (k vs) (map (λ (v) (cons k v)) vs))))
           (λ (x y)
             (<= (- (car (cdr x)) (cdr (cdr x)))
                 (- (car (cdr y)) (cdr (cdr y)))))))
 
        (define (show-info stx)
          (fprintf info-port "datum: ~s\nsource: ~a\nposition: ~s\noffset: ~s\noriginal: ~s\nbound-in-source: ~s\n\n"
-                  (syntax-object->datum stx)
+                  (syntax->datum stx)
                   (syntax-source stx)
                   (syntax-position stx)
                   (syntax-span stx)
@@ -79,13 +79,13 @@
               (fprintf info-port
                        "  original? ~a\n  datum:\n  ~a\n\n"
                        (and (syntax? origin) (syntax-original? origin))
-                       (and (syntax? origin) (syntax-object->datum origin)))]
+                       (and (syntax? origin) (syntax->datum origin)))]
              [else (void)])))
 
        (for-each
         (λ (range)
           (let* ([obj (car range)]
-                 [stx (hash-table-get stx-ht obj)]
+                 [stx (hash-ref stx-ht obj)]
                  [start (cadr range)]
                  [end (cddr range)])
             (when (syntax? stx)
@@ -109,7 +109,7 @@
                  (send info-text begin-edit-sequence)
                  (send info-text erase)
                  (for-each (λ (rng)
-                             (let ([stx (hash-table-get stx-ht (car rng))])
+                             (let ([stx (hash-ref stx-ht (car rng))])
                                (when (syntax? stx)
                                  (show-info stx))))
                            ranges)
@@ -126,26 +126,26 @@
   ;; build-ht : stx -> hash-table
   ;; the resulting hash-table maps from the each sub-object's to its syntax.
   (define (syntax-object->datum/ht stx)
-    (let ([ht (make-hash-table)])
+    (let ([ht (make-hasheq)])
       (values (let loop ([stx stx])
                 (let ([obj (syntax-e stx)])
                   (cond
                     [(list? obj) 
                      (let ([res (map loop obj)])
-                       (hash-table-put! ht res stx)
+                       (hash-set! ht res stx)
                        res)]
                     [(pair? obj) 
                      (let ([res (cons (loop (car obj))
                                       (loop (cdr obj)))])
-                       (hash-table-put! ht res stx)
+                       (hash-set! ht res stx)
                        res)]
                     [(vector? obj) 
                      (let ([res (list->vector (map loop (vector->list obj)))])
-                       (hash-table-put! ht res stx)
+                       (hash-set! ht res stx)
                        res)]
                     [else 
-                     (let ([res (syntax-object->datum stx)])
-                       (hash-table-put! ht res stx)
+                     (let ([res (syntax->datum stx)])
+                       (hash-set! ht res stx)
                        res)])))
               ht)))
 

drracket-core/drracket/private/text.rkt

@@ -1,5 +1,5 @@
 #lang racket/unit
-  (require mzlib/class
+  (require racket/class
            drracket/private/drsig
            framework)
 

drracket-core/drracket/private/tool-contract-language.rkt

@@ -1,10 +1,9 @@
-#lang mzscheme
+#lang racket/base
 
-  (provide (rename -#%module-begin #%module-begin)
-           (all-from-except mzscheme #%module-begin))
+  (provide (rename-out [-#%module-begin #%module-begin])
+           (except-out (all-from-out racket/base) #%module-begin))
 
-  (require racket/contract)
-  (require-for-syntax mzlib/list)
+  (require racket/contract (for-syntax racket/base racket/list))
 
   (define-syntax (-#%module-begin stx)
 
@@ -18,8 +17,8 @@
          (make-def-binding (syntax name) (syntax expr))]
         [(name type type-names strs ...)
          (and (identifier? (syntax name))
-              (not (string? (syntax-object->datum (syntax type))))
-              (andmap (λ (x) (string? (syntax-object->datum x))) (syntax->list (syntax (strs ...)))))
+              (not (string? (syntax->datum (syntax type))))
+              (andmap (λ (x) (string? (syntax->datum x))) (syntax->list (syntax (strs ...)))))
          (make-ctc-binding (syntax name) (syntax type))]
         [else (raise-syntax-error 'tool-contract-language.rkt "unknown case" stx case-stx)]))
 
@@ -33,7 +32,7 @@
                        [(ctc ...) (map ctc-binding-arg ctc-cases)]
                        [(def-name ...) (map def-binding-var def-cases)]
                        [(def-exp ...) (map def-binding-arg def-cases)]
-                       [wrap-tool-inputs (datum->syntax-object stx 'wrap-tool-inputs #'here)])
+                       [wrap-tool-inputs (datum->syntax stx 'wrap-tool-inputs #'here)])
            (syntax/loc stx
              (#%module-begin
               (provide wrap-tool-inputs)
@@ -62,7 +61,7 @@
        (begin
          (for-each
           (λ (str-stx)
-            (when (string? (syntax-object->datum str-stx))
+            (when (string? (syntax->datum str-stx))
               (raise-syntax-error 'tool-contract-language.rkt "expected type name specification"
                                   stx
                                   str-stx)))
@@ -74,19 +73,19 @@
           (syntax->list (syntax (name ...))))
          (for-each
           (λ (str)
-            (unless (string? (syntax-object->datum str))
+            (unless (string? (syntax->datum str))
               (raise-syntax-error 'tool-contract-language.rkt "expected docs string" stx str)))
           (apply append (map syntax->list (syntax->list (syntax ((strs ...) ...)))))))]))
 
   (define-syntax (-#%module-begin2 stx)
     (syntax-case stx ()
       [(_ (name type type-names strs ...) ...)
        (and (andmap identifier? (syntax->list (syntax (name ...))))
-            (andmap (λ (x) (not (string? (syntax-object->datum x))))
+            (andmap (λ (x) (not (string? (syntax->datum x))))
                     (syntax->list (syntax (type-names ...))))
-            (andmap (λ (x) (string? (syntax-object->datum x)))
+            (andmap (λ (x) (string? (syntax->datum x)))
                     (apply append (map syntax->list (syntax->list (syntax ((strs ...) ...)))))))
-       (with-syntax ([wrap-tool-inputs (datum->syntax-object stx 'wrap-tool-inputs #'here)])
+       (with-syntax ([wrap-tool-inputs (datum->syntax stx 'wrap-tool-inputs #'here)])
          (syntax/loc stx
            (#%module-begin
             (provide wrap-tool-inputs)
@@ -119,7 +118,7 @@
        (begin
          (for-each
           (λ (str-stx)
-            (when (string? (syntax-object->datum str-stx))
+            (when (string? (syntax->datum str-stx))
               (raise-syntax-error 'tool-contract-language.rkt "expected type name specification"
                                   stx
                                   str-stx)))
@@ -131,6 +130,6 @@
           (syntax->list (syntax (name ...))))
          (for-each
           (λ (str)
-            (unless (string? (syntax-object->datum str))
+            (unless (string? (syntax->datum str))
               (raise-syntax-error 'tool-contract-language.rkt "expected docs string" stx str)))
           (apply append (map syntax->list (syntax->list (syntax ((strs ...) ...)))))))]))

drracket-core/drracket/private/unit.rkt

@@ -8,6 +8,7 @@
          racket/list
          racket/match
          racket/format
+         racket/date
          string-constants
          framework
          framework/private/srcloc-panel
@@ -36,8 +37,6 @@
          mred
          (prefix-in mred: mred)
 
-         mzlib/date
-         
          framework/private/aspell
          framework/private/logging-timer