file-append: Optimizations

This commit is contained in:
retropikzel 2026-07-16 20:35:36 +03:00
parent 039e7847d3
commit a0ae8e6549
2 changed files with 10 additions and 10 deletions

View File

@ -1,19 +1,19 @@
(define-c-library libc '("stdio.h") #f ())
(define-c-procedure c-fopen libc 'fopen 'pointer '(pointer pointer))
(define-c-procedure c-fputc libc 'fputc 'int '(int pointer))
(define-c-procedure c-fwrite libc 'fwrite 'int '(pointer int int pointer))
(define-c-procedure c-fclose libc 'fclose 'int '(pointer))
(define mode-cbv (string->c-bytevector "a"))
(define (with-append-to-file path thunk)
(let* ((path-cbv (string->c-bytevector path))
(file-cbv (c-fopen path-cbv mode-cbv)))
(string-for-each
(lambda (c)
(c-fputc (char->integer c) file-cbv))
(parameterize ((current-output-port (open-output-string)))
(apply thunk '())
(get-output-string (current-output-port))))
(file-cbv (c-fopen path-cbv mode-cbv))
(output (parameterize ((current-output-port (open-output-string)))
(apply thunk '())
(get-output-string (current-output-port))))
(output-cbv (string->c-bytevector output))
(output-length (string-length output)))
(c-fwrite output-cbv 1 output-length file-cbv)
(c-fclose file-cbv)
(c-bytevector-free path-cbv)))
(c-bytevector-free path-cbv output-cbv)))

View File

@ -1 +1 @@
0.2.1
0.3.0