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

Jump to bottom

Simplify function definitions #3689

Closed
wants to merge 1 commit into from
Closed

Simplify function definitions #3689

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Jump to
Jump to file
Failed to load files.
Diff view
Diff view
39 changes: 19 additions & 20 deletions racket/collects/compiler/embed.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -1451,26 +1451,25 @@


;; The old interface:
(define make-embedding-executable
(lambda (dest mred? verbose?
modules
literal-files literal-expression
cmdline
[aux null]
[launcher? #f]
[variant (cross-system-type 'gc)]
[collects-path #f])
(create-embedding-executable dest
#:mred? mred?
#:verbose? verbose?
#:modules modules
#:literal-files literal-files
#:literal-expression literal-expression
#:cmdline cmdline
#:aux aux
#:launcher? launcher?
#:variant variant
#:collects-path collects-path)))
(define (make-embedding-executable dest mred? verbose?
modules
literal-files literal-expression
cmdline
[aux null]
[launcher? #f]
[variant (cross-system-type 'gc)]
[collects-path #f])
(create-embedding-executable dest
#:mred? mred?
#:verbose? verbose?
#:modules modules
#:literal-files literal-files
#:literal-expression literal-expression
#:cmdline cmdline
#:aux aux
#:launcher? launcher?
#:variant variant
#:collects-path collects-path))

;; Use `write-module-bundle', but figure out how to put it into an executable
(define (create-embedding-executable dest
Expand Down
27 changes: 13 additions & 14 deletions racket/collects/compiler/private/cm-log.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -18,20 +18,19 @@
(define indent (make-parameter 0))

(define managed-compiled-context-key (gensym))
(define (make-compilation-context-error-display-handler orig)
(lambda (str exn)
(define l (continuation-mark-set->list
(exn-continuation-marks exn)
managed-compiled-context-key))
(orig (if (null? l)
str
(apply
string-append
str
"\n compilation context...:"
(for/list ([i (in-list l)])
(format "\n ~a" i))))
exn)))
(define ((make-compilation-context-error-display-handler orig) str exn)
(define l (continuation-mark-set->list
(exn-continuation-marks exn)
managed-compiled-context-key))
(orig (if (null? l)
str
(apply
string-append
str
"\n compilation context...:"
(for/list ([i (in-list l)])
(format "\n ~a" i))))
exn))

(define (trace-printf fmt . args)
(let ([t (manager-trace-handler)])
Expand Down
38 changes: 16 additions & 22 deletions racket/collects/ffi/unsafe.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -231,33 +231,27 @@

;; This is better handled with `make-c-parameter'
(provide (protect-out ffi-obj-ref))
(define ffi-obj-ref
(case-lambda
[(name lib) (ffi-obj-ref name lib #f)]
[(name lib failure)
(let ([name (get-ffi-obj-name 'ffi-obj-ref name)]
[lib (get-ffi-lib-internal lib)])
(with-handlers ([exn:fail:filesystem?
(lambda (e) (if failure (failure) (raise e)))])
(ffi-obj name lib)))]))
(define (ffi-obj-ref name lib [failure #f])
(let ([name (get-ffi-obj-name 'ffi-obj-ref name)]
[lib (get-ffi-lib-internal lib)])
(with-handlers ([exn:fail:filesystem?
(lambda (e) (if failure (failure) (raise e)))])
(ffi-obj name lib))))

;; get-ffi-obj is implemented as a syntax only to be able to propagate the
;; foreign name into the type syntax, which allows generated wrappers to have a
;; proper name.
(provide (protect-out get-ffi-obj))
(define get-ffi-obj*
(case-lambda
[(name lib type) (get-ffi-obj* name lib type #f)]
[(name lib type failure)
(let ([name (get-ffi-obj-name 'get-ffi-obj name)]
[lib (get-ffi-lib-internal lib)])
(let-values ([(obj error?)
(with-handlers
([exn:fail:filesystem?
(lambda (e)
(if failure (values (failure) #t) (raise e)))])
(values (ffi-obj name lib) #f))])
(if error? obj (ffi-get obj type))))]))
(define (get-ffi-obj* name lib type [failure #f])
(let ([name (get-ffi-obj-name 'get-ffi-obj name)]
[lib (get-ffi-lib-internal lib)])
(let-values ([(obj error?)
(with-handlers
([exn:fail:filesystem?
(lambda (e)
(if failure (values (failure) #t) (raise e)))])
(values (ffi-obj name lib) #f))])
(if error? obj (ffi-get obj type)))))
(define-syntax (get-ffi-obj stx)
(syntax-case stx ()
[(_ name lib type)
Expand Down
9 changes: 4 additions & 5 deletions racket/collects/ffi/unsafe/atomic.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -31,11 +31,10 @@
(define-place-local monitor-owner #f)

;; An exception may be constructed while we're entered:
(define entered-err-string-handler
(lambda (s n)
(call-as-nonatomic
(lambda ()
((error-value->string-handler) s n)))))
(define (entered-err-string-handler s n)
(call-as-nonatomic
(lambda ()
((error-value->string-handler) s n))))

(define-place-local old-paramz #f)
(define-place-local old-break-paramz #f)
Expand Down
9 changes: 4 additions & 5 deletions racket/collects/ffi/unsafe/com.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -313,11 +313,10 @@
refiid))
(and p (cast p _pointer _type)))))

(define AddRef/no-release
(lambda (obj)
(check-com-type 'AddRef 'IUknown IUnknown? obj)
((IUnknown_vt-AddRef (cast (IUnknown-vt obj) _pointer _IUnknown_vt-pointer))
obj)))
(define (AddRef/no-release obj)
(check-com-type 'AddRef 'IUknown IUnknown? obj)
((IUnknown_vt-AddRef (cast (IUnknown-vt obj) _pointer _IUnknown_vt-pointer))
obj))

(define AddRef
((retainer Release) AddRef/no-release))
Expand Down
28 changes: 13 additions & 15 deletions racket/collects/ffi/unsafe/define.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -8,21 +8,19 @@
provide-protected
make-not-available)

(define (make-not-available id)
(lambda ()
(lambda args
(error id "implementation not found; ~a"
(if (null? args)
"no arguments provided"
(apply
string-append
"arguments:"
(let loop ([args args])
(if (null? args)
null
(cons (format " ~e"
(car args))
(loop (cdr args)))))))))))
(define (((make-not-available id)) . args)
Copy link
Sponsor Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This might be less clear in the new version -- maybe 0-argument functions should be a special case?

Copy link
Sponsor Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I think that makes sense. Opened jackfirth/resyntax#61 for this.

(error id "implementation not found; ~a"
(if (null? args)
"no arguments provided"
(apply
string-append
"arguments:"
(let loop ([args args])
(if (null? args)
null
(cons (format " ~e"
(car args))
(loop (cdr args)))))))))

(define-syntax-rule (provide-protected p ...)
(provide (protect-out p ...)))
Expand Down
41 changes: 20 additions & 21 deletions racket/collects/file/cache.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -126,27 +126,26 @@
;; including during `success-handler`, then call `failure-handler` with
;; the exception after logging it. Note that breaks are disabled when
;; calling the failure handler, so it should return quickly.
(define call-with-cache-db/catch-exn-until-success-finishes
(lambda (cache-dir log-error-string lock-mode
success-handler
failure-handler)
(define cache-db-file (build-path cache-dir "cache.rktd"))
(define (succeed db)
(success-handler db cache-db-file))
(with-handlers ([exn:fail?
(lambda (exn)
(log-error-string (format "cache attempt failed: ~a"
(exn-message exn)))
(failure-handler exn))])
(make-directory* cache-dir)
(call-with-file-lock/timeout
cache-db-file
lock-mode
(lambda ()
(succeed (read-db cache-db-file log-error-string)))
(lambda ()
;; raise exception to be caught above:
(error (format "could not acquire ~s lock" lock-mode)))))))
(define (call-with-cache-db/catch-exn-until-success-finishes cache-dir log-error-string lock-mode
success-handler
failure-handler)
(define cache-db-file (build-path cache-dir "cache.rktd"))
(define (succeed db)
(success-handler db cache-db-file))
(with-handlers ([exn:fail?
(lambda (exn)
(log-error-string (format "cache attempt failed: ~a"
(exn-message exn)))
(failure-handler exn))])
(make-directory* cache-dir)
(call-with-file-lock/timeout
cache-db-file
lock-mode
(lambda ()
(succeed (read-db cache-db-file log-error-string)))
(lambda ()
;; raise exception to be caught above:
(error (format "could not acquire ~s lock" lock-mode))))))

;; Called with read lock, and handles failure by returning
;; an empty db:
Expand Down
15 changes: 6 additions & 9 deletions racket/collects/file/gunzip.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -939,13 +939,10 @@
(define (gunzip-through-ports in out)
(do-gunzip in out void))

(define gunzip
(case-lambda
[(src) (gunzip src (lambda (name from-file?) name))]
[(src name-filter)
(let ([in (open-input-file src #:mode 'binary)])
(dynamic-wind
void
(lambda () (do-gunzip in #f name-filter))
(lambda () (close-input-port in))))]))
(define (gunzip src [name-filter (lambda (name from-file?) name)])
(let ([in (open-input-file src #:mode 'binary)])
(dynamic-wind
void
(lambda () (do-gunzip in #f name-filter))
(lambda () (close-input-port in)))))