Сишный snprintf в Scheme

В Scheme нет полного аналога функции snprintf. Поэтому, я решил его написать сам. И не просто написать, а вызвать из сишной библиотеки с помощью механизма FFI.

Функция snprintf принимает переменное число аргументов, однако, механизм FFI требует задание полного прототипа функции перед использованием. Данный пример показывает как можно обойти это ограничение и создавать прототипы в runtime.

Шаг 1. Ищем и подгружаем нужные dll'ки и определяем имя функции snprintf. На разных системах snprintf находится в разных библиотеках, в данном случае последовательно перебираем варианты с libc и msvcrt, поэтому данный код будет работать практически на всех вариантах UNIX и в Windows.

#lang racket

(require ffi/unsafe)
(require ffi/vector)

(define (load-oneof which)
  (cond
    ((eq? which '()) #f)
    (else
     (with-handlers ([exn:fail? (lambda (exn) (load-oneof (cdr which)))])
       (ffi-lib (car which))))))

(define (search-func-name where which)
  (cond
    ((eq? which '()) #f)
    (else
     (let*
         ((func-name (car which))
          (rest (cdr which)))
       (with-handlers ([exn:fail? (lambda (exn) (search-func-name where rest))])
         (begin
           (get-ffi-obj func-name where (_fun _int -> _void))
           func-name))))))

(define crt (load-oneof '("libc" "msvcrt")))
(define snprintf-name (search-func-name crt '("snprintf" "_snprintf")))

Шаг 2. Определяем функцию snprintf. Основная проблема здесь в том, что функция принимает переменное число аргументов, а интерфейс FFI требует определить прототип функции с заданным числом аргументов. Для обхода этой проблемы я генерирую прототип функции с нужным числом аргументов на лету. Также, обратите внимание, что snprintf генерирует массив байтов, который мы потом преобразуем в строку.

(define (snprintf max-len format . args)
  (let*
      ((mem  (make-u8vector max-len 0))
       (input-types 
        (foldl 
         (lambda (a result)
           (cond 
             ((string? a) (append result (list _string)))
             ((integer? a) (append result (list _int)))
             ((real? a) (append result (list _double)))
             (else result)
             ))
         (list _u8vector _int _string) args)
        )
       (func (get-ffi-obj snprintf-name crt (_cprocedure input-types _int)))
       (len (apply func `(,(u8vector-"cpointer mem) ,max-len ,format ,@args)))
       (output (open-output-bytes)))
    (begin
      (display mem output)
      (bytes-"string/utf-8 (subbytes (get-output-bytes output) 0 len))
      )
    )
  )

Шаг 3. Используем функцию:

(snprintf 100 "йцукен %.2lf %04d" 11.2 1)