(define-module (c cpp-util)
  :use-module ((srfi srfi-1) :select (drop-while break))
  :use-module ((hnh util) :select (->))
  :use-module (hnh util type)
  :use-module ((c lex2) :select (lex lexeme?))
  :use-module ((c unlex) :select (unlex))
  :use-module (c cpp-types)
  :export (tokens-until-eol
           squeeze-whitespace
           drop-whitespace
           drop-whitespace-right
           drop-whitespace-both
           cleanup-whitespace
           concatenate-tokens))

;; Returns two values:
;; - tokens until a newline token is met
;; - (potentially the newline token) and the remaining tokens
(define (tokens-until-eol tokens)
  (typecheck tokens (list-of lexeme?))
  (break newline-token? tokens))


;; Replace all whitespace with single spaces.
(define (squeeze-whitespace tokens)
  (cond ((null? tokens) '())
        ((null? (cdr tokens))
         (list
          (if (whitespace-token? (car tokens))
              (car (lex " "))
              (car tokens))))
        ((and (whitespace-token? (car tokens))
              (whitespace-token? (cadr tokens)))
         (squeeze-whitespace (cons (car (lex " "))
                                   (cddr tokens))))
        (else (cons (car tokens)
                    (squeeze-whitespace (cdr tokens))))))

;; Drop leading whitespace tokens
(define (drop-whitespace tokens)
  (typecheck tokens (list-of lexeme?))
  (drop-while whitespace-token? tokens))

(define (drop-whitespace-right tokens)
  (typecheck tokens (list-of lexeme?))
  (-> tokens reverse drop-whitespace reverse))

(define (drop-whitespace-both tokens)
  (typecheck tokens (list-of lexeme?))
  (-> tokens
      drop-whitespace
      drop-whitespace-right))

;; helper procedure to parse-parameter-list.
;; If a parameter is complex then whitespace is kept, but squeezed to single spaces. Surounding whitespace is removed.
;; Example:
;; #define str(x, y) #y
;; str(x,   (   2,     4    )     )
;; expands to:
;; "( 2, 4 )"
;; 6.10.3.2 p 2
(define (cleanup-whitespace tokens)
  (typecheck tokens (list-of lexeme?))
  (-> tokens drop-whitespace-both squeeze-whitespace))

(define (concatenate-tokens a b)
  (car (lex (string-append (unlex (list a))
                           (unlex (list b))))))