;;; -*- Mode: Scheme; scheme48-package: (config) -*-

;;;; C Stub Generator for Scheme
;;;; Scheme48 Package Definitions

;;; Copyright (c) 2009, Taylor R. Campbell
;;;
;;; Redistribution and use in source and binary forms, with or without
;;; modification, are permitted provided that the following conditions
;;; are met:
;;;
;;; * Redistributions of source code must retain the above copyright
;;;   notice, this list of conditions and the following disclaimer.
;;;
;;; * Redistributions in binary form must reproduce the above copyright
;;;   notice, this list of conditions and the following disclaimer in
;;;   the documentation and/or other materials provided with the
;;;   distribution.
;;;
;;; * Neither the names of the authors nor the names of contributors
;;;   may be used to endorse or promote products derived from this
;;;   software without specific prior written permission.
;;;
;;; THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS
;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
;;; ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY
;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

(define-structures ((stubber-syntax stubber-syntax-interface)
                    (stubber-records-syntax stubber-records-syntax-interface)
                    (stubber-callback-syntax stubber-callback-syntax-interface)
                    (stubber-enumerations-syntax
                     stubber-enumerations-syntax-interface))
  (open scheme
        define-record-types
        srfi-23                         ;error
        pp
        byte-vectors
        external-calls
        syntactic-module-locals
        finite-types
        finalization
        load-dynamic-externals
        filenames
        )
  (for-syntax
   (open scheme
         code-quote
         meta-names
         foof-loop
         nested-foof-loop
         stubber-code-generation
         stubber-c-format
         signals
         desyntaxification
         ))
  (files s48-syntax s48-callback-syntax s48-record-syntax))

;++ Argh.

(define-structure desyntaxification (export desyntaxify)
  (open scheme
        receiving
        handle
        simple-conditions
        (modify names (rename (desyntaxify %desyntaxify)))
        )
  (begin
    (define (desyntaxify form)
      (with-handler (lambda (condition propagate)
                      (receive (type stuff) (decode-condition condition)
                        (if (not (and (eq? 'WARNING type)
                                      (equal? "invalid datum in quotation"
                                              (car stuff))))
                            (propagate))))
        (lambda ()
          (%desyntaxify form))))))

(define-structure stubber-unix-syntax stubber-unix-syntax-interface
  (open scheme
        stubber-syntax
        )
  (for-syntax
   (open scheme
         stubber-c-format
         stubber-code-generation
         stubber-unix-code-generation
         ))
  (files unix-syntax))

;; (define-structure stubber-callback-syntax stubber-callback-syntax-interface
;;   (open scheme
;;         stubber-syntax
;;         )
;;   (for-syntax
;;    (open scheme
;;          stubber-c-format
;;          stubber-code-generation
;;          stubber-callback-code-generation
;;          ))
;;   (files s48-callback-syntax))

;; (define-structure stubber-records-syntax stubber-records-syntax-interface
;;   (open scheme
;;         stubber-syntax
;;         )
;;   (for-syntax
;;    (open scheme
;;          stubber-c-format
;;          stubber-code-generation
;;          stubber-records-code-generation
;;          ))
;;   (files s48-record-syntax))

(define-structure finalization finalization-interface
  (open scheme
        receiving
        srfi-9                          ;define-record-type
        srfi-23                         ;error
        (subset big-util (no-op))
        weak
        interrupts
        )
  (optimize auto-integrate)
  (files s48-finalize))

(define-structure stubber-code-generation stubber-code-generation-interface
  (open scheme
        srfi-1                          ;List Library
        srfi-9                          ;define-record-type
        srfi-23                         ;error
        filenames
        running-programs
        foof-loop
        nested-foof-loop
        format-combinators
        format-driver
        format-state
        stubber-c-format
        stubber-cpp-format
        )
  (files s48-codegen s48-callback-codegen s48-record-codegen))

(define-structure running-programs (export run-program)
  (open scheme posix interrupts srfi-23 display-conditions handle)
  (files s48-run-program))

(define-structure stubber-unix-code-generation
    stubber-unix-code-generation-interface
  (open scheme
        format-combinators
        stubber-c-format
        stubber-cpp-format
        stubber-code-generation
        )
  (files unix-codegen))

;; (define-structure stubber-callback-code-generation
;;     stubber-callback-code-generation-interface
;;   (open scheme
;;         foof-loop
;;         nested-foof-loop
;;         format-combinators
;;         stubber-c-format
;;         stubber-code-generation
;;         )
;;   (files s48-callback-codegen))

;; (define-structure stubber-records-code-generation
;;     stubber-records-code-generation-interface
;;   (open scheme
;;         foof-loop
;;         nested-foof-loop
;;         format-combinators
;;         stubber-c-format
;;         stubber-code-generation
;;         )
;;   (files s48-record-codegen))

(define-structure stubber-c-format stubber-c-format-interface
  (open scheme
        format-combinators
        format-driver
        format-state
        )
  (optimize auto-integrate)
  (files c))

(define-structure stubber-cpp-format stubber-cpp-format-interface
  (open scheme
        format-combinators
        format-driver
        format-state
        foof-loop
        )
  (optimize auto-integrate)
  (files cpp))

;;;; Syntactic Craziness

(define-structure meta-names meta-names-interface
  (open scheme code-quote)
  (files meta-names))

(define-structure syntactic-module-locals syntactic-module-locals-interface
  (open scheme)
  (for-syntax (open scheme meta-names signals code-quote))
  (files module-local))