lang.ss
#lang scheme
(require scheme/foreign
         "lang-api.ss"
         "c-loader.ss"
         (for-syntax scheme
                     scribble/text/output
                     scheme/private/at-syntax
                     (planet cce/scheme:4:1/planet)))
(unsafe!)

(define-syntax (c stx)
  (syntax-case stx ()
    [(_ c-str ...)
     (set-box! 
      c-strs 
      (append (unbox c-strs)
              (at-syntax #'(list "\n" c-str ... "\n"))))
     (syntax/loc stx
       (void))]))
(define-syntax (cflags stx)
  (syntax-case stx ()
    [(_ c-str ...)
     (set-box! 
      c-flags-strs 
      (append (unbox c-flags-strs)
              (at-syntax #'(list " " c-str ... " "))))
     (syntax/loc stx
       (void))]))
(define-syntax (ldflags stx)
  (syntax-case stx ()
    [(_ c-str ...)
     (set-box! 
      ld-flags-strs 
      (append (unbox ld-flags-strs)
              (at-syntax #'(list " " c-str ... " "))))
     (syntax/loc stx
       (void))]))

(define this-lib-b (box #f))

(define-syntax-rule (get-ffi-obj-from-this sym e ...)
  (get-ffi-obj sym (unbox this-lib-b) e ...))

(define-for-syntax (output-to-string l)
  (with-output-to-string (lambda () (output l))))

(define-syntax (module-begin stx)
  (syntax-case stx ()
    [(_ e ...)
     (with-syntax 
         ([(pmb body ...)
           (local-expand (quasisyntax/loc stx
                           (#%module-begin (require (planet #,(this-package-version-symbol lang-api)))
                                           e ...))
                         'module-begin 
                         empty)])
       (quasisyntax/loc stx
         (#%module-begin
          (c-loader this-lib-b
                    #,(output-to-string (unbox c-flags-strs))
                    #,(output-to-string (unbox ld-flags-strs))
                    #,(output-to-string (unbox c-strs)))
          body ...)))]))

(provide c
         cflags
         ldflags
         get-ffi-obj-from-this
         (rename-out [module-begin #%module-begin])
         (except-out (all-from-out scheme)
                     #%module-begin)
         (all-from-out scheme/foreign))