guile-devel
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[PATCH 03/25] Mirror types from system/foreign as <foreign-type>


From: KAction
Subject: [PATCH 03/25] Mirror types from system/foreign as <foreign-type>
Date: Mon, 18 Jul 2016 18:17:26 +0300

From: Dmitry Bogatov <address@hidden>

  * module/system/foreign/declarative.scm: import
    (system foreign), where identifiers `int', 'long'
    and so on are declared

  * module/system/foreign/declarative.scm: with two helper
    macros `mirror-primitive-type' and `mirror-primitive-types'
    create <foreign-type> for every foreign type defined
    in (system foreign).

In some sence, it builds base case for future code, that will
build complex <foreign-type>s from more simple.
---
 module/system/foreign/declarative.scm | 22 +++++++++++++++++++++-
 1 file changed, 21 insertions(+), 1 deletion(-)

diff --git a/module/system/foreign/declarative.scm 
b/module/system/foreign/declarative.scm
index 5c38416..b13bcf4 100644
--- a/module/system/foreign/declarative.scm
+++ b/module/system/foreign/declarative.scm
@@ -18,6 +18,7 @@
   #:export (make-foreign-type)
   #:export (define-foreign-type))
 (use-modules (srfi srfi-9))
+(use-modules (system foreign))
 
 (define-record-type <foreign-type>
   (%make-foreign-type name encode-proc decode-proc type clone-proc free-proc)
@@ -56,4 +57,23 @@
   (%make-foreign-type name encode-proc decode-proc type clone-proc free-proc))
 
 (define-syntax-rule (define-foreign-type name args ...)
-  (define name (make-foreign-type 'name args ...)))
+  (define-public name (make-foreign-type 'name args ...)))
+
+(define-syntax mirror-primitive-type
+  (lambda (x)
+    (syntax-case x ()
+      ((_ prim ft)
+       #'(define-foreign-type ft
+           #:encode-proc (lambda (x) x)
+           #:decode-proc (lambda (x) x)
+           #:type prim))
+      ((_ prim)
+       (with-syntax
+           ((ft (datum->syntax x (symbol-append (syntax->datum #'prim) ':))))
+         #'(mirror-primitive-type prim ft))))))
+(define-syntax-rule (mirror-primitive-types prim ...)
+  (begin
+    (mirror-primitive-type prim) ...))
+(mirror-primitive-types
+ size_t int long ptrdiff_t int8 int16 int32 int64 uint8 uint16 uint32 uint64)
+(mirror-primitive-type '* *:)
-- 
I may be not subscribed. Please, keep me in carbon copy.




reply via email to

[Prev in Thread] Current Thread [Next in Thread]