Remove old unused files.

13 files changed, 14 insertions, 1367 deletions

diff --git a/module/c/eval.scm b/module/c/eval.scm
deleted file mode 100644
index 67d0075d..00000000
--- a/module/c/eval.scm
+++ /dev/null
@@ -1,265 +0,0 @@
-(define-module (c eval)
-  :use-module (hnh util)
-  :use-module (srfi srfi-1)
-  :use-module (srfi srfi-71)
-  :use-module (srfi srfi-88)
-  :use-module (ice-9 match)
-  :use-module (ice-9 curried-definitions)
-  :use-module ((rnrs bytevectors)
-               :select (bytevector?))
-  :use-module ((rnrs arithmetic bitwise)
-               :select (bitwise-not
-                        bitwise-and
-                        bitwise-ior
-                        bitwise-xor
-                        bitwise-arithmetic-shift-left
-                        bitwise-arithmetic-shift-right))
-  :use-module (c eval environment)
-  :export (c-procedure?
-           procedure-formals
-           procedure-body
-           procedure-arity
-
-           c-eval
-           ))
-
-(define C-TRUE 1)
-(define C-FALSE 0)
-
-(define (boolean->c-boolean bool)
-  (if bool C-TRUE C-FALSE))
-
-(define (c-boolean->boolean bool)
-  (not (zero? bool)))
-
-(define (c-not b)
-  (-> b c-boolean->boolean not boolean->c-boolean))
-
-(define (c-procedure? expr)
-  (and (list? expr)
-       (not (null? expr))
-       (eq? 'lambda (car expr))))
-
-(define* (ensure-c-procedure expr optional: calling-procedure)
-  (unless (c-procedure? expr)
-    (scm-error 'c-eval-error calling-procedure
-               "Value not a procedure: ~s"
-               (list procedure #f))))
-
-(define (procedure-formals procedure)
-  (ensure-c-procedure procedure "procedure-formals")
-  (list-ref procedure 1))
-
-(define (procedure-body procedure)
-  (ensure-c-procedure procedure "procedure-body")
-  (list-ref procedure 2))
-
-(define (procedure-arity procedure)
-  (length (procedure-formals procedure)))
-
-(define (literal? expression)
-  (or (number? expression)
-      (bytevector? expression)))
-
-
-
-;; Internal helper procedures
-
-(define (mod-set operation)
-  (lambda (env slot value)
-    ;; a += b
-    ;; a = a + b
-    (c-eval env `(= ,slot (,operation ,slot ,value)))))
-
-(define (fold-2 proc init lst)
-  (car+cdr
-   (fold (lambda (arg env+done)
-           (let ((env* arg* (proc (car env+done) arg)))
-             (cons* env* arg* (cdr env+done))))
-         init
-         lst)))
-
-;; TODO this disregards
-;; - floating point convertions
-;; - integer truncation
-(define ((simple-infix operation) env . operands)
-  (let ((env done (fold-2 c-eval (cons env '()) operands)))
-    (values env (apply operation (reverse done)))))
-
-(define ((binary-operator proc) env i c)
-  (let ((env* i* (c-eval env i)))
-    (let ((env** c* (c-eval env* c)))
-      (values env** (proc i* c*)))))
-
-
-
-
-;; The order of evaluation for a number of these is undefined, meaning
-;; that any side effects without sequence points is undefined.
-;; However, for many of these I do the sensible thing and evaluate them
-;; from left to right, instead of ignoring all side effects.
-
-;; TODO double check these with a C standard
-
-
-;; Operators have their own namespace. They are called without funcall
-;; in the pseudo-lisp which C is compiled to, and they expand more like
-;; lisp macros, since its up to each operator what to do with its operands.
-;; This to allow assignment and short circuting.
-(define primitives
-  `((and . ,(lambda (env . operands)
-              (let loop ((env env) (operands operands))
-                (if (null? operands)
-                    (values env C-TRUE)
-                    (let* ((env* result (c-eval env (car operands))))
-                      (if (c-boolean->boolean result)
-                          (loop env* (cdr operands))
-                          (values env* result)))))))
-    (or . ,(lambda (env . operands)
-             (let loop ((env env) (operands operands))
-               (if (null? operands)
-                   (values env C-FALSE)
-                   (let* ((env* result (c-eval env (car operands))))
-                     (if (false? result)
-                         (values env* result)
-                         (loop env* (cdr operands))))))))
-    (= . ,(lambda (env slot value)
-            ;; TOOD if slot isn't a variable, but a field (or array index)
-            ;; then it needs to be resolved...
-            (let ((env* result (c-eval env value)))
-              (values (env-set! env* slot result)
-                      result))))
-    (and_eq ,(mod-set 'bitand))         ; &=
-    (or_eq  ,(mod-set 'bitor))          ; |=
-    (xor_eq ,(mod-set 'xor))            ; ^=
-    (+=  ,(mod-set '+))
-    (-=  ,(mod-set '-))
-    (*=  ,(mod-set '*))
-    (/=  ,(mod-set '/))
-    (<<= ,(mod-set '<<))
-    (>>= ,(mod-set '>>))
-    (%=  ,(mod-set '%))
-    (+ . ,(simple-infix +))
-    (* . ,(simple-infix *))
-    (/ . ,(simple-infix /))
-    (- . ,(lambda (env op . operands)
-            (if (null? operands)
-                (let ((env* value (c-eval env op)))
-                  (values env* (- value)))
-                (apply (simple-infix -)
-                       env op operands))))
-    (bitor  . ,(simple-infix bitwise-ior))
-    (bitand . ,(simple-infix bitwise-and))
-    (xor    . ,(simple-infix bitwise-xor))
-    (not_eq . ,(lambda (env a b) (c-eval env `(not (== ,a ,b))))) ; !=
-    (<< . ,(binary-operator bitwise-arithmetic-shift-left))
-    (>> . ,(binary-operator bitwise-arithmetic-shift-right))
-    (< . ,(binary-operator (compose boolean->c-boolean <)))
-    (> . ,(binary-operator (compose boolean->c-boolean >)))
-    ;; this assumes that = handles pointers
-    (== . ,(binary-operator (compose boolean->c-boolean =)))
-    (<= . ,(binary-operator (compose boolean->c-boolean <=)))
-    (>= . ,(binary-operator (compose boolean->c-boolean >=)))
-    (% .  ,(binary-operator modulo))
-
-    (not . ,(lambda (env value)
-              (let ((env* result (c-eval env value)))
-                (values env* (c-not result)))))
-    (compl . ,(lambda (env value)
-                (let ((env* result (c-eval env value)))
-                  (values env* (bitwise-not result)))))
-
-    ;; ++C
-    (pre-increment . ,(lambda (env slot) (c-eval env `(+= ,slot 1))))
-    (pre-decrement . ,(lambda (env slot) (c-eval env `(-= ,slot 1))))
-    ;; TODO these (C++, C--) need to handle if slot isn't a direct variabl
-    (post-increment . ,(lambda (env slot)
-                         (let ((value (env-ref env slot)))
-                           (values (env-set! env slot (1+ value))
-                                   value))))
-    (pre-decrement . ,(lambda (env slot)
-                        (let ((value (env-ref env slot)))
-                          (values (env-set! env slot (1+ value))
-                                  value))))
-
-    (ternary . ,(lambda (env test true-clause false-clause)
-                  (let ((env* value (c-eval env test)))
-                    (c-eval env*
-                            (if (c-boolean->boolean value)
-                                true-clause false-clause)))))
-
-    ;; TODO remaining operations
-    (as-type . ,(lambda (env target-type value)
-                  (format (current-error-port) "cast<~s>(~s)~%" target-type value)
-                  (values env value)))
-
-    (object-slot . ,(lambda (env object slot)
-                      (scm-error 'not-implemented "object-slot"
-                                 "Object slots are not implemented, when accessing ~s.~s"
-                                 (list object slot) #f)))
-    (dereference-slot ,(lambda (env ptr slot)
-                          (scm-error 'not-implemented "dereference-slot"
-                                 "Object slots are not implemented, when accessing ~s->~s"
-                                 (list object slot) #f)))
-    (dereference . ,(lambda (env ptr)
-                      (scm-error 'not-implemented "dereference"
-                                 "Poiner dereferencing is not implemented: *~s"
-                                 (list ptr) #f)))
-    (pointer . ,(lambda (env value)
-                  (scm-error 'not-implemented "pointer"
-                             "Pointer of is not implemented: &~s"
-                             (list value) #f)))))
-
-;; TODO |,|
-
-
-(define (c-eval environment expression)
-  (match expression
-    (('lambda formals body) (values environment `(lambda ,formals ,body)))
-    ;; hack since sizeof really should be a operator
-    (('funcall 'sizeof arg)
-     ;; TODO
-     (format (current-error-port) "sizeof ~s~%" arg)
-     (values environment 1))
-
-    (('funcall procedure-name ('#{,}# args ...))
-     (let ((procedure (env-ref environment procedure-name)))
-       (ensure-c-procedure procedure "c-eval")
-       (unless (= (length args) (procedure-arity procedure))
-         (scm-error 'c-eval-error "c-eval"
-                    "Procedure arity mismatch for ~s, expected ~s, got ~s"
-                    (list procedure-name
-                          (procedure-arity procedure)
-                          (length args))
-                    #f))
-       (let ((env args* (fold-2 c-eval (cons environment '()) args )))
-         (let ((inner-environment
-                (fold (lambda (name value env) (env-set! env name value))
-                      (push-frame! env)
-                      (procedure-formals procedure) args*)))
-           (let ((resulting-environment
-                  result-value
-                  (c-eval inner-environment (procedure-body procedure))))
-             (values (pop-frame! resulting-environment)
-                     result-value))))))
-
-    (('funcall procedure arg)
-     (c-eval environment `(funcall ,procedure (#{,}# ,arg))))
-
-    ((operator operands ...)
-     (apply (or (assoc-ref primitives operator)
-                (scm-error 'c-eval-error "c-eval"
-                           "Applying non-existant primitive operator: ~s, operands: ~s"
-                           (list operator operands) #f))
-            environment operands))
-
-    ;; "f()" gets compiled to simply f
-    ;; meaning that we instead use the environment to determine
-    ;; if something is a variable or procedure
-    (expr
-     (if (literal? expr)
-         (values environment expr)
-         (let ((value (env-ref environment expr)))
-           (if (c-procedure? value)
-               (c-eval environment `(funcall ,value (#{,}#)))
-               (values environment value)))))))
diff --git a/module/c/eval/environment.scm b/module/c/eval/environment.scm
deleted file mode 100644
index 12eefaf7..00000000
--- a/module/c/eval/environment.scm
+++ /dev/null
@@ -1,34 +0,0 @@
-(define-module (c eval environment)
-  :use-module (srfi srfi-1)
-  :export (make-environment
-           env-set! env-ref push-frame! pop-frame!))
-
-(define (make-frame)
-  (make-hash-table))
-
-(define (make-environment)
-  (list (make-frame)))
-
-;; Returns an updated environment, linear update
-(define (env-set! env key value)
-  ;; get handle to differentiate #f
-  ;; (even though #f should never be stored since it's not a C value)
-  (cond ((find (lambda (frame) (hashq-get-handle frame key)) env)
-         => (lambda (frame) (hashq-set! frame key value)))
-        (else (hashq-set! (car env) key value)))
-  env)
-
-(define (env-ref env key)
-  (cond ((null? env)
-         (scm-error 'misc-error "env-ref"
-                    "~s unbound"
-                    (list key)
-                    #f))
-        ((hashq-get-handle (car env) key) => cdr)
-        (else (env-ref (cdr env) key))))
-
-(define (push-frame! environment)
-  (cons (make-frame) environment))
-
-(define (pop-frame! environment)
-  (cdr environment))
diff --git a/module/c/cpp.scm b/module/c/old/cpp.scm
index aed496f2..1623bd11 100644
--- a/module/c/cpp.scm
+++ b/module/c/old/cpp.scm
@@ -1,4 +1,4 @@
-(define-module (c cpp)
+(define-module (c old cpp)
   :use-module (hnh util)
   :use-module (srfi srfi-1)
   :use-module (ice-9 popen)
@@ -9,9 +9,9 @@
   :use-module (ice-9 format)
   :use-module ((hnh util io) :select (read-lines))
   :use-module (hnh util graph)
-  :use-module (c lex)
-  :use-module (c parse)
-  :use-module (c operators)
+  :use-module (c old lex)
+  :use-module (c old parse)
+  :use-module (c old operators)
   :export (replace-symbols include#)
   )
 
diff --git a/module/c/lex.scm b/module/c/old/lex.scm
index 0bde5c9e..dcc7336d 100644
--- a/module/c/lex.scm
+++ b/module/c/old/lex.scm
@@ -1,6 +1,6 @@
-(define-module (c lex)
+(define-module (c old lex)
   :use-module (ice-9 peg)
-  :use-module (c operators)
+  :use-module (c old operators)
   :export (lex))
 
 
diff --git a/module/c/operators.scm b/module/c/old/operators.scm
index 910dc8a9..0b253ada 100644
--- a/module/c/operators.scm
+++ b/module/c/old/operators.scm
@@ -1,4 +1,4 @@
-(define-module (c operators)
+(define-module (c old operators)
   :export (wordy-binary-operators
            symbol-binary-operators
            binary-operators))
diff --git a/module/c/parse.scm b/module/c/old/parse.scm
index 7d11ea17..d598e3c9 100644
--- a/module/c/parse.scm
+++ b/module/c/old/parse.scm
@@ -1,4 +1,4 @@
-(define-module (c parse)
+(define-module (c old parse)
   :use-module (hnh util)
   :use-module (srfi srfi-1)
   :use-module (srfi srfi-71)
diff --git a/module/c/preprocessor.scm b/module/c/preprocessor.scm
deleted file mode 100644
index 71712b17..00000000
--- a/module/c/preprocessor.scm
+++ /dev/null
@@ -1,370 +0,0 @@
-(define-module (c preprocessor)
-  :use-module (srfi srfi-1)
-  :use-module (srfi srfi-9 gnu)
-  :use-module (ice-9 rdelim)
-  :use-module (ice-9 regex)
-  :use-module (hnh util object)
-
-  :use-module (hnh util)
-  :use-module (hnh util object)
-  )
-
-(define (read-lines port)
-  (let loop ((done '()))
-    (let ((line (read-line port)))
-      (if (eof-object? line)
-          (reverse done)
-          (loop (cons line done))))))
-
-;; The source line of a give readen line
-(define line-number (make-object-property))
-;; The source file of a given readen line
-(define line-file (make-object-property))
-
-
-(define (mark-with-property! items property property-value)
-  (for-each (lambda (item) (set! (property item) property-value))
-            items))
-
-(define trigraph-rx (make-regexp "??([=()/'<>!-])"))
-(define (expand-trigraphs line)
-  (regexp-substitute/global
-   #f trigraph-rx
-   line
-   'pre (lambda (m) (case (string-ref (match:substring m 1) 1)
-                 ((#\=) "#")
-                 ((#\() "[")
-                 ((#\)) "]")
-                 ((#\/) "\\")
-                 ((#\') "^")
-                 ((#\<) "{")
-                 ((#\>) "}")
-                 ((#\!) "|")
-                 ((#\-) "~")))
-   'post))
-
-(define (number-lines lines)
-  (for-each (lambda (line number)
-              (set! (line-number line) number))
-            lines
-            (iota (length lines) 1))
-  lines)
-
-;; Should this line be merged with the next
-(define (line-continued? line)
-  (case (string-length line)
-    ((0) #f)
-    ((1) (string=? "\\" line))
-    (else
-     (let ((len (string-length line)))
-       ;; TODO can extra backslashes change this?
-       (and (char=? #\\ (string-ref line (- len 1)))
-            (not (char=? #\\ (string-ref line (- len 2)))))))))
-
-(define (transfer-line-number to from)
-  (set! (line-number to) (line-number from))
-  to)
-
-;; Merge two lines, assuming that upper ends with a backslash
-(define (merge-lines upper lower)
-  (let ((new-string (string-append (string-drop-right upper 1) lower)))
-    (transfer-line-number new-string upper)
-    new-string))
-
-(define (fold-lines lines)
-  (fold-right (lambda (line done)
-                (if (line-continued? line)
-                    (cons (merge-lines line (car done)) (cdr done))
-                    (cons line done)))
-              '()
-              lines))
-
-
-(define comment-rx (make-regexp "(//|/[*]|[*]/)"))
-
-(define (strip-comments lines)
-  (let loop ((in-comment #f) (lines lines) (done '()))
-    (if (null? lines)
-        (reverse done)
-        (let ((line (car lines)))
-          (cond ((regexp-exec comment-rx line)
-                 => (lambda (m)
-                      (format (current-output-port) "~s ~s substr = ~s~%" in-comment (line-number line) (match:substring m))
-                      (cond ((and in-comment (string=? "*/" (match:substring m)))
-                             (loop #f (cons (transfer-line-number (match:suffix m) line)
-                                            (cdr lines))
-                                   done))
-                            (in-comment (loop #t (cdr lines) done))
-                            ((string=? "//" (match:substring m))
-                             (loop #f (cdr lines) (cons (transfer-line-number (match:prefix m) line)
-                                                        done)))
-                            ((string=? "/*" (match:substring m))
-                             (loop #t (cons (transfer-line-number (match:suffix m) line) (cdr lines)) done))
-                            (else
-                             (scm-error 'cpp-error "strip-comments"
-                                        "Unexpected */ in file ~a on line ~a"
-                                        (list (line-file line) (line-number line))
-                                        #f)))))
-                (else (loop in-comment (cdr lines) (cons line done))))))))
-
-
-(define-immutable-record-type <preprocessor-directive>
-  (make-preprocessor-directive type body)
-  proprocessor-directive?
-  (type directive-type)
-  (body directive-body))
-
-(define cpp-directive-rx (make-regexp "\\s*#\\s*((\\w+)(.*))?"))
-(define (preprocessor-directive? line)
-  (cond ((regexp-exec cpp-directive-rx line)
-         => (lambda (m)
-              (if (match:substring m 2)
-                  (make-preprocessor-directive
-                   (string->symbol (match:substring m 2))
-                   (string-trim-both (match:substring m 3) char-set:whitespace))
-                  'sort-of)))
-        (else #f)))
-
-;; defined
-
-;; TODO _Pragma
-
-
-(define (expand-function-line-macro environment macro . params)
-  (expand-macro environment (apply-macro macro (map (lambda (param) (expand-macro environment param)) params))))
-
-;; (define (environment-ref ))
-
-(define (list-of? lst predicate)
-  (every predicate lst))
-
-
-;; Parantheses when defining macro
-(define (parse-parameter-string string)
-  (map string-trim-both
-       (string-split (string-trim-both string (char-set #\( #\)))
-                     #\,)))
-
-
-(define-type (object-macro)
-  (body type: string?))
-
-(define-type (function-macro)
-  (formals type: (list-of? string?))
-  (body type: string?))
-
-
-;; 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 (crash-if-not-if body guilty)
-  (scm-error 'cpp-error guilty
-             "else, elif, and endif invalid outside if scope: ~s~%file: ~s line: ~s"
-             (list body (line-file body) (line-number body))))
-
-;; (environment, lines) -> environment x lines
-(define (parse-directives environment lines)
-  (let loop ((environment environment) (lines lines) (done '()))
-    (let* ((line (car line))
-           (directive? (preprocessor-directive? line)))
-      (case directive?
-        ((#f)                ; regular line
-         (loop environment (cdr lines)
-               ;; TODO this doesn't work, since parse-macros works on multiple lines
-               (cons (parse-macros environment (car lines)) done)))
-        ((sort-of)           ; a no-op directive
-         (loop environment (cdr lines) done))
-        (else                ; an actual directive
-         (case (car (cpp-if-status environment))
-           ((outside)
-            (case (directive-type m)
-              ((ifndef endif else)
-               (scm-error 'cpp-error "parse-directives"
-                          "Unexpected directive: ~s"
-                          (list line) #f))
-              (else          ; inside if, ifelse or else
-               ;; outside active-if inactive-if
-               (case (directive-type m)
-                 ;; stack ending directives
-                 ((endif)
-                  (case (car (cpp-if-status environment))
-                    ((outside) (crash-if-not-if (directive-body m) "endif"))
-                    (else (loop (modify environment cpp-if-status cdr)
-                                (cdr lines)
-                                done))))
-
-                 ;; stack nudging directives
-                 ((else)
-                  (case (car (cpp-if-status environment))
-                    ((outside) (crash-if-not-if (directive-body m) "else"))
-                    (else (loop (modify environment (lens-compose cpp-if-status car*)
-                                        (lambda (old)
-                                          (case old
-                                            ((active-if)   'inactive-if)
-                                            ((inactive-if) 'active-if))))
-                                (cdr lines)
-                                done))))
-                 ((elif)
-                  (case (car (cpp-if-status environment))
-                    ((outside) (crash-if-not-if (directive-body m) "elif"))
-                    (else 'TODO ;; TODO
-                     )
-                    ))
-
-                 ;; stack creating directives
-                 ;; on inactive-if each creates a new frame, which also is inactive
-                 ((ifndef)
-                  (case (car (cpp-if-status environment))
-                    ((inactive-if) (loop (modify environment cpp-if-status
-                                                 xcons 'inactive-if)
-                                         (cdr lines)
-                                         done))
-                    (else (loop (modify environment cpp-if-status
-                                        xcons (if (in-environment? environment (directive-body directive?))
-                                                  'inactive-if 'active-if))
-                                (cdr lines)
-                                done))))
-
-                 ((ifdef)
-                  (case (car (cpp-if-status environment))
-                    ((inactive-if) (loop (modify environment cpp-if-status
-                                                 xcons 'inactive-if)
-                                         (cdr lines)
-                                         done))
-                    (else
-                     (loop (modify environment cpp-if-status
-                                   xcons (if (in-environment? environment (directive-body directive?))
-                                             'active-if 'inactive-if))
-                           (cdr lines)
-                           done))))
-
-                 ((if)
-                  (case (car (cpp-if-status environment))
-                    ((inactive-if) (loop (modify environment cpp-if-status
-                                                 xcons 'inactive-if)
-                                         (cdr lines)
-                                         done))
-                    (else 'TODO ;; TODO
-                     )))
-
-
-                 ;; other directives
-                 ((include) (cond ((string-match "[<\"](.*)"
-                                                 => (lambda (m)
-                                                      (let ((fileneme (string-drop-right (directive-body m) 1)))
-                                                        (case (string-ref (match:substring m 1) 0)
-                                                          ;; TODO include-path
-                                                          ((#\<) (handle-file environment filename))
-                                                          ((#\") (handle-file environment filename))))))
-                                   (else (scm-error 'cpp-error "parse-directives"
-                                                    "Invalid include"
-                                                    '() #f)))))
-                  ((define)
-                   ;; TODO what are valid names?
-                   (cond ((string-match "^(\\w+)([(][^)]*[)])?\\s+(.*)" (directive-body directive?))
-                          => (lambda (m)
-                               (loop (let ((macro-body (string-trim-both (match:substring m 3))))
-                                       (add-identifier!
-                                        environment
-                                        (match:substring m 1)
-                                        (cond ((match:substring m 2)
-                                               => (lambda (parameter-string)
-                                                    (function-macro
-                                                     formals: (parse-parameter-string parameter-string)
-                                                     body: macro-body)))
-                                              (else (object-macro body: macro-body)))))
-                                     (cdr lines)
-                                     done)))
-                         (else (scm-error 'cpp-error "parse-directives"
-                                          "Invalid #define line, ~s"
-                                          (list (directive-body directive?))
-                                          #f))))
-
-                  ((undef)
-                   (case (car (cpp-if-status environment))
-                     ((inactive-if) (loop environment (cdr lines) done))
-                     (else (loop (remove-identifier environment (directive-body directive?))
-                                 (cdr lines)
-                                 done))))
-
-                  ((line)
-                   (case (car (cpp-if-status environment))
-                     ((inactive-if) (loop environment (cdr lines) done))
-                     ;; TODO add first-run parameter to loop, in case expand-macros still return something invalid
-                     (else (let parse-line-directive ((tokens (string-tokenize (directive-body directive?))))
-                             (cond ((= 1 (length tokens))
-                                    ;; TODO parse token
-                                    (if (integer? (car tokens))
-                                        ;; TODO update current line
-                                        (loop environment (cdr lines) done)
-                                        (parse-line-directive (expand-macros environment (directive-body directive?)))))
-                                   ((= 2 (length tokens))
-                                    ;; TODO parse tokens
-                                    (if (and (integer? (car tokens))
-                                             (string-literal? (cadr tokens)))
-                                        ;; TODO update current line and file
-                                        (loop environment (cdr lines) done)
-                                        (parse-line-directive (expand-macros environment (directive-body directive?)))))
-                                   (else (parse-line-directive (expand-macros environment (directive-body directive?)))))))))
-
-                  ((error)
-                   (throw 'cpp-error-directive
-                          (directive-body directive?)))
-
-                  ((warning)
-                   (format (current-error-port) "#warning ~a~%"
-                           (directive-body directive?))
-                   (loop environment (cdr lines) done))
-
-                  ((pragma)
-                   (format (current-error-port)
-                           "PRAGMA: ~s~%" (directive-body directive?))
-                   (loop environment (cdr lines) done))
-
-                  ((ident sccs)
-                   (format (current-error-port)
-                           "IDENT: ~s~%" (directive-body directive?))
-                   (loop environment (cdr lines) done))
-
-                  (else
-                   (scm-error 'cpp-error "parse-directives"
-                              "Unknown pre-processor directive: ~s"
-                              (list line) #f)
-                   )))))))))
-      ))
-
-
-(define* (writeln expr optional: (port (current-output-port)))
-  (write expr port)
-  (newline port))
-
-(define (handle-lines environment lines)
-  (parse-directive environment
-                   (compose strip-comments fold-lines number-lines)))
-
-  ;; parse-directives environment
-
-;; Return a number of lines
-(define (read-file file-path)
-  (define raw-lines (call-with-input-file file-path read-lines))
-  (mark-with-property! line line-file file-path)
-  (handle-lines raw-lines))
-
-
-;; pre defined macros
-;; see info manual for cpp 3.7.1 Standard Predefined Macros
-;; __FILE__
-;; __LINE__
-;; __DATE__ "Feb 12 1996"
-;; __TIME__ "23:59:01"
-;; __STDC__ 1
-;; __STDC_VERSION__ 201112L
-;; __STDC_HOSTED__ 1
-
-;; __cplusplus
-;; __OBJC__
-;; __ASSEMBLER__
diff --git a/module/c/util.scm b/module/c/util.scm
deleted file mode 100644
index f258d3e3..00000000
--- a/module/c/util.scm
+++ /dev/null
@@ -1,20 +0,0 @@
-(use-modules (c lex2)
-             (srfi srfi-1)
-             (srfi srfi-88)
-             (c to-token)
-             (c cpp-types))
-
-(define (tok s)
-  (map preprocessing-token->token (remove whitespace-token? (lex s))))
-
-(define* (parse tokens optional: (parser make-parser))
-  ((parser)
-   (build-lexical-analyzer tokens)
-   error))
-
-
-(define (mm)
-  (lalr-parser
-   (x)
-   (y (x))
-   ))
diff --git a/module/c/zipper.scm b/module/c/zipper.scm
deleted file mode 100644
index 65cea211..00000000
--- a/module/c/zipper.scm
+++ /dev/null
@@ -1,60 +0,0 @@
-;;; Commentary:
-;; Zipper data structure. Could be moved to (hnh util), but would then need to
-;; be at least slightly more thorough.
-;;; Code:
-
-(define-module (c zipper)
-  :use-module (srfi srfi-88)
-  :use-module (hnh util object)
-  :export (list-zipper
-           list-zipper?
-           left focused right
-           zip-left
-           zip-right
-           zip-find-right
-           list->zipper
-           zipper->list
-           rezip))
-
-(define-type (list-zipper)
-  (left type: list?)
-  focused
-  (right type: list?))
-
-;; Move zipper one step to the left
-(define (zip-left zipper)
-  (if (null? (left zipper))
-      zipper
-      (list-zipper left: (cdr (left zipper))
-                   right: (cons (focused zipper) (right zipper))
-                   focused: (car (left zipper)))))
-
-;; Move zipper one step to the right
-(define (zip-right zipper)
-  (if (null? (right zipper))
-      zipper
-      (list-zipper left: (cons (focused zipper) (left zipper))
-                   right: (cdr (right zipper))
-                   focused: (car (right zipper)))))
-
-;; find first element matching predicate, going right
-(define (zip-find-right predicate zipper)
-  (cond ((null? (right zipper)) zipper)
-        ((predicate (focused zipper)) zipper)
-        (else (zip-find-right predicate (zip-right zipper)))))
-
-(define (list->zipper list)
-  (list-zipper left: '()
-               focused: (car list)
-               right: (cdr list)))
-
-
-(define (rezip zipper)
-  (if (null? (left zipper))
-      zipper
-      (rezip (zip-left zipper))))
-
-(define (zipper->list zipper)
-  (let ((z (rezip zipper)))
-    (cons (focused z)
-          (right z))))
diff --git a/module/glob.scm b/module/glob.scm
index 64f97690..bd9a6ea5 100644
--- a/module/glob.scm
+++ b/module/glob.scm
@@ -1,7 +1,7 @@
 (define-module (glob)
   :use-module (system foreign)
   :use-module (rnrs bytevectors)
-  :use-module (c cpp)
+  :use-module (c old cpp)
   :export (glob))
 
 
diff --git a/module/vulgar/termios.scm b/module/vulgar/termios.scm
index ddd8920f..5ef86c00 100644
--- a/module/vulgar/termios.scm
+++ b/module/vulgar/termios.scm
@@ -7,7 +7,7 @@
   :use-module (ice-9 rdelim)
   :use-module (srfi srfi-9)             ; records
   :use-module (srfi srfi-88)
-  :use-module (c cpp)
+  :use-module (c old cpp)
   :use-module (hnh util)
   :export (make-termios
            copy-termios
diff --git a/tests/test/c-parse.scm b/tests/test/c-parse.scm
index c16958de..22aaf92a 100644
--- a/tests/test/c-parse.scm
+++ b/tests/test/c-parse.scm
@@ -6,11 +6,11 @@
 (define-module (test cpp)
   :use-module (srfi srfi-64)
   :use-module (srfi srfi-88)
-  :use-module ((c lex) :select (lex))
-  :use-module (c parse))
+  :use-module ((c old lex) :select (lex))
+  :use-module (c old parse))
 
-(define flatten-infix (@@ (c parse) flatten-infix))
-(define resolve-order-of-operations (@@ (c parse) resolve-order-of-operations))
+(define flatten-infix (@@ (c old parse) flatten-infix))
+(define resolve-order-of-operations (@@ (c old parse) resolve-order-of-operations))
 
 (test-group "Flatten infix"
  (test-equal "Simple binary operator"
diff --git a/tests/test/cpp.scm b/tests/test/cpp.scm
deleted file mode 100644
index 1294bc96..00000000
--- a/tests/test/cpp.scm
+++ /dev/null
@@ -1,604 +0,0 @@
-;;; Commentary:
-;; Tests my parser for a subset of the C programming language.
-;;; Code:
-
-(define-module (test cpp)
-  :use-module (srfi srfi-1)
-  :use-module (srfi srfi-64)
-  :use-module (srfi srfi-88)
-  :use-module ((c lex) :select (lex))
-  :use-module ((c parse) :select (parse-lexeme-tree))
-  :use-module ((c eval) :select (c-eval))
-  :use-module ((c eval environment) :select (make-environment env-set!))
-  :use-module ((rnrs arithmetic bitwise)
-               :select (bitwise-xor)))
-
-;; 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
-
-;; __asm__ always has strings as arguments
-(test-skip "__asm__")
-
-;; Lexer produces garbage when attempted. Fixing this would also fix cast
-;; operations.
-(test-skip "Float in infix expression")
-;; order of operation is wrong, leading to an incorrect result
-(test-skip "Cast with operation")
-
-;; not implemented
-(test-skip "Token concatenation")
-
-;; A string follewed by a macro (which expands to a string)
-;; should be concatenated. This is however not yet implemented
-(test-skip "Implicit concatenation of string and macro")
-
-(define run (compose parse-lexeme-tree lex))
-
-(define (alist->environment alist)
-  (fold (lambda (pair env)
-          (apply env-set! env pair))
-        (make-environment)
-        alist))
-
-(define (exec form . base-bindings)
-  (call-with-values
-      (lambda () (c-eval (alist->environment base-bindings)
-                    (run form)))
-    (lambda (env value) value)))
-
-(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))
- (test-equal 6 (exec 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-equal 6 (exec 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-equal 6 (exec form)))
-
-(test-group "Unary minus"
-  (test-group "Without space"
-    (let ((form "-1"))
-      (test-equal '(prefix (prefix-operator "-")
-                           (integer (base-10 "1")))
-        (lex form))
-      (test-equal '(- 1) (run form))
-      (test-equal -1 (exec form))))
-
-  (test-group "With space"
-    (let ((form "- 1"))
-      (test-equal '(prefix (prefix-operator "-")
-                           (integer (base-10 "1")))
-        (lex form))
-      (test-equal '(- 1) (run form))
-      (test-equal -1 (exec form))))
-
-  (test-group "Before variable"
-    (let ((form "-x"))
-      (test-equal '(prefix (prefix-operator "-")
-                           (variable "x"))
-        (lex form))
-      (test-equal '(- x) (run form))
-      (test-equal -5 (exec form '(x 5)))))
-
-  (test-group "Before infix"
-    (let ((form "-x+3"))
-      (test-equal '(infix (prefix (prefix-operator "-")
-                                  (variable "x"))
-                          (operator "+")
-                          (integer (base-10 "3")))
-        (lex form))
-      (test-equal '(+ (- x) 3) (run form))
-      (test-equal -2 (exec form '(x 5)))))
-
-  (test-group "Inside infix expression"
-    (let ((form "x+-3"))
-      (test-equal '(infix (variable "x")
-                          (operator "+")
-                          (prefix (prefix-operator "-")
-                                  (integer (base-10 "3"))))
-        (lex form))
-      (test-equal '(+ x (- 3)) (run form))
-      (test-equal 2 (exec form '(x 5)))))
-  )
-
-
-
-
-;; 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))
-  (test-equal 1000000 (exec 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))
-  (test-equal 1 (exec form '(a 1) '(b 2)))
-  (test-equal 0 (exec form '(a 1) '(b 1)))
-  )
-
-(let ((form "((c) == (val) && (val) != _POSIX_VDISABLE)"))
-  ;; (test-equal '() (lex form))
-  (test-equal '(and (== c val)
-                    (not_eq val _POSIX_VDISABLE))
-    (run form))
-  (test-equal 0 (exec form '(c 1) '(val 2) '(_POSIX_VDISABLE 3)))
-  )
-
-(let ((form "CTRL('O')"))
-  (test-equal '(funcall (variable "CTRL") (group (char "O"))) (lex form))
-  (test-equal '(funcall CTRL 79) (run form))
-  (test-equal (bitwise-xor #x40 (char->integer #\O))
-    (exec form
-          ;; Definition copied from our parsers output of
-          ;; preprocessing output as defined above
-          '(CTRL (lambda (x)
-                   (ternary (and (>= x 97) (<= x 122))
-                            (+ (- x 97) 1)
-                            (bitand (+ (- x 65) 1) 127)))))))
-
-(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)))
-
-
-;; 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)
-
-(test-group "Token concatenation"
-  (let ((form "x ## y"))
-    (test-equal '() (lex form))
-    (test-equal '0 (run form))))
-
-(test-group "Floating point numbers"
-
-  (test-group "Diffent forms"
-    (test-group "No decimal point, exponent, no suffix"
-      (let ((form "10e10"))
-        (test-equal '(float (float-integer (base-10 "10"))
-                            (exponent (base-10 "10")))
-          (lex form))
-        (test-equal 10e10 (run form))))
-
-    (test-group "No decimal point, negative exponent"
-      (let ((form "10e-10"))
-        (test-equal '(float (float-integer (base-10 "10"))
-                            (exponent "-" (base-10 "10")))
-          (lex form))
-        (test-equal 10e-10 (run form))))
-
-    (test-group "No decimal point, exponent and suffix"
-      (let ((form "10e10L"))
-        (test-equal '(float (float-integer (base-10 "10"))
-                            (exponent (base-10 "10"))
-                            (float-suffix "L"))
-          (lex form))
-        (test-equal '(as-type (long double) 10e10)
-          (run form))))
-
-    (test-group "Leading period, no exponent or suffix"
-      (let ((form ".1"))
-        (test-equal '(float (float-decimal (base-10 "1"))) (lex form))
-        (test-equal 0.1 (run form))))
-
-    (test-group "Trailing period, no exponent or suffix"
-      (let ((form "1."))
-        (test-equal '(float (float-integer (base-10 "1"))) (lex form))
-        (test-equal 1.0 (run form)))))
-
-
-  (test-group "Negative float"
-    (let ((form "-1.0"))
-      (test-equal '(prefix (prefix-operator "-")
-                           (float (float-integer (base-10 "1"))
-                                  (float-decimal (base-10 "0"))))
-        (lex form))
-      (test-equal '(- 1.0) (run form))))
-
-
-
-  (test-group "Real world examples"
-    (let ((form "4.9406564584124654e-324"))
-      (test-equal '(float (float-integer (base-10 "4"))
-                          (float-decimal (base-10 "9406564584124654"))
-                          (exponent "-" (base-10 "324")))
-        (lex form))
-      (test-equal 4.9406564584124654e-324 (run form)))
-
-    (let ((form "1.7976931348623157e+308"))
-      (test-equal '(float (float-integer (base-10 "1"))
-                          (float-decimal (base-10 "7976931348623157"))
-                          (exponent "+" (base-10 "308")))
-        (lex form))
-      (test-equal 1.7976931348623157e+308 (run form))))
-
-  (test-group "Float in infix expression"
-    (test-group "Simple case"
-      (let ((form "1. + .1"))
-        (test-equal '(infix (float (float-integer (base-10 "1")))
-                            (operator "+")
-                            (float (float-decimal (base-10 "1"))))
-          (lex form))
-        (test-equal '(+ 1.0 0.1) (run form))))
-    ;; (test-group "Complicated case")
-    ))
-
-(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 inout
-                                 (<< (bitand len IOCPARM_MASK) 16)
-                                 (<< group 8)
-                                 num))
-      (run form))))
-
-(test-group "Characters"
-  (let ((form "'c'"))
-    (test-equal '(char "c") (lex form))
-    (test-equal #x63 (run form)))
-
-  (let ((form "'\\n'"))
-    (test-equal '(char (escaped-char "n")) (lex form))
-    (test-equal (char->integer #\newline) (run form))))
-
-(test-group "Strings"
-  (test-group "Empty string"
-    (let ((form "\"\""))
-      (test-equal 'string (lex form))
-      (test-equal #vu8(0) (run form))))
-
-  (test-group "Simple string"
-    (let ((form "\"li\""))
-      (test-equal '(string "li") (lex form))
-      (test-equal #vu8(#x6C #x69 0) (run form))))
-
-  (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-group "Implicit concatenation of string and macro"
-    (let ((form "\"a\" MACRO"))
-      (test-equal '((string "a") (variable "MACRO")) (lex form))
-      (test-equal '() (run form))))
-
-  (test-group "String with only escape"
-    (let ((form (string #\" #\\ #\" #\")))
-      (test-equal `(string (escaped-char "\"")) (lex form))
-      (test-equal #vu8(34 0) (run form))))
-
-  (test-group "String with escape at start"
-    (let ((form (string #\" #\\ #\" #\a #\")))
-      (test-equal `(string (escaped-char "\"") "a") (lex form))
-      (test-equal #vu8(34 #x61 0) (run form))))
-
-  (test-group "String with escape at end"
-    (let ((form (string #\" #\a #\\ #\" #\")))
-      (test-equal `(string "a" (escaped-char "\"")) (lex form))
-      (test-equal #vu8(#x61 34 0) (run form))))
-
-  (test-group "String with escape in middle"
-    (let ((form (string #\" #\a #\\ #\" #\b #\")))
-      (test-equal `(string "a" (escaped-char "\"") "b") (lex form))
-      (test-equal #vu8(#x61 34 #x62 0) (run form))))
-
-  ;; \e is semi non-standard
-  (test-group "String with bakslash-e esacpe"
-    (let ((form "\"\\e\""))
-      (test-equal '(string (escaped-char "e")) (lex form))
-      (test-equal #vu8(#x1b 0) (run form))))
-
-  (test-group "String with byte secquence escape"
-    (let ((form "\"\\xf0\\x9f\\x92\\xa9\""))
-      (test-equal '(string (escaped-char (base-16-char "f0"))
-                           (escaped-char (base-16-char "9f"))
-                           (escaped-char (base-16-char "92"))
-                           (escaped-char (base-16-char "a9")))
-        (lex form))
-      (test-equal #vu8(#xf0 #x9f #x92 #xa9 0) (run form)))))
-
-(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)))