Split out some small utilities to prepare to reduce dependencies.

collects/typed-racket/core.rkt

@@ -11,7 +11,7 @@
          (rep type-rep)
          (for-template (only-in (base-env prims) :type :print-type :query-result-type))
          (utils utils tc-utils arm)
-         "tc-setup.rkt")
+         "tc-setup.rkt" "utils/debug.rkt")
 
 (provide mb-core ti-core wt-core)
 

collects/typed-racket/infer/signatures.rkt

@@ -1,6 +1,7 @@
 #lang racket/base
 (require racket/unit racket/contract racket/require
-         "constraint-structs.rkt" (path-up "utils/utils.rkt" "rep/type-rep.rkt"))
+         "constraint-structs.rkt" 
+         (path-up "utils/utils.rkt" "utils/unit-utils.rkt" "rep/type-rep.rkt"))
 (provide (all-defined-out))
 
 (define-signature dmap^

collects/typed-racket/tc-setup.rkt

@@ -8,7 +8,7 @@
          (typecheck typechecker provide-handling tc-toplevel)
          (env tvar-env type-name-env type-alias-env)
          (r:infer infer)
-         (utils tc-utils disarm mutated-vars)
+         (utils tc-utils disarm mutated-vars debug)
          (rep type-rep)
          (except-in (utils utils) infer)
          (only-in (r:infer infer-dummy) infer-param)

collects/typed-racket/typecheck/signatures.rkt

@@ -1,6 +1,7 @@
 #lang racket/base
 (require racket/unit racket/contract
-         "../utils/utils.rkt" (rep type-rep) (types utils))
+         "../utils/utils.rkt" "../utils/unit-utils.rkt"
+         (rep type-rep) (types utils))
 (provide (all-defined-out))
 
 (define-signature tc-expr^

collects/typed-racket/typed-racket.rkt

@@ -1,7 +1,7 @@
 #lang racket/base
 
 (require
- (for-syntax racket/base "utils/utils.rkt") ;; only for timing/debugging
+ (for-syntax racket/base "utils/timing.rkt") ;; only for timing/debugging
  ;; the below requires are needed since they provide identifiers
  ;; that may appear in the residual program
  (for-syntax "typecheck/renamer.rkt" "types/type-table.rkt")

collects/typed-racket/types/subtype.rkt

@@ -270,7 +270,7 @@
               [((or (? Struct? s1) (NameStruct: s1)) (or (? Struct? s2) (NameStruct: s2)))
                (=> unmatch)
                (cond [(unrelated-structs s1 s2)
-                      (dprintf "found unrelated structs: ~a ~a\n" s1 s2)
+                      ;(dprintf "found unrelated structs: ~a ~a\n" s1 s2)
                       (fail! s t)]
                      [else (unmatch)])]
               ;; similar case for structs and base types, which are obviously unrelated

collects/typed-racket/utils/debug.rkt

@@ -0,0 +1,8 @@
+#lang racket/base
+
+(require (prefix-in d: unstable/debug))
+(provide debugf debugging? dprintf)
+
+(define debugging? (make-parameter #f))
+(define-syntax-rule (debugf f . args) (if (debugging?) (d:debugf f . args) (f . args)))
+(define (dprintf . args) (when (debugging?) (apply d:dprintf args)))

collects/typed-racket/utils/timing.rkt

@@ -0,0 +1,38 @@
+#lang racket/base
+(require (for-syntax racket/base))
+(provide start-timing do-time)
+
+;; some macros to do some timing, only when `timing?' is #t
+(define-for-syntax timing? #f)
+
+(define last-time #f) (define initial-time #f)
+(define (set!-initial-time t) (set! initial-time t))
+(define (set!-last-time t) (set! last-time t))
+(define (pad str len pad-char)
+  (define l (string-length str))
+  (if (>= l len)
+      str
+      (string-append str (make-string (- len l) pad-char))))
+(define-syntaxes (start-timing do-time)
+  (if timing?
+      (values
+       (syntax-rules ()
+         [(_ msg)
+          (begin
+            (when last-time
+              (error 'start-timing "Timing already started"))
+            (set!-last-time (current-process-milliseconds))
+            (set!-initial-time last-time)
+            (log-debug (format "TR Timing: ~a at ~a" (pad "Starting" 32 #\space) initial-time)))])
+       (syntax-rules ()
+         [(_ msg)
+          (begin
+            (unless last-time
+              (start-timing msg))
+            (let* ([t (current-process-milliseconds)]
+                   [old last-time]
+                   [diff (- t old)]
+                   [new-msg (pad msg 32 #\space)])
+              (set!-last-time t)
+              (log-debug (format "TR Timing: ~a at ~a\tlast step: ~a\ttotal: ~a" new-msg t diff (- t initial-time)))))]))
+      (values (lambda _ #'(void)) (lambda _ #'(void)))))

collects/typed-racket/utils/unit-utils.rkt

@@ -0,0 +1,12 @@
+#lang racket/base
+(require (for-syntax racket/base) "utils.rkt" racket/unit)
+
+(provide cond-contracted)
+
+(define-signature-form (cond-contracted stx)
+  (syntax-case stx ()
+    [(_ nm cnt)
+     (if enable-contracts?
+         (list #'[contracted (nm cnt)])
+         (list #'nm))]))
+

collects/typed-racket/utils/utils.rkt

@@ -6,12 +6,11 @@ at least theoretically.
 |#
 
 (require (for-syntax racket/base syntax/parse racket/string)
-         racket/require-syntax racket/unit
-         racket/provide-syntax (prefix-in d: unstable/debug)
-         racket/struct-info)
+         racket/require-syntax racket/provide-syntax         
+         racket/struct-info "timing.rkt")
 
 ;; to move to unstable
-(provide reverse-begin list-update list-set debugf debugging? dprintf)
+(provide list-update list-set)
 
 (provide
  ;; optimization
@@ -94,9 +93,6 @@ at least theoretically.
 (define-requirer optimizer optimizer-out)
 (define-requirer base-env base-env-out)
 
-;; run `h' last, but drop its return value
-(define-syntax-rule (reverse-begin h . forms) (begin0 (begin . forms) h))
-
 ;; conditionalized logging
 ;; there's some logging code in the source
 ;; which was used for gathering statistics about various programs
@@ -110,41 +106,6 @@ at least theoretically.
 	 #'(log-debug (format fmt . args))])
       #'(void)))
 
-;; some macros to do some timing, only when `timing?' is #t
-(define-for-syntax timing? #f)
-
-(define last-time #f) (define initial-time #f)
-(define (set!-initial-time t) (set! initial-time t))
-(define (set!-last-time t) (set! last-time t))
-(define (pad str len pad-char)
-  (define l (string-length str))
-  (if (>= l len)
-      str
-      (string-append str (make-string (- len l) pad-char))))
-(define-syntaxes (start-timing do-time)
-  (if timing?
-      (values
-       (syntax-rules ()
-         [(_ msg)
-          (begin
-            (when last-time
-              (error 'start-timing "Timing already started"))
-            (set!-last-time (current-process-milliseconds))
-            (set!-initial-time last-time)
-            (log-debug (format "TR Timing: ~a at ~a" (pad "Starting" 32 #\space) initial-time)))])
-       (syntax-rules ()
-         [(_ msg)
-          (begin
-            (unless last-time
-              (start-timing msg))
-            (let* ([t (current-process-milliseconds)]
-                   [old last-time]
-                   [diff (- t old)]
-                   [new-msg (pad msg 32 #\space)])
-              (set!-last-time t)
-              (log-debug (format "TR Timing: ~a at ~a\tlast step: ~a\ttotal: ~a" new-msg t diff (- t initial-time)))))]))
-      (values (lambda _ #'(void)) (lambda _ #'(void)))))
-
 ;; custom printing
 ;; this requires lots of work for two reasons:
 ;; - 1 printers have to be defined at the same time as the structs
@@ -180,8 +141,7 @@ at least theoretically.
 ;; turn contracts on and off - off by default for performance.
 (provide (for-syntax enable-contracts?)
          provide/cond-contract
-         with-cond-contract
-         cond-contracted
+         with-cond-contract         
          define-struct/cond-contract
          define/cond-contract
          contract-req
@@ -242,13 +202,6 @@ at least theoretically.
         [(_ hd ([i c] ...) . opts)
          (define-struct hd (i ...) . opts)])))
 
-(define-signature-form (cond-contracted stx)
-  (syntax-case stx ()
-    [(_ nm cnt)
-     (if enable-contracts?
-         (list #'[contracted (nm cnt)])
-         (list #'nm))]))
-
 (define (list-update l i f)
   (cond [(null? l) (error 'list-update "list not long enough" l i f)]
         [(zero? i) (cons (f (car l)) (cdr l))]
@@ -259,10 +212,6 @@ at least theoretically.
       (cons v (cdr l))
       (cons (car l) (list-set (cdr l) (sub1 k) v))))
 
-(define debugging? (make-parameter #f))
-(define-syntax-rule (debugf f . args) (if (debugging?) (d:debugf f . args) (f . args)))
-(define (dprintf . args) (when (debugging?) (apply d:dprintf args)))
-
 
 (provide make-struct-info-self-ctor)
 ;Copied from racket/private/define-struct