X-Git-Url: https://git.jsancho.org/?a=blobdiff_plain;f=src%2Flow-level.scm;h=d604789712e14939ca66c66fa64c3a1cb4baf6b3;hb=0c88b5e31475e07d0d06ae9af01ad05a0efdc875;hp=53bb39eb4d83906996191061a09dc729fc9f573d;hpb=cc3b67814bd3d1d26e1d1d5523db7bf19384bf33;p=guile-assimp.git diff --git a/src/low-level.scm b/src/low-level.scm index 53bb39e..d604789 100644 --- a/src/low-level.scm +++ b/src/low-level.scm @@ -111,12 +111,12 @@ (cond ((= (pointer-address root) 0) '()) (else - (let loop ((i 0)) - (cond ((= i size) - '()) - (else - (cons (element-proc root (* element-size i)) - (loop (+ i 1))))))))) + (reverse + (let loop ((i 0) (res '())) + (cond ((= i size) + res) + (else + (loop (+ i 1) (cons (element-proc root (* element-size i)) res))))))))) (define (get-element-address root-pointer offset) (make-pointer (+ (pointer-address root-pointer) offset))) @@ -153,3 +153,18 @@ get-element-address sized-string wrap) + + +;;; Function Mappers + +(define-syntax define-foreign-function + (lambda (x) + (syntax-case x (->) + ((_ ((foreign-lib name) arg-type ...) -> return-type) + (with-syntax ((name-string (datum->syntax x (symbol->string (syntax->datum #'name))))) + #'(define name + (pointer->procedure return-type + (dynamic-func name-string foreign-lib) + (list arg-type ...)))))))) + +(export-syntax define-foreign-function)