Resolve # ## #

2 files changed, 18 insertions, 3 deletions

diff --git a/module/c/lex2.scm b/module/c/lex2.scm
index 50cf56e3..652aa6c1 100644
--- a/module/c/lex2.scm
+++ b/module/c/lex2.scm
@@ -330,6 +330,7 @@
          comment
          preprocessing-token)))
 
+
 
 (define-type (lexeme)
   (type type: (memv '(whitespace comment preprocessing-token placemaker)))
@@ -356,6 +357,12 @@
     ;; "unflatten"
     ('comment (lexeme body: "" type: 'comment))))
 
+
+
+;; At a number of places I chose token depending on the order of the rule. The
+;; standard however says that the longest possible choice should be used.
+;; 6.4 p. 4
+
 ;; returns a list of lexemes
 (define (lex string)
   (if (string-null? string)
diff --git a/module/c/preprocessor2.scm b/module/c/preprocessor2.scm
index 3cb5913f..4678ded7 100644
--- a/module/c/preprocessor2.scm
+++ b/module/c/preprocessor2.scm
@@ -26,7 +26,8 @@
 
 (define parameter-map? (of-type? (alist-of string? (list-of lexeme?))))
 
-(define (concat-token? token)            (equal? "##"  (punctuator-token? token)))
+(define (concat-token? token)            (and (equal? "##"  (punctuator-token? token))
+                                              (not (member "##" (lexeme-noexpand token)))))
 (define (stringify-token? token)         (equal? "#"   (punctuator-token? token)))
 (define (left-parenthesis-token? token)  (equal? "("   (punctuator-token? token)))
 (define (right-parenthesis-token? token) (equal? ")"   (punctuator-token? token)))
@@ -90,8 +91,15 @@
                     (loop (cdr l) r))
                    ((placemaker-token? (car r))
                     (loop (cdr l) (cons (car l) (cdr r))))
-                   (else (loop (cdr l) (cons (concatenate-tokens (car l) (car r))
-                                             (cdr r)))))))
+                   (else
+                    ;; 6.10.3.3 p. 3
+                    ;; I believe that ## is the only special case where the
+                    ;; result of concatenation is differente from the token directly.
+                    (let ((token (concatenate-tokens (car l) (car r))))
+                      (let ((token (if (concat-token? token)
+                                       (modify token lexeme-noexpand xcons "##")
+                                       token)))
+                        (loop (cdr l) (cons token (cdr r)))))))))
           (else
            (let ((pre post (break concat-token? right)))
              (loop (append left (reverse pre)) post))))))