Variable arity functions in Racket/C FFI - c

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)))

Related

FFI in Chez Scheme for C functions with variadic arguments (varargs)

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")

Highlighting entire c/cpp macro definition in emacs?

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.

passing unevaluated expressions to C/C++

I'd like to pass a variable number of arguments from a function to C/C++, but would like to leave the arguments unevaluated and at the same time don't want to do any computations in R (aside from calling the C/C++ function), i.e. I don't want to call substitute in my R function. One option for this that I thought I could use is .External and doing smth like this:
R_fn = function(...) .External("cpp_fn", ...)
...
# and in C code:
SEXP cpp_fn (SEXP arglist) {
}
However .External is evaluating arguments in ..., so if I try something like
rm(x, y) # just making sure these don't exist
R_fn(x*y)
I get an error because R is trying to evaluate x*y before sending it to the function.
To contrast, the following works in R:
f = function(...) g(...)
g = function(x, ...) print(substitute(x))
f(x*y*z)
# x * y * z
What other options do I have? Clearly it's possible to do as R itself does it for a number of functions, e.g. substitute itself, but I don't understand how to do it. I added the rcpp tag because my eventual usage of this is going to be in Rcpp.
One possibility is to do what match.call does (thanks to Ricardo Saporta for pointing me in that direction). This requires copy-pasting a few definitions from R source code that I won't do here, but the basic idea is to get the calling function from R_GlobalContext and then extract the function arguments from there. The rough sketch is as follows:
R_fn = function(...) .Call("cpp_fn")
// and in C++ code
Language cpp_fn() {
SEXP sysp = ((RCNTXT*)R_GlobalContext)->sysparent;
RCNTXT *cptr = (RCNTXT*)R_GlobalContext;
while (cptr != NULL) {
if (cptr->callflag & CTXT_FUNCTION && cptr->cloenv == sysp)
break;
cptr = cptr->nextcontext;
}
cptr = cptr->nextcontext; // because this is called from .Call and not from R_fn
// and now cptr->promargs has the unevaluated arguments to do as one pleases
// e.g.
Language firstArg(R_PromiseExpr(CAR(cptr->promargs)));
return firstArg;
}

Understanding how .Internal C functions are handled in R

I wonder if anyone can illustrate to me how R executes a C call from an R command typed at the console prompt. I am particularly confused by R's treatment of a) function arguments and b) the function call itself.
Let's take an example, in this case set.seed(). Wondering how it works I type the name in at the prompt, get the source (look here for more on that), see there is eventually a .Internal(set.seed(seed, i.knd, normal.kind), so dutifully look up the relevant function name in the .Internals section of /src/names.c, find it is called do_setseed and is in RNG.c which leads me to...
SEXP attribute_hidden do_setseed (SEXP call, SEXP op, SEXP args, SEXP env)
{
SEXP skind, nkind;
int seed;
checkArity(op, args);
if(!isNull(CAR(args))) {
seed = asInteger(CAR(args));
if (seed == NA_INTEGER)
error(_("supplied seed is not a valid integer"));
} else seed = TimeToSeed();
skind = CADR(args);
nkind = CADDR(args);
//...
//DO RNG here
//...
return R_NilValue;
}
What are CAR, CADR, CADDR? My research leads me to believe they are a Lisp influenced construct concerning lists but beyond that I do not understand what these functions do or why they are needed.
What does checkArity() do?
SEXP args seems self explanatory, but is this a list of the
arguments that is passed in the function call?
What does SEXP op represent? I take this to mean operator (like in binary functions such as +), but then what is the SEXP call for?
Is anyone able to flow through what happens when I type
set.seed(1)
at the R console prompt, up to the point at which skind and nkind are defined? I find I am not able to well understand the source code at this level and path from interpreter to C function.
CAR and CDR are how you access pairlist objects, as explained in section 2.1.11 of R Language Definition. CAR contains the first element, and CDR contains the remaining elements. An example is given in section 5.10.2 of Writing R Extensions:
#include <R.h>
#include <Rinternals.h>
SEXP convolveE(SEXP args)
{
int i, j, na, nb, nab;
double *xa, *xb, *xab;
SEXP a, b, ab;
a = PROTECT(coerceVector(CADR(args), REALSXP));
b = PROTECT(coerceVector(CADDR(args), REALSXP));
...
}
/* The macros: */
first = CADR(args);
second = CADDR(args);
third = CADDDR(args);
fourth = CAD4R(args);
/* provide convenient ways to access the first four arguments.
* More generally we can use the CDR and CAR macros as in: */
args = CDR(args); a = CAR(args);
args = CDR(args); b = CAR(args);
There's also a TAG macro to access the names given to the actual arguments.
checkArity ensures that the number of arguments passed to the function is correct. args are the actual arguments passed to the function. op is offset pointer "used for C functions that deal with more than one R function" (quoted from src/main/names.c, which also contains the table showing the offset and arity for each function).
For example, do_colsum handles col/rowSums and col/rowMeans.
/* Table of .Internal(.) and .Primitive(.) R functions
* ===== ========= ==========
* Each entry is a line with
*
* printname c-entry offset eval arity pp-kind precedence rightassoc
* --------- ------- ------ ---- ----- ------- ---------- ----------
{"colSums", do_colsum, 0, 11, 4, {PP_FUNCALL, PREC_FN, 0}},
{"colMeans", do_colsum, 1, 11, 4, {PP_FUNCALL, PREC_FN, 0}},
{"rowSums", do_colsum, 2, 11, 4, {PP_FUNCALL, PREC_FN, 0}},
{"rowMeans", do_colsum, 3, 11, 4, {PP_FUNCALL, PREC_FN, 0}},
Note that arity in the above table is 4 because (even though rowSums et al only have 3 arguments) do_colsum has 4, which you can see from the .Internal call in rowSums:
> rowSums
function (x, na.rm = FALSE, dims = 1L)
{
if (is.data.frame(x))
x <- as.matrix(x)
if (!is.array(x) || length(dn <- dim(x)) < 2L)
stop("'x' must be an array of at least two dimensions")
if (dims < 1L || dims > length(dn) - 1L)
stop("invalid 'dims'")
p <- prod(dn[-(1L:dims)])
dn <- dn[1L:dims]
z <- if (is.complex(x))
.Internal(rowSums(Re(x), prod(dn), p, na.rm)) + (0+1i) *
.Internal(rowSums(Im(x), prod(dn), p, na.rm))
else .Internal(rowSums(x, prod(dn), p, na.rm))
if (length(dn) > 1L) {
dim(z) <- dn
dimnames(z) <- dimnames(x)[1L:dims]
}
else names(z) <- dimnames(x)[[1L]]
z
}
The basic C-level pairlist extraction functions are CAR and CDR. (Pairlists are very similar to lists but are implemented as a linked-list and are used internally for argument lists). They have simple R equivalents: x[[1]] and x[-1]. R also provides lots of combinations of the two:
CAAR(x) = CAR(CAR(x)) which is equivalent to x[[1]][[1]]
CADR(x) = CAR(CDR(x)) which is equivalent to x[-1][[1]], i.e. x[[2]]
CADDR(x) = CAR(CDR(CDR(x)) is equivalent to x[-1][-1][[1]], i.e. x[[3]]
and so on
Accessing the nth element of a pairlist is an O(n) operation, unlike accessing the nth element of a list which is O(1). This is why there aren't nicer functions for accessing the nth element of a pairlist.
Internal/primitive functions don't do matching by name, they only use positional matching, which is why they can use this simple system for extracting the arguments.
Next you need to understand what the arguments to the C function are. I'm not sure where these are documented, so I might not be completely right about the structure, but I should be the general pieces:
call: the complete call, as might be captured by match.call()
op: the index of the .Internal function called from R. This is needed because there is a many-to-1 mapping from .Internal functions to C functions. (e.g. do_summary implements sum, mean, min, max and prod). The number is the third entry in names.c - it's always 0 for do_setseed and hence never used
args: a pair list of the arguments supplied to the function.
env: the environment from which the function was called.
checkArity is a macro which calls Rf_checkArityCall, which basically looks up the number of arguments (the fifth column in names.c is arity) and make sure the supplied number matches. You have to follow through quite a few macros and functions in C to see what's going on - it's very helpful to have a local copy of R-source that you can grep through.

printf symbol name and value

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.

Resources