From bc8768984e07c567337a899b861c009fb7cc9ce7 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@lysator.liu.se>
Date: Sun, 10 Jul 2022 23:51:25 +0200
Subject: Fix #line

---
 module/c/preprocessor2.scm | 41 +++++++++++++++++++++--------------------
 1 file changed, 21 insertions(+), 20 deletions(-)

(limited to 'module/c/preprocessor2.scm')

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)
-- 
cgit v1.2.3