From 20a17ece5e2f6473528eb87bd8b535b8f7ac2b6e Mon Sep 17 00:00:00 2001 From: "resyntax-ci[bot]" <181813515+resyntax-ci[bot]@users.noreply.github.com> Date: Sun, 13 Apr 2025 00:34:27 +0000 Subject: [PATCH 1/6] Fix 14 occurrences of `let-to-define` Internal definitions are recommended instead of `let` expressions, to reduce nesting. --- drracket/browser/private/btree.rkt | 263 +++++++++++------------ drracket/browser/private/bullet.rkt | 19 +- drracket/browser/private/html.rkt | 18 +- drracket/browser/private/option-snip.rkt | 76 +++---- 4 files changed, 184 insertions(+), 192 deletions(-) diff --git a/drracket/browser/private/btree.rkt b/drracket/browser/private/btree.rkt index 07d08c5ae..ee2bb8f77 100644 --- a/drracket/browser/private/btree.rkt +++ b/drracket/browser/private/btree.rkt @@ -27,171 +27,158 @@ (node-pos n))))) (define (rotate-left n btree) - (let ([old-right (node-right n)]) - (deadjust-offsets n old-right) - - (let ([r (node-left old-right)]) - (set-node-right! n r) - (when r - (set-node-parent! r n))) - - (let ([p (node-parent n)]) - (set-node-parent! old-right p) - (cond - [(not p) (set-btree-root! btree old-right)] - [(eq? n (node-left p)) (set-node-left! p old-right)] - [else (set-node-right! p old-right)])) - - (set-node-left! old-right n) - (set-node-parent! n old-right))) + (define old-right (node-right n)) + (deadjust-offsets n old-right) + + (let ([r (node-left old-right)]) + (set-node-right! n r) + (when r + (set-node-parent! r n))) + + (let ([p (node-parent n)]) + (set-node-parent! old-right p) + (cond + [(not p) (set-btree-root! btree old-right)] + [(eq? n (node-left p)) (set-node-left! p old-right)] + [else (set-node-right! p old-right)])) + + (set-node-left! old-right n) + (set-node-parent! n old-right)) (define (rotate-right n btree) - (let ([old-left (node-left n)]) - (adjust-offsets old-left n) - - (let ([l (node-right old-left)]) - (set-node-left! n l) - (when l - (set-node-parent! l n))) - - (let ([p (node-parent n)]) - (set-node-parent! old-left p) - (cond - [(not p) (set-btree-root! btree old-left)] - [(eq? n (node-left p)) (set-node-left! p old-left)] - [else (set-node-right! p old-left)])) - - (set-node-right! old-left n) - (set-node-parent! n old-left))) + (define old-left (node-left n)) + (adjust-offsets old-left n) + + (let ([l (node-right old-left)]) + (set-node-left! n l) + (when l + (set-node-parent! l n))) + + (let ([p (node-parent n)]) + (set-node-parent! old-left p) + (cond + [(not p) (set-btree-root! btree old-left)] + [(eq? n (node-left p)) (set-node-left! p old-left)] + [else (set-node-right! p old-left)])) + + (set-node-right! old-left n) + (set-node-parent! n old-left)) (define (insert before? n btree pos data) - (let ([new (node pos data #f #f #f 'black)]) - (if (not (btree-root btree)) - (set-btree-root! btree new) - - (begin - - (set-node-color! new 'red) - - ; Insert into tree - (if before? - - (if (not (node-left n)) - (begin - (set-node-left! n new) - (set-node-parent! new n)) - - (let loop ([node (node-left n)]) - (if (node-right node) - (loop (node-right node)) - (begin - (set-node-right! node new) - (set-node-parent! new node))))) - - (if (not (node-right n)) - (begin - (set-node-right! n new) - (set-node-parent! new n)) - - (let loop ([node (node-right n)]) - (if (node-left node) - (loop (node-left node)) - (begin - (set-node-left! node new) - (set-node-parent! new node)))))) - - ; Make value in new node relative to right-hand parents - (let loop ([node new]) - (let ([p (node-parent node)]) - (when p - (when (eq? node (node-right p)) - (adjust-offsets p new)) - (loop p)))) - - ; Balance tree - (let loop ([node new]) - (let ([p (node-parent node)]) - (when (and (not (eq? node (btree-root btree))) - (eq? 'red (node-color p))) - (let* ([recolor-k - (lambda (y) - (set-node-color! p 'black) - (set-node-color! y 'black) - (let ([pp (node-parent p)]) - (set-node-color! pp 'red) - (loop pp)))] - [rotate-k - (lambda (rotate node) - (let ([p (node-parent node)]) - (set-node-color! p 'black) - (let ([pp (node-parent p)]) - (set-node-color! pp 'red) - (rotate pp btree) - (loop pp))))] - [k - (lambda (node-y long-rotate always-rotate) + (define new (node pos data #f #f #f 'black)) + (if (not (btree-root btree)) + (set-btree-root! btree new) + + (begin + + (set-node-color! new 'red) + + ; Insert into tree + (if before? + + (if (not (node-left n)) + (begin + (set-node-left! n new) + (set-node-parent! new n)) + + (let loop ([node (node-left n)]) + (if (node-right node) + (loop (node-right node)) + (begin + (set-node-right! node new) + (set-node-parent! new node))))) + + (if (not (node-right n)) + (begin + (set-node-right! n new) + (set-node-parent! new n)) + + (let loop ([node (node-right n)]) + (if (node-left node) + (loop (node-left node)) + (begin + (set-node-left! node new) + (set-node-parent! new node)))))) + + ; Make value in new node relative to right-hand parents + (let loop ([node new]) + (let ([p (node-parent node)]) + (when p + (when (eq? node (node-right p)) + (adjust-offsets p new)) + (loop p)))) + + ; Balance tree + (let loop ([node new]) + (let ([p (node-parent node)]) + (when (and (not (eq? node (btree-root btree))) (eq? 'red (node-color p))) + (let* ([recolor-k (lambda (y) + (set-node-color! p 'black) + (set-node-color! y 'black) + (let ([pp (node-parent p)]) + (set-node-color! pp 'red) + (loop pp)))] + [rotate-k (lambda (rotate node) + (let ([p (node-parent node)]) + (set-node-color! p 'black) + (let ([pp (node-parent p)]) + (set-node-color! pp 'red) + (rotate pp btree) + (loop pp))))] + [k (lambda (node-y long-rotate always-rotate) (let ([y (node-y (node-parent p))]) (if (and y (eq? 'red (node-color y))) (recolor-k y) - (let ([k (lambda (node) - (rotate-k always-rotate node))]) + (let ([k (lambda (node) (rotate-k always-rotate node))]) (if (eq? node (node-y p)) (begin (long-rotate p btree) (k p)) (k node))))))]) - (if (eq? p (node-left (node-parent p))) - (k node-right rotate-left rotate-right) - (k node-left rotate-right rotate-left)))))) - - (set-node-color! (btree-root btree) 'black))))) + (if (eq? p (node-left (node-parent p))) + (k node-right rotate-left rotate-right) + (k node-left rotate-right rotate-left)))))) + + (set-node-color! (btree-root btree) 'black)))) (define (find-following-node btree pos) - (let ([root (btree-root btree)]) - (let loop ([n root] - [so-far root] - [so-far-pos (and root (node-pos root))] - [v 0]) - (if (not n) - (values so-far so-far-pos) - (let ([npos (+ (node-pos n) v)]) - (cond - [(<= pos npos) - (loop (node-left n) n npos v)] - [(or (not so-far-pos) - (> npos so-far-pos)) - (loop (node-right n) n npos npos)] - [else - (loop (node-right n) so-far so-far-pos npos)])))))) + (define root (btree-root btree)) + (let loop ([n root] + [so-far root] + [so-far-pos (and root (node-pos root))] + [v 0]) + (if (not n) + (values so-far so-far-pos) + (let ([npos (+ (node-pos n) v)]) + (cond + [(<= pos npos) (loop (node-left n) n npos v)] + [(or (not so-far-pos) (> npos so-far-pos)) (loop (node-right n) n npos npos)] + [else (loop (node-right n) so-far so-far-pos npos)]))))) (define (create-btree) (btree #f)) (define (btree-get btree pos) - (let-values ([(n npos) (find-following-node btree pos)]) - (and n - (= npos pos) - (node-data n)))) + (define-values (n npos) (find-following-node btree pos)) + (and n (= npos pos) (node-data n))) (define (btree-put! btree pos data) - (let-values ([(n npos) (find-following-node btree pos)]) - (if (and n (= npos pos)) - (set-node-data! n data) - (insert (and n (< pos npos)) - n btree pos data)))) + (define-values (n npos) (find-following-node btree pos)) + (if (and n (= npos pos)) + (set-node-data! n data) + (insert (and n (< pos npos)) n btree pos data))) (define (btree-shift! btree start delta) (let loop ([n (btree-root btree)] [v 0]) (when n - (let ([npos (node-pos n)]) - (cond - [(< start (+ v npos)) - (set-node-pos! n (+ npos delta)) - (loop (node-left n) v)] - [else - (loop (node-right n) (+ v npos))]))))) + (define npos (node-pos n)) + (cond + [(< start (+ v npos)) + (set-node-pos! n (+ npos delta)) + (loop (node-left n) v)] + [else (loop (node-right n) (+ v npos))])))) (define (btree-for-each btree f) (when (btree-root btree) diff --git a/drracket/browser/private/bullet.rkt b/drracket/browser/private/bullet.rkt index 3ec528198..19db107e4 100644 --- a/drracket/browser/private/bullet.rkt +++ b/drracket/browser/private/bullet.rkt @@ -51,16 +51,15 @@ [(0) (values (lambda (x y w h) (send dc draw-ellipse x y w h)) #t)] [(1) (values (lambda (x y w h) (send dc draw-ellipse x y w h)) #f)] [else (values (lambda (x y w h) (send dc draw-rectangle x y w h)) #f)])]) - (let ([b (send dc get-brush)]) - (send dc set-brush - (if solid? - (send the-brush-list - find-or-create-brush - (send (send dc get-pen) get-color) - 'solid) - transparent-brush)) - (draw x y bsize bsize) - (send dc set-brush b)))))] + (define b (send dc get-brush)) + (send dc set-brush + (if solid? + (send the-brush-list find-or-create-brush + (send (send dc get-pen) get-color) + 'solid) + transparent-brush)) + (draw x y bsize bsize) + (send dc set-brush b))))] [define/override copy (lambda () (make-object bullet-snip% depth))] diff --git a/drracket/browser/private/html.rkt b/drracket/browser/private/html.rkt index 0f97992d7..44e417223 100644 --- a/drracket/browser/private/html.rkt +++ b/drracket/browser/private/html.rkt @@ -41,13 +41,17 @@ ;; load-status : boolean string (union #f url) -> void (define (load-status push? what url) - (let ([s (format "Loading ~a ~a..." - what - (if url - (trim 150 (url->string url)) - "unknown url"))]) - (status-stack (cons s (if push? (status-stack) null))) - (status "~a" s))) + (define s + (format "Loading ~a ~a..." + what + (if url + (trim 150 (url->string url)) + "unknown url"))) + (status-stack (cons s + (if push? + (status-stack) + null))) + (status "~a" s)) (define (pop-status) (status-stack (cdr (status-stack))) diff --git a/drracket/browser/private/option-snip.rkt b/drracket/browser/private/option-snip.rkt index c857ae12e..025031737 100644 --- a/drracket/browser/private/option-snip.rkt +++ b/drracket/browser/private/option-snip.rkt @@ -31,9 +31,9 @@ (set! current-option (cons o v))) (set! w #f) (set! h #f) - (let ([a (get-admin)]) - (when a - (send a resized this #t)))) + (define a (get-admin)) + (when a + (send a resized this #t))) (define/public (get-value) (with-handlers ([exn:fail? (lambda (x) #f)]) @@ -41,30 +41,30 @@ (car options))))) (define/public (set-value v) - (let ([o (ormap (lambda (o) (and (equal? v (cdr o)) o)) options)]) - (if o - (set! current-option o) - (set! look-for-option (box v))))) + (define o (ormap (lambda (o) (and (equal? v (cdr o)) o)) options)) + (if o + (set! current-option o) + (set! look-for-option (box v)))) (override* [get-extent ; called by an editor to get the snip's size (lambda (dc x y wbox hbox descentbox spacebox lspacebox rspacebox) (unless w - (let ([font (send (get-style) get-font)]) - (let ([w+h+ds - (map (lambda (o) - (let-values ([(tw th td ta) (send dc get-text-extent (car o) font)]) - (list tw th td))) - options)]) - (if (null? w+h+ds) - (begin - (set! w 10) - (set! h 10) - (set! d 2)) - (begin - (set! w (+ (* 2 inset) arrow-sep 2 (* 2 arrow-height) (apply max (map car w+h+ds)))) - (set! h (+ (* 2 inset) 1 (apply max arrow-height (map cadr w+h+ds)))) - (set! d (+ inset 1 (apply max (map caddr w+h+ds))))))))) + (define font (send (get-style) get-font)) + (define w+h+ds + (map (lambda (o) + (let-values ([(tw th td ta) (send dc get-text-extent (car o) font)]) + (list tw th td))) + options)) + (if (null? w+h+ds) + (begin + (set! w 10) + (set! h 10) + (set! d 2)) + (begin + (set! w (+ (* 2 inset) arrow-sep 2 (* 2 arrow-height) (apply max (map car w+h+ds)))) + (set! h (+ (* 2 inset) 1 (apply max arrow-height (map cadr w+h+ds)))) + (set! d (+ inset 1 (apply max (map caddr w+h+ds))))))) (when hbox (set-box! hbox h)) (when wbox @@ -100,18 +100,20 @@ (lambda () (set! w #f) (set! h #f))] [on-event (lambda (dc x y editorx editory event) (when (send event button-down?) - (let ([popup (make-object popup-menu%)]) - (for-each (lambda (o) - (make-object menu-item% (car o) popup - (lambda (i e) - (set! current-option o) - (let ([a (get-admin)]) - (when a - (send a needs-update this 0 0 w h)))))) - options) - (let ([a (get-admin)]) - (when a - (send a popup-menu popup this 0 0))))))] + (define popup (make-object popup-menu%)) + (for-each (lambda (o) + (make-object menu-item% + (car o) + popup + (lambda (i e) + (set! current-option o) + (let ([a (get-admin)]) + (when a + (send a needs-update this 0 0 w h)))))) + options) + (define a (get-admin)) + (when a + (send a popup-menu popup this 0 0))))] [adjust-cursor (lambda (dc x y editorx editory event) arrow-cursor)]) (super-instantiate ()) @@ -190,9 +192,9 @@ arrow-cursor)]) (define/private (refresh) - (let ([a (get-admin)]) - (when a - (send a needs-update this 0 0 w h)))) + (define a (get-admin)) + (when a + (send a needs-update this 0 0 w h))) (super-instantiate ()) (set-flags (cons 'handles-events (get-flags))) From b374b55e8be6f4763c80b538c6c3dea178310c6a Mon Sep 17 00:00:00 2001 From: "resyntax-ci[bot]" <181813515+resyntax-ci[bot]@users.noreply.github.com> Date: Sun, 13 Apr 2025 00:34:27 +0000 Subject: [PATCH 2/6] Fix 1 occurrence of `if-let-to-cond` `cond` with internal definitions is preferred over `if` with `let`, to reduce nesting --- drracket/browser/private/btree.rkt | 15 ++++++--------- 1 file changed, 6 insertions(+), 9 deletions(-) diff --git a/drracket/browser/private/btree.rkt b/drracket/browser/private/btree.rkt index ee2bb8f77..564fd484a 100644 --- a/drracket/browser/private/btree.rkt +++ b/drracket/browser/private/btree.rkt @@ -196,12 +196,9 @@ (let loop ([n (btree-root btree)] [v 0] [a null]) - (if (not n) - a - (let* ([pre (loop (node-left n) v a)] - [here (cons (f (+ v (node-pos n)) - (node-data n)) - pre)]) - (loop (node-right n) - (+ v (node-pos n)) - here)))))) + (cond + [(not n) a] + [else + (define pre (loop (node-left n) v a)) + (define here (cons (f (+ v (node-pos n)) (node-data n)) pre)) + (loop (node-right n) (+ v (node-pos n)) here)])))) From 5c7c19f6f48511d71279eaef388b365550f9b05c Mon Sep 17 00:00:00 2001 From: "resyntax-ci[bot]" <181813515+resyntax-ci[bot]@users.noreply.github.com> Date: Sun, 13 Apr 2025 00:34:27 +0000 Subject: [PATCH 3/6] Fix 2 occurrences of `comparison-of-difference-and-zero-to-direct-comparison` This comparison can be replaced with a simpler, more direct comparison. --- drracket/browser/private/option-snip.rkt | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/drracket/browser/private/option-snip.rkt b/drracket/browser/private/option-snip.rkt index 025031737..e1d9f4840 100644 --- a/drracket/browser/private/option-snip.rkt +++ b/drracket/browser/private/option-snip.rkt @@ -169,8 +169,8 @@ (if (or (send event button-down?) (and tracking? (send event dragging?)) (and tracking? (send event button-up?))) - (if (and (<= 0 (- (send event get-x) x)) - (<= 0 (- (send event get-y) y))) + (if (and (> (send event get-x) x) + (> (send event get-y) y)) (when (not hit?) (set! hit? #t) (refresh)) From ce8536332f7a9bff46699d32fe515dfb3753a483 Mon Sep 17 00:00:00 2001 From: "resyntax-ci[bot]" <181813515+resyntax-ci[bot]@users.noreply.github.com> Date: Sun, 13 Apr 2025 00:34:27 +0000 Subject: [PATCH 4/6] Fix 1 occurrence of `inverted-when` This negated `when` expression can be replaced by an `unless` expression. --- drracket/browser/private/option-snip.rkt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/drracket/browser/private/option-snip.rkt b/drracket/browser/private/option-snip.rkt index e1d9f4840..79e2ce770 100644 --- a/drracket/browser/private/option-snip.rkt +++ b/drracket/browser/private/option-snip.rkt @@ -171,7 +171,7 @@ (and tracking? (send event button-up?))) (if (and (> (send event get-x) x) (> (send event get-y) y)) - (when (not hit?) + (unless hit? (set! hit? #t) (refresh)) (when hit? From 26c5bb412a60da3f7e07eca55b818d90ece20072 Mon Sep 17 00:00:00 2001 From: "resyntax-ci[bot]" <181813515+resyntax-ci[bot]@users.noreply.github.com> Date: Sun, 13 Apr 2025 00:34:27 +0000 Subject: [PATCH 5/6] Fix 1 occurrence of `send-chain-to-send+` This method chain made of nested `send` expressions can be written more clearly as a `send+` expression. --- drracket/browser/private/bullet.rkt | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/drracket/browser/private/bullet.rkt b/drracket/browser/private/bullet.rkt index 19db107e4..65b587544 100644 --- a/drracket/browser/private/bullet.rkt +++ b/drracket/browser/private/bullet.rkt @@ -11,8 +11,7 @@ (define bullet-size (make-parameter - (let ([s (send (send (send (make-object text%) get-style-list) basic-style) - get-size)]) + (let ([s (send+ (make-object text%) (get-style-list) (basic-style) (get-size))]) (max 7 (quotient s 2))))) (define (get-bullet-width) From 5c203b9f71711325bc6aac35df37a0042fd36e05 Mon Sep 17 00:00:00 2001 From: "resyntax-ci[bot]" <181813515+resyntax-ci[bot]@users.noreply.github.com> Date: Sun, 13 Apr 2025 00:34:27 +0000 Subject: [PATCH 6/6] Fix 1 occurrence of `nested-if-to-cond` This `if`-`else` chain can be converted to a `cond` expression. --- drracket/browser/private/bullet.rkt | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/drracket/browser/private/bullet.rkt b/drracket/browser/private/bullet.rkt index 65b587544..554bdaa9d 100644 --- a/drracket/browser/private/bullet.rkt +++ b/drracket/browser/private/bullet.rkt @@ -67,11 +67,10 @@ (send stream put depth))] [define/override get-text (lambda (offset num flattened?) - (if (< num 1) - "" - (if flattened? - "* " - "*")))] + (cond + [(< num 1) ""] + [flattened? "* "] + [else "*"]))] (super-new) (set-snipclass bullet-snip-class) (set-count 1)))