Rework handling of if expressions (#80)

Closes #75. Repeat attempt of #77, this time without the splash damage on normal function application.

---------

Also thanks to Rebecca Turner (@9999years) who made the initial fix.

Author: jackfirth

conventions.rkt

@@ -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

tests/benchmarks/class-internal.rkt.out

@@ -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))
@@ -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
@@ -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))

tests/benchmarks/hash.rkt.out

@@ -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)
@@ -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)
@@ -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)
@@ -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
@@ -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)
@@ -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)
@@ -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)
@@ -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
@@ -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)))
@@ -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)]
@@ -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)]
@@ -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)]
@@ -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)
@@ -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)
@@ -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
@@ -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)
@@ -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)]