contracts: union => or/c

svn: r2290

collects/mrflow/constraints-gen-and-prop.ss

@@ -201,7 +201,7 @@
              env))
      env args args-labels))
   
-  ; syntax-object (listof (cons symbol label)) -> (union label #f)
+  ; syntax-object (listof (cons symbol label)) -> (or/c label #f)
   (define (lookup-env var env)
     (let ([name-label-pair (assq (syntax-e var) env)])
       (if name-label-pair
@@ -224,7 +224,7 @@
   (define (add-top-level-name sba-state term label)
     (hash-table-put! (sba-state-top-level-name->label sba-state) (syntax-object->datum term) label))
   
-  ; sba-state symbol -> (union label #f)
+  ; sba-state symbol -> (or/c label #f)
   ; finds the label for a top level var.
   (define (lookup-top-level-name sba-state name)
     (hash-table-get (sba-state-top-level-name->label sba-state) name cst:thunk-false))
@@ -3222,7 +3222,7 @@
   
   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; PRIMITIVE TYPE PARSER AND LOOKUP
   
-  ; sba-state symbol -> (union prim-data #f)
+  ; sba-state symbol -> (or/c prim-data #f)
   (define (lookup-primitive-data sba-state name)
     (hash-table-get (sba-state-primitive-types-table sba-state) name cst:thunk-false))
   
@@ -4450,14 +4450,14 @@
   
   ; called when t2 is a (flow var free) type instead of a handle
   (define/contract subtype-type
-    (sba-state? handle? hc:hashcons-type? any/c boolean? (union false/c label?) . -> . boolean?)
+    (sba-state? handle? hc:hashcons-type? any/c boolean? (or/c false/c label?) . -> . boolean?)
     (lambda (sba-state t1-handle t2 delta-flow error? label)
       (subtype sba-state t1-handle
                (hc:hashcons-type (sba-state-hashcons-tbl sba-state) t2)
                delta-flow error? label)))
   
   (define/contract subtype
-    (sba-state? handle? handle? any/c boolean? (union false/c label?) . -> . boolean?)
+    (sba-state? handle? handle? any/c boolean? (or/c false/c label?) . -> . boolean?)
     (lambda (sba-state t1-handle t2-handle delta-flow error? label)
       (if (subt sba-state (sba-state-hashcons-tbl sba-state) t1-handle t2-handle delta-flow (set-make 'equal))
           #t
@@ -4493,11 +4493,11 @@
                 (eq? term-type '#%top)
                 (eq? term-type 'quote))))))
   
-  ; label -> (union number #f)
+  ; label -> (or/c number #f)
   (define (get-span-from-label label)
     (syntax-span (label-term label)))
   
-  ; sba-state label (union 'red 'green 'orange) string -> void
+  ; sba-state label (or/c 'red 'green 'orange) string -> void
   (define (set-error-for-label sba-state label gravity message)
     (err:error-table-set (sba-state-errors sba-state)
                          (list label)
@@ -4573,7 +4573,7 @@
             (set-type-var-reach! (label-type-var label) set)
             set))))
   
-  ; label -> (union type-var handle)
+  ; label -> (or/c type-var handle)
   ; the label better have a type-var...
   (define (get-handle-or-type-var label)
     (let* ([type-var (label-type-var label)]
@@ -4646,7 +4646,7 @@
           (set-type-var-handle! (label-type-var label) handle)
           handle)))
   
-  ; type (union (hash-table-of type-flow-var (cons label type)) symbol) -> string
+  ; type (or/c (hash-table-of type-flow-var (cons label type)) symbol) -> string
   ; type pretty printer
   ; delta-flow is the flow variable environment, or a symbol if no flow environment
   ; was available at the time of the call.

collects/mrflow/dfa.ss

@@ -109,7 +109,7 @@
     (lambda (dfa state-number)
       (hash-table-get (dfa-stnum->state dfa) state-number)))
   
-  (define/contract greatest-handle (dfa? . -> . (union false/c handle?))
+  (define/contract greatest-handle (dfa? . -> . (or/c false/c handle?))
     (lambda (dfa)
       (let ([greatest-handle -1])
         (hash-table-for-each (dfa-stnum->state dfa)
@@ -292,7 +292,7 @@
                                            (hash-table-put! state->var state str)
                                            str)))]
            [statify
-            (lambda (sym state) ;((union symbol? list?) state-number? . -> . (union symbol? list?))
+            (lambda (sym state) ;((or/c symbol? list?) state-number? . -> . (or/c symbol? list?))
               (let* ([first (if (list? sym) (car sym) sym)]
                      [first (string->symbol
                              (string-append (symbol->string first) ":" (number->string state)))])
@@ -802,13 +802,13 @@
   ;;
   
   (define/contract set-equiv-class-of-state-number! 
-    ((vectorof (union false/c natural?)) equiv-class? state-number? . -> . void?)
+    ((vectorof (or/c false/c natural?)) equiv-class? state-number? . -> . void?)
     (lambda (classes equiv-class stnum)
       (vector-set! classes stnum (equiv-class-number equiv-class))))
   
   ;; A function extracting some value from a dfa-state. Discriminators
   ;; are used when comparing two states
-  (define discriminator? (state? . -> . (union integer? boolean?)))
+  (define discriminator? (state? . -> . (or/c integer? boolean?)))
   
   (define/contract block->partition (block? . -> . partition?)
     list-immutable)

collects/mrflow/hashcons.ss

@@ -48,16 +48,16 @@
   ;(pretty-print-columns 105)
   
   ;; Some predicates for contracts
-  (define label-type? (union type-case-lambda? type-cons? type-promise?
+  (define label-type? (or/c type-case-lambda? type-cons? type-promise?
                             type-struct-value? type-union? type-values? type-vector?))
-  (define base-type? (union type-empty? type-cst? type-struct-type?))
+  (define base-type? (or/c type-empty? type-cst? type-struct-type?))
-  (define hashcons-type? (union label-type? base-type? type-rec?))
+  (define hashcons-type? (or/c label-type? base-type? type-rec?))
   
   ;;
   ;; Hashcons tables
   ;;
   (define-struct hashcons-table
-    (from-handle     ;; handle -> (union dfa label base-type)
+    (from-handle     ;; handle -> (or/c dfa label base-type)
      from-dfa        ;; dfa -> handle
      from-label      ;; label -> handle
      from-base-type  ;; base-type -> handle
@@ -270,7 +270,7 @@
   
   ;; After we've hashconsed a recursive type this does the final job
   ;; of adding it to the hashcons table.
-  (define/contract hashcons-rec-type-body (hashcons-table? (union type? handle?) . -> . (union type? handle?))
+  (define/contract hashcons-rec-type-body (hashcons-table? (or/c type? handle?) . -> . (or/c type? handle?))
     (lambda (tbl type)
       (let ([recall-type (lambda (type) (if (has-type? tbl type)
                                             (get-type-handle tbl type)
@@ -374,7 +374,7 @@
         (hashcons type))))
   
   (define/contract bottom-up-hashcons-rec-type
-    (hashcons-table? . -> . ((listof type-var?) (listof (union type? handle?)) (union type? handle?) . ->d .
+    (hashcons-table? . -> . ((listof type-var?) (listof (or/c type? handle?)) (or/c type? handle?) . ->d .
                                                 (lambda (vars types body)
                                                   (when (has-free-vars? (make-type-rec vars types body))
                                                     (error 'bottom-up-hashcons "~a has free type variables~n" (make-type-rec vars types body)))
@@ -646,7 +646,7 @@
             [else (error 'fold-type "Unmatched type ~a" type)])))))
   
   ;; Return a type with handles replacing variables
-  (define/contract subst-handles/vars ((union label-type? handle? type-var?) tenv? . -> . (union type? handle?))
+  (define/contract subst-handles/vars ((or/c label-type? handle? type-var?) tenv? . -> . (or/c type? handle?))
     (lambda (type tenv)
       (let subst ([type type])
         (cond
@@ -684,7 +684,7 @@
           [else (error 'subst-handles/vars "Unmatched type ~a" type)]))))
   
   (define/contract subst-handles/vars-if-possible
-    ((union hashcons-type? handle? type-var?) tenv? . -> . (union type? handle?))
+    ((or/c hashcons-type? handle? type-var?) tenv? . -> . (or/c type? handle?))
     (lambda (type tenv)
       (let subst ([type type])
         (match type
@@ -722,7 +722,7 @@
            type])
         )))
   
-  (define/contract has-free-vars? ((union type? handle?) . -> . boolean?)
+  (define/contract has-free-vars? ((or/c type? handle?) . -> . boolean?)
     (lambda (type)
       (let* ([bound-vars (make-hash-table)]
              [bind (lambda (var)
@@ -769,7 +769,7 @@
                   [_ (error 'has-free-vars? "Unmatched type ~a" type)])])
             (has-free-vars? type))))))
   
-  (define/contract get-referenced-vars ((union type? handle?) . -> . (listof symbol?))
+  (define/contract get-referenced-vars ((or/c type? handle?) . -> . (listof symbol?))
     (lambda (type)
       (let ([refed (make-hash-table)])
         (let loop ([type type])
@@ -797,7 +797,7 @@
           (hash-table-map refed (lambda (v _) v))))))
   
   (define/contract same-label-type?
-    (hashcons-table? state? (union type? handle?) . -> . boolean?)
+    (hashcons-table? state? (or/c type? handle?) . -> . boolean?)
     (lambda (tbl state type)
       (or (and (handle-state? state) (handle? type) (= (handle-state-handle state) type))
           (and (handle-state? state) (equal? (get-type tbl (handle-state-handle state)) type))
@@ -1163,7 +1163,7 @@
                                            (hash-table-put! handle->var handle str)
                                            str)))]
            [handlify
-            (lambda (str handle) ;(any/c handle? . -> . (union symbol? (cons/p symbol? any/c)))
+            (lambda (str handle) ;(any/c handle? . -> . (or/c symbol? (cons/p symbol? any/c)))
               (let* ([first (if (list? str) (car str) str)]
                      [first-handle
                       (string->symbol

collects/mrflow/snips-and-arrows-model.ss

@@ -114,7 +114,7 @@
    (for-each-label-in-source (gui-model-state? any/c (label? . -> . void?) . -> . void?))
    
    (add-arrow (gui-model-state? (list/c label? label? string?) boolean? . -> . void?))
-   (remove-arrows (gui-model-state? label? (union symbol? boolean?) boolean? . -> . void?))
+   (remove-arrows (gui-model-state? label? (or/c symbol? boolean?) boolean? . -> . void?))
    (remove-all-arrows (gui-model-state? . -> . void?))
    (for-each-arrow (gui-model-state? (non-negative-exact-integer? non-negative-exact-integer? non-negative-exact-integer? non-negative-exact-integer? any/c any/c boolean? string? . -> . void?) . -> . void?))
    (get-tacked-arrows-from-label (gui-model-state? label? . -> . non-negative-exact-integer?))
@@ -222,7 +222,7 @@
           (label-gui-data-left-new-pos label-gui-data)
           (get-new-pos-from-label gui-model-state label))))
   
-  ; gui-model-state label -> (union top #f)
+  ; gui-model-state label -> (or/c top #f)
   ; we register the source of the label and the label by its position,
   ; but we don't associate any label-gui-data with it yet, to save memory.
   ; We'll associate some label-gui-data with it on the fly, as needed (when
@@ -556,7 +556,7 @@
                                               (make-ending-arrow-set)))))
     cst:void)
   
-  ; gui-model-state label (union symbol boolean) boolean -> void
+  ; gui-model-state label (or/c symbol boolean) boolean -> void
   ; remove arrows starting at given label AND arrows ending at same given label
   ; Note that assoc-set-get will fail if we try to remove non-existant arrows...
   (define (remove-arrows gui-model-state start-label tacked? exn?)
@@ -588,7 +588,7 @@
                           get-source-from-label)))
     cst:void)
   
-  ; (assoc-setof top source-gui-data) (setof arrow) (union symbol boolean)
+  ; (assoc-setof top source-gui-data) (setof arrow) (or/c symbol boolean)
   ; (arrow -> label) (label-gui-data -> (setof arrow))
   ; (label -> top)
   ; -> (setof arrow)

collects/mrflow/snips-and-arrows-view.ss

@@ -64,7 +64,7 @@
    
    (add-arrow (gui-view-state? (list/c label? label? string?) boolean? . -> . void?))
    (get-tacked-arrows-from-label (gui-view-state? label? . -> . non-negative-exact-integer?))
-   (remove-arrows (gui-view-state? label? (union symbol? boolean?) boolean? . -> . void?))
+   (remove-arrows (gui-view-state? label? (or/c symbol? boolean?) boolean? . -> . void?))
    (redraw-arrows (gui-view-state? (is-a?/c dc<%>) real? real? . -> . void?))
    
    (invalidate-bitmap-cache (gui-view-state? . -> . void?))
@@ -167,7 +167,7 @@
   (define (add-arrow gui-view-state arrow-info tacked?)
     (saam:add-arrow (gui-view-state-gui-model-state gui-view-state) arrow-info tacked?))
   
-  ; gui-view-state label (union symbol boolean) boolean -> void
+  ; gui-view-state label (or/c symbol boolean) boolean -> void
   (define (remove-arrows gui-view-state start-label tacked? exn?)
     (saam:remove-arrows (gui-view-state-gui-model-state gui-view-state) start-label tacked? exn?))
   

collects/mrflow/trie.ss

@@ -29,7 +29,7 @@
 	    (old-make-trie '() (make-hash-table 'equal)))))
   
   ; Get the trie on the edge labeled by the DFA state
-  (define/contract get-trie-child (trie? state? . -> . (union trie? false/c))
+  (define/contract get-trie-child (trie? state? . -> . (or/c trie? false/c))
     (lambda (trie letter)
       (hash-table-get (trie-dfa-state->trie trie) letter cst:thunk-false)))
   
@@ -75,7 +75,7 @@
   ; contains the start state.  Getting the representative handle, we
   ; can lookup the handle of the start state in this noted trie.
   (define/contract dfa-present?
-    (trie? (nonempty-list-of? state?) . -> . (union false/c (listof handle?)))
+    (trie? (nonempty-list-of? state?) . -> . (or/c false/c (listof handle?)))
     (lambda (trie nstates) 
       (let/ec return-with
         (let* ([rev-tries (list:foldl (lambda (state tries)