Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-07-07 13:16:36 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

adding reference types to ffi

Browse source
This commit is contained in:
Alex Shinn 2011-04-08 00:27:58 +09:00
parent 13cf6d24d5
commit 4b6884e4a5
1 changed files with 28 additions and 21 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

49
tools/chibi-ffi
View file

@ -42,45 +42,48 @@
type) type)
(else (else
(let lp ((type type) (free? #f) (const? #f) (null-ptr? #f) (let lp ((type type) (free? #f) (const? #f) (null-ptr? #f)
(ptr? #f) (struct? #f) (link? #f) (result? #f) (array #f) (ptr? #f) (ref? #f) (struct? #f) (link? #f) (result? #f) (array #f)
(value #f) (default? #f)) (value #f) (default? #f))
(define (next) (if (null? (cddr type)) (cadr type) (cdr type))) (define (next) (if (null? (cddr type)) (cadr type) (cdr type)))
(case (and (pair? type) (car type)) (case (and (pair? type) (car type))
((free) ((free)
(lp (next) #t const? null-ptr? ptr? struct? link? result? array value default?)) (lp (next) #t const? null-ptr? ptr? ref? struct? link? result? array value default?))
((const) ((const)
(lp (next) free? #t null-ptr? ptr? struct? link? result? array value default?)) (lp (next) free? #t null-ptr? ptr? ref? struct? link? result? array value default?))
((maybe-null) ((maybe-null)
(lp (next) free? const? #t ptr? struct? link? result? array value default?)) (lp (next) free? const? #t ptr? ref? struct? link? result? array value default?))
((pointer) ((pointer)
(lp (next) free? const? null-ptr? #t struct? link? result? array value default?)) (lp (next) free? const? null-ptr? #t ref? struct? link? result? array value default?))
((reference)
(lp (next) free? const? null-ptr? ptr? #t struct? link? result? array value default?))
((struct) ((struct)
(lp (next) free? const? null-ptr? ptr? #t link? result? array value default?)) (lp (next) free? const? null-ptr? ptr? ref? #t link? result? array value default?))
((link) ((link)
(lp (next) free? const? null-ptr? ptr? struct? #t result? array value default?)) (lp (next) free? const? null-ptr? ptr? ref? struct? #t result? array value default?))
((result) ((result)
(lp (next) free? const? null-ptr? ptr? struct? link? #t array value default?)) (lp (next) free? const? null-ptr? ptr? ref? struct? link? #t array value default?))
((array) ((array)
(lp (cadr type) free? const? null-ptr? ptr? struct? link? result? (if (pair? (cddr type)) (caddr type) #t) value default?)) (lp (cadr type) free? const? null-ptr? ref? ptr? struct? link? result? (if (pair? (cddr type)) (caddr type) #t) value default?))
((value) ((value)
(lp (cddr type) free? const? null-ptr? ptr? struct? link? result? array (cadr type) default?)) (lp (cddr type) free? const? null-ptr? ref? ptr? struct? link? result? array (cadr type) default?))
((default) ((default)
(lp (cddr type) free? const? null-ptr? ptr? struct? link? result? array (cadr type) #t)) (lp (cddr type) free? const? null-ptr? ref? ptr? struct? link? result? array (cadr type) #t))
(else (else
(vector (if (and (pair? type) (null? (cdr type))) (car type) type) free? const? null-ptr? ptr? struct? link? result? array value default? (and (pair? o) (car o))))))))) (vector (if (and (pair? type) (null? (cdr type))) (car type) type) free? const? null-ptr? ptr? ref? struct? link? result? array value default? (and (pair? o) (car o)))))))))
(define (type-base type) (vector-ref type 0)) (define (type-base type) (vector-ref type 0))
(define (type-free? type) (vector-ref type 1)) (define (type-free? type) (vector-ref type 1))
(define (type-const? type) (vector-ref type 2)) (define (type-const? type) (vector-ref type 2))
(define (type-null? type) (vector-ref type 3)) (define (type-null? type) (vector-ref type 3))
(define (type-pointer? type) (vector-ref type 4)) (define (type-pointer? type) (vector-ref type 4))
(define (type-struct? type) (vector-ref type 5)) (define (type-reference? type) (vector-ref type 5))
(define (type-link? type) (vector-ref type 6)) (define (type-struct? type) (vector-ref type 6))
(define (type-result? type) (vector-ref type 7)) (define (type-link? type) (vector-ref type 7))
(define (type-array type) (vector-ref type 8)) (define (type-result? type) (vector-ref type 8))
(define (type-value type) (vector-ref type 9)) (define (type-array type) (vector-ref type 9))
(define (type-default? type) (vector-ref type 10)) (define (type-value type) (vector-ref type 10))
(define (type-index type) (vector-ref type 11)) (define (type-default? type) (vector-ref type 11))
(define (type-index type) (vector-ref type 12))
(define (type-auto-expand? type) (define (type-auto-expand? type)
(and (pair? (type-array type)) (and (pair? (type-array type))
@ -630,12 +633,15 @@
(for-each (for-each
(lambda (x) (lambda (x)
(let ((len (get-array-length func x))) (let ((len (get-array-length func x)))
(cat " " (type-c-name (type-base x)) " ") (cat " " (if (type-const? x) "const " "")
(type-c-name (type-base x)) " ")
(if (or (and (type-array x) (not (number? len))) (type-pointer? x)) (if (or (and (type-array x) (not (number? len))) (type-pointer? x))
(cat "*")) (cat "*"))
(cat (if (type-auto-expand? x) "buf" "tmp") (type-index-string x)) (cat (if (type-auto-expand? x) "buf" "tmp") (type-index-string x))
(if (number? len) (if (number? len)
(cat "[" len "]")) (cat "[" len "]"))
(if (type-reference? x)
(cat " = NULL"))
(cat ";\n") (cat ";\n")
(if (or (vector? len) (type-auto-expand? x)) (if (or (vector? len) (type-auto-expand? x))
(cat " int len" (type-index x) ";\n")) (cat " int len" (type-index x) ";\n"))
@ -710,6 +716,7 @@
(cat " tmp" (type-index a) "[i] = NULL;\n"))) (cat " tmp" (type-index a) "[i] = NULL;\n")))
((and (type-result? a) (not (basic-type? a)) ((and (type-result? a) (not (basic-type? a))
(not (type-free? a)) ;;(not (type-pointer? a)) (not (type-free? a)) ;;(not (type-pointer? a))
(not (type-reference? a))
(not (type-auto-expand? a)) (not (type-auto-expand? a))
(or (not (type-array a)) (or (not (type-array a))
(not (integer? len)))) (not (integer? len))))
@ -741,7 +748,7 @@
=> (lambda (y) (cat "len" (type-index y)))) => (lambda (y) (cat "len" (type-index y))))
(else (write x))))) (else (write x)))))
((or (type-result? arg) (type-array arg)) ((or (type-result? arg) (type-array arg))
(cat (if (or (type-free? arg) (basic-type? arg)) ;; (type-pointer? arg) (cat (if (or (type-free? arg) (type-reference? arg) (basic-type? arg))
"&" "&"
"") "")
"tmp" (type-index arg))) "tmp" (type-index arg)))