Resolve recursive macros.

1 files changed, 184 insertions, 151 deletions

diff --git a/tests/test/cpp/preprocessor2.scm b/tests/test/cpp/preprocessor2.scm
index 75e29834..e2ff0a17 100644
--- a/tests/test/cpp/preprocessor2.scm
+++ b/tests/test/cpp/preprocessor2.scm
@@ -5,6 +5,7 @@
   :use-module (srfi srfi-71)
   :use-module (srfi srfi-88)
   :use-module ((hnh util) :select (-> unval))
+  :use-module ((hnh util lens) :select (set))
   :use-module (c preprocessor2)
   :use-module (c cpp-environment)
   :use-module (c cpp-environment function-like-macro)
@@ -21,21 +22,19 @@
   (call-with-values
       (lambda ()
         (tokens-until-eol
-         (list before '(whitespace "\n") after)))
+         (list before (car (lex "\n")) after)))
     (lambda (bef aft)
       (test-equal (list before) bef)
-      (test-equal (list '(whitespace "\n") after) aft))))
+      (test-equal (list (car (lex "\n")) after) aft))))
 
 
 
 (define squeeze-whitespace (@@ (c preprocessor2) squeeze-whitespace))
 (test-equal "Squeeze whitespace"
-  '(bef (whitespace " ") aft)
+  (lex "bef aft")
   (squeeze-whitespace
-   '(bef
-     (whitespace a)
-     (whitespace b)
-     aft)))
+   (append (lex "bef ")
+           (lex " aft"))))
 
 
 
@@ -44,7 +43,7 @@
 
 (test-group "Stringify"
   (test-equal "("
-    (stringify-token '(punctuator "(")))
+    (stringify-token (car (lex "("))))
   ;; TODO more cases
 
   (test-equal (car (lex "\"(a, b)\""))
@@ -56,9 +55,9 @@
 
 (test-group "Parse identifier list"
   (test-group "Single argument"
-   (let ((rest args (parse-identifier-list (lex "x"))))
-     (test-assert (not rest))
-     (test-equal '("x") args)))
+    (let ((rest args (parse-identifier-list (lex "x"))))
+      (test-assert (not rest))
+      (test-equal '("x") args)))
 
   (test-group "Multiple parameters"
     (let ((rest args (parse-identifier-list (lex "x, y"))))
@@ -88,7 +87,7 @@
 
 
 
-(define expand-stringifiers (@@ (c preprocessor2) expand-stringifiers))
+(define expand# (@@ (c preprocessor2) expand#))
 (define build-parameter-map (@@ (c preprocessor2) build-parameter-map))
 (define parse-parameter-list (@@ (c preprocessor2) parse-parameter-list))
 (define cleanup-whitespace (@@ (c preprocessor2) cleanup-whitespace))
@@ -152,8 +151,7 @@
               identifier-list: '()
               body: (lex "#x"))))
       (build-parameter-map
-       m '() #; (list (lex "x"))
-       )))
+       m '())))
 
   (test-equal "Single (simple) argument"
     `(("x" . ,(lex "x")))
@@ -203,7 +201,7 @@
             body: (lex "#x"))))
     (test-equal "Correct stringification of one param"
       (lex "\"10\"")
-      (expand-stringifiers
+      (expand#
        m (build-parameter-map
           m (list (lex "10"))))))
 
@@ -213,7 +211,7 @@
             body: (lex "#x"))))
     (test-error "Stringification fails for non-parameters"
       'macro-expand-error
-      (expand-stringifiers
+      (expand#
        m (build-parameter-map
           m (list (lex "x")))))))
 
@@ -223,15 +221,22 @@
 (define join-file-line (@@ (c preprocessor2) join-file-line))
 
 (let ((e (join-file-line (make-environment))))
-  (test-equal (object-like-macro identifier: "__FILE__"
-                                 body: '((preprocessing-token (string-literal "*outside*"))))
+  (test-equal "__FILE__ default value"
+    (object-like-macro identifier: "__FILE__"
+                       body: (lex "\"*outside*\""))
     (get-identifier e "__FILE__"))
-  (test-equal (object-like-macro identifier: "__LINE__"
-                                 body: '((preprocessing-token (pp-number "1"))))
+  (test-equal "__LINE__ default value"
+    (object-like-macro identifier: "__LINE__"
+                       body: (lex "1"))
     (get-identifier e "__LINE__")))
 
 (define resolve-token-stream (@@ (c preprocessor2) resolve-token-stream))
 
+(define (remove-noexpand tokens)
+  ;; (typecheck tokens (list-of token?))
+  (map (lambda (token) (set token lexeme-noexpand '()))
+       tokens))
+
 (test-group "Token streams"
   (test-group "Non-expanding"
     (test-equal "Null stream"
@@ -239,37 +244,40 @@
     (test-equal "Constant resolve to themselves"
       (lex "1") (resolve-token-stream (make-environment) (lex "1")))
     (test-equal "Identifier-likes not in environment stay put"
-      (lex "x") (resolve-token-stream (make-environment) (lex "x")))
+      (lex "x") (remove-noexpand (resolve-token-stream (make-environment) (lex "x"))))
     (test-equal "Identifier-likes with stuff after keep stuff after"
-      (lex "x 1") (resolve-token-stream (make-environment) (lex "x 1"))))
+      (lex "x 1") (remove-noexpand (resolve-token-stream (make-environment) (lex "x 1")))))
 
   (test-group "Object likes"
     (test-equal "Expansion of single token"
       (lex "10")
-      (resolve-token-stream (extend-environment (make-environment)
-                                                (list (object-like-macro
-                                                       identifier: "x"
-                                                       body: (lex "10"))))
-                            (lex "x")))
+      (remove-noexpand
+       (resolve-token-stream (extend-environment (make-environment)
+                                                 (list (object-like-macro
+                                                        identifier: "x"
+                                                        body: (lex "10"))))
+                             (lex "x"))))
 
     (test-equal "Expansion keeps stuff after"
       (lex "10 1")
-      (resolve-token-stream (extend-environment (make-environment)
-                                                (list (object-like-macro
-                                                       identifier: "x"
-                                                       body: (lex "10"))))
-                            (lex "x 1")))
+      (remove-noexpand
+       (resolve-token-stream (extend-environment (make-environment)
+                                                 (list (object-like-macro
+                                                        identifier: "x"
+                                                        body: (lex "10"))))
+                             (lex "x 1"))))
 
     (test-equal "Multiple object like macros in one stream"
       (lex "10 20")
-      (resolve-token-stream (extend-environment (make-environment)
-                                                (list (object-like-macro
-                                                       identifier: "x"
-                                                       body: (lex "10"))
-                                                      (object-like-macro
-                                                       identifier: "y"
-                                                       body: (lex "20"))))
-                            (lex "x y"))))
+      (remove-noexpand
+       (resolve-token-stream (extend-environment (make-environment)
+                                                 (list (object-like-macro
+                                                        identifier: "x"
+                                                        body: (lex "10"))
+                                                       (object-like-macro
+                                                        identifier: "y"
+                                                        body: (lex "20"))))
+                             (lex "x y")))))
 
   ;; TODO
 
@@ -294,16 +302,18 @@
           (lambda () (expand-macro (make-environment)
                               (object-like-macro
                                identifier: "x" body: (lex "1 + 2"))
+                              '()
                               '()))
-        (lambda (_ tokens) (test-equal "Simplest case" (lex "1 + 2") tokens)))
+        (lambda (_ tokens) (test-equal "Simplest case" (lex "1 + 2") (remove-noexpand tokens))))
 
       (call-with-values
           (lambda () (expand-macro (make-environment)
                               (object-like-macro
                                identifier: "x" body: (lex "1+2"))
+                              '()
                               (cdr (lex "x something else"))))
         (lambda (_ tokens) (test-equal "Expansion with stuff after"
-                        (lex "1+2 something else") tokens)))
+                        (lex "1+2 something else") (remove-noexpand tokens))))
 
       ;; (call-with-values (expand-macro (make-environment)))
 
@@ -313,65 +323,67 @@
   (test-group "Maybe extend identifier"
     (test-equal "Non-identifier returns remaining"
       (lex "x")
-      ((unval maybe-extend-identifier 1)
-       (make-environment) "x" '()))
+      (remove-noexpand ((unval maybe-extend-identifier 1)
+                        (make-environment) "x" '()'())))
 
     (test-equal "Non-identifiers remaining tokens are returned verbatim"
       (append (lex "x") (list after))
-      ((unval maybe-extend-identifier 1)
-       (make-environment) "x" (list after)))
+      (remove-noexpand ((unval maybe-extend-identifier 1)
+                        (make-environment) "x" '() (list after))))
 
     (test-equal "Object like identifier expands"
       (lex "1 + 2")
-      ((unval maybe-extend-identifier 1)
-       (extend-environment (make-environment)
-                           (list
-                            (object-like-macro
-                             identifier: "x"
-                             body: (lex "1 + 2"))))
-       "x"
-       '()))
+      (remove-noexpand ((unval maybe-extend-identifier 1)
+                        (extend-environment (make-environment)
+                                            (list
+                                             (object-like-macro
+                                              identifier: "x"
+                                              body: (lex "1 + 2"))))
+                        "x"
+                        '()
+                        '())))
 
     (test-equal "Object like macro still returns remaining verbatim"
       (append (lex "1 + 2") (list after))
-      ((unval maybe-extend-identifier 1)
-       (extend-environment (make-environment)
-                           (list
-                            (object-like-macro
-                             identifier: "x"
-                             body: (lex "1 + 2"))))
-       "x"
-       (list after)))
+      (remove-noexpand ((unval maybe-extend-identifier 1)
+                        (extend-environment (make-environment)
+                                            (list
+                                             (object-like-macro
+                                              identifier: "x"
+                                              body: (lex "1 + 2"))))
+                        "x"
+                        '()
+                        (list after))))
 
     )
 
   (test-group "Apply macro"
     (test-equal "zero arg macro on nothing"
       (lex "1")
-      (apply-macro
-       (make-environment)
-       (function-like-macro identifier: "f"
-                            identifier-list: '()
-                            body: (lex "1"))
-       '()))
+      (remove-noexpand (apply-macro
+                        (make-environment)
+                        (function-like-macro identifier: "f"
+                                             identifier-list: '()
+                                             body: (lex "1"))
+                        '())))
 
     (test-equal "Single arg macro"
       (lex "10")
-      (apply-macro
-       (make-environment)
-       (function-like-macro identifier: "f"
-                            identifier-list: '("x")
-                            body: (lex "x"))
-       ((unval parse-parameter-list) (lex "(10)"))))
+      (remove-noexpand (apply-macro
+                        (make-environment)
+                        (function-like-macro identifier: "f"
+                                             identifier-list: '("x")
+                                             body: (lex "x"))
+                        ((unval parse-parameter-list) (lex "(10)")))))
 
     (test-equal "Two arg macro"
       (lex "10 + 20")
-      (apply-macro
-       (make-environment)
-       (function-like-macro identifier: "f"
-                            identifier-list: '("x" "y")
-                            body: (lex "x + y"))
-       ((unval parse-parameter-list) (lex "(10, 20)")))))
+      (remove-noexpand (apply-macro
+                        (make-environment)
+                        (function-like-macro identifier: "f"
+                                             identifier-list: '("x" "y")
+                                             body: (lex "x + y"))
+                        ((unval parse-parameter-list) (lex "(10, 20)"))))))
 
   (test-group "Expand macro part 2"
     (test-group "Function like macros"
@@ -380,21 +392,21 @@
                   identifier: "f"
                   identifier-list: '()
                   body: (lex "1"))))
-          (call-with-values (lambda () (expand-macro e m (lex "()")))
-            (lambda (_ tokens*) (test-equal (lex "1") tokens*)))
+          (call-with-values (lambda () (expand-macro e m '() (lex "()")))
+            (lambda (_ tokens*) (test-equal (lex "1") (remove-noexpand tokens*))))
           (test-error "Arity error for to many args"
-            'cpp-arity-error (expand-macro e m (lex "(10)"))))
+            'cpp-arity-error (expand-macro e m '() (lex "(10)"))))
         (let ((m (function-like-macro
                   identifier: "f"
                   identifier-list: '("x")
                   variadic?: #t
                   body: (lex "__VA_ARGS__ x"))))
-          (call-with-values (lambda () (expand-macro e m (lex "(1)")))
-            (lambda (_ tokens*) (test-equal (lex " 1") tokens*)))
+          (call-with-values (lambda () (expand-macro e m '() (lex "(1)")))
+            (lambda (_ tokens*) (test-equal (lex " 1") (remove-noexpand tokens*))))
           (test-error "Arity error on too few args (with variadic)"
-            'cpp-arity-error (expand-macro e m (lex "()")))
-          (call-with-values (lambda () (expand-macro e m (lex "(1,2,3)")))
-            (lambda (_ tokens*) (test-equal (lex "2,3 1") tokens*)))
+            'cpp-arity-error (expand-macro e m '() (lex "()")))
+          (call-with-values (lambda () (expand-macro e m '() (lex "(1,2,3)")))
+            (lambda (_ tokens*) (test-equal (lex "2,3 1") (remove-noexpand tokens*))))
           )
         ))))
 
@@ -402,44 +414,44 @@
   (test-group "Resolve token stream with function likes"
     (test-equal "Macro expanding to its parameter"
       (lex "0")
-      (resolve-token-stream
-       (extend-environment
-        e (list (function-like-macro identifier: "f"
-                                     identifier-list: '("x")
-                                     body: (lex "x"))))
-       (lex "f(0)")))
+      (remove-noexpand (resolve-token-stream
+                        (extend-environment
+                         e (list (function-like-macro identifier: "f"
+                                                      identifier-list: '("x")
+                                                      body: (lex "x"))))
+                        (lex "f(0)"))))
 
     (test-equal "Macro expanding parameter multiple times"
       (lex "(2) * (2)")
-      (resolve-token-stream
-       (extend-environment
-        e (list (function-like-macro identifier: "f"
-                                     identifier-list: '("x")
-                                     body: (lex "(x) * (x)"))))
-       (lex "f(2)"))
+      (remove-noexpand (resolve-token-stream
+                        (extend-environment
+                         e (list (function-like-macro identifier: "f"
+                                                      identifier-list: '("x")
+                                                      body: (lex "(x) * (x)"))))
+                        (lex "f(2)")))
       )
 
     (test-equal "Object like contains another object like"
       (lex "z")
-      (resolve-token-stream
-       (extend-environment
-        e (list (object-like-macro identifier: "x"
-                                   body: (lex "y"))
-                (object-like-macro identifier: "y"
-                                   body: (lex "z"))))
-       (lex "x")))
+      (remove-noexpand (resolve-token-stream
+                        (extend-environment
+                         e (list (object-like-macro identifier: "x"
+                                                    body: (lex "y"))
+                                 (object-like-macro identifier: "y"
+                                                    body: (lex "z"))))
+                        (lex "x"))))
 
     (test-equal "function like contains another macro"
       (lex "10")
-      (resolve-token-stream
-       (extend-environment
-        e (list (function-like-macro identifier: "f"
-                                     identifier-list: '("x")
-                                     body: (lex "g(x)"))
-                (function-like-macro identifier: "g"
-                                     identifier-list: '("y")
-                                     body: (lex "y"))))
-       (lex "f(10)")))
+      (remove-noexpand (resolve-token-stream
+                        (extend-environment
+                         e (list (function-like-macro identifier: "f"
+                                                      identifier-list: '("x")
+                                                      body: (lex "g(x)"))
+                                 (function-like-macro identifier: "g"
+                                                      identifier-list: '("y")
+                                                      body: (lex "y"))))
+                        (lex "f(10)"))))
 
     "
 #define f(x) g(x)
@@ -449,42 +461,42 @@ f(10)
 
     (test-equal "function like containing another macro using the same parameter name"
       (lex "10")
-      (resolve-token-stream
-       (extend-environment
-        e (list (function-like-macro identifier: "f"
-                                     identifier-list: '("x")
-                                     body: (lex "g(x)"))
-                (function-like-macro identifier: "g"
-                                     identifier-list: '("x")
-                                     body: (lex "x"))))
-       (lex "f(10)")))
+      (remove-noexpand (resolve-token-stream
+                        (extend-environment
+                         e (list (function-like-macro identifier: "f"
+                                                      identifier-list: '("x")
+                                                      body: (lex "g(x)"))
+                                 (function-like-macro identifier: "g"
+                                                      identifier-list: '("x")
+                                                      body: (lex "x"))))
+                        (lex "f(10)"))))
 
 
 
     (test-equal "function like contains another macro"
       (lex "10 * 2 + 20 * 2 + 30")
-      (resolve-token-stream
-       (extend-environment
-        e (list (function-like-macro identifier: "f"
-                                     identifier-list: '("x" "y")
-                                     body: (lex "g(x) + g(y)"))
-                (function-like-macro identifier: "g"
-                                     identifier-list: '("x")
-                                     body: (lex "x * 2"))))
-       (lex "f(10, 20) + 30")))))
+      (remove-noexpand (resolve-token-stream
+                        (extend-environment
+                         e (list (function-like-macro identifier: "f"
+                                                      identifier-list: '("x" "y")
+                                                      body: (lex "g(x) + g(y)"))
+                                 (function-like-macro identifier: "g"
+                                                      identifier-list: '("x")
+                                                      body: (lex "x * 2"))))
+                        (lex "f(10, 20) + 30"))))))
 
 (let ((e (extend-environment
           (make-environment)
           (list (@@ (c preprocessor2) defined-macro)))))
   (test-group "defined() macro"
     (test-equal "defined(NOT_DEFINED)"
-      (lex "0") (resolve-token-stream e (lex "defined(X)")))
+      (lex "0") (remove-noexpand (resolve-token-stream e (lex "defined(X)"))))
     (test-equal "defined(DEFINED)"
-      (lex "1") (resolve-token-stream
-                 (extend-environment
-                  e (list (object-like-macro identifier: "X"
-                                             body: (lex "10"))))
-                 (lex "defined(X)")))))
+      (lex "1") (remove-noexpand (resolve-token-stream
+                                  (extend-environment
+                                   e (list (object-like-macro identifier: "X"
+                                                              body: (lex "10"))))
+                                  (lex "defined(X)"))))))
 
 
 (let ((env (resolve-define (make-environment)
@@ -498,17 +510,38 @@ f(10)
 ;; (resolve-define (make-environment)
 ;;                 (lex "f(x)x+1"))
 
-;; (let ((env (resolve-define (make-environment)
-;;                            (lex "x x"))))
-;;   (test-equal "Macro expanding to itself leaves the token"
-;;     (lex "x")
-;;     (resolve-token-stream env (lex "x"))))
-
-(let ((env (-> (make-environment)
-               (resolve-define (lex "f(a) a*g"))
-               (resolve-define (lex "g(a) f(a)")))))
-  (test-equal '()
-   (resolve-token-stream env (lex "f(2)(9)"))))
+(define mark-noexpand (@@ (c preprocessor2) mark-noexpand))
+
+(test-group "Recursive macros"
+  (let ((env (resolve-define (make-environment)
+                             (lex "x x"))))
+    (test-equal "Macro expanding to itself leaves the token"
+      (mark-noexpand (lex "x") "x")
+      (resolve-token-stream env (lex "x"))))
+
+  ;; Test from C standard 6.10.3.4 p. 4
+  ;; Both the expansion "2*f(9)" and "2*9*g" are valid.
+  ;; The case chosen here is mostly a consequence of how the code works
+  (let ((env (-> (make-environment)
+                 (resolve-define (lex "f(a) a*g"))
+                 (resolve-define (lex "g(a) f(a)")))))
+    (test-equal "Mutual recursion with two function like macros"
+      (lex "2*f(9)")
+      (remove-noexpand (resolve-token-stream env (lex "f(2)(9)")))))
+
+  (let ((env (-> (make-environment)
+                 (resolve-define (lex "f 2 * g"))
+                 (resolve-define (lex "g(x) x + f")))))
+    (test-equal "Mutual recursion with object and function like macro"
+      (lex "2 * 10 + f")
+      (remove-noexpand (resolve-token-stream env (lex "f(10)")))))
+
+  (let ((env (-> (make-environment)
+                 (resolve-define (lex "x 2*y"))
+                 (resolve-define (lex "y 3*x")))))
+    (test-equal "Mutual recursion with two object likes"
+      (lex "2*3*x")
+      (remove-noexpand (resolve-token-stream env (lex "x"))))))