(define-module (c cpp-types)
  :use-module (c lex2)
  :use-module (ice-9 match)
  :use-module (c cpp-util)
  :use-module (hnh util type)
  :export (whitespace-token?
           comment-token?
           preprocessing-token?
           other-token?
           placemaker-token?
           newline-token?
           identifier-token?
           punctuator-token?
           pp-number?
           string-token?
           h-string-token?
           q-string-token?
           character-constant?
           comment->whitespace
           comments->whitespace
           make-string-literal
           ))

(define (whitespace-token? x)
  (and (lexeme? x)
       (eq? 'whitespace (lexeme-type x))))

(define (comment-token? x)
  (and (lexeme? x)
       (eq? 'comment (lexeme-type x))))

(define (preprocessing-token? x)
  (and (lexeme? x)
       (eq? 'preprocessing-token (lexeme-type x))))

(define (other-token? x)
  (and (lexeme? x)
       (eq? 'other (lexeme-type x))))

(define (placemaker-token? x)
  (and (lexeme? x)
       (eq? 'placemaker (lexeme-type x))))

(define (newline-token? x)
  (and (whitespace-token? x)
       (string=? "\n" (lexeme-body x))))

(define (identifier-token? token)
  (and (preprocessing-token? token)
       (match (lexeme-body token)
         (`(identifier ,id) id)
         (_ #f))))

(define (punctuator-token? token)
  (and (preprocessing-token? token)
       (match (lexeme-body token)
         (`(punctuator ,x) x)
         (_ #f))))

(define (pp-number? token)
  (and (preprocessing-token? token)
       (match (lexeme-body token)
         (`(pp-number ,x) x)
         (_ #f))))

;; TODO rename to string-literal-token?
(define (string-token? token)
  (and (preprocessing-token? token)
       (match (lexeme-body token)
         (('string-literal x ...) (apply values x))
         (_ #f))))

(define (character-constant? token)
  (and (preprocessing-token? token)
       (match (lexeme-body token)
         (('character-constant x ...) (apply values x))
         (_ #f))))


(define (h-string-token? token)
  (and (preprocessing-token? token)
       (match (lexeme-body token)
         (`(h-string ,x) x)
         (_ #f))))

;; NOTE q-string tokens are never produced by the lexer,
;; since they instead are treated as regular strings
(define (q-string-token? token)
  (cond ((string-token? token)
         (lambda (a . _) a) => (lambda (_ . a) (apply values a)))))

(define (make-string-literal parts)
  (typecheck parts (list-of (or string? list?)))
  (lexeme type: 'preprocessing-token
          body: (cons 'string-literal parts)))