;;; -*- Mode: Scheme; scheme48-package: c-output -*-

;;;; C Output Combinators

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

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

(define (with-c-indentation indentation item)
  (let ((item (item->output-procedure item)))
    (lambda (port)
      (let-fluid $c-indentation (+ indentation (fluid $c-indentation))
        (lambda ()
          (item port))))))

(define (c-indentation)
  (lambda (port)
    (write-string (make-string (fluid $c-indentation)
                               #\space)
                  port)))

(define (c-comment . contents)
  (decorated-list-sequence "/* " "" " */" contents))

(define (c-parenthesize item)
  (sequence "(" (with-c-indentation 1 item) ")"))

(define (c-line . contents)
  (line (c-indentation) (list-sequence contents)))

(define (c-block . body)
  (sequence (c-line "{")
            (with-c-indentation 2 (list-sequence body))
            (c-line "}")))

(define (c-function return-type name parameters . body)
  (sequence (c-line return-type)
            (c-line name
                    (decorated-list-sequence "(" ", " ")" parameters))
            (c-block (list-sequence body))))

(define (c-label name)                  ;Assumes some indentation
  (with-c-indentation -1 (c-line name ":")))

(define (c-statement statement)
  (c-line statement ";"))

(define (c-return value)
  (c-statement (sequence "return " (c-parenthesize value))))

(define (c-goto label)
  (c-statement (sequence "goto " label)))

;;; Simplified C-IF for our purposes.

(define (c-if condition consequent alternative)
  (sequence (c-line "if " (c-parenthesize condition))
            (with-c-indentation 2 consequent)
            (c-line "else")
            (with-c-indentation 2 alternative)))

(define (c-call-statement function arguments)
  (c-statement (c-call-expression function arguments)))

(define (c-call function arguments)
  (c-parenthesize (c-call-expression function arguments)))

(define (c-call-expression function arguments)
  (sequence function
            " "                    ; Add 2: space & paren.
            (with-c-indentation (+ 2 (string-length function))
              (decorated-list-sequence "("
                                       (sequence "," newline
                                                 (c-indentation))
                                       ")"
                                       arguments))))

(define (c-sizeof datum)
  (c-call "sizeof" (list datum)))

(define (c-cast type datum)
  (c-parenthesize (sequence (c-parenthesize type) " " datum)))

(define (c-struct-type struct-name)
  (sequence "struct " struct-name))

(define (c-pointer-type type)
  (sequence type " *"))

(define (c-struct-pointer-type struct-name)
  (c-pointer-type (c-struct-type struct-name)))

(define (c-address-type)
  (c-pointer-type "char"))

(define (c-address-of datum)
  (c-parenthesize (sequence "& " (c-parenthesize datum))))

(define (c-dereference pointer)
  (c-parenthesize (sequence "* " (c-parenthesize pointer))))

(define (c-field struct field)
  (c-parenthesize (sequence (c-parenthesize struct) " . " field)))

(define (c-pointer-field struct field)
  (c-parenthesize (sequence (c-parenthesize struct) " -> " field)))