work

3 files changed, 491 insertions, 150 deletions

diff --git a/module/c/cpp-environment.scm b/module/c/cpp-environment.scm
index 51f16168..fa69e1fc 100644
--- a/module/c/cpp-environment.scm
+++ b/module/c/cpp-environment.scm
@@ -15,6 +15,7 @@
            macro-identifier-list
            macro-variadic?
            macro?
+           ;; pprint-macro
 
            enter-active-if
            enter-inactive-if
@@ -31,13 +32,14 @@
            internal-macro?
 
            cpp-environment
+           cpp-environment?
            cpp-if-status cpp-variables
 
            make-environment in-environment?
            remove-identifier! add-identifier!
            get-identifier
            extend-environment
-
+           disjoin-macro
            ))
 
 (define (macro-identifier x)
@@ -73,6 +75,9 @@
       (fun:function-like-macro? x)
       (int:internal-macro? x)))
 
+
+
+
 (define-type (cpp-environment)
   (cpp-if-status type: (list-of (memv '(outside active-if inactive-if)))
                  default: '(outside))
@@ -81,6 +86,7 @@
                              (list-of (pair-of string? exact-integer?)))
                   default: '(("*outside*" . 1))))
 
+
 
 
 (define (enter-active-if environment)
@@ -112,7 +118,13 @@
 
 (define (make-environment) (cpp-environment))
 
-(define (in-envirnoment? environment key)
+(define (clone-hash-table ht)
+  (alist->hash-table (hash-map->list cons ht)))
+
+(define (clone-environment environment)
+  (modify environment cpp-variables clone-hash-table))
+
+(define (in-environment? environment key)
   (hash-get-handle (cpp-variables environment) key))
 
 (define (remove-identifier! environment key)
@@ -134,11 +146,15 @@
 (define (get-identifier environment key)
   (hash-ref (cpp-variables environment) key))
 
-(define (clone-hash-table ht)
-  (alist->hash-table (hash-map->list cons ht)))
 
 (define (extend-environment environment macros)
-  (let ((env (modify environment cpp-variables clone-hash-table)))
+  (typecheck macros (list-of macro?))
+  (let ((env (clone-environment environment)))
     (fold (lambda (m env) (add-identifier! env (macro-identifier m) m))
           env macros)))
 
+(define (disjoin-macro environment name)
+  (typecheck name string?)
+  (let ((env (clone-environment environment)))
+    (remove-identifier! env name)
+    env))
diff --git a/module/c/preprocessor2.scm b/module/c/preprocessor2.scm
index e99b1049..0bb101f8 100644
--- a/module/c/preprocessor2.scm
+++ b/module/c/preprocessor2.scm
@@ -5,21 +5,58 @@
   :use-module (ice-9 match)
   :use-module (c cpp-environment)
   :use-module (c eval2)
-  :use-module ((c cpp-environment function-like-macro) :select (function-like-macro))
+  :use-module ((c cpp-environment function-like-macro)
+               :select (function-like-macro variadic? identifier-list))
   :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 (->))
+  :use-module ((hnh util) :select (-> intersperse))
   :use-module ((hnh util lens) :select (set))
   :use-module (hnh util path)
+  :use-module (hnh util type)
   :use-module ((c lex2) :select (lex))
   :use-module ((c trigraph) :select (replace-trigraphs))
   :use-module ((c line-fold) :select (fold-lines))
   :export ())
 
+;;; Call graph
+;; squeeze-whitespace
+;; stringify-tokens
+;; expand-join
+;; build-parameter-map
+
+;; apply-macro
+;; - build-parameter-map
+;; - stringify-tokens
+;; - expand-join
+
+;; expand-macro
+;; - parse-parameter-list
+;; - apply-macro
+
+;; parse-parameter-list
+
+;; resolve-token-stream
+;; - maybe-extend-identifier
+
+;; maybe-extend-identifier
+;; - expand-macro
+
+;; resolve-define
+;; - parse-identifier-list
+
+;; expand-stringifiers
+;; - stringify-tokens
+
+;;;
+
+(define-syntax-rule (parameter-map? x)
+  (typecheck x (list-of (pair-of string? (list-of token?)))))
+
 ;; Returns two values:
 ;; - tokens until a newline token is met
 ;; - (potentially the newline token) and the remaining tokens
 (define (tokens-until-eol tokens)
+  (typecheck tokens (list-of token?))
   (break (lambda (token) (equal? token '(whitespace "\n")))
          tokens))
 
@@ -29,6 +66,11 @@
     (`(whitespace ,_) #t)
     (_ #f)))
 
+(define (identifier-token? token)
+  (match token
+    (`(preprocessing-token (identifier ,id)) id)
+    (_ #f)))
+
 (define (unwrap-preprocessing-token token)
   (match token
     (`(preprocessing-token ,x) x)
@@ -41,6 +83,10 @@
     (lambda () (unwrap-preprocessing-token token))
     (const #f)))
 
+(define (token? x)
+  (or (preprocessing-token? x)
+      (whitespace-token? x)))
+
 
 ;; Replace all whitespace with single spaces.
 (define (squeeze-whitespace tokens)
@@ -68,43 +114,70 @@
      (format #f "'~a'" c))
     (`(punctuator ,p) p)))
 
+;; takes a token list, and return a single string literal token
 (define (stringify-tokens tokens)
-  `(preprocessing-token
-    (string-literal
-     ,(string-concatenate
-       (map (match-lambda (`(preprocessing-token ,body) (stringify-token body))
-                          (`(whitespace ,_) " "))
-            (squeeze-whitespace tokens))))))
+  `(preprocessing-token (string-literal ,(unlex tokens))))
+
+;; takes a list of preprocessing-token's, and return a "source" string
+(define (unlex tokens)
+  (typecheck tokens (list-of token?))
+  (string-concatenate
+   (map (match-lambda (`(preprocessing-token ,body) (stringify-token body))
+                      (`(whitespace ,_) " "))
+        (squeeze-whitespace tokens))))
+
 
 ;; Expand ## tokens
 ;; TODO
 (define (expand-join macro tokens)
+  (typecheck macro macro?)
+  (typecheck tokens (list-of token?))
   tokens)
 
 ;; parameters is a lexeme list, as returned by parse-parameter-list
 (define (build-parameter-map macro parameters)
+  (typecheck macro macro?)
+  (typecheck parameters (list-of (list-of token?)))
   (if (macro-variadic? macro)
       (let ((head rest (split-at parameters (length (macro-identifier-list macro)))))
-        ;; TODO commas (,) should be interleaved with rest
-        (cons (cons "__VA_ARGS__" rest)
+        (cons (cons "__VA_ARGS__" (concatenate (intersperse
+                                                '((preprocessing-token (punctuator ",")))
+                                                rest)))
               (map cons (macro-identifier-list macro) head)))
       (map cons
            (macro-identifier-list macro)
            parameters)))
 
+
+;; TODO Deprecate?
+(define (parameter-map->macro-list param-map)
+  (typecheck param-map parameter-map?)
+  (map (lambda (pair)
+         (let ((identifier (car pair))
+               (body (cdr pair)))
+           (object-like-macro
+            identifier: identifier
+            body: body)))
+       param-map))
+
 ;; Drop leading whitespace tokens
 (define (drop-whitespace tokens)
+  (typecheck tokens (list-of token?))
   (drop-while whitespace-token? tokens))
 
 (define (drop-whitespace-right tokens)
+  (typecheck tokens (list-of token?))
   (-> tokens reverse drop-whitespace reverse))
 
 (define (drop-whitespace-both tokens)
+  (typecheck tokens (list-of token?))
   (-> tokens
       drop-whitespace
       drop-whitespace-right))
 
 (define (expand-stringifiers macro parameter-map)
+  (typecheck macro macro?)
+  (typecheck parameter-map parameter-map?)
   (let loop ((tokens (macro-body macro)))
     (match tokens
       (('(preprocessing-token (punctuator "#"))
@@ -123,13 +196,45 @@
 
 ;; expand function like macro
 (define (apply-macro environment macro parameters)
-  (define parameter-map (build-parameter-map macro parameters))
-  (define stringify-resolved (expand-stringifiers macro parameter-map))
-  ;; TODO resolve ##
-  (define resulting-body stringify-resolved #; (expand-join macro stringify-resolved)
-    )
-  (resolve-token-stream (extend-environment environment parameter-map)
-                        resulting-body))
+  (typecheck environment cpp-environment?)
+  ;; Each element should be the lexeme list for that argument
+  (typecheck parameters (list-of (list-of token?)))
+  (typecheck macro macro?)
+  (when (or (and (variadic? macro)
+                 (> (length (identifier-list macro))
+                    (length parameters)))
+            (and (not (variadic? macro))
+                 (not (= (length (identifier-list macro))
+                         (length parameters)))))
+    (scm-error 'cpp-arity-error "apply-macro"
+               ;; TODO better error message for variadic macros
+               "Wrong number of arguments to macro ~s, expected ~s, got ~s"
+               (list (macro-identifier macro)
+                     (length (identifier-list macro))
+                     (length parameters))
+               (list macro)))
+  (let ()
+    (define parameter-map (build-parameter-map macro parameters))
+    (define stringify-resolved (expand-stringifiers macro parameter-map))
+    ;; TODO resolve ##
+    (define resulting-body stringify-resolved #; (expand-join macro stringify-resolved))
+    (define (bound-identifier? id)
+      (member id (if (variadic? macro)
+                     (cons "__VA_ARGS__" (identifier-list macro))
+                     (identifier-list macro))))
+    (let loop ((tokens resulting-body))
+      (cond ((null? tokens) '())
+            ;; TODO the parameters should be macro-expanded before being inserted
+            ((identifier-token? (car tokens))
+             bound-identifier?
+             => (lambda (id) (append (assoc-ref parameter-map id)
+                                (loop (cdr tokens)))))
+            (else (cons (car tokens)
+                        (loop (cdr tokens))))))
+    #;
+    (let ((env (extend-environment environment
+                                   (parameter-map->macro-list parameter-map))))
+      (resolve-token-stream env resulting-body))))
 
 
 
@@ -142,28 +247,32 @@
 ;; ⇒ "VALUE"
 
 ;; token should be the token stream just after the name of the macro
-(define (expand-macro environment macro tokens)
-  (cond ((object-macro? macro)
-         ;; Shouldn't we expand the macro body here?
-         (values environment (append (macro-body macro) tokens)))
-
-        ((function-macro? macro)
-         (let ((containing remaining newlines (parse-parameter-list tokens)))
-           (values (bump-line environment newlines)
-                   ;; Macro output can be macro expanded
-                   ;; TODO self-referential macros?
-                   (append (apply-macro environment macro containing) remaining))))
-
-        ((internal-macro? macro)
-         (let ((containing remaining newlines (parse-parameter-list tokens)))
-           (values (bump-line environment newlines)
-                   (append ((macro-body macro) environment containing)
-                           remaining))))
-
-        (else
-         (scm-error 'wrong-type-arg "expand-macro"
-                    "Macro isn't a macro: ~s"
-                    (list macro) #f))))
+(define (expand-macro environment macro remaining-tokens)
+  (typecheck environment cpp-environment?)
+  (typecheck remaining-tokens (list-of token?))
+  (let ((name (macro-identifier macro)))
+   (cond ((object-macro? macro)
+          (values environment (append (mark-noexpand (macro-body macro) name)
+                                      remaining-tokens)))
+
+         ((function-macro? macro)
+          (let ((containing remaining newlines (parse-parameter-list remaining-tokens)))
+            (values (bump-line environment newlines)
+                    (append (mark-noexpand (apply-macro environment macro containing)
+                                           name)
+                            remaining))))
+
+         ((internal-macro? macro)
+          (let ((containing remaining newlines (parse-parameter-list remaining-tokens)))
+            (values (bump-line environment newlines)
+                    (append (mark-noexpand ((macro-body macro) environment containing)
+                                           name)
+                            remaining))))
+
+         (else
+          (scm-error 'wrong-type-arg "expand-macro"
+                     "Macro isn't a macro: ~s"
+                     (list macro) #f)))))
 
 ;; Takes a list of preprocessing tokens, and returns two values
 ;; if the last token was '...'
@@ -171,6 +280,7 @@
 ;; Note that this is ONLY #define f(x) forms
 ;; not usage forms
 (define (parse-identifier-list tokens)
+  (typecheck tokens (list-of token?))
   (let loop ((tokens (remove whitespace-token? tokens)) (done '()))
     (match tokens
       ('() (values #f (reverse done)))
@@ -205,6 +315,7 @@
 ;; "( 2, 4 )"
 ;; 6.10.3.2 p 2
 (define (cleanup-whitespace tokens)
+  (typecheck tokens (list-of token?))
   (-> tokens drop-whitespace-both squeeze-whitespace))
 
 ;; returns three values:
@@ -212,9 +323,10 @@
 ;; - the remaining tokenstream
 ;; - how many newlines were encountered
 ;; The standard might call these "replacement lists"
-(define (parse-parameter-list tokens)
+(define (parse-parameter-list tokens*)
+  (typecheck tokens* (list-of token?))
   (let %loop ((depth 0) (newlines 0) (current '())
-              (parameters '()) (tokens tokens) (%first-iteration? #t))
+              (parameters '()) (tokens tokens*) (%first-iteration? #t))
     (define* (loop tokens key:
                    (depth depth) (newlines newlines)
                    (current current) (parameters parameters))
@@ -223,6 +335,9 @@
                         current
                         (cons (car tokens) current))))
       (match tokens
+        (() (scm-error 'misc-error "parse-parameter-list"
+                       "Ran out of tokens while parsing: ~s"
+                       (list tokens*) #f))
         (('(whitespace "\n") rest ...)
          (loop rest newlines: (1+ newlines) current: current*))
         ((`(whitespace ,_) rest ...)
@@ -264,6 +379,7 @@
          (loop rest current: current*))))))
 
 
+;; Add __FILE__ and __LINE__ object macros to the environment
 (define (join-file-line environment)
   (define file (current-file environment))
   (define line (current-line environment))
@@ -282,6 +398,7 @@
 
 ;; #include <stdio.h>
 (define (resolve-h-file string)
+  (typecheck string string?)
   (cond ((path-absolute? string) string)
         (else
          (let ((filename
@@ -296,6 +413,7 @@
 
 ;; #include "myheader.h"
 (define (resolve-q-file string)
+  (typecheck string string?)
   ;; This should always be a fallback (6.10.2, p. 3)
   (cond (else (resolve-h-file string))))
 
@@ -304,8 +422,9 @@
    identifier: "defined"
    body: (lambda (environment tokens)
            (match tokens
-             (`((preprocessing-token (identifier ,id)))
-              `(preprocessing-token (pp-number ,(boolean->c-boolean (in-environment? environment id)))))
+             (`(((preprocessing-token (identifier ,id))))
+              (let ((in-env (boolean->c-boolean (in-environment? environment id))))
+                (lex (number->string in-env))))
              (_ (scm-error 'cpp-error "defined"
                            "Invalid parameter list to `defined': ~s"
                            (list tokens) #f))))))
@@ -334,26 +453,94 @@
 
 ;; TODO
 (define (resolve-constant-expression tokens)
+  (typecheck tokens (list-of token?))
   'TODO
   )
 
+(define* (pprint-macro x optional: (p (current-output-port)))
+  (cond ((internal-macro? x)
+         (format p "/* ~a INTERNAL MACRO */"
+                 (macro-identifier x)))
+        ((object-macro? x)
+         (format p "#define ~a ~a"
+                 (macro-identifier x)
+                 (unlex (macro-body x))))
+        ((function-macro? x)
+         (format p "#define ~a(~a) ~a"
+                 (macro-identifier x)
+                 (string-join (macro-identifier-list x) "," 'infix)
+                 (unlex (macro-body x))))))
+
+(define* (pprint-environment environment optional: (port (current-error-port)))
+  (display "== Environment ==\n")
+  (hash-for-each (lambda (key macro)
+                   (pprint-macro macro port)
+                   (newline port))
+                 (cpp-variables environment)))
+
+(define noexpand (make-object-property))
+
+(define (mark-noexpand tokens name)
+  (typecheck tokens (list-of token?))
+  (typecheck name string?)
+  (let ((tokens tokens))
+    (for-each (lambda (token) (set! (noexpand token) (cons name (noexpand token)))) tokens)
+    tokens))
+
+(define (list-like->list x)
+  (if (not (pair? x))
+      (list x)
+      (cons (car x) (list-like->list (cdr x)))))
+
+(define (marked-noexpand? token)
+  (cond ((identifier-token? token)
+         => (lambda (id) (member id (list-like->list (noexpand token)))))
+        (else #f)))
+
 ;; Expands a token-stream which contains no pre-processing directives (#if:s, ...)
 (define (resolve-token-stream environment tokens)
-  (let loop ((tokens tokens))
+  (typecheck environment cpp-environment?)
+  (typecheck tokens (list-of token?))
+  ;; (pprint-environment environment)
+  ;; (format (current-error-port) "~a~%~%" (unlex tokens))
+  (let loop ((environment environment) (tokens tokens))
+    (unless (null? tokens)
+      (format (current-error-port) "~s [~a] [~a]~%"
+              (car tokens)
+              (noexpand (car tokens))
+              (marked-noexpand? (car tokens))))
+    (format (current-error-port) "~a~%" (unlex tokens))
+    (cond ((null? tokens) '())
+          ((car tokens)
+           (lambda (x) (and (identifier-token? x)
+                       (not (marked-noexpand? x))))
+           => (lambda (token)
+                (call-with-values
+                    (lambda () (maybe-extend-identifier environment
+                                                   (identifier-token? token)
+                                                   (cdr tokens)))
+                  loop)))
+          (else (cons (car tokens)
+                      (loop environment (cdr tokens))))
+          )
+    #;
     (match tokens
       ('() '())
       ((`(preprocessing-token (identifier ,id)) rest ...)
        (call-with-values (lambda () (maybe-extend-identifier environment id rest))
-         (lambda (_ tokens) (loop tokens))))
-      ((`(whitespace ,_) rest ...)
-       (loop rest))
+                        loop))
+      ;; ((`(whitespace ,_) rest ...)
+      ;;  (loop environment rest))
       ((token rest ...)
-       (cons token (loop rest))))))
+       (cons token (loop environment rest))))))
 
 ;; returns a new environment
 ;; handle body of #if
 ;; environment, (list token) → environment
 (define (resolve-for-if environment tokens)
+  (typecheck environment cpp-environment?)
+  (typecheck tokens (list-of token?))
+
   (-> (extend-environment environment defined-macro)
       (resolve-token-stream tokens)
       resolve-constant-expression
@@ -363,15 +550,24 @@
 
 ;; environment, string, (list token) → environment, (list token)
 (define (maybe-extend-identifier environment identifier remaining-tokens)
+  (typecheck environment cpp-environment?)
+  (typecheck identifier string?)
+  (typecheck remaining-tokens (list-of token?))
+  ;; (typecheck continuation procedure?)   ; TODO arity?
   (cond ((get-identifier environment identifier)
          => (lambda (value) (expand-macro (join-file-line environment)
                                      value
                                      remaining-tokens)))
         (else                      ; It wasn't an identifier, leave it as is
-         ;; TODO shouldn't we include the identifier in the remaining tokens stream?
-         (values environment remaining-tokens))))
+         (values environment
+                 (append (mark-noexpand `((preprocessing-token (identifier ,identifier)))
+                                        identifier)
+                         remaining-tokens)))))
 
 (define (resolve-and-include-header environment tokens)
+  (typecheck environment cpp-environment?)
+  (typecheck tokens (list-of token?))
+
   (let loop ((%first-time #t) (tokens tokens))
     (match (drop-whitespace tokens)
       ((`(header-name (h-string ,str)) rest ...)
@@ -406,6 +602,9 @@
 
 ;; environment, tokens → environment
 (define (handle-line-directive environment tokens*)
+  (typecheck environment cpp-environment?)
+  (typecheck tokens* (list-of token?))
+
   (let loop ((%first-time #t) (tokens tokens*))
     (match tokens
       (`((preprocessing-token (pp-number ,line)) (whitespace ,_) ... rest ...)
@@ -429,6 +628,9 @@
 
 ;; environment, tokens → environment
 (define (resolve-define environment tokens)
+  (typecheck environment cpp-environment?)
+  (typecheck tokens (list-of token?))
+
   (match tokens
     ((`(preprocessing-token (identifier ,identifier)) tail ...)
      (-> environment
@@ -438,20 +640,22 @@
           (match tail
             (('(preprocessing-token (punctuator "(")) rest ...)
              ;; function like macro
-             (call-with-values (lambda () (break (lambda (token) (equal? token '(preprocessing-token (punctuator ")"))))
-                                            rest))
-               (lambda (identifier-list replacement-list)
-                 (let ((variadic? identifiers (parse-identifier-list identifier-list)))
-
-                   (function-like-macro
-                    identifier: identifier
-                    variadic?: variadic?
-                    identifier-list: identifiers
-                    ;; NOTE 6.10.3 states that there needs to be at least on whitespace here
-                    body: (cdr replacement-list))))))
+             (let ((identifier-list
+                    replacement-list
+                    (break (lambda (token) (equal? token '(preprocessing-token (punctuator ")"))))
+                           rest)))
+               (let ((variadic? identifiers (parse-identifier-list identifier-list)))
+                 (function-like-macro
+                  identifier: identifier
+                  variadic?: variadic?
+                  identifier-list: identifiers
+                  ;; NOTE 6.10.3 states that there needs to be at least on whitespace here
+                  ;; cdr drops the end parenthesis of the definition
+                  ;; surrounding whitespace is not part of the replacement list (6.10.3 p.7)
+                  body: (drop-whitespace-both (cdr replacement-list))))))
             (_ (object-like-macro
                 identifier: identifier
-                body: tail))))))))
+                body: (drop-whitespace-both tail)))))))))
 
 
 
@@ -548,8 +752,7 @@
                         remaining-tokens)))))))
 
       ((`(preprocessing-token (identifier ,id)) rest ...)
-       (call-with-values (lambda () (maybe-extend-identifier environment id rest))
-                         loop))
+       (maybe-extend-identifier environment id rest loop))
 
       (('(whitespace "\n") rest ...)
        (cons '(whitespace "\n") (loop (bump-line environment) rest)))
@@ -558,11 +761,6 @@
 
 
 
-(define (comment->whitespace expr)
-  (match expr
-    (('comment _) '(whitespace " "))
-    (other other)))
-
 (define (read-file path)
   (call-with-input-file path (@ (ice-9 rdelim) read-string)))
 
diff --git a/tests/test/cpp/preprocessor2.scm b/tests/test/cpp/preprocessor2.scm
index 3d62e224..75e29834 100644
--- a/tests/test/cpp/preprocessor2.scm
+++ b/tests/test/cpp/preprocessor2.scm
@@ -4,29 +4,27 @@
   :use-module (srfi srfi-64 test-error)
   :use-module (srfi srfi-71)
   :use-module (srfi srfi-88)
-  :use-module ((hnh util) :select (unval))
+  :use-module ((hnh util) :select (-> unval))
   :use-module (c preprocessor2)
   :use-module (c cpp-environment)
   :use-module (c cpp-environment function-like-macro)
   :use-module (c cpp-environment object-like-macro)
   :use-module (c lex2))
 
-;; TODO Not yet implemented
-;; (test-expect-fail (test-match-group "Stringify"))
-;; (test-expect-fail
-;;  (test-match-all (test-match-group "Expand stringifiers")
-;;                  (test-match-name "Correct stringification of one param")))
 
+;; arbitrary tokens useful in tests for checking that values are returned correctly
+(define before (car (lex "before")))
+(define after (car (lex "after")))
 
 (define tokens-until-eol (@@ (c preprocessor2) tokens-until-eol))
 (test-group "Tokens until End Of Line"
   (call-with-values
       (lambda ()
         (tokens-until-eol
-         '(before (whitespace "\n") after)))
+         (list before '(whitespace "\n") after)))
     (lambda (bef aft)
-      (test-equal '(before) bef)
-      (test-equal '((whitespace "\n") after) aft))))
+      (test-equal (list before) bef)
+      (test-equal (list '(whitespace "\n") after) aft))))
 
 
 
@@ -178,7 +176,7 @@
 
   (test-group "Rest arguments"
     (test-equal "Single simple"
-      `(("__VA_ARGS__" . ,(list (lex "x"))))
+      `(("__VA_ARGS__" . ,(lex "x")))
       (let ((m (function-like-macro
                 identifier: "str"
                 identifier-list: '()
@@ -187,18 +185,15 @@
         (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")))))
-    ))
-
+         m (list (lex "x,y")))))))
 
 
 (test-group "Expand stringifiers"
@@ -250,18 +245,20 @@
 
   (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")))
+      (lex "10")
+      (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")))
+      (lex "10 1")
+      (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")
@@ -272,8 +269,7 @@
                                                       (object-like-macro
                                                        identifier: "y"
                                                        body: (lex "20"))))
-                            (lex "x y")))
-    )
+                            (lex "x y"))))
 
   ;; TODO
 
@@ -314,42 +310,40 @@
       ))
 
 
-(test-group "Maybe extend identifier"
-  (test-equal "Non-identifier returns remaining"
-    '() ((unval maybe-extend-identifier 1)
-         (make-environment)
-         "x"
-         '()))
-
-  (test-equal "Non-identifiers remaining tokens are returned verbatim"
-    '(remaining) ((unval maybe-extend-identifier 1)
-                  (make-environment)
-                  "x"
-                  '(remaining)))
-
-  (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"
-     '()))
-
-  (test-equal "Object like macro still returns remaining verbatim"
-    (append (lex "1 + 2") '(remaining))
-    ((unval maybe-extend-identifier 1)
-     (extend-environment (make-environment)
-                         (list
-                          (object-like-macro
-                           identifier: "x"
-                           body: (lex "1 + 2"))))
-     "x"
-     '(remaining)))
+  (test-group "Maybe extend identifier"
+    (test-equal "Non-identifier returns remaining"
+      (lex "x")
+      ((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)))
+
+    (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"
+       '()))
 
-  )
+    (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)))
+
+    )
 
   (test-group "Apply macro"
     (test-equal "zero arg macro on nothing"
@@ -368,23 +362,156 @@
        (function-like-macro identifier: "f"
                             identifier-list: '("x")
                             body: (lex "x"))
-       (lex "10"))))
+       ((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)")))))
 
   (test-group "Expand macro part 2"
     (test-group "Function like macros"
-      (let ((e (make-environment))
-            (m (function-like-macro
-                identifier: "f"
-                identifier-list: '()
-                body: (lex "1"))))
-        (call-with-values (lambda () (expand-macro e m (lex "()")))
-          (lambda (_ tokens*) (test-equal (lex "1") tokens*)))
-        ;; TODO this should raise an arity error
-        (call-with-values (lambda () (expand-macro e m (lex "(10)")))
-          (lambda (_ tokens*) (test-equal '() tokens*)))))))
+      (let ((e (make-environment)))
+        (let ((m (function-like-macro
+                  identifier: "f"
+                  identifier-list: '()
+                  body: (lex "1"))))
+          (call-with-values (lambda () (expand-macro e m (lex "()")))
+            (lambda (_ tokens*) (test-equal (lex "1") tokens*)))
+          (test-error "Arity error for to many args"
+            '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*)))
+          (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*)))
+          )
+        ))))
+
+(let ((e (make-environment)))
+  (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)")))
+
+    (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)"))
+      )
+
+    (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")))
+
+    (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)")))
+
+    "
+#define f(x) g(x)
+#define g(y) y
+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)")))
+
+
+
+    (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")))))
+
+(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)")))
+    (test-equal "defined(DEFINED)"
+      (lex "1") (resolve-token-stream
+                 (extend-environment
+                  e (list (object-like-macro identifier: "X"
+                                             body: (lex "10"))))
+                 (lex "defined(X)")))))
+
+
+(let ((env (resolve-define (make-environment)
+                           (lex "f(x) x+1"))))
+  (test-assert "New binding added" (in-environment? env "f"))
+  (let ((m (get-identifier env "f")))
+    (test-equal "Macro parameters" '("x") (macro-identifier-list m))
+    (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)
+;;                 (lex "f(x)x+1"))
 
-(define apply-macro (@@ (c preprocessor2) apply-macro))
+;; (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)"))))
 
-;; (resolve-define (make-environment)
-;;                 (lex "f(x) x+1"))
+
+
+;; resolve-h-file
+;; resolve-q-file
+;; handle-pragma