From c7a73723dc9264ca9509ffb404acd50c92397425 Mon Sep 17 00:00:00 2001
From: eknauel <eknauel>
Date: Thu, 8 Jan 2004 07:47:22 +0000
Subject: [PATCH] + export make-integer-constant, make-string-constant + added
 generate-binding

---
 ffi-tools/ffi-tools-package.scm |  6 +++++-
 ffi-tools/ffi-tools.scm         | 15 +++++++++++++++
 2 files changed, 20 insertions(+), 1 deletion(-)

diff --git a/ffi-tools/ffi-tools-package.scm b/ffi-tools/ffi-tools-package.scm
index bbcdd9f..9859234 100644
--- a/ffi-tools/ffi-tools-package.scm
+++ b/ffi-tools/ffi-tools-package.scm
@@ -10,13 +10,17 @@
    constant-c-value-name
    constant-type
 
+   make-integer-constant
+   make-string-constant
+
    make-constant-from-c-name
    make-constant-from-c-name-integer
-   
+
    generate-c-declarations
    generate-c-enter-values-function
    generate-c-gc-protect-globals-function
 
+   generate-binding
    generate-finite-type-definition
    make-drop-common-prefix-name-converter))
 
diff --git a/ffi-tools/ffi-tools.scm b/ffi-tools/ffi-tools.scm
index 19f7e0a..3908a7e 100644
--- a/ffi-tools/ffi-tools.scm
+++ b/ffi-tools/ffi-tools.scm
@@ -28,6 +28,16 @@
 (define (constant-name->value-name constant-name)
   (string-append c-value-name-prefix constant-name))
 
+(define (make-integer-constant c-name scheme-name)
+  (make-constant c-name scheme-name 
+		 (constant-name->value-name c-name)
+		 constant-type-int))
+
+(define (make-string-constant c-name scheme-name)
+  (make-constant c-name scheme-name
+		 (constant-name->value-name c-name)
+		 constant-type-string))
+
 (define (make-constant-from-c-name c-name type)
   (let ((scheme-name (constant-name->scheme-name c-name)))
     (make-constant c-name scheme-name 
@@ -87,6 +97,11 @@
 
 ;;; generating scheme code
 
+(define (generate-binding constant)
+  (format "(define ~a (lookup-shared-binding \"~a\"))~%"
+	  (constant-scheme-name constant)
+	  (constant-c-value-name constant)))
+
 (define (generate-finite-type-definition ft-name name-converter constants)
   (let ((predicate-name (string-append ft-name "-object?")) 
 	(elements-name (string-append ft-name "-elments"))