Racket: Logging to a file - racket

I was writing a Racket program that needed to log information but I wanted to store the logs in a file. My first attempt was to use "with-logging-to-port" and use "open-output-file" to create an output-port.
#lang racket
(require racket/logging)
(define (identity/log x)
(log-info "returning ~a" x) x)
(with-logging-to-port (open-output-file "testing.txt")
(λ () (identity/log 4)) 'info)
However when I open the file afterwards it is blank! In addition, I can't run this more than once because "open-output-file" gives me an error that the file already exists.


I'm pretty sure the reason is that you don't close the file properly. This should work:
(let ((out (open-output-file "testing.txt"
; just to not get an error on consecutive runs
#:exists 'append)))
(with-logging-to-port out
(λ () (identity/log 4)) 'info)
(close-output-port out))
Instead of doing housekeeping you can use call-with-output-file
(call-with-output-file "testing.txt"
(λ (out)
(with-logging-to-port out
(λ () (identity/log 4)) 'info))
#:exists 'append)


If log information is in a list of strings, say lst, one can also use following function:
(display-lines-to-file lst "mylog.txt"
#:exists 'append)
See: https://docs.racket-lang.org/reference/Filesystem.html?q=lines-file#%28def._%28%28lib._racket%2Ffile..rkt%29._display-lines-to-file%29%29
(require racket/file)
(display-lines-to-file lst path
[ #:separator separator
#:mode mode-flag
#:exists exists-flag]) → void?


I give you my log func's source :
(define my_logger (make-logger 'my-log))
(define logger_thread #f)
(define (log fmt . content)
(log-message my_logger 'info "" (string-append (format-time (now)) " " (apply format (cons fmt content)))))
(define (start-logger log_path)
(let ([r (make-log-receiver my_logger 'info)]
[riqi (format-riqi (now))])
(set! logger_thread
(thread
(lambda ()
(let ([log_dir (build-path log_path (substring riqi 0 4))])
(when (not (directory-exists? log_dir))
(make-directory log_dir))
(with-output-to-file
(build-path log_path (substring riqi 0 4) riqi) #:exists 'append
(lambda ()
(let loop ()
(match (sync r)
[(vector l m v v1)
(printf "~a\n" v)
(flush-output)])
(loop))))))))))
(define (restart-logger)
(kill-thread logger_thread)
(start-logger))
(define (launch-log-daemon log_path)
(start-logger log_path)
(thread
(lambda ()
(let loop ()
(sync
(alarm-evt (+ (current-inexact-milliseconds) (* 1000 60 60))))
(when (= 0 (date-hour (seconds->date (current-seconds))))
(restart-logger))
(loop)))))
At the beginning of the app, you should run:
(launch-log-daemon log_path)
then you can use it like this:
(log "~a:~a" "some1" "some2")
I use the date as the log file directory and name,
it will automatically start a new log file when date changed.
foramt-riqi and format-time is here:
(define (format-riqi the_date)
(format "~a~a~a"
(date-year the_date)
(~a (date-month the_date) #:min-width 2 #:pad-string "0" #:align 'right)
(~a (number->string (date-day the_date)) #:min-width 2 #:pad-string "0" #:align 'right)))
(define (format-time the_date)
(format "~a:~a:~a"
(~a (date-hour the_date) #:min-width 2 #:pad-string "0" #:align 'right)
(~a (date-minute the_date) #:min-width 2 #:pad-string "0" #:align 'right)
(~a (date-second the_date) #:min-width 2 #:pad-string "0" #:align 'right)))


Open your file with flag 'append. For example:
(open-output-file "testing.txt" #:exists 'append )

Related

How to execute a define inside a macro in Racket?

I'm trying to write a macro to generate Church encodings I have this so far
#lang racket
(define-syntax data
(syntax-rules ()
[(data _ (ctr args ...) ...)
(let ((_ctrs (map car '((ctr) ...)))
(_args '((args ...) ...)))
(map
(lambda (i)
(let ((_ctr (list-ref _ctrs i))
(_args (list-ref _args i)))
`(define (,_ctr ,#_args) (lambda (,#_ctrs) (,_ctr ,#_args)))))
(range 0 (length _ctrs))))
]
))
(pretty-print (data option (some x) (none))
Which outputs
(data option (some x) (none))
=> ((define (some x) (lambda (some none) (some x)))
(define (none) (lambda (some none) (none))))
The output is good, but the defines are not being executed.
Now I want to execute these defines so that the functions are defined at top level
I tried this
(define-syntax data
(syntax-rules ()
[(data _ (ctr args ...) ...)
`(let ((_ctrs (map car '((ctr) ...)))
(_args '((args ...) ...)))
,#(map
(lambda (i)
(let ((_ctr (list-ref _ctrs i))
(_args (list-ref _args i)))
(define (,_ctr ,#_args) (lambda (,#_ctrs) (,_ctr ,#_args)))))
(range 0 (length _ctrs))))
]
))
But I get this error
(data option (some x) (none))
Error: struct:exn:fail:syntax
begin (possibly implicit): the last form is not an expression
at: (define ((unquote _ctr) (unquote-splicing _args)) (lambda ((unquote-splicing _ctrs)) ((unquote _ctr) (unquote-splicing _args))))
in: (begin (define ((unquote _ctr) (unquote-splicing _args)) (lambda ((unquote-splicing _ctrs)) ((unquote _ctr) (unquote-splicing _args)))))
I tried (expand #'(data option (some x) (none))) to debug but got the same error. I'm new to Racket, any advice on the macro debugging flow is welcome!!
---- Update
I have this macro now, it seems closer to what I need
(define-syntax data
(syntax-rules ()
[(data _ (ctr args ...) ...)
#'((define (ctr) (lambda (ctr ...) (ctr args ...))) ...)
]
))
But still if I remove the #' I get
define: not allowed in an expression context
in: (define (some) (lambda (some none) (some x)))

Okay I got it, I need a (begin here how I did it
(define-syntax data
(syntax-rules ()
[(data _ (ctr args ...) ...)
(begin
(define (ctr args ...) (lambda (ctr ...) (ctr args ...)))
...
)
]
))
(data option (some x) (none))
((some 1)
(lambda (x) (format "is some ~a" x))
(lambda () "is none")) ;; "is some 1"

Mapping within macro without extra parentheses?

Say I have a macro like this:
(define-syntax (choose stx)
(define data (syntax->datum stx))
(define args (cadr data))
(define body (cddr data))
(define output
`(apply (case (car ,args)
,(map (lambda (choice)
`((,(car choice)) ,(cadr choice)))
body)
(else (displayln "error")))
(cdr ,args)))
(println output)
#'(void))
If I use this on something like this (there could be more options):
(choose args
("run" runsomething)
("del" delsomethingelse))
It transforms it to
(apply
(case (car args)
((("run") runsomething)
(("del") delsomethingelse))
(else (displayln "error")))
(cdr args))
Which is not valid code, because the map gave it extra parentheses. Instead I want it to give me this:
(apply
(case (car args)
(("run") runsomething)
(("del") delsomethingelse)
(else (displayln "error")))
(cdr args))
How could I do something like this?

Use unquote-splicing (aka ,#) to get rid of the list surrounding map.
Example:
(define xs '(a b c))
`(1 2 ,xs 3 4) ; => '(1 2 (a b c) 3 4)
`(1 2 ,#xs 3 4) ; => '(1 2 a b c 3 4)
However I notice that you use syntax->datum on the input stx
of the syntax transformer. That removes lexical information, which
could end up causing problems. It recommend using either syntax-case
or syntax-parse, which use pattern matching to pick out the elements
of the input syntax and templates to generate the output.
(define-syntax (choose stx)
(syntax-case stx ()
[(_choose args
(datum fun-expr)
...)
#'(apply (case (car args)
[(datum) fun-expr]
...)
(cdr args))]))
(define (run-it . xs) (list 'ran-it xs))
(define (del-it . xs) (list 'delt-it xs))
(choose (list "run" 1 2 3)
("run" run-it)
("del" del-it))
Output: '(ran-it (1 2 3))

Trying to rewrite an ugly macro

I'm new to lisp, and have been trying to learn Common Lisp by diving in and writing some code. I've read plenty of documentation on the subject, but it's taking a while to really sink in.
I have written a couple of macros (? and ??) for performing unit tests, but I'm having some difficulty. The code is at the end of the post, to avoid cluttering the actual question.
Here is an example of usage:
(??
(? "Arithmetic tests"
(? "Addition"
(= (+ 1 2) 3)
(= (+ 1 2 3) 6)
(= (+ -1 -3) -4))))
And an example of output:
[Arithmetic tests]
[Addition]
(PASS) '(= (+ 1 2) 3)'
(PASS) '(= (+ 1 2 3) 6)'
(PASS) '(= (+ -1 -3) -4)'
Results: 3 tests passed, 0 tests failed
Now, the existing code works. Unfortunately, the (? ...) macro is ugly, verbose, resistant to change - and I'm pretty sure also badly structured. For example, do I really have to use a list to store pieces of output code and then emit the contents at the end?
I'd like to modify the macro to permit description strings (or symbols) to optionally follow each test, whereupon it would replace the test literal in the output, thus:
(??
(? "Arithmetic tests"
(? "Addition"
(= (+ 1 2) 3) "Adding 1 and 2 results in 3"
(= (+ 1 2 3) 6)
(= (+ -1 -3) -4))))
Output:
[Arithmetic tests]
[Addition]
(PASS) Adding 1 and 2 results in 3
(PASS) '(= (+ 1 2 3) 6)'
(PASS) '(= (+ -1 -3) -4)'
But unfortunately I can't find a sensible place in the macro to insert this change. Depending on where I put it, I get errors like you're not inside a backquote expression, label is not defined or body-forms is not defined. I know what these errors mean, but I can't find a way to avoid them.
Also, I'll be wanting to handle exceptions in the test, and treat that as a failure. Currently, there is no exception handling code - the test result is merely tested against nil. Again, it is not clear how I should add this functionality.
I'm thinking that maybe this macro is over-complex, due to my inexperience in writing macros; and perhaps if I simplify it, modification will be easier. I don't really want to separate it out into several smaller macros without good reason; but maybe there's a terser way to write it?
Can anyone help me out here, please?
A complete code listing follows:
(defmacro with-gensyms ((&rest names) &body body)
`(let ,(loop for n in names collect `(,n (gensym)))
,#body))
(defmacro while (condition &body body)
`(loop while ,condition do (progn ,#body)))
(defun flatten (L)
"Converts a list to single level."
(if (null L)
nil
(if (atom (first L))
(cons (first L) (flatten (rest L)))
(append (flatten (first L)) (flatten (rest L))))))
(defun starts-with-p (str1 str2)
"Determine whether `str1` starts with `str2`"
(let ((p (search str2 str1)))
(and p (= 0 p))))
(defmacro pop-first-char (string)
`(with-gensyms (c)
(if (> (length ,string) 0)
(progn
(setf c (schar ,string 0))
(if (> (length ,string) 1)
(setf ,string (subseq ,string 1))
(setf ,string ""))))
c))
(defmacro pop-chars (string count)
`(with-gensyms (result)
(setf result ())
(dotimes (index ,count)
(push (pop-first-char ,string) result))
result))
(defun format-ansi-codes (text)
(let ((result ()))
(while (> (length text) 0)
(cond
((starts-with-p text "\\e")
(push (code-char #o33) result)
(pop-chars text 2)
)
((starts-with-p text "\\r")
(push (code-char 13) result)
(pop-chars text 2)
)
(t (push (pop-first-char text) result))
))
(setf result (nreverse result))
(coerce result 'string)))
(defun kv-lookup (values key)
"Like getf, but works with 'keys as well as :keys, in both the list and the supplied key"
(setf key (if (typep key 'cons) (nth 1 key) key))
(while values
(let ((k (pop values)) (v (pop values)))
(setf k (if (typep k 'cons) (nth 1 k) k))
(if (eql (symbol-name key) (symbol-name k))
(return v)))))
(defun make-ansi-escape (ansi-name)
(let ((ansi-codes '( :normal "\\e[00m" :white "\\e[1;37m" :light-grey "\\e[0;37m" :dark-grey "\\e[1;30m"
:red "\\e[0;31m" :light-red "\\e[1;31m" :green "\\e[0;32m" :blue "\\e[1;34m" :dark-blue "\\e[1;34m"
:cyan "\\e[1;36m" :magenta "\\e[1;35m" :yellow "\\e[0;33m"
:bg-dark-grey "\\e[100m"
:bold "\\e[1m" :underline "\\e[4m"
:start-of-line "\\r" :clear-line "\\e[2K" :move-up "\\e[1A")))
(format-ansi-codes (kv-lookup ansi-codes ansi-name))
))
(defun format-ansi-escaped-arg (out-stream arg)
(cond
((typep arg 'symbol) (format out-stream "~a" (make-ansi-escape arg)))
((typep arg 'string) (format out-stream arg))
(t (format out-stream "~a" arg))
))
(defun format-ansi-escaped (out-stream &rest args)
(while args
(let ((arg (pop args)))
(if (typep arg 'list)
(let ((first-arg (eval (first arg))))
(format out-stream first-arg (second arg))
)
(format-ansi-escaped-arg out-stream arg)
))
))
(defmacro while-pop ((var sequence &optional result-form) &rest forms)
(with-gensyms (seq)
`(let (,var)
(progn
(do () ((not ,sequence))
(setf ,var (pop ,sequence))
(progn ,#forms))
,result-form))))
(defun report-start (form)
(format t "( ) '~a'~%" form))
(defun report-result (result form)
(format-ansi-escaped t "(" (if result :green :red) `("~:[FAIL~;PASS~]" ,result) :normal `(") '~a'~%" ,form))
result)
(defmacro ? (name &body body-forms)
"Run any number of test forms, optionally nested within further (?) calls, and print the results of each test"
(with-gensyms (result indent indent-string)
(if (not body-forms)
:empty
(progn
(setf result () indent 0 indent-string " ")
(cond
((typep (first body-forms) 'integer)
(setf indent (pop body-forms))))
`(progn
(format t "~v#{~A~:*~}" ,indent ,indent-string)
(format-ansi-escaped t "[" :white ,name :normal "]~%")
(with-gensyms (test-results)
(setf test-results ())
,(while-pop (body-form body-forms `(progn ,#(nreverse result)))
(cond
( (EQL (first body-form) '?)
(push `(progn
(setf test-results (append test-results (? ',(nth 1 body-form) ,(1+ indent) ,#(nthcdr 2 body-form))))
(format t "~%")
test-results
) result)
)
(t
(push `(progn
(format t "~v#{~A~:*~}" ,(1+ indent) ,indent-string)
(report-start ',body-form)
(with-gensyms (result label)
(setf result ,body-form)
(format-ansi-escaped t :move-up :start-of-line :clear-line)
(format t "~v#{~A~:*~}" ,(1+ indent) ,indent-string)
(push (report-result result ',body-form) test-results)
test-results
)) result))))))))))
(defun ?? (&rest results)
"Run any number of tests, and print a summary afterward"
(setf results (flatten results))
(format-ansi-escaped t "~&" :white "Results: " :green `("~a test~:p passed" ,(count t results)) :normal ", "
(if (find NIL results) :red :normal) `("~a test~:p failed" ,(count NIL results))
:yellow `("~[~:;, ~:*~a test~:p not run~]" ,(count :skip results))
:brown `("~[~:;, ~:*~a empty test group~:p skipped~]" ,(count :empty results))
:normal "~%"))

For my part, the ? macro is rather technical and it's hard to follow the logic behind the formatting functions. So instead of tracking errors I'd like to suggest my own attempt, perhaps it'll be of use.
I think that actually your ?? doesn't want to evaluate anything, but rather to treat its body as individual tests or sections. If the body includes a list starting with ?, this list represents a section; other elements are test forms optionally followed by descriptions. So in my implementation ?? will be a macro, and ? will be just a symbol.
I start with wishful thinking. I suppose I can create individual tests using a function make-test-item and test sections using a function make-test-section (their implementation is unimportant for now), that I can display them using an auxiliary function display-test and compute results using the function results, which returns two values: the total number of tests and the number of passed ones. Then I'd like the code
(??
(? "Arithmetic tests"
(? "Addition"
(= (+ 1 2) 3) "Adding 1 and 2 results in 3"
(= (+ 1 2 3) 6)
(= (+ -1 -3) 4))
(? "Subtraction"
(= (- 1 2) 1)))
(= (sin 0) 0) "Sine of 0 equals 0")
to expand into something like
(let ((tests (list (make-test-section :header "Arithmetic tests"
:items (list (make-test-section :header "Addition"
:items (list (make-test-item :form '(= (+ 1 2) 3)
:description "Adding 1 and 2 results in 3"
:passp (= (+ 1 2) 3))
(make-test-item :form '(= (+ 1 2 3) 6)
:passp (= (+ 1 2 3) 6))
(make-test-item :form '(= (+ -1 -3) 4)
:passp (= (+ -1 -3) 4))))
(make-test-section :header "Subtraction"
:items (list (make-test-item :form '(= (- 1 2) 1)
:passp (= (- 1 2) 1))))))
(make-test-item :form '(= (sin 0) 0)
:passp (= (sin 0) 0)
:description "Sine of 0 equals 0"))))
(loop for test in tests
with total = 0
with passed = 0
do (display-test test 0 t)
do (multiple-value-bind (ttl p) (results test)
(incf total ttl)
(incf passed p))
finally (display-result total passed t)))
Here a list of tests is created; then we traverse it printing each test (0 denotes the zero level of indentation and t is as in format) and keeping track of the results, finally displaying the total results. I don't think explicit eval is needed here.
It may not be the most exquisite piece of code ever, but it seems manageable. I supply missing definitions below, they are rather trivial (and can be improved) and have nothing to do with macros.
Now we pass on to the macros. Consider both pieces of code as data, then we want a list processing function which would turn the first one into the second. A few auxiliary functions would come in handy.
The major task is to parse the body of ?? and generate the list of test to go inside the let.
(defun test-item-form (form description)
`(make-test-item :form ',form :description ,description :passp ,form))
(defun test-section-form (header items)
`(make-test-section :header ,header :items (list ,#items)))
(defun parse-test (forms)
(let (new-forms)
(loop
(when (null forms)
(return (nreverse new-forms)))
(let ((f (pop forms)))
(cond ((and (listp f) (eq (first f) '?))
(push (test-section-form (second f) (parse-test (nthcdr 2 f))) new-forms))
((stringp (first forms))
(push (test-item-form f (pop forms)) new-forms))
(t (push (test-item-form f nil) new-forms)))))))
Here parse-test essentially absorbs the syntax of ??. Each iteration consumes one or two forms and collects corresponding make-... forms. The functions can be easily tested in REPL (and, of course, I did test them while writing).
Now the macro becomes quite simple:
(defmacro ?? (&body body)
`(let ((tests (list ,#(parse-test body))))
(loop for test in tests
with total = 0
with passed = 0
do (display-test test 0 t)
do (multiple-value-bind (ttl p) (results test)
(incf total ttl)
(incf passed p))
finally (display-result total passed t))))
It captures a few symbols, both in the variable name space and in the function one (the expansion may contain make-test-item and make-test-section). A clean solution with gensyms would be cumbersome, so I'd suggest just moving all the definitions in a separate package and exporting only ?? and ?.
For completeness, here is an implementation of the test API. Actually, it's what I started coding with and proceeded until I made sure the big let-form works; then I passed on to the macro part. This implementation is fairly sloppy; in particular, it doesn't support terminal colours and display-test can't even output a section into a string.
(defstruct test-item form description passp)
(defstruct test-section header items)
(defun results (test)
(etypecase test
(test-item (if (test-item-passp test)
(values 1 1)
(values 1 0)))
(test-section (let ((items-count 0)
(passed-count 0))
(dolist (i (test-section-items test) (values items-count passed-count))
(multiple-value-bind (i p) (results i)
(incf items-count i)
(incf passed-count p)))))))
(defparameter *test-indent* 2)
(defun display-test-item (i level stream)
(format stream "~V,0T~:[(FAIL)~;(PASS)~] ~:['~S'~;~:*~A~]~%"
(* level *test-indent*)
(test-item-passp i)
(test-item-description i)
(test-item-form i)))
(defun display-test-section-header (s level stream)
(format stream "~V,0T[~A]~%"
(* level *test-indent*)
(test-section-header s)))
(defun display-test (test level stream)
(etypecase test
(test-item (display-test-item test level stream))
(test-section
(display-test-section-header test level stream)
(dolist (i (test-section-items test))
(display-test i (1+ level) stream)))))
(defun display-result (total passed stream)
(format stream "Results: ~D test~:P passed, ~D test~:P failed.~%" passed (- total passed)))
All the code is licenced under WTFPL.

Reading Outer Nested Forms in Lisp?

Is there a way to do this:
(let ((x 5)(y 7))
(get-outer-form) ;; 'get-outer-form would capture the entire LET expression
(* x y))
35 ;; value returned from LET
*current-form-value* ;; variable to hold the form
(let ((x 5))(y 7))(* x y)) ;; value of evaluating *current-form-value*
If it can be done, pseudo-code will suffice. I'll naively assume that this would have to be done with read, however, if there is too much overhead generated from doing this, I will have to find another solution. Thanks.

No its not possible by default. Doing so would need some advanced code and is not likely to work easily:
custom evaluator
code walker which injects the necessary code

I've been fiddling a little around and came up with this. It's not exactly what you want but it's close. It it were possible to rename let and make your own it would be exactly what you want.
(defmacro letc (p &body b)
(when (equal (car b) '(get-outer-form))
(setq b `((setf *current-form-value* '(let ,p ,#(cdr b))),#(cdr b))))
`(let ,p ,#b))
(letc ((x 5)(y 7))
(get-outer-form) ;; 'get-outer-form would capture the entire LET expression
(* x y))
;; ==> 35
*current-form-value*
;; ==> (let ((x 5) (y 7)) (* x y))
Or simpler. Using letc implies you want it captured.
(defmacro letc (p &body b)
`(let ,p (setf *current-form-value* '(letc ,p ,#b)),#b)))
(letc ((x 5)(y 7))
(* x y))
;; ==> 35
*current-form-value*
;; ==> (letc ((x 5) (y 7)) (* x y))
Both of them have problems with nesting:
(letc ((x 5)(y 7))
(letc ((a (+ x y)))
(* 2 a)))
;; ==> 24
*current-form-value*
;; ==> (let ((a (+ x y))) (* 2 a))

I think Rainer is basically correct, but I couldn't help trying for a subset of your goal with either *macroexpand-hook* or a reader approach. I don't bother removing (get-outer-form) from the current form in either case, but that should be straightforward list manipulation.
First a reader approach. Wrap the open parenthesis reader with a function that searches for (get-outer-form) within the result of calling the default open parenthesis reader.
;(in-package |cl-user|)
(defparameter *standard-readtable* (copy-readtable ()))
*STANDARD-READTABLE*
;(in-package |cl-user|)
(defvar *current-form-value* ())
*CURRENT-FORM-VALUE*
;(in-package |cl-user|)
(defun get-outer-form ()
())
GET-OUTER-FORM
;(in-package |cl-user|)
(defun get-outer-form-paren-reader (stream char &optional count)
(declare (ignore count))
(let* ((seen ())
(paren-reader
(get-macro-character #\( *standard-readtable*))
(form (funcall paren-reader stream char)))
(subst-if ()
(lambda (x)
;; never substitute, search only.
(prog1 ()
(when (equalp x '(get-outer-form))
(setq seen t))))
form)
(when seen
(setq *current-form-value* form))
form))
GET-OUTER-FORM-PAREN-READER
;(in-package |cl-user|)
(set-macro-character #\( #'get-outer-form-paren-reader)
T
Second, a *macroexpand-hook* approach. Look for (get-outer-form) in forms before they are macroexpanded.
;(in-package |cl-user|)
(defun get-outer-form ()
(error "get-outer-form only works from within a macro"))
GET-OUTER-FORM
;(in-package |cl-user|)
(defvar *current-form-value* ())
*CURRENT-FORM-VALUE*
;(in-package |cl-user|)
(defun mhook (expander form env)
(let* ((seen ())
(fixed (subst-if ()
(lambda (x)
(when (equalp x '(get-outer-form))
(setq seen t)))
form)))
(when seen (setq *current-form-value* form))
(funcall expander fixed env)))
MHOOK
;(in-package |cl-user|)
(setq *macroexpand-hook* #'mhook)
#<Compiled-function MHOOK #x30200FC5BB1F>

how to write alike display (printf) to file in scheme?

Using TinyScheme.
I'm writing my code to file (solved it in 50% here: How to write to a file in tinyscheme?) with:
(with-output-to-file "biophilia.c"
(lambda ()
(write code)
))
; and segmentation fault comes here
but it writes my code with "" qotes and \n\r as is so it doesn't translate it to newline.
I need to write code like it looks with (display code)
in example in racket docs there is printf but seems like TinyScheme implementation got no printf, maybe I need to discover (add code of it) printf?

You could try:
(call-with-output-file "biophilia.c"
(lambda (port)
(write-string code port)))
Provided "code" is a string. It will remove any escapes, and write it as plain text.

Found solution, the only fix is ex-hanged put-char to write-char
(define assert
(lambda (aa msg)
(if (null? aa)
#t
(if (not (car aa))
(error msg)
(assert (cdr aa) msg)))))
(display "define fprintf\n\r")
(define (fprintf port f . args)
(let ((len (string-length f)))
(let loop ((i 0) (args args))
(cond ((= i len) (assert (null? args)))
((and (char=? (string-ref f i) #\~)
(< (+ i 1) len))
(dispatch-format (string-ref f (+ i 1)) port (car args))
(loop (+ i 2) (cdr args)))
(else
(write-char (string-ref f i) port)
(loop (+ i 1) args))))))
(display "define printf\n\r")
(define (printf f . args)
(let ((port (current-output-port)))
(apply fprintf port f args)
(flush-output-port port)))
(display "writing to output file biophilia.c\n\r")
(with-output-to-file "biophilia.c"
(lambda ()
(printf code)
))
code doesn't segfault anymore
but in the end of file: Error: ( : 25) not enough arguments