diff --git a/cli.rkt b/cli.rkt index 29f88d7..d0e59ac 100644 --- a/cli.rkt +++ b/cli.rkt @@ -46,21 +46,27 @@ (define suite default-recommendations) (define output-format plain-text) (define output-destination 'console) + (command-line #:program "resyntax analyze" + #:multi + ("--file" filepath "A file to analyze." (vector-builder-add targets (single-file-group filepath all-lines))) + ("--directory" dirpath "A directory to anaylze, including subdirectories." (vector-builder-add targets (directory-file-group dirpath))) + ("--package" pkgname "An installed package to analyze." (vector-builder-add targets (package-file-group pkgname))) + ("--local-git-repository" repopath baseref "A Git repository to search for modified files to analyze. The repopath argument is a directory @@ -68,7 +74,9 @@ path to the root of a Git repository, and the baseref argument is a Git referenc \"remotename/branchname\") to use as the base state of the repository. Any files that have been \ changed relative to baseref are analyzed." (vector-builder-add targets (git-repository-file-group repopath baseref))) + #:once-each + ("--refactoring-suite" modpath suite-name @@ -76,14 +84,17 @@ changed relative to baseref are analyzed." (define parsed-modpath (read (open-input-string modpath))) (define parsed-suite-name (read (open-input-string suite-name))) (set! suite (dynamic-require parsed-modpath parsed-suite-name))) + ("--output-to-file" outputpath "Store results in a file instead of printing them to the console." (set! output-destination (simple-form-path outputpath))) + ("--output-as-github-review" "Report results by leaving a GitHub review on the pull request currently being analyzed, as \ determined by the GITHUB_REPOSITORY and GITHUB_REF environment variables." (set! output-format github-pull-request-review))) + (resyntax-analyze-options #:targets (build-vector targets) #:suite suite @@ -99,21 +110,28 @@ determined by the GITHUB_REPOSITORY and GITHUB_REF environment variables." (define output-format plain-text) (define max-fixes +inf.0) (define max-pass-count 10) + (command-line #:program "resyntax fix" + #:multi + ("--file" filepath "A file to fix." (add-target! (single-file-group filepath all-lines))) + ("--directory" dirpath "A directory to fix, including subdirectories." (add-target! (directory-file-group dirpath))) + ("--package" pkgname "An installed package to fix." (add-target! (package-file-group pkgname))) + ("--output-as-commit-message" "Report results in the form of a Git commit message printed to stdout." (set! output-format git-commit-message)) + ("--local-git-repository" repopath baseref "A Git repository to search for modified files to fix. The repopath argument is a directory @@ -121,7 +139,9 @@ path to the root of a Git repository, and the baseref argument is a Git referenc \"remotename/branchname\") to use as the base state of the repository. Any files that have been \ changed relative to baseref are analyzed and fixed." (add-target! (git-repository-file-group repopath baseref))) + #:once-each + ("--refactoring-suite" modpath suite-name @@ -129,16 +149,19 @@ changed relative to baseref are analyzed and fixed." (define parsed-modpath (read (open-input-string modpath))) (define parsed-suite-name (read (open-input-string suite-name))) (set! suite (dynamic-require parsed-modpath parsed-suite-name))) + ("--max-pass-count" passcount "The maximum number of times Resyntax will fix each file. By default, Resyntax runs at most 10 \ passes over each file (or fewer, if no fixes would be made by additional passes). Multiple passes \ are needed when applying a fix unlocks further fixes." (set! max-pass-count (string->number passcount))) + ("--max-fixes" fixlimit "The maximum number of fixes to apply. If not specified, all fixes found will be applied." (set! max-fixes (string->number fixlimit)))) + (resyntax-fix-options #:targets (build-vector targets) #:suite suite #:output-format output-format @@ -165,7 +188,10 @@ For help on these, use 'analyze --help' or 'fix --help'." (define (call-command command-thunk) (parameterize ([current-command-line-arguments leftover-arg-vector]) (with-logging-to-port (current-error-port) - command-thunk 'info 'resyntax #:logger resyntax-logger))) + command-thunk + #:logger (current-logger) + 'info 'resyntax + 'error))) (match command ["analyze" (call-command resyntax-analyze-run)] diff --git a/default-recommendations/for-loop-shortcuts-test.rkt b/default-recommendations/for-loop-shortcuts-test.rkt index 84a545a..e035818 100644 --- a/default-recommendations/for-loop-shortcuts-test.rkt +++ b/default-recommendations/for-loop-shortcuts-test.rkt @@ -383,7 +383,7 @@ test: "non-nested for form isn't replaced by a for* form" ------------------------------ -test: "let loop over vector can be replaced by for/first" +test: "named let loop with conditional return over vector can be replaced by for/first" ------------------------------------------------------------ (define vec (vector 0 1 2 3 4 5)) (let loop ([i 0]) @@ -410,6 +410,35 @@ test: "let loop over vector can be replaced by for/first" ------------------------------------------------------------ +test: "named let loop over list can be replaced by for/list" +------------------------------------------------------------ +(require racket/list) +(let loop ([xs (list 1 2 3)]) + (cond + [(null? xs) '()] + [else + (displayln (car xs)) + (cons (* (car xs) 10) + (loop (cdr xs)))])) +------------------------------------------------------------ +------------------------------------------------------------ +(require racket/list) +(let loop ([xs (list 1 2 3)]) + (cond + [(empty? xs) '()] + [else + (displayln (first xs)) + (cons (* (first xs) 10) + (loop (rest xs)))])) +------------------------------------------------------------ +------------------------------------------------------------ +(require racket/list) +(for/list ([x (in-list (list 1 2 3))]) + (displayln x) + (* x 10)) +------------------------------------------------------------ + + test: "for-each and append-map can be replaced by for* with #:when" ------------------------------------------------------------ (require racket/list) diff --git a/default-recommendations/for-loop-shortcuts.rkt b/default-recommendations/for-loop-shortcuts.rkt index d3d42cc..a67203f 100644 --- a/default-recommendations/for-loop-shortcuts.rkt +++ b/default-recommendations/for-loop-shortcuts.rkt @@ -19,9 +19,12 @@ resyntax/default-recommendations/private/lambda-by-any-name resyntax/default-recommendations/private/let-binding resyntax/default-recommendations/private/metafunction + resyntax/default-recommendations/private/syntax-equivalence resyntax/default-recommendations/private/syntax-identifier-sets resyntax/default-recommendations/private/syntax-lines + resyntax/private/identifier-naming resyntax/private/syntax-neighbors + resyntax/private/syntax-traversal syntax/parse) @@ -262,6 +265,39 @@ return just that result." nested.body ...)) +(define-refactoring-rule named-let-loop-to-for/list + #:description "This named `let` expression is equivalent to a `for/list` loop." + #:literals (let cond else null? empty? null quote car first cdr rest cons) + (let loop:id ([vs:id init-list]) + (cond + [((~or null? empty?) vs2:id) (~or null '())] + [else + loop-body:expr ... + (cons loop-element:expr + (loop2:id ((~or cdr rest) vs3:id)))])) + #:when (free-identifier=? #'loop #'loop2) + #:when (free-identifier=? #'vs #'vs2) + #:when (free-identifier=? #'vs #'vs3) + #:when (for*/and ([body-stx (in-list (cons #'loop-element (attribute loop-body)))] + [vs-usage (in-list (syntax-directly-enclosing-expressions body-stx #'vs))]) + (or (syntax-free-identifier=? vs-usage #'(car vs)) + (syntax-free-identifier=? vs-usage #'(first vs)))) + #:cut + + #:with element-id (depluralize-id #'vs) + + #:with (modified-result-element modified-body ...) + (for/list ([body-stx (cons #'loop-element (attribute loop-body))]) + (syntax-traverse body-stx + #:literals (car first) + [(car vs-usage:id) #:when (free-identifier=? #'vs-usage #'vs) #'element-id] + [(first vs-usage:id) #:when (free-identifier=? #'vs-usage #'vs) #'element-id])) + + (for/list ([element-id (in-list init-list)]) + modified-body ... + modified-result-element)) + + (define-refactoring-rule named-let-loop-to-for/first-in-vector #:description "This loop can be replaced by a simpler, equivalent `for/first` loop." #:literals (let add1 + vector-length vector-ref if and <) @@ -344,6 +380,7 @@ return just that result." list->set-to-for/set list->vector-to-for/vector map-to-for + named-let-loop-to-for/list named-let-loop-to-for/first-in-vector nested-for-to-for* or-in-for/and-to-filter-clause diff --git a/private/identifier-naming.rkt b/private/identifier-naming.rkt new file mode 100644 index 0000000..43c99d5 --- /dev/null +++ b/private/identifier-naming.rkt @@ -0,0 +1,26 @@ +#lang racket/base + + +(require racket/contract/base) + + +(provide + (contract-out + [depluralize-id (-> identifier? identifier?)])) + + +(require racket/string + racket/syntax) + + +;@---------------------------------------------------------------------------------------------------- + + +(define (depluralize-id id) + (define plural-name (symbol->string (syntax-e id))) + (define singular-name + (cond + [(string-suffix? plural-name "es") (string-trim plural-name "es" #:left? #false)] + [(string-suffix? plural-name "s") (string-trim plural-name "s" #:left? #false)] + [else plural-name])) + (format-id id "~a" (string->symbol singular-name))) diff --git a/private/syntax-traversal.rkt b/private/syntax-traversal.rkt index 63bd3ba..975ad26 100644 --- a/private/syntax-traversal.rkt +++ b/private/syntax-traversal.rkt @@ -5,13 +5,24 @@ (provide + syntax-traverse (contract-out - [leaves-in-syntax (->* (syntax?) ((-> syntax? boolean?)) (sequence/c syntax?))])) + [leaves-in-syntax (->* (syntax?) ((-> syntax? boolean?)) (sequence/c syntax?))] + [syntax-directly-enclosing-expressions (-> syntax? identifier? (listof syntax?))])) -(require racket/match +(require (for-syntax racket/base + resyntax/private/more-syntax-parse-classes) + racket/match racket/sequence - racket/stream) + racket/stream + syntax/parse + syntax/parse/define) + + +(module+ test + (require (submod "..") + rackunit)) ;@---------------------------------------------------------------------------------------------------- @@ -45,3 +56,66 @@ (boolean? datum) (regexp? datum) (keyword? datum))) + + +(define (syntax-directly-enclosing-expressions stx id) + + (define (directly-encloses? subform) + (syntax-parse subform + [(part ...) + (for/or ([part-stx (in-list (attribute part))]) + (and (identifier? part-stx) (free-identifier=? id part-stx)))] + [(part ... . tail-part) + (for/or ([part-stx (in-list (cons #'tail-part (attribute part)))]) + (and (identifier? part-stx) (free-identifier=? id part-stx)))] + [_ #false])) + + (sequence->list (leaves-in-syntax stx directly-encloses?))) + + +(define-syntax-parse-rule + (syntax-traverse (~var stx-expr (expr/c #'syntax?)) + option:syntax-parse-option ... + [clause-pattern directive:syntax-parse-pattern-directive ... clause-body:expr ...] ...) + (let () + (define-syntax-class traversal-case + #:attributes (traversed) + (~@ . option) ... + (pattern clause-pattern (~@ . directive) ... + #:attr traversed (let () clause-body ...)) ...) + (let loop ([stx stx-expr.c]) + (syntax-parse stx + [(~var matched traversal-case) (attribute matched.traversed)] + + [(part (... ...)) + #:cut + #:with (traversed-part (... ...)) (map loop (attribute part)) + #'(traversed-part (... ...))] + [(part (... ...+) . tail-part) + #:cut + #:with (traversed-part (... ...)) (map loop (attribute part)) + #:with traversed-tail (loop #'tail-part) + #'(traversed-part (... ...) . traversed-tail)] + [_ stx])))) + + +(module+ test + (test-case "syntax-traverse" + (define stx + #'(define (foo) + (cons x y) + (define (bar) + (cons a b)) + (cons c d))) + (define actual + (syntax->datum + (syntax-traverse stx + #:literals (cons) + [(cons _ _) #'CONS-EXPRESSION]))) + (define expected + '(define (foo) + CONS-EXPRESSION + (define (bar) + CONS-EXPRESSION) + CONS-EXPRESSION)) + (check-equal? actual expected)))