+ export make-integer-constant, make-string-constant

+ added generate-binding
This commit is contained in:
eknauel 2004-01-08 07:47:22 +00:00
parent 7e51c85710
commit c7a73723dc
2 changed files with 20 additions and 1 deletions

View File

@ -10,13 +10,17 @@
constant-c-value-name constant-c-value-name
constant-type constant-type
make-integer-constant
make-string-constant
make-constant-from-c-name make-constant-from-c-name
make-constant-from-c-name-integer make-constant-from-c-name-integer
generate-c-declarations generate-c-declarations
generate-c-enter-values-function generate-c-enter-values-function
generate-c-gc-protect-globals-function generate-c-gc-protect-globals-function
generate-binding
generate-finite-type-definition generate-finite-type-definition
make-drop-common-prefix-name-converter)) make-drop-common-prefix-name-converter))

View File

@ -28,6 +28,16 @@
(define (constant-name->value-name constant-name) (define (constant-name->value-name constant-name)
(string-append c-value-name-prefix 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) (define (make-constant-from-c-name c-name type)
(let ((scheme-name (constant-name->scheme-name c-name))) (let ((scheme-name (constant-name->scheme-name c-name)))
(make-constant c-name scheme-name (make-constant c-name scheme-name
@ -87,6 +97,11 @@
;;; generating scheme code ;;; 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) (define (generate-finite-type-definition ft-name name-converter constants)
(let ((predicate-name (string-append ft-name "-object?")) (let ((predicate-name (string-append ft-name "-object?"))
(elements-name (string-append ft-name "-elments")) (elements-name (string-append ft-name "-elments"))