diff --git a/collects/mrflow/constraints-gen-and-prop.ss b/collects/mrflow/constraints-gen-and-prop.ss index 0c7869d2b0..384b7ef797 100644 --- a/collects/mrflow/constraints-gen-and-prop.ss +++ b/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. diff --git a/collects/mrflow/dfa.ss b/collects/mrflow/dfa.ss index faa53e6fa4..0a5d9598e3 100644 --- a/collects/mrflow/dfa.ss +++ b/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) diff --git a/collects/mrflow/hashcons.ss b/collects/mrflow/hashcons.ss index 1750c4cbed..2d80b635b3 100644 --- a/collects/mrflow/hashcons.ss +++ b/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? - type-struct-value? type-union? type-values? type-vector?)) - (define base-type? (union type-empty? type-cst? type-struct-type?)) - (define hashcons-type? (union label-type? base-type? type-rec?)) + (define label-type? (or/c type-case-lambda? type-cons? type-promise? + type-struct-value? type-union? type-values? type-vector?)) + (define base-type? (or/c type-empty? type-cst? type-struct-type?)) + (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 diff --git a/collects/mrflow/snips-and-arrows-model.ss b/collects/mrflow/snips-and-arrows-model.ss index dcf223348f..9e8732d0f9 100644 --- a/collects/mrflow/snips-and-arrows-model.ss +++ b/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) diff --git a/collects/mrflow/snips-and-arrows-view.ss b/collects/mrflow/snips-and-arrows-view.ss index 4abc4c6a18..340a1f8400 100644 --- a/collects/mrflow/snips-and-arrows-view.ss +++ b/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?)) diff --git a/collects/mrflow/trie.ss b/collects/mrflow/trie.ss index 9029077efa..ed9573c098 100644 --- a/collects/mrflow/trie.ss +++ b/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)