Skip to content

Instantly share code, notes, and snippets.

@shakdwipeea
Created September 12, 2019 09:59
Show Gist options
  • Save shakdwipeea/4de4710ec76d63f596873c867991c2a2 to your computer and use it in GitHub Desktop.
Save shakdwipeea/4de4710ec76d63f596873c867991c2a2 to your computer and use it in GitHub Desktop.
ffi macros
(import :std/foreign)
(import (for-syntax :play/stxutil))
(export #t)
(begin-ffi ()
(c-declare "#include<string.h>"))
(defsyntax (access stx)
(syntax-case stx ()
((_ type)
(with-syntax ((type** (format-id #'type "~a**" (stx-e #'type)))
(malloc! (format-id #'type "malloc-~a**" (stx-e #'type)))
(set! (format-id #'type "set-~a**" (stx-e #'type)))
(get (format-id #'type "get-~a**" (stx-e #'type))))
#'(begin-ffi (type**
malloc!
set!
get)
(c-define-type type** (pointer type))
(define-c-lambda malloc! (int) type**
"___return (malloc(___arg1 * sizeof(char*)));")
(define-c-lambda set! (type** int type) void
"*(___arg1 + ___arg2) = strdup(___arg3);
___return;")
(define-c-lambda get (type** int) type
"___return (*(___arg1 + ___arg2));"))))))
(access char-string)
(define (main . args)
(define a (malloc-char-string** 2))
(set-char-string** a 0 "abcd")
(set-char-string** a 1 "def")
(displayln (get-char-string** a 0))
(displayln (get-char-string** a 1)))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment