(declare (block) (standard-bindings) (extended-bindings))
(begin
  (define-macro (define-guard guard defn)
    (if (eval `(cond-expand (,guard #t) (else #f)))
        '(begin)
        (begin (eval `(define-cond-expand-feature ,guard)) defn)))
  (define-macro (define-c-lambda id args ret #!optional (name #f))
    (let ((name (or name (symbol->string id))))
      `(define ,id (c-lambda ,args ,ret ,name))))
  (define-macro (define-const symbol)
    (let* ((str (symbol->string symbol))
           (ref (string-append "___return (" str ");")))
      `(define ,symbol ((c-lambda () int ,ref)))))
  (define-macro (define-const* symbol)
    (let* ((str (symbol->string symbol))
           (code (string-append
                  "#ifdef "
                  str
                  "\n"
                  "___return (___FIX ("
                  str
                  "));\n"
                  "#else \n"
                  "___return (___FAL);\n"
                  "#endif")))
      `(define ,symbol ((c-lambda () scheme-object ,code)))))
  (define-macro (define-with-errno symbol ffi-symbol args)
    `(define (,symbol ,@args)
       (declare (not interrupts-enabled))
       (let ((r (,ffi-symbol ,@args)))
         (if (##fx< r 0) (##fx- (##c-code "___RESULT = ___FIX (errno);")) r))))
  (define-macro (define-c-struct
                 struct
                 #!optional
                 (members '())
                 release-function)
    (let* ((struct-str (symbol->string struct))
           (struct-ptr (string->symbol (string-append struct-str "*")))
           (shallow-ptr
            (string->symbol (string-append struct-str "-shallow-ptr*")))
           (borrowed-ptr
            (string->symbol (string-append struct-str "-borrowed-ptr*")))
           (string-types
            '(char-string
              nonull-char-string
              UTF-8-string
              nonnull-UTF-8-string
              UTF-16-string
              nonnull-UTF16-string))
           (string-compat-required?
            (let loop ((m members))
              (cond ((null? m) #f)
                    ((member (cdr (car m)) string-types) #t)
                    (else (loop (cdr m))))))
           (string-setter-body
            (lambda (member-name)
              (let ((m (string-append "___arg1->" member-name)))
                (string-append
                 "if("
                 m
                 " == NULL)"
                 "\n"
                 m
                 "= strdup(___arg2);"
                 "\n"
                 "else if (strcmp("
                 m
                 ", ___arg2) != 0) {"
                 "\n"
                 "free("
                 m
                 ");"
                 "\n"
                 m
                 "= strdup(___arg2);"
                 "\n"
                 "}"
                 "\n"
                 "___return;"
                 "\n"))))
           (default-free-body
            (and string-compat-required?
                 (string-append
                  "___SCMOBJ "
                  struct-str
                  "_ffi_free (void *ptr) {"
                  "\n"
                  "struct "
                  struct-str
                  " *obj = (struct "
                  struct-str
                  "*) ptr;"
                  "\n"
                  (apply string-append
                         (map (lambda (m)
                                (cond ((memq (cdr m) string-types)
                                       (let ((mem-name
                                              (symbol->string (car m))))
                                         (string-append
                                          "if(obj->"
                                          mem-name
                                          ") "
                                          "free(obj->"
                                          mem-name
                                          ");"
                                          "\n")))
                                      (else "")))
                              members))
                  "free(obj);"
                  "\n"
                  "return ___FIX (___NO_ERR);"
                  "\n"
                  "}")))
           (release-function
            (or release-function
                (if string-compat-required?
                    (string-append struct-str "_ffi_free")
                    "ffi_free")))
           (string-compat-types
            (if string-compat-required?
                `((c-declare ,default-free-body)
                  (c-define-type
                   ,shallow-ptr
                   (pointer ,struct (,struct-ptr) "ffi_free")))
                '())))
      `(begin
         (c-define-type ,struct (struct ,struct-str))
         (c-define-type
          ,struct-ptr
          (pointer ,struct (,struct-ptr) ,release-function))
         (c-define-type ,borrowed-ptr (pointer ,struct (,struct-ptr)))
         ,@string-compat-types
         (define ,(string->symbol (string-append struct-str "-ptr?"))
           (lambda (obj)
             (and (foreign? obj) (equal? (foreign-tags obj) '(,struct-ptr)))))
         ,@(apply append
                  (map (lambda (m)
                         (let* ((member-name (symbol->string (car m)))
                                (member-type (cdr m))
                                (getter-name
                                 (string-append struct-str "-" member-name))
                                (setter-body
                                 (cond ((member member-type string-types)
                                        (string-setter-body member-name))
                                       (else
                                        (string-append
                                         "___arg1->"
                                         member-name
                                         " = ___arg2;"
                                         "\n"
                                         "___return;"
                                         "\n")))))
                           `((define ,(string->symbol getter-name)
                               (c-lambda
                                (,struct-ptr)
                                ,member-type
                                ,(string-append
                                  "___return(___arg1->"
                                  member-name
                                  ");")))
                             (define ,(string->symbol
                                       (string-append getter-name "-set!"))
                               (c-lambda
                                (,struct-ptr ,member-type)
                                void
                                ,setter-body)))))
                       members))
         (define ,(string->symbol (string-append "malloc-" struct-str))
           (c-lambda
            ()
            ,struct-ptr
            ,(string-append
              "struct "
              struct-str
              "* var = (struct "
              struct-str
              " *) malloc(sizeof(struct "
              struct-str
              "));"
              "\n"
              "if (var == NULL)"
              "\n"
              "    ___return (NULL);"
              "\n"
              "memset(var, 0, sizeof(struct "
              struct-str
              "));"
              "___return(var);")))
         (define ,(string->symbol (string-append "ptr->" struct-str))
           (c-lambda (,struct-ptr) ,struct "___return(*___arg1);"))
         (define ,(string->symbol
                   (string-append "malloc-" struct-str "-array"))
           (c-lambda
            (unsigned-int32)
            ,(if string-compat-required? shallow-ptr struct-ptr)
            ,(string-append
              "struct "
              struct-str
              " *arr_var=(struct "
              struct-str
              " *) malloc(___arg1*sizeof(struct "
              struct-str
              "));"
              "\n"
              "if (arr_var == NULL)"
              "\n"
              "    ___return (NULL);"
              "\n"
              "memset(arr_var, 0, ___arg1*sizeof(struct "
              struct-str
              "));"
              "\n"
              "___return(arr_var);")))
         (define ,(string->symbol (string-append struct-str "-array-ref"))
           (c-lambda
            (,struct-ptr unsigned-int32)
            ,borrowed-ptr
            "___return (___arg1 + ___arg2);"))
         (define ,(string->symbol (string-append struct-str "-array-set!"))
           (c-lambda
            (,struct-ptr unsigned-int32 ,struct-ptr)
            void
            "*(___arg1 + ___arg2) = *___arg3; ___return;")))))
  (c-declare "#include <stdlib.h>")
  (c-declare "#include <string.h>")
  (c-declare "#include <errno.h>")
  (c-declare "static ___SCMOBJ ffi_free (void *ptr);")
  (c-declare
   "#ifndef ___HAVE_FFI_U8VECTOR\n#define ___HAVE_FFI_U8VECTOR\n#define U8_DATA(obj) ___CAST (___U8*, ___BODY_AS (obj, ___tSUBTYPED))\n#define U8_LEN(obj) ___HD_BYTES (___HEADER (obj))\n#endif")
  (namespace
   ("std/foreign-test#"
    g
    bar-j-set!
    bar-j
    bar-i-set!
    bar-i
    bar-ptr?
    ptr->bar
    bar-array-set!
    bar-array-ref
    malloc-bar-array
    malloc-bar
    foo-str-set!
    foo-str
    foo-d2-set!
    foo-d2
    foo-a1-set!
    foo-a1
    foo-ptr?
    ptr->foo
    foo-array-set!
    foo-array-ref
    malloc-foo-array
    malloc-foo
    abc-b-set!
    abc-b
    abc-a-set!
    abc-a
    abc-ptr?
    ptr->abc
    abc-array-set!
    abc-array-ref
    malloc-abc-array
    malloc-abc
    f))
  (c-declare
   "\nstruct abc {\n    char* a;\n    char* b;\n    char* c;\n};\nstruct d { int e;};\n\nstruct foo {\n    struct abc* a1;\n    struct abc* d2;\n    char* str;\n};\n\nstruct bar {\nint i;\nint j;\n};\n")
  (c-define-type d (struct "d"))
  (define-c-lambda f () int "___return(2);")
  (define-c-lambda g () int "___return(2);")
  (define-c-struct abc ((a . char-string) (b . char-string)))
  (define-c-struct foo ((a1 . abc*) (d2 . abc*) (str . char-string)))
  (define-c-struct bar ((i . int) (j . int)))
  (c-declare
   "#ifndef ___HAVE_FFI_FREE\n#define ___HAVE_FFI_FREE\n___SCMOBJ ffi_free (void *ptr)\n{\n free (ptr);\n return ___FIX (___NO_ERR);\n}\n#endif")
  (define std/foreign-test#foreign-test
    (std/test#make-test-suite
     '"test :std/foreign"
     (lambda ()
       (letrec* ((_test-str1401_ '"hello")
                 (_test-str2402_ '"world")
                 (_make-abc403_
                  (lambda (_a472_ _b473_)
                    (let ((_o475_ (std/foreign-test#malloc-abc)))
                      (std/foreign-test#abc-a-set! _o475_ _a472_)
                      (std/foreign-test#abc-b-set! _o475_ _b473_)
                      _o475_))))
         (std/test#run-test-case!
          '"c struct"
          (lambda ()
            (letrec* ((_obj406_ (std/foreign-test#malloc-abc)))
              (std/foreign-test#abc-a-set! _obj406_ _test-str1401_)
              (std/foreign-test#abc-b-set! _obj406_ _test-str2402_)
              (let ((_val408_ _test-str1401_))
                (std/test#verbose
                 '"... check ~a is ~a to ~s~n"
                 '(abc-a obj)
                 'equal?
                 _val408_)
                (std/test#test-check-e
                 '(check equal? (abc-a obj) test-str1)
                 std/test#equal-values?
                 (lambda () (std/foreign-test#abc-a _obj406_))
                 _val408_
                 '"\"foreign-test.ss\"@62.33"))
              (let ((_val412_ _test-str2402_))
                (std/test#verbose
                 '"... check ~a is ~a to ~s~n"
                 '(abc-b obj)
                 'equal?
                 _val412_)
                (std/test#test-check-e
                 '(check equal? (abc-b obj) test-str2)
                 std/test#equal-values?
                 (lambda () (std/foreign-test#abc-b _obj406_))
                 _val412_
                 '"\"foreign-test.ss\"@63.33"))
              (let ((_val416_ '#t))
                (std/test#verbose
                 '"... check ~a is ~a to ~s~n"
                 '(abc-ptr? obj)
                 'equal?
                 _val416_)
                (std/test#test-check-e
                 '(check equal? (abc-ptr? obj) #t)
                 std/test#equal-values?
                 (lambda () (std/foreign-test#abc-ptr? _obj406_))
                 _val416_
                 '"\"foreign-test.ss\"@65.33")))))
         (std/test#run-test-case!
          '"c struct array"
          (lambda ()
            (letrec* ((_obj-array421_ (std/foreign-test#malloc-abc-array '2))
                      (_obj1422_ (std/foreign-test#malloc-abc))
                      (_g4113_ (let ((_g4114_ (std/foreign-test#abc-a-set!
                                               _obj1422_
                                               _test-str1401_)))
                                 #!void
                                 _g4114_))
                      (_obj2423_ (std/foreign-test#malloc-abc)))
              (begin
                (std/foreign-test#abc-a-set! _obj2423_ _test-str2402_)
                (std/foreign-test#abc-array-set! _obj-array421_ '0 _obj1422_)
                (std/foreign-test#abc-array-set! _obj-array421_ '1 _obj2423_)
                (let ((_val425_ _test-str1401_))
                  (std/test#verbose
                   '"... check ~a is ~a to ~s~n"
                   '(abc-a (abc-array-ref obj-array 0))
                   'equal?
                   _val425_)
                  (std/test#test-check-e
                   '(check equal?
                           (abc-a (abc-array-ref obj-array 0))
                           test-str1)
                   std/test#equal-values?
                   (lambda ()
                     (std/foreign-test#abc-a
                      (std/foreign-test#abc-array-ref _obj-array421_ '0)))
                   _val425_
                   '"\"foreign-test.ss\"@80.33"))
                (let ((_val429_ _test-str2402_))
                  (std/test#verbose
                   '"... check ~a is ~a to ~s~n"
                   '(abc-a (abc-array-ref obj-array 1))
                   'equal?
                   _val429_)
                  (std/test#test-check-e
                   '(check equal?
                           (abc-a (abc-array-ref obj-array 1))
                           test-str2)
                   std/test#equal-values?
                   (lambda ()
                     (std/foreign-test#abc-a
                      (std/foreign-test#abc-array-ref _obj-array421_ '1)))
                   _val429_
                   '"\"foreign-test.ss\"@81.33"))))))
         (std/test#run-test-case!
          '"c int struct array"
          (lambda ()
            (letrec* ((_y434_ (std/foreign-test#malloc-bar))
                      (_g4116_ (let ((_g4117_ (std/foreign-test#bar-i-set!
                                               _y434_
                                               '123)))
                                 #!void
                                 _g4117_))
                      (_g4119_ (let ((_g4120_ (std/foreign-test#bar-j-set!
                                               _y434_
                                               '456)))
                                 #!void
                                 _g4120_))
                      (_y2435_ (std/foreign-test#malloc-bar))
                      (_g4122_ (let ((_g4123_ (std/foreign-test#bar-i-set!
                                               _y2435_
                                               '320)))
                                 #!void
                                 _g4123_))
                      (_g4125_ (let ((_g4126_ (std/foreign-test#bar-j-set!
                                               _y2435_
                                               '328)))
                                 #!void
                                 _g4126_))
                      (_k436_ (std/foreign-test#malloc-bar-array '2)))
              (begin
                (std/foreign-test#bar-array-set! _k436_ '0 _y434_)
                (std/foreign-test#bar-array-set! _k436_ '1 _y2435_)
                (let ((_val438_ '320))
                  (std/test#verbose
                   '"... check ~a is ~a to ~s~n"
                   '(bar-i (bar-array-ref k 1))
                   'equal?
                   _val438_)
                  (std/test#test-check-e
                   '(check equal? (bar-i (bar-array-ref k 1)) 320)
                   std/test#equal-values?
                   (lambda ()
                     (std/foreign-test#bar-i
                      (std/foreign-test#bar-array-ref _k436_ '1)))
                   _val438_
                   '"\"foreign-test.ss\"@96.33"))))))
         (std/test#run-test-case!
          '"modifying c strings"
          (lambda ()
            (letrec* ((_obj1443_ (std/foreign-test#malloc-abc))
                      (_t3444_ (string-append _test-str1401_ _test-str2402_))
                      (_t4445_ (string-append _test-str1401_ '" test")))
              (std/foreign-test#abc-a-set! _obj1443_ _test-str1401_)
              (std/foreign-test#abc-b-set! _obj1443_ _test-str2402_)
              (std/foreign-test#abc-a-set! _obj1443_ _t3444_)
              (std/foreign-test#abc-b-set! _obj1443_ _t4445_)
              (let ((_val447_ _t3444_))
                (std/test#verbose
                 '"... check ~a is ~a to ~s~n"
                 '(abc-a obj1)
                 'equal?
                 _val447_)
                (std/test#test-check-e
                 '(check equal? (abc-a obj1) t3)
                 std/test#equal-values?
                 (lambda () (std/foreign-test#abc-a _obj1443_))
                 _val447_
                 '"\"foreign-test.ss\"@109.33"))
              (let ((_val451_ _t4445_))
                (std/test#verbose
                 '"... check ~a is ~a to ~s~n"
                 '(abc-b obj1)
                 'equal?
                 _val451_)
                (std/test#test-check-e
                 '(check equal? (abc-b obj1) t4)
                 std/test#equal-values?
                 (lambda () (std/foreign-test#abc-b _obj1443_))
                 _val451_
                 '"\"foreign-test.ss\"@110.33")))))
         (std/test#run-test-case!
          '"nested structs"
          (lambda ()
            (letrec* ((_foo-arr456_ (std/foreign-test#malloc-foo-array '2))
                      (_obj1457_ (_make-abc403_ _test-str1401_ _test-str2402_))
                      (_obj2458_ (_make-abc403_ _test-str2402_ _test-str1401_))
                      (_t5459_ '"here we go")
                      (_t6460_ '"but not")
                      (_foo1461_ (std/foreign-test#malloc-foo))
                      (_g4128_ (let ((_g4129_ (std/foreign-test#foo-a1-set!
                                               _foo1461_
                                               _obj1457_)))
                                 #!void
                                 _g4129_))
                      (_g4131_ (let ((_g4132_ (std/foreign-test#foo-d2-set!
                                               _foo1461_
                                               _obj2458_)))
                                 #!void
                                 _g4132_))
                      (_g4134_ (let ((_g4135_ (std/foreign-test#foo-str-set!
                                               _foo1461_
                                               _t5459_)))
                                 #!void
                                 _g4135_))
                      (_foo2462_ (std/foreign-test#malloc-foo)))
              (begin
                (std/foreign-test#foo-a1-set! _foo2462_ _obj2458_)
                (std/foreign-test#foo-d2-set! _foo2462_ _obj1457_)
                (std/foreign-test#foo-str-set! _foo2462_ _t6460_)
                (std/foreign-test#foo-array-set! _foo-arr456_ '0 _foo1461_)
                (std/foreign-test#foo-array-set! _foo-arr456_ '1 _foo2462_)
                (let ((_val464_ _t5459_))
                  (std/test#verbose
                   '"... check ~a is ~a to ~s~n"
                   '(foo-str (foo-array-ref foo-arr 0))
                   'equal?
                   _val464_)
                  (std/test#test-check-e
                   '(check equal? (foo-str (foo-array-ref foo-arr 0)) t5)
                   std/test#equal-values?
                   (lambda ()
                     (std/foreign-test#foo-str
                      (std/foreign-test#foo-array-ref _foo-arr456_ '0)))
                   _val464_
                   '"\"foreign-test.ss\"@134.33"))
                (let ((_val468_ _t6460_))
                  (std/test#verbose
                   '"... check ~a is ~a to ~s~n"
                   '(foo-str (foo-array-ref foo-arr 1))
                   'equal?
                   _val468_)
                  (std/test#test-check-e
                   '(check equal? (foo-str (foo-array-ref foo-arr 1)) t6)
                   std/test#equal-values?
                   (lambda ()
                     (std/foreign-test#foo-str
                      (std/foreign-test#foo-array-ref _foo-arr456_ '1)))
                   _val468_
                   '"\"foreign-test.ss\"@135.33")))))))))))
