puck/zilch
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

(zilch core magic): use bytevectors to calculate rewrites, use mapping

Browse source 
This massively improves performance. Turns out strings are slow!

Change-Id: I6a6a6964c48e10fe046298eaf29c4e86f7d30cf1
This commit is contained in:
puck 2025-06-18 17:07:16 +00:00
parent 9382082702
commit 9b61f4df0a
1 changed files with 10 additions and 27 deletions
Download patch file Download diff file Expand all files Collapse all files

37
core/src/magic.sld
View file

@ -278,43 +278,26 @@
is-ca) is-ca)
(define (rewrite-string str with-rewrites) (define (rewrite-string str with-rewrites)
(define parts '()) (define bv (string->utf8 str))
(define (find-part-at i last-i) (define out (rewrite-bytevector bv with-rewrites))
(define next-slash (string-contains str "/" i)) (if (eq? bv out) str (utf8->string out)))
(if (or (not next-slash) (>= next-slash (- (string-length str) 53)))
(if (= last-i 0)
(set! parts #f)
(set! parts (cons (string-copy str last-i) parts)))
(let* ((actual-string (string-copy str next-slash (+ next-slash 53)))
(mapping-pair (assoc actual-string with-rewrites string=?)))
; If we have a mapping for this string, replace it and continue.
(if mapping-pair
(begin
(set! parts (cons (cdr mapping-pair) (cons (string-copy str last-i next-slash) parts)))
(find-part-at (+ next-slash 53) (+ next-slash 53)))
(find-part-at (+ next-slash 1) last-i)))))
(find-part-at 0 0)
(if (pair? parts)
(string-concatenate-reverse parts)
str))
(define (rewrite-bytevector str with-rewrites) (define (rewrite-bytevector str with-rewrites)
(define parts '()) (define parts '())
(define (find-part-at i last-i) (let find-part-at ((i 0) (last-i 0))
(define next-slash (bytestring-index str (lambda (c) (= c #x2F)) i)) (let ((next-slash (bytestring-index str (lambda (c) (= c #x2F)) i)))
(if (or (not next-slash) (>= next-slash (- (bytevector-length str) 53))) (if (or (not next-slash) (>= next-slash (- (bytevector-length str) 53)))
(if (= last-i 0) (if (= last-i 0)
(set! parts #f) (set! parts #f)
(set! parts (cons (bytevector-copy str last-i) parts))) (set! parts (cons (bytevector-copy str last-i) parts)))
(let* ((actual-string (utf8->string (bytevector-copy str next-slash (+ next-slash 53)))) (let* ((actual-string (utf8->string (bytevector-copy str next-slash (+ next-slash 53))))
(mapping-pair (assoc actual-string with-rewrites string=?))) (mapping-pair (mapping-ref/default with-rewrites actual-string #f)))
; If we have a mapping for this string, replace it and continue. ; If we have a mapping for this string, replace it and continue.
(if mapping-pair (if mapping-pair
(begin (begin
(set! parts (cons (string->utf8 (cdr mapping-pair)) (cons (bytevector-copy str last-i next-slash) parts))) (set! parts (cons (string->utf8 mapping-pair) (cons (bytevector-copy str last-i next-slash) parts)))
(find-part-at (+ next-slash 53) (+ next-slash 53))) (find-part-at (+ next-slash 53) (+ next-slash 53)))
(find-part-at (+ next-slash 1) last-i))))) (find-part-at (+ next-slash 1) last-i))))))
(find-part-at 0 0)
(if (pair? parts) (if (pair? parts)
(apply bytevector-append (reverse parts)) (apply bytevector-append (reverse parts))
str)) str))
@ -416,7 +399,7 @@
; Rewrite CA drv to IA drv using the known inputs ; Rewrite CA drv to IA drv using the known inputs
(define new-drvs (list)) (define new-drvs (list))
(define new-srcs (derivation-input-src (pending-item-ca-drv item))) (define new-srcs (derivation-input-src (pending-item-ca-drv item)))
(define rewrites (list)) (define rewrites (mapping (make-default-comparator)))
(for-each (for-each
(lambda (drv-and-outputs) (lambda (drv-and-outputs)
(mutex-lock! pending-mutex) (mutex-lock! pending-mutex)
@ -429,7 +412,7 @@
(define new-path (cdr (assoc output (pending-item-resolved-paths dep-pend)))) (define new-path (cdr (assoc output (pending-item-resolved-paths dep-pend))))
(set! new-srcs (cons new-path new-srcs)) (set! new-srcs (cons new-path new-srcs))
(define old-output (cdr (assoc output (derivation-outputs (car drv-and-outputs))))) (define old-output (cdr (assoc output (derivation-outputs (car drv-and-outputs)))))
(set! rewrites (cons (cons (derivation-output-path old-output) new-path) rewrites))) (set! rewrites (mapping-set! rewrites (derivation-output-path old-output) new-path)))
(cdr drv-and-outputs)) (cdr drv-and-outputs))
; Not a CA drv, add it back to the drvs list ; Not a CA drv, add it back to the drvs list