Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Automated Resyntax fixes #718

Open
wants to merge 8 commits into
base: master
Choose a base branch
from
278 changes: 131 additions & 147 deletions drracket/browser/private/btree.rkt
Original file line number Diff line number Diff line change
Expand Up @@ -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))
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

In this region (recolor-k, rotate-k, and k), why didn't the lets turn into defines? It looks like the main change here is reformatting?

(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)])))))
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

the formatting changes here don't seem like a win, alas.


(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)
Expand All @@ -209,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)]))))
31 changes: 14 additions & 17 deletions drracket/browser/private/bullet.rkt
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down Expand Up @@ -51,16 +50,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
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

another send formatting issue. I think this one has been mentioned before, tho.

(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))]
Expand All @@ -69,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)))
Expand Down
2 changes: 1 addition & 1 deletion drracket/browser/private/entity-names.rkt
Original file line number Diff line number Diff line change
Expand Up @@ -256,6 +256,6 @@
(euro . 8364)))

(define (entity-name->integer s)
(hash-ref table s (lambda () #f)))
(hash-ref table s #f))


Loading