Rackety (mostly letrec-values => define and minimizing dependencies)

collects/redex/private/dot.rkt

@@ -1,10 +1,11 @@
-#lang scheme/gui
+#lang racket/base
-
+(require racket/contract
+         racket/class
+         racket/gui/base
+         racket/system)
 (provide/contract [dot-positioning (-> (is-a?/c pasteboard%) string? boolean? void?)]
                   [find-dot (-> (or/c path? false/c))])
 
-(require scheme/system)
-
 (provide dot-label neato-label neato-hier-label neato-ipsep-label)
 (define dot-label "dot")
 (define neato-label "neato")

collects/redex/private/fresh.rkt

@@ -1,4 +1,5 @@
-#lang scheme
+#lang racket/base
+(require racket/contract)
 
 (define re:gen-d #rx".*[^0-9]([0-9]+)$")
 (define (variable-not-in sexp var)
@@ -31,7 +32,7 @@
   (let loop ([sorted (sort nums <)]
              [i 1])
     (cond
-      [(empty? sorted) i]
+      [(null? sorted) i]
       [else 
        (let ([fst (car sorted)])
          (cond

collects/redex/private/keyword-macros.rkt

@@ -1,6 +1,7 @@
-#lang racket
+#lang racket/base
 
-(require (for-template racket/base racket/contract))
+(require racket/match
+         (for-template racket/base racket/contract))
 
 (define (parse-kw-args formals actuals source form-name)
   (let loop ([current (for/hash ([arg formals]) (values (car arg) #f))]

collects/redex/private/rg.rkt

@@ -1,4 +1,4 @@
-#lang scheme/base
+#lang racket/base
 
 (require "matcher.rkt"
          "reduction-semantics.rkt"
@@ -6,18 +6,17 @@
          "term.rkt"
          "error.rkt"
          "struct.rkt"
-         (for-syntax scheme/base
+         (for-syntax racket/base
                      "rewrite-side-conditions.rkt"
                      "term-fn.rkt"
                      "reduction-semantics.rkt"
                      "keyword-macros.rkt")
-         scheme/dict
+         racket/dict
-         scheme/contract
+         racket/contract
-         scheme/promise
+         racket/promise
-         scheme/unit
+         racket/unit
-         scheme/match
+         racket/match
-         scheme/pretty
+         racket/pretty
-         scheme/function
          mrlib/tex-table)
 
 (define redex-pseudo-random-generator
@@ -174,29 +173,27 @@
     (import) (export decisions^))
   
   (define (gen-nt lang name cross? retries size attempt filler)
-    (let*-values
+    (define productions
-        ([(productions)
+      (hash-ref ((if cross? rg-lang-cross rg-lang-non-cross) lang) name))
-          (hash-ref ((if cross? rg-lang-cross rg-lang-non-cross) lang) name)]
+    (define-values (term _)
-         [(term _)
       (let ([gen (pick-from-list
                   (if (zero? size)
                       (min-prods name productions 
                                  ((if cross? base-cases-cross base-cases-non-cross)
                                   (rg-lang-base-cases lang)))
                       ((next-non-terminal-decision) productions)))])
-            (gen retries (max 0 (sub1 size)) attempt empty-env filler))])
+        (gen retries (max 0 (sub1 size)) attempt empty-env filler)))
-      term))
+    term)
   
   (define (generate/pred name gen pred init-sz init-att retries)
-    (let ([pre-threshold-incr 
+    (define pre-threshold-incr 
       (ceiling
        (/ (- retry-threshold init-att)
-               (* proportion-before-threshold (add1 retries))))]
+          (* proportion-before-threshold (add1 retries)))))
-          [incr-size? 
+    (define (incr-size? remain)
-           (λ (remain)
       (zero? 
        (modulo (sub1 remain) 
-                      (ceiling (* proportion-at-size retries)))))])
+               (ceiling (* proportion-at-size retries)))))
     (let retry ([remaining (add1 retries)]
                 [size init-sz]
                 [attempt init-att])
@@ -210,7 +207,7 @@
                        (+ attempt
                           (if (>= attempt retry-threshold)
                               post-threshold-incr
-                                pre-threshold-incr)))))))))
+                              pre-threshold-incr))))))))
   
   (define (generate/prior name env gen)
     (let* ([none (gensym)]
@@ -232,22 +229,21 @@
       (foldl (λ (var env)
                (hash-set env var (map (λ (seq-env) (hash-ref seq-env var)) seq-envs)))
              env vars))
-    (let-values
+    (define-values (seq envs)
-        ([(seq envs)
       (let recur ([envs (split-environment env)])
         (if (null? envs)
             (values null null)
             (let*-values 
                 ([(hd env) (gen (car envs))]
                  [(tl envs) (recur (cdr envs))])
-                  (values (cons hd tl) (cons env envs)))))])
+              (values (cons hd tl) (cons env envs))))))
-      (values seq (merge-environments envs))))
+    (values seq (merge-environments envs)))
   
   (define ((generator/attempts g) r s a e f)
     (values (g a) e))
   
   (define (mismatches-satisfied? env)
-    (let ([groups (make-hasheq)])
+    (define groups (make-hasheq))
     (define (get-group group)
       (hash-ref groups group
                 (λ ()
@@ -258,7 +254,7 @@
       (or (not (mismatch? name))
           (let ([prior (get-group (mismatch-group name))])
             (and (not (hash-ref prior val #f))
-                   (hash-set! prior val #t)))))))
+                 (hash-set! prior val #t))))))
   
   (define empty-env #hash())
   
@@ -269,12 +265,11 @@
            (cons (make-bind (binder-name key) val) bindings)
            bindings))))
   
-  (let*-values ([(langp lits lang-bases) (prepare-lang lang)]
+  (define-values (langp lits lang-bases) (prepare-lang lang))
-                [(sexpp _ sexp-bases) (prepare-lang sexp)]
+  (define-values (sexpp _ sexp-bases) (prepare-lang sexp))
-                [(lit-syms) (compiled-lang-literals lang)])
+  (define lit-syms (compiled-lang-literals lang))
-    (letrec-values 
+  
-        ([(compile)
+  (define (compile pat any?)
-          (λ (pat any?)
     (let* ([nt? (is-nt? (if any? sexpp langp))]
            [mismatches? #f]
            [generator 
@@ -402,34 +397,30 @@
             (let ([g (λ (s a) (generator r s a e f))]
                   [p? (λ (_ e) (mismatches-satisfied? e))])
               (generate/pred (unparse-pattern pat) g p? s a r)))
-                  generator)))]
+          generator)))
-         [(compile-non-terminals)
+  (define (compile-non-terminals nts any?)
-          (λ (nts any?)
     (make-immutable-hash
      (map (λ (nt) (cons (nt-name nt)
                         (map (λ (p) (compile (rhs-pattern p) any?))
                              (nt-rhs nt))))
-                  nts)))]
+          nts)))
-         [(compile-language)
+  (define (compile-language lang bases any?)
-          (λ (lang bases any?)
     (make-rg-lang
      (compile-non-terminals (compiled-lang-lang lang) any?)
      (delay (compile-non-terminals (compiled-lang-cclang lang) any?))
-             bases))]
+     bases))
-         [(langc sexpc compile-pattern)
+  (define langc (compile-language langp lang-bases #f))
-          (values
+  (define sexpc (compile-language sexpp sexp-bases #t))
-           (compile-language langp lang-bases #f)
+  (define (compile-pattern pat) (compile pat #f))
-           (compile-language sexpp sexp-bases #t)
-           (λ (pat) (compile pat #f)))])
   (λ (pat)
-        (let ([g (compile-pattern (reassign-classes (parse-pattern pat lang 'top-level)))])
+    (define g (compile-pattern (reassign-classes (parse-pattern pat lang 'top-level))))
     (λ (size attempt retries)
-            (let-values ([(t e) (g retries size attempt empty-env the-hole)])
+      (define-values (t e) (g retries size attempt empty-env the-hole))
       (values (let replace-the-not-hole ([t t])
                 (cond [(eq? t the-not-hole) the-hole]
                       [(list? t) (map replace-the-not-hole t)]
                       [else t])) 
-                      (bindings e)))))))))
+              (bindings e)))))
 
 (define-struct base-cases (delayed-cross non-cross))
 (define (base-cases-cross x) (force (base-cases-delayed-cross x)))
@@ -997,7 +988,7 @@
        (reduction-relation-make-procs r)))
 
 (define (metafunction-srcs m)
-  (map (compose (curry format "clause at ~a") metafunc-case-src-loc)
+  (map (λ (x) (format "clause at ~a" (metafunc-case-src-loc x)))
        (metafunc-proc-cases m)))
 
 (define-syntax (check-reduction-relation stx)

collects/redex/private/struct.rkt

@@ -1,6 +1,6 @@
-#lang racket
+#lang racket/base
 
-(require "matcher.rkt")
+(require racket/list "matcher.rkt")
 
 ;; don't provide reduction-relation directly, so that we can use that for the macro's name.
 (provide reduction-relation-lang