aboutsummaryrefslogtreecommitdiff
path: root/module/c/preprocessor2.scm
diff options
context:
space:
mode:
authorHugo Hörnquist <hugo@lysator.liu.se>2022-07-10 23:51:25 +0200
committerHugo Hörnquist <hugo@lysator.liu.se>2022-07-10 23:53:01 +0200
commitbc8768984e07c567337a899b861c009fb7cc9ce7 (patch)
tree69e35cff23185bc5c44003b5974f804c7510cd01 /module/c/preprocessor2.scm
parentResolve recursive macros. (diff)
downloadcalp-bc8768984e07c567337a899b861c009fb7cc9ce7.tar.gz
calp-bc8768984e07c567337a899b861c009fb7cc9ce7.tar.xz
Fix #line
Diffstat (limited to 'module/c/preprocessor2.scm')
-rw-r--r--module/c/preprocessor2.scm41
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)