General cleanup in preprocessor.

1 files changed, 155 insertions, 215 deletions

diff --git a/tests/test/cpp/preprocessor2.scm b/tests/test/cpp/preprocessor2.scm
index 4e808b8b..f79ece15 100644
--- a/tests/test/cpp/preprocessor2.scm
+++ b/tests/test/cpp/preprocessor2.scm
@@ -5,7 +5,7 @@
   :use-module (srfi srfi-64 test-error)
   :use-module (srfi srfi-71)
   :use-module (srfi srfi-88)
-  :use-module ((hnh util) :select (-> ->> unval swap))
+  :use-module ((hnh util) :select (-> ->>))
   :use-module ((hnh util lens) :select (set))
   :use-module ((hnh util io) :select (call-with-tmpfile))
   :use-module (hnh util values)
@@ -29,13 +29,11 @@
                         next-token-matches?
                         ))
   :use-module ((c unlex)
-               :select (
-                        unlex
+               :select (unlex
                         unlex-aggressive
                         stringify-token
                         stringify-tokens
-                        )
-               )
+                        ))
   :use-module ((c cpp-types)
                :select (punctuator-token? identifier-token? whitespace-token?))
   :use-module (c lex2)
@@ -51,7 +49,6 @@
 
 
 (define apply-macro (@@ (c preprocessor2) apply-macro))
-(define build-parameter-map (@@ (c preprocessor2) build-parameter-map))
 (define expand# (@@ (c preprocessor2) expand#))
 (define expand## (@@ (c preprocessor2) expand##))
 (define expand-macro (@@ (c preprocessor2) expand-macro))
@@ -62,13 +59,11 @@
 (define maybe-extend-identifier (@@ (c preprocessor2) maybe-extend-identifier))
 (define parse-identifier-list (@@ (c preprocessor2) parse-identifier-list))
 (define parse-parameter-list (@@ (c preprocessor2) parse-parameter-list))
-(define resolve-define (@@ (c preprocessor2) resolve-define))
+(define handle-define-directive (@@ (c preprocessor2) handle-define-directive))
 (define resolve-token-stream (@@ (c preprocessor2) resolve-token-stream))
-;; (define tokenize (@@ (c preprocessor2) tokenize))
 (define resolve-h-file (@@ (c preprocessor2) resolve-h-file))
 (define resolve-q-file (@@ (c preprocessor2) resolve-q-file))
 (define resolve-header (@@ (c preprocessor2) resolve-header))
-;; (define include-header (@@ (c preprocessor2) include-header))
 
 ;; Remove the noexpand list from each token.
 
@@ -233,86 +228,6 @@
       (test-equal '() remaining)
       (test-equal 2 nls))))
 
-(test-group "Build parameter map"
-  (test-equal "Simplest case, zero arguments"
-    '()
-    (let ((m (function-like-macro
-              identifier: "str"
-              identifier-list: '()
-              body: (lex "#x"))))
-      (build-parameter-map
-       m '())))
-
-  (test-equal "Single (simple) argument"
-    `(("x" . ,(lex "x")))
-    (let ((m (function-like-macro
-              identifier: "str"
-              identifier-list: '("x")
-              body: '())))
-      (build-parameter-map
-       m
-       (list (lex "x")))))
-
-  (test-equal "Single advanced argument"
-    `(("x" . ,(lex "(x)")))
-    (let ((m (function-like-macro
-              identifier: "str"
-              identifier-list: '("x")
-              body: '())))
-      (build-parameter-map
-       m (list (lex "(x)")))))
-
-  (test-group "Rest arguments"
-    (test-equal "Single simple"
-      `(("__VA_ARGS__" . ,(lex "x")))
-      (let ((m (function-like-macro
-                identifier: "str"
-                identifier-list: '()
-                variadic?: #t
-                body: '())))
-        (build-parameter-map
-         m (list (lex "x")))))
-
-    (test-equal "Two simple"
-      `(("__VA_ARGS__" . ,(lex "x,y")))
-      (let ((m (function-like-macro
-                identifier: "str"
-                identifier-list: '()
-                variadic?: #t
-                body: '())))
-        (build-parameter-map
-         m (list (lex "x,y")))))))
-
-
-(test-group "Expand stringifiers"
-  (let ((m (function-like-macro
-            identifier: "str"
-            identifier-list: '("x")
-            body: (lex "#x"))))
-    (test-equal "Correct stringification of one param"
-      (lex "\"10\"")
-      (expand#
-       m (build-parameter-map
-          m (list (lex "10"))))))
-
-  (let ((m (function-like-macro
-            identifier: "str"
-            identifier-list: '()
-            body: (lex "#x"))))
-    (test-error "Stringification fails for non-parameters"
-      'macro-expand-error
-      (expand#
-       m (build-parameter-map
-          m (list (lex "x"))))))
-
-  (let ((m (function-like-macro
-            identifier: "f"
-            identifier-list: '()
-            variadic?: #t
-            body: (lex "# __VA_ARGS__"))))
-    (test-equal "Stringify __VA_ARGS__"
-      (lex "\"10, 20\"")
-      (expand# m (build-parameter-map m (list (lex "10, 20")))))))
 
 
 (let ((e (join-file-line (make-environment))))
@@ -329,47 +244,50 @@
 (test-group "Token streams"
   (test-group "Non-expanding"
     (test-equal "Null stream"
-      '() ((unval resolve-token-stream 1) (make-environment) '()))
+      '() (value-ref (resolve-token-stream (make-environment) '()) 1))
     (test-equal "Constant resolve to themselves"
-      (lex "1") ((unval resolve-token-stream 1) (make-environment) (lex "1")))
+      (lex "1") (value-ref (resolve-token-stream (make-environment) (lex "1")) 1))
     (test-equal "Identifier-likes not in environment stay put"
-      (lex "x") (remove-noexpand ((unval resolve-token-stream 1) (make-environment) (lex "x"))))
+      (lex "x") (remove-noexpand (value-ref (resolve-token-stream (make-environment) (lex "x")) 1)))
     (test-equal "Identifier-likes with stuff after keep stuff after"
-      (lex "x 1") (remove-noexpand ((unval resolve-token-stream 1) (make-environment) (lex "x 1")))))
+      (lex "x 1") (remove-noexpand (value-ref (resolve-token-stream (make-environment) (lex "x 1")) 1))))
 
   (test-group "Object likes"
     (test-equal "Expansion of single token"
       (lex "10")
-      (remove-noexpand
-       ((unval resolve-token-stream 1)
-        (extend-environment (make-environment)
-                            (list (object-like-macro
-                                   identifier: "x"
-                                   body: (lex "10"))))
-        (lex "x"))))
+      (-> (make-environment)
+          (extend-environment
+           (list (object-like-macro
+                  identifier: "x"
+                  body: (lex "10"))))
+          (resolve-token-stream (lex "x"))
+          (value-ref 1)
+          remove-noexpand))
 
     (test-equal "Expansion keeps stuff after"
       (lex "10 1")
-      (remove-noexpand
-       ((unval resolve-token-stream 1)
-        (extend-environment (make-environment)
-                            (list (object-like-macro
-                                   identifier: "x"
-                                   body: (lex "10"))))
-        (lex "x 1"))))
+      (-> (make-environment)
+          (extend-environment
+           (list (object-like-macro
+                  identifier: "x"
+                  body: (lex "10"))))
+          (resolve-token-stream (lex "x 1"))
+          (value-ref 1)
+          remove-noexpand))
 
     (test-equal "Multiple object like macros in one stream"
       (lex "10 20")
-      (remove-noexpand
-       ((unval resolve-token-stream 1)
-        (extend-environment (make-environment)
-                            (list (object-like-macro
-                                   identifier: "x"
-                                   body: (lex "10"))
-                                  (object-like-macro
-                                   identifier: "y"
-                                   body: (lex "20"))))
-        (lex "x y"))))))
+      (-> (make-environment)
+          (extend-environment
+           (list (object-like-macro
+                  identifier: "x"
+                  body: (lex "10"))
+                 (object-like-macro
+                  identifier: "y"
+                  body: (lex "20"))))
+          (resolve-token-stream (lex "x y"))
+          (value-ref 1)
+          remove-noexpand))))
 
 
 (test-group "Macro expansion"
@@ -403,39 +321,39 @@
   (test-group "Maybe extend identifier"
     (test-equal "Non-identifier returns remaining"
       (lex "x")
-      (remove-noexpand ((unval maybe-extend-identifier 1)
-                        (make-environment) "x" '()'())))
+      (-> (make-environment)
+          (maybe-extend-identifier "x" '() '())
+          (value-ref 1)
+          remove-noexpand))
 
     (test-equal "Non-identifiers remaining tokens are returned verbatim"
       (append (lex "x") (lex "after"))
-      (remove-noexpand ((unval maybe-extend-identifier 1)
-                        (make-environment) "x" '() (lex "after"))))
+      (-> (make-environment)
+          (maybe-extend-identifier "x" '() (lex "after"))
+          (value-ref 1)
+          remove-noexpand))
 
     (test-equal "Object like identifier expands"
       (lex "1 + 2")
-      (remove-noexpand ((unval maybe-extend-identifier 1)
-                        (extend-environment (make-environment)
-                                            (list
-                                             (object-like-macro
-                                              identifier: "x"
-                                              body: (lex "1 + 2"))))
-                        "x"
-                        '()
-                        '())))
+      (-> (make-environment)
+          (extend-environment
+           (list (object-like-macro
+                  identifier: "x"
+                  body: (lex "1 + 2"))))
+          (maybe-extend-identifier "x" '() '())
+          (value-ref 1)
+          remove-noexpand))
 
     (test-equal "Object like macro still returns remaining verbatim"
       (append (lex "1 + 2") (lex "after"))
-      (remove-noexpand ((unval maybe-extend-identifier 1)
-                        (extend-environment (make-environment)
-                                            (list
-                                             (object-like-macro
-                                              identifier: "x"
-                                              body: (lex "1 + 2"))))
-                        "x"
-                        '()
-                        (lex "after"))))
-
-    )
+      (-> (make-environment)
+          (extend-environment
+           (list (object-like-macro
+                  identifier: "x"
+                  body: (lex "1 + 2"))))
+          (maybe-extend-identifier "x" '() (lex "after"))
+          (value-ref 1)
+          remove-noexpand)))
 
   (test-group "Apply macro"
     (test-equal "zero arg macro on nothing"
@@ -449,21 +367,25 @@
 
     (test-equal "Single arg macro"
       (lex "10")
-      (remove-noexpand (apply-macro
-                        (make-environment)
+      (->> (lex "(10)")
+           parse-parameter-list
+           (value-refx 0)
+           (apply-macro (make-environment)
                         (function-like-macro identifier: "f"
                                              identifier-list: '("x")
-                                             body: (lex "x"))
-                        ((unval parse-parameter-list) (lex "(10)")))))
+                                             body: (lex "x")))
+           remove-noexpand))
 
     (test-equal "Two arg macro"
       (lex "10 + 20")
-      (remove-noexpand (apply-macro
-                        (make-environment)
+      (->> (lex "(10, 20)")
+           parse-parameter-list
+           (value-refx 0)
+           (apply-macro (make-environment)
                         (function-like-macro identifier: "f"
                                              identifier-list: '("x" "y")
-                                             body: (lex "x + y"))
-                        ((unval parse-parameter-list) (lex "(10, 20)"))))))
+                                             body: (lex "x + y")))
+           remove-noexpand)))
 
   (test-group "Expand macro part 2"
     (test-group "Function like macros"
@@ -497,74 +419,85 @@
   (test-group "Resolve token stream with function likes"
     (test-equal "Macro expanding to its parameter"
       (lex "0")
-      (remove-noexpand ((unval resolve-token-stream 1)
-                        (extend-environment
-                         e (list (function-like-macro identifier: "f"
-                                                      identifier-list: '("x")
-                                                      body: (lex "x"))))
-                        (lex "f(0)"))))
+      (-> e
+          (extend-environment
+           (list (function-like-macro identifier: "f"
+                                      identifier-list: '("x")
+                                      body: (lex "x"))))
+          (resolve-token-stream (lex "f(0)"))
+          (value-ref 1)
+          remove-noexpand))
 
     (test-equal "Macro expanding parameter multiple times"
       (lex "(2) * (2)")
-      (remove-noexpand ((unval resolve-token-stream 1)
-                        (extend-environment
-                         e (list (function-like-macro identifier: "f"
-                                                      identifier-list: '("x")
-                                                      body: (lex "(x) * (x)"))))
-                        (lex "f(2)")))
-      )
+      (-> e
+          (extend-environment
+           (list (function-like-macro identifier: "f"
+                                      identifier-list: '("x")
+                                      body: (lex "(x) * (x)"))))
+          (resolve-token-stream (lex "f(2)"))
+          (value-ref 1)
+          remove-noexpand))
 
     (test-equal "Object like contains another object like"
       (lex "z")
-      (remove-noexpand ((unval resolve-token-stream 1)
-                        (extend-environment
-                         e (list (object-like-macro identifier: "x"
-                                                    body: (lex "y"))
-                                 (object-like-macro identifier: "y"
-                                                    body: (lex "z"))))
-                        (lex "x"))))
+      (-> e
+          (extend-environment
+           (list (object-like-macro identifier: "x"
+                                    body: (lex "y"))
+                 (object-like-macro identifier: "y"
+                                    body: (lex "z"))))
+          (resolve-token-stream (lex "x"))
+          (value-ref 1)
+          remove-noexpand))
 
     (test-equal "function like contains another macro"
       (lex "10")
-      (remove-noexpand ((unval resolve-token-stream 1)
-                        (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)"))))
+      (-> e
+          (extend-environment
+           (list (function-like-macro identifier: "f"
+                                      identifier-list: '("x")
+                                      body: (lex "g(x)"))
+                 (function-like-macro identifier: "g"
+                                      identifier-list: '("y")
+                                      body: (lex "y"))))
+          (resolve-token-stream (lex "f(10)"))
+          (value-ref 1)
+          remove-noexpand))
 
 
     (test-equal "function like containing another macro using the same parameter name"
       (lex "10")
-      (remove-noexpand ((unval resolve-token-stream 1)
-                        (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)"))))
+      (-> e
+          (extend-environment
+           (list (function-like-macro identifier: "f"
+                                      identifier-list: '("x")
+                                      body: (lex "g(x)"))
+                 (function-like-macro identifier: "g"
+                                      identifier-list: '("x")
+                                      body: (lex "x"))))
+          (resolve-token-stream (lex "f(10)"))
+          (value-ref 1)
+          remove-noexpand))
 
 
 
     (test-equal "function like contains another macro"
       (lex "10 * 2 + 20 * 2 + 30")
-      (remove-noexpand ((unval resolve-token-stream 1)
-                        (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 ((env (resolve-define (make-environment)
+      (-> e
+          (extend-environment
+           (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"))))
+          (resolve-token-stream (lex "f(10, 20) + 30"))
+          (value-ref 1)
+          remove-noexpand))))
+
+
+(let ((env (handle-define-directive (make-environment)
                            (lex "f(x) x+1"))))
   (test-assert "New binding added" (in-environment? env "f"))
   (let ((m (get-identifier env "f")))
@@ -572,39 +505,46 @@
     (test-equal "Macro body" (lex "x+1") (macro-body m))))
 
 ;; This should issue a warning, since the standard requires a space after the ending parenthe here (6.10.3)
-;; (resolve-define (make-environment)
+;; (handle-define-directive (make-environment)
 ;;                 (lex "f(x)x+1"))
 
 (test-group "Recursive macros"
-  (let ((env (resolve-define (make-environment)
+  (let ((env (handle-define-directive (make-environment)
                              (lex "x x"))))
     (test-equal "Macro expanding to itself leaves the token"
-      (mark-noexpand (lex "x") "x")
-      ((unval resolve-token-stream 1) env (lex "x"))))
+      (mark-noexpand "x" (lex "x"))
+      (-> (resolve-token-stream env (lex "x"))
+          (value-ref 1))))
 
   ;; 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)")))))
+                 (handle-define-directive (lex "f(a) a*g"))
+                 (handle-define-directive (lex "g(a) f(a)")))))
     (test-equal "Mutual recursion with two function like macros"
       (lex "2*f(9)")
-      (remove-noexpand ((unval resolve-token-stream 1) env (lex "f(2)(9)")))))
+      (-> (resolve-token-stream env (lex "f(2)(9)"))
+          (value-ref 1)
+          remove-noexpand)))
 
   (let ((env (-> (make-environment)
-                 (resolve-define (lex "f 2 * g"))
-                 (resolve-define (lex "g(x) x + f")))))
+                 (handle-define-directive (lex "f 2 * g"))
+                 (handle-define-directive (lex "g(x) x + f")))))
     (test-equal "Mutual recursion with object and function like macro"
       (lex "2 * 10 + f")
-      (remove-noexpand ((unval resolve-token-stream 1) env (lex "f(10)")))))
+      (-> (resolve-token-stream env (lex "f(10)"))
+          (value-ref 1)
+          remove-noexpand)))
 
   (let ((env (-> (make-environment)
-                 (resolve-define (lex "x 2*y"))
-                 (resolve-define (lex "y 3*x")))))
+                 (handle-define-directive (lex "x 2*y"))
+                 (handle-define-directive (lex "y 3*x")))))
     (test-equal "Mutual recursion with two object likes"
       (lex "2*3*x")
-      (remove-noexpand ((unval resolve-token-stream 1) env (lex "x"))))))
+      (-> (resolve-token-stream env (lex "x"))
+          (value-ref 1)
+          remove-noexpand))))
 
 
 
@@ -622,7 +562,7 @@
       '(("*outside*" . 9))
       (cpp-file-stack
        (handle-line-directive
-        (resolve-define e (lex "x 10"))
+        (handle-define-directive e (lex "x 10"))
         (lex "x"))))))
 
 
@@ -991,10 +931,10 @@ char c[2][6] = { str(hello), str() };"))
   (test-group "Example 3"
     (test-equal "Subtest 1, is result of function application further macro expanded?"
       (unlex-aggressive (lex "f(2 * (0,1))"))
-      ((unval handle-preprocessing-tokens 1) (make-environment) (tokenize "
+      (value-ref (handle-preprocessing-tokens (make-environment) (tokenize "
 #define m(a) a(0,1)
 #define f(a) f(2 * (a))
-m(f)")))
+m(f)")) 1))
 
 
     (test-equal "True test"