diff --git a/default-recommendations/list-shortcuts-test.rkt b/default-recommendations/list-shortcuts-test.rkt index 1a68b93..b7065d9 100644 --- a/default-recommendations/list-shortcuts-test.rkt +++ b/default-recommendations/list-shortcuts-test.rkt @@ -192,3 +192,57 @@ test: "build-list with const refactorable to make-list" racket/list) (make-list 5 42) ------------------------------ + + +test: "list of contiguous selections to take and drop" +------------------------------ +(require racket/list) +(define vs (list 'foo 'bar 'baz 'blah 'zorp 'zoog 'karp)) +(list (list-ref vs 2) (list-ref vs 3) (list-ref vs 4)) +------------------------------ +------------------------------ +(require racket/list) +(define vs (list 'foo 'bar 'baz 'blah 'zorp 'zoog 'karp)) +(list (third vs) (fourth vs) (fifth vs)) +------------------------------ +------------------------------ +(require racket/list) +(define vs (list 'foo 'bar 'baz 'blah 'zorp 'zoog 'karp)) +(list (caddr vs) (cadddr vs) (list-ref vs 4)) +------------------------------ +------------------------------ +(require racket/list) +(define vs (list 'foo 'bar 'baz 'blah 'zorp 'zoog 'karp)) +(take (drop vs 2) 3) +------------------------------ + + +test: "list of contiguous selections starting at first element to take" +------------------------------ +(require racket/list) +(define vs (list 'foo 'bar 'baz 'blah 'zorp 'zoog 'karp)) +(list (list-ref vs 0) (list-ref vs 1) (list-ref vs 2)) +------------------------------ +------------------------------ +(require racket/list) +(define vs (list 'foo 'bar 'baz 'blah 'zorp 'zoog 'karp)) +(list (first vs) (second vs) (third vs)) +------------------------------ +------------------------------ +(require racket/list) +(define vs (list 'foo 'bar 'baz 'blah 'zorp 'zoog 'karp)) +(list (car vs) (cadr vs) (caddr vs)) +------------------------------ +------------------------------ +(require racket/list) +(define vs (list 'foo 'bar 'baz 'blah 'zorp 'zoog 'karp)) +(take vs 3) +------------------------------ + + +test: "list of only two contiguous selections not refactorable to take and drop" +------------------------------ +(require racket/list) +(define vs (list 'foo 'bar 'baz 'blah 'zorp 'zoog 'karp)) +(list (list-ref vs 2) (list-ref vs 3)) +------------------------------ diff --git a/default-recommendations/list-shortcuts.rkt b/default-recommendations/list-shortcuts.rkt index f3e6748..cff40f6 100644 --- a/default-recommendations/list-shortcuts.rkt +++ b/default-recommendations/list-shortcuts.rkt @@ -10,15 +10,15 @@ (require (for-syntax racket/base) + guard racket/function racket/list + racket/sequence racket/set - rebellion/private/static-name resyntax/base resyntax/default-recommendations/private/lambda-by-any-name resyntax/default-recommendations/private/literal-constant resyntax/default-recommendations/private/syntax-identifier-sets - resyntax/private/syntax-neighbors syntax/parse) @@ -140,6 +140,80 @@ (make-list count elem)) +(define/guard (all-free-identifier=? ids) + (guard-match (cons first-id remaining-ids) (sequence->list ids) #:else #false) + (for/and ([id (in-list remaining-ids)]) + (free-identifier=? first-id id))) + + +(define/guard (contiguous-increasing-integer-series? ints) + (define int-list (sequence->list ints)) + (guard (not (empty? int-list)) #:else #false) + (for/and ([previous (in-list int-list)] + [next (in-list (rest int-list))]) + (equal? (add1 previous) next))) + + +(define-syntax-class list-selection-expression + #:attributes (target-list-id index) + #:literals (list-ref + first + second + third + fourth + fifth + sixth + seventh + eighth + ninth + tenth + car + cadr + caddr + cadddr) + + (pattern (list-ref target-list-id:id index-stx:nat) #:attr index (syntax-e #'index-stx)) + (pattern (first target-list-id:id) #:attr index 0) + (pattern (second target-list-id:id) #:attr index 1) + (pattern (third target-list-id:id) #:attr index 2) + (pattern (fourth target-list-id:id) #:attr index 3) + (pattern (fifth target-list-id:id) #:attr index 4) + (pattern (sixth target-list-id:id) #:attr index 5) + (pattern (seventh target-list-id:id) #:attr index 6) + (pattern (eighth target-list-id:id) #:attr index 7) + (pattern (ninth target-list-id:id) #:attr index 8) + (pattern (tenth target-list-id:id) #:attr index 9) + (pattern (car target-list-id:id) #:attr index 0) + (pattern (cadr target-list-id:id) #:attr index 1) + (pattern (caddr target-list-id:id) #:attr index 2) + (pattern (cadddr target-list-id:id) #:attr index 3)) + + +(define-refactoring-rule list-selectors-to-take-and-drop + #:description + "This list expression is constructing a sublist of a larger list, which can be expressed more\ + clearly with `take` and `drop`." + #:literals (list) + + (list selection:list-selection-expression ...) + + #:when (>= (length (attribute selection)) 3) + + #:when (all-free-identifier=? (attribute selection.target-list-id)) + #:with target-list-id (first (attribute selection.target-list-id)) + + #:when (contiguous-increasing-integer-series? (attribute selection.index)) + #:do [(define first-index (first (attribute selection.index))) + (define last-index (last (attribute selection.index)))] + + #:with target-list-with-prefix-dropped + (if (zero? first-index) #'target-list-id #`(drop target-list-id #,first-index)) + + #:with amount-to-take (- (add1 last-index) first-index) + + (take target-list-with-prefix-dropped amount-to-take)) + + (define-refactoring-suite list-shortcuts #:rules (append-single-list-to-single-list append*-and-map-to-append-map @@ -150,6 +224,7 @@ filter-to-remv* first-reverse-to-last ignored-map-to-for-each + list-selectors-to-take-and-drop quasiquote-to-append quasiquote-to-list sort-with-keyed-comparator-to-sort-by-key))