35 lines
832 B
Scheme
35 lines
832 B
Scheme
|
(define-interface ffi-tools-rts-interface
|
||
|
|
(export
|
||
|
|
(lookup-shared-value :syntax)
|
||
|
|
make-finite-type-import-function))
|
||
|
|
|
||
|
|
(define-structure ffi-tools-rts ffi-tools-rts-interface
|
||
|
|
(open scheme srfi-23 external-calls)
|
||
|
|
(begin
|
||
|
|
|
||
|
|
(define-syntax lookup-shared-value
|
||
|
|
(syntax-rules ()
|
||
|
|
((lookup-shared-value %s)
|
||
|
|
(shared-binding-ref
|
||
|
|
(lookup-imported-binding %s)))))
|
||
|
|
|
||
|
|
(define (make-finite-type-alist elements id-proc)
|
||
|
|
(map
|
||
|
|
(lambda (e) (cons (id-proc e) e))
|
||
|
|
(vector->list elements)))
|
||
|
|
|
||
|
|
(define (make-finite-type-import-function finite-type-name elements id-proc)
|
||
|
|
(let ((alist (make-finite-type-alist elements id-proc)))
|
||
|
|
(lambda (id)
|
||
|
|
(cond
|
||
|
|
((assoc id alist) => cdr)
|
||
|
|
(else
|
||
|
|
(error "Could not map value to finite type "
|
||
|
|
finite-type-name id))))))
|
||
|
|
|
||
|
|
))
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
|