I want to write a FFI for printf function of C in Chez Scheme using foreign-procedure. But I cannot figure out what I should put as the signature, since the last argument in printf function is a variadic argument. Here's my code:
(import (chezscheme))
(define (print-format)
(foreign-procedure "printf"
(string void*) int)) ;; <-- Here, the type format is "(arg arg ...) ret"
(print-format "Hello, %s!" "Ryan")
I have tried this as well to no avail:
(define (print-format . args)
(foreign-procedure "printf"
(string args) int))
This is not working either:
(define (print-format)
(foreign-procedure "printf"
(string ...) int))
How do you specify variadic arguments in function signature for foreign-procedure?
Although it is not the ultimate solution,
you could use macros to accommodate variable number
of parameters to a system call.
create-list is used to supply proper number of parameters to the foreign-procedure
system call.
For example, macro call
(print-format "Hello %s and %s" "Ryan" "Greg")
is expanded as
((foreign-procedure "printf" (string string string) int) "Hello %s and %s" "Ryan" "Greg")
(define create-list
(lambda (element n)
"create a list by replicating element n times"
(letrec ((helper
(lambda (lst element n)
(cond ((zero? n) lst)
(else
(helper
(cons element lst) element (- n 1)))))))
(helper '() element n))))
(define-syntax print-format
(lambda (x)
(syntax-case x ()
((_ cmd ...)
(with-syntax
((system-call-spec
(syntax
(create-list 'string
(length (syntax (cmd ...)))))))
(with-syntax
((proc (syntax
(eval
`(foreign-procedure "printf"
(,#system-call-spec) int)))))
(syntax
(proc cmd ...))))))))
(print-format "Hello %s!" "Ryan")
(print-format "Hello %s and %s" "Ryan" "Greg")
Related
The following get_file function reads file from disk as a Scheme R6RS string:
; Gets all characters from a port
(define (read_chars_from_port_rev port result)
(let ((char (read-char port)))
(if (eof-object? char)
result
(read_chars_from_port_rev port (cons char result)))))
; Gets the contents of a file as a string
; If it doesn't exist, returns empty
(define (get_file file)
(if (file-exists? file)
(let ((port (open-input-file file)))
(let ((text (list->string (reverse (read_chars_from_port_rev port '())))))
(begin
(close-input-port port)
text)))
""))
It works by opening the file, tail-call-recursively reading char-by-char into a linked list until we find eof, closing the file, then reversing the linked list (because of the tail-call) and converting it to a string.
This procedure should be slow compared to, say, Node.js's readFile, because it reads char by char, and allocates a linked list with one cell for each character in the file. Ideally, we should be able to just read a file as a string buffer, with no dynamic memory allocations.
Is there any way to optimize get_file with the primitives available in R6RS?
You can use get-string-all:
> (let* ((fp (open-input-file "my-file.txt"))
(buf (get-string-all fp)))
(close-port fp)
(display buf))
Four score and seven years ago
our fathers brought forth upon this continent,....
This can be made somewhat more convenient by using call-with-input-file:
;;; Returns a string containing the contents of the file `fname`; closes the
;;; input port automatically (unless `get-string-all` does not return for
;;; some reason).
(define (get-file fname)
(call-with-input-file fname get-string-all))
> (get-file "my-file.txt")
"Four score and seven years ago\nour fathers brought forth upon this continent,....\n"
You can use guard to facilitate returning an empty string when the sought file does not exist (as in the posted code):
(define (guarded-get-file fname)
(guard (con
((i/o-file-does-not-exist-error? con) ""))
(call-with-input-file fname get-string-all)))
> (guarded-get-file "my-file.txt")
"Four score and seven years ago\nour fathers brought forth upon this continent,....\n"
> (guarded-get-file "oops.txt")
""
Declaring functions with Racket's FFI is simple enough to do with _fun and define-ffi-definer. (A tutorial can be found on the PRL blog) For example, I can make a binding for atoi:
#lang racket
(require ffi/unsafe
ffi/unsafe/define)
(define-ffi-definer define-libc #f)
(define-libc atoi (_fun _string -> _int))
And now I can call atoi with Racket strings:
> (atoi "5")
5
The problem now is, how do I call C functions with a variable arity, such as printf, who's signature is:
int printf(const char *format, ...);
I would guess that (since the linking happens dynamically), the Racket code should have a 'rest' argument at the end, which takes an array (pointer) for the rest of the arguments, that is either null terminated or (more likely), indicated by yet another argument. However, I can't think of any good ways to test this.
So, how do you handle variable arity functions with the Racket-C FFI?
Look at this solution c-printf:
(provide c-printf)
(define interfaces (make-hash))
(define (c-printf fmt . args)
(define itypes
(cons _string
(map (lambda (x)
(cond [(and (integer? x) (exact? x)) _int]
[(and (number? x) (real? x)) _double*]
[(string? x) _string]
[(bytes? x) _bytes]
[(symbol? x) _symbol]
[else (error 'c-printf
"don't know how to deal with ~e" x)]))
args)))
(let ([printf (hash-ref interfaces itypes
(lambda ()
;; Note: throws away the return value of printf
(let ([i (get-ffi-obj "printf" #f
(_cprocedure itypes _void))])
(hash-set! interfaces itypes i)
i)))])
(apply printf fmt args)))
In vim, entire c macro definition is fully highlighted with different color. How do i get similar style in emacs?. You can refer below screenshot showing that in vim(right side), entire EXAMPLE_MACRO is highlighted and showing that CALL_MACRO(0) is part of the definition.
#include <stdio.h>
#define CALL_MACRO(x) \
EXAMPLE_MACRO(x) \
int
main(int argc, char *argv[])
{
#define EXAMPLE_MACRO(x) \
if (x) { \
printf("\n Condition is true"); \
} else { \
printf("\n Condition is false"); \
} \
\
CALL_MACRO(0);
CALL_MACRO(1);
#undef EXAMPLE_MARCO
}
major-mode for above code is c-mode.
Please note above code doesn't compile.
I found below code which can make #if 0 and #endif to be shown as font-lock.
(defun my-c-mode-font-lock-if0 (limit)
(save-restriction
(widen)
(save-excursion
(goto-char (point-min))
(let ((depth 0) str start start-depth)
(while (re-search-forward "^\\s-*#\\s-*\\(if\\|else\\|endif\\)" limit 'move)
(setq str (match-string 1))
(if (string= str "if")
(progn
(setq depth (1+ depth))
(when (and (null start) (looking-at "\\s-+0"))
(setq start (match-end 0)
start-depth depth)))
(when (and start (= depth start-depth))
(c-put-font-lock-face start (match-beginning 0) 'font-lock-comment-face)
(setq start nil))
(when (string= str "endif")
(setq depth (1- depth)))))
(when (and start (> depth 0))
(c-put-font-lock-face start (point) 'font-lock-comment-face)))))
nil)
(defun my-c-mode-common-hook ()
(font-lock-add-keywords
nil
'((my-c-mode-font-lock-if0 (0 font-lock-comment-face prepend))) 'add-to-end))
(add-hook 'c-mode-common-hook 'my-c-mode-common-hook)
I'm not sure if above code can be modified to highlight multiline macro.
scottmcpeak.com/elisp/scott.emacs.el
There is mention of
;'("^([ \t]#.(\\\n.))" 1 font-lock-preprocessor-face)
; this 2nd line is my attempt to get it to recognize multiline macros
; and highlight them entirely as preprocessor (doesn't work..)
I just came across an awesome package by #Lindydancer called prepaint.el, that does exactly what you want. It highlights macros differently, including multi-line macros and also preserves the keyword highlighting in the macros.
Suppose somewhere I have defined several symbols:
#lang racket
(define foo 123)
(define bar '("1" "2" "3"))
I need a way to produce a string like "foo = 123" or "bar = '("1" "2" "3")". I wrote a function for that:
(define (f2 sy)
(format "~a = ~s" sy (eval sy)))
This function works in the interpretator window pretty well.
> (f2 'foo)
"foo = 123"
> (f2 'bar)
"bar = (\"1\" \"2\" \"3\")"
That is quite satisfactory for me. However, when I use it in the code, I get
foo: unbound identifier;
also, no #%top syntax transformer is bound in: foo
I have a feeling that I am doing something wrong. Can you please suggest the right way to solve my problem?
P.S.: I am using DrRacket, version 5.3.1
First of all, eval should really only be used as a last resort in Racket. It makes your program less efficient and harder to understand. The right way to do this is probably to write a macro such as the following:
(define-syntax-rule (f2 sy)
(format "~a = ~s" (quote sy) sy))
(define foo 2)
(f2 foo)
This macro just substitutes the name of the variable you want to lookup into the format expression in the body. The quote turns the variable name into a symbol you can print. This macro doesn't work as a procedure, because (f2 foo) would deference foo before you can quote and print its name.
Note: the reason why your eval doesn't work as expected is because eval always evaluates with respect to a namespace, which dictates what is in scope. The default namespace within a module has nothing in it, so eval can't see foo or anything else. You can read more about namespaces in the Guide.
Another solution, also inspired by Asumu Takikawa uses the trick described in the guide:
(define-namespace-anchor a)
(define ns (namespace-anchor->namespace a))
(define (f2 sy)
(format "~a = ~s" sy (eval sy ns)))
On the contrast to the solution with macros, this function can be mapped.
I have a simple c/c++ app that has an optional TCL interpreter with the function wrappers generated using SWIG. For several of the functions all the arguments are optional. How is this typically handled? I'd like to support a TCL command like this, where any of the arguments are optional but the C function takes fixed arguments:
//TCL command
get_list [options] filename
-opt1
-opt2
-opt3 arg1
-opt4 arg2
filename
//C function
static signed get_list(bool opt1,
bool opt2,
char * arg1,
objectType * arg2,
char * fileName)
Currently I have something like this:
static pList * get_list(char * arg1=NULL,
char * arg2=NULL,
char * arg3=NULL,
tObject * arg4=NULL)
This has many problems such as enforcing the object pointer is always the last argument. The SWIG documentation talks at length about C functions with variable arguments using "..." but I don't think this is what I need. I'd like the C function arguments to be fixed.
The easiest method is to wrap a Tcl procedure around the outside, like this:
rename get_list original.get_list
proc get_list args {
if {[llength $args] == 0 || [llength $args] % 2 == 0} {
error "wrong # args: ..."; # Do a proper error message here!
}
# Handle the required argument
set filename [lindex $args end]
# Initialize the defaults
array set opts {
-opt1 false
-opt2 false
-opt3 ""
-opt4 ""
}
# Merge in the supplied options
foreach {opt val} [lrange $args 0 end-1] {
if {![info exist opts($opt)]} {
error "unrecognized option \"$opt\""
}
set opts($opt) $value
}
# Hand off to C level...
original.get_list $opts(-opt1) $opts(-opt2) $opts(-opt3) $opts(-opt4) $filename
}
If you've got Tcl 8.6, that last handoff is best done with tailcall so the rewriting code is cut out of the Tcl stack. It's not vital though, as SWIGged code rarely resolves names of Tcl commands and variables.