Major work on c parser.

5 files changed, 557 insertions, 74 deletions

diff --git a/module/c/cpp.scm b/module/c/cpp.scm
index a2935352..9a8245ad 100644
--- a/module/c/cpp.scm
+++ b/module/c/cpp.scm
@@ -11,7 +11,7 @@
   :use-module (c lex)
   :use-module (c parse)
   :use-module (c operators)
-  :export (do-funcall replace-symbols include#)
+  :export (replace-symbols include#)
   )
 
 
@@ -20,7 +20,7 @@
 ;; 2 macro name  | F
 ;; 3 macro args  | (x, y)
 ;; 4 macro body  | x + y
-(define define-re (make-regexp "^#define ((\\w+)(\\([^)]*\\))?) (.*)"))
+(define define-re (make-regexp "^#define ((\\w+)([(][^)]*[)])?) (.*)"))
 
 (define (tokenize-define-line header-line)
   (aif (regexp-exec define-re header-line)
@@ -32,20 +32,6 @@
                (list header-line) #f)))
 
 
-(define (do-funcall function arguments)
-  (if (list? arguments)
-      (apply function arguments)
-      (function arguments)))
-
-(define symb-map
-  `((,(symbol #\|) . logior)
-    (funcall . (@ (c cpp) do-funcall))
-    (&& . and)
-    (& . logand)
-    (== . =)
-    (!= . (negate =))
-    ))
-
 (define (replace-symbols tree dict)
   (if (not (list? tree))
       (or (assoc-ref dict tree) tree)
@@ -77,7 +63,6 @@
       [arg (list arg)]))
 
   (define right (f (cdr pair)))
-  (define alt-right (replace-symbols right symb-map))
   (define dependencies
     (lset-difference
      eq?
@@ -91,12 +76,12 @@
    dependencies
    (match left
      [('funcall name ('#{,}# args ...))
-      (cons name `(lambda ,args ,alt-right))]
+      (cons name `(lambda ,args ,right))]
 
      [('funcall name arg)
-      (cons name `(lambda (,arg) ,alt-right))]
+      (cons name `(lambda (,arg) ,right))]
 
-     [name (cons name alt-right)])))
+     [name (cons name right)])))
 
 
 (define (parse-cpp-file lines)
@@ -104,7 +89,9 @@
          (catch #t
            (lambda () (parse-cpp-define line))
            (lambda (err caller fmt args data)
-             (format #t "~a ~?~%" fmt args)
+             (format #t "~a in ~a: ~?~%"
+                     err caller fmt args)
+             (format #t "~s~%" line)
              #f)))
        lines))
 
@@ -114,29 +101,32 @@
 (define (tokenize-header-file header-file)
   (map tokenize-define-line
        (call-with-port
-        (open-input-pipe
-         (string-append "cpp -dM " header-file))
+        (open-pipe* OPEN_READ "cpp" "-dM" header-file)
         read-lines)))
 
-(define-macro (include# header-file . args)
-
-  (define define-form (if (null? args) 'define (car args)))
-
-  (define lines (remove (compose private-c-symbol? car)
-                        (tokenize-header-file header-file)))
+(define (load-cpp-file header-file)
 
+  (define lines (tokenize-header-file header-file))
   (define forms (parse-cpp-file lines))
 
-  (define graph*
-    (fold (lambda (node graph)
-            (add-node graph (cdr node) (car node)))
-          (make-graph car)
-          (filter identity forms)))
+  (fold (lambda (node graph)
+          (add-node graph (cdr node) (car node)))
+        (make-graph car)
+        (filter identity forms)))
 
+(define (include% header-file)
+  (define graph* (load-cpp-file header-file))
   ;; Hack for termios since this symbol isn't defined.
   ;; (including in the above removed private c symbols)
   (define graph (add-node graph* (cons '_POSIX_VDISABLE #f) '()))
+  ;; TODO expand bodies
+  ;; (remove (compose private-c-symbol? car))
+  (resolve-dependency-graph graph))
+
+(define-macro (include# header-file . args)
+
+  (define define-form (if (null? args) 'define (car args)))
 
   `(begin
      ,@(map (lambda (pair) `(,define-form ,(car pair) ,(cdr pair)))
-            (resolve-dependency-graph graph))))
+            (include% header-file))))
diff --git a/module/c/lex.scm b/module/c/lex.scm
index 34e52d88..5f395322 100644
--- a/module/c/lex.scm
+++ b/module/c/lex.scm
@@ -43,8 +43,22 @@
 (define-peg-pattern integer all
   (and (or base-8 base-16 base-10) (? integer-suffix)))
 
+;; (define-peg-pattern float-suffix all
+;;   (* (or "f" "F" "l" "L")))
+
+;; (define-peg-pattern exponent all
+;;   (and (ignore (or "e" "E")) (? (or "+" "-")) base-10))
+
+;; (define-peg-pattern float all
+;;   (or
+;;    (and base-10 exponent (? float-suffix))
+;;    (and base-10 (ignore ".") (? exponent) (? float-suffix))
+;;    (and (? base-10) (ignore ".") base-10 (? exponent) (? float-suffix))))
+
 (define-peg-pattern number body
-  (or integer))
+  (or ; float
+   integer
+   ))
 
 (define-peg-pattern group all
   (and (ignore "(") expr (ignore ")")))
@@ -65,11 +79,16 @@
 (define-peg-pattern char all
   (and (ignore "'") (or escaped-char peg-any) (ignore "'")))
 
+;; (define-peg-pattern quot none (string "\""))
+
+;; (define-peg-pattern string all
+;;   (and quot (* (or escaped-char (or peg-any))) quot))
 
 (define-peg-pattern* operator all
   `(or ,@(map symbol->string symbol-binary-operators)
        ,@(map (lambda (op) `(and ,(symbol->string op) ws))
-              wordy-binary-operators)))
+              wordy-binary-operators)
+       "?" ":"))
 
 ;; whitespace
 (define-peg-pattern ws none
@@ -99,7 +118,7 @@
                               )))
 
 (define-peg-pattern postfix-operator all
-  (or "++" "--"))
+  (or "++" "--" "*"))
 
 (define-peg-pattern postfix all
   ;; literals can't be in-place incremented and decremented
diff --git a/module/c/operators.scm b/module/c/operators.scm
index ab1b3e7c..131c702c 100644
--- a/module/c/operators.scm
+++ b/module/c/operators.scm
@@ -9,6 +9,7 @@
   `(+ - * / & ,(symbol #\|) ^ << >> % < > =))
 
 ;; apparently part of C
+;; https://en.cppreference.com/w/cpp/language/operator_alternative
 (define wordy-binary-operators
   '(bitand and_eq and bitor or_eq or xor_eq xor))
 
diff --git a/module/c/parse.scm b/module/c/parse.scm
index 8030da77..d407f5ac 100644
--- a/module/c/parse.scm
+++ b/module/c/parse.scm
@@ -38,6 +38,19 @@
                   "Invalid integer suffix ~s"
                   (list str) #f)))
 
+(define (group-body->type vars)
+  (concatenate
+   (map
+    (match-lambda (('variable var) (list (parse-lexeme-tree `(variable ,var))))
+                  (('postfix ('variable var)
+                             ('postfix-operator "*"))
+                   (list (parse-lexeme-tree `(variable ,var))
+                         '*))
+                  (else (scm-error 'c-parse-error "parse-lexeme-tree"
+                                   "Invalid token ~s in typecast form: ~s"
+                                   (list else vars) #f)))
+    vars)))
+
 (define (parse-lexeme-tree tree)
   (match tree
     ['() '()]
@@ -74,25 +87,43 @@
         ((#\v) #\vtab)
         ((#\\) #\\)
         ((#\') #\')))]
+
     [('char c) (char->integer (string-ref c 0))]
 
     [('variable var) (string->symbol var)]
+
+    [('operator "&&") 'and]
+    [('operator "&=") 'and_eq]
+    [('operator "&")  'bitand]
+    [('operator "|")  'bitor]
+    [('operator "!=") 'not_eq]
+    [('operator "||") 'or]
+    [('operator "|=") 'or_eq]
+    [('operator "^")  'xor]
+    [('operator "^=") 'xor_eq]
     [('operator op)  (string->symbol op)]
+
     [('prefix-operator op)
      (case (string->symbol op)
+       ((!) 'not)
+       ((~) 'compl)
        ((*) 'dereference)
        ((&) 'pointer)
        ((++) 'pre-increment)
        ((--) 'pre-decrement)
-       (else => identity))]
+       (else (scm-error 'c-parse-error "parse-lexeme-tree"
+                        "Unknown prefix operator ~s"
+                        (list op) #f)))]
     [('postfix-operator op)
      (case (string->symbol op)
        [(++) 'post-increment]
        [(--) 'post-decrement]
-       [else => identity])]
+       [else (scm-error 'c-parse-error "parse-lexeme-tree"
+                        "Unknown postfix operator ~s"
+                        (list op) #f)])]
 
     ;; Parenthesis grouping
-    [('group args)
+    [('group args ...)
      (parse-lexeme-tree args)]
 
     ;; Atomic item. Used by flatten-infix
@@ -108,37 +139,104 @@
        ,(parse-lexeme-tree arg))]
 
     [('infix args ...)
-     (resolve-order-of-operations
-      (flatten-infix (cons 'infix args)))]
+     (let ((r
+            (resolve-order-of-operations
+             (flatten-infix (cons 'infix args)))))
+       (match r
+         (`(: (? ,op ,true)
+              ,false)
+          `(ternary ,op ,true ,false))
+         (_ r)))]
 
     [('funcall function ('group arguments))
      `(funcall ,(parse-lexeme-tree function)
                ,(parse-lexeme-tree arguments))]
 
-    [bare (scm-error 'c-parse-error
-                     "parse-lexeme-tree"
-                     "Naked literal in lex-tree: ~s"
-                     (list bare)
-                     #f)]))
+    [(('variable "struct") ('variable value) ..1)
+     `(struct-type ,@(map string->symbol value))
+     ]
+
+    ;; A list of variables. Most likely a type signature
+    ;; [(('variable value) ..1)
+    ;;  ]
+
+    ;; A typecast with only variables must (?) be a typecast?
+    [(('group groups ..1) ... value)
+     (fold-right (lambda (type done) `(as-type ,type ,done))
+                 (parse-lexeme-tree value)
+                 (map group-body->type groups))]
+
+    ;; Type name resolution?
+    ;; https://en.wikipedia.org/wiki/C_data_types
+    ;; base types with spaces:
+    ;; =======================
+    ;; [[un]signed] char
+    ;; [[un]signed] short [int]
+    ;; [[un]signed] int
+    ;; [un]signed [int]
+    ;; [[un]signed] long [int]
+    ;; [[un]signed] long long [int]
+    ;; float
+    ;; [long] double
+
+    ;; https://en.wikipedia.org/wiki/Type_qualifier
+    ;; qualifiers
+    ;; const
+    ;; volatile
+    ;; restrict
+    ;; _Atomic
+
+
+    ;; Storage specifiers
+    ;; auto
+    ;; register
+    ;; static
+    ;; extern
+
+    ;; struct <typename>
+    ;; enum <typename>
+    ;; union <typename>
+
+    ;; https://en.wikipedia.org/wiki/C_syntax
+    ;; int (*ptr_to_array)[100]
+
+
+    [(? symbol? bare)
+     (scm-error 'c-parse-error
+                "parse-lexeme-tree"
+                "Naked literal in lex-tree: ~s"
+                (list bare)
+                #f)]
+
+    [form
+     (scm-error 'c-parse-error
+                "parse-lexeme-tree"
+                "Unknown form in lex-tree: ~s"
+                (list form) #f)
+     ]))
 
 ;; https://en.wikipedia.org/wiki/Operators_in_C_and_C%2B%2B
+;; https://en.cppreference.com/w/c/language/operator_precedence
 
 (define order-of-operations
   (reverse
    (concatenate
     ;; This is only for binary operations
     `((-> ,(symbol #\.))
+      ;; All unary procedures go here, incnluding typecasts, and sizeof
       (* / %)
       (+ -)
       (<< >>)
       (< <= > >=)
-      (== !=)
-      (&)
-      (^)
-      (,(symbol #\|))
-      (&&)
-      (,(symbol #\| #\|))
-      (= += -= *= /= %= <<= >>= &= ^= ,(symbol #\| #\=))
+      (== != not_eq)
+      (& bitand)
+      (^ xorg)
+      (,(symbol #\|) bitor)
+      (&& and)
+      (,(symbol #\| #\|) or)
+      (? :)
+      (= += -= *= /= %= <<= >>= &= ^= ,(symbol #\| #\=)
+         and_eq or_eq xor_eq)
       (,(symbol #\,))
       ))))
 
@@ -148,8 +246,12 @@
 (define* (resolve-order-of-operations
           tree optional: (order order-of-operations))
 
+  (format (current-error-port) "~s~%" tree)
   (if (null? order)
-      (car tree)
+      (scm-error 'c-parse-error
+                 "resolve-order-of-operations"
+                 "Out of operations to resolve when resolving expression ~s"
+                 (list tree) #f)
       (match tree
         [('*other* body ...) body]
         [(form) (resolve-order-of-operations form order)]
diff --git a/tests/test/cpp.scm b/tests/test/cpp.scm
index 9c720fde..f3b9ff72 100644
--- a/tests/test/cpp.scm
+++ b/tests/test/cpp.scm
@@ -8,32 +8,403 @@
   :use-module ((c lex) :select (lex))
   :use-module ((c parse) :select (parse-lexeme-tree)))
 
+;; Note that the lexer's output isn't stable.
+;; The tests here are more to see where the lexer succeeds but the parser fails.
+;; So changing the lexer test cases isn't a problem
+;; but don't change the parser test cases
+
 (define run (compose parse-lexeme-tree lex))
 
-(test-equal
-  '(+ (post-increment (dereference C)) 3)
-  (run "(*C)++ + 3"))
+(define-syntax let-group
+  (syntax-rules ()
+    ((let ((form name) rest ...) body ...)
+     (test-group name
+       (let ((form name)
+             rest ...)
+         body ...)))))
+
+(let-group
+ ((form "(*C)++ + 3"))
+ (test-equal '(infix (postfix (group (prefix (prefix-operator "*")
+                                             (variable "C")))
+                              (postfix-operator "++"))
+                     (operator "+")
+                     (integer (base-10 "3")))
+   (lex form))
+ (test-equal '(+ (post-increment (dereference C)) 3)
+   (run form)))
+
+(let-group
+ ((form "*C++ + 3"))
+ (test-equal '(infix (postfix (prefix (prefix-operator "*")
+                                      (variable "C"))
+                              (postfix-operator "++"))
+                     (operator "+")
+                     (integer (base-10 "3")))
+   (lex form))
+ (test-equal '(+ (post-increment (dereference C)) 3)
+   (run form)))
+
+(let-group
+ ((form "*C++"))
+ (test-equal '(postfix (prefix (prefix-operator "*")
+                               (variable "C"))
+                       (postfix-operator "++"))
+   (lex form))
+ (test-equal '(post-increment (dereference C))
+   (run form)))
+
+(let-group
+ ((form "C++ + C++"))
+ (test-equal '(infix (postfix (variable "C")
+                              (postfix-operator "++"))
+                     (operator "+")
+                     (postfix (variable "C")
+                              (postfix-operator "++")))
+   (lex form))
+ (test-equal '(+ (post-increment C) (post-increment C))
+   (run form)))
+
+(let-group
+ ((form "++C + ++C"))
+ (test-equal '(infix (prefix (prefix-operator "++")
+                             (variable "C"))
+                     (operator "+")
+                     (prefix (prefix-operator "++")
+                             (variable "C")))
+   (lex form))
+ (test-equal '(+ (pre-increment C) (pre-increment C))
+   (run form)))
+
+(let-group
+ ((form "2 + 2 * 2"))
+ (test-equal '(infix (integer (base-10 "2"))
+                     (operator "+")
+                     (infix (integer (base-10 "2"))
+                            (operator "*")
+                            (integer (base-10 "2"))))
+   (lex form))
+ (test-equal '(+ 2 (* 2 2)) (run form)))
+
+(let-group
+ ((form "2 * 2 + 2"))
+ (test-equal '(infix (integer (base-10 "2"))
+                     (operator "*")
+                     (infix (integer (base-10 "2"))
+                            (operator "+")
+                            (integer (base-10 "2"))))
+   (lex form))
+ (test-equal '(+ (* 2 2) 2) (run form)))
+
+(let-group
+ ((form "2+2+2"))
+ (test-equal '(infix (integer (base-10 "2"))
+                     (operator "+")
+                     (infix (integer (base-10 "2"))
+                            (operator "+")
+                            (integer (base-10 "2")))) (lex form))
+ (test-equal '(+ 2 2 2) (run form)))
+
+
+
+
+(test-skip "Strings")
+(test-skip "__asm__")
+(test-skip "Token concatenation")
+(test-skip "Floating point numbers")
+
+;; Hand picked forms from output of `cpp -dM /usr/include/termios.h` on
+;; FreeBSD 13.1-RELEASE releng/13.1-n250148-fc952ac2212 GENERIC amd64
+;; 2022-06-28
+
+(let ((form "00000200"))
+  (test-equal '(integer (base-8 "0000200")) (lex form))
+  (test-equal 128 (run form)))
+
+(let ((form "0"))
+  (test-equal '(integer (base-10 "0")) (lex form))
+  (test-equal 0 (run form)))
+
+(let ((form "1000000U"))
+  (test-equal '(integer (base-10 "1000000") (integer-suffix "U")) (lex form))
+  (test-equal '(as-type (unsigned) 1000000) (run form)))
+
+
+(let ((form "0x10c"))
+  (test-equal '(integer (base-16 "10c")) (lex form))
+  (test-equal 268 (run form)))
+
+;; Lexer keeps original case, handled later by parser
+(let ((form "0X10C"))
+  (test-equal '(integer (base-16 "10C")) (lex form))
+  (test-equal 268 (run form)))
+
+(let ((form "a != b"))
+  (test-equal '(infix (variable "a")
+                      (operator "!=")
+                      (variable "b"))
+    (lex form))
+  (test-equal '(not_eq a b) (run form)))
+
+(let ((form "((c) == (val) && (val) != _POSIX_VDISABLE)"))
+  ;; (test-equal '() (lex form))
+  (test-equal '(and (== c val)
+                    (not_eq val _POSIX_VDISABLE))
+    (run form)))
+
+(let ((form "CTRL('O')"))
+  (test-equal '(funcall (variable "CTRL") (group (char "O"))) (lex form))
+  (test-equal '(funcall CTRL 79) (run form)))
+
+(let ((form "CREPRINT"))
+  (test-equal '(variable "CREPRINT") (lex form))
+  (test-equal 'CREPRINT (run form)))
+
+(let ((form "(CCTS_OFLOW | CRTS_IFLOW)"))
+  (test-equal '(group (infix (variable "CCTS_OFLOW")
+                             (operator "|")
+                             (variable "CRTS_IFLOW")))
+    (lex form))
+  (test-equal '(bitor CCTS_OFLOW CRTS_IFLOW) (run form)))
+
+;; ((x) >= 'a' && (x) <= 'z'
+;;   ? ((x) - 'a' + 1)
+;;   : (((x) - 'a' + 1) & 0x7f))
+(let ((form "((x) >= 'a' && (x) <= 'z' ? ((x) - 'a' + 1) : (((x) - 'a' + 1) & 0x7f))"))
+  ;; (test-equal '() (lex form))
+  (test-equal '(ternary
+                (and (>= x #x61)
+                     (<= x #x7A))
+                (- x (+ #x61 1))
+                (bitand (- x (+ #x61 1)) 127))
+    (run form)))
+
+(let ((form "((x) & ~(IOCPARM_MASK << 16))"))
+  ;; (test-equal '() (lex form))
+  (test-equal '(bitand x (compl (<< IOCPARM_MASK 16))) (run form)))
+
+(let ((form "(((x) >> 8) & 0xff)"))
+  ;; (test-equal '() (lex form))
+  (test-equal '(bitand (>> x 8) 255) (run form)))
+
+(let ((form "(((x) >> 16) & IOCPARM_MASK)"))
+  ;; (test-equal '() (lex form))
+  (test-equal '(bitand (>> x 16) IOCPARM_MASK) (run form)))
+
+(let ((form "((1 << IOCPARM_SHIFT) - 1)"))
+  ;; (test-equal '() (lex form))
+  (test-equal '(- (<< 1 IOCPARM_SHIFT) 1) (run form)))
+
+(let ((form "_IO('t', 120)"))
+  (test-equal '(funcall
+                (variable "_IO")
+                (group (infix (char "t")
+                              (operator ",")
+                              (integer (base-10 "120")))))
+    (lex form))
+  (test-equal '(funcall _IO (#{,}# 116 120)) (run form)))
+
+;; note the lone type
+(let ((form "_IOW('t', 98, int)"))
+  ;; (test-equal '() (lex form))
+  (test-equal '(funcall _IOW (#{,}# 116 98 int))
+    (run form)))
+
+;; note the multi-word type
+(let ((form "_IOR('t', 19, struct termios)"))
+  ;; (test-equal '() (lex form))
+  (test-equal '(funcall _IOR (#{,}# 116 19 (struct-type termios))) (run form)))
+
+
+(test-group "Token concatenation"
+  (let ((form "x ## y"))
+    (test-equal '() (lex form))
+    (test-equal '0 (run form))))
+
+(test-group "Floating point numbers"
+  (let ((form "4.9406564584124654e-324"))
+    (test-equal '(float (base-10 "4") (base-10)) (lex form))
+    (test-equal '0 (run form)))
+
+  (let ((form "1.7976931348623157e+308"))
+    (test-equal '() (lex form))
+    (test-equal '0 (run form))))
+
+(test-group "Typecasts"
+
+  (let ((form "(unsigned) 5"))
+    (test-equal '((group (variable "unsigned"))
+                  (integer (base-10 "5")))
+      (lex form))
+    (test-equal '(as-type (unsigned) 5)
+      (run form)))
+
+  (let ((form "(unsigned integer) 5"))
+    (test-equal '((group (variable "unsigned")
+                         (variable "integer"))
+                  (integer (base-10 "5")))
+      (lex form))
+    (test-equal '(as-type (unsigned integer) 5) (run form)))
+
+  (test-group "Pointer with space"
+    (let ((form "(int *) 5"))
+      (test-equal '((group (postfix (variable "int")
+                                    (postfix-operator "*")))
+                    (integer (base-10 "5")))
+        (lex form))
+      (test-equal '(as-type (int *) 5)
+        (run form))))
+
+  (test-group "Pointer without space"
+    (let ((form "(int*) 5"))
+      (test-equal '((group (postfix (variable "int")
+                                    (postfix-operator "*")))
+                    (integer (base-10 "5")))
+        (lex form))
+      (test-equal '(as-type (int *) 5)
+        (run form))))
+
+  (test-group "Multi word type pointer"
+    (let ((form "(unsigned int*) 5"))
+      (test-equal '((group (variable "unsigned")
+                           (postfix (variable "int")
+                                    (postfix-operator "*")))
+                    (integer (base-10 "5")))
+        (lex form))
+      (test-equal '(as-type (unsigned int *) 5)
+        (run form))))
+
+  (test-group "Double cast"
+    (let ((form "(int)(unsigned) 5"))
+      (test-equal '((group (variable "int"))
+                    (group (variable "unsigned"))
+                    (integer (base-10 "5"))) (lex form))
+      (test-equal '(as-type (int) (as-type (unsigned) 5))
+        (run form))))
+
+  (test-group "Cast with operation"
+    (let ((form "(int) 5 + 7"))
+      (test-equal '((group (variable "int"))
+                    (infix (integer (base-10 "5"))
+                           (operator "+")
+                           (integer (base-10 "7"))))
+        (lex form))
+
+      (test-equal '(+ (as-type (int) 5) 7)
+        (run form))))
+
+
+
+  (test-group "Tripple cast, with value inside paranthesis"
+    (let ((form "(type)(__uintptr_t)(const void *)(var)"))
+      (test-equal '((group (variable "type"))
+                    (group (variable "__uintptr_t"))
+                    (group (variable "const")
+                           (postfix (variable "void")
+                                    (postfix-operator "*")))
+                    (group (variable "var")))
+        (lex form))
+      (test-equal '(as-type (type)
+                            (as-type (__uintptr_t)
+                                     (as-type (const void *)
+                                              var)))
+        (run form))))
+
+  (test-group "Same as above, but whole thing inside parenthesis"
+    (let ((form "((type)(__uintptr_t)(const void *)(var))"))
+      (test-equal '(group (group (variable "type"))
+                          (group (variable "__uintptr_t"))
+                          (group (variable "const")
+                                 (postfix (variable "void")
+                                          (postfix-operator "*")))
+                          (group (variable "var")))
+        (lex form))
+      (test-equal '(as-type (type)
+                            (as-type (__uintptr_t)
+                                     (as-type (const void *)
+                                              var)))
+        (run form))))
+
+  (let ((form "((type)(__uintptr_t)(const volatile void *)(var))"))
+    ;; (test-equal '() (lex form))
+    (test-equal '(as-type (type)
+                          (as-type (__uintptr_t)
+                                   (as-type (const volatile void *)
+                                            var)))
+      (run form)))
+
+  (let ((form "((unsigned long) ((inout) | (((len) & IOCPARM_MASK) << 16) | ((group) << 8) | (num)))"))
+    (test-equal '(group (group (variable "unsigned") (variable "long"))
+                        (group (infix (group (variable "inout"))
+                                      (operator "|")
+                                      (infix (group (infix (group (infix (group (variable "len"))
+                                                                         (operator "&")
+                                                                         (variable "IOCPARM_MASK")))
+                                                           (operator "<<")
+                                                           (integer (base-10 "16"))))
+                                             (operator "|")
+                                             (infix (group (infix (group (variable "group"))
+                                                                  (operator "<<")
+                                                                  (integer (base-10 "8"))))
+                                                    (operator "|")
+                                                    (group (variable "num")))))))
+      (lex form))
+    (test-equal '(as-type (unsigned long)
+                          (bitor (<< (bitand len IOCPARM_MASK) 16)
+                                 (<< group 8)
+                                 num))
+      (run form))))
 
-(test-equal
-  '(+ (post-increment (dereference C)) 3)
-  (run "*C++ + 3"))
 
-(test-equal
-  '(post-increment (dereference C))
-  (run "*C++"))
+(test-group "Strings"
+  (test-group "Empty string"
+    (let ((form "\"\""))
+      (test-equal '(string "") (lex form))
+      (test-equal #vu8(0) (run form))))
 
-(test-equal
-  '(+ (post-increment C) (post-increment C))
-  (run "C++ + C++"))
+  (test-group "Simple string"
+    (let ((form "\"li\""))
+      (test-equal '(string "li") (lex form))
+      (test-equal #vu8(#x6C #x69 0) (run form))))
 
-(test-equal
-  '(+ (pre-increment C) (pre-increment C))
-  (run "++C + ++C"))
+  (test-group "Implicit concatenation of strings"
+    (let ((form "\"a\" \"b\""))
+      (test-equal '((string "a")
+                    (string "b"))
+        (lex form))
+      (test-equal #vu8(#x61 #x62 0)
+                  (run form))))
 
-(test-equal '(+ 2 (* 2 2)) (run "2 + 2 * 2"))
+  (test-group "Implicit concatenation of string and macro"
+    (let ((form "\"a\" MACRO"))
+      (test-equal '() (lex form))
+      (test-equal '() (run form))))
 
-(test-equal '(+ (* 2 2) 2) (run "2 * 2 + 2"))
+  (test-group "String with escape"
+    (let ((form (string #\\ #\")))
+      (test-equal `(string ,(string #\")) (lex form))
+      (test-equal #vu8(34 0) (run form)))))
 
-(test-equal '(+ 2 2 2) (run "2+2+2"))
+(test-group "__asm__"
+  (let ((form "__asm__(\".globl \" __XSTRING(sym))"))
+    (test-equal '() (lex form))
+    ;; TODO implicit string concatenation
+    (test-equal '(funcall __asm__
+                          (string ".globl ")
+                          (funcall __XSTRING sym)) (run form))))
 
+(let ((form "__attribute__((__aligned__(x)))"))
+  (test-equal '(funcall (variable "__attribute__")
+                        (group (group (funcall (variable "__aligned__")
+                                               (group (variable "x"))))))
+    (lex form))
+  ;; This drops the extra set of parenthesis. Do we care?
+  (test-equal '(funcall __attribute__
+                        (funcall __aligned__ x))
+    (run form)))
 
+;; TODO concatenation rules
+;; #define __CONCAT(x,y) __CONCAT1(x,y)
+;; #define __CONCAT1(x,y) x ## y
+;; #define __CONSTANT_CFSTRINGS__ 1
+;; #define __COPYRIGHT(s) __IDSTRING(__CONCAT(__copyright_,__LINE__),s)