mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-10 14:00:21 +02:00
Code Activity

Add install-sports!, uninstall-sports! functions

Browse source 
* module/ice-9/sports.scm (install-sports!, uninstall-sports!): New
  functions.
This commit is contained in:
Andy Wingo 2016-05-20 23:14:56 +02:00
parent 534139e458
commit 1852633a9b
1 changed files with 36 additions and 1 deletions
Download patch file Download diff file Expand all files Collapse all files

37
module/ice-9/sports.scm
View file

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