Commit 9e61633e authored by -urso-'s avatar -urso-

updated cffi-qbook after adding defmethod* to cffi-utils

darcs-hash:2c25ba7191163050f09d5f417382f9e0102a2530
parent 5eddf6c1
......@@ -169,7 +169,8 @@
>Method ((SETF STREAM-POSITION) T FLEXI-STREAM)</a
> </p
></div
></div
>
</div
></div
></body
></html
......
......@@ -200,6 +200,7 @@
> </p
></div
>
</div
></div
></body
......
......@@ -192,6 +192,7 @@
> returns a list of flags, which byte pattern is found in value</p
></div
>
</div
></div
></body
......
......@@ -52,6 +52,7 @@
;;helpers
#:defcfun*
#:defmethod*
;;cbuffer
#:make-cbuffer
......
......@@ -17,6 +17,7 @@
>(defun create-cffi-arglist (args)
(mapcar (lambda (arg)
(cond ((member :out arg) `(,(car arg) :pointer))
((member :class arg) `(,(car arg) ,(second arg)))
((member :flag arg) `(,(car arg) ,(flag-exp-type arg)))
((in (third arg) :const :key) `(,(car arg) ,(second arg)))
(t arg)))
......
......@@ -14,14 +14,14 @@
><h2
>Source</h2
><pre class="code"
>(defun create-lisp-arglist (args)
>(defun create-lisp-arglist (method args)
(let* ((no-out-args (remove-if (curry #'member :out) args))
(flags (remove-if (complement (curry #'member :flag))
no-out-args))
(has-keys (or flags
(some (lambda (exp) (eq (third exp) :key))
no-out-args)))
(std-args (mapcar #'car
(std-args (mapcar (curry #'create-std-arg method)
(remove-if (funion (curry #'member :flag)
(curry #'member :const)
(curry #'member :key))
......
......@@ -20,6 +20,11 @@
(cond ((member :out arg) name)
((member :flag arg) (create-flag-call arg))
((member :const arg) (fourth arg))
((member :class arg)
(let ((class-desc (second (member :class arg))))
`(slot-value ,name ',(if (listp class-desc)
(second class-desc)
class-desc))))
(t (if (or (member :pointer arg)
(member :string arg))
`(if (not ,name) (null-pointer) ,name)
......
<html
><head
><title
>Function CREATE-STD-ARG</title
><link href="../style.css" rel="stylesheet"
/><link title="Print" href="../print.css" rel="alternate stylesheet"
/></head
><body
><div class="qbook"
><div class="computational-element"
><h1
>Function: CREATE-STD-ARG</h1
><div class="contents"
><h2
>Source</h2
><pre class="code"
>(defun create-std-arg (method arg-spec)
(let ((class-desc (second (member :class arg-spec)))
(name (car arg-spec)))
(cond ((and method
(listp class-desc)
(not (null class-desc))) `(,name ,(first class-desc)))
((and method
(atom class-desc)) name)
((and (not method)
class-desc)
(error &quot;using arg option :class without declaring method&quot;))
(t name))))</pre
><a href="../defcfun_0020extension.html#function_005FCFFI-UTIL_003A_003ACREATE-STD-ARG"
>Source Context</a
></div
></div
></div
></body
></html
>
\ No newline at end of file
......@@ -17,7 +17,7 @@
>if ret-type is keyword :error-int the cfunction will return
an int indicating an error if ret!=0 and error-fun is called with using
the returned value
syntax: (defcfun* (name fun-name &lt;:error-fun symbol&gt;)
syntax: (defcfun* (name fun-name &lt;:error-fun symbol&gt; &lt;:method t|nil&gt;)
ret-type
args*)
ctype ::= see cffi manual...
......@@ -27,7 +27,9 @@
&lt;:flag-type ctype&gt;
&lt;:default flag-list&gt;
&lt;:flag-system flag-system&gt;)
(arg ctype :class class-args)
flag-list ::= (flag-keyword*)
class-args ::= slot-name | (class-name slot-name)
params: flag-type: default is uint32
default: flags being set to t by default
name: cfunction name
......@@ -41,12 +43,14 @@
><h2
>Source</h2
><pre class="code"
>(defmacro defcfun* ((name fun-name &amp;key (error-fun 'std-check-error))
>(defmacro defcfun* ((name fun-name &amp;key
(error-fun 'std-check-error)
method)
ret-type &amp;body arg-list)
&quot;if ret-type is keyword :error-int the cfunction will return
an int indicating an error if ret!=0 and error-fun is called with using
the returned value
syntax: (defcfun* (name fun-name &lt;:error-fun symbol&gt;)
syntax: (defcfun* (name fun-name &lt;:error-fun symbol&gt; &lt;:method t|nil&gt;)
ret-type
args*)
ctype ::= see cffi manual...
......@@ -56,7 +60,9 @@
&lt;:flag-type ctype&gt;
&lt;:default flag-list&gt;
&lt;:flag-system flag-system&gt;)
(arg ctype :class class-args)
flag-list ::= (flag-keyword*)
class-args ::= slot-name | (class-name slot-name)
params: flag-type: default is uint32
default: flags being set to t by default
name: cfunction name
......@@ -69,7 +75,7 @@
more :P )&quot;
(let ((cfun-name (symb '% fun-name))
(cffi-arglist (create-cffi-arglist arg-list))
(lisp-arglist (create-lisp-arglist arg-list))
(lisp-arglist (create-lisp-arglist method arg-list))
(out-arglist (create-out-arglist arg-list))
(call-list (create-lisp-call-list arg-list))
(real-ret-type (if (eq :error-int ret-type) :int ret-type)))
......@@ -77,7 +83,7 @@
(defcfun (,name ,cfun-name) ,real-ret-type
,@cffi-arglist)
(defun ,fun-name ,lisp-arglist
(,(if method 'defmethod 'defun) ,fun-name ,lisp-arglist
,(if (null out-arglist)
(if (eq :error-int ret-type)
`(,error-fun (,cfun-name ,@call-list))
......
<html
><head
><title
>Macro DEFMETHOD*</title
><link href="../style.css" rel="stylesheet"
/><link title="Print" href="../print.css" rel="alternate stylesheet"
/></head
><body
><div class="qbook"
><div class="computational-element"
><h1
>Macro: DEFMETHOD*</h1
><div class="contents"
><h2
>Source</h2
><pre class="code"
>(defmacro defmethod* ((name fun-name &amp;key (error-fun 'std-check-error))
ret-type &amp;body args)
`(defcfun* (,name ,fun-name :error-fun ,error-fun :method t)
,ret-type ,@args))</pre
><a href="../defcfun_0020extension.html#macro_005FCFFI-UTIL_003A_003ADEFMETHOD_002A"
>Source Context</a
></div
></div
></div
></body
></html
>
\ No newline at end of file
......@@ -24,7 +24,42 @@
> | <a href="index.html"
>toc</a
></div
>
><p>example usage:
(defcfun* (&quot;test&quot; test :method t) :error-int
(a :int)
(b :out :uchar)
(c :int :key)
(flag :flag (:create :truncate))
(aflag :uint32 :const 0)
(cl :uint32 :class (my-class value))
(cl2 :uint32 :class any-slot)
)
==&gt;
(PROGN
(DEFCFUN (&quot;test&quot; %TEST)
:INT
(A :INT)
(B :POINTER)
(C :INT)
(FLAG :UINT32)
(AFLAG :UINT32)
(CL :UINT32)
(CL2 :UINT32))
(DEFMETHOD TEST (A (CL MY-CLASS) CL2 &amp;KEY C CREATE TRUNCATE)
(WITH-FOREIGN-OBJECTS ((B :UCHAR))
(LET ((RET
(%TEST A
B
C
(LOGIOR (IF CREATE 0 0)
(IF TRUNCATE 0 0))
0
(SLOT-VALUE CL 'VALUE)
(SLOT-VALUE CL2 'ANY-SLOT))))
(WHEN (STD-CHECK-ERROR RET)
(VALUES (MEM-REF B :UCHAR)))))))
<div class="computational-element-link computational-element-link-function"
><p
><a href="api/function_005FCFFI-UTIL_003A_003ASTD-CHECK-ERROR.html" name="function_005FCFFI-UTIL_003A_003ASTD-CHECK-ERROR"
......@@ -42,6 +77,15 @@
></div
>
<div class="computational-element-link computational-element-link-macro"
><p
><a href="api/macro_005FCFFI-UTIL_003A_003ADEFMETHOD_002A.html" name="macro_005FCFFI-UTIL_003A_003ADEFMETHOD_002A"
>Macro DEFMETHOD*</a
> </p
></div
>
<div class="computational-element-link computational-element-link-function"
><p
><a href="api/function_005FCFFI-UTIL_003A_003AUNPACK-FLAG.html" name="function_005FCFFI-UTIL_003A_003AUNPACK-FLAG"
......@@ -82,6 +126,14 @@
></div
>
<div class="computational-element-link computational-element-link-function"
><p
><a href="api/function_005FCFFI-UTIL_003A_003ACREATE-STD-ARG.html" name="function_005FCFFI-UTIL_003A_003ACREATE-STD-ARG"
>Function CREATE-STD-ARG</a
> </p
></div
>
<div class="computational-element-link computational-element-link-function"
><p
><a href="api/function_005FCFFI-UTIL_003A_003ACREATE-LISP-ARGLIST.html" name="function_005FCFFI-UTIL_003A_003ACREATE-LISP-ARGLIST"
......@@ -113,9 +165,6 @@
> </p
></div
>
</div
></div
></body
......
......@@ -91,6 +91,10 @@
><a href="../api/function_005FCFFI-UTIL_003A_003ACREATE-OUT-ARGLIST.html"
>CREATE-OUT-ARGLIST</a
></dt
><dt
><a href="../api/function_005FCFFI-UTIL_003A_003ACREATE-STD-ARG.html"
>CREATE-STD-ARG</a
></dt
><dt
><a href="../api/function_005FCFFI-UTIL_003A_003ADEF-FLAG.html"
>DEF-FLAG</a
......
......@@ -25,6 +25,10 @@
></dt
><dd
>same as def-flag, but creates a constant</dd
><dt
><a href="../api/macro_005FCFFI-UTIL_003A_003ADEFMETHOD_002A.html"
>DEFMETHOD*</a
></dt
><dt
><a href="../api/macro_005FCFFI-UTIL_003A_003AFLAGS.html"
>FLAGS</a
......
......@@ -40,6 +40,20 @@
> [Function] </a
></td
></tr
><tr
><td align="right"
><a href="../api/function_005FCFFI-UTIL_003A_003ACREATE-STD-ARG.html"
>CREATE-STD-</a
></td
><td
><a href="../api/function_005FCFFI-UTIL_003A_003ACREATE-STD-ARG.html"
>ARG</a
></td
><td
><a href="../api/function_005FCFFI-UTIL_003A_003ACREATE-STD-ARG.html"
> [Function] </a
></td
></tr
><tr
><td align="right"
><a href="../api/function_005FCFFI-UTIL_003A_003ACREATE-OUT-ARGLIST.html"
......@@ -754,6 +768,20 @@
> [Function] </a
></td
></tr
><tr
><td align="right"
><a href="../api/function_005FCFFI-UTIL_003A_003ACREATE-STD-ARG.html"
></a
></td
><td
><a href="../api/function_005FCFFI-UTIL_003A_003ACREATE-STD-ARG.html"
>CREATE-STD-ARG</a
></td
><td
><a href="../api/function_005FCFFI-UTIL_003A_003ACREATE-STD-ARG.html"
> [Function] </a
></td
></tr
><tr
><td align="right"
><a href="../api/variable_005FCFFI-UTIL_003A_003A_002ACURRENT-FLAG-SYSTEM_002A.html"
......@@ -824,6 +852,20 @@
> [Macro] </a
></td
></tr
><tr
><td align="right"
><a href="../api/macro_005FCFFI-UTIL_003A_003ADEFMETHOD_002A.html"
></a
></td
><td
><a href="../api/macro_005FCFFI-UTIL_003A_003ADEFMETHOD_002A.html"
>DEFMETHOD*</a
></td
><td
><a href="../api/macro_005FCFFI-UTIL_003A_003ADEFMETHOD_002A.html"
> [Macro] </a
></td
></tr
><tr
><td align="right"
><a href="../api/function_005FCFFI-UTIL_003A_003ADELETE-FLAG-SYSTEM.html"
......@@ -2070,6 +2112,20 @@
> [Variable] </a
></td
></tr
><tr
><td align="right"
><a href="../api/function_005FCFFI-UTIL_003A_003ACREATE-STD-ARG.html"
>CREATE-</a
></td
><td
><a href="../api/function_005FCFFI-UTIL_003A_003ACREATE-STD-ARG.html"
>STD-ARG</a
></td
><td
><a href="../api/function_005FCFFI-UTIL_003A_003ACREATE-STD-ARG.html"
> [Function] </a
></td
></tr
><tr
><td align="right"
><a href="../api/function_005FCFFI-UTIL_003A_003ASTD-CHECK-ERROR.html"
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment