diff --git a/base/comparator.rkt b/base/comparator.rkt index 44467101..ef46b322 100644 --- a/base/comparator.rkt +++ b/base/comparator.rkt @@ -49,7 +49,7 @@ rebellion/base/immutable-string rebellion/base/symbol rebellion/private/contract-projection - rebellion/private/guarded-block + guard rebellion/private/impersonation rebellion/private/static-name rebellion/private/strict-cond @@ -443,7 +443,7 @@ (define/guard (comparator-operand-contract comparator) (define contract (value-contract comparator)) - (guard (abstract-comparator-contract? contract) else + (guard (abstract-comparator-contract? contract) #:else any/c) (abstract-comparator-contract-operand-contract contract)) diff --git a/base/converter.rkt b/base/converter.rkt index ea1eee31..787f2c79 100644 --- a/base/converter.rkt +++ b/base/converter.rkt @@ -31,7 +31,7 @@ number->immutable-string) rebellion/collection/list rebellion/private/contract-projection - rebellion/private/guarded-block + guard rebellion/private/impersonation rebellion/private/static-name rebellion/type/object) @@ -265,7 +265,8 @@ ;; Built-in converters and converter utilities (define/guard (converter-pipe #:name [name 'piped] . converters) - (guard (nonempty-list? converters) else identity-converter) + (guard (nonempty-list? converters) #:else + identity-converter) (define forward-functions (map converter-forward-function converters)) (define backward-functions (map converter-backward-function converters)) (make-converter diff --git a/base/option/private/guard.rkt b/base/option/private/guard.rkt index 2084c9c8..785c03a1 100644 --- a/base/option/private/guard.rkt +++ b/base/option/private/guard.rkt @@ -6,7 +6,7 @@ racket/syntax) racket/block rebellion/base/option - rebellion/private/guarded-block + guard syntax/parse/define) (module+ test @@ -26,23 +26,13 @@ (define-syntax-parser guard-present #:track-literals - #:literals (then else) - - [(_ id:id expr then ~! body:expr ...+) + + [(_ id:id expr #:else ~! body:expr ...+) #:declare expr (expr/c #'option?) #:with id-option (make-option-id #'id) #'(begin (define id-option expr.c) - (guard (present? id-option) then - (define id (present-value id-option)) - (block body ...)))] - - [(_ id:id expr else ~! body:expr ...+) - #:declare expr (expr/c #'option?) - #:with id-option (make-option-id #'id) - #'(begin - (define id-option expr.c) - (guard (present? id-option) else body ...) + (guard (present? id-option) #:else body ...) (define id (present-value id-option)))] [(_ id:id expr) @@ -50,23 +40,16 @@ #:with id-option (make-option-id #'id) #'(begin (define id-option expr.c) - (guard (present? id-option) else + (guard (present? id-option) #:else (raise-arguments-error 'guard-present "expected a present option")) (define id (present-value id-option)))]) (module+ test (test-case "guard-present" - (test-case "then case" - (define/guard (run opt) - (guard-present v opt then v) - #false) - (check-equal? (run (present 4)) 4) - (check-false (run absent))) - (test-case "else case" (define/guard (run opt) - (guard-present v opt else #false) + (guard-present v opt #:else #false) v) (check-equal? (run (present 4)) 4) (check-false (run absent))) @@ -89,11 +72,6 @@ "other binding") (check-equal? (guarded-block - (guard-present foo absent then foo) - foo-option) - "other binding") - (check-equal? - (guarded-block - (guard-present foo absent else foo-option) + (guard-present foo absent #:else foo-option) foo) "other binding")))) diff --git a/base/range.rkt b/base/range.rkt index 2519962b..01dcd380 100644 --- a/base/range.rkt +++ b/base/range.rkt @@ -26,8 +26,10 @@ #:pre/name (lower-bound upper-bound cmp) "lower endpoint must be less than or equal to upper endpoint" (guarded-block - (guard (unbounded? lower-bound) then #true) - (guard (unbounded? upper-bound) then #true) + (guard (not (unbounded? lower-bound)) #:else + #true) + (guard (not (unbounded? upper-bound)) #:else + #true) (define lower (range-bound-endpoint lower-bound)) (define upper (range-bound-endpoint upper-bound)) (not (equal? (compare (default-real<=> cmp) lower upper) greater))) @@ -146,7 +148,7 @@ racket/match rebellion/base/comparator rebellion/private/cut - rebellion/private/guarded-block + guard rebellion/private/static-name rebellion/private/strict-cond rebellion/type/enum @@ -467,7 +469,8 @@ (inclusive-bound? (range-upper-bound range))))) (define/guard (nonempty-range? range) - (guard (range? range) else #false) + (guard (range? range) #:else + #false) (define lower (range-lower-bound range)) (define upper (range-upper-bound range)) (or (unbounded? lower) @@ -806,12 +809,12 @@ (define/guard (range-gap range1 range2) (define cmp (cut<=> (range-comparator range1))) - (guard (equal? (compare cmp (range-upper-cut range1) (range-lower-cut range2)) greater) else + (guard (equal? (compare cmp (range-upper-cut range1) (range-lower-cut range2)) greater) #:else (range (range-bound-flip (range-upper-bound range1)) (range-bound-flip (range-lower-bound range2)) #:comparator (range-comparator range1))) - (guard (equal? (compare cmp (range-lower-cut range1) (range-upper-cut range2)) lesser) else + (guard (equal? (compare cmp (range-lower-cut range1) (range-upper-cut range2)) lesser) #:else (range (range-bound-flip (range-upper-bound range2)) (range-bound-flip (range-lower-bound range1)) diff --git a/base/variant.rkt b/base/variant.rkt index 723df62b..b1749254 100644 --- a/base/variant.rkt +++ b/base/variant.rkt @@ -22,7 +22,7 @@ racket/string racket/struct rebellion/private/contract-projection - rebellion/private/guarded-block + guard rebellion/private/static-name rebellion/type/tuple) @@ -144,7 +144,8 @@ (define first-order-case-tests (map contract-first-order case-contracts)) (λ (first-order-test v) (guarded-block - (guard (variant? v) else #false) + (guard (variant? v) #:else + #false) (define index (index-of case-keywords (variant-tag v))) (and index ((list-ref first-order-case-tests index) v))))) diff --git a/binary/bitstring.rkt b/binary/bitstring.rkt index 8d22531c..b90729bd 100644 --- a/binary/bitstring.rkt +++ b/binary/bitstring.rkt @@ -34,7 +34,7 @@ rebellion/binary/bit rebellion/binary/byte rebellion/collection/list - rebellion/private/guarded-block + guard rebellion/streaming/reducer rebellion/type/tuple) @@ -104,7 +104,8 @@ #false #false #false #false #false #false #false #true)))]) (guarded-block (define next-byte (+ b (* current-byte 2))) - (guard eighth-bit? else (values next-byte current-index)) + (guard eighth-bit? #:else + (values next-byte current-index)) (bytes-set! mutable-padded-bytes current-index next-byte) (values 0 (add1 current-index)))) @@ -137,7 +138,8 @@ (define (bytes->bitstring bytes #:padding [padding 0]) (guarded-block - (guard (positive? padding) else (constructor:bitstring bytes 0)) + (guard (positive? padding) #:else + (constructor:bitstring bytes 0)) (define size (bytes-length bytes)) (define last-pos (sub1 size)) (define mutable-padded-bytes (make-bytes size 0)) diff --git a/collection/entry.rkt b/collection/entry.rkt index 8a7f18bc..99b1ccae 100644 --- a/collection/entry.rkt +++ b/collection/entry.rkt @@ -35,7 +35,7 @@ rebellion/base/variant rebellion/collection/list rebellion/private/contract-projection - rebellion/private/guarded-block + guard rebellion/private/static-name rebellion/private/total-match rebellion/streaming/reducer @@ -255,11 +255,12 @@ (define states (groups-reducer-states g)) (define keys (groups-reverse-ordered-keys g)) (define finished (groups-finished-keys g)) - (guard (not (set-member? finished k)) else g) + (guard (not (set-member? finished k)) #:else + g) - (guard (not (hash-has-key? states k)) else + (guard (not (hash-has-key? states k)) #:else (define value-state (consumer (hash-ref states k) v)) - (guard (variant-tagged-as? value-state '#:consume) else + (guard (variant-tagged-as? value-state '#:consume) #:else (hash-remove! states k) (define next-g (groups @@ -274,7 +275,7 @@ g) (define value-state (starter)) - (guard (variant-tagged-as? value-state '#:early-finish) else + (guard (variant-tagged-as? value-state '#:early-finish) #:else (hash-set! states k (variant-value value-state)) (define intermediate-g (groups @@ -311,7 +312,8 @@ (λ/match (g (entry k v)) (guarded-block (define next (groups-insert g k v #:reducer value-reducer)) - (guard (groups? next) else (variant #:emit next)) + (guard (groups? next) #:else + (variant #:emit next)) (variant #:consume next))) #:emitter (λ (state) @@ -322,7 +324,7 @@ (λ (g*) (guarded-block (define g (half-close-groups g*)) - (guard (positive? (closing-groups-size g)) else + (guard (positive? (closing-groups-size g)) #:else (variant #:finish #false)) (variant #:half-closed-emit g))) #:half-closed-emitter diff --git a/collection/list.rkt b/collection/list.rkt index 88a08380..1e59834d 100644 --- a/collection/list.rkt +++ b/collection/list.rkt @@ -21,7 +21,7 @@ (require racket/math rebellion/base/option - rebellion/private/guarded-block + guard rebellion/streaming/reducer) (module+ test @@ -44,8 +44,10 @@ (define (list-ref-safe lst pos) (define/guard (loop lst pos) - (guard (nonempty-list? lst) else absent) - (guard (zero? pos) else (loop (list-rest lst) (sub1 pos))) + (guard (nonempty-list? lst) #:else + absent) + (guard (zero? pos) #:else + (loop (list-rest lst) (sub1 pos))) (present (list-first lst))) (loop lst pos)) diff --git a/collection/multidict.rkt b/collection/multidict.rkt index c61a778e..2bab3f40 100644 --- a/collection/multidict.rkt +++ b/collection/multidict.rkt @@ -42,7 +42,7 @@ rebellion/collection/entry rebellion/collection/multiset rebellion/collection/keyset - rebellion/private/guarded-block + guard rebellion/private/printer-markup rebellion/streaming/reducer rebellion/type/record) @@ -66,9 +66,10 @@ (or/c set? multiset? (sequence/c any/c))) (define/guard (sequence->set seq) - (guard (set? seq) then seq) - (guard (multiset? seq) then (multiset-unique-elements seq)) - (for/set ([v seq]) v)) + (cond + [(set? seq) seq] + [(multiset? seq) (multiset-unique-elements seq)] + [else (for/set ([v seq]) v)])) (define (make-multidict-properties descriptor) (define type (record-descriptor-type descriptor)) @@ -174,7 +175,8 @@ (define/guard (multidict-add dict k v) (define old-vs (multidict-ref dict k)) - (guard (set-member? old-vs v) then dict) + (guard (not (set-member? old-vs v)) #:else + dict) (define delta (set-delta #:extra-elements (set) #:missing-elements (set v))) (multidict-replace-values dict k (set-add old-vs v) @@ -185,7 +187,8 @@ (define/guard (multidict-remove dict k v) (define old-vs (multidict-ref dict k)) - (guard (set-member? old-vs v) else dict) + (guard (set-member? old-vs v) #:else + dict) (define delta (set-delta #:extra-elements (set v) #:missing-elements (set))) (multidict-replace-values dict k (set-remove old-vs v) #:precomputed-value-set-delta delta)) diff --git a/collection/multiset.rkt b/collection/multiset.rkt index bcb3538e..8cdc36f1 100644 --- a/collection/multiset.rkt +++ b/collection/multiset.rkt @@ -39,7 +39,7 @@ racket/stream racket/struct rebellion/collection/entry - rebellion/private/guarded-block + guard rebellion/private/static-name rebellion/streaming/reducer rebellion/type/record) @@ -116,8 +116,10 @@ (multiset-set-frequency set element frequency)) (define/guard (multiset-remove set element #:copies [copies 1]) - (guard (multiset-contains? set element) else set) - (guard (equal? copies +inf.0) then (multiset-set-frequency set element 0)) + (guard (multiset-contains? set element) #:else + set) + (guard (not (equal? copies +inf.0)) #:else + (multiset-set-frequency set element 0)) (define frequency (max (- (multiset-frequency set element) copies) 0)) (multiset-set-frequency set element frequency)) diff --git a/collection/private/endpoint-map-range-set.rkt b/collection/private/endpoint-map-range-set.rkt index 7baced99..fb5044c1 100644 --- a/collection/private/endpoint-map-range-set.rkt +++ b/collection/private/endpoint-map-range-set.rkt @@ -38,7 +38,7 @@ (submod rebellion/streaming/reducer private-for-rebellion-only) rebellion/streaming/transducer rebellion/private/cut - rebellion/private/guarded-block + guard rebellion/private/precondition rebellion/private/static-name rebellion/private/todo @@ -101,13 +101,13 @@ (guarded-block (guard-match (present (entry leftmost-range-lower-cut leftmost-range-upper-cut)) (sorted-map-entry-at-most (this-endpoints this) lower-subset-cut) - else + #:else endpoints-submap) - (guard (compare-infix cut-comparator leftmost-range-upper-cut > lower-subset-cut) else + (guard (compare-infix cut-comparator leftmost-range-upper-cut > lower-subset-cut) #:else endpoints-submap) (define corrected-lower-range (range-from-cuts lower-subset-cut leftmost-range-upper-cut #:comparator cut-comparator)) - (guard (empty-range? corrected-lower-range) then + (guard (not (empty-range? corrected-lower-range)) #:else endpoints-submap) (sorted-map-put endpoints-submap lower-subset-cut leftmost-range-upper-cut))) @@ -115,13 +115,13 @@ (guarded-block (guard-match (present (entry rightmost-range-lower-cut rightmost-range-upper-cut)) (sorted-map-greatest-entry endpoints-submap-with-left-end-corrected) - else + #:else endpoints-submap-with-left-end-corrected) (define corrected-upper-cut (comparator-min cut-comparator rightmost-range-upper-cut upper-subset-cut)) (define corrected-rightmost-range (range-from-cuts rightmost-range-lower-cut corrected-upper-cut #:comparator cut-comparator)) - (guard (empty-range? corrected-rightmost-range) then + (guard (not (empty-range? corrected-rightmost-range)) #:else (sorted-map-remove endpoints-submap-with-left-end-corrected rightmost-range-lower-cut)) (sorted-map-put endpoints-submap-with-left-end-corrected rightmost-range-lower-cut corrected-upper-cut))) @@ -146,7 +146,7 @@ "range" range "range comparator" (range-comparator range) "range set comparator" cmp) - (guard (empty-range? range) then + (guard (not (empty-range? range)) #:else this) (define endpoints (this-endpoints this)) (define cut-cmp (sorted-map-key-comparator endpoints)) @@ -189,7 +189,7 @@ "range" range "range comparator" (range-comparator range) "range set comparator" cmp) - (guard (empty-range? range) then + (guard (not (empty-range? range)) #:else this) (define endpoints (this-endpoints this)) (define cut-cmp (sorted-map-key-comparator endpoints)) @@ -318,7 +318,7 @@ "range" range "range comparator" (range-comparator range) "range set comparator" cmp) - (guard (empty-range? range) then + (guard (not (empty-range? range)) #:else (void)) (define endpoints (this-endpoints this)) (define cut-cmp (sorted-map-key-comparator endpoints)) @@ -361,7 +361,7 @@ "range" range "range comparator" (range-comparator range) "range set comparator" cmp) - (guard (empty-range? range) then + (guard (not (empty-range? range)) #:else (void)) (define endpoints (this-endpoints this)) (define cut-cmp (sorted-map-key-comparator endpoints)) @@ -479,7 +479,7 @@ (define/guard (range-set-range-containing-or-absent this value) (define subrange (this-subrange this)) - (guard (range-contains? subrange value) else + (guard (range-contains? subrange value) #:else absent) (option-map (generic-range-set-range-containing-or-absent (this-delegate-range-set this) value) (λ (r) (range-intersection subrange r)))) @@ -511,7 +511,7 @@ "range" range "range comparator" (range-comparator range) "range set comparator" cmp) - (guard (empty-range? range) then + (guard (not (empty-range? range)) #:else (void)) (check-precondition (range-encloses? (this-subrange this) range) @@ -531,7 +531,7 @@ "range" range "range comparator" (range-comparator range) "range set comparator" cmp) - (guard (empty-range? range) then + (guard (not (empty-range? range)) #:else (void)) (generic-range-set-remove! delegate (range-intersection (this-subrange this) range))) @@ -566,7 +566,7 @@ (define/guard (endpoint-map-overlaps? endpoints comparator range) (define lower-cut (range-lower-cut range)) (define upper-cut (range-upper-cut range)) - (guard-match (present (entry _ upper)) (sorted-map-entry-at-most endpoints upper-cut) else + (guard-match (present (entry _ upper)) (sorted-map-entry-at-most endpoints upper-cut) #:else #false) (compare-infix (cut<=> (range-comparator range)) lower-cut < upper)) @@ -578,7 +578,7 @@ (define/guard (endpoint-map-span-or-absent endpoints comparator) - (guard (sorted-map-empty? endpoints) then + (guard (not (sorted-map-empty? endpoints)) #:else absent) (match-define (present lower-cut) (sorted-map-least-key endpoints)) (match-define (present (entry _ upper-cut)) (sorted-map-greatest-entry endpoints)) @@ -586,7 +586,7 @@ (define/guard (endpoint-map-get-nearest-range endpoints comparator cut) - (guard-match (present (entry lower upper)) (sorted-map-entry-at-most endpoints cut) else + (guard-match (present (entry lower upper)) (sorted-map-entry-at-most endpoints cut) #:else absent) (present (range-from-cuts lower upper #:comparator comparator))) diff --git a/collection/private/mutable-red-black-tree-deletion.rkt b/collection/private/mutable-red-black-tree-deletion.rkt index b21fbf7f..ec9fa0b5 100644 --- a/collection/private/mutable-red-black-tree-deletion.rkt +++ b/collection/private/mutable-red-black-tree-deletion.rkt @@ -11,7 +11,7 @@ (require rebellion/collection/private/mutable-red-black-tree-base rebellion/collection/private/mutable-red-black-tree-search - rebellion/private/guarded-block + guard rebellion/private/static-name) @@ -38,10 +38,10 @@ (define right-child (mutable-rb-node-child node right)) ;; First we check for the simple cases that don't require any rebalancing. - (guard (and root? (nil-leaf? left-child) (nil-leaf? right-child)) then + (guard (not (and root? (nil-leaf? left-child) (nil-leaf? right-child))) #:else (mutable-rb-tree-clear! tree)) - (guard (and (proper-mutable-rb-node? left-child) (proper-mutable-rb-node? right-child)) then + (guard (not (and (proper-mutable-rb-node? left-child) (proper-mutable-rb-node? right-child))) #:else (define choose-left? (>= (mutable-rb-node-size left-child) (mutable-rb-node-size right-child))) (define child (if choose-left? @@ -52,16 +52,16 @@ (define color (mutable-rb-node-color node)) - (guard (equal? color red) then + (guard (not (equal? color red)) #:else (if root? (mutable-rb-tree-clear! tree) (mutable-rb-node-remove-from-parent! node))) - (guard (proper-mutable-rb-node? left-child) then + (guard (not (proper-mutable-rb-node? left-child)) #:else (mutable-rb-node-swap-contents! node left-child) (mutable-rb-tree-remove-node! tree left-child)) - (guard (proper-mutable-rb-node? right-child) then + (guard (not (proper-mutable-rb-node? right-child)) #:else (mutable-rb-node-swap-contents! node right-child) (mutable-rb-tree-remove-node! tree right-child)) @@ -70,7 +70,7 @@ (define parent (mutable-rb-node-parent node)) (define dir (mutable-rb-node-parent-direction node)) - (define/guard (rebalance! node) + (define (rebalance! node) (cond [(deletion-case1? node) @@ -172,7 +172,7 @@ (define/guard (mutable-rb-node-sibling node) (define parent (mutable-rb-node-parent node)) - (guard (mutable-rb-root? parent) then + (guard (not (mutable-rb-root? parent)) #:else #false) (define parents-left-child (mutable-rb-node-child parent left)) (if (equal? parents-left-child node) @@ -182,7 +182,7 @@ (define/guard (mutable-rb-node-close-nephew node) (define parent (mutable-rb-node-parent node)) - (guard (mutable-rb-root? parent) then + (guard (not (mutable-rb-root? parent)) #:else #false) (define parents-left-child (mutable-rb-node-child parent left)) (cond @@ -196,7 +196,7 @@ (define/guard (mutable-rb-node-distant-nephew node) (define parent (mutable-rb-node-parent node)) - (guard (mutable-rb-root? parent) then + (guard (not (mutable-rb-root? parent)) #:else #false) (define parents-left-child (mutable-rb-node-child parent left)) (cond diff --git a/collection/private/mutable-red-black-tree-insertion.rkt b/collection/private/mutable-red-black-tree-insertion.rkt index 3e0ca60b..3cb8ee7c 100644 --- a/collection/private/mutable-red-black-tree-insertion.rkt +++ b/collection/private/mutable-red-black-tree-insertion.rkt @@ -18,7 +18,7 @@ rebellion/collection/entry rebellion/collection/private/mutable-red-black-tree-base rebellion/collection/private/mutable-red-black-tree-search - rebellion/private/guarded-block + guard rebellion/private/static-name) @@ -36,14 +36,14 @@ (define/guard (mutable-rb-tree-put! tree key value) (define previous-leaf (mutable-rb-tree-get-node tree key)) - (guard (nil-leaf? previous-leaf) else + (guard (nil-leaf? previous-leaf) #:else (mutable-rb-node-set-value! previous-leaf value)) (mutable-rb-tree-put-absent! tree previous-leaf key value)) (define/guard (mutable-rb-tree-put-if-absent! tree key value) (define previous-leaf (mutable-rb-tree-get-node tree key)) - (guard (nil-leaf? previous-leaf) else + (guard (nil-leaf? previous-leaf) #:else (present (mutable-rb-node-value previous-leaf))) (mutable-rb-tree-put-absent! tree previous-leaf key value) absent) @@ -51,7 +51,7 @@ (define/guard (mutable-rb-tree-get! tree key failure-result) (define previous-leaf (mutable-rb-tree-get-node tree key)) - (guard (nil-leaf? previous-leaf) else + (guard (nil-leaf? previous-leaf) #:else (mutable-rb-node-value previous-leaf)) (define value (if (procedure? failure-result) (failure-result) failure-result)) (mutable-rb-tree-put-absent! tree previous-leaf key value) @@ -60,7 +60,7 @@ (define/guard (mutable-rb-tree-get-entry! tree key failure-result) (define previous-leaf (mutable-rb-tree-get-node tree key)) - (guard (nil-leaf? previous-leaf) else + (guard (nil-leaf? previous-leaf) #:else (mutable-rb-node-entry previous-leaf)) (define value (if (procedure? failure-result) (failure-result) failure-result)) (mutable-rb-tree-put-absent! tree previous-leaf key value) @@ -69,7 +69,7 @@ (define/guard (mutable-rb-tree-update! tree key updater failure-result) (define previous-leaf (mutable-rb-tree-get-node tree key)) - (guard (nil-leaf? previous-leaf) else + (guard (nil-leaf? previous-leaf) #:else (define new-value (updater (mutable-rb-node-value previous-leaf))) (mutable-rb-node-set-value! previous-leaf new-value)) (define value (updater (if (procedure? failure-result) (failure-result) failure-result))) @@ -77,7 +77,7 @@ (define/guard (mutable-rb-tree-put-absent! tree previous-leaf key value) - (guard (root-node? previous-leaf) then + (guard (not (root-node? previous-leaf)) #:else (mutable-rb-tree-add-root-child! tree (make-red-node key value))) (define parent (mutable-rb-node-parent previous-leaf)) (define direction (mutable-rb-node-parent-direction previous-leaf)) @@ -86,14 +86,14 @@ (define/guard (rebalancing-loop node parent) - (guard (red-node? parent) else + (guard (red-node? parent) #:else ;; Insertion case 3: parent is black. No rebalancing necessary, black parent node with new red ;; child node is fine. (void)) (define grandparent (mutable-rb-node-parent parent)) - (guard (mutable-rb-root? grandparent) then + (guard (not (mutable-rb-root? grandparent)) #:else ;; Insertion case 6: parent is red and root. (mutable-rb-node-repaint! parent black)) @@ -103,7 +103,7 @@ (define uncle (mutable-rb-node-child grandparent grandparent-uncle-direction)) - (guard (black-node? uncle) then + (guard (not (black-node? uncle)) #:else ;; Insertion cases 4 and 5: parent is red and uncle is black. (cond [(equal? (mutable-rb-node-parent-direction node) grandparent-parent-direction) @@ -127,7 +127,7 @@ (mutable-rb-node-repaint! uncle black) (mutable-rb-node-repaint! grandparent red) (define great-grandparent (mutable-rb-node-parent grandparent)) - (guard (mutable-rb-root? great-grandparent) then + (guard (not (mutable-rb-root? great-grandparent)) #:else ;; Insertion case 2: same as case 1, except the grandparent is the root so after repainting it ;; the tree is already fully balanced. (void)) diff --git a/collection/private/mutable-red-black-tree-iteration.rkt b/collection/private/mutable-red-black-tree-iteration.rkt index f7a49127..aba68161 100644 --- a/collection/private/mutable-red-black-tree-iteration.rkt +++ b/collection/private/mutable-red-black-tree-iteration.rkt @@ -24,7 +24,7 @@ (submod rebellion/base/range private-for-rebellion-only) rebellion/collection/entry rebellion/collection/private/mutable-red-black-tree-base - rebellion/private/guarded-block) + guard) ;@---------------------------------------------------------------------------------------------------- @@ -35,7 +35,7 @@ (define (recur node) (in-mutable-rb-tree-node node #:descending? descending?)) - (guard (nil-leaf? node) then + (guard (not (nil-leaf? node)) #:else (stream)) (define entry (mutable-rb-node-entry node)) (define true-left (mutable-rb-node-child node left)) @@ -69,7 +69,7 @@ (define (recur node) (in-mutable-rb-subtree-node node key-range #:descending? descending?)) - (guard (nil-leaf? node) then + (guard (not (nil-leaf? node)) #:else (stream)) (define key (mutable-rb-node-key node)) diff --git a/collection/private/mutable-red-black-tree-search.rkt b/collection/private/mutable-red-black-tree-search.rkt index eb0051a4..43a38ae0 100644 --- a/collection/private/mutable-red-black-tree-search.rkt +++ b/collection/private/mutable-red-black-tree-search.rkt @@ -41,7 +41,7 @@ rebellion/collection/private/mutable-red-black-tree-iteration rebellion/collection/private/vector-binary-search rebellion/private/cut - rebellion/private/guarded-block) + guard) ;@---------------------------------------------------------------------------------------------------- @@ -70,13 +70,13 @@ (define key<=> (mutable-rb-tree-key-comparator tree)) (let loop ([node (mutable-rb-tree-root-node tree)]) (guarded-block - (guard (nil-leaf? node) then - node) - (define node-key (mutable-rb-node-key node)) - (match (compare key<=> key node-key) - [(== equivalent) node] - [(== lesser) (loop (mutable-rb-node-child node left))] - [(== greater) (loop (mutable-rb-node-child node right))])))) + (guard (not (nil-leaf? node)) #:else + node) + (define node-key (mutable-rb-node-key node)) + (match (compare key<=> key node-key) + [(== equivalent) node] + [(== lesser) (loop (mutable-rb-node-child node left))] + [(== greater) (loop (mutable-rb-node-child node right))])))) (define (mutable-rb-node-min-child node) @@ -105,7 +105,7 @@ (define/guard (mutable-rb-tree-contains-entry? tree entry) (define cmp (mutable-rb-tree-key-comparator tree)) (define key (entry-key entry)) - (guard (contract-first-order-passes? (comparator-operand-contract cmp) key) else + (guard (contract-first-order-passes? (comparator-operand-contract cmp) key) #:else #false) (define node (mutable-rb-tree-get-node tree key)) (and (proper-mutable-rb-node? node) (equal? (mutable-rb-node-value node) (entry-value entry)))) @@ -176,7 +176,7 @@ [min-start-index 0] [lower-entry absent] [upper-entry absent]) - (guard (proper-mutable-rb-node? node) else + (guard (proper-mutable-rb-node? node) #:else (map-gap min-start-index lower-entry upper-entry)) (define key (mutable-rb-node-key node)) (define value (mutable-rb-node-value node)) diff --git a/collection/private/mutable-sorted-map.rkt b/collection/private/mutable-sorted-map.rkt index ffec2289..aec654f7 100644 --- a/collection/private/mutable-sorted-map.rkt +++ b/collection/private/mutable-sorted-map.rkt @@ -27,7 +27,7 @@ rebellion/collection/private/sorted-map-key-set rebellion/collection/private/sorted-submap rebellion/collection/vector - rebellion/private/guarded-block + guard rebellion/private/precondition rebellion/private/static-name) @@ -267,7 +267,7 @@ (define/guard (sorted-submap this key-range) (define delegate (get-delegate this)) (define original-range (get-range this)) - (guard (range-overlaps? original-range key-range) else + (guard (range-overlaps? original-range key-range) #:else (make-empty-mutable-sorted-map (generic-sorted-map-key-comparator delegate))) (define intersection (range-intersection original-range key-range)) (constructor:regular-mutable-sorted-submap delegate intersection)) diff --git a/collection/private/mutable-sorted-set.rkt b/collection/private/mutable-sorted-set.rkt index 204a2335..58d7700f 100644 --- a/collection/private/mutable-sorted-set.rkt +++ b/collection/private/mutable-sorted-set.rkt @@ -26,7 +26,7 @@ rebellion/collection/private/sorted-set-interface (submod rebellion/collection/private/sorted-set-interface private-for-rebellion-only) rebellion/collection/private/sorted-subset - rebellion/private/guarded-block + guard rebellion/private/sequence-empty rebellion/private/static-name) @@ -138,7 +138,7 @@ (define/guard (sorted-subset this element-range) (define delegate (get-delegate this)) (define original-range (get-range this)) - (guard (range-overlaps? original-range element-range) else + (guard (range-overlaps? original-range element-range) #:else (make-empty-mutable-sorted-set (generic-sorted-set-comparator delegate))) (define intersection (range-intersection original-range element-range)) (constructor:regular-mutable-sorted-subset delegate intersection)) diff --git a/collection/private/persistent-red-black-tree.rkt b/collection/private/persistent-red-black-tree.rkt index ce16fd80..6dc2bbfa 100644 --- a/collection/private/persistent-red-black-tree.rkt +++ b/collection/private/persistent-red-black-tree.rkt @@ -73,7 +73,7 @@ rebellion/collection/entry rebellion/collection/private/vector-binary-search rebellion/private/cut - rebellion/private/guarded-block + guard rebellion/private/static-name) @@ -200,10 +200,10 @@ (define/guard (persistent-red-black-subtree-copy tree range) - (guard-match (present least) (persistent-red-black-tree-least-key tree) else + (guard-match (present least) (persistent-red-black-tree-least-key tree) #:else (empty-persistent-red-black-tree (persistent-red-black-tree-comparator tree))) (match-define (present greatest) (persistent-red-black-tree-greatest-key tree)) - (guard (and (range-contains? range least) (range-contains? range greatest)) then + (guard (not (and (range-contains? range least) (range-contains? range greatest))) #:else tree) (for/fold ([tree (empty-persistent-red-black-tree (persistent-red-black-tree-comparator tree))]) ([element (in-persistent-red-black-subtree tree range)]) @@ -248,7 +248,7 @@ (define/guard (in-persistent-red-black-subtree-node node key-range #:descending? [descending? #false]) - (guard (persistent-red-black-node? node) else + (guard (persistent-red-black-node? node) #:else (stream)) (define (recur node) @@ -298,7 +298,7 @@ (define cmp (persistent-red-black-tree-comparator tree)) (define/guard (loop [node (persistent-red-black-tree-root-node tree)]) - (guard (persistent-red-black-node? node) else + (guard (persistent-red-black-node? node) #:else #false) (match-define (persistent-red-black-node _ left node-key _ right _) node) (match (compare cmp node-key key) @@ -313,7 +313,7 @@ (define cmp (persistent-red-black-tree-comparator tree)) (define/guard (loop [node (persistent-red-black-tree-root-node tree)]) - (guard (persistent-red-black-node? node) else + (guard (persistent-red-black-node? node) #:else #false) (match-define (persistent-red-black-node _ left node-key _ right _) node) (match (compare cmp node-key key) @@ -330,7 +330,7 @@ (define cmp (persistent-red-black-tree-comparator tree)) (define/guard (loop [node (persistent-red-black-tree-root-node tree)]) - (guard (persistent-red-black-node? node) else + (guard (persistent-red-black-node? node) #:else (if (procedure? failure-result) (failure-result) failure-result)) (match-define (persistent-red-black-node _ left node-key value right _) node) (match (compare cmp node-key key) @@ -347,7 +347,7 @@ (define cmp (persistent-red-black-tree-comparator tree)) (define/guard (loop [node (persistent-red-black-tree-root-node tree)]) - (guard (persistent-red-black-node? node) else + (guard (persistent-red-black-node? node) #:else absent) (match-define (persistent-red-black-node _ left node-key value right _) node) (match (compare cmp node-key key) @@ -369,7 +369,7 @@ (define root (persistent-red-black-tree-root-node tree)) (define/guard (loop node) - (guard (persistent-red-black-node? node) else + (guard (persistent-red-black-node? node) #:else (define value (if (procedure? failure-result) (failure-result) failure-result)) (singleton-red-black-node key (updater value))) (define node-element (persistent-red-black-node-key node)) @@ -411,7 +411,7 @@ [min-start-index 0] [lower-entry absent] [upper-entry absent]) - (guard-match (persistent-red-black-node _ left key value right _) node else + (guard-match (persistent-red-black-node _ left key value right _) node #:else (map-gap min-start-index lower-entry upper-entry)) (match (search-function key) [(== lesser) @@ -452,7 +452,7 @@ (define/guard (persistent-red-black-tree-least-key tree) (define root (persistent-red-black-tree-root-node tree)) - (guard (persistent-red-black-node? root) else + (guard (persistent-red-black-node? root) #:else absent) (define (loop node) @@ -465,7 +465,7 @@ (define/guard (persistent-red-black-tree-least-entry tree) (define root (persistent-red-black-tree-root-node tree)) - (guard (persistent-red-black-node? root) else + (guard (persistent-red-black-node? root) #:else absent) (define (loop node) @@ -479,7 +479,7 @@ (define/guard (persistent-red-black-tree-greatest-key tree) (define root (persistent-red-black-tree-root-node tree)) - (guard (persistent-red-black-node? root) else + (guard (persistent-red-black-node? root) #:else absent) (define (loop node) @@ -492,7 +492,7 @@ (define/guard (persistent-red-black-tree-greatest-entry tree) (define root (persistent-red-black-tree-root-node tree)) - (guard (persistent-red-black-node? root) else + (guard (persistent-red-black-node? root) #:else absent) (define (loop node) @@ -548,7 +548,7 @@ (define root (persistent-red-black-tree-root-node tree)) (define/guard (loop node) - (guard (persistent-red-black-node? node) else + (guard (persistent-red-black-node? node) #:else (singleton-red-black-node key value)) (define node-key (persistent-red-black-node-key node)) (match (compare key<=> key node-key) diff --git a/collection/private/persistent-sorted-map.rkt b/collection/private/persistent-sorted-map.rkt index 484297f7..92377910 100644 --- a/collection/private/persistent-sorted-map.rkt +++ b/collection/private/persistent-sorted-map.rkt @@ -28,22 +28,21 @@ rebellion/collection/private/sorted-map-entry-set rebellion/collection/private/sorted-map-key-set rebellion/collection/private/sorted-submap - rebellion/private/guarded-block + guard rebellion/private/static-name) ;@---------------------------------------------------------------------------------------------------- -(define (sorted-map->persistent-sorted-map map) - (cond - [(persistent-sorted-map? map) map] - [else - (define key<=> (sorted-map-key-comparator map)) - (constructor:persistent-sorted-map - (for/fold ([tree (empty-persistent-red-black-tree key<=>)]) - ([e map]) - (persistent-red-black-tree-insert tree (entry-key e) (entry-value e))))])) +(define/guard (sorted-map->persistent-sorted-map map) + (guard (not (persistent-sorted-map? map)) #:else + map) + (define key<=> (sorted-map-key-comparator map)) + (constructor:persistent-sorted-map + (for/fold ([tree (empty-persistent-red-black-tree key<=>)]) + ([e map]) + (persistent-red-black-tree-insert tree (entry-key e) (entry-value e))))) ;; We define a specialized implementation of the empty map for speed. It's included in this module so @@ -422,7 +421,7 @@ (define/guard (sorted-submap this key-range) (define delegate (get-delegate this)) (define original-range (get-range this)) - (guard (range-overlaps? original-range key-range) else + (guard (range-overlaps? original-range key-range) #:else (empty-sorted-map (generic-sorted-map-key-comparator delegate))) (define intersection (range-intersection original-range key-range)) (constructor:persistent-sorted-submap delegate intersection)) diff --git a/collection/private/persistent-sorted-set.rkt b/collection/private/persistent-sorted-set.rkt index db574ea8..dd785654 100644 --- a/collection/private/persistent-sorted-set.rkt +++ b/collection/private/persistent-sorted-set.rkt @@ -23,7 +23,7 @@ rebellion/collection/private/sorted-set-interface (submod rebellion/collection/private/sorted-set-interface private-for-rebellion-only) rebellion/collection/private/sorted-subset - rebellion/private/guarded-block + guard rebellion/private/sequence-empty) @@ -206,7 +206,7 @@ (define/guard (sorted-subset this element-range) (define delegate (get-delegate this)) (define original-range (get-range this)) - (guard (range-overlaps? original-range element-range) else + (guard (range-overlaps? original-range element-range) #:else (empty-sorted-set (generic-sorted-set-comparator delegate))) (define intersection (range-intersection original-range element-range)) (constructor:persistent-sorted-subset delegate intersection)) diff --git a/collection/private/range-set-interface.rkt b/collection/private/range-set-interface.rkt index 16501858..e8336ecf 100644 --- a/collection/private/range-set-interface.rkt +++ b/collection/private/range-set-interface.rkt @@ -60,7 +60,7 @@ rebellion/base/comparator rebellion/base/option rebellion/base/range - rebellion/private/guarded-block + guard rebellion/private/printer-markup rebellion/private/static-name) @@ -189,14 +189,14 @@ [(define/guard (equal-proc this other recur) - (guard (recur (range-set-comparator this) (range-set-comparator other)) else + (guard (recur (range-set-comparator this) (range-set-comparator other)) #:else #false) ;; We check emptiness as a fast path, since empty collections are common in practice and ;; easy to optimize for. - (guard (range-set-empty? this) then + (guard (not (range-set-empty? this)) #:else (range-set-empty? other)) - (guard (range-set-empty? other) then + (guard (not (range-set-empty? other)) #:else #false) ;; We check the size before comparing elements so that we can avoid paying the O(n) range diff --git a/collection/private/regular-immutable-sorted-map.rkt b/collection/private/regular-immutable-sorted-map.rkt index d1ec812c..0e429d0a 100644 --- a/collection/private/regular-immutable-sorted-map.rkt +++ b/collection/private/regular-immutable-sorted-map.rkt @@ -39,7 +39,7 @@ (submod rebellion/collection/private/sorted-map-interface private-for-rebellion-only) rebellion/collection/private/vector-binary-search rebellion/private/cut - rebellion/private/guarded-block + guard rebellion/private/static-name) @@ -176,7 +176,7 @@ (define keys (regular-immutable-sorted-map-sorted-key-vector this)) (define values (regular-immutable-sorted-map-sorted-value-vector this)) (define key<=> (regular-immutable-sorted-map-key-comparator this)) - (guard (contract-first-order-passes? (comparator-operand-contract key<=>) key) else + (guard (contract-first-order-passes? (comparator-operand-contract key<=>) key) #:else #false) (match (vector-binary-search keys key #:comparator key<=>) [(list-position i _) (equal? (vector-ref values i) value)] @@ -195,7 +195,7 @@ (define keys (regular-immutable-sorted-map-sorted-key-vector this)) (define values (regular-immutable-sorted-map-sorted-value-vector this)) (define key<=> (regular-immutable-sorted-map-key-comparator this)) - (guard (contract-first-order-passes? (comparator-operand-contract key<=>) key) else + (guard (contract-first-order-passes? (comparator-operand-contract key<=>) key) #:else (if (procedure? failure-result) (failure-result) failure-result)) (match (vector-binary-search keys key #:comparator key<=>) [(list-position i _) (vector-ref values i)] @@ -205,7 +205,7 @@ (define keys (regular-immutable-sorted-map-sorted-key-vector this)) (define values (regular-immutable-sorted-map-sorted-value-vector this)) (define key<=> (regular-immutable-sorted-map-key-comparator this)) - (guard (contract-first-order-passes? (comparator-operand-contract key<=>) key) else + (guard (contract-first-order-passes? (comparator-operand-contract key<=>) key) #:else absent) (match (vector-binary-search keys key #:comparator key<=>) [(list-position i _) (present (vector-ref values i))] @@ -219,7 +219,7 @@ (define keys (regular-immutable-sorted-map-sorted-key-vector this)) (define values (regular-immutable-sorted-map-sorted-value-vector this)) (define key<=> (regular-immutable-sorted-map-key-comparator this)) - (guard (contract-first-order-passes? (comparator-operand-contract key<=>) key) else + (guard (contract-first-order-passes? (comparator-operand-contract key<=>) key) #:else (entry key (if (procedure? failure-result) (failure-result) failure-result))) (match (vector-binary-search keys key #:comparator key<=>) [(list-position i real-key) (entry real-key (vector-ref values i))] @@ -397,7 +397,7 @@ (define key<=> (regular-immutable-sorted-submap-key-comparator this)) (define start (regular-immutable-sorted-submap-start-index this)) (define end (regular-immutable-sorted-submap-end-index this)) - (guard (contract-first-order-passes? (comparator-operand-contract key<=>) key) else + (guard (contract-first-order-passes? (comparator-operand-contract key<=>) key) #:else #false) (match (vector-binary-search keys key start end #:comparator key<=>) [(list-position i _) (equal? (vector-ref values i) value)] @@ -413,7 +413,7 @@ (define key<=> (regular-immutable-sorted-submap-key-comparator this)) (define start (regular-immutable-sorted-submap-start-index this)) (define end (regular-immutable-sorted-submap-end-index this)) - (guard (contract-first-order-passes? (comparator-operand-contract key<=>) key) else + (guard (contract-first-order-passes? (comparator-operand-contract key<=>) key) #:else (if (procedure? failure-result) (failure-result) failure-result)) (match (vector-binary-search keys key start end #:comparator key<=>) [(list-position i _) (vector-ref values i)] @@ -425,7 +425,7 @@ (define key<=> (regular-immutable-sorted-submap-key-comparator this)) (define start (regular-immutable-sorted-submap-start-index this)) (define end (regular-immutable-sorted-submap-end-index this)) - (guard (contract-first-order-passes? (comparator-operand-contract key<=>) key) else + (guard (contract-first-order-passes? (comparator-operand-contract key<=>) key) #:else absent) (match (vector-binary-search keys key start end #:comparator key<=>) [(list-position i _) (present (vector-ref values i))] @@ -441,21 +441,21 @@ (define key<=> (regular-immutable-sorted-submap-key-comparator this)) (define start (regular-immutable-sorted-submap-start-index this)) (define end (regular-immutable-sorted-submap-end-index this)) - (guard (contract-first-order-passes? (comparator-operand-contract key<=>) key) else + (guard (contract-first-order-passes? (comparator-operand-contract key<=>) key) #:else (entry key (if (procedure? failure-result) (failure-result) failure-result))) (match (vector-binary-search keys key start end #:comparator key<=>) [(list-position i real-key) (entry real-key (vector-ref values i))] [_ (entry key (if (procedure? failure-result) (failure-result) failure-result))])) (define/guard (sorted-map-least-key this) - (guard (sorted-map-empty? this) then + (guard (not (sorted-map-empty? this)) #:else absent) (define keys (regular-immutable-sorted-submap-sorted-key-vector this)) (define start (regular-immutable-sorted-submap-start-index this)) (present (vector-ref keys start))) (define/guard (sorted-map-least-entry this) - (guard (sorted-map-empty? this) then + (guard (not (sorted-map-empty? this)) #:else absent) (define keys (regular-immutable-sorted-submap-sorted-key-vector this)) (define values (regular-immutable-sorted-submap-sorted-value-vector this)) diff --git a/collection/private/regular-immutable-sorted-set.rkt b/collection/private/regular-immutable-sorted-set.rkt index fbaa599c..949746fa 100644 --- a/collection/private/regular-immutable-sorted-set.rkt +++ b/collection/private/regular-immutable-sorted-set.rkt @@ -29,7 +29,7 @@ rebellion/collection/private/sorted-set-interface (submod rebellion/collection/private/sorted-set-interface private-for-rebellion-only) rebellion/collection/private/vector-binary-search - rebellion/private/guarded-block) + guard) ;@---------------------------------------------------------------------------------------------------- @@ -186,7 +186,7 @@ (list-position? (vector-binary-search vec value start end #:comparator cmp)))) (define/guard (sorted-set-least-element this) - (guard (sorted-set-empty? this) then + (guard (not (sorted-set-empty? this)) #:else absent) (define vec (regular-immutable-sorted-subset-sorted-vector this)) (define start (regular-immutable-sorted-subset-start-index this)) diff --git a/collection/private/reversed-sorted-set.rkt b/collection/private/reversed-sorted-set.rkt index dc04e1e9..eb679295 100644 --- a/collection/private/reversed-sorted-set.rkt +++ b/collection/private/reversed-sorted-set.rkt @@ -19,7 +19,7 @@ rebellion/collection/private/persistent-red-black-tree rebellion/collection/private/sorted-set-interface (submod rebellion/collection/private/sorted-set-interface private-for-rebellion-only) - rebellion/private/guarded-block + guard rebellion/private/sequence-empty) diff --git a/collection/private/sorted-map-builder.rkt b/collection/private/sorted-map-builder.rkt index 2bde1728..2a8c76c3 100644 --- a/collection/private/sorted-map-builder.rkt +++ b/collection/private/sorted-map-builder.rkt @@ -25,7 +25,7 @@ (submod rebellion/collection/private/regular-immutable-sorted-map private-for-rebellion-only) rebellion/collection/private/sorted-map-interface rebellion/streaming/transducer - rebellion/private/guarded-block + guard rebellion/private/static-name) @@ -56,7 +56,7 @@ (define key<=> (sorted-map-builder-key-comparator builder)) (define mutable-entries (build-mutable-vector (sorted-map-builder-entry-vector-builder builder))) - (guard (vector-empty? mutable-entries) then + (guard (not (vector-empty? mutable-entries)) #:else (empty-sorted-map key<=>)) (define (entry< e1 e2) diff --git a/collection/private/sorted-map-entry-set.rkt b/collection/private/sorted-map-entry-set.rkt index 6b7c9893..fd91153c 100644 --- a/collection/private/sorted-map-entry-set.rkt +++ b/collection/private/sorted-map-entry-set.rkt @@ -25,7 +25,7 @@ rebellion/collection/private/sorted-map-interface rebellion/collection/sorted-set (submod rebellion/collection/private/sorted-set-interface private-for-rebellion-only) - rebellion/private/guarded-block + guard rebellion/private/static-name) @@ -249,7 +249,7 @@ (define/guard (make-key-bound bound) - (guard (unbounded? bound) then + (guard (not (unbounded? bound)) #:else unbounded) (define key (entry-key (range-bound-endpoint bound))) (range-bound key (range-bound-type bound))) diff --git a/collection/private/sorted-map-interface.rkt b/collection/private/sorted-map-interface.rkt index 81482425..2a0d84c8 100644 --- a/collection/private/sorted-map-interface.rkt +++ b/collection/private/sorted-map-interface.rkt @@ -86,7 +86,7 @@ rebellion/base/symbol rebellion/collection/entry rebellion/collection/private/sorted-set-interface - rebellion/private/guarded-block + guard rebellion/private/printer-markup) @@ -229,14 +229,14 @@ [(define/guard (equal-proc this other recur) - (guard (recur (sorted-map-key-comparator this) (sorted-map-key-comparator other)) else + (guard (recur (sorted-map-key-comparator this) (sorted-map-key-comparator other)) #:else #false) ;; We check emptiness as a fast path, since empty collections are common in practice and ;; easy to optimize for. - (guard (sorted-map-empty? this) then + (guard (not (sorted-map-empty? this)) #:else (sorted-map-empty? other)) - (guard (sorted-map-empty? other) then + (guard (not (sorted-map-empty? other)) #:else #false) ;; We check the size before comparing elements so that we can avoid paying the O(n) element diff --git a/collection/private/sorted-set-builder.rkt b/collection/private/sorted-set-builder.rkt index 077c0679..0722745b 100644 --- a/collection/private/sorted-set-builder.rkt +++ b/collection/private/sorted-set-builder.rkt @@ -22,7 +22,7 @@ (submod rebellion/collection/private/regular-immutable-sorted-set private-for-rebellion-only) rebellion/collection/private/sorted-set-interface rebellion/streaming/transducer - rebellion/private/guarded-block) + guard) ;@---------------------------------------------------------------------------------------------------- @@ -51,7 +51,7 @@ (define/guard (build-sorted-set builder) (define element<=> (sorted-set-builder-comparator builder)) (define mutable-elements (build-mutable-vector (sorted-set-builder-vector-builder builder))) - (guard (zero? (vector-length mutable-elements)) then + (guard (positive? (vector-length mutable-elements)) #:else (empty-sorted-set element<=>)) (define (< x y) diff --git a/collection/private/sorted-set-interface.rkt b/collection/private/sorted-set-interface.rkt index 976d772a..49641809 100644 --- a/collection/private/sorted-set-interface.rkt +++ b/collection/private/sorted-set-interface.rkt @@ -59,7 +59,7 @@ rebellion/base/comparator rebellion/base/option rebellion/base/range - rebellion/private/guarded-block) + guard) ;@---------------------------------------------------------------------------------------------------- @@ -199,14 +199,14 @@ [(define/guard (equal-proc this other recur) - (guard (recur (sorted-set-comparator this) (sorted-set-comparator other)) else + (guard (recur (sorted-set-comparator this) (sorted-set-comparator other)) #:else #false) ;; We check emptiness as a fast path, since empty collections are common in practice and ;; easy to optimize for. - (guard (sorted-set-empty? this) then + (guard (not (sorted-set-empty? this)) #:else (sorted-set-empty? other)) - (guard (sorted-set-empty? other) then + (guard (not (sorted-set-empty? other)) #:else #false) ;; We check the size before comparing elements so that we can avoid paying the O(n) element diff --git a/collection/private/sorted-submap.rkt b/collection/private/sorted-submap.rkt index 0c1fcd7a..a0bcb4e7 100644 --- a/collection/private/sorted-submap.rkt +++ b/collection/private/sorted-submap.rkt @@ -34,7 +34,7 @@ rebellion/collection/entry rebellion/collection/private/sorted-map-interface rebellion/private/cut - rebellion/private/guarded-block) + guard) ;@---------------------------------------------------------------------------------------------------- @@ -60,7 +60,7 @@ (define/guard (sorted-submap-get map key-range key failure-result) (define key-cmp (sorted-map-key-comparator map)) (guard (and (contract-first-order-passes? (comparator-operand-contract key-cmp) key) - (range-contains? key-range key)) else + (range-contains? key-range key)) #:else (if (procedure? failure-result) (failure-result) failure-result)) (sorted-map-get map key failure-result)) @@ -68,18 +68,18 @@ (define/guard (sorted-submap-get-option map key-range key) (define key-cmp (sorted-map-key-comparator map)) (guard (and (contract-first-order-passes? (comparator-operand-contract key-cmp) key) - (range-contains? key-range key)) else + (range-contains? key-range key)) #:else absent) (sorted-map-get-option map key)) -(define/guard (sorted-submap-get-entry map key-range key failure-result) +(define (sorted-submap-get-entry map key-range key failure-result) (entry key (sorted-submap-get map key-range key failure-result))) (define/guard (sorted-submap-least-key map key-range) (define lower (range-lower-bound key-range)) - (guard (equal? lower unbounded) then + (guard (not (equal? lower unbounded)) #:else (sorted-map-least-key map)) (define endpoint (range-bound-endpoint lower)) (match (range-bound-type lower) @@ -89,7 +89,7 @@ (define/guard (sorted-submap-least-entry map key-range) (define lower (range-lower-bound key-range)) - (guard (equal? lower unbounded) then + (guard (not (equal? lower unbounded)) #:else (sorted-map-least-entry map)) (define endpoint (range-bound-endpoint lower)) (match (range-bound-type lower) @@ -99,7 +99,7 @@ (define/guard (sorted-submap-greatest-key map key-range) (define upper (range-upper-bound key-range)) - (guard (equal? upper unbounded) then + (guard (not (equal? upper unbounded)) #:else (sorted-map-greatest-key map)) (define endpoint (range-bound-endpoint upper)) (match (range-bound-type upper) @@ -109,7 +109,7 @@ (define/guard (sorted-submap-greatest-entry map key-range) (define upper (range-upper-bound key-range)) - (guard (equal? upper unbounded) then + (guard (not (equal? upper unbounded)) #:else (sorted-map-greatest-entry map)) (define endpoint (range-bound-endpoint upper)) (match (range-bound-type upper) diff --git a/collection/private/sorted-subset.rkt b/collection/private/sorted-subset.rkt index 787e0dc4..21dd6b32 100644 --- a/collection/private/sorted-subset.rkt +++ b/collection/private/sorted-subset.rkt @@ -23,7 +23,7 @@ (submod rebellion/base/range private-for-rebellion-only) rebellion/collection/private/sorted-set-interface rebellion/private/cut - rebellion/private/guarded-block) + guard) ;@---------------------------------------------------------------------------------------------------- @@ -37,7 +37,7 @@ (define/guard (sorted-subset-least-element tree range) (define lower (range-lower-bound range)) - (guard (equal? lower unbounded) then + (guard (not (equal? lower unbounded)) #:else (sorted-set-least-element tree)) (define endpoint (range-bound-endpoint lower)) (match (range-bound-type lower) @@ -47,7 +47,7 @@ (define/guard (sorted-subset-greatest-element tree range) (define upper (range-upper-bound range)) - (guard (equal? upper unbounded) then + (guard (not (equal? upper unbounded)) #:else (sorted-set-greatest-element tree)) (define endpoint (range-bound-endpoint upper)) (match (range-bound-type upper) diff --git a/collection/private/testing/mutable-red-black-tree-invariants.rkt b/collection/private/testing/mutable-red-black-tree-invariants.rkt index 944c5b32..586bed20 100644 --- a/collection/private/testing/mutable-red-black-tree-invariants.rkt +++ b/collection/private/testing/mutable-red-black-tree-invariants.rkt @@ -10,7 +10,7 @@ (module+ test (require rackunit rebellion/collection/private/mutable-red-black-tree-base - rebellion/private/guarded-block)) + guard)) ;@---------------------------------------------------------------------------------------------------- @@ -59,7 +59,7 @@ (define-check (check-mutable-rb-tree-invariants tree) (define/guard (check-red-node-children-are-black node) - (guard (nil-leaf? node) then + (guard (not (nil-leaf? node)) #:else (void)) (define left-child (mutable-rb-node-child node left)) (define right-child (mutable-rb-node-child node right)) @@ -76,7 +76,7 @@ (check-red-node-children-are-black right-child)) (define/guard (check-path-black-node-counts node) - (guard (nil-leaf? node) then + (guard (not (nil-leaf? node)) #:else 0) (define left-count (check-path-black-node-counts (mutable-rb-node-child node left))) (define right-count (check-path-black-node-counts (mutable-rb-node-child node right))) @@ -89,7 +89,7 @@ (if (black-node? node) (add1 left-count) left-count)) (define/guard (check-node-sizes node) - (guard (nil-leaf? node) then + (guard (not (nil-leaf? node)) #:else (void)) (define size (mutable-rb-node-size node)) (define left-child (mutable-rb-node-child node left)) diff --git a/collection/private/vector-binary-search.rkt b/collection/private/vector-binary-search.rkt index e27153b4..ed0581da 100644 --- a/collection/private/vector-binary-search.rkt +++ b/collection/private/vector-binary-search.rkt @@ -40,7 +40,7 @@ (submod rebellion/base/range private-for-rebellion-only) rebellion/collection/entry rebellion/private/cut - rebellion/private/guarded-block + guard rebellion/private/static-name) @@ -111,7 +111,7 @@ [lower-element absent] [upper (sub1 end)] [upper-element absent]) - (guard (<= lower upper) else + (guard (<= lower upper) #:else (list-gap lower lower-element upper-element)) (define middle (quotient (+ lower upper) 2)) (define middle-element (vector-ref vec middle)) diff --git a/collection/range-set.rkt b/collection/range-set.rkt index 40aa289e..5f6ff6a9 100644 --- a/collection/range-set.rkt +++ b/collection/range-set.rkt @@ -56,7 +56,6 @@ rebellion/base/comparator rebellion/base/range rebellion/private/static-name - rebellion/private/todo rebellion/streaming/transducer)) diff --git a/collection/sorted-set.rkt b/collection/sorted-set.rkt index 1e68961c..04684625 100644 --- a/collection/sorted-set.rkt +++ b/collection/sorted-set.rkt @@ -26,7 +26,7 @@ rebellion/collection/private/sorted-set-builder rebellion/collection/private/synchronized-sorted-set rebellion/collection/private/unmodifiable-sorted-set - rebellion/private/guarded-block + guard rebellion/private/static-name rebellion/streaming/reducer rebellion/streaming/transducer) @@ -44,8 +44,8 @@ ;; immutable-sorted-set? because the latter includes subset views. A subset view could be a tiny ;; portion of a much larger backing set, and there's a soft expectation that copying a sequence into ;; an immutable collection retains space linear in the size of the returned collection. - (guard (and (regular-immutable-sorted-set? elements) - (equal? (sorted-set-comparator elements) comparator)) then + (guard (not (and (regular-immutable-sorted-set? elements) + (equal? (sorted-set-comparator elements) comparator))) #:else elements) (transduce elements #:into (into-sorted-set comparator))) diff --git a/collection/table.rkt b/collection/table.rkt index ec34978c..76c8c2c9 100644 --- a/collection/table.rkt +++ b/collection/table.rkt @@ -25,7 +25,7 @@ rebellion/collection/immutable-vector rebellion/collection/keyset rebellion/collection/record - rebellion/private/guarded-block + guard rebellion/private/printer-markup rebellion/private/static-name rebellion/streaming/reducer @@ -156,7 +156,7 @@ (define size (table-builder-size builder)) (define columns (table-builder-columns builder)) (define lists (table-builder-lists builder)) - (guard (zero? size) then + (guard (positive? size) #:else (define lists (for/vector #:length (record-size record) ([v (in-vector (record-values record))]) diff --git a/collection/vector.rkt b/collection/vector.rkt index 26c13b70..b8568b9c 100644 --- a/collection/vector.rkt +++ b/collection/vector.rkt @@ -18,7 +18,7 @@ racket/set rebellion/collection/vector/builder rebellion/collection/immutable-vector - rebellion/private/guarded-block + guard rebellion/private/static-name rebellion/streaming/reducer) @@ -43,7 +43,8 @@ #:name (name into-mutable-vector))) (define/guard (into-vector #:size [size +inf.0]) - (guard (equal? size +inf.0) then into-unlimited-vector) + (guard (not (equal? size +inf.0)) #:else + into-unlimited-vector) (define (make-builder) (make-vector-builder #:expected-size size)) (define unlimited (make-effectful-fold-reducer @@ -51,7 +52,8 @@ (reducer-limit unlimited size)) (define/guard (into-mutable-vector #:size [size +inf.0]) - (guard (equal? size +inf.0) then into-unlimited-mutable-vector) + (guard (not (equal? size +inf.0)) #:else + into-unlimited-mutable-vector) (define (make-builder) (make-vector-builder #:expected-size size)) (define unlimited (make-effectful-fold-reducer @@ -60,13 +62,12 @@ (reducer-limit unlimited size)) (define/guard (sequence->vector seq) - (guard (vector? seq) then + (guard (not (vector? seq)) #:else (if (immutable? seq) seq (vector->immutable-vector seq))) - (guard (list? seq) then (vector->immutable-vector (list->vector seq))) - (guard (set? seq) then - (vector->immutable-vector - (for/vector #:length (set-count seq) ([v seq]) v))) - (vector->immutable-vector (for/vector ([v seq]) v))) + (cond + [(list? seq) (vector->immutable-vector (list->vector seq))] + [(set? seq) (vector->immutable-vector (for/vector #:length (set-count seq) ([v seq]) v))] + [else (vector->immutable-vector (for/vector ([v seq]) v))])) (module+ test (test-case "into-vector" diff --git a/collection/vector/builder.rkt b/collection/vector/builder.rkt index 1f49e65b..b97ecac4 100644 --- a/collection/vector/builder.rkt +++ b/collection/vector/builder.rkt @@ -22,7 +22,7 @@ racket/vector rebellion/collection/immutable-vector rebellion/collection/list - rebellion/private/guarded-block + guard rebellion/private/static-name) diff --git a/concurrency/atomic/fixnum.rkt b/concurrency/atomic/fixnum.rkt index 314cd945..d277d150 100644 --- a/concurrency/atomic/fixnum.rkt +++ b/concurrency/atomic/fixnum.rkt @@ -28,7 +28,7 @@ racket/fixnum rebellion/base/symbol rebellion/private/static-name - rebellion/private/guarded-block + guard syntax/parse/define) (module+ test @@ -63,8 +63,9 @@ (define/name (atomic-fixnum-compare-and-exchange! num expected replacement) (guarded-block (define x (atomic-fixnum-get num)) - (guard (eq? x expected) else x) - (guard (atomic-fixnum-compare-and-set! num expected replacement) else + (guard (eq? x expected) #:else + x) + (guard (atomic-fixnum-compare-and-set! num expected replacement) #:else (log-atomic-fixnum-contention num) (atomic-fixnum-compare-and-exchange! num expected replacement)) x)) @@ -72,7 +73,7 @@ (define/name (atomic-fixnum-get-then-set! num replacement) (guarded-block (define x (atomic-fixnum-get num)) - (guard (atomic-fixnum-compare-and-set! num x replacement) else + (guard (atomic-fixnum-compare-and-set! num x replacement) #:else (log-atomic-fixnum-contention num) (atomic-fixnum-get-then-set! num replacement)) x)) @@ -86,7 +87,7 @@ (define/name (atomic-fixnum-get-then-add! num amount) (guarded-block (define x (atomic-fixnum-get num)) - (guard (atomic-fixnum-compare-and-add! num x amount) else + (guard (atomic-fixnum-compare-and-add! num x amount) #:else (log-atomic-fixnum-contention num) (atomic-fixnum-get-then-add! num amount)) x)) @@ -95,7 +96,7 @@ (guarded-block (define x (atomic-fixnum-get num)) (define x* (fx+ x amount)) - (guard (atomic-fixnum-compare-and-set! num x x*) else + (guard (atomic-fixnum-compare-and-set! num x x*) #:else (log-atomic-fixnum-contention num) (atomic-fixnum-add-then-get! num amount)) x*)) @@ -109,7 +110,7 @@ (define/name (atomic-fixnum-get-then-update! num updater) (guarded-block (define x (atomic-fixnum-get num)) - (guard (atomic-fixnum-compare-and-set! num x (updater x)) else + (guard (atomic-fixnum-compare-and-set! num x (updater x)) #:else (log-atomic-fixnum-contention num) (atomic-fixnum-get-then-update! num updater)) x)) @@ -118,7 +119,7 @@ (guarded-block (define x (atomic-fixnum-get num)) (define x* (updater x)) - (guard (atomic-fixnum-compare-and-set! num x x*) else + (guard (atomic-fixnum-compare-and-set! num x x*) #:else (log-atomic-fixnum-contention num) (atomic-fixnum-update-then-get! num updater)) x*)) diff --git a/info.rkt b/info.rkt index e1cebfee..c6d80ca0 100644 --- a/info.rkt +++ b/info.rkt @@ -9,7 +9,8 @@ "rebellion"))) (define deps - (list "base")) + (list "base" + "guard")) (define build-deps (list "net-doc" diff --git a/media/application/octet-stream.rkt b/media/application/octet-stream.rkt index e0dfde62..fdfdec33 100644 --- a/media/application/octet-stream.rkt +++ b/media/application/octet-stream.rkt @@ -19,7 +19,7 @@ rebellion/binary/immutable-bytes rebellion/collection/record rebellion/media - rebellion/private/guarded-block + guard rebellion/type/tuple) (module+ test @@ -57,7 +57,8 @@ (define type (media-get-type m)) (define padding (guarded-block - (guard (application/octet-stream? type) else 0) + (guard (application/octet-stream? type) #:else + 0) (define params (media-type-parameters type)) (if (record-contains-key? params '#:padding) (string->number (record-ref params '#:padding)) diff --git a/permutation.rkt b/permutation.rkt index efee73e8..b683d23a 100644 --- a/permutation.rkt +++ b/permutation.rkt @@ -29,7 +29,6 @@ rebellion/base/variant rebellion/collection/list rebellion/collection/vector - rebellion/private/guarded-block rebellion/private/static-name rebellion/streaming/reducer rebellion/streaming/transducer @@ -130,7 +129,7 @@ (define no-value (gensym "no-value")) -(define/guard (permuting perm) +(define (permuting perm) (let ([perm (permutation-reverse perm)]) (define size (permutation-size perm)) (define temp-storage (make-vector size no-value)) diff --git a/private/cut.rkt b/private/cut.rkt index 12513a62..fc2bb580 100644 --- a/private/cut.rkt +++ b/private/cut.rkt @@ -20,7 +20,7 @@ (require racket/match rebellion/base/comparator - rebellion/private/guarded-block + guard rebellion/private/static-name) @@ -69,38 +69,28 @@ (define/guard ((cut-compare base-comparator) left right) - (guard (and (equal? left bottom-cut) (equal? right bottom-cut)) then - equivalent) - (guard (equal? left bottom-cut) then - lesser) - (guard (equal? right bottom-cut) then - greater) - (guard (and (equal? left top-cut) (equal? right top-cut)) then - equivalent) - (guard (equal? left top-cut) then - greater) - (guard (equal? right top-cut) then - lesser) - (define result - (compare - base-comparator - (intermediate-cut-value left) - (intermediate-cut-value right))) - (guard (or (equal? result lesser) (equal? result greater)) then - result) - (guard (and (lower-cut? left) (lower-cut? right)) then - equivalent) - (guard (lower-cut? left) then - lesser) - (guard (lower-cut? right) then - greater) - (guard (and (middle-cut? left) (middle-cut? right)) then - equivalent) - (guard (middle-cut? left) then - lesser) - (guard (middle-cut? right) then - greater) - equivalent) + (cond + [(and (equal? left bottom-cut) (equal? right bottom-cut)) equivalent] + [(equal? left bottom-cut) lesser] + [(equal? right bottom-cut) greater] + [(and (equal? left top-cut) (equal? right top-cut)) equivalent] + [(equal? left top-cut) greater] + [(equal? right top-cut) lesser] + [else + (define result + (compare + base-comparator + (intermediate-cut-value left) + (intermediate-cut-value right))) + (cond + [(or (equal? result lesser) (equal? result greater)) result] + [(and (lower-cut? left) (lower-cut? right)) equivalent] + [(lower-cut? left) lesser] + [(lower-cut? right) greater] + [(and (middle-cut? left) (middle-cut? right)) equivalent] + [(middle-cut? left) lesser] + [(middle-cut? right) greater] + [else equivalent])])) (define (cut-flip-side cut) diff --git a/private/printer-markup.rkt b/private/printer-markup.rkt index 3e0e58be..7b1bafb3 100644 --- a/private/printer-markup.rkt +++ b/private/printer-markup.rkt @@ -35,7 +35,7 @@ (require racket/pretty racket/sequence rebellion/custom-write - rebellion/private/guarded-block) + guard) ;@---------------------------------------------------------------------------------------------------- @@ -61,7 +61,7 @@ (define inline-separator (sequence-markup-inline-separator this)) (define inline (inline-sequence-markup elements #:prefix prefix #:suffix suffix #:separator inline-separator)) - (guard (pretty-printing-with-finite-columns?) else + (guard (pretty-printing-with-finite-columns?) #:else (custom-write inline out mode)) (unless (try-pretty-print-single-line inline out mode) (define multiline diff --git a/private/subsequence.rkt b/private/subsequence.rkt index 76376948..e5cfdf55 100644 --- a/private/subsequence.rkt +++ b/private/subsequence.rkt @@ -12,7 +12,7 @@ (require racket/math racket/sequence - rebellion/private/guarded-block) + guard) (module+ test (require (submod "..") @@ -21,7 +21,8 @@ ;@------------------------------------------------------------------------------ (define/guard (subsequence sequence start [end #false]) - (guard end else (sequence-tail sequence start)) + (guard end #:else + (sequence-tail sequence start)) (define limit (- end start)) (define indexed-tail (sequence-map cons (in-indexed (sequence-tail sequence start)))) diff --git a/private/vector-merge-adjacent.rkt b/private/vector-merge-adjacent.rkt index f390840f..12f8a13e 100644 --- a/private/vector-merge-adjacent.rkt +++ b/private/vector-merge-adjacent.rkt @@ -11,7 +11,7 @@ (require rebellion/collection/vector/builder - rebellion/private/guarded-block) + guard) (module+ test @@ -33,7 +33,7 @@ ;; (define/guard (vector-merge-adjacent vec should-merge? merge-function) (define count (vector-length vec)) - (guard (< count 2) then + (guard (>= count 2) #:else (vector->immutable-vector vec)) (for/fold ([builder (make-vector-builder #:expected-size count)] [element (vector-ref vec 0)] diff --git a/streaming/reducer.rkt b/streaming/reducer.rkt index 6fc9c8e2..ec50f212 100644 --- a/streaming/reducer.rkt +++ b/streaming/reducer.rkt @@ -76,7 +76,7 @@ rebellion/base/option/private/guard rebellion/base/symbol rebellion/base/variant - rebellion/private/guarded-block + guard rebellion/private/static-name rebellion/streaming/reducer/private/base rebellion/streaming/reducer/private/zip @@ -123,9 +123,10 @@ (define finisher (reducer-finisher red)) (define early-finisher (reducer-early-finisher red)) (define/guard (loop [tagged-state (starter)] [vs vs]) - (guard-match (variant #:consume state) tagged-state else + (guard-match (variant #:consume state) tagged-state #:else (early-finisher (variant-value tagged-state))) - (guard-match (cons v next-vs) vs else (finisher state)) + (guard-match (cons v next-vs) vs #:else + (finisher state)) (loop (consumer state v) next-vs)) (loop)) @@ -139,10 +140,11 @@ [sequence-position 0] [first-vs first-vs] [generate-rest generate-rest]) - (guard-match (variant #:consume state) tagged-state else + (guard-match (variant #:consume state) tagged-state #:else (early-finisher (variant-value tagged-state))) - (guard (false? first-vs) then (finisher state)) - (guard-match (list v) first-vs else + (guard first-vs #:else + (finisher state)) + (guard-match (list v) first-vs #:else (apply raise-result-arity-error enclosing-function-name 1 (format "\n in: sequence elements at position ~a" sequence-position) @@ -199,9 +201,9 @@ (define/guard (start) (define original (original-starter)) - (guard-match (variant #:consume original-state) original else + (guard-match (variant #:consume original-state) original #:else (variant #:early-finish (original-result (variant-value original)))) - (guard (zero? amount) then + (guard (positive? amount) #:else (variant #:early-finish (limited-result (variant-value original)))) (define state (limited-state #:amount-left amount #:original-state original-state)) (variant #:consume state)) @@ -209,9 +211,9 @@ (define/guard (consume state element) (define next-state (original-consumer (limited-state-original-state state) element)) (define next-amount (sub1 (limited-state-amount-left state))) - (guard-match (variant #:consume next-state-value) next-state else + (guard-match (variant #:consume next-state-value) next-state #:else (variant #:early-finish (original-result (variant-value next-state)))) - (guard (zero? next-amount) then + (guard (positive? next-amount) #:else (variant #:early-finish (limited-result next-state-value))) (variant #:consume (limited-state #:amount-left next-amount #:original-state next-state-value))) @@ -509,7 +511,7 @@ #:name enclosing-variable-name)) (define/guard (nonempty-into-last-finish state) - (guard-present last-element state else + (guard-present last-element state #:else (raise-arguments-error (name nonempty-into-last) "expected at least one element")) last-element) @@ -521,14 +523,15 @@ #:early-finisher values #:name enclosing-variable-name)) -(define/guard (into-option-consume previous element) - (guard-present first previous then - (raise-arguments-error - (name into-option) - "expected at most one element" - "first element" first - "second element" element)) - (variant #:consume (present element))) +(define (into-option-consume previous element) + (match previous + [(present first) + (raise-arguments-error + (name into-option) + "expected at most one element" + "first element" first + "second element" element)] + [_ (variant #:consume (present element))])) (define/name into-option (make-reducer @@ -538,17 +541,18 @@ #:early-finisher values #:name enclosing-variable-name)) -(define/guard (into-only-element-consume previous element) - (guard-present first previous then - (raise-arguments-error - (name into-only-element) - "expected exactly one element, but multiple elements were received" - "first element" first - "second element" element)) - (variant #:consume (present element))) +(define (into-only-element-consume previous element) + (match previous + [(present first) + (raise-arguments-error + (name into-only-element) + "expected exactly one element, but multiple elements were received" + "first element" first + "second element" element)] + [_ (variant #:consume (present element))])) (define/guard (into-only-element-finish result-option) - (guard-present result result-option else + (guard-present result result-option #:else (raise-arguments-error (name into-only-element) "expected exactly one element, but zero elements were received")) @@ -612,13 +616,13 @@ #:consumer (λ (best-candidate elem) (guarded-block - (define key (key-function elem)) - (guard (present? best-candidate) else - (variant #:consume (present (candidate #:element elem #:key key)))) - (define best-key (candidate-key (present-value best-candidate))) - (guard (equal? (compare comparator best-key key) lesser) else - (variant #:consume best-candidate)) - (variant #:consume (present (candidate #:element elem #:key key))))) + (define key (key-function elem)) + (guard (present? best-candidate) #:else + (variant #:consume (present (candidate #:element elem #:key key)))) + (define best-key (candidate-key (present-value best-candidate))) + (guard (equal? (compare comparator best-key key) lesser) #:else + (variant #:consume best-candidate)) + (variant #:consume (present (candidate #:element elem #:key key))))) #:finisher (λ (best) (option-map best candidate-element)) #:early-finisher values #:name enclosing-function-name)) @@ -627,12 +631,12 @@ (into-max (comparator-reverse comparator) #:key key-function)) (define/guard (check-max result-option) - (guard-present result result-option else + (guard-present result result-option #:else (raise-arguments-error (name nonempty-into-max) "expected at least one element")) result) (define/guard (check-min result-option) - (guard-present result result-option else + (guard-present result result-option #:else (raise-arguments-error (name nonempty-into-min) "expected at least one element")) result) diff --git a/streaming/transducer/composition.rkt b/streaming/transducer/composition.rkt index 5f405a00..54528eee 100644 --- a/streaming/transducer/composition.rkt +++ b/streaming/transducer/composition.rkt @@ -12,7 +12,7 @@ racket/match rebellion/base/impossible-function rebellion/base/variant - rebellion/private/guarded-block + guard rebellion/private/static-name rebellion/streaming/transducer/base rebellion/type/record) @@ -21,9 +21,10 @@ ;; Wrappers that provide a nicer API over core binary composition (define/guard (transducer-pipe . transducers-list) - (guard (empty? transducers-list) then identity-transducer) - (for/fold ([piped (first transducers-list)]) - ([trans (in-list (rest transducers-list))]) + (guard-match (cons first-transducer remaining-transducers) transducers-list #:else + identity-transducer) + (for/fold ([piped first-transducer]) + ([trans (in-list remaining-transducers)]) (transducer-binary-pipe piped trans))) (define (transducer-compose . transducers) @@ -52,7 +53,8 @@ downstream-state)) (define/guard (emit-pipe-state? v) - (guard (pipe-state? v) else #false) + (guard (pipe-state? v) #:else + #false) (define upstream (pipe-state-upstream-state v)) (define downstream (pipe-state-downstream-state v)) (and (variant-tagged-as? downstream '#:emit) @@ -61,7 +63,8 @@ (not (variant-tagged-as? upstream '#:finish)))))) (define/guard (half-closed-emit-pipe-state? v) - (guard (pipe-state? v) else #false) + (guard (pipe-state? v) #:else + #false) (define upstream (pipe-state-upstream-state v)) (define downstream (pipe-state-downstream-state v)) (or (variant-tagged-as? downstream '#:half-closed-emit) @@ -108,7 +111,7 @@ (define downstream (pipe-state-downstream-transducer state)) (define downstream-state (pipe-state-downstream-state state)) - (guard (internal-half-close-pipe-state? state) then + (guard (not (internal-half-close-pipe-state? state)) #:else (define downstream-half-closer (transducer-half-closer downstream)) (define next-downstream-state (downstream-half-closer (variant-value downstream-state))) @@ -118,7 +121,7 @@ #:downstream-transducer downstream #:downstream-state next-downstream-state))) - (guard (internal-finish-pipe-state? state) then + (guard (not (internal-finish-pipe-state? state)) #:else (define upstream-finisher (transducer-finisher upstream)) (upstream-finisher (variant-value upstream-state)) (resolve-internal-pipe-state-transitions @@ -127,7 +130,7 @@ #:downstream-transducer downstream #:downstream-state downstream-state))) - (guard (internal-consume-pipe-state? state) then + (guard (not (internal-consume-pipe-state? state)) #:else (define upstream-emitter (transducer-emitter upstream)) (define downstream-consumer (transducer-consumer downstream)) (define em (upstream-emitter (variant-value upstream-state))) @@ -141,7 +144,7 @@ #:downstream-transducer downstream #:downstream-state next-downstream-state))) - (guard (internal-half-closed-consume-pipe-state? state) then + (guard (not (internal-half-closed-consume-pipe-state? state)) #:else (define upstream-emitter (transducer-half-closed-emitter upstream)) (define downstream-consumer (transducer-consumer downstream)) (define em (upstream-emitter (variant-value upstream-state))) diff --git a/streaming/transducer/private.rkt b/streaming/transducer/private.rkt index 0008fd8a..49604cb3 100644 --- a/streaming/transducer/private.rkt +++ b/streaming/transducer/private.rkt @@ -25,7 +25,7 @@ rebellion/base/option rebellion/base/variant rebellion/collection/list - rebellion/private/guarded-block + guard rebellion/private/static-name rebellion/streaming/reducer rebellion/streaming/transducer/base @@ -131,7 +131,7 @@ (define upstream-element (transducer-position-upstream-element position)) (define upstream-generator (transducer-position-upstream-generator position)) - (guard upstream-element else + (guard upstream-element #:else (define next-state (half-closer (variant-value state))) (transducer-position #:state next-state #:downstream-element absent @@ -173,7 +173,7 @@ "cannot try emitting when in consuming position" position)) - (guard (variant-tagged-as? state '#:emit) then + (guard (not (variant-tagged-as? state '#:emit)) #:else (define em (emitter (variant-value state))) (transducer-position #:state (emission-state em) @@ -181,7 +181,7 @@ #:upstream-element upstream-element #:upstream-generator upstream-generator)) - (guard (variant-tagged-as? state '#:half-closed-emit) then + (guard (not (variant-tagged-as? state '#:half-closed-emit)) #:else (define em (half-closed-emitter (variant-value state))) (transducer-position #:state (half-closed-emission-state em) diff --git a/streaming/transducer/private/batching.rkt b/streaming/transducer/private/batching.rkt index 9a25bec0..2072c425 100644 --- a/streaming/transducer/private/batching.rkt +++ b/streaming/transducer/private/batching.rkt @@ -7,7 +7,7 @@ [batching (-> reducer? transducer?)])) (require rebellion/base/variant - rebellion/private/guarded-block + guard rebellion/private/static-name rebellion/streaming/reducer rebellion/streaming/transducer/base @@ -46,7 +46,8 @@ (define (emit batch-result) (emission (start) batch-result)) (define/guard (half-close last-batch) - (guard (unstarted-batch-placeholder? last-batch) then (variant #:finish #f)) + (guard (not (unstarted-batch-placeholder? last-batch)) #:else + (variant #:finish #f)) (define last-batch-result (batch-finisher (batch-state last-batch))) (variant #:half-closed-emit last-batch-result)) (define (half-closed-emit last-batch-result) diff --git a/streaming/transducer/private/deduplicating.rkt b/streaming/transducer/private/deduplicating.rkt index d1d1f84d..d7e19545 100644 --- a/streaming/transducer/private/deduplicating.rkt +++ b/streaming/transducer/private/deduplicating.rkt @@ -11,7 +11,7 @@ rebellion/base/impossible-function rebellion/base/option rebellion/base/variant - rebellion/private/guarded-block + guard rebellion/streaming/transducer/base rebellion/type/record) @@ -26,7 +26,8 @@ (λ (encountered v) (guarded-block (define k (key-function v)) - (guard (set-member? encountered k) then (variant #:consume encountered)) + (guard (not (set-member? encountered k)) #:else + (variant #:consume encountered)) (define state (emit-state #:previously-encountered (set-add encountered k) #:novel-element v)) @@ -50,11 +51,11 @@ (λ (previous v) (guarded-block (define k (key-function v)) - (guard (present? previous) else + (guard (present? previous) #:else (variant #:emit (consecutive-emit-state #:previous-key (present k) #:novel-element v))) - (guard (equal? (present-value previous) k) then + (guard (not (equal? (present-value previous) k)) #:else (variant #:consume previous)) (variant #:emit (consecutive-emit-state #:previous-key (present k) diff --git a/streaming/transducer/private/sorting.rkt b/streaming/transducer/private/sorting.rkt index cf0cdcee..3ac54665 100644 --- a/streaming/transducer/private/sorting.rkt +++ b/streaming/transducer/private/sorting.rkt @@ -15,7 +15,7 @@ rebellion/base/option rebellion/base/variant rebellion/collection/list - rebellion/private/guarded-block + guard rebellion/streaming/transducer/base rebellion/type/record rebellion/type/singleton @@ -70,7 +70,7 @@ (define-record-type tree-trimming (minimum-leaves leftover-tree)) (define/guard (tree-trim-minimum possibly-unbuilt-tree comparator) - (guard (partially-sorted-tree? possibly-unbuilt-tree) then + (guard (not (partially-sorted-tree? possibly-unbuilt-tree)) #:else (partially-sorted-tree-trim-minimum possibly-unbuilt-tree comparator)) (define elements (list-reverse (unsorted-stack-value possibly-unbuilt-tree))) @@ -84,7 +84,7 @@ (define lesser-subtree (partially-sorted-tree-lesser-subtree tree)) (define equivalent-stack (partially-sorted-tree-equivalent-stack tree)) (define greater-stack (partially-sorted-tree-greater-stack tree)) - (guard (empty-tree? lesser-subtree) then + (guard (not (empty-tree? lesser-subtree)) #:else (define leaves (list-insert (list-reverse equivalent-stack) pivot-element)) (define leftovers (if (empty-list? greater-stack) @@ -109,29 +109,29 @@ #:greater-stack empty-list)) (define/guard (tree-insert tree element #:comparator comparator) - (guard (empty-tree? tree) then (singleton-tree element)) + (guard (not (empty-tree? tree)) #:else + (singleton-tree element)) (define pivot (partially-sorted-tree-pivot-element tree)) (define lesser-subtree (partially-sorted-tree-lesser-subtree tree)) (define equivalent-stack (partially-sorted-tree-equivalent-stack tree)) (define greater-stack (partially-sorted-tree-greater-stack tree)) (define comparison-to-pivot (compare comparator element pivot)) - (guard (equal? comparison-to-pivot equivalent) then + (guard (not (equal? comparison-to-pivot equivalent)) #:else (partially-sorted-tree #:pivot-element pivot #:lesser-subtree lesser-subtree #:equivalent-stack (list-insert equivalent-stack element) #:greater-stack greater-stack)) - (guard (equal? comparison-to-pivot greater) then + (guard (not (equal? comparison-to-pivot greater)) #:else (partially-sorted-tree #:pivot-element pivot #:lesser-subtree lesser-subtree #:equivalent-stack equivalent-stack #:greater-stack (list-insert greater-stack element))) - (define new-subtree - (tree-insert lesser-subtree element #:comparator comparator)) + (define new-subtree (tree-insert lesser-subtree element #:comparator comparator)) (partially-sorted-tree #:pivot-element pivot #:lesser-subtree new-subtree diff --git a/streaming/transducer/private/transposing.rkt b/streaming/transducer/private/transposing.rkt index 0826aaaa..d100b17e 100644 --- a/streaming/transducer/private/transposing.rkt +++ b/streaming/transducer/private/transposing.rkt @@ -14,7 +14,7 @@ racket/sequence rebellion/base/variant rebellion/collection/vector - rebellion/private/guarded-block + guard rebellion/private/static-name rebellion/streaming/reducer rebellion/streaming/transducer/base diff --git a/streaming/transducer/testing.rkt b/streaming/transducer/testing.rkt index 2c1cf44d..ca3239bf 100644 --- a/streaming/transducer/testing.rkt +++ b/streaming/transducer/testing.rkt @@ -21,7 +21,7 @@ [half-closed-emit-event-value (-> half-closed-emit-event? any/c)])) (require rebellion/base/variant - rebellion/private/guarded-block + guard rebellion/private/static-name rebellion/streaming/transducer/private/contract rebellion/streaming/transducer/base @@ -113,8 +113,9 @@ (define original-state (materialized-transduction-step-original-state step)) (define next-state (guarded-block - (guard (variant? original-state) else (variant #:finish #false)) - (guard (equal? (variant-tag original-state) '#:half-closed-emit) else + (guard (variant? original-state) #:else + (variant #:finish #false)) + (guard (equal? (variant-tag original-state) '#:half-closed-emit) #:else (original-finisher (variant-value original-state)) (define next-step (materialized-transduction-step diff --git a/type/object/descriptor.rkt b/type/object/descriptor.rkt index 31bd7539..5ebd4fac 100644 --- a/type/object/descriptor.rkt +++ b/type/object/descriptor.rkt @@ -19,10 +19,10 @@ #:inspector inspector?) initialized-object-descriptor?)] [default-object-properties - (-> object-descriptor? (listof (cons/c struct-type-property? any/c)))] + (-> object-descriptor? (listof (cons/c struct-type-property? any/c)))] [default-object-equal+hash (-> object-descriptor? equal+hash/c)] [default-object-custom-write - (-> object-descriptor? custom-write-function/c)] + (-> object-descriptor? custom-write-function/c)] [default-object-name-property (-> object-descriptor? natural?)] [make-object-field-accessor (-> object-descriptor? natural? procedure?)] [object-impersonate @@ -38,7 +38,7 @@ rebellion/collection/keyset/low-dependency rebellion/custom-write rebellion/equal+hash - rebellion/private/guarded-block + guard rebellion/private/impersonation rebellion/type/record rebellion/type/object/base @@ -127,9 +127,9 @@ (define (positional-keyword-constructor kws vs) (define args (guarded-block - (guard (equal? (length kws) size) then vs) - (define-values (before-name after-name) (split-at vs name-position)) - (append before-name (list #false) after-name))) + (guard (not (equal? (length kws) size)) #:else vs) + (define-values (before-name after-name) (split-at vs name-position)) + (append before-name (list #false) after-name))) (apply constructor args)) (define arity-unchecked-constructor (make-keyword-procedure positional-keyword-constructor))