suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

retabbing and dead code removal only

Browse Source
This commit is contained in:
John Clements 2011-07-09 13:33:59 -07:00
parent 3d03e8f884
commit ba82f46a07
1 changed files with 328 additions and 346 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
collects/stepper/private/macro-unwind.rkt
View File

@ -27,17 +27,6 @@
[else [else
(eq? elt improper-list)])) (eq? elt improper-list)]))
(define-syntax (noisy-and stx)
(syntax-case stx ()
[(_) #`#t]
[(_ a b ...)
(with-syntax ([inner (syntax/loc stx (noisy-and b ...))]
[error (syntax/loc #`a
(error 'noisy-and "and clause failed"))])
(syntax/loc stx (if a inner error)))]
[else
(error 'noisy-and "bad syntax for noisy-and")]))
;(->* (syntax? (listof syntax?)) ;(->* (syntax? (listof syntax?))
; (syntax? (listof syntax?))) ; (syntax? (listof syntax?)))
@ -119,6 +108,7 @@
[(comes-from-check-expect) unwind-check-expect] [(comes-from-check-expect) unwind-check-expect]
[(comes-from-check-within) unwind-check-within] [(comes-from-check-within) unwind-check-within]
[(comes-from-check-error) unwind-check-error] [(comes-from-check-error) unwind-check-error]
;; unused: the fake-exp begin takes care of this for us...
;;[(comes-from-begin) unwind-begin] ;;[(comes-from-begin) unwind-begin]
[else fall-through])]) [else fall-through])])
(process stx settings)))) (process stx settings))))
@ -282,14 +272,6 @@
(syntax->datum stx))))]) (syntax->datum stx))))])
(syntax (cond . clauses))))) (syntax (cond . clauses)))))
;; unused: the fake-exp begin takes care of this for us...
#;(define (unwind-begin stx settings)
(syntax-case stx (let-values)
[(let-values () body ...)
(with-syntax ([(new-body ...)
(map (lambda (body) (unwind body settings)) (syntax->list #`(body ...)))])
#`(begin new-body ...))]))
(define ((unwind-and/or label) stx settings) (define ((unwind-and/or label) stx settings)
(let ([user-source (syntax-property stx 'user-source)] (let ([user-source (syntax-property stx 'user-source)]
[user-position (syntax-property stx 'user-position)]) [user-position (syntax-property stx 'user-position)])