Change else in match to _

This fixes at least one "potential" bug in the file
`collects/pkg/private/create.rkt`, where `else` in the
`cond` is bound to `else` from `match` instead of `racket/base`.
(though it turns out that the format will always be
truthy, making the program happen to be correct.)
This commit is contained in:
Sorawee Porncharoenwase 2020-08-22 06:00:05 -07:00 committed by Matthew Flatt
parent 6edc3dbfab
commit 66547f3aaf
26 changed files with 72 additions and 72 deletions

View File

@ -124,7 +124,7 @@
['start (when (verbose) (printf " ~a making ~a\n" id (->rel work)))]
['done (when (verbose) (printf " ~a made ~a\n" id (->rel work)))]
['output (printf " ~a output from: ~a\n~a~a" id work out err)]
[else (printf " ~a error compiling ~a\n~a\n~a~a" id work msg out err)]))
[_ (printf " ~a error compiling ~a\n~a\n~a~a" id work msg out err)]))
#:options (let ([cons-if-true (lambda (bool carv cdrv)
(if bool
(cons carv cdrv)

View File

@ -63,7 +63,7 @@
[plt-home-rel? (printf " unpack to main installation\n")]
[plt-rel? (printf " unpack to user add-ons\n")]
[else (printf " unpack locally\n")])]
[else
[_
(printf "config function:\n")
(pretty-write config)]))
a)
@ -74,7 +74,7 @@
(printf "setup collections:\n")
(for ([c (in-list c)])
(printf " ~s\n" (string-join c "/")))]
[else
[_
(printf "setup unit:\n")
(pretty-write setup)]))
a)

View File

@ -282,9 +282,9 @@
num-shares share-vec
mutable-fill-vec
result-vec)]
[else
[_
(decompile-linklet l)])]
[else
[_
(decompile-linklet l)])]
[(struct faslable-correlated-linklet (expr name))
(match (strip-correlated expr)
@ -307,9 +307,9 @@
num-shares share-vec
mutable-fill-vec
result-vec)]
[else
[_
(decompile-linklet l)])]
[else
[_
(decompile-linklet l)]))
(define (decompile-form form globs stack closed)
@ -330,7 +330,7 @@
`(begin ,@(map (lambda (form)
(decompile-form form globs stack closed))
forms))]
[else
[_
(decompile-expr form globs stack closed)]))
(define (extract-name name)
@ -348,7 +348,7 @@
(extract-name name)]
[(struct closure (lam gen-id))
(extract-id lam)]
[else #f]))
[_ #f]))
(define (extract-ids! body ids)
(match body
@ -362,7 +362,7 @@
(extract-ids! body ids)]
[(struct boxenv (pos body))
(extract-ids! body ids)]
[else #f]))
[_ #f]))
(define (decompile-tl expr globs stack closed no-check?)
(match expr
@ -441,10 +441,10 @@
`(begin
(set! ,id (#%box ,id))
,(decompile-expr body globs stack closed)))]
[(struct branch (test then else))
[(struct branch (test then els))
`(if ,(decompile-expr test globs stack closed)
,(decompile-expr then globs stack closed)
,(decompile-expr else globs stack closed))]
,(decompile-expr els globs stack closed))]
[(struct application (rator rands))
(let ([stack (append (for/list ([i (in-list rands)]) (gensym 'rand))
stack)])
@ -485,7 +485,7 @@
(hash-set! closed gen-id #t)
`(#%closed ,gen-id ,(decompile-expr lam globs stack closed))))]
[(? void?) (list 'void)]
[else `(quote ,expr)]))
[_ `(quote ,expr)]))
(define (decompile-lam expr globs stack closed)
(match expr

View File

@ -160,7 +160,7 @@
[(def-values ids rhs)
(for/or ([id (in-list ids)])
(eq? 'used (hash-ref used (toplevel-pos id) #f)))]
[else (not (pure? b))]))
[_ (not (pure? b))]))
b))
(define new-body (remap-positions used-body

View File

@ -97,7 +97,7 @@
(match n
[(? (lambda (x) (x . < . 0))) (raise (format "split-n: n: ~a less than 0" n))]
[1 lst]
[else
[_
(define splits (sub1 n))
(define-values (q r) (quotient/remainder (length lst) n))
(let loop ([lst-in lst]

View File

@ -153,16 +153,16 @@
;; if this happens, this code should be updated
(error 'make-script
"internal error: unexpected tooltip"))]
[else body])])
[_ body])])
(values (compact-url href) (compact-body body)))]
[else
[_
(log-error "search script: unrecognized index-entry shape: ~e" e)
(values #f #f)])))
(define (lib->name lib)
(quote-string (let loop ([lib lib])
(match lib
[`',lib (string-append "'" (loop lib))]
[else (format "~s" lib)]))))
[_ (format "~s" lib)]))))
(define from-libs
(cond
[(exported-index-desc? desc)

View File

@ -576,10 +576,10 @@
[_ 'no]))
(comp 1
(match (box 'x) ('#&x 1) (else #f)))
(match (box 'x) ('#&x 1) (_ #f)))
(comp 2
(match (vector 1 2) ('#(1 2) 2) (else #f)))
(match (vector 1 2) ('#(1 2) 2) (_ #f)))
(comp 'yes
(with-handlers ([exn:fail? (lambda _ 'yes)]
@ -622,7 +622,7 @@
(comp 'bad
(match #(1)
[(vector a b) a]
[else 'bad]))
[_ 'bad]))
(comp '(1 2)
(call-with-values
@ -680,7 +680,7 @@
(match (make-pose 1 2 3)
[(struct pose (x y a)) "Gotcha!"]
[else "Epic fail!"])))
[_ "Epic fail!"])))
(comp #f
(match (list 'a 'b 'c)

View File

@ -16,11 +16,11 @@
(check eq? #t (match '(tile a b c)
[`(tile ,@'(a b c))
#t]
[else #f]))
[_ #f]))
(check eq? #t (match '(tile a b c)
[`(tile ,@`(a b c))
#t]
[else #f])))))
[_ #f])))))
(define cons-tests
(test-suite "Tests for cons pattern"
(test-case "simple"
@ -197,7 +197,7 @@
(define (origin? pt)
(match pt
((struct point (0 0)) #t)
(else #f)))
(_ #f)))
(check-true (origin? (make-point 0 0)))
(check-false (origin? (make-point 1 1)))))
; These tests ensures that the unsafe struct optimization is correct
@ -209,7 +209,7 @@
(define (origin? pt)
(match pt
((struct point (0 0)) #t)
(else #f)))
(_ #f)))
(check-true (origin? (make-point 'a 0 0)))
(check-false (origin? (make-point 'a 1 1))))))
(test-case "struct patterns (with fake struct info)"
@ -221,7 +221,7 @@
(define (origin? pt)
(match pt
((struct point (0 1)) #t)
(else #f)))
(_ #f)))
(check-true (origin? (list 0 1)))
(check-false (origin? (list 1 1)))
(check-false (origin? (list 1 1 1)))

View File

@ -37,7 +37,7 @@
(define (origin? pt)
(match pt
(($ point 0 0) #t)
(else #f)))
(_ #f)))
(check-true (origin? (make-point 0 0)))
(check-false (origin? (make-point 1 1)))))
(test-case "empty hash-table pattern bug"

View File

@ -39,56 +39,56 @@
(mytest (match "hello"
((pregexp (pregexp "hello")) #t)
(else #f))
(_ #f))
#t)
(mytest (match 123
((pregexp "123") #t)
(else #f))
(_ #f))
#f)
(mytest (match 123
((regexp "123") #t)
(else #f))
(_ #f))
#f)
(mytest (match 123
((pregexp "123" (list a ...)) #t)
(else #f))
(_ #f))
#f)
(mytest (match 123
((regexp "123" (list a ...)) #t)
(else #f))
(_ #f))
#f)
(mytest (match "hello"
((regexp "hello") #t)
(else #f))
(_ #f))
#t)
(mytest (match "frank"
((regexp "hello") #t)
((regexp "frank") 2)
(else #f))
(_ #f))
2)
(mytest (match "frank"
((pregexp "hello") #t)
((pregexp "frank") 2)
(else #f))
(_ #f))
2)
(mytest (match "frank"
((regexp "hello") #t)
(else #f))
(_ #f))
#f)
(mytest (match "hello"
((regexp "(hel)lo" (list whol a rest ...)) a)
(else #f))
(_ #f))
"hel")
(mytest (match "hello"
((pregexp "(hel)lo" (list whole a rest ...)) a)
(else #f))
(_ #f))
"hel")
(mytest (match-let*
@ -117,28 +117,28 @@
[(list 'case-> types ...) 1]
[(list '->) 2]
[(list '-> types ...) 3]
[else 4])
[_ 4])
1)
(mytest (match '(->)
[(list 'case-> types ...) 1]
[(list '->) 2]
[(list '-> types ...) 3]
[else 4])
[_ 4])
2)
(mytest (match '(-> a b)
[(list 'case-> types ...) 1]
[(list '->) 2]
[(list '-> types ...) 3]
[else 4])
[_ 4])
3)
(mytest (match 'x
[(list 'case-> types ...) 1]
[(list '->) 2]
[(list '-> types ...) 3]
[else 4])
[_ 4])
4)
(mytest (match '((r a))

View File

@ -21,7 +21,7 @@
['start (printf " Making ~a\n" work)]
['done (printf " Made ~a\n" work)]
['output (printf " Output from: ~a\n~a~a" work out err)]
[else (eprintf " Error compiling ~a\n~a\n~a~a" work msg out err)])))
[_ (eprintf " Error compiling ~a\n~a\n~a~a" work msg out err)])))
(define compiled (car (use-compiled-file-paths)))

View File

@ -36,7 +36,7 @@
[(linkl-bundle table)
;; single linklet bundle:
(zo-marshal-bundle-to table outp)]
[else
[_
(error 'zo-marshal-top "not a linklet bundle or directory:" top)]))
(define (zo-marshal-directory-to top outp)
@ -616,11 +616,11 @@
(out-number boxenv-type-num out)
(out-anything pos out)
(out-anything (protect-quote body) out)]
[(struct branch (test then else))
[(struct branch (test then els))
(out-byte CPT_BRANCH out)
(out-anything (protect-quote test) out)
(out-anything (protect-quote then) out)
(out-anything (protect-quote else) out)]
(out-anything (protect-quote els) out)]
[(struct application (rator rands))
(let ([len (length rands)])
(if (len . < . (- CPT_SMALL_APPLICATION_END CPT_SMALL_APPLICATION_START))
@ -826,7 +826,7 @@
(define bstr (get-output-bytes s))
(out-number (bytes-length bstr) out)
(out-bytes bstr out)]
[else (error 'out-anything "~s" (current-type-trace))])))))
[_ (error 'out-anything "~s" (current-type-trace))])))))
(define (out-linklet linklet-form out)
(out-byte CPT_LINKLET out)

View File

@ -432,7 +432,7 @@
(pkg-desc url-str (if reject-existing? 'clone current-type) name
checksum auto? extra-path)]
[else #f])]
[else #f]))
[_ #f]))
;; For a `desc`, extract it's clone location, if it's a clone
(define (desc-clone desc)

View File

@ -133,7 +133,7 @@
(define (default-pkg-scope)
(match (default-pkg-scope-as-string)
["installation" 'installation]
[else 'user]))
[_ 'user]))
(define (default-pkg-scope-as-string)
(read-pkg-cfg/def 'default-scope))

View File

@ -35,7 +35,7 @@
(find-files file-exists?)))])
(display f)
(newline))))]
[else
[_
(define pkg (format "~a.~a" pkg-name create:format))
(define actual-dest-dir (if dest-dir
(path->complete-path dest-dir)

View File

@ -26,7 +26,7 @@
(system "whoami")]
['windows
(system "echo %username%")]
[else (pkg-error "not supported")])))))
[_ (pkg-error "not supported")])))))
(define ====
(make-string (string-length name) #\=))

View File

@ -151,7 +151,7 @@
;; Can use compiled bytecode, etc.:
(parameterize ([current-namespace ns])
(dynamic-require file '#%info-lookup)))))])]
[else (err "does not contain a module of the right shape")])))
[_ (err "does not contain a module of the right shape")])))
(define (filter-environment-variables ev)
(let ([keep (environment-variables-ref ev #"PLT_INFO_ALLOW_VARS")]

View File

@ -58,7 +58,7 @@
(idle! +1)
(hash-set! depends wrkr (cons w fn))
(list w (append waitlst (list wrkr)))]))]
[else
[_
(wrkr/send wrkr (list 'locked))
(list wrkr null)]))
(not v)))
@ -122,18 +122,18 @@
(append-error cc "making" #f out err "output"))
;(when last (printer (current-output-port) "made" "~a" (cc-name cc)))
#t]
[else (eprintf "Failed trying to match:\n~s\n" result-type)]))]
[_ (eprintf "Failed trying to match:\n~s\n" result-type)]))]
[(list _ (list 'ADD fn))
;; Currently ignoring queued individual files
#f]
[else
[_
(match work
[(list-rest (list cc file last) message)
(append-error cc "making" #f "" "" "error")
(eprintf "work-done match cc failed.\n")
(eprintf "trying to match:\n~e\n" (list work msg))
#t]
[else
[_
(eprintf "work-done match cc failed.\n")
(eprintf "trying to match:\n~e\n" (list work msg))
(eprintf "FATAL\n")
@ -176,7 +176,7 @@
[(cons (list cc (cons file ft) subs) tail)
(hash-set! hash id (cons (list cc ft subs) tail))
(build-job cc file #f)]
[else
[_
(eprintf "get-job match cc failed.\n")
(eprintf "trying to match:\n~v\n" cc)]))
@ -258,7 +258,7 @@
(set! filelist (cons fn filelist))
(set! seen (hash-set seen fn #t)))
#f]
[else
[_
(handler id 'fatalerror (format "Error matching work: ~a queue ~a" work filelist) "" "") #t]))
(define/public (get-job workerid)
@ -316,12 +316,12 @@
[(list 'compiled) #f]
[(list 'DIE) (worker/die 1)]
[x (send/error (format "DIDNT MATCH B ~v\n" x))]
[else (send/error (format "DIDNT MATCH B\n"))])]
[_ (send/error (format "DIDNT MATCH B\n"))])]
['unlock
(DEBUG_COMM (eprintf "UNLOCKING ~a ~a ~a\n" worker-id name _full-file))
(send/msg (list (list 'UNLOCK (path->bytes fn)) "" ""))]
[x (send/error (format "DIDNT MATCH C ~v\n" x))]
[else (send/error (format "DIDNT MATCH C\n"))]))
[_ (send/error (format "DIDNT MATCH C\n"))]))
(with-handlers ([exn:fail? (lambda (x)
(send/resp (list 'ERROR
;; Long form shows context:
@ -364,7 +364,7 @@
(stop-logging-thread))
(send/resp 'DONE))]
[x (send/error (format "DIDNT MATCH A ~v\n" x))]
[else (send/error (format "DIDNT MATCH A\n"))]))))
[_ (send/error (format "DIDNT MATCH A\n"))]))))
(define (parallel-compile-files list-of-files
#:worker-count [worker-count (processor-count)]

View File

@ -293,7 +293,7 @@
(begin
(queue/work-done work-queue node wrkr (string-append msg (wrkr/read-all wrkr)))
(kill/remove-dead-worker node-worker wrkr))))))]
[else
[_
(log-error (format "parallel-do-event-loop match node-worker failed trying to match: ~e"
node-worker))]))
(DEBUG_COMM (printf "WAITING ON WORKERS TO RESPOND\n"))

View File

@ -1276,7 +1276,7 @@
(and (path? base)
(equal? (path->directory-path p)
(path->directory-path base)))))))]
[else
[_
#t])
p)]))
(if (and dir

View File

@ -301,7 +301,7 @@
(not (eq? test-dirs 'else))
(cadr test-dirs))]
[else (failure)]))]
[else
[_
(error "info-procedure S-expression did not have the expected shape: "
v)]))])
(unless (and (procedure? info)
@ -458,7 +458,7 @@
((length target-dir-info) . > . 1)
print-status)
collections]
[else
[_
(error "expected a `unit' pattern, got" u)])))
;; Cancelled: no collections

View File

@ -558,7 +558,7 @@ EOS
out))]
[#"highest_type" (display highest-type out)]
[#"lowest_type" (display lowest-type out)]
[else
[_
(let ([m2 (regexp-match (format "~a, */[*] ([0-9]+) [*]/" (cadr m))
styles)])
(if m2

View File

@ -362,5 +362,5 @@
(match v
[`(begin ,vs ...)
(for-each loop vs)]
[else
[_
(pretty-write (rename-functions (rename-locals v)))])))))))

View File

@ -75,7 +75,7 @@
;; Strip away a `begin` that's there to record a function name:
(match orig-body
[`(begin (quote ,_) ,e) e]
[else orig-body]))
[_ orig-body]))
(cond
[(let ([result (extract-result body)])
(and (pair? result)

View File

@ -69,7 +69,7 @@
(cons (prune rator #f)
(for/list ([rand (in-list rands)])
(prune rand #f)))]
[else e]))
[_ e]))
(define (get-single-id ids)
(and (pair? ids)

View File

@ -298,13 +298,13 @@
[`(,def ,err-val ,flags ,ret ,name ,args)
`(,def ,err-val ,flags ,(update-type ret) ,name
,(map (lambda (a) (update-bind a #:as-argument? #t)) args))]
[else e]))
[_ e]))
(define (update-type-types e)
(match e
[`(define-struct-type ,name ,fields)
`(define-struct-type ,name ,(map update-bind fields))]
[else e]))
[_ e]))
(define content
(append