;;; -*- Mode: Scheme -*-

;;;; C Stub Generator for Scheme
;;;; Formatting C Pre-Processor Junk

;;; 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-format (cpp-format:line-prefix)
  (format:sequence "#" (cpp-format:nesting)))

(define-format (cpp-format:line . formats)
  (format:line (cpp-format:line-prefix) (format:list formats)))

(define-format (cpp-format:with-keyword keyword . formats)
  (cpp-format:line keyword
                   (if (pair? formats)
                       (format:list (cons (format:non-breaking-space) formats))
                       (format:empty))))

(define-format (cpp-format:include pathname-format)
  (cpp-format:with-keyword "include" pathname-format))

(define-format (cpp-format:system-header pathname)
  (format:sequence "<" pathname ">"))

(define-format (cpp-format:local-header pathname)
  (format:sequence "\"" pathname "\""))

(define-format (cpp-format:define prototype . formats)
  (cpp-format:with-keyword "define"
    prototype
    (if (not (pair? formats))
        (format:empty)
        (cpp-format:with-backslash-line-breaks
          (format:with-indentation +2
            (format:join (format:soft-break)
                         (format:line-break)
                         (format:line-break)
                         formats))))))

(define-format (cpp-format:call-prototype name arguments)
  (cpp-format:with-no-line-breaks
    ;; Observe the absence of a space.
    (format:sequence name
                     (format:join "("
                                  (format:sequence "," (format:soft-break))
                                  ")"
                                  arguments))))

(define-format (cpp-format:stringify datum)
  (format:sequence "#" datum))

(define-format (cpp-format:concatenate datum . data)
  (format:join/infix (cpp-format:infix-operator "##") (cons datum data)))

(define-format (cpp-format:error string)
  (cpp-format:with-keyword "error" (cpp-format:error-string string)))

(define-format (cpp-format:call macro arguments)
  (format:sequence macro
                   (format:soft-break)
                   (cpp-format:parenthesis
                    (format:join/infix ", " arguments))))

(define-format (cpp-format:parenthesis expression)
  (format:sequence "(" (format:with-indentation +1 expression) ")"))

(define-format (cpp-format:comment . formats)
  (format:join "/* " "" " */" formats))

;;;; Conditionals

(define-format (cpp-format:with-condition condition format)
  (format:with-property 'CPP:CONDITION condition format))

(define-format (cpp-format:condition)
  (format:lookup-property 'CPP:CONDITION "{unknown cpp condition}"))

(define-format (cpp-format:if condition . body)
  (format:sequence
   (cpp-format:with-keyword "if" condition)
   (cpp-format:with-condition condition
     (cpp-format:with-nesting +1 (format:list body)))
   (cpp-format:with-keyword "endif" (cpp-format:comment condition))))

(define-format (cpp-format:ifdef macro . body)
  (let ((condition (cpp-format:defined? macro)))
    (format:sequence
     (cpp-format:with-keyword "ifdef" macro)
     (cpp-format:with-condition condition
       (cpp-format:with-nesting +1 (format:list body)))
     (cpp-format:with-keyword "endif" (cpp-format:comment condition)))))

(define-format (cpp-format:else)
  (cpp-format:with-nesting -1
    (cpp-format:with-keyword "else"
                             (cpp-format:comment
                              (cpp-format:not (cpp-format:condition))))))

(define-format (cpp-format:elif condition)
  (cpp-format:with-nesting -1
    (cpp-format:with-keyword "elif" condition)))

(define-format (cpp-format:== a b)
  (format:sequence (cpp-format:parenthesis a)
                   (cpp-format:infix-operator "==")
                   (cpp-format:parenthesis b)))

(define-format (cpp-format:defined? macro)
  (cpp-format:call "defined" (list macro)))

(define-format (cpp-format:not expression)
  (cpp-format:call "!" (list expression)))

(define-format (cpp-format:infix-reduction nullary-case operator conditions)
  (if (pair? conditions)
      (format:join/infix (cpp-format:infix-operator operator)
                         (map cpp-format:parenthesis conditions))
      nullary-case))

(define-format (cpp-format:or conditions)
  (cpp-format:infix-reduction "0" "||" conditions))

(define-format (cpp-format:and conditions)
  (cpp-format:infix-reduction "1" "&&" conditions))

(define-format (cpp-format:infix-operator string)
  (format:sequence (format:soft-break) string (format:soft-break)))

;;;; Miscellaneous Cruft

(define-format (cpp-format:nesting)
  (format:search-property 'CPP:NESTING
    (lambda (nesting)
      (make-string nesting #\space))
    (lambda () "")))

(define-format (cpp-format:with-nesting increment format)
  (format:with-modified-property 'CPP:NESTING 0 (lambda (n) (+ n increment))
    format))

(define-format (cpp-format:with-no-line-breaks format)
  (format:with-property 'LINE-BREAK-HANDLER
      (lambda (state)
        ((format-state/char-handler state) state #\space)
        state)
    format))

(define-format (cpp-format:with-backslash-line-breaks format)
  ;++ Actually do clever backslash cruft here.
  (cpp-format:with-no-line-breaks format))

(define-format (cpp-format:error-string string)
  (format:bracketed #\" #\"
    (format:call-with-output-port
      (lambda (output-port)
        (define (emit char) (write-char char output-port))
        (define (escape char) (emit #\\) (emit char))
        (loop ((for char (in-string string)))
          (cond ((char=? char #\\) (escape #\\))
                ((char=? char #\") (escape #\"))
                (else (emit char))))))))