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)
(else
(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))
(define (next) (if (null? (cddr type)) (cadr type) (cdr type)))
(case (and (pair? type) (car type))
((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)
(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)
(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)
(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)
(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)
(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)
(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)
(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)
(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)
(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
(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-free? type) (vector-ref type 1))
(define (type-const? type) (vector-ref type 2))
(define (type-null? type) (vector-ref type 3))
(define (type-pointer? type) (vector-ref type 4))
(define (type-struct? type) (vector-ref type 5))
(define (type-link? type) (vector-ref type 6))
(define (type-result? type) (vector-ref type 7))
(define (type-array type) (vector-ref type 8))
(define (type-value type) (vector-ref type 9))
(define (type-default? type) (vector-ref type 10))
(define (type-index type) (vector-ref type 11))
(define (type-reference? type) (vector-ref type 5))
(define (type-struct? type) (vector-ref type 6))
(define (type-link? type) (vector-ref type 7))
(define (type-result? type) (vector-ref type 8))
(define (type-array type) (vector-ref type 9))
(define (type-value type) (vector-ref type 10))
(define (type-default? type) (vector-ref type 11))
(define (type-index type) (vector-ref type 12))
(define (type-auto-expand? type)
(and (pair? (type-array type))
@ -630,12 +633,15 @@
(for-each
(lambda (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))
(cat "*"))
(cat (if (type-auto-expand? x) "buf" "tmp") (type-index-string x))
(if (number? len)
(cat "[" len "]"))
(if (type-reference? x)
(cat " = NULL"))
(cat ";\n")
(if (or (vector? len) (type-auto-expand? x))
(cat " int len" (type-index x) ";\n"))
@ -710,6 +716,7 @@
(cat " tmp" (type-index a) "[i] = NULL;\n")))
((and (type-result? a) (not (basic-type? a))
(not (type-free? a)) ;;(not (type-pointer? a))
(not (type-reference? a))
(not (type-auto-expand? a))
(or (not (type-array a))
(not (integer? len))))
@ -741,7 +748,7 @@
=> (lambda (y) (cat "len" (type-index y))))
(else (write x)))))
((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)))