diff options
author | Hugo Hörnquist <hugo@lysator.liu.se> | 2022-07-10 23:51:25 +0200 |
---|---|---|
committer | Hugo Hörnquist <hugo@lysator.liu.se> | 2022-07-10 23:53:01 +0200 |
commit | bc8768984e07c567337a899b861c009fb7cc9ce7 (patch) | |
tree | 69e35cff23185bc5c44003b5974f804c7510cd01 /module/c/preprocessor2.scm | |
parent | Resolve recursive macros. (diff) | |
download | calp-bc8768984e07c567337a899b861c009fb7cc9ce7.tar.gz calp-bc8768984e07c567337a899b861c009fb7cc9ce7.tar.xz |
Fix #line
Diffstat (limited to 'module/c/preprocessor2.scm')
-rw-r--r-- | module/c/preprocessor2.scm | 41 |
1 files changed, 21 insertions, 20 deletions
diff --git a/module/c/preprocessor2.scm b/module/c/preprocessor2.scm index 2d2a9530..a6710314 100644 --- a/module/c/preprocessor2.scm +++ b/module/c/preprocessor2.scm @@ -464,27 +464,28 @@ (typecheck environment cpp-environment?) (typecheck tokens* (list-of lexeme?)) - ;; TODO rewrite without match (let loop ((%first-time #t) (tokens tokens*)) - (match tokens - (`((preprocessing-token (pp-number ,line)) (whitespace ,_) ... rest ...) - (match rest - (`((preprocessing-token (string-literal ,file)) (whitespace ,_) ...) - (-> environment - (set current-line line) - (set current-file file))) - (`((whitespace ,_) ...) - (set environment current-line line)) - (_ (unless %first-time - (scm-error 'cpp-error "handle-line-directive" - "Invalid line directive: ~s" - (list tokens*) #f)) - (loop #f (resolve-token-stream environment tokens))))) - (_ (unless %first-time - (scm-error 'cpp-error "handle-line-directive" - "Invalid line directive: ~s" - (list tokens*) #f)) - (loop #f (resolve-token-stream environment tokens)))))) + (cond ((null? tokens)) + ((number-token? (car tokens)) + => (lambda (line) + (let ((line (string->number line))) + (let ((remaining (drop-whitespace (cdr tokens)))) + (cond ((null? remaining) (set environment current-line line)) + ((string-token? (car remaining)) + => (lambda (file) + (-> environment + (set current-line line) + (set current-file file)))) + (%first-time + (loop #f (resolve-token-stream environment tokens))) + (else (scm-error 'cpp-error "handle-line-directive" + "Invalid line directive: ~s" + (list tokens*) #f) + )))))) + (%first-time (loop #f (resolve-token-stream environment tokens))) + (else (scm-error 'cpp-error "handle-line-directive" + "Invalid line directive: ~s" + (list tokens*) #f))))) ;; environment, tokens → environment (define (resolve-define environment tokens) |