Skip to content

Commit

Permalink
Fix format-if bug, add tests, and regenerate
Browse files Browse the repository at this point in the history
  • Loading branch information
jackfirth committed Oct 11, 2024
1 parent d4f4e53 commit b0306d6
Show file tree
Hide file tree
Showing 9 changed files with 981 additions and 465 deletions.
6 changes: 3 additions & 3 deletions conventions.rkt
Original file line number Diff line number Diff line change
Expand Up @@ -276,12 +276,12 @@
(define-pretty format-if
#:type node?
(match/extract (node-content doc) #:as unfits tail
[([-if #t] [-conditional #f] [-true-branch #t] [-false-branch #t])
(define args-list (list -conditional -true-branch -false-branch))
[([-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 (or (node? -true-branch) (node? -false-branch))
(if (ormap node? tail)
multi-line-args
(alt multi-line-args single-line-args)))
(pretty-node #:unfits unfits
Expand Down
270 changes: 188 additions & 82 deletions tests/benchmarks/class-internal.rkt.out

Large diffs are not rendered by default.

43 changes: 28 additions & 15 deletions tests/benchmarks/hash.rkt.out
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
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

0 comments on commit b0306d6

Please sign in to comment.