work.

5 files changed, 236 insertions, 156 deletions

diff --git a/module/c/compiler.scm b/module/c/compiler.scm
index 121e6c07..801c3752 100644
--- a/module/c/compiler.scm
+++ b/module/c/compiler.scm
@@ -2,14 +2,17 @@
   :use-module ((c lex2) :select (lex))
   :use-module ((c trigraph) :select (replace-trigraphs))
   :use-module ((c line-fold) :select (fold-lines))
+  :use-module (c cpp-environment object-like-macro)
+  :use-module ((c cpp-environment)
+               :select (make-environment
+                         extend-environment
+                         enter-file))
   :use-module (hnh util)
+  ;; TODO importort
+  ;; handle-preprocessing-tokens
+  ;; load-and-tokenize-file
   :export (run-compiler))
 
-(define (comment->whitespace expr)
-  (match expr
-    (('comment _) '(whitespace " "))
-    (other other)))
-
 "
 #define __STDC__ 1
 #define __STDC_HOSTED__ 1
@@ -36,17 +39,15 @@
     body: `(preprocessing-token (string-literal ,(strftime "%b %_d %Y" now))))
    (object-like-macro
     identifier: "__TIME__"
-    body: (preprocessing-token
-           (string-literal
-            ,(strftime "%H:%M:%S" now))))))
+    body: `(preprocessing-token
+            (string-literal
+             ,(strftime "%H:%M:%S" now))))))
 
 (define environment
   (-> (make-environment)
       (extend-environment default-macros)))
 
 
-(define (read-file path)
-  (call-with-input-file path read-string))
 
 ;;; 5.1.11.2 Translation phases
 
diff --git a/module/c/cpp-environment.scm b/module/c/cpp-environment.scm
index 20589b8e..3ce754df 100644
--- a/module/c/cpp-environment.scm
+++ b/module/c/cpp-environment.scm
@@ -43,7 +43,10 @@
   (define identifier
    (cond ((obj:object-like-macro? x)   obj:identifier)
          ((fun:function-like-macro? x) fun:identifier)
-         ((int:internal-macro? x)      int:identifier)))
+         ((int:internal-macro? x)      int:identifier)
+         (else (scm-error 'wrong-type-arg "macro-identifier"
+                          "Not a macro: ~s"
+                          (list x) #f))))
   (identifier x))
 
 
@@ -51,7 +54,10 @@
   (define body-proc
     (cond ((obj:object-like-macro? macro)   obj:body)
           ((fun:function-like-macro? macro) fun:body)
-          ((int:internal-macro? macro)      int:body)))
+          ((int:internal-macro? macro)      int:body)
+          (else (scm-error 'wrong-type-arg "macro-body"
+                           "Not a macro: ~s"
+                           (list macro) #f))))
   (body-proc macro))
 
 (define macro-identifier-list fun:identifier-list)
@@ -69,9 +75,10 @@
 (define-type (cpp-environment)
   (cpp-if-status type: (list-of (memv '(outside active-if inactive-if)))
                  default: '(outside))
-  (cpp-variabes type: hash-table? default: (make-hash-table))
-  (cpp-file-stack type: list?
-                  default: '()))
+  (cpp-variables type: hash-table? default: (make-hash-table))
+  (cpp-file-stack type: (and ((negate null?))
+                             (list-of (pair-of string? exact-integer?)))
+                  default: '(("*outside*" . 1))))
 
 
 
@@ -116,7 +123,7 @@
     (scm-error 'wrong-type-arg "add-identifier!"
                "Key must be a string, got: ~s"
                (list key) #f))
-  (unless (macro? key)
+  (unless (macro? value)
     (scm-error 'wrong-type-arg "add-identifier!"
                "Value must be a macro, got: ~s"
                (list value) #f))
@@ -131,7 +138,6 @@
 
 (define (extend-environment environment macros)
   (let ((env (modify environment cpp-variables clone-hash-table)))
-    (fold (lambda (pair m)
-            (add-identifier! env (macro-identifier m) m ))
+    (fold (lambda (m env) (add-identifier! env (macro-identifier m) m))
           env macros)))
 
diff --git a/module/c/lex2.scm b/module/c/lex2.scm
index 23fa9da4..6083190f 100644
--- a/module/c/lex2.scm
+++ b/module/c/lex2.scm
@@ -144,7 +144,7 @@
       hexadecimal-floating-constant))
 
 ;; (6.4.4.2)
-(define-peg-pattern floating-constant all
+(define-peg-pattern decimal-floating-constant all
   (or (and fractional-constant (? exponent-part) (? floating-suffix))
       (and digit-sequence exponent-part (? floating-suffix))))
 
@@ -253,10 +253,12 @@
 
 ;; (6.4.6)
 (define-peg-pattern punctuator all
-  (or "[" "]" "(" ")" "{" "}" "." "->"
+  (or "[" "]" "(" ")" "{" "}"
+      "..."                             ; Moved to be before "."
+      "." "->"
       "++" "--" "&" "*" "+" "-" "~" "!"
       "/" "%" "<<" ">>" "<" ">" "<=" ">=" "==" "!=" "^" "|" "&&" "||"
-      "?" ":" ";" "..."
+      "?" ":" ";"
       "=" "*=" "/=" "%=" "+=" "-=" "<<=" ">>=" "&=" "^=" "|="
       "," "#" "##"
       "<:" ":>" "<%" "%>" "%:" "%:%:"))
@@ -313,11 +315,12 @@
 (define-peg-pattern comment all
   (or line-comment block-comment))
 
-(define-peg-pattern preprocessing-tokens body
+(define-peg-pattern preprocessing-tokens all
   (* (or whitespace
          comment
          preprocessing-token)))
 
 
+;; returns a list of lexemes
 (define (lex string)
-  (peg:tree (match-pattern preprocessing-tokens string)))
+  (cdr (peg:tree (match-pattern preprocessing-tokens string))))
diff --git a/module/c/preprocessor.scm b/module/c/preprocessor.scm
index 49ecfa27..71712b17 100644
--- a/module/c/preprocessor.scm
+++ b/module/c/preprocessor.scm
@@ -139,27 +139,6 @@
   (every predicate lst))
 
 
-(define-type (cpp-environment)
-  (cpp-if-status type: (list-of? (lambda (x) (memv x '(outside active-if inactive-if))))
-                 ;; type: (list-of? (memv '(outside active-if inactive-if)))
-                 default: '(outside))
-  (cpp-variabes type: hash-table? default: (make-hash-table)))
-
-(define (make-environment) (cpp-environment))
-
-(define (in-envirnoment? environment key)
-  (hash-get-handle (cpp-variables environment) key))
-
-(define (remove-identifier! environment key)
-  (hash-remove! (cpp-variables environment) key)
-  environment)
-
-(define (add-identifier! environment key value)
-  (assert (string? key))
-  (assert (macro? value))
-  (hash-set! (cpp-variables environment) key value)
-  environment)
-
 ;; Parantheses when defining macro
 (define (parse-parameter-string string)
   (map string-trim-both
@@ -174,15 +153,12 @@
   (formals type: (list-of? string?))
   (body type: string?))
 
-(define (macro? x)
-  (or (object-macro? x)
-      (function-macro? x)))
 
 ;; The interesting part
 ;; environment, (list string) -> (values (list string) (list strings))
 ;; multiple lines since since a function-like macro can extend over multiple lines
-(define (expand-macros environment strings)
-  )
+;; (define (expand-macros environment strings)
+;;   )
 
 
 (define (crash-if-not-if body guilty)
@@ -235,7 +211,7 @@
                  ((elif)
                   (case (car (cpp-if-status environment))
                     ((outside) (crash-if-not-if (directive-body m) "elif"))
-                    (else ;; TODO
+                    (else 'TODO ;; TODO
                      )
                     ))
 
@@ -272,7 +248,7 @@
                                                  xcons 'inactive-if)
                                          (cdr lines)
                                          done))
-                    (else ;; TODO
+                    (else 'TODO ;; TODO
                      )))
 
 
@@ -286,7 +262,7 @@
                                                           ((#\") (handle-file environment filename))))))
                                    (else (scm-error 'cpp-error "parse-directives"
                                                     "Invalid include"
-                                                    '() #f))))
+                                                    '() #f)))))
                   ((define)
                    ;; TODO what are valid names?
                    (cond ((string-match "^(\\w+)([(][^)]*[)])?\\s+(.*)" (directive-body directive?))
diff --git a/module/c/preprocessor2.scm b/module/c/preprocessor2.scm
index 19daabfb..e99b1049 100644
--- a/module/c/preprocessor2.scm
+++ b/module/c/preprocessor2.scm
@@ -16,82 +16,120 @@
   :use-module ((c line-fold) :select (fold-lines))
   :export ())
 
+;; Returns two values:
+;; - tokens until a newline token is met
+;; - (potentially the newline token) and the remaining tokens
 (define (tokens-until-eol tokens)
   (break (lambda (token) (equal? token '(whitespace "\n")))
          tokens))
 
+;; match in predicates so non-lists fail properly
 (define (whitespace-token? token)
-  (eq? 'whitespace (car token)))
+  (match token
+    (`(whitespace ,_) #t)
+    (_ #f)))
+
+(define (unwrap-preprocessing-token token)
+  (match token
+    (`(preprocessing-token ,x) x)
+    (_ (scm-error 'wrong-type-arg "unwrap-preprocessing-token"
+                  "Not a preprocessing token: ~s" (list token)
+                  #f))))
 
 (define (preprocessing-token? token)
-  (eq? 'preprocessing-token token))
+  (catch 'wrong-type-arg
+    (lambda () (unwrap-preprocessing-token token))
+    (const #f)))
+
 
+;; Replace all whitespace with single spaces.
 (define (squeeze-whitespace tokens)
   (match tokens
     ('() '())
-    (`((whitespace ,_) (whitespace ,_) ,rest ...)
+    ((`(whitespace ,_) `(whitespace ,_) rest ...)
      (squeeze-whitespace (cons '(whitespace " ") rest)))
-    (`((whitespace ,_) ,rest ...)
+    ((`(whitespace ,_) rest ...)
      (cons '(whitespace " ") (squeeze-whitespace rest)))
     ((token rest ...)
      (cons token (squeeze-whitespace rest)))))
 
-(define (stringify-token token)
-  ;; TODO propperly implement this
-  `(preprocessing-token
-    (string-literal ,(with-output-to-string (lambda () (display token))))))
+;; Returns the "source" of the token, as a preprocessing string literal token
+(define (stringify-token unwrapped-preprocessing-token)
+  (match unwrapped-preprocessing-token
+    (`(string-literal ,s)
+     (format #f "~s" s))
+    (`(header-name (q-string ,s))
+     (format #f "~s" s))
+    (`(header-name (h-string ,s))
+     (format #f "<~a>" s))
+    (`(identifier ,id) id)
+    (`(pp-number ,n) n)
+    (`(character-constant ,c)
+     (format #f "'~a'" c))
+    (`(punctuator ,p) p)))
 
 (define (stringify-tokens tokens)
-  (with-output-to-string
-    (lambda ()
-      (for-each (compose display stringify-token)
-                (squeeze-whitespace tokens)))))
+  `(preprocessing-token
+    (string-literal
+     ,(string-concatenate
+       (map (match-lambda (`(preprocessing-token ,body) (stringify-token body))
+                          (`(whitespace ,_) " "))
+            (squeeze-whitespace tokens))))))
 
 ;; Expand ## tokens
 ;; TODO
 (define (expand-join macro tokens)
   tokens)
 
-;; expand function like macro
-(define (apply-macro environment macro parameters)
-  (define parameter-map
-    (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)
-                (map cons (macro-identifier-list macro) head)))
-        (map cons
-             (macro-identifier-list macro)
-             parameters)))
-
-  ;; resolve strigify operators
-  (define stringify-resolved
-   (let loop ((tokens (macro-body macro)))
-     (match tokens
-       (`((preprocessing-token (punctuator "#"))
-          (whitespace ,_) ...
-          (preprocessing-token (identifier ,x))
-          ,rest ...)
-        (unless (member x (macro-identifier-list macro))
-          (scm-error 'macro-expand-error "apply-macro"
-                     "'#' is not followed by a macro parameter: ~s"
-                     (list x) #f)
+;; parameters is a lexeme list, as returned by parse-parameter-list
+(define (build-parameter-map macro parameters)
+  (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)
+              (map cons (macro-identifier-list macro) head)))
+      (map cons
+           (macro-identifier-list macro)
+           parameters)))
+
+;; Drop leading whitespace tokens
+(define (drop-whitespace tokens)
+  (drop-while whitespace-token? tokens))
+
+(define (drop-whitespace-right tokens)
+  (-> tokens reverse drop-whitespace reverse))
+
+(define (drop-whitespace-both tokens)
+  (-> tokens
+      drop-whitespace
+      drop-whitespace-right))
+
+(define (expand-stringifiers macro parameter-map)
+  (let loop ((tokens (macro-body macro)))
+    (match tokens
+      (('(preprocessing-token (punctuator "#"))
+        rest ...)
+       (match (drop-whitespace rest)
+         ((`(preprocessing-token (identifier ,x)) rest ...)
+          (unless (member x (macro-identifier-list macro))
+            (scm-error 'macro-expand-error "expand-stringifiers"
+                       "'#' is not followed by a macro parameter: ~s"
+                       (list x) #f))
           (cons (stringify-tokens (assoc-ref parameter-map x))
-                (loop rest))))
-       ('() '())
-       ((token rest ...)
-        (cons token (loop rest))))))
-
-  ;; TODO
-  ;; - resolve ##
-  (define resulting-body
-    (expand-join macro stringify-resolved))
+                (loop rest)))))
+      ('() '())
+      ((token rest ...)
+       (cons token (loop rest))))))
 
-  ;; - subtitute parameters
-  ;; TODO what am I doing here?
-  (expand-macro (-> environment
-                    (extend-environment parameter-map))
-                resulting-body))
+;; 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))
 
 
 
@@ -103,8 +141,10 @@
 ;; OTHER
 ;; ⇒ "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)
@@ -118,7 +158,12 @@
          (let ((containing remaining newlines (parse-parameter-list tokens)))
            (values (bump-line environment newlines)
                    (append ((macro-body macro) environment containing)
-                           remaining))))))
+                           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 '...'
@@ -130,16 +175,19 @@
     (match tokens
       ('() (values #f (reverse done)))
 
-      ((`(preprocessing-token (punctuation "...")))
-       (values #t (reverse done)))
-
       ((`(preprocessing-token (identifier ,id)) rest ...)
        (loop rest (cons id done)))
 
-      ((`(preprocessing-token (punctuation "...")) rest ...)
+      ((`(preprocessing-token (punctuator "...")))
+       (values #t (reverse done)))
+
+      ((`(preprocessing-token (punctuator "...")) rest ...)
        (scm-error 'cpp-error "parse-identifier-list"
-                  "'...' only allowed as last argument in identifier list"
-                  '() #f))
+                  "'...' only allowed as last argument in identifier list. Rest: ~s"
+                  (list rest) #f))
+
+      ((`(preprocessing-token (punctuator ",")) rest ...)
+       (loop rest done))
 
       ((`(preprocessing-token ,other) rest ...)
        (scm-error 'cpp-error "parse-identifier-list"
@@ -147,10 +195,23 @@
                   (list other) #f)))))
 
 
+
+;; helper procedure to parse-parameter-list.
+;; If a parameter is complex then whitespace is kept, but squeezed to single spaces. Surounding whitespace is removed.
+;; Example:
+;; #define str(x, y) #y
+;; str(x,   (   2,     4    )     )
+;; expands to:
+;; "( 2, 4 )"
+;; 6.10.3.2 p 2
+(define (cleanup-whitespace tokens)
+  (-> tokens drop-whitespace-both squeeze-whitespace))
+
 ;; returns three values:
 ;; - a list of tokens where each is a parameter to the function like macro
 ;; - the remaining tokenstream
 ;; - how many newlines were encountered
+;; The standard might call these "replacement lists"
 (define (parse-parameter-list tokens)
   (let %loop ((depth 0) (newlines 0) (current '())
               (parameters '()) (tokens tokens) (%first-iteration? #t))
@@ -162,26 +223,45 @@
                         current
                         (cons (car tokens) current))))
       (match tokens
-        (`((whitespace "\n") ,rest ...)
+        (('(whitespace "\n") rest ...)
          (loop rest newlines: (1+ newlines) current: current*))
-        (`((whitespace ,_) ,rest ...)
+        ((`(whitespace ,_) rest ...)
          (loop rest current: current*))
-        (`((preprocessing-token (punctuator "(")) ,rest ...)
+        (('(preprocessing-token (punctuator "(")) rest ...)
          (loop rest depth: (1+ depth) current: current*))
-        (`((preprocessing-token (punctuator ")")) ,rest ...)
+        (('(preprocessing-token (punctuator ")")) rest ...)
          (if (= 1 depth)
-             (values (reverse (cons (reverse current) parameters))
+             ;; 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)))))
+
                      rest
                      newlines)
              (loop rest
                    depth: (1- depth)
                    current: current*)))
-        (`((preprocessing-token (punctuator ",")) ,rest ...)
+        (('(preprocessing-token (punctuator ",")) rest ...)
          (if (= 1 depth)
              (loop rest
                    current: '()
-                   parameters: (cons (reverse current) parameters))
-             (loop rest current: current*)))))))
+                   parameters:
+                   (cons (cond ((null? current) '())
+                               ((every whitespace-token? current) '())
+                               (else (cleanup-whitespace (reverse current))))
+                         parameters))
+             (loop rest current: current*)))
+        ((_ rest ...)
+         (loop rest current: current*))))))
 
 
 (define (join-file-line environment)
@@ -190,8 +270,13 @@
   (extend-environment
    environment
    ;; 6.10.8
-   `(("__FILE__" . (preprocessing-token (string-literal ,file)))
-     ("__LINE__" . (preprocessing-token (pp-number ,(number->string line)))))))
+   (list
+    (object-like-macro
+     identifier: "__FILE__"
+     body: `((preprocessing-token (string-literal ,file))))
+    (object-like-macro
+     identifier: "__LINE__"
+     body: `((preprocessing-token (pp-number ,(number->string line))))))))
 
 (define (c-search-path) (make-parameter (list "." "/usr/include")))
 
@@ -219,8 +304,8 @@
    identifier: "defined"
    body: (lambda (environment tokens)
            (match tokens
-             (`((preprocessor-token (identifier ,id)))
-              `(preprocessor-token (pp-number ,(boolean->c-boolean (in-environment? environment id)))))
+             (`((preprocessing-token (identifier ,id)))
+              `(preprocessing-token (pp-number ,(boolean->c-boolean (in-environment? environment id)))))
              (_ (scm-error 'cpp-error "defined"
                            "Invalid parameter list to `defined': ~s"
                            (list tokens) #f))))))
@@ -252,14 +337,15 @@
   'TODO
   )
 
+;; Expands a token-stream which contains no pre-processing directives (#if:s, ...)
 (define (resolve-token-stream environment tokens)
   (let loop ((tokens tokens))
     (match tokens
       ('() '())
-      (`((preprocessing-token (identifier ,id)) ,rest ...)
+      ((`(preprocessing-token (identifier ,id)) rest ...)
        (call-with-values (lambda () (maybe-extend-identifier environment id rest))
          (lambda (_ tokens) (loop tokens))))
-      (`((whitespace ,_) ,rest ...)
+      ((`(whitespace ,_) rest ...)
        (loop rest))
       ((token rest ...)
        (cons token (loop rest))))))
@@ -278,13 +364,16 @@
 ;; environment, string, (list token) → environment, (list token)
 (define (maybe-extend-identifier environment identifier remaining-tokens)
   (cond ((get-identifier environment identifier)
-         => (lambda (value) (expand-macro (join-file-line environment) value remaining-tokens)))
+         => (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))))
 
 (define (resolve-and-include-header environment tokens)
   (let loop ((%first-time #t) (tokens tokens))
-    (match (drop-while whitespace-token? tokens)
+    (match (drop-whitespace tokens)
       ((`(header-name (h-string ,str)) rest ...)
        (cond ((remove whitespace-token? rest)
               (negate null?)
@@ -341,27 +430,28 @@
 ;; environment, tokens → environment
 (define (resolve-define environment tokens)
   (match tokens
-    (`((preprocessing-token (identifier ,identifier)) tail ...)
+    ((`(preprocessing-token (identifier ,identifier)) tail ...)
      (-> environment
          bump-line
          (add-identifier!
           identifier
-          (if (equal? '(preprocessing-token (punctuator "(")) (car tail))
-              ;; function like macro
-              (call-with-values (lambda () (break (lambda (token) (equal? token '(preprocessing-token (punctuator ")"))))
-                                             (cdr tail)))
-                (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)))))
-
-              (object-like-macro
-               identifier: identifier
-               body: tail)))))))
+          (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))))))
+            (_ (object-like-macro
+                identifier: identifier
+                body: tail))))))))
 
 
 
@@ -376,14 +466,18 @@
                         args)
                  #f))
 
+    ;; TODO all of this needs to be surounded with a conditional for
+    ;; environmentns if status. However, ensure that each directive
+    ;; starts at start of line
+
     (match tokens
       ('() '())
-      (`((whitespace "\n") (whitespace ,_) ... (preprocessing-token (puntuator "#")) ,rest ...)
+      ((`(whitespace "\n") `(whitespace ,_) '... '(preprocessing-token (puntuator "#")) rest ...)
        ;; Line tokens are those in this line,
        ;; while remaining tokens are the newline, follewed by the rest of the files tokens
        (let ((line-tokens remaining-tokens (tokens-until-eol rest)))
          ;; Actual tokens just removes all whitespace between "#" and "define"
-         (let ((actual-tokens (drop-while whitespace-token? line-tokens)))
+         (let ((actual-tokens (drop-whitespace line-tokens)))
            (if (null? actual-tokens)
                (loop (bump-line environment) remaining-tokens)
                (match (car actual-tokens)
@@ -393,7 +487,7 @@
 
                  (`(preprocessing-token (identifier "ifdef"))
                   (match actual-tokens
-                    (`((preprocessing-token (identifier ,id)) ,_ ...)
+                    ((`(preprocessing-token (identifier ,id)) _ ...)
                      (loop
                       ((if (in-environment? environment id)
                            enter-active-if enter-inactive-if)
@@ -403,7 +497,7 @@
 
                  (`(preprocessing-token (identifier "ifndef"))
                   (match actual-tokens
-                    (`((preprocessing-token (identifier ,id)) ,_ ...)
+                    ((`(preprocessing-token (identifier ,id)) _ ...)
                      (loop
                       ((if (in-environment? environment id)
                            enter-inactive-if enter-active-if)
@@ -411,49 +505,49 @@
                       remaining-tokens))
                     (_ (err "Non identifier in ifndef: ~s" actual-tokens))))
 
-                 (`(preprocessing-token (identifier "else"))
+                 ('(preprocessing-token (identifier "else"))
                   ;; TODO
                   'TODO
                   )
 
-                 (`(preprocessing-token (identifier "elif"))
+                 ('(preprocessing-token (identifier "elif"))
                   (-> environment leave-if
                       (resolve-for-if actual-tokens)
                       (loop remaining-tokens)))
 
-                 (`(preprocessing-token (identifier "endif"))
+                 ('(preprocessing-token (identifier "endif"))
                   (loop (leave-if environment) remaining-tokens))
 
-                 (`(preprocessing-token (identifier "include"))
+                 ('(preprocessing-token (identifier "include"))
                   (call-with-values
                       (lambda () (resolve-and-include-header environment (cdr actual-tokens)))
                     (lambda (environment tokens)
                      (loop environment (append tokens remaining-tokens)))))
 
-                 (`(preprocessing-token (identifier "define"))
+                 ('(preprocessing-token (identifier "define"))
                   (let ((env (resolve-define environment (cdr actual-tokens))))
                     (loop env remaining-tokens))
                   )
 
-                 (`(preprocessing-token (identifier "undef"))
+                 ('(preprocessing-token (identifier "undef"))
                   (loop (match actual-tokens
                           (`((preprocessing-token (identifier ,id)))
                            (-> environment bump-line (remove-identifier! id))))
                         remaining-tokens))
 
-                 (`(preprocessing-token (identifier "line"))
+                 ('(preprocessing-token (identifier "line"))
                   (loop (handle-line-directive environment actual-tokens)
                         remaining-tokens))
 
-                 (`(preprocessing-token (identifier "error"))
+                 ('(preprocessing-token (identifier "error"))
                   ;; NOTE this is an "expected" error
                   (throw 'cpp-error actual-tokens))
 
-                 (`(preprocessing-token (identifier "pragma"))
+                 ('(preprocessing-token (identifier "pragma"))
                   (loop (handle-pragma environment actual-tokens)
                         remaining-tokens)))))))
 
-      (`((preprocessing-token (identifier ,id)) ,rest ...)
+      ((`(preprocessing-token (identifier ,id)) rest ...)
        (call-with-values (lambda () (maybe-extend-identifier environment id rest))
                          loop))