From cc0bd32be216d273a835a3c212207138d92e0081 Mon Sep 17 00:00:00 2001 From: Jack Firth Date: Sat, 14 Sep 2024 00:50:00 -0700 Subject: [PATCH] Refactor nested let bindings in one pass (#289) Closes #284. --- .../let-binding-suggestions-nesting-test.rkt | 60 +++++++++++++++++++ .../private/let-binding.rkt | 42 +++++++++---- 2 files changed, 91 insertions(+), 11 deletions(-) create mode 100644 default-recommendations/let-binding-suggestions-nesting-test.rkt diff --git a/default-recommendations/let-binding-suggestions-nesting-test.rkt b/default-recommendations/let-binding-suggestions-nesting-test.rkt new file mode 100644 index 0000000..97f2fbd --- /dev/null +++ b/default-recommendations/let-binding-suggestions-nesting-test.rkt @@ -0,0 +1,60 @@ +#lang resyntax/testing/refactoring-test + + +require: resyntax/default-recommendations let-binding-suggestions + + +header: +- #lang racket/base + + +test: "nested let bindings" +------------------------------ +(define (f) + (let ([x 1]) + (let ([y 1]) + (let ([z 1]) + 1)))) +------------------------------ +------------------------------ +(define (f) + (define x 1) + (define y 1) + (define z 1) + 1) +------------------------------ + + +test: "nested let bindings with interleaved expressions" +------------------------------ +(define (f) + (let ([x 1]) + (displayln "foo") + (let ([y 1]) + (displayln "bar") + (let ([z 1]) + 1)))) +------------------------------ +------------------------------ +(define (f) + (define x 1) + (displayln "foo") + (define y 1) + (displayln "bar") + (define z 1) + 1) +------------------------------ + + +test: "nested conflicting let bindings only partially refactorable" +------------------------------ +(define (f) + (let ([x 1]) + (let ([x 2]) + 1))) +------------------------------ +------------------------------ +(define (f) + (define x 1) + (let ([x 2]) 1)) +------------------------------ diff --git a/default-recommendations/private/let-binding.rkt b/default-recommendations/private/let-binding.rkt index c36c956..b4cb902 100644 --- a/default-recommendations/private/let-binding.rkt +++ b/default-recommendations/private/let-binding.rkt @@ -27,24 +27,44 @@ (define-splicing-syntax-class body-with-refactorable-let-expression - #:attributes ([refactored 1]) + #:attributes ([refactored 1] [id 1]) (pattern (~seq leading-body ... let-expression:refactorable-let-expression) - #:with (refactored ...) #'(leading-body ... (~@ let-expression.refactored ...)))) + #:with (refactored ...) #'(leading-body ... (~@ let-expression.refactored ...)) + #:with (id ...) (attribute let-expression.id))) (define-syntax-class refactorable-let-expression - #:attributes ([refactored 1]) - #:literals (let let-values let* let*-values) - (pattern - (~or ((~or let let-values) ~! bindings:binding-group body ...+) - ((~or let* let*-values) ~! (~var bindings (binding-group #:nested? #true)) body ...+)) - #:when (for/and ([id (attribute bindings.id)]) + #:attributes ([refactored 1] [id 1]) + (pattern (header:let-header body:let-body) + #:with (id ...) (append (attribute header.id) (attribute body.id)) + #:when (for/and ([id (attribute id)]) (not (identifier-has-exact-binding-in-context? id this-syntax))) - #:when (for/and ([id (attribute bindings.id)]) - (identifier-binding-unchanged-in-context? id (first (attribute body)))) + #:when (not (check-duplicate-identifier + (for/list ([id (attribute id)]) + (identifier-in-context id this-syntax)))) + #:when (for/and ([id (attribute header.id)]) + (identifier-binding-unchanged-in-context? id (attribute body.first-body))) #:with (refactored ...) - #`(~splicing-replacement (bindings.definition ... body ...) #:original #,this-syntax))) + #`(~splicing-replacement (header.definition ... body.refactored ...) #:original #,this-syntax))) + + +(define-splicing-syntax-class let-body + #:attributes (first-body [refactored 1] [id 1]) + (pattern :body-with-refactorable-let-expression + #:with first-body (first (attribute refactored))) + (pattern (~seq first-body body ...) + #:with (refactored ...) this-syntax + #:with (id ...) '())) + + +(define-splicing-syntax-class let-header + #:attributes ([id 1] [definition 1]) + #:literals (let let-values let* let*-values) + (pattern (~seq (~or let let-values) ~! :binding-group)) + (pattern (~seq (~or let* let*-values) ~! (~var bindings (binding-group #:nested? #true))) + #:attr [id 1] (attribute bindings.id) + #:attr [definition 1] (attribute bindings.definition))) (define-syntax-class binding-clause