Merge pull request #552 from jackfirth/cleanup-guard

Replace Rebellion's guard macro with new package

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))
 

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

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,47 +26,30 @@
 
 (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)
    #:declare expr (expr/c #'option?)
    #: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"))))

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))

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)))))
 

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))

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

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))
 

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))

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))