file-append: Optimizations

retropikzel/file-append.scm

@@ -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)))
+         (file-cbv (c-fopen path-cbv mode-cbv))
-    (string-for-each
+         (output (parameterize ((current-output-port (open-output-string)))
-      (lambda (c)
+                   (apply thunk '())
-        (c-fputc (char->integer c) file-cbv))
+                   (get-output-string (current-output-port))))
-      (parameterize ((current-output-port (open-output-string)))
+         (output-cbv (string->c-bytevector output))
-        (apply thunk '())
+         (output-length (string-length output)))
-        (get-output-string (current-output-port))))
+    (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)))

retropikzel/file-append/VERSION

@@ -1 +1 @@
-0.2.1
+0.3.0