diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2013-01-01 23:12:34 +0100 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2013-01-01 23:12:34 +0100 |
| commit | 93b035757554830d4f4e190aef7d5b90fa845bb0 (patch) | |
| tree | dcf759852ff519b7463c02ad2650d2d8b782f4a2 | |
| parent | 4d058c67929aa9d464fcb1ff0217122424078cb8 (diff) | |
| download | guix-93b035757554830d4f4e190aef7d5b90fa845bb0.tar guix-93b035757554830d4f4e190aef7d5b90fa845bb0.tar.gz | |
utils: Use binary I/O primitives for `remove-store-references'.
* guix/build/utils.scm (fold-port-matches)[get-char]: New procedure.
(remove-store-references): Use `put-u8' and `put-bytevector'.
| -rw-r--r-- | guix/build/utils.scm | 21 |
1 files changed, 15 insertions, 6 deletions
diff --git a/guix/build/utils.scm b/guix/build/utils.scm index 11bd4cc163..5729cdbf04 100644 --- a/guix/build/utils.scm +++ b/guix/build/utils.scm @@ -1,5 +1,5 @@ ;;; Guix --- Nix package management from Guile. -*- coding: utf-8 -*- -;;; Copyright (C) 2012 Ludovic Courtès <ludo@gnu.org> +;;; Copyright (C) 2012, 2013 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of Guix. ;;; @@ -517,6 +517,14 @@ for each unmatched character." (map char-set (string->list pattern)) pattern)) + (define (get-char p) + ;; We call it `get-char', but that's really a binary version + ;; thereof. (The real `get-char' cannot be used here because our + ;; bootstrap Guile is hacked to always use UTF-8.) + (match (get-u8 p) + ((? integer? x) (integer->char x)) + (x x))) + ;; Note: we're not really striving for performance here... (let loop ((chars '()) (pattern initial-pattern) @@ -576,16 +584,17 @@ known as `nuke-refs' in Nixpkgs." (setvbuf in _IOFBF 65536) (setvbuf out _IOFBF 65536) (fold-port-matches (lambda (match result) - (put-string out store) - (put-char out #\/) - (put-string out - "eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee-") + (put-bytevector out (string->utf8 store)) + (put-u8 out (char->integer #\/)) + (put-bytevector out + (string->utf8 + "eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee-")) #t) #f pattern in (lambda (char result) - (put-char out char) + (put-u8 out (char->integer char)) result)))))) ;;; Local Variables: |