aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2013-01-01 23:12:34 +0100
committerLudovic Courtès <ludo@gnu.org>2013-01-01 23:12:34 +0100
commit93b035757554830d4f4e190aef7d5b90fa845bb0 (patch)
treedcf759852ff519b7463c02ad2650d2d8b782f4a2
parent4d058c67929aa9d464fcb1ff0217122424078cb8 (diff)
downloadpatches-93b035757554830d4f4e190aef7d5b90fa845bb0.tar
patches-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.scm21
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: