;;; -*- Mode: Scheme; scheme48-package: stubber-cpp-output -*-

;;;; Scheme48 Stubber
;;;; CPP Output

;;; This code is written by Taylor R. Campbell and placed in the Public
;;; Domain.  All warranties are disclaimed.

(define $cpp-indentation (make-fluid 0))

(define (with-cpp-indentation indentation item)
  (let ((write-output (output-item item)))
    (lambda (port)
      (let-fluid $cpp-indentation (+ indentation
                                     (fluid $cpp-indentation))
        (lambda ()
          (write-output port))))))

(define (cpp-prefix)
  (output-sequence
   "#"
   (lambda (port)
     (write-string (make-string (fluid $cpp-indentation)
                                #\space)
                   port))))

(define (cpp-item keyword . body)
  (output-line (cpp-prefix)
               keyword
               (if (null? body)
                   (output-nothing)
                   (output-list (cons #\space body)))))

(define (cpp-include filename)
  (cpp-item "include" (output-escaped-string filename)))

(define (cpp-system-include filename)
  (cpp-item "include" (output-sequence "<" filename ">")))

(define (cpp-define name value)
  (cpp-item "define" name #\space value))

(define (cpp-stringify datum)
  (output-sequence "#" datum))

(define (cpp-concatenate . data)
  (output-decorated-list "" " ## " "" data))

(define (cpp-error string)
  (cpp-item "error" (output-escaped-string string)))

(define (cpp-call macro arguments)
  (output-sequence macro " "
                   (output-decorated-list "(" ", " ")" arguments)))

(define (cpp-comment . contents)
  (output-decorated-list "/* " "" " */" contents))

;;;; CPP Conditional Combinators

(define $cpp-condition (make-fluid #f))

(define (with-cpp-condition condition item)
  (let ((write-item (output-item item)))
    (lambda (port)
      (let-fluid $cpp-condition condition
        (lambda ()
          (write-item port))))))

(define (cpp-condition)
  (lambda (port)
    ((fluid $cpp-condition) port)))

(define (cpp-expression item)
  (output-sequence "(" item ")"))

(define (cpp-ifdef macro . body)
  (output-sequence
   (cpp-item "ifdef" macro)
   (with-cpp-condition (cpp-defined? macro)
     (with-cpp-indentation 1 (output-list body)))
   (cpp-item "endif"
             (cpp-comment (cpp-expression (cpp-defined? macro))))))

(define (cpp-if condition . body)
  (output-sequence
   (cpp-item "if" (cpp-expression condition))
   (with-cpp-condition condition
     (with-cpp-indentation 1 (output-list body)))
   (cpp-item "endif" (cpp-comment condition))))

(define (cpp-else)
  (with-cpp-indentation -1
    (cpp-item "else" (cpp-comment (cpp-not (cpp-condition))))))

(define (cpp-elif condition)
  (with-cpp-indentation -1
    (cpp-item "elif" (cpp-expression condition))))

(define (cpp-eq? x y)
  (output-sequence (cpp-expression x) " == " (cpp-expression y)))

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

(define (cpp-not condition)
  (output-sequence "(! " (cpp-expression condition) ")"))

(define (cpp-conjunction nil-case operator)
  (lambda (conditions)
    (if (null? conditions)
        nil-case
        ;; We could do a cleaner job of handling the parentheses here,
        ;; if we had an elegant DECORATED-MAP->SEQUENCE or something.
        ;; But this is expedient.
        (output-decorated-list ""
                               operator
                               ""
                               (map cpp-expression conditions)))))

(define cpp-or  (cpp-conjunction 0 " || "))
(define cpp-and (cpp-conjunction 1 " && "))