me/guix
Archived
1
0
Fork 0
Code Activity

utils: Use binary I/O primitives for `remove-store-references'.

Browse source 
* guix/build/utils.scm (fold-port-matches)[get-char]: New procedure.
  (remove-store-references): Use `put-u8' and `put-bytevector'.
This commit is contained in:
Ludovic Courtès 2013-01-01 23:12:34 +01:00
parent 4d058c6792
commit 93b0357575
1 changed files with 15 additions and 6 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

21
guix/build/utils.scm
View file

@ -1,5 +1,5 @@
;;; Guix --- Nix package management from Guile. -*- coding: utf-8 -*- ;;; 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. ;;; This file is part of Guix.
;;; ;;;
@ -517,6 +517,14 @@ for each unmatched character."
(map char-set (string->list pattern)) (map char-set (string->list pattern))
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... ;; Note: we're not really striving for performance here...
(let loop ((chars '()) (let loop ((chars '())
(pattern initial-pattern) (pattern initial-pattern)
@ -576,16 +584,17 @@ known as `nuke-refs' in Nixpkgs."
(setvbuf in _IOFBF 65536) (setvbuf in _IOFBF 65536)
(setvbuf out _IOFBF 65536) (setvbuf out _IOFBF 65536)
(fold-port-matches (lambda (match result) (fold-port-matches (lambda (match result)
(put-string out store) (put-bytevector out (string->utf8 store))
(put-char out #\/) (put-u8 out (char->integer #\/))
(put-string out (put-bytevector out
"eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee-") (string->utf8
"eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee-"))
#t) #t)
#f #f
pattern pattern
in in
(lambda (char result) (lambda (char result)
(put-char out char) (put-u8 out (char->integer char))
result)))))) result))))))
;;; Local Variables: ;;; Local Variables: