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.

Sign up for GitHub

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

Rework handling of if expressions #80

Merged
merged 3 commits into from
Oct 11, 2024
Merged

Rework handling of if expressions #80

Show file tree
Hide file tree
Changes from 2 commits
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
d4f4e53
Rework handling of `if` expressions
jackfirth Oct 11, 2024
b0306d6
Fix `format-if` bug, add tests, and regenerate
jackfirth Oct 11, 2024
5ba8d02
add more if tests
sorawee Oct 11, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
17 changes: 16 additions & 1 deletion conventions.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -272,7 +272,22 @@
((format-horizontal/helper) xs))))]
[_ (pretty doc)]))

(define format-if (format-if-like/helper format-#%app))

(define-pretty format-if
#:type node?
(match/extract (node-content doc) #:as unfits tail
[([-if #t] [-conditional #f])
(define args-list (cons -conditional tail))
(define multi-line-args ((format-vertical/helper) args-list))
(define single-line-args (flatten (as-concat (map pretty args-list))))
(define args-doc
(if (ormap node? tail)
multi-line-args
(alt multi-line-args single-line-args)))
(pretty-node #:unfits unfits
#:adjust '("(" ")")
(<+s> (flatten (pretty -if)) (try-indent #:n 0 #:because-of args-list args-doc)))]
[#:else (format-#%app doc)]))

;; try to fit in one line if the body has exactly one form,
;; else will be multiple lines
Expand Down
270 changes: 188 additions & 82 deletions tests/benchmarks/class-internal.rkt.out
View file
Open in desktop

Large diffs are not rendered by default.

43 changes: 28 additions & 15 deletions tests/benchmarks/hash.rkt.out
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -6,12 +6,17 @@

(define (merge one two combine/key)
(for/fold ([one one]) ([(k v) (in-hash two)])
(hash-set one k (if (hash-has-key? one k) (combine/key k (hash-ref one k) v) v))))
(hash-set one
k
(if (hash-has-key? one k)
(combine/key k (hash-ref one k) v)
v))))

(define (hash-union #:combine [combine #f]
#:combine/key
[combine/key
(if combine (lambda (_ x y) (combine x y)) (hash-duplicate-error 'hash-union))]
#:combine/key [combine/key
(if combine
(lambda (_ x y) (combine x y))
(hash-duplicate-error 'hash-union))]
one
. rest)
(define one-empty (hash-clear one))
Expand All @@ -24,21 +29,27 @@
[else (merge one two combine/key)])))

(define (hash-union! #:combine [combine #f]
#:combine/key
[combine/key
(if combine (lambda (_ x y) (combine x y)) (hash-duplicate-error 'hash-union!))]
#:combine/key [combine/key
(if combine
(lambda (_ x y) (combine x y))
(hash-duplicate-error 'hash-union!))]
one
. rest)
(for* ([two (in-list rest)]
[(k v) (in-hash two)])
(hash-set! one k (if (hash-has-key? one k) (combine/key k (hash-ref one k) v) v))))
(hash-set! one
k
(if (hash-has-key? one k)
(combine/key k (hash-ref one k) v)
v))))

(define (hash-intersect
#:combine [combine #f]
#:combine/key
[combine/key (if combine (λ (_ x y) (combine x y)) (hash-duplicate-error 'hash-intersect))]
one
. rest)
(define (hash-intersect #:combine [combine #f]
#:combine/key [combine/key
(if combine
(λ (_ x y) (combine x y))
(hash-duplicate-error 'hash-intersect))]
one
. rest)
(define hashes (cons one rest))
(define empty-h (hash-clear one)) ;; empty hash of same type as one
(define (argmin f lst) ;; avoid racket/list to improve loading time
Expand All @@ -47,7 +58,9 @@
#:result best)
([x (in-list lst)])
(define fx (f x))
(if (< fx fbest) (values x fx) (values best fbest))))
(if (< fx fbest)
(values x fx)
(values best fbest))))
(for/fold ([res empty-h]) ([k (in-hash-keys (argmin hash-count hashes))])
(if (for/and ([h (in-list hashes)])
(hash-has-key? h k))
Expand Down
97 changes: 76 additions & 21 deletions tests/benchmarks/list.rkt.out
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -89,7 +89,9 @@
(let loop ([l l0]
[pos npos])
(if (pair? l)
(if (eq? pos 1) (car l) (loop (cdr l) (sub1 pos)))
(if (eq? pos 1)
(car l)
(loop (cdr l) (sub1 pos)))
(raise-arguments-error 'name "list contains too few elements" "list" l0)))
(raise-argument-error 'name "list?" l0)))]))
(define-lgetter second 2)
Expand All @@ -106,14 +108,18 @@
(if (pair? l)
(let loop ([l l]
[x (cdr l)])
(if (pair? x) (loop x (cdr x)) l))
(if (pair? x)
(loop x (cdr x))
l))
(raise-argument-error 'last-pair "pair?" l)))

(define (last l)
(if (and (pair? l) (list? l))
(let loop ([l l]
[x (cdr l)])
(if (pair? x) (loop x (cdr x)) (car l)))
(if (pair? x)
(loop x (cdr x))
(car l)))
(raise-argument-error 'last "(and/c list? (not/c empty?))" l)))

(define (rest l)
Expand All @@ -128,7 +134,9 @@
(raise-argument-error 'make-list "exact-nonnegative-integer?" 0 n x))
(let loop ([n n]
[r '()])
(if (zero? n) r (loop (sub1 n) (cons x r)))))
(if (zero? n)
r
(loop (sub1 n) (cons x r)))))

(define (list-update l i f)
(unless (list? l)
Expand All @@ -150,7 +158,9 @@

;; internal use below
(define (drop* list n) ; no error checking, returns #f if index is too large
(if (zero? n) list (and (pair? list) (drop* (cdr list) (sub1 n)))))
(if (zero? n)
list
(and (pair? list) (drop* (cdr list) (sub1 n)))))
(define (too-large who list n)
(define proper? (list? list))
(raise-argument-error who
Expand Down Expand Up @@ -192,7 +202,10 @@
(raise-argument-error 'takef "procedure?" 1 list pred))
(let loop ([list list])
(if (pair? list)
(let ([x (car list)]) (if (pred x) (cons x (loop (cdr list))) '()))
(let ([x (car list)])
(if (pred x)
(cons x (loop (cdr list)))
'()))
;; could return `list' here, but make it behave like `take'
;; example: (takef '(a b c . d) symbol?) should be similar
;; to (take '(a b c . d) 3)
Expand All @@ -202,7 +215,9 @@
(unless (procedure? pred)
(raise-argument-error 'dropf "procedure?" 1 list pred))
(let loop ([list list])
(if (and (pair? list) (pred (car list))) (loop (cdr list)) list)))
(if (and (pair? list) (pred (car list)))
(loop (cdr list))
list)))

(define (splitf-at list pred)
(unless (procedure? pred)
Expand All @@ -221,15 +236,19 @@
(let loop ([list list]
[lead (or (drop* list n) (too-large 'take-right list n))])
;; could throw an error for non-lists, but be more like `take'
(if (pair? lead) (loop (cdr list) (cdr lead)) list)))
(if (pair? lead)
(loop (cdr list) (cdr lead))
list)))

(define (drop-right list n)
(unless (exact-nonnegative-integer? n)
(raise-argument-error 'drop-right "exact-nonnegative-integer?" 1 list n))
(let loop ([list list]
[lead (or (drop* list n) (too-large 'drop-right list n))])
;; could throw an error for non-lists, but be more like `drop'
(if (pair? lead) (cons (car list) (loop (cdr list) (cdr lead))) '())))
(if (pair? lead)
(cons (car list) (loop (cdr list) (cdr lead)))
'())))

(define (split-at-right list n)
(unless (exact-nonnegative-integer? n)
Expand All @@ -238,7 +257,9 @@
[lead (or (drop* list n) (too-large 'split-at-right list n))]
[pfx '()])
;; could throw an error for non-lists, but be more like `split-at'
(if (pair? lead) (loop (cdr list) (cdr lead) (cons (car list) pfx)) (values (reverse pfx) list))))
(if (pair? lead)
(loop (cdr list) (cdr lead) (cons (car list) pfx))
(values (reverse pfx) list))))

;; For just `takef-right', it's possible to do something smart that
;; scans the list in order, keeping a pointer to the beginning of the
Expand All @@ -265,7 +286,9 @@
(loop (cdr list) (cons (car list) rev) (add1 n))
(let loop ([n n]
[list rev])
(if (and (pair? list) (pred (car list))) (loop (sub1 n) (cdr list)) n)))))
(if (and (pair? list) (pred (car list)))
(loop (sub1 n) (cdr list))
n)))))

(define (takef-right list pred)
(drop list (count-from-right 'takef-right list pred)))
Expand Down Expand Up @@ -371,7 +394,10 @@
(check-not-given before-first "#:before-first")
(check-not-given after-last "#:after-last")])
(cond
[(or (null? l) (null? (cdr l))) (if splice? (append before-first l after-last) l)]
[(or (null? l) (null? (cdr l)))
(if splice?
(append before-first l after-last)
l)]
;; two cases for efficiency, maybe not needed
[splice?
(let* ([x (reverse x)]
Expand Down Expand Up @@ -452,7 +478,9 @@
(begin
(hash-set! h k #t)
(cons x (loop l)))))))])])
(if key (loop key) (loop no-key)))])))
(if key
(loop key)
(loop no-key)))])))

;; check-duplicates : (listof X)
;; [(K K -> bool)]
Expand All @@ -466,7 +494,9 @@
(raise-argument-error 'check-duplicates "list?" 0 items))
(unless (and (procedure? key) (procedure-arity-includes? key 1))
(raise-argument-error 'check-duplicates "(-> any/c any/c)" key))
(let ([fail-k (if (procedure? failure-result) failure-result (λ () failure-result))])
(let ([fail-k (if (procedure? failure-result)
failure-result
(λ () failure-result))])
(cond
[(eq? same? equal?) (check-duplicates/t items key (make-hash) fail-k)]
[(eq? same? eq?) (check-duplicates/t items key (make-hasheq) fail-k)]
Expand Down Expand Up @@ -532,10 +562,17 @@
(if (null? l)
null
(let ([x (apply f (car l) (map car ls))])
(if x (cons x (loop (cdr l) (map cdr ls))) (loop (cdr l) (map cdr ls))))))
(if x
(cons x (loop (cdr l) (map cdr ls)))
(loop (cdr l) (map cdr ls))))))
(raise-arguments-error 'filter-map "all lists must have same size")))
(let loop ([l l])
(if (null? l) null (let ([x (f (car l))]) (if x (cons x (loop (cdr l))) (loop (cdr l))))))))
(if (null? l)
null
(let ([x (f (car l))])
(if x
(cons x (loop (cdr l)))
(loop (cdr l))))))))

;; very similar to `filter-map', one more such function will justify some macro
(define (count f l . ls)
Expand All @@ -548,11 +585,20 @@
[c 0])
(if (null? l)
c
(loop (cdr l) (map cdr ls) (if (apply f (car l) (map car ls)) (add1 c) c))))
(loop (cdr l)
(map cdr ls)
(if (apply f (car l) (map car ls))
(add1 c)
c))))
(raise-arguments-error 'count "all lists must have same size")))
(let loop ([l l]
[c 0])
(if (null? l) c (loop (cdr l) (if (f (car l)) (add1 c) c))))))
(if (null? l)
c
(loop (cdr l)
(if (f (car l))
(add1 c)
c))))))

;; Originally from srfi-1 -- shares common tail with the input when possible
;; (define (partition f l)
Expand Down Expand Up @@ -581,7 +627,9 @@
(values (reverse i) (reverse o))
(let ([x (car l)]
[l (cdr l)])
(if (pred x) (loop l (cons x i) o) (loop l i (cons x o)))))))
(if (pred x)
(loop l (cons x i) o)
(loop l i (cons x o)))))))

;; similar to in-range, but returns a list
(define range-proc
Expand Down Expand Up @@ -647,7 +695,12 @@
;; faster than a plain loop
(let loop ([l list]
[result null])
(if (null? l) (reverse result) (loop (cdr l) (if (f (car l)) result (cons (car l) result))))))
(if (null? l)
(reverse result)
(loop (cdr l)
(if (f (car l))
result
(cons (car l) result))))))

;; Fisher-Yates Shuffle
(define (shuffle l)
Expand Down Expand Up @@ -689,7 +742,9 @@
(let ([curr (unbox curr-box)])
(if (< curr limit)
(begin0 (for/fold ([acc '()]) ([i (in-range N-1 -1 -1)])
(if (bitwise-bit-set? curr i) (cons (vector-ref v i) acc) acc))
(if (bitwise-bit-set? curr i)
(cons (vector-ref v i) acc)
acc))
(set-box! curr-box (+ curr 1)))
#f)))]
[(< N k) (lambda () #f)]
Expand Down
Loading
Loading