Fix whitespace for rest args.

2 files changed, 92 insertions, 74 deletions

diff --git a/module/c/preprocessor2.scm b/module/c/preprocessor2.scm
index c6410ca3..67ba4687 100644
--- a/module/c/preprocessor2.scm
+++ b/module/c/preprocessor2.scm
@@ -10,7 +10,7 @@
   :use-module ((c cpp-environment object-like-macro) :select (object-like-macro))
   :use-module ((c cpp-environment internal-macro) :select (internal-macro))
   :use-module ((hnh util) :select (-> intersperse aif swap))
-  :use-module ((hnh util lens) :select (set modify))
+  :use-module ((hnh util lens) :select (set modify cdr*))
   :use-module (hnh util path)
   :use-module (hnh util type)
   :use-module (hnh util object)
@@ -33,15 +33,16 @@
 (define (build-parameter-map macro parameters)
   (typecheck macro macro?)
   (typecheck parameters (list-of (list-of lexeme?)))
-  (if (macro-variadic? macro)
-      (let ((head rest (split-at parameters (length (macro-identifier-list macro)))))
-        (cons (cons "__VA_ARGS__" (concatenate (intersperse
-                                                (lex ",")
-                                                rest)))
-              (map cons (macro-identifier-list macro) head)))
-      (map cons
-           (macro-identifier-list macro)
-           parameters)))
+  (map (lambda (pair) (modify pair cdr* drop-whitespace-both))
+       (if (macro-variadic? macro)
+           (let ((head rest (split-at parameters (length (macro-identifier-list macro)))))
+             (cons (cons "__VA_ARGS__" (concatenate (intersperse
+                                                     (lex ",")
+                                                     rest)))
+                   (map cons (macro-identifier-list macro) head)))
+           (map cons
+                (macro-identifier-list macro)
+                parameters))))
 
 
 (define (expand# macro parameter-map)
@@ -49,22 +50,19 @@
   (typecheck parameter-map parameter-map?)
   (let loop ((tokens (macro-body macro)))
     (cond ((null? tokens) '())
-          ((equal? '(punctuator "#")
-                   (lexeme-body (car tokens)))
-           (let ((trimmed (drop-whitespace (cdr tokens))))
-             (let ((x (identifier-token? (car trimmed)))
-                   (rest (cdr trimmed)))
-               (unless (member x (macro-identifier-list macro))
-                 (scm-error 'macro-expand-error "expand#"
-                            "'#' is not followed by a macro parameter: ~s"
-                            (list x) #f))
-               (cons (stringify-tokens (assoc-ref parameter-map x))
-                     (loop rest)))))
-          (else (cons (car tokens) (loop (cdr tokens)))))))
-
-
-;; Tokens is the body of the macro
-
+          ((equal? "#" (punctuator-token? (car tokens)))
+           (let* ((head rest (car+cdr (drop-whitespace (cdr tokens))))
+                  (x (identifier-token? head)))
+             (cond ((assoc-ref parameter-map x)
+                    => (lambda (tokens)
+                         (cons (stringify-tokens tokens)
+                               (loop rest))))
+                   (else
+                    (scm-error 'macro-expand-error "expand#"
+                               "'#' is not followed by a macro parameter: ~s"
+                               (list x) #f)))))
+          (else (cons (car tokens)
+                      (loop (cdr tokens)))))))
 
 
 (define-type (list-zipper)
@@ -180,11 +178,10 @@
                (list macro)))
   (let ()
 
-    (define (resolve-cpp-variables tokens)
+    (define (resolve-cpp-variables tokens parameter-map)
       (define (bound-identifier? id)
-        (and (string? id)
-             (or (and (variadic? macro) (string=? id "__VA_ARGS__"))
-                 (member id (macro-identifier-list macro)))))
+        (assoc-ref parameter-map id))
+
       ;; expand parameters, and place placemaker tokens
       (let loop ((tokens tokens))
         (cond ((null? tokens) '())
@@ -201,7 +198,7 @@
     (define parameter-map (build-parameter-map macro parameters))
     (define stringify-resolved (expand# macro parameter-map))
     (remove placemaker-token?
-            (expand## (resolve-cpp-variables stringify-resolved)))))
+            (expand## (resolve-cpp-variables stringify-resolved parameter-map)))))
 
 
 
@@ -305,18 +302,9 @@
              (if (= 1 depth)
                  ;; return value
                  (values
-                  (if (null? parameters)
-                      (cond ((null? current) '())
-                            ((every whitespace-token? current) '())
-                            (else (reverse
-                                   (cons (cleanup-whitespace (reverse current))
-                                         parameters))))
-                      (reverse
-                       (cond ((null? current) parameters)
-                             ((every whitespace-token? current) parameters)
-                             (else (cons (cleanup-whitespace (reverse current))
-                                         parameters)))))
-
+                  (reverse (if (null? current)
+                               parameters
+                               (cons (reverse current) parameters)))
                   (cdr tokens)
                   newlines)
                  (loop (cdr tokens)
@@ -326,11 +314,7 @@
              (if (= 1 depth)
                  (loop (cdr tokens)
                        current: '()
-                       parameters:
-                       (cons (cond ((null? current) '())
-                                   ((every whitespace-token? current) '())
-                                   (else (cleanup-whitespace (reverse current))))
-                             parameters))
+                       parameters: (cons (reverse current) parameters))
                  (loop (cdr tokens) current: current*)))
             (else
              (loop (cdr tokens) current: current*))))))
diff --git a/tests/test/cpp/preprocessor2.scm b/tests/test/cpp/preprocessor2.scm
index 9349d290..9ad1a726 100644
--- a/tests/test/cpp/preprocessor2.scm
+++ b/tests/test/cpp/preprocessor2.scm
@@ -14,7 +14,6 @@
   :use-module (c lex2))
 
 
-(test-skip "Stringify __VA_ARGS__")
 (test-skip "__LINE__ through macro")
 (test-skip "__LINE__ standalone")
 
@@ -120,7 +119,7 @@
   (test-group "Two values in parameter list"
     (let ((containing remaining nls (parse-parameter-list (lex "(x, y)"))))
       (test-equal (list (lex "x")
-                        (lex "y"))
+                        (lex " y"))
         containing)
       (test-equal '() remaining)
       (test-equal 0 nls)))
@@ -128,8 +127,8 @@
   (test-group "Three values in parameter list"
     (let ((containing remaining nls (parse-parameter-list (lex "(x, y, z)"))))
       (test-equal (list (lex "x")
-                        (lex "y")
-                        (lex "z"))
+                        (lex " y")
+                        (lex " z"))
         containing)
       (test-equal '() remaining)
       (test-equal 0 nls)))
@@ -144,7 +143,7 @@
   (test-group "Two values, one of which is a paretheseed pair"
     (let ((containing remaining nls
                       (parse-parameter-list (lex "(x, (y, z))"))))
-      (test-equal (list (lex "x") (lex "(y, z)"))
+      (test-equal (list (lex "x") (lex " (y, z)"))
         containing)
       (test-equal '() remaining)
       (test-equal 0 nls))))
@@ -642,48 +641,83 @@ __LINE__")))))
   (test-equal (lex "ab") (expand## (lex "a ## b")))
   )
 
-(test-equal "Token concatenation in function like macro"
-  (lex "ab")
+(define (run str)
   (remove-noexpand
    (handle-preprocessing-tokens
     (make-environment)
-    (tokenize "
+    (tokenize str))))
+
+
+(test-equal "Token concatenation in function like macro"
+  (lex "ab")
+  (run "
 #define f() a ## b
-f()"))))
+f()"))
 
 (test-equal "token concatentanion in object like macro"
   (lex "ab")
-  (remove-noexpand
-   (handle-preprocessing-tokens
-    (make-environment)
-    (tokenize "
+  (run "
 #define x a ## b
-x"))))
+x"))
 
 (test-equal "Token concatenation with parameter"
   (lex "ab")
-  (remove-noexpand
-   (handle-preprocessing-tokens
-    (make-environment)
-    (tokenize "
+  (run "
 #define f(x) x ## b
-f(a)"))))
+f(a)"))
+
+
 
 
 ;; 6.10.3.3 p. 4
-(test-equal
+(test-equal "x ## y"
     (lex "\"x ## y\"")
-  (drop-whitespace-both
-   (remove-noexpand
-    (handle-preprocessing-tokens
-     (make-environment)
-     (tokenize "
+  (run "
 #define hash_hash # ## #
 #define mkstr(a) # a
 #define in_between(a) mkstr(a)
 #define join(c, d) in_between(c hash_hash d)
 
-join(x, y)")))))
+join(x, y)"))
+
+(test-equal "__VA_ARGS__ split its arguments"
+  (lex "1")
+  (run "
+#define fst(x, y) x
+#define f(...) fst(__VA_ARGS__)
+f(1,2)
+"))
+
+(test-equal
+    "Stringify __VA_ARGS__"
+    (lex "\"1,2\"")
+ (run "
+#define g(...) #__VA_ARGS__
+g(1,2)
+"))
+
+(test-equal "__VA_ARGS__ keep whitespace"
+  (lex "x, y")
+  (run "
+#define args(...) __VA_ARGS__
+args(x, y)
+"))
+
+(test-equal "Concat with __VA_ARGS__"
+  (lex "fx,y")
+  (run "
+#define wf(...) f ## __VA_ARGS__
+wf(x,y)
+"))
+
+(test-equal
+    "Concat with __VA_ARGS__ (keeping whitespace)"
+  (lex "fx, y")
+  (run "
+#define wf(...) f ## __VA_ARGS__
+wf(x, y)
+"))
+
 
 ;; __LINE__
 ;; #line