diff options
| author | Kaz Kylheku <kaz@kylheku.com> | 2017-05-20 16:18:34 -0700 |
|---|---|---|
| committer | Kaz Kylheku <kaz@kylheku.com> | 2017-05-20 16:18:34 -0700 |
| commit | 298e35d6496cd4edac00578433ecbc020801e3a5 (patch) | |
| tree | 30789cd653387d04b9eed4a575346b1cade19204 | |
| parent | 66479625440d34dbb43b8e8a5f645dca95f9cc97 (diff) | |
| download | txr-298e35d6496cd4edac00578433ecbc020801e3a5.tar.gz txr-298e35d6496cd4edac00578433ecbc020801e3a5.tar.bz2 txr-298e35d6496cd4edac00578433ecbc020801e3a5.zip | |
ffi: deffi generates fixed-arg defun.
* share/txr/stdlib/ffi.tl (deffi): Since the arity of
a foreign function is fixed, generate a fixed-argument
defun. This provides a better check on the number of
arguments than letting ffi-call detect it.
| -rw-r--r-- | share/txr/stdlib/ffi.tl | 20 |
1 files changed, 10 insertions, 10 deletions
diff --git a/share/txr/stdlib/ffi.tl b/share/txr/stdlib/ffi.tl index 99d76137..ce497d17 100644 --- a/share/txr/stdlib/ffi.tl +++ b/share/txr/stdlib/ffi.tl @@ -53,21 +53,21 @@ (mac-param-bind f (sym ver) fun-expr ^(dlvsym-checked sys:ffi-lib ,sym ,ver))) (t fun-expr))) - (args-sym (gensym "args-")) (ret-type-sym (gensym "ret-type-")) (arg-types-sym (gensym "arg-types-")) (call-desc-sym (gensym "call-desc-")) (fun-sym (gensym "ffi-fun-"))) (tree-bind (nargs nvariadic . argtypes) (sys:analyze-argtypes f argtypes) - ^(progn - (defvarl ,ret-type-sym (ffi-type-compile ',rettype)) - (defvarl ,arg-types-sym [mapcar ffi-type-compile ',argtypes]) - (defvarl ,call-desc-sym (ffi-make-call-desc ,nargs ,nvariadic - ,ret-type-sym - ,arg-types-sym)) - (defvarl ,fun-sym ,fun-ref) - (defun ,name ,args-sym - (ffi-call ,fun-sym ,call-desc-sym . ,args-sym)))))) + (let ((arg-syms (take nargs (gun (gensym))))) + ^(progn + (defvarl ,ret-type-sym (ffi-type-compile ',rettype)) + (defvarl ,arg-types-sym [mapcar ffi-type-compile ',argtypes]) + (defvarl ,call-desc-sym (ffi-make-call-desc ,nargs ,nvariadic + ,ret-type-sym + ,arg-types-sym)) + (defvarl ,fun-sym ,fun-ref) + (defun ,name ,arg-syms + (ffi-call ,fun-sym ,call-desc-sym ,*arg-syms))))))) (defmacro deffi-type (name type-expr) ^(ffi-typedef ',name (ffi-type-compile ',type-expr))) |