diff options
author | Andy Wingo <wingo@pobox.com> | 2016-05-20 23:14:56 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2016-05-20 23:15:50 +0200 |
commit | 1852633a9bf449e4a2399de969db70a0d095a5ea (patch) | |
tree | 0e5cb1f909619eddfc8b2f99326f3665376dd0d4 | |
parent | 534139e45852f5b59ef4a75c99d757c7456ce19c (diff) | |
download | guile-1852633a9bf449e4a2399de969db70a0d095a5ea.tar.gz |
Add install-sports!, uninstall-sports! functions
* module/ice-9/sports.scm (install-sports!, uninstall-sports!): New
functions.
-rw-r--r-- | module/ice-9/sports.scm | 37 |
1 files changed, 36 insertions, 1 deletions
diff --git a/module/ice-9/sports.scm b/module/ice-9/sports.scm index c178b7310..91e51e37a 100644 --- a/module/ice-9/sports.scm +++ b/module/ice-9/sports.scm @@ -51,12 +51,15 @@ (define-module (ice-9 sports) #:use-module (rnrs bytevectors) #:use-module (ice-9 ports internal) + #:use-module (ice-9 match) #:replace (peek-char read-char) #:export (lookahead-u8 get-u8 current-read-waiter - current-write-waiter)) + current-write-waiter + install-sports! + uninstall-sports!)) (define (write-bytes port src start count) (let ((written ((port-write port) port src start count))) @@ -426,3 +429,35 @@ (else (slow-path))))) (peek-bytes port 1 fast-path (lambda (buf bv cur buffered) (slow-path)))) + +(define saved-port-bindings #f) +(define port-bindings + '(((guile) read-char peek-char) + ((ice-9 binary-ports) get-u8 lookahead-u8))) +(define (install-sports!) + (unless saved-port-bindings + (set! saved-port-bindings (make-hash-table)) + (for-each + (match-lambda + ((mod . syms) + (let ((mod (resolve-module mod))) + (for-each (lambda (sym) + (hashq-set! saved-port-bindings sym + (module-ref mod sym)) + (module-set! mod sym + (module-ref (current-module) sym))) + syms)))) + port-bindings))) + +(define (uninstall-sports!) + (when saved-port-bindings + (for-each + (match-lambda + ((mod . syms) + (let ((mod (resolve-module mod))) + (for-each (lambda (sym) + (let ((saved (hashq-ref saved-port-bindings sym))) + (module-set! mod sym saved))) + syms)))) + port-bindings) + (set! saved-port-bindings #f))) |