From 38755bba9944ade1914e64da45962c7e56257bfc Mon Sep 17 00:00:00 2001 From: Jack Firth Date: Fri, 16 Aug 2024 17:52:53 -0700 Subject: [PATCH] Delete some now-unused modules --- collection/entry.rkt | 24 ++++---- filter.rkt | 5 -- private/filter.rkt | 43 ------------- private/guarded-block.rkt | 97 ------------------------------ private/struct-definition-util.rkt | 27 --------- private/total-match.rkt | 38 ------------ 6 files changed, 13 insertions(+), 221 deletions(-) delete mode 100644 filter.rkt delete mode 100644 private/filter.rkt delete mode 100644 private/guarded-block.rkt delete mode 100644 private/struct-definition-util.rkt delete mode 100644 private/total-match.rkt diff --git a/collection/entry.rkt b/collection/entry.rkt index 99b1ccae..2762ae3d 100644 --- a/collection/entry.rkt +++ b/collection/entry.rkt @@ -27,7 +27,9 @@ [grouping (-> reducer? (transducer/c entry? entry?))])) -(require racket/contract/combinator +(require guard + racket/contract/combinator + racket/match racket/sequence racket/set rebellion/base/impossible-function @@ -35,9 +37,7 @@ rebellion/base/variant rebellion/collection/list rebellion/private/contract-projection - guard rebellion/private/static-name - rebellion/private/total-match rebellion/streaming/reducer rebellion/streaming/transducer rebellion/type/record @@ -46,7 +46,6 @@ (module+ test (require (submod "..") - racket/match rackunit rebellion/base/option)) @@ -88,11 +87,11 @@ (define (mapping-keys key-function) - (mapping (λ/match ((entry k v)) (entry (key-function k) v)))) + (mapping (λ (e) (match e [(entry k v) (entry (key-function k) v)])))) (define (mapping-values value-function) - (mapping (λ/match ((entry k v)) (entry k (value-function v))))) + (mapping (λ (e) (match e [(entry k v) (entry k (value-function v))])))) (define (indexing key-function) (bisecting key-function values)) @@ -108,14 +107,16 @@ (define (append-mapping-keys key-sequence-maker) (append-mapping - (λ/match ((entry k v)) - (sequence-map (λ (k) (entry k v)) (key-sequence-maker k))))) + (λ (e) + (match-define (entry k v) e) + (sequence-map (λ (k2) (entry k2 v)) (key-sequence-maker k))))) (define (append-mapping-values value-sequence-maker) (append-mapping - (λ/match ((entry k v)) - (sequence-map (λ (v) (entry k v)) (value-sequence-maker v))))) + (λ (e) + (match-define (entry k v) e) + (sequence-map (λ (v2) (entry k v2)) (value-sequence-maker v))))) (module+ test @@ -309,8 +310,9 @@ (make-transducer #:starter (λ () (variant #:consume (make-empty-groups))) #:consumer - (λ/match (g (entry k v)) + (λ (g e) (guarded-block + (match-define (entry k v) e) (define next (groups-insert g k v #:reducer value-reducer)) (guard (groups? next) #:else (variant #:emit next)) diff --git a/filter.rkt b/filter.rkt deleted file mode 100644 index 37096911..00000000 --- a/filter.rkt +++ /dev/null @@ -1,5 +0,0 @@ -#lang racket/base - -(require rebellion/private/filter) - -(provide (all-from-out rebellion/private/filter)) diff --git a/private/filter.rkt b/private/filter.rkt deleted file mode 100644 index 3b54e951..00000000 --- a/private/filter.rkt +++ /dev/null @@ -1,43 +0,0 @@ -#lang racket/base - -(require racket/contract/base) - -(provide - (contract-out - [filter? (-> any/c boolean?)] - [keep? (-> any/c boolean?)] - [discard? (-> any/c boolean?)] - [keep keep?] - [discard discard?] - [keep-when (-> (-> any/c boolean?) filter?)] - [keep-unless (-> (-> any/c boolean?) filter?)] - [discard-when (-> (-> any/c boolean?) filter?)] - [discard-unless (-> (-> any/c boolean?) filter?)] - [make-filter (-> (-> any/c (or/c keep? discard?)) filter?)] - [filter-apply (-> filter? any/c (or/c keep? discard?))] - [filter-function (-> filter? (-> any/c (or/c keep? discard?)))])) - -(require rebellion/type/singleton) - -;@------------------------------------------------------------------------------ - -(define-singleton-type keep) -(define-singleton-type discard) - -(struct filter (function) - #:constructor-name make-filter - #:property prop:procedure (struct-field-index function)) - -(define (keep-when predicate) - (make-filter (λ (v) (if (predicate v) keep discard)))) - -(define (keep-unless predicate) - (make-filter (λ (v) (if (predicate v) discard keep)))) - -(define (discard-when predicate) - (make-filter (λ (v) (if (predicate v) discard keep)))) - -(define (discard-unless predicate) - (make-filter (λ (v) (if (predicate v) keep discard)))) - -(define (filter-apply filt v) ((filter-function filt) v)) diff --git a/private/guarded-block.rkt b/private/guarded-block.rkt deleted file mode 100644 index 9ab786d8..00000000 --- a/private/guarded-block.rkt +++ /dev/null @@ -1,97 +0,0 @@ -#lang racket/base - -;; Guarded blocks are like regular blocks, except they support early exits. -;; Early exits are specified with the guard statement. Guarded blocks are -;; transformed into equivalent nested cond expressions. - -(provide define/guard - guard - guard-match - guarded-block - then) - -(require (for-syntax racket/base - syntax/parse - syntax/parse/lib/function-header) - racket/match - syntax/parse/define) - -(module+ test - (require (submod "..") - rackunit)) - -;@------------------------------------------------------------------------------ - -(define-syntax (guard stx) - (raise-syntax-error - #false "must be used immediately within a guarded block" stx)) - -(define-syntax (then stx) - (raise-syntax-error - #false "must be used immediately within a guard statement" stx)) - -(define-simple-macro (guarded-block form:expr ...) - (let () (guarded-begin form ...))) - -(define-syntax guarded-begin - (syntax-parser - #:track-literals - [(_) #'(begin)] - [(_ initial-form leftover-form ...) - (define expanded-initial-form - (local-expand - #'initial-form (syntax-local-context) (list #'guard #'define-values))) - (syntax-protect - (syntax-parse (syntax-disarm expanded-initial-form #false) - #:literal-sets (kernel-literals) - #:literals (guard else then) - #:track-literals - [(begin ~! subform:expr ...) - #'(guarded-begin subform ... leftover-form ...)] - [(define-values ~! . _) - #`(begin #,expanded-initial-form (guarded-begin leftover-form ...))] - [(define-syntaxes ~! . _) - #`(begin #,expanded-initial-form (guarded-begin leftover-form ...))] - [(guard condition:expr then ~! then-form:expr ...+) - #'(cond - [condition (guarded-begin then-form ...)] - [else (guarded-begin leftover-form ...)])] - [(guard condition:expr else ~! else-form:expr ...+) - #'(cond - [condition (guarded-begin leftover-form ...)] - [else (guarded-begin else-form ...)])] - [e:expr #'(begin e (guarded-begin leftover-form ...))]))])) - -(define-simple-macro (define/guard header:function-header body:expr ...+) - (define header (guarded-begin body ...))) - -(define-syntax-parser guard-match - #:literals (then else) - [(_ pattern subject:expr then success-body ...+) - #'(begin - (define subject-matched? (match subject [pattern #true] [_ #false])) - (guard subject-matched? then - (match-define pattern subject) - success-body ...))] - [(_ pattern subject:expr else failure-body ...+) - #'(begin - (define subject-matched? (match subject [pattern #true] [_ #false])) - (guard subject-matched? else failure-body ...) - (match-define pattern subject))]) - -(module+ test - (test-case "guard-match" - - (test-case "then branch" - (define/guard (f opt) - (guard-match (? number? x) opt then (format "x = ~a" x)) - "failed") - (check-equal? (f "not a number") "failed") - (check-equal? (f 5) "x = 5")) - - (test-case "else branch" - (define/guard (f opt) - (guard-match (? number? x) opt else "failed") - (format "x = ~a" x)) - (check-equal? (f "not a number") "failed") - (check-equal? (f 5) "x = 5")))) diff --git a/private/struct-definition-util.rkt b/private/struct-definition-util.rkt deleted file mode 100644 index 7a8ed131..00000000 --- a/private/struct-definition-util.rkt +++ /dev/null @@ -1,27 +0,0 @@ -#lang racket/base - -(provide - define-struct-field-accessors) - -(require (for-syntax racket/base - racket/syntax) - rebellion/type/struct - syntax/parse/define) - -;@------------------------------------------------------------------------------ - -(define-simple-macro - (define-struct-field-accessors struct:id (field:id ...) - #:descriptor descriptor:expr) - #:with (field-accessor:id ...) - (map (λ (field-id) - (format-id field-id "~a-~a" (syntax-e #'struct) (syntax-e field-id) - #:source field-id #:props field-id)) - (syntax->list #'(field ...))) - #:with (position:nat ...) - (build-list (length (syntax->list #'(field ...))) values) - (begin - (define accessor (struct-descriptor-accessor descriptor)) - (define field-accessor - (make-struct-field-accessor accessor 'position 'field)) - ...)) diff --git a/private/total-match.rkt b/private/total-match.rkt deleted file mode 100644 index ae89fd13..00000000 --- a/private/total-match.rkt +++ /dev/null @@ -1,38 +0,0 @@ -#lang racket/base - -(provide define/total-match - λ/match) - -(require (for-syntax racket/base) - racket/match - syntax/parse/define) - -(module+ test - (require (submod "..") - rackunit - rebellion/private/static-name)) - -;@------------------------------------------------------------------------------ - -(define-simple-macro - (define/total-match (name:id parameter-pattern:expr ...) body:expr ...+) - #:with (parameter ...) (generate-temporaries #'(parameter-pattern ...)) - (define (name parameter ...) - (match-define parameter-pattern parameter) ... - body ...)) - -(define-simple-macro - (λ/match (parameter-pattern:expr ...) body:expr ...+) - #:with (parameter ...) (generate-temporaries #'(parameter-pattern ...)) - (λ (parameter ...) - (match-define parameter-pattern parameter) ... - body ...)) - -(module+ test - (test-case (name-string define/total-match) - (define/total-match (cons-pair-swap (cons x y)) (cons y x)) - (check-equal? (cons-pair-swap (cons 1 2)) (cons 2 1))) - - (test-case (name-string λ/match) - (define cons-pair-swap (λ/match ((cons x y)) (cons y x))) - (check-equal? (cons-pair-swap (cons 1 2)) (cons 2 1))))