blob: fff3cc9e70540ddce16f5407959b21e97f5a97c1 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
|
(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))))))
|
