From 52d9fefb42ce8d5686070ec532c09c5c218c6d3d Mon Sep 17 00:00:00 2001 From: Jacqueline Firth Date: Wed, 23 Oct 2024 01:12:58 -0700 Subject: [PATCH] Add modified sources and use them for new analysis API (#381) Part of #380. Now it's possible for Resyntax to analyze files after prior modifications without actually modifying the file. --- cli.rkt | 15 +++++--- main.rkt | 72 ++++++++++++++++----------------------- private/source.rkt | 56 +++++++++++++++++++----------- test/private/rackunit.rkt | 8 +++-- 4 files changed, 82 insertions(+), 69 deletions(-) diff --git a/cli.rkt b/cli.rkt index 2143e5e..0eee6d7 100644 --- a/cli.rkt +++ b/cli.rkt @@ -222,7 +222,11 @@ For help on these, use 'analyze --help' or 'fix --help'." (printf "resyntax: --- analyzing code ---\n") (define results (transduce files - (append-mapping (refactor-file _ #:suite (resyntax-analyze-options-suite options))) + (append-mapping + (λ (portion) + (resyntax-analyze (file-source (file-portion-path portion)) + #:suite (resyntax-analyze-options-suite options) + #:lines (file-portion-lines portion)))) #:into into-list)) (define (display-results) @@ -373,9 +377,12 @@ For help on these, use 'analyze --help' or 'fix --help'." ;; a convenient manner. (append-mapping entry-value) ; throw away the file path, we don't need it anymore - (append-mapping (λ (p) - (refactor-file (filter-file-portion p lines-to-analyze-by-file) - #:suite (resyntax-fix-options-suite options)))) + (mapping (filter-file-portion _ lines-to-analyze-by-file)) + (append-mapping + (λ (portion) + (resyntax-analyze (file-portion-path portion) + #:suite (resyntax-fix-options-suite options) + #:lines (file-portion-lines portion)))) (limiting max-modified-lines #:by (λ (result) (define replacement (refactoring-result-line-replacement result)) diff --git a/main.rkt b/main.rkt index 948481a..31dfc93 100644 --- a/main.rkt +++ b/main.rkt @@ -6,10 +6,9 @@ (provide (contract-out - [refactor! (-> (sequence/c refactoring-result?) void?)] - [refactor - (->* (string?) (#:suite refactoring-suite? #:lines range-set?) (listof refactoring-result?))] - [refactor-file (->* (file-portion?) (#:suite refactoring-suite?) (listof refactoring-result?))])) + [resyntax-analyze + (->* (source?) (#:suite refactoring-suite? #:lines range-set?) (listof refactoring-result?))] + [refactor! (-> (sequence/c refactoring-result?) void?)])) (require fancy-app @@ -49,6 +48,30 @@ ;@---------------------------------------------------------------------------------------------------- +(define (resyntax-analyze source + #:suite [suite default-recommendations] + #:lines [lines (range-set (unbounded-range #:comparator natural<=>))]) + (define comments (with-input-from-source source read-comment-locations)) + (define full-source (source->string source)) + (log-resyntax-info "analyzing ~a" (or (source-path source) "string source")) + (for ([comment (in-range-set comments)]) + (log-resyntax-debug "parsed comment: ~a: ~v" comment (substring-by-range full-source comment))) + + (define (skip e) + (log-resyntax-error + "skipping ~a\n encountered an error during macro expansion\n error:\n~a" + (or (source-path source) "string source") + (string-indent (exn-message e) #:amount 3)) + empty-list) + + (with-handlers ([exn:fail:syntax? skip] + [exn:fail:filesystem:missing-module? skip]) + (define analysis + (parameterize ([current-namespace (make-base-namespace)]) + (source-analyze source #:lines lines))) + (refactor-visited-forms #:analysis analysis #:suite suite #:comments comments #:lines lines))) + + (define (refactoring-rules-refactor rules syntax #:comments comments #:analysis analysis) (define (refactor rule) @@ -97,43 +120,6 @@ result))) -(define (refactor code-string - #:suite [suite default-recommendations] - #:lines [lines (range-set (unbounded-range #:comparator natural<=>))]) - (define rule-list (refactoring-suite-rules suite)) - (define source (string-source code-string)) - (define comments (with-input-from-source source read-comment-locations)) - (parameterize ([current-namespace (make-base-namespace)]) - (define analysis (source-analyze source #:lines lines)) - (refactor-visited-forms #:analysis analysis #:suite suite #:comments comments #:lines lines))) - - -(define (refactor-file portion #:suite [suite default-recommendations]) - (define path (file-portion-path portion)) - (define lines (file-portion-lines portion)) - (log-resyntax-info "analyzing ~a" path) - (define source (file-source path)) - - (define (skip e) - (log-resyntax-error - "skipping ~a\n encountered an error during macro expansion\n error:\n~a" - path - (string-indent (exn-message e) #:amount 3)) - empty-list) - - (with-handlers ([exn:fail:syntax? skip] - [exn:fail:filesystem:missing-module? skip]) - (parameterize ([current-namespace (make-base-namespace)]) - (define analysis (source-analyze source #:lines lines)) - (define comments (with-input-from-source source read-comment-locations)) - (define full-source (source->string source)) - (for ([comment (in-range-set comments)]) - (log-resyntax-debug "parsed comment: ~a: ~v" - comment - (substring-by-range full-source comment))) - (refactor-visited-forms #:analysis analysis #:suite suite #:comments comments #:lines lines)))) - - (define (refactor-visited-forms #:analysis analysis #:suite suite #:comments comments #:lines lines) (define rule-list (refactoring-suite-rules suite)) (for*/fold ([results '()] @@ -199,8 +185,8 @@ (module+ test - (test-case "refactor" - (define results (refactor "#lang racket (or 1 (or 2 3))")) + (test-case "resyntax-analyze" + (define results (resyntax-analyze (string-source "#lang racket (or 1 (or 2 3))"))) (check-equal? (length results) 1) (check-equal? (refactoring-result-string-replacement (first results)) (string-replacement #:start 13 diff --git a/private/source.rkt b/private/source.rkt index e42c86a..e7a3714 100644 --- a/private/source.rkt +++ b/private/source.rkt @@ -7,10 +7,11 @@ (provide (contract-out [source? (-> any/c boolean?)] + [unmodified-source? (-> any/c boolean?)] [source->string (-> source? immutable-string?)] + [source-path (-> source? (or/c path? #false))] [source-directory (-> source? (or/c path? #false))] [source-read-syntax (-> source? syntax?)] - [source-produced-syntax? (-> source? syntax? boolean?)] [source-analyze (->* (source?) (#:lines range-set?) source-code-analysis?)] [file-source? (-> any/c boolean?)] [file-source (-> path-string? file-source?)] @@ -18,6 +19,10 @@ [string-source? (-> any/c boolean?)] [string-source (-> string? string-source?)] [string-source-contents (-> string-source? immutable-string?)] + [modified-source? (-> any/c boolean?)] + [modified-source (-> unmodified-source? string? modified-source?)] + [modified-source-contents (-> modified-source? immutable-string?)] + [modified-source-original (-> modified-source? unmodified-source?)] [source-code-analysis? (-> any/c boolean?)] [source-code-analysis-code (-> source-code-analysis? source?)] [source-code-analysis-visited-forms (-> source-code-analysis? (listof syntax?))] @@ -54,14 +59,24 @@ (struct source () #:transparent) -(struct file-source source (path) #:transparent +(struct unmodified-source source () #:transparent) + + +(struct file-source unmodified-source (path) + #:transparent #:guard (λ (path _) (simple-form-path path))) -(struct string-source source (contents) #:transparent +(struct string-source unmodified-source (contents) + #:transparent #:guard (λ (contents _) (string->immutable-string contents))) +(struct modified-source source (original contents) + #:transparent + #:guard (λ (original contents _) (values original (string->immutable-string contents)))) + + (define-record-type source-code-analysis (code visited-forms)) (define-record-type source-location (source line column position span)) @@ -75,7 +90,11 @@ (match code [(file-source path) (call-with-input-file path call-proc-with-reencoded-input)] - [(string-source contents) (call-proc-with-reencoded-input (open-input-string contents))])) + [(string-source contents) (call-proc-with-reencoded-input (open-input-string contents))] + [(modified-source (file-source path) contents) + (call-proc-with-reencoded-input (open-input-string contents path))] + [(modified-source (? string-source?) contents) + (call-proc-with-reencoded-input (open-input-string contents))])) (define (source->string code) @@ -89,9 +108,14 @@ (with-input-from-source code read-from-input)) +(define/guard (source-path code) + (guard-match (or (file-source path) (modified-source (file-source path) _)) code #:else #false) + path) + + (define/guard (source-directory code) - (guard-match (file-source path) code #:else #false) - (path-only path)) + (define path (source-path code)) + (and path (path-only path))) (define (source-analyze code #:lines [lines (range-set (unbounded-range #:comparator natural<=>))]) @@ -115,13 +139,13 @@ (define (syntax-original-and-from-source? stx) (and (syntax-original? stx) - ;; Some macros are able to bend hygiene and syntax properties in such a way that they - ;; introduce syntax objects into the program that are syntax-original?, but from a - ;; different file than the one being expanded. So in addition to checking for - ;; originality, we also check that they come from the same source as the main program - ;; syntax object. The (open ...) clause of the define-signature macro bends hygiene - ;; in this way, and is what originally motivated the addition of this check. - (equal? (syntax-source stx) program-source-name))) + ;; Some macros are able to bend hygiene and syntax properties in such a way that they + ;; introduce syntax objects into the program that are syntax-original?, but from a + ;; different file than the one being expanded. So in addition to checking for + ;; originality, we also check that they come from the same source as the main program + ;; syntax object. The (open ...) clause of the define-signature macro bends hygiene + ;; in this way, and is what originally motivated the addition of this check. + (equal? (syntax-source stx) program-source-name))) (define/guard (resyntax-should-analyze-syntax? stx #:as-visit? [as-visit? #true]) (guard (syntax-original-and-from-source? stx) #:else #false) @@ -205,9 +229,3 @@ (define syntax-source-location<=> (comparator-chain (comparator-map real<=> source-location-position) (comparator-map (comparator-reverse real<=>) source-location-span))) - - -(define/guard (source-produced-syntax? code stx) - (guard (syntax-original? stx) #:else #false) - (guard-match (file-source path) code #:else #false) - (equal? path (syntax-source stx))) diff --git a/test/private/rackunit.rkt b/test/private/rackunit.rkt index bd2c8cf..d7082b1 100644 --- a/test/private/rackunit.rkt +++ b/test/private/rackunit.rkt @@ -123,8 +123,9 @@ (define results (call-with-logs-captured (λ () - (refactor (code-block-raw-string original-program) - #:suite suite #:lines modified-line-mask)))) + (resyntax-analyze (string-source (code-block-raw-string original-program)) + #:suite suite + #:lines modified-line-mask)))) (with-check-info* (if (empty? results) @@ -189,7 +190,8 @@ (define results (call-with-logs-captured - (λ () (refactor (code-block-raw-string original-program) #:suite suite)))) + (λ () + (resyntax-analyze (string-source (code-block-raw-string original-program)) #:suite suite)))) (define replacement (transduce results (mapping refactoring-result-string-replacement)