diff options
Diffstat (limited to '')
-rw-r--r-- | module/c/preprocessor2.scm | 80 | ||||
-rw-r--r-- | tests/test/cpp/preprocessor2.scm | 86 |
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 |